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, _).
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, transparent, 1), 831 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 832'$predicate_property'(mode(Pattern), Pred) :- 833 '$get_predicate_attribute'(Pred, transparent, 0), 834 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 835'$predicate_property'(file(File), Pred) :- 836 '$get_predicate_attribute'(Pred, file, File). 837'$predicate_property'(line_count(LineNumber), Pred) :- 838 '$get_predicate_attribute'(Pred, line_count, LineNumber). 839'$predicate_property'(notrace, Pred) :- 840 '$get_predicate_attribute'(Pred, trace, 0). 841'$predicate_property'(nodebug, Pred) :- 842 '$get_predicate_attribute'(Pred, hide_childs, 1). 843'$predicate_property'(spying, Pred) :- 844 '$get_predicate_attribute'(Pred, spy, 1). 845'$predicate_property'(number_of_clauses(N), Pred) :- 846 '$get_predicate_attribute'(Pred, number_of_clauses, N). 847'$predicate_property'(number_of_rules(N), Pred) :- 848 '$get_predicate_attribute'(Pred, number_of_rules, N). 849'$predicate_property'(last_modified_generation(Gen), Pred) :- 850 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 851'$predicate_property'(indexed(Indices), Pred) :- 852 '$get_predicate_attribute'(Pred, indexed, Indices). 853'$predicate_property'(noprofile, Pred) :- 854 '$get_predicate_attribute'(Pred, noprofile, 1). 855'$predicate_property'(ssu, Pred) :- 856 '$get_predicate_attribute'(Pred, ssu, 1). 857'$predicate_property'(iso, Pred) :- 858 '$get_predicate_attribute'(Pred, iso, 1). 859'$predicate_property'(det, Pred) :- 860 '$get_predicate_attribute'(Pred, det, 1). 861'$predicate_property'(sig_atomic, Pred) :- 862 '$get_predicate_attribute'(Pred, sig_atomic, 1). 863'$predicate_property'(quasi_quotation_syntax, Pred) :- 864 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 865'$predicate_property'(defined, Pred) :- 866 '$get_predicate_attribute'(Pred, defined, 1). 867'$predicate_property'(tabled, Pred) :- 868 '$get_predicate_attribute'(Pred, tabled, 1). 869'$predicate_property'(tabled(Flag), Pred) :- 870 '$get_predicate_attribute'(Pred, tabled, 1), 871 table_flag(Flag, Pred). 872'$predicate_property'(incremental, Pred) :- 873 '$get_predicate_attribute'(Pred, incremental, 1). 874'$predicate_property'(monotonic, Pred) :- 875 '$get_predicate_attribute'(Pred, monotonic, 1). 876'$predicate_property'(opaque, Pred) :- 877 '$get_predicate_attribute'(Pred, opaque, 1). 878'$predicate_property'(lazy, Pred) :- 879 '$get_predicate_attribute'(Pred, lazy, 1). 880'$predicate_property'(abstract(N), Pred) :- 881 '$get_predicate_attribute'(Pred, abstract, N). 882'$predicate_property'(size(Bytes), Pred) :- 883 '$get_predicate_attribute'(Pred, size, Bytes). 884'$predicate_property'(primary_index(Arg), Pred) :- 885 '$get_predicate_attribute'(Pred, primary_index, Arg). 886 887system_undefined(user:prolog_trace_interception/4). 888system_undefined(prolog:prolog_exception_hook/5). 889system_undefined(system:'$c_call_prolog'/0). 890system_undefined(system:window_title/2). 891 892table_flag(variant, Pred) :- 893 '$tbl_implementation'(Pred, M:Head), 894 M:'$tabled'(Head, variant). 895table_flag(subsumptive, Pred) :- 896 '$tbl_implementation'(Pred, M:Head), 897 M:'$tabled'(Head, subsumptive). 898table_flag(shared, Pred) :- 899 '$get_predicate_attribute'(Pred, tshared, 1). 900table_flag(incremental, Pred) :- 901 '$get_predicate_attribute'(Pred, incremental, 1). 902table_flag(monotonic, Pred) :- 903 '$get_predicate_attribute'(Pred, monotonic, 1). 904table_flag(subgoal_abstract(N), Pred) :- 905 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 906table_flag(answer_abstract(N), Pred) :- 907 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 908table_flag(subgoal_abstract(N), Pred) :- 909 '$get_predicate_attribute'(Pred, max_answers, N).
918visible_predicate(Pred) :- 919 Pred = M:Head, 920 current_module(M), 921 ( callable(Head) 922 -> ( '$get_predicate_attribute'(Pred, defined, 1) 923 -> true 924 ; \+ current_prolog_flag(Munknown, fail), 925 '$head_name_arity'(Head, Name, Arity), 926 '$find_library'(M, Name, Arity, _LoadModule, _Library) 927 ) 928 ; setof(PI, visible_in_module(M, PI), PIs), 929 '$member'(Name/Arity, PIs), 930 functor(Head, Name, Arity) 931 ). 932 933visible_in_module(M, Name/Arity) :- 934 default_module(M, DefM), 935 DefHead = DefM:Head, 936 '$c_current_predicate'(_, DefHead), 937 '$get_predicate_attribute'(DefHead, defined, 1), 938 \+ hidden_system_predicate(Head), 939 functor(Head, Name, Arity). 940visible_in_module(_, Name/Arity) :- 941 '$in_library'(Name, Arity, _). 942 (Head) :- 944 functor(Head, Name, _), 945 atom(Name), % Avoid []. 946 sub_atom(Name, 0, _, _, $), 947 \+ current_prolog_flag(access_level, system).
true.972clause_property(Clause, Property) :- 973 '$clause_property'(Property, Clause). 974 975'$clause_property'(line_count(LineNumber), Clause) :- 976 '$get_clause_attribute'(Clause, line_count, LineNumber). 977'$clause_property'(file(File), Clause) :- 978 '$get_clause_attribute'(Clause, file, File). 979'$clause_property'(source(File), Clause) :- 980 '$get_clause_attribute'(Clause, owner, File). 981'$clause_property'(size(Bytes), Clause) :- 982 '$get_clause_attribute'(Clause, size, Bytes). 983'$clause_property'(fact, Clause) :- 984 '$get_clause_attribute'(Clause, fact, true). 985'$clause_property'(erased, Clause) :- 986 '$get_clause_attribute'(Clause, erased, true). 987'$clause_property'(predicate(PI), Clause) :- 988 '$get_clause_attribute'(Clause, predicate_indicator, PI). 989'$clause_property'(module(M), Clause) :- 990 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1004dynamic(M:Predicates, Options) :- 1005 '$must_be'(list, Predicates), 1006 options_properties(Options, Props), 1007 set_pprops(Predicates, M, [dynamic|Props]). 1008 1009set_pprops([], _, _). 1010set_pprops([H|T], M, Props) :- 1011 set_pprops1(Props, M:H), 1012 strip_module(M:H, M2, P), 1013 '$pi_head'(M2:P, Pred), 1014 '$set_table_wrappers'(Pred), 1015 set_pprops(T, M, Props). 1016 1017set_pprops1([], _). 1018set_pprops1([H|T], P) :- 1019 ( atom(H) 1020 -> '$set_predicate_attribute'(P, H, true) 1021 ; H =.. [Name,Value] 1022 -> '$set_predicate_attribute'(P, Name, Value) 1023 ), 1024 set_pprops1(T, P). 1025 1026options_properties(Options, Props) :- 1027 G = opt_prop(_,_,_,_), 1028 findall(G, G, Spec), 1029 options_properties(Spec, Options, Props). 1030 1031options_properties([], _, []). 1032options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1033 Options, [Prop|PT]) :- 1034 Opt =.. [Name,V], 1035 '$option'(Opt, Options), 1036 '$must_be'(Type, V), 1037 V = SetValue, 1038 !, 1039 options_properties(T, Options, PT). 1040options_properties([_|T], Options, PT) :- 1041 options_properties(T, Options, PT). 1042 1043opt_prop(incremental, boolean, Bool, incremental(Bool)). 1044opt_prop(abstract, between(0,0), 0, abstract). 1045opt_prop(multifile, boolean, true, multifile). 1046opt_prop(discontiguous, boolean, true, discontiguous). 1047opt_prop(volatile, boolean, true, volatile). 1048opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1049 local, thread_local). 1050 1051 /******************************** 1052 * MODULES * 1053 *********************************/
1059current_module(Module) :-
1060 '$current_module'(Module, _).1076module_property(Module, Property) :- 1077 nonvar(Module), nonvar(Property), 1078 !, 1079 property_module(Property, Module). 1080module_property(Module, Property) :- % -, file(File) 1081 nonvar(Property), Property = file(File), 1082 !, 1083 ( nonvar(File) 1084 -> '$current_module'(Modules, File), 1085 ( atom(Modules) 1086 -> Module = Modules 1087 ; '$member'(Module, Modules) 1088 ) 1089 ; '$current_module'(Module, File), 1090 File \== [] 1091 ). 1092module_property(Module, Property) :- 1093 current_module(Module), 1094 property_module(Property, Module). 1095 1096property_module(Property, Module) :- 1097 module_property(Property), 1098 ( Property = exported_operators(List) 1099 -> '$exported_ops'(Module, List, []) 1100 ; '$module_property'(Module, Property) 1101 ). 1102 1103module_property(class(_)). 1104module_property(file(_)). 1105module_property(line_count(_)). 1106module_property(exports(_)). 1107module_property(exported_operators(_)). 1108module_property(size(_)). 1109module_property(program_size(_)). 1110module_property(program_space(_)). 1111module_property(last_modified_generation(_)).
1117module(Module) :- 1118 atom(Module), 1119 current_module(Module), 1120 !, 1121 '$set_typein_module'(Module). 1122module(Module) :- 1123 '$set_typein_module'(Module), 1124 print_message(warning, no_current_module(Module)).
1131working_directory(Old, New) :- 1132 '$cwd'(Old), 1133 ( Old == New 1134 -> true 1135 ; '$chdir'(New) 1136 ). 1137 1138 1139 /******************************* 1140 * TRIES * 1141 *******************************/
1147current_trie(Trie) :-
1148 current_blob(Trie, trie),
1149 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1185trie_property(Trie, Property) :- 1186 current_trie(Trie), 1187 trie_property(Property), 1188 '$trie_property'(Trie, Property). 1189 1190trie_property(node_count(_)). 1191trie_property(value_count(_)). 1192trie_property(size(_)). 1193trie_property(hashed(_)). 1194trie_property(compiled_size(_)). 1195 % below only when -DO_TRIE_STATS 1196trie_property(lookup_count(_)). % is enabled in pl-trie.h 1197trie_property(gen_call_count(_)). 1198trie_property(invalidated(_)). % IDG stats 1199trie_property(reevaluated(_)). 1200trie_property(deadlock(_)). % Shared tabling stats 1201trie_property(wait(_)). 1202trie_property(idg_affected_count(_)). 1203trie_property(idg_dependent_count(_)). 1204trie_property(idg_size(_)). 1205 1206 1207 /******************************** 1208 * SYSTEM INTERACTION * 1209 *********************************/ 1210 1211shell(Command) :- 1212 shell(Command, 0). 1213 1214 1215 /******************************* 1216 * SIGNALS * 1217 *******************************/ 1218 1219:- meta_predicate 1220 on_signal(, , ), 1221 current_signal(, , ).
1225on_signal(Signal, Old, New) :- 1226 atom(Signal), 1227 !, 1228 '$on_signal'(_Num, Signal, Old, New). 1229on_signal(Signal, Old, New) :- 1230 integer(Signal), 1231 !, 1232 '$on_signal'(Signal, _Name, Old, New). 1233on_signal(Signal, _Old, _New) :- 1234 '$type_error'(signal_name, Signal).
1238current_signal(Name, Id, Handler) :- 1239 between(1, 32, Id), 1240 '$on_signal'(Id, Name, Handler, Handler). 1241 1242:- multifile 1243 prolog:called_by/2. 1244 1245prologcalled_by(on_signal(_,_,New), [New+1]) :- 1246 ( new == throw 1247 ; new == default 1248 ), !, fail. 1249 1250 1251 /******************************* 1252 * I/O * 1253 *******************************/ 1254 1255format(Fmt) :- 1256 format(Fmt, []). 1257 1258 /******************************* 1259 * FILES * 1260 *******************************/
1264absolute_file_name(Name, Abs) :- 1265 atomic(Name), 1266 !, 1267 '$absolute_file_name'(Name, Abs). 1268absolute_file_name(Term, Abs) :- 1269 '$chk_file'(Term, [''], [access(read)], true, File), 1270 !, 1271 '$absolute_file_name'(File, Abs). 1272absolute_file_name(Term, Abs) :- 1273 '$chk_file'(Term, [''], [], true, File), 1274 !, 1275 '$absolute_file_name'(File, Abs).
1283tmp_file_stream(Enc, File, Stream) :- 1284 atom(Enc), var(File), var(Stream), 1285 !, 1286 '$tmp_file_stream'('', Enc, File, Stream). 1287tmp_file_stream(File, Stream, Options) :- 1288 current_prolog_flag(encoding, DefEnc), 1289 '$option'(encoding(Enc), Options, DefEnc), 1290 '$option'(extension(Ext), Options, ''), 1291 '$tmp_file_stream'(Ext, Enc, File, Stream), 1292 set_stream(Stream, file_name(File)). 1293 1294 1295 /******************************** 1296 * MEMORY MANAGEMENT * 1297 *********************************/
1306garbage_collect :-
1307 '$garbage_collect'(0).
1313set_prolog_stack(Stack, Option) :-
1314 Option =.. [Name,Value0],
1315 Value is Value0,
1316 '$set_prolog_stack'(Stack, Name, _Old, Value).1322prolog_stack_property(Stack, Property) :- 1323 stack_property(P), 1324 stack_name(Stack), 1325 Property =.. [P,Value], 1326 '$set_prolog_stack'(Stack, P, Value, Value). 1327 1328stack_name(local). 1329stack_name(global). 1330stack_name(trail). 1331 1332stack_property(limit). 1333stack_property(spare). 1334stack_property(min_free). 1335stack_property(low). 1336stack_property(factor). 1337 1338 1339 /******************************* 1340 * CLAUSE * 1341 *******************************/
:-
as neck.1349rule(Head, Rule) :- 1350 '$rule'(Head, Rule0), 1351 conditional_rule(Rule0, Rule1), 1352 Rule = Rule1. 1353rule(Head, Rule, Ref) :- 1354 '$rule'(Head, Rule0, Ref), 1355 conditional_rule(Rule0, Rule1), 1356 Rule = Rule1. 1357 1358conditional_rule(?=>(Head, (!, Body)), Rule) => 1359 Rule = (Head => Body). 1360conditional_rule(?=>(Head, !), Rule) => 1361 Rule = (Head => true). 1362conditional_rule(?=>(Head, Body0), Rule), 1363 split_on_cut(Body0, Cond, Body) => 1364 Rule = (Head,Cond=>Body). 1365conditional_rule(Head, Rule) => 1366 Rule = Head. 1367 1368split_on_cut((Cond0,!,Body0), Cond, Body) => 1369 Cond = Cond0, 1370 Body = Body0. 1371split_on_cut((!,Body0), Cond, Body) => 1372 Cond = true, 1373 Body = Body0. 1374split_on_cut((A,B), Cond, Body) => 1375 Cond = (A,Cond1), 1376 split_on_cut(B, Cond1, Body). 1377split_on_cut(_, _, _) => 1378 fail. 1379 1380 1381 /******************************* 1382 * TERM * 1383 *******************************/ 1384 1385:- '$iso'((numbervars/3)).
1393numbervars(Term, From, To) :- 1394 numbervars(Term, From, To, []). 1395 1396 1397 /******************************* 1398 * STRING * 1399 *******************************/
1405term_string(Term, String, Options) :- 1406 nonvar(String), 1407 !, 1408 read_term_from_atom(String, Term, Options). 1409term_string(Term, String, Options) :- 1410 ( '$option'(quoted(_), Options) 1411 -> Options1 = Options 1412 ; '$merge_options'(_{quoted:true}, Options, Options1) 1413 ), 1414 format(string(String), '~W', [Term, Options1]). 1415 1416 1417 /******************************* 1418 * THREADS * 1419 *******************************/ 1420 1421:- meta_predicate 1422 thread_create(, ).
thread_create(Goal, Id, []).
1428thread_create(Goal, Id) :-
1429 thread_create(Goal, Id, []).
1438thread_join(Id) :-
1439 thread_join(Id, Status),
1440 ( Status == true
1441 -> true
1442 ; throw(error(thread_error(Id, Status), _))
1443 ).1453sig_block(Pattern) :- 1454 ( nb_current('$sig_blocked', List) 1455 -> true 1456 ; List = [] 1457 ), 1458 nb_setval('$sig_blocked', [Pattern|List]). 1459 1460sig_unblock(Pattern) :- 1461 ( nb_current('$sig_blocked', List) 1462 -> unblock(List, Pattern, NewList), 1463 ( List == NewList 1464 -> true 1465 ; nb_setval('$sig_blocked', NewList), 1466 '$sig_unblock' 1467 ) 1468 ; true 1469 ). 1470 1471unblock([], _, []). 1472unblock([H|T], P, List) :- 1473 ( subsumes_term(P, H) 1474 -> unblock(T, P, List) 1475 ; List = [H|T1], 1476 unblock(T, P, T1) 1477 ). 1478 1479:- public signal_is_blocked/1. % called by signal_is_blocked() 1480 1481signal_is_blocked(Head) :- 1482 nb_current('$sig_blocked', List), 1483 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.1500set_prolog_gc_thread(Status) :- 1501 var(Status), 1502 !, 1503 '$instantiation_error'(Status). 1504set_prolog_gc_thread(_) :- 1505 \+ current_prolog_flag(threads, true), 1506 !. 1507set_prolog_gc_thread(false) :- 1508 !, 1509 set_prolog_flag(gc_thread, false), 1510 ( current_prolog_flag(threads, true) 1511 -> ( '$gc_stop' 1512 -> thread_join(gc) 1513 ; true 1514 ) 1515 ; true 1516 ). 1517set_prolog_gc_thread(true) :- 1518 !, 1519 set_prolog_flag(gc_thread, true). 1520set_prolog_gc_thread(stop) :- 1521 !, 1522 ( current_prolog_flag(threads, true) 1523 -> ( '$gc_stop' 1524 -> thread_join(gc) 1525 ; true 1526 ) 1527 ; true 1528 ). 1529set_prolog_gc_thread(Status) :- 1530 '$domain_error'(gc_thread, Status).
1539transaction(Goal) :- 1540 '$transaction'(Goal, []). 1541transaction(Goal, Options) :- 1542 '$transaction'(Goal, Options). 1543transaction(Goal, Constraint, Mutex) :- 1544 '$transaction'(Goal, Constraint, Mutex). 1545snapshot(Goal) :- 1546 '$snapshot'(Goal). 1547 1548 1549 /******************************* 1550 * UNDO * 1551 *******************************/ 1552 1553:- meta_predicate 1554 undo().
1561undo(Goal) :- 1562 '$undo'(Goal). 1563 1564:- public 1565 '$run_undo'/1. 1566 1567'$run_undo'([One]) :- 1568 !, 1569 ( call(One) 1570 -> true 1571 ; true 1572 ). 1573'$run_undo'(List) :- 1574 run_undo(List, _, Error), 1575 ( var(Error) 1576 -> true 1577 ; throw(Error) 1578 ). 1579 1580run_undo([], E, E). 1581run_undo([H|T], E0, E) :- 1582 ( catch(H, E1, true) 1583 -> ( var(E1) 1584 -> true 1585 ; '$urgent_exception'(E0, E1, E2) 1586 ) 1587 ; true 1588 ), 1589 run_undo(T, E2, E).
1597:- meta_predicate 1598 '$wrap_predicate'(, , , , ). 1599 1600'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1601 callable_name_arguments(Head, PName, Args), 1602 callable_name_arity(Head, PName, Arity), 1603 ( is_most_general_term(Head) 1604 -> true 1605 ; '$domain_error'(most_general_term, Head) 1606 ), 1607 atomic_list_concat(['$wrap$', PName], WrapName), 1608 PI = M:WrapName/Arity, 1609 dynamic(PI), 1610 '$notransact'(PI), 1611 volatile(PI), 1612 module_transparent(PI), 1613 WHead =.. [WrapName|Args], 1614 wrapped_clause(M, WHead, Body, Clause), 1615 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause). 1616 1617callable_name_arguments(Head, PName, Args) :- 1618 atom(Head), 1619 !, 1620 PName = Head, 1621 Args = []. 1622callable_name_arguments(Head, PName, Args) :- 1623 compound_name_arguments(Head, PName, Args). 1624 1625callable_name_arity(Head, PName, Arity) :- 1626 atom(Head), 1627 !, 1628 PName = Head, 1629 Arity = 0. 1630callable_name_arity(Head, PName, Arity) :- 1631 compound_name_arity(Head, PName, Arity). 1632 1633wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !. 1634wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))