View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2009-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$expand',
   38          [ expand_term/2,              % +Term0, -Term
   39            expand_goal/2,              % +Goal0, -Goal
   40            expand_term/4,              % +Term0, ?Pos0, -Term, -Pos
   41            expand_goal/4,              % +Goal0, ?Pos0, -Goal, -Pos
   42            var_property/2,             % +Var, ?Property
   43
   44            '$expand_closure'/3         % +GoalIn, +Extra, -GoalOut
   45          ]).

Prolog source-code transformation

This module specifies, together with dcg.pl, the transformation of terms as they are read from a file before they are processed by the compiler.

The toplevel is expand_term/2. This uses three other translators:

Note that this ordering implies that conditional compilation directives cannot be generated by term_expansion/2 rules: they must literally appear in the source-code.

Term-expansion may choose to overrule DCG expansion. If the result of term-expansion is a DCG rule, the rule is subject to translation into a predicate.

Next, the result is passed to expand_bodies/2, which performs goal expansion. */

   70:- dynamic
   71    system:term_expansion/2,
   72    system:goal_expansion/2,
   73    user:term_expansion/2,
   74    user:goal_expansion/2,
   75    system:term_expansion/4,
   76    system:goal_expansion/4,
   77    user:term_expansion/4,
   78    user:goal_expansion/4.   79:- multifile
   80    system:term_expansion/2,
   81    system:goal_expansion/2,
   82    user:term_expansion/2,
   83    user:goal_expansion/2,
   84    system:term_expansion/4,
   85    system:goal_expansion/4,
   86    user:term_expansion/4,
   87    user:goal_expansion/4.   88
   89:- meta_predicate
   90    expand_terms(4, +, ?, -, -).
 expand_term(+Input, -Output) is det
 expand_term(+Input, +Pos0, -Output, -Pos) is det
This predicate is used to translate terms as they are read from a source-file before they are added to the Prolog database.
   98expand_term(Term0, Term) :-
   99    expand_term(Term0, _, Term, _).
  100
  101expand_term(Var, Pos, Expanded, Pos) :-
  102    var(Var),
  103    !,
  104    Expanded = Var.
  105expand_term(Term, Pos0, [], Pos) :-
  106    cond_compilation(Term, X),
  107    X == [],
  108    !,
  109    atomic_pos(Pos0, Pos).
  110expand_term(Term, Pos0, Expanded, Pos) :-
  111    b_setval('$term', Term),
  112    '$def_modules'([term_expansion/4,term_expansion/2], MList),
  113    call_term_expansion(MList, Term, Pos0, Term1, Pos1),
  114    expand_terms(expand_term_2, Term1, Pos1, Term2, Pos),
  115    rename(Term2, Expanded),
  116    b_setval('$term', []).
  117
  118call_term_expansion([], Term, Pos, Term, Pos).
  119call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  120    current_prolog_flag(sandboxed_load, false),
  121    !,
  122    (   '$member'(Pred, Preds),
  123        (   Pred == term_expansion/2
  124        ->  M:term_expansion(Term0, Term1),
  125            Pos1 = Pos0
  126        ;   M:term_expansion(Term0, Pos0, Term1, Pos1)
  127        )
  128    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  129    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  130    ).
  131call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  132    (   '$member'(Pred, Preds),
  133        (   Pred == term_expansion/2
  134        ->  allowed_expansion(M:term_expansion(Term0, Term1)),
  135            call(M:term_expansion(Term0, Term1)),
  136            Pos1 = Pos
  137        ;   allowed_expansion(M:term_expansion(Term0, Pos0, Term1, Pos1)),
  138            call(M:term_expansion(Term0, Pos0, Term1, Pos1))
  139        )
  140    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  141    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  142    ).
  143
  144expand_term_2((Head --> Body), Pos0, Expanded, Pos) :-
  145    dcg_translate_rule((Head --> Body), Pos0, Expanded0, Pos1),
  146    !,
  147    expand_bodies(Expanded0, Pos1, Expanded, Pos).
  148expand_term_2(Term0, Pos0, Term, Pos) :-
  149    nonvar(Term0),
  150    !,
  151    expand_bodies(Term0, Pos0, Term, Pos).
  152expand_term_2(Term, Pos, Term, Pos).
 expand_bodies(+Term, +Pos0, -Out, -Pos) is det
Find the body terms in Term and give them to expand_goal/2 for further processing. Note that we maintain status information about variables. Currently we only detect whether variables are fresh or not. See var_info/3.
  161expand_bodies(Terms, Pos0, Out, Pos) :-
  162    '$def_modules'([goal_expansion/4,goal_expansion/2], MList),
  163    expand_terms(expand_body(MList), Terms, Pos0, Out, Pos),
  164    remove_attributes(Out, '$var_info').
  165
  166expand_body(MList, (Head0 :- Body), Pos0, (Head :- ExpandedBody), Pos) :-
  167    !,
  168    term_variables(Head0, HVars),
  169    mark_vars_non_fresh(HVars),
  170    f2_pos(Pos0, HPos, BPos0, Pos, HPos, BPos),
  171    expand_goal(Body, BPos0, ExpandedBody0, BPos, MList, (Head0 :- Body)),
  172    (   compound(Head0),
  173        '$current_source_module'(M),
  174        replace_functions(Head0, Eval, Head, M),
  175        Eval \== true
  176    ->  ExpandedBody = (Eval,ExpandedBody0)
  177    ;   Head = Head0,
  178        ExpandedBody = ExpandedBody0
  179    ).
  180expand_body(MList, (:- Body), Pos0, (:- ExpandedBody), Pos) :-
  181    !,
  182    f1_pos(Pos0, BPos0, Pos, BPos),
  183    expand_goal(Body, BPos0, ExpandedBody, BPos, MList, (:- Body)).
  184
  185expand_body(_MList, Head0, Pos, Clause, Pos) :- % TBD: Position handling
  186    compound(Head0),
  187    '$current_source_module'(M),
  188    replace_functions(Head0, Eval, Head, M),
  189    Eval \== true,
  190    !,
  191    Clause = (Head :- Eval).
  192expand_body(_, Head, Pos, Head, Pos).
 expand_terms(:Closure, +In, +Pos0, -Out, -Pos)
