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    E = error(Formal,_),
  909    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
  910    (   var(Formal)
  911    ->  fail
  912    ;   !,
  913        print_message(error, E),
  914        fail
  915    ).
  916allowed_expansion(_).
  917
  918
  919                 /*******************************
  920                 *      FUNCTIONAL NOTATION     *
  921                 *******************************/
 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.
  930expand_functions(G0, P0, G, P, M, MList, Term) :-
  931    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
  932    (   expand_arithmetic(G1, P1, G, P, Term)
  933    ->  true
  934    ;   G = G1,
  935        P = P1
  936    ).
 expand_functional_notation(+G0, +P0, -G, -P, +M, +MList, +Term) is det
To be done
- : position logic
- : make functions module-local
  943expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
  944    contains_functions(G0),
  945    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
  946    Eval \== true,
  947    !,
  948    wrap_var(G1, G1Pos, G2, G2Pos),
  949    conj(Eval, EvalPos, G2, G2Pos, G, P).
  950expand_functional_notation(G, P, G, P, _, _, _).
  951
  952wrap_var(G, P, G, P) :-
  953    nonvar(G),
  954    !.
  955wrap_var(G, P0, call(G), P) :-
  956    (   nonvar(P0)
  957    ->  P = term_position(F,T,F,T,[P0]),
  958        atomic_pos(P0, F-T)
  959    ;   true
  960    ).
 contains_functions(@Term) is semidet
True when Term contains a function reference.
  966contains_functions(Term) :-
  967    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
  968            (   contains_functions2(Skeleton)
  969            ;   contains_functions2(Assignments)
  970            )).
  971
  972contains_functions2(Term) :-
  973    compound(Term),
  974    (   function(Term, _)
  975    ->  true
  976    ;   arg(_, Term, Arg),
  977        contains_functions2(Arg)
  978    ->  true
  979    ).
 replace_functions(+GoalIn, +PosIn, -Eval, -EvalPos, -GoalOut, -PosOut, +ContextTerm) is det
To be done
- Proper propagation of list, dict and brace term positions.
  988:- public
  989    replace_functions/4.            % used in dicts.pl
  990
  991replace_functions(GoalIn, Eval, GoalOut, Context) :-
  992    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
  993
  994replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
  995    var(Var),
  996    !.
  997replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
  998    function(F, Ctx),
  999    !,
 1000    compound_name_arity(F, Name, Arity),
 1001    PredArity is Arity+1,
 1002    compound_name_arity(G, Name, PredArity),
 1003    arg(PredArity, G, Var),
 1004    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1005    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1006    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1007replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1008    compound(Term0),
 1009    !,
 1010    compound_name_arity(Term0, Name, Arity),
 1011    compound_name_arity(Term, Name, Arity),
 1012    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1013    map_functions(0, Arity,
 1014                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1015replace_functions(Term, Pos, true, _, Term, Pos, _).
 map_functions(+Arg, +Arity, +TermIn, +ArgInPos, -Term, -ArgPos, -Eval, -EvalPos, +Context)
 1022map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1023    !,
 1024    pos_nil(LPos0, LPos).
 1025map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1026    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1027    I is I0+1,
 1028    arg(I, Term0, Arg0),
 1029    arg(I, Term, Arg),
 1030    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1031    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1032    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1033
 1034conj(true, X, X) :- !.
 1035conj(X, true, X) :- !.
 1036conj(X, Y, (X,Y)).
 1037
 1038conj(true, _, X, P, X, P) :- !.
 1039conj(X, P, true, _, X, P) :- !.
 1040conj(X, PX, Y, PY, (X,Y), _) :-
 1041    var(PX), var(PY),
 1042    !.
 1043conj(X, PX, Y, PY, (X,Y), P) :-
 1044    P = term_position(F,T,FF,FT,[PX,PY]),
 1045    atomic_pos(PX, F-FF),
 1046    atomic_pos(PY, FT-T).
 function(?Term, +Context)
True if function expansion needs to be applied for the given term.
 1053function(.(_,_), _) :- \+ functor([_|_], ., _).
 1054
 1055
 1056                 /*******************************
 1057                 *          ARITHMETIC          *
 1058                 *******************************/
 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.
 1068expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1069
 1070
 1071                 /*******************************
 1072                 *        POSITION LOGIC        *
 1073                 *******************************/
 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.
 1083f2_pos(Var, _, _, _, _, _) :-
 1084    var(Var),
 1085    !.
 1086f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1087       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1088f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1089       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1090    !,
 1091    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1092f2_pos(Pos, _, _, _, _, _) :-
 1093    expected_layout(f2, Pos).
 1094
 1095f1_pos(Var, _, _, _) :-
 1096    var(Var),
 1097    !.
 1098f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1099       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1100f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1101       parentheses_term_position(O,C,Pos),  A1) :-
 1102    !,
 1103    f1_pos(Pos0, A10, Pos, A1).
 1104f1_pos(Pos, _, _, _) :-
 1105    expected_layout(f1, Pos).
 1106
 1107f_pos(Var, _, _, _) :-
 1108    var(Var),
 1109    !.
 1110f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1111      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1112f_pos(parentheses_term_position(O,C,Pos0), A10,
 1113      parentheses_term_position(O,C,Pos),  A1) :-
 1114    !,
 1115    f_pos(Pos0, A10, Pos, A1).
 1116f_pos(Pos, _, _, _) :-
 1117    expected_layout(compound, Pos).
 1118
 1119atomic_pos(Pos, _) :-
 1120    var(Pos),
 1121    !.
 1122atomic_pos(Pos, F-T) :-
 1123    arg(1, Pos, F),
 1124    arg(2, Pos, T).
 pos_nil(+Nil, -Nil) is det
 pos_list(+List0, -H0, -T0, -List, -H, -T) is det
