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

   72:- dynamic
   73    system:term_expansion/2,
   74    system:goal_expansion/2,
   75    user:term_expansion/2,
   76    user:goal_expansion/2,
   77    system:term_expansion/4,
   78    system:goal_expansion/4,
   79    user:term_expansion/4,
   80    user:goal_expansion/4.   81:- multifile
   82    system:term_expansion/2,
   83    system:goal_expansion/2,
   84    user:term_expansion/2,
   85    user:goal_expansion/2,
   86    system:term_expansion/4,
   87    system:goal_expansion/4,
   88    user:term_expansion/4,
   89    user:goal_expansion/4.   90:- '$notransact'((system:term_expansion/2,
   91                  system:goal_expansion/2,
   92                  user:term_expansion/2,
   93                  user:goal_expansion/2,
   94                  system:term_expansion/4,
   95                  system:goal_expansion/4,
   96                  user:term_expansion/4,
   97                  user:goal_expansion/4)).   98
   99:- meta_predicate
  100    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.

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

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

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

  300expand_terms(_, X, P, X, P) :-
  301    var(X),
  302    !.
  303expand_terms(C, List0, Pos0, List, Pos) :-
  304    nonvar(List0),
  305    List0 = [_|_],
  306    !,
  307    (   is_list(List0)
  308    ->  list_pos(Pos0, Elems0, Pos, Elems),
  309        expand_term_list(C, List0, Elems0, List, Elems)
  310    ;   '$type_error'(list, List0)
  311    ).
  312expand_terms(C, '$source_location'(File, Line):Clause0, Pos0, Clause, Pos) :-
  313    !,
  314    expand_terms(C, Clause0, Pos0, Clause1, Pos),
  315    add_source_location(Clause1, '$source_location'(File, Line), Clause).
  316expand_terms(C, Term0, Pos0, Term, Pos) :-
  317    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.

  324add_source_location(Clauses0, SrcLoc, Clauses) :-
  325    (   is_list(Clauses0)
  326    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  327    ;   Clauses = SrcLoc:Clauses0
  328    ).
  329
  330add_source_location_list([], _, []).
  331add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  332    add_source_location_list(Clauses0, SrcLoc, Clauses).

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

  336expand_term_list(_, [], _, [], []) :- !.
  337expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  338    !,
  339    expand_terms(C, H0, PH0, H, PH),
  340    add_term(H, PH, Terms, TT, PosL, PT),
  341    expand_term_list(C, T0, [PH0], TT, PT).
  342expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  343    !,
  344    expand_terms(C, H0, PH0, H, PH),
  345    add_term(H, PH, Terms, TT, PosL, PT),
  346    expand_term_list(C, T0, PT0, TT, PT).
  347expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  348    expected_layout(list, PH0),
  349    expand_terms(C, H0, PH0, H, PH),
  350    add_term(H, PH, Terms, TT, PosL, PT),
  351    expand_term_list(C, T0, [PH0], TT, PT).

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

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

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

