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.130mkconj(A,B,Conj) :- 131 ( is_true(A) 132 -> Conj = B 133 ; is_true(B) 134 -> Conj = A 135 ; Conj = (A,B) 136 ). 137 138mkdisj(A,B,Conj) :- 139 ( is_false(A) 140 -> Conj = B 141 ; is_false(B) 142 -> Conj = A 143 ; Conj = (A;B) 144 ). 145 146is_true(Goal) :- Goal == true. 147is_false(Goal) :- (Goal == false -> true ; Goal == fail).
153is_predicate_indicator(Var) :- 154 var(Var), 155 !, 156 instantiation_error(Var). 157is_predicate_indicator(PI) :- 158 strip_module(PI, M, PI1), 159 atom(M), 160 ( PI1 = (Name/Arity) 161 -> true 162 ; PI1 = (Name//Arity) 163 ), 164 atom(Name), 165 integer(Arity), 166 Arity >= 0.
175pi_head(PI, Head) :-
176 '$pi_head'(PI, Head).
184head_name_arity(Goal, Name, Arity) :-
185 '$head_name_arity'(Goal, Name, Arity).193most_general_goal(Goal, General) :- 194 var(Goal), 195 !, 196 General = Goal. 197most_general_goal(Goal, General) :- 198 atom(Goal), 199 !, 200 General = Goal. 201most_general_goal(M:Goal, M:General) :- 202 !, 203 most_general_goal(Goal, General). 204most_general_goal(Compound, General) :- 205 compound_name_arity(Compound, Name, Arity), 206 compound_name_arity(General, Name, Arity).
call(Goal0, ...) is returned.215extend_goal(Goal0, Extra, Goal) :- 216 var(Goal0), 217 !, 218 Goal =.. [call,Goal0|Extra]. 219extend_goal(M:Goal0, Extra, M:Goal) :- 220 extend_goal(Goal0, Extra, Goal). 221extend_goal(Atom, Extra, Goal) :- 222 atom(Atom), 223 !, 224 Goal =.. [Atom|Extra]. 225extend_goal(Goal0, Extra, Goal) :- 226 compound_name_arguments(Goal0, Name, Args0), 227 append(Args0, Extra, Args), 228 compound_name_arguments(Goal, Name, Args). 229 230 231 /******************************* 232 * LABELS * 233 *******************************/
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.
245predicate_label(PI, Label) :- 246 must_be(ground, PI), 247 pi_head(PI, Head), 248 user:prolog_predicate_name(Head, Label), 249 !. 250predicate_label(M:Name/Arity, Label) :- 251 !, 252 ( hidden_module(M, Name/Arity) 253 -> atomic_list_concat([Name, /, Arity], Label) 254 ; atomic_list_concat([M, :, Name, /, Arity], Label) 255 ). 256predicate_label(M:Name//Arity, Label) :- 257 !, 258 ( hidden_module(M, Name//Arity) 259 -> atomic_list_concat([Name, //, Arity], Label) 260 ; atomic_list_concat([M, :, Name, //, Arity], Label) 261 ). 262predicate_label(Name/Arity, Label) :- 263 !, 264 atomic_list_concat([Name, /, Arity], Label). 265predicate_label(Name//Arity, Label) :- 266 !, 267 atomic_list_concat([Name, //, Arity], Label). 268 (system, _). 270hidden_module(user, _). 271hidden_module(M, Name/Arity) :- 272 functor(H, Name, Arity), 273 predicate_property(system:H, imported_from(M)). 274hidden_module(M, Name//DCGArity) :- 275 Arity is DCGArity+1, 276 functor(H, Name, Arity), 277 predicate_property(system:H, imported_from(M)).
283predicate_sort_key(_:PI, Name) :- 284 !, 285 predicate_sort_key(PI, Name). 286predicate_sort_key(Name/_Arity, Name). 287predicate_sort_key(Name//_Arity, Name).
297is_control_goal(Goal) :- 298 var(Goal), 299 !, fail. 300is_control_goal((_,_)). 301is_control_goal((_;_)). 302is_control_goal((_->_)). 303is_control_goal((_|_)). 304is_control_goal((_*->_)). 305is_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).
316body_term_calls(M:Body, Calls) :- 317 body_term_calls(Body, M, M, Calls). 318 319body_term_calls(Var, M, C, Calls) :- 320 var(Var), 321 !, 322 qualify(M, C, Var, Calls). 323body_term_calls(M:Goal, _, C, Calls) :- 324 !, 325 body_term_calls(Goal, M, C, Calls). 326body_term_calls(Goal, M, C, Calls) :- 327 qualify(M, C, Goal, Calls). 328body_term_calls((A,B), M, C, Calls) :- 329 !, 330 ( body_term_calls(A, M, C, Calls) 331 ; body_term_calls(B, M, C, Calls) 332 ). 333body_term_calls((A;B), M, C, Calls) :- 334 !, 335 ( body_term_calls(A, M, C, Calls) 336 ; body_term_calls(B, M, C, Calls) 337 ). 338body_term_calls((A->B), M, C, Calls) :- 339 !, 340 ( body_term_calls(A, M, C, Calls) 341 ; body_term_calls(B, M, C, Calls) 342 ). 343body_term_calls((A*->B), M, C, Calls) :- 344 !, 345 ( body_term_calls(A, M, C, Calls) 346 ; body_term_calls(B, M, C, Calls) 347 ). 348body_term_calls(\+ A, M, C, Calls) :- 349 !, 350 body_term_calls(A, M, C, Calls). 351body_term_calls(Goal, M, C, Calls) :- 352 predicate_property(M:Goal, meta_predicate(Spec)), 353 \+ ( functor(Goal, call, _), 354 arg(1, Goal, A1), 355 strip_module(A1, _, P1), 356 var(P1) 357 ), 358 !, 359 arg(I, Spec, SArg), 360 arg(I, Goal, GArg), 361 meta_calls(SArg, GArg, Call0), 362 body_term_calls(Call0, M, C, Calls). 363 364meta_calls(0, Goal, Goal) :- 365 !. 366meta_calls(I, Goal0, Goal) :- 367 integer(I), 368 !, 369 length(Extra, I), 370 extend_goal(Goal0, Extra, Goal). 371meta_calls(//, Goal0, Goal) :- 372 extend_goal(Goal0, [_,_], Goal). 373meta_calls(^, Goal0, Goal) :- 374 !, 375 strip_existential(Goal0, Goal). 376 377strip_existential(Var, Var) :- 378 var(Var), 379 !. 380strip_existential(_^In, Out) :- 381 strip_existential(In, Out). 382 383qualify(M, C, Goal, Calls) :- 384 M == C, 385 !, 386 Calls = Goal. 387qualify(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:
*/