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)  2007-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(apply_macros,
   38          [ expand_phrase/2,            % :PhraseGoal, -Goal
   39            expand_phrase/4             % :PhraseGoal, +Pos0, -Goal, -Pos
   40          ]).   41% maplist expansion uses maplist.  Do not autoload.
   42:- use_module(library(apply), [maplist/2, maplist/3, maplist/4]).   43% these may be autoloaded
   44:- autoload(library(error),[type_error/2]).   45:- autoload(library(lists),[append/3]).   46:- autoload(library(prolog_code), [mkconj/3, extend_goal/3]).   47:- autoload(library(yall), [is_lambda/1, lambda_calls/3]).   48
   49/** <module> Goal expansion rules to avoid meta-calling
   50
   51This module defines goal_expansion/2 rules to   deal with commonly used,
   52but fundamentally slow meta-predicates. Notable   maplist/2... defines a
   53useful set of predicates, but its  execution is considerable slower than
   54a traditional Prolog loop. Using this  library calls to maplist/2... are
   55translated into an call  to  a  generated  auxiliary  predicate  that is
   56compiled using compile_aux_clauses/1. Currently this module supports:
   57
   58        * maplist/2..
   59        * forall/2
   60        * once/1
   61        * ignore/1
   62        * phrase/2
   63        * phrase/3
   64        * call_dcg/2
   65        * call_dcg/3
   66
   67The idea for this library originates from ECLiPSe and came to SWI-Prolog
   68through YAP.
   69
   70@tbd    Support more predicates
   71@author Jan Wielemaker
   72*/
   73
   74:- dynamic
   75    user:goal_expansion/2.   76:- multifile
   77    user:goal_expansion/2.   78
   79
   80%!  expand_maplist(+Callable, +Lists, -Goal) is det.
   81%
   82%   Macro expansion for maplist/2 and  higher   arity.  The first clause
   83%   deals with code using maplist on fixed  lists to reduce typing. Note
   84%   that we only expand if all  lists   have  fixed length. In theory we
   85%   only need at least one of fixed length,   but  in that case the goal
   86%   expansion instantiates variables in the  clause, causing issues with
   87%   the remainder of the clause expansion mechanism.
   88
   89expand_maplist(Callable, Lists, Goal) :-
   90    maplist(is_list, Lists),
   91    maplist(length, Lists, Lens),
   92    (   sort(Lens, [Len])
   93    ->  Len < 10,
   94        unfold_maplist(Lists, Callable, Goal),
   95        !
   96    ;   Maplist =.. [maplist,Callable|Lists],
   97        print_message(warning, maplist(inconsistent_length(Maplist, Lens))),
   98        fail
   99    ).
  100expand_maplist(Callable0, Lists, Goal) :-
  101    length(Lists, N),
  102    expand_closure_no_fail(Callable0, N, Callable1),
  103    (   Callable1 = _:_
  104    ->  strip_module(Callable1, M, Callable),
  105        NextGoal = M:NextCall,
  106        QPred = M:Pred
  107    ;   Callable = Callable1,
  108        NextGoal = NextCall,
  109        QPred = Pred
  110    ),
  111    Callable =.. [Pred|Args],
  112    length(Args, Argc),
  113    length(Argv, Argc),
  114    length(Vars, N),
  115    MapArity is N + 1,
  116    format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]),
  117    append(Lists, Args, AuxArgs),
  118    Goal =.. [AuxName|AuxArgs],
  119
  120    AuxArity is N+Argc,
  121    prolog_load_context(module, Module),
  122    functor(NextCall, Pred, AuxArity),
  123    \+ predicate_property(Module:NextGoal, transparent),
  124    (   predicate_property(Module:Goal, defined)
  125    ->  true
  126    ;   empty_lists(N, BaseLists),
  127        length(Anon, Argc),
  128        append(BaseLists, Anon, BaseArgs),
  129        BaseClause =.. [AuxName|BaseArgs],
  130
  131        heads_and_tails(N, NextArgs, Vars, Tails),
  132        append(NextArgs, Argv, AllNextArgs),
  133        NextHead =.. [AuxName|AllNextArgs],
  134        append(Argv, Vars, PredArgs),
  135        NextCall =.. [Pred|PredArgs],
  136        append(Tails, Argv, IttArgs),
  137        NextIterate =.. [AuxName|IttArgs],
  138        NextClause = (NextHead :- NextGoal, NextIterate),
  139        compile_aux_clauses([BaseClause, NextClause])
  140    ).
  141
  142unfold_maplist(Lists, Callable, Goal) :-
  143    maplist(cons, Lists, Heads, Tails),
  144    !,
  145    maplist_extend_goal(Callable, Heads, G1),
  146    unfold_maplist(Tails, Callable, G2),
  147    mkconj(G1, G2, Goal).
  148unfold_maplist(_, _, true).
  149
  150cons([H|T], H, T).
  151
  152%!  maplist_extend_goal(+Closure, +Args, -Goal) is semidet.
  153%
  154%   Extend the maplist Closure with Args.   This  can be tricky. Notably
  155%   library(yall) lambda expressions may instantiate   the Closure while
  156%   the  real  execution  does  not.  We    can   solve  that  by  using
  157%   lambda_calls/3. The expand_goal_no_instantiate/2 ensures   safe goal
  158%   expansion.
  159
  160maplist_extend_goal(Closure, Args, Goal) :-
  161    is_lambda(Closure),
  162    !,
  163    lambda_calls(Closure, Args, Goal1),
  164    expand_goal_no_instantiate(Goal1, Goal).
  165maplist_extend_goal(Closure, Args, Goal) :-
  166    extend_goal(Closure, Args, Goal1),
  167    expand_goal_no_instantiate(Goal1, Goal).
  168
  169% using is_most_general_term/1 is an alternative, but fails
  170% if the goal variables have attributes.
  171
  172expand_goal_no_instantiate(Goal0, Goal) :-
  173    term_variables(Goal0, Vars0),
  174    expand_goal(Goal0, Goal),
  175    term_variables(Goal0, Vars1),
  176    Vars0 == Vars1.
  177
  178%!  expand_closure_no_fail(+Goal, +Extra:integer, -GoalExt) is det.
  179%
  180%   Add Extra additional arguments to Goal.
  181
  182expand_closure_no_fail(Callable0, N, Callable1) :-
  183    '$expand_closure'(Callable0, N, Callable1),
  184    !.
  185expand_closure_no_fail(Callable, _, Callable).
  186
  187empty_lists(0, []) :- !.
  188empty_lists(N, [[]|T]) :-
  189    N2 is N - 1,
  190    empty_lists(N2, T).
  191
  192heads_and_tails(0, [], [], []).
  193heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :-
  194    N2 is N - 1,
  195    heads_and_tails(N2, L1, L2, L3).
  196
  197
  198%!  expand_apply(+GoalIn:callable, -GoalOut) is semidet.
  199%
  200%   Macro expansion for `apply' predicates.
  201
  202expand_apply(Maplist, Goal) :-
  203    compound(Maplist),
  204    compound_name_arity(Maplist, maplist, N),
  205    N >= 2,
  206    Maplist =.. [maplist, Callable|Lists],
  207    qcall_instantiated(Callable),
  208    !,
  209    expand_maplist(Callable, Lists, Goal).
  210
  211%!  expand_apply(+GoalIn:callable, -GoalOut, +PosIn, -PosOut) is semidet.
  212%
  213%   Translation  of  simple  meta  calls    to   inline  code  while
  214%   maintaining position information. Note that once(Goal) cannot be
  215%   translated  to  `(Goal->true)`  because  this   will  break  the
  216%   compilation of `(once(X) ; Y)`.  A   correct  translation  is to
  217%   `(Goal->true;fail)`.       Abramo       Bagnara        suggested
  218%   `((Goal->true),true)`, which is both faster   and avoids warning
  219%   if style_check(+var_branches) is used.
  220
  221expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :-
  222    Goal = \+((Cond, \+(Action))),
  223    (   nonvar(Pos0),
  224        Pos0 = term_position(_,_,_,_,[PosCond,PosAct])
  225    ->  Pos = term_position(0,0,0,0, % \+
  226                            [ term_position(0,0,0,0, % ,/2
  227                                            [ PosCond,
  228                                              term_position(0,0,0,0, % \+
  229                                                            [PosAct])
  230                                            ])
  231                            ])
  232    ;   true
  233    ).
  234expand_apply(once(Once), Pos0, Goal, Pos) :-
  235    Goal = (Once->true),
  236    (   nonvar(Pos0),
  237        Pos0 = term_position(_,_,_,_,[OncePos]),
  238        compound(OncePos)
  239    ->  Pos = term_position(0,0,0,0,        % ->/2
  240                            [ OncePos,
  241                              F-T           % true
  242                            ]),
  243        arg(2, OncePos, F),         % highlight true/false on ")"
  244        T is F+1
  245    ;   true
  246    ).
  247expand_apply(ignore(Ignore), Pos0, Goal, Pos) :-
  248    Goal = (Ignore->true;true),
  249    (   nonvar(Pos0),
  250        Pos0 = term_position(_,_,_,_,[IgnorePos]),
  251        compound(IgnorePos)
  252    ->  Pos = term_position(0,0,0,0,                        % ;/2
  253                            [ term_position(0,0,0,0,        % ->/2
  254                                            [ IgnorePos,
  255                                              F-T           % true
  256                                            ]),
  257                              F-T                           % true
  258                            ]),
  259        arg(2, IgnorePos, F),       % highlight true/false on ")"
  260        T is F+1
  261    ;   true
  262    ).
  263expand_apply(Phrase, Pos0, Expanded, Pos) :-
  264    expand_phrase(Phrase, Pos0, Expanded, Pos),
  265    !.
  266
  267
  268%!  expand_phrase(+PhraseGoal, -Goal) is semidet.
  269%!  expand_phrase(+PhraseGoal, +Pos0, -Goal, -Pos) is semidet.
  270%
  271%   Provide goal-expansion for  PhraseGoal.   PhraseGoal  is  either
  272%   phrase/2,3  or  call_dcg/2,3.  The  current   version  does  not
  273%   translate control structures, but  only   simple  terminals  and
  274%   non-terminals.
  275%
  276%   For example:
  277%
  278%     ==
  279%     ?- expand_phrase(phrase(("ab", rule)), List), Goal).
  280%     Goal = (List=[97, 98|_G121], rule(_G121, [])).
  281%     ==
  282%
  283%   @throws Re-throws errors from dcg_translate_rule/2
  284
  285expand_phrase(Phrase, Goal) :-
  286    expand_phrase(Phrase, _, Goal, _).
  287
  288expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :-
  289    !,
  290    extend_pos(Pos0, 1, Pos1),
  291    expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos).
  292expand_phrase(Goal, Pos0, NewGoal, Pos) :-
  293    dcg_goal(Goal, NT, Xs0, Xs),
  294    nonvar(NT),
  295    nt_pos(Pos0, NTPos),
  296    dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs).
  297
  298dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs).
  299dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
  300
  301%!  dcg_extend(+Callable, +Pos0, -Goal, -Pos, +Xs0, ?Xs) is semidet.
  302
  303dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :-
  304    compound(Compound0),
  305    \+ dcg_control(Compound0),
  306    !,
  307    extend_pos(Pos0, 2, Pos),
  308    compound_name_arguments(Compound0, Name, Args0),
  309    append(Args0, [Xs0,Xs], Args),
  310    compound_name_arguments(Compound, Name, Args).
  311dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :-
  312    atom(Name),
  313    \+ dcg_control(Name),
  314    !,
  315    extend_pos(Pos0, 2, Pos),
  316    compound_name_arguments(Compound, Name, [Xs0,Xs]).
  317dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :-
  318    compound(Q0), Q0 = M:Q1,
  319    '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos),
  320    dcg_extend(Q1, APos0, Q, APos, Xs0, Xs).
  321dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :-
  322    terminal(Terminal, DList, Xs),
  323    !,
  324    t_pos(Pos0, Pos).
  325
  326dcg_control(!).
  327dcg_control([]).
  328dcg_control([_|_]).
  329dcg_control({_}).
  330dcg_control((_,_)).
  331dcg_control((_;_)).
  332dcg_control((_->_)).
  333dcg_control((_*->_)).
  334dcg_control(_:_).
  335
  336terminal(List, DList, Tail) :-
  337    compound(List),
  338    List = [_|_],
  339    !,
  340    '$skip_list'(_, List, T0),
  341    (   var(T0)
  342    ->  DList = List,
  343        Tail = T0
  344    ;   T0 == []
  345    ->  append(List, Tail, DList)
  346    ;   type_error(list, List)
  347    ).
  348terminal(List, DList, Tail) :-
  349    List == [],
  350    !,
  351    DList = Tail.
  352terminal(String, DList, Tail) :-
  353    string(String),
  354    string_codes(String, List),
  355    append(List, Tail, DList).
  356
  357extend_pos(Var, _, Var) :-
  358    var(Var),
  359    !.
  360extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra,
  361           term_position(F,T,FF,FT,ArgPos)) :-
  362    !,
  363    extra_pos(Extra, T, ExtraPos),
  364    append(ArgPos0, ExtraPos, ArgPos).
  365extend_pos(FF-FT, Extra,
  366           term_position(FF,FT,FF,FT,ArgPos)) :-
  367    !,
  368    extra_pos(Extra, FT, ArgPos).
  369
  370extra_pos(1, T, [T-T]).
  371extra_pos(2, T, [T-T,T-T]).
  372
  373nt_pos(PhrasePos, _NTPos) :-
  374    var(PhrasePos),
  375    !.
  376nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos).
  377
  378t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :-
  379    compound(Pos0),
  380    !,
  381    arg(1, Pos0, F),
  382    arg(2, Pos0, T).
  383t_pos(_, _).
  384
  385
  386%!  qcall_instantiated(@Term) is semidet.
  387%
  388%   True if Term is instantiated sufficiently to call it.
  389%
  390%   @tbd    Shouldn't this be callable straight away?
  391
  392qcall_instantiated(Var) :-
  393    var(Var),
  394    !,
  395    fail.
  396qcall_instantiated(M:C) :-
  397    !,
  398    atom(M),
  399    callable(C).
  400qcall_instantiated(C) :-
  401    callable(C).
  402
  403
  404                 /*******************************
  405                 *            DEBUGGER          *
  406                 *******************************/
  407
  408:- multifile
  409    prolog_clause:unify_goal/5.  410
  411prolog_clause:unify_goal(Maplist, Expanded, _Module, Pos0, Pos) :-
  412    is_maplist(Maplist),
  413    maplist_expansion(Expanded),
  414    Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]),
  415    Pos  = term_position(F,T,FF,FT,ArgsPos).
  416
  417is_maplist(Goal) :-
  418    compound(Goal),
  419    compound_name_arity(Goal, maplist, A),
  420    A >= 2.
  421
  422maplist_expansion(Expanded) :-
  423    compound(Expanded),
  424    compound_name_arity(Expanded, Name, _),
  425    sub_atom(Name, 0, _, _, '__aux_maplist/').
  426
  427
  428                 /*******************************
  429                 *          XREF/COLOUR         *
  430                 *******************************/
  431
  432:- multifile
  433    prolog_colour:vararg_goal_classification/3.  434
  435prolog_colour:vararg_goal_classification(maplist, Arity, expanded) :-
  436    Arity >= 2.
  437
  438
  439                 /*******************************
  440                 *           ACTIVATE           *
  441                 *******************************/
  442
  443:- multifile
  444    system:goal_expansion/2,
  445    system:goal_expansion/4.  446
  447%       @tbd    Should we only apply if optimization is enabled (-O)?
  448
  449system:goal_expansion(GoalIn, GoalOut) :-
  450    \+ current_prolog_flag(xref, true),
  451    expand_apply(GoalIn, GoalOut).
  452system:goal_expansion(GoalIn, PosIn, GoalOut, PosOut) :-
  453    expand_apply(GoalIn, PosIn, GoalOut, PosOut).
  454
  455		 /*******************************
  456		 *            MESSAGES		*
  457		 *******************************/
  458
  459:- multifile
  460    prolog:message//1.  461
  462prolog:message(maplist(inconsistent_length(Maplist, Lens))) -->
  463    { functor(Maplist, _, N) },
  464    [ 'maplist/~d called with proper lists of different lengths (~p) always fails'
  465      -[N, Lens] ]