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-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(apply_macros,
   37          [ expand_phrase/2,            % :PhraseGoal, -Goal
   38            expand_phrase/4             % :PhraseGoal, +Pos0, -Goal, -Pos
   39          ]).   40:- use_module(library(lists)).   41
   42/** <module> Goal expansion rules to avoid meta-calling
   43
   44This module defines goal_expansion/2 rules to   deal with commonly used,
   45but fundamentally slow meta-predicates. Notable   maplist/2... defines a
   46useful set of predicates, but its  execution is considerable slower than
   47a traditional Prolog loop. Using this  library calls to maplist/2... are
   48translated into an call  to  a   generated  auxilary  predicate  that is
   49compiled using compile_aux_clauses/1. Currently this module supports:
   50
   51        * maplist/2..
   52        * forall/2
   53        * once/1
   54        * ignore/1
   55        * phrase/2
   56        * phrase/3
   57        * call_dcg/2
   58        * call_dcg/3
   59
   60The idea for this library originates from ECLiPSe and came to SWI-Prolog
   61through YAP.
   62
   63@tbd    Support more predicates
   64@author Jan Wielemaker
   65*/
   66
   67:- dynamic
   68    user:goal_expansion/2.   69:- multifile
   70    user:goal_expansion/2.   71
   72
   73%!  expand_maplist(+Callable, +Lists, -Goal) is det.
   74%
   75%   Macro expansion for maplist/2 and higher arity.
   76
   77expand_maplist(Callable0, Lists, Goal) :-
   78    length(Lists, N),
   79    expand_closure_no_fail(Callable0, N, Callable1),
   80    (   Callable1 = _:_
   81    ->  strip_module(Callable0, M, Callable),
   82        NextGoal = M:NextCall,
   83        QPred = M:Pred
   84    ;   Callable = Callable1,
   85        NextGoal = NextCall,
   86        QPred = Pred
   87    ),
   88    Callable =.. [Pred|Args],
   89    length(Args, Argc),
   90    length(Argv, Argc),
   91    length(Vars, N),
   92    MapArity is N + 1,
   93    format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]),
   94    append(Lists, Args, AuxArgs),
   95    Goal =.. [AuxName|AuxArgs],
   96
   97    AuxArity is N+Argc,
   98    prolog_load_context(module, Module),
   99    functor(NextCall, Pred, AuxArity),
  100    \+ predicate_property(Module:NextGoal, transparent),
  101    (   predicate_property(Module:Goal, defined)
  102    ->  true
  103    ;   empty_lists(N, BaseLists),
  104        length(Anon, Argc),
  105        append(BaseLists, Anon, BaseArgs),
  106        BaseClause =.. [AuxName|BaseArgs],
  107
  108        heads_and_tails(N, NextArgs, Vars, Tails),
  109        append(NextArgs, Argv, AllNextArgs),
  110        NextHead =.. [AuxName|AllNextArgs],
  111        append(Argv, Vars, PredArgs),
  112        NextCall =.. [Pred|PredArgs],
  113        append(Tails, Argv, IttArgs),
  114        NextIterate =.. [AuxName|IttArgs],
  115        NextClause = (NextHead :- NextGoal, NextIterate),
  116        compile_aux_clauses([BaseClause, NextClause])
  117    ).
  118
  119expand_closure_no_fail(Callable0, N, Callable1) :-
  120    '$expand_closure'(Callable0, N, Callable1),
  121    !.
  122expand_closure_no_fail(Callable, _, Callable).
  123
  124empty_lists(0, []) :- !.
  125empty_lists(N, [[]|T]) :-
  126    N2 is N - 1,
  127    empty_lists(N2, T).
  128
  129heads_and_tails(0, [], [], []).
  130heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :-
  131    N2 is N - 1,
  132    heads_and_tails(N2, L1, L2, L3).
  133
  134
  135%!  expand_apply(+GoalIn:callable, -GoalOut) is semidet.
  136%
  137%   Macro expansion for `apply' predicates.
  138
  139expand_apply(Maplist, Goal) :-
  140    compound(Maplist),
  141    compound_name_arity(Maplist, maplist, N),
  142    N >= 2,
  143    Maplist =.. [maplist, Callable|Lists],
  144    qcall_instantiated(Callable),
  145    !,
  146    expand_maplist(Callable, Lists, Goal).
  147
  148%!  expand_apply(+GoalIn:callable, -GoalOut, +PosIn, -PosOut) is semidet.
  149%
  150%   Translation  of  simple  meta  calls    to   inline  code  while
  151%   maintaining position information. Note that once(Goal) cannot be
  152%   translated  to  `(Goal->true)`  because  this   will  break  the
  153%   compilation of `(once(X) ; Y)`.  A   correct  translation  is to
  154%   `(Goal->true;fail)`.       Abramo       Bagnara        suggested
  155%   `((Goal->true),true)`, which is both faster   and avoids warning
  156%   if style_check(+var_branches) is used.
  157
  158expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :-
  159    Goal = \+((Cond, \+(Action))),
  160    (   nonvar(Pos0),
  161        Pos0 = term_position(_,_,_,_,[PosCond,PosAct])
  162    ->  Pos = term_position(0,0,0,0, % \+
  163                            [ term_position(0,0,0,0, % ,/2
  164                                            [ PosCond,
  165                                              term_position(0,0,0,0, % \+
  166                                                            [PosAct])
  167                                            ])
  168                            ])
  169    ;   true
  170    ).
  171expand_apply(once(Once), Pos0, Goal, Pos) :-
  172    Goal = (Once->true),
  173    (   nonvar(Pos0),
  174        Pos0 = term_position(_,_,_,_,[OncePos]),
  175        compound(OncePos)
  176    ->  Pos = term_position(0,0,0,0,        % ->/2
  177                            [ OncePos,
  178                              F-T           % true
  179                            ]),
  180        arg(2, OncePos, F),         % highlight true/false on ")"
  181        T is F+1
  182    ;   true
  183    ).
  184expand_apply(ignore(Ignore), Pos0, Goal, Pos) :-
  185    Goal = (Ignore->true;true),
  186    (   nonvar(Pos0),
  187        Pos0 = term_position(_,_,_,_,[IgnorePos]),
  188        compound(IgnorePos)
  189    ->  Pos = term_position(0,0,0,0,                        % ;/2
  190                            [ term_position(0,0,0,0,        % ->/2
  191                                            [ IgnorePos,
  192                                              F-T           % true
  193                                            ]),
  194                              F-T                           % true
  195                            ]),
  196        arg(2, IgnorePos, F),       % highlight true/false on ")"
  197        T is F+1
  198    ;   true
  199    ).
  200expand_apply(Phrase, Pos0, Expanded, Pos) :-
  201    expand_phrase(Phrase, Pos0, Expanded, Pos),
  202    !.
  203
  204
  205%!  expand_phrase(+PhraseGoal, -Goal) is semidet.
  206%!  expand_phrase(+PhraseGoal, +Pos0, -Goal, -Pos) is semidet.
  207%
  208%   Provide goal-expansion for  PhraseGoal.   PhraseGoal  is  either
  209%   phrase/2,3  or  call_dcg/2,3.  The  current   version  does  not
  210%   translate control structures, but  only   simple  terminals  and
  211%   non-terminals.
  212%
  213%   For example:
  214%
  215%     ==
  216%     ?- expand_phrase(phrase(("ab", rule)), List), Goal).
  217%     Goal = (List=[97, 98|_G121], rule(_G121, [])).
  218%     ==
  219%
  220%   @throws Re-throws errors from dcg_translate_rule/2
  221
  222expand_phrase(Phrase, Goal) :-
  223    expand_phrase(Phrase, _, Goal, _).
  224
  225expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :-
  226    !,
  227    extend_pos(Pos0, 1, Pos1),
  228    expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos).
  229expand_phrase(Goal, Pos0, NewGoal, Pos) :-
  230    dcg_goal(Goal, NT, Xs0, Xs),
  231    nonvar(NT),
  232    nt_pos(Pos0, NTPos),
  233    dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs).
  234
  235dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs).
  236dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
  237
  238%!  dcg_extend(+Callable, +Pos0, -Goal, -Pos, +Xs0, ?Xs) is semidet.
  239
  240dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :-
  241    compound(Compound0),
  242    \+ dcg_control(Compound0),
  243    !,
  244    extend_pos(Pos0, 2, Pos),
  245    compound_name_arguments(Compound0, Name, Args0),
  246    append(Args0, [Xs0,Xs], Args),
  247    compound_name_arguments(Compound, Name, Args).
  248dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :-
  249    atom(Name),
  250    \+ dcg_control(Name),
  251    !,
  252    extend_pos(Pos0, 2, Pos),
  253    compound_name_arguments(Compound, Name, [Xs0,Xs]).
  254dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :-
  255    compound(Q0), Q0 = M:Q1,
  256    '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos),
  257    dcg_extend(Q1, APos0, Q, APos, Xs0, Xs).
  258dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :-
  259    terminal(Terminal, DList, Xs),
  260    !,
  261    t_pos(Pos0, Pos).
  262
  263dcg_control(!).
  264dcg_control([]).
  265dcg_control([_|_]).
  266dcg_control({_}).
  267dcg_control((_,_)).
  268dcg_control((_;_)).
  269dcg_control((_->_)).
  270dcg_control((_*->_)).
  271dcg_control(_:_).
  272
  273terminal(List, DList, Tail) :-
  274    compound(List),
  275    List = [_|_],
  276    !,
  277    '$skip_list'(_, List, T0),
  278    (   var(T0)
  279    ->  DList = List,
  280        Tail = T0
  281    ;   T0 == []
  282    ->  append(List, Tail, DList)
  283    ;   type_error(list, List)
  284    ).
  285terminal(List, DList, Tail) :-
  286    List == [],
  287    !,
  288    DList = Tail.
  289terminal(String, DList, Tail) :-
  290    string(String),
  291    string_codes(String, List),
  292    append(List, Tail, DList).
  293
  294extend_pos(Var, _, Var) :-
  295    var(Var),
  296    !.
  297extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra,
  298           term_position(F,T,FF,FT,ArgPos)) :-
  299    !,
  300    extra_pos(Extra, T, ExtraPos),
  301    append(ArgPos0, ExtraPos, ArgPos).
  302extend_pos(FF-FT, Extra,
  303           term_position(FF,FT,FF,FT,ArgPos)) :-
  304    !,
  305    extra_pos(Extra, FT, ArgPos).
  306
  307extra_pos(1, T, [T-T]).
  308extra_pos(2, T, [T-T,T-T]).
  309
  310nt_pos(PhrasePos, _NTPos) :-
  311    var(PhrasePos),
  312    !.
  313nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos).
  314
  315t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :-
  316    compound(Pos0),
  317    !,
  318    arg(1, Pos0, F),
  319    arg(2, Pos0, T).
  320t_pos(_, _).
  321
  322
  323%!  qcall_instantiated(@Term) is semidet.
  324%
  325%   True if Term is instantiated sufficiently to call it.
  326%
  327%   @tbd    Shouldn't this be callable straight away?
  328
  329qcall_instantiated(Var) :-
  330    var(Var),
  331    !,
  332    fail.
  333qcall_instantiated(M:C) :-
  334    !,
  335    atom(M),
  336    callable(C).
  337qcall_instantiated(C) :-
  338    callable(C).
  339
  340
  341                 /*******************************
  342                 *            DEBUGGER          *
  343                 *******************************/
  344
  345:- multifile
  346    prolog_clause:unify_goal/5.  347
  348prolog_clause:unify_goal(Maplist, Expanded, _Module, Pos0, Pos) :-
  349    is_maplist(Maplist),
  350    maplist_expansion(Expanded),
  351    Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]),
  352    Pos  = term_position(F,T,FF,FT,ArgsPos).
  353
  354is_maplist(Goal) :-
  355    compound(Goal),
  356    functor(Goal, maplist, A),
  357    A >= 2.
  358
  359maplist_expansion(Expanded) :-
  360    compound(Expanded),
  361    functor(Expanded, Name, _),
  362    sub_atom(Name, 0, _, _, '__aux_maplist/').
  363
  364
  365                 /*******************************
  366                 *          XREF/COLOUR         *
  367                 *******************************/
  368
  369:- multifile
  370    prolog_colour:vararg_goal_classification/3.  371
  372prolog_colour:vararg_goal_classification(maplist, Arity, expanded) :-
  373    Arity >= 2.
  374
  375
  376                 /*******************************
  377                 *           ACTIVATE           *
  378                 *******************************/
  379
  380:- multifile
  381    system:goal_expansion/2,
  382    system:goal_expansion/4.  383
  384%       @tbd    Should we only apply if optimization is enabled (-O)?
  385
  386system:goal_expansion(GoalIn, GoalOut) :-
  387    \+ current_prolog_flag(xref, true),
  388    expand_apply(GoalIn, GoalOut).
  389system:goal_expansion(GoalIn, PosIn, GoalOut, PosOut) :-
  390    expand_apply(GoalIn, PosIn, GoalOut, PosOut)