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(Compound0, Pos0, Compound, Pos, Xs0, Xs) :- 304 compound(Compound0), 305 \+ dcg_control(Compound0), 306 !, 307 extend_pos(Pos0, 2, Pos), 308 compound_name_arguments(Compound0, Name, Args0), 309 append(Args0, [Xs0,Xs], Args), 310 compound_name_arguments(Compound, Name, Args). 311dcg_extend(Name, Pos0, Compound, Pos, Xs0, Xs) :- 312 atom(Name), 313 \+ dcg_control(Name), 314 !, 315 extend_pos(Pos0, 2, Pos), 316 compound_name_arguments(Compound, Name, [Xs0,Xs]). 317dcg_extend(Q0, Pos0, M:Q, Pos, Xs0, Xs) :- 318 compound(Q0), Q0 = M:Q1, 319 '$expand':f2_pos(Pos0, MPos, APos0, Pos, MPos, APos), 320 dcg_extend(Q1, APos0, Q, APos, Xs0, Xs). 321dcg_extend(Terminal, Pos0, Xs0 = DList, Pos, Xs0, Xs) :- 322 terminal(Terminal, DList, Xs), 323 !, 324 t_pos(Pos0, Pos). 325 326dcg_control(!). 327dcg_control([]). 328dcg_control([_|_]). 329dcg_control({_}). 330dcg_control((_,_)). 331dcg_control((_;_)). 332dcg_control((_->_)). 333dcg_control((_*->_)). 334dcg_control(_:_). 335 336terminal(List, DList, Tail) :- 337 compound(List), 338 List = [_|_], 339 !, 340 '$skip_list'(_, List, T0), 341 ( var(T0) 342 -> DList = List, 343 Tail = T0 344 ; T0 == [] 345 -> append(List, Tail, DList) 346 ; type_error(list, List) 347 ). 348terminal(List, DList, Tail) :- 349 List == [], 350 !, 351 DList = Tail. 352terminal(String, DList, Tail) :- 353 string(String), 354 string_codes(String, List), 355 append(List, Tail, DList). 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. 446 447% @tbd Should we only apply if optimization is enabled (-O)? 448 449systemgoal_expansion(GoalIn, GoalOut) :- 450 \+ current_prolog_flag(xref, true), 451 expand_apply(GoalIn, GoalOut). 452systemgoal_expansion(GoalIn, PosIn, GoalOut, PosOut) :- 453 expand_apply(GoalIn, PosIn, GoalOut, PosOut). 454 455 /******************************* 456 * MESSAGES * 457 *******************************/ 458 459:- multifile 460 prolog:message//1. 461 462prologmessage(maplist(inconsistent_length(Maplist, Lens))) --> 463 { functor(Maplist, _, N) }, 464 [ 'maplist/~d called with proper lists of different lengths (~p) always fails' 465 -[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.