Position propagation for lists.
 1131pos_nil(Var, _) :- var(Var), !.
 1132pos_nil([], []) :- !.
 1133pos_nil(Pos, _) :-
 1134    expected_layout(nil, Pos).
 1135
 1136pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1137pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1138pos_list(Pos, _, _, _, _, _) :-
 1139    expected_layout(list, Pos).
 extend_1_pos(+FunctionPos, -FArgPos, -EvalPos, -EArgPos, -VarPos)
Deal with extending a function to include the return value.
 1145extend_1_pos(Pos, _, _, _, _) :-
 1146    var(Pos),
 1147    !.
 1148extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1149             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1150             FT-FT1) :-
 1151    integer(FT),
 1152    !,
 1153    FT1 is FT+1,
 1154    '$same_length'(FArgPos, GArgPos0),
 1155    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1156extend_1_pos(F-T, [],
 1157             term_position(F,T,F,T,[T-T1]), [],
 1158             T-T1) :-
 1159    integer(T),
 1160    !,
 1161    T1 is T+1.
 1162extend_1_pos(Pos, _, _, _, _) :-
 1163    expected_layout(callable, Pos).
 1164
 1165'$same_length'(List, List) :-
 1166    var(List),
 1167    !.
 1168'$same_length'([], []).
 1169'$same_length'([_|T0], [_|T]) :-
 1170    '$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.
 1180:- create_prolog_flag(debug_term_position, false, []). 1181
 1182expected_layout(Expected, Pos) :-
 1183    current_prolog_flag(debug_term_position, true),
 1184    !,
 1185    '$print_message'(warning, expected_layout(Expected, Pos)).
 1186expected_layout(_, _).
 1187
 1188
 1189                 /*******************************
 1190                 *    SIMPLIFICATION ROUTINES   *
 1191                 *******************************/
 simplify(+ControlIn, +Pos0, -ControlOut, -Pos) is det
