1:- module(tor, 2 [(tor)/2 3 ,op(1100,xfy,tor) 4 ,op(1150,fx,tor) 5 ,search/1 6 ,tor_handlers/3 7 ,tor_before_handlers/3 8 ,tor_merge/2 9 ,dbs_tree/1 10 ,dbs/2 11 ,dibs_tree/1 12 ,dibs/2 13 ,id/1 14 ,nbs/2 15 ,nbs_tree/1 16 ,bab/2 17 ,lds/1 18 ,dbs/3 19 ,iterate/1 20 ,tor_statistics/1 21 ,solution_count/2 22 ,node_count/2 23 ,failure_count/2 24 ,log/1 25 ,parallel/1 26 ]).

Tor infrastructure and many handlers.

This module contains the basic Tor infrastructure for hookable disjunction as well as the definition of the search strategies.

35:- use_module(library(apply)). 36:- use_module(library(lists)). 37:- use_module(library(terms)). 38:- use_module(library(mutable_variables)). 39:- use_module(library(clpfd)). 40:- use_module(library(unix)). 41 42%------------------------------------------------------------------------------- 43% Tor hookable disjunction 44%------------------------------------------------------------------------------- 45 46:- meta_predicate tor(0,0).

52G1 tor G2 :- 53 ( b_getval(left,Left), 54 call(Left,G1) 55 ; b_getval(right,Right), 56 call(Right,G2) 57 ). 58 59%------------------------------------------------------------------------------- 60% Infrastructure 61%------------------------------------------------------------------------------- 62 63:- meta_predicate search(0). 64 65:- initialization nb_setval(left,call), nb_setval(right, call).

72search(Goal) :- 73 b_getval(left,OldLeft), 74 b_getval(right,OldRight), 75 b_setval(left,call), 76 b_setval(right,call), 77 call(Goal), 78 b_setval(left,OldLeft), 79 b_setval(right,OldRight). 80 81:- meta_predicate tor_handlers(0,1,1).

88tor_handlers(Goal,Left,Right) :- 89 b_getval(left,LeftHandler), 90 b_getval(right,RightHandler), 91 b_setval(left,compose(LeftHandler,Left)), 92 b_setval(right,compose(RightHandler,Right)), 93 call(Goal), 94 b_setval(left,LeftHandler), 95 b_setval(right,RightHandler). 96 97 98:- meta_predicate compose(1,1,0). 99 100% Conceptually: G1(G2(Goal)) 101compose(G1,G2,Goal) :- call(G1,call(G2,Goal)). 102 103:- meta_predicate tor_before_handlers(0,0,0). 104 105% tor_before_handlers(+Goal, +Left, +Right) 106% 107% Before advice: in case the handler only needs to precede the actual branch 108% goal by its own goal. 109tor_before_handlers(Goal,Left,Right) :- 110 tor_handlers(Goal,before(Left),before(Right)). 111 112:- meta_predicate before(0,0). 113 114before(G1,G2) :- G1, G2. 115 116% :- meta_predicate tor_merge(0,0).

