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'(erased_clauses(Count), Pred) :- 908 '$get_predicate_attribute'(Pred, erased_clauses, Count). 909'$predicate_property'(erased_clause_space(Bytes), Pred) :- 910 '$get_predicate_attribute'(Pred, erased_clause_space, Bytes). 911'$predicate_property'(primary_index(Arg), Pred) :- 912 '$get_predicate_attribute'(Pred, primary_index, Arg). 913 914system_undefined(user:prolog_trace_interception/4). 915system_undefined(prolog:prolog_exception_hook/5). 916system_undefined(system:'$c_call_prolog'/0). 917system_undefined(system:window_title/2). 918 919table_flag(variant, Pred) :- 920 '$tbl_implementation'(Pred, M:Head), 921 M:'$tabled'(Head, variant). 922table_flag(subsumptive, Pred) :- 923 '$tbl_implementation'(Pred, M:Head), 924 M:'$tabled'(Head, subsumptive). 925table_flag(shared, Pred) :- 926 '$get_predicate_attribute'(Pred, tshared, 1). 927table_flag(incremental, Pred) :- 928 '$get_predicate_attribute'(Pred, incremental, 1). 929table_flag(monotonic, Pred) :- 930 '$get_predicate_attribute'(Pred, monotonic, 1). 931table_flag(subgoal_abstract(N), Pred) :- 932 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 933table_flag(answer_abstract(N), Pred) :- 934 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 935table_flag(subgoal_abstract(N), Pred) :- 936 '$get_predicate_attribute'(Pred, max_answers, N).
945visible_predicate(Pred) :- 946 Pred = M:Head, 947 current_module(M), 948 ( callable(Head) 949 -> ( '$get_predicate_attribute'(Pred, defined, 1) 950 -> true 951 ; \+ current_prolog_flag(Munknown, fail), 952 '$head_name_arity'(Head, Name, Arity), 953 '$find_library'(M, Name, Arity, _LoadModule, _Library) 954 ) 955 ; setof(PI, visible_in_module(M, PI), PIs), 956 '$member'(Name/Arity, PIs), 957 functor(Head, Name, Arity) 958 ). 959 960visible_in_module(M, Name/Arity) :- 961 default_module(M, DefM), 962 DefHead = DefM:Head, 963 '$c_current_predicate'(_, DefHead), 964 '$get_predicate_attribute'(DefHead, defined, 1), 965 \+ hidden_system_predicate(Head), 966 functor(Head, Name, Arity). 967visible_in_module(_, Name/Arity) :- 968 '$in_library'(Name, Arity, _). 969 (Head) :- 971 functor(Head, Name, _), 972 atom(Name), % Avoid []. 973 sub_atom(Name, 0, _, _, $), 974 \+ current_prolog_flag(access_level, system). 975 976 977 /******************************** 978 * SOURCE LOCATION * 979 *********************************/
This predicate provides the source location for both the message
system (see predicate_reference//2 in boot/messages.pl) and
library(edit).
993:- meta_predicate 994 '$predicate_source_location'(, ). 995 996'$predicate_source_location'(Head, File:Line) :- 997 '$primary_predicate'(Head, Primary), 998 ( predicate_property(Primary, file(File)), 999 predicate_property(Primary, line_count(Line)) 1000 -> true 1001 ; predicate_property(Primary, foreign), 1002 '$foreign_source_location'(Primary, File, Line) 1003 ).
1010'$primary_predicate'(Pred, Primary) :-
1011 ( predicate_property(Pred, imported_from(Module))
1012 -> strip_module(Pred, _, Head),
1013 Primary = Module:Head
1014 ; Primary = Pred
1015 ).addr2line or atos in a child process we can
only afford to do this once per predicate.1023:- dynamic 1024 '$foreign_source_cache'/2. % PI, File:Line or `none` 1025 1026'$foreign_source_location'(Head, File, Line) :- 1027 '$pi_head'(PI, Head), 1028 ( '$foreign_source_cache'(PI, Cached) 1029 -> true 1030 ; ( '$foreign_predicate_source'(Head, Source), 1031 '$addr2line_location'(Source, File0, Line0) 1032 -> Cached = File0:Line0 1033 ; Cached = none 1034 ), 1035 assertz('$foreign_source_cache'(PI, Cached)) 1036 ), 1037 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.1047'$addr2line_location'(Description, File, Line) :- 1048 sub_string(Description, Before, _, After, " at "), 1049 !, 1050 Start is Before+4, 1051 sub_string(Description, Start, After, 0, Rest), 1052 '$split_file_line'(Rest, File, Line). 1053 1054'$split_file_line'(Rest, File, Line) :- 1055 sub_string(Rest, BC, _, AC, ":"), 1056 Start is BC+1, 1057 sub_string(Rest, Start, AC, 0, Tail), 1058 ( sub_string(Tail, BS, _, _, " ") % e.g. " (discriminator 1)" 1059 -> sub_string(Tail, 0, BS, _, LineText) 1060 ; LineText = Tail 1061 ), 1062 number_string(Line, LineText), 1063 integer(Line), 1064 Line >= 1, % `addr2line` says 0 if unknown 1065 !, 1066 sub_string(Rest, 0, BC, _, FileText), 1067 FileText \== "??", % and `??` for the file 1068 atom_string(File, FileText).
true.1093clause_property(Clause, Property) :- 1094 '$clause_property'(Property, Clause). 1095 1096'$clause_property'(line_count(LineNumber), Clause) :- 1097 '$get_clause_attribute'(Clause, line_count, LineNumber). 1098'$clause_property'(file(File), Clause) :- 1099 '$get_clause_attribute'(Clause, file, File). 1100'$clause_property'(source(File), Clause) :- 1101 '$get_clause_attribute'(Clause, owner, File). 1102'$clause_property'(size(Bytes), Clause) :- 1103 '$get_clause_attribute'(Clause, size, Bytes). 1104'$clause_property'(fact, Clause) :- 1105 '$get_clause_attribute'(Clause, fact, true). 1106'$clause_property'(erased, Clause) :- 1107 '$get_clause_attribute'(Clause, erased, true). 1108'$clause_property'(predicate(PI), Clause) :- 1109 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1110'$clause_property'(module(M), Clause) :- 1111 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1125dynamic(M:Predicates, Options) :- 1126 '$must_be'(list, Predicates), 1127 options_properties(Options, Props), 1128 set_pprops(Predicates, M, [dynamic|Props]). 1129 1130set_pprops([], _, _). 1131set_pprops([H|T], M, Props) :- 1132 set_pprops1(Props, M:H), 1133 strip_module(M:H, M2, P), 1134 '$pi_head'(M2:P, Pred), 1135 '$set_table_wrappers'(Pred), 1136 set_pprops(T, M, Props). 1137 1138set_pprops1([], _). 1139set_pprops1([H|T], P) :- 1140 ( atom(H) 1141 -> '$set_predicate_attribute'(P, H, true) 1142 ; H =.. [Name,Value] 1143 -> '$set_predicate_attribute'(P, Name, Value) 1144 ), 1145 set_pprops1(T, P). 1146 1147options_properties(Options, Props) :- 1148 G = opt_prop(_,_,_,_), 1149 findall(G, G, Spec), 1150 options_properties(Spec, Options, Props). 1151 1152options_properties([], _, []). 1153options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1154 Options, [Prop|PT]) :- 1155 Opt =.. [Name,V], 1156 '$option'(Opt, Options), 1157 '$must_be'(Type, V), 1158 V = SetValue, 1159 !, 1160 options_properties(T, Options, PT). 1161options_properties([_|T], Options, PT) :- 1162 options_properties(T, Options, PT). 1163 1164opt_prop(incremental, boolean, Bool, incremental(Bool)). 1165opt_prop(abstract, between(0,0), 0, abstract). 1166opt_prop(multifile, boolean, true, multifile). 1167opt_prop(discontiguous, boolean, true, discontiguous). 1168opt_prop(volatile, boolean, true, volatile). 1169opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1170 local, thread_local). 1171 1172 /******************************** 1173 * MODULES * 1174 *********************************/
1180current_module(Module) :-
1181 '$current_module'(Module, _).1197module_property(Module, Property) :- 1198 nonvar(Module), nonvar(Property), 1199 !, 1200 property_module(Property, Module). 1201module_property(Module, Property) :- % -, file(File) 1202 nonvar(Property), Property = file(File), 1203 !, 1204 ( nonvar(File) 1205 -> '$current_module'(Modules, File), 1206 ( atom(Modules) 1207 -> Module = Modules 1208 ; '$member'(Module, Modules) 1209 ) 1210 ; '$current_module'(Module, File), 1211 File \== [] 1212 ). 1213module_property(Module, Property) :- 1214 current_module(Module), 1215 property_module(Property, Module). 1216 1217property_module(Property, Module) :- 1218 module_property(Property), 1219 ( Property = exported_operators(List) 1220 -> '$exported_ops'(Module, List, []) 1221 ; '$module_property'(Module, Property) 1222 ). 1223 1224module_property(class(_)). 1225module_property(file(_)). 1226module_property(line_count(_)). 1227module_property(exports(_)). 1228module_property(exported_operators(_)). 1229module_property(size(_)). 1230module_property(program_size(_)). 1231module_property(program_space(_)). 1232module_property(last_modified_generation(_)).
1238module(Module) :- 1239 atom(Module), 1240 current_module(Module), 1241 !, 1242 '$set_typein_module'(Module). 1243module(Module) :- 1244 '$set_typein_module'(Module), 1245 print_message(warning, no_current_module(Module)).
1252working_directory(Old, New) :- 1253 '$cwd'(Old), 1254 ( Old == New 1255 -> true 1256 ; '$chdir'(New) 1257 ). 1258 1259 1260 /******************************* 1261 * TRIES * 1262 *******************************/
1268current_trie(Trie) :-
1269 current_blob(Trie, trie),
1270 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1306trie_property(Trie, Property) :- 1307 current_trie(Trie), 1308 trie_property(Property), 1309 '$trie_property'(Trie, Property). 1310 1311trie_property(node_count(_)). 1312trie_property(value_count(_)). 1313trie_property(size(_)). 1314trie_property(hashed(_)). 1315trie_property(compiled_size(_)). 1316 % below only when -DO_TRIE_STATS 1317trie_property(lookup_count(_)). % is enabled in pl-trie.h 1318trie_property(gen_call_count(_)). 1319trie_property(invalidated(_)). % IDG stats 1320trie_property(reevaluated(_)). 1321trie_property(deadlock(_)). % Shared tabling stats 1322trie_property(wait(_)). 1323trie_property(idg_affected_count(_)). 1324trie_property(idg_dependent_count(_)). 1325trie_property(idg_size(_)). 1326 1327 1328 /******************************** 1329 * SYSTEM INTERACTION * 1330 *********************************/ 1331 1332shell(Command) :- 1333 shell(Command, 0). 1334 1335 1336 /******************************* 1337 * SIGNALS * 1338 *******************************/ 1339 1340:- meta_predicate 1341 on_signal(, , ), 1342 current_signal(, , ).
1346on_signal(Signal, Old, New) :- 1347 atom(Signal), 1348 !, 1349 '$on_signal'(_Num, Signal, Old, New). 1350on_signal(Signal, Old, New) :- 1351 integer(Signal), 1352 !, 1353 '$on_signal'(Signal, _Name, Old, New). 1354on_signal(Signal, _Old, _New) :- 1355 '$type_error'(signal_name, Signal).
1359current_signal(Name, Id, Handler) :- 1360 between(1, 32, Id), 1361 '$on_signal'(Id, Name, Handler, Handler). 1362 1363:- multifile 1364 prolog:called_by/2. 1365 1366prologcalled_by(on_signal(_,_,New), [New+1]) :- 1367 ( new == throw 1368 ; new == default 1369 ), !, fail. 1370 1371 1372 /******************************* 1373 * I/O * 1374 *******************************/ 1375 1376format(Fmt) :- 1377 format(Fmt, []). 1378 1379 /******************************* 1380 * FILES * 1381 *******************************/
1385absolute_file_name(Name, Abs) :- 1386 atomic(Name), 1387 !, 1388 '$absolute_file_name'(Name, Abs). 1389absolute_file_name(Term, Abs) :- 1390 '$chk_file'(Term, [''], [access(read)], true, File), 1391 !, 1392 '$absolute_file_name'(File, Abs). 1393absolute_file_name(Term, Abs) :- 1394 '$chk_file'(Term, [''], [], true, File), 1395 !, 1396 '$absolute_file_name'(File, Abs).
1404tmp_file_stream(Enc, File, Stream) :- 1405 atom(Enc), var(File), var(Stream), 1406 !, 1407 '$tmp_file_stream'('', Enc, File, Stream). 1408tmp_file_stream(File, Stream, Options) :- 1409 current_prolog_flag(encoding, DefEnc), 1410 '$option'(encoding(Enc), Options, DefEnc), 1411 '$option'(extension(Ext), Options, ''), 1412 '$tmp_file_stream'(Ext, Enc, File, Stream), 1413 set_stream(Stream, file_name(File)). 1414 1415 1416 /******************************** 1417 * MEMORY MANAGEMENT * 1418 *********************************/
1427garbage_collect :-
1428 '$garbage_collect'(0).
1434set_prolog_stack(Stack, Option) :-
1435 Option =.. [Name,Value0],
1436 Value is Value0,
1437 '$set_prolog_stack'(Stack, Name, _Old, Value).1443prolog_stack_property(Stack, Property) :- 1444 stack_property(P), 1445 stack_name(Stack), 1446 Property =.. [P,Value], 1447 '$set_prolog_stack'(Stack, P, Value, Value). 1448 1449stack_name(local). 1450stack_name(global). 1451stack_name(trail). 1452 1453stack_property(limit). 1454stack_property(spare). 1455stack_property(min_free). 1456stack_property(low). 1457stack_property(factor). 1458 1459 1460 /******************************* 1461 * CLAUSE * 1462 *******************************/
:-
as neck.1470rule(Head, Rule) :- 1471 '$rule'(Head, Rule0), 1472 conditional_rule(Rule0, Rule1), 1473 Rule = Rule1. 1474rule(Head, Rule, Ref) :- 1475 '$rule'(Head, Rule0, Ref), 1476 conditional_rule(Rule0, Rule1), 1477 Rule = Rule1. 1478 1479conditional_rule(?=>(Head, (!, Body)), Rule) => 1480 Rule = (Head => Body). 1481conditional_rule(?=>(Head, !), Rule) => 1482 Rule = (Head => true). 1483conditional_rule(?=>(Head, Body0), Rule), 1484 split_on_cut(Body0, Cond, Body) => 1485 Rule = (Head,Cond=>Body). 1486conditional_rule(Head, Rule) => 1487 Rule = Head. 1488 1489split_on_cut((Cond0,!,Body0), Cond, Body) => 1490 Cond = Cond0, 1491 Body = Body0. 1492split_on_cut((!,Body0), Cond, Body) => 1493 Cond = true, 1494 Body = Body0. 1495split_on_cut((A,B), Cond, Body) => 1496 Cond = (A,Cond1), 1497 split_on_cut(B, Cond1, Body). 1498split_on_cut(_, _, _) => 1499 fail. 1500 1501 1502 /******************************* 1503 * TERM * 1504 *******************************/ 1505 1506:- '$iso'((numbervars/3)).
1514numbervars(Term, From, To) :- 1515 numbervars(Term, From, To, []). 1516 1517 1518 /******************************* 1519 * STRING * 1520 *******************************/
1526term_string(Term, String, Options) :- 1527 nonvar(String), 1528 !, 1529 read_term_from_atom(String, Term, Options). 1530term_string(Term, String, Options) :- 1531 ( '$option'(quoted(_), Options) 1532 -> Options1 = Options 1533 ; '$merge_options'(_{quoted:true}, Options, Options1) 1534 ), 1535 format(string(String), '~W', [Term, Options1]). 1536 1537 1538 /******************************* 1539 * THREADS * 1540 *******************************/ 1541 1542:- meta_predicate 1543 thread_create(, ).
thread_create(Goal, Id, []).
1549thread_create(Goal, Id) :-
1550 thread_create(Goal, Id, []).
1559thread_join(Id) :-
1560 thread_join(Id, Status),
1561 ( Status == true
1562 -> true
1563 ; throw(error(thread_error(Id, Status), _))
1564 ).1574sig_block(Pattern) :- 1575 ( nb_current('$sig_blocked', List) 1576 -> true 1577 ; List = [] 1578 ), 1579 nb_setval('$sig_blocked', [Pattern|List]). 1580 1581sig_unblock(Pattern) :- 1582 ( nb_current('$sig_blocked', List) 1583 -> unblock(List, Pattern, NewList), 1584 ( List == NewList 1585 -> true 1586 ; nb_setval('$sig_blocked', NewList), 1587 '$sig_unblock' 1588 ) 1589 ; true 1590 ). 1591 1592unblock([], _, []). 1593unblock([H|T], P, List) :- 1594 ( subsumes_term(P, H) 1595 -> unblock(T, P, List) 1596 ; List = [H|T1], 1597 unblock(T, P, T1) 1598 ). 1599 1600:- public signal_is_blocked/1. % called by signal_is_blocked() 1601 1602signal_is_blocked(Head) :- 1603 nb_current('$sig_blocked', List), 1604 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.1621set_prolog_gc_thread(Status) :- 1622 var(Status), 1623 !, 1624 '$instantiation_error'(Status). 1625set_prolog_gc_thread(_) :- 1626 \+ current_prolog_flag(threads, true), 1627 !. 1628set_prolog_gc_thread(false) :- 1629 !, 1630 set_prolog_flag(gc_thread, false), 1631 ( current_prolog_flag(threads, true) 1632 -> ( '$gc_stop' 1633 -> thread_join(gc) 1634 ; true 1635 ) 1636 ; true 1637 ). 1638set_prolog_gc_thread(true) :- 1639 !, 1640 set_prolog_flag(gc_thread, true). 1641set_prolog_gc_thread(stop) :- 1642 !, 1643 ( current_prolog_flag(threads, true) 1644 -> ( '$gc_stop' 1645 -> thread_join(gc) 1646 ; true 1647 ) 1648 ; true 1649 ). 1650set_prolog_gc_thread(Status) :- 1651 '$domain_error'(gc_thread, Status).
1660transaction(Goal) :- 1661 '$transaction'(Goal, []). 1662transaction(Goal, Options) :- 1663 '$transaction'(Goal, Options). 1664transaction(Goal, Constraint, Mutex) :- 1665 '$transaction'(Goal, Constraint, Mutex). 1666snapshot(Goal) :- 1667 '$snapshot'(Goal). 1668 1669 1670 /******************************* 1671 * UNDO * 1672 *******************************/ 1673 1674:- meta_predicate 1675 undo().
1682undo(Goal) :- 1683 '$undo'(Goal). 1684 1685:- public 1686 '$run_undo'/1. 1687 1688'$run_undo'([One]) :- 1689 !, 1690 ( call(One) 1691 -> true 1692 ; true 1693 ). 1694'$run_undo'(List) :- 1695 run_undo(List, _, Error), 1696 ( var(Error) 1697 -> true 1698 ; throw(Error) 1699 ). 1700 1701run_undo([], E, E). 1702run_undo([H|T], E0, E) :- 1703 ( catch(H, E1, true) 1704 -> ( var(E1) 1705 -> true 1706 ; '$urgent_exception'(E0, E1, E2) 1707 ) 1708 ; true 1709 ), 1710 run_undo(T, E2, E).
1718:- meta_predicate 1719 '$wrap_predicate'(, , , , ). 1720 1721'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1722 callable_name_arguments(Head, PName, Args), 1723 callable_name_arity(Head, PName, Arity), 1724 ( is_most_general_term(Head) 1725 -> true 1726 ; '$domain_error'(most_general_term, Head) 1727 ), 1728 atomic_list_concat(['$wrap$', PName], WrapName), 1729 PI = M:WrapName/Arity, 1730 dynamic(PI), 1731 '$notransact'(PI), 1732 volatile(PI), 1733 module_transparent(PI), 1734 WHead =.. [WrapName|Args], 1735 wrapped_clause(M, WHead, Body, Clause), 1736 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause). 1737 1738callable_name_arguments(Head, PName, Args) :- 1739 atom(Head), 1740 !, 1741 PName = Head, 1742 Args = []. 1743callable_name_arguments(Head, PName, Args) :- 1744 compound_name_arguments(Head, PName, Args). 1745 1746callable_name_arity(Head, PName, Arity) :- 1747 atom(Head), 1748 !, 1749 PName = Head, 1750 Arity = 0. 1751callable_name_arity(Head, PName, Arity) :- 1752 compound_name_arity(Head, PName, Arity). 1753 1754wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !. 1755wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))