1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Joachim Schimpf. 20% 21% END LICENSE BLOCK 22% ---------------------------------------------------------------------- 23% System: ECLiPSe Constraint Logic Programming System 24% Component: ECLiPSe III compiler 25% Version: $Id: compiler_indexing.ecl,v 1.12 2010/07/25 13:29:04 jschimpf Exp $ 26%---------------------------------------------------------------------- 27 28:- module(compiler_indexing). 29 30:- comment(summary, "ECLiPSe III compiler - indexing"). 31:- comment(copyright, "Cisco Technology Inc"). 32:- comment(author, "Joachim Schimpf"). 33:- comment(date, "$Date: 2010/07/25 13:29:04 $"). 34 35:- use_module(compiler_common). 36:- import state_lookup_binding/3 from compiler_analysis. 37 38:- lib(hash). 39 40:- comment(desc, ascii(" 41 This pass finds information that can be exploited for indexing (i.e. 42 filtering alternatives from disjunctions). The disjunctions are annotated 43 with this information. 44 45 The code generator uses this information to generate switch-instructions 46 and try-sequences. 47")). 48 49 50% Structure describing a guard test: 51% Specifies which values of a variable the guard will accept. 52% Guard goals that cannot be indexed are represented with varid:0,class:[] 53:- local struct(guard( 54 branchnr, % branch in which this guard occurs 55 varid, % variable that this guard tests (or 0) 56 class % list of: atomic Tag name, value(Val,Tag) or N/A 57 )). 58 59 60:- export indexing_transformation/3. 61 62indexing_transformation(Goals, OutGoals, Options) :- 63 indexing_transformation(Goals, OutGoals, det, Options). 64 65indexing_transformation([], [], _Det, _Options). 66indexing_transformation([Goal|Goals], OutGoals, Det, Options) :- 67 ( Goal = disjunction{branches:Branches,determinism:BranchDets} -> 68 OutGoals = [OutGoal|OutGoals1], 69 update_struct(disjunction, [branches:OutBranches], Goal, OutGoal), 70 index_disjunction(Goal), 71 dump_indexes(Goal, Options), 72 ( 73 foreach(Branch,Branches), 74 foreach(OutBranch,OutBranches), 75 foreacharg(BranchDet,BranchDets), 76 param(Options) 77 do 78 indexing_transformation(Branch, OutBranch, BranchDet, Options) 79 ) 80 81 ; Goal = goal{functor:cut_to/1,kind:simple,definition_module:sepia_kernel, 82 args:[variable{varid:VarId}],state:State,callpos:CutPos} -> 83 % Eliminate cuts that are always in the last (or only) alternative 84 ( 85 state_lookup_binding(State, VarId, ++(cutpoint(SaveCutPos))), 86 in_following_branch_guard(SaveCutPos, CutPos), 87 last_alternative(Det) 88 -> 89 OutGoals = OutGoals1 % eliminate the cut! 90 ; 91 OutGoals = [Goal|OutGoals1] 92 ) 93 ; 94 OutGoals = [Goal|OutGoals1] 95 ), 96 indexing_transformation(Goals, OutGoals1, Det, Options). 97 98 99/* 100Algorithm: 101 Scan the guards in every branch of the disjunction. The guards 102 are the leading goals in the disjunctions up to, but not 103 including, the first regular goal or the first cut(_to). 104 105 A guard that can be used for indexing is represented as a struct 106 guard{}, which describes the conditions under which a guard is 107 satisfied for a particular variable. It lists the value classes 108 for which the guard must (t) or may (m) pass. For example, a 109 guard X=3 in branch 5 of the disjunctions is represented as 110 guard{branchnr:5,varid:Xid,[[integer,3]-t]) A value class is a 111 list containing the tag and optionally a value. 112 113 Then the guards are grouped by variable, and translated into 114 a decision tree, where the first level corresponds to the tags, 115 and the second level to values. However, the tree implementation 116 is general and the structure can be made more complex. 117 118 Finally, the decision trees for the different variables are 119 evaluated, and ordered according to their selectivity. 120 121 The weighted decision trees form the input for the code generator. 122 123 CAUTION: the entries in the index tree *assume* (for purposes of 124 definitive passing of guard and commit) that the indexing code 125 tests for exactly the tag/value given in the tree entry. 126*/ 127 128index_disjunction(disjunction{branches:Branches,branchlabels:BranchLabelArray, 129 state:StartState, 130 indexvars:Args,indexes:OrderedIndexes,determinism:Determinism}) :- 131 132 % Collect all guards of all branches into one list of guard{} 133 hash_create(VaridsInCommittedGuards), 134 ( 135 % for each branch in the disjunction 136 count(I,1,NBranches), 137 foreach(Branch,Branches), 138 fromto(GuardsByBranch,Guards0,Guards1,[]), 139 param(StartState,VaridsInCommittedGuards) 140 do 141 extract_guards_from_prefix(Branch, I, StartState, [], GuardInfo0, false, _UnifyFlag, End), 142 ( End == commit -> 143 % remember the varids that occur in committed guards 144 ( foreach(guard{varid:VarId},GuardInfo0), param(VaridsInCommittedGuards) do 145 hash_set(VaridsInCommittedGuards, VarId, []) 146 ), 147 exploit_commit(GuardInfo0, GuardInfo1) 148 ; 149 GuardInfo1 = GuardInfo0 150 ), 151 sort(varid of guard, =<, GuardInfo1, GuardInfo2), 152 % remove marker entries of non-indexable guards 153 ( GuardInfo2 = [guard{varid:0}|GuardInfo] -> 154 true 155 ; 156 GuardInfo = GuardInfo2 157 ), 158 append(GuardInfo, Guards1, Guards0) 159 ), 160 dim(BranchLabelArray, [NBranches]), 161 162 % Heuristic: If any of the branches had committed guards, we 163 % use for indexing only the variables that occurred in at least 164 % one committed guard. This reduces the number of useless 165 % indexes on what are probably output variables. 166 ( hash_count(VaridsInCommittedGuards, 0) -> 167 % no committed guards at all: index everything 168 UsefulGuardsByBranch = GuardsByBranch 169 ; 170 % filter out likely output-variables 171 ( 172 foreach(Guard,GuardsByBranch), 173 fromto(UsefulGuardsByBranch,UGBB1,UGBB0,[]), 174 param(VaridsInCommittedGuards) 175 do 176 Guard = guard{varid:VarId}, 177 ( hash_contains(VaridsInCommittedGuards,VarId) -> 178 UGBB1 = [Guard|UGBB0] 179 ; 180 UGBB1 = UGBB0 181 ) 182 ) 183 ), 184 185 % Compute the set of indexable varids and initialise 186 % one index descriptor for each of them 187 project_arg(varid of guard, UsefulGuardsByBranch, VarIdsMulti), 188 sort(0, <, VarIdsMulti, VarIds), 189 ( 190 % for each indexable variable 191 foreach(VarId,VarIds), 192 foreach(VarDesc,Args), 193 foreach(index{variable:VarDesc,partition:DT},Indexes) 194 do 195 % create variable access descriptor (must be done before 196 % compute_lifetimes) for use in generate_code later 197 new_vardesc(VarId, VarDesc), 198 % init the decision tree for this variable 199 dt_init(DT) 200 ), 201 202 % Now incrementally build the decision trees by adding 203 % each branch to each variable's decision tree. 204 % PRE: UsefulGuardsByBranch are sorted first by branch, then by varid. 205 ( 206 % for each branch in the disjunction 207 for(I,1,NBranches), 208 fromto(UsefulGuardsByBranch,Guards1,Guards4,[]), 209 param(Indexes) 210 do 211 ( 212 % for each indexable variable 213 foreach(index{variable:variable{varid:VarId},partition:DT},Indexes), 214 fromto(Guards1,Guards2,Guards3,Guards4), 215 param(I) 216 do 217 ( Guards2 = [guard{varid:VarId,branchnr:I,class:AltClasses}|Guards3] -> 218 ( foreach(Class-Pass,AltClasses), param(I,DT) do 219 ( Pass=c -> Final=yes ; Final=no), 220 dt_add(DT, Class, I, Final) 221 ) 222 ; 223 % no guard for VarId in branch I 224 Guards3 = Guards2, 225 dt_add(DT, [], I, no) 226 ) 227 ) 228 ), 229 230 % Evaluate and sort indexes according to quality 231 ( foreach(index{partition:Dt,quality:Q},Indexes) do 232 eval_index_quality(Dt, Q) 233 ), 234 sort(quality of index, =<, Indexes, OrderedIndexes), 235 eval_index_det(OrderedIndexes, NBranches, Determinism). 236 237 238 239% Takes the goals that start the given branch, and a starting state. 240% Computes a representation of the guard goals, plus a flag indicating 241% whether the guard ends with or without a commit. 242extract_guards_from_prefix([], _BranchNr, _StartState, Info, Info, UnifyFlag, UnifyFlag, end). 243extract_guards_from_prefix([Goal|Goals], BranchNr, StartState, Info0, Info, UnifyFlag0, UnifyFlag, End) :- 244 ( 245 % consider only builtin predicates 246 % caution: regular preds can wake (and fail!) 247 Goal = goal{kind:simple,definition_module:sepia_kernel}, 248 extract_guards_from_goal(Goal, BranchNr, StartState, UnifyFlag0, UnifyFlag1, Guard, End) 249 -> 250 and_guard(Guard, Info0, Info1), 251 ( var(End) -> 252 extract_guards_from_prefix(Goals, BranchNr, StartState, Info1, Info, UnifyFlag1, UnifyFlag, End) 253 ; 254 % end of guard detected 255 Info = Info1, UnifyFlag = UnifyFlag0 256 ) 257 258 ; Goal = goal{kind:head,state:HeadState} -> 259 % Use the head's binding information instead of what was known 260 % prior to the disjunction 261 extract_guards_from_prefix(Goals, BranchNr, HeadState, Info0, Info, UnifyFlag0, UnifyFlag, End) 262% extract_guards_from_prefix(Goals, BranchNr, StartState, Info0, Info, UnifyFlag0, UnifyFlag, End) 263 264 ; Goal = disjunction{branches:[SubBranch1|SubBranches]} -> 265 % look into the prefixes of the branches 266 extract_guards_from_prefix(SubBranch1, BranchNr, StartState, [], SubInfo1, UnifyFlag0, UnifyFlag1, _End), 267 ( 268 foreach(SubBranch,SubBranches), 269 fromto(SubInfo1,SubInfo2,SubInfo4,SubInfo), 270 fromto(UnifyFlag1,UnifyFlag2,UnifyFlag3,UnifyFlag), 271 param(BranchNr,StartState, UnifyFlag0) 272 do 273 extract_guards_from_prefix(SubBranch, BranchNr, StartState, [], SubInfo3, UnifyFlag0, UnifyFlagI, _End), 274 or_guards(SubInfo2, SubInfo3, SubInfo4), 275 or_flags(UnifyFlagI, UnifyFlag2, UnifyFlag3) 276 ), 277 and_guards(Info0, SubInfo, Info), 278 End = end % not sure about the scope of commits in sub-branches 279 ; 280 % end of guard 281 Info = Info0, UnifyFlag = UnifyFlag0, End = end 282 ). 283 284 285% PRE: the goal is a builtin from sepia_kernel. 286% Fail if encountering a goal that signals end-of-guard. 287% Regular goal can cause waking (and therefore insert failures). 288% StartState is the analysis state at the beginning of the disjunction. 289% UnifyFlag is true if goals between switch and the current goal might 290% have unified any switch variables (and thus weakened the guards). 291% Additionally, we set UnifyFlagAfter iff the current goal can unify a 292% switch variable (and thus weaken the switch conditions for subsequent guards). 293 294extract_guards_from_goal(goal{functor:get_cut/1}, 295 _BranchNr, _StartState, UnifyFlag, UnifyFlag, true, _) :- !. 296 297extract_guards_from_goal(goal{functor:cut_to/1}, 298 _BranchNr, _StartState, UnifyFlag, UnifyFlag, true, commit) :- !. 299 300extract_guards_from_goal(goal{functor:(=)/2, args:[Lhs,Rhs], state:GoalState}, 301 BranchNr, StartState, _UnifyFlag, UnifyFlagAfter, Guard, _) :- !, 302 % unifications should be normalised and always 303 % have a variable on the left hand side 304 certainly_once Lhs = variable{varid:VarId}, 305 % state_lookup_binding should succeed iff the variable was known 306 % before the start of the disjunction 307 ( state_lookup_binding(StartState, VarId, _Binding) -> 308 ( atomic_tag(Rhs, Tag) -> 309 ( value_indexable(Tag) -> 310 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag,Rhs]-t]} 311 ; single_value(Tag) -> 312 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag]-t]} 313 ; 314 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[Tag]-m]} 315 ) 316 ; Rhs = structure{name:F,arity:A,args:Args} -> 317 (all_fresh_vars(Args, A, GoalState) -> PassFlag=t ; PassFlag=m ), 318 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[structure,F/A]-PassFlag]} 319 ; Rhs = [A1|A2] -> 320 (all_fresh_vars([A1,A2], 2, GoalState) -> PassFlag=t ; PassFlag=m ), 321 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var]-t,[list]-PassFlag]} 322 ; Rhs = variable{varid:VarId} -> 323 % an X=X dummy goal 324 Guard = true 325 ; verify Rhs = variable{}, 326 %%% REVIEW: classes should be disjoint 327% Guard = guard{branchnr:BranchNr,varid:VarId,class:[[]-m,[var]-t]} 328% Guard = guard{branchnr:BranchNr,varid:VarId,class:[[]-m]} 329 Guard = guard{branchnr:BranchNr,varid:0,class:[]} 330 ), 331 % Conservatively assume that the goal may (directly, via aliasing, 332 % or via occurrences in the Rhs) unify this or another switch variable 333 UnifyFlagAfter = true 334 % This could be more precise, using binding information: 335 % A = X false 336 % A = f(X,X) false 337 % X = f(A,B) with inst(X) false 338 % X = f(A,B) with univ(X) true 339 % X = f(A,A) true 340 % X = f(Y) true 341 % X = f(a) true 342 % X = f(g(_)) true 343 % state_lookup_binding(GoalState, VarId, LhsBinding), 344 % ( binding_inst(LhsBinding) -> \+all_fresh_term(Rhs) ; true ). 345 ; 346 % Nothing known about the variable at switch time, so it can't be 347 % used for indexing. Check whether it can fail at call time. 348 ( state_lookup_binding(GoalState, VarId, _Binding) -> 349 % insert marker for possibly failing goal 350 Guard = guard{branchnr:BranchNr,varid:0,class:[]}, 351 % Conservatively assume that the goal may (via aliasing or 352 % occurrences in Rhs) unify another switch variable 353 UnifyFlagAfter = true 354 ; 355 % a fresh variable, goal will always succeed 356 Guard = true, 357 % No danger of the guard unifying a switch variable 358 UnifyFlagAfter = false 359 ) 360 ). 361 362extract_guards_from_goal(goal{functor:(==)/2, args:[Lhs,Rhs]}, 363 BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :- !, 364 ( Lhs = variable{varid:VarId}, Rhs \= variable{} -> 365 extract_guards_from_identity(VarId, Rhs, BranchNr, StartState, UnifyFlag, Guard) 366 ; Rhs = variable{varid:VarId}, Lhs \= variable{} -> 367 extract_guards_from_identity(VarId, Lhs, BranchNr, StartState, UnifyFlag, Guard) 368 ; Lhs = variable{varid:VarId}, Rhs = variable{varid:VarId} -> 369 Guard = true 370 ; 371 % goal may fail, but can't be used for indexing 372 Guard = guard{branchnr:BranchNr,varid:0,class:[]} 373 ). 374 375extract_guards_from_goal(goal{functor:(?=)/2, args:[Lhs,Rhs], state:GoalState}, 376 BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :- !, 377 % matchings should not be preceded by unifications 378 verify UnifyFlag == false, 379 % matchings should be normalised and always 380 % have a variable on the left hand side 381 certainly_once Lhs = variable{varid:VarId}, 382 % state_lookup_binding should succeed iff the variable was known 383 % before the start of the disjunction 384 ( state_lookup_binding(StartState, VarId, _Binding) -> 385 ( atomic_tag(Rhs, Tag) -> 386 ( value_indexable(Tag) -> 387 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag,Rhs]-t]} 388 ; single_value(Tag) -> 389 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-t]} 390 ; 391 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-m]} 392 ) 393 ; Rhs = attrvar{} -> 394 % TODO fresh vars check 395 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[var,meta]-m]} 396 ; Rhs = structure{name:F,arity:A,args:Args} -> 397 (all_fresh_vars(Args, A, GoalState) -> PassFlag=t ; PassFlag=m ), 398 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[structure,F/A]-PassFlag]} 399 ; 400 Rhs = [A1|A2], 401 (all_fresh_vars([A1,A2], 2, GoalState) -> PassFlag=t ; PassFlag=m ), 402 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[list]-PassFlag]} 403 ) 404 ; 405 % This can happen if the lhs was an output mode (-) argument 406 warning("Output mode (-) overrides matching clause semantics"), 407 Guard = true 408 ). 409 410extract_guards_from_goal(goal{ 411 functor:Test/1, args:[variable{varid:VarId}] }, 412 BranchNr, StartState, UnifyFlag, UnifyFlag, Guard, _) :- 413 type_test(Test, TestClasses), 414 !, 415 ( state_lookup_binding(StartState, VarId, _Binding) -> 416 binding_effect_on_guard(UnifyFlag, TestClasses, Classes), 417 Guard = guard{branchnr:BranchNr,varid:VarId,class:Classes} 418 ; 419 % nothing known about the variable, 420 % goal may fail, but can't be used for indexing 421 % (we could probably be more precise here) 422 Guard = guard{branchnr:BranchNr,varid:0,class:[]} 423 ). 424 425 % For the ==/2 predicate, matching, etc 426 extract_guards_from_identity(VarId, Rhs, BranchNr, StartState, UnifyFlag, Guard) :- 427 % state_lookup_binding should succeed iff the variable was known 428 % before the start of the disjunction 429 ( state_lookup_binding(StartState, VarId, _Binding) -> 430 % Binding after switch can make guard true in var case! 431 binding_effect_on_guard(UnifyFlag, [], VarClass), 432 ( atomic_tag(Rhs, Tag) -> 433 ( value_indexable(Tag) -> 434 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag,Rhs]-t|VarClass]} 435 ; single_value(Tag) -> 436 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-t|VarClass]} 437 ; 438 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[Tag]-m|VarClass]} 439 ) 440 ; Rhs = structure{name:F,arity:A} -> 441 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[structure,F/A]-m|VarClass]} 442 ; verify Rhs = [_|_], 443 Guard = guard{branchnr:BranchNr,varid:VarId,class:[[list]-m|VarClass]} 444 ) 445 ; 446 % nothing known about the variable at switch time, can't be used for indexing, 447 Guard = guard{branchnr:BranchNr,varid:0,class:[]} 448 ). 449 450 451% The tags that have switch_on_value instructions 452:- mode value_indexable(+). 453value_indexable(integer). 454value_indexable(atom). 455value_indexable(structure). 456 457 458single_value([]). 459 460 461% Compute the tag of a value 462:- mode atomic_tag(+,-). 463atomic_tag(X, bignum) :- sepia_kernel:bignum(X), !. 464atomic_tag(X, integer) :- integer(X). 465atomic_tag([], '[]') :- !. 466atomic_tag(X, atom) :- atom(X). 467atomic_tag(X, breal) :- breal(X). 468atomic_tag(X, double) :- float(X). 469atomic_tag(X, rational) :- rational(X). 470atomic_tag(X, handle) :- is_handle(X). % can't occur in textual source 471atomic_tag(X, string) :- string(X). 472 473 474% Compute the tag sets resulting from various type tests 475% Also set the pass-flag: 476% t with this tag the test is definitely satisfied 477% m with this tag the test may be satisfied 478type_test(atom, [[atom]-t,[[]]-t]). 479type_test(atomic, [[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]). 480type_test(bignum, [[bignum]-t]). 481type_test(breal, [[breal]-t]). 482type_test(callable, [[[]]-t,[atom]-t,[list]-t,[structure]-t]). 483type_test(compound, [[list]-t,[structure]-t]). 484type_test(float, [[double]-t]). 485type_test(free, [[var,free]-t]). 486type_test(ground, [[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[list]-m,[structure]-m,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]). % not only tag test 487type_test(integer, [[bignum]-t,[integer]-t]). 488type_test(is_event, [[atom]-m,[handle]-m]). % not only tag test! 489type_test(is_handle, [[handle]-t]). 490type_test(is_list, [[[]]-t,[list]-m]). % not only tag test! 491type_test(is_suspension, [[goal]-m]). % not only tag test! 492type_test(meta, [[var,meta]-t]). 493type_test(nonground, [[var]-t,[list]-m,[structure]-m]). % not only tag test 494type_test(nonvar, [[[]]-t,[atom]-t,[bignum]-t,[breal]-t,[goal]-t,[list]-t,[structure]-t,[double]-t,[handle]-t,[integer]-t,[rational]-t,[string]-t]). 495type_test(number, [[bignum]-t,[breal]-t,[double]-t,[integer]-t,[rational]-t]). 496type_test(rational, [[rational]-t]). 497type_test(real, [[breal]-t,[double]-t]). 498type_test(string, [[string]-t]). 499type_test(var, [[var]-t]). 500 501 502% A unification of the switch-argument in between the switch and the 503% guard test can make the guard true in the var-case as well. 504binding_effect_on_guard(true, TestClasses, Classes) ?- 505 or_classes(TestClasses, [[var]-m], Classes). 506binding_effect_on_guard(false, Classes, Classes). 507 508 509and_guards(Guards1, Guards2, Guards) :- 510 ( 511 foreach(Guard,Guards1), 512 fromto(Guards2,Guards3,Guards4,Guards) 513 do 514 and_guard(Guard, Guards3, Guards4) 515 ). 516 517 518% OldGuards is a list containing at most one guard{} for each VarId 519% Guard is a guard{} for a particular VarId 520and_guard(true, Guards, Guards). 521and_guard(Guard, OldGuards, NewGuards) :- 522 Guard = guard{branchnr:BranchNr,varid:VarId,class:Classes}, 523 % lookup and replace guard for BranchNr and VarId 524 OldGuard = guard{branchnr:BranchNr,varid:VarId,class:OldClasses}, 525 ( selectchk(OldGuard, OldGuards, NewGuard, NewGuards) -> 526 NewGuard = guard{branchnr:BranchNr,varid:VarId,class:NewClasses}, 527 and_classes(Classes, OldClasses, NewClasses) 528 ; 529 NewGuards = [Guard|OldGuards] 530 ). 531 532 533% Compute the conjunctions of the guards, represented as class lists. 534% Class lists are supposed to contain disjoint, alternative classes. 535and_classes(Ls, Rs, Cs) :- 536 ( 537 foreach(LClass-LPass,Ls) * foreach(RClass-RPass,Rs), 538 fromto(Cs,Cs1,Cs0,[]) 539 do 540 ( and_class(LClass,RClass,Class) -> 541 and_pass(LPass, RPass, Pass), 542 Cs1 = [Class-Pass|Cs0] 543 ; 544 Cs1 = Cs0 545 ) 546 ). 547 548 549 % guard passing only guaranteed if both guards are guaranteed to pass 550 and_pass(t, t, t) :- !. 551 and_pass(_, _, m). 552 553 554 % keep the more specific class only. e.g. [atom,a] * [atom] -> [atom,a] 555 % fail if classes are incomparable 556 and_class(L, R, C) :- 557 ( append(L, _, R) -> % L is the prefix 558 C = R 559 ; append(R, _, L) -> % R is the prefix 560 C = L 561 ). 562 563 564or_guards(Guards1, Guards2, OrGuards) :- 565 ( 566 foreach(guard{varid:VarId,branchnr:BNr,class:Class1},Guards1), 567 fromto(Guards2,Guards3,Guards4,_), 568 fromto(OrGuards,OrGuards1,OrGuards2,[]) 569 do 570 ( VarId \== 0, delete(guard{varid:VarId,branchnr:BNr,class:Class2},Guards3,Guards4) -> 571 or_classes(Class1, Class2, OrClass), 572 OrGuards1 = [guard{varid:VarId,branchnr:BNr,class:OrClass}|OrGuards2] 573 ; 574 Guards3 = Guards4, OrGuards1 = OrGuards2 575 ) 576 ). 577 578 579% Compute the disjunction of the guards, represented as class lists. 580% Class lists are supposed to contain disjoint, alternative classes. 581or_classes(Ls, Rs, Cs) :- 582 sort(1, =<, Ls, Ls1), 583 sort(1, =<, Rs, Rs1), 584 merge(1, =<, Ls1, Rs1, Cs0), 585 ( Cs0 = [C1|Cs1] -> 586 ( 587 fromto(C1,C0,C,Cn), 588 fromto(Cs1,[C2|Cs2],Cs2,[]), 589 fromto(Cs,Cs3,Cs4,[Cn]) 590 do 591 ( class_subsumes(C0, C2, C) -> 592 Cs3 = Cs4 % drop C2 593 ; 594 Cs3 = [C0|Cs4], C = C2 595 ) 596 ) 597 ; 598 Cs = Cs0 599 ). 600 601 class_subsumes(LC-LP, RC-RP, LC-P) :- 602 append(LC, Rest, RC), 603 ( Rest == [] -> 604 or_pass(LP, RP, P) % LC==RC: choose stronger pass flag 605 ; 606 P = LP % LC-LP 607 ). 608 609 or_pass(t, _, t) :- !. 610 or_pass(_, t, t) :- !. 611 or_pass(_, _, m). 612 613 614or_flags(false, false, false) :- !. 615or_flags(false, true, true) :- !. 616or_flags(true, false, true) :- !. 617or_flags(true, true, true) :- !. 618 619 620% Check whether Args is a list of disjoint fresh variables 621all_fresh_vars(Args, Arity, State) :- 622 ( 623 foreach(variable{varid:VarId},Args), 624 foreach(VarId,VarIds), 625 param(State) 626 do 627 \+ state_lookup_binding(State, VarId, _Binding) 628 ), 629 sort(VarIds, UniqVarIds), 630 length(UniqVarIds, Arity). 631 632 633% Succeed iff term does not contain old variables or internal aliasing 634all_fresh_term(Term, _State) :- atomic(Term). 635all_fresh_term(structure{arity:Arity,args:Args}, State) ?- !, 636 all_fresh_vars(Args, Arity, State). 637all_fresh_term([A1|A2], State) ?- !, 638 all_fresh_vars([A1,A2], 2, State). 639all_fresh_term(variable{varid:VarId}, State) ?- !, 640 \+ state_lookup_binding(State, VarId, _Binding). 641%all_fresh_term(attrvar{}, _State) ?- fail. 642 643 644% If we had only one guarded variable followed by commit, 645% we change its pass-markers from -t to -c to indicate that 646% any subsequent branches cannot be reached for these classes. 647exploit_commit([Guard0], [Guard]) :- !, 648 Guard0 = guard{class:Classes0}, 649 update_struct(guard, class:Classes, Guard0, Guard), 650 ( 651 foreach(Class-Pass0,Classes0), 652 foreach(Class-Pass,Classes) 653 do 654 ( Pass0=t -> Pass=c ; Pass=Pass0 ) 655 ). 656exploit_commit(GuardInfo, GuardInfo). 657 658 659 660% Evaluate index quality: A positive float, the smaller the better. 661% Roughly computes fan-out (number of alternatives jumped to) 662% divided by fan-in (number of different argument values tested for). 663 664eval_index_quality(Dt, Q) :- 665 % collect all occurring sets of alternatives 666 dt_values(Dt, Branches0), 667 ( dt_lookup2(Dt, [var], _, _) -> 668 Branches = Branches0 669 ; 670 Branches = [[]|Branches0] 671 ), 672 % remove duplicate sets 673 sort(Branches, BranchesSets), 674 ( 675 foreach(BranchesSet,BranchesSets) >> foreach(_,BranchesSet), 676 count(_,1,NTargetBranches) 677 do 678 true 679 ), 680 % This is the quality measure 681 Q is NTargetBranches/length(BranchesSets). 682 683 684% 685% Compute determinacy information after indexing analysis 686% (we only look at the first index, and assume it is going to be 687% implemented accurately by the generated indexing code) 688% 689% BranchDets: For each branch of the disjunction, which position it can take: 690% det - never one of several matching alternatives 691% try - always the first of several matching alternatives 692% trust - always the last of several matching alternatives 693% retry - can be anywhere in try sequence 694% failure - never matches (dead code) 695% 696% DisjDet: The whole disjunction is classified as: 697% semidet - if it never creates a choicepoint 698% nondet - otherwise 699% 700 701eval_index_det([index{partition:Dt}|_], NBranches, BranchDets) :- !, 702 dt_list(Dt, Parts), 703 hash_create(NonLasts), 704 hash_create(Dets), 705 hash_create(NonFirsts), 706 ( 707 foreach(_Key-Branches,Parts), 708 param(NonLasts,Dets,NonFirsts) 709 do 710 ( Branches = [] -> 711 true 712 ; 713 Branches = [B1|Bs], 714 ( Bs = [] -> 715 hash_set(Dets, B1, true) 716 ; 717 hash_set(NonLasts, B1, true), 718 ( fromto(Bs,[Bi|Bs1],Bs1,[Bn]), param(NonFirsts,NonLasts) do 719 hash_set(NonFirsts, Bi, true), 720 hash_set(NonLasts, Bi, true) 721 ), 722 hash_set(NonFirsts, Bn, true) 723 ) 724 ) 725 ), 726 dim(BranchDets, [NBranches]), 727 ( foreacharg(BranchDet,BranchDets,I), param(NonLasts,Dets,NonFirsts) do 728 ( hash_contains(NonFirsts, I) -> 729 ( hash_contains(NonLasts, I) -> 730 BranchDet = retry 731 ; 732 BranchDet = trust 733 ) 734 ; hash_contains(NonLasts, I) -> 735 BranchDet = try 736 ; hash_contains(Dets, I) -> 737 BranchDet = det 738 ; 739 BranchDet = failure 740 ) 741 ). 742eval_index_det([], NBranches, BranchDets) :- 743 verify NBranches >= 2, 744 dim(BranchDets, [NBranches]), 745 arg(1, BranchDets, try), 746 arg(NBranches, BranchDets, trust), 747 ( for(I,2,NBranches-1), param(BranchDets) do 748 arg(I, BranchDets, retry) 749 ). 750 751 752% Debugging: print readable summary of index 753 754dump_indexes(disjunction{callpos:CallPos,determinism:BranchDets,indexes:Indexes}, options{print_indexes:Flag}) :- 755 ( Flag==on, Indexes = [_|_] -> 756 ( foreacharg(BrDet,BranchDets), fromto(semidet,Det1,Det2,Det) do 757 ( (BrDet==det;BrDet==failure) -> Det2=Det1 ; Det2=nondet ) 758 ), 759 printf("INDEXES for (%w) disjunction %w%n", [Det,CallPos]), 760 ( 761 count(I,1,_), 762% foreach(index{quality:Q,variable:variable{varid:VarId},partition:Dt},Indexes) 763 foreach(index{quality:Q,partition:Dt},Indexes) 764 do 765 Q1 is round(10*Q)/10, % printf's rounding is unreliable 766% printf("%d. Quality %.1f, variable %d%n", [I,Q1,VarId]), 767 printf("%d. Quality %.1f%n", [I,Q1]), 768 dt_list(Dt, Parts), 769 ( foreach(Part,Parts) do 770 printf(" %w%n", [Part]) 771 ) 772 ), 773 printf("Branch determinisms for disjunction %w%n", [CallPos]), 774 ( foreacharg(BranchDet,BranchDets,I) do 775 printf(" Branch %d: %w%n", [I,BranchDet]) 776 ) 777 ; 778 true 779 ). 780