Loop over two constructs that can be added by term-expansion rules in order to run the next phase: calling term_expansion/2 can return a list and terms may be preceeded with a source-location.
  202expand_terms(_, X, P, X, P) :-
  203    var(X),
  204    !.
  205expand_terms(C, List0, Pos0, List, Pos) :-
  206    nonvar(List0),
  207    List0 = [_|_],
  208    !,
  209    (   is_list(List0)
  210    ->  list_pos(Pos0, Elems0, Pos, Elems),
  211        expand_term_list(C, List0, Elems0, List, Elems)
  212    ;   '$type_error'(list, List0)
  213    ).
  214expand_terms(C, '$source_location'(File, Line):Clause0, Pos0, Clause, Pos) :-
  215    !,
  216    expand_terms(C, Clause0, Pos0, Clause1, Pos),
  217    add_source_location(Clause1, '$source_location'(File, Line), Clause).
  218expand_terms(C, Term0, Pos0, Term, Pos) :-
  219    call(C, Term0, Pos0, Term, Pos).
 add_source_location(+Term, +SrcLoc, -SrcTerm)
Re-apply source location after term expansion. If the result is a list, claim all terms to originate from this location.
  226add_source_location(Clauses0, SrcLoc, Clauses) :-
  227    (   is_list(Clauses0)
  228    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  229    ;   Clauses = SrcLoc:Clauses0
  230    ).
  231
  232add_source_location_list([], _, []).
  233add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  234    add_source_location_list(Clauses0, SrcLoc, Clauses).
 expand_term_list(:Expander, +TermList, +Pos, -NewTermList, -PosList)
  238expand_term_list(_, [], _, [], []) :- !.
  239expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  240    !,
  241    expand_terms(C, H0, PH0, H, PH),
  242    add_term(H, PH, Terms, TT, PosL, PT),
  243    expand_term_list(C, T0, [PH0], TT, PT).
  244expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  245    !,
  246    expand_terms(C, H0, PH0, H, PH),
  247    add_term(H, PH, Terms, TT, PosL, PT),
  248    expand_term_list(C, T0, PT0, TT, PT).
  249expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  250    expected_layout(list, PH0),
  251    expand_terms(C, H0, PH0, H, PH),
  252    add_term(H, PH, Terms, TT, PosL, PT),
  253    expand_term_list(C, T0, [PH0], TT, PT).
 add_term(+ExpandOut, ?ExpandPosOut, -Terms, ?TermsT, -PosL, ?PosLT)
  257add_term(List, Pos, Terms, TermT, PosL, PosT) :-
  258    nonvar(List), List = [_|_],
  259    !,
  260    (   is_list(List)
  261    ->  append_tp(List, Terms, TermT, Pos, PosL, PosT)
  262    ;   '$type_error'(list, List)
  263    ).
  264add_term(Term, Pos, [Term|Terms], Terms, [Pos|PosT], PosT).
  265
  266append_tp([], Terms, Terms, _, PosL, PosL).
  267append_tp([H|T0], [H|T1], Terms, [HP], [HP|TP1], PosL) :-
  268    !,
  269    append_tp(T0, T1, Terms, [HP], TP1, PosL).
  270append_tp([H|T0], [H|T1], Terms, [HP0|TP0], [HP0|TP1], PosL) :-
  271    !,
  272    append_tp(T0, T1, Terms, TP0, TP1, PosL).
  273append_tp([H|T0], [H|T1], Terms, Pos, [Pos|TP1], PosL) :-
  274    expected_layout(list, Pos),
  275    append_tp(T0, T1, Terms, [Pos], TP1, PosL).
  276
  277
  278list_pos(Var, _, _, _) :-
  279    var(Var),
  280    !.
  281list_pos(list_position(F,T,Elems0,none), Elems0,
  282         list_position(F,T,Elems,none),  Elems).
  283list_pos(Pos, [Pos], Elems, Elems).
  284
  285
  286                 /*******************************
  287                 *      VAR_INFO/3 SUPPORT      *
  288                 *******************************/
 var_intersection(+List1, +List2, -Shared) is det
Shared is the ordered intersection of List1 and List2.
  294var_intersection(List1, List2, Intersection) :-
  295    sort(List1, Set1),
  296    sort(List2, Set2),
  297    ord_intersection(Set1, Set2, Intersection).
 ord_intersection(+OSet1, +OSet2, -Int)
Ordered list intersection. Copied from the library.
  303ord_intersection([], _Int, []).
  304ord_intersection([H1|T1], L2, Int) :-
  305    isect2(L2, H1, T1, Int).
  306
  307isect2([], _H1, _T1, []).
  308isect2([H2|T2], H1, T1, Int) :-
  309    compare(Order, H1, H2),
  310    isect3(Order, H1, T1, H2, T2, Int).
  311
  312isect3(<, _H1, T1,  H2, T2, Int) :-
  313    isect2(T1, H2, T2, Int).
  314isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  315    ord_intersection(T1, T2, Int).
  316isect3(>, H1, T1,  _H2, T2, Int) :-
  317    isect2(T2, H1, T1, Int).
 merge_variable_info(+Saved)
Merge info from two branches. The info in Saved is the saved info from the first branch, while the info in the actual variables is the info in the second branch. Only if both branches claim the variable to be fresh, we can consider it fresh.
  328merge_variable_info([]).
  329merge_variable_info([Var=State|States]) :-
  330    (   get_attr(Var, '$var_info', CurrentState)
  331    ->  true
  332    ;   CurrentState = (-)
  333    ),
  334    merge_states(Var, State, CurrentState),
  335    merge_variable_info(States).
  336
  337merge_states(_Var, State, State) :- !.
  338merge_states(_Var, -, _) :- !.
  339merge_states(Var, State, -) :-
  340    !,
  341    put_attr(Var, '$var_info', State).
  342merge_states(Var, Left, Right) :-
  343    (   get_dict(fresh, Left, false)
  344    ->  put_dict(fresh, Right, false)
  345    ;   get_dict(fresh, Right, false)
  346    ->  put_dict(fresh, Left, false)
  347    ),
  348    !,
  349    (   Left >:< Right
  350    ->  put_dict(Left, Right, State),
  351        put_attr(Var, '$var_info', State)
  352    ;   print_message(warning,
  353                      inconsistent_variable_properties(Left, Right)),
  354        put_dict(Left, Right, State),
  355        put_attr(Var, '$var_info', State)
  356    ).
  357
  358
  359save_variable_info([], []).
  360save_variable_info([Var|Vars], [Var=State|States]):-
  361    (   get_attr(Var, '$var_info', State)
  362    ->  true
  363    ;   State = (-)
  364    ),
  365    save_variable_info(Vars, States).
  366
  367restore_variable_info([]).
  368restore_variable_info([Var=State|States]) :-
  369    (   State == (-)
  370    ->  del_attr(Var, '$var_info')
  371    ;   put_attr(Var, '$var_info', State)
  372    ),
  373    restore_variable_info(States).
 var_property(+Var, ?Property)