122tor_merge(Heuristic,Goal) :- 123 % For a correct translation, we need to have a head that only contains free variables 124 construct_template(Heuristic,FreeHead), 125 clause(FreeHead,Body), 126 % Do translation 127 % BVarPos is a list of positions at which we need we need a mutable variable 128 translate(FreeHead,Body, HandlerLeft, HandlerRight, HandlerLeftHeadVars, HandlerRightHeadVars, BVarPos), 129 % Assert handlers 130 assert_handler(HandlerLeftHeadVars, HandlerLeft, LeftSym), 131 assert_handler(HandlerRightHeadVars, HandlerRight, RightSym), 132 % Create and initialize mutable variables 133 maplist(create_bvar(Heuristic),BVarPos,MutableVariables), 134 install_handlers(Heuristic, MutableVariables, BVarPos, LeftSym, RightSym, InstallLeft, InstallRight), 135 tor_handlers(Goal,InstallLeft,InstallRight). 136 137% Asserts handler under a unique name 138% Mode: + + - 139assert_handler(HandlerHeadVars, HandlerBody, Sym) :- 140 gensym('handler',Sym), 141 Head =.. [Sym|HandlerHeadVars], 142 assert((Head :- HandlerBody)). 143 144% Gets argument at given position in head and initializes a new mutable variable with it. 145% Designed to be used with maplist/3 146create_bvar(Head,Pos,MutableVariable) :- 147 Head =.. [_|ArgList], 148 nth0(Pos,ArgList,Value), 149 new_bvar(Value,MutableVariable). 150 151% Installs both handlers 152% Mode: + + + + + - - 153install_handlers(Heuristic, MutableVariables, BVarPos, LeftSym, RightSym, InstallLeft, InstallRight) :- 154 % Construct the list of arguments for the handler terms that we are going to install 155 % Do this by merging mutable variables and normal variables. Handlers must only be partially applied. Tor_handlers does the rest. 156 Heuristic =.. [_|AllArgs], 157 merge_by_pos(AllArgs,MutableVariables,BVarPos,InstallArgs), 158 InstallLeft =.. [LeftSym|InstallArgs], 159 InstallRight =.. [RightSym|InstallArgs]. 160 161% Creates ListOut by taking the elements of List1, except for the positions mentioned in PosList, where the first element of List2 is used that has not been used so far. 162% Counting starts from zero. 163% Much more efficient to use this instead of merge_by_pos(List1, List2, PosList, ListOut, []). 164merge_by_pos(List1,List2,PosList,ListOut) :- 165 merge_by_pos_(List1,List2,PosList,0,ListOut). 166 167merge_by_pos_([],_List2,_PosList,_Pos,[]). 168merge_by_pos_([X|Xs],[],_PosList,_Pos,[X|Xs]). 169merge_by_pos_([X|Xs],[Y|Ys],PosList,Pos,[Z|Zs]) :- 170 Pos1 is Pos + 1, 171 ( memberchk(Pos,PosList) -> 172 Z = Y, 173 merge_by_pos_(Xs,Ys,PosList,Pos1,Zs) 174 ; Z = X, 175 merge_by_pos_(Xs,[Y|Ys],PosList,Pos1,Zs) 176 ). 177 178% Creates a difference list by taking the elements of List1, except for the positions mentioned in PosList, where the first element of List2 is used that has not been used so far. 179% Mode: + + + - - 180% Counting starts from zero. 181% Should only be used if TailOut is not [] (for efficiency). 182merge_by_pos(List1,List2,PosList,ListOut,TailOut) :- 183 merge_by_pos_(List1,List2,PosList,0,ListOut,TailOut). 184 185merge_by_pos_([],_List2,_PosList,_Pos,X,X). 186% Extra case for efficiency: don't bother about updating pos - it still is not terribly efficient since we can only add a single element at a time. 187merge_by_pos_([X|Xs],[],_PosList,_Pos,[X|HO],TO) :- !, 188 merge_by_pos_(Xs,[],dummy,dummy,HO,TO). 189merge_by_pos_([X|Xs],[Y|Ys],PosList,Pos,[Z|HO],TO) :- 190 Pos1 is Pos + 1, 191 ( memberchk(Pos,PosList) -> 192 Z = Y, 193 merge_by_pos_(Xs,Ys,PosList,Pos1,HO,TO) 194 ; Z = X, 195 merge_by_pos_(Xs,[Y|Ys],PosList,Pos1,HO,TO) 196 ). 197 198% Derives left and right handler definitions from a high-level heuristic definition. 199% This process involves: 200% - splitting into left and right handler by finding tor operator 201% - replacing regular parameters with mutable variables 202% - adding b_get and b_put for those variables 203% - eliminating explicit recursive calls 204translate(Head, Body, HandlerLeft, HandlerRight,HandlerLeftHeadVars,HandlerRightHeadVars, DiffPos) :- 205 split_handlers(Body, Left, Right), 206 % Find out what to b_get: that is, we need to look at all the recursive calls and if a parameter changes between the head and the recursive call, we need to use a mutable variable and a b_get. 207 % First find all recursive calls 208 functor(Head,HeadName,HeadArity), 209 find_goals(HeadName, HeadArity, Body, RecursiveCalls), 210 % For each recursive call: check in which argument positions head and call have different variables. 211 maplist(differentVariablePosList(Head),RecursiveCalls,ListListDiffPos), 212 foldl(union,ListListDiffPos,[],DiffPos), 213 % Translate left and right handler seperately. 214 translate_handler(Head, Left, DiffPos, HandlerLeft, HandlerLeftHeadVars), 215 translate_handler(Head, Right, DiffPos, HandlerRight, HandlerRightHeadVars). 216 217% Returns a list of positions in which different variables were found 218differentVariablePosList(Head1,Head2, DifferentPos) :- 219 Head1 =.. [_|Args1], 220 Head2 =.. [_|Args2], 221 differentVariablePosList_(Args1,Args2,0,DifferentPos-[]). 222 223differentVariablePosList_([],[],_,X-X). 224differentVariablePosList_([X|Xs], [Y|Ys], Nr, List-Tail) :- 225 ( X \== Y -> 226 List = [Nr|Tail1] 227 ; 228 Tail1 = List 229 ), 230 Pos1 is Nr + 1, 231 differentVariablePosList_(Xs, Ys, Pos1, Tail1-Tail). 232 233% Construct template: a predicate with the same name and arity, but containing only free variables 234construct_template(Predicate,Template) :- 235 functor(Predicate, Name, Arity), 236 functor(Template, Name, Arity). 237 238% Does translation for a single handler 239% Parameters: 240% - Head 241% - Body: handler code to transform (does not contain tor disjunctions anymore) 242% - MutableVarsPositions: list of positions, starting from zero, that indicate which head variables need to become mutable variables. 243translate_handler(Head, Body, MutableVarsPositions, Handler, HandlerHeadVars) :- 244 % Construct template for recursive call and replace it by a free variable in Body, resulting in Body2. 245 construct_template(Head,TemplateRecursive), 246 replace_goal(TemplateRecursive, Body,Free,Body2), 247 % Generalized adding of b_get here: 248 % Make a conjunction of b_gets, and one of b_puts 249 % Use a pair for the first argument, since maplist/6 is not defined anymore, but maplist/5 is 250 Head =.. [_|Args], 251 TemplateRecursive =.. [_|Args2], 252 maplist(make_bgetput_arg_pos(Args-Args2),MutableVarsPositions,MutableVars,BGetList,BPutList), 253 list_to_conj(BGetList,BGetConj), 254 list_to_conj(BPutList,BPutConj), 255 % Add b_gets and b_puts to handlers. 256 % list_to_conj gives true in case of empty list, avoid to insert these 257 empty_different(BGetList,Handler,(BGetConj,Body2),Body2), 258 empty_different(BPutList,Free,(BPutConj,call(Goal)),call(Goal)), 259 % Now create the head variables for the handler by combining free variables that must become mutable variables and regular arguments. 260 merge_by_pos(Args,MutableVars,MutableVarsPositions,HandlerHeadVars, [Goal]). % We should be able to use argument from recursive call instead and get the same result. 261 262% Binds Variable to Nonempty if List is non-empty, else binds Variable to Empty. 263empty_different(List,Variable,Nonempty,Empty) :- 264 (List = [] -> 265 Variable = Empty 266 ; 267 Variable = Nonempty 268 ). 269 270% For use with maplist/5 271% Gets argument nr. Position from Args and Args2 272% Intented "results": MutableVariable, b_get(MutableVariable,Argument) and b_put(MutableVariable,Argument2). 273make_bgetput_arg_pos(Args-Args2,Position,MutableVariable,b_get(MutableVariable,Arg),b_put(MutableVariable,Arg2)) :- 274 nth0(Position,Args,Arg), 275 nth0(Position,Args2,Arg2). 276 277find_goals(PredicateName, Arity, Term, ResultList) :- 278 find_goals_(PredicateName, Arity, Term, ResultList-[]). 279 280% Does term contain conjunction, disjunction or tor disjunction? 281% If yes, Arg1 and Arg2 are both operands, and Operator is the operator. 282has_selected_binary_operator(Term, Operator, Arg1, Arg2) :- 283 Term =.. [Operator,Arg1, Arg2], 284 memberchk(Operator,[',', ';', 'tor']). 285 286% Does term contain conjunction, disjunction? 287% If yes, Arg1 and Arg2 are both operands, and Operator is the operator. 288has_selected_binary_operator2(Term, Operator, Arg1, Arg2) :- 289 Term =.. [Operator,Arg1, Arg2], 290 memberchk(Operator,[',', ';']). 291 292% Does not look in test - needs to be tested before disjunction 293find_goals_(PredicateName, Arity, (_Test -> Term1 ; Term2), List-Tail) :- !, 294 find_goals_(PredicateName, Arity, Term1, List-Tail1), 295 find_goals_(PredicateName, Arity, Term2, Tail1-Tail). 296find_goals_(PredicateName, Arity, Term, List-Tail) :- 297 has_selected_binary_operator(Term, _Operator, Term1, Term2), !, % Mind the place of the cut 298 find_goals_(PredicateName, Arity, Term1, List-Tail1), 299 find_goals_(PredicateName, Arity, Term2, Tail1-Tail). 300find_goals_(PredicateName, Arity, Term, List-Tail) :- !, 301 functor(Template,PredicateName, Arity), 302 ( (nonvar(Term), Term = Template) -> 303 % Add to difflist 304 List = [Template|Tail] 305 ; 306 List = Tail 307 ). 308 309% In a term that is 310% - a conjunction of subterms 311% - a disjunction of subterms 312% - an if containing two subterms (test not investigated further), 313% replace goal that matches given template by free variable 314% Must be before disjunction 315replace_goal(Template,(Test -> Term1 ; Term2),Free, (Test -> Result1 ; Result2)) :- !, 316 replace_goal(Template,Term1,Free,Result1), 317 replace_goal(Template,Term2,Free,Result2). 318replace_goal(Template,Term,Free,Result) :- 319 has_selected_binary_operator(Term,Operator,Term1,Term2), !, % Mind the place of the cut 320 replace_goal(Template,Term1,Free,Result1), 321 replace_goal(Template,Term2,Free,Result2), 322 Result =.. [Operator,Result1,Result2]. 323replace_goal(Template,Term,Free,Result) :- 324 ((nonvar(Term), Template = Term) -> 325 % Found match! 326 Result = Free 327 ; 328 Result = Term 329 ). 330 331% Must be before disjunction 332split_handlers((Term1,Term2),(Result1,Result2),(Result3,Result4)) :- !, 333 split_handlers(Term1,Result1,Result3), 334 split_handlers(Term2,Result2,Result4). 335split_handlers((Test -> Term1 ; Term2), (Test -> Result1 ; Result2), (Test -> Result3 ; Result4)) :- !, 336 split_handlers(Term1,Result1,Result3), 337 split_handlers(Term2,Result2,Result4). 338split_handlers((Term1;Term2),(Result1;Result2),(Result3;Result4)) :- !, 339 split_handlers(Term1,Result1,Result3), 340 split_handlers(Term2,Result2,Result4). 341split_handlers(Term,Result,Result2) :- 342 ((nonvar(Term), tor(X,Y) = Term) -> 343 % Found match! 344 Result = X, 345 Result2 = Y 346 ; 347 Result = Term, 348 Result2 = Term 349 ). 350 351 352% Converts a list of conjuncts to a conjunction. 353list_to_conj([],true) :- ! . 354list_to_conj([X],X) :- ! . 355list_to_conj([X1,X2],(X1,X2)) :- ! . 356list_to_conj([X|Xs],(X,Ys)) :- 357 list_to_conj(Xs,Ys). 358 359%------------------------------------------------------------------------------- 360% Search Methods listed in the paper 361%-------------------------------------------------------------------------------

