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:- autoload(library(error),[type_error/2]). 41:- autoload(library(lists),[append/3]).
69:- dynamic 70 user:goal_expansion/2. 71:- multifile 72 user:goal_expansion/2.
79expand_maplist(Callable0, Lists, Goal) :- 80 length(Lists, N), 81 expand_closure_no_fail(Callable0, N, Callable1), 82 ( Callable1 = _:_ 83 -> strip_module(Callable1, M, Callable), 84 NextGoal = M:NextCall, 85 QPred = M:Pred 86 ; Callable = Callable1, 87 NextGoal = NextCall, 88 QPred = Pred 89 ), 90 Callable =.. [Pred|Args], 91 length(Args, Argc), 92 length(Argv, Argc), 93 length(Vars, N), 94 MapArity is N + 1, 95 format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]), 96 append(Lists, Args, AuxArgs), 97 Goal =.. [AuxName|AuxArgs], 98 99 AuxArity is N+Argc, 100 prolog_load_context(module, Module), 101 functor(NextCall, Pred, AuxArity), 102 \+ predicate_property(Module:NextGoal, transparent), 103 ( predicate_property(Module:Goal, defined) 104 -> true 105 ; empty_lists(N, BaseLists), 106 length(Anon, Argc), 107 append(BaseLists, Anon, BaseArgs), 108 BaseClause =.. [AuxName|BaseArgs], 109 110 heads_and_tails(N, NextArgs, Vars, Tails), 111 append(NextArgs, Argv, AllNextArgs), 112 NextHead =.. [AuxName|AllNextArgs], 113 append(Argv, Vars, PredArgs), 114 NextCall =.. [Pred|PredArgs], 115 append(Tails, Argv, IttArgs), 116 NextIterate =.. [AuxName|IttArgs], 117 NextClause = (NextHead :- NextGoal, NextIterate), 118 compile_aux_clauses([BaseClause, NextClause]) 119 ). 120 121expand_closure_no_fail(Callable0, N, Callable1) :- 122 '$expand_closure'(Callable0, N, Callable1), 123 !. 124expand_closure_no_fail(Callable, _, Callable). 125 126empty_lists(0, []) :- !. 127empty_lists(N, [[]|T]) :- 128 N2 is N - 1, 129 empty_lists(N2, T). 130 131heads_and_tails(0, [], [], []). 132heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :- 133 N2 is N - 1, 134 heads_and_tails(N2, L1, L2, L3).
141expand_apply(Maplist, Goal) :-
142 compound(Maplist),
143 compound_name_arity(Maplist, maplist, N),
144 N >= 2,
145 Maplist =.. [maplist, Callable|Lists],
146 qcall_instantiated(Callable),
147 !,
148 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.160expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :- 161 Goal = \+((Cond, \+(Action))), 162 ( nonvar(Pos0), 163 Pos0 = term_position(_,_,_,_,[PosCond,PosAct]) 164 -> Pos = term_position(0,0,0,0, % \+ 165 [ term_position(0,0,0,0, % ,/2 166 [ PosCond, 167 term_position(0,0,0,0, % \+ 168 [PosAct]) 169 ]) 170 ]) 171 ; true 172 ). 173expand_apply(once(Once), Pos0, Goal, Pos) :- 174 Goal = (Once->true), 175 ( nonvar(Pos0), 176 Pos0 = term_position(_,_,_,_,[OncePos]), 177 compound(OncePos) 178 -> Pos = term_position(0,0,0,0, % ->/2 179 [ OncePos, 180 F-T % true 181 ]), 182 arg(2, OncePos, F), % highlight true/false on ")" 183 T is F+1 184 ; true 185 ). 186expand_apply(ignore(Ignore), Pos0, Goal, Pos) :- 187 Goal = (Ignore->true;true), 188 ( nonvar(Pos0), 189 Pos0 = term_position(_,_,_,_,[IgnorePos]), 190 compound(IgnorePos) 191 -> Pos = term_position(0,0,0,0, % ;/2 192 [ term_position(0,0,0,0, % ->/2 193 [ IgnorePos, 194 F-T % true 195 ]), 196 F-T % true 197 ]), 198 arg(2, IgnorePos, F), % highlight true/false on ")" 199 T is F+1 200 ; true 201 ). 202expand_apply(Phrase, Pos0, Expanded, Pos) :- 203 expand_phrase(Phrase, Pos0, Expanded, Pos), 204 !.
For example:
?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
224expand_phrase(Phrase, Goal) :- 225 expand_phrase(Phrase, _, Goal, _). 226 227expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :- 228 !, 229 extend_pos(Pos0, 1, Pos1), 230 expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos). 231expand_phrase(Goal, Pos0, NewGoal, Pos) :- 232 dcg_goal(Goal, NT, Xs0, Xs), 233 nonvar(NT), 234 nt_pos(Pos0, NTPos), 235 dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs). 236 237dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs). 238dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
242dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :- 243 compound(Compound0), 244 \+ dcg_control(Compound0), 245 !, 246 extend_pos(Pos0, 2, Pos), 247 compound_name_arguments(Compound0, Name, Args0), 248 append(Args0, [Xs0,Xs], Args), 249 compound_name_arguments(Compound, Name, Args). 250dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :- 251 atom(Name), 252 \+ dcg_control(Name), 253 !, 254 extend_pos(Pos0, 2, Pos), 255 compound_name_arguments(Compound, Name, [Xs0,Xs]). 256dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :- 257 compound(Q0), Q0 = M:Q1, 258 '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos), 259 dcg_extend(Q1, APos0, Q, APos, Xs0, Xs). 260dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :- 261 terminal(Terminal, DList, Xs), 262 !, 263 t_pos(Pos0, Pos). 264 265dcg_control(!). 266dcg_control([]). 267dcg_control([_|_]). 268dcg_control({_}). 269dcg_control((_,_)). 270dcg_control((_;_)). 271dcg_control((_->_)). 272dcg_control((_*->_)). 273dcg_control(_:_). 274 275terminal(List, DList, Tail) :- 276 compound(List), 277 List = [_|_], 278 !, 279 '$skip_list'(_, List, T0), 280 ( var(T0) 281 -> DList = List, 282 Tail = T0 283 ; T0 == [] 284 -> append(List, Tail, DList) 285 ; type_error(list, List) 286 ). 287terminal(List, DList, Tail) :- 288 List == [], 289 !, 290 DList = Tail. 291terminal(String, DList, Tail) :- 292 string(String), 293 string_codes(String, List), 294 append(List, Tail, DList). 295 296extend_pos(Var, _, Var) :- 297 var(Var), 298 !. 299extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra, 300 term_position(F,T,FF,FT,ArgPos)) :- 301 !, 302 extra_pos(Extra, T, ExtraPos), 303 append(ArgPos0, ExtraPos, ArgPos). 304extend_pos(FF-FT, Extra, 305 term_position(FF,FT,FF,FT,ArgPos)) :- 306 !, 307 extra_pos(Extra, FT, ArgPos). 308 309extra_pos(1, T, [T-T]). 310extra_pos(2, T, [T-T,T-T]). 311 312nt_pos(PhrasePos, _NTPos) :- 313 var(PhrasePos), 314 !. 315nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos). 316 317t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :- 318 compound(Pos0), 319 !, 320 arg(1, Pos0, F), 321 arg(2, Pos0, T). 322t_pos(_, _).
331qcall_instantiated(Var) :- 332 var(Var), 333 !, 334 fail. 335qcall_instantiated(M:C) :- 336 !, 337 atom(M), 338 callable(C). 339qcall_instantiated(C) :- 340 callable(C). 341 342 343 /******************************* 344 * DEBUGGER * 345 *******************************/ 346 347:- multifile 348 prolog_clause:unify_goal/5. 349 350prolog_clauseunify_goal(Maplist, Expanded, _Module, Pos0, Pos) :- 351 is_maplist(Maplist), 352 maplist_expansion(Expanded), 353 Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]), 354 Pos = term_position(F,T,FF,FT,ArgsPos). 355 356is_maplist(Goal) :- 357 compound(Goal), 358 compound_name_arity(Goal, maplist, A), 359 A >= 2. 360 361maplist_expansion(Expanded) :- 362 compound(Expanded), 363 compound_name_arity(Expanded, Name, _), 364 sub_atom(Name, 0, _, _, '__aux_maplist/'). 365 366 367 /******************************* 368 * XREF/COLOUR * 369 *******************************/ 370 371:- multifile 372 prolog_colour:vararg_goal_classification/3. 373 374prolog_colourvararg_goal_classification(maplist, Arity, expanded) :- 375 Arity >= 2. 376 377 378 /******************************* 379 * ACTIVATE * 380 *******************************/ 381 382:- multifile 383 system:goal_expansion/2, 384 system:goal_expansion/4. 385 386% @tbd Should we only apply if optimization is enabled (-O)? 387 388systemgoal_expansion(GoalIn, GoalOut) :- 389 \+ current_prolog_flag(xref, true), 390 expand_apply(GoalIn, GoalOut). 391systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 392 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 auxiliary 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.