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-2020, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module('$syspreds', 38 [ leash/1, 39 visible/1, 40 style_check/1, 41 (spy)/1, 42 (nospy)/1, 43 nospyall/0, 44 debugging/0, 45 flag/3, 46 atom_prefix/2, 47 dwim_match/2, 48 source_file_property/2, 49 source_file/1, 50 source_file/2, 51 unload_file/1, 52 exists_source/1, % +Spec 53 exists_source/2, % +Spec, -Path 54 use_foreign_library/1, % :FileSpec 55 use_foreign_library/2, % :FileSpec, +Install 56 prolog_load_context/2, 57 stream_position_data/3, 58 current_predicate/2, 59 '$defined_predicate'/1, 60 predicate_property/2, 61 '$predicate_property'/2, 62 (dynamic)/2, % :Predicates, +Options 63 clause_property/2, 64 current_module/1, % ?Module 65 module_property/2, % ?Module, ?Property 66 module/1, % +Module 67 current_trie/1, % ?Trie 68 trie_property/2, % ?Trie, ?Property 69 working_directory/2, % -OldDir, +NewDir 70 shell/1, % +Command 71 on_signal/3, 72 current_signal/3, 73 open_shared_object/2, 74 open_shared_object/3, 75 format/1, 76 garbage_collect/0, 77 set_prolog_stack/2, 78 prolog_stack_property/2, 79 absolute_file_name/2, 80 tmp_file_stream/3, % +Enc, -File, -Stream 81 call_with_depth_limit/3, % :Goal, +Limit, -Result 82 call_with_inference_limit/3, % :Goal, +Limit, -Result 83 numbervars/3, % +Term, +Start, -End 84 term_string/3, % ?Term, ?String, +Options 85 nb_setval/2, % +Var, +Value 86 thread_create/2, % :Goal, -Id 87 thread_join/1, % +Id 88 transaction/1, % :Goal 89 transaction/2, % :Goal, +Options 90 transaction/3, % :Goal, :Constraint, +Mutex 91 snapshot/1, % :Goal 92 set_prolog_gc_thread/1, % +Status 93 94 '$wrap_predicate'/5 % :Head, +Name, -Closure, -Wrapped, +Body 95 ]). 96 97:- meta_predicate 98 dynamic( , ), 99 use_foreign_library( ), 100 use_foreign_library( , ), 101 transaction( ), 102 transaction( , , ), 103 snapshot( ). 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.
210:- multifile 211 prolog:debug_control_hook/1. % +Action 212 213:- meta_predicate 214 spy( ), 215 nospy( ).
informational
, with one
of the following terms, where Spec is of the form M:Head.
spy(Spec)
nospy(Spec)
232spy(_:X) :- 233 var(X), 234 throw(error(instantiation_error, _)). 235spy(_:[]) :- !. 236spy(M:[H|T]) :- 237 !, 238 spy(M:H), 239 spy(M:T). 240spy(Spec) :- 241 notrace(prolog:debug_control_hook(spy(Spec))), 242 !. 243spy(Spec) :- 244 '$find_predicate'(Spec, Preds), 245 '$member'(PI, Preds), 246 pi_to_head(PI, Head), 247 '$define_predicate'(Head), 248 '$spy'(Head), 249 fail. 250spy(_). 251 252nospy(_:X) :- 253 var(X), 254 throw(error(instantiation_error, _)). 255nospy(_:[]) :- !. 256nospy(M:[H|T]) :- 257 !, 258 nospy(M:H), 259 nospy(M:T). 260nospy(Spec) :- 261 notrace(prolog:debug_control_hook(nospy(Spec))), 262 !. 263nospy(Spec) :- 264 '$find_predicate'(Spec, Preds), 265 '$member'(PI, Preds), 266 pi_to_head(PI, Head), 267 '$nospy'(Head), 268 fail. 269nospy(_). 270 271nospyall :- 272 notrace(prolog:debug_control_hook(nospyall)), 273 fail. 274nospyall :- 275 spy_point(Head), 276 '$nospy'(Head), 277 fail. 278nospyall. 279 280pi_to_head(M:PI, M:Head) :- 281 !, 282 pi_to_head(PI, Head). 283pi_to_head(Name/Arity, Head) :- 284 functor(Head, Name, Arity).
290debugging :- 291 notrace(prolog:debug_control_hook(debugging)), 292 !. 293debugging :- 294 current_prolog_flag(debug, true), 295 !, 296 print_message(informational, debugging(on)), 297 findall(H, spy_point(H), SpyPoints), 298 print_message(informational, spying(SpyPoints)). 299debugging :- 300 print_message(informational, debugging(off)). 301 302spy_point(Module:Head) :- 303 current_predicate(_, Module:Head), 304 '$get_predicate_attribute'(Module:Head, spy, 1), 305 \+ predicate_property(Module:Head, imported_from(_)).
312flag(Name, Old, New) :- 313 Old == New, 314 !, 315 get_flag(Name, Old). 316flag(Name, Old, New) :- 317 with_mutex('$flag', update_flag(Name, Old, New)). 318 319update_flag(Name, Old, New) :- 320 get_flag(Name, Old), 321 ( atom(New) 322 -> set_flag(Name, New) 323 ; Value is New, 324 set_flag(Name, Value) 325 ). 326 327 328 /******************************** 329 * ATOMS * 330 *********************************/ 331 332dwim_match(A1, A2) :- 333 dwim_match(A1, A2, _). 334 335atom_prefix(Atom, Prefix) :- 336 sub_atom(Atom, 0, _, _, Prefix). 337 338 339 /******************************** 340 * SOURCE * 341 *********************************/
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.
354source_file(File) :-
355 ( current_prolog_flag(access_level, user)
356 -> Level = user
357 ; true
358 ),
359 ( ground(File)
360 -> ( '$time_source_file'(File, Time, Level)
361 ; absolute_file_name(File, Abs),
362 '$time_source_file'(Abs, Time, Level)
363 ), !
364 ; '$time_source_file'(File, Time, Level)
365 ),
366 Time > 0.0.
373:- meta_predicate source_file( , ). 374 375source_file(M:Head, File) :- 376 nonvar(M), nonvar(Head), 377 !, 378 ( '$c_current_predicate'(_, M:Head), 379 predicate_property(M:Head, multifile) 380 -> multi_source_files(M:Head, Files), 381 '$member'(File, Files) 382 ; '$source_file'(M:Head, File) 383 ). 384source_file(M:Head, File) :- 385 ( nonvar(File) 386 -> true 387 ; source_file(File) 388 ), 389 '$source_file_predicates'(File, Predicates), 390 '$member'(M:Head, Predicates). 391 392:- thread_local found_src_file/1. 393 394multi_source_files(Head, Files) :- 395 call_cleanup( 396 findall(File, multi_source_file(Head, File), Files), 397 retractall(found_src_file(_))). 398 399multi_source_file(Head, File) :- 400 nth_clause(Head, _, Clause), 401 clause_property(Clause, source(File)), 402 \+ found_src_file(File), 403 asserta(found_src_file(File)).
410source_file_property(File, P) :- 411 nonvar(File), 412 !, 413 canonical_source_file(File, Path), 414 property_source_file(P, Path). 415source_file_property(File, P) :- 416 property_source_file(P, File). 417 418property_source_file(modified(Time), File) :- 419 '$time_source_file'(File, Time, user). 420property_source_file(source(Source), File) :- 421 ( '$source_file_property'(File, from_state, true) 422 -> Source = state 423 ; '$source_file_property'(File, resource, true) 424 -> Source = resource 425 ; Source = file 426 ). 427property_source_file(module(M), File) :- 428 ( nonvar(M) 429 -> '$current_module'(M, File) 430 ; nonvar(File) 431 -> '$current_module'(ML, File), 432 ( atom(ML) 433 -> M = ML 434 ; '$member'(M, ML) 435 ) 436 ; '$current_module'(M, File) 437 ). 438property_source_file(load_context(Module, Location, Options), File) :- 439 '$time_source_file'(File, _, user), 440 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 441 ( clause_property(Ref, file(FromFile)), 442 clause_property(Ref, line_count(FromLine)) 443 -> Location = FromFile:FromLine 444 ; Location = user 445 ). 446property_source_file(includes(Master, Stamp), File) :- 447 system:'$included'(File, _Line, Master, Stamp). 448property_source_file(included_in(Master, Line), File) :- 449 system:'$included'(Master, Line, File, _). 450property_source_file(derived_from(DerivedFrom, Stamp), File) :- 451 system:'$derived_source'(File, DerivedFrom, Stamp). 452property_source_file(reloading, File) :- 453 source_file(File), 454 '$source_file_property'(File, reloading, true). 455property_source_file(load_count(Count), File) :- 456 source_file(File), 457 '$source_file_property'(File, load_count, Count). 458property_source_file(number_of_clauses(Count), File) :- 459 source_file(File), 460 '$source_file_property'(File, number_of_clauses, Count).
467canonical_source_file(Spec, File) :- 468 atom(Spec), 469 '$time_source_file'(Spec, _, _), 470 !, 471 File = Spec. 472canonical_source_file(Spec, File) :- 473 system:'$included'(_Master, _Line, Spec, _), 474 !, 475 File = Spec. 476canonical_source_file(Spec, File) :- 477 absolute_file_name(Spec, 478 [ file_type(prolog), 479 access(read), 480 file_errors(fail) 481 ], 482 File), 483 source_file(File).
:- if(exists_source(library(error))). :- use_module_library(error). :- endif.
500exists_source(Source) :- 501 exists_source(Source, _Path). 502 503exists_source(Source, Path) :- 504 absolute_file_name(Source, Path, 505 [ file_type(prolog), 506 access(read), 507 file_errors(fail) 508 ]).
517prolog_load_context(module, Module) :- 518 '$current_source_module'(Module). 519prolog_load_context(file, File) :- 520 input_file(File). 521prolog_load_context(source, F) :- % SICStus compatibility 522 input_file(F0), 523 '$input_context'(Context), 524 '$top_file'(Context, F0, F). 525prolog_load_context(stream, S) :- 526 ( system:'$load_input'(_, S0) 527 -> S = S0 528 ). 529prolog_load_context(directory, D) :- 530 input_file(F), 531 file_directory_name(F, D). 532prolog_load_context(dialect, D) :- 533 current_prolog_flag(emulated_dialect, D). 534prolog_load_context(term_position, TermPos) :- 535 source_location(_, L), 536 ( nb_current('$term_position', Pos), 537 compound(Pos), % actually set 538 stream_position_data(line_count, Pos, L) 539 -> TermPos = Pos 540 ; TermPos = '$stream_position'(0,L,0,0) 541 ). 542prolog_load_context(script, Bool) :- 543 ( '$toplevel':loaded_init_file(script, Path), 544 input_file(File), 545 same_file(File, Path) 546 -> Bool = true 547 ; Bool = false 548 ). 549prolog_load_context(variable_names, Bindings) :- 550 nb_current('$variable_names', Bindings). 551prolog_load_context(term, Term) :- 552 nb_current('$term', Term). 553prolog_load_context(reloading, true) :- 554 prolog_load_context(source, F), 555 '$source_file_property'(F, reloading, true). 556 557input_file(File) :- 558 ( system:'$load_input'(_, Stream) 559 -> stream_property(Stream, file_name(File)) 560 ), 561 !. 562input_file(File) :- 563 source_location(File, _).
570:- dynamic system:'$resolved_source_path'/2. 571 572unload_file(File) :- 573 ( canonical_source_file(File, Path) 574 -> '$unload_file'(Path), 575 retractall(system:'$resolved_source_path'(_, Path)) 576 ; true 577 ). 578 579 /******************************* 580 * FOREIGN LIBRARIES * 581 *******************************/
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.
600use_foreign_library(FileSpec) :- 601 ensure_shlib, 602 initialization(shlib:load_foreign_library(FileSpec), now). 603 604use_foreign_library(FileSpec, Entry) :- 605 ensure_shlib, 606 initialization(shlib:load_foreign_library(FileSpec, Entry), now). 607 608ensure_shlib :- 609 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1), 610 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1), 611 !. 612ensure_shlib :- 613 use_module(library(shlib), []). 614 615 616 /******************************* 617 * STREAMS * 618 *******************************/
625stream_position_data(Prop, Term, Value) :- 626 nonvar(Prop), 627 !, 628 ( stream_position_field(Prop, Pos) 629 -> arg(Pos, Term, Value) 630 ; throw(error(domain_error(stream_position_data, Prop))) 631 ). 632stream_position_data(Prop, Term, Value) :- 633 stream_position_field(Prop, Pos), 634 arg(Pos, Term, Value). 635 636stream_position_field(char_count, 1). 637stream_position_field(line_count, 2). 638stream_position_field(line_position, 3). 639stream_position_field(byte_count, 4). 640 641 642 /******************************* 643 * CONTROL * 644 *******************************/
652:- meta_predicate 653 call_with_depth_limit( , , ). 654 655call_with_depth_limit(G, Limit, Result) :- 656 '$depth_limit'(Limit, OLimit, OReached), 657 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)), 658 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 659 ( Det == ! -> ! ; true ) 660 ; '$depth_limit_false'(OLimit, OReached, Result) 661 ).
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.
674:- meta_predicate 675 call_with_inference_limit( , , ). 676 677call_with_inference_limit(G, Limit, Result) :- 678 '$inference_limit'(Limit, OLimit), 679 ( catch(G, Except, 680 system:'$inference_limit_except'(OLimit, Except, Result0)), 681 ( Result0 == inference_limit_exceeded 682 -> ! 683 ; system:'$inference_limit_true'(Limit, OLimit, Result0), 684 ( Result0 == ! -> ! ; true ) 685 ), 686 Result = Result0 687 ; system:'$inference_limit_false'(OLimit) 688 ). 689 690 691 /******************************** 692 * DATA BASE * 693 *********************************/ 694 695/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 696The predicate current_predicate/2 is a difficult subject since the 697introduction of defaulting modules and dynamic libraries. 698current_predicate/2 is normally called with instantiated arguments to 699verify some predicate can be called without trapping an undefined 700predicate. In this case we must perform the search algorithm used by 701the prolog system itself. 702 703If the pattern is not fully specified, we only generate the predicates 704actually available in this module. This seems the best for listing, 705etc. 706- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 707 708 709:- meta_predicate 710 current_predicate( , ), 711 '$defined_predicate'( ). 712 713current_predicate(Name, Module:Head) :- 714 (var(Module) ; var(Head)), 715 !, 716 generate_current_predicate(Name, Module, Head). 717current_predicate(Name, Term) :- 718 '$c_current_predicate'(Name, Term), 719 '$defined_predicate'(Term), 720 !. 721current_predicate(Name, Module:Head) :- 722 default_module(Module, DefModule), 723 '$c_current_predicate'(Name, DefModule:Head), 724 '$defined_predicate'(DefModule:Head), 725 !. 726current_predicate(Name, Module:Head) :- 727 '$autoload':autoload_in(Module, general), 728 \+ current_prolog_flag(Moduleunknown, fail), 729 ( compound(Head) 730 -> compound_name_arity(Head, Name, Arity) 731 ; Name = Head, Arity = 0 732 ), 733 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 734 !. 735 736generate_current_predicate(Name, Module, Head) :- 737 current_module(Module), 738 QHead = Module:Head, 739 '$c_current_predicate'(Name, QHead), 740 '$get_predicate_attribute'(QHead, defined, 1). 741 742'$defined_predicate'(Head) :- 743 '$get_predicate_attribute'(Head, defined, 1), 744 !.
750:- meta_predicate 751 predicate_property( , ). 752 753:- multifile 754 '$predicate_property'/2. 755 756:- '$iso'(predicate_property/2). 757 758predicate_property(Pred, Property) :- % Mode ?,+ 759 nonvar(Property), 760 !, 761 property_predicate(Property, Pred). 762predicate_property(Pred, Property) :- % Mode +,- 763 define_or_generate(Pred), 764 '$predicate_property'(Property, Pred).
undefined
, visible
and
autoload
, followed by the generic case.772property_predicate(undefined, Pred) :- 773 !, 774 Pred = Module:Head, 775 current_module(Module), 776 '$c_current_predicate'(_, Pred), 777 \+ '$defined_predicate'(Pred), % Speed up a bit 778 \+ current_predicate(_, Pred), 779 goal_name_arity(Head, Name, Arity), 780 \+ system_undefined(Module:Name/Arity). 781property_predicate(visible, Pred) :- 782 !, 783 visible_predicate(Pred). 784property_predicate(autoload(File), Head) :- 785 !, 786 \+ current_prolog_flag(autoload, false), 787 '$autoload':autoloadable(Head, File). 788property_predicate(implementation_module(IM), M:Head) :- 789 !, 790 atom(M), 791 ( default_module(M, DM), 792 '$get_predicate_attribute'(DM:Head, defined, 1) 793 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 794 -> IM = ImportM 795 ; IM = M 796 ) 797 ; \+ current_prolog_flag(Munknown, fail), 798 goal_name_arity(Head, Name, Arity), 799 '$find_library'(_, Name, Arity, LoadModule, _File) 800 -> IM = LoadModule 801 ; M = IM 802 ). 803property_predicate(iso, _:Head) :- 804 callable(Head), 805 !, 806 goal_name_arity(Head, Name, Arity), 807 current_predicate(system:Name/Arity), 808 '$predicate_property'(iso, system:Head). 809property_predicate(built_in, Module:Head) :- 810 callable(Head), 811 !, 812 goal_name_arity(Head, Name, Arity), 813 current_predicate(Module:Name/Arity), 814 '$predicate_property'(built_in, Module:Head). 815property_predicate(Property, Pred) :- 816 define_or_generate(Pred), 817 '$predicate_property'(Property, Pred). 818 819goal_name_arity(Head, Name, Arity) :- 820 compound(Head), 821 !, 822 compound_name_arity(Head, Name, Arity). 823goal_name_arity(Head, Head, 0).
832define_or_generate(M:Head) :- 833 callable(Head), 834 atom(M), 835 '$get_predicate_attribute'(M:Head, defined, 1), 836 !. 837define_or_generate(M:Head) :- 838 callable(Head), 839 nonvar(M), M \== system, 840 !, 841 '$define_predicate'(M:Head). 842define_or_generate(Pred) :- 843 current_predicate(_, Pred), 844 '$define_predicate'(Pred). 845 846 847'$predicate_property'(interpreted, Pred) :- 848 '$get_predicate_attribute'(Pred, foreign, 0). 849'$predicate_property'(visible, Pred) :- 850 '$get_predicate_attribute'(Pred, defined, 1). 851'$predicate_property'(built_in, Pred) :- 852 '$get_predicate_attribute'(Pred, system, 1). 853'$predicate_property'(exported, Pred) :- 854 '$get_predicate_attribute'(Pred, exported, 1). 855'$predicate_property'(public, Pred) :- 856 '$get_predicate_attribute'(Pred, public, 1). 857'$predicate_property'(non_terminal, Pred) :- 858 '$get_predicate_attribute'(Pred, non_terminal, 1). 859'$predicate_property'(foreign, Pred) :- 860 '$get_predicate_attribute'(Pred, foreign, 1). 861'$predicate_property'((dynamic), Pred) :- 862 '$get_predicate_attribute'(Pred, (dynamic), 1). 863'$predicate_property'((static), Pred) :- 864 '$get_predicate_attribute'(Pred, (dynamic), 0). 865'$predicate_property'((volatile), Pred) :- 866 '$get_predicate_attribute'(Pred, (volatile), 1). 867'$predicate_property'((thread_local), Pred) :- 868 '$get_predicate_attribute'(Pred, (thread_local), 1). 869'$predicate_property'((multifile), Pred) :- 870 '$get_predicate_attribute'(Pred, (multifile), 1). 871'$predicate_property'(imported_from(Module), Pred) :- 872 '$get_predicate_attribute'(Pred, imported, Module). 873'$predicate_property'(transparent, Pred) :- 874 '$get_predicate_attribute'(Pred, transparent, 1). 875'$predicate_property'(meta_predicate(Pattern), Pred) :- 876 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 877'$predicate_property'(file(File), Pred) :- 878 '$get_predicate_attribute'(Pred, file, File). 879'$predicate_property'(line_count(LineNumber), Pred) :- 880 '$get_predicate_attribute'(Pred, line_count, LineNumber). 881'$predicate_property'(notrace, Pred) :- 882 '$get_predicate_attribute'(Pred, trace, 0). 883'$predicate_property'(nodebug, Pred) :- 884 '$get_predicate_attribute'(Pred, hide_childs, 1). 885'$predicate_property'(spying, Pred) :- 886 '$get_predicate_attribute'(Pred, spy, 1). 887'$predicate_property'(number_of_clauses(N), Pred) :- 888 '$get_predicate_attribute'(Pred, number_of_clauses, N). 889'$predicate_property'(number_of_rules(N), Pred) :- 890 '$get_predicate_attribute'(Pred, number_of_rules, N). 891'$predicate_property'(last_modified_generation(Gen), Pred) :- 892 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 893'$predicate_property'(indexed(Indices), Pred) :- 894 '$get_predicate_attribute'(Pred, indexed, Indices). 895'$predicate_property'(noprofile, Pred) :- 896 '$get_predicate_attribute'(Pred, noprofile, 1). 897'$predicate_property'(iso, Pred) :- 898 '$get_predicate_attribute'(Pred, iso, 1). 899'$predicate_property'(quasi_quotation_syntax, Pred) :- 900 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 901'$predicate_property'(defined, Pred) :- 902 '$get_predicate_attribute'(Pred, defined, 1). 903'$predicate_property'(tabled, Pred) :- 904 '$get_predicate_attribute'(Pred, tabled, 1). 905'$predicate_property'(tabled(Flag), Pred) :- 906 '$get_predicate_attribute'(Pred, tabled, 1), 907 table_flag(Flag, Pred). 908'$predicate_property'(incremental, Pred) :- 909 '$get_predicate_attribute'(Pred, incremental, 1). 910'$predicate_property'(monotonic, Pred) :- 911 '$get_predicate_attribute'(Pred, monotonic, 1). 912'$predicate_property'(opaque, Pred) :- 913 '$get_predicate_attribute'(Pred, opaque, 1). 914'$predicate_property'(lazy, Pred) :- 915 '$get_predicate_attribute'(Pred, lazy, 1). 916'$predicate_property'(abstract(N), Pred) :- 917 '$get_predicate_attribute'(Pred, abstract, N). 918'$predicate_property'(size(Bytes), Pred) :- 919 '$get_predicate_attribute'(Pred, size, Bytes). 920 921system_undefined(user:prolog_trace_interception/4). 922system_undefined(user:prolog_exception_hook/4). 923system_undefined(system:'$c_call_prolog'/0). 924system_undefined(system:window_title/2). 925 926table_flag(variant, Pred) :- 927 '$tbl_implementation'(Pred, M:Head), 928 M:'$tabled'(Head, variant). 929table_flag(subsumptive, Pred) :- 930 '$tbl_implementation'(Pred, M:Head), 931 M:'$tabled'(Head, subsumptive). 932table_flag(shared, Pred) :- 933 '$get_predicate_attribute'(Pred, tshared, 1). 934table_flag(incremental, Pred) :- 935 '$get_predicate_attribute'(Pred, incremental, 1). 936table_flag(monotonic, Pred) :- 937 '$get_predicate_attribute'(Pred, monotonic, 1). 938table_flag(subgoal_abstract(N), Pred) :- 939 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 940table_flag(answer_abstract(N), Pred) :- 941 '$get_predicate_attribute'(Pred, subgoal_abstract, N). 942table_flag(subgoal_abstract(N), Pred) :- 943 '$get_predicate_attribute'(Pred, max_answers, N).
952visible_predicate(Pred) :- 953 Pred = M:Head, 954 current_module(M), 955 ( callable(Head) 956 -> ( '$get_predicate_attribute'(Pred, defined, 1) 957 -> true 958 ; \+ current_prolog_flag(Munknown, fail), 959 functor(Head, Name, Arity), 960 '$find_library'(M, Name, Arity, _LoadModule, _Library) 961 ) 962 ; setof(PI, visible_in_module(M, PI), PIs), 963 '$member'(Name/Arity, PIs), 964 functor(Head, Name, Arity) 965 ). 966 967visible_in_module(M, Name/Arity) :- 968 default_module(M, DefM), 969 DefHead = DefM:Head, 970 '$c_current_predicate'(_, DefHead), 971 '$get_predicate_attribute'(DefHead, defined, 1), 972 \+ hidden_system_predicate(Head), 973 functor(Head, Name, Arity). 974visible_in_module(_, Name/Arity) :- 975 '$in_library'(Name, Arity, _). 976 Head) (:- 978 functor(Head, Name, _), 979 atom(Name), % Avoid []. 980 sub_atom(Name, 0, _, _, $), 981 \+ current_prolog_flag(access_level, system).
true
.1006clause_property(Clause, Property) :- 1007 '$clause_property'(Property, Clause). 1008 1009'$clause_property'(line_count(LineNumber), Clause) :- 1010 '$get_clause_attribute'(Clause, line_count, LineNumber). 1011'$clause_property'(file(File), Clause) :- 1012 '$get_clause_attribute'(Clause, file, File). 1013'$clause_property'(source(File), Clause) :- 1014 '$get_clause_attribute'(Clause, owner, File). 1015'$clause_property'(size(Bytes), Clause) :- 1016 '$get_clause_attribute'(Clause, size, Bytes). 1017'$clause_property'(fact, Clause) :- 1018 '$get_clause_attribute'(Clause, fact, true). 1019'$clause_property'(erased, Clause) :- 1020 '$get_clause_attribute'(Clause, erased, true). 1021'$clause_property'(predicate(PI), Clause) :- 1022 '$get_clause_attribute'(Clause, predicate_indicator, PI). 1023'$clause_property'(module(M), Clause) :- 1024 '$get_clause_attribute'(Clause, module, M).
incremental(+Bool)
abstract(+Level)
multifile(+Bool)
discontiguous(+Bool)
thread(+Mode)
volatile(+Bool)
1038dynamic(M:Predicates, Options) :- 1039 '$must_be'(list, Predicates), 1040 options_properties(Options, Props), 1041 set_pprops(Predicates, M, [dynamic|Props]). 1042 1043set_pprops([], _, _). 1044set_pprops([H|T], M, Props) :- 1045 set_pprops1(Props, M:H), 1046 strip_module(M:H, M2, P), 1047 '$pi_head'(M2:P, Pred), 1048 '$set_table_wrappers'(Pred), 1049 set_pprops(T, M, Props). 1050 1051set_pprops1([], _). 1052set_pprops1([H|T], P) :- 1053 ( atom(H) 1054 -> '$set_predicate_attribute'(P, H, true) 1055 ; H =.. [Name,Value] 1056 -> '$set_predicate_attribute'(P, Name, Value) 1057 ), 1058 set_pprops1(T, P). 1059 1060options_properties(Options, Props) :- 1061 G = opt_prop(_,_,_,_), 1062 findall(G, G, Spec), 1063 options_properties(Spec, Options, Props). 1064 1065options_properties([], _, []). 1066options_properties([opt_prop(Name, Type, SetValue, Prop)|T], 1067 Options, [Prop|PT]) :- 1068 Opt =.. [Name,V], 1069 '$option'(Opt, Options), 1070 '$must_be'(Type, V), 1071 V = SetValue, 1072 !, 1073 options_properties(T, Options, PT). 1074options_properties([_|T], Options, PT) :- 1075 options_properties(T, Options, PT). 1076 1077opt_prop(incremental, boolean, Bool, incremental(Bool)). 1078opt_prop(abstract, between(0,0), 0, abstract). 1079opt_prop(multifile, boolean, true, multifile). 1080opt_prop(discontiguous, boolean, true, discontiguous). 1081opt_prop(volatile, boolean, true, volatile). 1082opt_prop(thread, oneof(atom, [local,shared],[local,shared]), 1083 local, thread_local). 1084 1085 /******************************** 1086 * MODULES * 1087 *********************************/
1093current_module(Module) :-
1094 '$current_module'(Module, _).
1110module_property(Module, Property) :- 1111 nonvar(Module), nonvar(Property), 1112 !, 1113 property_module(Property, Module). 1114module_property(Module, Property) :- % -, file(File) 1115 nonvar(Property), Property = file(File), 1116 !, 1117 ( nonvar(File) 1118 -> '$current_module'(Modules, File), 1119 ( atom(Modules) 1120 -> Module = Modules 1121 ; '$member'(Module, Modules) 1122 ) 1123 ; '$current_module'(Module, File), 1124 File \== [] 1125 ). 1126module_property(Module, Property) :- 1127 current_module(Module), 1128 property_module(Property, Module). 1129 1130property_module(Property, Module) :- 1131 module_property(Property), 1132 ( Property = exported_operators(List) 1133 -> '$exported_ops'(Module, List, []) 1134 ; '$module_property'(Module, Property) 1135 ). 1136 1137module_property(class(_)). 1138module_property(file(_)). 1139module_property(line_count(_)). 1140module_property(exports(_)). 1141module_property(exported_operators(_)). 1142module_property(size(_)). 1143module_property(program_size(_)). 1144module_property(program_space(_)). 1145module_property(last_modified_generation(_)).
1151module(Module) :- 1152 atom(Module), 1153 current_module(Module), 1154 !, 1155 '$set_typein_module'(Module). 1156module(Module) :- 1157 '$set_typein_module'(Module), 1158 print_message(warning, no_current_module(Module)).
1165working_directory(Old, New) :- 1166 '$cwd'(Old), 1167 ( Old == New 1168 -> true 1169 ; '$chdir'(New) 1170 ). 1171 1172 1173 /******************************* 1174 * TRIES * 1175 *******************************/
1181current_trie(Trie) :-
1182 current_blob(Trie, trie),
1183 is_trie(Trie).
Incremental tabling statistics:
Shared tabling statistics:
1219trie_property(Trie, Property) :- 1220 current_trie(Trie), 1221 trie_property(Property), 1222 '$trie_property'(Trie, Property). 1223 1224trie_property(node_count(_)). 1225trie_property(value_count(_)). 1226trie_property(size(_)). 1227trie_property(hashed(_)). 1228trie_property(compiled_size(_)). 1229 % below only when -DO_TRIE_STATS 1230trie_property(lookup_count(_)). % is enabled in pl-trie.h 1231trie_property(gen_call_count(_)). 1232trie_property(invalidated(_)). % IDG stats 1233trie_property(reevaluated(_)). 1234trie_property(deadlock(_)). % Shared tabling stats 1235trie_property(wait(_)). 1236trie_property(idg_affected_count(_)). 1237trie_property(idg_dependent_count(_)). 1238trie_property(idg_size(_)). 1239 1240 1241 /******************************** 1242 * SYSTEM INTERACTION * 1243 *********************************/ 1244 1245shell(Command) :- 1246 shell(Command, 0). 1247 1248 1249 /******************************* 1250 * SIGNALS * 1251 *******************************/ 1252 1253:- meta_predicate 1254 on_signal( , , ), 1255 current_signal( , , ).
1259on_signal(Signal, Old, New) :- 1260 atom(Signal), 1261 !, 1262 '$on_signal'(_Num, Signal, Old, New). 1263on_signal(Signal, Old, New) :- 1264 integer(Signal), 1265 !, 1266 '$on_signal'(Signal, _Name, Old, New). 1267on_signal(Signal, _Old, _New) :- 1268 '$type_error'(signal_name, Signal).
1272current_signal(Name, Id, Handler) :- 1273 between(1, 32, Id), 1274 '$on_signal'(Id, Name, Handler, Handler). 1275 1276:- multifile 1277 prolog:called_by/2. 1278 1279prologcalled_by(on_signal(_,_,New), [New+1]) :- 1280 ( new == throw 1281 ; new == default 1282 ), !, fail. 1283 1284 1285 /******************************* 1286 * DLOPEN * 1287 *******************************/
now
Resolve all symbols in the file now instead of lazily.global
Make new symbols globally known.1301open_shared_object(File, Handle) :- 1302 open_shared_object(File, Handle, []). % use pl-load.c defaults 1303 1304open_shared_object(File, Handle, Flags) :- 1305 ( is_list(Flags) 1306 -> true 1307 ; throw(error(type_error(list, Flags), _)) 1308 ), 1309 map_dlflags(Flags, Mask), 1310 '$open_shared_object'(File, Handle, Mask). 1311 1312dlopen_flag(now, 2'01). % see pl-load.c for these constants 1313dlopen_flag(global, 2'10). % Solaris only 1314 1315map_dlflags([], 0). 1316map_dlflags([F|T], M) :- 1317 map_dlflags(T, M0), 1318 ( dlopen_flag(F, I) 1319 -> true 1320 ; throw(error(domain_error(dlopen_flag, F), _)) 1321 ), 1322 M is M0 \/ I. 1323 1324 1325 /******************************* 1326 * I/O * 1327 *******************************/ 1328 1329format(Fmt) :- 1330 format(Fmt, []). 1331 1332 /******************************* 1333 * FILES * 1334 *******************************/
1338absolute_file_name(Name, Abs) :- 1339 atomic(Name), 1340 !, 1341 '$absolute_file_name'(Name, Abs). 1342absolute_file_name(Term, Abs) :- 1343 '$chk_file'(Term, [''], [access(read)], true, File), 1344 !, 1345 '$absolute_file_name'(File, Abs). 1346absolute_file_name(Term, Abs) :- 1347 '$chk_file'(Term, [''], [], true, File), 1348 !, 1349 '$absolute_file_name'(File, Abs).
1357tmp_file_stream(Enc, File, Stream) :- 1358 atom(Enc), var(File), var(Stream), 1359 !, 1360 '$tmp_file_stream'('', Enc, File, Stream). 1361tmp_file_stream(File, Stream, Options) :- 1362 current_prolog_flag(encoding, DefEnc), 1363 '$option'(encoding(Enc), Options, DefEnc), 1364 '$option'(extension(Ext), Options, ''), 1365 '$tmp_file_stream'(Ext, Enc, File, Stream), 1366 set_stream(Stream, file_name(File)). 1367 1368 1369 /******************************** 1370 * MEMORY MANAGEMENT * 1371 *********************************/
1380garbage_collect :-
1381 '$garbage_collect'(0).
1387set_prolog_stack(Stack, Option) :-
1388 Option =.. [Name,Value0],
1389 Value is Value0,
1390 '$set_prolog_stack'(Stack, Name, _Old, Value).
1396prolog_stack_property(Stack, Property) :- 1397 stack_property(P), 1398 stack_name(Stack), 1399 Property =.. [P,Value], 1400 '$set_prolog_stack'(Stack, P, Value, Value). 1401 1402stack_name(local). 1403stack_name(global). 1404stack_name(trail). 1405 1406stack_property(limit). 1407stack_property(spare). 1408stack_property(min_free). 1409stack_property(low). 1410stack_property(factor). 1411 1412 1413 /******************************* 1414 * TERM * 1415 *******************************/ 1416 1417:- '$iso'((numbervars/3)).
1425numbervars(Term, From, To) :- 1426 numbervars(Term, From, To, []). 1427 1428 1429 /******************************* 1430 * STRING * 1431 *******************************/
1437term_string(Term, String, Options) :- 1438 nonvar(String), 1439 !, 1440 read_term_from_atom(String, Term, Options). 1441term_string(Term, String, Options) :- 1442 ( '$option'(quoted(_), Options) 1443 -> Options1 = Options 1444 ; '$merge_options'(_{quoted:true}, Options, Options1) 1445 ), 1446 format(string(String), '~W', [Term, Options1]). 1447 1448 1449 /******************************* 1450 * GVAR * 1451 *******************************/
1457nb_setval(Name, Value) :- 1458 duplicate_term(Value, Copy), 1459 nb_linkval(Name, Copy). 1460 1461 1462 /******************************* 1463 * THREADS * 1464 *******************************/ 1465 1466:- meta_predicate 1467 thread_create( , ).
thread_create(Goal, Id, [])
.
1473thread_create(Goal, Id) :-
1474 thread_create(Goal, Id, []).
1483thread_join(Id) :-
1484 thread_join(Id, Status),
1485 ( Status == true
1486 -> true
1487 ; throw(error(thread_error(Id, Status), _))
1488 ).
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.1505set_prolog_gc_thread(Status) :- 1506 var(Status), 1507 !, 1508 '$instantiation_error'(Status). 1509set_prolog_gc_thread(false) :- 1510 !, 1511 set_prolog_flag(gc_thread, false), 1512 ( current_prolog_flag(threads, true) 1513 -> ( '$gc_stop' 1514 -> thread_join(gc) 1515 ; true 1516 ) 1517 ; true 1518 ). 1519set_prolog_gc_thread(true) :- 1520 !, 1521 set_prolog_flag(gc_thread, true). 1522set_prolog_gc_thread(stop) :- 1523 !, 1524 ( current_prolog_flag(threads, true) 1525 -> ( '$gc_stop' 1526 -> thread_join(gc) 1527 ; true 1528 ) 1529 ; true 1530 ). 1531set_prolog_gc_thread(Status) :- 1532 '$domain_error'(gc_thread, Status).
1541transaction(Goal) :- 1542 '$transaction'(Goal, []). 1543transaction(Goal, Options) :- 1544 '$transaction'(Goal, Options). 1545transaction(Goal, Constraint, Mutex) :- 1546 '$transaction'(Goal, Constraint, Mutex). 1547snapshot(Goal) :- 1548 '$snapshot'(Goal).
1556:- meta_predicate 1557 '$wrap_predicate'( , , , , ). 1558 1559'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :- 1560 callable_name_arguments(Head, PName, Args), 1561 callable_name_arity(Head, PName, Arity), 1562 ( is_most_general_term(Head) 1563 -> true 1564 ; '$domain_error'(most_general_term, Head) 1565 ), 1566 atomic_list_concat(['$wrap$', PName], WrapName), 1567 volatile(M:WrapName/Arity), 1568 module_transparent(M:WrapName/Arity), 1569 WHead =.. [WrapName|Args], 1570 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)). 1571 1572callable_name_arguments(Head, PName, Args) :- 1573 atom(Head), 1574 !, 1575 PName = Head, 1576 Args = []. 1577callable_name_arguments(Head, PName, Args) :- 1578 compound_name_arguments(Head, PName, Args). 1579 1580callable_name_arity(Head, PName, Arity) :- 1581 atom(Head), 1582 !, 1583 PName = Head, 1584 Arity = 0. 1585callable_name_arity(Head, PName, Arity) :- 1586 compound_name_arity(Head, PName, Arity)