True when Var has a property Key with Value. Defined properties are:
fresh(Fresh)
Variable is first introduced in this goal and thus guaranteed to be unbound. This property is always present.
singleton(Bool)
It true indicate that the variable appears once in the source. Note this doesn't mean it is a semantic singleton.
name(-Name)
True when Name is the name of the variable.
  389var_property(Var, Property) :-
  390    prop_var(Property, Var).
  391
  392prop_var(fresh(Fresh), Var) :-
  393    (   get_attr(Var, '$var_info', Info),
  394        get_dict(fresh, Info, Fresh0)
  395    ->  Fresh = Fresh0
  396    ;   Fresh = true
  397    ).
  398prop_var(singleton(Singleton), Var) :-
  399    get_attr(Var, '$var_info', Info),
  400    get_dict(singleton, Info, Singleton).
  401prop_var(name(Name), Var) :-
  402    (   nb_current('$variable_names', Bindings),
  403        '$member'(Name0=Var0, Bindings),
  404        Var0 == Var
  405    ->  Name = Name0
  406    ).
  407
  408
  409mark_vars_non_fresh([]) :- !.
  410mark_vars_non_fresh([Var|Vars]) :-
  411    (   get_attr(Var, '$var_info', Info)
  412    ->  (   get_dict(fresh, Info, false)
  413        ->  true
  414        ;   put_dict(fresh, Info, false, Info1),
  415            put_attr(Var, '$var_info', Info1)
  416        )
  417    ;   put_attr(Var, '$var_info', '$var_info'{fresh:false})
  418    ),
  419    mark_vars_non_fresh(Vars).
 remove_attributes(+Term, +Attribute) is det
Remove all variable attributes Attribute from Term. This is used to make term_expansion end with a clean term. This is currently required for saving directives in QLF files. The compiler ignores attributes, but I think it is cleaner to remove them anyway.
  430remove_attributes(Term, Attr) :-
  431    term_variables(Term, Vars),
  432    remove_var_attr(Vars, Attr).
  433
  434remove_var_attr([], _):- !.
  435remove_var_attr([Var|Vars], Attr):-
  436    del_attr(Var, Attr),
  437    remove_var_attr(Vars, Attr).
 $var_info:attr_unify_hook(_, _) is det
Dummy unification hook for attributed variables. Just succeeds.
  443'$var_info':attr_unify_hook(_, _).
  444
  445
  446                 /*******************************
  447                 *   GOAL_EXPANSION/2 SUPPORT   *
  448                 *******************************/
 expand_goal(+BodyTerm, +Pos0, -Out, -Pos) is det
 expand_goal(+BodyTerm, -Out) is det
Perform macro-expansion on body terms by calling goal_expansion/2.
  456expand_goal(A, B) :-
  457    expand_goal(A, _, B, _).
  458
  459expand_goal(A, P0, B, P) :-
  460    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  461    (   expand_goal(A, P0, B, P, MList, _)
  462    ->  remove_attributes(B, '$var_info'), A \== B
  463    ),
  464    !.
  465expand_goal(A, P, A, P).
 $expand_closure(+BodyIn, +ExtraArgs, -BodyOut) is semidet
 $expand_closure(+BodyIn, +PIn, +ExtraArgs, -BodyOut, -POut) is semidet
Expand a closure using goal expansion for some extra arguments. Note that the extra argument must remain at the end. If this is not the case, '$expand_closure'/3,5 fail.
  474'$expand_closure'(G0, N, G) :-
  475    '$expand_closure'(G0, _, N, G, _).
  476
  477'$expand_closure'(G0, P0, N, G, P) :-
  478    length(Ex, N),
  479    mark_vars_non_fresh(Ex),
  480    extend_arg_pos(G0, P0, Ex, G1, P1),
  481    expand_goal(G1, P1, G2, P2),
  482    term_variables(G0, VL),
  483    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  484
  485
  486expand_goal(G0, P0, G, P, MList, Term) :-
  487    '$current_source_module'(M),
  488    expand_goal(G0, P0, G, P, M, MList, Term, []).
 expand_goal(+GoalIn, ?PosIn, -GoalOut, -PosOut, +Module, -ModuleList, +Term, +Done) is det
Arguments:
Module- is the current module to consider
ModuleList- are the other expansion modules
Term- is the overall term that is being translated
Done- is a list of terms that have already been expanded
  498% (*)   This is needed because call_goal_expansion may introduce extra
  499%       context variables.  Consider the code below, where the variable
  500%       E is introduced.  Is there a better representation for the
  501%       context?
  502%
  503%         ==
  504%         goal_expansion(catch_and_print(Goal), catch(Goal, E, print(E))).
  505%
  506%         test :-
  507%               catch_and_print(true).
  508%         ==
  509
  510expand_goal(G, P, G, P, _, _, _, _) :-
  511    var(G),
  512    !.
  513expand_goal(M:G, P, M:G, P, _M, _MList, _Term, _) :-
  514    var(M), var(G),
  515    !.
  516expand_goal(M:G, P0, M:EG, P, _M, _MList, Term, Done) :-
  517    atom(M),
  518    !,
  519    f2_pos(P0, PA, PB0, P, PA, PB),
  520    '$def_modules'(M:[goal_expansion/4,goal_expansion/2], MList),
  521    setup_call_cleanup(
  522        '$set_source_module'(Old, M),
  523        '$expand':expand_goal(G, PB0, EG, PB, M, MList, Term, Done),
  524        '$set_source_module'(Old)).
  525expand_goal(G0, P0, G, P, M, MList, Term, Done) :-
  526    (   already_expanded(G0, Done, Done1)
  527    ->  expand_control(G0, P0, G, P, M, MList, Term, Done1)
  528    ;   call_goal_expansion(MList, G0, P0, G1, P1)
  529    ->  expand_goal(G1, P1, G, P, M, MList, Term/G1, [G0|Done])      % (*)
  530    ;   expand_control(G0, P0, G, P, M, MList, Term, Done)
  531    ).
  532
  533expand_control((A,B), P0, Conj, P, M, MList, Term, Done) :-
  534    !,
  535    f2_pos(P0, PA0, PB0, P1, PA, PB),
  536    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  537    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  538    simplify((EA,EB), P1, Conj, P).
  539expand_control((A;B), P0, Or, P, M, MList, Term, Done) :-
  540    !,
  541    f2_pos(P0, PA0, PB0, P1, PA1, PB),
  542    term_variables(A, AVars),
  543    term_variables(B, BVars),
  544    var_intersection(AVars, BVars, SharedVars),
  545    save_variable_info(SharedVars, SavedState),
  546    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  547    save_variable_info(SharedVars, SavedState2),
  548    restore_variable_info(SavedState),
  549    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  550    merge_variable_info(SavedState2),
  551    fixup_or_lhs(A, EA, PA, EA1, PA1),
  552    simplify((EA1;EB), P1, Or, P).
  553expand_control((A->B), P0, Goal, P, M, MList, Term, Done) :-
  554    !,
  555    f2_pos(P0, PA0, PB0, P1, PA, PB),
  556    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  557    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  558    simplify((EA->EB), P1, Goal, P).
  559expand_control((A*->B), P0, Goal, P, M, MList, Term, Done) :-
  560    !,
  561    f2_pos(P0, PA0, PB0, P1, PA, PB),
  562    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  563    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  564    simplify((EA*->EB), P1, Goal, P).
  565expand_control((\+A), P0, Goal, P, M, MList, Term, Done) :-
  566    !,
  567    f1_pos(P0, PA0, P1, PA),
  568    term_variables(A, AVars),
  569    save_variable_info(AVars, SavedState),
  570    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  571    restore_variable_info(SavedState),
  572    simplify(\+(EA), P1, Goal, P).
  573expand_control(call(A), P0, call(EA), P, M, MList, Term, Done) :-
  574    !,
  575    f1_pos(P0, PA0, P, PA),
  576    expand_goal(A, PA0, EA, PA, M, MList, Term, Done).
  577expand_control(G0, P0, G, P, M, MList, Term, Done) :-
  578    is_meta_call(G0, M, Head),
  579    !,
  580    term_variables(G0, Vars),
  581    mark_vars_non_fresh(Vars),
  582    expand_meta(Head, G0, P0, G, P, M, MList, Term, Done).
  583expand_control(G0, P0, G, P, M, MList, Term, _Done) :-
  584    term_variables(G0, Vars),
  585    mark_vars_non_fresh(Vars),
  586    expand_functions(G0, P0, G, P, M, MList, Term).
 already_expanded(+Goal, +Done, -RestDone) is semidet
  590already_expanded(Goal, Done, Done1) :-
  591    '$select'(G, Done, Done1),
  592    G == Goal,
  593    !.
 fixup_or_lhs(+OldLeft, -ExpandedLeft, +ExpPos, -Fixed, -FixedPos) is det
