View source with formatted comments or as raw
    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-2016, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module('$expand',
   37          [ expand_term/2,              % +Term0, -Term
   38            expand_goal/2,              % +Goal0, -Goal
   39            expand_term/4,              % +Term0, ?Pos0, -Term, -Pos
   40            expand_goal/4,              % +Goal0, ?Pos0, -Goal, -Pos
   41            var_property/2,             % +Var, ?Property
   42
   43            '$expand_closure'/3         % +GoalIn, +Extra, -GoalOut
   44          ]).   45
   46/** <module> Prolog source-code transformation
   47
   48This module specifies, together with dcg.pl, the transformation of terms
   49as they are read from a file before they are processed by the compiler.
   50
   51The toplevel is expand_term/2.  This uses three other translators:
   52
   53        * Conditional compilation
   54        * term_expansion/2 rules provided by the user
   55        * DCG expansion
   56
   57Note that this ordering implies  that conditional compilation directives
   58cannot be generated  by  term_expansion/2   rules:  they  must literally
   59appear in the source-code.
   60
   61Term-expansion may choose to overrule DCG   expansion.  If the result of
   62term-expansion is a DCG rule, the rule  is subject to translation into a
   63predicate.
   64
   65Next, the result is  passed  to   expand_bodies/2,  which  performs goal
   66expansion.
   67*/
   68
   69:- dynamic
   70    system:term_expansion/2,
   71    system:goal_expansion/2,
   72    user:term_expansion/2,
   73    user:goal_expansion/2,
   74    system:term_expansion/4,
   75    system:goal_expansion/4,
   76    user:term_expansion/4,
   77    user:goal_expansion/4.   78:- multifile
   79    system:term_expansion/2,
   80    system:goal_expansion/2,
   81    user:term_expansion/2,
   82    user:goal_expansion/2,
   83    system:term_expansion/4,
   84    system:goal_expansion/4,
   85    user:term_expansion/4,
   86    user:goal_expansion/4.   87
   88:- meta_predicate
   89    expand_terms(4, +, ?, -, -).   90
   91%!  expand_term(+Input, -Output) is det.
   92%!  expand_term(+Input, +Pos0, -Output, -Pos) is det.
   93%
   94%   This predicate is used to translate terms  as they are read from
   95%   a source-file before they are added to the Prolog database.
   96
   97expand_term(Term0, Term) :-
   98    expand_term(Term0, _, Term, _).
   99
  100expand_term(Var, Pos, Expanded, Pos) :-
  101    var(Var),
  102    !,
  103    Expanded = Var.
  104expand_term(Term, Pos0, [], Pos) :-
  105    cond_compilation(Term, X),
  106    X == [],
  107    !,
  108    atomic_pos(Pos0, Pos).
  109expand_term(Term, Pos0, Expanded, Pos) :-
  110    b_setval('$term', Term),
  111    '$def_modules'([term_expansion/4,term_expansion/2], MList),
  112    call_term_expansion(MList, Term, Pos0, Term1, Pos1),
  113    expand_term_2(Term1, Pos1, Term2, Pos),
  114    rename(Term2, Expanded),
  115    b_setval('$term', []).
  116
  117call_term_expansion([], Term, Pos, Term, Pos).
  118call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  119    current_prolog_flag(sandboxed_load, false),
  120    !,
  121    (   '$member'(Pred, Preds),
  122        (   Pred == term_expansion/2
  123        ->  M:term_expansion(Term0, Term1),
  124            Pos1 = Pos0
  125        ;   M:term_expansion(Term0, Pos0, Term1, Pos1)
  126        )
  127    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  128    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  129    ).
  130call_term_expansion([M-Preds|T], Term0, Pos0, Term, Pos) :-
  131    (   '$member'(Pred, Preds),
  132        (   Pred == term_expansion/2
  133        ->  allowed_expansion(M:term_expansion(Term0, Term1)),
  134            call(M:term_expansion(Term0, Term1)),
  135            Pos1 = Pos
  136        ;   allowed_expansion(M:term_expansion(Term0, Pos0, Term1, Pos1)),
  137            call(M:term_expansion(Term0, Pos0, Term1, Pos1))
  138        )
  139    ->  expand_terms(call_term_expansion(T), Term1, Pos1, Term, Pos)
  140    ;   call_term_expansion(T, Term0, Pos0, Term, Pos)
  141    ).
  142
  143expand_term_2((Head --> Body), Pos0, Expanded, Pos) :-
  144    dcg_translate_rule((Head --> Body), Pos0, Expanded0, Pos1),
  145    !,
  146    expand_bodies(Expanded0, Pos1, Expanded, Pos).
  147expand_term_2(Term0, Pos0, Term, Pos) :-
  148    nonvar(Term0),
  149    !,
  150    expand_bodies(Term0, Pos0, Term, Pos).
  151expand_term_2(Term, Pos, Term, Pos).
  152
  153%!  expand_bodies(+Term, +Pos0, -Out, -Pos) is det.
  154%
  155%   Find the body terms in Term and   give them to expand_goal/2 for
  156%   further processing. Note that  we   maintain  status information
  157%   about variables. Currently we only  detect whether variables are
  158%   _fresh_ or not. See var_info/3.
  159
  160expand_bodies(Terms, Pos0, Out, Pos) :-
  161    '$def_modules'([goal_expansion/4,goal_expansion/2], MList),
  162    expand_terms(expand_body(MList), Terms, Pos0, Out, Pos),
  163    remove_attributes(Out, '$var_info').
  164
  165expand_body(MList, (Head0 :- Body), Pos0, (Head :- ExpandedBody), Pos) :-
  166    !,
  167    term_variables(Head0, HVars),
  168    mark_vars_non_fresh(HVars),
  169    f2_pos(Pos0, HPos, BPos0, Pos, HPos, BPos),
  170    expand_goal(Body, BPos0, ExpandedBody0, BPos, MList, (Head0 :- Body)),
  171    (   compound(Head0),
  172        '$current_source_module'(M),
  173        replace_functions(Head0, Eval, Head, M),
  174        Eval \== true
  175    ->  ExpandedBody = (Eval,ExpandedBody0)
  176    ;   Head = Head0,
  177        ExpandedBody = ExpandedBody0
  178    ).
  179expand_body(MList, (:- Body), Pos0, (:- ExpandedBody), Pos) :-
  180    !,
  181    f1_pos(Pos0, BPos0, Pos, BPos),
  182    expand_goal(Body, BPos0, ExpandedBody, BPos, MList, (:- Body)).
  183
  184expand_body(_MList, Head0, Pos, Clause, Pos) :- % TBD: Position handling
  185    compound(Head0),
  186    '$current_source_module'(M),
  187    replace_functions(Head0, Eval, Head, M),
  188    Eval \== true,
  189    !,
  190    Clause = (Head :- Eval).
  191expand_body(_, Head, Pos, Head, Pos).
  192
  193
  194%!  expand_terms(:Closure, +In, +Pos0, -Out, -Pos)
  195%
  196%   Loop over two constructs that  can   be  added by term-expansion
  197%   rules in order to run the   next phase: calling term_expansion/2
  198%   can  return  a  list  and  terms    may   be  preceeded  with  a
  199%   source-location.
  200
  201expand_terms(_, X, P, X, P) :-
  202    var(X),
  203    !.
  204expand_terms(C, List0, Pos0, List, Pos) :-
  205    nonvar(List0),
  206    List0 = [_|_],
  207    !,
  208    (   is_list(List0)
  209    ->  list_pos(Pos0, Elems0, Pos, Elems),
  210        expand_term_list(C, List0, Elems0, List, Elems)
  211    ;   '$type_error'(list, List0)
  212    ).
  213expand_terms(C, '$source_location'(File, Line):Clause0, Pos0, Clause, Pos) :-
  214    !,
  215    expand_terms(C, Clause0, Pos0, Clause1, Pos),
  216    add_source_location(Clause1, '$source_location'(File, Line), Clause).
  217expand_terms(C, Term0, Pos0, Term, Pos) :-
  218    call(C, Term0, Pos0, Term, Pos).
  219
  220%!  add_source_location(+Term, +SrcLoc, -SrcTerm)
  221%
  222%   Re-apply source location after term expansion.  If the result is
  223%   a list, claim all terms to originate from this location.
  224
  225add_source_location(Clauses0, SrcLoc, Clauses) :-
  226    (   is_list(Clauses0)
  227    ->  add_source_location_list(Clauses0, SrcLoc, Clauses)
  228    ;   Clauses = SrcLoc:Clauses0
  229    ).
  230
  231add_source_location_list([], _, []).
  232add_source_location_list([Clause|Clauses0], SrcLoc, [SrcLoc:Clause|Clauses]) :-
  233    add_source_location_list(Clauses0, SrcLoc, Clauses).
  234
  235%!  expand_term_list(:Expander, +TermList, +Pos, -NewTermList, -PosList)
  236
  237expand_term_list(_, [], _, [], []) :- !.
  238expand_term_list(C, [H0|T0], [PH0], Terms, PosL) :-
  239    !,
  240    expand_terms(C, H0, PH0, H, PH),
  241    add_term(H, PH, Terms, TT, PosL, PT),
  242    expand_term_list(C, T0, [PH0], TT, PT).
  243expand_term_list(C, [H0|T0], [PH0|PT0], Terms, PosL) :-
  244    !,
  245    expand_terms(C, H0, PH0, H, PH),
  246    add_term(H, PH, Terms, TT, PosL, PT),
  247    expand_term_list(C, T0, PT0, TT, PT).
  248expand_term_list(C, [H0|T0], PH0, Terms, PosL) :-
  249    expected_layout(list, PH0),
  250    expand_terms(C, H0, PH0, H, PH),
  251    add_term(H, PH, Terms, TT, PosL, PT),
  252    expand_term_list(C, T0, [PH0], TT, PT).
  253
  254%!  add_term(+ExpandOut, ?ExpandPosOut, -Terms, ?TermsT, -PosL, ?PosLT)
  255
  256add_term(List, Pos, Terms, TermT, PosL, PosT) :-
  257    nonvar(List), List = [_|_],
  258    !,
  259    (   is_list(List)
  260    ->  append_tp(List, Terms, TermT, Pos, PosL, PosT)
  261    ;   '$type_error'(list, List)
  262    ).
  263add_term(Term, Pos, [Term|Terms], Terms, [Pos|PosT], PosT).
  264
  265append_tp([], Terms, Terms, _, PosL, PosL).
  266append_tp([H|T0], [H|T1], Terms, [HP], [HP|TP1], PosL) :-
  267    !,
  268    append_tp(T0, T1, Terms, [HP], TP1, PosL).
  269append_tp([H|T0], [H|T1], Terms, [HP0|TP0], [HP0|TP1], PosL) :-
  270    !,
  271    append_tp(T0, T1, Terms, TP0, TP1, PosL).
  272append_tp([H|T0], [H|T1], Terms, Pos, [Pos|TP1], PosL) :-
  273    expected_layout(list, Pos),
  274    append_tp(T0, T1, Terms, [Pos], TP1, PosL).
  275
  276
  277list_pos(Var, _, _, _) :-
  278    var(Var),
  279    !.
  280list_pos(list_position(F,T,Elems0,none), Elems0,
  281         list_position(F,T,Elems,none),  Elems).
  282list_pos(Pos, [Pos], Elems, Elems).
  283
  284
  285                 /*******************************
  286                 *      VAR_INFO/3 SUPPORT      *
  287                 *******************************/
  288
  289%!  var_intersection(+List1, +List2, -Shared) is det.
  290%
  291%   Shared is the ordered intersection of List1 and List2.
  292
  293var_intersection(List1, List2, Intersection) :-
  294    sort(List1, Set1),
  295    sort(List2, Set2),
  296    ord_intersection(Set1, Set2, Intersection).
  297
  298%!  ord_intersection(+OSet1, +OSet2, -Int)
  299%
  300%   Ordered list intersection.  Copied from the library.
  301
  302ord_intersection([], _Int, []).
  303ord_intersection([H1|T1], L2, Int) :-
  304    isect2(L2, H1, T1, Int).
  305
  306isect2([], _H1, _T1, []).
  307isect2([H2|T2], H1, T1, Int) :-
  308    compare(Order, H1, H2),
  309    isect3(Order, H1, T1, H2, T2, Int).
  310
  311isect3(<, _H1, T1,  H2, T2, Int) :-
  312    isect2(T1, H2, T2, Int).
  313isect3(=, H1, T1, _H2, T2, [H1|Int]) :-
  314    ord_intersection(T1, T2, Int).
  315isect3(>, H1, T1,  _H2, T2, Int) :-
  316    isect2(T2, H1, T1, Int).
  317
  318
  319%!  merge_variable_info(+Saved)
  320%
  321%   Merge info from two branches. The  info   in  Saved is the saved
  322%   info from the  first  branch,  while   the  info  in  the actual
  323%   variables is the  info  in  the   second  branch.  Only  if both
  324%   branches claim the variable to  be   fresh,  we  can consider it
  325%   fresh.
  326
  327merge_variable_info([]).
  328merge_variable_info([Var=State|States]) :-
  329    (   get_attr(Var, '$var_info', CurrentState)
  330    ->  true
  331    ;   CurrentState = (-)
  332    ),
  333    merge_states(Var, State, CurrentState),
  334    merge_variable_info(States).
  335
  336merge_states(_Var, State, State) :- !.
  337merge_states(_Var, -, _) :- !.
  338merge_states(Var, State, -) :-
  339    !,
  340    put_attr(Var, '$var_info', State).
  341merge_states(Var, Left, Right) :-
  342    (   get_dict(fresh, Left, false)
  343    ->  put_dict(fresh, Right, false)
  344    ;   get_dict(fresh, Right, false)
  345    ->  put_dict(fresh, Left, false)
  346    ),
  347    !,
  348    (   Left >:< Right
  349    ->  put_dict(Left, Right, State),
  350        put_attr(Var, '$var_info', State)
  351    ;   print_message(warning,
  352                      inconsistent_variable_properties(Left, Right)),
  353        put_dict(Left, Right, State),
  354        put_attr(Var, '$var_info', State)
  355    ).
  356
  357
  358save_variable_info([], []).
  359save_variable_info([Var|Vars], [Var=State|States]):-
  360    (   get_attr(Var, '$var_info', State)
  361    ->  true
  362    ;   State = (-)
  363    ),
  364    save_variable_info(Vars, States).
  365
  366restore_variable_info([]).
  367restore_variable_info([Var=State|States]) :-
  368    (   State == (-)
  369    ->  del_attr(Var, '$var_info')
  370    ;   put_attr(Var, '$var_info', State)
  371    ),
  372    restore_variable_info(States).
  373
  374%!  var_property(+Var, ?Property)
  375%
  376%   True when Var has a property  Key with Value. Defined properties
  377%   are:
  378%
  379%     - fresh(Fresh)
  380%     Variable is first introduced in this goal and thus guaranteed
  381%     to be unbound.  This property is always present.
  382%     - singleton(Bool)
  383%     It `true` indicate that the variable appears once in the source.
  384%     Note this doesn't mean it is a semantic singleton.
  385%     - name(-Name)
  386%     True when Name is the name of the variable.
  387
  388var_property(Var, Property) :-
  389    prop_var(Property, Var).
  390
  391prop_var(fresh(Fresh), Var) :-
  392    (   get_attr(Var, '$var_info', Info),
  393        get_dict(fresh, Info, Fresh0)
  394    ->  Fresh = Fresh0
  395    ;   Fresh = true
  396    ).
  397prop_var(singleton(Singleton), Var) :-
  398    get_attr(Var, '$var_info', Info),
  399    get_dict(singleton, Info, Singleton).
  400prop_var(name(Name), Var) :-
  401    (   nb_current('$variable_names', Bindings),
  402        '$member'(Name0=Var0, Bindings),
  403        Var0 == Var
  404    ->  Name = Name0
  405    ).
  406
  407
  408mark_vars_non_fresh([]) :- !.
  409mark_vars_non_fresh([Var|Vars]) :-
  410    (   get_attr(Var, '$var_info', Info)
  411    ->  (   get_dict(fresh, Info, false)
  412        ->  true
  413        ;   put_dict(fresh, Info, false, Info1),
  414            put_attr(Var, '$var_info', Info1)
  415        )
  416    ;   put_attr(Var, '$var_info', '$var_info'{fresh:false})
  417    ),
  418    mark_vars_non_fresh(Vars).
  419
  420
  421%!  remove_attributes(+Term, +Attribute) is det.
  422%
  423%   Remove all variable attributes Attribute from Term. This is used
  424%   to make term_expansion end with a  clean term. This is currently
  425%   _required_ for saving directives  in   QLF  files.  The compiler
  426%   ignores attributes, but I think  it   is  cleaner to remove them
  427%   anyway.
  428
  429remove_attributes(Term, Attr) :-
  430    term_variables(Term, Vars),
  431    remove_var_attr(Vars, Attr).
  432
  433remove_var_attr([], _):- !.
  434remove_var_attr([Var|Vars], Attr):-
  435    del_attr(Var, Attr),
  436    remove_var_attr(Vars, Attr).
  437
  438%!  '$var_info':attr_unify_hook(_,_) is det.
  439%
  440%   Dummy unification hook for attributed variables.  Just succeeds.
  441
  442'$var_info':attr_unify_hook(_, _).
  443
  444
  445                 /*******************************
  446                 *   GOAL_EXPANSION/2 SUPPORT   *
  447                 *******************************/
  448
  449%!  expand_goal(+BodyTerm, +Pos0, -Out, -Pos) is det.
  450%!  expand_goal(+BodyTerm, -Out) is det.
  451%
  452%   Perform   macro-expansion   on    body     terms    by   calling
  453%   goal_expansion/2.
  454
  455expand_goal(A, B) :-
  456    expand_goal(A, _, B, _).
  457
  458expand_goal(A, P0, B, P) :-
  459    '$def_modules'([goal_expansion/4, goal_expansion/2], MList),
  460    (   expand_goal(A, P0, B, P, MList, _)
  461    ->  remove_attributes(B, '$var_info'), A \== B
  462    ),
  463    !.
  464expand_goal(A, P, A, P).
  465
  466%!  '$expand_closure'(+BodyIn, +ExtraArgs, -BodyOut) is semidet.
  467%!  '$expand_closure'(+BodyIn, +PIn, +ExtraArgs, -BodyOut, -POut) is semidet.
  468%
  469%   Expand a closure using goal expansion  for some extra arguments.
  470%   Note that the extra argument must remain  at the end. If this is
  471%   not the case, '$expand_closure'/3,5 fail.
  472
  473'$expand_closure'(G0, N, G) :-
  474    '$expand_closure'(G0, _, N, G, _).
  475
  476'$expand_closure'(G0, P0, N, G, P) :-
  477    length(Ex, N),
  478    mark_vars_non_fresh(Ex),
  479    extend_arg_pos(G0, P0, Ex, G1, P1),
  480    expand_goal(G1, P1, G2, P2),
  481    term_variables(G0, VL),
  482    remove_arg_pos(G2, P2, [], VL, Ex, G, P).
  483
  484
  485expand_goal(G0, P0, G, P, MList, Term) :-
  486    '$current_source_module'(M),
  487    expand_goal(G0, P0, G, P, M, MList, Term).
  488
  489%!  expand_goal(+GoalIn, ?PosIn, -GoalOut, -PosOut,
  490%!              +Module, -ModuleList, +Term) is det.
  491%
  492%   @param Module is the current module to consider
  493%   @param ModuleList are the other expansion modules
  494%   @param Term is the overall term that is being translated
  495
  496% (*)   This is needed because call_goal_expansion may introduce extra
  497%       context variables.  Consider the code below, where the variable
  498%       E is introduced.  Is there a better representation for the
  499%       context?
  500%
  501%         ==
  502%         goal_expansion(catch_and_print(Goal), catch(Goal, E, print(E))).
  503%
  504%         test :-
  505%               catch_and_print(true).
  506%         ==
  507
  508expand_goal(G, P, G, P, _, _, _) :-
  509    var(G),
  510    !.
  511expand_goal(M:G, P, M:G, P, _M, _MList, _Term) :-
  512    var(M), var(G),
  513    !.
  514expand_goal(M:G, P0, M:EG, P, _M, _MList, Term) :-
  515    atom(M),
  516    !,
  517    f2_pos(P0, PA, PB0, P, PA, PB),
  518    '$def_modules'(M:[goal_expansion/4,goal_expansion/2], MList),
  519    setup_call_cleanup(
  520        '$set_source_module'(Old, M),
  521        '$expand':expand_goal(G, PB0, EG, PB, M, MList, Term),
  522        '$set_source_module'(Old)).
  523expand_goal(G0, P0, G, P, M, MList, Term) :-
  524    call_goal_expansion(MList, G0, P0, G1, P1),
  525    !,
  526    expand_goal(G1, P1, G, P, M, MList, Term/G1).           % (*)
  527expand_goal((A,B), P0, Conj, P, M, MList, Term) :-
  528    !,
  529    f2_pos(P0, PA0, PB0, P1, PA, PB),
  530    expand_goal(A, PA0, EA, PA, M, MList, Term),
  531    expand_goal(B, PB0, EB, PB, M, MList, Term),
  532    simplify((EA,EB), P1, Conj, P).
  533expand_goal((A;B), P0, Or, P, M, MList, Term) :-
  534    !,
  535    f2_pos(P0, PA0, PB0, P1, PA1, PB),
  536    term_variables(A, AVars),
  537    term_variables(B, BVars),
  538    var_intersection(AVars, BVars, SharedVars),
  539    save_variable_info(SharedVars, SavedState),
  540    expand_goal(A, PA0, EA, PA, M, MList, Term),
  541    save_variable_info(SharedVars, SavedState2),
  542    restore_variable_info(SavedState),
  543    expand_goal(B, PB0, EB, PB, M, MList, Term),
  544    merge_variable_info(SavedState2),
  545    fixup_or_lhs(A, EA, PA, EA1, PA1),
  546    simplify((EA1;EB), P1, Or, P).
  547expand_goal((A->B), P0, Goal, P, M, MList, Term) :-
  548    !,
  549    f2_pos(P0, PA0, PB0, P1, PA, PB),
  550    expand_goal(A, PA0, EA, PA, M, MList, Term),
  551    expand_goal(B, PB0, EB, PB, M, MList, Term),
  552    simplify((EA->EB), P1, Goal, P).
  553expand_goal((A*->B), P0, Goal, P, M, MList, Term) :-
  554    !,
  555    f2_pos(P0, PA0, PB0, P1, PA, PB),
  556    expand_goal(A, PA0, EA, PA, M, MList, Term),
  557    expand_goal(B, PB0, EB, PB, M, MList, Term),
  558    simplify((EA*->EB), P1, Goal, P).
  559expand_goal((\+A), P0, Goal, P, M, MList, Term) :-
  560    !,
  561    f1_pos(P0, PA0, P1, PA),
  562    term_variables(A, AVars),
  563    save_variable_info(AVars, SavedState),
  564    expand_goal(A, PA0, EA, PA, M, MList, Term),
  565    restore_variable_info(SavedState),
  566    simplify(\+(EA), P1, Goal, P).
  567expand_goal(call(A), P0, call(EA), P, M, MList, Term) :-
  568    !,
  569    f1_pos(P0, PA0, P, PA),
  570    expand_goal(A, PA0, EA, PA, M, MList, Term).
  571expand_goal(G0, P0, G, P, M, MList, Term) :-
  572    is_meta_call(G0, M, Head),
  573    !,
  574    term_variables(G0, Vars),
  575    mark_vars_non_fresh(Vars),
  576    expand_meta(Head, G0, P0, G, P, M, MList, Term).
  577expand_goal(G0, P0, G, P, M, MList, Term) :-
  578    term_variables(G0, Vars),
  579    mark_vars_non_fresh(Vars),
  580    expand_functions(G0, P0, G, P, M, MList, Term).
  581
  582%!  fixup_or_lhs(+OldLeft, -ExpandedLeft, +ExpPos, -Fixed, -FixedPos) is det.
  583%
  584%   The semantics of (A;B) is different if  A is (If->Then). We need
  585%   to keep the same semantics if -> is introduced or removed by the
  586%   expansion. If -> is introduced, we make sure that the whole
  587%   thing remains a disjunction by creating ((EA,true);B)
  588
  589fixup_or_lhs(Old, New, PNew, Fix, PFixed) :-
  590    nonvar(Old),
  591    nonvar(New),
  592    (   Old = (_ -> _)
  593    ->  New \= (_ -> _),
  594        Fix = (New -> true)
  595    ;   New = (_ -> _),
  596        Fix = (New, true)
  597    ),
  598    !,
  599    lhs_pos(PNew, PFixed).
  600fixup_or_lhs(_Old, New, P, New, P).
  601
  602lhs_pos(P0, _) :-
  603    var(P0),
  604    !.
  605lhs_pos(P0, term_position(F,T,T,T,[P0,T-T])) :-
  606    arg(1, P0, F),
  607    arg(2, P0, T).
  608
  609
  610%!  is_meta_call(+G0, +M, +Head) is semidet.
  611%
  612%   True if M:G0 resolves to a real meta-goal as specified by Head.
  613
  614is_meta_call(G0, M, Head) :-
  615    compound(G0),
  616    default_module(M, M2),
  617    '$c_current_predicate'(_, M2:G0),
  618    !,
  619    '$get_predicate_attribute'(M2:G0, meta_predicate, Head),
  620    has_meta_arg(Head).
  621
  622
  623%!  expand_meta(+MetaSpec, +G0, ?P0, -G, -P, +M, +Mlist, +Term)
  624
  625expand_meta(Spec, G0, P0, G, P, M, MList, Term) :-
  626    functor(Spec, _, Arity),
  627    functor(G0, Name, Arity),
  628    functor(G1, Name, Arity),
  629    f_pos(P0, ArgPos0, P, ArgPos),
  630    expand_meta(1, Arity, Spec,
  631                G0, ArgPos0, Eval,
  632                G1,  ArgPos,
  633                M, MList, Term),
  634    conj(Eval, G1, G).
  635
  636expand_meta(I, Arity, Spec, G0, ArgPos0, Eval, G, [P|PT], M, MList, Term) :-
  637    I =< Arity,
  638    !,
  639    arg_pos(ArgPos0, P0, PT0),
  640    arg(I, Spec, Meta),
  641    arg(I, G0, A0),
  642    arg(I, G, A),
  643    expand_meta_arg(Meta, A0, P0, EvalA, A, P, M, MList, Term),
  644    I2 is I + 1,
  645    expand_meta(I2, Arity, Spec, G0, PT0, EvalB, G, PT, M, MList, Term),
  646    conj(EvalA, EvalB, Eval).
  647expand_meta(_, _, _, _, _, true, _, [], _, _, _).
  648
  649arg_pos(List, _, _) :- var(List), !.    % no position info
  650arg_pos([H|T], H, T) :- !.              % argument list
  651arg_pos([], _, []).                     % new has more
  652
  653mapex([], _).
  654mapex([E|L], E) :- mapex(L, E).
  655
  656%!  extended_pos(+Pos0, +N, -Pos) is det.
  657%!  extended_pos(-Pos0, +N, +Pos) is det.
  658%
  659%   Pos is the result of adding N extra positions to Pos0.
  660
  661extended_pos(Var, _, Var) :-
  662    var(Var),
  663    !.
  664extended_pos(parentheses_term_position(O,C,Pos0),
  665             N,
  666             parentheses_term_position(O,C,Pos)) :-
  667    !,
  668    extended_pos(Pos0, N, Pos).
  669extended_pos(term_position(F,T,FF,FT,Args),
  670             _,
  671             term_position(F,T,FF,FT,Args)) :-
  672    var(Args),
  673    !.
  674extended_pos(term_position(F,T,FF,FT,Args0),
  675             N,
  676             term_position(F,T,FF,FT,Args)) :-
  677    length(Ex, N),
  678    mapex(Ex, T-T),
  679    '$append'(Args0, Ex, Args),
  680    !.
  681extended_pos(F-T,
  682             N,
  683             term_position(F,T,F,T,Ex)) :-
  684    !,
  685    length(Ex, N),
  686    mapex(Ex, T-T).
  687extended_pos(Pos, N, Pos) :-
  688    '$print_message'(warning, extended_pos(Pos, N)).
  689
  690%!  expand_meta_arg(+MetaSpec, +Arg0, +ArgPos0, -Eval,
  691%!                  -Arg, -ArgPos, +ModuleList, +Term) is det.
  692%
  693%   Goal expansion for a meta-argument.
  694%
  695%   @arg    Eval is always `true`.  Future versions should allow for
  696%           functions on such positions.  This requires proper
  697%           position management for function expansion.
  698
  699expand_meta_arg(0, A0, PA0, true, A, PA, M, MList, Term) :-
  700    !,
  701    expand_goal(A0, PA0, A1, PA, M, MList, Term),
  702    compile_meta_call(A1, A, M, Term).
  703expand_meta_arg(N, A0, P0, true, A, P, M, MList, Term) :-
  704    integer(N), callable(A0),
  705    replace_functions(A0, true, _, M),
  706    !,
  707    length(Ex, N),
  708    mark_vars_non_fresh(Ex),
  709    extend_arg_pos(A0, P0, Ex, A1, PA1),
  710    expand_goal(A1, PA1, A2, PA2, M, MList, Term),
  711    compile_meta_call(A2, A3, M, Term),
  712    term_variables(A0, VL),
  713    remove_arg_pos(A3, PA2, M, VL, Ex, A, P).
  714expand_meta_arg(^, A0, PA0, true, A, PA, M, MList, Term) :-
  715    replace_functions(A0, true, _, M),
  716    !,
  717    expand_setof_goal(A0, PA0, A, PA, M, MList, Term).
  718expand_meta_arg(S, A0, _PA0, Eval, A, _PA, M, _MList, _Term) :-
  719    replace_functions(A0, Eval, A, M), % TBD: pass positions
  720    (   Eval == true
  721    ->  true
  722    ;   same_functor(A0, A)
  723    ->  true
  724    ;   meta_arg(S)
  725    ->  throw(error(context_error(function, meta_arg(S)), _))
  726    ;   true
  727    ).
  728
  729same_functor(T1, T2) :-
  730    compound(T1),
  731    !,
  732    compound(T2),
  733    compound_name_arity(T1, N, A),
  734    compound_name_arity(T2, N, A).
  735same_functor(T1, T2) :-
  736    atom(T1),
  737    T1 == T2.
  738
  739variant_sha1_nat(Term, Hash) :-
  740    copy_term_nat(Term, TNat),
  741    variant_sha1(TNat, Hash).
  742
  743wrap_meta_arguments(A0, M, VL, Ex, A) :-
  744    '$append'(VL, Ex, AV),
  745    variant_sha1_nat(A0+AV, Hash),
  746    atom_concat('__aux_wrapper_', Hash, AuxName),
  747    H =.. [AuxName|AV],
  748    compile_auxiliary_clause(M, (H :- A0)),
  749    A =.. [AuxName|VL].
  750
  751%!  extend_arg_pos(+A0, +P0, +Ex, -A, -P) is det.
  752%
  753%   Adds extra arguments Ex to A0, and  extra subterm positions to P
  754%   for such arguments.
  755
  756extend_arg_pos(A, P, _, A, P) :-
  757    var(A),
  758    !.
  759extend_arg_pos(M:A0, P0, Ex, M:A, P) :-
  760    !,
  761    f2_pos(P0, PM, PA0, P, PM, PA),
  762    extend_arg_pos(A0, PA0, Ex, A, PA).
  763extend_arg_pos(A0, P0, Ex, A, P) :-
  764    callable(A0),
  765    !,
  766    extend_term(A0, Ex, A),
  767    length(Ex, N),
  768    extended_pos(P0, N, P).
  769extend_arg_pos(A, P, _, A, P).
  770
  771extend_term(Atom, Extra, Term) :-
  772    atom(Atom),
  773    !,
  774    Term =.. [Atom|Extra].
  775extend_term(Term0, Extra, Term) :-
  776    compound_name_arguments(Term0, Name, Args0),
  777    '$append'(Args0, Extra, Args),
  778    compound_name_arguments(Term, Name, Args).
  779
  780%!  remove_arg_pos(+A0, +P0, +M, +Ex, +VL, -A, -P) is det.
  781%
  782%   Removes the Ex arguments  from  A0   and  the  respective  extra
  783%   positions from P0. Note that  if  they   are  not  at the end, a
  784%   wrapper with the elements of VL as arguments is generated to put
  785%   them in order.
  786%
  787%   @see wrap_meta_arguments/5
  788
  789remove_arg_pos(A, P, _, _, _, A, P) :-
  790    var(A),
  791    !.
  792remove_arg_pos(M:A0, P0, _, VL, Ex, M:A, P) :-
  793    !,
  794    f2_pos(P, PM, PA0, P0, PM, PA),
  795    remove_arg_pos(A0, PA, M, VL, Ex, A, PA0).
  796remove_arg_pos(A0, P0, M, VL, Ex0, A, P) :-
  797    callable(A0),
  798    !,
  799    length(Ex0, N),
  800    (   A0 =.. [F|Args],
  801        length(Ex, N),
  802        '$append'(Args0, Ex, Args),
  803        Ex==Ex0
  804    ->  extended_pos(P, N, P0),
  805        A =.. [F|Args0]
  806    ;   M \== [],
  807        wrap_meta_arguments(A0, M, VL, Ex0, A),
  808        wrap_meta_pos(P0, P)
  809    ).
  810remove_arg_pos(A, P, _, _, _, A, P).
  811
  812wrap_meta_pos(P0, P) :-
  813    (   nonvar(P0)
  814    ->  P = term_position(F,T,_,_,_),
  815        atomic_pos(P0, F-T)
  816    ;   true
  817    ).
  818
  819has_meta_arg(Head) :-
  820    arg(_, Head, Arg),
  821    direct_call_meta_arg(Arg),
  822    !.
  823
  824direct_call_meta_arg(I) :- integer(I).
  825direct_call_meta_arg(^).
  826
  827meta_arg(:).
  828meta_arg(//).
  829meta_arg(I) :- integer(I).
  830
  831expand_setof_goal(Var, Pos, Var, Pos, _, _, _) :-
  832    var(Var),
  833    !.
  834expand_setof_goal(V^G, P0, V^EG, P, M, MList, Term) :-
  835    !,
  836    f2_pos(P0, PA0, PB, P, PA, PB),
  837    expand_setof_goal(G, PA0, EG, PA, M, MList, Term).
  838expand_setof_goal(M0:G, P0, M0:EG, P, M, MList, Term) :-
  839    !,
  840    f2_pos(P0, PA0, PB, P, PA, PB),
  841    expand_setof_goal(G, PA0, EG, PA, M, MList, Term).
  842expand_setof_goal(G, P0, EG, P, M, MList, Term) :-
  843    !,
  844    expand_goal(G, P0, EG0, P, M, MList, Term),
  845    compile_meta_call(EG0, EG, M, Term).            % TBD: Pos?
  846
  847
  848%!  call_goal_expansion(+ExpandModules,
  849%!                      +Goal0, ?Pos0, -Goal, -Pos) is semidet.
  850%
  851%   Succeeds  if  the   context   has    a   module   that   defines
  852%   goal_expansion/2 this rule succeeds and  Goal   is  not equal to
  853%   Goal0. Note that the translator is   called  recursively until a
  854%   fixed-point is reached.
  855
  856call_goal_expansion(MList, G0, P0, G, P) :-
  857    current_prolog_flag(sandboxed_load, false),
  858    !,
  859    (   '$member'(M-Preds, MList),
  860        '$member'(Pred, Preds),
  861        (   Pred == goal_expansion/4
  862        ->  M:goal_expansion(G0, P0, G, P)
  863        ;   M:goal_expansion(G0, G),
  864            P = P0
  865        ),
  866        G0 \== G
  867    ->  true
  868    ).
  869call_goal_expansion(MList, G0, P0, G, P) :-
  870    (   '$member'(M-Preds, MList),
  871        '$member'(Pred, Preds),
  872        (   Pred == goal_expansion/4
  873        ->  Expand = M:goal_expansion(G0, P0, G, P)
  874        ;   Expand = M:goal_expansion(G0, G)
  875        ),
  876        allowed_expansion(Expand),
  877        call(Expand),
  878        G0 \== G
  879    ->  true
  880    ).
  881
  882%!  allowed_expansion(:Goal) is semidet.
  883%
  884%   Calls prolog:sandbox_allowed_expansion(:Goal) prior   to calling
  885%   Goal for the purpose of term or   goal  expansion. This hook can
  886%   prevent the expansion to take place by raising an exception.
  887%
  888%   @throws exceptions from prolog:sandbox_allowed_expansion/1.
  889
  890:- multifile
  891    prolog:sandbox_allowed_expansion/1.  892
  893allowed_expansion(QGoal) :-
  894    strip_module(QGoal, M, Goal),
  895    catch(prolog:sandbox_allowed_expansion(M:Goal), E, true),
  896    (   var(E)
  897    ->  fail
  898    ;   !,
  899        print_message(error, E),
  900        fail
  901    ).
  902allowed_expansion(_).
  903
  904
  905                 /*******************************
  906                 *      FUNCTIONAL NOTATION     *
  907                 *******************************/
  908
  909%!  expand_functions(+G0, +P0, -G, -P, +M, +MList, +Term) is det.
  910%
  911%   Expand functional notation and arithmetic functions.
  912%
  913%   @arg MList is the list of modules defining goal_expansion/2 in
  914%   the expansion context.
  915
  916expand_functions(G0, P0, G, P, M, MList, Term) :-
  917    expand_functional_notation(G0, P0, G1, P1, M, MList, Term),
  918    (   expand_arithmetic(G1, P1, G, P, Term)
  919    ->  true
  920    ;   G = G1,
  921        P = P1
  922    ).
  923
  924%!  expand_functional_notation(+G0, +P0, -G, -P, +M, +MList, +Term) is det.
  925%
  926%   @tbd: position logic
  927%   @tbd: make functions module-local
  928
  929expand_functional_notation(G0, P0, G, P, M, _MList, _Term) :-
  930    contains_functions(G0),
  931    replace_functions(G0, P0, Eval, EvalPos, G1, G1Pos, M),
  932    Eval \== true,
  933    !,
  934    wrap_var(G1, G1Pos, G2, G2Pos),
  935    conj(Eval, EvalPos, G2, G2Pos, G, P).
  936expand_functional_notation(G, P, G, P, _, _, _).
  937
  938wrap_var(G, P, G, P) :-
  939    nonvar(G),
  940    !.
  941wrap_var(G, P0, call(G), P) :-
  942    (   nonvar(P0)
  943    ->  P = term_position(F,T,F,T,[P0]),
  944        atomic_pos(P0, F-T)
  945    ;   true
  946    ).
  947
  948%!  contains_functions(@Term) is semidet.
  949%
  950%   True when Term contains a function reference.
  951
  952contains_functions(Term) :-
  953    \+ \+ ( '$factorize_term'(Term, Skeleton, Assignments),
  954            (   contains_functions2(Skeleton)
  955            ;   contains_functions2(Assignments)
  956            )).
  957
  958contains_functions2(Term) :-
  959    compound(Term),
  960    (   function(Term, _)
  961    ->  true
  962    ;   arg(_, Term, Arg),
  963        contains_functions2(Arg)
  964    ->  true
  965    ).
  966
  967%!  replace_functions(+GoalIn, +PosIn,
  968%!                    -Eval, -EvalPos,
  969%!                    -GoalOut, -PosOut,
  970%!                    +ContextTerm) is det.
  971%
  972%   @tbd    Proper propagation of list, dict and brace term positions.
  973
  974:- public
  975    replace_functions/4.            % used in dicts.pl
  976
  977replace_functions(GoalIn, Eval, GoalOut, Context) :-
  978    replace_functions(GoalIn, _, Eval, _, GoalOut, _, Context).
  979
  980replace_functions(Var, Pos, true, _, Var, Pos, _Ctx) :-
  981    var(Var),
  982    !.
  983replace_functions(F, FPos, Eval, EvalPos, Var, VarPos, Ctx) :-
  984    function(F, Ctx),
  985    !,
  986    compound_name_arity(F, Name, Arity),
  987    PredArity is Arity+1,
  988    compound_name_arity(G, Name, PredArity),
  989    arg(PredArity, G, Var),
  990    extend_1_pos(FPos, FArgPos, GPos, GArgPos, VarPos),
  991    map_functions(0, Arity, F, FArgPos, G, GArgPos, Eval0, EP0, Ctx),
  992    conj(Eval0, EP0, G, GPos, Eval, EvalPos).
  993replace_functions(Term0, Term0Pos, Eval, EvalPos, Term, TermPos, Ctx) :-
  994    compound(Term0),
  995    !,
  996    compound_name_arity(Term0, Name, Arity),
  997    compound_name_arity(Term, Name, Arity),
  998    f_pos(Term0Pos, Args0Pos, TermPos, ArgsPos),
  999    map_functions(0, Arity,
 1000                  Term0, Args0Pos, Term, ArgsPos, Eval, EvalPos, Ctx).
 1001replace_functions(Term, Pos, true, _, Term, Pos, _).
 1002
 1003
 1004%!  map_functions(+Arg, +Arity,
 1005%!                +TermIn, +ArgInPos, -Term, -ArgPos, -Eval, -EvalPos,
 1006%!                +Context)
 1007
 1008map_functions(Arity, Arity, _, LPos0, _, LPos, true, _, _) :-
 1009    !,
 1010    pos_nil(LPos0, LPos).
 1011map_functions(I0, Arity, Term0, LPos0, Term, LPos, Eval, EP, Ctx) :-
 1012    pos_list(LPos0, AP0, APT0, LPos, AP, APT),
 1013    I is I0+1,
 1014    arg(I, Term0, Arg0),
 1015    arg(I, Term, Arg),
 1016    replace_functions(Arg0, AP0, Eval0, EP0, Arg, AP, Ctx),
 1017    map_functions(I, Arity, Term0, APT0, Term, APT, Eval1, EP1, Ctx),
 1018    conj(Eval0, EP0, Eval1, EP1, Eval, EP).
 1019
 1020conj(true, X, X) :- !.
 1021conj(X, true, X) :- !.
 1022conj(X, Y, (X,Y)).
 1023
 1024conj(true, _, X, P, X, P) :- !.
 1025conj(X, P, true, _, X, P) :- !.
 1026conj(X, PX, Y, PY, (X,Y), _) :-
 1027    var(PX), var(PY),
 1028    !.
 1029conj(X, PX, Y, PY, (X,Y), P) :-
 1030    P = term_position(F,T,FF,FT,[PX,PY]),
 1031    atomic_pos(PX, F-FF),
 1032    atomic_pos(PY, FT-T).
 1033
 1034%!  function(?Term, +Context)
 1035%
 1036%   True if function expansion needs to be applied for the given
 1037%   term.
 1038
 1039function(.(_,_), _) :- \+ functor([_|_], ., _).
 1040
 1041
 1042                 /*******************************
 1043                 *          ARITHMETIC          *
 1044                 *******************************/
 1045
 1046%!  expand_arithmetic(+G0, +P0, -G, -P, +Term) is semidet.
 1047%
 1048%   Expand arithmetic expressions  in  is/2,   (>)/2,  etc.  This is
 1049%   currently a dummy.  The  idea  is   to  call  rules  similar  to
 1050%   goal_expansion/2,4  that  allow  for   rewriting  an  arithmetic
 1051%   expression. The system rules will perform evaluation of constant
 1052%   expressions.
 1053
 1054expand_arithmetic(_G0, _P0, _G, _P, _Term) :- fail.
 1055
 1056
 1057                 /*******************************
 1058                 *        POSITION LOGIC        *
 1059                 *******************************/
 1060
 1061%!  f2_pos(?TermPos0, ?PosArg10, ?PosArg20,
 1062%!         ?TermPos,  ?PosArg1,  ?PosArg2) is det.
 1063%!  f1_pos(?TermPos0, ?PosArg10, ?TermPos,  ?PosArg1) is det.
 1064%!  f_pos(?TermPos0, ?PosArgs0, ?TermPos,  ?PosArgs) is det.
 1065%!  atomic_pos(?TermPos0, -AtomicPos) is det.
 1066%
 1067%   Position progapation routines.
 1068
 1069f2_pos(Var, _, _, _, _, _) :-
 1070    var(Var),
 1071    !.
 1072f2_pos(term_position(F,T,FF,FT,[A10,A20]), A10, A20,
 1073       term_position(F,T,FF,FT,[A1, A2 ]), A1,  A2) :- !.
 1074f2_pos(parentheses_term_position(O,C,Pos0), A10, A20,
 1075       parentheses_term_position(O,C,Pos),  A1,  A2) :-
 1076    !,
 1077    f2_pos(Pos0, A10, A20, Pos, A1, A2).
 1078f2_pos(Pos, _, _, _, _, _) :-
 1079    expected_layout(f2, Pos).
 1080
 1081f1_pos(Var, _, _, _) :-
 1082    var(Var),
 1083    !.
 1084f1_pos(term_position(F,T,FF,FT,[A10]), A10,
 1085       term_position(F,T,FF,FT,[A1 ]),  A1) :- !.
 1086f1_pos(parentheses_term_position(O,C,Pos0), A10,
 1087       parentheses_term_position(O,C,Pos),  A1) :-
 1088    !,
 1089    f1_pos(Pos0, A10, Pos, A1).
 1090f1_pos(Pos, _, _, _) :-
 1091    expected_layout(f1, Pos).
 1092
 1093f_pos(Var, _, _, _) :-
 1094    var(Var),
 1095    !.
 1096f_pos(term_position(F,T,FF,FT,ArgPos0), ArgPos0,
 1097      term_position(F,T,FF,FT,ArgPos),  ArgPos) :- !.
 1098f_pos(parentheses_term_position(O,C,Pos0), A10,
 1099      parentheses_term_position(O,C,Pos),  A1) :-
 1100    !,
 1101    f_pos(Pos0, A10, Pos, A1).
 1102f_pos(Pos, _, _, _) :-
 1103    expected_layout(compound, Pos).
 1104
 1105atomic_pos(Pos, _) :-
 1106    var(Pos),
 1107    !.
 1108atomic_pos(Pos, F-T) :-
 1109    arg(1, Pos, F),
 1110    arg(2, Pos, T).
 1111
 1112%!  pos_nil(+Nil, -Nil) is det.
 1113%!  pos_list(+List0, -H0, -T0, -List, -H, -T) is det.
 1114%
 1115%   Position propagation for lists.
 1116
 1117pos_nil(Var, _) :- var(Var), !.
 1118pos_nil([], []) :- !.
 1119pos_nil(Pos, _) :-
 1120    expected_layout(nil, Pos).
 1121
 1122pos_list(Var, _, _, _, _, _) :- var(Var), !.
 1123pos_list([H0|T0], H0, T0, [H|T], H, T) :- !.
 1124pos_list(Pos, _, _, _, _, _) :-
 1125    expected_layout(list, Pos).
 1126
 1127%!  extend_1_pos(+FunctionPos, -FArgPos, -EvalPos, -EArgPos, -VarPos)
 1128%
 1129%   Deal with extending a function to include the return value.
 1130
 1131extend_1_pos(Pos, _, _, _, _) :-
 1132    var(Pos),
 1133    !.
 1134extend_1_pos(term_position(F,T,FF,FT,FArgPos), FArgPos,
 1135             term_position(F,T,FF,FT,GArgPos), GArgPos0,
 1136             FT-FT1) :-
 1137    integer(FT),
 1138    !,
 1139    FT1 is FT+1,
 1140    '$same_length'(FArgPos, GArgPos0),
 1141    '$append'(GArgPos0, [FT-FT1], GArgPos).
 1142extend_1_pos(F-T, [],
 1143             term_position(F,T,F,T,[T-T1]), [],
 1144             T-T1) :-
 1145    integer(T),
 1146    !,
 1147    T1 is T+1.
 1148extend_1_pos(Pos, _, _, _, _) :-
 1149    expected_layout(callable, Pos).
 1150
 1151'$same_length'(List, List) :-
 1152    var(List),
 1153    !.
 1154'$same_length'([], []).
 1155'$same_length'([_|T0], [_|T]) :-
 1156    '$same_length'(T0, T).
 1157
 1158
 1159%!  expected_layout(+Expected, +Found)
 1160%
 1161%   Print a message  if  the  layout   term  does  not  satisfy  our
 1162%   expectations.  This  means  that   the  transformation  requires
 1163%   support from term_expansion/4 and/or goal_expansion/4 to achieve
 1164%   proper source location information.
 1165
 1166:- create_prolog_flag(debug_term_position, false, []). 1167
 1168expected_layout(Expected, Pos) :-
 1169    current_prolog_flag(debug_term_position, true),
 1170    !,
 1171    '$print_message'(warning, expected_layout(Expected, Pos)).
 1172expected_layout(_, _).
 1173
 1174
 1175                 /*******************************
 1176                 *    SIMPLIFICATION ROUTINES   *
 1177                 *******************************/
 1178
 1179%!  simplify(+ControlIn, +Pos0, -ControlOut, -Pos) is det.
 1180%
 1181%   Simplify control structures
 1182%
 1183%   @tbd    Much more analysis
 1184%   @tbd    Turn this into a separate module
 1185
 1186simplify(Control, P, Control, P) :-
 1187    current_prolog_flag(optimise, false),
 1188    !.
 1189simplify(Control, P0, Simple, P) :-
 1190    simple(Control, P0, Simple, P),
 1191    !.
 1192simplify(Control, P, Control, P).
 1193
 1194%!  simple(+Goal, +GoalPos, -Simple, -SimplePos)
 1195%
 1196%   Simplify a control structure.  Note  that   we  do  not simplify
 1197%   (A;fail). Logically, this is the  same  as   `A`  if  `A` is not
 1198%   `_->_` or `_*->_`, but  the  choice   point  may  be  created on
 1199%   purpose.
 1200
 1201simple((X,Y), P0, Conj, P) :-
 1202    (   true(X)
 1203    ->  Conj = Y,
 1204        f2_pos(P0, _, P, _, _, _)
 1205    ;   false(X)
 1206    ->  Conj = fail,
 1207        f2_pos(P0, P1, _, _, _, _),
 1208        atomic_pos(P1, P)
 1209    ;   true(Y)
 1210    ->  Conj = X,
 1211        f2_pos(P0, P, _, _, _, _)
 1212    ).
 1213simple((I->T;E), P0, ITE, P) :-         % unification with _->_ is fine
 1214    (   true(I)                     % because nothing happens if I and T
 1215    ->  ITE = T,                    % are unbound.
 1216        f2_pos(P0, P1, _, _, _, _),
 1217        f2_pos(P1, _, P, _, _, _)
 1218    ;   false(I)
 1219    ->  ITE = E,
 1220        f2_pos(P0, _, P, _, _, _)
 1221    ).
 1222simple((X;Y), P0, Or, P) :-
 1223    false(X),
 1224    Or = Y,
 1225    f2_pos(P0, _, P, _, _, _).
 1226
 1227true(X) :-
 1228    nonvar(X),
 1229    eval_true(X).
 1230
 1231false(X) :-
 1232    nonvar(X),
 1233    eval_false(X).
 1234
 1235
 1236%!  eval_true(+Goal) is semidet.
 1237%!  eval_false(+Goal) is semidet.
 1238
 1239eval_true(true).
 1240eval_true(otherwise).
 1241
 1242eval_false(fail).
 1243eval_false(false).
 1244
 1245
 1246                 /*******************************
 1247                 *         META CALLING         *
 1248                 *******************************/
 1249
 1250:- create_prolog_flag(compile_meta_arguments, false, [type(atom)]). 1251
 1252%!  compile_meta_call(+CallIn, -CallOut, +Module, +Term) is det.
 1253%
 1254%   Compile (complex) meta-calls into a clause.
 1255
 1256compile_meta_call(CallIn, CallIn, _, Term) :-
 1257    var(Term),
 1258    !.                   % explicit call; no context
 1259compile_meta_call(CallIn, CallIn, _, _) :-
 1260    var(CallIn),
 1261    !.
 1262compile_meta_call(CallIn, CallIn, _, _) :-
 1263    (   current_prolog_flag(compile_meta_arguments, false)
 1264    ;   current_prolog_flag(xref, true)
 1265    ),
 1266    !.
 1267compile_meta_call(CallIn, CallIn, _, _) :-
 1268    strip_module(CallIn, _, Call),
 1269    (   is_aux_meta(Call)
 1270    ;   \+ control(Call),
 1271        (   '$c_current_predicate'(_, system:Call),
 1272            \+ current_prolog_flag(compile_meta_arguments, always)
 1273        ;   current_prolog_flag(compile_meta_arguments, control)
 1274        )
 1275    ),
 1276    !.
 1277compile_meta_call(M:CallIn, CallOut, _, Term) :-
 1278    !,
 1279    (   atom(M), callable(CallIn)
 1280    ->  compile_meta_call(CallIn, CallOut, M, Term)
 1281    ;   CallOut = M:CallIn
 1282    ).
 1283compile_meta_call(CallIn, CallOut, Module, Term) :-
 1284    compile_meta(CallIn, CallOut, Module, Term, Clause),
 1285    compile_auxiliary_clause(Module, Clause).
 1286
 1287compile_auxiliary_clause(Module, Clause) :-
 1288    Clause = (Head:-Body),
 1289    '$current_source_module'(SM),
 1290    (   predicate_property(SM:Head, defined)
 1291    ->  true
 1292    ;   SM == Module
 1293    ->  compile_aux_clauses([Clause])
 1294    ;   compile_aux_clauses([Head:-Module:Body])
 1295    ).
 1296
 1297control((_,_)).
 1298control((_;_)).
 1299control((_->_)).
 1300control((_*->_)).
 1301control(\+(_)).
 1302
 1303is_aux_meta(Term) :-
 1304    callable(Term),
 1305    functor(Term, Name, _),
 1306    sub_atom(Name, 0, _, _, '__aux_meta_call_').
 1307
 1308compile_meta(CallIn, CallOut, M, Term, (CallOut :- Body)) :-
 1309    term_variables(Term, AllVars),
 1310    term_variables(CallIn, InVars),
 1311    intersection_eq(InVars, AllVars, HeadVars),
 1312    variant_sha1(CallIn+HeadVars, Hash),
 1313    atom_concat('__aux_meta_call_', Hash, AuxName),
 1314    expand_goal(CallIn, _Pos0, Body, _Pos, M, [], (CallOut:-CallIn)),
 1315    length(HeadVars, Arity),
 1316    (   Arity > 256                 % avoid 1024 arity limit
 1317    ->  HeadArgs = [v(HeadVars)]
 1318    ;   HeadArgs = HeadVars
 1319    ),
 1320    CallOut =.. [AuxName|HeadArgs].
 1321
 1322%!  intersection_eq(+Small, +Big, -Shared) is det.
 1323%
 1324%   Shared are the variables in Small that   also appear in Big. The
 1325%   variables in Shared are in the same order as Small.
 1326
 1327intersection_eq([], _, []).
 1328intersection_eq([H|T0], L, List) :-
 1329    (   member_eq(H, L)
 1330    ->  List = [H|T],
 1331        intersection_eq(T0, L, T)
 1332    ;   intersection_eq(T0, L, List)
 1333    ).
 1334
 1335member_eq(E, [H|T]) :-
 1336    (   E == H
 1337    ->  true
 1338    ;   member_eq(E, T)
 1339    ).
 1340
 1341                 /*******************************
 1342                 *            RENAMING          *
 1343                 *******************************/
 1344
 1345:- multifile
 1346    prolog:rename_predicate/2. 1347
 1348rename(Var, Var) :-
 1349    var(Var),
 1350    !.
 1351rename(end_of_file, end_of_file) :- !.
 1352rename(Terms0, Terms) :-
 1353    is_list(Terms0),
 1354    !,
 1355    '$current_source_module'(M),
 1356    rename_preds(Terms0, Terms, M).
 1357rename(Term0, Term) :-
 1358    '$current_source_module'(M),
 1359    rename(Term0, Term, M),
 1360    !.
 1361rename(Term, Term).
 1362
 1363rename_preds([], [], _).
 1364rename_preds([H0|T0], [H|T], M) :-
 1365    (   rename(H0, H, M)
 1366    ->  true
 1367    ;   H = H0
 1368    ),
 1369    rename_preds(T0, T, M).
 1370
 1371rename(Var, Var, _) :-
 1372    var(Var),
 1373    !.
 1374rename(M:Term0, M:Term, M0) :-
 1375    !,
 1376    (   M = '$source_location'(_File, _Line)
 1377    ->  rename(Term0, Term, M0)
 1378    ;   rename(Term0, Term, M)
 1379    ).
 1380rename((Head0 :- Body), (Head :- Body), M) :-
 1381    !,
 1382    rename_head(Head0, Head, M).
 1383rename((:-_), _, _) :-
 1384    !,
 1385    fail.
 1386rename(Head0, Head, M) :-
 1387    rename_head(Head0, Head, M).
 1388
 1389rename_head(Var, Var, _) :-
 1390    var(Var),
 1391    !.
 1392rename_head(M:Term0, M:Term, _) :-
 1393    !,
 1394    rename_head(Term0, Term, M).
 1395rename_head(Head0, Head, M) :-
 1396    prolog:rename_predicate(M:Head0, M:Head).
 1397
 1398
 1399                 /*******************************
 1400                 *      :- IF ... :- ENDIF      *
 1401                 *******************************/
 1402
 1403:- thread_local
 1404    '$include_code'/3. 1405
 1406'$including' :-
 1407    '$include_code'(X, _, _),
 1408    !,
 1409    X == true.
 1410'$including'.
 1411
 1412cond_compilation((:- if(G)), []) :-
 1413    source_location(File, Line),
 1414    (   '$including'
 1415    ->  (   catch('$eval_if'(G), E, (print_message(error, E), fail))
 1416        ->  asserta('$include_code'(true, File, Line))
 1417        ;   asserta('$include_code'(false, File, Line))
 1418        )
 1419    ;   asserta('$include_code'(else_false, File, Line))
 1420    ).
 1421cond_compilation((:- elif(G)), []) :-
 1422    source_location(File, Line),
 1423    (   clause('$include_code'(Old, OF, _), _, Ref)
 1424    ->  same_source(File, OF, elif),
 1425        erase(Ref),
 1426        (   Old == true
 1427        ->  asserta('$include_code'(else_false, File, Line))
 1428        ;   Old == false,
 1429            catch('$eval_if'(G), E, (print_message(error, E), fail))
 1430        ->  asserta('$include_code'(true, File, Line))
 1431        ;   asserta('$include_code'(Old, File, Line))
 1432        )
 1433    ;   throw(error(conditional_compilation_error(no_if, elif), _))
 1434    ).
 1435cond_compilation((:- else), []) :-
 1436    source_location(File, Line),
 1437    (   clause('$include_code'(X, OF, _), _, Ref)
 1438    ->  same_source(File, OF, else),
 1439        erase(Ref),
 1440        (   X == true
 1441        ->  X2 = false
 1442        ;   X == false
 1443        ->  X2 = true
 1444        ;   X2 = X
 1445        ),
 1446        asserta('$include_code'(X2, File, Line))
 1447    ;   throw(error(conditional_compilation_error(no_if, else), _))
 1448    ).
 1449cond_compilation(end_of_file, end_of_file) :-   % TBD: Check completeness
 1450    !,
 1451    source_location(File, _),
 1452    (   clause('$include_code'(_, OF, OL), _)
 1453    ->  (   File == OF
 1454        ->  throw(error(conditional_compilation_error(
 1455                            unterminated,OF:OL), _))
 1456        ;   true
 1457        )
 1458    ;   true
 1459    ).
 1460cond_compilation((:- endif), []) :-
 1461    !,
 1462    source_location(File, _),
 1463    (   (   clause('$include_code'(_, OF, _), _, Ref)
 1464        ->  same_source(File, OF, endif),
 1465            erase(Ref)
 1466        )
 1467    ->  true
 1468    ;   throw(error(conditional_compilation_error(no_if, endif), _))
 1469    ).
 1470cond_compilation(_, []) :-
 1471    \+ '$including'.
 1472
 1473same_source(File, File, _) :- !.
 1474same_source(_,    _,    Op) :-
 1475    throw(error(conditional_compilation_error(no_if, Op), _)).
 1476
 1477
 1478'$eval_if'(G) :-
 1479    expand_goal(G, G2),
 1480    '$current_source_module'(Module),
 1481    Module:G2