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    prepare_directive(Term),
  113    '$def_modules'([term_expansion/4,term_expansion/2], MList),
  114    call_term_expansion(MList, Term, Pos0, Term1, Pos1),
  115    expand_terms(expand_term_2, Term1, Pos1, Term2, Pos),
  116    rename(Term2, Expanded),
  117    b_setval('$term', []).
 prepare_directive(+Directive) is det
Try to autoload goals associated with a directive such that we can allow for term expansion of autoloaded directives such as setting/4. Trying to do so shall raise no errors nor fail as the directive may be further expanded.
  126prepare_directive((:- Directive)) :-
  127    '$current_source_module'(M),
  128    prepare_directive(Directive, M),
  129    !.
  130prepare_directive(_).
  131
  132prepare_directive(Goal, _) :-
  133    \+ callable(Goal),
  134    !.
  135prepare_directive((A,B), Module) :-
  136    !,
  137    prepare_directive(A, Module),
  138    prepare_directive(B, Module).
  139prepare_directive(module(_,_), _) :- !.
  140prepare_directive(Goal, Module) :-
  141    '$get_predicate_attribute'(Module:Goal, defined, 1),
  142    !.
  143prepare_directive(Goal, Module) :-
  144    \+ current_prolog_flag(autoload, false),
  145    (   compound(Goal)
  146    ->  compound_name_arity(Goal, Name, Arity)
  147    ;   Name = Goal, Arity = 0
  148    ),
  149    '$autoload'(Module:Name/Arity),
  150    !.
  151prepare_directive(_, _).
  152
  153
  154call_term_expansion([], Term, Pos, Term, Pos).
  155call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  156    current_prolog_flag(sandboxed_load, false),
  157    !,
  158    (   '$member'(Pred, Preds),
  159        (   Pred == term_expansion/2
  160        ->  M:term_expansion(Term0, Term1),
  161            Pos1 = Pos0
  162        ;   M:term_expansion(Term0, Pos0, Term1, Pos1)
  163        )
  164    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  165    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  166    ).
  167call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  168    (   '$member'(Pred, Preds),
  169        (   Pred == term_expansion/2
  170        ->  allowed_expansion(M:term_expansion(Term0, Term1)),
  171            call(M:term_expansion(Term0, Term1)),
  172            Pos1 = Pos
  173        ;   allowed_expansion(M:term_expansion(Term0, Pos0, Term1, Pos1)),
  174            call(M:term_expansion(Term0, Pos0, Term1, Pos1))
  175        )
  176    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  177    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  178    ).
  179
  180expand_term_2((Head --> Body), Pos0, Expanded, Pos) :-
  181    dcg_translate_rule((Head --> Body), Pos0, Expanded0, Pos1),
  182    !,
  183    expand_bodies(Expanded0, Pos1, Expanded1, Pos),
  184    non_terminal_decl(Expanded1, Expanded).
  185expand_term_2(Term0, Pos0, Term, Pos) :-
  186    nonvar(Term0),
  187    !,
  188    expand_bodies(Term0, Pos0, Term, Pos).
  189expand_term_2(Term, Pos, Term, Pos).
  190
  191non_terminal_decl(Clause, Decl) :-
  192    \+ current_prolog_flag(xref, true),
  193    clause_head(Clause, Head),
  194    '$current_source_module'(M),
  195    (   '$get_predicate_attribute'(M:Head, non_terminal, NT)
  196    ->  NT == 0
  197    ;   true
  198    ),
  199    !,
  200    '$pi_head'(PI, Head),
  201    Decl = [:-(non_terminal(M:PI)), Clause].
  202non_terminal_decl(Clause, Clause).
  203
  204clause_head(Head:-_, Head) :- !.
  205clause_head(Head, Head).
 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.
  216expand_bodies(Terms, Pos0, Out, Pos) :-
  217    '$def_modules'([goal_expansion/4,goal_expansion/2], MList),
  218    expand_terms(expand_body(MList), Terms, Pos0, Out, Pos),
  219    remove_attributes(Out, '$var_info').
  220
  221expand_body(MList, (Head0 :- Body), Pos0, (Head :- ExpandedBody), Pos) :-
  222    !,
  223    term_variables(Head0, HVars),
  224    mark_vars_non_fresh(HVars),
  225    f2_pos(Pos0, HPos, BPos0, Pos, HPos, BPos),
  226    expand_goal(Body, BPos0, ExpandedBody0, BPos, MList, (Head0 :- Body)),
  227    (   compound(Head0),
  228        '$current_source_module'(M),
  229        replace_functions(Head0, Eval, Head, M),
  230        Eval \== true
  231    ->  ExpandedBody = (Eval,ExpandedBody0)
  232    ;   Head = Head0,
  233        ExpandedBody = ExpandedBody0
  234    ).
  235expand_body(MList, (:- Body), Pos0, (:- ExpandedBody), Pos) :-
  236    !,
  237    f1_pos(Pos0, BPos0, Pos, BPos),
  238    expand_goal(Body, BPos0, ExpandedBody, BPos, MList, (:- Body)).
  239
  240expand_body(_MList, Head0, Pos, Clause, Pos) :- % TBD: Position handling
  241    compound(Head0),
  242    '$current_source_module'(M),
  243    replace_functions(Head0, Eval, Head, M),
  244    Eval \== true,
  245    !,
  246    Clause = (Head :- Eval).
  247expand_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.
  257expand_terms(_, X, P, X, P) :-
  258    var(X),
  259    !.
  260expand_terms(C, List0, Pos0, List, Pos) :-
  261    nonvar(List0),
  262    List0 = [_|_],
  263    !,
  264    (   is_list(List0)
  265    ->  list_pos(Pos0, Elems0, Pos, Elems),
  266        expand_term_list(C, List0, Elems0, List, Elems)
  267    ;   '$type_error'(list, List0)
  268    ).
  269expand_terms(C, '$source_location'(File, Line):Clause0, Pos0, Clause, Pos) :-
  270    !,
  271    expand_terms(C, Clause0, Pos0, Clause1, Pos),
  272    add_source_location(Clause1, '$source_location'(File, Line), Clause).
  273expand_terms(C, Term0, Pos0, Term, Pos) :-
  274    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.
  281add_source_location(Clauses0, SrcLoc, Clauses) :-
  282    (   is_list(Clauses0)
  283    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  284    ;   Clauses = SrcLoc:Clauses0
  285    ).
  286
  287add_source_location_list([], _, []).
  288add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  289    add_source_location_list(Clauses0, SrcLoc, Clauses).
 expand_term_list(:Expander, +TermList, +Pos, -NewTermList, -PosList)
  293expand_term_list(_, [], _, [], []) :- !.
  294expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  295    !,
  296    expand_terms(C, H0, PH0, H, PH),
  297    add_term(H, PH, Terms, TT, PosL, PT),
  298    expand_term_list(C, T0, [PH0], TT, PT).
  299expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  300    !,
  301    expand_terms(C, H0, PH0, H, PH),
  302    add_term(H, PH, Terms, TT, PosL, PT),
  303    expand_term_list(C, T0, PT0, TT, PT).
  304expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  305    expected_layout(list, PH0),
  306    expand_terms(C, H0, PH0, H, PH),
  307    add_term(H, PH, Terms, TT, PosL, PT),
  308    expand_term_list(C, T0, [PH0], TT, PT).
 add_term(+ExpandOut, ?ExpandPosOut, -Terms, ?TermsT, -PosL, ?PosLT)
  312add_term(List, Pos, Terms, TermT, PosL, PosT) :-
  313    nonvar(List), List = [_|_],
  314    !,
  315    (   is_list(List)
  316    ->  append_tp(List, Terms, TermT, Pos, PosL, PosT)
  317    ;   '$type_error'(list, List)
  318    ).
  319add_term(Term, Pos, [Term|Terms], Terms, [Pos|PosT], PosT).
  320
  321append_tp([], Terms, Terms, _, PosL, PosL).
  322append_tp([H|T0], [H|T1], Terms, [HP], [HP|TP1], PosL) :-
  323    !,
  324    append_tp(T0, T1, Terms, [HP], TP1, PosL).
  325append_tp([H|T0], [H|T1], Terms, [HP0|TP0], [HP0|TP1], PosL) :-
  326    !,
  327    append_tp(T0, T1, Terms, TP0, TP1, PosL).
  328append_tp([H|T0], [H|T1], Terms, Pos, [Pos|TP1], PosL) :-
  329    expected_layout(list, Pos),
  330    append_tp(T0, T1, Terms, [Pos], TP1, PosL).
  331
  332
  333list_pos(Var, _, _, _) :-
  334    var(Var),
  335    !.
  336list_pos(list_position(F,T,Elems0,none), Elems0,
  337         list_position(F,T,Elems,none),  Elems).
  338list_pos(Pos, [Pos], Elems, Elems).
  339
  340
  341                 /*******************************
  342                 *      VAR_INFO/3 SUPPORT      *
  343                 *******************************/
 var_intersection(+List1, +List2, -Shared) is det
