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).
  381list_pos(Pos, [Pos], Elems, Elems).
  382
  383
  384                 /*******************************
  385                 *      VAR_INFO/3 SUPPORT      *
  386                 *******************************/

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

Shared is the ordered intersection of List1 and List2.

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

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

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

 ord_subtract(+Set, +Subtract, -Diff)

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

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

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

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

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

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

 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.

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

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

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

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

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

 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)

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

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

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

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

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

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

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

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

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

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

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

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

 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.

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

 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.

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

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

To be done

- : position logic

- : make functions module-local

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

 contains_functions(@Term) is semidet

True when Term contains a function reference.

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

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

To be done

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

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

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

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

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

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

 function(?Term, +Context)

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

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

 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.

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

 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.

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

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

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

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

Deal with extending a function to include the return value.

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

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

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

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

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

 eval_true(+Goal) is semidet

 eval_false(+Goal) is semidet

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