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-2024, 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(DCGRule, Pos0, Expanded, Pos) :-
  196    is_dcg(DCGRule),
  197    dcg_translate_rule(DCGRule, Pos0, Expanded0, Pos1),
  198    !,
  199    expand_bodies(Expanded0, Pos1, Expanded1, Pos),
  200    non_terminal_decl(Expanded1, Expanded).
  201expand_term_2(Term0, Pos0, Term, Pos) :-
  202    nonvar(Term0),
  203    !,
  204    expand_bodies(Term0, Pos0, Term, Pos).
  205expand_term_2(Term, Pos, Term, Pos).
  206
  207is_dcg(_-->_) => true.
  208is_dcg(_==>_) => true.
  209is_dcg(_)     => fail.
  210
  211non_terminal_decl(Clause, Decl) :-
  212    \+ current_prolog_flag(xref, true),
  213    clause_head(Clause, Head),
  214    '$current_source_module'(M),
  215    (   '$get_predicate_attribute'(M:Head, non_terminal, NT)
  216    ->  NT == 0
  217    ;   true
  218    ),
  219    !,
  220    '$pi_head'(PI, Head),
  221    Decl = [:-(non_terminal(M:PI)), Clause].
  222non_terminal_decl(Clause, Clause).
  223
  224clause_head(Head:-_, Head) :- !.
  225clause_head((Head,_=>_), Head) :- !.
  226clause_head(Head=>_, Head) :- !.
  227clause_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.

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

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

  331add_source_location(Clauses0, SrcLoc, Clauses) :-
  332    (   is_list(Clauses0)
  333    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  334    ;   Clauses = SrcLoc:Clauses0
  335    ).
  336
  337add_source_location_list([], _, []).
  338add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  339    add_source_location_list(Clauses0, SrcLoc, Clauses).

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

  343expand_term_list(_, [], _, [], []) :- !.
  344expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  345    !,
  346    expand_terms(C, H0, PH0, H, PH),
  347    add_term(H, PH, Terms, TT, PosL, PT),
  348    expand_term_list(C, T0, [PH0], TT, PT).
  349expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  350    !,
  351    expand_terms(C, H0, PH0, H, PH),
  352    add_term(H, PH, Terms, TT, PosL, PT),
  353    expand_term_list(C, T0, PT0, TT, PT).
  354expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  355    expected_layout(list, PH0),
  356    expand_terms(C, H0, PH0, H, PH),
  357    add_term(H, PH, Terms, TT, PosL, PT),
  358    expand_term_list(C, T0, [PH0], TT, PT).

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

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

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

Shared is the ordered intersection of List1 and List2.

  400var_intersection(List1, List2, Intersection) :-
  401    sort(List1, Set1),
  402    sort(List2, Set2),
  403    ord_intersection(Set1, Set2, Intersection).

 ord_intersection(+OSet1, +OSet2, -Int)

Ordered list intersection. Copied from the library.

  409ord_intersection([], _Int, []).
  410ord_intersection([H1|T1], L2, Int) :-
  411    isect2(L2, H1, T1, Int).
  412
  413isect2([], _H1, _T1, []).
  414isect2([H2|T2], H1, T1, Int) :-
  415    compare(Order, H1, H2),
  416    isect3(Order, H1, T1, H2, T2, Int).
  417
  418isect3(<, _H1, T1,  H2, T2, Int) :-
  419    isect2(T1, H2, T2, Int).
  420isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  421    ord_intersection(T1, T2, Int).
  422isect3(>, H1, T1,  _H2, T2, Int) :-
  423    isect2(T2, H1, T1, Int).

 ord_subtract(+Set, +Subtract, -Diff)

  427ord_subtract([], _Not, []).
  428ord_subtract(S1, S2, Diff) :-
  429    S1 == S2,
  430    !,
  431    Diff = [].
  432ord_subtract([H1|T1], L2, Diff) :-
  433    diff21(L2, H1, T1, Diff).
  434
  435diff21([], H1, T1, [H1|T1]).
  436diff21([H2|T2], H1, T1, Diff) :-
  437    compare(Order, H1, H2),
  438    diff3(Order, H1, T1, H2, T2, Diff).
  439
  440diff12([], _H2, _T2, []).
  441diff12([H1|T1], H2, T2, Diff) :-
  442    compare(Order, H1, H2),
  443    diff3(Order, H1, T1, H2, T2, Diff).
  444
  445diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
  446    diff12(T1, H2, T2, Diff).
  447diff3(=, _H1, T1, _H2, T2, Diff) :-
  448    ord_subtract(T1, T2, Diff).
  449diff3(>,  H1, T1, _H2, T2, Diff) :-
  450    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.

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

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

  577remove_attributes(Term, Attr) :-
  578    term_variables(Term, Vars),
  579    remove_var_attr(Vars, Attr).
  580
  581remove_var_attr([], _):- !.
  582remove_var_attr([Var|Vars], Attr):-
  583    del_attr(Var, Attr),
  584    remove_var_attr(Vars, Attr).

 $var_info:attr_unify_hook(_, _) is det

