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) 2019-2020, VU University Amsterdam 7 CWI, 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(prolog_code, 37 [ comma_list/2, % (A,B) <-> [A,B] 38 semicolon_list/2, % (A;B) <-> [A,B] 39 40 mkconj/3, % +A, +B, -Conjunction 41 mkdisj/3, % +A, +B, -Disjunction 42 43 pi_head/2, % :PI, :Head 44 head_name_arity/3, % ?Goal, ?Name, ?Arity 45 46 most_general_goal/2, % :Goal, -General 47 extend_goal/3, % :Goal, +Extra, -GoalOut 48 49 predicate_label/2, % +PI, -Label 50 predicate_sort_key/2, % +PI, -Key 51 52 is_control_goal/1, % @Term 53 is_predicate_indicator/1, % @Term 54 55 body_term_calls/2 % :BodyTerm, -Goal 56 ]). 57:- autoload(library(error),[must_be/2, instantiation_error/1]). 58:- autoload(library(lists),[append/3]). 59 60:- meta_predicate 61 body_term_calls(, ). 62 63:- multifile 64 user:prolog_predicate_name/2.
This predicate is typically used to reason about Prolog conjunctions (disjunctions) as many operations are easier on lists than on binary trees over some operator.
95comma_list(CommaList, List) :- 96 phrase(binlist(CommaList, ','), List). 97semicolon_list(CommaList, List) :- 98 phrase(binlist(CommaList, ';'), List). 99 100binlist(Term, Functor) --> 101 { nonvar(Term) }, 102 !, 103 ( { Term =.. [Functor,A,B] } 104 -> binlist(A, Functor), 105 binlist(B, Functor) 106 ; [Term] 107 ). 108binlist(Term, Functor) --> 109 [A], 110 ( var_tail 111 -> ( { Term = A } 112 ; { Term =.. [Functor,A,B] }, 113 binlist(B,Functor) 114 ) 115 ; \+ [_] 116 -> {Term = A} 117 ; binlist(B,Functor), 118 {Term =.. [Functor,A,B]} 119 ). 120 121var_tail(H, H) :- 122 var(H).
true (mkconj/2) and false (mkdisj/2). Note that a false
encountered in a conjunction does not cause the conjunction to
be false, i.e. semantics under side effects are preserved.
The Prolog `, and ;` operators are of type xfy, i.e. right
associative. These predicates preserve this grouping. For example,
?- mkconj((a,b), c, Conj) Conj = (a,b,c)
138mkconj(A,B,Conj) :- 139 ( is_true(A) 140 -> Conj = B 141 ; is_true(B) 142 -> Conj = A 143 ; mkconj_(A,B,Conj) 144 ). 145 146mkconj_((A,B), C, Conj) => 147 Conj = (A,C2), 148 mkconj_(B,C,C2). 149mkconj_(A, B, C) => 150 C = (A,B). 151 152mkdisj(A,B,Disj) :- 153 ( is_false(A) 154 -> Disj = B 155 ; is_false(B) 156 -> Disj = A 157 ; mkdisj_(A,B,Disj) 158 ). 159 160mkdisj_((A;B), C, Disj) => 161 Disj = (A;C2), 162 mkdisj_(B, C, C2). 163mkdisj_(A, B, C) => 164 C = (A;B). 165 166is_true(Goal) :- Goal == true. 167is_false(Goal) :- (Goal == false -> true ; Goal == fail).
173is_predicate_indicator(Var) :- 174 var(Var), 175 !, 176 instantiation_error(Var). 177is_predicate_indicator(PI) :- 178 strip_module(PI, M, PI1), 179 atom(M), 180 ( PI1 = (Name/Arity) 181 -> true 182 ; PI1 = (Name//Arity) 183 ), 184 atom(Name), 185 integer(Arity), 186 Arity >= 0.
195pi_head(PI, Head) :-
196 '$pi_head'(PI, Head).
204head_name_arity(Goal, Name, Arity) :-
205 '$head_name_arity'(Goal, Name, Arity).213most_general_goal(Goal, General) :- 214 var(Goal), 215 !, 216 General = Goal. 217most_general_goal(Goal, General) :- 218 atom(Goal), 219 !, 220 General = Goal. 221most_general_goal(M:Goal, M:General) :- 222 !, 223 most_general_goal(Goal, General). 224most_general_goal(Compound, General) :- 225 compound_name_arity(Compound, Name, Arity), 226 compound_name_arity(General, Name, Arity).
call(Goal0, ...) is returned.235extend_goal(Goal0, Extra, Goal) :- 236 var(Goal0), 237 !, 238 Goal =.. [call,Goal0|Extra]. 239extend_goal(M:Goal0, Extra, M:Goal) :- 240 extend_goal(Goal0, Extra, Goal). 241extend_goal(Atom, Extra, Goal) :- 242 atom(Atom), 243 !, 244 Goal =.. [Atom|Extra]. 245extend_goal(Goal0, Extra, Goal) :- 246 compound_name_arguments(Goal0, Name, Args0), 247 append(Args0, Extra, Args), 248 compound_name_arguments(Goal, Name, Args). 249 250 251 /******************************* 252 * LABELS * 253 *******************************/
user and built-in
predicates. This predicate is intended for reporting predicate
information to the user, for example in the profiler.
First PI is converted to a head and the hook prolog_predicate_name/2 is tried.
265predicate_label(PI, Label) :- 266 must_be(ground, PI), 267 pi_head(PI, Head), 268 user:prolog_predicate_name(Head, Label), 269 !. 270predicate_label(M:Name/Arity, Label) :- 271 !, 272 predicate_name_(Name, PName), 273 ( hidden_module(M, PName/Arity) 274 -> atomic_list_concat([PName, /, Arity], Label) 275 ; atomic_list_concat([M, :, PName, /, Arity], Label) 276 ). 277predicate_label(M:Name//Arity, Label) :- 278 !, 279 predicate_name_(Name, PName), 280 ( hidden_module(M, PName//Arity) 281 -> atomic_list_concat([PName, //, Arity], Label) 282 ; atomic_list_concat([M, :, PName, //, Arity], Label) 283 ). 284predicate_label(Name/Arity, Label) :- 285 !, 286 predicate_name_(Name, PName), 287 atomic_list_concat([PName, /, Arity], Label). 288predicate_label(Name//Arity, Label) :- 289 !, 290 predicate_name_(Name, PName), 291 atomic_list_concat([PName, //, Arity], Label). 292 293predicate_name_([], '[]') :- !. % "compatibility hack" 294predicate_name_(Name, Name). 295 (system, _). 297hidden_module(user, _). 298hidden_module(M, Name/Arity) :- 299 functor(H, Name, Arity), 300 predicate_property(system:H, imported_from(M)). 301hidden_module(M, Name//DCGArity) :- 302 Arity is DCGArity+1, 303 functor(H, Name, Arity), 304 predicate_property(system:H, imported_from(M)).
310predicate_sort_key(_:PI, Name) :- 311 !, 312 predicate_sort_key(PI, Name). 313predicate_sort_key(Name/_Arity, Name). 314predicate_sort_key(Name//_Arity, Name).
324is_control_goal(Goal) :- 325 var(Goal), 326 !, fail. 327is_control_goal((_,_)). 328is_control_goal((_;_)). 329is_control_goal((_->_)). 330is_control_goal((_|_)). 331is_control_goal((_*->_)). 332is_control_goal(\+(_)).
When a variable is called, this is normally returned in Goal.
Currently if a variable is called with additional arguments, e.g.,
call(Var, a1), this call is reported as call(Var, a1).
343body_term_calls(M:Body, Calls) :- 344 body_term_calls(Body, M, M, Calls). 345 346body_term_calls(Var, M, C, Calls) :- 347 var(Var), 348 !, 349 qualify(M, C, Var, Calls). 350body_term_calls(M:Goal, _, C, Calls) :- 351 !, 352 body_term_calls(Goal, M, C, Calls). 353body_term_calls(Goal, M, C, Calls) :- 354 qualify(M, C, Goal, Calls). 355body_term_calls((A,B), M, C, Calls) :- 356 !, 357 ( body_term_calls(A, M, C, Calls) 358 ; body_term_calls(B, M, C, Calls) 359 ). 360body_term_calls((A;B), M, C, Calls) :- 361 !, 362 ( body_term_calls(A, M, C, Calls) 363 ; body_term_calls(B, M, C, Calls) 364 ). 365body_term_calls((A->B), M, C, Calls) :- 366 !, 367 ( body_term_calls(A, M, C, Calls) 368 ; body_term_calls(B, M, C, Calls) 369 ). 370body_term_calls((A*->B), M, C, Calls) :- 371 !, 372 ( body_term_calls(A, M, C, Calls) 373 ; body_term_calls(B, M, C, Calls) 374 ). 375body_term_calls(\+ A, M, C, Calls) :- 376 !, 377 body_term_calls(A, M, C, Calls). 378body_term_calls(Goal, M, C, Calls) :- 379 predicate_property(M:Goal, meta_predicate(Spec)), 380 \+ ( functor(Goal, call, _), 381 arg(1, Goal, A1), 382 strip_module(A1, _, P1), 383 var(P1) 384 ), 385 !, 386 arg(I, Spec, SArg), 387 arg(I, Goal, GArg), 388 meta_calls(SArg, GArg, Call0), 389 body_term_calls(Call0, M, C, Calls). 390 391meta_calls(0, Goal, Goal) :- 392 !. 393meta_calls(I, Goal0, Goal) :- 394 integer(I), 395 !, 396 length(Extra, I), 397 extend_goal(Goal0, Extra, Goal). 398meta_calls(//, Goal0, Goal) :- 399 extend_goal(Goal0, [_,_], Goal). 400meta_calls(^, Goal0, Goal) :- 401 !, 402 strip_existential(Goal0, Goal). 403 404strip_existential(Var, Var) :- 405 var(Var), 406 !. 407strip_existential(_^In, Out) :- 408 strip_existential(In, Out). 409 410qualify(M, C, Goal, Calls) :- 411 M == C, 412 !, 413 Calls = Goal. 414qualify(M, _, Goal, M:Goal)
Utilities for reasoning about code
This library collects utilities to reason about terms commonly needed for reasoning about Prolog code. Note that many related facilities can be found in the core as well as other libraries:
*/