The semantics of (A;B) is different if A is (If->Then). We need to keep the same semantics if -> is introduced or removed by the expansion. If -> is introduced, we make sure that the whole thing remains a disjunction by creating ((EA,true);B)
  602fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  603    nonvar(Old),
  604    nonvar(New),
  605    (   Old = (_ -> _)
  606    ->  New \= (_ -> _),
  607        Fix = (New -> true)
  608    ;   New = (_ -> _),
  609        Fix = (New, true)
  610    ),
  611    !,
  612    lhs_pos(PNew, PFixed).
  613fixup_or_lhs(_Old, New, P, New, P).
  614
  615lhs_pos(P0, _) :-
  616    var(P0),
  617    !.
  618lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  619    arg(1, P0, F),
  620    arg(2, P0, T).
 is_meta_call(+G0, +M, -Head) is semidet
True if M:G0 resolves to a real meta-goal as specified by Head.
  627is_meta_call(G0, M, Head) :-
  628    compound(G0),
  629    default_module(M, M2),
  630    '$c_current_predicate'(_, M2:G0),
  631    !,
  632    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  633    has_meta_arg(Head).
 expand_meta(+MetaSpec, +G0, ?P0, -G, -P, +M, +Mlist, +Term, +Done)
  638expand_meta(Spec, G0, P0, G, P, M, MList, Term, Done) :-
  639    functor(Spec, _, Arity),
  640    functor(G0, Name, Arity),
  641    functor(G1, Name, Arity),
  642    f_pos(P0, ArgPos0, P, ArgPos),
  643    expand_meta(1, Arity, Spec,
  644                G0, ArgPos0, Eval,
  645                G1,  ArgPos,
  646                M, MList, Term, Done),
  647    conj(Eval, G1, G).
  648
  649expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, G, [P|PT], M, MList, Term, Done) :-
  650    I =< Arity,
  651    !,
  652    arg_pos(ArgPos0, P0, PT0),
  653    arg(I, Spec, Meta),
  654    arg(I, G0, A0),
  655    arg(I, G, A),
  656    expand_meta_arg(Meta, A0, P0, EvalA, A, P, M, MList, Term, Done),
  657    I2 is I + 1,
  658    expand_meta(I2, Arity, Spec, G0, PT0, EvalB, G, PT, M, MList, Term, Done),
  659    conj(EvalA, EvalB, Eval).
  660expand_meta(_, _, _, _, _, true, _, [], _, _, _, _).
  661
  662arg_pos(List, _, _) :- var(List), !.    % no position info
  663arg_pos([H|T], H, T) :- !.              % argument list
  664arg_pos([], _, []).                     % new has more
  665
  666mapex([], _).
  667mapex([E|L], E) :- mapex(L, E).
 extended_pos(+Pos0, +N, -Pos) is det
extended_pos(-Pos0, +N, +Pos) is det
Pos is the result of adding N extra positions to Pos0.
  674extended_pos(Var, _, Var) :-
  675    var(Var),
  676    !.
  677extended_pos(parentheses_term_position(O,C,Pos0),
  678             N,
  679             parentheses_term_position(O,C,Pos)) :-
  680    !,
  681    extended_pos(Pos0, N, Pos).
  682extended_pos(term_position(F,T,FF,FT,Args),
  683             _,
  684             term_position(F,T,FF,FT,Args)) :-
  685    var(Args),
  686    !.
  687extended_pos(term_position(F,T,FF,FT,Args0),
  688             N,
  689             term_position(F,T,FF,FT,Args)) :-
  690    length(Ex, N),
  691    mapex(Ex, T-T),
  692    '$append'(Args0, Ex, Args),
  693    !.
  694extended_pos(F-T,
  695             N,
  696             term_position(F,T,F,T,Ex)) :-
  697    !,
  698    length(Ex, N),
  699    mapex(Ex, T-T).
  700extended_pos(Pos, N, Pos) :-
  701    '$print_message'(warning, extended_pos(Pos, N)).
 expand_meta_arg(+MetaSpec, +Arg0, +ArgPos0, -Eval, -Arg, -ArgPos, +ModuleList, +Term, +Done) is det