399id(Goal) :- 400 new_nbvar(not_pruned,PVar), 401 id_loop(Goal,0,PVar). 402 403id_loop(Goal,Depth,PVar) :- 404 nb_put(PVar,not_pruned), 405 ( tor_merge(id_tree(Depth,PVar),Goal) 406 ; 407 nb_get(PVar,Value), 408 Value == pruned, 409 NDepth is Depth + 1, 410 id_loop(Goal,NDepth,PVar) 411 ). 412 413id_tree(Depth,PruneVar) :- 414 ( Depth > 0 -> 415 NDepth is Depth - 1 416 ; 417 nb_put(PruneVar,pruned), false 418 ), 419 ( id_tree(NDepth, PruneVar) 420 tor 421 id_tree(NDepth, PruneVar) 422 ).

450bab(Objective,Goal) :- 451 fd_inf(Objective,Inf), 452 LowerBound is Inf - 1, 453 new_nbvar(LowerBound,BestVar), 454 Current = inf, 455 tor_merge(bab_tree(Objective,BestVar,Current),Goal), 456 nb_put(BestVar,Objective). 457 458bab_tree(Objective, BestVar, Current) :- 459 nb_get(BestVar, Best), 460 ( Best \= inf, (Current == inf ; Best > Current ) -> 461 Objective #> Best, 462 NCurrent = Best 463 ; 464 NCurrent = Current 465 ), 466 ( bab_tree(Objective, BestVar, NCurrent) 467 tor 468 bab_tree(Objective, BestVar, NCurrent) 469 ). 470 471:- meta_predicate lds(0).

476lds(Goal) :- 477 iterate(flip(dibs,Goal)). 478 479% Level is a number, so should not be module sensitive. 480% The Method is called with the Goal as extra argument, so meta argument specifier must a 1. 481:- meta_predicate dbs(+,1,0).

487dbs(Level, Method, Goal) :- 488 new_bvar(yes(Level),Var), 489 tor_handlers(Goal,dbs_handler(Var,Method) 490 ,dbs_handler(Var,Method)). 491 492dbs_handler(Var,Method,Goal) :- 493 b_get(Var,MDepth), 494 dbs_handler_(MDepth,Var,Method,Goal). 495 496dbs_handler_(yes(Depth),Var,Method,Goal) :- 497 ( Depth > 1 -> 498 NDepth is Depth - 1, 499 b_put(Var,yes(NDepth)), 500 call(Goal) 501 ; 502 b_put(Var,no), 503 call(Method,Goal) 504 ). 505dbs_handler_(no,_,_,Goal) :- 506 call(Goal). 507 508%------------------------------------------------------------------------------- 509% Iteration patterns and pruning 510%------------------------------------------------------------------------------- 511 512prune :- 513 set_pruned(true), 514 fail. 515 516reset_pruned :- 517 set_pruned(false). 518 519is_pruned :- 520 get_pruned(true). 521 522get_pruned(Flag) :- 523 nb_getval(pruned,Flag). 524 525set_pruned(Flag) :- 526 nb_setval(pruned,Flag). 527 528scope_pruned(Goal) :- 529 get_pruned(OldFlag), 530 ( reset_pruned, 531 call(Goal) 532 ; 533 set_pruned(OldFlag), 534 fail 535 ). 536 537pruned_union(true,_,true). 538pruned_union(false,true,true). 539pruned_union(false,false,false). 540 541:- meta_predicate iterate(0).

547iterate(PGoal) :- 548 scope_pruned( 549 iterate_loop(0,PGoal)). 550 551:- meta_predicate iterate_loop(+,1). 552 553iterate_loop(N,PGoal) :- 554 ( 555 call(PGoal,N) 556 ; 557 is_pruned, 558 reset_pruned, 559 M is N + 1, 560 iterate_loop(M,PGoal) 561 ). 562 563% The third argument is a number, which is not module-sensitive. 564% Using 0 instead of + therefore is wrong. 565:- meta_predicate flip(0,0,+). 566 567flip(BaseStrategy, Goal, Number) :- 568 call(BaseStrategy,Number, Goal). 569 570%------------------------------------------------------------------------------- 571% Statistics and visualisation 572%------------------------------------------------------------------------------- 573 574:- meta_predicate tor_statistics(0).

582tor_statistics(Goal) :- 583 new_nbvar(0,SolutionVar), 584 new_nbvar(0,NodeVar), 585 new_nbvar(0,FailureVar), 586 Vars = [SolutionVar,NodeVar,FailureVar], 587 Names = ['solutions','nodes','failures'], 588 ( solution_count(SolutionVar,node_count(NodeVar,failure_count(FailureVar,Goal))), 589 maplist(nb_report,Vars,Names) 590 ; 591 maplist(nb_report,Vars,Names) 592 ). 593 594nb_report(Var,Name) :- 595 nb_get(Var,Value), 596 format('% Number of ~w: ~`.t ~d~34|~n',[Name,Value]). 597 598:- meta_predicate solution_count(+,0).

603solution_count(SolutionVar,Goal) :- 604 call(Goal), 605 nb_inc(SolutionVar). 606 607:- meta_predicate node_count(+,0). 608 609% node_count(+NodeVar, +Goal) 610% 611% Count number of nodes processed using provided nonbacktrackable variable 612node_count(NodeVar,Goal) :- 613 tor_before_handlers(Goal,nb_inc(NodeVar),nb_inc(NodeVar)). 614 615nb_inc(Var) :- 616 nb_get(Var,Value), 617 NValue is Value + 1, 618 nb_put(Var,NValue). 619 620:- meta_predicate failure_count(+,0). 621 622% failure_count(+FailureVar, +Goal) 623% 624% Count number of failures using provided nonbacktrackable variable 625failure_count(FailureVar,Goal) :- 626 tor_handlers(Goal,failure_handler(FailureVar),failure_handler(FailureVar)). 627 628failure_handler(Var,Goal) :- 629 ( call(Goal) *-> 630 true 631 ; 632 nb_inc(Var), 633 fail 634 ).

640log(Goal) :- 641 tor_merge(log_tree, Goal), 642 writeln(solution). 643 644log_tree :- 645 ( ( writeln(left) 646 tor 647 writeln(right) 648 ), 649 log_tree 650 ; 651 writeln(false), 652 false 653 ). 654 655%------------------------------------------------------------------------------- 656% Parallel infrastructure 657%-------------------------------------------------------------------------------

662parallel(Goal) :- 663 open('num_threads', write, Stream1, [lock(exclusive)]), 664 format(Stream1, "0.\n", []), 665 close(Stream1), 666 general_tor_hook(Goal, tor_fork, tor_fork). 667 668tor_fork(Goal) :- 669 wait_for_slot, 670 fork(PID), 671 ( PID == child -> Goal 672 ; false 673 ). 674 675wait_for_slot :- 676 open(mylock, write, Lock, [lock(exclusive)]), 677 repeat, 678 catch(open('num_threads', read, Stream, []), 679 E, 680 ( writeln(E), false)), 681 read(Stream, Num), 682 close(Stream), 683 integer(Num), 684 format("num: ~w\n", [Num]), 685 ( Num > 5 -> sleep(0.5), false 686 ; true 687 ), 688 !, 689 Num1 is Num + 1, 690 open('num_threads', write, Stream1, [lock(exclusive)]), 691 format(Stream1, "~w.\n", [Num1]), 692 close(Stream1), 693 close(Lock). 694 695general_tor_hook(Goal,Left,Right) :- 696 b_getval(left,LeftHook), 697 b_getval(right,RightHook), 698 b_setval(left,compose(LeftHook,Left)), 699 b_setval(right,compose(RightHook,Right)), 700 call(Goal), 701 b_setval(left,LeftHook), 702 b_setval(right,RightHook). 703 704%------------------------------------------------------------------------------- 705% tor/1 declaration 706%------------------------------------------------------------------------------- 707% The declaration `:- tor Pred/Arity.' replaces the implicit disjunctions 708% between the clauses of Pred/Arity by explicit calls to tor/2 disjunction. 709% 710% TODO 711% - perform substitations to simplify the unifier 712% - eliminate unifications with singleton variables from the unifier 713% 714 715:- multifile user:term_expansion/2. 716:- dynamic '$tor_predicate'/3. 717:- dynamic '$tor_clause'/5. 718 719tor_expansion((:- tor F/A), File, []) :- 720 assertz('$tor_predicate'(F,A,File)). 721tor_expansion(Head,File,[]) :- 722 functor(Head,F,A), 723 '$tor_predicate'(F,A,File), 724 assertz('$tor_clause'(F,A,File,Head,true)). 725tor_expansion((Head :- Body),File,[]) :- 726 functor(Head,F,A), 727 '$tor_predicate'(F,A,File), 728 assertz('$tor_clause'(F,A,File,Head,Body)). 729tor_expansion(end_of_file,File,Clauses) :- 730 findall(Clause,(retract('$tor_predicate'(F,A,File)), merge_tor_clauses(F,A,File,Clause)),Clauses). 731 732merge_tor_clauses(F,A,File,Head :- Body) :- 733 findall(Term-TermBody,retract('$tor_clause'(F,A,File,Term,TermBody)),TermBodyPairs), 734 merge_tor_head(TermBodyPairs,Head), 735 reverse(TermBodyPairs,RTermBodyPairs), 736 merge_tor_bodies(RTermBodyPairs,Head,Body). 737 738merge_tor_head([Term-_|Terms],Head) :- 739 merge_tor_head_(Terms,Term,Head). 740 741merge_tor_head_([],Head,Head). 742merge_tor_head_([Term-_|Terms],Acc,Head) :- 743 term_subsumer(Term,Acc,NAcc), 744 merge_tor_head_(Terms,NAcc,Head). 745 746merge_tor_bodies([Term-TermBody|Terms],Head,Body) :- 747 head_matcher(Head,Term,Matcher), 748 optimize_conjunction(Matcher,TermBody,Goal), 749 merge_tor_bodies_(Terms,Head,Goal,Body). 750 751merge_tor_bodies_([],_Head,Body,Body). 752merge_tor_bodies_([Term-TermBody|Terms],Head,Acc,Body) :- 753 head_matcher(Head,Term,Matcher), 754 optimize_conjunction(Matcher,TermBody,Goal), 755 merge_tor_bodies_(Terms,Head,(Goal tor Acc),Body). 756 757head_matcher(Head,Term,Matcher) :- 758 unifiable(Head,Term,Unifier), 759 head_matcher(Unifier,Matcher). 760 761head_matcher([],true). 762head_matcher([G],Body) :- !, 763 Body = G. 764head_matcher([G|Gs],(G,Matcher)) :- 765 head_matcher(Gs,Matcher). 766 767optimize_conjunction(G1,G2,NG) :- 768 ( G1 == true -> 769 NG = G2 770 ; G1 == false -> 771 NG = false 772 ; G2 == true -> 773 NG = G1 774 ; 775 NG = (G1,G2) 776 ). 777 778%------------------------------------------------------------------------------- 779% tor/1 declaration 780%------------------------------------------------------------------------------- 781% 782% Save term_expansion for the end of the file. 783% 784% (thanks to Jan Wielemaker) 785 786user:term_expansion(TermIn, TermOut) :- 787 \+ current_prolog_flag(xref, true), 788 prolog_load_context(source, File), 789 tor_expansion(TermIn, File, TermOut)