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)).
67:- dynamic 68 user:goal_expansion/2. 69:- multifile 70 user:goal_expansion/2.
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).
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).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 !.
For example:
?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
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).
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(_, _).
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_clauseunify_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_colourvararg_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 384systemgoal_expansion(GoalIn, GoalOut) :- 385 \+ current_prolog_flag(xref, true), 386 expand_apply(GoalIn, GoalOut). 387systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 388 expand_apply(GoalIn, PosIn, GoalOut, PosOut)
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.