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).
361canonical_source_file(Spec, File) :- 362 atom(Spec), 363 '$time_source_file'(Spec, _, _), 364 !, 365 File = Spec. 366canonical_source_file(Spec, File) :- 367 system:'$included'(_Master, _Line, Spec, _), 368 !, 369 File = Spec. 370canonical_source_file(Spec, File) :- 371 absolute_file_name(Spec, File, 372 [ file_type(source), 373 solutions(all), 374 file_errors(fail) 375 ]), 376 source_file(File), 377 !.
:- if(exists_source(library(error))). :- use_module_library(error). :- endif.
394exists_source(Source) :- 395 exists_source(Source, _Path). 396 397exists_source(Source, Path) :- 398 absolute_file_name(Source, Path, 399 [ file_type(prolog), 400 access(read), 401 file_errors(fail) 402 ]).
411prolog_load_context(module, Module) :- 412 '$current_source_module'(Module). 413prolog_load_context(file, File) :- 414 input_file(File). 415prolog_load_context(source, F) :- % SICStus compatibility 416 input_file(F0), 417 '$input_context'(Context), 418 '$top_file'(Context, F0, F). 419prolog_load_context(stream, S) :- 420 ( system:'$load_input'(_, S0) 421 -> S = S0 422 ). 423prolog_load_context(directory, D) :- 424 input_file(F), 425 file_directory_name(F, D). 426prolog_load_context(dialect, D) :- 427 current_prolog_flag(emulated_dialect, D). 428prolog_load_context(term_position, TermPos) :- 429 source_location(_, L), 430 ( nb_current('$term_position', Pos), 431 compound(Pos), % actually set 432 stream_position_data(line_count, Pos, L) 433 -> TermPos = Pos 434 ; TermPos = '$stream_position'(0,L,0,0) 435 ). 436prolog_load_context(script, Bool) :- 437 ( '$toplevel':loaded_init_file(script, Path), 438 input_file(File), 439 same_file(File, Path) 440 -> Bool = true 441 ; Bool = false 442 ). 443prolog_load_context(variable_names, Bindings) :- 444 ( nb_current('$variable_names', Bindings0) 445 -> Bindings = Bindings0 446 ; Bindings = [] 447 ). 448prolog_load_context(term, Term) :- 449 nb_current('$term', Term). 450prolog_load_context(reloading, true) :- 451 prolog_load_context(source, F), 452 '$source_file_property'(F, reloading, true). 453 454input_file(File) :- 455 ( system:'$load_input'(_, Stream) 456 -> stream_property(Stream, file_name(File)) 457 ), 458 !. 459input_file(File) :- 460 source_location(File, _).
472:- dynamic system:'$resolved_source_path'/2. 473 474unload_file(File) :- 475 ( canonical_source_file(File, Path) 476 -> unload_file_(Path), 477 '$clear_source_admin'(Path), 478 garbage_collect_clauses 479 ; true 480 ). 481 482:- if(current_prolog_flag(open_shared_object, true)). 483unload_file_(Path) :- 484 source_file_property(Path, module(M)), 485 ensure_shlib, 486 !, 487 forall(shlib:foreign_library_property(Foreign, module(M)), 488 shlib:unload_foreign_library(Foreign)), 489 '$unload_file'(Path). 490:- endif. 491unload_file_(Path) :- 492 '$unload_file'(Path). 493 494:- if(current_prolog_flag(open_shared_object, true)). 495 496 /******************************* 497 * FOREIGN LIBRARIES * 498 *******************************/
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.
517:- meta_predicate 518 use_foreign_library(), 519 use_foreign_library(, ). 520:- public 521 use_foreign_library_noi/1. 522 523use_foreign_library(FileSpec) :- 524 ensure_shlib, 525 initialization(use_foreign_library_noi(FileSpec), now). 526 527% noi -> no initialize; used by '$autoload':exports/3. 528use_foreign_library_noi(FileSpec) :- 529 ensure_shlib, 530 shlib:load_foreign_library(FileSpec). 531 532use_foreign_library(FileSpec, Options) :- 533 ensure_shlib, 534 initialization(shlib:load_foreign_library(FileSpec, Options), now). 535 536ensure_shlib :- 537 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 538 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 539 !. 540ensure_shlib :- 541 use_module(library(shlib), []). 542 543:- export(use_foreign_library/1). 544:- export(use_foreign_library/2). 545 546:- elif(current_predicate('$activate_static_extension'/1)). 547 548% Version when using shared objects is disabled and extensions are added 549% as static libraries. 550 551:- meta_predicate 552 use_foreign_library(). 553:- public 554 use_foreign_library_noi/1. 555:- dynamic 556 loading/1, 557 foreign_predicate/2. 558 559use_foreign_library(FileSpec) :- 560 initialization(use_foreign_library_noi(FileSpec), now). 561 562use_foreign_library_noi(Module:foreign(Extension)) :- 563 setup_call_cleanup( 564 asserta(loading(foreign(Extension)), Ref), 565 @('$activate_static_extension'(Extension), Module), 566 erase(Ref)). 567 568:- export(use_foreign_library/1). 569 570system:'$foreign_registered'(M, H) :- 571 ( loading(Lib) 572 -> true 573 ; Lib = '<spontaneous>' 574 ), 575 assert(foreign_predicate(Lib, M:H)).
581current_foreign_library(File, Public) :- 582 setof(Pred, foreign_predicate(File, Pred), Public). 583 584:- export(current_foreign_library/2). 585 586:- endif. /* open_shared_object support */ 587 588 /******************************* 589 * STREAMS * 590 *******************************/
597stream_position_data(Prop, Term, Value) :- 598 nonvar(Prop), 599 !, 600 ( stream_position_field(Prop, Pos) 601 -> arg(Pos, Term, Value) 602 ; throw(error(domain_error(stream_position_data, Prop))) 603 ). 604stream_position_data(Prop, Term, Value) :- 605 stream_position_field(Prop, Pos), 606 arg(Pos, Term, Value). 607 608stream_position_field(char_count, 1). 609stream_position_field(line_count, 2). 610stream_position_field(line_position, 3). 611stream_position_field(byte_count, 4). 612 613 614 /******************************* 615 * CONTROL * 616 *******************************/
624:- meta_predicate 625 call_with_depth_limit(, , ). 626 627call_with_depth_limit(G, Limit, Result) :- 628 '$depth_limit'(Limit, OLimit, OReached), 629 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 630 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 631 ( Det == ! -> ! ; true ) 632 ; '$depth_limit_false'(OLimit, OReached, Result) 633 ).
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.
646:- meta_predicate 647 call_with_inference_limit(, , ). 648 649call_with_inference_limit(G, Limit, Result) :- 650 '$inference_limit'(Limit, OLimit), 651 ( catch(G, Except, 652 system:'$inference_limit_except'(OLimit, Except, Result0)), 653 ( Result0 == inference_limit_exceeded 654 -> ! 655 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 656 ( Result0 == ! -> ! ; true ) 657 ), 658 Result = Result0 659 ; system:'$inference_limit_false'(OLimit) 660 ). 661 662 663 /******************************** 664 * DATA BASE * 665 *********************************/ 666 667/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 668The predicate current_predicate/2 is a difficult subject since the 669introduction of defaulting modules and dynamic libraries. 670current_predicate/2 is normally called with instantiated arguments to 671verify some predicate can be called without trapping an undefined 672predicate. In this case we must perform the search algorithm used by 673the prolog system itself. 674 675If the pattern is not fully specified, we only generate the predicates 676actually available in this module. This seems the best for listing, 677etc. 678- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 679 680 681:- meta_predicate 682 current_predicate(, ), 683 '$defined_predicate'(). 684 685current_predicate(Name, Module:Head) :- 686 (var(Module) ; var(Head)), 687 !, 688 generate_current_predicate(Name, Module, Head). 689current_predicate(Name, Term) :- 690 '$c_current_predicate'(Name, Term), 691 '$defined_predicate'(Term), 692 !. 693current_predicate(Name, Module:Head) :- 694 default_module(Module, DefModule), 695 '$c_current_predicate'(Name, DefModule:Head), 696 '$defined_predicate'(DefModule:Head), 697 !. 698current_predicate(Name, Module:Head) :- 699 '$autoload':autoload_in(Module, general), 700 \+ current_prolog_flag(Moduleunknown, fail), 701 ( compound(Head) 702 -> compound_name_arity(Head, Name, Arity) 703 ; Name = Head, Arity = 0 704 ), 705 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 706 !. 707 708generate_current_predicate(Name, Module, Head) :- 709 current_module(Module), 710 QHead = Module:Head, 711 '$c_current_predicate'(Name, QHead), 712 '$get_predicate_attribute'(QHead, defined, 1). 713 714'$defined_predicate'(Head) :- 715 '$get_predicate_attribute'(Head, defined, 1), 716 !.
722:- meta_predicate 723 predicate_property(, ). 724 725:- multifile 726 '$predicate_property'/2. 727 728:- '$iso'(predicate_property/2). 729 730predicate_property(Pred, Property) :- % Mode ?,+ 731 nonvar(Property), 732 !, 733 property_predicate(Property, Pred). 734predicate_property(Pred, Property) :- % Mode +,- 735 define_or_generate(Pred), 736 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.744property_predicate(undefined, Pred) :- 745 !, 746 Pred = Module:Head, 747 current_module(Module), 748 '$c_current_predicate'(_, Pred), 749 \+ '$defined_predicate'(Pred), % Speed up a bit 750 \+ current_predicate(_, Pred), 751 goal_name_arity(Head, Name, Arity), 752 \+ system_undefined(Module:Name/Arity). 753property_predicate(visible, Pred) :- 754 !, 755 visible_predicate(Pred). 756property_predicate(autoload(File), Head) :- 757 !, 758 \+ current_prolog_flag(autoload, false), 759 '$autoload':autoloadable(Head, File). 760property_predicate(implementation_module(IM), M:Head) :- 761 !, 762 atom(M), 763 ( default_module(M, DM), 764 '$get_predicate_attribute'(DM:Head, defined, 1) 765 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 766 -> IM = ImportM 767 ; IM = M 768 ) 769 ; \+ current_prolog_flag(Munknown, fail), 770 goal_name_arity(Head, Name, Arity), 771 '$find_library'(_, Name, Arity, LoadModule, _File) 772 -> IM = LoadModule 773 ; M = IM 774 ). 775property_predicate(iso, _:Head) :- 776 callable(Head), 777 !, 778 goal_name_arity(Head, Name, Arity), 779 current_predicate(system:Name/Arity), 780 '$predicate_property'(iso, system:Head). 781property_predicate(built_in, Module:Head) :- 782 callable(Head), 783 !, 784 goal_name_arity(Head, Name, Arity), 785 current_predicate(Module:Name/Arity), 786 '$predicate_property'(built_in, Module:Head). 787property_predicate(Property, Pred) :- 788 define_or_generate(Pred), 789 '$predicate_property'(Property, Pred). 790 791goal_name_arity(Head, Name, Arity) :- 792 compound(Head), 793 !, 794 compound_name_arity(Head, Name, Arity). 795goal_name_arity(Head, Head, 0).
804define_or_generate(M:Head) :- 805 callable(Head), 806 atom(M), 807 '$get_predicate_attribute'(M:Head, defined, 1), 808 !. 809define_or_generate(M:Head) :- 810 callable(Head), 811 nonvar(M), M \== system, 812 !, 813 '$define_predicate'(M:Head). 814define_or_generate(Pred) :- 815 current_predicate(_, Pred), 816 '$define_predicate'(Pred). 817 818 819'$predicate_property'(interpreted, Pred) :- 820 '$get_predicate_attribute'(Pred, foreign, 0). 821'$predicate_property'(visible, Pred) :- 822 '$get_predicate_attribute'(Pred, defined, 1). 823'$predicate_property'(built_in, Pred) :- 824 '$get_predicate_attribute'(Pred, system, 1). 825'$predicate_property'(exported, Pred) :- 826 '$get_predicate_attribute'(Pred, exported, 1). 827'$predicate_property'(public, Pred) :- 828 '$get_predicate_attribute'(Pred, public, 1). 829'$predicate_property'(non_terminal, Pred) :- 830 '$get_predicate_attribute'(Pred, non_terminal, 1). 831'$predicate_property'(foreign, Pred) :- 832 '$get_predicate_attribute'(Pred, foreign, 1). 833'$predicate_property'((dynamic), Pred) :- 834 '$get_predicate_attribute'(Pred, (dynamic), 1). 835'$predicate_property'((static), Pred) :- 836 '$get_predicate_attribute'(Pred, (dynamic), 0). 837'$predicate_property'((volatile), Pred) :- 838 '$get_predicate_attribute'(Pred, (volatile), 1). 839'$predicate_property'((thread_local), Pred) :- 840 '$get_predicate_attribute'(Pred, (thread_local), 1). 841'$predicate_property'((multifile), Pred) :- 842 '$get_predicate_attribute'(Pred, (multifile), 1). 843'$predicate_property'((discontiguous), Pred) :- 844 '$get_predicate_attribute'(Pred, (discontiguous), 1). 845'$predicate_property'(imported_from(Module), Pred) :- 846 '$get_predicate_attribute'(Pred, imported, Module). 847'$predicate_property'(transparent, Pred) :- 848 '$get_predicate_attribute'(Pred, transparent, 1). 849'$predicate_property'(meta_predicate(Pattern), Pred) :- 850 '$get_predicate_attribute'(Pred, transparent, 1), 851 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 852'$predicate_property'(mode(Pattern), Pred) :- 853 '$get_predicate_attribute'(Pred, transparent, 0), 854 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 855'$predicate_property'(file(File), Pred) :- 856 '$get_predicate_attribute'(Pred, file, File). 857'$predicate_property'(line_count(LineNumber), Pred) :- 858 '$get_predicate_attribute'(Pred, line_count, LineNumber). 859'$predicate_property'(notrace, Pred) :- 860 '$get_predicate_attribute'(Pred, trace, 0). 861'$predicate_property'(nodebug, Pred) :- 862 '$get_predicate_attribute'(Pred, hide_childs, 1). 863'$predicate_property'(spying, Pred) :- 864 '$get_predicate_attribute'(Pred, spy, 1). 865'$predicate_property'(number_of_clauses(N), Pred) :- 866 '$get_predicate_attribute'(Pred, number_of_clauses, N). 867'$predicate_property'(number_of_rules(N), Pred) :- 868 '$get_predicate_attribute'(Pred, number_of_rules, N). 869'$predicate_property'(last_modified_generation(Gen), Pred) :- 870 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 871'$predicate_property'(indexed(Indices), Pred) :- 872 '$get_predicate_attribute'(Pred, indexed, Indices). 873'$predicate_property'(noprofile, Pred) :- 874 '$get_predicate_attribute'(Pred, noprofile, 1). 875'$predicate_property'(ssu, Pred) :- 876 '$get_predicate_attribute'(Pred, ssu, 1). 877'$predicate_property'(iso, Pred) :- 878 '$get_predicate_attribute'(Pred, iso, 1). 879'$predicate_property'(det, Pred) :- 880 '$get_predicate_attribute'(Pred, det, 1). 881'$predicate_property'(sig_atomic, Pred) :- 882 '$get_predicate_attribute'(Pred, sig_atomic, 1). 883'$predicate_property'(quasi_quotation_syntax, Pred) :- 884 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 885'$predicate_property'(defined, Pred) :- 886 '$get_predicate_attribute'(Pred, defined, 1). 887'$predicate_property'(tabled, Pred) :- 888 '$get_predicate_attribute'(Pred, tabled, 1). 889'$predicate_property'(tabled(Flag), Pred) :- 890 '$get_predicate_attribute'(Pred, tabled, 1), 891 table_flag(Flag, Pred). 892'$predicate_property'(incremental, Pred) :- 893 '$get_predicate_attribute'(Pred, incremental, 1). 894'$predicate_property'(monotonic, Pred) :- 895 '$get_predicate_attribute'(Pred, monotonic, 1). 896'$predicate_property'(opaque, Pred) :- 897 '$get_predicate_attribute'(Pred, opaque, 1). 898'$predicate_property'(lazy, Pred) :- 899 '$get_predicate_attribute'(Pred, lazy, 1). 900'$predicate_property'(abstract(N), Pred) :- 901 '$get_predicate_attribute'(Pred, abstract, N). 902'$predicate_property'(size(Bytes), Pred) :- 903 '$get_predicate_attribute'(Pred, size, Bytes). 904'$predicate_property'(primary_index(Arg), Pred) :- 905 '$get_predicate_attribute'(Pred, primary_index, Arg). 906 907system_undefined(user:prolog_trace_interception/4). 908system_undefined(prolog:prolog_exception_hook/5). 909system_undefined(system:'$c_call_prolog'/0). 910system_undefined(system:window_title/2). 911 912table_flag(variant, Pred) :- 913 '$tbl_implementation'(Pred, M:Head), 914 M:'$tabled'(Head, variant). 915table_flag(subsumptive, Pred) :- 916 '$tbl_implementation'(Pred, M:Head), 917 M:'$tabled'(Head, subsumptive). 918table_flag(shared, Pred) :- 919 '$get_predicate_attribute'(Pred, tshared, 1). 920table_flag(incremental, Pred) :- 921 '$get_predicate_attribute'(Pred, incremental, 1). 922table_flag(monotonic, Pred) :- 923 '$get_predicate_attribute'(Pred, monotonic, 1). 924table_flag(subgoal_abstract(N), Pred) :- 925 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 926table_flag(answer_abstract(N), Pred) :- 927 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 928table_flag(subgoal_abstract(N), Pred) :- 929 '$get_predicate_attribute'(Pred, max_answers, N).
938visible_predicate(Pred) :- 939 Pred = M:Head, 940 current_module(M), 941 ( callable(Head) 942 -> ( '$get_predicate_attribute'(Pred, defined, 1) 943 -> true 944 ; \+ current_prolog_flag(Munknown, fail), 945 '$head_name_arity'(Head, Name, Arity), 946 '$find_library'(M, Name, Arity, _LoadModule, _Library) 947 ) 948 ; setof(PI, visible_in_module(M, PI), PIs), 949 '$member'(Name/Arity, PIs), 950 functor(Head, Name, Arity) 951 ). 952 953visible_in_module(M, Name/Arity) :- 954 default_module(M, DefM), 955 DefHead = DefM:Head, 956 '$c_current_predicate'(_, DefHead), 957 '$get_predicate_attribute'(DefHead, defined, 1), 958 \+ hidden_system_predicate(Head), 959 functor(Head, Name, Arity). 960visible_in_module(_, Name/Arity) :- 961 '$in_library'(Name, Arity, _). 962 (Head) :- 964 functor(Head, Name, _), 965 atom(Name), % Avoid []. 966 sub_atom(Name, 0, _, _, $), 967 \+ current_prolog_flag(access_level, system). 968 969 970 /******************************** 971 * SOURCE LOCATION * 972 *********************************/
This predicate provides the source location for both the message
system (see predicate_reference//2 in boot/messages.pl) and
library(edit).
986:- meta_predicate 987 '$predicate_source_location'(, ). 988 989'$predicate_source_location'(Head, File:Line) :- 990 '$primary_predicate'(Head, Primary), 991 ( predicate_property(Primary, file(File)), 992 predicate_property(Primary, line_count(Line)) 993 -> true 994 ; predicate_property(Primary, foreign), 995 '$foreign_source_location'(Primary, File, Line) 996 ).
1003'$primary_predicate'(Pred, Primary) :-
1004 ( predicate_property(Pred, imported_from(Module))
1005 -> strip_module(Pred, _, Head),
1006 Primary = Module:Head
1007 ; Primary = Pred
1008 ).addr2line or atos in a child process we can
only afford to do this once per predicate.1016:- dynamic 1017 '$foreign_source_cache'/2. % PI, File:Line or `none` 1018 1019'$foreign_source_location'(Head, File, Line) :- 1020 '$pi_head'(PI, Head), 1021 ( '$foreign_source_cache'(PI, Cached) 1022 -> true 1023 ; ( '$foreign_predicate_source'(Head, Source), 1024 '$addr2line_location'(Source, File0, Line0) 1025 -> Cached = File0:Line0 1026 ; Cached = none 1027 ), 1028 assertz('$foreign_source_cache'(PI, Cached)) 1029 ), 1030 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.1040'$addr2line_location'(Description, File, Line) :- 1041 sub_string(Description, Before, _, After, " at "), 1042 !, 1043 Start is Before+4, 1044 sub_string(Description, Start, After, 0, Rest), 1045 '$split_file_line'(Rest, File, Line). 1046 1047'$split_file_line'(Rest, File, Line) :- 1048 sub_string(Rest, BC, _, AC, ":"), 1049 Start is BC+1, 1050 sub_string(Rest, Start, AC, 0, Tail), 1051 ( sub_string(Tail, BS, _, _, " ") % e.g. " (discriminator 1)" 1052 -> sub_string(Tail, 0, BS, _, LineText) 1053 ; LineText = Tail 1054 ), 1055 number_string(Line, LineText), 1056 integer(Line), 1057 Line >= 1, % `addr2line` says 0 if unknown 1058 !, 1059 sub_string(Rest, 0, BC, _, FileText), 1060 FileText \== "??", % and `??` for the file 1061 atom_string(File, FileText).
true.1086clause_property(Clause, Property) :- 1087 '$clause_property'(Property, Clause). 1088 1089'$clause_property'(line_count(LineNumber), Clause) :- 1090 '$get_clause_attribute'(Clause, line_count, LineNumber). 1091'$clause_property'(file(File), Clause) :- 1092 '$get_clause_attribute'(Clause, file, File). 1093'$clause_property'(source(File), Clause) :- 1094 '$get_clause_attribute'(Clause, owner, File). 1095'$clause_property'(size(Bytes), Clause) :- 1096 '$get_clause_attribute'(Clause, size, Bytes). 1097'$clause_property'(fact, Clause) :- 1098 '$get_clause_attribute'(Clause, fact, true). 1099'$clause_property'(erased, Clause) :- 1100 '$get_clause_attribute'(Clause, erased, true). 1101'$clause_property'(predicate(PI), Clause) :- 1102 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1103'$clause_property'(module(M), Clause) :- 1104 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1118dynamic(M:Predicates, Options) :- 1119 '$must_be'(list, Predicates), 1120 options_properties(Options, Props), 1121 set_pprops(Predicates, M, [dynamic|Props]). 1122 1123set_pprops([], _, _). 1124set_pprops([H|T], M, Props) :- 1125 set_pprops1(Props, M:H), 1126 strip_module(M:H, M2, P), 1127 '$pi_head'(M2:P, Pred), 1128 '$set_table_wrappers'(Pred), 1129 set_pprops(T, M, Props). 1130 1131set_pprops1([], _). 1132set_pprops1([H|T], P) :- 1133 ( atom(H) 1134 -> '$set_predicate_attribute'(P, H, true) 1135 ; H =.. [Name,Value] 1136 -> '$set_predicate_attribute'(P, Name, Value) 1137 ), 1138 set_pprops1(T, P). 1139 1140options_properties(Options, Props) :- 1141 G = opt_prop(_,_,_,_), 1142 findall(G, G, Spec), 1143 options_properties(Spec, Options, Props). 1144 1145options_properties([], _, []). 1146options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1147 Options, [Prop|PT]) :- 1148 Opt =.. [Name,V], 1149 '$option'(Opt, Options), 1150 '$must_be'(Type, V), 1151 V = SetValue, 1152 !, 1153 options_properties(T, Options, PT). 1154options_properties([_|T], Options, PT) :- 1155 options_properties(T, Options, PT). 1156 1157opt_prop(incremental, boolean, Bool, incremental(Bool)). 1158opt_prop(abstract, between(0,0), 0, abstract). 1159opt_prop(multifile, boolean, true, multifile). 1160opt_prop(discontiguous, boolean, true, discontiguous). 1161opt_prop(volatile, boolean, true, volatile). 1162opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1163 local, thread_local). 1164 1165 /******************************** 1166 * MODULES * 1167 *********************************/
1173current_module(Module) :-
1174 '$current_module'(Module, _).1190module_property(Module, Property) :- 1191 nonvar(Module), nonvar(Property), 1192 !, 1193 property_module(Property, Module). 1194module_property(Module, Property) :- % -, file(File) 1195 nonvar(Property), Property = file(File), 1196 !, 1197 ( nonvar(File) 1198 -> '$current_module'(Modules, File), 1199 ( atom(Modules) 1200 -> Module = Modules 1201 ; '$member'(Module, Modules) 1202 ) 1203 ; '$current_module'(Module, File), 1204 File \== [] 1205 ). 1206module_property(Module, Property) :- 1207 current_module(Module), 1208 property_module(Property, Module). 1209 1210property_module(Property, Module) :- 1211 module_property(Property), 1212 ( Property = exported_operators(List) 1213 -> '$exported_ops'(Module, List, []) 1214 ; '$module_property'(Module, Property) 1215 ). 1216 1217module_property(class(_)). 1218module_property(file(_)). 1219module_property(line_count(_)). 1220module_property(exports(_)). 1221module_property(exported_operators(_)). 1222module_property(size(_)). 1223module_property(program_size(_)). 1224module_property(program_space(_)). 1225module_property(last_modified_generation(_)).
1231module(Module) :- 1232 atom(Module), 1233 current_module(Module), 1234 !, 1235 '$set_typein_module'(Module). 1236module(Module) :- 1237 '$set_typein_module'(Module), 1238 print_message(warning, no_current_module(Module)).
1245working_directory(Old, New) :- 1246 '$cwd'(Old), 1247 ( Old == New 1248 -> true 1249 ; '$chdir'(New) 1250 ). 1251 1252 1253 /******************************* 1254 * TRIES * 1255 *******************************/
1261current_trie(Trie) :-
1262 current_blob(Trie, trie),
1263 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1299trie_property(Trie, Property) :- 1300 current_trie(Trie), 1301 trie_property(Property), 1302 '$trie_property'(Trie, Property). 1303 1304trie_property(node_count(_)). 1305trie_property(value_count(_)). 1306trie_property(size(_)). 1307trie_property(hashed(_)). 1308trie_property(compiled_size(_)). 1309 % below only when -DO_TRIE_STATS 1310trie_property(lookup_count(_)). % is enabled in pl-trie.h 1311trie_property(gen_call_count(_)). 1312trie_property(invalidated(_)). % IDG stats 1313trie_property(reevaluated(_)). 1314trie_property(deadlock(_)). % Shared tabling stats 1315trie_property(wait(_)). 1316trie_property(idg_affected_count(_)). 1317trie_property(idg_dependent_count(_)). 1318trie_property(idg_size(_)). 1319 1320 1321 /******************************** 1322 * SYSTEM INTERACTION * 1323 *********************************/ 1324 1325shell(Command) :- 1326 shell(Command, 0). 1327 1328 1329 /******************************* 1330 * SIGNALS * 1331 *******************************/ 1332 1333:- meta_predicate 1334 on_signal(, , ), 1335 current_signal(, , ).
1339on_signal(Signal, Old, New) :- 1340 atom(Signal), 1341 !, 1342 '$on_signal'(_Num, Signal, Old, New). 1343on_signal(Signal, Old, New) :- 1344 integer(Signal), 1345 !, 1346 '$on_signal'(Signal, _Name, Old, New). 1347on_signal(Signal, _Old, _New) :- 1348 '$type_error'(signal_name, Signal).
1352current_signal(Name, Id, Handler) :- 1353 between(1, 32, Id), 1354 '$on_signal'(Id, Name, Handler, Handler). 1355 1356:- multifile 1357 prolog:called_by/2. 1358 1359prologcalled_by(on_signal(_,_,New), [New+1]) :- 1360 ( new == throw 1361 ; new == default 1362 ), !, fail. 1363 1364 1365 /******************************* 1366 * I/O * 1367 *******************************/ 1368 1369format(Fmt) :- 1370 format(Fmt, []). 1371 1372 /******************************* 1373 * FILES * 1374 *******************************/
1378absolute_file_name(Name, Abs) :- 1379 atomic(Name), 1380 !, 1381 '$absolute_file_name'(Name, Abs). 1382absolute_file_name(Term, Abs) :- 1383 '$chk_file'(Term, [''], [access(read)], true, File), 1384 !, 1385 '$absolute_file_name'(File, Abs). 1386absolute_file_name(Term, Abs) :- 1387 '$chk_file'(Term, [''], [], true, File), 1388 !, 1389 '$absolute_file_name'(File, Abs).
1397tmp_file_stream(Enc, File, Stream) :- 1398 atom(Enc), var(File), var(Stream), 1399 !, 1400 '$tmp_file_stream'('', Enc, File, Stream). 1401tmp_file_stream(File, Stream, Options) :- 1402 current_prolog_flag(encoding, DefEnc), 1403 '$option'(encoding(Enc), Options, DefEnc), 1404 '$option'(extension(Ext), Options, ''), 1405 '$tmp_file_stream'(Ext, Enc, File, Stream), 1406 set_stream(Stream, file_name(File)). 1407 1408 1409 /******************************** 1410 * MEMORY MANAGEMENT * 1411 *********************************/
1420garbage_collect :-
1421 '$garbage_collect'(0).
1427set_prolog_stack(Stack, Option) :-
1428 Option =.. [Name,Value0],
1429 Value is Value0,
1430 '$set_prolog_stack'(Stack, Name, _Old, Value).1436prolog_stack_property(Stack, Property) :- 1437 stack_property(P), 1438 stack_name(Stack), 1439 Property =.. [P,Value], 1440 '$set_prolog_stack'(Stack, P, Value, Value). 1441 1442stack_name(local). 1443stack_name(global). 1444stack_name(trail). 1445 1446stack_property(limit). 1447stack_property(spare). 1448stack_property(min_free). 1449stack_property(low). 1450stack_property(factor). 1451 1452 1453 /******************************* 1454 * CLAUSE * 1455 *******************************/
:-
as neck.1463rule(Head, Rule) :- 1464 '$rule'(Head, Rule0), 1465 conditional_rule(Rule0, Rule1), 1466 Rule = Rule1. 1467rule(Head, Rule, Ref) :- 1468 '$rule'(Head, Rule0, Ref), 1469 conditional_rule(Rule0, Rule1), 1470 Rule = Rule1. 1471 1472conditional_rule(?=>(Head, (!, Body)), Rule) => 1473 Rule = (Head => Body). 1474conditional_rule(?=>(Head, !), Rule) => 1475 Rule = (Head => true). 1476conditional_rule(?=>(Head, Body0), Rule), 1477 split_on_cut(Body0, Cond, Body) => 1478 Rule = (Head,Cond=>Body). 1479conditional_rule(Head, Rule) => 1480 Rule = Head. 1481 1482split_on_cut((Cond0,!,Body0), Cond, Body) => 1483 Cond = Cond0, 1484 Body = Body0. 1485split_on_cut((!,Body0), Cond, Body) => 1486 Cond = true, 1487 Body = Body0. 1488split_on_cut((A,B), Cond, Body) => 1489 Cond = (A,Cond1), 1490 split_on_cut(B, Cond1, Body). 1491split_on_cut(_, _, _) => 1492 fail. 1493 1494 1495 /******************************* 1496 * TERM * 1497 *******************************/ 1498 1499:- '$iso'((numbervars/3)).
1507numbervars(Term, From, To) :- 1508 numbervars(Term, From, To, []). 1509 1510 1511 /******************************* 1512 * STRING * 1513 *******************************/
1519term_string(Term, String, Options) :- 1520 nonvar(String), 1521 !, 1522 read_term_from_atom(String, Term, Options). 1523term_string(Term, String, Options) :- 1524 ( '$option'(quoted(_), Options) 1525 -> Options1 = Options 1526 ; '$merge_options'(_{quoted:true}, Options, Options1) 1527 ), 1528 format(string(String), '~W', [Term, Options1]). 1529 1530 1531 /******************************* 1532 * THREADS * 1533 *******************************/ 1534 1535:- meta_predicate 1536 thread_create(, ).
thread_create(Goal, Id, []).
1542thread_create(Goal, Id) :-
1543 thread_create(Goal, Id, []).
1552thread_join(Id) :-
1553 thread_join(Id, Status),
1554 ( Status == true
1555 -> true
1556 ; throw(error(thread_error(Id, Status), _))
1557 ).1567sig_block(Pattern) :- 1568 ( nb_current('$sig_blocked', List) 1569 -> true 1570 ; List = [] 1571 ), 1572 nb_setval('$sig_blocked', [Pattern|List]). 1573 1574sig_unblock(Pattern) :- 1575 ( nb_current('$sig_blocked', List) 1576 -> unblock(List, Pattern, NewList), 1577 ( List == NewList 1578 -> true 1579 ; nb_setval('$sig_blocked', NewList), 1580 '$sig_unblock' 1581 ) 1582 ; true 1583 ). 1584 1585unblock([], _, []). 1586unblock([H|T], P, List) :- 1587 ( subsumes_term(P, H) 1588 -> unblock(T, P, List) 1589 ; List = [H|T1], 1590 unblock(T, P, T1) 1591 ). 1592 1593:- public signal_is_blocked/1. % called by signal_is_blocked() 1594 1595signal_is_blocked(Head) :- 1596 nb_current('$sig_blocked', List), 1597 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.1614set_prolog_gc_thread(Status) :- 1615 var(Status), 1616 !, 1617 '$instantiation_error'(Status). 1618set_prolog_gc_thread(_) :- 1619 \+ current_prolog_flag(threads, true), 1620 !. 1621set_prolog_gc_thread(false) :- 1622 !, 1623 set_prolog_flag(gc_thread, false), 1624 ( current_prolog_flag(threads, true) 1625 -> ( '$gc_stop' 1626 -> thread_join(gc) 1627 ; true 1628 ) 1629 ; true 1630 ). 1631set_prolog_gc_thread(true) :- 1632 !, 1633 set_prolog_flag(gc_thread, true). 1634set_prolog_gc_thread(stop) :- 1635 !, 1636 ( current_prolog_flag(threads, true) 1637 -> ( '$gc_stop' 1638 -> thread_join(gc) 1639 ; true 1640 ) 1641 ; true 1642 ). 1643set_prolog_gc_thread(Status) :- 1644 '$domain_error'(gc_thread, Status).
1653transaction(Goal) :- 1654 '$transaction'(Goal, []). 1655transaction(Goal, Options) :- 1656 '$transaction'(Goal, Options). 1657transaction(Goal, Constraint, Mutex) :- 1658 '$transaction'(Goal, Constraint, Mutex). 1659snapshot(Goal) :- 1660 '$snapshot'(Goal). 1661 1662 1663 /******************************* 1664 * UNDO * 1665 *******************************/ 1666 1667:- meta_predicate 1668 undo().
1675undo(Goal) :- 1676 '$undo'(Goal). 1677 1678:- public 1679 '$run_undo'/1. 1680 1681'$run_undo'([One]) :- 1682 !, 1683 ( call(One) 1684 -> true 1685 ; true 1686 ). 1687'$run_undo'(List) :- 1688 run_undo(List, _, Error), 1689 ( var(Error) 1690 -> true 1691 ; throw(Error) 1692 ). 1693 1694run_undo([], E, E). 1695run_undo([H|T], E0, E) :- 1696 ( catch(H, E1, true) 1697 -> ( var(E1) 1698 -> true 1699 ; '$urgent_exception'(E0, E1, E2) 1700 ) 1701 ; true 1702 ), 1703 run_undo(T, E2, E).
1711:- meta_predicate 1712 '$wrap_predicate'(, , , , ). 1713 1714'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1715 callable_name_arguments(Head, PName, Args), 1716 callable_name_arity(Head, PName, Arity), 1717 ( is_most_general_term(Head) 1718 -> true 1719 ; '$domain_error'(most_general_term, Head) 1720 ), 1721 atomic_list_concat(['$wrap$', PName], WrapName), 1722 PI = M:WrapName/Arity, 1723 dynamic(PI), 1724 '$notransact'(PI), 1725 volatile(PI), 1726 module_transparent(PI), 1727 WHead =.. [WrapName|Args], 1728 wrapped_clause(M, WHead, Body, Clause), 1729 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause). 1730 1731callable_name_arguments(Head, PName, Args) :- 1732 atom(Head), 1733 !, 1734 PName = Head, 1735 Args = []. 1736callable_name_arguments(Head, PName, Args) :- 1737 compound_name_arguments(Head, PName, Args). 1738 1739callable_name_arity(Head, PName, Arity) :- 1740 atom(Head), 1741 !, 1742 PName = Head, 1743 Arity = 0. 1744callable_name_arity(Head, PName, Arity) :- 1745 compound_name_arity(Head, PName, Arity). 1746 1747wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !. 1748wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))