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 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).
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).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.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 !.
For example:
?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
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).
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(_, _).
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_clauseunify_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_colourvararg_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 386systemgoal_expansion(GoalIn, GoalOut) :- 387 \+ current_prolog_flag(xref, true), 388 expand_apply(GoalIn, GoalOut). 389systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 390 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.