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(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :-
  304    terminal(Terminal, DList, Xs),
  305    !,
  306    t_pos(Pos0, Pos).
  307dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :-
  308    nonvar(Q0), Q0 = M:Q1,
  309    !,
  310    '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos),
  311    dcg_extend(Q1, APos0, Q, APos, Xs0, Xs).
  312dcg_extend(Control, _, _, _, _, _) :-
  313    dcg_control(Control),
  314    !,
  315    fail.
  316dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :-
  317    compound(Compound0),
  318    !,
  319    extend_pos(Pos0, 2, Pos),
  320    compound_name_arguments(Compound0, Name, Args0),
  321    append(Args0, [Xs0,Xs], Args),
  322    compound_name_arguments(Compound, Name, Args).
  323dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :-
  324    atom(Name),
  325    !,
  326    extend_pos(Pos0, 2, Pos),
  327    compound_name_arguments(Compound, Name, [Xs0,Xs]).
  328
  329dcg_control(!).
  330dcg_control([]).
  331dcg_control([_|_]).
  332dcg_control({_}).
  333dcg_control((_,_)).
  334dcg_control((_;_)).
  335dcg_control((_->_)).
  336dcg_control((_*->_)).
  337
  338terminal([], DList, Tail) =>
  339    DList = Tail.
  340terminal(String, DList, Tail), string(String) =>
  341    string(String),
  342    string_codes(String, List),
  343    append(List, Tail, DList).
  344terminal(List, DList, Tail), is_list(List) =>
  345    append(List, Tail, DList).
  346terminal(_, _, _) =>
  347    fail.
  348
  349extend_pos(Var, _, Var) :-
  350    var(Var),
  351    !.
  352extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra,
  353           term_position(F,T,FF,FT,ArgPos)) :-
  354    !,
  355    extra_pos(Extra, T, ExtraPos),
  356    append(ArgPos0, ExtraPos, ArgPos).
  357extend_pos(FF-FT, Extra,
  358           term_position(FF,FT,FF,FT,ArgPos)) :-
  359    !,
  360    extra_pos(Extra, FT, ArgPos).
  361
  362extra_pos(1, T, [T-T]).
  363extra_pos(2, T, [T-T,T-T]).
  364
  365nt_pos(PhrasePos, _NTPos) :-
  366    var(PhrasePos),
  367    !.
  368nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos).
  369
  370t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :-
  371    compound(Pos0),
  372    !,
  373    arg(1, Pos0, F),
  374    arg(2, Pos0, T).
  375t_pos(_, _).
  376
  377
  378%!  qcall_instantiated(@Term) is semidet.
  379%
  380%   True if Term is instantiated sufficiently to call it.
  381%
  382%   @tbd    Shouldn't this be callable straight away?
  383
  384qcall_instantiated(Var) :-
  385    var(Var),
  386    !,
  387    fail.
  388qcall_instantiated(M:C) :-
  389    !,
  390    atom(M),
  391    callable(C).
  392qcall_instantiated(C) :-
  393    callable(C).
  394
  395
  396                 /*******************************
  397                 *            DEBUGGER          *
  398                 *******************************/
  399
  400:- multifile
  401    prolog_clause:unify_goal/5.  402
  403prolog_clause:unify_goal(Maplist, Expanded, _Module, Pos0, Pos) :-
  404    is_maplist(Maplist),
  405    maplist_expansion(Expanded),
  406    Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]),
  407    Pos  = term_position(F,T,FF,FT,ArgsPos).
  408
  409is_maplist(Goal) :-
  410    compound(Goal),
  411    compound_name_arity(Goal, maplist, A),
  412    A >= 2.
  413
  414maplist_expansion(Expanded) :-
  415    compound(Expanded),
  416    compound_name_arity(Expanded, Name, _),
  417    sub_atom(Name, 0, _, _, '__aux_maplist/').
  418
  419
  420                 /*******************************
  421                 *          XREF/COLOUR         *
  422                 *******************************/
  423
  424:- multifile
  425    prolog_colour:vararg_goal_classification/3.  426
  427prolog_colour:vararg_goal_classification(maplist, Arity, expanded) :-
  428    Arity >= 2.
  429
  430
  431                 /*******************************
  432                 *           ACTIVATE           *
  433                 *******************************/
  434
  435:- multifile
  436    system:goal_expansion/2,
  437    system:goal_expansion/4.  438
  439%       @tbd    Should we only apply if optimization is enabled (-O)?
  440
  441system:goal_expansion(GoalIn, GoalOut) :-
  442    \+ current_prolog_flag(xref, true),
  443    expand_apply(GoalIn, GoalOut).
  444system:goal_expansion(GoalIn, PosIn, GoalOut, PosOut) :-
  445    expand_apply(GoalIn, PosIn, GoalOut, PosOut).
  446
  447		 /*******************************
  448		 *            MESSAGES		*
  449		 *******************************/
  450
  451:- multifile
  452    prolog:message//1.  453
  454prolog:message(maplist(inconsistent_length(Maplist, Lens))) -->
  455    { functor(Maplist, _, N) },
  456    [ 'maplist/~d called with proper lists of different lengths (~p) always fails'
  457      -[N, Lens] ]