Simplify control structures
To be done
- Much more analysis
- Turn this into a separate module
 1200simplify(Control, P, Control, P) :-
 1201    current_prolog_flag(optimise, false),
 1202    !.
 1203simplify(Control, P0, Simple, P) :-
 1204    simple(Control, P0, Simple, P),
 1205    !.
 1206simplify(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.
 1215simple((X,Y), P0, Conj, P) :-
 1216    (   true(X)
 1217    ->  Conj = Y,
 1218        f2_pos(P0, _, P, _, _, _)
 1219    ;   false(X)
 1220    ->  Conj = fail,
 1221        f2_pos(P0, P1, _, _, _, _),
 1222        atomic_pos(P1, P)
 1223    ;   true(Y)
 1224    ->  Conj = X,
 1225        f2_pos(P0, P, _, _, _, _)
 1226    ).
 1227simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1228    (   true(I)                     % because nothing happens if I and T
 1229    ->  ITE = T,                    % are unbound.
 1230        f2_pos(P0, P1, _, _, _, _),
 1231        f2_pos(P1, _, P, _, _, _)
 1232    ;   false(I)
 1233    ->  ITE = E,
 1234        f2_pos(P0, _, P, _, _, _)
 1235    ).
 1236simple((X;Y), P0, Or, P) :-
 1237    false(X),
 1238    Or = Y,
 1239    f2_pos(P0, _, P, _, _, _).
 1240
 1241true(X) :-
 1242    nonvar(X),
 1243    eval_true(X).
 1244
 1245false(X) :-
 1246    nonvar(X),
 1247    eval_false(X).
 eval_true(+Goal) is semidet
 eval_false(+Goal) is semidet
 1253eval_true(true).
 1254eval_true(otherwise).
 1255
 1256eval_false(fail).
 1257eval_false(false).
 1258
 1259
 1260                 /*******************************
 1261                 *         META CALLING         *
 1262                 *******************************/
 1263
 1264:- 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.
 1270compile_meta_call(CallIn, CallIn, _, Term) :-
 1271    var(Term),
 1272    !.                   % explicit call; no context
 1273compile_meta_call(CallIn, CallIn, _, _) :-
 1274    var(CallIn),
 1275    !.
 1276compile_meta_call(CallIn, CallIn, _, _) :-
 1277    (   current_prolog_flag(compile_meta_arguments, false)
 1278    ;   current_prolog_flag(xref, true)
 1279    ),
 1280    !.
 1281compile_meta_call(CallIn, CallIn, _, _) :-
 1282    strip_module(CallIn, _, Call),
 1283    (   is_aux_meta(Call)
 1284    ;   \+ control(Call),
 1285        (   '$c_current_predicate'(_, system:Call),
 1286            \+ current_prolog_flag(compile_meta_arguments, always)
 1287        ;   current_prolog_flag(compile_meta_arguments, control)
 1288        )
 1289    ),
 1290    !.
 1291compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1292    !,
 1293    (   atom(M), callable(CallIn)
 1294    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1295    ;   CallOut = M:CallIn
 1296    ).
 1297compile_meta_call(CallIn, CallOut, Module, Term) :-
 1298    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1299    compile_auxiliary_clause(Module, Clause).
 1300
 1301compile_auxiliary_clause(Module, Clause) :-
 1302    Clause = (Head:-Body),
 1303    '$current_source_module'(SM),
 1304    (   predicate_property(SM:Head, defined)
 1305    ->  true
 1306    ;   SM == Module
 1307    ->  compile_aux_clauses([Clause])
 1308    ;   compile_aux_clauses([Head:-Module:Body])
 1309    ).
 1310
 1311control((_,_)).
 1312control((_;_)).
 1313control((_->_)).
 1314control((_*->_)).
 1315control(\+(_)).
 1316
 1317is_aux_meta(Term) :-
 1318    callable(Term),
 1319    functor(Term, Name, _),
 1320    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1321
 1322compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1323    term_variables(Term, AllVars),
 1324    term_variables(CallIn, InVars),
 1325    intersection_eq(InVars, AllVars, HeadVars),
 1326    variant_sha1(CallIn+HeadVars, Hash),
 1327    atom_concat('__aux_meta_call_', Hash, AuxName),
 1328    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn), []),
 1329    length(HeadVars, Arity),
 1330    (   Arity > 256                 % avoid 1024 arity limit
 1331    ->  HeadArgs = [v(HeadVars)]
 1332    ;   HeadArgs = HeadVars
 1333    ),
 1334    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.
 1341intersection_eq([], _, []).
 1342intersection_eq([H|T0], L, List) :-
 1343    (   member_eq(H, L)
 1344    ->  List = [H|T],
 1345        intersection_eq(T0, L, T)
 1346    ;   intersection_eq(T0, L, List)
 1347    ).
 1348
 1349member_eq(E, [H|T]) :-
 1350    (   E == H
 1351    ->  true
 1352    ;   member_eq(E, T)
 1353    ).
 1354
 1355                 /*******************************
 1356                 *            RENAMING          *
 1357                 *******************************/
 1358
 1359:- multifile
 1360    prolog:rename_predicate/2. 1361
 1362rename(Var, Var) :-
 1363    var(Var),
 1364    !.
 1365rename(end_of_file, end_of_file) :- !.
 1366rename(Terms0, Terms) :-
 1367    is_list(Terms0),
 1368    !,
 1369    '$current_source_module'(M),
 1370    rename_preds(Terms0, Terms, M).
 1371rename(Term0, Term) :-
 1372    '$current_source_module'(M),
 1373    rename(Term0, Term, M),
 1374    !.
 1375rename(Term, Term).
 1376
 1377rename_preds([], [], _).
 1378rename_preds([H0|T0], [H|T], M) :-
 1379    (   rename(H0, H, M)
 1380    ->  true
 1381    ;   H = H0
 1382    ),
 1383    rename_preds(T0, T, M).
 1384
 1385rename(Var, Var, _) :-
 1386    var(Var),
 1387    !.
 1388rename(M:Term0, M:Term, M0) :-
 1389    !,
 1390    (   M = '$source_location'(_File, _Line)
 1391    ->  rename(Term0, Term, M0)
 1392    ;   rename(Term0, Term, M)
 1393    ).
 1394rename((Head0 :- Body), (Head :- Body), M) :-
 1395    !,
 1396    rename_head(Head0, Head, M).
 1397rename((:-_), _, _) :-
 1398    !,
 1399    fail.
 1400rename(Head0, Head, M) :-
 1401    rename_head(Head0, Head, M).
 1402
 1403rename_head(Var, Var, _) :-
 1404    var(Var),
 1405    !.
 1406rename_head(M:Term0, M:Term, _) :-
 1407    !,
 1408    rename_head(Term0, Term, M).
 1409rename_head(Head0, Head, M) :-
 1410    prolog:rename_predicate(M:Head0, M:Head).
 1411
 1412
 1413                 /*******************************
 1414                 *      :- IF ... :- ENDIF      *
 1415                 *******************************/
 1416
 1417:- thread_local
 1418    '$include_code'/3. 1419
 1420'$including' :-
 1421    '$include_code'(X, _, _),
 1422    !,
 1423    X == true.
 1424'$including'.
 1425
 1426cond_compilation((:- if(G)), []) :-
 1427    source_location(File, Line),
 1428    (   '$including'
 1429    ->  (   catch('$eval_if'(G), E, (print_message(error, E), fail))
 1430        ->  asserta('$include_code'(true, File, Line))
 1431        ;   asserta('$include_code'(false, File, Line))
 1432        )
 1433    ;   asserta('$include_code'(else_false, File, Line))
 1434    ).
 1435cond_compilation((:- elif(G)), []) :-
 1436    source_location(File, Line),
 1437    (   clause('$include_code'(Old, OF, _), _, Ref)
 1438    ->  same_source(File, OF, elif),
 1439        erase(Ref),
 1440        (   Old == true
 1441        ->  asserta('$include_code'(else_false, File, Line))
 1442        ;   Old == false,
 1443            catch('$eval_if'(G), E, (print_message(error, E), fail))
 1444        ->  asserta('$include_code'(true, File, Line))
 1445        ;   asserta('$include_code'(Old, File, Line))
 1446        )
 1447    ;   throw(error(conditional_compilation_error(no_if, elif), _))
 1448    ).
 1449cond_compilation((:- else), []) :-
 1450    source_location(File, Line),
 1451    (   clause('$include_code'(X, OF, _), _, Ref)
 1452    ->  same_source(File, OF, else),
 1453        erase(Ref),
 1454        (   X == true
 1455        ->  X2 = false
 1456        ;   X == false
 1457        ->  X2 = true
 1458        ;   X2 = X
 1459        ),
 1460        asserta('$include_code'(X2, File, Line))
 1461    ;   throw(error(conditional_compilation_error(no_if, else), _))
 1462    ).
 1463cond_compilation(end_of_file, end_of_file) :-   % TBD: Check completeness
 1464    !,
 1465    source_location(File, _),
 1466    (   clause('$include_code'(_, OF, OL), _)
 1467    ->  (   File == OF
 1468        ->  throw(error(conditional_compilation_error(
 1469                            unterminated,OF:OL), _))
 1470        ;   true
 1471        )
 1472    ;   true
 1473    ).
 1474cond_compilation((:- endif), []) :-
 1475    !,
 1476    source_location(File, _),
 1477    (   (   clause('$include_code'(_, OF, _), _, Ref)
 1478        ->  same_source(File, OF, endif),
 1479            erase(Ref)
 1480        )
 1481    ->  true
 1482    ;   throw(error(conditional_compilation_error(no_if, endif), _))
 1483    ).
 1484cond_compilation(_, []) :-
 1485    \+ '$including'.
 1486
 1487same_source(File, File, _) :- !.
 1488same_source(_,    _,    Op) :-
 1489    throw(error(conditional_compilation_error(no_if, Op), _)).
 1490
 1491
 1492'$eval_if'(G) :-
 1493    expand_goal(G, G2),
 1494    '$current_source_module'(Module),
 1495    Module:G2