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-2023, 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            apply_macros_sentinel/0
   41          ]).   42% maplist expansion uses maplist.  Do not autoload.
   43:- use_module(library(apply), [maplist/2, maplist/3, maplist/4]).   44:- use_module(library(yall), [is_lambda/1, lambda_calls/3]).   45% these may be autoloaded
   46:- autoload(library(lists),[append/3]).   47:- autoload(library(prolog_code), [mkconj/3, extend_goal/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:- create_prolog_flag(optimise_apply, default,
   75                      [ keep(true),
   76                        type(oneof([default,false,true]))
   77                      ]).   78:- create_prolog_flag(apply_macros_scope, global,
   79                      [ keep(true),
   80                        type(oneof([global,imported]))
   81                      ]).   82
   83:- dynamic
   84    user:goal_expansion/2.   85:- multifile
   86    user:goal_expansion/2.   87
   88%!  expand_maplist(+Callable, +Lists, -Goal) is det.
   89%
   90%   Macro expansion for maplist/2 and  higher   arity.  The first clause
   91%   deals with code using maplist on fixed  lists to reduce typing. Note
   92%   that we only expand if all  lists   have  fixed length. In theory we
   93%   only need at least one of fixed length,   but  in that case the goal
   94%   expansion instantiates variables in the  clause, causing issues with
   95%   the remainder of the clause expansion mechanism.
   96
   97expand_maplist(Callable, Lists, Goal) :-
   98    maplist(is_list, Lists),
   99    maplist(length, Lists, Lens),
  100    (   sort(Lens, [Len])
  101    ->  Len < 10,
  102        unfold_maplist(Lists, Callable, Goal),
  103        !
  104    ;   Maplist =.. [maplist,Callable|Lists],
  105        print_message(warning, maplist(inconsistent_length(Maplist, Lens))),
  106        fail
  107    ).
  108expand_maplist(Callable0, Lists, Goal) :-
  109    length(Lists, N),
  110    expand_closure_no_fail(Callable0, N, Callable1),
  111    (   Callable1 = _:_
  112    ->  strip_module(Callable1, M, Callable),
  113        NextGoal = M:NextCall,
  114        QPred = M:Pred
  115    ;   Callable = Callable1,
  116        NextGoal = NextCall,
  117        QPred = Pred
  118    ),
  119    Callable =.. [Pred|Args],
  120    length(Args, Argc),
  121    length(Argv, Argc),
  122    length(Vars, N),
  123    MapArity is N + 1,
  124    format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]),
  125    append(Lists, Args, AuxArgs),
  126    Goal =.. [AuxName|AuxArgs],
  127
  128    AuxArity is N+Argc,
  129    prolog_load_context(module, Module),
  130    functor(NextCall, Pred, AuxArity),
  131    \+ predicate_property(Module:NextGoal, transparent),
  132    (   predicate_property(Module:Goal, defined)
  133    ->  true
  134    ;   empty_lists(N, BaseLists),
  135        length(Anon, Argc),
  136        append(BaseLists, Anon, BaseArgs),
  137        BaseClause =.. [AuxName|BaseArgs],
  138
  139        heads_and_tails(N, NextArgs, Vars, Tails),
  140        append(NextArgs, Argv, AllNextArgs),
  141        NextHead =.. [AuxName|AllNextArgs],
  142        append(Argv, Vars, PredArgs),
  143        NextCall =.. [Pred|PredArgs],
  144        append(Tails, Argv, IttArgs),
  145        NextIterate =.. [AuxName|IttArgs],
  146        NextClause = (NextHead :- NextGoal, NextIterate),
  147        compile_aux_clauses([BaseClause, NextClause])
  148    ).
  149
  150unfold_maplist(Lists, Callable, Goal) :-
  151    maplist(cons, Lists, Heads, Tails),
  152    !,
  153    maplist_extend_goal(Callable, Heads, G1),
  154    unfold_maplist(Tails, Callable, G2),
  155    mkconj(G1, G2, Goal).
  156unfold_maplist(_, _, true).
  157
  158cons([H|T], H, T).
  159
  160%!  maplist_extend_goal(+Closure, +Args, -Goal) is semidet.
  161%
  162%   Extend the maplist Closure with Args.   This  can be tricky. Notably
  163%   library(yall) lambda expressions may instantiate   the Closure while
  164%   the  real  execution  does  not.  We    can   solve  that  by  using
  165%   lambda_calls/3. The expand_goal_no_instantiate/2 ensures   safe goal
  166%   expansion.
  167
  168maplist_extend_goal(Closure, Args, Goal) :-
  169    is_lambda(Closure),
  170    !,
  171    lambda_calls(Closure, Args, Goal1),
  172    expand_goal_no_instantiate(Goal1, Goal).
  173maplist_extend_goal(Closure, Args, Goal) :-
  174    extend_goal(Closure, Args, Goal1),
  175    expand_goal_no_instantiate(Goal1, Goal).
  176
  177% using is_most_general_term/1 is an alternative, but fails
  178% if the goal variables have attributes.
  179
  180expand_goal_no_instantiate(Goal0, Goal) :-
  181    term_variables(Goal0, Vars0),
  182    expand_goal(Goal0, Goal),
  183    term_variables(Goal0, Vars1),
  184    Vars0 == Vars1.
  185
  186%!  expand_closure_no_fail(+Goal, +Extra:integer, -GoalExt) is det.
  187%
  188%   Add Extra additional arguments to Goal.
  189
  190expand_closure_no_fail(Callable0, N, Callable1) :-
  191    '$expand_closure'(Callable0, N, Callable1),
  192    !.
  193expand_closure_no_fail(Callable, _, Callable).
  194
  195empty_lists(0, []) :- !.
  196empty_lists(N, [[]|T]) :-
  197    N2 is N - 1,
  198    empty_lists(N2, T).
  199
  200heads_and_tails(0, [], [], []).
  201heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :-
  202    N2 is N - 1,
  203    heads_and_tails(N2, L1, L2, L3).
  204
  205
  206%!  expand_apply(+GoalIn:callable, -GoalOut) is semidet.
  207%
  208%   Macro expansion for `apply' predicates.
  209
  210expand_apply(Maplist, Goal) :-
  211    compound(Maplist),
  212    compound_name_arity(Maplist, maplist, N),
  213    N >= 2,
  214    Maplist =.. [maplist, Callable|Lists],
  215    qcall_instantiated(Callable),
  216    !,
  217    expand_maplist(Callable, Lists, Goal).
  218
  219%!  expand_apply(+GoalIn:callable, -GoalOut, +PosIn, -PosOut) is semidet.
  220%
  221%   Translation  of  simple  meta  calls    to   inline  code  while
  222%   maintaining position information. Note that once(Goal) cannot be
  223%   translated  to  `(Goal->true)`  because  this   will  break  the
  224%   compilation of `(once(X) ; Y)`.  A   correct  translation  is to
  225%   `(Goal->true;fail)`.       Abramo       Bagnara        suggested
  226%   `((Goal->true),true)`, which is both faster   and avoids warning
  227%   if style_check(+var_branches) is used.
  228
  229expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :-
  230    Goal = \+((Cond, \+(Action))),
  231    (   nonvar(Pos0),
  232        Pos0 = term_position(_,_,_,_,[PosCond,PosAct])
  233    ->  Pos = term_position(0,0,0,0, % \+
  234                            [ term_position(0,0,0,0, % ,/2
  235                                            [ PosCond,
  236                                              term_position(0,0,0,0, % \+
  237                                                            [PosAct])
  238                                            ])
  239                            ])
  240    ;   true
  241    ).
  242expand_apply(once(Once), Pos0, Goal, Pos) :-
  243    Goal = (Once->true),
  244    (   nonvar(Pos0),
  245        Pos0 = term_position(_,_,_,_,[OncePos]),
  246        compound(OncePos)
  247    ->  Pos = term_position(0,0,0,0,        % ->/2
  248                            [ OncePos,
  249                              F-T           % true
  250                            ]),
  251        arg(2, OncePos, F),         % highlight true/false on ")"
  252        T is F+1
  253    ;   true
  254    ).
  255expand_apply(ignore(Ignore), Pos0, Goal, Pos) :-
  256    Goal = (Ignore->true;true),
  257    (   nonvar(Pos0),
  258        Pos0 = term_position(_,_,_,_,[IgnorePos]),
  259        compound(IgnorePos)
  260    ->  Pos = term_position(0,0,0,0,                        % ;/2
  261                            [ term_position(0,0,0,0,        % ->/2
  262                                            [ IgnorePos,
  263                                              F-T           % true
  264                                            ]),
  265                              F-T                           % true
  266                            ]),
  267        arg(2, IgnorePos, F),       % highlight true/false on ")"
  268        T is F+1
  269    ;   true
  270    ).
  271expand_apply(Phrase, Pos0, Expanded, Pos) :-
  272    expand_phrase(Phrase, Pos0, Expanded, Pos),
  273    !.
  274
  275
  276%!  expand_phrase(+PhraseGoal, -Goal) is semidet.
  277%!  expand_phrase(+PhraseGoal, +Pos0, -Goal, -Pos) is semidet.
  278%
  279%   Provide goal-expansion for  PhraseGoal.   PhraseGoal  is  either
  280%   phrase/2,3  or  call_dcg/2,3.  The  current   version  does  not
  281%   translate control structures, but  only   simple  terminals  and
  282%   non-terminals.
  283%
  284%   For example:
  285%
  286%     ==
  287%     ?- expand_phrase(phrase(("ab", rule)), List), Goal).
  288%     Goal = (List=[97, 98|_G121], rule(_G121, [])).
  289%     ==
  290%
  291%   @throws Re-throws errors from dcg_translate_rule/2
  292
  293expand_phrase(Phrase, Goal) :-
  294    expand_phrase(Phrase, _, Goal, _).
  295
  296expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :-
  297    !,
  298    extend_pos(Pos0, 1, Pos1),
  299    expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos).
  300expand_phrase(Goal, Pos0, NewGoal, Pos) :-
  301    dcg_goal(Goal, NT, Xs0, Xs),
  302    nonvar(NT),
  303    nt_pos(Pos0, NTPos),
  304    dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs).
  305
  306dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs).
  307dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
  308
  309%!  dcg_extend(+Callable, +Pos0, -Goal, -Pos, +Xs0, ?Xs) is semidet.
  310
  311dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :-
  312    terminal(Terminal, DList, Xs),
  313    !,
  314    t_pos(Pos0, Pos).
  315dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :-
  316    nonvar(Q0), Q0 = M:Q1,
  317    !,
  318    '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos),
  319    dcg_extend(Q1, APos0, Q, APos, Xs0, Xs).
  320dcg_extend(Control, _, _, _, _, _) :-
  321    dcg_control(Control),
  322    !,
  323    fail.
  324dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :-
  325    compound(Compound0),
  326    !,
  327    extend_pos(Pos0, 2, Pos),
  328    compound_name_arguments(Compound0, Name, Args0),
  329    append(Args0, [Xs0,Xs], Args),
  330    compound_name_arguments(Compound, Name, Args).
  331dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :-
  332    atom(Name),
  333    !,
  334    extend_pos(Pos0, 2, Pos),
  335    compound_name_arguments(Compound, Name, [Xs0,Xs]).
  336
  337dcg_control(!).
  338dcg_control([]).
  339dcg_control([_|_]).
  340dcg_control({_}).
  341dcg_control((_,_)).
  342dcg_control((_;_)).
  343dcg_control((_->_)).
  344dcg_control((_*->_)).
  345
  346terminal([], DList, Tail) =>
  347    DList = Tail.
  348terminal(String, DList, Tail), string(String) =>
  349    string(String),
  350    string_codes(String, List),
  351    append(List, Tail, DList).
  352terminal(List, DList, Tail), is_list(List) =>
  353    append(List, Tail, DList).
  354terminal(_, _, _) =>
  355    fail.
  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%!  apply_macros_sentinel
  448%
  449%   Used to detect that library(apply_macros) is loaded into the current
  450%   context  explicitly.  This  test  is  used    if   the  Prolog  flag
  451%   `apply_macros` is set to `imported`.
  452
  453apply_macros_sentinel.
  454
  455optimise_apply :-
  456    (   current_prolog_flag(optimise_apply, true)
  457    ->  true
  458    ;   current_prolog_flag(optimise_apply, default),
  459        current_prolog_flag(optimise, true)
  460    ->  true
  461    ).
  462
  463apply_macros :-
  464    current_prolog_flag(xref, true),
  465    !,
  466    fail.
  467apply_macros :-
  468    optimise_apply,
  469    current_prolog_flag(apply_macros_scope, Scope),
  470    apply_macros(Scope).
  471
  472apply_macros(global) =>
  473    true.
  474apply_macros(imported) =>
  475    prolog_load_context(module, M),
  476    predicate_property(M:apply_macros_sentinel, imported_from(apply_macros)),
  477    !.
  478
  479system:goal_expansion(GoalIn, GoalOut) :-
  480    apply_macros,
  481    expand_apply(GoalIn, GoalOut).
  482system:goal_expansion(GoalIn, PosIn, GoalOut, PosOut) :-
  483    apply_macros,
  484    expand_apply(GoalIn, PosIn, GoalOut, PosOut).
  485
  486
  487		 /*******************************
  488		 *            MESSAGES		*
  489		 *******************************/
  490
  491:- multifile
  492    prolog:message//1.  493
  494prolog:message(maplist(inconsistent_length(Maplist, Lens))) -->
  495    { functor(Maplist, _, N) },
  496    [ 'maplist/~d called with proper lists of different lengths (~p) always fails'
  497      -[N, Lens] ]