View source with raw comments or as raw
    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)).

Goal expansion rules to avoid meta-calling

This module defines goal_expansion/2 rules to deal with commonly used, but fundamentally slow meta-predicates. Notable maplist/2... defines a useful set of predicates, but its execution is considerable slower than a traditional Prolog loop. Using this library calls to maplist/2... are translated into an call to a generated auxilary predicate that is compiled using compile_aux_clauses/1. Currently this module supports:

The idea for this library originates from ECLiPSe and came to SWI-Prolog through YAP.

author
- Jan Wielemaker */
To be done
- Support more predicates
   67:- dynamic
   68    user:goal_expansion/2.   69:- multifile
   70    user:goal_expansion/2.
 expand_maplist(+Callable, +Lists, -Goal) is det
Macro expansion for maplist/2 and higher arity.
   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).
 expand_apply(+GoalIn:callable, -GoalOut) is semidet
Macro expansion for `apply' predicates.
  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).
 expand_apply(+GoalIn:callable, -GoalOut, +PosIn, -PosOut) is semidet
Translation of simple meta calls to inline code while maintaining position information. Note that once(Goal) cannot be translated to (Goal->true) because this will break the compilation of (once(X) ; Y). A correct translation is to (Goal->true;fail). Abramo Bagnara suggested ((Goal->true),true), which is both faster and avoids warning if style_check(+var_branches) is used.
  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    !.
 expand_phrase(+PhraseGoal, -Goal) is semidet
 expand_phrase(+PhraseGoal, +Pos0, -Goal, -Pos) is semidet
Provide goal-expansion for PhraseGoal. PhraseGoal is either phrase/2,3 or call_dcg/2,3. The current version does not translate control structures, but only simple terminals and non-terminals.

For example:

?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
throws
- Re-throws errors from dcg_translate_rule/2
  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).
 dcg_extend(+Callable, +Pos0, -Goal, -Pos, +Xs0, ?Xs) is semidet
  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(_, _).
 qcall_instantiated(@Term) is semidet
True if Term is instantiated sufficiently to call it.
To be done
- Shouldn't this be callable straight away?
  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)