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

   72:- dynamic
   73    system:term_expansion/2,
   74    system:goal_expansion/2,
   75    user:term_expansion/2,
   76    user:goal_expansion/2,
   77    system:term_expansion/4,
   78    system:goal_expansion/4,
   79    user:term_expansion/4,
   80    user:goal_expansion/4.   81:- multifile
   82    system:term_expansion/2,
   83    system:goal_expansion/2,
   84    user:term_expansion/2,
   85    user:goal_expansion/2,
   86    system:term_expansion/4,
   87    system:goal_expansion/4,
   88    user:term_expansion/4,
   89    user:goal_expansion/4.   90
   91:- meta_predicate
   92    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.

  100expand_term(Term0, Term) :-
  101    expand_term(Term0, _, Term, _).
  102
  103expand_term(Var, Pos, Expanded, Pos) :-
  104    var(Var),
  105    !,
  106    Expanded = Var.
  107expand_term(Term, Pos0, [], Pos) :-
  108    cond_compilation(Term, X),
  109    X == [],
  110    !,
  111    atomic_pos(Pos0, Pos).
  112expand_term(Term, Pos0, Expanded, Pos) :-
  113    setup_call_cleanup(
  114        '$push_input_context'(expand_term),
  115        expand_term_keep_source_loc(Term, Pos0, Expanded, Pos),
  116        '$pop_input_context').
  117
  118expand_term_keep_source_loc(Term, Pos0, Expanded, Pos) :-
  119    b_setval('$term', Term),
  120    prepare_directive(Term),
  121    '$def_modules'([term_expansion/4,term_expansion/2], MList),
  122    call_term_expansion(MList, Term, Pos0, Term1, Pos1),
  123    expand_terms(expand_term_2, Term1, Pos1, Expanded, Pos),
  124    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.

  133prepare_directive((:- Directive)) :-
  134    '$current_source_module'(M),
  135    prepare_directive(Directive, M),
  136    !.
  137prepare_directive(_).
  138
  139prepare_directive(Goal, _) :-
  140    \+ callable(Goal),
  141    !.
  142prepare_directive((A,B), Module) :-
  143    !,
  144    prepare_directive(A, Module),
  145    prepare_directive(B, Module).
  146prepare_directive(module(_,_), _) :- !.
  147prepare_directive(Goal, Module) :-
  148    '$get_predicate_attribute'(Module:Goal, defined, 1),
  149    !.
  150prepare_directive(Goal, Module) :-
  151    \+ current_prolog_flag(autoload, false),
  152    (   compound(Goal)
  153    ->  compound_name_arity(Goal, Name, Arity)
  154    ;   Name = Goal, Arity = 0
  155    ),
  156    '$autoload'(Module:Name/Arity),
  157    !.
  158prepare_directive(_, _).
  159
  160
  161call_term_expansion([], Term, Pos, Term, Pos).
  162call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  163    current_prolog_flag(sandboxed_load, false),
  164    !,
  165    (   '$member'(Pred, Preds),
  166        (   Pred == term_expansion/2
  167        ->  M:term_expansion(Term0, Term1),
  168            Pos1 = Pos0
  169        ;   M:term_expansion(Term0, Pos0, Term1, Pos1)
  170        )
  171    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  172    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  173    ).
  174call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  175    (   '$member'(Pred, Preds),
  176        (   Pred == term_expansion/2
  177        ->  allowed_expansion(M:term_expansion(Term0, Term1)),
  178            call(M:term_expansion(Term0, Term1)),
  179            Pos1 = Pos
  180        ;   allowed_expansion(M:term_expansion(Term0, Pos0, Term1, Pos1)),
  181            call(M:term_expansion(Term0, Pos0, Term1, Pos1))
  182        )
  183    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  184    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  185    ).
  186
  187expand_term_2((Head --> Body), Pos0, Expanded, Pos) :-
  188    dcg_translate_rule((Head --> Body), Pos0, Expanded0, Pos1),
  189    !,
  190    expand_bodies(Expanded0, Pos1, Expanded1, Pos),
  191    non_terminal_decl(Expanded1, Expanded).
  192expand_term_2(Term0, Pos0, Term, Pos) :-
  193    nonvar(Term0),
  194    !,
  195    expand_bodies(Term0, Pos0, Term, Pos).
  196expand_term_2(Term, Pos, Term, Pos).
  197
  198non_terminal_decl(Clause, Decl) :-
  199    \+ current_prolog_flag(xref, true),
  200    clause_head(Clause, Head),
  201    '$current_source_module'(M),
  202    (   '$get_predicate_attribute'(M:Head, non_terminal, NT)
  203    ->  NT == 0
  204    ;   true
  205    ),
  206    !,
  207    '$pi_head'(PI, Head),
  208    Decl = [:-(non_terminal(M:PI)), Clause].
  209non_terminal_decl(Clause, Clause).
  210
  211clause_head(Head:-_, Head) :- !.
  212clause_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.

  223expand_bodies(Terms, Pos0, Out, Pos) :-
  224    '$def_modules'([goal_expansion/4,goal_expansion/2], MList),
  225    expand_terms(expand_body(MList), Terms, Pos0, Out, Pos),
  226    remove_attributes(Out, '$var_info').
  227
  228expand_body(MList, Clause0, Pos0, Clause, Pos) :-
  229    clause_head_body(Clause0, Left0, Neck, Body0),
  230    !,
  231    clause_head_body(Clause, Left, Neck, Body),
  232    f2_pos(Pos0, LPos0, BPos0, Pos, LPos, BPos),
  233    (   head_guard(Left0, Neck, Head0, Guard0)
  234    ->  f2_pos(LPos0, HPos, GPos0, LPos, HPos, GPos),
  235        mark_head_variables(Head0),
  236        expand_goal(Guard0, GPos0, Guard, GPos, MList, Clause0),
  237        Left = (Head,Guard)
  238    ;   LPos = LPos0,
  239        Head0 = Left0,
  240        Left = Head,
  241        mark_head_variables(Head0)
  242    ),
  243    expand_goal(Body0, BPos0, Body1, BPos, MList, Clause0),
  244    expand_head_functions(Head0, Head, Body1, Body).
  245expand_body(MList, (:- Body), Pos0, (:- ExpandedBody), Pos) :-
  246    !,
  247    f1_pos(Pos0, BPos0, Pos, BPos),
  248    expand_goal(Body, BPos0, ExpandedBody, BPos, MList, (:- Body)).
  249
  250clause_head_body((Head :- Body), Head, :-, Body).
  251clause_head_body((Head => Body), Head, =>, Body).
  252clause_head_body(?=>(Head, Body), Head, ?=>, Body).
  253
  254head_guard(Left, Neck, Head, Guard) :-
  255    nonvar(Left),
  256    Left = (Head,Guard),
  257    (   Neck == (=>)
  258    ->  true
  259    ;   Neck == (?=>)
  260    ).
  261
  262mark_head_variables(Head) :-
  263    term_variables(Head, HVars),
  264    mark_vars_non_fresh(HVars).
  265
  266expand_head_functions(Head0, Head, Body0, Body) :-
  267    compound(Head0),
  268    '$current_source_module'(M),
  269    replace_functions(Head0, Eval, Head, M),
  270    Eval \== true,
  271    !,
  272    Body = (Eval,Body0).
  273expand_head_functions(Head, Head, Body, Body).
  274
  275expand_body(_MList, Head0, Pos, Clause, Pos) :- % TBD: Position handling
  276    compound(Head0),
  277    '$current_source_module'(M),
  278    replace_functions(Head0, Eval, Head, M),
  279    Eval \== true,
  280    !,
  281    Clause = (Head :- Eval).
  282expand_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.

  292expand_terms(_, X, P, X, P) :-
  293    var(X),
  294    !.
  295expand_terms(C, List0, Pos0, List, Pos) :-
  296    nonvar(List0),
  297    List0 = [_|_],
  298    !,
  299    (   is_list(List0)
  300    ->  list_pos(Pos0, Elems0, Pos, Elems),
  301        expand_term_list(C, List0, Elems0, List, Elems)
  302    ;   '$type_error'(list, List0)
  303    ).
  304expand_terms(C, '$source_location'(File, Line):Clause0, Pos0, Clause, Pos) :-
  305    !,
  306    expand_terms(C, Clause0, Pos0, Clause1, Pos),
  307    add_source_location(Clause1, '$source_location'(File, Line), Clause).
  308expand_terms(C, Term0, Pos0, Term, Pos) :-
  309    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.

  316add_source_location(Clauses0, SrcLoc, Clauses) :-
  317    (   is_list(Clauses0)
  318    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  319    ;   Clauses = SrcLoc:Clauses0
  320    ).
  321
  322add_source_location_list([], _, []).
  323add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  324    add_source_location_list(Clauses0, SrcLoc, Clauses).

 expand_term_list(:Expander, +TermList, +Pos, -NewTermList, -PosList)

  328expand_term_list(_, [], _, [], []) :- !.
  329expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  330    !,
  331    expand_terms(C, H0, PH0, H, PH),
  332    add_term(H, PH, Terms, TT, PosL, PT),
  333    expand_term_list(C, T0, [PH0], TT, PT).
  334expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  335    !,
  336    expand_terms(C, H0, PH0, H, PH),
  337    add_term(H, PH, Terms, TT, PosL, PT),
  338    expand_term_list(C, T0, PT0, TT, PT).
  339expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  340    expected_layout(list, PH0),
  341    expand_terms(C, H0, PH0, H, PH),
  342    add_term(H, PH, Terms, TT, PosL, PT),
  343    expand_term_list(C, T0, [PH0], TT, PT).

 add_term(+ExpandOut, ?ExpandPosOut, -Terms, ?TermsT, -PosL, ?PosLT)

  347add_term(List, Pos, Terms, TermT, PosL, PosT) :-
  348    nonvar(List), List = [_|_],
  349    !,
  350    (   is_list(List)
  351    ->  append_tp(List, Terms, TermT, Pos, PosL, PosT)
  352    ;   '$type_error'(list, List)
  353    ).
  354add_term(Term, Pos, [Term|Terms], Terms, [Pos|PosT], PosT).
  355
  356append_tp([], Terms, Terms, _, PosL, PosL).
  357append_tp([H|T0], [H|T1], Terms, [HP], [HP|TP1], PosL) :-
  358    !,
  359    append_tp(T0, T1, Terms, [HP], TP1, PosL).
  360append_tp([H|T0], [H|T1], Terms, [HP0|TP0], [HP0|TP1], PosL) :-
  361    !,
  362    append_tp(T0, T1, Terms, TP0, TP1, PosL).
  363append_tp([H|T0], [H|T1], Terms, Pos, [Pos|TP1], PosL) :-
  364    expected_layout(list, Pos),
  365    append_tp(T0, T1, Terms, [Pos], TP1, PosL).
  366
  367
  368list_pos(Var, _, _, _) :-
  369    var(Var),
  370    !.
  371list_pos(list_position(F,T,Elems0,none), Elems0,
  372         list_position(F,T,Elems,none),  Elems).
  373list_pos(Pos, [Pos], Elems, Elems).
  374
  375
  376                 /*******************************
  377                 *      VAR_INFO/3 SUPPORT      *
  378                 *******************************/

 var_intersection(+List1, +List2, -Shared) is det