Dummy unification hook for attributed variables. Just succeeds.

  590'$var_info':attr_unify_hook(_, _).
  591
  592
  593                 /*******************************
  594                 *   GOAL_EXPANSION/2 SUPPORT   *
  595                 *******************************/

 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.

  603expand_goal(A, B) :-
  604    expand_goal(A, _, B, _).
  605
  606expand_goal(A, P0, B, P) :-
  607    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  608    (   expand_goal(A, P0, B, P, MList, _)
  609    ->  remove_attributes(B, '$var_info'), A \== B
  610    ),
  611    !.
  612expand_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.

  621'$expand_closure'(G0, N, G) :-
  622    '$expand_closure'(G0, _, N, G, _).
  623
  624'$expand_closure'(G0, P0, N, G, P) :-
  625    length(Ex, N),
  626    mark_vars_non_fresh(Ex),
  627    extend_arg_pos(G0, P0, Ex, G1, P1),
  628    expand_goal(G1, P1, G2, P2),
  629    term_variables(G0, VL),
  630    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  631
  632
  633expand_goal(G0, P0, G, P, MList, Term) :-
  634    '$current_source_module'(M),
  635    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

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

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

  741already_expanded(Goal, Done, Done1) :-
  742    '$select'(G, Done, Done1),
  743    G == Goal,
  744    !.

 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)

  753fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  754    nonvar(Old),
  755    nonvar(New),
  756    (   Old = (_ -> _)
  757    ->  New \= (_ -> _),
  758        Fix = (New -> true)
  759    ;   New = (_ -> _),
  760        Fix = (New, true)
  761    ),
  762    !,
  763    lhs_pos(PNew, PFixed).
  764fixup_or_lhs(_Old, New, P, New, P).
  765
  766lhs_pos(P0, _) :-
  767    var(P0),
  768    !.
  769lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  770    arg(1, P0, F),
  771    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.

  778is_meta_call(G0, M, Head) :-
  779    compound(G0),
  780    default_module(M, M2),
  781    '$c_current_predicate'(_, M2:G0),
  782    !,
  783    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  784    has_meta_arg(Head).

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

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

  826extended_pos(Var, _, Var) :-
  827    var(Var),
  828    !.
  829extended_pos(parentheses_term_position(O,C,Pos0),
  830             N,
  831             parentheses_term_position(O,C,Pos)) :-
  832    !,
  833    extended_pos(Pos0, N, Pos).
  834extended_pos(term_position(F,T,FF,FT,Args),
  835             _,
  836             term_position(F,T,FF,FT,Args)) :-
  837    var(Args),
  838    !.
  839extended_pos(term_position(F,T,FF,FT,Args0),
  840             N,
  841             term_position(F,T,FF,FT,Args)) :-
  842    length(Ex, N),
  843    mapex(Ex, T-T),
  844    '$append'(Args0, Ex, Args),
  845    !.
  846extended_pos(F-T,
  847             N,
  848             term_position(F,T,F,T,Ex)) :-
  849    !,
  850    length(Ex, N),
  851    mapex(Ex, T-T).
  852extended_pos(Pos, N, Pos) :-
  853    '$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.

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

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

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

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

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

 1021extend_existential(G0, G1, V) :-
 1022    term_variables(G0, GV0), sort(GV0, SV0),
 1023    term_variables(G1, GV1), sort(GV1, SV1),
 1024    ord_subtract(SV1, SV0, New),
 1025    New \== [],
 1026    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.

 1036call_goal_expansion(MList, G0, P0, G, P) :-
 1037    current_prolog_flag(sandboxed_load, false),
 1038    !,
 1039    (   '$member'(M-Preds, MList),
 1040        '$member'(Pred, Preds),
 1041        (   Pred == goal_expansion/4
 1042        ->  M:goal_expansion(G0, P0, G, P)
 1043        ;   M:goal_expansion(G0, G),
 1044            P = P0
 1045        ),
 1046        G0 \== G
 1047    ->  true
 1048    ).
 1049call_goal_expansion(MList, G0, P0, G, P) :-
 1050    (   '$member'(M-Preds, MList),
 1051        '$member'(Pred, Preds),
 1052        (   Pred == goal_expansion/4
 1053        ->  Expand = M:goal_expansion(G0, P0, G, P)
 1054        ;   Expand = M:goal_expansion(G0, G)
 1055        ),
 1056        allowed_expansion(Expand),
 1057        call(Expand),
 1058        G0 \== G
 1059    ->  true
 1060    ).

 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.

 1070:- multifile
 1071    prolog:sandbox_allowed_expansion/1. 1072
 1073allowed_expansion(QGoal) :-
 1074    strip_module(QGoal, M, Goal),
 1075    E = error(Formal,_),
 1076    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
 1077    (   var(Formal)
 1078    ->  fail
 1079    ;   !,
 1080        print_message(error, E),
 1081        fail
 1082    ).
 1083allowed_expansion(_).
 1084
 1085
 1086                 /*******************************
 1087                 *      FUNCTIONAL NOTATION     *
 1088                 *******************************/

 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.

 1097expand_functions(G0, P0, G, P, M, MList, Term) :-
 1098    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
 1099    (   expand_arithmetic(G1, P1, G, P, Term)
 1100    ->  true
 1101    ;   G = G1,
 1102        P = P1
 1103    ).

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