Goal expansion for a meta-argument.
Arguments:
Eval- is always true. Future versions should allow for functions on such positions. This requires proper position management for function expansion.
  712expand_meta_arg(0, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  713    !,
  714    expand_goal(A0, PA0, A1, PA, M, MList, Term, Done),
  715    compile_meta_call(A1, A, M, Term).
  716expand_meta_arg(N, A0, P0, true, A, P, M, MList, Term, Done) :-
  717    integer(N), callable(A0),
  718    replace_functions(A0, true, _, M),
  719    !,
  720    length(Ex, N),
  721    mark_vars_non_fresh(Ex),
  722    extend_arg_pos(A0, P0, Ex, A1, PA1),
  723    expand_goal(A1, PA1, A2, PA2, M, MList, Term, Done),
  724    compile_meta_call(A2, A3, M, Term),
  725    term_variables(A0, VL),
  726    remove_arg_pos(A3, PA2, M, VL, Ex, A, P).
  727expand_meta_arg(^, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  728    replace_functions(A0, true, _, M),
  729    !,
  730    expand_setof_goal(A0, PA0, A, PA, M, MList, Term, Done).
  731expand_meta_arg(S, A0, _PA0, Eval, A, _PA, M, _MList, _Term, _Done) :-
  732    replace_functions(A0, Eval, A, M), % TBD: pass positions
  733    (   Eval == true
  734    ->  true
  735    ;   same_functor(A0, A)
  736    ->  true
  737    ;   meta_arg(S)
  738    ->  throw(error(context_error(function, meta_arg(S)), _))
  739    ;   true
  740    ).
  741
  742same_functor(T1, T2) :-
  743    compound(T1),
  744    !,
  745    compound(T2),
  746    compound_name_arity(T1, N, A),
  747    compound_name_arity(T2, N, A).
  748same_functor(T1, T2) :-
  749    atom(T1),
  750    T1 == T2.
  751
  752variant_sha1_nat(Term, Hash) :-
  753    copy_term_nat(Term, TNat),
  754    variant_sha1(TNat, Hash).
  755
  756wrap_meta_arguments(A0, M, VL, Ex, A) :-
  757    '$append'(VL, Ex, AV),
  758    variant_sha1_nat(A0+AV, Hash),
  759    atom_concat('__aux_wrapper_', Hash, AuxName),
  760    H =.. [AuxName|AV],
  761    compile_auxiliary_clause(M, (H :- A0)),
  762    A =.. [AuxName|VL].
 extend_arg_pos(+A0, +P0, +Ex, -A, -P) is det
Adds extra arguments Ex to A0, and extra subterm positions to P for such arguments.
  769extend_arg_pos(A, P, _, A, P) :-
  770    var(A),
  771    !.
  772extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  773    !,
  774    f2_pos(P0, PM, PA0, P, PM, PA),
  775    extend_arg_pos(A0, PA0, Ex, A, PA).
  776extend_arg_pos(A0, P0, Ex, A, P) :-
  777    callable(A0),
  778    !,
  779    extend_term(A0, Ex, A),
  780    length(Ex, N),
  781    extended_pos(P0, N, P).
  782extend_arg_pos(A, P, _, A, P).
  783
  784extend_term(Atom, Extra, Term) :-
  785    atom(Atom),
  786    !,
  787    Term =.. [Atom|Extra].
  788extend_term(Term0, Extra, Term) :-
  789    compound_name_arguments(Term0, Name, Args0),
  790    '$append'(Args0, Extra, Args),
  791    compound_name_arguments(Term, Name, Args).
 remove_arg_pos(+A0, +P0, +M, +Ex, +VL, -A, -P) is det
Removes the Ex arguments from A0 and the respective extra positions from P0. Note that if they are not at the end, a wrapper with the elements of VL as arguments is generated to put them in order.
See also
- wrap_meta_arguments/5
  802remove_arg_pos(A, P, _, _, _, A, P) :-
  803    var(A),
  804    !.
  805remove_arg_pos(M:A0, P0, _, VL, Ex, M:A, P) :-
  806    !,
  807    f2_pos(P, PM, PA0, P0, PM, PA),
  808    remove_arg_pos(A0, PA, M, VL, Ex, A, PA0).
  809remove_arg_pos(A0, P0, M, VL, Ex0, A, P) :-
  810    callable(A0),
  811    !,
  812    length(Ex0, N),
  813    (   A0 =.. [F|Args],
  814        length(Ex, N),
  815        '$append'(Args0, Ex, Args),
  816        Ex==Ex0
  817    ->  extended_pos(P, N, P0),
  818        A =.. [F|Args0]
  819    ;   M \== [],
  820        wrap_meta_arguments(A0, M, VL, Ex0, A),
  821        wrap_meta_pos(P0, P)
  822    ).
  823remove_arg_pos(A, P, _, _, _, A, P).
  824
  825wrap_meta_pos(P0, P) :-
  826    (   nonvar(P0)
  827    ->  P = term_position(F,T,_,_,_),
  828        atomic_pos(P0, F-T)
  829    ;   true
  830    ).
  831
  832has_meta_arg(Head) :-
  833    arg(_, Head, Arg),
  834    direct_call_meta_arg(Arg),
  835    !.
  836
  837direct_call_meta_arg(I) :- integer(I).
  838direct_call_meta_arg(^).
  839
  840meta_arg(:).
  841meta_arg(//).
  842meta_arg(I) :- integer(I).
  843
  844expand_setof_goal(Var, Pos, Var, Pos, _, _, _, _) :-
  845    var(Var),
  846    !.
  847expand_setof_goal(V^G, P0, V^EG, P, M, MList, Term, Done) :-
  848    !,
  849    f2_pos(P0, PA0, PB, P, PA, PB),
  850    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  851expand_setof_goal(M0:G, P0, M0:EG, P, M, MList, Term, Done) :-
  852    !,
  853    f2_pos(P0, PA0, PB, P, PA, PB),
  854    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  855expand_setof_goal(G, P0, EG, P, M, MList, Term, Done) :-
  856    !,
  857    expand_goal(G, P0, EG0, P, M, MList, Term, Done),
  858    compile_meta_call(EG0, EG, M, Term).            % TBD: Pos?
 call_goal_expansion(+ExpandModules, +Goal0, ?Pos0, -Goal, -Pos, +Done) is semidet
Succeeds if the context has a module that defines goal_expansion/2 this rule succeeds and Goal is not equal to Goal0. Note that the translator is called recursively until a fixed-point is reached.
  869call_goal_expansion(MList, G0, P0, G, P) :-
  870    current_prolog_flag(sandboxed_load, false),
  871    !,
  872    (   '$member'(M-Preds, MList),
  873        '$member'(Pred, Preds),
  874        (   Pred == goal_expansion/4
  875        ->  M:goal_expansion(G0, P0, G, P)
  876        ;   M:goal_expansion(G0, G),
  877            P = P0
  878        ),
  879        G0 \== G
  880    ->  true
  881    ).
  882call_goal_expansion(MList, G0, P0, G, P) :-
  883    (   '$member'(M-Preds, MList),
  884        '$member'(Pred, Preds),
  885        (   Pred == goal_expansion/4
  886        ->  Expand = M:goal_expansion(G0, P0, G, P)
  887        ;   Expand = M:goal_expansion(G0, G)
  888        ),
  889        allowed_expansion(Expand),
  890        call(Expand),
  891        G0 \== G
  892    ->  true
  893    ).
 allowed_expansion(:Goal) is semidet
Calls prolog:sandbox_allowed_expansion(:Goal) prior to calling Goal for the purpose of term or goal expansion. This hook can prevent the expansion to take place by raising an exception.
throws
- exceptions from prolog:sandbox_allowed_expansion/1.
  903:- multifile
  904    prolog:sandbox_allowed_expansion/1.  905
  906allowed_expansion(QGoal) :-
  907    strip_module(QGoal, M, Goal),
  908    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
  909    (   var(E)
  910    ->  fail
  911    ;   !,
  912        print_message(error, E),
  913        fail
  914    ).
  915allowed_expansion(_).
  916
  917
  918                 /*******************************
  919                 *      FUNCTIONAL NOTATION     *
  920                 *******************************/
 expand_functions(+G0, +P0, -G, -P, +M, +MList, +Term) is det
Expand functional notation and arithmetic functions.
Arguments:
MList- is the list of modules defining goal_expansion/2 in the expansion context.
  929expand_functions(G0, P0, G, P, M, MList, Term) :-
  930    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
  931    (   expand_arithmetic(G1, P1, G, P, Term)
  932    ->  true
  933    ;   G = G1,
  934        P = P1
  935    ).
 expand_functional_notation(+G0, +P0, -G, -P, +M, +MList, +Term) is det
To be done
- : position logic
- : make functions module-local
  942expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
  943    contains_functions(G0),
  944    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
  945    Eval \== true,
  946    !,
  947    wrap_var(G1, G1Pos, G2, G2Pos),
  948    conj(Eval, EvalPos, G2, G2Pos, G, P).
  949expand_functional_notation(G, P, G, P, _, _, _).
  950
  951wrap_var(G, P, G, P) :-
  952    nonvar(G),
  953    !.
  954wrap_var(G, P0, call(G), P) :-
  955    (   nonvar(P0)
  956    ->  P = term_position(F,T,F,T,[P0]),
  957        atomic_pos(P0, F-T)
  958    ;   true
  959    ).
 contains_functions(@Term) is semidet
True when Term contains a function reference.
  965contains_functions(Term) :-
  966    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
  967            (   contains_functions2(Skeleton)
  968            ;   contains_functions2(Assignments)
  969            )).
  970
  971contains_functions2(Term) :-
  972    compound(Term),
  973    (   function(Term, _)
  974    ->  true
  975    ;   arg(_, Term, Arg),
  976        contains_functions2(Arg)
  977    ->  true
  978    ).
 replace_functions(+GoalIn, +PosIn, -Eval, -EvalPos, -GoalOut, -PosOut, +ContextTerm) is det
To be done
- Proper propagation of list, dict and brace term positions.
  987:- public
  988    replace_functions/4.            % used in dicts.pl
  989
  990replace_functions(GoalIn, Eval, GoalOut, Context) :-
  991    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
  992
  993replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
  994    var(Var),
  995    !.
  996replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
  997    function(F, Ctx),
  998    !,
  999    compound_name_arity(F, Name, Arity),
 1000    PredArity is Arity+1,
 1001    compound_name_arity(G, Name, PredArity),
 1002    arg(PredArity, G, Var),
 1003    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1004    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1005    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1006replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1007    compound(Term0),
 1008    !,
 1009    compound_name_arity(Term0, Name, Arity),
 1010    compound_name_arity(Term, Name, Arity),
 1011    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1012    map_functions(0, Arity,
 1013                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1014replace_functions(Term, Pos, true, _, Term, Pos, _).
 map_functions(+Arg, +Arity, +TermIn, +ArgInPos, -Term, -ArgPos, -Eval, -EvalPos, +Context)
 1021map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1022    !,
 1023    pos_nil(LPos0, LPos).
 1024map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1025    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1026    I is I0+1,
 1027    arg(I, Term0, Arg0),
 1028    arg(I, Term, Arg),
 1029    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1030    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1031    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1032
 1033conj(true, X, X) :- !.
 1034conj(X, true, X) :- !.
 1035conj(X, Y, (X,Y)).
 1036
 1037conj(true, _, X, P, X, P) :- !.
 1038conj(X, P, true, _, X, P) :- !.
 1039conj(X, PX, Y, PY, (X,Y), _) :-
 1040    var(PX), var(PY),
 1041    !.
 1042conj(X, PX, Y, PY, (X,Y), P) :-
 1043    P = term_position(F,T,FF,FT,[PX,PY]),
 1044    atomic_pos(PX, F-FF),
 1045    atomic_pos(PY, FT-T).
 function(?Term, +Context)
True if function expansion needs to be applied for the given term.
 1052function(.(_,_), _) :- \+ functor([_|_], ., _).
 1053
 1054
 1055                 /*******************************
 1056                 *          ARITHMETIC          *
 1057                 *******************************/
 expand_arithmetic(+G0, +P0, -G, -P, +Term) is semidet
Expand arithmetic expressions in is/2, (>)/2, etc. This is currently a dummy. The idea is to call rules similar to goal_expansion/2,4 that allow for rewriting an arithmetic expression. The system rules will perform evaluation of constant expressions.
 1067expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1068
 1069
 1070                 /*******************************
 1071                 *        POSITION LOGIC        *
 1072                 *******************************/
 f2_pos(?TermPos0, ?PosArg10, ?PosArg20, ?TermPos, ?PosArg1, ?PosArg2) is det
 f1_pos(?TermPos0, ?PosArg10, ?TermPos, ?PosArg1) is det
 f_pos(?TermPos0, ?PosArgs0, ?TermPos, ?PosArgs) is det
 atomic_pos(?TermPos0, -AtomicPos) is det
Position progapation routines.
 1082f2_pos(Var, _, _, _, _, _) :-
 1083    var(Var),
 1084    !.
 1085f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1086       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1087f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1088       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1089    !,
 1090    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1091f2_pos(Pos, _, _, _, _, _) :-
 1092    expected_layout(f2, Pos).
 1093
 1094f1_pos(Var, _, _, _) :-
 1095    var(Var),
 1096    !.
 1097f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1098       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1099f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1100       parentheses_term_position(O,C,Pos),  A1) :-
 1101    !,
 1102    f1_pos(Pos0, A10, Pos, A1).
 1103f1_pos(Pos, _, _, _) :-
 1104    expected_layout(f1, Pos).
 1105
 1106f_pos(Var, _, _, _) :-
 1107    var(Var),
 1108    !.
 1109f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1110      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1111f_pos(parentheses_term_position(O,C,Pos0), A10,
 1112      parentheses_term_position(O,C,Pos),  A1) :-
 1113    !,
 1114    f_pos(Pos0, A10, Pos, A1).
 1115f_pos(Pos, _, _, _) :-
 1116    expected_layout(compound, Pos).
 1117
 1118atomic_pos(Pos, _) :-
 1119    var(Pos),
 1120    !.
 1121atomic_pos(Pos, F-T) :-
 1122    arg(1, Pos, F),
 1123    arg(2, Pos, T).
 pos_nil(+Nil, -Nil) is det
 pos_list(+List0, -H0, -T0, -List, -H, -T) is det
Position propagation for lists.
 1130pos_nil(Var, _) :- var(Var), !.
 1131pos_nil([], []) :- !.
 1132pos_nil(Pos, _) :-
 1133    expected_layout(nil, Pos).
 1134
 1135pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1136pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1137pos_list(Pos, _, _, _, _, _) :-
 1138    expected_layout(list, Pos).
 extend_1_pos(+FunctionPos, -FArgPos, -EvalPos, -EArgPos, -VarPos)
Deal with extending a function to include the return value.
 1144extend_1_pos(Pos, _, _, _, _) :-
 1145    var(Pos),
 1146    !.
 1147extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1148             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1149             FT-FT1) :-
 1150    integer(FT),
 1151    !,
 1152    FT1 is FT+1,
 1153    '$same_length'(FArgPos, GArgPos0),
 1154    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1155extend_1_pos(F-T, [],
 1156             term_position(F,T,F,T,[T-T1]), [],
 1157             T-T1) :-
 1158    integer(T),
 1159    !,
 1160    T1 is T+1.
 1161extend_1_pos(Pos, _, _, _, _) :-
 1162    expected_layout(callable, Pos).
 1163
 1164'$same_length'(List, List) :-
 1165    var(List),
 1166    !.
 1167'$same_length'([], []).
 1168'$same_length'([_|T0], [_|T]) :-
 1169    '$same_length'(T0, T).
 expected_layout(+Expected, +Found)
Print a message if the layout term does not satisfy our expectations. This means that the transformation requires support from term_expansion/4 and/or goal_expansion/4 to achieve proper source location information.
 1179:- create_prolog_flag(debug_term_position, false, []). 1180
 1181expected_layout(Expected, Pos) :-
 1182    current_prolog_flag(debug_term_position, true),
 1183    !,
 1184    '$print_message'(warning, expected_layout(Expected, Pos)).
 1185expected_layout(_, _).
 1186
 1187
 1188                 /*******************************
 1189                 *    SIMPLIFICATION ROUTINES   *
 1190                 *******************************/
 simplify(+ControlIn, +Pos0, -ControlOut, -Pos) is det
Simplify control structures
To be done
- Much more analysis
- Turn this into a separate module
 1199simplify(Control, P, Control, P) :-
 1200    current_prolog_flag(optimise, false),
 1201    !.
 1202simplify(Control, P0, Simple, P) :-
 1203    simple(Control, P0, Simple, P),
 1204    !.
 1205simplify(Control, P, Control, P).
 simple(+Goal, +GoalPos, -Simple, -SimplePos)
Simplify a control structure. Note that we do not simplify (A;fail). Logically, this is the same as A if A is not _->_ or _*->_, but the choice point may be created on purpose.
 1214simple((X,Y), P0, Conj, P) :-
 1215    (   true(X)
 1216    ->  Conj = Y,
 1217        f2_pos(P0, _, P, _, _, _)
 1218    ;   false(X)
 1219    ->  Conj = fail,
 1220        f2_pos(P0, P1, _, _, _, _),
 1221        atomic_pos(P1, P)
 1222    ;   true(Y)
 1223    ->  Conj = X,
 1224        f2_pos(P0, P, _, _, _, _)
 1225    ).
 1226simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1227    (   true(I)                     % because nothing happens if I and T
 1228    ->  ITE = T,                    % are unbound.
 1229        f2_pos(P0, P1, _, _, _, _),
 1230        f2_pos(P1, _, P, _, _, _)
 1231    ;   false(I)
 1232    ->  ITE = E,
 1233        f2_pos(P0, _, P, _, _, _)
 1234    ).
 1235simple((X;Y), P0, Or, P) :-
 1236    false(X),
 1237    Or = Y,
 1238    f2_pos(P0, _, P, _, _, _).
 1239
 1240true(X) :-
 1241    nonvar(X),
 1242    eval_true(X).
 1243
 1244false(X) :-
 1245    nonvar(X),
 1246    eval_false(X).
 eval_true(+Goal) is semidet
 eval_false(+Goal) is semidet
 1252eval_true(true).
 1253eval_true(otherwise).
 1254
 1255eval_false(fail).
 1256eval_false(false).
 1257
 1258
 1259                 /*******************************
 1260                 *         META CALLING         *
 1261                 *******************************/
 1262
 1263:- create_prolog_flag(compile_meta_arguments, false, [type(atom)]).
 compile_meta_call(+CallIn, -CallOut, +Module, +Term) is det
Compile (complex) meta-calls into a clause.
 1269compile_meta_call(CallIn, CallIn, _, Term) :-
 1270    var(Term),
 1271    !.                   % explicit call; no context
 1272compile_meta_call(CallIn, CallIn, _, _) :-
 1273    var(CallIn),
 1274    !.
 1275compile_meta_call(CallIn, CallIn, _, _) :-
 1276    (   current_prolog_flag(compile_meta_arguments, false)
 1277    ;   current_prolog_flag(xref, true)
 1278    ),
 1279    !.
 1280compile_meta_call(CallIn, CallIn, _, _) :-
 1281    strip_module(CallIn, _, Call),
 1282    (   is_aux_meta(Call)
 1283    ;   \+ control(Call),
 1284        (   '$c_current_predicate'(_, system:Call),
 1285            \+ current_prolog_flag(compile_meta_arguments, always)
 1286        ;   current_prolog_flag(compile_meta_arguments, control)
 1287        )
 1288    ),
 1289    !.
 1290compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1291    !,
 1292    (   atom(M), callable(CallIn)
 1293    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1294    ;   CallOut = M:CallIn
 1295    ).
 1296compile_meta_call(CallIn, CallOut, Module, Term) :-
 1297    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1298    compile_auxiliary_clause(Module, Clause).
 1299
 1300compile_auxiliary_clause(Module, Clause) :-
 1301    Clause = (Head:-Body),
 1302    '$current_source_module'(SM),
 1303    (   predicate_property(SM:Head, defined)
 1304    ->  true
 1305    ;   SM == Module
 1306    ->  compile_aux_clauses([Clause])
 1307    ;   compile_aux_clauses([Head:-Module:Body])
 1308    ).
 1309
 1310control((_,_)).
 1311control((_;_)).
 1312control((_->_)).
 1313control((_*->_)).
 1314control(\+(_)).
 1315
 1316is_aux_meta(Term) :-
 1317    callable(Term),
 1318    functor(Term, Name, _),
 1319    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1320
 1321compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1322    term_variables(Term, AllVars),
 1323    term_variables(CallIn, InVars),
 1324    intersection_eq(InVars, AllVars, HeadVars),
 1325    variant_sha1(CallIn+HeadVars, Hash),
 1326    atom_concat('__aux_meta_call_', Hash, AuxName),
 1327    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn), []),
 1328    length(HeadVars, Arity),
 1329    (   Arity > 256                 % avoid 1024 arity limit
 1330    ->  HeadArgs = [v(HeadVars)]
 1331    ;   HeadArgs = HeadVars
 1332    ),
 1333    CallOut =.. [AuxName|HeadArgs].
 intersection_eq(+Small, +Big, -Shared) is det