Shared is the ordered intersection of List1 and List2.
  349var_intersection(List1, List2, Intersection) :-
  350    sort(List1, Set1),
  351    sort(List2, Set2),
  352    ord_intersection(Set1, Set2, Intersection).
 ord_intersection(+OSet1, +OSet2, -Int)
Ordered list intersection. Copied from the library.
  358ord_intersection([], _Int, []).
  359ord_intersection([H1|T1], L2, Int) :-
  360    isect2(L2, H1, T1, Int).
  361
  362isect2([], _H1, _T1, []).
  363isect2([H2|T2], H1, T1, Int) :-
  364    compare(Order, H1, H2),
  365    isect3(Order, H1, T1, H2, T2, Int).
  366
  367isect3(<, _H1, T1,  H2, T2, Int) :-
  368    isect2(T1, H2, T2, Int).
  369isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  370    ord_intersection(T1, T2, Int).
  371isect3(>, H1, T1,  _H2, T2, Int) :-
  372    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.
  383merge_variable_info([]).
  384merge_variable_info([Var=State|States]) :-
  385    (   get_attr(Var, '$var_info', CurrentState)
  386    ->  true
  387    ;   CurrentState = (-)
  388    ),
  389    merge_states(Var, State, CurrentState),
  390    merge_variable_info(States).
  391
  392merge_states(_Var, State, State) :- !.
  393merge_states(_Var, -, _) :- !.
  394merge_states(Var, State, -) :-
  395    !,
  396    put_attr(Var, '$var_info', State).
  397merge_states(Var, Left, Right) :-
  398    (   get_dict(fresh, Left, false)
  399    ->  put_dict(fresh, Right, false)
  400    ;   get_dict(fresh, Right, false)
  401    ->  put_dict(fresh, Left, false)
  402    ),
  403    !,
  404    (   Left >:< Right
  405    ->  put_dict(Left, Right, State),
  406        put_attr(Var, '$var_info', State)
  407    ;   print_message(warning,
  408                      inconsistent_variable_properties(Left, Right)),
  409        put_dict(Left, Right, State),
  410        put_attr(Var, '$var_info', State)
  411    ).
  412
  413
  414save_variable_info([], []).
  415save_variable_info([Var|Vars], [Var=State|States]):-
  416    (   get_attr(Var, '$var_info', State)
  417    ->  true
  418    ;   State = (-)
  419    ),
  420    save_variable_info(Vars, States).
  421
  422restore_variable_info([]).
  423restore_variable_info([Var=State|States]) :-
  424    (   State == (-)
  425    ->  del_attr(Var, '$var_info')
  426    ;   put_attr(Var, '$var_info', State)
  427    ),
  428    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.
  444var_property(Var, Property) :-
  445    prop_var(Property, Var).
  446
  447prop_var(fresh(Fresh), Var) :-
  448    (   get_attr(Var, '$var_info', Info),
  449        get_dict(fresh, Info, Fresh0)
  450    ->  Fresh = Fresh0
  451    ;   Fresh = true
  452    ).
  453prop_var(singleton(Singleton), Var) :-
  454    nb_current('$term', Term),
  455    term_singletons(Term, Singletons),
  456    (   '$member'(V, Singletons),
  457        V == Var
  458    ->  Singleton = true
  459    ;   Singleton = false
  460    ).
  461prop_var(name(Name), Var) :-
  462    (   nb_current('$variable_names', Bindings),
  463        '$member'(Name0=Var0, Bindings),
  464        Var0 == Var
  465    ->  Name = Name0
  466    ).
  467
  468
  469mark_vars_non_fresh([]) :- !.
  470mark_vars_non_fresh([Var|Vars]) :-
  471    (   get_attr(Var, '$var_info', Info)
  472    ->  (   get_dict(fresh, Info, false)
  473        ->  true
  474        ;   put_dict(fresh, Info, false, Info1),
  475            put_attr(Var, '$var_info', Info1)
  476        )
  477    ;   put_attr(Var, '$var_info', '$var_info'{fresh:false})
  478    ),
  479    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.
  490remove_attributes(Term, Attr) :-
  491    term_variables(Term, Vars),
  492    remove_var_attr(Vars, Attr).
  493
  494remove_var_attr([], _):- !.
  495remove_var_attr([Var|Vars], Attr):-
  496    del_attr(Var, Attr),
  497    remove_var_attr(Vars, Attr).
 $var_info:attr_unify_hook(_, _) is det
