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