Shared are the variables in Small that also appear in Big. The variables in Shared are in the same order as Small.
 1340intersection_eq([], _, []).
 1341intersection_eq([H|T0], L, List) :-
 1342    (   member_eq(H, L)
 1343    ->  List = [H|T],
 1344        intersection_eq(T0, L, T)
 1345    ;   intersection_eq(T0, L, List)
 1346    ).
 1347
 1348member_eq(E, [H|T]) :-
 1349    (   E == H
 1350    ->  true
 1351    ;   member_eq(E, T)
 1352    ).
 1353
 1354                 /*******************************
 1355                 *            RENAMING          *
 1356                 *******************************/
 1357
 1358:- multifile
 1359    prolog:rename_predicate/2. 1360
 1361rename(Var, Var) :-
 1362    var(Var),
 1363    !.
 1364rename(end_of_file, end_of_file) :- !.
 1365rename(Terms0, Terms) :-
 1366    is_list(Terms0),
 1367    !,
 1368    '$current_source_module'(M),
 1369    rename_preds(Terms0, Terms, M).
 1370rename(Term0, Term) :-
 1371    '$current_source_module'(M),
 1372    rename(Term0, Term, M),
 1373    !.
 1374rename(Term, Term).
 1375
 1376rename_preds([], [], _).
 1377rename_preds([H0|T0], [H|T], M) :-
 1378    (   rename(H0, H, M)
 1379    ->  true
 1380    ;   H = H0
 1381    ),
 1382    rename_preds(T0, T, M).
 1383
 1384rename(Var, Var, _) :-
 1385    var(Var),
 1386    !.
 1387rename(M:Term0, M:Term, M0) :-
 1388    !,
 1389    (   M = '$source_location'(_File, _Line)
 1390    ->  rename(Term0, Term, M0)
 1391    ;   rename(Term0, Term, M)
 1392    ).
 1393rename((Head0 :- Body), (Head :- Body), M) :-
 1394    !,
 1395    rename_head(Head0, Head, M).
 1396rename((:-_), _, _) :-
 1397    !,
 1398    fail.
 1399rename(Head0, Head, M) :-
 1400    rename_head(Head0, Head, M).
 1401
 1402rename_head(Var, Var, _) :-
 1403    var(Var),
 1404    !.
 1405rename_head(M:Term0, M:Term, _) :-
 1406    !,
 1407    rename_head(Term0, Term, M).
 1408rename_head(Head0, Head, M) :-
 1409    prolog:rename_predicate(M:Head0, M:Head).
 1410
 1411
 1412                 /*******************************
 1413                 *      :- IF ... :- ENDIF      *
 1414                 *******************************/
 1415
 1416:- thread_local
 1417    '$include_code'/3. 1418
 1419'$including' :-
 1420    '$include_code'(X, _, _),
 1421    !,
 1422    X == true.
 1423'$including'.
 1424
 1425cond_compilation((:- if(G)), []) :-
 1426    source_location(File, Line),
 1427    (   '$including'
 1428    ->  (   catch('$eval_if'(G), E, (print_message(error, E), fail))
 1429        ->  asserta('$include_code'(true, File, Line))
 1430        ;   asserta('$include_code'(false, File, Line))
 1431        )
 1432    ;   asserta('$include_code'(else_false, File, Line))
 1433    ).
 1434cond_compilation((:- elif(G)), []) :-
 1435    source_location(File, Line),
 1436    (   clause('$include_code'(Old, OF, _), _, Ref)
 1437    ->  same_source(File, OF, elif),
 1438        erase(Ref),
 1439        (   Old == true
 1440        ->  asserta('$include_code'(else_false, File, Line))
 1441        ;   Old == false,
 1442            catch('$eval_if'(G), E, (print_message(error, E), fail))
 1443        ->  asserta('$include_code'(true, File, Line))
 1444        ;   asserta('$include_code'(Old, File, Line))
 1445        )
 1446    ;   throw(error(conditional_compilation_error(no_if, elif), _))
 1447    ).
 1448cond_compilation((:- else), []) :-
 1449    source_location(File, Line),
 1450    (   clause('$include_code'(X, OF, _), _, Ref)
 1451    ->  same_source(File, OF, else),
 1452        erase(Ref),
 1453        (   X == true
 1454        ->  X2 = false
 1455        ;   X == false
 1456        ->  X2 = true
 1457        ;   X2 = X
 1458        ),
 1459        asserta('$include_code'(X2, File, Line))
 1460    ;   throw(error(conditional_compilation_error(no_if, else), _))
 1461    ).
 1462cond_compilation(end_of_file, end_of_file) :-   % TBD: Check completeness
 1463    !,
 1464    source_location(File, _),
 1465    (   clause('$include_code'(_, OF, OL), _)
 1466    ->  (   File == OF
 1467        ->  throw(error(conditional_compilation_error(
 1468                            unterminated,OF:OL), _))
 1469        ;   true
 1470        )
 1471    ;   true
 1472    ).
 1473cond_compilation((:- endif), []) :-
 1474    !,
 1475    source_location(File, _),
 1476    (   (   clause('$include_code'(_, OF, _), _, Ref)
 1477        ->  same_source(File, OF, endif),
 1478            erase(Ref)
 1479        )
 1480    ->  true
 1481    ;   throw(error(conditional_compilation_error(no_if, endif), _))
 1482    ).
 1483cond_compilation(_, []) :-
 1484    \+ '$including'.
 1485
 1486same_source(File, File, _) :- !.
 1487same_source(_,    _,    Op) :-
 1488    throw(error(conditional_compilation_error(no_if, Op), _)).
 1489
 1490
 1491'$eval_if'(G) :-
 1492    expand_goal(G, G2),
 1493    '$current_source_module'(Module),
 1494    Module:G2