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            '$including'/0,
   45            '$expand_closure'/3         % +GoalIn, +Extra, -GoalOut
   46          ]).

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

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

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

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

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

  310add_source_location(Clauses0, SrcLoc, Clauses) :-
  311    (   is_list(Clauses0)
  312    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  313    ;   Clauses = SrcLoc:Clauses0
  314    ).
  315
  316add_source_location_list([], _, []).
  317add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  318    add_source_location_list(Clauses0, SrcLoc, Clauses).

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

  322expand_term_list(_, [], _, [], []) :- !.
  323expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  324    !,
  325    expand_terms(C, H0, PH0, H, PH),
  326    add_term(H, PH, Terms, TT, PosL, PT),
  327    expand_term_list(C, T0, [PH0], TT, PT).
  328expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  329    !,
  330    expand_terms(C, H0, PH0, H, PH),
  331    add_term(H, PH, Terms, TT, PosL, PT),
  332    expand_term_list(C, T0, PT0, TT, PT).
  333expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  334    expected_layout(list, PH0),
  335    expand_terms(C, H0, PH0, H, PH),
  336    add_term(H, PH, Terms, TT, PosL, PT),
  337    expand_term_list(C, T0, [PH0], TT, PT).

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

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

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

Shared is the ordered intersection of List1 and List2.

  378var_intersection(List1, List2, Intersection) :-
  379    sort(List1, Set1),
  380    sort(List2, Set2),
  381    ord_intersection(Set1, Set2, Intersection).

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

  387ord_intersection([], _Int, []).
  388ord_intersection([H1|T1], L2, Int) :-
  389    isect2(L2, H1, T1, Int).
  390
  391isect2([], _H1, _T1, []).
  392isect2([H2|T2], H1, T1, Int) :-
  393    compare(Order, H1, H2),
  394    isect3(Order, H1, T1, H2, T2, Int).
  395
  396isect3(<, _H1, T1,  H2, T2, Int) :-
  397    isect2(T1, H2, T2, Int).
  398isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  399    ord_intersection(T1, T2, Int).
  400isect3(>, H1, T1,  _H2, T2, Int) :-
  401    isect2(T2, H1, T1, Int).

 ord_subtract(+Set, +Subtract, -Diff)

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

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

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

  555remove_attributes(Term, Attr) :-
  556    term_variables(Term, Vars),
  557    remove_var_attr(Vars, Attr).
  558
  559remove_var_attr([], _):- !.
  560remove_var_attr([Var|Vars], Attr):-
  561    del_attr(Var, Attr),
  562    remove_var_attr(Vars, Attr).

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

  568'$var_info':attr_unify_hook(_, _).
  569
  570
  571                 /*******************************
  572                 *   GOAL_EXPANSION/2 SUPPORT   *
  573                 *******************************/

 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.

  581expand_goal(A, B) :-
  582    expand_goal(A, _, B, _).
  583
  584expand_goal(A, P0, B, P) :-
  585    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  586    (   expand_goal(A, P0, B, P, MList, _)
  587    ->  remove_attributes(B, '$var_info'), A \== B
  588    ),
  589    !.
  590expand_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.

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

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

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

  719already_expanded(Goal, Done, Done1) :-
  720    '$select'(G, Done, Done1),
  721    G == Goal,
  722    !.

 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)

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

  756is_meta_call(G0, M, Head) :-
  757    compound(G0),
  758    default_module(M, M2),
  759    '$c_current_predicate'(_, M2:G0),
  760    !,
  761    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  762    has_meta_arg(Head).

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

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

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

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

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

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

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

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

  998extend_existential(G0, G1, V) :-
  999    term_variables(G0, GV0), sort(GV0, SV0),
 1000    term_variables(G1, GV1), sort(GV1, SV1),
 1001    ord_subtract(SV1, SV0, New),
 1002    New \== [],
 1003    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.

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

 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.

 1047:- multifile
 1048    prolog:sandbox_allowed_expansion/1. 1049
 1050allowed_expansion(QGoal) :-
 1051    strip_module(QGoal, M, Goal),
 1052    E = error(Formal,_),
 1053    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
 1054    (   var(Formal)
 1055    ->  fail
 1056    ;   !,
 1057        print_message(error, E),
 1058        fail
 1059    ).
 1060allowed_expansion(_).
 1061
 1062
 1063                 /*******************************
 1064                 *      FUNCTIONAL NOTATION     *
 1065                 *******************************/

 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.

 1074expand_functions(G0, P0, G, P, M, MList, Term) :-
 1075    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
 1076    (   expand_arithmetic(G1, P1, G, P, Term)
 1077    ->  true
 1078    ;   G = G1,
 1079        P = P1
 1080    ).

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

To be done

- : position logic

- : make functions module-local

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

 contains_functions(@Term) is semidet

True when Term contains a function reference.

 1110contains_functions(Term) :-
 1111    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1112            (   contains_functions2(Skeleton)
 1113            ;   contains_functions2(Assignments)
 1114            )).
 1115
 1116contains_functions2(Term) :-
 1117    compound(Term),
 1118    (   function(Term, _)
 1119    ->  true
 1120    ;   arg(_, Term, Arg),
 1121        contains_functions2(Arg)
 1122    ->  true
 1123    ).

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

To be done

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

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

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

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

 function(?Term, +Context)

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

 1197:- multifile
 1198    function/2. 1199
 1200function(.(_,_), _) :- \+ functor([_|_], ., _).
 1201
 1202
 1203                 /*******************************
 1204                 *          ARITHMETIC          *
 1205                 *******************************/

 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.

 1215expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1216
 1217
 1218                 /*******************************
 1219                 *        POSITION LOGIC        *
 1220                 *******************************/

 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.

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

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

 1278pos_nil(Var, _) :- var(Var), !.
 1279pos_nil([], []) :- !.
 1280pos_nil(Pos, _) :-
 1281    expected_layout(nil, Pos).
 1282
 1283pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1284pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1285pos_list(Pos, _, _, _, _, _) :-
 1286    expected_layout(list, Pos).

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

Deal with extending a function to include the return value.

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

 1327:- create_prolog_flag(debug_term_position, false, []). 1328
 1329expected_layout(Expected, Pos) :-
 1330    current_prolog_flag(debug_term_position, true),
 1331    !,
 1332    '$print_message'(warning, expected_layout(Expected, Pos)).
 1333expected_layout(_, _).
 1334
 1335
 1336                 /*******************************
 1337                 *    SIMPLIFICATION ROUTINES   *
 1338                 *******************************/

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

 1347simplify(Control, P, Control, P) :-
 1348    current_prolog_flag(optimise, false),
 1349    !.
 1350simplify(Control, P0, Simple, P) :-
 1351    simple(Control, P0, Simple, P),
 1352    !.
 1353simplify(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.

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

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

 1400eval_true(true).
 1401eval_true(otherwise).
 1402
 1403eval_false(fail).
 1404eval_false(false).
 1405
 1406
 1407                 /*******************************
 1408                 *         META CALLING         *
 1409                 *******************************/
 1410
 1411:- 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.

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