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