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

   70:- dynamic
   71    system:term_expansion/2,
   72    system:goal_expansion/2,
   73    user:term_expansion/2,
   74    user:goal_expansion/2,
   75    system:term_expansion/4,
   76    system:goal_expansion/4,
   77    user:term_expansion/4,
   78    user:goal_expansion/4.   79:- multifile
   80    system:term_expansion/2,
   81    system:goal_expansion/2,
   82    user:term_expansion/2,
   83    user:goal_expansion/2,
   84    system:term_expansion/4,
   85    system:goal_expansion/4,
   86    user:term_expansion/4,
   87    user:goal_expansion/4.   88
   89:- meta_predicate
   90    expand_terms(4, +, ?, -, -).

 expand_term(+Input, -Output) is det

 expand_term(+Input, +Pos0, -Output, -Pos) is det

This predicate is used to translate terms as they are read from a source-file before they are added to the Prolog database.

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

 prepare_directive(+Directive) is det

Try to autoload goals associated with a directive such that we can allow for term expansion of autoloaded directives such as setting/4. Trying to do so shall raise no errors nor fail as the directive may be further expanded.

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

 expand_bodies(+Term, +Pos0, -Out, -Pos) is det

Find the body terms in Term and give them to expand_goal/2 for further processing. Note that we maintain status information about variables. Currently we only detect whether variables are fresh or not. See var_info/3.

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

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

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

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

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

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

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

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

Shared is the ordered intersection of List1 and List2.

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

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

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

 ord_subtract(+Set, +Subtract, -Diff)

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

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

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

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

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

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

 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.

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

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

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

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

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

 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)

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

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

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

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

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

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

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

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

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

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

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

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

 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.

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

 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.

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

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

To be done

- : position logic

- : make functions module-local

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

 contains_functions(@Term) is semidet

True when Term contains a function reference.

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

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

To be done

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

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

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

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

 function(?Term, +Context)

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

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

 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.

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

 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.

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

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

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

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

Deal with extending a function to include the return value.

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

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

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

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

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

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

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

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