Shared is the ordered intersection of List1 and List2.

  384var_intersection(List1, List2, Intersection) :-
  385    sort(List1, Set1),
  386    sort(List2, Set2),
  387    ord_intersection(Set1, Set2, Intersection).

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

  393ord_intersection([], _Int, []).
  394ord_intersection([H1|T1], L2, Int) :-
  395    isect2(L2, H1, T1, Int).
  396
  397isect2([], _H1, _T1, []).
  398isect2([H2|T2], H1, T1, Int) :-
  399    compare(Order, H1, H2),
  400    isect3(Order, H1, T1, H2, T2, Int).
  401
  402isect3(<, _H1, T1,  H2, T2, Int) :-
  403    isect2(T1, H2, T2, Int).
  404isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  405    ord_intersection(T1, T2, Int).
  406isect3(>, H1, T1,  _H2, T2, Int) :-
  407    isect2(T2, H1, T1, Int).

 ord_subtract(+Set, +Subtract, -Diff)

  411ord_subtract([], _Not, []).
  412ord_subtract(S1, S2, Diff) :-
  413    S1 == S2,
  414    !,
  415    Diff = [].
  416ord_subtract([H1|T1], L2, Diff) :-
  417    diff21(L2, H1, T1, Diff).
  418
  419diff21([], H1, T1, [H1|T1]).
  420diff21([H2|T2], H1, T1, Diff) :-
  421    compare(Order, H1, H2),
  422    diff3(Order, H1, T1, H2, T2, Diff).
  423
  424diff12([], _H2, _T2, []).
  425diff12([H1|T1], H2, T2, Diff) :-
  426    compare(Order, H1, H2),
  427    diff3(Order, H1, T1, H2, T2, Diff).
  428
  429diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
  430    diff12(T1, H2, T2, Diff).
  431diff3(=, _H1, T1, _H2, T2, Diff) :-
  432    ord_subtract(T1, T2, Diff).
  433diff3(>,  H1, T1, _H2, T2, Diff) :-
  434    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.

  444merge_variable_info(State) :-
  445    catch(merge_variable_info_(State),
  446          error(uninstantiation_error(Term),_),
  447          throw(error(goal_expansion_error(bound, Term), _))).
  448
  449merge_variable_info_([]).
  450merge_variable_info_([Var=State|States]) :-
  451    (   get_attr(Var, '$var_info', CurrentState)
  452    ->  true
  453    ;   CurrentState = (-)
  454    ),
  455    merge_states(Var, State, CurrentState),
  456    merge_variable_info_(States).
  457
  458merge_states(_Var, State, State) :- !.
  459merge_states(_Var, -, _) :- !.
  460merge_states(Var, State, -) :-
  461    !,
  462    put_attr(Var, '$var_info', State).
  463merge_states(Var, Left, Right) :-
  464    (   get_dict(fresh, Left, false)
  465    ->  put_dict(fresh, Right, false)
  466    ;   get_dict(fresh, Right, false)
  467    ->  put_dict(fresh, Left, false)
  468    ),
  469    !,
  470    (   Left >:< Right
  471    ->  put_dict(Left, Right, State),
  472        put_attr(Var, '$var_info', State)
  473    ;   print_message(warning,
  474                      inconsistent_variable_properties(Left, Right)),
  475        put_dict(Left, Right, State),
  476        put_attr(Var, '$var_info', State)
  477    ).
  478
  479
  480save_variable_info([], []).
  481save_variable_info([Var|Vars], [Var=State|States]):-
  482    (   get_attr(Var, '$var_info', State)
  483    ->  true
  484    ;   State = (-)
  485    ),
  486    save_variable_info(Vars, States).
  487
  488restore_variable_info(State) :-
  489    catch(restore_variable_info_(State),
  490          error(uninstantiation_error(Term),_),
  491          throw(error(goal_expansion_error(bound, Term), _))).
  492
  493restore_variable_info_([]).
  494restore_variable_info_([Var=State|States]) :-
  495    (   State == (-)
  496    ->  del_attr(Var, '$var_info')
  497    ;   put_attr(Var, '$var_info', State)
  498    ),
  499    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.

  515var_property(Var, Property) :-
  516    prop_var(Property, Var).
  517
  518prop_var(fresh(Fresh), Var) :-
  519    (   get_attr(Var, '$var_info', Info),
  520        get_dict(fresh, Info, Fresh0)
  521    ->  Fresh = Fresh0
  522    ;   Fresh = true
  523    ).
  524prop_var(singleton(Singleton), Var) :-
  525    nb_current('$term', Term),
  526    term_singletons(Term, Singletons),
  527    (   '$member'(V, Singletons),
  528        V == Var
  529    ->  Singleton = true
  530    ;   Singleton = false
  531    ).
  532prop_var(name(Name), Var) :-
  533    (   nb_current('$variable_names', Bindings),
  534        '$member'(Name0=Var0, Bindings),
  535        Var0 == Var
  536    ->  Name = Name0
  537    ).
  538
  539
  540mark_vars_non_fresh([]) :- !.
  541mark_vars_non_fresh([Var|Vars]) :-
  542    (   get_attr(Var, '$var_info', Info)
  543    ->  (   get_dict(fresh, Info, false)
  544        ->  true
  545        ;   put_dict(fresh, Info, false, Info1),
  546            put_attr(Var, '$var_info', Info1)
  547        )
  548    ;   put_attr(Var, '$var_info', '$var_info'{fresh:false})
  549    ),
  550    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.

  561remove_attributes(Term, Attr) :-
  562    term_variables(Term, Vars),
  563    remove_var_attr(Vars, Attr).
  564
  565remove_var_attr([], _):- !.
  566remove_var_attr([Var|Vars], Attr):-
  567    del_attr(Var, Attr),
  568    remove_var_attr(Vars, Attr).

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

  574'$var_info':attr_unify_hook(_, _).
  575
  576
  577                 /*******************************
  578                 *   GOAL_EXPANSION/2 SUPPORT   *
  579                 *******************************/

 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.

  587expand_goal(A, B) :-
  588    expand_goal(A, _, B, _).
  589
  590expand_goal(A, P0, B, P) :-
  591    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  592    (   expand_goal(A, P0, B, P, MList, _)
  593    ->  remove_attributes(B, '$var_info'), A \== B
  594    ),
  595    !.
  596expand_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.

  605'$expand_closure'(G0, N, G) :-
  606    '$expand_closure'(G0, _, N, G, _).
  607
  608'$expand_closure'(G0, P0, N, G, P) :-
  609    length(Ex, N),
  610    mark_vars_non_fresh(Ex),
  611    extend_arg_pos(G0, P0, Ex, G1, P1),
  612    expand_goal(G1, P1, G2, P2),
  613    term_variables(G0, VL),
  614    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  615
  616
  617expand_goal(G0, P0, G, P, MList, Term) :-
  618    '$current_source_module'(M),
  619    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

  629% (*)   This is needed because call_goal_expansion may introduce extra
  630%       context variables.  Consider the code below, where the variable
  631%       E is introduced.  Is there a better representation for the
  632%       context?
  633%
  634%         ==
  635%         goal_expansion(catch_and_print(Goal), catch(Goal, E, print(E))).
  636%
  637%         test :-
  638%               catch_and_print(true).
  639%         ==
  640
  641expand_goal(G, P, G, P, _, _, _, _) :-
  642    var(G),
  643    !.
  644expand_goal(M:G, P, M:G, P, _M, _MList, _Term, _) :-
  645    var(M), var(G),
  646    !.
  647expand_goal(M:G, P0, M:EG, P, _M, _MList, Term, Done) :-
  648    atom(M),
  649    !,
  650    f2_pos(P0, PA, PB0, P, PA, PB),
  651    '$def_modules'(M:[goal_expansion/4,goal_expansion/2], MList),
  652    setup_call_cleanup(
  653        '$set_source_module'(Old, M),
  654        '$expand':expand_goal(G, PB0, EG, PB, M, MList, Term, Done),
  655        '$set_source_module'(Old)).
  656expand_goal(G0, P0, G, P, M, MList, Term, Done) :-
  657    (   already_expanded(G0, Done, Done1)
  658    ->  expand_control(G0, P0, G, P, M, MList, Term, Done1)
  659    ;   call_goal_expansion(MList, G0, P0, G1, P1)
  660    ->  expand_goal(G1, P1, G, P, M, MList, Term/G1, [G0|Done])      % (*)
  661    ;   expand_control(G0, P0, G, P, M, MList, Term, Done)
  662    ).
  663
  664expand_control((A,B), P0, Conj, P, M, MList, Term, Done) :-
  665    !,
  666    f2_pos(P0, PA0, PB0, P1, PA, PB),
  667    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  668    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  669    simplify((EA,EB), P1, Conj, P).
  670expand_control((A;B), P0, Or, P, M, MList, Term, Done) :-
  671    !,
  672    f2_pos(P0, PA0, PB0, P1, PA1, PB),
  673    term_variables(A, AVars),
  674    term_variables(B, BVars),
  675    var_intersection(AVars, BVars, SharedVars),
  676    save_variable_info(SharedVars, SavedState),
  677    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  678    save_variable_info(SharedVars, SavedState2),
  679    restore_variable_info(SavedState),
  680    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  681    merge_variable_info(SavedState2),
  682    fixup_or_lhs(A, EA, PA, EA1, PA1),
  683    simplify((EA1;EB), P1, Or, P).
  684expand_control((A->B), P0, Goal, P, M, MList, Term, Done) :-
  685    !,
  686    f2_pos(P0, PA0, PB0, P1, PA, PB),
  687    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  688    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  689    simplify((EA->EB), P1, Goal, P).
  690expand_control((A*->B), P0, Goal, P, M, MList, Term, Done) :-
  691    !,
  692    f2_pos(P0, PA0, PB0, P1, PA, PB),
  693    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  694    expand_goal(B, PB0, EB, PB, M, MList, Term, Done),
  695    simplify((EA*->EB), P1, Goal, P).
  696expand_control((\+A), P0, Goal, P, M, MList, Term, Done) :-
  697    !,
  698    f1_pos(P0, PA0, P1, PA),
  699    term_variables(A, AVars),
  700    save_variable_info(AVars, SavedState),
  701    expand_goal(A, PA0, EA, PA, M, MList, Term, Done),
  702    restore_variable_info(SavedState),
  703    simplify(\+(EA), P1, Goal, P).
  704expand_control(call(A), P0, call(EA), P, M, MList, Term, Done) :-
  705    !,
  706    f1_pos(P0, PA0, P, PA),
  707    expand_goal(A, PA0, EA, PA, M, MList, Term, Done).
  708expand_control($(A), P0, $(EA), P, M, MList, Term, Done) :-
  709    !,
  710    f1_pos(P0, PA0, P, PA),
  711    expand_goal(A, PA0, EA, PA, M, MList, Term, Done).
  712expand_control(G0, P0, G, P, M, MList, Term, Done) :-
  713    is_meta_call(G0, M, Head),
  714    !,
  715    term_variables(G0, Vars),
  716    mark_vars_non_fresh(Vars),
  717    expand_meta(Head, G0, P0, G, P, M, MList, Term, Done).
  718expand_control(G0, P0, G, P, M, MList, Term, _Done) :-
  719    term_variables(G0, Vars),
  720    mark_vars_non_fresh(Vars),
  721    expand_functions(G0, P0, G, P, M, MList, Term).

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

  725already_expanded(Goal, Done, Done1) :-
  726    '$select'(G, Done, Done1),
  727    G == Goal,
  728    !.

 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)

  737fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  738    nonvar(Old),
  739    nonvar(New),
  740    (   Old = (_ -> _)
  741    ->  New \= (_ -> _),
  742        Fix = (New -> true)
  743    ;   New = (_ -> _),
  744        Fix = (New, true)
  745    ),
  746    !,
  747    lhs_pos(PNew, PFixed).
  748fixup_or_lhs(_Old, New, P, New, P).
  749
  750lhs_pos(P0, _) :-
  751    var(P0),
  752    !.
  753lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  754    arg(1, P0, F),
  755    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.

  762is_meta_call(G0, M, Head) :-
  763    compound(G0),
  764    default_module(M, M2),
  765    '$c_current_predicate'(_, M2:G0),
  766    !,
  767    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  768    has_meta_arg(Head).

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

  773expand_meta(Spec, G0, P0, G, P, M, MList, Term, Done) :-
  774    functor(Spec, _, Arity),
  775    functor(G0, Name, Arity),
  776    functor(G1, Name, Arity),
  777    f_pos(P0, ArgPos0, P, ArgPos),
  778    expand_meta(1, Arity, Spec,
  779                G0, ArgPos0, Eval,
  780                G1,  ArgPos,
  781                M, MList, Term, Done),
  782    conj(Eval, G1, G).
  783
  784expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, G, [P|PT], M, MList, Term, Done) :-
  785    I =< Arity,
  786    !,
  787    arg_pos(ArgPos0, P0, PT0),
  788    arg(I, Spec, Meta),
  789    arg(I, G0, A0),
  790    arg(I, G, A),
  791    expand_meta_arg(Meta, A0, P0, EvalA, A, P, M, MList, Term, Done),
  792    I2 is I + 1,
  793    expand_meta(I2, Arity, Spec, G0, PT0, EvalB, G, PT, M, MList, Term, Done),
  794    conj(EvalA, EvalB, Eval).
  795expand_meta(_, _, _, _, _, true, _, [], _, _, _, _).
  796
  797arg_pos(List, _, _) :- var(List), !.    % no position info
  798arg_pos([H|T], H, T) :- !.              % argument list
  799arg_pos([], _, []).                     % new has more
  800
  801mapex([], _).
  802mapex([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.

  809extended_pos(Var, _, Var) :-
  810    var(Var),
  811    !.
  812extended_pos(parentheses_term_position(O,C,Pos0),
  813             N,
  814             parentheses_term_position(O,C,Pos)) :-
  815    !,
  816    extended_pos(Pos0, N, Pos).
  817extended_pos(term_position(F,T,FF,FT,Args),
  818             _,
  819             term_position(F,T,FF,FT,Args)) :-
  820    var(Args),
  821    !.
  822extended_pos(term_position(F,T,FF,FT,Args0),
  823             N,
  824             term_position(F,T,FF,FT,Args)) :-
  825    length(Ex, N),
  826    mapex(Ex, T-T),
  827    '$append'(Args0, Ex, Args),
  828    !.
  829extended_pos(F-T,
  830             N,
  831             term_position(F,T,F,T,Ex)) :-
  832    !,
  833    length(Ex, N),
  834    mapex(Ex, T-T).
  835extended_pos(Pos, N, Pos) :-
  836    '$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.

  847expand_meta_arg(0, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  848    !,
  849    expand_goal(A0, PA0, A1, PA, M, MList, Term, Done),
  850    compile_meta_call(A1, A, M, Term).
  851expand_meta_arg(N, A0, P0, true, A, P, M, MList, Term, Done) :-
  852    integer(N), callable(A0),
  853    replace_functions(A0, true, _, M),
  854    !,
  855    length(Ex, N),
  856    mark_vars_non_fresh(Ex),
  857    extend_arg_pos(A0, P0, Ex, A1, PA1),
  858    expand_goal(A1, PA1, A2, PA2, M, MList, Term, Done),
  859    compile_meta_call(A2, A3, M, Term),
  860    term_variables(A0, VL),
  861    remove_arg_pos(A3, PA2, M, VL, Ex, A, P).
  862expand_meta_arg(^, A0, PA0, true, A, PA, M, MList, Term, Done) :-
  863    !,
  864    expand_setof_goal(A0, PA0, A, PA, M, MList, Term, Done).
  865expand_meta_arg(S, A0, _PA0, Eval, A, _PA, M, _MList, _Term, _Done) :-
  866    replace_functions(A0, Eval, A, M), % TBD: pass positions
  867    (   Eval == true
  868    ->  true
  869    ;   same_functor(A0, A)
  870    ->  true
  871    ;   meta_arg(S)
  872    ->  throw(error(context_error(function, meta_arg(S)), _))
  873    ;   true
  874    ).
  875
  876same_functor(T1, T2) :-
  877    compound(T1),
  878    !,
  879    compound(T2),
  880    compound_name_arity(T1, N, A),
  881    compound_name_arity(T2, N, A).
  882same_functor(T1, T2) :-
  883    atom(T1),
  884    T1 == T2.
  885
  886variant_sha1_nat(Term, Hash) :-
  887    copy_term_nat(Term, TNat),
  888    variant_sha1(TNat, Hash).
  889
  890wrap_meta_arguments(A0, M, VL, Ex, A) :-
  891    '$append'(VL, Ex, AV),
  892    variant_sha1_nat(A0+AV, Hash),
  893    atom_concat('__aux_wrapper_', Hash, AuxName),
  894    H =.. [AuxName|AV],
  895    compile_auxiliary_clause(M, (H :- A0)),
  896    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.

  903extend_arg_pos(A, P, _, A, P) :-
  904    var(A),
  905    !.
  906extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  907    !,
  908    f2_pos(P0, PM, PA0, P, PM, PA),
  909    extend_arg_pos(A0, PA0, Ex, A, PA).
  910extend_arg_pos(A0, P0, Ex, A, P) :-
  911    callable(A0),
  912    !,
  913    extend_term(A0, Ex, A),
  914    length(Ex, N),
  915    extended_pos(P0, N, P).
  916extend_arg_pos(A, P, _, A, P).
  917
  918extend_term(Atom, Extra, Term) :-
  919    atom(Atom),
  920    !,
  921    Term =.. [Atom|Extra].
  922extend_term(Term0, Extra, Term) :-
  923    compound_name_arguments(Term0, Name, Args0),
  924    '$append'(Args0, Extra, Args),
  925    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

  936remove_arg_pos(A, P, _, _, _, A, P) :-
  937    var(A),
  938    !.
  939remove_arg_pos(M:A0, P0, _, VL, Ex, M:A, P) :-
  940    !,
  941    f2_pos(P, PM, PA0, P0, PM, PA),
  942    remove_arg_pos(A0, PA, M, VL, Ex, A, PA0).
  943remove_arg_pos(A0, P0, M, VL, Ex0, A, P) :-
  944    callable(A0),
  945    !,
  946    length(Ex0, N),
  947    (   A0 =.. [F|Args],
  948        length(Ex, N),
  949        '$append'(Args0, Ex, Args),
  950        Ex==Ex0
  951    ->  extended_pos(P, N, P0),
  952        A =.. [F|Args0]
  953    ;   M \== [],
  954        wrap_meta_arguments(A0, M, VL, Ex0, A),
  955        wrap_meta_pos(P0, P)
  956    ).
  957remove_arg_pos(A, P, _, _, _, A, P).
  958
  959wrap_meta_pos(P0, P) :-
  960    (   nonvar(P0)
  961    ->  P = term_position(F,T,_,_,_),
  962        atomic_pos(P0, F-T)
  963    ;   true
  964    ).
  965
  966has_meta_arg(Head) :-
  967    arg(_, Head, Arg),
  968    direct_call_meta_arg(Arg),
  969    !.
  970
  971direct_call_meta_arg(I) :- integer(I).
  972direct_call_meta_arg(^).
  973
  974meta_arg(:).
  975meta_arg(//).
  976meta_arg(I) :- integer(I).
  977
  978expand_setof_goal(Var, Pos, Var, Pos, _, _, _, _) :-
  979    var(Var),
  980    !.
  981expand_setof_goal(V^G, P0, V^EG, P, M, MList, Term, Done) :-
  982    !,
  983    f2_pos(P0, PA0, PB, P, PA, PB),
  984    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  985expand_setof_goal(M0:G, P0, M0:EG, P, M, MList, Term, Done) :-
  986    !,
  987    f2_pos(P0, PA0, PB, P, PA, PB),
  988    expand_setof_goal(G, PA0, EG, PA, M, MList, Term, Done).
  989expand_setof_goal(G, P0, EG, P, M, MList, Term, Done) :-
  990    !,
  991    expand_goal(G, P0, EG0, P, M, MList, Term, Done),
  992    compile_meta_call(EG0, EG1, M, Term),
  993    (   extend_existential(G, EG1, V)
  994    ->  EG = V^EG1
  995    ;   EG = EG1
  996    ).

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

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

 1004extend_existential(G0, G1, V) :-
 1005    term_variables(G0, GV0), sort(GV0, SV0),
 1006    term_variables(G1, GV1), sort(GV1, SV1),
 1007    ord_subtract(SV1, SV0, New),
 1008    New \== [],
 1009    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.

 1019call_goal_expansion(MList, G0, P0, G, P) :-
 1020    current_prolog_flag(sandboxed_load, false),
 1021    !,
 1022    (   '$member'(M-Preds, MList),
 1023        '$member'(Pred, Preds),
 1024        (   Pred == goal_expansion/4
 1025        ->  M:goal_expansion(G0, P0, G, P)
 1026        ;   M:goal_expansion(G0, G),
 1027            P = P0
 1028        ),
 1029        G0 \== G
 1030    ->  true
 1031    ).
 1032call_goal_expansion(MList, G0, P0, G, P) :-
 1033    (   '$member'(M-Preds, MList),
 1034        '$member'(Pred, Preds),
 1035        (   Pred == goal_expansion/4
 1036        ->  Expand = M:goal_expansion(G0, P0, G, P)
 1037        ;   Expand = M:goal_expansion(G0, G)
 1038        ),
 1039        allowed_expansion(Expand),
 1040        call(Expand),
 1041        G0 \== G
 1042    ->  true
 1043    ).

 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.

 1053:- multifile
 1054    prolog:sandbox_allowed_expansion/1. 1055
 1056allowed_expansion(QGoal) :-
 1057    strip_module(QGoal, M, Goal),
 1058    E = error(Formal,_),
 1059    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
 1060    (   var(Formal)
 1061    ->  fail
 1062    ;   !,
 1063        print_message(error, E),
 1064        fail
 1065    ).
 1066allowed_expansion(_).
 1067
 1068
 1069                 /*******************************
 1070                 *      FUNCTIONAL NOTATION     *
 1071                 *******************************/

 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.

 1080expand_functions(G0, P0, G, P, M, MList, Term) :-
 1081    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
 1082    (   expand_arithmetic(G1, P1, G, P, Term)
 1083    ->  true
 1084    ;   G = G1,
 1085        P = P1
 1086    ).

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

To be done

- : position logic

- : make functions module-local

 1093expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
 1094    contains_functions(G0),
 1095    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
 1096    Eval \== true,
 1097    !,
 1098    wrap_var(G1, G1Pos, G2, G2Pos),
 1099    conj(Eval, EvalPos, G2, G2Pos, G, P).
 1100expand_functional_notation(G, P, G, P, _, _, _).
 1101
 1102wrap_var(G, P, G, P) :-
 1103    nonvar(G),
 1104    !.
 1105wrap_var(G, P0, call(G), P) :-
 1106    (   nonvar(P0)
 1107    ->  P = term_position(F,T,F,T,[P0]),
 1108        atomic_pos(P0, F-T)
 1109    ;   true
 1110    ).

 contains_functions(@Term) is semidet

True when Term contains a function reference.

 1116contains_functions(Term) :-
 1117    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1118            (   contains_functions2(Skeleton)
 1119            ;   contains_functions2(Assignments)
 1120            )).
 1121
 1122contains_functions2(Term) :-
 1123    compound(Term),
 1124    (   function(Term, _)
 1125    ->  true
 1126    ;   arg(_, Term, Arg),
 1127        contains_functions2(Arg)
 1128    ->  true
 1129    ).

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

To be done

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

 1138:- public
 1139    replace_functions/4.            % used in dicts.pl
 1140
 1141replace_functions(GoalIn, Eval, GoalOut, Context) :-
 1142    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
 1143
 1144replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
 1145    var(Var),
 1146    !.
 1147replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
 1148    function(F, Ctx),
 1149    !,
 1150    compound_name_arity(F, Name, Arity),
 1151    PredArity is Arity+1,
 1152    compound_name_arity(G, Name, PredArity),
 1153    arg(PredArity, G, Var),
 1154    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1155    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1156    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1157replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1158    compound(Term0),
 1159    !,
 1160    compound_name_arity(Term0, Name, Arity),
 1161    compound_name_arity(Term, Name, Arity),
 1162    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1163    map_functions(0, Arity,
 1164                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1165replace_functions(Term, Pos, true, _, Term, Pos, _).

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

 1172map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1173    !,
 1174    pos_nil(LPos0, LPos).
 1175map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1176    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1177    I is I0+1,
 1178    arg(I, Term0, Arg0),
 1179    arg(I, Term, Arg),
 1180    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1181    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1182    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1183
 1184conj(true, X, X) :- !.
 1185conj(X, true, X) :- !.
 1186conj(X, Y, (X,Y)).
 1187
 1188conj(true, _, X, P, X, P) :- !.
 1189conj(X, P, true, _, X, P) :- !.
 1190conj(X, PX, Y, PY, (X,Y), _) :-
 1191    var(PX), var(PY),
 1192    !.
 1193conj(X, PX, Y, PY, (X,Y), P) :-
 1194    P = term_position(F,T,FF,FT,[PX,PY]),
 1195    atomic_pos(PX, F-FF),
 1196    atomic_pos(PY, FT-T).

 function(?Term, +Context)

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

 1203:- multifile
 1204    function/2. 1205
 1206function(.(_,_), _) :- \+ functor([_|_], ., _).
 1207
 1208
 1209                 /*******************************
 1210                 *          ARITHMETIC          *
 1211                 *******************************/

 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.

 1221expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1222
 1223
 1224                 /*******************************
 1225                 *        POSITION LOGIC        *
 1226                 *******************************/

 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.

 1236f2_pos(Var, _, _, _, _, _) :-
 1237    var(Var),
 1238    !.
 1239f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1240       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1241f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1242       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1243    !,
 1244    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1245f2_pos(Pos, _, _, _, _, _) :-
 1246    expected_layout(f2, Pos).
 1247
 1248f1_pos(Var, _, _, _) :-
 1249    var(Var),
 1250    !.
 1251f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1252       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1253f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1254       parentheses_term_position(O,C,Pos),  A1) :-
 1255    !,
 1256    f1_pos(Pos0, A10, Pos, A1).
 1257f1_pos(Pos, _, _, _) :-
 1258    expected_layout(f1, Pos).
 1259
 1260f_pos(Var, _, _, _) :-
 1261    var(Var),
 1262    !.
 1263f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1264      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1265f_pos(parentheses_term_position(O,C,Pos0), A10,
 1266      parentheses_term_position(O,C,Pos),  A1) :-
 1267    !,
 1268    f_pos(Pos0, A10, Pos, A1).
 1269f_pos(Pos, _, _, _) :-
 1270    expected_layout(compound, Pos).
 1271
 1272atomic_pos(Pos, _) :-
 1273    var(Pos),
 1274    !.
 1275atomic_pos(Pos, F-T) :-
 1276    arg(1, Pos, F),
 1277    arg(2, Pos, T).

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

 1284pos_nil(Var, _) :- var(Var), !.
 1285pos_nil([], []) :- !.
 1286pos_nil(Pos, _) :-
 1287    expected_layout(nil, Pos).
 1288
 1289pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1290pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1291pos_list(Pos, _, _, _, _, _) :-
 1292    expected_layout(list, Pos).

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

Deal with extending a function to include the return value.

 1298extend_1_pos(Pos, _, _, _, _) :-
 1299    var(Pos),
 1300    !.
 1301extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1302             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1303             FT-FT1) :-
 1304    integer(FT),
 1305    !,
 1306    FT1 is FT+1,
 1307    '$same_length'(FArgPos, GArgPos0),
 1308    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1309extend_1_pos(F-T, [],
 1310             term_position(F,T,F,T,[T-T1]), [],
 1311             T-T1) :-
 1312    integer(T),
 1313    !,
 1314    T1 is T+1.
 1315extend_1_pos(Pos, _, _, _, _) :-
 1316    expected_layout(callable, Pos).
 1317
 1318'$same_length'(List, List) :-
 1319    var(List),
 1320    !.
 1321'$same_length'([], []).
 1322'$same_length'([_|T0], [_|T]) :-
 1323    '$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.

 1333:- create_prolog_flag(debug_term_position, false, []). 1334
 1335expected_layout(Expected, Pos) :-
 1336    current_prolog_flag(debug_term_position, true),
 1337    !,
 1338    '$print_message'(warning, expected_layout(Expected, Pos)).
 1339expected_layout(_, _).
 1340
 1341
 1342                 /*******************************
 1343                 *    SIMPLIFICATION ROUTINES   *
 1344                 *******************************/

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

 1353simplify(Control, P, Control, P) :-
 1354    current_prolog_flag(optimise, false),
 1355    !.
 1356simplify(Control, P0, Simple, P) :-
 1357    simple(Control, P0, Simple, P),
 1358    !.
 1359simplify(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.

 1368simple((X,Y), P0, Conj, P) :-
 1369    (   true(X)
 1370    ->  Conj = Y,
 1371        f2_pos(P0, _, P, _, _, _)
 1372    ;   false(X)
 1373    ->  Conj = fail,
 1374        f2_pos(P0, P1, _, _, _, _),
 1375        atomic_pos(P1, P)
 1376    ;   true(Y)
 1377    ->  Conj = X,
 1378        f2_pos(P0, P, _, _, _, _)
 1379    ).
 1380simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1381    (   true(I)                     % because nothing happens if I and T
 1382    ->  ITE = T,                    % are unbound.
 1383        f2_pos(P0, P1, _, _, _, _),
 1384        f2_pos(P1, _, P, _, _, _)
 1385    ;   false(I)
 1386    ->  ITE = E,
 1387        f2_pos(P0, _, P, _, _, _)
 1388    ).
 1389simple((X;Y), P0, Or, P) :-
 1390    false(X),
 1391    Or = Y,
 1392    f2_pos(P0, _, P, _, _, _).
 1393
 1394true(X) :-
 1395    nonvar(X),
 1396    eval_true(X).
 1397
 1398false(X) :-
 1399    nonvar(X),
 1400    eval_false(X).

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

 1406eval_true(true).
 1407eval_true(otherwise).
 1408
 1409eval_false(fail).
 1410eval_false(false).
 1411
 1412
 1413                 /*******************************
 1414                 *         META CALLING         *
 1415                 *******************************/
 1416
 1417:- 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.

 1423compile_meta_call(CallIn, CallIn, _, Term) :-
 1424    var(Term),
 1425    !.                   % explicit call; no context
 1426compile_meta_call(CallIn, CallIn, _, _) :-
 1427    var(CallIn),
 1428    !.
 1429compile_meta_call(CallIn, CallIn, _, _) :-
 1430    (   current_prolog_flag(compile_meta_arguments, false)
 1431    ;   current_prolog_flag(xref, true)
 1432    ),
 1433    !.
 1434compile_meta_call(CallIn, CallIn, _, _) :-
 1435    strip_module(CallIn, _, Call),
 1436    (   is_aux_meta(Call)
 1437    ;   \+ control(Call),
 1438        (   '$c_current_predicate'(_, system:Call),
 1439            \+ current_prolog_flag(compile_meta_arguments, always)
 1440        ;   current_prolog_flag(compile_meta_arguments, control)
 1441        )
 1442    ),
 1443    !.
 1444compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1445    !,
 1446    (   atom(M), callable(CallIn)
 1447    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1448    ;   CallOut = M:CallIn
 1449    ).
 1450compile_meta_call(CallIn, CallOut, Module, Term) :-
 1451    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1452    compile_auxiliary_clause(Module, Clause).
 1453
 1454compile_auxiliary_clause(Module, Clause) :-
 1455    Clause = (Head:-Body),
 1456    '$current_source_module'(SM),
 1457    (   predicate_property(SM:Head, defined)
 1458    ->  true
 1459    ;   SM == Module
 1460    ->  compile_aux_clauses([Clause])
 1461    ;   compile_aux_clauses([Head:-Module:Body])
 1462    ).
 1463
 1464control((_,_)).
 1465control((_;_)).
 1466control((_->_)).
 1467control((_*->_)).
 1468control(\+(_)).
 1469control($(_)).
 1470
 1471is_aux_meta(Term) :-
 1472    callable(Term),
 1473    functor(Term, Name, _),
 1474    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1475
 1476compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1477    replace_subterm(CallIn, true, Term, Term2),
 1478    term_variables(Term2, AllVars),
 1479    term_variables(CallIn, InVars),
 1480    intersection_eq(InVars, AllVars, HeadVars),
 1481    copy_term_nat(CallIn+HeadVars, NAT),
 1482    variant_sha1(NAT, Hash),
 1483    atom_concat('__aux_meta_call_', Hash, AuxName),
 1484    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn), []),
 1485    length(HeadVars, Arity),
 1486    (   Arity > 256                 % avoid 1024 arity limit
 1487    ->  HeadArgs = [v(HeadVars)]
 1488    ;   HeadArgs = HeadVars
 1489    ),
 1490    CallOut =.. [AuxName|HeadArgs].