1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1985-2022, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module('$syspreds', 39 [ leash/1, 40 visible/1, 41 style_check/1, 42 flag/3, 43 atom_prefix/2, 44 dwim_match/2, 45 source_file_property/2, 46 source_file/1, 47 source_file/2, 48 unload_file/1, 49 exists_source/1, % +Spec 50 exists_source/2, % +Spec, -Path 51 prolog_load_context/2, 52 stream_position_data/3, 53 current_predicate/2, 54 '$defined_predicate'/1, 55 predicate_property/2, 56 '$predicate_property'/2, 57 (dynamic)/2, % :Predicates, +Options 58 clause_property/2, 59 current_module/1, % ?Module 60 module_property/2, % ?Module, ?Property 61 module/1, % +Module 62 current_trie/1, % ?Trie 63 trie_property/2, % ?Trie, ?Property 64 working_directory/2, % -OldDir, +NewDir 65 shell/1, % +Command 66 on_signal/3, 67 current_signal/3, 68 format/1, 69 garbage_collect/0, 70 set_prolog_stack/2, 71 prolog_stack_property/2, 72 absolute_file_name/2, 73 tmp_file_stream/3, % +Enc, -File, -Stream 74 call_with_depth_limit/3, % :Goal, +Limit, -Result 75 call_with_inference_limit/3, % :Goal, +Limit, -Result 76 rule/2, % :Head, -Rule 77 rule/3, % :Head, -Rule, ?Ref 78 numbervars/3, % +Term, +Start, -End 79 term_string/3, % ?Term, ?String, +Options 80 nb_setval/2, % +Var, +Value 81 thread_create/2, % :Goal, -Id 82 thread_join/1, % +Id 83 sig_block/1, % :Pattern 84 sig_unblock/1, % :Pattern 85 transaction/1, % :Goal 86 transaction/2, % :Goal, +Options 87 transaction/3, % :Goal, :Constraint, +Mutex 88 snapshot/1, % :Goal 89 undo/1, % :Goal 90 set_prolog_gc_thread/1, % +Status 91 92 '$wrap_predicate'/5 % :Head, +Name, -Closure, -Wrapped, +Body 93 ]). 94 95:- meta_predicate 96 dynamic(, ), 97 transaction(), 98 transaction(,,), 99 snapshot(), 100 rule(, ), 101 rule(, , ), 102 sig_block(), 103 sig_unblock(). 104 105 106 /******************************** 107 * DEBUGGER * 108 *********************************/
112:- meta_predicate 113 map_bits(, , , ). 114 115map_bits(_, Var, _, _) :- 116 var(Var), 117 !, 118 '$instantiation_error'(Var). 119map_bits(_, [], Bits, Bits) :- !. 120map_bits(Pred, [H|T], Old, New) :- 121 map_bits(Pred, H, Old, New0), 122 map_bits(Pred, T, New0, New). 123map_bits(Pred, +Name, Old, New) :- % set a bit 124 !, 125 bit(Pred, Name, Bits), 126 !, 127 New is Old \/ Bits. 128map_bits(Pred, -Name, Old, New) :- % clear a bit 129 !, 130 bit(Pred, Name, Bits), 131 !, 132 New is Old /\ (\Bits). 133map_bits(Pred, ?(Name), Old, Old) :- % ask a bit 134 !, 135 bit(Pred, Name, Bits), 136 Old /\ Bits > 0. 137map_bits(_, Term, _, _) :- 138 '$type_error'('+|-|?(Flag)', Term). 139 140bit(Pred, Name, Bits) :- 141 call(Pred, Name, Bits), 142 !. 143bit(_:Pred, Name, _) :- 144 '$domain_error'(Pred, Name). 145 146:- public port_name/2. % used by library(test_cover) 147 148port_name( call, 2'000000001). 149port_name( exit, 2'000000010). 150port_name( fail, 2'000000100). 151port_name( redo, 2'000001000). 152port_name( unify, 2'000010000). 153port_name( break, 2'000100000). 154port_name( cut_call, 2'001000000). 155port_name( cut_exit, 2'010000000). 156port_name( exception, 2'100000000). 157port_name( cut, 2'011000000). 158port_name( all, 2'000111111). 159port_name( full, 2'000101111). 160port_name( half, 2'000101101). % ' 161 162leash(Ports) :- 163 '$leash'(Old, Old), 164 map_bits(port_name, Ports, Old, New), 165 '$leash'(_, New). 166 167visible(Ports) :- 168 '$visible'(Old, Old), 169 map_bits(port_name, Ports, Old, New), 170 '$visible'(_, New). 171 172style_name(atom, 0x0001) :- 173 print_message(warning, decl_no_effect(style_check(atom))). 174style_name(singleton, 0x0042). % semantic and syntactic 175style_name(discontiguous, 0x0008). 176style_name(charset, 0x0020). 177style_name(no_effect, 0x0080). 178style_name(var_branches, 0x0100).
182style_check(Var) :- 183 var(Var), 184 !, 185 '$instantiation_error'(Var). 186style_check(?(Style)) :- 187 !, 188 ( var(Style) 189 -> enum_style_check(Style) 190 ; enum_style_check(Style) 191 -> true 192 ). 193style_check(Spec) :- 194 '$style_check'(Old, Old), 195 map_bits(style_name, Spec, Old, New), 196 '$style_check'(_, New). 197 198enum_style_check(Style) :- 199 '$style_check'(Bits, Bits), 200 style_name(Style, Bit), 201 Bit /\ Bits =\= 0.
209flag(Name, Old, New) :- 210 Old == New, 211 !, 212 get_flag(Name, Old). 213flag(Name, Old, New) :- 214 with_mutex('$flag', update_flag(Name, Old, New)). 215 216update_flag(Name, Old, New) :- 217 get_flag(Name, Old), 218 ( atom(New) 219 -> set_flag(Name, New) 220 ; Value is New, 221 set_flag(Name, Value) 222 ). 223 224 225 /******************************** 226 * ATOMS * 227 *********************************/ 228 229dwim_match(A1, A2) :- 230 dwim_match(A1, A2, _). 231 232atom_prefix(Atom, Prefix) :- 233 sub_atom(Atom, 0, _, _, Prefix). 234 235 236 /******************************** 237 * SOURCE * 238 *********************************/
Note that Time = 0.0 is used by PlDoc and other code that needs to create a file record without being interested in the time.
251source_file(File) :-
252 ( current_prolog_flag(access_level, user)
253 -> Level = user
254 ; true
255 ),
256 ( ground(File)
257 -> ( '$time_source_file'(File, Time, Level)
258 ; absolute_file_name(File, Abs),
259 '$time_source_file'(Abs, Time, Level)
260 ), !
261 ; '$time_source_file'(File, Time, Level)
262 ),
263 Time > 0.0.270:- meta_predicate source_file(, ). 271 272source_file(M:Head, File) :- 273 nonvar(M), nonvar(Head), 274 !, 275 ( '$c_current_predicate'(_, M:Head), 276 predicate_property(M:Head, multifile) 277 -> multi_source_files(M:Head, Files), 278 '$member'(File, Files) 279 ; '$source_file'(M:Head, File) 280 ). 281source_file(M:Head, File) :- 282 ( nonvar(File) 283 -> true 284 ; source_file(File) 285 ), 286 '$source_file_predicates'(File, Predicates), 287 '$member'(M:Head, Predicates). 288 289:- thread_local found_src_file/1. 290 291multi_source_files(Head, Files) :- 292 call_cleanup( 293 findall(File, multi_source_file(Head, File), Files), 294 retractall(found_src_file(_))). 295 296multi_source_file(Head, File) :- 297 nth_clause(Head, _, Clause), 298 clause_property(Clause, source(File)), 299 \+ found_src_file(File), 300 asserta(found_src_file(File)).
307source_file_property(File, P) :- 308 nonvar(File), 309 !, 310 canonical_source_file(File, Path), 311 property_source_file(P, Path). 312source_file_property(File, P) :- 313 property_source_file(P, File). 314 315property_source_file(modified(Time), File) :- 316 '$time_source_file'(File, Time, user). 317property_source_file(source(Source), File) :- 318 ( '$source_file_property'(File, from_state, true) 319 -> Source = state 320 ; '$source_file_property'(File, resource, true) 321 -> Source = resource 322 ; Source = file 323 ). 324property_source_file(module(M), File) :- 325 ( nonvar(M) 326 -> '$current_module'(M, File) 327 ; nonvar(File) 328 -> '$current_module'(ML, File), 329 ( atom(ML) 330 -> M = ML 331 ; '$member'(M, ML) 332 ) 333 ; '$current_module'(M, File) 334 ). 335property_source_file(load_context(Module, Location, Options), File) :- 336 '$time_source_file'(File, _, user), 337 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 338 ( clause_property(Ref, file(FromFile)), 339 clause_property(Ref, line_count(FromLine)) 340 -> Location = FromFile:FromLine 341 ; Location = user 342 ). 343property_source_file(includes(Master, Stamp), File) :- 344 system:'$included'(File, _Line, Master, Stamp). 345property_source_file(included_in(Master, Line), File) :- 346 system:'$included'(Master, Line, File, _). 347property_source_file(derived_from(DerivedFrom, Stamp), File) :- 348 system:'$derived_source'(File, DerivedFrom, Stamp). 349property_source_file(reloading, File) :- 350 source_file(File), 351 '$source_file_property'(File, reloading, true). 352property_source_file(load_count(Count), File) :- 353 source_file(File), 354 '$source_file_property'(File, load_count, Count). 355property_source_file(number_of_clauses(Count), File) :- 356 source_file(File), 357 '$source_file_property'(File, number_of_clauses, Count).
364canonical_source_file(Spec, File) :- 365 atom(Spec), 366 '$time_source_file'(Spec, _, _), 367 !, 368 File = Spec. 369canonical_source_file(Spec, File) :- 370 system:'$included'(_Master, _Line, Spec, _), 371 !, 372 File = Spec. 373canonical_source_file(Spec, File) :- 374 absolute_file_name(Spec, File, 375 [ file_type(prolog), 376 access(read), 377 file_errors(fail) 378 ]), 379 source_file(File).
:- if(exists_source(library(error))). :- use_module_library(error). :- endif.
396exists_source(Source) :- 397 exists_source(Source, _Path). 398 399exists_source(Source, Path) :- 400 absolute_file_name(Source, Path, 401 [ file_type(prolog), 402 access(read), 403 file_errors(fail) 404 ]).
413prolog_load_context(module, Module) :- 414 '$current_source_module'(Module). 415prolog_load_context(file, File) :- 416 input_file(File). 417prolog_load_context(source, F) :- % SICStus compatibility 418 input_file(F0), 419 '$input_context'(Context), 420 '$top_file'(Context, F0, F). 421prolog_load_context(stream, S) :- 422 ( system:'$load_input'(_, S0) 423 -> S = S0 424 ). 425prolog_load_context(directory, D) :- 426 input_file(F), 427 file_directory_name(F, D). 428prolog_load_context(dialect, D) :- 429 current_prolog_flag(emulated_dialect, D). 430prolog_load_context(term_position, TermPos) :- 431 source_location(_, L), 432 ( nb_current('$term_position', Pos), 433 compound(Pos), % actually set 434 stream_position_data(line_count, Pos, L) 435 -> TermPos = Pos 436 ; TermPos = '$stream_position'(0,L,0,0) 437 ). 438prolog_load_context(script, Bool) :- 439 ( '$toplevel':loaded_init_file(script, Path), 440 input_file(File), 441 same_file(File, Path) 442 -> Bool = true 443 ; Bool = false 444 ). 445prolog_load_context(variable_names, Bindings) :- 446 ( nb_current('$variable_names', Bindings0) 447 -> Bindings = Bindings0 448 ; Bindings = [] 449 ). 450prolog_load_context(term, Term) :- 451 nb_current('$term', Term). 452prolog_load_context(reloading, true) :- 453 prolog_load_context(source, F), 454 '$source_file_property'(F, reloading, true). 455 456input_file(File) :- 457 ( system:'$load_input'(_, Stream) 458 -> stream_property(Stream, file_name(File)) 459 ), 460 !. 461input_file(File) :- 462 source_location(File, _).
469:- dynamic system:'$resolved_source_path'/2. 470 471unload_file(File) :- 472 ( canonical_source_file(File, Path) 473 -> '$unload_file'(Path), 474 retractall(system:'$resolved_source_path'(_, Path)) 475 ; true 476 ). 477 478:- if(current_prolog_flag(open_shared_object, true)). 479 480 /******************************* 481 * FOREIGN LIBRARIES * 482 *******************************/
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.
501:- meta_predicate 502 use_foreign_library(), 503 use_foreign_library(, ). 504:- public 505 use_foreign_library_noi/1. 506 507use_foreign_library(FileSpec) :- 508 ensure_shlib, 509 initialization(use_foreign_library_noi(FileSpec), now). 510 511% noi -> no initialize; used by '$autoload':exports/3. 512use_foreign_library_noi(FileSpec) :- 513 ensure_shlib, 514 shlib:load_foreign_library(FileSpec). 515 516use_foreign_library(FileSpec, Options) :- 517 ensure_shlib, 518 initialization(shlib:load_foreign_library(FileSpec, Options), now). 519 520ensure_shlib :- 521 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 522 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 523 !. 524ensure_shlib :- 525 use_module(library(shlib), []). 526 527:- export(use_foreign_library/1). 528:- export(use_foreign_library/2). 529 530:- elif(current_predicate('$activate_static_extension'/1)). 531 532% Version when using shared objects is disabled and extensions are added 533% as static libraries. 534 535:- meta_predicate 536 use_foreign_library(). 537:- public 538 use_foreign_library_noi/1. 539:- dynamic 540 loading/1, 541 foreign_predicate/2. 542 543use_foreign_library(FileSpec) :- 544 initialization(use_foreign_library_noi(FileSpec), now). 545 546use_foreign_library_noi(Module:foreign(Extension)) :- 547 setup_call_cleanup( 548 asserta(loading(foreign(Extension)), Ref), 549 @('$activate_static_extension'(Extension), Module), 550 erase(Ref)). 551 552:- export(use_foreign_library/1). 553 554system:'$foreign_registered'(M, H) :- 555 ( loading(Lib) 556 -> true 557 ; Lib = '<spontaneous>' 558 ), 559 assert(foreign_predicate(Lib, M:H)).
565current_foreign_library(File, Public) :- 566 setof(Pred, foreign_predicate(File, Pred), Public). 567 568:- export(current_foreign_library/2). 569 570:- endif. /* open_shared_object support */ 571 572 /******************************* 573 * STREAMS * 574 *******************************/
581stream_position_data(Prop, Term, Value) :- 582 nonvar(Prop), 583 !, 584 ( stream_position_field(Prop, Pos) 585 -> arg(Pos, Term, Value) 586 ; throw(error(domain_error(stream_position_data, Prop))) 587 ). 588stream_position_data(Prop, Term, Value) :- 589 stream_position_field(Prop, Pos), 590 arg(Pos, Term, Value). 591 592stream_position_field(char_count, 1). 593stream_position_field(line_count, 2). 594stream_position_field(line_position, 3). 595stream_position_field(byte_count, 4). 596 597 598 /******************************* 599 * CONTROL * 600 *******************************/
608:- meta_predicate 609 call_with_depth_limit(, , ). 610 611call_with_depth_limit(G, Limit, Result) :- 612 '$depth_limit'(Limit, OLimit, OReached), 613 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 614 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 615 ( Det == ! -> ! ; true ) 616 ; '$depth_limit_false'(OLimit, OReached, Result) 617 ).
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.
630:- meta_predicate 631 call_with_inference_limit(, , ). 632 633call_with_inference_limit(G, Limit, Result) :- 634 '$inference_limit'(Limit, OLimit), 635 ( catch(G, Except, 636 system:'$inference_limit_except'(OLimit, Except, Result0)), 637 ( Result0 == inference_limit_exceeded 638 -> ! 639 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 640 ( Result0 == ! -> ! ; true ) 641 ), 642 Result = Result0 643 ; system:'$inference_limit_false'(OLimit) 644 ). 645 646 647 /******************************** 648 * DATA BASE * 649 *********************************/ 650 651/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 652The predicate current_predicate/2 is a difficult subject since the 653introduction of defaulting modules and dynamic libraries. 654current_predicate/2 is normally called with instantiated arguments to 655verify some predicate can be called without trapping an undefined 656predicate. In this case we must perform the search algorithm used by 657the prolog system itself. 658 659If the pattern is not fully specified, we only generate the predicates 660actually available in this module. This seems the best for listing, 661etc. 662- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 663 664 665:- meta_predicate 666 current_predicate(, ), 667 '$defined_predicate'(). 668 669current_predicate(Name, Module:Head) :- 670 (var(Module) ; var(Head)), 671 !, 672 generate_current_predicate(Name, Module, Head). 673current_predicate(Name, Term) :- 674 '$c_current_predicate'(Name, Term), 675 '$defined_predicate'(Term), 676 !. 677current_predicate(Name, Module:Head) :- 678 default_module(Module, DefModule), 679 '$c_current_predicate'(Name, DefModule:Head), 680 '$defined_predicate'(DefModule:Head), 681 !. 682current_predicate(Name, Module:Head) :- 683 '$autoload':autoload_in(Module, general), 684 \+ current_prolog_flag(Moduleunknown, fail), 685 ( compound(Head) 686 -> compound_name_arity(Head, Name, Arity) 687 ; Name = Head, Arity = 0 688 ), 689 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 690 !. 691 692generate_current_predicate(Name, Module, Head) :- 693 current_module(Module), 694 QHead = Module:Head, 695 '$c_current_predicate'(Name, QHead), 696 '$get_predicate_attribute'(QHead, defined, 1). 697 698'$defined_predicate'(Head) :- 699 '$get_predicate_attribute'(Head, defined, 1), 700 !.
706:- meta_predicate 707 predicate_property(, ). 708 709:- multifile 710 '$predicate_property'/2. 711 712:- '$iso'(predicate_property/2). 713 714predicate_property(Pred, Property) :- % Mode ?,+ 715 nonvar(Property), 716 !, 717 property_predicate(Property, Pred). 718predicate_property(Pred, Property) :- % Mode +,- 719 define_or_generate(Pred), 720 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.728property_predicate(undefined, Pred) :- 729 !, 730 Pred = Module:Head, 731 current_module(Module), 732 '$c_current_predicate'(_, Pred), 733 \+ '$defined_predicate'(Pred), % Speed up a bit 734 \+ current_predicate(_, Pred), 735 goal_name_arity(Head, Name, Arity), 736 \+ system_undefined(Module:Name/Arity). 737property_predicate(visible, Pred) :- 738 !, 739 visible_predicate(Pred). 740property_predicate(autoload(File), Head) :- 741 !, 742 \+ current_prolog_flag(autoload, false), 743 '$autoload':autoloadable(Head, File). 744property_predicate(implementation_module(IM), M:Head) :- 745 !, 746 atom(M), 747 ( default_module(M, DM), 748 '$get_predicate_attribute'(DM:Head, defined, 1) 749 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 750 -> IM = ImportM 751 ; IM = M 752 ) 753 ; \+ current_prolog_flag(Munknown, fail), 754 goal_name_arity(Head, Name, Arity), 755 '$find_library'(_, Name, Arity, LoadModule, _File) 756 -> IM = LoadModule 757 ; M = IM 758 ). 759property_predicate(iso, _:Head) :- 760 callable(Head), 761 !, 762 goal_name_arity(Head, Name, Arity), 763 current_predicate(system:Name/Arity), 764 '$predicate_property'(iso, system:Head). 765property_predicate(built_in, Module:Head) :- 766 callable(Head), 767 !, 768 goal_name_arity(Head, Name, Arity), 769 current_predicate(Module:Name/Arity), 770 '$predicate_property'(built_in, Module:Head). 771property_predicate(Property, Pred) :- 772 define_or_generate(Pred), 773 '$predicate_property'(Property, Pred). 774 775goal_name_arity(Head, Name, Arity) :- 776 compound(Head), 777 !, 778 compound_name_arity(Head, Name, Arity). 779goal_name_arity(Head, Head, 0).
788define_or_generate(M:Head) :- 789 callable(Head), 790 atom(M), 791 '$get_predicate_attribute'(M:Head, defined, 1), 792 !. 793define_or_generate(M:Head) :- 794 callable(Head), 795 nonvar(M), M \== system, 796 !, 797 '$define_predicate'(M:Head). 798define_or_generate(Pred) :- 799 current_predicate(_, Pred), 800 '$define_predicate'(Pred). 801 802 803'$predicate_property'(interpreted, Pred) :- 804 '$get_predicate_attribute'(Pred, foreign, 0). 805'$predicate_property'(visible, Pred) :- 806 '$get_predicate_attribute'(Pred, defined, 1). 807'$predicate_property'(built_in, Pred) :- 808 '$get_predicate_attribute'(Pred, system, 1). 809'$predicate_property'(exported, Pred) :- 810 '$get_predicate_attribute'(Pred, exported, 1). 811'$predicate_property'(public, Pred) :- 812 '$get_predicate_attribute'(Pred, public, 1). 813'$predicate_property'(non_terminal, Pred) :- 814 '$get_predicate_attribute'(Pred, non_terminal, 1). 815'$predicate_property'(foreign, Pred) :- 816 '$get_predicate_attribute'(Pred, foreign, 1). 817'$predicate_property'((dynamic), Pred) :- 818 '$get_predicate_attribute'(Pred, (dynamic), 1). 819'$predicate_property'((static), Pred) :- 820 '$get_predicate_attribute'(Pred, (dynamic), 0). 821'$predicate_property'((volatile), Pred) :- 822 '$get_predicate_attribute'(Pred, (volatile), 1). 823'$predicate_property'((thread_local), Pred) :- 824 '$get_predicate_attribute'(Pred, (thread_local), 1). 825'$predicate_property'((multifile), Pred) :- 826 '$get_predicate_attribute'(Pred, (multifile), 1). 827'$predicate_property'((discontiguous), Pred) :- 828 '$get_predicate_attribute'(Pred, (discontiguous), 1). 829'$predicate_property'(imported_from(Module), Pred) :- 830 '$get_predicate_attribute'(Pred, imported, Module). 831'$predicate_property'(transparent, Pred) :- 832 '$get_predicate_attribute'(Pred, transparent, 1). 833'$predicate_property'(meta_predicate(Pattern), Pred) :- 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 885system_undefined(user:prolog_trace_interception/4). 886system_undefined(prolog:prolog_exception_hook/5). 887system_undefined(system:'$c_call_prolog'/0). 888system_undefined(system:window_title/2). 889 890table_flag(variant, Pred) :- 891 '$tbl_implementation'(Pred, M:Head), 892 M:'$tabled'(Head, variant). 893table_flag(subsumptive, Pred) :- 894 '$tbl_implementation'(Pred, M:Head), 895 M:'$tabled'(Head, subsumptive). 896table_flag(shared, Pred) :- 897 '$get_predicate_attribute'(Pred, tshared, 1). 898table_flag(incremental, Pred) :- 899 '$get_predicate_attribute'(Pred, incremental, 1). 900table_flag(monotonic, Pred) :- 901 '$get_predicate_attribute'(Pred, monotonic, 1). 902table_flag(subgoal_abstract(N), Pred) :- 903 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 904table_flag(answer_abstract(N), Pred) :- 905 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 906table_flag(subgoal_abstract(N), Pred) :- 907 '$get_predicate_attribute'(Pred, max_answers, N).
916visible_predicate(Pred) :- 917 Pred = M:Head, 918 current_module(M), 919 ( callable(Head) 920 -> ( '$get_predicate_attribute'(Pred, defined, 1) 921 -> true 922 ; \+ current_prolog_flag(Munknown, fail), 923 '$head_name_arity'(Head, Name, Arity), 924 '$find_library'(M, Name, Arity, _LoadModule, _Library) 925 ) 926 ; setof(PI, visible_in_module(M, PI), PIs), 927 '$member'(Name/Arity, PIs), 928 functor(Head, Name, Arity) 929 ). 930 931visible_in_module(M, Name/Arity) :- 932 default_module(M, DefM), 933 DefHead = DefM:Head, 934 '$c_current_predicate'(_, DefHead), 935 '$get_predicate_attribute'(DefHead, defined, 1), 936 \+ hidden_system_predicate(Head), 937 functor(Head, Name, Arity). 938visible_in_module(_, Name/Arity) :- 939 '$in_library'(Name, Arity, _). 940 (Head) :- 942 functor(Head, Name, _), 943 atom(Name), % Avoid []. 944 sub_atom(Name, 0, _, _, $), 945 \+ current_prolog_flag(access_level, system).
true.970clause_property(Clause, Property) :- 971 '$clause_property'(Property, Clause). 972 973'$clause_property'(line_count(LineNumber), Clause) :- 974 '$get_clause_attribute'(Clause, line_count, LineNumber). 975'$clause_property'(file(File), Clause) :- 976 '$get_clause_attribute'(Clause, file, File). 977'$clause_property'(source(File), Clause) :- 978 '$get_clause_attribute'(Clause, owner, File). 979'$clause_property'(size(Bytes), Clause) :- 980 '$get_clause_attribute'(Clause, size, Bytes). 981'$clause_property'(fact, Clause) :- 982 '$get_clause_attribute'(Clause, fact, true). 983'$clause_property'(erased, Clause) :- 984 '$get_clause_attribute'(Clause, erased, true). 985'$clause_property'(predicate(PI), Clause) :- 986 '$get_clause_attribute'(Clause, predicate_indicator, PI). 987'$clause_property'(module(M), Clause) :- 988 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)abstract(+Level)multifile(+Bool)discontiguous(+Bool)thread(+Mode)volatile(+Bool)1002dynamic(M:Predicates, Options) :- 1003 '$must_be'(list, Predicates), 1004 options_properties(Options, Props), 1005 set_pprops(Predicates, M, [dynamic|Props]). 1006 1007set_pprops([], _, _). 1008set_pprops([H|T], M, Props) :- 1009 set_pprops1(Props, M:H), 1010 strip_module(M:H, M2, P), 1011 '$pi_head'(M2:P, Pred), 1012 '$set_table_wrappers'(Pred), 1013 set_pprops(T, M, Props). 1014 1015set_pprops1([], _). 1016set_pprops1([H|T], P) :- 1017 ( atom(H) 1018 -> '$set_predicate_attribute'(P, H, true) 1019 ; H =.. [Name,Value] 1020 -> '$set_predicate_attribute'(P, Name, Value) 1021 ), 1022 set_pprops1(T, P). 1023 1024options_properties(Options, Props) :- 1025 G = opt_prop(_,_,_,_), 1026 findall(G, G, Spec), 1027 options_properties(Spec, Options, Props). 1028 1029options_properties([], _, []). 1030options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1031 Options, [Prop|PT]) :- 1032 Opt =.. [Name,V], 1033 '$option'(Opt, Options), 1034 '$must_be'(Type, V), 1035 V = SetValue, 1036 !, 1037 options_properties(T, Options, PT). 1038options_properties([_|T], Options, PT) :- 1039 options_properties(T, Options, PT). 1040 1041opt_prop(incremental, boolean, Bool, incremental(Bool)). 1042opt_prop(abstract, between(0,0), 0, abstract). 1043opt_prop(multifile, boolean, true, multifile). 1044opt_prop(discontiguous, boolean, true, discontiguous). 1045opt_prop(volatile, boolean, true, volatile). 1046opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1047 local, thread_local). 1048 1049 /******************************** 1050 * MODULES * 1051 *********************************/
1057current_module(Module) :-
1058 '$current_module'(Module, _).1074module_property(Module, Property) :- 1075 nonvar(Module), nonvar(Property), 1076 !, 1077 property_module(Property, Module). 1078module_property(Module, Property) :- % -, file(File) 1079 nonvar(Property), Property = file(File), 1080 !, 1081 ( nonvar(File) 1082 -> '$current_module'(Modules, File), 1083 ( atom(Modules) 1084 -> Module = Modules 1085 ; '$member'(Module, Modules) 1086 ) 1087 ; '$current_module'(Module, File), 1088 File \== [] 1089 ). 1090module_property(Module, Property) :- 1091 current_module(Module), 1092 property_module(Property, Module). 1093 1094property_module(Property, Module) :- 1095 module_property(Property), 1096 ( Property = exported_operators(List) 1097 -> '$exported_ops'(Module, List, []) 1098 ; '$module_property'(Module, Property) 1099 ). 1100 1101module_property(class(_)). 1102module_property(file(_)). 1103module_property(line_count(_)). 1104module_property(exports(_)). 1105module_property(exported_operators(_)). 1106module_property(size(_)). 1107module_property(program_size(_)). 1108module_property(program_space(_)). 1109module_property(last_modified_generation(_)).
1115module(Module) :- 1116 atom(Module), 1117 current_module(Module), 1118 !, 1119 '$set_typein_module'(Module). 1120module(Module) :- 1121 '$set_typein_module'(Module), 1122 print_message(warning, no_current_module(Module)).
1129working_directory(Old, New) :- 1130 '$cwd'(Old), 1131 ( Old == New 1132 -> true 1133 ; '$chdir'(New) 1134 ). 1135 1136 1137 /******************************* 1138 * TRIES * 1139 *******************************/
1145current_trie(Trie) :-
1146 current_blob(Trie, trie),
1147 is_trie(Trie).Incremental tabling statistics:
Shared tabling statistics:
1183trie_property(Trie, Property) :- 1184 current_trie(Trie), 1185 trie_property(Property), 1186 '$trie_property'(Trie, Property). 1187 1188trie_property(node_count(_)). 1189trie_property(value_count(_)). 1190trie_property(size(_)). 1191trie_property(hashed(_)). 1192trie_property(compiled_size(_)). 1193 % below only when -DO_TRIE_STATS 1194trie_property(lookup_count(_)). % is enabled in pl-trie.h 1195trie_property(gen_call_count(_)). 1196trie_property(invalidated(_)). % IDG stats 1197trie_property(reevaluated(_)). 1198trie_property(deadlock(_)). % Shared tabling stats 1199trie_property(wait(_)). 1200trie_property(idg_affected_count(_)). 1201trie_property(idg_dependent_count(_)). 1202trie_property(idg_size(_)). 1203 1204 1205 /******************************** 1206 * SYSTEM INTERACTION * 1207 *********************************/ 1208 1209shell(Command) :- 1210 shell(Command, 0). 1211 1212 1213 /******************************* 1214 * SIGNALS * 1215 *******************************/ 1216 1217:- meta_predicate 1218 on_signal(, , ), 1219 current_signal(, , ).
1223on_signal(Signal, Old, New) :- 1224 atom(Signal), 1225 !, 1226 '$on_signal'(_Num, Signal, Old, New). 1227on_signal(Signal, Old, New) :- 1228 integer(Signal), 1229 !, 1230 '$on_signal'(Signal, _Name, Old, New). 1231on_signal(Signal, _Old, _New) :- 1232 '$type_error'(signal_name, Signal).
1236current_signal(Name, Id, Handler) :- 1237 between(1, 32, Id), 1238 '$on_signal'(Id, Name, Handler, Handler). 1239 1240:- multifile 1241 prolog:called_by/2. 1242 1243prologcalled_by(on_signal(_,_,New), [New+1]) :- 1244 ( new == throw 1245 ; new == default 1246 ), !, fail. 1247 1248 1249 /******************************* 1250 * I/O * 1251 *******************************/ 1252 1253format(Fmt) :- 1254 format(Fmt, []). 1255 1256 /******************************* 1257 * FILES * 1258 *******************************/
1262absolute_file_name(Name, Abs) :- 1263 atomic(Name), 1264 !, 1265 '$absolute_file_name'(Name, Abs). 1266absolute_file_name(Term, Abs) :- 1267 '$chk_file'(Term, [''], [access(read)], true, File), 1268 !, 1269 '$absolute_file_name'(File, Abs). 1270absolute_file_name(Term, Abs) :- 1271 '$chk_file'(Term, [''], [], true, File), 1272 !, 1273 '$absolute_file_name'(File, Abs).
1281tmp_file_stream(Enc, File, Stream) :- 1282 atom(Enc), var(File), var(Stream), 1283 !, 1284 '$tmp_file_stream'('', Enc, File, Stream). 1285tmp_file_stream(File, Stream, Options) :- 1286 current_prolog_flag(encoding, DefEnc), 1287 '$option'(encoding(Enc), Options, DefEnc), 1288 '$option'(extension(Ext), Options, ''), 1289 '$tmp_file_stream'(Ext, Enc, File, Stream), 1290 set_stream(Stream, file_name(File)). 1291 1292 1293 /******************************** 1294 * MEMORY MANAGEMENT * 1295 *********************************/
1304garbage_collect :-
1305 '$garbage_collect'(0).
1311set_prolog_stack(Stack, Option) :-
1312 Option =.. [Name,Value0],
1313 Value is Value0,
1314 '$set_prolog_stack'(Stack, Name, _Old, Value).1320prolog_stack_property(Stack, Property) :- 1321 stack_property(P), 1322 stack_name(Stack), 1323 Property =.. [P,Value], 1324 '$set_prolog_stack'(Stack, P, Value, Value). 1325 1326stack_name(local). 1327stack_name(global). 1328stack_name(trail). 1329 1330stack_property(limit). 1331stack_property(spare). 1332stack_property(min_free). 1333stack_property(low). 1334stack_property(factor). 1335 1336 1337 /******************************* 1338 * CLAUSE * 1339 *******************************/
:-
as neck.1347rule(Head, Rule) :- 1348 '$rule'(Head, Rule0), 1349 conditional_rule(Rule0, Rule1), 1350 Rule = Rule1. 1351rule(Head, Rule, Ref) :- 1352 '$rule'(Head, Rule0, Ref), 1353 conditional_rule(Rule0, Rule1), 1354 Rule = Rule1. 1355 1356conditional_rule(?=>(Head, (!, Body)), Rule) => 1357 Rule = (Head => Body). 1358conditional_rule(?=>(Head, !), Rule) => 1359 Rule = (Head => true). 1360conditional_rule(?=>(Head, Body0), Rule), 1361 split_on_cut(Body0, Cond, Body) => 1362 Rule = (Head,Cond=>Body). 1363conditional_rule(Head, Rule) => 1364 Rule = Head. 1365 1366split_on_cut((Cond0,!,Body0), Cond, Body) => 1367 Cond = Cond0, 1368 Body = Body0. 1369split_on_cut((!,Body0), Cond, Body) => 1370 Cond = true, 1371 Body = Body0. 1372split_on_cut((A,B), Cond, Body) => 1373 Cond = (A,Cond1), 1374 split_on_cut(B, Cond1, Body). 1375split_on_cut(_, _, _) => 1376 fail. 1377 1378 1379 /******************************* 1380 * TERM * 1381 *******************************/ 1382 1383:- '$iso'((numbervars/3)).
1391numbervars(Term, From, To) :- 1392 numbervars(Term, From, To, []). 1393 1394 1395 /******************************* 1396 * STRING * 1397 *******************************/
1403term_string(Term, String, Options) :- 1404 nonvar(String), 1405 !, 1406 read_term_from_atom(String, Term, Options). 1407term_string(Term, String, Options) :- 1408 ( '$option'(quoted(_), Options) 1409 -> Options1 = Options 1410 ; '$merge_options'(_{quoted:true}, Options, Options1) 1411 ), 1412 format(string(String), '~W', [Term, Options1]). 1413 1414 1415 /******************************* 1416 * GVAR * 1417 *******************************/
1423nb_setval(Name, Value) :- 1424 duplicate_term(Value, Copy), 1425 nb_linkval(Name, Copy). 1426 1427 1428 /******************************* 1429 * THREADS * 1430 *******************************/ 1431 1432:- meta_predicate 1433 thread_create(, ).
thread_create(Goal, Id, []).
1439thread_create(Goal, Id) :-
1440 thread_create(Goal, Id, []).
1449thread_join(Id) :-
1450 thread_join(Id, Status),
1451 ( Status == true
1452 -> true
1453 ; throw(error(thread_error(Id, Status), _))
1454 ).1464sig_block(Pattern) :- 1465 ( nb_current('$sig_blocked', List) 1466 -> true 1467 ; List = [] 1468 ), 1469 nb_setval('$sig_blocked', [Pattern|List]). 1470 1471sig_unblock(Pattern) :- 1472 ( nb_current('$sig_blocked', List) 1473 -> unblock(List, Pattern, NewList), 1474 ( List == NewList 1475 -> true 1476 ; nb_setval('$sig_blocked', NewList), 1477 '$sig_unblock' 1478 ) 1479 ; true 1480 ). 1481 1482unblock([], _, []). 1483unblock([H|T], P, List) :- 1484 ( subsumes_term(P, H) 1485 -> unblock(T, P, List) 1486 ; List = [H|T1], 1487 unblock(T, P, T1) 1488 ). 1489 1490:- public signal_is_blocked/1. % called by signal_is_blocked() 1491 1492signal_is_blocked(Head) :- 1493 nb_current('$sig_blocked', List), 1494 '$member'(Head, List), 1495 !.
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.1512set_prolog_gc_thread(Status) :- 1513 var(Status), 1514 !, 1515 '$instantiation_error'(Status). 1516set_prolog_gc_thread(_) :- 1517 \+ current_prolog_flag(threads, true), 1518 !. 1519set_prolog_gc_thread(false) :- 1520 !, 1521 set_prolog_flag(gc_thread, false), 1522 ( current_prolog_flag(threads, true) 1523 -> ( '$gc_stop' 1524 -> thread_join(gc) 1525 ; true 1526 ) 1527 ; true 1528 ). 1529set_prolog_gc_thread(true) :- 1530 !, 1531 set_prolog_flag(gc_thread, true). 1532set_prolog_gc_thread(stop) :- 1533 !, 1534 ( current_prolog_flag(threads, true) 1535 -> ( '$gc_stop' 1536 -> thread_join(gc) 1537 ; true 1538 ) 1539 ; true 1540 ). 1541set_prolog_gc_thread(Status) :- 1542 '$domain_error'(gc_thread, Status).
1551transaction(Goal) :- 1552 '$transaction'(Goal, []). 1553transaction(Goal, Options) :- 1554 '$transaction'(Goal, Options). 1555transaction(Goal, Constraint, Mutex) :- 1556 '$transaction'(Goal, Constraint, Mutex). 1557snapshot(Goal) :- 1558 '$snapshot'(Goal). 1559 1560 1561 /******************************* 1562 * UNDO * 1563 *******************************/ 1564 1565:- meta_predicate 1566 undo().
1573undo(Goal) :- 1574 '$undo'(Goal). 1575 1576:- public 1577 '$run_undo'/1. 1578 1579'$run_undo'([One]) :- 1580 !, 1581 ( call(One) 1582 -> true 1583 ; true 1584 ). 1585'$run_undo'(List) :- 1586 run_undo(List, _, Error), 1587 ( var(Error) 1588 -> true 1589 ; throw(Error) 1590 ). 1591 1592run_undo([], E, E). 1593run_undo([H|T], E0, E) :- 1594 ( catch(H, E1, true) 1595 -> ( var(E1) 1596 -> true 1597 ; '$urgent_exception'(E0, E1, E2) 1598 ) 1599 ; true 1600 ), 1601 run_undo(T, E2, E).
1609:- meta_predicate 1610 '$wrap_predicate'(, , , , ). 1611 1612'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1613 callable_name_arguments(Head, PName, Args), 1614 callable_name_arity(Head, PName, Arity), 1615 ( is_most_general_term(Head) 1616 -> true 1617 ; '$domain_error'(most_general_term, Head) 1618 ), 1619 atomic_list_concat(['$wrap$', PName], WrapName), 1620 volatile(M:WrapName/Arity), 1621 module_transparent(M:WrapName/Arity), 1622 WHead =.. [WrapName|Args], 1623 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)). 1624 1625callable_name_arguments(Head, PName, Args) :- 1626 atom(Head), 1627 !, 1628 PName = Head, 1629 Args = []. 1630callable_name_arguments(Head, PName, Args) :- 1631 compound_name_arguments(Head, PName, Args). 1632 1633callable_name_arity(Head, PName, Arity) :- 1634 atom(Head), 1635 !, 1636 PName = Head, 1637 Arity = 0. 1638callable_name_arity(Head, PName, Arity) :- 1639 compound_name_arity(Head, PName, Arity)