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) 1985-2025, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module('$syspreds', 39 [ leash/1, 40 visible/1, 41 style_check/1, 42 flag/3, 43 atom_prefix/2, 44 dwim_match/2, 45 source_file_property/2, 46 source_file/1, 47 source_file/2, 48 unload_file/1, 49 exists_source/1, % +Spec 50 exists_source/2, % +Spec, -Path 51 prolog_load_context/2, 52 stream_position_data/3, 53 current_predicate/2, 54 '$defined_predicate'/1, 55 predicate_property/2, 56 '$predicate_property'/2, 57 (dynamic)/2, % :Predicates, +Options 58 clause_property/2, 59 current_module/1, % ?Module 60 module_property/2, % ?Module, ?Property 61 module/1, % +Module 62 current_trie/1, % ?Trie 63 trie_property/2, % ?Trie, ?Property 64 working_directory/2, % -OldDir, +NewDir 65 shell/1, % +Command 66 on_signal/3, 67 current_signal/3, 68 format/1, 69 garbage_collect/0, 70 set_prolog_stack/2, 71 prolog_stack_property/2, 72 absolute_file_name/2, 73 tmp_file_stream/3, % +Enc, -File, -Stream 74 call_with_depth_limit/3, % :Goal, +Limit, -Result 75 call_with_inference_limit/3, % :Goal, +Limit, -Result 76 rule/2, % :Head, -Rule 77 rule/3, % :Head, -Rule, ?Ref 78 numbervars/3, % +Term, +Start, -End 79 term_string/3, % ?Term, ?String, +Options 80 thread_create/2, % :Goal, -Id 81 thread_join/1, % +Id 82 sig_block/1, % :Pattern 83 sig_unblock/1, % :Pattern 84 transaction/1, % :Goal 85 transaction/2, % :Goal, +Options 86 transaction/3, % :Goal, :Constraint, +Mutex 87 snapshot/1, % :Goal 88 undo/1, % :Goal 89 set_prolog_gc_thread/1, % +Status 90 91 '$wrap_predicate'/5, % :Head, +Name, -Closure, -Wrapped, +Body 92 '$predicate_source_location'/2, % :Head, -File:Line 93 '$addr2line_location'/3 % +Description, -File, -Line 94 ]). 95 96:- meta_predicate 97 dynamic(, ), 98 transaction(), 99 transaction(,,), 100 snapshot(), 101 rule(, ), 102 rule(, , ), 103 sig_block(), 104 sig_unblock(). 105 106 107 /******************************** 108 * DEBUGGER * 109 *********************************/
113:- meta_predicate 114 map_bits(, , , ). 115 116map_bits(_, Var, _, _) :- 117 var(Var), 118 !, 119 '$instantiation_error'(Var). 120map_bits(_, [], Bits, Bits) :- !. 121map_bits(Pred, [H|T], Old, New) :- 122 map_bits(Pred, H, Old, New0), 123 map_bits(Pred, T, New0, New). 124map_bits(Pred, +Name, Old, New) :- % set a bit 125 !, 126 bit(Pred, Name, Bits), 127 !, 128 New is Old \/ Bits. 129map_bits(Pred, -Name, Old, New) :- % clear a bit 130 !, 131 bit(Pred, Name, Bits), 132 !, 133 New is Old /\ (\Bits). 134map_bits(Pred, ?(Name), Old, Old) :- % ask a bit 135 !, 136 bit(Pred, Name, Bits), 137 Old /\ Bits > 0. 138map_bits(_, Term, _, _) :- 139 '$type_error'('+|-|?(Flag)', Term). 140 141bit(Pred, Name, Bits) :- 142 call(Pred, Name, Bits), 143 !. 144bit(_:Pred, Name, _) :- 145 '$domain_error'(Pred, Name). 146 147:- public port_name/2. % used by library(test_cover) 148 149port_name( call, 2'000000001). 150port_name( exit, 2'000000010). 151port_name( fail, 2'000000100). 152port_name( redo, 2'000001000). 153port_name( unify, 2'000010000). 154port_name( break, 2'000100000). 155port_name( cut_call, 2'001000000). 156port_name( cut_exit, 2'010000000). 157port_name( exception, 2'100000000). 158port_name( cut, 2'011000000). 159port_name( all, 2'000111111). 160port_name( full, 2'000101111). 161port_name( half, 2'000101101). % ' 162 163leash(Ports) :- 164 '$leash'(Old, Old), 165 map_bits(port_name, Ports, Old, New), 166 '$leash'(_, New). 167 168visible(Ports) :- 169 '$visible'(Old, Old), 170 map_bits(port_name, Ports, Old, New), 171 '$visible'(_, New). 172 173style_name(atom, 0x0001) :- 174 print_message(warning, decl_no_effect(style_check(atom))). 175style_name(singleton, 0x0042). % semantic and syntactic 176style_name(discontiguous, 0x0008). 177style_name(charset, 0x0020). 178style_name(no_effect, 0x0080). 179style_name(var_branches, 0x0100).
183style_check(Var) :- 184 var(Var), 185 !, 186 '$instantiation_error'(Var). 187style_check(?(Style)) :- 188 !, 189 ( var(Style) 190 -> enum_style_check(Style) 191 ; enum_style_check(Style) 192 -> true 193 ). 194style_check(Spec) :- 195 '$style_check'(Old, Old), 196 map_bits(style_name, Spec, Old, New), 197 '$style_check'(_, New). 198 199enum_style_check(Style) :- 200 '$style_check'(Bits, Bits), 201 style_name(Style, Bit), 202 Bit /\ Bits =\= 0.
210flag(Name, Old, New) :- 211 Old == New, 212 !, 213 get_flag(Name, Old). 214flag(Name, Old, New) :- 215 with_mutex('$flag', update_flag(Name, Old, New)). 216 217update_flag(Name, Old, New) :- 218 get_flag(Name, Old), 219 ( atom(New) 220 -> set_flag(Name, New) 221 ; Value is New, 222 set_flag(Name, Value) 223 ). 224 225 226 /******************************** 227 * ATOMS * 228 *********************************/ 229 230dwim_match(A1, A2) :- 231 dwim_match(A1, A2, _). 232 233atom_prefix(Atom, Prefix) :- 234 sub_atom(Atom, 0, _, _, Prefix). 235 236 237 /******************************** 238 * SOURCE * 239 *********************************/
Note that Time = 0 is used by PlDoc and other code that needs to create a file record without being interested in the time.
252source_file(File) :-
253 ( current_prolog_flag(access_level, user)
254 -> Level = user
255 ; true
256 ),
257 ( ground(File)
258 -> ( '$time_source_file'(File, Time, Level)
259 ; absolute_file_name(File, Abs),
260 '$time_source_file'(Abs, Time, Level)
261 ), !
262 ; '$time_source_file'(File, Time, Level)
263 ),
264 float(Time).271:- meta_predicate source_file(, ). 272 273source_file(M:Head, File) :- 274 nonvar(M), nonvar(Head), 275 !, 276 ( '$c_current_predicate'(_, M:Head), 277 predicate_property(M:Head, multifile) 278 -> multi_source_file(M:Head, File) 279 ; '$source_file'(M:Head, File) 280 ). 281source_file(M:Head, File) :- 282 ( nonvar(File) 283 -> true 284 ; source_file(File) 285 ), 286 '$source_file_predicates'(File, Predicates), 287 '$member'(M:Head, Predicates). 288 289multi_source_file(Head, File) :- 290 State = state([]), 291 nth_clause(Head, _, Clause), 292 clause_property(Clause, source(File)), 293 arg(1, State, Found), 294 ( memberchk(File, Found) 295 -> fail 296 ; nb_linkarg(1, State, [File|Found]) 297 ).
304source_file_property(File, P) :- 305 nonvar(File), 306 !, 307 canonical_source_file(File, Path), 308 property_source_file(P, Path). 309source_file_property(File, P) :- 310 property_source_file(P, File). 311 312property_source_file(modified(Time), File) :- 313 '$time_source_file'(File, Time, user). 314property_source_file(source(Source), File) :- 315 ( '$source_file_property'(File, from_state, true) 316 -> Source = state 317 ; '$source_file_property'(File, resource, true) 318 -> Source = resource 319 ; Source = file 320 ). 321property_source_file(module(M), File) :- 322 ( nonvar(M) 323 -> '$current_module'(M, File) 324 ; nonvar(File) 325 -> '$current_module'(ML, File), 326 ( atom(ML) 327 -> M = ML 328 ; '$member'(M, ML) 329 ) 330 ; '$current_module'(M, File) 331 ). 332property_source_file(load_context(Module, Location, Options), File) :- 333 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 334 '$time_source_file'(File, _, user), 335 ( clause_property(Ref, file(FromFile)), 336 clause_property(Ref, line_count(FromLine)) 337 -> Location = FromFile:FromLine 338 ; Location = user 339 ). 340property_source_file(includes(Master, Stamp), File) :- 341 system:'$included'(File, _Line, Master, Stamp). 342property_source_file(included_in(Master, Line), File) :- 343 system:'$included'(Master, Line, File, _). 344property_source_file(derived_from(DerivedFrom, Stamp), File) :- 345 system:'$derived_source'(File, DerivedFrom, Stamp). 346property_source_file(reloading, File) :- 347 source_file(File), 348 '$source_file_property'(File, reloading, true). 349property_source_file(load_count(Count), File) :- 350 source_file(File), 351 '$source_file_property'(File, load_count, Count). 352property_source_file(number_of_clauses(Count), File) :- 353 source_file(File), 354 '$source_file_property'(File, number_of_clauses, Count). 355property_source_file(loaded(Stamp), File) :- 356 source_file(File), 357 '$source_file_property'(File, loaded, Stamp).
364canonical_source_file(Spec, File) :- 365 atom(Spec), 366 '$time_source_file'(Spec, _, _), 367 !, 368 File = Spec. 369canonical_source_file(Spec, File) :- 370 system:'$included'(_Master, _Line, Spec, _), 371 !, 372 File = Spec. 373canonical_source_file(Spec, File) :- 374 absolute_file_name(Spec, File, 375 [ file_type(source), 376 solutions(all), 377 file_errors(fail) 378 ]), 379 source_file(File), 380 !.
:- if(exists_source(library(error))). :- use_module_library(error). :- endif.
397exists_source(Source) :- 398 exists_source(Source, _Path). 399 400exists_source(Source, Path) :- 401 absolute_file_name(Source, Path, 402 [ file_type(prolog), 403 access(read), 404 file_errors(fail) 405 ]).
414prolog_load_context(module, Module) :- 415 '$current_source_module'(Module). 416prolog_load_context(file, File) :- 417 input_file(File). 418prolog_load_context(source, F) :- % SICStus compatibility 419 input_file(F0), 420 '$input_context'(Context), 421 '$top_file'(Context, F0, F). 422prolog_load_context(stream, S) :- 423 ( system:'$load_input'(_, S0) 424 -> S = S0 425 ). 426prolog_load_context(directory, D) :- 427 input_file(F), 428 file_directory_name(F, D). 429prolog_load_context(dialect, D) :- 430 current_prolog_flag(emulated_dialect, D). 431prolog_load_context(term_position, TermPos) :- 432 source_location(_, L), 433 ( nb_current('$term_position', Pos), 434 compound(Pos), % actually set 435 stream_position_data(line_count, Pos, L) 436 -> TermPos = Pos 437 ; TermPos = '$stream_position'(0,L,0,0) 438 ). 439prolog_load_context(script, Bool) :- 440 ( '$toplevel':loaded_init_file(script, Path), 441 input_file(File), 442 same_file(File, Path) 443 -> Bool = true 444 ; Bool = false 445 ). 446prolog_load_context(variable_names, Bindings) :- 447 ( nb_current('$variable_names', Bindings0) 448 -> Bindings = Bindings0 449 ; Bindings = [] 450 ). 451prolog_load_context(term, Term) :- 452 nb_current('$term', Term). 453prolog_load_context(reloading, true) :- 454 prolog_load_context(source, F), 455 '$source_file_property'(F, reloading, true). 456 457input_file(File) :- 458 ( system:'$load_input'(_, Stream) 459 -> stream_property(Stream, file_name(File)) 460 ), 461 !. 462input_file(File) :- 463 source_location(File, _).
475:- dynamic system:'$resolved_source_path'/2. 476 477unload_file(File) :- 478 ( canonical_source_file(File, Path) 479 -> unload_file_(Path), 480 '$clear_source_admin'(Path), 481 garbage_collect_clauses 482 ; true 483 ). 484 485:- if(current_prolog_flag(open_shared_object, true)). 486unload_file_(Path) :- 487 source_file_property(Path, module(M)), 488 ensure_shlib, 489 !, 490 forall(shlib:foreign_library_property(Foreign, module(M)), 491 shlib:unload_foreign_library(Foreign)), 492 '$unload_file'(Path). 493:- endif. 494unload_file_(Path) :- 495 '$unload_file'(Path). 496 497:- if(current_prolog_flag(open_shared_object, true)). 498 499 /******************************* 500 * FOREIGN LIBRARIES * 501 *******************************/
now. This is similar to using:
:- initialization(load_foreign_library(foreign(mylib))).
but using the initialization/1 wrapper causes the library to be loaded after loading of the file in which it appears is completed, while use_foreign_library/1 loads the library immediately. I.e. the difference is only relevant if the remainder of the file uses functionality of the C-library.
520:- meta_predicate 521 use_foreign_library(), 522 use_foreign_library(, ). 523:- public 524 use_foreign_library_noi/1. 525 526use_foreign_library(FileSpec) :- 527 ensure_shlib, 528 initialization(use_foreign_library_noi(FileSpec), now). 529 530% noi -> no initialize; used by '$autoload':exports/3. 531use_foreign_library_noi(FileSpec) :- 532 ensure_shlib, 533 shlib:load_foreign_library(FileSpec). 534 535use_foreign_library(FileSpec, Options) :- 536 ensure_shlib, 537 initialization(shlib:load_foreign_library(FileSpec, Options), now). 538 539ensure_shlib :- 540 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 541 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 542 !. 543ensure_shlib :- 544 use_module(library(shlib), []). 545 546:- export(use_foreign_library/1). 547:- export(use_foreign_library/2). 548 549:- elif(current_predicate('$activate_static_extension'/1)). 550 551% Version when using shared objects is disabled and extensions are added 552% as static libraries. 553 554:- meta_predicate 555 use_foreign_library(). 556:- public 557 use_foreign_library_noi/1. 558:- dynamic 559 loading/1, 560 foreign_predicate/2. 561 562use_foreign_library(FileSpec) :- 563 initialization(use_foreign_library_noi(FileSpec), now). 564 565use_foreign_library_noi(Module:foreign(Extension)) :- 566 setup_call_cleanup( 567 asserta(loading(foreign(Extension)), Ref), 568 @('$activate_static_extension'(Extension), Module), 569 erase(Ref)). 570 571:- export(use_foreign_library/1). 572 573system:'$foreign_registered'(M, H) :- 574 ( loading(Lib) 575 -> true 576 ; Lib = '<spontaneous>' 577 ), 578 assert(foreign_predicate(Lib, M:H)).
584current_foreign_library(File, Public) :- 585 setof(Pred, foreign_predicate(File, Pred), Public). 586 587:- export(current_foreign_library/2). 588 589:- endif. /* open_shared_object support */ 590 591 /******************************* 592 * STREAMS * 593 *******************************/
600stream_position_data(Prop, Term, Value) :- 601 nonvar(Prop), 602 !, 603 ( stream_position_field(Prop, Pos) 604 -> arg(Pos, Term, Value) 605 ; throw(error(domain_error(stream_position_data, Prop))) 606 ). 607stream_position_data(Prop, Term, Value) :- 608 stream_position_field(Prop, Pos), 609 arg(Pos, Term, Value). 610 611stream_position_field(char_count, 1). 612stream_position_field(line_count, 2). 613stream_position_field(line_position, 3). 614stream_position_field(byte_count, 4). 615 616 617 /******************************* 618 * CONTROL * 619 *******************************/
627:- meta_predicate 628 call_with_depth_limit(, , ). 629 630call_with_depth_limit(G, Limit, Result) :- 631 '$depth_limit'(Limit, OLimit, OReached), 632 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 633 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 634 ( Det == ! -> ! ; true ) 635 ; '$depth_limit_false'(OLimit, OReached, Result) 636 ).
call(Goal), but poses a limit on the number of
inferences. If this limit is reached, Result is unified with
inference_limit_exceeded, otherwise Result is unified with ! if
Goal succeeded without a choicepoint and true otherwise.
Note that we perform calls in system to avoid auto-importing, which
makes raiseInferenceLimitException() fail to recognise that the
exception happens in the overhead.
649:- meta_predicate 650 call_with_inference_limit(, , ). 651 652call_with_inference_limit(G, Limit, Result) :- 653 '$inference_limit'(Limit, OLimit), 654 ( catch(G, Except, 655 system:'$inference_limit_except'(OLimit, Except, Result0)), 656 ( Result0 == inference_limit_exceeded 657 -> ! 658 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 659 ( Result0 == ! -> ! ; true ) 660 ), 661 Result = Result0 662 ; system:'$inference_limit_false'(OLimit) 663 ). 664 665 666 /******************************** 667 * DATA BASE * 668 *********************************/ 669 670/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 671The predicate current_predicate/2 is a difficult subject since the 672introduction of defaulting modules and dynamic libraries. 673current_predicate/2 is normally called with instantiated arguments to 674verify some predicate can be called without trapping an undefined 675predicate. In this case we must perform the search algorithm used by 676the prolog system itself. 677 678If the pattern is not fully specified, we only generate the predicates 679actually available in this module. This seems the best for listing, 680etc. 681- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 682 683 684:- meta_predicate 685 current_predicate(, ), 686 '$defined_predicate'(). 687 688current_predicate(Name, Module:Head) :- 689 (var(Module) ; var(Head)), 690 !, 691 generate_current_predicate(Name, Module, Head). 692current_predicate(Name, Term) :- 693 '$c_current_predicate'(Name, Term), 694 '$defined_predicate'(Term), 695 !. 696current_predicate(Name, Module:Head) :- 697 default_module(Module, DefModule), 698 '$c_current_predicate'(Name, DefModule:Head), 699 '$defined_predicate'(DefModule:Head), 700 !. 701current_predicate(Name, Module:Head) :- 702 '$autoload':autoload_in(Module, general), 703 \+ current_prolog_flag(Moduleunknown, fail), 704 ( compound(Head) 705 -> compound_name_arity(Head, Name, Arity) 706 ; Name = Head, Arity = 0 707 ), 708 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 709 !. 710 711generate_current_predicate(Name, Module, Head) :- 712 current_module(Module), 713 QHead = Module:Head, 714 '$c_current_predicate'(Name, QHead), 715 '$get_predicate_attribute'(QHead, defined, 1). 716 717'$defined_predicate'(Head) :- 718 '$get_predicate_attribute'(Head, defined, 1), 719 !.
725:- meta_predicate 726 predicate_property(, ). 727 728:- multifile 729 '$predicate_property'/2. 730 731:- '$iso'(predicate_property/2). 732 733predicate_property(Pred, Property) :- % Mode ?,+ 734 nonvar(Property), 735 !, 736 property_predicate(Property, Pred). 737predicate_property(Pred, Property) :- % Mode +,- 738 define_or_generate(Pred), 739 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.747property_predicate(undefined, Pred) :- 748 !, 749 Pred = Module:Head, 750 current_module(Module), 751 '$c_current_predicate'(_, Pred), 752 \+ '$defined_predicate'(Pred), % Speed up a bit 753 \+ current_predicate(_, Pred), 754 goal_name_arity(Head, Name, Arity), 755 \+ system_undefined(Module:Name/Arity). 756property_predicate(visible, Pred) :- 757 !, 758 visible_predicate(Pred). 759property_predicate(autoload(File), Head) :- 760 !, 761 \+ current_prolog_flag(autoload, false), 762 '$autoload':autoloadable(Head, File). 763property_predicate(implementation_module(IM), M:Head) :- 764 !, 765 atom(M), 766 ( default_module(M, DM), 767 '$get_predicate_attribute'(DM:Head, defined, 1) 768 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 769 -> IM = ImportM 770 ; IM = M 771 ) 772 ; \+ current_prolog_flag(Munknown, fail), 773 goal_name_arity(Head, Name, Arity), 774 '$find_library'(_, Name, Arity, LoadModule, _File) 775 -> IM = LoadModule 776 ; M = IM 777 ). 778property_predicate(iso, _:Head) :- 779 callable(Head), 780 !, 781 goal_name_arity(Head, Name, Arity), 782 current_predicate(system:Name/Arity), 783 '$predicate_property'(iso, system:Head). 784property_predicate(built_in, Module:Head) :- 785 callable(Head), 786 !, 787 goal_name_arity(Head, Name, Arity), 788 current_predicate(Module:Name/Arity), 789 '$predicate_property'(built_in, Module:Head). 790property_predicate(Property, Pred) :- 791 define_or_generate(Pred), 792 '$predicate_property'(Property, Pred). 793 794goal_name_arity(Head, Name, Arity) :- 795 compound(Head), 796 !, 797 compound_name_arity(Head, Name, Arity). 798goal_name_arity(Head, Head, 0).
807define_or_generate(M:Head) :- 808 callable(Head), 809 atom(M), 810 '$get_predicate_attribute'(M:Head, defined, 1), 811 !. 812define_or_generate(M:Head) :- 813 callable(Head), 814 nonvar(M), M \== system, 815 !, 816 '$define_predicate'(M:Head). 817define_or_generate(Pred) :- 818 current_predicate(_, Pred), 819 '$define_predicate'(Pred). 820 821 822'$predicate_property'(interpreted, Pred) :- 823 '$get_predicate_attribute'(Pred, foreign, 0). 824'$predicate_property'(visible, Pred) :- 825 '$get_predicate_attribute'(Pred, defined, 1). 826'$predicate_property'(built_in, Pred) :- 827 '$get_predicate_attribute'(Pred, system, 1). 828'$predicate_property'(exported, Pred) :- 829 '$get_predicate_attribute'(Pred, exported, 1). 830'$predicate_property'(public, Pred) :- 831 '$get_predicate_attribute'(Pred, public, 1). 832'$predicate_property'(non_terminal, Pred) :- 833 '$get_predicate_attribute'(Pred, non_terminal, 1). 834'$predicate_property'(foreign, Pred) :- 835 '$get_predicate_attribute'(Pred, foreign, 1). 836'$predicate_property'((dynamic), Pred) :- 837 '$get_predicate_attribute'(Pred, (dynamic), 1). 838'$predicate_property'((static), Pred) :- 839 '$get_predicate_attribute'(Pred, (dynamic), 0). 840'$predicate_property'((volatile), Pred) :- 841 '$get_predicate_attribute'(Pred, (volatile), 1). 842'$predicate_property'((thread_local), Pred) :- 843 '$get_predicate_attribute'(Pred, (thread_local), 1). 844'$predicate_property'((multifile), Pred) :- 845 '$get_predicate_attribute'(Pred, (multifile), 1). 846'$predicate_property'((discontiguous), Pred) :- 847 '$get_predicate_attribute'(Pred, (discontiguous), 1). 848'$predicate_property'(imported_from(Module), Pred) :- 849 '$get_predicate_attribute'(Pred, imported, Module). 850'$predicate_property'(transparent, Pred) :- 851 '$get_predicate_attribute'(Pred, transparent, 1). 852'$predicate_property'(meta_predicate(Pattern), Pred) :- 853 '$get_predicate_attribute'(Pred, transparent, 1), 854 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 855'$predicate_property'(mode(Pattern), Pred) :- 856 '$get_predicate_attribute'(Pred, transparent, 0), 857 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 858'$predicate_property'(file(File), Pred) :- 859 '$get_predicate_attribute'(Pred, file, File). 860'$predicate_property'(line_count(LineNumber), Pred) :- 861 '$get_predicate_attribute'(Pred, line_count, LineNumber). 862'$predicate_property'(notrace, Pred) :- 863 '$get_predicate_attribute'(Pred, trace, 0). 864'$predicate_property'(nodebug, Pred) :- 865 '$get_predicate_attribute'(Pred, hide_childs, 1). 866'$predicate_property'(spying, Pred) :- 867 '$get_predicate_attribute'(Pred, spy, 1). 868'$predicate_property'(number_of_clauses(N), Pred) :- 869 '$get_predicate_attribute'(Pred, number_of_clauses, N). 870'$predicate_property'(number_of_rules(N), Pred) :- 871 '$get_predicate_attribute'(Pred, number_of_rules, N). 872'$predicate_property'(last_modified_generation(Gen), Pred) :- 873 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 874'$predicate_property'(indexed(Indices), Pred) :- 875 '$get_predicate_attribute'(Pred, indexed, Indices). 876'$predicate_property'(noprofile, Pred) :- 877 '$get_predicate_attribute'(Pred, noprofile, 1). 878'$predicate_property'(ssu, Pred) :- 879 '$get_predicate_attribute'(Pred, ssu, 1). 880'$predicate_property'(iso, Pred) :- 881 '$get_predicate_attribute'(Pred, iso, 1). 882'$predicate_property'(det, Pred) :- 883 '$get_predicate_attribute'(Pred, det, 1). 884'$predicate_property'(sig_atomic, Pred) :- 885 '$get_predicate_attribute'(Pred, sig_atomic, 1). 886'$predicate_property'(quasi_quotation_syntax, Pred) :- 887 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 888'$predicate_property'(defined, Pred) :- 889 '$get_predicate_attribute'(Pred, defined, 1). 890'$predicate_property'(tabled, Pred) :- 891 '$get_predicate_attribute'(Pred, tabled, 1). 892'$predicate_property'(tabled(Flag), Pred) :- 893 '$get_predicate_attribute'(Pred, tabled, 1), 894 table_flag(Flag, Pred). 895'$predicate_property'(incremental, Pred) :- 896 '$get_predicate_attribute'(Pred, incremental, 1). 897'$predicate_property'(monotonic, Pred) :- 898 '$get_predicate_attribute'(Pred, monotonic, 1). 899'$predicate_property'(opaque, Pred) :- 900 '$get_predicate_attribute'(Pred, opaque, 1). 901'$predicate_property'(lazy, Pred) :- 902 '$get_predicate_attribute'(Pred, lazy, 1). 903'$predicate_property'(abstract(N), Pred) :- 904 '$get_predicate_attribute'(Pred, abstract, N). 905'$predicate_property'(size(Bytes), Pred) :- 906 '$get_predicate_attribute'(Pred, size, Bytes). 907'$predicate_property'(primary_index(Arg), Pred) :- 908 '$get_predicate_attribute'(Pred, primary_index, Arg). 909 910system_undefined(user:prolog_trace_interception/4). 911system_undefined(prolog:prolog_exception_hook/5). 912system_undefined(system:'$c_call_prolog'/0). 913system_undefined(system:window_title/2). 914 915table_flag(variant, Pred) :- 916 '$tbl_implementation'(Pred, M:Head), 917 M:'$tabled'(Head, variant). 918table_flag(subsumptive, Pred) :- 919 '$tbl_implementation'(Pred, M:Head), 920 M:'$tabled'(Head, subsumptive). 921table_flag(shared, Pred) :- 922 '$get_predicate_attribute'(Pred, tshared, 1). 923table_flag(incremental, Pred) :- 924 '$get_predicate_attribute'(Pred, incremental, 1). 925table_flag(monotonic, Pred) :- 926 '$get_predicate_attribute'(Pred, monotonic, 1). 927table_flag(subgoal_abstract(N), Pred) :- 928 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 929table_flag(answer_abstract(N), Pred) :- 930 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 931table_flag(subgoal_abstract(N), Pred) :- 932 '$get_predicate_attribute'(Pred, max_answers, N).
941visible_predicate(Pred) :- 942 Pred = M:Head, 943 current_module(M), 944 ( callable(Head) 945 -> ( '$get_predicate_attribute'(Pred, defined, 1) 946 -> true 947 ; \+ current_prolog_flag(Munknown, fail), 948 '$head_name_arity'(Head, Name, Arity), 949 '$find_library'(M, Name, Arity, _LoadModule, _Library) 950 ) 951 ; setof(PI, visible_in_module(M, PI), PIs), 952 '$member'(Name/Arity, PIs), 953 functor(Head, Name, Arity) 954 ). 955 956visible_in_module(M, Name/Arity) :- 957 default_module(M, DefM), 958 DefHead = DefM:Head, 959 '$c_current_predicate'(_, DefHead), 960 '$get_predicate_attribute'(DefHead, defined, 1), 961 \+ hidden_system_predicate(Head), 962 functor(Head, Name, Arity). 963visible_in_module(_, Name/Arity) :- 964 '$in_library'(Name, Arity, _). 965 (Head) :- 967 functor(Head, Name, _), 968 atom(Name), % Avoid []. 969 sub_atom(Name, 0, _, _, $), 970 \+ current_prolog_flag(access_level, system). 971 972 973 /******************************** 974 * SOURCE LOCATION * 975 *********************************/
This predicate provides the source location for both the message
system (see predicate_reference//2 in boot/messages.pl) and
library(edit).
989:- meta_predicate 990 '$predicate_source_location'(, ). 991 992'$predicate_source_location'(Head, File:Line) :- 993 '$primary_predicate'(Head, Primary), 994 ( predicate_property(Primary, file(File)), 995 predicate_property(Primary, line_count(Line)) 996 -> true 997 ; predicate_property(Primary, foreign), 998 '$foreign_source_location'(Primary, File, Line) 999 ).
1006'$primary_predicate'(Pred, Primary) :-
1007 ( predicate_property(Pred, imported_from(Module))
1008 -> strip_module(Pred, _, Head),
1009 Primary = Module:Head
1010 ; Primary = Pred
1011 ).addr2line or atos in a child process we can
only afford to do this once per predicate.1019:- dynamic 1020 '$foreign_source_cache'/2. % PI, File:Line or `none` 1021 1022'$foreign_source_location'(Head, File, Line) :- 1023 '$pi_head'(PI, Head), 1024 ( '$foreign_source_cache'(PI, Cached) 1025 -> true 1026 ; ( '$foreign_predicate_source'(Head, Source), 1027 '$addr2line_location'(Source, File0, Line0) 1028 -> Cached = File0:Line0 1029 ; Cached = none 1030 ), 1031 assertz('$foreign_source_cache'(PI, Cached)) 1032 ), 1033 Cached = File:Line.
Function() at File:Line description as produced by
'$foreign_predicate_source'/2 and '$addr2line'/2. Fails if the
description does not carry a source location, which happens if the
symbol lives in the main executable or the file has no debug
information.1043'$addr2line_location'(Description, File, Line) :- 1044 sub_string(Description, Before, _, After, " at "), 1045 !, 1046 Start is Before+4, 1047 sub_string(Description, Start, After, 0, Rest), 1048 '$split_file_line'(Rest, File, Line). 1049 1050'$split_file_line'(Rest, File, Line) :- 1051 sub_string(Rest, BC, _, AC, ":"), 1052 Start is BC+1, 1053 sub_string(Rest, Start, AC, 0, Tail), 1054 ( sub_string(Tail, BS, _, _, " ") % e.g. " (discriminator 1)" 1055 -> sub_string(Tail, 0, BS, _, LineText) 1056 ; LineText = Tail 1057 ), 1058 number_string(Line, LineText), 1059 integer(Line), 1060 Line >= 1, % `addr2line` says 0 if unknown 1061 !, 1062 sub_string(Rest, 0, BC, _, FileText), 1063 FileText \== "??", % and `??` for the file 1064 atom_string(File, FileText).
true.1089clause_property(Clause, Property) :- 1090 '$clause_property'(Property, Clause). 1091 1092'$clause_property'(line_count(LineNumber), Clause) :- 1093 '$get_clause_attribute'(Clause, line_count, LineNumber). 1094'$clause_property'(file(File), Clause) :- 1095 '$get_clause_attribute'(Clause, file, File). 1096'$clause_property'(source(File), Clause) :- 1097 '$get_clause_attribute'(Clause, owner, File). 1098'$clause_property'(size(Bytes), Clause) :- 1099 '$get_clause_attribute'(Clause, size, Bytes). 1100'$clause_property'(fact, Clause) :- 1101 '$get_clause_attribute'(Clause, fact, true). 1102'$clause_property'(erased, Clause) :- 1103 '$get_clause_attribute'(Clause, erased, true). 1104'$clause_property'(predicate(PI), Clause) :- 1105 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1106'$clause_property'(module(M), Clause) :- 1107 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1121dynamic(M:Predicates, Options) :- 1122 '$must_be'(list, Predicates), 1123 options_properties(Options, Props), 1124 set_pprops(Predicates, M, [dynamic|Props]). 1125 1126set_pprops([], _, _). 1127set_pprops([H|T], M, Props) :- 1128 set_pprops1(Props, M:H), 1129 strip_module(M:H, M2, P), 1130 '$pi_head'(M2:P, Pred), 1131 '$set_table_wrappers'(Pred), 1132 set_pprops(T, M, Props). 1133 1134set_pprops1([], _). 1135set_pprops1([H|T], P) :- 1136 ( atom(H) 1137 -> '$set_predicate_attribute'(P, H, true) 1138 ; H =.. [Name,Value] 1139 -> '$set_predicate_attribute'(P, Name, Value) 1140 ), 1141 set_pprops1(T, P). 1142 1143options_properties(Options, Props) :- 1144 G = opt_prop(_,_,_,_), 1145 findall(G, G, Spec), 1146 options_properties(Spec, Options, Props). 1147 1148options_properties([], _, []). 1149options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1150 Options, [Prop|PT]) :- 1151 Opt =.. [Name,V], 1152 '$option'(Opt, Options), 1153 '$must_be'(Type, V), 1154 V = SetValue, 1155 !, 1156 options_properties(T, Options, PT). 1157options_properties([_|T], Options, PT) :- 1158 options_properties(T, Options, PT). 1159 1160opt_prop(incremental, boolean, Bool, incremental(Bool)). 1161opt_prop(abstract, between(0,0), 0, abstract). 1162opt_prop(multifile, boolean, true, multifile). 1163opt_prop(discontiguous, boolean, true, discontiguous). 1164opt_prop(volatile, boolean, true, volatile). 1165opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1166 local, thread_local). 1167 1168 /******************************** 1169 * MODULES * 1170 *********************************/
1176current_module(Module) :-
1177 '$current_module'(Module, _).1193module_property(Module, Property) :- 1194 nonvar(Module), nonvar(Property), 1195 !, 1196 property_module(Property, Module). 1197module_property(Module, Property) :- % -, file(File) 1198 nonvar(Property), Property = file(File), 1199 !, 1200 ( nonvar(File) 1201 -> '$current_module'(Modules, File), 1202 ( atom(Modules) 1203 -> Module = Modules 1204 ; '$member'(Module, Modules) 1205 ) 1206 ; '$current_module'(Module, File), 1207 File \== [] 1208 ). 1209module_property(Module, Property) :- 1210 current_module(Module), 1211 property_module(Property, Module). 1212 1213property_module(Property, Module) :- 1214 module_property(Property), 1215 ( Property = exported_operators(List) 1216 -> '$exported_ops'(Module, List, []) 1217 ; '$module_property'(Module, Property) 1218 ). 1219 1220module_property(class(_)). 1221module_property(file(_)). 1222module_property(line_count(_)). 1223module_property(exports(_)). 1224module_property(exported_operators(_)). 1225module_property(size(_)). 1226module_property(program_size(_)). 1227module_property(program_space(_)). 1228module_property(last_modified_generation(_)).
1234module(Module) :- 1235 atom(Module), 1236 current_module(Module), 1237 !, 1238 '$set_typein_module'(Module). 1239module(Module) :- 1240 '$set_typein_module'(Module), 1241 print_message(warning, no_current_module(Module)).
1248working_directory(Old, New) :- 1249 '$cwd'(Old), 1250 ( Old == New 1251 -> true 1252 ; '$chdir'(New) 1253 ). 1254 1255 1256 /******************************* 1257 * TRIES * 1258 *******************************/
1264current_trie(Trie) :-
1265 current_blob(Trie, trie),
1266 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1302trie_property(Trie, Property) :- 1303 current_trie(Trie), 1304 trie_property(Property), 1305 '$trie_property'(Trie, Property). 1306 1307trie_property(node_count(_)). 1308trie_property(value_count(_)). 1309trie_property(size(_)). 1310trie_property(hashed(_)). 1311trie_property(compiled_size(_)). 1312 % below only when -DO_TRIE_STATS 1313trie_property(lookup_count(_)). % is enabled in pl-trie.h 1314trie_property(gen_call_count(_)). 1315trie_property(invalidated(_)). % IDG stats 1316trie_property(reevaluated(_)). 1317trie_property(deadlock(_)). % Shared tabling stats 1318trie_property(wait(_)). 1319trie_property(idg_affected_count(_)). 1320trie_property(idg_dependent_count(_)). 1321trie_property(idg_size(_)). 1322 1323 1324 /******************************** 1325 * SYSTEM INTERACTION * 1326 *********************************/ 1327 1328shell(Command) :- 1329 shell(Command, 0). 1330 1331 1332 /******************************* 1333 * SIGNALS * 1334 *******************************/ 1335 1336:- meta_predicate 1337 on_signal(, , ), 1338 current_signal(, , ).
1342on_signal(Signal, Old, New) :- 1343 atom(Signal), 1344 !, 1345 '$on_signal'(_Num, Signal, Old, New). 1346on_signal(Signal, Old, New) :- 1347 integer(Signal), 1348 !, 1349 '$on_signal'(Signal, _Name, Old, New). 1350on_signal(Signal, _Old, _New) :- 1351 '$type_error'(signal_name, Signal).
1355current_signal(Name, Id, Handler) :- 1356 between(1, 32, Id), 1357 '$on_signal'(Id, Name, Handler, Handler). 1358 1359:- multifile 1360 prolog:called_by/2. 1361 1362prologcalled_by(on_signal(_,_,New), [New+1]) :- 1363 ( new == throw 1364 ; new == default 1365 ), !, fail. 1366 1367 1368 /******************************* 1369 * I/O * 1370 *******************************/ 1371 1372format(Fmt) :- 1373 format(Fmt, []). 1374 1375 /******************************* 1376 * FILES * 1377 *******************************/
1381absolute_file_name(Name, Abs) :- 1382 atomic(Name), 1383 !, 1384 '$absolute_file_name'(Name, Abs). 1385absolute_file_name(Term, Abs) :- 1386 '$chk_file'(Term, [''], [access(read)], true, File), 1387 !, 1388 '$absolute_file_name'(File, Abs). 1389absolute_file_name(Term, Abs) :- 1390 '$chk_file'(Term, [''], [], true, File), 1391 !, 1392 '$absolute_file_name'(File, Abs).
1400tmp_file_stream(Enc, File, Stream) :- 1401 atom(Enc), var(File), var(Stream), 1402 !, 1403 '$tmp_file_stream'('', Enc, File, Stream). 1404tmp_file_stream(File, Stream, Options) :- 1405 current_prolog_flag(encoding, DefEnc), 1406 '$option'(encoding(Enc), Options, DefEnc), 1407 '$option'(extension(Ext), Options, ''), 1408 '$tmp_file_stream'(Ext, Enc, File, Stream), 1409 set_stream(Stream, file_name(File)). 1410 1411 1412 /******************************** 1413 * MEMORY MANAGEMENT * 1414 *********************************/
1423garbage_collect :-
1424 '$garbage_collect'(0).
1430set_prolog_stack(Stack, Option) :-
1431 Option =.. [Name,Value0],
1432 Value is Value0,
1433 '$set_prolog_stack'(Stack, Name, _Old, Value).1439prolog_stack_property(Stack, Property) :- 1440 stack_property(P), 1441 stack_name(Stack), 1442 Property =.. [P,Value], 1443 '$set_prolog_stack'(Stack, P, Value, Value). 1444 1445stack_name(local). 1446stack_name(global). 1447stack_name(trail). 1448 1449stack_property(limit). 1450stack_property(spare). 1451stack_property(min_free). 1452stack_property(low). 1453stack_property(factor). 1454 1455 1456 /******************************* 1457 * CLAUSE * 1458 *******************************/
:-
as neck.1466rule(Head, Rule) :- 1467 '$rule'(Head, Rule0), 1468 conditional_rule(Rule0, Rule1), 1469 Rule = Rule1. 1470rule(Head, Rule, Ref) :- 1471 '$rule'(Head, Rule0, Ref), 1472 conditional_rule(Rule0, Rule1), 1473 Rule = Rule1. 1474 1475conditional_rule(?=>(Head, (!, Body)), Rule) => 1476 Rule = (Head => Body). 1477conditional_rule(?=>(Head, !), Rule) => 1478 Rule = (Head => true). 1479conditional_rule(?=>(Head, Body0), Rule), 1480 split_on_cut(Body0, Cond, Body) => 1481 Rule = (Head,Cond=>Body). 1482conditional_rule(Head, Rule) => 1483 Rule = Head. 1484 1485split_on_cut((Cond0,!,Body0), Cond, Body) => 1486 Cond = Cond0, 1487 Body = Body0. 1488split_on_cut((!,Body0), Cond, Body) => 1489 Cond = true, 1490 Body = Body0. 1491split_on_cut((A,B), Cond, Body) => 1492 Cond = (A,Cond1), 1493 split_on_cut(B, Cond1, Body). 1494split_on_cut(_, _, _) => 1495 fail. 1496 1497 1498 /******************************* 1499 * TERM * 1500 *******************************/ 1501 1502:- '$iso'((numbervars/3)).
1510numbervars(Term, From, To) :- 1511 numbervars(Term, From, To, []). 1512 1513 1514 /******************************* 1515 * STRING * 1516 *******************************/
1522term_string(Term, String, Options) :- 1523 nonvar(String), 1524 !, 1525 read_term_from_atom(String, Term, Options). 1526term_string(Term, String, Options) :- 1527 ( '$option'(quoted(_), Options) 1528 -> Options1 = Options 1529 ; '$merge_options'(_{quoted:true}, Options, Options1) 1530 ), 1531 format(string(String), '~W', [Term, Options1]). 1532 1533 1534 /******************************* 1535 * THREADS * 1536 *******************************/ 1537 1538:- meta_predicate 1539 thread_create(, ).
thread_create(Goal, Id, []).
1545thread_create(Goal, Id) :-
1546 thread_create(Goal, Id, []).
1555thread_join(Id) :-
1556 thread_join(Id, Status),
1557 ( Status == true
1558 -> true
1559 ; throw(error(thread_error(Id, Status), _))
1560 ).1570sig_block(Pattern) :- 1571 ( nb_current('$sig_blocked', List) 1572 -> true 1573 ; List = [] 1574 ), 1575 nb_setval('$sig_blocked', [Pattern|List]). 1576 1577sig_unblock(Pattern) :- 1578 ( nb_current('$sig_blocked', List) 1579 -> unblock(List, Pattern, NewList), 1580 ( List == NewList 1581 -> true 1582 ; nb_setval('$sig_blocked', NewList), 1583 '$sig_unblock' 1584 ) 1585 ; true 1586 ). 1587 1588unblock([], _, []). 1589unblock([H|T], P, List) :- 1590 ( subsumes_term(P, H) 1591 -> unblock(T, P, List) 1592 ; List = [H|T1], 1593 unblock(T, P, T1) 1594 ). 1595 1596:- public signal_is_blocked/1. % called by signal_is_blocked() 1597 1598signal_is_blocked(Head) :- 1599 nb_current('$sig_blocked', List), 1600 memberchk(Head, List).
gc.gc thread if it is running. The thread is recreated
on the next implicit atom or clause garbage collection. Used
by fork/1 to avoid forking a multi-threaded application.1617set_prolog_gc_thread(Status) :- 1618 var(Status), 1619 !, 1620 '$instantiation_error'(Status). 1621set_prolog_gc_thread(_) :- 1622 \+ current_prolog_flag(threads, true), 1623 !. 1624set_prolog_gc_thread(false) :- 1625 !, 1626 set_prolog_flag(gc_thread, false), 1627 ( current_prolog_flag(threads, true) 1628 -> ( '$gc_stop' 1629 -> thread_join(gc) 1630 ; true 1631 ) 1632 ; true 1633 ). 1634set_prolog_gc_thread(true) :- 1635 !, 1636 set_prolog_flag(gc_thread, true). 1637set_prolog_gc_thread(stop) :- 1638 !, 1639 ( current_prolog_flag(threads, true) 1640 -> ( '$gc_stop' 1641 -> thread_join(gc) 1642 ; true 1643 ) 1644 ; true 1645 ). 1646set_prolog_gc_thread(Status) :- 1647 '$domain_error'(gc_thread, Status).
1656transaction(Goal) :- 1657 '$transaction'(Goal, []). 1658transaction(Goal, Options) :- 1659 '$transaction'(Goal, Options). 1660transaction(Goal, Constraint, Mutex) :- 1661 '$transaction'(Goal, Constraint, Mutex). 1662snapshot(Goal) :- 1663 '$snapshot'(Goal). 1664 1665 1666 /******************************* 1667 * UNDO * 1668 *******************************/ 1669 1670:- meta_predicate 1671 undo().
1678undo(Goal) :- 1679 '$undo'(Goal). 1680 1681:- public 1682 '$run_undo'/1. 1683 1684'$run_undo'([One]) :- 1685 !, 1686 ( call(One) 1687 -> true 1688 ; true 1689 ). 1690'$run_undo'(List) :- 1691 run_undo(List, _, Error), 1692 ( var(Error) 1693 -> true 1694 ; throw(Error) 1695 ). 1696 1697run_undo([], E, E). 1698run_undo([H|T], E0, E) :- 1699 ( catch(H, E1, true) 1700 -> ( var(E1) 1701 -> true 1702 ; '$urgent_exception'(E0, E1, E2) 1703 ) 1704 ; true 1705 ), 1706 run_undo(T, E2, E).
1714:- meta_predicate 1715 '$wrap_predicate'(, , , , ). 1716 1717'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1718 callable_name_arguments(Head, PName, Args), 1719 callable_name_arity(Head, PName, Arity), 1720 ( is_most_general_term(Head) 1721 -> true 1722 ; '$domain_error'(most_general_term, Head) 1723 ), 1724 atomic_list_concat(['$wrap$', PName], WrapName), 1725 PI = M:WrapName/Arity, 1726 dynamic(PI), 1727 '$notransact'(PI), 1728 volatile(PI), 1729 module_transparent(PI), 1730 WHead =.. [WrapName|Args], 1731 wrapped_clause(M, WHead, Body, Clause), 1732 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause). 1733 1734callable_name_arguments(Head, PName, Args) :- 1735 atom(Head), 1736 !, 1737 PName = Head, 1738 Args = []. 1739callable_name_arguments(Head, PName, Args) :- 1740 compound_name_arguments(Head, PName, Args). 1741 1742callable_name_arity(Head, PName, Arity) :- 1743 atom(Head), 1744 !, 1745 PName = Head, 1746 Arity = 0. 1747callable_name_arity(Head, PName, Arity) :- 1748 compound_name_arity(Head, PName, Arity). 1749 1750wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !. 1751wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))