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-2023, 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 apply_macros_sentinel/0 41 ]). 42% maplist expansion uses maplist. Do not autoload. 43:- use_module(library(apply), [maplist/2, maplist/3, maplist/4]). 44:- use_module(library(yall), [is_lambda/1, lambda_calls/3]). 45% these may be autoloaded 46:- autoload(library(lists),[append/3]). 47:- autoload(library(prolog_code), [mkconj/3, extend_goal/3]).
74:- create_prolog_flag(optimise_apply, default, 75 [ keep(true), 76 type(oneof([default,false,true])) 77 ]). 78:- create_prolog_flag(apply_macros_scope, global, 79 [ keep(true), 80 type(oneof([global,imported])) 81 ]). 82 83:- dynamic 84 user:goal_expansion/2. 85:- multifile 86 user:goal_expansion/2.
97expand_maplist(Callable, Lists, Goal) :- 98 maplist(is_list, Lists), 99 maplist(length, Lists, Lens), 100 ( sort(Lens, [Len]) 101 -> Len < 10, 102 unfold_maplist(Lists, Callable, Goal), 103 ! 104 ; Maplist =.. [maplist,Callable|Lists], 105 print_message(warning, maplist(inconsistent_length(Maplist, Lens))), 106 fail 107 ). 108expand_maplist(Callable0, Lists, Goal) :- 109 length(Lists, N), 110 expand_closure_no_fail(Callable0, N, Callable1), 111 ( Callable1 = _:_ 112 -> strip_module(Callable1, M, Callable), 113 NextGoal = M:NextCall, 114 QPred = M:Pred 115 ; Callable = Callable1, 116 NextGoal = NextCall, 117 QPred = Pred 118 ), 119 Callable =.. [Pred|Args], 120 length(Args, Argc), 121 length(Argv, Argc), 122 length(Vars, N), 123 MapArity is N + 1, 124 format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, QPred, Argc]), 125 append(Lists, Args, AuxArgs), 126 Goal =.. [AuxName|AuxArgs], 127 128 AuxArity is N+Argc, 129 prolog_load_context(module, Module), 130 functor(NextCall, Pred, AuxArity), 131 \+ predicate_property(Module:NextGoal, transparent), 132 ( predicate_property(Module:Goal, defined) 133 -> true 134 ; empty_lists(N, BaseLists), 135 length(Anon, Argc), 136 append(BaseLists, Anon, BaseArgs), 137 BaseClause =.. [AuxName|BaseArgs], 138 139 heads_and_tails(N, NextArgs, Vars, Tails), 140 append(NextArgs, Argv, AllNextArgs), 141 NextHead =.. [AuxName|AllNextArgs], 142 append(Argv, Vars, PredArgs), 143 NextCall =.. [Pred|PredArgs], 144 append(Tails, Argv, IttArgs), 145 NextIterate =.. [AuxName|IttArgs], 146 NextClause = (NextHead :- NextGoal, NextIterate), 147 compile_aux_clauses([BaseClause, NextClause]) 148 ). 149 150unfold_maplist(Lists, Callable, Goal) :- 151 maplist(cons, Lists, Heads, Tails), 152 !, 153 maplist_extend_goal(Callable, Heads, G1), 154 unfold_maplist(Tails, Callable, G2), 155 mkconj(G1, G2, Goal). 156unfold_maplist(_, _, true). 157 158cons([H|T], H, T).
168maplist_extend_goal(Closure, Args, Goal) :- 169 is_lambda(Closure), 170 !, 171 lambda_calls(Closure, Args, Goal1), 172 expand_goal_no_instantiate(Goal1, Goal). 173maplist_extend_goal(Closure, Args, Goal) :- 174 extend_goal(Closure, Args, Goal1), 175 expand_goal_no_instantiate(Goal1, Goal). 176 177% using is_most_general_term/1 is an alternative, but fails 178% if the goal variables have attributes. 179 180expand_goal_no_instantiate(Goal0, Goal) :- 181 term_variables(Goal0, Vars0), 182 expand_goal(Goal0, Goal), 183 term_variables(Goal0, Vars1), 184 Vars0 == Vars1.
190expand_closure_no_fail(Callable0, N, Callable1) :- 191 '$expand_closure'(Callable0, N, Callable1), 192 !. 193expand_closure_no_fail(Callable, _, Callable). 194 195empty_lists(0, []) :- !. 196empty_lists(N, [[]|T]) :- 197 N2 is N - 1, 198 empty_lists(N2, T). 199 200heads_and_tails(0, [], [], []). 201heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :- 202 N2 is N - 1, 203 heads_and_tails(N2, L1, L2, L3).
210expand_apply(Maplist, Goal) :-
211 compound(Maplist),
212 compound_name_arity(Maplist, maplist, N),
213 N >= 2,
214 Maplist =.. [maplist, Callable|Lists],
215 qcall_instantiated(Callable),
216 !,
217 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.229expand_apply(forall(Cond, Action), Pos0, Goal, Pos) :- 230 Goal = \+((Cond, \+(Action))), 231 ( nonvar(Pos0), 232 Pos0 = term_position(_,_,_,_,[PosCond,PosAct]) 233 -> Pos = term_position(0,0,0,0, % \+ 234 [ term_position(0,0,0,0, % ,/2 235 [ PosCond, 236 term_position(0,0,0,0, % \+ 237 [PosAct]) 238 ]) 239 ]) 240 ; true 241 ). 242expand_apply(once(Once), Pos0, Goal, Pos) :- 243 Goal = (Once->true), 244 ( nonvar(Pos0), 245 Pos0 = term_position(_,_,_,_,[OncePos]), 246 compound(OncePos) 247 -> Pos = term_position(0,0,0,0, % ->/2 248 [ OncePos, 249 F-T % true 250 ]), 251 arg(2, OncePos, F), % highlight true/false on ")" 252 T is F+1 253 ; true 254 ). 255expand_apply(ignore(Ignore), Pos0, Goal, Pos) :- 256 Goal = (Ignore->true;true), 257 ( nonvar(Pos0), 258 Pos0 = term_position(_,_,_,_,[IgnorePos]), 259 compound(IgnorePos) 260 -> Pos = term_position(0,0,0,0, % ;/2 261 [ term_position(0,0,0,0, % ->/2 262 [ IgnorePos, 263 F-T % true 264 ]), 265 F-T % true 266 ]), 267 arg(2, IgnorePos, F), % highlight true/false on ")" 268 T is F+1 269 ; true 270 ). 271expand_apply(Phrase, Pos0, Expanded, Pos) :- 272 expand_phrase(Phrase, Pos0, Expanded, Pos), 273 !.
For example:
?- expand_phrase(phrase(("ab", rule)), List), Goal).
Goal = (List=[97, 98|_G121], rule(_G121, [])).
293expand_phrase(Phrase, Goal) :- 294 expand_phrase(Phrase, _, Goal, _). 295 296expand_phrase(phrase(NT,Xs), Pos0, NTXsNil, Pos) :- 297 !, 298 extend_pos(Pos0, 1, Pos1), 299 expand_phrase(phrase(NT,Xs,[]), Pos1, NTXsNil, Pos). 300expand_phrase(Goal, Pos0, NewGoal, Pos) :- 301 dcg_goal(Goal, NT, Xs0, Xs), 302 nonvar(NT), 303 nt_pos(Pos0, NTPos), 304 dcg_extend(NT, NTPos, NewGoal, Pos, Xs0, Xs). 305 306dcg_goal(phrase(NT,Xs0,Xs), NT, Xs0, Xs). 307dcg_goal(call_dcg(NT,Xs0,Xs), NT, Xs0, Xs).
311dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :- 312 terminal(Terminal, DList, Xs), 313 !, 314 t_pos(Pos0, Pos). 315dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :- 316 nonvar(Q0), Q0 = M:Q1, 317 !, 318 '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos), 319 dcg_extend(Q1, APos0, Q, APos, Xs0, Xs). 320dcg_extend(Control, _, _, _, _, _) :- 321 dcg_control(Control), 322 !, 323 fail. 324dcg_extend(Compound0, Pos0, Compound, Pos, Xs0, Xs) :- 325 compound(Compound0), 326 !, 327 extend_pos(Pos0, 2, Pos), 328 compound_name_arguments(Compound0, Name, Args0), 329 append(Args0, [Xs0,Xs], Args), 330 compound_name_arguments(Compound, Name, Args). 331dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :- 332 atom(Name), 333 !, 334 extend_pos(Pos0, 2, Pos), 335 compound_name_arguments(Compound, Name, [Xs0,Xs]). 336 337dcg_control(!). 338dcg_control([]). 339dcg_control([_|_]). 340dcg_control({_}). 341dcg_control((_,_)). 342dcg_control((_;_)). 343dcg_control((_->_)). 344dcg_control((_*->_)). 345 346terminal([], DList, Tail) => 347 DList = Tail. 348terminal(String, DList, Tail), string(String) => 349 string(String), 350 string_codes(String, List), 351 append(List, Tail, DList). 352terminal(List, DList, Tail), is_list(List) => 353 append(List, Tail, DList). 354terminal(_, _, _) => 355 fail. 356 357extend_pos(Var, _, Var) :- 358 var(Var), 359 !. 360extend_pos(term_position(F,T,FF,FT,ArgPos0), Extra, 361 term_position(F,T,FF,FT,ArgPos)) :- 362 !, 363 extra_pos(Extra, T, ExtraPos), 364 append(ArgPos0, ExtraPos, ArgPos). 365extend_pos(FF-FT, Extra, 366 term_position(FF,FT,FF,FT,ArgPos)) :- 367 !, 368 extra_pos(Extra, FT, ArgPos). 369 370extra_pos(1, T, [T-T]). 371extra_pos(2, T, [T-T,T-T]). 372 373nt_pos(PhrasePos, _NTPos) :- 374 var(PhrasePos), 375 !. 376nt_pos(term_position(_,_,_,_,[NTPos|_]), NTPos). 377 378t_pos(Pos0, term_position(F,T,F,T,[F-T,F-T])) :- 379 compound(Pos0), 380 !, 381 arg(1, Pos0, F), 382 arg(2, Pos0, T). 383t_pos(_, _).
392qcall_instantiated(Var) :- 393 var(Var), 394 !, 395 fail. 396qcall_instantiated(M:C) :- 397 !, 398 atom(M), 399 callable(C). 400qcall_instantiated(C) :- 401 callable(C). 402 403 404 /******************************* 405 * DEBUGGER * 406 *******************************/ 407 408:- multifile 409 prolog_clause:unify_goal/5. 410 411prolog_clauseunify_goal(Maplist, Expanded, _Module, Pos0, Pos) :- 412 is_maplist(Maplist), 413 maplist_expansion(Expanded), 414 Pos0 = term_position(F,T,FF,FT,[_MapPos|ArgsPos]), 415 Pos = term_position(F,T,FF,FT,ArgsPos). 416 417is_maplist(Goal) :- 418 compound(Goal), 419 compound_name_arity(Goal, maplist, A), 420 A >= 2. 421 422maplist_expansion(Expanded) :- 423 compound(Expanded), 424 compound_name_arity(Expanded, Name, _), 425 sub_atom(Name, 0, _, _, '__aux_maplist/'). 426 427 428 /******************************* 429 * XREF/COLOUR * 430 *******************************/ 431 432:- multifile 433 prolog_colour:vararg_goal_classification/3. 434 435prolog_colourvararg_goal_classification(maplist, Arity, expanded) :- 436 Arity >= 2. 437 438 439 /******************************* 440 * ACTIVATE * 441 *******************************/ 442 443:- multifile 444 system:goal_expansion/2, 445 system:goal_expansion/4.
apply_macros is set to imported.453apply_macros_sentinel. 454 455optimise_apply :- 456 ( current_prolog_flag(optimise_apply, true) 457 -> true 458 ; current_prolog_flag(optimise_apply, default), 459 current_prolog_flag(optimise, true) 460 -> true 461 ). 462 463apply_macros :- 464 current_prolog_flag(xref, true), 465 !, 466 fail. 467apply_macros :- 468 optimise_apply, 469 current_prolog_flag(apply_macros_scope, Scope), 470 apply_macros(Scope). 471 472apply_macros(global) => 473 true. 474apply_macros(imported) => 475 prolog_load_context(module, M), 476 predicate_property(M:apply_macros_sentinel, imported_from(apply_macros)), 477 !. 478 479systemgoal_expansion(GoalIn, GoalOut) :- 480 apply_macros, 481 expand_apply(GoalIn, GoalOut). 482systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 483 apply_macros, 484 expand_apply(GoalIn, PosIn, GoalOut, PosOut). 485 486 487 /******************************* 488 * MESSAGES * 489 *******************************/ 490 491:- multifile 492 prolog:message//1. 493 494prologmessage(maplist(inconsistent_length(Maplist, Lens))) --> 495 { functor(Maplist, _, N) }, 496 [ 'maplist/~d called with proper lists of different lengths (~p) always fails' 497 -[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.