To be done

- : position logic

- : make functions module-local

 1110expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
 1111    contains_functions(G0),
 1112    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
 1113    Eval \== true,
 1114    !,
 1115    wrap_var(G1, G1Pos, G2, G2Pos),
 1116    conj(Eval, EvalPos, G2, G2Pos, G, P).
 1117expand_functional_notation(G, P, G, P, _, _, _).
 1118
 1119wrap_var(G, P, G, P) :-
 1120    nonvar(G),
 1121    !.
 1122wrap_var(G, P0, call(G), P) :-
 1123    (   nonvar(P0)
 1124    ->  P = term_position(F,T,F,T,[P0]),
 1125        atomic_pos(P0, F-T)
 1126    ;   true
 1127    ).

 contains_functions(@Term) is semidet

True when Term contains a function reference.

 1133contains_functions(Term) :-
 1134    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
 1135            (   contains_functions2(Skeleton)
 1136            ;   contains_functions2(Assignments)
 1137            )).
 1138
 1139contains_functions2(Term) :-
 1140    compound(Term),
 1141    (   function(Term, _)
 1142    ->  true
 1143    ;   arg(_, Term, Arg),
 1144        contains_functions2(Arg)
 1145    ->  true
 1146    ).

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

To be done

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

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

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

 1189map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1190    !,
 1191    pos_nil(LPos0, LPos).
 1192map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1193    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1194    I is I0+1,
 1195    arg(I, Term0, Arg0),
 1196    arg(I, Term, Arg),
 1197    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1198    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1199    conj(Eval0, EP0, Eval1, EP1, Eval, EP).

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

 1203conj(true, _, X, P, X, P) :- !.
 1204conj(X, P, true, _, X, P) :- !.
 1205conj(X, PX, Y, PY, (X,Y), _) :-
 1206    var(PX), var(PY),
 1207    !.
 1208conj(X, PX, Y, PY, (X,Y), P) :-
 1209    P = term_position(F,T,FF,FT,[PX,PY]),
 1210    atomic_pos(PX, F-FF),
 1211    atomic_pos(PY, FT-T).

 function(?Term, +Context)

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

 1218:- multifile
 1219    function/2. 1220
 1221function(.(_,_), _) :- \+ functor([_|_], ., _).
 1222
 1223
 1224                 /*******************************
 1225                 *          ARITHMETIC          *
 1226                 *******************************/

 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.

 1236expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1237
 1238
 1239                 /*******************************
 1240                 *        POSITION LOGIC        *
 1241                 *******************************/

 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.

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

 pos_nil(+Nil, -Nil) is det

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

Position propagation for lists.

 1299pos_nil(Var, _) :- var(Var), !.
 1300pos_nil([], []) :- !.
 1301pos_nil(Pos, _) :-
 1302    expected_layout(nil, Pos).
 1303
 1304pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1305pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1306pos_list(Pos, _, _, _, _, _) :-
 1307    expected_layout(list, Pos).

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

Deal with extending a function to include the return value.

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

 1348:- create_prolog_flag(debug_term_position, false, []). 1349
 1350expected_layout(Expected, Pos) :-
 1351    current_prolog_flag(debug_term_position, true),
 1352    !,
 1353    '$print_message'(warning, expected_layout(Expected, Pos)).
 1354expected_layout(_, _).
 1355
 1356
 1357                 /*******************************
 1358                 *    SIMPLIFICATION ROUTINES   *
 1359                 *******************************/

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

Simplify control structures

To be done

- Much more analysis

- Turn this into a separate module

 1368simplify(Control, P, Control, P) :-
 1369    current_prolog_flag(optimise, false),
 1370    !.
 1371simplify(Control, P0, Simple, P) :-
 1372    simple(Control, P0, Simple, P),
 1373    !.
 1374simplify(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.

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