Dummy unification hook for attributed variables. Just succeeds.
  503'$var_info':attr_unify_hook(_, _).
  504
  505
  506                 /*******************************
  507                 *   GOAL_EXPANSION/2 SUPPORT   *
  508                 *******************************/
 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.
  516expand_goal(A, B) :-
  517    expand_goal(A, _, B, _).
  518
  519expand_goal(A, P0, B, P) :-
  520    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  521    (   expand_goal(A, P0, B, P, MList, _)
  522    ->  remove_attributes(B, '$var_info'), A \== B
  523    ),
  524    !.
  525expand_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.
  534'$expand_closure'(G0, N, G) :-
  535    '$expand_closure'(G0, _, N, G, _).
  536
  537'$expand_closure'(G0, P0, N, G, P) :-
  538    length(Ex, N),
  539    mark_vars_non_fresh(Ex),
  540    extend_arg_pos(G0, P0, Ex, G1, P1),
  541    expand_goal(G1, P1, G2, P2),
  542    term_variables(G0, VL),
  543    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  544
  545
  546expand_goal(G0, P0, G, P, MList, Term) :-
  547    '$current_source_module'(M),
  548    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
  558% (*)   This is needed because call_goal_expansion may introduce extra
  559%       context variables.  Consider the code below, where the variable
  560%       E is introduced.  Is there a better representation for the
  561%       context?
  562%
  563%         ==
  564%         goal_expansion(catch_and_print(Goal), catch(Goal, E, print(E))).
  565%
  566%         test :-
  567%               catch_and_print(true).
  568%         ==
  569
  570expand_goal(G, P, G, P, _, _, _, _) :-
  571    var(G),
  572    !.
  573expand_goal(M:G, P, M:G, P, _M, _MList, _Term, _) :-
  574    var(M), var(G),
  575    !.
  576expand_goal(M:G, P0, M:EG, P, _M, _MList, Term, Done) :-
  577    atom(M),
  578    !,
  579    f2_pos(P0, PA, PB0, P, PA, PB),
  580    '$def_modules'(M:[goal_expansion/4,goal_expansion/2], MList),
  581    setup_call_cleanup(
  582        '$set_source_module'(Old, M),
  583        '$expand':expand_goal(G, PB0, EG, PB, M, MList, Term, Done),
  584        '$set_source_module'(Old)).
  585expand_goal(G0, P0, G, P, M, MList, Term, Done) :-
  586    (   already_expanded(G0, Done, Done1)
  587    ->  expand_control(G0, P0, G, P, M, MList, Term, Done1)
  588    ;   call_goal_expansion(MList, G0, P0, G1, P1)
  589    ->  expand_goal(G1, P1, G, P, M, MList, Term/G1, [G0|Done])      % (*)
  590    ;   expand_control(G0, P0, G, P, M, MList, Term, Done)
  591    ).
  592
  593expand_control((A,B), P0, Conj, P, M, MList, Term, Done) :-
  594    !,
  595    f2_pos(P0, PA0, PB0, P1, PA, PB),
  596    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  597    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  598    simplify((EA,EB), P1, Conj, P).
  599expand_control((A;B), P0, Or, P, M, MList, Term, Done) :-
  600    !,
  601    f2_pos(P0, PA0, PB0, P1, PA1, PB),
  602    term_variables(A, AVars),
  603    term_variables(B, BVars),
  604    var_intersection(AVars, BVars, SharedVars),
  605    save_variable_info(SharedVars, SavedState),
  606    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  607    save_variable_info(SharedVars, SavedState2),
  608    restore_variable_info(SavedState),
  609    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  610    merge_variable_info(SavedState2),
  611    fixup_or_lhs(A, EA, PA, EA1, PA1),
  612    simplify((EA1;EB), P1, Or, P).
  613expand_control((A->B), P0, Goal, P, M, MList, Term, Done) :-
  614    !,
  615    f2_pos(P0, PA0, PB0, P1, PA, PB),
  616    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  617    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  618    simplify((EA->EB), P1, Goal, P).
  619expand_control((A*->B), P0, Goal, P, M, MList, Term, Done) :-
  620    !,
  621    f2_pos(P0, PA0, PB0, P1, PA, PB),
  622    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  623    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  624    simplify((EA*->EB), P1, Goal, P).
  625expand_control((\+A), P0, Goal, P, M, MList, Term, Done) :-
  626    !,
  627    f1_pos(P0, PA0, P1, PA),
  628    term_variables(A, AVars),
  629    save_variable_info(AVars, SavedState),
  630    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  631    restore_variable_info(SavedState),
  632    simplify(\+(EA), P1, Goal, P).
  633expand_control(call(A), P0, call(EA), P, M, MList, Term, Done) :-
  634    !,
  635    f1_pos(P0, PA0, P, PA),
  636    expand_goal(A, PA0, EA, PA, M, MList, Term, Done).
  637expand_control(G0, P0, G, P, M, MList, Term, Done) :-
  638    is_meta_call(G0, M, Head),
  639    !,
  640    term_variables(G0, Vars),
  641    mark_vars_non_fresh(Vars),
  642    expand_meta(Head, G0, P0, G, P, M, MList, Term, Done).
  643expand_control(G0, P0, G, P, M, MList, Term, _Done) :-
  644    term_variables(G0, Vars),
  645    mark_vars_non_fresh(Vars),
  646    expand_functions(G0, P0, G, P, M, MList, Term).
 already_expanded(+Goal, +Done, -RestDone) is semidet
  650already_expanded(Goal, Done, Done1) :-
  651    '$select'(G, Done, Done1),
  652    G == Goal,
  653    !.
 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)
  662fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  663    nonvar(Old),
  664    nonvar(New),
  665    (   Old = (_ -> _)
  666    ->  New \= (_ -> _),
  667        Fix = (New -> true)
  668    ;   New = (_ -> _),
  669        Fix = (New, true)
  670    ),
  671    !,
  672    lhs_pos(PNew, PFixed).
  673fixup_or_lhs(_Old, New, P, New, P).
  674
  675lhs_pos(P0, _) :-
  676    var(P0),
  677    !.
  678lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  679    arg(1, P0, F),
  680    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.
  687is_meta_call(G0, M, Head) :-
  688    compound(G0),
  689    default_module(M, M2),
  690    '$c_current_predicate'(_, M2:G0),
  691    !,
  692    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  693    has_meta_arg(Head).
 expand_meta(+MetaSpec, +G0, ?P0, -G, -P, +M, +Mlist, +Term, +Done)
  698expand_meta(Spec, G0, P0, G, P, M, MList, Term, Done) :-
  699    functor(Spec, _, Arity),
  700    functor(G0, Name, Arity),
  701    functor(G1, Name, Arity),
  702    f_pos(P0, ArgPos0, P, ArgPos),
  703    expand_meta(1, Arity, Spec,
  704                G0, ArgPos0, Eval,
  705                G1,  ArgPos,
  706                M, MList, Term, Done),
  707    conj(Eval, G1, G).
  708
  709expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, G, [P|PT], M, MList, Term, Done) :-
  710    I =< Arity,
  711    !,
  712    arg_pos(ArgPos0, P0, PT0),
  713    arg(I, Spec, Meta),
  714    arg(I, G0, A0),
  715    arg(I, G, A),
  716    expand_meta_arg(Meta, A0, P0, EvalA, A, P, M, MList, Term, Done),
  717    I2 is I + 1,
  718    expand_meta(I2, Arity, Spec, G0, PT0, EvalB, G, PT, M, MList, Term, Done),
  719    conj(EvalA, EvalB, Eval).
  720expand_meta(_, _, _, _, _, true, _, [], _, _, _, _).
  721
  722arg_pos(List, _, _) :- var(List), !.    % no position info
  723arg_pos([H|T], H, T) :- !.              % argument list
  724arg_pos([], _, []).                     % new has more
  725
  726mapex([], _).
  727mapex([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.
  734extended_pos(Var, _, Var) :-
  735    var(Var),
  736    !.
  737extended_pos(parentheses_term_position(O,C,Pos0),
  738             N,
  739             parentheses_term_position(O,C,Pos)) :-
  740    !,
  741    extended_pos(Pos0, N, Pos).
  742extended_pos(term_position(F,T,FF,FT,Args),
  743             _,
  744             term_position(F,T,FF,FT,Args)) :-
  745    var(Args),
  746    !.
  747extended_pos(term_position(F,T,FF,FT,Args0),
  748             N,
  749             term_position(F,T,FF,FT,Args)) :-
  750    length(Ex, N),
  751    mapex(Ex, T-T),
  752    '$append'(Args0, Ex, Args),
  753    !.
  754extended_pos(F-T,
  755             N,
  756             term_position(F,T,F,T,Ex)) :-
  757    !,
  758    length(Ex, N),
  759    mapex(Ex, T-T).
  760extended_pos(Pos, N, Pos) :-
  761    '$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.
  772expand_meta_arg(0, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  773    !,
  774    expand_goal(A0, PA0, A1, PA, M, MList, Term, Done),
  775    compile_meta_call(A1, A, M, Term).
  776expand_meta_arg(N, A0, P0, true, A, P, M, MList, Term, Done) :-
  777    integer(N), callable(A0),
  778    replace_functions(A0, true, _, M),
  779    !,
  780    length(Ex, N),
  781    mark_vars_non_fresh(Ex),
  782    extend_arg_pos(A0, P0, Ex, A1, PA1),
  783    expand_goal(A1, PA1, A2, PA2, M, MList, Term, Done),
  784    compile_meta_call(A2, A3, M, Term),
  785    term_variables(A0, VL),
  786    remove_arg_pos(A3, PA2, M, VL, Ex, A, P).
  787expand_meta_arg(^, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  788    replace_functions(A0, true, _, M),
  789    !,
  790    expand_setof_goal(A0, PA0, A, PA, M, MList, Term, Done).
  791expand_meta_arg(S, A0, _PA0, Eval, A, _PA, M, _MList, _Term, _Done) :-
  792    replace_functions(A0, Eval, A, M), % TBD: pass positions
  793    (   Eval == true
  794    ->  true
  795    ;   same_functor(A0, A)
  796    ->  true
  797    ;   meta_arg(S)
  798    ->  throw(error(context_error(function, meta_arg(S)), _))
  799    ;   true
  800    ).
  801
  802same_functor(T1, T2) :-
  803    compound(T1),
  804    !,
  805    compound(T2),
  806    compound_name_arity(T1, N, A),
  807    compound_name_arity(T2, N, A).
  808same_functor(T1, T2) :-
  809    atom(T1),
  810    T1 == T2.
  811
  812variant_sha1_nat(Term, Hash) :-
  813    copy_term_nat(Term, TNat),
  814    variant_sha1(TNat, Hash).
  815
  816wrap_meta_arguments(A0, M, VL, Ex, A) :-
  817    '$append'(VL, Ex, AV),
  818    variant_sha1_nat(A0+AV, Hash),
  819    atom_concat('__aux_wrapper_', Hash, AuxName),
  820    H =.. [AuxName|AV],
  821    compile_auxiliary_clause(M, (H :- A0)),
  822    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.
  829extend_arg_pos(A, P, _, A, P) :-
  830    var(A),
  831    !.
  832extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  833    !,
  834    f2_pos(P0, PM, PA0, P, PM, PA),
  835    extend_arg_pos(A0, PA0, Ex, A, PA).
  836extend_arg_pos(A0, P0, Ex, A, P) :-
  837    callable(A0),
  838    !,
  839    extend_term(A0, Ex, A),
  840    length(Ex, N),
  841    extended_pos(P0, N, P).
  842extend_arg_pos(A, P, _, A, P).
  843
  844extend_term(Atom, Extra, Term) :-
  845    atom(Atom),
  846    !,
  847    Term =.. [Atom|Extra].
  848extend_term(Term0, Extra, Term) :-
  849    compound_name_arguments(Term0, Name, Args0),
  850    '$append'(Args0, Extra, Args),
  851    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
  862remove_arg_pos(A, P, _, _, _, A, P) :-
  863    var(A),
  864    !.
  865remove_arg_pos(M:A0, P0, _, VL, Ex, M:A, P) :-
  866    !,
  867    f2_pos(P, PM, PA0, P0, PM, PA),
  868    remove_arg_pos(A0, PA, M, VL, Ex, A, PA0).
  869remove_arg_pos(A0, P0, M, VL, Ex0, A, P) :-
  870    callable(A0),
  871    !,
  872    length(Ex0, N),
  873    (   A0 =.. [F|Args],
  874        length(Ex, N),
  875        '$append'(Args0, Ex, Args),
  876        Ex==Ex0
  877    ->  extended_pos(P, N, P0),
  878        A =.. [F|Args0]
  879    ;   M \== [],
  880        wrap_meta_arguments(A0, M, VL, Ex0, A),
  881        wrap_meta_pos(P0, P)
  882    ).
  883remove_arg_pos(A, P, _, _, _, A, P).
  884
  885wrap_meta_pos(P0, P) :-
  886    (   nonvar(P0)
  887    ->  P = term_position(F,T,_,_,_),
  888        atomic_pos(P0, F-T)
  889    ;   true
  890    ).
  891
  892has_meta_arg(Head) :-
  893    arg(_, Head, Arg),
  894    direct_call_meta_arg(Arg),
  895    !.
  896
  897direct_call_meta_arg(I) :- integer(I).
  898direct_call_meta_arg(^).
  899
  900meta_arg(:).
  901meta_arg(//).
  902meta_arg(I) :- integer(I).
  903
  904expand_setof_goal(Var, Pos, Var, Pos, _, _, _, _) :-
  905    var(Var),
  906    !.
  907expand_setof_goal(V^G, P0, V^EG, P, M, MList, Term, Done) :-
  908    !,
  909    f2_pos(P0, PA0, PB, P, PA, PB),
  910    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  911expand_setof_goal(M0:G, P0, M0:EG, P, M, MList, Term, Done) :-
  912    !,
  913    f2_pos(P0, PA0, PB, P, PA, PB),
  914    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  915expand_setof_goal(G, P0, EG, P, M, MList, Term, Done) :-
  916    !,
  917    expand_goal(G, P0, EG0, P, M, MList, Term, Done),
  918    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.
  929call_goal_expansion(MList, G0, P0, G, P) :-
  930    current_prolog_flag(sandboxed_load, false),
  931    !,
  932    (   '$member'(M-Preds, MList),
  933        '$member'(Pred, Preds),
  934        (   Pred == goal_expansion/4
  935        ->  M:goal_expansion(G0, P0, G, P)
  936        ;   M:goal_expansion(G0, G),
  937            P = P0
  938        ),
  939        G0 \== G
  940    ->  true
  941    ).
  942call_goal_expansion(MList, G0, P0, G, P) :-
  943    (   '$member'(M-Preds, MList),
  944        '$member'(Pred, Preds),
  945        (   Pred == goal_expansion/4
  946        ->  Expand = M:goal_expansion(G0, P0, G, P)
  947        ;   Expand = M:goal_expansion(G0, G)
  948        ),
  949        allowed_expansion(Expand),
  950        call(Expand),
  951        G0 \== G
  952    ->  true
  953    ).
 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.
  963:- multifile
  964    prolog:sandbox_allowed_expansion/1.  965
  966allowed_expansion(QGoal) :-
  967    strip_module(QGoal, M, Goal),
  968    E = error(Formal,_),
  969    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
  970    (   var(Formal)
  971    ->  fail
  972    ;   !,
  973        print_message(error, E),
  974        fail
  975    ).
  976allowed_expansion(_).
  977
  978
  979                 /*******************************
  980                 *      FUNCTIONAL NOTATION     *
  981                 *******************************/
 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.
  990expand_functions(G0, P0, G, P, M, MList, Term) :-
  991    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
  992    (   expand_arithmetic(G1, P1, G, P, Term)
  993    ->  true
  994    ;   G = G1,
  995        P = P1
  996    ).
 expand_functional_notation(+G0, +P0, -G, -P, +M, +MList, +Term) is det
To be done
- : position logic
- : make functions module-local
 1003expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
 1004    contains_functions(G0),
 1005    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
 1006    Eval \== true,
 1007    !,
 1008    wrap_var(G1, G1Pos, G2, G2Pos),
 1009    conj(Eval, EvalPos, G2, G2Pos, G, P).
 1010expand_functional_notation(G, P, G, P, _, _, _).
 1011
 1012wrap_var(G, P, G, P) :-
 1013    nonvar(G),
 1014    !.
 1015wrap_var(G, P0, call(G), P) :-
 1016    (   nonvar(P0)
 1017    ->  P = term_position(F,T,F,T,[P0]),
 1018        atomic_pos(P0, F-T)
 1019    ;   true
 1020    ).
 contains_functions(@Term) is semidet
True when Term contains a function reference.
 1026contains_functions(Term) :-
 1027    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1028            (   contains_functions2(Skeleton)
 1029            ;   contains_functions2(Assignments)
 1030            )).
 1031
 1032contains_functions2(Term) :-
 1033    compound(Term),
 1034    (   function(Term, _)
 1035    ->  true
 1036    ;   arg(_, Term, Arg),
 1037        contains_functions2(Arg)
 1038    ->  true
 1039    ).
 replace_functions(+GoalIn, +PosIn, -Eval, -EvalPos, -GoalOut, -PosOut, +ContextTerm) is det
To be done
- Proper propagation of list, dict and brace term positions.
 1048:- public
 1049    replace_functions/4.            % used in dicts.pl
 1050
 1051replace_functions(GoalIn, Eval, GoalOut, Context) :-
 1052    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
 1053
 1054replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
 1055    var(Var),
 1056    !.
 1057replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
 1058    function(F, Ctx),
 1059    !,
 1060    compound_name_arity(F, Name, Arity),
 1061    PredArity is Arity+1,
 1062    compound_name_arity(G, Name, PredArity),
 1063    arg(PredArity, G, Var),
 1064    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1065    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1066    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1067replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1068    compound(Term0),
 1069    !,
 1070    compound_name_arity(Term0, Name, Arity),
 1071    compound_name_arity(Term, Name, Arity),
 1072    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1073    map_functions(0, Arity,
 1074                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1075replace_functions(Term, Pos, true, _, Term, Pos, _).
 map_functions(+Arg, +Arity, +TermIn, +ArgInPos, -Term, -ArgPos, -Eval, -EvalPos, +Context)
 1082map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1083    !,
 1084    pos_nil(LPos0, LPos).
 1085map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1086    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1087    I is I0+1,
 1088    arg(I, Term0, Arg0),
 1089    arg(I, Term, Arg),
 1090    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1091    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1092    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1093
 1094conj(true, X, X) :- !.
 1095conj(X, true, X) :- !.
 1096conj(X, Y, (X,Y)).
 1097
 1098conj(true, _, X, P, X, P) :- !.
 1099conj(X, P, true, _, X, P) :- !.
 1100conj(X, PX, Y, PY, (X,Y), _) :-
 1101    var(PX), var(PY),
 1102    !.
 1103conj(X, PX, Y, PY, (X,Y), P) :-
 1104    P = term_position(F,T,FF,FT,[PX,PY]),
 1105    atomic_pos(PX, F-FF),
 1106    atomic_pos(PY, FT-T).
 function(?Term, +Context)
True if function expansion needs to be applied for the given term.
 1113function(.(_,_), _) :- \+ functor([_|_], ., _).
 1114
 1115
 1116                 /*******************************
 1117                 *          ARITHMETIC          *
 1118                 *******************************/
 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.
 1128expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1129
 1130
 1131                 /*******************************
 1132                 *        POSITION LOGIC        *
 1133                 *******************************/
 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.
 1143f2_pos(Var, _, _, _, _, _) :-
 1144    var(Var),
 1145    !.
 1146f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1147       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1148f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1149       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1150    !,
 1151    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1152f2_pos(Pos, _, _, _, _, _) :-
 1153    expected_layout(f2, Pos).
 1154
 1155f1_pos(Var, _, _, _) :-
 1156    var(Var),
 1157    !.
 1158f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1159       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1160f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1161       parentheses_term_position(O,C,Pos),  A1) :-
 1162    !,
 1163    f1_pos(Pos0, A10, Pos, A1).
 1164f1_pos(Pos, _, _, _) :-
 1165    expected_layout(f1, Pos).
 1166
 1167f_pos(Var, _, _, _) :-
 1168    var(Var),
 1169    !.
 1170f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1171      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1172f_pos(parentheses_term_position(O,C,Pos0), A10,
 1173      parentheses_term_position(O,C,Pos),  A1) :-
 1174    !,
 1175    f_pos(Pos0, A10, Pos, A1).
 1176f_pos(Pos, _, _, _) :-
 1177    expected_layout(compound, Pos).
 1178
 1179atomic_pos(Pos, _) :-
 1180    var(Pos),
 1181    !.
 1182atomic_pos(Pos, F-T) :-
 1183    arg(1, Pos, F),
 1184    arg(2, Pos, T).
 pos_nil(+Nil, -Nil) is det
 pos_list(+List0, -H0, -T0, -List, -H, -T) is det
Position propagation for lists.
 1191pos_nil(Var, _) :- var(Var), !.
 1192pos_nil([], []) :- !.
 1193pos_nil(Pos, _) :-
 1194    expected_layout(nil, Pos).
 1195
 1196pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1197pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1198pos_list(Pos, _, _, _, _, _) :-
 1199    expected_layout(list, Pos).
 extend_1_pos(+FunctionPos, -FArgPos, -EvalPos, -EArgPos, -VarPos)
Deal with extending a function to include the return value.
 1205extend_1_pos(Pos, _, _, _, _) :-
 1206    var(Pos),
 1207    !.
 1208extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1209             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1210             FT-FT1) :-
 1211    integer(FT),
 1212    !,
 1213    FT1 is FT+1,
 1214    '$same_length'(FArgPos, GArgPos0),
 1215    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1216extend_1_pos(F-T, [],
 1217             term_position(F,T,F,T,[T-T1]), [],
 1218             T-T1) :-
 1219    integer(T),
 1220    !,
 1221    T1 is T+1.
 1222extend_1_pos(Pos, _, _, _, _) :-
 1223    expected_layout(callable, Pos).
 1224
 1225'$same_length'(List, List) :-
 1226    var(List),
 1227    !.
 1228'$same_length'([], []).
 1229'$same_length'([_|T0], [_|T]) :-
 1230    '$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.
 1240:- create_prolog_flag(debug_term_position, false, []). 1241
 1242expected_layout(Expected, Pos) :-
 1243    current_prolog_flag(debug_term_position, true),
 1244    !,
 1245    '$print_message'(warning, expected_layout(Expected, Pos)).
 1246expected_layout(_, _).
 1247
 1248
 1249                 /*******************************
 1250                 *    SIMPLIFICATION ROUTINES   *
 1251                 *******************************/
 simplify(+ControlIn, +Pos0, -ControlOut, -Pos) is det
Simplify control structures
To be done
- Much more analysis
- Turn this into a separate module
 1260simplify(Control, P, Control, P) :-
 1261    current_prolog_flag(optimise, false),
 1262    !.
 1263simplify(Control, P0, Simple, P) :-
 1264    simple(Control, P0, Simple, P),
 1265    !.
 1266simplify(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.
 1275simple((X,Y), P0, Conj, P) :-
 1276    (   true(X)
 1277    ->  Conj = Y,
 1278        f2_pos(P0, _, P, _, _, _)
 1279    ;   false(X)
 1280    ->  Conj = fail,
 1281        f2_pos(P0, P1, _, _, _, _),
 1282        atomic_pos(P1, P)
 1283    ;   true(Y)
 1284    ->  Conj = X,
 1285        f2_pos(P0, P, _, _, _, _)
 1286    ).
 1287simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1288    (   true(I)                     % because nothing happens if I and T
 1289    ->  ITE = T,                    % are unbound.
 1290        f2_pos(P0, P1, _, _, _, _),
 1291        f2_pos(P1, _, P, _, _, _)
 1292    ;   false(I)
 1293    ->  ITE = E,
 1294        f2_pos(P0, _, P, _, _, _)
 1295    ).
 1296simple((X;Y), P0, Or, P) :-
 1297    false(X),
 1298    Or = Y,
 1299    f2_pos(P0, _, P, _, _, _).
 1300
 1301true(X) :-
 1302    nonvar(X),
 1303    eval_true(X).
 1304
 1305false(X) :-
 1306    nonvar(X),
 1307    eval_false(X).
 eval_true(+Goal) is semidet
 eval_false(+Goal) is semidet
 1313eval_true(true).
 1314eval_true(otherwise).
 1315
 1316eval_false(fail).
 1317eval_false(false).
 1318
 1319
 1320                 /*******************************
 1321                 *         META CALLING         *
 1322                 *******************************/
 1323
 1324:- 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.
 1330compile_meta_call(CallIn, CallIn, _, Term) :-
 1331    var(Term),
 1332    !.                   % explicit call; no context
 1333compile_meta_call(CallIn, CallIn, _, _) :-
 1334    var(CallIn),
 1335    !.
 1336compile_meta_call(CallIn, CallIn, _, _) :-
 1337    (   current_prolog_flag(compile_meta_arguments, false)
 1338    ;   current_prolog_flag(xref, true)
 1339    ),
 1340    !.
 1341compile_meta_call(CallIn, CallIn, _, _) :-
 1342    strip_module(CallIn, _, Call),
 1343    (   is_aux_meta(Call)
 1344    ;   \+ control(Call),
 1345        (   '$c_current_predicate'(_, system:Call),
 1346            \+ current_prolog_flag(compile_meta_arguments, always)
 1347        ;   current_prolog_flag(compile_meta_arguments, control)
 1348        )
 1349    ),
 1350    !.
 1351compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1352    !,
 1353    (   atom(M), callable(CallIn)
 1354    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1355    ;   CallOut = M:CallIn
 1356    ).
 1357compile_meta_call(CallIn, CallOut, Module, Term) :-
 1358    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1359    compile_auxiliary_clause(Module, Clause).
 1360
 1361compile_auxiliary_clause(Module, Clause) :-
 1362    Clause = (Head:-Body),
 1363    '$current_source_module'(SM),
 1364    (   predicate_property(SM:Head, defined)
 1365    ->  true
 1366    ;   SM == Module
 1367    ->  compile_aux_clauses([Clause])
 1368    ;   compile_aux_clauses([Head:-Module:Body])
 1369    ).
 1370
 1371control((_,_)).
 1372control((_;_)).
 1373control((_->_)).
 1374control((_*->_)).
 1375control(\+(_)).
 1376
 1377is_aux_meta(Term) :-
 1378    callable(Term),
 1379    functor(Term, Name, _),
 1380    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1381
 1382compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1383    term_variables(Term, AllVars),
 1384    term_variables(CallIn, InVars),
 1385    intersection_eq(InVars, AllVars, HeadVars),
 1386    variant_sha1(CallIn+HeadVars, Hash),
 1387    atom_concat('__aux_meta_call_', Hash, AuxName),
 1388    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn), []),
 1389    length(HeadVars, Arity),
 1390    (   Arity > 256                 % avoid 1024 arity limit
 1391    ->  HeadArgs = [v(HeadVars)]
 1392    ;   HeadArgs = HeadVars
 1393    ),
 1394    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.
 1401intersection_eq([], _, []).
 1402intersection_eq([H|T0], L, List) :-
 1403    (   member_eq(H, L)
 1404    ->  List = [H|T],
 1405        intersection_eq(T0, L, T)
 1406    ;   intersection_eq(T0, L, List)
 1407    ).
 1408
 1409member_eq(E, [H|T]) :-
 1410    (   E == H
 1411    ->  true
 1412    ;   member_eq(E, T)
 1413    ).
 1414
 1415                 /*******************************
 1416                 *            RENAMING          *
 1417                 *******************************/
 1418
 1419:- multifile
 1420    prolog:rename_predicate/2. 1421
 1422rename(Var, Var) :-
 1423    var(Var),
 1424    !.
 1425rename(end_of_file, end_of_file) :- !.
 1426rename(Terms0, Terms) :-
 1427    is_list(Terms0),
 1428    !,
 1429    '$current_source_module'(M),
 1430    rename_preds(Terms0, Terms, M).
 1431rename(Term0, Term) :-
 1432    '$current_source_module'(M),
 1433    rename(Term0, Term, M),
 1434    !.
 1435rename(Term, Term).
 1436
 1437rename_preds([], [], _).
 1438rename_preds([H0|T0], [H|T], M) :-
 1439    (   rename(H0, H, M)
 1440    ->  true
 1441    ;   H = H0
 1442    ),
 1443    rename_preds(T0, T, M).
 1444
 1445rename(Var, Var, _) :-
 1446    var(Var),
 1447    !.
 1448rename(M:Term0, M:Term, M0) :-
 1449    !,
 1450    (   M = '$source_location'(_File, _Line)
 1451    ->  rename(Term0, Term, M0)
 1452    ;   rename(Term0, Term, M)
 1453    ).
 1454rename((Head0 :- Body), (Head :- Body), M) :-
 1455    !,
 1456    rename_head(Head0, Head, M).
 1457rename((:-_), _, _) :-
 1458    !,
 1459    fail.
 1460rename(Head0, Head, M) :-
 1461    rename_head(Head0, Head, M).
 1462
 1463rename_head(Var, Var, _) :-
 1464    var(Var),
 1465    !.
 1466rename_head(M:Term0, M:Term, _) :-
 1467    !,
 1468    rename_head(Term0, Term, M).
 1469rename_head(Head0, Head, M) :-
 1470    prolog:rename_predicate(M:Head0, M:Head).
 1471
 1472
 1473                 /*******************************
 1474                 *      :- IF ... :- ENDIF      *
 1475                 *******************************/
 1476
 1477:- thread_local
 1478    '$include_code'/3. 1479
 1480'$including' :-
 1481    '$include_code'(X, _, _),
 1482    !,
 1483    X == true.
 1484'$including'.
 1485
 1486cond_compilation((:- if(G)), []) :-
 1487    source_location(File, Line),
 1488    (   '$including'
 1489    ->  (   catch('$eval_if'(G), E, (print_message(error, E), fail))
 1490        ->  asserta('$include_code'(true, File, Line))
 1491        ;   asserta('$include_code'(false, File, Line))
 1492        )
 1493    ;   asserta('$include_code'(else_false, File, Line))
 1494    ).
 1495cond_compilation((:- elif(G)), []) :-
 1496    source_location(File, Line),
 1497    (   clause('$include_code'(Old, OF, _), _, Ref)
 1498    ->  same_source(File, OF, elif),
 1499        erase(Ref),
 1500        (   Old == true
 1501        ->  asserta('$include_code'(else_false, File, Line))
 1502        ;   Old == false,
 1503            catch('$eval_if'(G), E, (print_message(error, E), fail))
 1504        ->  asserta('$include_code'(true, File, Line))
 1505        ;   asserta('$include_code'(Old, File, Line))
 1506        )
 1507    ;   throw(error(conditional_compilation_error(no_if, elif), _))
 1508    ).
 1509cond_compilation((:- else), []) :-
 1510    source_location(File, Line),
 1511    (   clause('$include_code'(X, OF, _), _, Ref)
 1512    ->  same_source(File, OF, else),
 1513        erase(Ref),
 1514        (   X == true
 1515        ->  X2 = false
 1516        ;   X == false
 1517        ->  X2 = true
 1518        ;   X2 = X
 1519        ),
 1520        asserta('$include_code'(X2, File, Line))
 1521    ;   throw(error(conditional_compilation_error(no_if, else), _))
 1522    ).
 1523cond_compilation(end_of_file, end_of_file) :-   % TBD: Check completeness
 1524    !,
 1525    source_location(File, _),
 1526    (   clause('$include_code'(_, OF, OL), _)
 1527    ->  (   File == OF
 1528        ->  throw(error(conditional_compilation_error(
 1529                            unterminated,OF:OL), _))
 1530        ;   true
 1531        )
 1532    ;   true
 1533    ).
 1534cond_compilation((:- endif), []) :-
 1535    !,
 1536    source_location(File, _),
 1537    (   (   clause('$include_code'(_, OF, _), _, Ref)
 1538        ->  same_source(File, OF, endif),
 1539            erase(Ref)
 1540        )
 1541    ->  true
 1542    ;   throw(error(conditional_compilation_error(no_if, endif), _))
 1543    ).
 1544cond_compilation(_, []) :-
 1545    \+ '$including'.
 1546
 1547same_source(File, File, _) :- !.
 1548same_source(_,    _,    Op) :-
 1549    throw(error(conditional_compilation_error(no_if, Op), _)).
 1550
 1551
 1552'$eval_if'(G) :-
 1553    expand_goal(G, G2),
 1554    '$current_source_module'(Module),
 1555    Module:G2