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-2021, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(apply_macros, 38 [ expand_phrase/2, % :PhraseGoal, -Goal 39 expand_phrase/4 % :PhraseGoal, +Pos0, -Goal, -Pos 40 ]). 41% maplist expansion uses maplist. Do not autoload. 42:- use_module(library(apply), [maplist/2, maplist/3, maplist/4]). 43% these may be autoloaded 44:- autoload(library(error),[type_error/2]). 45:- autoload(library(lists),[append/3]). 46:- autoload(library(prolog_code), [mkconj/3, extend_goal/3]). 47:- autoload(library(yall), [is_lambda/1, lambda_calls/3]).
74:- dynamic 75 user:goal_expansion/2. 76:- multifile 77 user:goal_expansion/2.
89expand_maplist(Callable, Lists, Goal) :- 90 maplist(is_list, Lists), 91 maplist(length, Lists, Lens), 92 ( sort(Lens, [Len]) 93 -> Len < 10, 94 unfold_maplist(Lists, Callable, Goal), 95 ! 96 ; Maplist =.. [maplist,Callable|Lists], 97 print_message(warning, maplist(inconsistent_length(Maplist, Lens))), 98 fail 99 ). 100expand_maplist(Callable0, Lists, Goal) :- 101 length(Lists, N), 102 expand_closure_no_fail(Callable0, N, Callable1), 103 ( Callable1 = _:_ 104 -> strip_module(Callable1, M, Callable), 105 NextGoal = M:NextCall, 106 QPred = M:Pred 107 ; Callable = Callable1, 108 NextGoal = NextCall, 109 QPred = Pred 110 ), 111 Callable =.. [Pred|Args], 112 length(Args, Argc), 113 length(Argv, Argc), 114 length(Vars, N), 115 MapArity is N + 1, 116 format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]), 117 append(Lists, Args, AuxArgs), 118 Goal =.. [AuxName|AuxArgs], 119 120 AuxArity is N+Argc, 121 prolog_load_context(module, Module), 122 functor(NextCall, Pred, AuxArity), 123 \+ predicate_property(Module:NextGoal, transparent), 124 ( predicate_property(Module:Goal, defined) 125 -> true 126 ; empty_lists(N, BaseLists), 127 length(Anon, Argc), 128 append(BaseLists, Anon, BaseArgs), 129 BaseClause =.. [AuxName|BaseArgs], 130 131 heads_and_tails(N, NextArgs, Vars, Tails), 132 append(NextArgs, Argv, AllNextArgs), 133 NextHead =.. [AuxName|AllNextArgs], 134 append(Argv, Vars, PredArgs), 135 NextCall =.. [Pred|PredArgs], 136 append(Tails, Argv, IttArgs), 137 NextIterate =.. [AuxName|IttArgs], 138 NextClause = (NextHead :- NextGoal, NextIterate), 139 compile_aux_clauses([BaseClause, NextClause]) 140 ). 141 142unfold_maplist(Lists, Callable, Goal) :- 143 maplist(cons, Lists, Heads, Tails), 144 !, 145 maplist_extend_goal(Callable, Heads, G1), 146 unfold_maplist(Tails, Callable, G2), 147 mkconj(G1, G2, Goal). 148unfold_maplist(_, _, true). 149 150cons([H|T], H, T).
160maplist_extend_goal(Closure, Args, Goal) :- 161 is_lambda(Closure), 162 !, 163 lambda_calls(Closure, Args, Goal1), 164 expand_goal_no_instantiate(Goal1, Goal). 165maplist_extend_goal(Closure, Args, Goal) :- 166 extend_goal(Closure, Args, Goal1), 167 expand_goal_no_instantiate(Goal1, Goal). 168 169% using is_most_general_term/1 is an alternative, but fails 170% if the goal variables have attributes. 171 172expand_goal_no_instantiate(Goal0, Goal) :- 173 term_variables(Goal0, Vars0), 174 expand_goal(Goal0, Goal), 175 term_variables(Goal0, Vars1), 176 Vars0 == Vars1.
182expand_closure_no_fail(Callable0, N, Callable1) :- 183 '$expand_closure'(Callable0, N, Callable1), 184 !. 185expand_closure_no_fail(Callable, _, Callable). 186 187empty_lists(0, []) :- !. 188empty_lists(N, [[]|T]) :- 189 N2 is N - 1, 190 empty_lists(N2, T). 191 192heads_and_tails(0, [], [], []). 193heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :- 194 N2 is N - 1, 195 heads_and_tails(N2, L1, L2, L3).
202expand_apply(Maplist, Goal) :-
203 compound(Maplist),
204 compound_name_arity(Maplist, maplist, N),
205 N >= 2,
206 Maplist =.. [maplist, Callable|Lists],
207 qcall_instantiated(Callable),
208 !,
209 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.221expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :- 222 Goal = \+((Cond, \+(Action))), 223 ( nonvar(Pos0), 224 Pos0 = term_position(_,_,_,_,[PosCond,PosAct]) 225 -> Pos = term_position(0,0,0,0, % \+ 226 [ term_position(0,0,0,0, % ,/2 227 [ PosCond, 228 term_position(0,0,0,0, % \+ 229 [PosAct]) 230 ]) 231 ]) 232 ; true 233 ). 234expand_apply(once(Once), Pos0, Goal, Pos) :- 235 Goal = (Once->true), 236 ( nonvar(Pos0), 237 Pos0 = term_position(_,_,_,_,[OncePos]), 238 compound(OncePos) 239 -> Pos = term_position(0,0,0,0, % ->/2 240 [ OncePos, 241 F-T % true 242 ]), 243 arg(2, OncePos, F), % highlight true/false on ")" 244 T is F+1 245 ; true 246 ). 247expand_apply(ignore(Ignore), Pos0, Goal, Pos) :- 248 Goal = (Ignore->true;true), 249 ( nonvar(Pos0), 250 Pos0 = term_position(_,_,_,_,[IgnorePos]), 251 compound(IgnorePos) 252 -> Pos = term_position(0,0,0,0, % ;/2 253 [ term_position(0,0,0,0, % ->/2 254 [ IgnorePos, 255 F-T % true 256 ]), 257 F-T % true 258 ]), 259 arg(2, IgnorePos, F), % highlight true/false on ")" 260 T is F+1 261 ; true 262 ). 263expand_apply(Phrase, Pos0, Expanded, Pos) :- 264 expand_phrase(Phrase, Pos0, Expanded, Pos), 265 !.
For example:
?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
285expand_phrase(Phrase, Goal) :- 286 expand_phrase(Phrase, _, Goal, _). 287 288expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :- 289 !, 290 extend_pos(Pos0, 1, Pos1), 291 expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos). 292expand_phrase(Goal, Pos0, NewGoal, Pos) :- 293 dcg_goal(Goal, NT, Xs0, Xs), 294 nonvar(NT), 295 nt_pos(Pos0, NTPos), 296 dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs). 297 298dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs). 299dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
303dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :- 304 terminal(Terminal, DList, Xs), 305 !, 306 t_pos(Pos0, Pos). 307dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :- 308 nonvar(Q0), Q0 = M:Q1, 309 !, 310 '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos), 311 dcg_extend(Q1, APos0, Q, APos, Xs0, Xs). 312dcg_extend(Control, _, _, _, _, _) :- 313 dcg_control(Control), 314 !, 315 fail. 316dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :- 317 compound(Compound0), 318 !, 319 extend_pos(Pos0, 2, Pos), 320 compound_name_arguments(Compound0, Name, Args0), 321 append(Args0, [Xs0,Xs], Args), 322 compound_name_arguments(Compound, Name, Args). 323dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :- 324 atom(Name), 325 !, 326 extend_pos(Pos0, 2, Pos), 327 compound_name_arguments(Compound, Name, [Xs0,Xs]). 328 329dcg_control(!). 330dcg_control([]). 331dcg_control([_|_]). 332dcg_control({_}). 333dcg_control((_,_)). 334dcg_control((_;_)). 335dcg_control((_->_)). 336dcg_control((_*->_)). 337 338terminal([], DList, Tail) => 339 DList = Tail. 340terminal(String, DList, Tail), string(String) => 341 string(String), 342 string_codes(String, List), 343 append(List, Tail, DList). 344terminal(List, DList, Tail), is_list(List) => 345 append(List, Tail, DList). 346terminal(_, _, _) => 347 fail. 348 349extend_pos(Var, _, Var) :- 350 var(Var), 351 !. 352extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra, 353 term_position(F,T,FF,FT,ArgPos)) :- 354 !, 355 extra_pos(Extra, T, ExtraPos), 356 append(ArgPos0, ExtraPos, ArgPos). 357extend_pos(FF-FT, Extra, 358 term_position(FF,FT,FF,FT,ArgPos)) :- 359 !, 360 extra_pos(Extra, FT, ArgPos). 361 362extra_pos(1, T, [T-T]). 363extra_pos(2, T, [T-T,T-T]). 364 365nt_pos(PhrasePos, _NTPos) :- 366 var(PhrasePos), 367 !. 368nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos). 369 370t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :- 371 compound(Pos0), 372 !, 373 arg(1, Pos0, F), 374 arg(2, Pos0, T). 375t_pos(_, _).
384qcall_instantiated(Var) :- 385 var(Var), 386 !, 387 fail. 388qcall_instantiated(M:C) :- 389 !, 390 atom(M), 391 callable(C). 392qcall_instantiated(C) :- 393 callable(C). 394 395 396 /******************************* 397 * DEBUGGER * 398 *******************************/ 399 400:- multifile 401 prolog_clause:unify_goal/5. 402 403prolog_clauseunify_goal(Maplist, Expanded, _Module, Pos0, Pos) :- 404 is_maplist(Maplist), 405 maplist_expansion(Expanded), 406 Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]), 407 Pos = term_position(F,T,FF,FT,ArgsPos). 408 409is_maplist(Goal) :- 410 compound(Goal), 411 compound_name_arity(Goal, maplist, A), 412 A >= 2. 413 414maplist_expansion(Expanded) :- 415 compound(Expanded), 416 compound_name_arity(Expanded, Name, _), 417 sub_atom(Name, 0, _, _, '__aux_maplist/'). 418 419 420 /******************************* 421 * XREF/COLOUR * 422 *******************************/ 423 424:- multifile 425 prolog_colour:vararg_goal_classification/3. 426 427prolog_colourvararg_goal_classification(maplist, Arity, expanded) :- 428 Arity >= 2. 429 430 431 /******************************* 432 * ACTIVATE * 433 *******************************/ 434 435:- multifile 436 system:goal_expansion/2, 437 system:goal_expansion/4. 438 439% @tbd Should we only apply if optimization is enabled (-O)? 440 441systemgoal_expansion(GoalIn, GoalOut) :- 442 \+ current_prolog_flag(xref, true), 443 expand_apply(GoalIn, GoalOut). 444systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 445 expand_apply(GoalIn, PosIn, GoalOut, PosOut). 446 447 /******************************* 448 * MESSAGES * 449 *******************************/ 450 451:- multifile 452 prolog:message//1. 453 454prologmessage(maplist(inconsistent_length(Maplist, Lens))) --> 455 { functor(Maplist, _, N) }, 456 [ 'maplist/~d called with proper lists of different lengths (~p) always fails' 457 -[N, Lens] ]
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.