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 user: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 ( hidden_module(M, Name/Arity) 273 -> atomic_list_concat([Name, /, Arity], Label) 274 ; atomic_list_concat([M, :, Name, /, Arity], Label) 275 ). 276predicate_label(M:Name//Arity, Label) :- 277 !, 278 ( hidden_module(M, Name//Arity) 279 -> atomic_list_concat([Name, //, Arity], Label) 280 ; atomic_list_concat([M, :, Name, //, Arity], Label) 281 ). 282predicate_label(Name/Arity, Label) :- 283 !, 284 atomic_list_concat([Name, /, Arity], Label). 285predicate_label(Name//Arity, Label) :- 286 !, 287 atomic_list_concat([Name, //, Arity], Label). 288 (system, _). 290hidden_module(user, _). 291hidden_module(M, Name/Arity) :- 292 functor(H, Name, Arity), 293 predicate_property(system:H, imported_from(M)). 294hidden_module(M, Name//DCGArity) :- 295 Arity is DCGArity+1, 296 functor(H, Name, Arity), 297 predicate_property(system:H, imported_from(M)).
303predicate_sort_key(_:PI, Name) :- 304 !, 305 predicate_sort_key(PI, Name). 306predicate_sort_key(Name/_Arity, Name). 307predicate_sort_key(Name//_Arity, Name).
317is_control_goal(Goal) :- 318 var(Goal), 319 !, fail. 320is_control_goal((_,_)). 321is_control_goal((_;_)). 322is_control_goal((_->_)). 323is_control_goal((_|_)). 324is_control_goal((_*->_)). 325is_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).
336body_term_calls(M:Body, Calls) :- 337 body_term_calls(Body, M, M, Calls). 338 339body_term_calls(Var, M, C, Calls) :- 340 var(Var), 341 !, 342 qualify(M, C, Var, Calls). 343body_term_calls(M:Goal, _, C, Calls) :- 344 !, 345 body_term_calls(Goal, M, C, Calls). 346body_term_calls(Goal, M, C, Calls) :- 347 qualify(M, C, Goal, Calls). 348body_term_calls((A,B), M, C, Calls) :- 349 !, 350 ( body_term_calls(A, M, C, Calls) 351 ; body_term_calls(B, M, C, Calls) 352 ). 353body_term_calls((A;B), M, C, Calls) :- 354 !, 355 ( body_term_calls(A, M, C, Calls) 356 ; body_term_calls(B, M, C, Calls) 357 ). 358body_term_calls((A->B), M, C, Calls) :- 359 !, 360 ( body_term_calls(A, M, C, Calls) 361 ; body_term_calls(B, M, C, Calls) 362 ). 363body_term_calls((A*->B), M, C, Calls) :- 364 !, 365 ( body_term_calls(A, M, C, Calls) 366 ; body_term_calls(B, M, C, Calls) 367 ). 368body_term_calls(\+ A, M, C, Calls) :- 369 !, 370 body_term_calls(A, M, C, Calls). 371body_term_calls(Goal, M, C, Calls) :- 372 predicate_property(M:Goal, meta_predicate(Spec)), 373 \+ ( functor(Goal, call, _), 374 arg(1, Goal, A1), 375 strip_module(A1, _, P1), 376 var(P1) 377 ), 378 !, 379 arg(I, Spec, SArg), 380 arg(I, Goal, GArg), 381 meta_calls(SArg, GArg, Call0), 382 body_term_calls(Call0, M, C, Calls). 383 384meta_calls(0, Goal, Goal) :- 385 !. 386meta_calls(I, Goal0, Goal) :- 387 integer(I), 388 !, 389 length(Extra, I), 390 extend_goal(Goal0, Extra, Goal). 391meta_calls(//, Goal0, Goal) :- 392 extend_goal(Goal0, [_,_], Goal). 393meta_calls(^, Goal0, Goal) :- 394 !, 395 strip_existential(Goal0, Goal). 396 397strip_existential(Var, Var) :- 398 var(Var), 399 !. 400strip_existential(_^In, Out) :- 401 strip_existential(In, Out). 402 403qualify(M, C, Goal, Calls) :- 404 M == C, 405 !, 406 Calls = Goal. 407qualify(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:
*/