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)).
  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).