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 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 332 '$time_source_file'(File, _, user), 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(source), 371 solutions(all), 372 file_errors(fail) 373 ]), 374 source_file(File), 375 !.
:- 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, _).
470:- dynamic system:'$resolved_source_path'/2. 471 472unload_file(File) :- 473 ( canonical_source_file(File, Path) 474 -> unload_file_(Path), 475 '$clear_source_admin'(Path), 476 garbage_collect_clauses 477 ; true 478 ). 479 480:- if(current_prolog_flag(open_shared_object, true)). 481unload_file_(Path) :- 482 source_file_property(Path, module(M)), 483 ensure_shlib, 484 !, 485 forall(shlib:foreign_library_property(Foreign, module(M)), 486 shlib:unload_foreign_library(Foreign)), 487 '$unload_file'(Path). 488:- endif. 489unload_file_(Path) :- 490 '$unload_file'(Path). 491 492:- if(current_prolog_flag(open_shared_object, true)). 493 494 /******************************* 495 * FOREIGN LIBRARIES * 496 *******************************/
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.
515:- meta_predicate 516 use_foreign_library(), 517 use_foreign_library(, ). 518:- public 519 use_foreign_library_noi/1. 520 521use_foreign_library(FileSpec) :- 522 ensure_shlib, 523 initialization(use_foreign_library_noi(FileSpec), now). 524 525% noi -> no initialize; used by '$autoload':exports/3. 526use_foreign_library_noi(FileSpec) :- 527 ensure_shlib, 528 shlib:load_foreign_library(FileSpec). 529 530use_foreign_library(FileSpec, Options) :- 531 ensure_shlib, 532 initialization(shlib:load_foreign_library(FileSpec, Options), now). 533 534ensure_shlib :- 535 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 536 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 537 !. 538ensure_shlib :- 539 use_module(library(shlib), []). 540 541:- export(use_foreign_library/1). 542:- export(use_foreign_library/2). 543 544:- elif(current_predicate('$activate_static_extension'/1)). 545 546% Version when using shared objects is disabled and extensions are added 547% as static libraries. 548 549:- meta_predicate 550 use_foreign_library(). 551:- public 552 use_foreign_library_noi/1. 553:- dynamic 554 loading/1, 555 foreign_predicate/2. 556 557use_foreign_library(FileSpec) :- 558 initialization(use_foreign_library_noi(FileSpec), now). 559 560use_foreign_library_noi(Module:foreign(Extension)) :- 561 setup_call_cleanup( 562 asserta(loading(foreign(Extension)), Ref), 563 @('$activate_static_extension'(Extension), Module), 564 erase(Ref)). 565 566:- export(use_foreign_library/1). 567 568system:'$foreign_registered'(M, H) :- 569 ( loading(Lib) 570 -> true 571 ; Lib = '<spontaneous>' 572 ), 573 assert(foreign_predicate(Lib, M:H)).
579current_foreign_library(File, Public) :- 580 setof(Pred, foreign_predicate(File, Pred), Public). 581 582:- export(current_foreign_library/2). 583 584:- endif. /* open_shared_object support */ 585 586 /******************************* 587 * STREAMS * 588 *******************************/
595stream_position_data(Prop, Term, Value) :- 596 nonvar(Prop), 597 !, 598 ( stream_position_field(Prop, Pos) 599 -> arg(Pos, Term, Value) 600 ; throw(error(domain_error(stream_position_data, Prop))) 601 ). 602stream_position_data(Prop, Term, Value) :- 603 stream_position_field(Prop, Pos), 604 arg(Pos, Term, Value). 605 606stream_position_field(char_count, 1). 607stream_position_field(line_count, 2). 608stream_position_field(line_position, 3). 609stream_position_field(byte_count, 4). 610 611 612 /******************************* 613 * CONTROL * 614 *******************************/
622:- meta_predicate 623 call_with_depth_limit(, , ). 624 625call_with_depth_limit(G, Limit, Result) :- 626 '$depth_limit'(Limit, OLimit, OReached), 627 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 628 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 629 ( Det == ! -> ! ; true ) 630 ; '$depth_limit_false'(OLimit, OReached, Result) 631 ).
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.
644:- meta_predicate 645 call_with_inference_limit(, , ). 646 647call_with_inference_limit(G, Limit, Result) :- 648 '$inference_limit'(Limit, OLimit), 649 ( catch(G, Except, 650 system:'$inference_limit_except'(OLimit, Except, Result0)), 651 ( Result0 == inference_limit_exceeded 652 -> ! 653 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 654 ( Result0 == ! -> ! ; true ) 655 ), 656 Result = Result0 657 ; system:'$inference_limit_false'(OLimit) 658 ). 659 660 661 /******************************** 662 * DATA BASE * 663 *********************************/ 664 665/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 666The predicate current_predicate/2 is a difficult subject since the 667introduction of defaulting modules and dynamic libraries. 668current_predicate/2 is normally called with instantiated arguments to 669verify some predicate can be called without trapping an undefined 670predicate. In this case we must perform the search algorithm used by 671the prolog system itself. 672 673If the pattern is not fully specified, we only generate the predicates 674actually available in this module. This seems the best for listing, 675etc. 676- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 677 678 679:- meta_predicate 680 current_predicate(, ), 681 '$defined_predicate'(). 682 683current_predicate(Name, Module:Head) :- 684 (var(Module) ; var(Head)), 685 !, 686 generate_current_predicate(Name, Module, Head). 687current_predicate(Name, Term) :- 688 '$c_current_predicate'(Name, Term), 689 '$defined_predicate'(Term), 690 !. 691current_predicate(Name, Module:Head) :- 692 default_module(Module, DefModule), 693 '$c_current_predicate'(Name, DefModule:Head), 694 '$defined_predicate'(DefModule:Head), 695 !. 696current_predicate(Name, Module:Head) :- 697 '$autoload':autoload_in(Module, general), 698 \+ current_prolog_flag(Moduleunknown, fail), 699 ( compound(Head) 700 -> compound_name_arity(Head, Name, Arity) 701 ; Name = Head, Arity = 0 702 ), 703 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 704 !. 705 706generate_current_predicate(Name, Module, Head) :- 707 current_module(Module), 708 QHead = Module:Head, 709 '$c_current_predicate'(Name, QHead), 710 '$get_predicate_attribute'(QHead, defined, 1). 711 712'$defined_predicate'(Head) :- 713 '$get_predicate_attribute'(Head, defined, 1), 714 !.
720:- meta_predicate 721 predicate_property(, ). 722 723:- multifile 724 '$predicate_property'/2. 725 726:- '$iso'(predicate_property/2). 727 728predicate_property(Pred, Property) :- % Mode ?,+ 729 nonvar(Property), 730 !, 731 property_predicate(Property, Pred). 732predicate_property(Pred, Property) :- % Mode +,- 733 define_or_generate(Pred), 734 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.742property_predicate(undefined, Pred) :- 743 !, 744 Pred = Module:Head, 745 current_module(Module), 746 '$c_current_predicate'(_, Pred), 747 \+ '$defined_predicate'(Pred), % Speed up a bit 748 \+ current_predicate(_, Pred), 749 goal_name_arity(Head, Name, Arity), 750 \+ system_undefined(Module:Name/Arity). 751property_predicate(visible, Pred) :- 752 !, 753 visible_predicate(Pred). 754property_predicate(autoload(File), Head) :- 755 !, 756 \+ current_prolog_flag(autoload, false), 757 '$autoload':autoloadable(Head, File). 758property_predicate(implementation_module(IM), M:Head) :- 759 !, 760 atom(M), 761 ( default_module(M, DM), 762 '$get_predicate_attribute'(DM:Head, defined, 1) 763 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 764 -> IM = ImportM 765 ; IM = M 766 ) 767 ; \+ current_prolog_flag(Munknown, fail), 768 goal_name_arity(Head, Name, Arity), 769 '$find_library'(_, Name, Arity, LoadModule, _File) 770 -> IM = LoadModule 771 ; M = IM 772 ). 773property_predicate(iso, _:Head) :- 774 callable(Head), 775 !, 776 goal_name_arity(Head, Name, Arity), 777 current_predicate(system:Name/Arity), 778 '$predicate_property'(iso, system:Head). 779property_predicate(built_in, Module:Head) :- 780 callable(Head), 781 !, 782 goal_name_arity(Head, Name, Arity), 783 current_predicate(Module:Name/Arity), 784 '$predicate_property'(built_in, Module:Head). 785property_predicate(Property, Pred) :- 786 define_or_generate(Pred), 787 '$predicate_property'(Property, Pred). 788 789goal_name_arity(Head, Name, Arity) :- 790 compound(Head), 791 !, 792 compound_name_arity(Head, Name, Arity). 793goal_name_arity(Head, Head, 0).
802define_or_generate(M:Head) :- 803 callable(Head), 804 atom(M), 805 '$get_predicate_attribute'(M:Head, defined, 1), 806 !. 807define_or_generate(M:Head) :- 808 callable(Head), 809 nonvar(M), M \== system, 810 !, 811 '$define_predicate'(M:Head). 812define_or_generate(Pred) :- 813 current_predicate(_, Pred), 814 '$define_predicate'(Pred). 815 816 817'$predicate_property'(interpreted, Pred) :- 818 '$get_predicate_attribute'(Pred, foreign, 0). 819'$predicate_property'(visible, Pred) :- 820 '$get_predicate_attribute'(Pred, defined, 1). 821'$predicate_property'(built_in, Pred) :- 822 '$get_predicate_attribute'(Pred, system, 1). 823'$predicate_property'(exported, Pred) :- 824 '$get_predicate_attribute'(Pred, exported, 1). 825'$predicate_property'(public, Pred) :- 826 '$get_predicate_attribute'(Pred, public, 1). 827'$predicate_property'(non_terminal, Pred) :- 828 '$get_predicate_attribute'(Pred, non_terminal, 1). 829'$predicate_property'(foreign, Pred) :- 830 '$get_predicate_attribute'(Pred, foreign, 1). 831'$predicate_property'((dynamic), Pred) :- 832 '$get_predicate_attribute'(Pred, (dynamic), 1). 833'$predicate_property'((static), Pred) :- 834 '$get_predicate_attribute'(Pred, (dynamic), 0). 835'$predicate_property'((volatile), Pred) :- 836 '$get_predicate_attribute'(Pred, (volatile), 1). 837'$predicate_property'((thread_local), Pred) :- 838 '$get_predicate_attribute'(Pred, (thread_local), 1). 839'$predicate_property'((multifile), Pred) :- 840 '$get_predicate_attribute'(Pred, (multifile), 1). 841'$predicate_property'((discontiguous), Pred) :- 842 '$get_predicate_attribute'(Pred, (discontiguous), 1). 843'$predicate_property'(imported_from(Module), Pred) :- 844 '$get_predicate_attribute'(Pred, imported, Module). 845'$predicate_property'(transparent, Pred) :- 846 '$get_predicate_attribute'(Pred, transparent, 1). 847'$predicate_property'(meta_predicate(Pattern), Pred) :- 848 '$get_predicate_attribute'(Pred, transparent, 1), 849 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 850'$predicate_property'(mode(Pattern), Pred) :- 851 '$get_predicate_attribute'(Pred, transparent, 0), 852 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 853'$predicate_property'(file(File), Pred) :- 854 '$get_predicate_attribute'(Pred, file, File). 855'$predicate_property'(line_count(LineNumber), Pred) :- 856 '$get_predicate_attribute'(Pred, line_count, LineNumber). 857'$predicate_property'(notrace, Pred) :- 858 '$get_predicate_attribute'(Pred, trace, 0). 859'$predicate_property'(nodebug, Pred) :- 860 '$get_predicate_attribute'(Pred, hide_childs, 1). 861'$predicate_property'(spying, Pred) :- 862 '$get_predicate_attribute'(Pred, spy, 1). 863'$predicate_property'(number_of_clauses(N), Pred) :- 864 '$get_predicate_attribute'(Pred, number_of_clauses, N). 865'$predicate_property'(number_of_rules(N), Pred) :- 866 '$get_predicate_attribute'(Pred, number_of_rules, N). 867'$predicate_property'(last_modified_generation(Gen), Pred) :- 868 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 869'$predicate_property'(indexed(Indices), Pred) :- 870 '$get_predicate_attribute'(Pred, indexed, Indices). 871'$predicate_property'(noprofile, Pred) :- 872 '$get_predicate_attribute'(Pred, noprofile, 1). 873'$predicate_property'(ssu, Pred) :- 874 '$get_predicate_attribute'(Pred, ssu, 1). 875'$predicate_property'(iso, Pred) :- 876 '$get_predicate_attribute'(Pred, iso, 1). 877'$predicate_property'(det, Pred) :- 878 '$get_predicate_attribute'(Pred, det, 1). 879'$predicate_property'(sig_atomic, Pred) :- 880 '$get_predicate_attribute'(Pred, sig_atomic, 1). 881'$predicate_property'(quasi_quotation_syntax, Pred) :- 882 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 883'$predicate_property'(defined, Pred) :- 884 '$get_predicate_attribute'(Pred, defined, 1). 885'$predicate_property'(tabled, Pred) :- 886 '$get_predicate_attribute'(Pred, tabled, 1). 887'$predicate_property'(tabled(Flag), Pred) :- 888 '$get_predicate_attribute'(Pred, tabled, 1), 889 table_flag(Flag, Pred). 890'$predicate_property'(incremental, Pred) :- 891 '$get_predicate_attribute'(Pred, incremental, 1). 892'$predicate_property'(monotonic, Pred) :- 893 '$get_predicate_attribute'(Pred, monotonic, 1). 894'$predicate_property'(opaque, Pred) :- 895 '$get_predicate_attribute'(Pred, opaque, 1). 896'$predicate_property'(lazy, Pred) :- 897 '$get_predicate_attribute'(Pred, lazy, 1). 898'$predicate_property'(abstract(N), Pred) :- 899 '$get_predicate_attribute'(Pred, abstract, N). 900'$predicate_property'(size(Bytes), Pred) :- 901 '$get_predicate_attribute'(Pred, size, Bytes). 902'$predicate_property'(primary_index(Arg), Pred) :- 903 '$get_predicate_attribute'(Pred, primary_index, Arg). 904 905system_undefined(user:prolog_trace_interception/4). 906system_undefined(prolog:prolog_exception_hook/5). 907system_undefined(system:'$c_call_prolog'/0). 908system_undefined(system:window_title/2). 909 910table_flag(variant, Pred) :- 911 '$tbl_implementation'(Pred, M:Head), 912 M:'$tabled'(Head, variant). 913table_flag(subsumptive, Pred) :- 914 '$tbl_implementation'(Pred, M:Head), 915 M:'$tabled'(Head, subsumptive). 916table_flag(shared, Pred) :- 917 '$get_predicate_attribute'(Pred, tshared, 1). 918table_flag(incremental, Pred) :- 919 '$get_predicate_attribute'(Pred, incremental, 1). 920table_flag(monotonic, Pred) :- 921 '$get_predicate_attribute'(Pred, monotonic, 1). 922table_flag(subgoal_abstract(N), Pred) :- 923 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 924table_flag(answer_abstract(N), Pred) :- 925 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 926table_flag(subgoal_abstract(N), Pred) :- 927 '$get_predicate_attribute'(Pred, max_answers, N).
936visible_predicate(Pred) :- 937 Pred = M:Head, 938 current_module(M), 939 ( callable(Head) 940 -> ( '$get_predicate_attribute'(Pred, defined, 1) 941 -> true 942 ; \+ current_prolog_flag(Munknown, fail), 943 '$head_name_arity'(Head, Name, Arity), 944 '$find_library'(M, Name, Arity, _LoadModule, _Library) 945 ) 946 ; setof(PI, visible_in_module(M, PI), PIs), 947 '$member'(Name/Arity, PIs), 948 functor(Head, Name, Arity) 949 ). 950 951visible_in_module(M, Name/Arity) :- 952 default_module(M, DefM), 953 DefHead = DefM:Head, 954 '$c_current_predicate'(_, DefHead), 955 '$get_predicate_attribute'(DefHead, defined, 1), 956 \+ hidden_system_predicate(Head), 957 functor(Head, Name, Arity). 958visible_in_module(_, Name/Arity) :- 959 '$in_library'(Name, Arity, _). 960 (Head) :- 962 functor(Head, Name, _), 963 atom(Name), % Avoid []. 964 sub_atom(Name, 0, _, _, $), 965 \+ current_prolog_flag(access_level, system).
true.990clause_property(Clause, Property) :- 991 '$clause_property'(Property, Clause). 992 993'$clause_property'(line_count(LineNumber), Clause) :- 994 '$get_clause_attribute'(Clause, line_count, LineNumber). 995'$clause_property'(file(File), Clause) :- 996 '$get_clause_attribute'(Clause, file, File). 997'$clause_property'(source(File), Clause) :- 998 '$get_clause_attribute'(Clause, owner, File). 999'$clause_property'(size(Bytes), Clause) :- 1000 '$get_clause_attribute'(Clause, size, Bytes). 1001'$clause_property'(fact, Clause) :- 1002 '$get_clause_attribute'(Clause, fact, true). 1003'$clause_property'(erased, Clause) :- 1004 '$get_clause_attribute'(Clause, erased, true). 1005'$clause_property'(predicate(PI), Clause) :- 1006 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1007'$clause_property'(module(M), Clause) :- 1008 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1022dynamic(M:Predicates, Options) :- 1023 '$must_be'(list, Predicates), 1024 options_properties(Options, Props), 1025 set_pprops(Predicates, M, [dynamic|Props]). 1026 1027set_pprops([], _, _). 1028set_pprops([H|T], M, Props) :- 1029 set_pprops1(Props, M:H), 1030 strip_module(M:H, M2, P), 1031 '$pi_head'(M2:P, Pred), 1032 '$set_table_wrappers'(Pred), 1033 set_pprops(T, M, Props). 1034 1035set_pprops1([], _). 1036set_pprops1([H|T], P) :- 1037 ( atom(H) 1038 -> '$set_predicate_attribute'(P, H, true) 1039 ; H =.. [Name,Value] 1040 -> '$set_predicate_attribute'(P, Name, Value) 1041 ), 1042 set_pprops1(T, P). 1043 1044options_properties(Options, Props) :- 1045 G = opt_prop(_,_,_,_), 1046 findall(G, G, Spec), 1047 options_properties(Spec, Options, Props). 1048 1049options_properties([], _, []). 1050options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1051 Options, [Prop|PT]) :- 1052 Opt =.. [Name,V], 1053 '$option'(Opt, Options), 1054 '$must_be'(Type, V), 1055 V = SetValue, 1056 !, 1057 options_properties(T, Options, PT). 1058options_properties([_|T], Options, PT) :- 1059 options_properties(T, Options, PT). 1060 1061opt_prop(incremental, boolean, Bool, incremental(Bool)). 1062opt_prop(abstract, between(0,0), 0, abstract). 1063opt_prop(multifile, boolean, true, multifile). 1064opt_prop(discontiguous, boolean, true, discontiguous). 1065opt_prop(volatile, boolean, true, volatile). 1066opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1067 local, thread_local). 1068 1069 /******************************** 1070 * MODULES * 1071 *********************************/
1077current_module(Module) :-
1078 '$current_module'(Module, _).1094module_property(Module, Property) :- 1095 nonvar(Module), nonvar(Property), 1096 !, 1097 property_module(Property, Module). 1098module_property(Module, Property) :- % -, file(File) 1099 nonvar(Property), Property = file(File), 1100 !, 1101 ( nonvar(File) 1102 -> '$current_module'(Modules, File), 1103 ( atom(Modules) 1104 -> Module = Modules 1105 ; '$member'(Module, Modules) 1106 ) 1107 ; '$current_module'(Module, File), 1108 File \== [] 1109 ). 1110module_property(Module, Property) :- 1111 current_module(Module), 1112 property_module(Property, Module). 1113 1114property_module(Property, Module) :- 1115 module_property(Property), 1116 ( Property = exported_operators(List) 1117 -> '$exported_ops'(Module, List, []) 1118 ; '$module_property'(Module, Property) 1119 ). 1120 1121module_property(class(_)). 1122module_property(file(_)). 1123module_property(line_count(_)). 1124module_property(exports(_)). 1125module_property(exported_operators(_)). 1126module_property(size(_)). 1127module_property(program_size(_)). 1128module_property(program_space(_)). 1129module_property(last_modified_generation(_)).
1135module(Module) :- 1136 atom(Module), 1137 current_module(Module), 1138 !, 1139 '$set_typein_module'(Module). 1140module(Module) :- 1141 '$set_typein_module'(Module), 1142 print_message(warning, no_current_module(Module)).
1149working_directory(Old, New) :- 1150 '$cwd'(Old), 1151 ( Old == New 1152 -> true 1153 ; '$chdir'(New) 1154 ). 1155 1156 1157 /******************************* 1158 * TRIES * 1159 *******************************/
1165current_trie(Trie) :-
1166 current_blob(Trie, trie),
1167 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1203trie_property(Trie, Property) :- 1204 current_trie(Trie), 1205 trie_property(Property), 1206 '$trie_property'(Trie, Property). 1207 1208trie_property(node_count(_)). 1209trie_property(value_count(_)). 1210trie_property(size(_)). 1211trie_property(hashed(_)). 1212trie_property(compiled_size(_)). 1213 % below only when -DO_TRIE_STATS 1214trie_property(lookup_count(_)). % is enabled in pl-trie.h 1215trie_property(gen_call_count(_)). 1216trie_property(invalidated(_)). % IDG stats 1217trie_property(reevaluated(_)). 1218trie_property(deadlock(_)). % Shared tabling stats 1219trie_property(wait(_)). 1220trie_property(idg_affected_count(_)). 1221trie_property(idg_dependent_count(_)). 1222trie_property(idg_size(_)). 1223 1224 1225 /******************************** 1226 * SYSTEM INTERACTION * 1227 *********************************/ 1228 1229shell(Command) :- 1230 shell(Command, 0). 1231 1232 1233 /******************************* 1234 * SIGNALS * 1235 *******************************/ 1236 1237:- meta_predicate 1238 on_signal(, , ), 1239 current_signal(, , ).
1243on_signal(Signal, Old, New) :- 1244 atom(Signal), 1245 !, 1246 '$on_signal'(_Num, Signal, Old, New). 1247on_signal(Signal, Old, New) :- 1248 integer(Signal), 1249 !, 1250 '$on_signal'(Signal, _Name, Old, New). 1251on_signal(Signal, _Old, _New) :- 1252 '$type_error'(signal_name, Signal).
1256current_signal(Name, Id, Handler) :- 1257 between(1, 32, Id), 1258 '$on_signal'(Id, Name, Handler, Handler). 1259 1260:- multifile 1261 prolog:called_by/2. 1262 1263prologcalled_by(on_signal(_,_,New), [New+1]) :- 1264 ( new == throw 1265 ; new == default 1266 ), !, fail. 1267 1268 1269 /******************************* 1270 * I/O * 1271 *******************************/ 1272 1273format(Fmt) :- 1274 format(Fmt, []). 1275 1276 /******************************* 1277 * FILES * 1278 *******************************/
1282absolute_file_name(Name, Abs) :- 1283 atomic(Name), 1284 !, 1285 '$absolute_file_name'(Name, Abs). 1286absolute_file_name(Term, Abs) :- 1287 '$chk_file'(Term, [''], [access(read)], true, File), 1288 !, 1289 '$absolute_file_name'(File, Abs). 1290absolute_file_name(Term, Abs) :- 1291 '$chk_file'(Term, [''], [], true, File), 1292 !, 1293 '$absolute_file_name'(File, Abs).
1301tmp_file_stream(Enc, File, Stream) :- 1302 atom(Enc), var(File), var(Stream), 1303 !, 1304 '$tmp_file_stream'('', Enc, File, Stream). 1305tmp_file_stream(File, Stream, Options) :- 1306 current_prolog_flag(encoding, DefEnc), 1307 '$option'(encoding(Enc), Options, DefEnc), 1308 '$option'(extension(Ext), Options, ''), 1309 '$tmp_file_stream'(Ext, Enc, File, Stream), 1310 set_stream(Stream, file_name(File)). 1311 1312 1313 /******************************** 1314 * MEMORY MANAGEMENT * 1315 *********************************/
1324garbage_collect :-
1325 '$garbage_collect'(0).
1331set_prolog_stack(Stack, Option) :-
1332 Option =.. [Name,Value0],
1333 Value is Value0,
1334 '$set_prolog_stack'(Stack, Name, _Old, Value).1340prolog_stack_property(Stack, Property) :- 1341 stack_property(P), 1342 stack_name(Stack), 1343 Property =.. [P,Value], 1344 '$set_prolog_stack'(Stack, P, Value, Value). 1345 1346stack_name(local). 1347stack_name(global). 1348stack_name(trail). 1349 1350stack_property(limit). 1351stack_property(spare). 1352stack_property(min_free). 1353stack_property(low). 1354stack_property(factor). 1355 1356 1357 /******************************* 1358 * CLAUSE * 1359 *******************************/
:-
as neck.1367rule(Head, Rule) :- 1368 '$rule'(Head, Rule0), 1369 conditional_rule(Rule0, Rule1), 1370 Rule = Rule1. 1371rule(Head, Rule, Ref) :- 1372 '$rule'(Head, Rule0, Ref), 1373 conditional_rule(Rule0, Rule1), 1374 Rule = Rule1. 1375 1376conditional_rule(?=>(Head, (!, Body)), Rule) => 1377 Rule = (Head => Body). 1378conditional_rule(?=>(Head, !), Rule) => 1379 Rule = (Head => true). 1380conditional_rule(?=>(Head, Body0), Rule), 1381 split_on_cut(Body0, Cond, Body) => 1382 Rule = (Head,Cond=>Body). 1383conditional_rule(Head, Rule) => 1384 Rule = Head. 1385 1386split_on_cut((Cond0,!,Body0), Cond, Body) => 1387 Cond = Cond0, 1388 Body = Body0. 1389split_on_cut((!,Body0), Cond, Body) => 1390 Cond = true, 1391 Body = Body0. 1392split_on_cut((A,B), Cond, Body) => 1393 Cond = (A,Cond1), 1394 split_on_cut(B, Cond1, Body). 1395split_on_cut(_, _, _) => 1396 fail. 1397 1398 1399 /******************************* 1400 * TERM * 1401 *******************************/ 1402 1403:- '$iso'((numbervars/3)).
1411numbervars(Term, From, To) :- 1412 numbervars(Term, From, To, []). 1413 1414 1415 /******************************* 1416 * STRING * 1417 *******************************/
1423term_string(Term, String, Options) :- 1424 nonvar(String), 1425 !, 1426 read_term_from_atom(String, Term, Options). 1427term_string(Term, String, Options) :- 1428 ( '$option'(quoted(_), Options) 1429 -> Options1 = Options 1430 ; '$merge_options'(_{quoted:true}, Options, Options1) 1431 ), 1432 format(string(String), '~W', [Term, Options1]). 1433 1434 1435 /******************************* 1436 * THREADS * 1437 *******************************/ 1438 1439:- meta_predicate 1440 thread_create(, ).
thread_create(Goal, Id, []).
1446thread_create(Goal, Id) :-
1447 thread_create(Goal, Id, []).
1456thread_join(Id) :-
1457 thread_join(Id, Status),
1458 ( Status == true
1459 -> true
1460 ; throw(error(thread_error(Id, Status), _))
1461 ).1471sig_block(Pattern) :- 1472 ( nb_current('$sig_blocked', List) 1473 -> true 1474 ; List = [] 1475 ), 1476 nb_setval('$sig_blocked', [Pattern|List]). 1477 1478sig_unblock(Pattern) :- 1479 ( nb_current('$sig_blocked', List) 1480 -> unblock(List, Pattern, NewList), 1481 ( List == NewList 1482 -> true 1483 ; nb_setval('$sig_blocked', NewList), 1484 '$sig_unblock' 1485 ) 1486 ; true 1487 ). 1488 1489unblock([], _, []). 1490unblock([H|T], P, List) :- 1491 ( subsumes_term(P, H) 1492 -> unblock(T, P, List) 1493 ; List = [H|T1], 1494 unblock(T, P, T1) 1495 ). 1496 1497:- public signal_is_blocked/1. % called by signal_is_blocked() 1498 1499signal_is_blocked(Head) :- 1500 nb_current('$sig_blocked', List), 1501 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.1518set_prolog_gc_thread(Status) :- 1519 var(Status), 1520 !, 1521 '$instantiation_error'(Status). 1522set_prolog_gc_thread(_) :- 1523 \+ current_prolog_flag(threads, true), 1524 !. 1525set_prolog_gc_thread(false) :- 1526 !, 1527 set_prolog_flag(gc_thread, false), 1528 ( current_prolog_flag(threads, true) 1529 -> ( '$gc_stop' 1530 -> thread_join(gc) 1531 ; true 1532 ) 1533 ; true 1534 ). 1535set_prolog_gc_thread(true) :- 1536 !, 1537 set_prolog_flag(gc_thread, true). 1538set_prolog_gc_thread(stop) :- 1539 !, 1540 ( current_prolog_flag(threads, true) 1541 -> ( '$gc_stop' 1542 -> thread_join(gc) 1543 ; true 1544 ) 1545 ; true 1546 ). 1547set_prolog_gc_thread(Status) :- 1548 '$domain_error'(gc_thread, Status).
1557transaction(Goal) :- 1558 '$transaction'(Goal, []). 1559transaction(Goal, Options) :- 1560 '$transaction'(Goal, Options). 1561transaction(Goal, Constraint, Mutex) :- 1562 '$transaction'(Goal, Constraint, Mutex). 1563snapshot(Goal) :- 1564 '$snapshot'(Goal). 1565 1566 1567 /******************************* 1568 * UNDO * 1569 *******************************/ 1570 1571:- meta_predicate 1572 undo().
1579undo(Goal) :- 1580 '$undo'(Goal). 1581 1582:- public 1583 '$run_undo'/1. 1584 1585'$run_undo'([One]) :- 1586 !, 1587 ( call(One) 1588 -> true 1589 ; true 1590 ). 1591'$run_undo'(List) :- 1592 run_undo(List, _, Error), 1593 ( var(Error) 1594 -> true 1595 ; throw(Error) 1596 ). 1597 1598run_undo([], E, E). 1599run_undo([H|T], E0, E) :- 1600 ( catch(H, E1, true) 1601 -> ( var(E1) 1602 -> true 1603 ; '$urgent_exception'(E0, E1, E2) 1604 ) 1605 ; true 1606 ), 1607 run_undo(T, E2, E).
1615:- meta_predicate 1616 '$wrap_predicate'(, , , , ). 1617 1618'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1619 callable_name_arguments(Head, PName, Args), 1620 callable_name_arity(Head, PName, Arity), 1621 ( is_most_general_term(Head) 1622 -> true 1623 ; '$domain_error'(most_general_term, Head) 1624 ), 1625 atomic_list_concat(['$wrap$', PName], WrapName), 1626 PI = M:WrapName/Arity, 1627 dynamic(PI), 1628 '$notransact'(PI), 1629 volatile(PI), 1630 module_transparent(PI), 1631 WHead =.. [WrapName|Args], 1632 wrapped_clause(M, WHead, Body, Clause), 1633 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause). 1634 1635callable_name_arguments(Head, PName, Args) :- 1636 atom(Head), 1637 !, 1638 PName = Head, 1639 Args = []. 1640callable_name_arguments(Head, PName, Args) :- 1641 compound_name_arguments(Head, PName, Args). 1642 1643callable_name_arity(Head, PName, Arity) :- 1644 atom(Head), 1645 !, 1646 PName = Head, 1647 Arity = 0. 1648callable_name_arity(Head, PName, Arity) :- 1649 compound_name_arity(Head, PName, Arity). 1650 1651wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !. 1652wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))