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          ]).

   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 preceded 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).

 ord_subtract(+Set, +Subtract, -Diff)

  376ord_subtract([], _Not, []).
  377ord_subtract(S1, S2, Diff) :-
  378    S1 == S2,
  379    !,
  380    Diff = [].
  381ord_subtract([H1|T1], L2, Diff) :-
  382    diff21(L2, H1, T1, Diff).
  383
  384diff21([], H1, T1, [H1|T1]).
  385diff21([H2|T2], H1, T1, Diff) :-
  386    compare(Order, H1, H2),
  387    diff3(Order, H1, T1, H2, T2, Diff).
  388
  389diff12([], _H2, _T2, []).
  390diff12([H1|T1], H2, T2, Diff) :-
  391    compare(Order, H1, H2),
  392    diff3(Order, H1, T1, H2, T2, Diff).
  393
  394diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
  395    diff12(T1, H2, T2, Diff).
  396diff3(=, _H1, T1, _H2, T2, Diff) :-
  397    ord_subtract(T1, T2, Diff).
  398diff3(>,  H1, T1, _H2, T2, Diff) :-
  399    diff21(T2, H1, T1, Diff).

 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.

  409merge_variable_info([]).
  410merge_variable_info([Var=State|States]) :-
  411    (   get_attr(Var, '$var_info', CurrentState)
  412    ->  true
  413    ;   CurrentState = (-)
  414    ),
  415    merge_states(Var, State, CurrentState),
  416    merge_variable_info(States).
  417
  418merge_states(_Var, State, State) :- !.
  419merge_states(_Var, -, _) :- !.
  420merge_states(Var, State, -) :-
  421    !,
  422    put_attr(Var, '$var_info', State).
  423merge_states(Var, Left, Right) :-
  424    (   get_dict(fresh, Left, false)
  425    ->  put_dict(fresh, Right, false)
  426    ;   get_dict(fresh, Right, false)
  427    ->  put_dict(fresh, Left, false)
  428    ),
  429    !,
  430    (   Left >:< Right
  431    ->  put_dict(Left, Right, State),
  432        put_attr(Var, '$var_info', State)
  433    ;   print_message(warning,
  434                      inconsistent_variable_properties(Left, Right)),
  435        put_dict(Left, Right, State),
  436        put_attr(Var, '$var_info', State)
  437    ).
  438
  439
  440save_variable_info([], []).
  441save_variable_info([Var|Vars], [Var=State|States]):-
  442    (   get_attr(Var, '$var_info', State)
  443    ->  true
  444    ;   State = (-)
  445    ),
  446    save_variable_info(Vars, States).
  447
  448restore_variable_info([]).
  449restore_variable_info([Var=State|States]) :-
  450    (   State == (-)
  451    ->  del_attr(Var, '$var_info')
  452    ;   put_attr(Var, '$var_info', State)
  453    ),
  454    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.

  470var_property(Var, Property) :-
  471    prop_var(Property, Var).
  472
  473prop_var(fresh(Fresh), Var) :-
  474    (   get_attr(Var, '$var_info', Info),
  475        get_dict(fresh, Info, Fresh0)
  476    ->  Fresh = Fresh0
  477    ;   Fresh = true
  478    ).
  479prop_var(singleton(Singleton), Var) :-
  480    nb_current('$term', Term),
  481    term_singletons(Term, Singletons),
  482    (   '$member'(V, Singletons),
  483        V == Var
  484    ->  Singleton = true
  485    ;   Singleton = false
  486    ).
  487prop_var(name(Name), Var) :-
  488    (   nb_current('$variable_names', Bindings),
  489        '$member'(Name0=Var0, Bindings),
  490        Var0 == Var
  491    ->  Name = Name0
  492    ).
  493
  494
  495mark_vars_non_fresh([]) :- !.
  496mark_vars_non_fresh([Var|Vars]) :-
  497    (   get_attr(Var, '$var_info', Info)
  498    ->  (   get_dict(fresh, Info, false)
  499        ->  true
  500        ;   put_dict(fresh, Info, false, Info1),
  501            put_attr(Var, '$var_info', Info1)
  502        )
  503    ;   put_attr(Var, '$var_info', '$var_info'{fresh:false})
  504    ),
  505    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.

  516remove_attributes(Term, Attr) :-
  517    term_variables(Term, Vars),
  518    remove_var_attr(Vars, Attr).
  519
  520remove_var_attr([], _):- !.
  521remove_var_attr([Var|Vars], Attr):-
  522    del_attr(Var, Attr),
  523    remove_var_attr(Vars, Attr).

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

  529'$var_info':attr_unify_hook(_, _).
  530
  531
  532                 /*******************************
  533                 *   GOAL_EXPANSION/2 SUPPORT   *
  534                 *******************************/

 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.

  542expand_goal(A, B) :-
  543    expand_goal(A, _, B, _).
  544
  545expand_goal(A, P0, B, P) :-
  546    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  547    (   expand_goal(A, P0, B, P, MList, _)
  548    ->  remove_attributes(B, '$var_info'), A \== B
  549    ),
  550    !.
  551expand_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.

  560'$expand_closure'(G0, N, G) :-
  561    '$expand_closure'(G0, _, N, G, _).
  562
  563'$expand_closure'(G0, P0, N, G, P) :-
  564    length(Ex, N),
  565    mark_vars_non_fresh(Ex),
  566    extend_arg_pos(G0, P0, Ex, G1, P1),
  567    expand_goal(G1, P1, G2, P2),
  568    term_variables(G0, VL),
  569    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  570
  571
  572expand_goal(G0, P0, G, P, MList, Term) :-
  573    '$current_source_module'(M),
  574    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

  584% (*)   This is needed because call_goal_expansion may introduce extra
  585%       context variables.  Consider the code below, where the variable
  586%       E is introduced.  Is there a better representation for the
  587%       context?
  588%
  589%         ==
  590%         goal_expansion(catch_and_print(Goal), catch(Goal, E, print(E))).
  591%
  592%         test :-
  593%               catch_and_print(true).
  594%         ==
  595
  596expand_goal(G, P, G, P, _, _, _, _) :-
  597    var(G),
  598    !.
  599expand_goal(M:G, P, M:G, P, _M, _MList, _Term, _) :-
  600    var(M), var(G),
  601    !.
  602expand_goal(M:G, P0, M:EG, P, _M, _MList, Term, Done) :-
  603    atom(M),
  604    !,
  605    f2_pos(P0, PA, PB0, P, PA, PB),
  606    '$def_modules'(M:[goal_expansion/4,goal_expansion/2], MList),
  607    setup_call_cleanup(
  608        '$set_source_module'(Old, M),
  609        '$expand':expand_goal(G, PB0, EG, PB, M, MList, Term, Done),
  610        '$set_source_module'(Old)).
  611expand_goal(G0, P0, G, P, M, MList, Term, Done) :-
  612    (   already_expanded(G0, Done, Done1)
  613    ->  expand_control(G0, P0, G, P, M, MList, Term, Done1)
  614    ;   call_goal_expansion(MList, G0, P0, G1, P1)
  615    ->  expand_goal(G1, P1, G, P, M, MList, Term/G1, [G0|Done])      % (*)
  616    ;   expand_control(G0, P0, G, P, M, MList, Term, Done)
  617    ).
  618
  619expand_control((A,B), P0, Conj, 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, Conj, P).
  625expand_control((A;B), P0, Or, P, M, MList, Term, Done) :-
  626    !,
  627    f2_pos(P0, PA0, PB0, P1, PA1, PB),
  628    term_variables(A, AVars),
  629    term_variables(B, BVars),
  630    var_intersection(AVars, BVars, SharedVars),
  631    save_variable_info(SharedVars, SavedState),
  632    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  633    save_variable_info(SharedVars, SavedState2),
  634    restore_variable_info(SavedState),
  635    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  636    merge_variable_info(SavedState2),
  637    fixup_or_lhs(A, EA, PA, EA1, PA1),
  638    simplify((EA1;EB), P1, Or, P).
  639expand_control((A->B), P0, Goal, P, M, MList, Term, Done) :-
  640    !,
  641    f2_pos(P0, PA0, PB0, P1, PA, PB),
  642    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  643    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  644    simplify((EA->EB), P1, Goal, P).
  645expand_control((A*->B), P0, Goal, P, M, MList, Term, Done) :-
  646    !,
  647    f2_pos(P0, PA0, PB0, P1, PA, PB),
  648    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  649    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  650    simplify((EA*->EB), P1, Goal, P).
  651expand_control((\+A), P0, Goal, P, M, MList, Term, Done) :-
  652    !,
  653    f1_pos(P0, PA0, P1, PA),
  654    term_variables(A, AVars),
  655    save_variable_info(AVars, SavedState),
  656    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  657    restore_variable_info(SavedState),
  658    simplify(\+(EA), P1, Goal, P).
  659expand_control(call(A), P0, call(EA), P, M, MList, Term, Done) :-
  660    !,
  661    f1_pos(P0, PA0, P, PA),
  662    expand_goal(A, PA0, EA, PA, M, MList, Term, Done).
  663expand_control(G0, P0, G, P, M, MList, Term, Done) :-
  664    is_meta_call(G0, M, Head),
  665    !,
  666    term_variables(G0, Vars),
  667    mark_vars_non_fresh(Vars),
  668    expand_meta(Head, G0, P0, G, P, M, MList, Term, Done).
  669expand_control(G0, P0, G, P, M, MList, Term, _Done) :-
  670    term_variables(G0, Vars),
  671    mark_vars_non_fresh(Vars),
  672    expand_functions(G0, P0, G, P, M, MList, Term).

 already_expanded(+Goal, +Done, -RestDone) is semidet

  676already_expanded(Goal, Done, Done1) :-
  677    '$select'(G, Done, Done1),
  678    G == Goal,
  679    !.

 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)

  688fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  689    nonvar(Old),
  690    nonvar(New),
  691    (   Old = (_ -> _)
  692    ->  New \= (_ -> _),
  693        Fix = (New -> true)
  694    ;   New = (_ -> _),
  695        Fix = (New, true)
  696    ),
  697    !,
  698    lhs_pos(PNew, PFixed).
  699fixup_or_lhs(_Old, New, P, New, P).
  700
  701lhs_pos(P0, _) :-
  702    var(P0),
  703    !.
  704lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  705    arg(1, P0, F),
  706    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.

  713is_meta_call(G0, M, Head) :-
  714    compound(G0),
  715    default_module(M, M2),
  716    '$c_current_predicate'(_, M2:G0),
  717    !,
  718    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  719    has_meta_arg(Head).

 expand_meta(+MetaSpec, +G0, ?P0, -G, -P, +M, +Mlist, +Term, +Done)

  724expand_meta(Spec, G0, P0, G, P, M, MList, Term, Done) :-
  725    functor(Spec, _, Arity),
  726    functor(G0, Name, Arity),
  727    functor(G1, Name, Arity),
  728    f_pos(P0, ArgPos0, P, ArgPos),
  729    expand_meta(1, Arity, Spec,
  730                G0, ArgPos0, Eval,
  731                G1,  ArgPos,
  732                M, MList, Term, Done),
  733    conj(Eval, G1, G).
  734
  735expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, G, [P|PT], M, MList, Term, Done) :-
  736    I =< Arity,
  737    !,
  738    arg_pos(ArgPos0, P0, PT0),
  739    arg(I, Spec, Meta),
  740    arg(I, G0, A0),
  741    arg(I, G, A),
  742    expand_meta_arg(Meta, A0, P0, EvalA, A, P, M, MList, Term, Done),
  743    I2 is I + 1,
  744    expand_meta(I2, Arity, Spec, G0, PT0, EvalB, G, PT, M, MList, Term, Done),
  745    conj(EvalA, EvalB, Eval).
  746expand_meta(_, _, _, _, _, true, _, [], _, _, _, _).
  747
  748arg_pos(List, _, _) :- var(List), !.    % no position info
  749arg_pos([H|T], H, T) :- !.              % argument list
  750arg_pos([], _, []).                     % new has more
  751
  752mapex([], _).
  753mapex([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.

  760extended_pos(Var, _, Var) :-
  761    var(Var),
  762    !.
  763extended_pos(parentheses_term_position(O,C,Pos0),
  764             N,
  765             parentheses_term_position(O,C,Pos)) :-
  766    !,
  767    extended_pos(Pos0, N, Pos).
  768extended_pos(term_position(F,T,FF,FT,Args),
  769             _,
  770             term_position(F,T,FF,FT,Args)) :-
  771    var(Args),
  772    !.
  773extended_pos(term_position(F,T,FF,FT,Args0),
  774             N,
  775             term_position(F,T,FF,FT,Args)) :-
  776    length(Ex, N),
  777    mapex(Ex, T-T),
  778    '$append'(Args0, Ex, Args),
  779    !.
  780extended_pos(F-T,
  781             N,
  782             term_position(F,T,F,T,Ex)) :-
  783    !,
  784    length(Ex, N),
  785    mapex(Ex, T-T).
  786extended_pos(Pos, N, Pos) :-
  787    '$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.

  798expand_meta_arg(0, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  799    !,
  800    expand_goal(A0, PA0, A1, PA, M, MList, Term, Done),
  801    compile_meta_call(A1, A, M, Term).
  802expand_meta_arg(N, A0, P0, true, A, P, M, MList, Term, Done) :-
  803    integer(N), callable(A0),
  804    replace_functions(A0, true, _, M),
  805    !,
  806    length(Ex, N),
  807    mark_vars_non_fresh(Ex),
  808    extend_arg_pos(A0, P0, Ex, A1, PA1),
  809    expand_goal(A1, PA1, A2, PA2, M, MList, Term, Done),
  810    compile_meta_call(A2, A3, M, Term),
  811    term_variables(A0, VL),
  812    remove_arg_pos(A3, PA2, M, VL, Ex, A, P).
  813expand_meta_arg(^, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  814    !,
  815    expand_setof_goal(A0, PA0, A, PA, M, MList, Term, Done).
  816expand_meta_arg(S, A0, _PA0, Eval, A, _PA, M, _MList, _Term, _Done) :-
  817    replace_functions(A0, Eval, A, M), % TBD: pass positions
  818    (   Eval == true
  819    ->  true
  820    ;   same_functor(A0, A)
  821    ->  true
  822    ;   meta_arg(S)
  823    ->  throw(error(context_error(function, meta_arg(S)), _))
  824    ;   true
  825    ).
  826
  827same_functor(T1, T2) :-
  828    compound(T1),
  829    !,
  830    compound(T2),
  831    compound_name_arity(T1, N, A),
  832    compound_name_arity(T2, N, A).
  833same_functor(T1, T2) :-
  834    atom(T1),
  835    T1 == T2.
  836
  837variant_sha1_nat(Term, Hash) :-
  838    copy_term_nat(Term, TNat),
  839    variant_sha1(TNat, Hash).
  840
  841wrap_meta_arguments(A0, M, VL, Ex, A) :-
  842    '$append'(VL, Ex, AV),
  843    variant_sha1_nat(A0+AV, Hash),
  844    atom_concat('__aux_wrapper_', Hash, AuxName),
  845    H =.. [AuxName|AV],
  846    compile_auxiliary_clause(M, (H :- A0)),
  847    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.

  854extend_arg_pos(A, P, _, A, P) :-
  855    var(A),
  856    !.
  857extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  858    !,
  859    f2_pos(P0, PM, PA0, P, PM, PA),
  860    extend_arg_pos(A0, PA0, Ex, A, PA).
  861extend_arg_pos(A0, P0, Ex, A, P) :-
  862    callable(A0),
  863    !,
  864    extend_term(A0, Ex, A),
  865    length(Ex, N),
  866    extended_pos(P0, N, P).
  867extend_arg_pos(A, P, _, A, P).
  868
  869extend_term(Atom, Extra, Term) :-
  870    atom(Atom),
  871    !,
  872    Term =.. [Atom|Extra].
  873extend_term(Term0, Extra, Term) :-
  874    compound_name_arguments(Term0, Name, Args0),
  875    '$append'(Args0, Extra, Args),
  876    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

  887remove_arg_pos(A, P, _, _, _, A, P) :-
  888    var(A),
  889    !.
  890remove_arg_pos(M:A0, P0, _, VL, Ex, M:A, P) :-
  891    !,
  892    f2_pos(P, PM, PA0, P0, PM, PA),
  893    remove_arg_pos(A0, PA, M, VL, Ex, A, PA0).
  894remove_arg_pos(A0, P0, M, VL, Ex0, A, P) :-
  895    callable(A0),
  896    !,
  897    length(Ex0, N),
  898    (   A0 =.. [F|Args],
  899        length(Ex, N),
  900        '$append'(Args0, Ex, Args),
  901        Ex==Ex0
  902    ->  extended_pos(P, N, P0),
  903        A =.. [F|Args0]
  904    ;   M \== [],
  905        wrap_meta_arguments(A0, M, VL, Ex0, A),
  906        wrap_meta_pos(P0, P)
  907    ).
  908remove_arg_pos(A, P, _, _, _, A, P).
  909
  910wrap_meta_pos(P0, P) :-
  911    (   nonvar(P0)
  912    ->  P = term_position(F,T,_,_,_),
  913        atomic_pos(P0, F-T)
  914    ;   true
  915    ).
  916
  917has_meta_arg(Head) :-
  918    arg(_, Head, Arg),
  919    direct_call_meta_arg(Arg),
  920    !.
  921
  922direct_call_meta_arg(I) :- integer(I).
  923direct_call_meta_arg(^).
  924
  925meta_arg(:).
  926meta_arg(//).
  927meta_arg(I) :- integer(I).
  928
  929expand_setof_goal(Var, Pos, Var, Pos, _, _, _, _) :-
  930    var(Var),
  931    !.
  932expand_setof_goal(V^G, P0, V^EG, P, M, MList, Term, Done) :-
  933    !,
  934    f2_pos(P0, PA0, PB, P, PA, PB),
  935    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  936expand_setof_goal(M0:G, P0, M0:EG, P, M, MList, Term, Done) :-
  937    !,
  938    f2_pos(P0, PA0, PB, P, PA, PB),
  939    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  940expand_setof_goal(G, P0, EG, P, M, MList, Term, Done) :-
  941    !,
  942    expand_goal(G, P0, EG0, P, M, MList, Term, Done),
  943    compile_meta_call(EG0, EG1, M, Term),
  944    (   extend_existential(G, EG1, V)
  945    ->  EG = V^EG1
  946    ;   EG = EG1
  947    ).

 extend_existential(+G0, +G1, -V) is semidet

Extend the variable template to compensate for intermediate variables introduced during goal expansion (notably for functional notation).

  955extend_existential(G0, G1, V) :-
  956    term_variables(G0, GV0), sort(GV0, SV0),
  957    term_variables(G1, GV1), sort(GV1, SV1),
  958    ord_subtract(SV1, SV0, New),
  959    New \== [],
  960    V =.. [v|New].

 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.

  970call_goal_expansion(MList, G0, P0, G, P) :-
  971    current_prolog_flag(sandboxed_load, false),
  972    !,
  973    (   '$member'(M-Preds, MList),
  974        '$member'(Pred, Preds),
  975        (   Pred == goal_expansion/4
  976        ->  M:goal_expansion(G0, P0, G, P)
  977        ;   M:goal_expansion(G0, G),
  978            P = P0
  979        ),
  980        G0 \== G
  981    ->  true
  982    ).
  983call_goal_expansion(MList, G0, P0, G, P) :-
  984    (   '$member'(M-Preds, MList),
  985        '$member'(Pred, Preds),
  986        (   Pred == goal_expansion/4
  987        ->  Expand = M:goal_expansion(G0, P0, G, P)
  988        ;   Expand = M:goal_expansion(G0, G)
  989        ),
  990        allowed_expansion(Expand),
  991        call(Expand),
  992        G0 \== G
  993    ->  true
  994    ).

 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.

 1004:- multifile
 1005    prolog:sandbox_allowed_expansion/1. 1006
 1007allowed_expansion(QGoal) :-
 1008    strip_module(QGoal, M, Goal),
 1009    E = error(Formal,_),
 1010    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
 1011    (   var(Formal)
 1012    ->  fail
 1013    ;   !,
 1014        print_message(error, E),
 1015        fail
 1016    ).
 1017allowed_expansion(_).
 1018
 1019
 1020                 /*******************************
 1021                 *      FUNCTIONAL NOTATION     *
 1022                 *******************************/

 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.

 1031expand_functions(G0, P0, G, P, M, MList, Term) :-
 1032    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
 1033    (   expand_arithmetic(G1, P1, G, P, Term)
 1034    ->  true
 1035    ;   G = G1,
 1036        P = P1
 1037    ).

 expand_functional_notation(+G0, +P0, -G, -P, +M, +MList, +Term) is det

To be done

- : position logic

- : make functions module-local

 1044expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
 1045    contains_functions(G0),
 1046    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
 1047    Eval \== true,
 1048    !,
 1049    wrap_var(G1, G1Pos, G2, G2Pos),
 1050    conj(Eval, EvalPos, G2, G2Pos, G, P).
 1051expand_functional_notation(G, P, G, P, _, _, _).
 1052
 1053wrap_var(G, P, G, P) :-
 1054    nonvar(G),
 1055    !.
 1056wrap_var(G, P0, call(G), P) :-
 1057    (   nonvar(P0)
 1058    ->  P = term_position(F,T,F,T,[P0]),
 1059        atomic_pos(P0, F-T)
 1060    ;   true
 1061    ).

 contains_functions(@Term) is semidet

True when Term contains a function reference.

 1067contains_functions(Term) :-
 1068    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1069            (   contains_functions2(Skeleton)
 1070            ;   contains_functions2(Assignments)
 1071            )).
 1072
 1073contains_functions2(Term) :-
 1074    compound(Term),
 1075    (   function(Term, _)
 1076    ->  true
 1077    ;   arg(_, Term, Arg),
 1078        contains_functions2(Arg)
 1079    ->  true
 1080    ).

 replace_functions(+GoalIn, +PosIn, -Eval, -EvalPos, -GoalOut, -PosOut, +ContextTerm) is det

To be done

- Proper propagation of list, dict and brace term positions.

 1089:- public
 1090    replace_functions/4.            % used in dicts.pl
 1091
 1092replace_functions(GoalIn, Eval, GoalOut, Context) :-
 1093    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
 1094
 1095replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
 1096    var(Var),
 1097    !.
 1098replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
 1099    function(F, Ctx),
 1100    !,
 1101    compound_name_arity(F, Name, Arity),
 1102    PredArity is Arity+1,
 1103    compound_name_arity(G, Name, PredArity),
 1104    arg(PredArity, G, Var),
 1105    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1106    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1107    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1108replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1109    compound(Term0),
 1110    !,
 1111    compound_name_arity(Term0, Name, Arity),
 1112    compound_name_arity(Term, Name, Arity),
 1113    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1114    map_functions(0, Arity,
 1115                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1116replace_functions(Term, Pos, true, _, Term, Pos, _).

 map_functions(+Arg, +Arity, +TermIn, +ArgInPos, -Term, -ArgPos, -Eval, -EvalPos, +Context)

 1123map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1124    !,
 1125    pos_nil(LPos0, LPos).
 1126map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1127    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1128    I is I0+1,
 1129    arg(I, Term0, Arg0),
 1130    arg(I, Term, Arg),
 1131    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1132    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1133    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1134
 1135conj(true, X, X) :- !.
 1136conj(X, true, X) :- !.
 1137conj(X, Y, (X,Y)).
 1138
 1139conj(true, _, X, P, X, P) :- !.
 1140conj(X, P, true, _, X, P) :- !.
 1141conj(X, PX, Y, PY, (X,Y), _) :-
 1142    var(PX), var(PY),
 1143    !.
 1144conj(X, PX, Y, PY, (X,Y), P) :-
 1145    P = term_position(F,T,FF,FT,[PX,PY]),
 1146    atomic_pos(PX, F-FF),
 1147    atomic_pos(PY, FT-T).

 function(?Term, +Context)

True if function expansion needs to be applied for the given term.

 1154:- multifile
 1155    function/2. 1156
 1157function(.(_,_), _) :- \+ functor([_|_], ., _).
 1158
 1159
 1160                 /*******************************
 1161                 *          ARITHMETIC          *
 1162                 *******************************/

 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.

 1172expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1173
 1174
 1175                 /*******************************
 1176                 *        POSITION LOGIC        *
 1177                 *******************************/

 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.

 1187f2_pos(Var, _, _, _, _, _) :-
 1188    var(Var),
 1189    !.
 1190f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1191       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1192f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1193       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1194    !,
 1195    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1196f2_pos(Pos, _, _, _, _, _) :-
 1197    expected_layout(f2, Pos).
 1198
 1199f1_pos(Var, _, _, _) :-
 1200    var(Var),
 1201    !.
 1202f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1203       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1204f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1205       parentheses_term_position(O,C,Pos),  A1) :-
 1206    !,
 1207    f1_pos(Pos0, A10, Pos, A1).
 1208f1_pos(Pos, _, _, _) :-
 1209    expected_layout(f1, Pos).
 1210
 1211f_pos(Var, _, _, _) :-
 1212    var(Var),
 1213    !.
 1214f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1215      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1216f_pos(parentheses_term_position(O,C,Pos0), A10,
 1217      parentheses_term_position(O,C,Pos),  A1) :-
 1218    !,
 1219    f_pos(Pos0, A10, Pos, A1).
 1220f_pos(Pos, _, _, _) :-
 1221    expected_layout(compound, Pos).
 1222
 1223atomic_pos(Pos, _) :-
 1224    var(Pos),
 1225    !.
 1226atomic_pos(Pos, F-T) :-
 1227    arg(1, Pos, F),
 1228    arg(2, Pos, T).

 pos_nil(+Nil, -Nil) is det

 pos_list(+List0, -H0, -T0, -List, -H, -T) is det

Position propagation for lists.

 1235pos_nil(Var, _) :- var(Var), !.
 1236pos_nil([], []) :- !.
 1237pos_nil(Pos, _) :-
 1238    expected_layout(nil, Pos).
 1239
 1240pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1241pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1242pos_list(Pos, _, _, _, _, _) :-
 1243    expected_layout(list, Pos).

 extend_1_pos(+FunctionPos, -FArgPos, -EvalPos, -EArgPos, -VarPos)

Deal with extending a function to include the return value.

 1249extend_1_pos(Pos, _, _, _, _) :-
 1250    var(Pos),
 1251    !.
 1252extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1253             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1254             FT-FT1) :-
 1255    integer(FT),
 1256    !,
 1257    FT1 is FT+1,
 1258    '$same_length'(FArgPos, GArgPos0),
 1259    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1260extend_1_pos(F-T, [],
 1261             term_position(F,T,F,T,[T-T1]), [],
 1262             T-T1) :-
 1263    integer(T),
 1264    !,
 1265    T1 is T+1.
 1266extend_1_pos(Pos, _, _, _, _) :-
 1267    expected_layout(callable, Pos).
 1268
 1269'$same_length'(List, List) :-
 1270    var(List),
 1271    !.
 1272'$same_length'([], []).
 1273'$same_length'([_|T0], [_|T]) :-
 1274    '$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.

 1284:- create_prolog_flag(debug_term_position, false, []). 1285
 1286expected_layout(Expected, Pos) :-
 1287    current_prolog_flag(debug_term_position, true),
 1288    !,
 1289    '$print_message'(warning, expected_layout(Expected, Pos)).
 1290expected_layout(_, _).
 1291
 1292
 1293                 /*******************************
 1294                 *    SIMPLIFICATION ROUTINES   *
 1295                 *******************************/

 simplify(+ControlIn, +Pos0, -ControlOut, -Pos) is det

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

 1304simplify(Control, P, Control, P) :-
 1305    current_prolog_flag(optimise, false),
 1306    !.
 1307simplify(Control, P0, Simple, P) :-
 1308    simple(Control, P0, Simple, P),
 1309    !.
 1310simplify(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.

 1319simple((X,Y), P0, Conj, P) :-
 1320    (   true(X)
 1321    ->  Conj = Y,
 1322        f2_pos(P0, _, P, _, _, _)
 1323    ;   false(X)
 1324    ->  Conj = fail,
 1325        f2_pos(P0, P1, _, _, _, _),
 1326        atomic_pos(P1, P)
 1327    ;   true(Y)
 1328    ->  Conj = X,
 1329        f2_pos(P0, P, _, _, _, _)
 1330    ).
 1331simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1332    (   true(I)                     % because nothing happens if I and T
 1333    ->  ITE = T,                    % are unbound.
 1334        f2_pos(P0, P1, _, _, _, _),
 1335        f2_pos(P1, _, P, _, _, _)
 1336    ;   false(I)
 1337    ->  ITE = E,
 1338        f2_pos(P0, _, P, _, _, _)
 1339    ).
 1340simple((X;Y), P0, Or, P) :-
 1341    false(X),
 1342    Or = Y,
 1343    f2_pos(P0, _, P, _, _, _).
 1344
 1345true(X) :-
 1346    nonvar(X),
 1347    eval_true(X).
 1348
 1349false(X) :-
 1350    nonvar(X),
 1351    eval_false(X).

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

 1357eval_true(true).
 1358eval_true(otherwise).
 1359
 1360eval_false(fail).
 1361eval_false(false).
 1362
 1363
 1364                 /*******************************
 1365                 *         META CALLING         *
 1366                 *******************************/
 1367
 1368:- 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.

 1374compile_meta_call(CallIn, CallIn, _, Term) :-
 1375    var(Term),
 1376    !.                   % explicit call; no context
 1377compile_meta_call(CallIn, CallIn, _, _) :-
 1378    var(CallIn),
 1379    !.
 1380compile_meta_call(CallIn, CallIn, _, _) :-
 1381    (   current_prolog_flag(compile_meta_arguments, false)
 1382    ;   current_prolog_flag(xref, true)
 1383    ),
 1384    !.
 1385compile_meta_call(CallIn, CallIn, _, _) :-
 1386    strip_module(CallIn, _, Call),
 1387    (   is_aux_meta(Call)
 1388    ;   \+ control(Call),
 1389        (   '$c_current_predicate'(_, system:Call),
 1390            \+ current_prolog_flag(compile_meta_arguments, always)
 1391        ;   current_prolog_flag(compile_meta_arguments, control)
 1392        )
 1393    ),
 1394    !.
 1395compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1396    !,
 1397    (   atom(M), callable(CallIn)
 1398    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1399    ;   CallOut = M:CallIn
 1400    ).
 1401compile_meta_call(CallIn, CallOut, Module, Term) :-
 1402    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1403    compile_auxiliary_clause(Module, Clause).
 1404
 1405compile_auxiliary_clause(Module, Clause) :-
 1406    Clause = (Head:-Body),
 1407    '$current_source_module'(SM),
 1408    (   predicate_property(SM:Head, defined)
 1409    ->  true
 1410    ;   SM == Module
 1411    ->  compile_aux_clauses([Clause])
 1412    ;   compile_aux_clauses([Head:-Module:Body])
 1413    ).
 1414
 1415control((_,_)).
 1416control((_;_)).
 1417control((_->_)).
 1418control((_*->_)).
 1419control(\+(_)).
 1420
 1421is_aux_meta(Term) :-
 1422    callable(Term),
 1423    functor(Term, Name, _),
 1424    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1425
 1426compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1427    replace_subterm(CallIn, true, Term, Term2),
 1428    term_variables(Term2, AllVars),
 1429    term_variables(CallIn, InVars),
 1430    intersection_eq(InVars, AllVars, HeadVars),
 1431    copy_term_nat(CallIn+HeadVars, NAT),
 1432    variant_sha1(NAT, Hash),
 1433    atom_concat('__aux_meta_call_', Hash, AuxName),
 1434    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn), []),
 1435    length(HeadVars, Arity),
 1436    (   Arity > 256                 % avoid 1024 arity limit
 1437    ->  HeadArgs = [v(HeadVars)]
 1438    ;   HeadArgs = HeadVars
 1439    ),
 1440    CallOut =.. [AuxName|HeadArgs].