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-2017, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module('$syspreds', 37 [ leash/1, 38 visible/1, 39 style_check/1, 40 (spy)/1, 41 (nospy)/1, 42 trace/1, 43 trace/2, 44 nospyall/0, 45 debugging/0, 46 rational/3, 47 flag/3, 48 atom_prefix/2, 49 dwim_match/2, 50 source_file_property/2, 51 source_file/1, 52 source_file/2, 53 unload_file/1, 54 prolog_load_context/2, 55 stream_position_data/3, 56 current_predicate/2, 57 '$defined_predicate'/1, 58 predicate_property/2, 59 '$predicate_property'/2, 60 clause_property/2, 61 current_module/1, % ?Module 62 module_property/2, % ?Module, ?Property 63 module/1, % +Module 64 current_trie/1, % ?Trie 65 trie_property/2, % ?Trie, ?Property 66 working_directory/2, % -OldDir, +NewDir 67 shell/1, % +Command 68 on_signal/3, 69 current_signal/3, 70 open_shared_object/2, 71 open_shared_object/3, 72 format/1, 73 garbage_collect/0, 74 set_prolog_stack/2, 75 prolog_stack_property/2, 76 absolute_file_name/2, 77 require/1, 78 call_with_depth_limit/3, % :Goal, +Limit, -Result 79 call_with_inference_limit/3, % :Goal, +Limit, -Result 80 numbervars/3, % +Term, +Start, -End 81 term_string/3, % ?Term, ?String, +Options 82 nb_setval/2, % +Var, +Value 83 thread_create/2, % :Goal, -Id 84 thread_join/1, % +Id 85 set_prolog_gc_thread/1 % +Status 86 ]). 87 88 /******************************** 89 * DEBUGGER * 90 *********************************/
94:- meta_predicate 95 map_bits( , , , ). 96 97map_bits(_, Var, _, _) :- 98 var(Var), 99 !, 100 '$instantiation_error'(Var). 101map_bits(_, [], Bits, Bits) :- !. 102map_bits(Pred, [H|T], Old, New) :- 103 map_bits(Pred, H, Old, New0), 104 map_bits(Pred, T, New0, New). 105map_bits(Pred, +Name, Old, New) :- % set a bit 106 !, 107 bit(Pred, Name, Bits), 108 !, 109 New is Old \/ Bits. 110map_bits(Pred, -Name, Old, New) :- % clear a bit 111 !, 112 bit(Pred, Name, Bits), 113 !, 114 New is Old /\ (\Bits). 115map_bits(Pred, ?(Name), Old, Old) :- % ask a bit 116 !, 117 bit(Pred, Name, Bits), 118 Old /\ Bits > 0. 119map_bits(_, Term, _, _) :- 120 '$type_error'('+|-|?(Flag)', Term). 121 122bit(Pred, Name, Bits) :- 123 call(Pred, Name, Bits), 124 !. 125bit(_:Pred, Name, _) :- 126 '$domain_error'(Pred, Name). 127 128:- public port_name/2. % used by library(test_cover) 129 130port_name( call, 2'000000001). 131port_name( exit, 2'000000010). 132port_name( fail, 2'000000100). 133port_name( redo, 2'000001000). 134port_name( unify, 2'000010000). 135port_name( break, 2'000100000). 136port_name( cut_call, 2'001000000). 137port_name( cut_exit, 2'010000000). 138port_name( exception, 2'100000000). 139port_name( cut, 2'011000000). 140port_name( all, 2'000111111). 141port_name( full, 2'000101111). 142port_name( half, 2'000101101). % ' 143 144leash(Ports) :- 145 '$leash'(Old, Old), 146 map_bits(port_name, Ports, Old, New), 147 '$leash'(_, New). 148 149visible(Ports) :- 150 '$visible'(Old, Old), 151 map_bits(port_name, Ports, Old, New), 152 '$visible'(_, New). 153 154style_name(atom, 0x0001) :- 155 print_message(warning, decl_no_effect(style_check(atom))). 156style_name(singleton, 0x0042). % semantic and syntactic 157style_name(discontiguous, 0x0008). 158style_name(charset, 0x0020). 159style_name(no_effect, 0x0080). 160style_name(var_branches, 0x0100).
164style_check(Var) :- 165 var(Var), 166 !, 167 '$instantiation_error'(Var). 168style_check(?(Style)) :- 169 !, 170 ( var(Style) 171 -> enum_style_check(Style) 172 ; enum_style_check(Style) 173 -> true 174 ). 175style_check(Spec) :- 176 '$style_check'(Old, Old), 177 map_bits(style_name, Spec, Old, New), 178 '$style_check'(_, New). 179 180enum_style_check(Style) :- 181 '$style_check'(Bits, Bits), 182 style_name(Style, Bit), 183 Bit /\ Bits =\= 0.
TBD: What hooks to provide for trace/[1,2]
194:- multifile 195 prolog:debug_control_hook/1. % +Action
203:- meta_predicate 204 trace( ), 205 trace( , ). 206 207trace(Preds) :- 208 trace(Preds, +all). 209 210trace(_:X, _) :- 211 var(X), 212 !, 213 throw(error(instantiation_error, _)). 214trace(_:[], _) :- !. 215trace(M:[H|T], Ps) :- 216 !, 217 trace(M:H, Ps), 218 trace(M:T, Ps). 219trace(Pred, Ports) :- 220 '$find_predicate'(Pred, Preds), 221 Preds \== [], 222 set_prolog_flag(debug, true), 223 ( '$member'(PI, Preds), 224 pi_to_head(PI, Head), 225 ( Head = _:_ 226 -> QHead0 = Head 227 ; QHead0 = user:Head 228 ), 229 '$define_predicate'(QHead0), 230 ( predicate_property(QHead0, imported_from(M)) 231 -> QHead0 = _:Plain, 232 QHead = M:Plain 233 ; QHead = QHead0 234 ), 235 '$trace'(Ports, QHead), 236 trace_ports(QHead, Tracing), 237 print_message(informational, trace(QHead, Tracing)), 238 fail 239 ; true 240 ). 241 242trace_alias(all, [trace_call, trace_redo, trace_exit, trace_fail]). 243trace_alias(call, [trace_call]). 244trace_alias(redo, [trace_redo]). 245trace_alias(exit, [trace_exit]). 246trace_alias(fail, [trace_fail]). 247 248'$trace'([], _) :- !. 249'$trace'([H|T], Head) :- 250 !, 251 '$trace'(H, Head), 252 '$trace'(T, Head). 253'$trace'(+H, Head) :- 254 trace_alias(H, A0), 255 !, 256 tag_list(A0, +, A1), 257 '$trace'(A1, Head). 258'$trace'(+H, Head) :- 259 !, 260 trace_alias(_, [H]), 261 '$set_predicate_attribute'(Head, H, true). 262'$trace'(-H, Head) :- 263 trace_alias(H, A0), 264 !, 265 tag_list(A0, -, A1), 266 '$trace'(A1, Head). 267'$trace'(-H, Head) :- 268 !, 269 trace_alias(_, [H]), 270 '$set_predicate_attribute'(Head, H, false). 271'$trace'(H, Head) :- 272 atom(H), 273 '$trace'(+H, Head). 274 275tag_list([], _, []). 276tag_list([H0|T0], F, [H1|T1]) :- 277 H1 =.. [F, H0], 278 tag_list(T0, F, T1). 279 280:- meta_predicate 281 spy( ), 282 nospy( ).
informational
, with one
of the following terms, where Spec is of the form M:Head.
spy(Spec)
nospy(Spec)
299spy(_:X) :- 300 var(X), 301 throw(error(instantiation_error, _)). 302spy(_:[]) :- !. 303spy(M:[H|T]) :- 304 !, 305 spy(M:H), 306 spy(M:T). 307spy(Spec) :- 308 notrace(prolog:debug_control_hook(spy(Spec))), 309 !. 310spy(Spec) :- 311 '$find_predicate'(Spec, Preds), 312 '$member'(PI, Preds), 313 pi_to_head(PI, Head), 314 '$define_predicate'(Head), 315 '$spy'(Head), 316 fail. 317spy(_). 318 319nospy(_:X) :- 320 var(X), 321 throw(error(instantiation_error, _)). 322nospy(_:[]) :- !. 323nospy(M:[H|T]) :- 324 !, 325 nospy(M:H), 326 nospy(M:T). 327nospy(Spec) :- 328 notrace(prolog:debug_control_hook(nospy(Spec))), 329 !. 330nospy(Spec) :- 331 '$find_predicate'(Spec, Preds), 332 '$member'(PI, Preds), 333 pi_to_head(PI, Head), 334 '$nospy'(Head), 335 fail. 336nospy(_). 337 338nospyall :- 339 notrace(prolog:debug_control_hook(nospyall)), 340 fail. 341nospyall :- 342 spy_point(Head), 343 '$nospy'(Head), 344 fail. 345nospyall. 346 347pi_to_head(M:PI, M:Head) :- 348 !, 349 pi_to_head(PI, Head). 350pi_to_head(Name/Arity, Head) :- 351 functor(Head, Name, Arity).
357debugging :- 358 notrace(prolog:debug_control_hook(debugging)), 359 !. 360debugging :- 361 current_prolog_flag(debug, true), 362 !, 363 print_message(informational, debugging(on)), 364 findall(H, spy_point(H), SpyPoints), 365 print_message(informational, spying(SpyPoints)), 366 findall(trace(H,P), trace_point(H,P), TracePoints), 367 print_message(informational, tracing(TracePoints)). 368debugging :- 369 print_message(informational, debugging(off)). 370 371spy_point(Module:Head) :- 372 current_predicate(_, Module:Head), 373 '$get_predicate_attribute'(Module:Head, spy, 1), 374 \+ predicate_property(Module:Head, imported_from(_)). 375 376trace_point(Module:Head, Ports) :- 377 current_predicate(_, Module:Head), 378 '$get_predicate_attribute'(Module:Head, trace_any, 1), 379 \+ predicate_property(Module:Head, imported_from(_)), 380 trace_ports(Module:Head, Ports). 381 382trace_ports(Head, Ports) :- 383 findall(Port, 384 (trace_alias(Port, [AttName]), 385 '$get_predicate_attribute'(Head, AttName, 1)), 386 Ports).
394flag(Name, Old, New) :- 395 Old == New, 396 !, 397 get_flag(Name, Old). 398flag(Name, Old, New) :- 399 with_mutex('$flag', update_flag(Name, Old, New)). 400 401update_flag(Name, Old, New) :- 402 get_flag(Name, Old), 403 ( atom(New) 404 -> set_flag(Name, New) 405 ; Value is New, 406 set_flag(Name, Value) 407 ). 408 409 410 /******************************* 411 * RATIONAL * 412 *******************************/
419rational(Rat, M, N) :- 420 rational(Rat), 421 ( Rat = rdiv(M, N) 422 -> true 423 ; integer(Rat) 424 -> M = Rat, 425 N = 1 426 ). 427 428 429 /******************************** 430 * ATOMS * 431 *********************************/ 432 433dwim_match(A1, A2) :- 434 dwim_match(A1, A2, _). 435 436atom_prefix(Atom, Prefix) :- 437 sub_atom(Atom, 0, _, _, Prefix). 438 439 440 /******************************** 441 * SOURCE * 442 *********************************/
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.
455source_file(File) :-
456 ( current_prolog_flag(access_level, user)
457 -> Level = user
458 ; true
459 ),
460 ( ground(File)
461 -> ( '$time_source_file'(File, Time, Level)
462 ; absolute_file_name(File, Abs),
463 '$time_source_file'(Abs, Time, Level)
464 ), !
465 ; '$time_source_file'(File, Time, Level)
466 ),
467 Time > 0.0.
474:- meta_predicate source_file( , ). 475 476source_file(M:Head, File) :- 477 nonvar(M), nonvar(Head), 478 !, 479 ( '$c_current_predicate'(_, M:Head), 480 predicate_property(M:Head, multifile) 481 -> multi_source_files(M:Head, Files), 482 '$member'(File, Files) 483 ; '$source_file'(M:Head, File) 484 ). 485source_file(M:Head, File) :- 486 ( nonvar(File) 487 -> true 488 ; source_file(File) 489 ), 490 '$source_file_predicates'(File, Predicates), 491 '$member'(M:Head, Predicates). 492 493:- thread_local found_src_file/1. 494 495multi_source_files(Head, Files) :- 496 call_cleanup( 497 findall(File, multi_source_file(Head, File), Files), 498 retractall(found_src_file(_))). 499 500multi_source_file(Head, File) :- 501 nth_clause(Head, _, Clause), 502 clause_property(Clause, source(File)), 503 \+ found_src_file(File), 504 asserta(found_src_file(File)).
511source_file_property(File, P) :- 512 nonvar(File), 513 !, 514 canonical_source_file(File, Path), 515 property_source_file(P, Path). 516source_file_property(File, P) :- 517 property_source_file(P, File). 518 519property_source_file(modified(Time), File) :- 520 '$time_source_file'(File, Time, user). 521property_source_file(module(M), File) :- 522 ( nonvar(M) 523 -> '$current_module'(M, File) 524 ; nonvar(File) 525 -> '$current_module'(ML, File), 526 ( atom(ML) 527 -> M = ML 528 ; '$member'(M, ML) 529 ) 530 ; '$current_module'(M, File) 531 ). 532property_source_file(load_context(Module, Location, Options), File) :- 533 '$time_source_file'(File, _, user), 534 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 535 ( clause_property(Ref, file(FromFile)), 536 clause_property(Ref, line_count(FromLine)) 537 -> Location = FromFile:FromLine 538 ; Location = user 539 ). 540property_source_file(includes(Master, Stamp), File) :- 541 system:'$included'(File, _Line, Master, Stamp). 542property_source_file(included_in(Master, Line), File) :- 543 system:'$included'(Master, Line, File, _). 544property_source_file(derived_from(DerivedFrom, Stamp), File) :- 545 system:'$derived_source'(File, DerivedFrom, Stamp). 546property_source_file(reloading, File) :- 547 source_file(File), 548 '$source_file_property'(File, reloading, true). 549property_source_file(load_count(Count), File) :- 550 source_file(File), 551 '$source_file_property'(File, load_count, Count). 552property_source_file(number_of_clauses(Count), File) :- 553 source_file(File), 554 '$source_file_property'(File, number_of_clauses, Count).
561canonical_source_file(Spec, File) :- 562 atom(Spec), 563 '$time_source_file'(Spec, _, _), 564 !, 565 File = Spec. 566canonical_source_file(Spec, File) :- 567 system:'$included'(_Master, _Line, Spec, _), 568 !, 569 File = Spec. 570canonical_source_file(Spec, File) :- 571 absolute_file_name(Spec, 572 [ file_type(prolog), 573 access(read), 574 file_errors(fail) 575 ], 576 File), 577 source_file(File).
586prolog_load_context(module, Module) :- 587 '$current_source_module'(Module). 588prolog_load_context(file, F) :- 589 source_location(F, _). 590prolog_load_context(source, F) :- % SICStus compatibility 591 source_location(F0, _), 592 '$input_context'(Context), 593 '$top_file'(Context, F0, F). 594prolog_load_context(stream, S) :- 595 ( system:'$load_input'(_, S0) 596 -> S = S0 597 ). 598prolog_load_context(directory, D) :- 599 source_location(F, _), 600 file_directory_name(F, D). 601prolog_load_context(dialect, D) :- 602 current_prolog_flag(emulated_dialect, D). 603prolog_load_context(term_position, TermPos) :- 604 source_location(_, L), 605 ( nb_current('$term_position', Pos), 606 compound(Pos), % actually set 607 stream_position_data(line_count, Pos, L) 608 -> TermPos = Pos 609 ; TermPos = '$stream_position'(0,L,0,0) 610 ). 611prolog_load_context(script, Bool) :- 612 ( '$toplevel':loaded_init_file(script, Path), 613 source_location(Path, _) 614 -> Bool = true 615 ; Bool = false 616 ). 617prolog_load_context(variable_names, Bindings) :- 618 nb_current('$variable_names', Bindings). 619prolog_load_context(term, Term) :- 620 nb_current('$term', Term). 621prolog_load_context(reloading, true) :- 622 prolog_load_context(source, F), 623 '$source_file_property'(F, reloading, true).
629unload_file(File) :- 630 ( canonical_source_file(File, Path) 631 -> '$unload_file'(Path) 632 ; true 633 ). 634 635 636 /******************************* 637 * STREAMS * 638 *******************************/
645stream_position_data(Prop, Term, Value) :- 646 nonvar(Prop), 647 !, 648 ( stream_position_field(Prop, Pos) 649 -> arg(Pos, Term, Value) 650 ; throw(error(domain_error(stream_position_data, Prop))) 651 ). 652stream_position_data(Prop, Term, Value) :- 653 stream_position_field(Prop, Pos), 654 arg(Pos, Term, Value). 655 656stream_position_field(char_count, 1). 657stream_position_field(line_count, 2). 658stream_position_field(line_position, 3). 659stream_position_field(byte_count, 4). 660 661 662 /******************************* 663 * CONTROL * 664 *******************************/
672:- meta_predicate 673 call_with_depth_limit( , , ). 674 675call_with_depth_limit(G, Limit, Result) :- 676 '$depth_limit'(Limit, OLimit, OReached), 677 ( catch(, E, '$depth_limit_except'(OLimit, OReached, E)), 678 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 679 ( Det == ! -> ! ; true ) 680 ; '$depth_limit_false'(OLimit, OReached, Result) 681 ).
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.
695:- meta_predicate 696 call_with_inference_limit( , , ). 697 698call_with_inference_limit(G, Limit, Result) :- 699 '$inference_limit'(Limit, OLimit), 700 ( catch(, Except, 701 system:'$inference_limit_except'(OLimit, Except, Result0)), 702 system:'$inference_limit_true'(Limit, OLimit, Result0), 703 ( Result0 == ! -> ! ; true ), 704 Result = Result0 705 ; system:'$inference_limit_false'(OLimit) 706 ). 707 708 709 /******************************** 710 * DATA BASE * 711 *********************************/ 712 713/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 714The predicate current_predicate/2 is a difficult subject since the 715introduction of defaulting modules and dynamic libraries. 716current_predicate/2 is normally called with instantiated arguments to 717verify some predicate can be called without trapping an undefined 718predicate. In this case we must perform the search algorithm used by 719the prolog system itself. 720 721If the pattern is not fully specified, we only generate the predicates 722actually available in this module. This seems the best for listing, 723etc. 724- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 725 726 727:- meta_predicate 728 current_predicate( , ), 729 '$defined_predicate'( ). 730 731current_predicate(Name, Module:Head) :- 732 (var(Module) ; var(Head)), 733 !, 734 generate_current_predicate(Name, Module, Head). 735current_predicate(Name, Term) :- 736 '$c_current_predicate'(Name, Term), 737 '$defined_predicate'(Term), 738 !. 739current_predicate(Name, Module:Head) :- 740 default_module(Module, DefModule), 741 '$c_current_predicate'(Name, DefModule:Head), 742 '$defined_predicate'(DefModule:Head), 743 !. 744current_predicate(Name, Module:Head) :- 745 current_prolog_flag(autoload, true), 746 \+ current_prolog_flag(Moduleunknown, fail), 747 ( compound(Head) 748 -> compound_name_arity(Head, Name, Arity) 749 ; Name = Head, Arity = 0 750 ), 751 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 752 !. 753 754generate_current_predicate(Name, Module, Head) :- 755 current_module(Module), 756 QHead = Module:Head, 757 '$c_current_predicate'(Name, QHead), 758 '$get_predicate_attribute'(QHead, defined, 1). 759 760'$defined_predicate'(Head) :- 761 '$get_predicate_attribute'(Head, defined, 1), 762 !.
768:- meta_predicate 769 predicate_property( , ). 770 771:- '$iso'(predicate_property/2). 772 773predicate_property(Pred, Property) :- % Mode ?,+ 774 nonvar(Property), 775 !, 776 property_predicate(Property, Pred). 777predicate_property(Pred, Property) :- % Mode +,- 778 define_or_generate(Pred), 779 '$predicate_property'(Property, Pred).
undefined
, visible
and
autoload
, followed by the generic case.787property_predicate(undefined, Pred) :- 788 !, 789 Pred = Module:Head, 790 current_module(Module), 791 '$c_current_predicate'(_, Pred), 792 \+ '$defined_predicate'(Pred), % Speed up a bit 793 \+ current_predicate(_, Pred), 794 goal_name_arity(Head, Name, Arity), 795 \+ system_undefined(Module:Name/Arity). 796property_predicate(visible, Pred) :- 797 !, 798 visible_predicate(Pred). 799property_predicate(autoload(File), _:Head) :- 800 !, 801 current_prolog_flag(autoload, true), 802 ( callable(Head) 803 -> goal_name_arity(Head, Name, Arity), 804 ( '$find_library'(_, Name, Arity, _, File) 805 -> true 806 ) 807 ; '$in_library'(Name, Arity, File), 808 functor(Head, Name, Arity) 809 ). 810property_predicate(implementation_module(IM), M:Head) :- 811 !, 812 atom(M), 813 ( default_module(M, DM), 814 '$get_predicate_attribute'(DM:Head, defined, 1) 815 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 816 -> IM = ImportM 817 ; IM = M 818 ) 819 ; \+ current_prolog_flag(Munknown, fail), 820 goal_name_arity(Head, Name, Arity), 821 '$find_library'(_, Name, Arity, LoadModule, _File) 822 -> IM = LoadModule 823 ; M = IM 824 ). 825property_predicate(Property, Pred) :- 826 define_or_generate(Pred), 827 '$predicate_property'(Property, Pred). 828 829goal_name_arity(Head, Name, Arity) :- 830 compound(Head), 831 !, 832 compound_name_arity(Head, Name, Arity). 833goal_name_arity(Head, Head, 0).
842define_or_generate(M:Head) :- 843 callable(Head), 844 atom(M), 845 '$get_predicate_attribute'(M:Head, defined, 1), 846 !. 847define_or_generate(M:Head) :- 848 callable(Head), 849 nonvar(M), M \== system, 850 !, 851 '$define_predicate'(M:Head). 852define_or_generate(Pred) :- 853 current_predicate(_, Pred), 854 '$define_predicate'(Pred). 855 856 857'$predicate_property'(interpreted, Pred) :- 858 '$get_predicate_attribute'(Pred, foreign, 0). 859'$predicate_property'(visible, Pred) :- 860 '$get_predicate_attribute'(Pred, defined, 1). 861'$predicate_property'(built_in, Pred) :- 862 '$get_predicate_attribute'(Pred, system, 1). 863'$predicate_property'(exported, Pred) :- 864 '$get_predicate_attribute'(Pred, exported, 1). 865'$predicate_property'(public, Pred) :- 866 '$get_predicate_attribute'(Pred, public, 1). 867'$predicate_property'(foreign, Pred) :- 868 '$get_predicate_attribute'(Pred, foreign, 1). 869'$predicate_property'((dynamic), Pred) :- 870 '$get_predicate_attribute'(Pred, (dynamic), 1). 871'$predicate_property'((static), Pred) :- 872 '$get_predicate_attribute'(Pred, (dynamic), 0). 873'$predicate_property'((volatile), Pred) :- 874 '$get_predicate_attribute'(Pred, (volatile), 1). 875'$predicate_property'((thread_local), Pred) :- 876 '$get_predicate_attribute'(Pred, (thread_local), 1). 877'$predicate_property'((multifile), Pred) :- 878 '$get_predicate_attribute'(Pred, (multifile), 1). 879'$predicate_property'(imported_from(Module), Pred) :- 880 '$get_predicate_attribute'(Pred, imported, Module). 881'$predicate_property'(transparent, Pred) :- 882 '$get_predicate_attribute'(Pred, transparent, 1). 883'$predicate_property'(meta_predicate(Pattern), Pred) :- 884 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 885'$predicate_property'(file(File), Pred) :- 886 '$get_predicate_attribute'(Pred, file, File). 887'$predicate_property'(line_count(LineNumber), Pred) :- 888 '$get_predicate_attribute'(Pred, line_count, LineNumber). 889'$predicate_property'(notrace, Pred) :- 890 '$get_predicate_attribute'(Pred, trace, 0). 891'$predicate_property'(nodebug, Pred) :- 892 '$get_predicate_attribute'(Pred, hide_childs, 1). 893'$predicate_property'(spying, Pred) :- 894 '$get_predicate_attribute'(Pred, spy, 1). 895'$predicate_property'(number_of_clauses(N), Pred) :- 896 '$get_predicate_attribute'(Pred, number_of_clauses, N). 897'$predicate_property'(number_of_rules(N), Pred) :- 898 '$get_predicate_attribute'(Pred, number_of_rules, N). 899'$predicate_property'(last_modified_generation(Gen), Pred) :- 900 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 901'$predicate_property'(indexed(Indices), Pred) :- 902 '$get_predicate_attribute'(Pred, indexed, Indices). 903'$predicate_property'(noprofile, Pred) :- 904 '$get_predicate_attribute'(Pred, noprofile, 1). 905'$predicate_property'(iso, Pred) :- 906 '$get_predicate_attribute'(Pred, iso, 1). 907'$predicate_property'(quasi_quotation_syntax, Pred) :- 908 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 909'$predicate_property'(defined, Pred) :- 910 '$get_predicate_attribute'(Pred, defined, 1). 911 912system_undefined(user:prolog_trace_interception/4). 913system_undefined(user:prolog_exception_hook/4). 914system_undefined(system:'$c_call_prolog'/0). 915system_undefined(system:window_title/2).
923visible_predicate(Pred) :- 924 Pred = M:Head, 925 current_module(M), 926 ( callable(Head) 927 -> ( '$get_predicate_attribute'(Pred, defined, 1) 928 -> true 929 ; \+ current_prolog_flag(Munknown, fail), 930 functor(Head, Name, Arity), 931 '$find_library'(M, Name, Arity, _LoadModule, _Library) 932 ) 933 ; setof(PI, visible_in_module(M, PI), PIs), 934 '$member'(Name/Arity, PIs), 935 functor(Head, Name, Arity) 936 ). 937 938visible_in_module(M, Name/Arity) :- 939 default_module(M, DefM), 940 DefHead = DefM:Head, 941 '$c_current_predicate'(_, DefHead), 942 '$get_predicate_attribute'(DefHead, defined, 1), 943 \+ hidden_system_predicate(Head), 944 functor(Head, Name, Arity). 945visible_in_module(_, Name/Arity) :- 946 '$in_library'(Name, Arity, _). 947 Head) (:- 949 functor(Head, Name, _), 950 atom(Name), % Avoid []. 951 sub_atom(Name, 0, _, _, $), 952 \+ current_prolog_flag(access_level, system).
true
.977clause_property(Clause, Property) :- 978 '$clause_property'(Property, Clause). 979 980'$clause_property'(line_count(LineNumber), Clause) :- 981 '$get_clause_attribute'(Clause, line_count, LineNumber). 982'$clause_property'(file(File), Clause) :- 983 '$get_clause_attribute'(Clause, file, File). 984'$clause_property'(source(File), Clause) :- 985 '$get_clause_attribute'(Clause, owner, File). 986'$clause_property'(size(Bytes), Clause) :- 987 '$get_clause_attribute'(Clause, size, Bytes). 988'$clause_property'(fact, Clause) :- 989 '$get_clause_attribute'(Clause, fact, true). 990'$clause_property'(erased, Clause) :- 991 '$get_clause_attribute'(Clause, erased, true). 992'$clause_property'(predicate(PI), Clause) :- 993 '$get_clause_attribute'(Clause, predicate_indicator, PI). 994'$clause_property'(module(M), Clause) :- 995 '$get_clause_attribute'(Clause, module, M). 996 997 998 /******************************* 999 * REQUIRE * 1000 *******************************/ 1001 1002:- meta_predicate 1003 require( ).
1012require(M:List) :- 1013 ( is_list(List) 1014 -> require(List, M) 1015 ; throw(error(type_error(list, List), _)) 1016 ). 1017 1018require([], _). 1019require([N/A|T], M) :- 1020 !, 1021 functor(Head, N, A), 1022 '$require'(M:Head), 1023 require(T, M). 1024require([H|_T], _) :- 1025 throw(error(type_error(predicate_indicator, H), _)). 1026 1027 1028 /******************************** 1029 * MODULES * 1030 *********************************/
1036current_module(Module) :-
1037 '$current_module'(Module, _).
1053module_property(Module, Property) :- 1054 nonvar(Module), nonvar(Property), 1055 !, 1056 property_module(Property, Module). 1057module_property(Module, Property) :- % -, file(File) 1058 nonvar(Property), Property = file(File), 1059 !, 1060 ( nonvar(File) 1061 -> '$current_module'(Modules, File), 1062 ( atom(Modules) 1063 -> Module = Modules 1064 ; '$member'(Module, Modules) 1065 ) 1066 ; '$current_module'(Module, File), 1067 File \== [] 1068 ). 1069module_property(Module, Property) :- 1070 current_module(Module), 1071 property_module(Property, Module). 1072 1073property_module(Property, Module) :- 1074 module_property(Property), 1075 ( Property = exported_operators(List) 1076 -> '$exported_ops'(Module, List, []), 1077 List \== [] 1078 ; '$module_property'(Module, Property) 1079 ). 1080 1081module_property(class(_)). 1082module_property(file(_)). 1083module_property(line_count(_)). 1084module_property(exports(_)). 1085module_property(exported_operators(_)). 1086module_property(program_size(_)). 1087module_property(program_space(_)). 1088module_property(last_modified_generation(_)).
1094module(Module) :- 1095 atom(Module), 1096 current_module(Module), 1097 !, 1098 '$set_typein_module'(Module). 1099module(Module) :- 1100 '$set_typein_module'(Module), 1101 print_message(warning, no_current_module(Module)).
1108working_directory(Old, New) :- 1109 '$cwd'(Old), 1110 ( Old == New 1111 -> true 1112 ; '$chdir'(New) 1113 ). 1114 1115 1116 /******************************* 1117 * TRIES * 1118 *******************************/
1124current_trie(Trie) :-
1125 current_blob(Trie, trie),
1126 is_trie(Trie).
1142trie_property(Trie, Property) :- 1143 current_trie(Trie), 1144 trie_property(Property), 1145 '$trie_property'(Trie, Property). 1146 1147trie_property(node_count(_)). 1148trie_property(value_count(_)). 1149trie_property(size(_)). 1150trie_property(hashed(_)). 1151 1152 1153 1154 /******************************** 1155 * SYSTEM INTERACTION * 1156 *********************************/ 1157 1158shell(Command) :- 1159 shell(Command, 0).
1166:- if(current_prolog_flag(windows, true)). 1167:- export(win_add_dll_directory/1). 1168win_add_dll_directory(Dir) :- 1169 win_add_dll_directory(Dir, _), 1170 !. 1171win_add_dll_directory(Dir) :- 1172 prolog_to_os_filename(Dir, OSDir), 1173 getenv('PATH', Path0), 1174 atomic_list_concat([Path0, OSDir], ';', Path), 1175 setenv('PATH', Path). 1176:- endif. 1177 1178 /******************************* 1179 * SIGNALS * 1180 *******************************/ 1181 1182:- meta_predicate 1183 on_signal( , , ), 1184 current_signal( , , ).
1188on_signal(Signal, Old, New) :- 1189 atom(Signal), 1190 !, 1191 '$on_signal'(_Num, Signal, Old, New). 1192on_signal(Signal, Old, New) :- 1193 integer(Signal), 1194 !, 1195 '$on_signal'(Signal, _Name, Old, New). 1196on_signal(Signal, _Old, _New) :- 1197 '$type_error'(signal_name, Signal).
1201current_signal(Name, Id, Handler) :- 1202 between(1, 32, Id), 1203 '$on_signal'(Id, Name, Handler, Handler). 1204 1205:- multifile 1206 prolog:called_by/2. 1207 1208prologcalled_by(on_signal(_,_,New), [New+1]) :- 1209 ( new == throw 1210 ; new == default 1211 ), !, fail. 1212 1213 1214 /******************************* 1215 * DLOPEN * 1216 *******************************/
now
Resolve all symbols in the file now instead of lazily.global
Make new symbols globally known.1230open_shared_object(File, Handle) :- 1231 open_shared_object(File, Handle, []). % use pl-load.c defaults 1232 1233open_shared_object(File, Handle, Flags) :- 1234 ( is_list(Flags) 1235 -> true 1236 ; throw(error(type_error(list, Flags), _)) 1237 ), 1238 map_dlflags(Flags, Mask), 1239 '$open_shared_object'(File, Handle, Mask). 1240 1241dlopen_flag(now, 2'01). % see pl-load.c for these constants 1242dlopen_flag(global, 2'10). % Solaris only 1243 1244map_dlflags([], 0). 1245map_dlflags([F|T], M) :- 1246 map_dlflags(T, M0), 1247 ( dlopen_flag(F, I) 1248 -> true 1249 ; throw(error(domain_error(dlopen_flag, F), _)) 1250 ), 1251 M is M0 \/ I. 1252 1253 1254 /******************************* 1255 * I/O * 1256 *******************************/ 1257 1258format(Fmt) :- 1259 format(Fmt, []). 1260 1261 /******************************* 1262 * FILES * 1263 *******************************/ 1264 1265% absolute_file_name(+Term, -AbsoluteFile) 1266 1267absolute_file_name(Name, Abs) :- 1268 atomic(Name), 1269 !, 1270 '$absolute_file_name'(Name, Abs). 1271absolute_file_name(Term, Abs) :- 1272 '$chk_file'(Term, [''], [access(read)], true, File), 1273 !, 1274 '$absolute_file_name'(File, Abs). 1275absolute_file_name(Term, Abs) :- 1276 '$chk_file'(Term, [''], [], true, File), 1277 !, 1278 '$absolute_file_name'(File, Abs). 1279 1280 1281 /******************************** 1282 * MEMORY MANAGEMENT * 1283 *********************************/
1292garbage_collect :-
1293 '$garbage_collect'(0).
1299set_prolog_stack(Stack, Option) :-
1300 Option =.. [Name,Value0],
1301 Value is Value0,
1302 '$set_prolog_stack'(Stack, Name, _Old, Value).
1308prolog_stack_property(Stack, Property) :- 1309 stack_property(P), 1310 stack_name(Stack), 1311 Property =.. [P,Value], 1312 '$set_prolog_stack'(Stack, P, Value, Value). 1313 1314stack_name(local). 1315stack_name(global). 1316stack_name(trail). 1317 1318stack_property(limit). 1319stack_property(spare). 1320stack_property(min_free). 1321stack_property(low). 1322stack_property(factor). 1323 1324 1325 /******************************* 1326 * TERM * 1327 *******************************/ 1328 1329:- '$iso'((numbervars/3)).
1337numbervars(Term, From, To) :- 1338 numbervars(Term, From, To, []). 1339 1340 1341 /******************************* 1342 * STRING * 1343 *******************************/
1349term_string(Term, String, Options) :- 1350 nonvar(String), 1351 !, 1352 read_term_from_atom(String, Term, Options). 1353term_string(Term, String, Options) :- 1354 ( '$option'(quoted(_), Options) 1355 -> Options1 = Options 1356 ; '$merge_options'(_{quoted:true}, Options, Options1) 1357 ), 1358 format(string(String), '~W', [Term, Options1]). 1359 1360 1361 /******************************* 1362 * GVAR * 1363 *******************************/
1369nb_setval(Name, Value) :- 1370 duplicate_term(Value, Copy), 1371 nb_linkval(Name, Copy). 1372 1373 1374 /******************************* 1375 * THREADS * 1376 *******************************/ 1377 1378:- meta_predicate 1379 thread_create( , ).
thread_create(Goal, Id, [])
.
1385thread_create(Goal, Id) :-
1386 thread_create(, Id, []).
1395thread_join(Id) :-
1396 thread_join(Id, Status),
1397 ( Status == true
1398 -> true
1399 ; throw(error(thread_error(Status), _))
1400 ).
gc
.gc
thread it 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.1417set_prolog_gc_thread(Status) :- 1418 var(Status), 1419 !, 1420 '$instantiation_error'(Status). 1421:- if(current_prolog_flag(threads,true)). 1422set_prolog_gc_thread(false) :- 1423 !, 1424 set_prolog_flag(gc_thread, false), 1425 ( '$gc_stop' 1426 -> thread_join(gc) 1427 ; true 1428 ). 1429set_prolog_gc_thread(true) :- 1430 !, 1431 set_prolog_flag(gc_thread, true). 1432set_prolog_gc_thread(stop) :- 1433 !, 1434 ( '$gc_stop' 1435 -> thread_join(gc) 1436 ; true 1437 ). 1438:- else. 1439set_prolog_gc_thread(false) :- !. 1440set_prolog_gc_thread(true) :- !. 1441set_prolog_gc_thread(stop) :- !. 1442:- endif. 1443set_prolog_gc_thread(Status) :- 1444 '$domain_error'(gc_thread, Status)