Shared is the ordered intersection of List1 and List2.

  393var_intersection(List1, List2, Intersection) :-
  394    sort(List1, Set1),
  395    sort(List2, Set2),
  396    ord_intersection(Set1, Set2, Intersection).

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

  402ord_intersection([], _Int, []).
  403ord_intersection([H1|T1], L2, Int) :-
  404    isect2(L2, H1, T1, Int).
  405
  406isect2([], _H1, _T1, []).
  407isect2([H2|T2], H1, T1, Int) :-
  408    compare(Order, H1, H2),
  409    isect3(Order, H1, T1, H2, T2, Int).
  410
  411isect3(<, _H1, T1,  H2, T2, Int) :-
  412    isect2(T1, H2, T2, Int).
  413isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  414    ord_intersection(T1, T2, Int).
  415isect3(>, H1, T1,  _H2, T2, Int) :-
  416    isect2(T2, H1, T1, Int).

 ord_subtract(+Set, +Subtract, -Diff)

  420ord_subtract([], _Not, []).
  421ord_subtract(S1, S2, Diff) :-
  422    S1 == S2,
  423    !,
  424    Diff = [].
  425ord_subtract([H1|T1], L2, Diff) :-
  426    diff21(L2, H1, T1, Diff).
  427
  428diff21([], H1, T1, [H1|T1]).
  429diff21([H2|T2], H1, T1, Diff) :-
  430    compare(Order, H1, H2),
  431    diff3(Order, H1, T1, H2, T2, Diff).
  432
  433diff12([], _H2, _T2, []).
  434diff12([H1|T1], H2, T2, Diff) :-
  435    compare(Order, H1, H2),
  436    diff3(Order, H1, T1, H2, T2, Diff).
  437
  438diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
  439    diff12(T1, H2, T2, Diff).
  440diff3(=, _H1, T1, _H2, T2, Diff) :-
  441    ord_subtract(T1, T2, Diff).
  442diff3(>,  H1, T1, _H2, T2, Diff) :-
  443    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.

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

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

  570remove_attributes(Term, Attr) :-
  571    term_variables(Term, Vars),
  572    remove_var_attr(Vars, Attr).
  573
  574remove_var_attr([], _):- !.
  575remove_var_attr([Var|Vars], Attr):-
  576    del_attr(Var, Attr),
  577    remove_var_attr(Vars, Attr).

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

  583'$var_info':attr_unify_hook(_, _).
  584
  585
  586                 /*******************************
  587                 *   GOAL_EXPANSION/2 SUPPORT   *
  588                 *******************************/

 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.

  596expand_goal(A, B) :-
  597    expand_goal(A, _, B, _).
  598
  599expand_goal(A, P0, B, P) :-
  600    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  601    (   expand_goal(A, P0, B, P, MList, _)
  602    ->  remove_attributes(B, '$var_info'), A \== B
  603    ),
  604    !.
  605expand_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.

  614'$expand_closure'(G0, N, G) :-
  615    '$expand_closure'(G0, _, N, G, _).
  616
  617'$expand_closure'(G0, P0, N, G, P) :-
  618    length(Ex, N),
  619    mark_vars_non_fresh(Ex),
  620    extend_arg_pos(G0, P0, Ex, G1, P1),
  621    expand_goal(G1, P1, G2, P2),
  622    term_variables(G0, VL),
  623    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  624
  625
  626expand_goal(G0, P0, G, P, MList, Term) :-
  627    '$current_source_module'(M),
  628    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

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

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

  734already_expanded(Goal, Done, Done1) :-
  735    '$select'(G, Done, Done1),
  736    G == Goal,
  737    !.

 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)

  746fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  747    nonvar(Old),
  748    nonvar(New),
  749    (   Old = (_ -> _)
  750    ->  New \= (_ -> _),
  751        Fix = (New -> true)
  752    ;   New = (_ -> _),
  753        Fix = (New, true)
  754    ),
  755    !,
  756    lhs_pos(PNew, PFixed).
  757fixup_or_lhs(_Old, New, P, New, P).
  758
  759lhs_pos(P0, _) :-
  760    var(P0),
  761    !.
  762lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  763    arg(1, P0, F),
  764    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.

  771is_meta_call(G0, M, Head) :-
  772    compound(G0),
  773    default_module(M, M2),
  774    '$c_current_predicate'(_, M2:G0),
  775    !,
  776    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  777    has_meta_arg(Head).

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

  782expand_meta(Spec, G0, P0, G, P, M, MList, Term, Done) :-
  783    functor(Spec, _, Arity),
  784    functor(G0, Name, Arity),
  785    functor(G1, Name, Arity),
  786    f_pos(P0, ArgPos0, G1P, ArgPos),
  787    expand_meta(1, Arity, Spec,
  788                G0, ArgPos0, Eval, EvalPos,
  789                G1,  ArgPos,
  790                M, MList, Term, Done),
  791    conj(Eval, EvalPos, G1, G1P, G, P).
  792
  793expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, EvalPos, G, [P|PT],
  794            M, MList, Term, Done) :-
  795    I =< Arity,
  796    !,
  797    arg_pos(ArgPos0, P0, PT0),
  798    arg(I, Spec, Meta),
  799    arg(I, G0, A0),
  800    arg(I, G, A),
  801    expand_meta_arg(Meta, A0, P0, EvalA, EPA, A, P, M, MList, Term, Done),
  802    I2 is I + 1,
  803    expand_meta(I2, Arity, Spec, G0, PT0, EvalB,EPB, G, PT, M, MList, Term, Done),
  804    conj(EvalA, EPA, EvalB, EPB, Eval, EvalPos).
  805expand_meta(_, _, _, _, _, true, _, _, [], _, _, _, _).
  806
  807arg_pos(List, _, _) :- var(List), !.    % no position info
  808arg_pos([H|T], H, T) :- !.              % argument list
  809arg_pos([], _, []).                     % new has more
  810
  811mapex([], _).
  812mapex([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.

  819extended_pos(Var, _, Var) :-
  820    var(Var),
  821    !.
  822extended_pos(parentheses_term_position(O,C,Pos0),
  823             N,
  824             parentheses_term_position(O,C,Pos)) :-
  825    !,
  826    extended_pos(Pos0, N, Pos).
  827extended_pos(term_position(F,T,FF,FT,Args),
  828             _,
  829             term_position(F,T,FF,FT,Args)) :-
  830    var(Args),
  831    !.
  832extended_pos(term_position(F,T,FF,FT,Args0),
  833             N,
  834             term_position(F,T,FF,FT,Args)) :-
  835    length(Ex, N),
  836    mapex(Ex, T-T),
  837    '$append'(Args0, Ex, Args),
  838    !.
  839extended_pos(F-T,
  840             N,
  841             term_position(F,T,F,T,Ex)) :-
  842    !,
  843    length(Ex, N),
  844    mapex(Ex, T-T).
  845extended_pos(Pos, N, Pos) :-
  846    '$print_message'(warning, extended_pos(Pos, N)).

 expand_meta_arg(+MetaSpec, +Arg0, +ArgPos0, -Eval, -EvalPos, -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.

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

  913extend_arg_pos(A, P, _, A, P) :-
  914    var(A),
  915    !.
  916extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  917    !,
  918    f2_pos(P0, PM, PA0, P, PM, PA),
  919    extend_arg_pos(A0, PA0, Ex, A, PA).
  920extend_arg_pos(A0, P0, Ex, A, P) :-
  921    callable(A0),
  922    !,
  923    extend_term(A0, Ex, A),
  924    length(Ex, N),
  925    extended_pos(P0, N, P).
  926extend_arg_pos(A, P, _, A, P).
  927
  928extend_term(Atom, Extra, Term) :-
  929    atom(Atom),
  930    !,
  931    Term =.. [Atom|Extra].
  932extend_term(Term0, Extra, Term) :-
  933    compound_name_arguments(Term0, Name, Args0),
  934    '$append'(Args0, Extra, Args),
  935    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

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

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

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

 1014extend_existential(G0, G1, V) :-
 1015    term_variables(G0, GV0), sort(GV0, SV0),
 1016    term_variables(G1, GV1), sort(GV1, SV1),
 1017    ord_subtract(SV1, SV0, New),
 1018    New \== [],
 1019    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.

 1029call_goal_expansion(MList, G0, P0, G, P) :-
 1030    current_prolog_flag(sandboxed_load, false),
 1031    !,
 1032    (   '$member'(M-Preds, MList),
 1033        '$member'(Pred, Preds),
 1034        (   Pred == goal_expansion/4
 1035        ->  M:goal_expansion(G0, P0, G, P)
 1036        ;   M:goal_expansion(G0, G),
 1037            P = P0
 1038        ),
 1039        G0 \== G
 1040    ->  true
 1041    ).
 1042call_goal_expansion(MList, G0, P0, G, P) :-
 1043    (   '$member'(M-Preds, MList),
 1044        '$member'(Pred, Preds),
 1045        (   Pred == goal_expansion/4
 1046        ->  Expand = M:goal_expansion(G0, P0, G, P)
 1047        ;   Expand = M:goal_expansion(G0, G)
 1048        ),
 1049        allowed_expansion(Expand),
 1050        call(Expand),
 1051        G0 \== G
 1052    ->  true
 1053    ).

 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.

 1063:- multifile
 1064    prolog:sandbox_allowed_expansion/1. 1065
 1066allowed_expansion(QGoal) :-
 1067    strip_module(QGoal, M, Goal),
 1068    E = error(Formal,_),
 1069    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
 1070    (   var(Formal)
 1071    ->  fail
 1072    ;   !,
 1073        print_message(error, E),
 1074        fail
 1075    ).
 1076allowed_expansion(_).
 1077
 1078
 1079                 /*******************************
 1080                 *      FUNCTIONAL NOTATION     *
 1081                 *******************************/

 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.

 1090expand_functions(G0, P0, G, P, M, MList, Term) :-
 1091    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
 1092    (   expand_arithmetic(G1, P1, G, P, Term)
 1093    ->  true
 1094    ;   G = G1,
 1095        P = P1
 1096    ).

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

To be done

- : position logic

- : make functions module-local

 1103expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
 1104    contains_functions(G0),
 1105    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
 1106    Eval \== true,
 1107    !,
 1108    wrap_var(G1, G1Pos, G2, G2Pos),
 1109    conj(Eval, EvalPos, G2, G2Pos, G, P).
 1110expand_functional_notation(G, P, G, P, _, _, _).
 1111
 1112wrap_var(G, P, G, P) :-
 1113    nonvar(G),
 1114    !.
 1115wrap_var(G, P0, call(G), P) :-
 1116    (   nonvar(P0)
 1117    ->  P = term_position(F,T,F,T,[P0]),
 1118        atomic_pos(P0, F-T)
 1119    ;   true
 1120    ).

 contains_functions(@Term) is semidet

True when Term contains a function reference.

 1126contains_functions(Term) :-
 1127    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1128            (   contains_functions2(Skeleton)
 1129            ;   contains_functions2(Assignments)
 1130            )).
 1131
 1132contains_functions2(Term) :-
 1133    compound(Term),
 1134    (   function(Term, _)
 1135    ->  true
 1136    ;   arg(_, Term, Arg),
 1137        contains_functions2(Arg)
 1138    ->  true
 1139    ).

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

To be done

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

 1148:- public
 1149    replace_functions/4.            % used in dicts.pl
 1150
 1151replace_functions(GoalIn, Eval, GoalOut, Context) :-
 1152    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
 1153
 1154replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
 1155    var(Var),
 1156    !.
 1157replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
 1158    function(F, Ctx),
 1159    !,
 1160    compound_name_arity(F, Name, Arity),
 1161    PredArity is Arity+1,
 1162    compound_name_arity(G, Name, PredArity),
 1163    arg(PredArity, G, Var),
 1164    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
 1165    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
 1166    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
 1167replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
 1168    compound(Term0),
 1169    !,
 1170    compound_name_arity(Term0, Name, Arity),
 1171    compound_name_arity(Term, Name, Arity),
 1172    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
 1173    map_functions(0, Arity,
 1174                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1175replace_functions(Term, Pos, true, _, Term, Pos, _).

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

 1182map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1183    !,
 1184    pos_nil(LPos0, LPos).
 1185map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1186    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1187    I is I0+1,
 1188    arg(I, Term0, Arg0),
 1189    arg(I, Term, Arg),
 1190    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1191    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1192    conj(Eval0, EP0, Eval1, EP1, Eval, EP).

 conj(+G1, +P1, +G2, +P2, -G, -P)

 1196conj(true, _, X, P, X, P) :- !.
 1197conj(X, P, true, _, X, P) :- !.
 1198conj(X, PX, Y, PY, (X,Y), _) :-
 1199    var(PX), var(PY),
 1200    !.
 1201conj(X, PX, Y, PY, (X,Y), P) :-
 1202    P = term_position(F,T,FF,FT,[PX,PY]),
 1203    atomic_pos(PX, F-FF),
 1204    atomic_pos(PY, FT-T).

 function(?Term, +Context)

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

 1211:- multifile
 1212    function/2. 1213
 1214function(.(_,_), _) :- \+ functor([_|_], ., _).
 1215
 1216
 1217                 /*******************************
 1218                 *          ARITHMETIC          *
 1219                 *******************************/

 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.

 1229expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1230
 1231
 1232                 /*******************************
 1233                 *        POSITION LOGIC        *
 1234                 *******************************/

 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.

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

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

 1292pos_nil(Var, _) :- var(Var), !.
 1293pos_nil([], []) :- !.
 1294pos_nil(Pos, _) :-
 1295    expected_layout(nil, Pos).
 1296
 1297pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1298pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1299pos_list(Pos, _, _, _, _, _) :-
 1300    expected_layout(list, Pos).

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

Deal with extending a function to include the return value.

 1306extend_1_pos(Pos, _, _, _, _) :-
 1307    var(Pos),
 1308    !.
 1309extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1310             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1311             FT-FT1) :-
 1312    integer(FT),
 1313    !,
 1314    FT1 is FT+1,
 1315    '$same_length'(FArgPos, GArgPos0),
 1316    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1317extend_1_pos(F-T, [],
 1318             term_position(F,T,F,T,[T-T1]), [],
 1319             T-T1) :-
 1320    integer(T),
 1321    !,
 1322    T1 is T+1.
 1323extend_1_pos(Pos, _, _, _, _) :-
 1324    expected_layout(callable, Pos).
 1325
 1326'$same_length'(List, List) :-
 1327    var(List),
 1328    !.
 1329'$same_length'([], []).
 1330'$same_length'([_|T0], [_|T]) :-
 1331    '$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.

 1341:- create_prolog_flag(debug_term_position, false, []). 1342
 1343expected_layout(Expected, Pos) :-
 1344    current_prolog_flag(debug_term_position, true),
 1345    !,
 1346    '$print_message'(warning, expected_layout(Expected, Pos)).
 1347expected_layout(_, _).
 1348
 1349
 1350                 /*******************************
 1351                 *    SIMPLIFICATION ROUTINES   *
 1352                 *******************************/

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

 1361simplify(Control, P, Control, P) :-
 1362    current_prolog_flag(optimise, false),
 1363    !.
 1364simplify(Control, P0, Simple, P) :-
 1365    simple(Control, P0, Simple, P),
 1366    !.
 1367simplify(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.

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

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

 1414eval_true(true).
 1415eval_true(otherwise).
 1416
 1417eval_false(fail).
 1418eval_false(false).
 1419
 1420
 1421                 /*******************************
 1422                 *         META CALLING         *
 1423                 *******************************/
 1424
 1425:- create_prolog_flag(compile_meta_arguments, false, [type(atom)]).