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 * DLOPEN * 482 *******************************/
now
Resolve all symbols in the file now instead of lazily.global
Make new symbols globally known.496open_shared_object(File, Handle) :- 497 open_shared_object(File, Handle, []). % use pl-load.c defaults 498 499open_shared_object(File, Handle, Flags) :- 500 ( is_list(Flags) 501 -> true 502 ; throw(error(type_error(list, Flags), _)) 503 ), 504 map_dlflags(Flags, Mask), 505 '$open_shared_object'(File, Handle, Mask). 506 507dlopen_flag(now, 2'01). % see pl-load.c for these constants 508dlopen_flag(global, 2'10). % Solaris only 509 510map_dlflags([], 0). 511map_dlflags([F|T], M) :- 512 map_dlflags(T, M0), 513 ( dlopen_flag(F, I) 514 -> true 515 ; throw(error(domain_error(dlopen_flag, F), _)) 516 ), 517 M is M0 \/ I. 518 519:- export(open_shared_object/2). 520:- export(open_shared_object/3). 521 522 523 /******************************* 524 * FOREIGN LIBRARIES * 525 *******************************/
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.
544:- meta_predicate 545 use_foreign_library( ), 546 use_foreign_library( , ). 547:- public 548 use_foreign_library_noi/1. 549 550use_foreign_library(FileSpec) :- 551 ensure_shlib, 552 initialization(use_foreign_library_noi(FileSpec), now). 553 554% noi -> no initialize; used by '$autoload':exports/3. 555use_foreign_library_noi(FileSpec) :- 556 ensure_shlib, 557 shlib:load_foreign_library(FileSpec). 558 559use_foreign_library(FileSpec, Entry) :- 560 ensure_shlib, 561 initialization(shlib:load_foreign_library(FileSpec, Entry), now). 562 563ensure_shlib :- 564 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 565 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 566 !. 567ensure_shlib :- 568 use_module(library(shlib), []). 569 570:- export(use_foreign_library/1). 571:- export(use_foreign_library/2). 572 573:- elif(current_predicate('$activate_static_extension'/1)). 574 575% Version when using shared objects is disabled and extensions are added 576% as static libraries. 577 578:- meta_predicate 579 use_foreign_library( ). 580:- public 581 use_foreign_library_noi/1. 582:- dynamic 583 loading/1, 584 foreign_predicate/2. 585 586use_foreign_library(FileSpec) :- 587 initialization(use_foreign_library_noi(FileSpec), now). 588 589use_foreign_library_noi(Module:foreign(Extension)) :- 590 setup_call_cleanup( 591 asserta(loading(foreign(Extension)), Ref), 592 @('$activate_static_extension'(Extension), Module), 593 erase(Ref)). 594 595:- export(use_foreign_library/1). 596 597system:'$foreign_registered'(M, H) :- 598 ( loading(Lib) 599 -> true 600 ; Lib = '<spontaneous>' 601 ), 602 assert(foreign_predicate(Lib, M:H)).
608current_foreign_library(File, Public) :- 609 setof(Pred, foreign_predicate(File, Pred), Public). 610 611:- export(current_foreign_library/2). 612 613:- endif. /* open_shared_object support */ 614 615 /******************************* 616 * STREAMS * 617 *******************************/
624stream_position_data(Prop, Term, Value) :- 625 nonvar(Prop), 626 !, 627 ( stream_position_field(Prop, Pos) 628 -> arg(Pos, Term, Value) 629 ; throw(error(domain_error(stream_position_data, Prop))) 630 ). 631stream_position_data(Prop, Term, Value) :- 632 stream_position_field(Prop, Pos), 633 arg(Pos, Term, Value). 634 635stream_position_field(char_count, 1). 636stream_position_field(line_count, 2). 637stream_position_field(line_position, 3). 638stream_position_field(byte_count, 4). 639 640 641 /******************************* 642 * CONTROL * 643 *******************************/
651:- meta_predicate 652 call_with_depth_limit( , , ). 653 654call_with_depth_limit(G, Limit, Result) :- 655 '$depth_limit'(Limit, OLimit, OReached), 656 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 657 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 658 ( Det == ! -> ! ; true ) 659 ; '$depth_limit_false'(OLimit, OReached, Result) 660 ).
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.
673:- meta_predicate 674 call_with_inference_limit( , , ). 675 676call_with_inference_limit(G, Limit, Result) :- 677 '$inference_limit'(Limit, OLimit), 678 ( catch(G, Except, 679 system:'$inference_limit_except'(OLimit, Except, Result0)), 680 ( Result0 == inference_limit_exceeded 681 -> ! 682 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 683 ( Result0 == ! -> ! ; true ) 684 ), 685 Result = Result0 686 ; system:'$inference_limit_false'(OLimit) 687 ). 688 689 690 /******************************** 691 * DATA BASE * 692 *********************************/ 693 694/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 695The predicate current_predicate/2 is a difficult subject since the 696introduction of defaulting modules and dynamic libraries. 697current_predicate/2 is normally called with instantiated arguments to 698verify some predicate can be called without trapping an undefined 699predicate. In this case we must perform the search algorithm used by 700the prolog system itself. 701 702If the pattern is not fully specified, we only generate the predicates 703actually available in this module. This seems the best for listing, 704etc. 705- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 706 707 708:- meta_predicate 709 current_predicate( , ), 710 '$defined_predicate'( ). 711 712current_predicate(Name, Module:Head) :- 713 (var(Module) ; var(Head)), 714 !, 715 generate_current_predicate(Name, Module, Head). 716current_predicate(Name, Term) :- 717 '$c_current_predicate'(Name, Term), 718 '$defined_predicate'(Term), 719 !. 720current_predicate(Name, Module:Head) :- 721 default_module(Module, DefModule), 722 '$c_current_predicate'(Name, DefModule:Head), 723 '$defined_predicate'(DefModule:Head), 724 !. 725current_predicate(Name, Module:Head) :- 726 '$autoload':autoload_in(Module, general), 727 \+ current_prolog_flag(Moduleunknown, fail), 728 ( compound(Head) 729 -> compound_name_arity(Head, Name, Arity) 730 ; Name = Head, Arity = 0 731 ), 732 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 733 !. 734 735generate_current_predicate(Name, Module, Head) :- 736 current_module(Module), 737 QHead = Module:Head, 738 '$c_current_predicate'(Name, QHead), 739 '$get_predicate_attribute'(QHead, defined, 1). 740 741'$defined_predicate'(Head) :- 742 '$get_predicate_attribute'(Head, defined, 1), 743 !.
749:- meta_predicate 750 predicate_property( , ). 751 752:- multifile 753 '$predicate_property'/2. 754 755:- '$iso'(predicate_property/2). 756 757predicate_property(Pred, Property) :- % Mode ?,+ 758 nonvar(Property), 759 !, 760 property_predicate(Property, Pred). 761predicate_property(Pred, Property) :- % Mode +,- 762 define_or_generate(Pred), 763 '$predicate_property'(Property, Pred).
undefined
, visible
and
autoload
, followed by the generic case.771property_predicate(undefined, Pred) :- 772 !, 773 Pred = Module:Head, 774 current_module(Module), 775 '$c_current_predicate'(_, Pred), 776 \+ '$defined_predicate'(Pred), % Speed up a bit 777 \+ current_predicate(_, Pred), 778 goal_name_arity(Head, Name, Arity), 779 \+ system_undefined(Module:Name/Arity). 780property_predicate(visible, Pred) :- 781 !, 782 visible_predicate(Pred). 783property_predicate(autoload(File), Head) :- 784 !, 785 \+ current_prolog_flag(autoload, false), 786 '$autoload':autoloadable(Head, File). 787property_predicate(implementation_module(IM), M:Head) :- 788 !, 789 atom(M), 790 ( default_module(M, DM), 791 '$get_predicate_attribute'(DM:Head, defined, 1) 792 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 793 -> IM = ImportM 794 ; IM = M 795 ) 796 ; \+ current_prolog_flag(Munknown, fail), 797 goal_name_arity(Head, Name, Arity), 798 '$find_library'(_, Name, Arity, LoadModule, _File) 799 -> IM = LoadModule 800 ; M = IM 801 ). 802property_predicate(iso, _:Head) :- 803 callable(Head), 804 !, 805 goal_name_arity(Head, Name, Arity), 806 current_predicate(system:Name/Arity), 807 '$predicate_property'(iso, system:Head). 808property_predicate(built_in, Module:Head) :- 809 callable(Head), 810 !, 811 goal_name_arity(Head, Name, Arity), 812 current_predicate(Module:Name/Arity), 813 '$predicate_property'(built_in, Module:Head). 814property_predicate(Property, Pred) :- 815 define_or_generate(Pred), 816 '$predicate_property'(Property, Pred). 817 818goal_name_arity(Head, Name, Arity) :- 819 compound(Head), 820 !, 821 compound_name_arity(Head, Name, Arity). 822goal_name_arity(Head, Head, 0).
831define_or_generate(M:Head) :- 832 callable(Head), 833 atom(M), 834 '$get_predicate_attribute'(M:Head, defined, 1), 835 !. 836define_or_generate(M:Head) :- 837 callable(Head), 838 nonvar(M), M \== system, 839 !, 840 '$define_predicate'(M:Head). 841define_or_generate(Pred) :- 842 current_predicate(_, Pred), 843 '$define_predicate'(Pred). 844 845 846'$predicate_property'(interpreted, Pred) :- 847 '$get_predicate_attribute'(Pred, foreign, 0). 848'$predicate_property'(visible, Pred) :- 849 '$get_predicate_attribute'(Pred, defined, 1). 850'$predicate_property'(built_in, Pred) :- 851 '$get_predicate_attribute'(Pred, system, 1). 852'$predicate_property'(exported, Pred) :- 853 '$get_predicate_attribute'(Pred, exported, 1). 854'$predicate_property'(public, Pred) :- 855 '$get_predicate_attribute'(Pred, public, 1). 856'$predicate_property'(non_terminal, Pred) :- 857 '$get_predicate_attribute'(Pred, non_terminal, 1). 858'$predicate_property'(foreign, Pred) :- 859 '$get_predicate_attribute'(Pred, foreign, 1). 860'$predicate_property'((dynamic), Pred) :- 861 '$get_predicate_attribute'(Pred, (dynamic), 1). 862'$predicate_property'((static), Pred) :- 863 '$get_predicate_attribute'(Pred, (dynamic), 0). 864'$predicate_property'((volatile), Pred) :- 865 '$get_predicate_attribute'(Pred, (volatile), 1). 866'$predicate_property'((thread_local), Pred) :- 867 '$get_predicate_attribute'(Pred, (thread_local), 1). 868'$predicate_property'((multifile), Pred) :- 869 '$get_predicate_attribute'(Pred, (multifile), 1). 870'$predicate_property'((discontiguous), Pred) :- 871 '$get_predicate_attribute'(Pred, (discontiguous), 1). 872'$predicate_property'(imported_from(Module), Pred) :- 873 '$get_predicate_attribute'(Pred, imported, Module). 874'$predicate_property'(transparent, Pred) :- 875 '$get_predicate_attribute'(Pred, transparent, 1). 876'$predicate_property'(meta_predicate(Pattern), Pred) :- 877 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 878'$predicate_property'(file(File), Pred) :- 879 '$get_predicate_attribute'(Pred, file, File). 880'$predicate_property'(line_count(LineNumber), Pred) :- 881 '$get_predicate_attribute'(Pred, line_count, LineNumber). 882'$predicate_property'(notrace, Pred) :- 883 '$get_predicate_attribute'(Pred, trace, 0). 884'$predicate_property'(nodebug, Pred) :- 885 '$get_predicate_attribute'(Pred, hide_childs, 1). 886'$predicate_property'(spying, Pred) :- 887 '$get_predicate_attribute'(Pred, spy, 1). 888'$predicate_property'(number_of_clauses(N), Pred) :- 889 '$get_predicate_attribute'(Pred, number_of_clauses, N). 890'$predicate_property'(number_of_rules(N), Pred) :- 891 '$get_predicate_attribute'(Pred, number_of_rules, N). 892'$predicate_property'(last_modified_generation(Gen), Pred) :- 893 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 894'$predicate_property'(indexed(Indices), Pred) :- 895 '$get_predicate_attribute'(Pred, indexed, Indices). 896'$predicate_property'(noprofile, Pred) :- 897 '$get_predicate_attribute'(Pred, noprofile, 1). 898'$predicate_property'(ssu, Pred) :- 899 '$get_predicate_attribute'(Pred, ssu, 1). 900'$predicate_property'(iso, Pred) :- 901 '$get_predicate_attribute'(Pred, iso, 1). 902'$predicate_property'(det, Pred) :- 903 '$get_predicate_attribute'(Pred, det, 1). 904'$predicate_property'(sig_atomic, Pred) :- 905 '$get_predicate_attribute'(Pred, sig_atomic, 1). 906'$predicate_property'(quasi_quotation_syntax, Pred) :- 907 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 908'$predicate_property'(defined, Pred) :- 909 '$get_predicate_attribute'(Pred, defined, 1). 910'$predicate_property'(tabled, Pred) :- 911 '$get_predicate_attribute'(Pred, tabled, 1). 912'$predicate_property'(tabled(Flag), Pred) :- 913 '$get_predicate_attribute'(Pred, tabled, 1), 914 table_flag(Flag, Pred). 915'$predicate_property'(incremental, Pred) :- 916 '$get_predicate_attribute'(Pred, incremental, 1). 917'$predicate_property'(monotonic, Pred) :- 918 '$get_predicate_attribute'(Pred, monotonic, 1). 919'$predicate_property'(opaque, Pred) :- 920 '$get_predicate_attribute'(Pred, opaque, 1). 921'$predicate_property'(lazy, Pred) :- 922 '$get_predicate_attribute'(Pred, lazy, 1). 923'$predicate_property'(abstract(N), Pred) :- 924 '$get_predicate_attribute'(Pred, abstract, N). 925'$predicate_property'(size(Bytes), Pred) :- 926 '$get_predicate_attribute'(Pred, size, Bytes). 927 928system_undefined(user:prolog_trace_interception/4). 929system_undefined(user:prolog_exception_hook/4). 930system_undefined(system:'$c_call_prolog'/0). 931system_undefined(system:window_title/2). 932 933table_flag(variant, Pred) :- 934 '$tbl_implementation'(Pred, M:Head), 935 M:'$tabled'(Head, variant). 936table_flag(subsumptive, Pred) :- 937 '$tbl_implementation'(Pred, M:Head), 938 M:'$tabled'(Head, subsumptive). 939table_flag(shared, Pred) :- 940 '$get_predicate_attribute'(Pred, tshared, 1). 941table_flag(incremental, Pred) :- 942 '$get_predicate_attribute'(Pred, incremental, 1). 943table_flag(monotonic, Pred) :- 944 '$get_predicate_attribute'(Pred, monotonic, 1). 945table_flag(subgoal_abstract(N), Pred) :- 946 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 947table_flag(answer_abstract(N), Pred) :- 948 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 949table_flag(subgoal_abstract(N), Pred) :- 950 '$get_predicate_attribute'(Pred, max_answers, N).
959visible_predicate(Pred) :- 960 Pred = M:Head, 961 current_module(M), 962 ( callable(Head) 963 -> ( '$get_predicate_attribute'(Pred, defined, 1) 964 -> true 965 ; \+ current_prolog_flag(Munknown, fail), 966 '$head_name_arity'(Head, Name, Arity), 967 '$find_library'(M, Name, Arity, _LoadModule, _Library) 968 ) 969 ; setof(PI, visible_in_module(M, PI), PIs), 970 '$member'(Name/Arity, PIs), 971 functor(Head, Name, Arity) 972 ). 973 974visible_in_module(M, Name/Arity) :- 975 default_module(M, DefM), 976 DefHead = DefM:Head, 977 '$c_current_predicate'(_, DefHead), 978 '$get_predicate_attribute'(DefHead, defined, 1), 979 \+ hidden_system_predicate(Head), 980 functor(Head, Name, Arity). 981visible_in_module(_, Name/Arity) :- 982 '$in_library'(Name, Arity, _). 983 Head) (:- 985 functor(Head, Name, _), 986 atom(Name), % Avoid []. 987 sub_atom(Name, 0, _, _, $), 988 \+ current_prolog_flag(access_level, system).
true
.1013clause_property(Clause, Property) :- 1014 '$clause_property'(Property, Clause). 1015 1016'$clause_property'(line_count(LineNumber), Clause) :- 1017 '$get_clause_attribute'(Clause, line_count, LineNumber). 1018'$clause_property'(file(File), Clause) :- 1019 '$get_clause_attribute'(Clause, file, File). 1020'$clause_property'(source(File), Clause) :- 1021 '$get_clause_attribute'(Clause, owner, File). 1022'$clause_property'(size(Bytes), Clause) :- 1023 '$get_clause_attribute'(Clause, size, Bytes). 1024'$clause_property'(fact, Clause) :- 1025 '$get_clause_attribute'(Clause, fact, true). 1026'$clause_property'(erased, Clause) :- 1027 '$get_clause_attribute'(Clause, erased, true). 1028'$clause_property'(predicate(PI), Clause) :- 1029 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1030'$clause_property'(module(M), Clause) :- 1031 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)
abstract(+Level)
multifile(+Bool)
discontiguous(+Bool)
thread(+Mode)
volatile(+Bool)
1045dynamic(M:Predicates, Options) :- 1046 '$must_be'(list, Predicates), 1047 options_properties(Options, Props), 1048 set_pprops(Predicates, M, [dynamic|Props]). 1049 1050set_pprops([], _, _). 1051set_pprops([H|T], M, Props) :- 1052 set_pprops1(Props, M:H), 1053 strip_module(M:H, M2, P), 1054 '$pi_head'(M2:P, Pred), 1055 '$set_table_wrappers'(Pred), 1056 set_pprops(T, M, Props). 1057 1058set_pprops1([], _). 1059set_pprops1([H|T], P) :- 1060 ( atom(H) 1061 -> '$set_predicate_attribute'(P, H, true) 1062 ; H =.. [Name,Value] 1063 -> '$set_predicate_attribute'(P, Name, Value) 1064 ), 1065 set_pprops1(T, P). 1066 1067options_properties(Options, Props) :- 1068 G = opt_prop(_,_,_,_), 1069 findall(G, G, Spec), 1070 options_properties(Spec, Options, Props). 1071 1072options_properties([], _, []). 1073options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1074 Options, [Prop|PT]) :- 1075 Opt =.. [Name,V], 1076 '$option'(Opt, Options), 1077 '$must_be'(Type, V), 1078 V = SetValue, 1079 !, 1080 options_properties(T, Options, PT). 1081options_properties([_|T], Options, PT) :- 1082 options_properties(T, Options, PT). 1083 1084opt_prop(incremental, boolean, Bool, incremental(Bool)). 1085opt_prop(abstract, between(0,0), 0, abstract). 1086opt_prop(multifile, boolean, true, multifile). 1087opt_prop(discontiguous, boolean, true, discontiguous). 1088opt_prop(volatile, boolean, true, volatile). 1089opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1090 local, thread_local). 1091 1092 /******************************** 1093 * MODULES * 1094 *********************************/
1100current_module(Module) :-
1101 '$current_module'(Module, _).
1117module_property(Module, Property) :- 1118 nonvar(Module), nonvar(Property), 1119 !, 1120 property_module(Property, Module). 1121module_property(Module, Property) :- % -, file(File) 1122 nonvar(Property), Property = file(File), 1123 !, 1124 ( nonvar(File) 1125 -> '$current_module'(Modules, File), 1126 ( atom(Modules) 1127 -> Module = Modules 1128 ; '$member'(Module, Modules) 1129 ) 1130 ; '$current_module'(Module, File), 1131 File \== [] 1132 ). 1133module_property(Module, Property) :- 1134 current_module(Module), 1135 property_module(Property, Module). 1136 1137property_module(Property, Module) :- 1138 module_property(Property), 1139 ( Property = exported_operators(List) 1140 -> '$exported_ops'(Module, List, []) 1141 ; '$module_property'(Module, Property) 1142 ). 1143 1144module_property(class(_)). 1145module_property(file(_)). 1146module_property(line_count(_)). 1147module_property(exports(_)). 1148module_property(exported_operators(_)). 1149module_property(size(_)). 1150module_property(program_size(_)). 1151module_property(program_space(_)). 1152module_property(last_modified_generation(_)).
1158module(Module) :- 1159 atom(Module), 1160 current_module(Module), 1161 !, 1162 '$set_typein_module'(Module). 1163module(Module) :- 1164 '$set_typein_module'(Module), 1165 print_message(warning, no_current_module(Module)).
1172working_directory(Old, New) :- 1173 '$cwd'(Old), 1174 ( Old == New 1175 -> true 1176 ; '$chdir'(New) 1177 ). 1178 1179 1180 /******************************* 1181 * TRIES * 1182 *******************************/
1188current_trie(Trie) :-
1189 current_blob(Trie, trie),
1190 is_trie(Trie).
Incremental tabling statistics:
Shared tabling statistics:
1226trie_property(Trie, Property) :- 1227 current_trie(Trie), 1228 trie_property(Property), 1229 '$trie_property'(Trie, Property). 1230 1231trie_property(node_count(_)). 1232trie_property(value_count(_)). 1233trie_property(size(_)). 1234trie_property(hashed(_)). 1235trie_property(compiled_size(_)). 1236 % below only when -DO_TRIE_STATS 1237trie_property(lookup_count(_)). % is enabled in pl-trie.h 1238trie_property(gen_call_count(_)). 1239trie_property(invalidated(_)). % IDG stats 1240trie_property(reevaluated(_)). 1241trie_property(deadlock(_)). % Shared tabling stats 1242trie_property(wait(_)). 1243trie_property(idg_affected_count(_)). 1244trie_property(idg_dependent_count(_)). 1245trie_property(idg_size(_)). 1246 1247 1248 /******************************** 1249 * SYSTEM INTERACTION * 1250 *********************************/ 1251 1252shell(Command) :- 1253 shell(Command, 0). 1254 1255 1256 /******************************* 1257 * SIGNALS * 1258 *******************************/ 1259 1260:- meta_predicate 1261 on_signal( , , ), 1262 current_signal( , , ).
1266on_signal(Signal, Old, New) :- 1267 atom(Signal), 1268 !, 1269 '$on_signal'(_Num, Signal, Old, New). 1270on_signal(Signal, Old, New) :- 1271 integer(Signal), 1272 !, 1273 '$on_signal'(Signal, _Name, Old, New). 1274on_signal(Signal, _Old, _New) :- 1275 '$type_error'(signal_name, Signal).
1279current_signal(Name, Id, Handler) :- 1280 between(1, 32, Id), 1281 '$on_signal'(Id, Name, Handler, Handler). 1282 1283:- multifile 1284 prolog:called_by/2. 1285 1286prologcalled_by(on_signal(_,_,New), [New+1]) :- 1287 ( new == throw 1288 ; new == default 1289 ), !, fail. 1290 1291 1292 /******************************* 1293 * I/O * 1294 *******************************/ 1295 1296format(Fmt) :- 1297 format(Fmt, []). 1298 1299 /******************************* 1300 * FILES * 1301 *******************************/
1305absolute_file_name(Name, Abs) :- 1306 atomic(Name), 1307 !, 1308 '$absolute_file_name'(Name, Abs). 1309absolute_file_name(Term, Abs) :- 1310 '$chk_file'(Term, [''], [access(read)], true, File), 1311 !, 1312 '$absolute_file_name'(File, Abs). 1313absolute_file_name(Term, Abs) :- 1314 '$chk_file'(Term, [''], [], true, File), 1315 !, 1316 '$absolute_file_name'(File, Abs).
1324tmp_file_stream(Enc, File, Stream) :- 1325 atom(Enc), var(File), var(Stream), 1326 !, 1327 '$tmp_file_stream'('', Enc, File, Stream). 1328tmp_file_stream(File, Stream, Options) :- 1329 current_prolog_flag(encoding, DefEnc), 1330 '$option'(encoding(Enc), Options, DefEnc), 1331 '$option'(extension(Ext), Options, ''), 1332 '$tmp_file_stream'(Ext, Enc, File, Stream), 1333 set_stream(Stream, file_name(File)). 1334 1335 1336 /******************************** 1337 * MEMORY MANAGEMENT * 1338 *********************************/
1347garbage_collect :-
1348 '$garbage_collect'(0).
1354set_prolog_stack(Stack, Option) :-
1355 Option =.. [Name,Value0],
1356 Value is Value0,
1357 '$set_prolog_stack'(Stack, Name, _Old, Value).
1363prolog_stack_property(Stack, Property) :- 1364 stack_property(P), 1365 stack_name(Stack), 1366 Property =.. [P,Value], 1367 '$set_prolog_stack'(Stack, P, Value, Value). 1368 1369stack_name(local). 1370stack_name(global). 1371stack_name(trail). 1372 1373stack_property(limit). 1374stack_property(spare). 1375stack_property(min_free). 1376stack_property(low). 1377stack_property(factor). 1378 1379 1380 /******************************* 1381 * CLAUSE * 1382 *******************************/
:-
as neck.1390rule(Head, Rule) :- 1391 '$rule'(Head, Rule0), 1392 conditional_rule(Rule0, Rule1), 1393 Rule = Rule1. 1394rule(Head, Rule, Ref) :- 1395 '$rule'(Head, Rule0, Ref), 1396 conditional_rule(Rule0, Rule1), 1397 Rule = Rule1. 1398 1399conditional_rule(?=>(Head, (!, Body)), Rule) => 1400 Rule = (Head => Body). 1401conditional_rule(?=>(Head, !), Rule) => 1402 Rule = (Head => true). 1403conditional_rule(?=>(Head, Body0), Rule), 1404 split_on_cut(Body0, Cond, Body) => 1405 Rule = (Head,Cond=>Body). 1406conditional_rule(Head, Rule) => 1407 Rule = Head. 1408 1409split_on_cut((Cond0,!,Body0), Cond, Body) => 1410 Cond = Cond0, 1411 Body = Body0. 1412split_on_cut((!,Body0), Cond, Body) => 1413 Cond = true, 1414 Body = Body0. 1415split_on_cut((A,B), Cond, Body) => 1416 Cond = (A,Cond1), 1417 split_on_cut(B, Cond1, Body). 1418split_on_cut(_, _, _) => 1419 fail. 1420 1421 1422 /******************************* 1423 * TERM * 1424 *******************************/ 1425 1426:- '$iso'((numbervars/3)).
1434numbervars(Term, From, To) :- 1435 numbervars(Term, From, To, []). 1436 1437 1438 /******************************* 1439 * STRING * 1440 *******************************/
1446term_string(Term, String, Options) :- 1447 nonvar(String), 1448 !, 1449 read_term_from_atom(String, Term, Options). 1450term_string(Term, String, Options) :- 1451 ( '$option'(quoted(_), Options) 1452 -> Options1 = Options 1453 ; '$merge_options'(_{quoted:true}, Options, Options1) 1454 ), 1455 format(string(String), '~W', [Term, Options1]). 1456 1457 1458 /******************************* 1459 * GVAR * 1460 *******************************/
1466nb_setval(Name, Value) :- 1467 duplicate_term(Value, Copy), 1468 nb_linkval(Name, Copy). 1469 1470 1471 /******************************* 1472 * THREADS * 1473 *******************************/ 1474 1475:- meta_predicate 1476 thread_create( , ).
thread_create(Goal, Id, [])
.
1482thread_create(Goal, Id) :-
1483 thread_create(Goal, Id, []).
1492thread_join(Id) :-
1493 thread_join(Id, Status),
1494 ( Status == true
1495 -> true
1496 ; throw(error(thread_error(Id, Status), _))
1497 ).
1507sig_block(Pattern) :- 1508 ( nb_current('$sig_blocked', List) 1509 -> true 1510 ; List = [] 1511 ), 1512 nb_setval('$sig_blocked', [Pattern|List]). 1513 1514sig_unblock(Pattern) :- 1515 ( nb_current('$sig_blocked', List) 1516 -> unblock(List, Pattern, NewList), 1517 ( List == NewList 1518 -> true 1519 ; nb_setval('$sig_blocked', NewList), 1520 '$sig_unblock' 1521 ) 1522 ; true 1523 ). 1524 1525unblock([], _, []). 1526unblock([H|T], P, List) :- 1527 ( subsumes_term(P, H) 1528 -> unblock(T, P, List) 1529 ; List = [H|T1], 1530 unblock(T, P, T1) 1531 ). 1532 1533:- public signal_is_blocked/1. % called by signal_is_blocked() 1534 1535signal_is_blocked(Head) :- 1536 nb_current('$sig_blocked', List), 1537 '$member'(Head, List), 1538 !.
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.1555set_prolog_gc_thread(Status) :- 1556 var(Status), 1557 !, 1558 '$instantiation_error'(Status). 1559set_prolog_gc_thread(false) :- 1560 !, 1561 set_prolog_flag(gc_thread, false), 1562 ( current_prolog_flag(threads, true) 1563 -> ( '$gc_stop' 1564 -> thread_join(gc) 1565 ; true 1566 ) 1567 ; true 1568 ). 1569set_prolog_gc_thread(true) :- 1570 !, 1571 set_prolog_flag(gc_thread, true). 1572set_prolog_gc_thread(stop) :- 1573 !, 1574 ( current_prolog_flag(threads, true) 1575 -> ( '$gc_stop' 1576 -> thread_join(gc) 1577 ; true 1578 ) 1579 ; true 1580 ). 1581set_prolog_gc_thread(Status) :- 1582 '$domain_error'(gc_thread, Status).
1591transaction(Goal) :- 1592 '$transaction'(Goal, []). 1593transaction(Goal, Options) :- 1594 '$transaction'(Goal, Options). 1595transaction(Goal, Constraint, Mutex) :- 1596 '$transaction'(Goal, Constraint, Mutex). 1597snapshot(Goal) :- 1598 '$snapshot'(Goal). 1599 1600 1601 /******************************* 1602 * UNDO * 1603 *******************************/ 1604 1605:- meta_predicate 1606 undo( ).
1613undo(Goal) :- 1614 '$undo'(Goal). 1615 1616:- public 1617 '$run_undo'/1. 1618 1619'$run_undo'([One]) :- 1620 !, 1621 call(One). 1622'$run_undo'(List) :- 1623 run_undo(List, _, Error), 1624 ( var(Error) 1625 -> true 1626 ; throw(Error) 1627 ). 1628 1629run_undo([], E, E). 1630run_undo([H|T], E0, E) :- 1631 ( catch(H, E1, true) 1632 -> ( var(E1) 1633 -> true 1634 ; '$urgent_exception'(E0, E1, E2) 1635 ) 1636 ; true 1637 ), 1638 run_undo(T, E2, E).
1646:- meta_predicate 1647 '$wrap_predicate'( , , , , ). 1648 1649'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1650 callable_name_arguments(Head, PName, Args), 1651 callable_name_arity(Head, PName, Arity), 1652 ( is_most_general_term(Head) 1653 -> true 1654 ; '$domain_error'(most_general_term, Head) 1655 ), 1656 atomic_list_concat(['$wrap$', PName], WrapName), 1657 volatile(M:WrapName/Arity), 1658 module_transparent(M:WrapName/Arity), 1659 WHead =.. [WrapName|Args], 1660 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)). 1661 1662callable_name_arguments(Head, PName, Args) :- 1663 atom(Head), 1664 !, 1665 PName = Head, 1666 Args = []. 1667callable_name_arguments(Head, PName, Args) :- 1668 compound_name_arguments(Head, PName, Args). 1669 1670callable_name_arity(Head, PName, Arity) :- 1671 atom(Head), 1672 !, 1673 PName = Head, 1674 Arity = 0. 1675callable_name_arity(Head, PName, Arity) :- 1676 compound_name_arity(Head, PName, Arity)