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-2022, 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 nb_setval/2, % +Var, +Value 81 thread_create/2, % :Goal, -Id 82 thread_join/1, % +Id 83 sig_block/1, % :Pattern 84 sig_unblock/1, % :Pattern 85 transaction/1, % :Goal 86 transaction/2, % :Goal, +Options 87 transaction/3, % :Goal, :Constraint, +Mutex 88 snapshot/1, % :Goal 89 undo/1, % :Goal 90 set_prolog_gc_thread/1, % +Status 91 92 '$wrap_predicate'/5 % :Head, +Name, -Closure, -Wrapped, +Body 93 ]). 94 95:- meta_predicate 96 dynamic(, ), 97 transaction(), 98 transaction(,,), 99 snapshot(), 100 rule(, ), 101 rule(, , ), 102 sig_block(), 103 sig_unblock(). 104 105 106 /******************************** 107 * DEBUGGER * 108 *********************************/
112:- meta_predicate 113 map_bits(, , , ). 114 115map_bits(_, Var, _, _) :- 116 var(Var), 117 !, 118 '$instantiation_error'(Var). 119map_bits(_, [], Bits, Bits) :- !. 120map_bits(Pred, [H|T], Old, New) :- 121 map_bits(Pred, H, Old, New0), 122 map_bits(Pred, T, New0, New). 123map_bits(Pred, +Name, Old, New) :- % set a bit 124 !, 125 bit(Pred, Name, Bits), 126 !, 127 New is Old \/ Bits. 128map_bits(Pred, -Name, Old, New) :- % clear a bit 129 !, 130 bit(Pred, Name, Bits), 131 !, 132 New is Old /\ (\Bits). 133map_bits(Pred, ?(Name), Old, Old) :- % ask a bit 134 !, 135 bit(Pred, Name, Bits), 136 Old /\ Bits > 0. 137map_bits(_, Term, _, _) :- 138 '$type_error'('+|-|?(Flag)', Term). 139 140bit(Pred, Name, Bits) :- 141 call(Pred, Name, Bits), 142 !. 143bit(_:Pred, Name, _) :- 144 '$domain_error'(Pred, Name). 145 146:- public port_name/2. % used by library(test_cover) 147 148port_name( call, 2'000000001). 149port_name( exit, 2'000000010). 150port_name( fail, 2'000000100). 151port_name( redo, 2'000001000). 152port_name( unify, 2'000010000). 153port_name( break, 2'000100000). 154port_name( cut_call, 2'001000000). 155port_name( cut_exit, 2'010000000). 156port_name( exception, 2'100000000). 157port_name( cut, 2'011000000). 158port_name( all, 2'000111111). 159port_name( full, 2'000101111). 160port_name( half, 2'000101101). % ' 161 162leash(Ports) :- 163 '$leash'(Old, Old), 164 map_bits(port_name, Ports, Old, New), 165 '$leash'(_, New). 166 167visible(Ports) :- 168 '$visible'(Old, Old), 169 map_bits(port_name, Ports, Old, New), 170 '$visible'(_, New). 171 172style_name(atom, 0x0001) :- 173 print_message(warning, decl_no_effect(style_check(atom))). 174style_name(singleton, 0x0042). % semantic and syntactic 175style_name(discontiguous, 0x0008). 176style_name(charset, 0x0020). 177style_name(no_effect, 0x0080). 178style_name(var_branches, 0x0100).
182style_check(Var) :- 183 var(Var), 184 !, 185 '$instantiation_error'(Var). 186style_check(?(Style)) :- 187 !, 188 ( var(Style) 189 -> enum_style_check(Style) 190 ; enum_style_check(Style) 191 -> true 192 ). 193style_check(Spec) :- 194 '$style_check'(Old, Old), 195 map_bits(style_name, Spec, Old, New), 196 '$style_check'(_, New). 197 198enum_style_check(Style) :- 199 '$style_check'(Bits, Bits), 200 style_name(Style, Bit), 201 Bit /\ Bits =\= 0.
209flag(Name, Old, New) :- 210 Old == New, 211 !, 212 get_flag(Name, Old). 213flag(Name, Old, New) :- 214 with_mutex('$flag', update_flag(Name, Old, New)). 215 216update_flag(Name, Old, New) :- 217 get_flag(Name, Old), 218 ( atom(New) 219 -> set_flag(Name, New) 220 ; Value is New, 221 set_flag(Name, Value) 222 ). 223 224 225 /******************************** 226 * ATOMS * 227 *********************************/ 228 229dwim_match(A1, A2) :- 230 dwim_match(A1, A2, _). 231 232atom_prefix(Atom, Prefix) :- 233 sub_atom(Atom, 0, _, _, Prefix). 234 235 236 /******************************** 237 * SOURCE * 238 *********************************/
Note that Time = 0.0 is used by PlDoc and other code that needs to create a file record without being interested in the time.
251source_file(File) :-
252 ( current_prolog_flag(access_level, user)
253 -> Level = user
254 ; true
255 ),
256 ( ground(File)
257 -> ( '$time_source_file'(File, Time, Level)
258 ; absolute_file_name(File, Abs),
259 '$time_source_file'(Abs, Time, Level)
260 ), !
261 ; '$time_source_file'(File, Time, Level)
262 ),
263 Time > 0.0.270:- meta_predicate source_file(, ). 271 272source_file(M:Head, File) :- 273 nonvar(M), nonvar(Head), 274 !, 275 ( '$c_current_predicate'(_, M:Head), 276 predicate_property(M:Head, multifile) 277 -> multi_source_file(M:Head, File) 278 ; '$source_file'(M:Head, File) 279 ). 280source_file(M:Head, File) :- 281 ( nonvar(File) 282 -> true 283 ; source_file(File) 284 ), 285 '$source_file_predicates'(File, Predicates), 286 '$member'(M:Head, Predicates). 287 288multi_source_file(Head, File) :- 289 State = state([]), 290 nth_clause(Head, _, Clause), 291 clause_property(Clause, source(File)), 292 arg(1, State, Found), 293 ( memberchk(File, Found) 294 -> fail 295 ; nb_linkarg(1, State, [File|Found]) 296 ).
303source_file_property(File, P) :- 304 nonvar(File), 305 !, 306 canonical_source_file(File, Path), 307 property_source_file(P, Path). 308source_file_property(File, P) :- 309 property_source_file(P, File). 310 311property_source_file(modified(Time), File) :- 312 '$time_source_file'(File, Time, user). 313property_source_file(source(Source), File) :- 314 ( '$source_file_property'(File, from_state, true) 315 -> Source = state 316 ; '$source_file_property'(File, resource, true) 317 -> Source = resource 318 ; Source = file 319 ). 320property_source_file(module(M), File) :- 321 ( nonvar(M) 322 -> '$current_module'(M, File) 323 ; nonvar(File) 324 -> '$current_module'(ML, File), 325 ( atom(ML) 326 -> M = ML 327 ; '$member'(M, ML) 328 ) 329 ; '$current_module'(M, File) 330 ). 331property_source_file(load_context(Module, Location, Options), File) :- 332 '$time_source_file'(File, _, user), 333 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 334 ( clause_property(Ref, file(FromFile)), 335 clause_property(Ref, line_count(FromLine)) 336 -> Location = FromFile:FromLine 337 ; Location = user 338 ). 339property_source_file(includes(Master, Stamp), File) :- 340 system:'$included'(File, _Line, Master, Stamp). 341property_source_file(included_in(Master, Line), File) :- 342 system:'$included'(Master, Line, File, _). 343property_source_file(derived_from(DerivedFrom, Stamp), File) :- 344 system:'$derived_source'(File, DerivedFrom, Stamp). 345property_source_file(reloading, File) :- 346 source_file(File), 347 '$source_file_property'(File, reloading, true). 348property_source_file(load_count(Count), File) :- 349 source_file(File), 350 '$source_file_property'(File, load_count, Count). 351property_source_file(number_of_clauses(Count), File) :- 352 source_file(File), 353 '$source_file_property'(File, number_of_clauses, Count).
360canonical_source_file(Spec, File) :- 361 atom(Spec), 362 '$time_source_file'(Spec, _, _), 363 !, 364 File = Spec. 365canonical_source_file(Spec, File) :- 366 system:'$included'(_Master, _Line, Spec, _), 367 !, 368 File = Spec. 369canonical_source_file(Spec, File) :- 370 absolute_file_name(Spec, File, 371 [ file_type(prolog), 372 access(read), 373 file_errors(fail) 374 ]), 375 source_file(File).
:- if(exists_source(library(error))). :- use_module_library(error). :- endif.
392exists_source(Source) :- 393 exists_source(Source, _Path). 394 395exists_source(Source, Path) :- 396 absolute_file_name(Source, Path, 397 [ file_type(prolog), 398 access(read), 399 file_errors(fail) 400 ]).
409prolog_load_context(module, Module) :- 410 '$current_source_module'(Module). 411prolog_load_context(file, File) :- 412 input_file(File). 413prolog_load_context(source, F) :- % SICStus compatibility 414 input_file(F0), 415 '$input_context'(Context), 416 '$top_file'(Context, F0, F). 417prolog_load_context(stream, S) :- 418 ( system:'$load_input'(_, S0) 419 -> S = S0 420 ). 421prolog_load_context(directory, D) :- 422 input_file(F), 423 file_directory_name(F, D). 424prolog_load_context(dialect, D) :- 425 current_prolog_flag(emulated_dialect, D). 426prolog_load_context(term_position, TermPos) :- 427 source_location(_, L), 428 ( nb_current('$term_position', Pos), 429 compound(Pos), % actually set 430 stream_position_data(line_count, Pos, L) 431 -> TermPos = Pos 432 ; TermPos = '$stream_position'(0,L,0,0) 433 ). 434prolog_load_context(script, Bool) :- 435 ( '$toplevel':loaded_init_file(script, Path), 436 input_file(File), 437 same_file(File, Path) 438 -> Bool = true 439 ; Bool = false 440 ). 441prolog_load_context(variable_names, Bindings) :- 442 ( nb_current('$variable_names', Bindings0) 443 -> Bindings = Bindings0 444 ; Bindings = [] 445 ). 446prolog_load_context(term, Term) :- 447 nb_current('$term', Term). 448prolog_load_context(reloading, true) :- 449 prolog_load_context(source, F), 450 '$source_file_property'(F, reloading, true). 451 452input_file(File) :- 453 ( system:'$load_input'(_, Stream) 454 -> stream_property(Stream, file_name(File)) 455 ), 456 !. 457input_file(File) :- 458 source_location(File, _).
465:- dynamic system:'$resolved_source_path'/2. 466 467unload_file(File) :- 468 ( canonical_source_file(File, Path) 469 -> '$unload_file'(Path), 470 retractall(system:'$resolved_source_path'(_, Path)) 471 ; true 472 ). 473 474:- if(current_prolog_flag(open_shared_object, true)). 475 476 /******************************* 477 * FOREIGN LIBRARIES * 478 *******************************/
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.
497:- meta_predicate 498 use_foreign_library(), 499 use_foreign_library(, ). 500:- public 501 use_foreign_library_noi/1. 502 503use_foreign_library(FileSpec) :- 504 ensure_shlib, 505 initialization(use_foreign_library_noi(FileSpec), now). 506 507% noi -> no initialize; used by '$autoload':exports/3. 508use_foreign_library_noi(FileSpec) :- 509 ensure_shlib, 510 shlib:load_foreign_library(FileSpec). 511 512use_foreign_library(FileSpec, Options) :- 513 ensure_shlib, 514 initialization(shlib:load_foreign_library(FileSpec, Options), now). 515 516ensure_shlib :- 517 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 518 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 519 !. 520ensure_shlib :- 521 use_module(library(shlib), []). 522 523:- export(use_foreign_library/1). 524:- export(use_foreign_library/2). 525 526:- elif(current_predicate('$activate_static_extension'/1)). 527 528% Version when using shared objects is disabled and extensions are added 529% as static libraries. 530 531:- meta_predicate 532 use_foreign_library(). 533:- public 534 use_foreign_library_noi/1. 535:- dynamic 536 loading/1, 537 foreign_predicate/2. 538 539use_foreign_library(FileSpec) :- 540 initialization(use_foreign_library_noi(FileSpec), now). 541 542use_foreign_library_noi(Module:foreign(Extension)) :- 543 setup_call_cleanup( 544 asserta(loading(foreign(Extension)), Ref), 545 @('$activate_static_extension'(Extension), Module), 546 erase(Ref)). 547 548:- export(use_foreign_library/1). 549 550system:'$foreign_registered'(M, H) :- 551 ( loading(Lib) 552 -> true 553 ; Lib = '<spontaneous>' 554 ), 555 assert(foreign_predicate(Lib, M:H)).
561current_foreign_library(File, Public) :- 562 setof(Pred, foreign_predicate(File, Pred), Public). 563 564:- export(current_foreign_library/2). 565 566:- endif. /* open_shared_object support */ 567 568 /******************************* 569 * STREAMS * 570 *******************************/
577stream_position_data(Prop, Term, Value) :- 578 nonvar(Prop), 579 !, 580 ( stream_position_field(Prop, Pos) 581 -> arg(Pos, Term, Value) 582 ; throw(error(domain_error(stream_position_data, Prop))) 583 ). 584stream_position_data(Prop, Term, Value) :- 585 stream_position_field(Prop, Pos), 586 arg(Pos, Term, Value). 587 588stream_position_field(char_count, 1). 589stream_position_field(line_count, 2). 590stream_position_field(line_position, 3). 591stream_position_field(byte_count, 4). 592 593 594 /******************************* 595 * CONTROL * 596 *******************************/
604:- meta_predicate 605 call_with_depth_limit(, , ). 606 607call_with_depth_limit(G, Limit, Result) :- 608 '$depth_limit'(Limit, OLimit, OReached), 609 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 610 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 611 ( Det == ! -> ! ; true ) 612 ; '$depth_limit_false'(OLimit, OReached, Result) 613 ).
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.
626:- meta_predicate 627 call_with_inference_limit(, , ). 628 629call_with_inference_limit(G, Limit, Result) :- 630 '$inference_limit'(Limit, OLimit), 631 ( catch(G, Except, 632 system:'$inference_limit_except'(OLimit, Except, Result0)), 633 ( Result0 == inference_limit_exceeded 634 -> ! 635 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 636 ( Result0 == ! -> ! ; true ) 637 ), 638 Result = Result0 639 ; system:'$inference_limit_false'(OLimit) 640 ). 641 642 643 /******************************** 644 * DATA BASE * 645 *********************************/ 646 647/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 648The predicate current_predicate/2 is a difficult subject since the 649introduction of defaulting modules and dynamic libraries. 650current_predicate/2 is normally called with instantiated arguments to 651verify some predicate can be called without trapping an undefined 652predicate. In this case we must perform the search algorithm used by 653the prolog system itself. 654 655If the pattern is not fully specified, we only generate the predicates 656actually available in this module. This seems the best for listing, 657etc. 658- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 659 660 661:- meta_predicate 662 current_predicate(, ), 663 '$defined_predicate'(). 664 665current_predicate(Name, Module:Head) :- 666 (var(Module) ; var(Head)), 667 !, 668 generate_current_predicate(Name, Module, Head). 669current_predicate(Name, Term) :- 670 '$c_current_predicate'(Name, Term), 671 '$defined_predicate'(Term), 672 !. 673current_predicate(Name, Module:Head) :- 674 default_module(Module, DefModule), 675 '$c_current_predicate'(Name, DefModule:Head), 676 '$defined_predicate'(DefModule:Head), 677 !. 678current_predicate(Name, Module:Head) :- 679 '$autoload':autoload_in(Module, general), 680 \+ current_prolog_flag(Moduleunknown, fail), 681 ( compound(Head) 682 -> compound_name_arity(Head, Name, Arity) 683 ; Name = Head, Arity = 0 684 ), 685 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 686 !. 687 688generate_current_predicate(Name, Module, Head) :- 689 current_module(Module), 690 QHead = Module:Head, 691 '$c_current_predicate'(Name, QHead), 692 '$get_predicate_attribute'(QHead, defined, 1). 693 694'$defined_predicate'(Head) :- 695 '$get_predicate_attribute'(Head, defined, 1), 696 !.
702:- meta_predicate 703 predicate_property(, ). 704 705:- multifile 706 '$predicate_property'/2. 707 708:- '$iso'(predicate_property/2). 709 710predicate_property(Pred, Property) :- % Mode ?,+ 711 nonvar(Property), 712 !, 713 property_predicate(Property, Pred). 714predicate_property(Pred, Property) :- % Mode +,- 715 define_or_generate(Pred), 716 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.724property_predicate(undefined, Pred) :- 725 !, 726 Pred = Module:Head, 727 current_module(Module), 728 '$c_current_predicate'(_, Pred), 729 \+ '$defined_predicate'(Pred), % Speed up a bit 730 \+ current_predicate(_, Pred), 731 goal_name_arity(Head, Name, Arity), 732 \+ system_undefined(Module:Name/Arity). 733property_predicate(visible, Pred) :- 734 !, 735 visible_predicate(Pred). 736property_predicate(autoload(File), Head) :- 737 !, 738 \+ current_prolog_flag(autoload, false), 739 '$autoload':autoloadable(Head, File). 740property_predicate(implementation_module(IM), M:Head) :- 741 !, 742 atom(M), 743 ( default_module(M, DM), 744 '$get_predicate_attribute'(DM:Head, defined, 1) 745 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 746 -> IM = ImportM 747 ; IM = M 748 ) 749 ; \+ current_prolog_flag(Munknown, fail), 750 goal_name_arity(Head, Name, Arity), 751 '$find_library'(_, Name, Arity, LoadModule, _File) 752 -> IM = LoadModule 753 ; M = IM 754 ). 755property_predicate(iso, _:Head) :- 756 callable(Head), 757 !, 758 goal_name_arity(Head, Name, Arity), 759 current_predicate(system:Name/Arity), 760 '$predicate_property'(iso, system:Head). 761property_predicate(built_in, Module:Head) :- 762 callable(Head), 763 !, 764 goal_name_arity(Head, Name, Arity), 765 current_predicate(Module:Name/Arity), 766 '$predicate_property'(built_in, Module:Head). 767property_predicate(Property, Pred) :- 768 define_or_generate(Pred), 769 '$predicate_property'(Property, Pred). 770 771goal_name_arity(Head, Name, Arity) :- 772 compound(Head), 773 !, 774 compound_name_arity(Head, Name, Arity). 775goal_name_arity(Head, Head, 0).
784define_or_generate(M:Head) :- 785 callable(Head), 786 atom(M), 787 '$get_predicate_attribute'(M:Head, defined, 1), 788 !. 789define_or_generate(M:Head) :- 790 callable(Head), 791 nonvar(M), M \== system, 792 !, 793 '$define_predicate'(M:Head). 794define_or_generate(Pred) :- 795 current_predicate(_, Pred), 796 '$define_predicate'(Pred). 797 798 799'$predicate_property'(interpreted, Pred) :- 800 '$get_predicate_attribute'(Pred, foreign, 0). 801'$predicate_property'(visible, Pred) :- 802 '$get_predicate_attribute'(Pred, defined, 1). 803'$predicate_property'(built_in, Pred) :- 804 '$get_predicate_attribute'(Pred, system, 1). 805'$predicate_property'(exported, Pred) :- 806 '$get_predicate_attribute'(Pred, exported, 1). 807'$predicate_property'(public, Pred) :- 808 '$get_predicate_attribute'(Pred, public, 1). 809'$predicate_property'(non_terminal, Pred) :- 810 '$get_predicate_attribute'(Pred, non_terminal, 1). 811'$predicate_property'(foreign, Pred) :- 812 '$get_predicate_attribute'(Pred, foreign, 1). 813'$predicate_property'((dynamic), Pred) :- 814 '$get_predicate_attribute'(Pred, (dynamic), 1). 815'$predicate_property'((static), Pred) :- 816 '$get_predicate_attribute'(Pred, (dynamic), 0). 817'$predicate_property'((volatile), Pred) :- 818 '$get_predicate_attribute'(Pred, (volatile), 1). 819'$predicate_property'((thread_local), Pred) :- 820 '$get_predicate_attribute'(Pred, (thread_local), 1). 821'$predicate_property'((multifile), Pred) :- 822 '$get_predicate_attribute'(Pred, (multifile), 1). 823'$predicate_property'((discontiguous), Pred) :- 824 '$get_predicate_attribute'(Pred, (discontiguous), 1). 825'$predicate_property'(imported_from(Module), Pred) :- 826 '$get_predicate_attribute'(Pred, imported, Module). 827'$predicate_property'(transparent, Pred) :- 828 '$get_predicate_attribute'(Pred, transparent, 1). 829'$predicate_property'(meta_predicate(Pattern), Pred) :- 830 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 831'$predicate_property'(file(File), Pred) :- 832 '$get_predicate_attribute'(Pred, file, File). 833'$predicate_property'(line_count(LineNumber), Pred) :- 834 '$get_predicate_attribute'(Pred, line_count, LineNumber). 835'$predicate_property'(notrace, Pred) :- 836 '$get_predicate_attribute'(Pred, trace, 0). 837'$predicate_property'(nodebug, Pred) :- 838 '$get_predicate_attribute'(Pred, hide_childs, 1). 839'$predicate_property'(spying, Pred) :- 840 '$get_predicate_attribute'(Pred, spy, 1). 841'$predicate_property'(number_of_clauses(N), Pred) :- 842 '$get_predicate_attribute'(Pred, number_of_clauses, N). 843'$predicate_property'(number_of_rules(N), Pred) :- 844 '$get_predicate_attribute'(Pred, number_of_rules, N). 845'$predicate_property'(last_modified_generation(Gen), Pred) :- 846 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 847'$predicate_property'(indexed(Indices), Pred) :- 848 '$get_predicate_attribute'(Pred, indexed, Indices). 849'$predicate_property'(noprofile, Pred) :- 850 '$get_predicate_attribute'(Pred, noprofile, 1). 851'$predicate_property'(ssu, Pred) :- 852 '$get_predicate_attribute'(Pred, ssu, 1). 853'$predicate_property'(iso, Pred) :- 854 '$get_predicate_attribute'(Pred, iso, 1). 855'$predicate_property'(det, Pred) :- 856 '$get_predicate_attribute'(Pred, det, 1). 857'$predicate_property'(sig_atomic, Pred) :- 858 '$get_predicate_attribute'(Pred, sig_atomic, 1). 859'$predicate_property'(quasi_quotation_syntax, Pred) :- 860 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 861'$predicate_property'(defined, Pred) :- 862 '$get_predicate_attribute'(Pred, defined, 1). 863'$predicate_property'(tabled, Pred) :- 864 '$get_predicate_attribute'(Pred, tabled, 1). 865'$predicate_property'(tabled(Flag), Pred) :- 866 '$get_predicate_attribute'(Pred, tabled, 1), 867 table_flag(Flag, Pred). 868'$predicate_property'(incremental, Pred) :- 869 '$get_predicate_attribute'(Pred, incremental, 1). 870'$predicate_property'(monotonic, Pred) :- 871 '$get_predicate_attribute'(Pred, monotonic, 1). 872'$predicate_property'(opaque, Pred) :- 873 '$get_predicate_attribute'(Pred, opaque, 1). 874'$predicate_property'(lazy, Pred) :- 875 '$get_predicate_attribute'(Pred, lazy, 1). 876'$predicate_property'(abstract(N), Pred) :- 877 '$get_predicate_attribute'(Pred, abstract, N). 878'$predicate_property'(size(Bytes), Pred) :- 879 '$get_predicate_attribute'(Pred, size, Bytes). 880 881system_undefined(user:prolog_trace_interception/4). 882system_undefined(prolog:prolog_exception_hook/5). 883system_undefined(system:'$c_call_prolog'/0). 884system_undefined(system:window_title/2). 885 886table_flag(variant, Pred) :- 887 '$tbl_implementation'(Pred, M:Head), 888 M:'$tabled'(Head, variant). 889table_flag(subsumptive, Pred) :- 890 '$tbl_implementation'(Pred, M:Head), 891 M:'$tabled'(Head, subsumptive). 892table_flag(shared, Pred) :- 893 '$get_predicate_attribute'(Pred, tshared, 1). 894table_flag(incremental, Pred) :- 895 '$get_predicate_attribute'(Pred, incremental, 1). 896table_flag(monotonic, Pred) :- 897 '$get_predicate_attribute'(Pred, monotonic, 1). 898table_flag(subgoal_abstract(N), Pred) :- 899 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 900table_flag(answer_abstract(N), Pred) :- 901 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 902table_flag(subgoal_abstract(N), Pred) :- 903 '$get_predicate_attribute'(Pred, max_answers, N).
912visible_predicate(Pred) :- 913 Pred = M:Head, 914 current_module(M), 915 ( callable(Head) 916 -> ( '$get_predicate_attribute'(Pred, defined, 1) 917 -> true 918 ; \+ current_prolog_flag(Munknown, fail), 919 '$head_name_arity'(Head, Name, Arity), 920 '$find_library'(M, Name, Arity, _LoadModule, _Library) 921 ) 922 ; setof(PI, visible_in_module(M, PI), PIs), 923 '$member'(Name/Arity, PIs), 924 functor(Head, Name, Arity) 925 ). 926 927visible_in_module(M, Name/Arity) :- 928 default_module(M, DefM), 929 DefHead = DefM:Head, 930 '$c_current_predicate'(_, DefHead), 931 '$get_predicate_attribute'(DefHead, defined, 1), 932 \+ hidden_system_predicate(Head), 933 functor(Head, Name, Arity). 934visible_in_module(_, Name/Arity) :- 935 '$in_library'(Name, Arity, _). 936 (Head) :- 938 functor(Head, Name, _), 939 atom(Name), % Avoid []. 940 sub_atom(Name, 0, _, _, $), 941 \+ current_prolog_flag(access_level, system).
true.966clause_property(Clause, Property) :- 967 '$clause_property'(Property, Clause). 968 969'$clause_property'(line_count(LineNumber), Clause) :- 970 '$get_clause_attribute'(Clause, line_count, LineNumber). 971'$clause_property'(file(File), Clause) :- 972 '$get_clause_attribute'(Clause, file, File). 973'$clause_property'(source(File), Clause) :- 974 '$get_clause_attribute'(Clause, owner, File). 975'$clause_property'(size(Bytes), Clause) :- 976 '$get_clause_attribute'(Clause, size, Bytes). 977'$clause_property'(fact, Clause) :- 978 '$get_clause_attribute'(Clause, fact, true). 979'$clause_property'(erased, Clause) :- 980 '$get_clause_attribute'(Clause, erased, true). 981'$clause_property'(predicate(PI), Clause) :- 982 '$get_clause_attribute'(Clause, predicate_indicator, PI). 983'$clause_property'(module(M), Clause) :- 984 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)998dynamic(M:Predicates, Options) :- 999 '$must_be'(list, Predicates), 1000 options_properties(Options, Props), 1001 set_pprops(Predicates, M, [dynamic|Props]). 1002 1003set_pprops([], _, _). 1004set_pprops([H|T], M, Props) :- 1005 set_pprops1(Props, M:H), 1006 strip_module(M:H, M2, P), 1007 '$pi_head'(M2:P, Pred), 1008 '$set_table_wrappers'(Pred), 1009 set_pprops(T, M, Props). 1010 1011set_pprops1([], _). 1012set_pprops1([H|T], P) :- 1013 ( atom(H) 1014 -> '$set_predicate_attribute'(P, H, true) 1015 ; H =.. [Name,Value] 1016 -> '$set_predicate_attribute'(P, Name, Value) 1017 ), 1018 set_pprops1(T, P). 1019 1020options_properties(Options, Props) :- 1021 G = opt_prop(_,_,_,_), 1022 findall(G, G, Spec), 1023 options_properties(Spec, Options, Props). 1024 1025options_properties([], _, []). 1026options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1027 Options, [Prop|PT]) :- 1028 Opt =.. [Name,V], 1029 '$option'(Opt, Options), 1030 '$must_be'(Type, V), 1031 V = SetValue, 1032 !, 1033 options_properties(T, Options, PT). 1034options_properties([_|T], Options, PT) :- 1035 options_properties(T, Options, PT). 1036 1037opt_prop(incremental, boolean, Bool, incremental(Bool)). 1038opt_prop(abstract, between(0,0), 0, abstract). 1039opt_prop(multifile, boolean, true, multifile). 1040opt_prop(discontiguous, boolean, true, discontiguous). 1041opt_prop(volatile, boolean, true, volatile). 1042opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1043 local, thread_local). 1044 1045 /******************************** 1046 * MODULES * 1047 *********************************/
1053current_module(Module) :-
1054 '$current_module'(Module, _).1070module_property(Module, Property) :- 1071 nonvar(Module), nonvar(Property), 1072 !, 1073 property_module(Property, Module). 1074module_property(Module, Property) :- % -, file(File) 1075 nonvar(Property), Property = file(File), 1076 !, 1077 ( nonvar(File) 1078 -> '$current_module'(Modules, File), 1079 ( atom(Modules) 1080 -> Module = Modules 1081 ; '$member'(Module, Modules) 1082 ) 1083 ; '$current_module'(Module, File), 1084 File \== [] 1085 ). 1086module_property(Module, Property) :- 1087 current_module(Module), 1088 property_module(Property, Module). 1089 1090property_module(Property, Module) :- 1091 module_property(Property), 1092 ( Property = exported_operators(List) 1093 -> '$exported_ops'(Module, List, []) 1094 ; '$module_property'(Module, Property) 1095 ). 1096 1097module_property(class(_)). 1098module_property(file(_)). 1099module_property(line_count(_)). 1100module_property(exports(_)). 1101module_property(exported_operators(_)). 1102module_property(size(_)). 1103module_property(program_size(_)). 1104module_property(program_space(_)). 1105module_property(last_modified_generation(_)).
1111module(Module) :- 1112 atom(Module), 1113 current_module(Module), 1114 !, 1115 '$set_typein_module'(Module). 1116module(Module) :- 1117 '$set_typein_module'(Module), 1118 print_message(warning, no_current_module(Module)).
1125working_directory(Old, New) :- 1126 '$cwd'(Old), 1127 ( Old == New 1128 -> true 1129 ; '$chdir'(New) 1130 ). 1131 1132 1133 /******************************* 1134 * TRIES * 1135 *******************************/
1141current_trie(Trie) :-
1142 current_blob(Trie, trie),
1143 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1179trie_property(Trie, Property) :- 1180 current_trie(Trie), 1181 trie_property(Property), 1182 '$trie_property'(Trie, Property). 1183 1184trie_property(node_count(_)). 1185trie_property(value_count(_)). 1186trie_property(size(_)). 1187trie_property(hashed(_)). 1188trie_property(compiled_size(_)). 1189 % below only when -DO_TRIE_STATS 1190trie_property(lookup_count(_)). % is enabled in pl-trie.h 1191trie_property(gen_call_count(_)). 1192trie_property(invalidated(_)). % IDG stats 1193trie_property(reevaluated(_)). 1194trie_property(deadlock(_)). % Shared tabling stats 1195trie_property(wait(_)). 1196trie_property(idg_affected_count(_)). 1197trie_property(idg_dependent_count(_)). 1198trie_property(idg_size(_)). 1199 1200 1201 /******************************** 1202 * SYSTEM INTERACTION * 1203 *********************************/ 1204 1205shell(Command) :- 1206 shell(Command, 0). 1207 1208 1209 /******************************* 1210 * SIGNALS * 1211 *******************************/ 1212 1213:- meta_predicate 1214 on_signal(, , ), 1215 current_signal(, , ).
1219on_signal(Signal, Old, New) :- 1220 atom(Signal), 1221 !, 1222 '$on_signal'(_Num, Signal, Old, New). 1223on_signal(Signal, Old, New) :- 1224 integer(Signal), 1225 !, 1226 '$on_signal'(Signal, _Name, Old, New). 1227on_signal(Signal, _Old, _New) :- 1228 '$type_error'(signal_name, Signal).
1232current_signal(Name, Id, Handler) :- 1233 between(1, 32, Id), 1234 '$on_signal'(Id, Name, Handler, Handler). 1235 1236:- multifile 1237 prolog:called_by/2. 1238 1239prologcalled_by(on_signal(_,_,New), [New+1]) :- 1240 ( new == throw 1241 ; new == default 1242 ), !, fail. 1243 1244 1245 /******************************* 1246 * I/O * 1247 *******************************/ 1248 1249format(Fmt) :- 1250 format(Fmt, []). 1251 1252 /******************************* 1253 * FILES * 1254 *******************************/
1258absolute_file_name(Name, Abs) :- 1259 atomic(Name), 1260 !, 1261 '$absolute_file_name'(Name, Abs). 1262absolute_file_name(Term, Abs) :- 1263 '$chk_file'(Term, [''], [access(read)], true, File), 1264 !, 1265 '$absolute_file_name'(File, Abs). 1266absolute_file_name(Term, Abs) :- 1267 '$chk_file'(Term, [''], [], true, File), 1268 !, 1269 '$absolute_file_name'(File, Abs).
1277tmp_file_stream(Enc, File, Stream) :- 1278 atom(Enc), var(File), var(Stream), 1279 !, 1280 '$tmp_file_stream'('', Enc, File, Stream). 1281tmp_file_stream(File, Stream, Options) :- 1282 current_prolog_flag(encoding, DefEnc), 1283 '$option'(encoding(Enc), Options, DefEnc), 1284 '$option'(extension(Ext), Options, ''), 1285 '$tmp_file_stream'(Ext, Enc, File, Stream), 1286 set_stream(Stream, file_name(File)). 1287 1288 1289 /******************************** 1290 * MEMORY MANAGEMENT * 1291 *********************************/
1300garbage_collect :-
1301 '$garbage_collect'(0).
1307set_prolog_stack(Stack, Option) :-
1308 Option =.. [Name,Value0],
1309 Value is Value0,
1310 '$set_prolog_stack'(Stack, Name, _Old, Value).1316prolog_stack_property(Stack, Property) :- 1317 stack_property(P), 1318 stack_name(Stack), 1319 Property =.. [P,Value], 1320 '$set_prolog_stack'(Stack, P, Value, Value). 1321 1322stack_name(local). 1323stack_name(global). 1324stack_name(trail). 1325 1326stack_property(limit). 1327stack_property(spare). 1328stack_property(min_free). 1329stack_property(low). 1330stack_property(factor). 1331 1332 1333 /******************************* 1334 * CLAUSE * 1335 *******************************/
:-
as neck.1343rule(Head, Rule) :- 1344 '$rule'(Head, Rule0), 1345 conditional_rule(Rule0, Rule1), 1346 Rule = Rule1. 1347rule(Head, Rule, Ref) :- 1348 '$rule'(Head, Rule0, Ref), 1349 conditional_rule(Rule0, Rule1), 1350 Rule = Rule1. 1351 1352conditional_rule(?=>(Head, (!, Body)), Rule) => 1353 Rule = (Head => Body). 1354conditional_rule(?=>(Head, !), Rule) => 1355 Rule = (Head => true). 1356conditional_rule(?=>(Head, Body0), Rule), 1357 split_on_cut(Body0, Cond, Body) => 1358 Rule = (Head,Cond=>Body). 1359conditional_rule(Head, Rule) => 1360 Rule = Head. 1361 1362split_on_cut((Cond0,!,Body0), Cond, Body) => 1363 Cond = Cond0, 1364 Body = Body0. 1365split_on_cut((!,Body0), Cond, Body) => 1366 Cond = true, 1367 Body = Body0. 1368split_on_cut((A,B), Cond, Body) => 1369 Cond = (A,Cond1), 1370 split_on_cut(B, Cond1, Body). 1371split_on_cut(_, _, _) => 1372 fail. 1373 1374 1375 /******************************* 1376 * TERM * 1377 *******************************/ 1378 1379:- '$iso'((numbervars/3)).
1387numbervars(Term, From, To) :- 1388 numbervars(Term, From, To, []). 1389 1390 1391 /******************************* 1392 * STRING * 1393 *******************************/
1399term_string(Term, String, Options) :- 1400 nonvar(String), 1401 !, 1402 read_term_from_atom(String, Term, Options). 1403term_string(Term, String, Options) :- 1404 ( '$option'(quoted(_), Options) 1405 -> Options1 = Options 1406 ; '$merge_options'(_{quoted:true}, Options, Options1) 1407 ), 1408 format(string(String), '~W', [Term, Options1]). 1409 1410 1411 /******************************* 1412 * GVAR * 1413 *******************************/
1419nb_setval(Name, Value) :- 1420 duplicate_term(Value, Copy), 1421 nb_linkval(Name, Copy). 1422 1423 1424 /******************************* 1425 * THREADS * 1426 *******************************/ 1427 1428:- meta_predicate 1429 thread_create(, ).
thread_create(Goal, Id, []).
1435thread_create(Goal, Id) :-
1436 thread_create(Goal, Id, []).
1445thread_join(Id) :-
1446 thread_join(Id, Status),
1447 ( Status == true
1448 -> true
1449 ; throw(error(thread_error(Id, Status), _))
1450 ).1460sig_block(Pattern) :- 1461 ( nb_current('$sig_blocked', List) 1462 -> true 1463 ; List = [] 1464 ), 1465 nb_setval('$sig_blocked', [Pattern|List]). 1466 1467sig_unblock(Pattern) :- 1468 ( nb_current('$sig_blocked', List) 1469 -> unblock(List, Pattern, NewList), 1470 ( List == NewList 1471 -> true 1472 ; nb_setval('$sig_blocked', NewList), 1473 '$sig_unblock' 1474 ) 1475 ; true 1476 ). 1477 1478unblock([], _, []). 1479unblock([H|T], P, List) :- 1480 ( subsumes_term(P, H) 1481 -> unblock(T, P, List) 1482 ; List = [H|T1], 1483 unblock(T, P, T1) 1484 ). 1485 1486:- public signal_is_blocked/1. % called by signal_is_blocked() 1487 1488signal_is_blocked(Head) :- 1489 nb_current('$sig_blocked', List), 1490 '$member'(Head, List), 1491 !.
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.1508set_prolog_gc_thread(Status) :- 1509 var(Status), 1510 !, 1511 '$instantiation_error'(Status). 1512set_prolog_gc_thread(_) :- 1513 \+ current_prolog_flag(threads, true), 1514 !. 1515set_prolog_gc_thread(false) :- 1516 !, 1517 set_prolog_flag(gc_thread, false), 1518 ( current_prolog_flag(threads, true) 1519 -> ( '$gc_stop' 1520 -> thread_join(gc) 1521 ; true 1522 ) 1523 ; true 1524 ). 1525set_prolog_gc_thread(true) :- 1526 !, 1527 set_prolog_flag(gc_thread, true). 1528set_prolog_gc_thread(stop) :- 1529 !, 1530 ( current_prolog_flag(threads, true) 1531 -> ( '$gc_stop' 1532 -> thread_join(gc) 1533 ; true 1534 ) 1535 ; true 1536 ). 1537set_prolog_gc_thread(Status) :- 1538 '$domain_error'(gc_thread, Status).
1547transaction(Goal) :- 1548 '$transaction'(Goal, []). 1549transaction(Goal, Options) :- 1550 '$transaction'(Goal, Options). 1551transaction(Goal, Constraint, Mutex) :- 1552 '$transaction'(Goal, Constraint, Mutex). 1553snapshot(Goal) :- 1554 '$snapshot'(Goal). 1555 1556 1557 /******************************* 1558 * UNDO * 1559 *******************************/ 1560 1561:- meta_predicate 1562 undo().
1569undo(Goal) :- 1570 '$undo'(Goal). 1571 1572:- public 1573 '$run_undo'/1. 1574 1575'$run_undo'([One]) :- 1576 !, 1577 ( call(One) 1578 -> true 1579 ; true 1580 ). 1581'$run_undo'(List) :- 1582 run_undo(List, _, Error), 1583 ( var(Error) 1584 -> true 1585 ; throw(Error) 1586 ). 1587 1588run_undo([], E, E). 1589run_undo([H|T], E0, E) :- 1590 ( catch(H, E1, true) 1591 -> ( var(E1) 1592 -> true 1593 ; '$urgent_exception'(E0, E1, E2) 1594 ) 1595 ; true 1596 ), 1597 run_undo(T, E2, E).
1605:- meta_predicate 1606 '$wrap_predicate'(, , , , ). 1607 1608'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1609 callable_name_arguments(Head, PName, Args), 1610 callable_name_arity(Head, PName, Arity), 1611 ( is_most_general_term(Head) 1612 -> true 1613 ; '$domain_error'(most_general_term, Head) 1614 ), 1615 atomic_list_concat(['$wrap$', PName], WrapName), 1616 PI = M:WrapName/Arity, 1617 dynamic(PI), 1618 '$notransact'(PI), 1619 volatile(PI), 1620 module_transparent(PI), 1621 WHead =.. [WrapName|Args], 1622 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)). 1623 1624callable_name_arguments(Head, PName, Args) :- 1625 atom(Head), 1626 !, 1627 PName = Head, 1628 Args = []. 1629callable_name_arguments(Head, PName, Args) :- 1630 compound_name_arguments(Head, PName, Args). 1631 1632callable_name_arity(Head, PName, Arity) :- 1633 atom(Head), 1634 !, 1635 PName = Head, 1636 Arity = 0. 1637callable_name_arity(Head, PName, Arity) :- 1638 compound_name_arity(Head, PName, Arity)