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).
214extend_goal(Goal0, _, _) :- 215 var(Goal0), 216 !, 217 instantiation_error(Goal0). 218extend_goal(M:Goal0, Extra, M:Goal) :- 219 extend_goal(Goal0, Extra, Goal). 220extend_goal(Atom, Extra, Goal) :- 221 atom(Atom), 222 !, 223 Goal =.. [Atom|Extra]. 224extend_goal(Goal0, Extra, Goal) :- 225 compound_name_arguments(Goal0, Name, Args0), 226 append(Args0, Extra, Args), 227 compound_name_arguments(Goal, Name, Args). 228 229 230 /******************************* 231 * LABELS * 232 *******************************/
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.
244predicate_label(PI, Label) :- 245 must_be(ground, PI), 246 pi_head(PI, Head), 247 user:prolog_predicate_name(Head, Label), 248 !. 249predicate_label(M:Name/Arity, Label) :- 250 !, 251 ( hidden_module(M, Name/Arity) 252 -> atomic_list_concat([Name, /, Arity], Label) 253 ; atomic_list_concat([M, :, Name, /, Arity], Label) 254 ). 255predicate_label(M:Name//Arity, Label) :- 256 !, 257 ( hidden_module(M, Name//Arity) 258 -> atomic_list_concat([Name, //, Arity], Label) 259 ; atomic_list_concat([M, :, Name, //, Arity], Label) 260 ). 261predicate_label(Name/Arity, Label) :- 262 !, 263 atomic_list_concat([Name, /, Arity], Label). 264predicate_label(Name//Arity, Label) :- 265 !, 266 atomic_list_concat([Name, //, Arity], Label). 267 (system, _). 269hidden_module(user, _). 270hidden_module(M, Name/Arity) :- 271 functor(H, Name, Arity), 272 predicate_property(system:H, imported_from(M)). 273hidden_module(M, Name//DCGArity) :- 274 Arity is DCGArity+1, 275 functor(H, Name, Arity), 276 predicate_property(system:H, imported_from(M)).
282predicate_sort_key(_:PI, Name) :- 283 !, 284 predicate_sort_key(PI, Name). 285predicate_sort_key(Name/_Arity, Name). 286predicate_sort_key(Name//_Arity, Name).
296is_control_goal(Goal) :- 297 var(Goal), 298 !, fail. 299is_control_goal((_,_)). 300is_control_goal((_;_)). 301is_control_goal((_->_)). 302is_control_goal((_|_)). 303is_control_goal((_*->_)). 304is_control_goal(\+(_)).
311body_term_calls(M:Body, Calls) :- 312 body_term_calls(Body, M, M, Calls). 313 314body_term_calls(Var, M, C, Calls) :- 315 var(Var), 316 !, 317 qualify(M, C, Var, Calls). 318body_term_calls(M:Goal, _, C, Calls) :- 319 !, 320 body_term_calls(Goal, M, C, Calls). 321body_term_calls(Goal, M, C, Calls) :- 322 qualify(M, C, Goal, Calls). 323body_term_calls((A,B), M, C, Calls) :- 324 !, 325 ( body_term_calls(A, M, C, Calls) 326 ; body_term_calls(B, M, C, Calls) 327 ). 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, M, C, Calls) :- 344 !, 345 body_term_calls(A, M, C, Calls). 346body_term_calls(Goal, M, C, Calls) :- 347 348 predicate_property(M:Goal, meta_predicate(Spec)), 349 !, 350 arg(I, Spec, SArg), 351 arg(I, Goal, GArg), 352 meta_calls(SArg, GArg, Call0), 353 body_term_calls(Call0, M, C, Calls). 354 355meta_calls(0, Goal, Goal) :- 356 !. 357meta_calls(I, Goal0, Goal) :- 358 integer(I), 359 !, 360 length(Extra, I), 361 extend_goal(Goal0, Extra, Goal). 362meta_calls(//, Goal0, Goal) :- 363 extend_goal(Goal0, [_,_], Goal). 364meta_calls(^, Goal0, Goal) :- 365 !, 366 strip_existential(Goal0, Goal). 367 368strip_existential(Var, Var) :- 369 var(Var), 370 !. 371strip_existential(_^In, Out) :- 372 strip_existential(In, Out). 373 374qualify(M, C, Goal, Calls) :- 375 M == C, 376 !, 377 Calls = Goal. 378qualify(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:
*/