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 ]). 86 87 /******************************** 88 * DEBUGGER * 89 *********************************/
93:- meta_predicate 94 map_bits(, , , ). 95 96map_bits(_, Var, _, _) :- 97 var(Var), 98 !, 99 '$instantiation_error'(Var). 100map_bits(_, [], Bits, Bits) :- !. 101map_bits(Pred, [H|T], Old, New) :- 102 map_bits(Pred, H, Old, New0), 103 map_bits(Pred, T, New0, New). 104map_bits(Pred, +Name, Old, New) :- % set a bit 105 !, 106 bit(Pred, Name, Bits), 107 !, 108 New is Old \/ Bits. 109map_bits(Pred, -Name, Old, New) :- % clear a bit 110 !, 111 bit(Pred, Name, Bits), 112 !, 113 New is Old /\ (\Bits). 114map_bits(Pred, ?(Name), Old, Old) :- % ask a bit 115 !, 116 bit(Pred, Name, Bits), 117 Old /\ Bits > 0. 118map_bits(_, Term, _, _) :- 119 '$type_error'('+|-|?(Flag)', Term). 120 121bit(Pred, Name, Bits) :- 122 call(Pred, Name, Bits), 123 !. 124bit(_:Pred, Name, _) :- 125 '$domain_error'(Pred, Name). 126 127:- public port_name/2. % used by library(test_cover) 128 129port_name( call, 2'000000001). 130port_name( exit, 2'000000010). 131port_name( fail, 2'000000100). 132port_name( redo, 2'000001000). 133port_name( unify, 2'000010000). 134port_name( break, 2'000100000). 135port_name( cut_call, 2'001000000). 136port_name( cut_exit, 2'010000000). 137port_name( exception, 2'100000000). 138port_name( cut, 2'011000000). 139port_name( all, 2'000111111). 140port_name( full, 2'000101111). 141port_name( half, 2'000101101). % ' 142 143leash(Ports) :- 144 '$leash'(Old, Old), 145 map_bits(port_name, Ports, Old, New), 146 '$leash'(_, New). 147 148visible(Ports) :- 149 '$visible'(Old, Old), 150 map_bits(port_name, Ports, Old, New), 151 '$visible'(_, New). 152 153style_name(atom, 0x0001) :- 154 print_message(warning, decl_no_effect(style_check(atom))). 155style_name(singleton, 0x0042). % semantic and syntactic 156style_name(discontiguous, 0x0008). 157style_name(charset, 0x0020). 158style_name(no_effect, 0x0080). 159style_name(var_branches, 0x0100).
163style_check(Var) :- 164 var(Var), 165 !, 166 '$instantiation_error'(Var). 167style_check(?(Style)) :- 168 !, 169 ( var(Style) 170 -> enum_style_check(Style) 171 ; enum_style_check(Style) 172 -> true 173 ). 174style_check(Spec) :- 175 '$style_check'(Old, Old), 176 map_bits(style_name, Spec, Old, New), 177 '$style_check'(_, New). 178 179enum_style_check(Style) :- 180 '$style_check'(Bits, Bits), 181 style_name(Style, Bit), 182 Bit /\ Bits =\= 0.
TBD: What hooks to provide for trace/[1,2]
193:- multifile 194 prolog:debug_control_hook/1. % +Action
202:- meta_predicate 203 trace(), 204 trace(, ). 205 206trace(Preds) :- 207 trace(Preds, +all). 208 209trace(_:X, _) :- 210 var(X), 211 !, 212 throw(error(instantiation_error, _)). 213trace(_:[], _) :- !. 214trace(M:[H|T], Ps) :- 215 !, 216 trace(M:H, Ps), 217 trace(M:T, Ps). 218trace(Pred, Ports) :- 219 '$find_predicate'(Pred, Preds), 220 Preds \== [], 221 set_prolog_flag(debug, true), 222 ( '$member'(PI, Preds), 223 pi_to_head(PI, Head), 224 ( Head = _:_ 225 -> QHead0 = Head 226 ; QHead0 = user:Head 227 ), 228 '$define_predicate'(QHead0), 229 ( predicate_property(QHead0, imported_from(M)) 230 -> QHead0 = _:Plain, 231 QHead = M:Plain 232 ; QHead = QHead0 233 ), 234 '$trace'(Ports, QHead), 235 trace_ports(QHead, Tracing), 236 print_message(informational, trace(QHead, Tracing)), 237 fail 238 ; true 239 ). 240 241trace_alias(all, [trace_call, trace_redo, trace_exit, trace_fail]). 242trace_alias(call, [trace_call]). 243trace_alias(redo, [trace_redo]). 244trace_alias(exit, [trace_exit]). 245trace_alias(fail, [trace_fail]). 246 247'$trace'([], _) :- !. 248'$trace'([H|T], Head) :- 249 !, 250 '$trace'(H, Head), 251 '$trace'(T, Head). 252'$trace'(+H, Head) :- 253 trace_alias(H, A0), 254 !, 255 tag_list(A0, +, A1), 256 '$trace'(A1, Head). 257'$trace'(+H, Head) :- 258 !, 259 trace_alias(_, [H]), 260 '$set_predicate_attribute'(Head, H, true). 261'$trace'(-H, Head) :- 262 trace_alias(H, A0), 263 !, 264 tag_list(A0, -, A1), 265 '$trace'(A1, Head). 266'$trace'(-H, Head) :- 267 !, 268 trace_alias(_, [H]), 269 '$set_predicate_attribute'(Head, H, false). 270'$trace'(H, Head) :- 271 atom(H), 272 '$trace'(+H, Head). 273 274tag_list([], _, []). 275tag_list([H0|T0], F, [H1|T1]) :- 276 H1 =.. [F, H0], 277 tag_list(T0, F, T1). 278 279:- meta_predicate 280 spy(), 281 nospy().
informational, with one
of the following terms, where Spec is of the form M:Head.
spy(Spec)nospy(Spec)298spy(_:X) :- 299 var(X), 300 throw(error(instantiation_error, _)). 301spy(_:[]) :- !. 302spy(M:[H|T]) :- 303 !, 304 spy(M:H), 305 spy(M:T). 306spy(Spec) :- 307 notrace(prolog:debug_control_hook(spy(Spec))), 308 !. 309spy(Spec) :- 310 '$find_predicate'(Spec, Preds), 311 '$member'(PI, Preds), 312 pi_to_head(PI, Head), 313 '$define_predicate'(Head), 314 '$spy'(Head), 315 fail. 316spy(_). 317 318nospy(_:X) :- 319 var(X), 320 throw(error(instantiation_error, _)). 321nospy(_:[]) :- !. 322nospy(M:[H|T]) :- 323 !, 324 nospy(M:H), 325 nospy(M:T). 326nospy(Spec) :- 327 notrace(prolog:debug_control_hook(nospy(Spec))), 328 !. 329nospy(Spec) :- 330 '$find_predicate'(Spec, Preds), 331 '$member'(PI, Preds), 332 pi_to_head(PI, Head), 333 '$nospy'(Head), 334 fail. 335nospy(_). 336 337nospyall :- 338 notrace(prolog:debug_control_hook(nospyall)), 339 fail. 340nospyall :- 341 spy_point(Head), 342 '$nospy'(Head), 343 fail. 344nospyall. 345 346pi_to_head(M:PI, M:Head) :- 347 !, 348 pi_to_head(PI, Head). 349pi_to_head(Name/Arity, Head) :- 350 functor(Head, Name, Arity).
356debugging :- 357 notrace(prolog:debug_control_hook(debugging)), 358 !. 359debugging :- 360 current_prolog_flag(debug, true), 361 !, 362 print_message(informational, debugging(on)), 363 findall(H, spy_point(H), SpyPoints), 364 print_message(informational, spying(SpyPoints)), 365 findall(trace(H,P), trace_point(H,P), TracePoints), 366 print_message(informational, tracing(TracePoints)). 367debugging :- 368 print_message(informational, debugging(off)). 369 370spy_point(Module:Head) :- 371 current_predicate(_, Module:Head), 372 '$get_predicate_attribute'(Module:Head, spy, 1), 373 \+ predicate_property(Module:Head, imported_from(_)). 374 375trace_point(Module:Head, Ports) :- 376 current_predicate(_, Module:Head), 377 '$get_predicate_attribute'(Module:Head, trace_any, 1), 378 \+ predicate_property(Module:Head, imported_from(_)), 379 trace_ports(Module:Head, Ports). 380 381trace_ports(Head, Ports) :- 382 findall(Port, 383 (trace_alias(Port, [AttName]), 384 '$get_predicate_attribute'(Head, AttName, 1)), 385 Ports).
393flag(Name, Old, New) :- 394 Old == New, 395 !, 396 get_flag(Name, Old). 397flag(Name, Old, New) :- 398 with_mutex('$flag', update_flag(Name, Old, New)). 399 400update_flag(Name, Old, New) :- 401 get_flag(Name, Old), 402 ( atom(New) 403 -> set_flag(Name, New) 404 ; Value is New, 405 set_flag(Name, Value) 406 ). 407 408 409 /******************************* 410 * RATIONAL * 411 *******************************/
418rational(Rat, M, N) :- 419 rational(Rat), 420 ( Rat = rdiv(M, N) 421 -> true 422 ; integer(Rat) 423 -> M = Rat, 424 N = 1 425 ). 426 427 428 /******************************** 429 * ATOMS * 430 *********************************/ 431 432dwim_match(A1, A2) :- 433 dwim_match(A1, A2, _). 434 435atom_prefix(Atom, Prefix) :- 436 sub_atom(Atom, 0, _, _, Prefix). 437 438 439 /******************************** 440 * SOURCE * 441 *********************************/
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.
454source_file(File) :-
455 ( current_prolog_flag(access_level, user)
456 -> Level = user
457 ; true
458 ),
459 ( ground(File)
460 -> ( '$time_source_file'(File, Time, Level)
461 ; absolute_file_name(File, Abs),
462 '$time_source_file'(Abs, Time, Level)
463 ), !
464 ; '$time_source_file'(File, Time, Level)
465 ),
466 Time > 0.0.473:- meta_predicate source_file(, ). 474 475source_file(M:Head, File) :- 476 nonvar(M), nonvar(Head), 477 !, 478 ( predicate_property(M:Head, multifile) 479 -> multi_source_files(M:Head, Files), 480 '$member'(File, Files) 481 ; '$source_file'(M:Head, File) 482 ). 483source_file(M:Head, File) :- 484 ( nonvar(File) 485 -> true 486 ; source_file(File) 487 ), 488 '$source_file_predicates'(File, Predicates), 489 '$member'(M:Head, Predicates). 490 491:- thread_local found_src_file/1. 492 493multi_source_files(Head, Files) :- 494 call_cleanup( 495 findall(File, multi_source_file(Head, File), Files), 496 retractall(found_src_file(_))). 497 498multi_source_file(Head, File) :- 499 nth_clause(Head, _, Clause), 500 clause_property(Clause, source(File)), 501 \+ found_src_file(File), 502 asserta(found_src_file(File)).
509source_file_property(File, P) :- 510 nonvar(File), 511 !, 512 canonical_source_file(File, Path), 513 property_source_file(P, Path). 514source_file_property(File, P) :- 515 property_source_file(P, File). 516 517property_source_file(modified(Time), File) :- 518 '$time_source_file'(File, Time, user). 519property_source_file(module(M), File) :- 520 ( nonvar(M) 521 -> '$current_module'(M, File) 522 ; nonvar(File) 523 -> '$current_module'(ML, File), 524 ( atom(ML) 525 -> M = ML 526 ; '$member'(M, ML) 527 ) 528 ; '$current_module'(M, File) 529 ). 530property_source_file(load_context(Module, Location, Options), File) :- 531 '$time_source_file'(File, _, user), 532 clause(system:'$load_context_module'(File, Module, Options), true, Ref), 533 ( clause_property(Ref, file(FromFile)), 534 clause_property(Ref, line_count(FromLine)) 535 -> Location = FromFile:FromLine 536 ; Location = user 537 ). 538property_source_file(includes(Master, Stamp), File) :- 539 system:'$included'(File, _Line, Master, Stamp). 540property_source_file(included_in(Master, Line), File) :- 541 system:'$included'(Master, Line, File, _). 542property_source_file(derived_from(DerivedFrom, Stamp), File) :- 543 system:'$derived_source'(File, DerivedFrom, Stamp). 544property_source_file(reloading, File) :- 545 source_file(File), 546 '$source_file_property'(File, reloading, true). 547property_source_file(load_count(Count), File) :- 548 source_file(File), 549 '$source_file_property'(File, load_count, Count). 550property_source_file(number_of_clauses(Count), File) :- 551 source_file(File), 552 '$source_file_property'(File, number_of_clauses, Count).
559canonical_source_file(Spec, File) :- 560 atom(Spec), 561 '$time_source_file'(Spec, _, _), 562 !, 563 File = Spec. 564canonical_source_file(Spec, File) :- 565 system:'$included'(_Master, _Line, Spec, _), 566 !, 567 File = Spec. 568canonical_source_file(Spec, File) :- 569 absolute_file_name(Spec, 570 [ file_type(prolog), 571 access(read), 572 file_errors(fail) 573 ], 574 File), 575 source_file(File).
584prolog_load_context(module, Module) :- 585 '$current_source_module'(Module). 586prolog_load_context(file, F) :- 587 source_location(F, _). 588prolog_load_context(source, F) :- % SICStus compatibility 589 source_location(F0, _), 590 '$input_context'(Context), 591 '$top_file'(Context, F0, F). 592prolog_load_context(stream, S) :- 593 ( system:'$load_input'(_, S0) 594 -> S = S0 595 ). 596prolog_load_context(directory, D) :- 597 source_location(F, _), 598 file_directory_name(F, D). 599prolog_load_context(dialect, D) :- 600 current_prolog_flag(emulated_dialect, D). 601prolog_load_context(term_position, TermPos) :- 602 source_location(_, L), 603 ( nb_current('$term_position', Pos), 604 compound(Pos), % actually set 605 stream_position_data(line_count, Pos, L) 606 -> TermPos = Pos 607 ; TermPos = '$stream_position'(0,L,0,0) 608 ). 609prolog_load_context(script, Bool) :- 610 ( '$toplevel':loaded_init_file(script, Path), 611 source_location(Path, _) 612 -> Bool = true 613 ; Bool = false 614 ). 615prolog_load_context(variable_names, Bindings) :- 616 nb_current('$variable_names', Bindings). 617prolog_load_context(term, Term) :- 618 nb_current('$term', Term). 619prolog_load_context(reloading, true) :- 620 prolog_load_context(source, F), 621 '$source_file_property'(F, reloading, true).
627unload_file(File) :- 628 ( canonical_source_file(File, Path) 629 -> '$unload_file'(Path) 630 ; true 631 ). 632 633 634 /******************************* 635 * STREAMS * 636 *******************************/
643stream_position_data(Prop, Term, Value) :- 644 nonvar(Prop), 645 !, 646 ( stream_position_field(Prop, Pos) 647 -> arg(Pos, Term, Value) 648 ; throw(error(domain_error(stream_position_data, Prop))) 649 ). 650stream_position_data(Prop, Term, Value) :- 651 stream_position_field(Prop, Pos), 652 arg(Pos, Term, Value). 653 654stream_position_field(char_count, 1). 655stream_position_field(line_count, 2). 656stream_position_field(line_position, 3). 657stream_position_field(byte_count, 4). 658 659 660 /******************************* 661 * CONTROL * 662 *******************************/
670:- meta_predicate 671 call_with_depth_limit(, , ). 672 673call_with_depth_limit(G, Limit, Result) :- 674 '$depth_limit'(Limit, OLimit, OReached), 675 ( catch(, E, '$depth_limit_except'(OLimit, OReached, E)), 676 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det), 677 ( Det == ! -> ! ; true ) 678 ; '$depth_limit_false'(OLimit, OReached, Result) 679 ).
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.
693:- meta_predicate 694 call_with_inference_limit(, , ). 695 696call_with_inference_limit(G, Limit, Result) :- 697 '$inference_limit'(Limit, OLimit), 698 ( catch(, Except, 699 system:'$inference_limit_except'(OLimit, Except, Result0)), 700 system:'$inference_limit_true'(Limit, OLimit, Result0), 701 ( Result0 == ! -> ! ; true ), 702 Result = Result0 703 ; system:'$inference_limit_false'(OLimit) 704 ). 705 706 707 /******************************** 708 * DATA BASE * 709 *********************************/ 710 711/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 712The predicate current_predicate/2 is a difficult subject since the 713introduction of defaulting modules and dynamic libraries. 714current_predicate/2 is normally called with instantiated arguments to 715verify some predicate can be called without trapping an undefined 716predicate. In this case we must perform the search algorithm used by 717the prolog system itself. 718 719If the pattern is not fully specified, we only generate the predicates 720actually available in this module. This seems the best for listing, 721etc. 722- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 723 724 725:- meta_predicate 726 current_predicate(, ), 727 '$defined_predicate'(). 728 729current_predicate(Name, Module:Head) :- 730 (var(Module) ; var(Head)), 731 !, 732 generate_current_predicate(Name, Module, Head). 733current_predicate(Name, Term) :- 734 '$c_current_predicate'(Name, Term), 735 '$defined_predicate'(Term), 736 !. 737current_predicate(Name, Module:Head) :- 738 default_module(Module, DefModule), 739 '$c_current_predicate'(Name, DefModule:Head), 740 '$defined_predicate'(DefModule:Head), 741 !. 742current_predicate(Name, Module:Head) :- 743 current_prolog_flag(autoload, true), 744 \+ current_prolog_flag(Moduleunknown, fail), 745 ( compound(Head) 746 -> compound_name_arity(Head, Name, Arity) 747 ; Name = Head, Arity = 0 748 ), 749 '$find_library'(Module, Name, Arity, _LoadModule, _Library), 750 !. 751 752generate_current_predicate(Name, Module, Head) :- 753 current_module(Module), 754 QHead = Module:Head, 755 '$c_current_predicate'(Name, QHead), 756 '$get_predicate_attribute'(QHead, defined, 1). 757 758'$defined_predicate'(Head) :- 759 '$get_predicate_attribute'(Head, defined, 1), 760 !.
766:- meta_predicate 767 predicate_property(, ). 768 769:- '$iso'(predicate_property/2). 770 771predicate_property(Pred, Property) :- % Mode ?,+ 772 nonvar(Property), 773 !, 774 property_predicate(Property, Pred). 775predicate_property(Pred, Property) :- % Mode +,- 776 define_or_generate(Pred), 777 '$predicate_property'(Property, Pred).
undefined, visible and
autoload, followed by the generic case.785property_predicate(undefined, Pred) :- 786 !, 787 Pred = Module:Head, 788 current_module(Module), 789 '$c_current_predicate'(_, Pred), 790 \+ '$defined_predicate'(Pred), % Speed up a bit 791 \+ current_predicate(_, Pred), 792 goal_name_arity(Head, Name, Arity), 793 \+ system_undefined(Module:Name/Arity). 794property_predicate(visible, Pred) :- 795 !, 796 visible_predicate(Pred). 797property_predicate(autoload(File), _:Head) :- 798 !, 799 current_prolog_flag(autoload, true), 800 ( callable(Head) 801 -> goal_name_arity(Head, Name, Arity), 802 ( '$find_library'(_, Name, Arity, _, File) 803 -> true 804 ) 805 ; '$find_library'(_, Name, Arity, _, File), 806 functor(Head, Name, Arity) 807 ). 808property_predicate(implementation_module(IM), M:Head) :- 809 !, 810 atom(M), 811 ( default_module(M, DM), 812 '$get_predicate_attribute'(DM:Head, defined, 1) 813 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM) 814 -> IM = ImportM 815 ; IM = M 816 ) 817 ; \+ current_prolog_flag(Munknown, fail), 818 goal_name_arity(Head, Name, Arity), 819 '$find_library'(_, Name, Arity, LoadModule, _File) 820 -> IM = LoadModule 821 ; M = IM 822 ). 823property_predicate(Property, Pred) :- 824 define_or_generate(Pred), 825 '$predicate_property'(Property, Pred). 826 827goal_name_arity(Head, Name, Arity) :- 828 compound(Head), 829 !, 830 compound_name_arity(Head, Name, Arity). 831goal_name_arity(Head, Head, 0).
840define_or_generate(M:Head) :- 841 callable(Head), 842 atom(M), 843 '$get_predicate_attribute'(M:Head, defined, 1), 844 !. 845define_or_generate(M:Head) :- 846 callable(Head), 847 nonvar(M), M \== system, 848 !, 849 '$define_predicate'(M:Head). 850define_or_generate(Pred) :- 851 current_predicate(_, Pred), 852 '$define_predicate'(Pred). 853 854 855'$predicate_property'(interpreted, Pred) :- 856 '$get_predicate_attribute'(Pred, foreign, 0). 857'$predicate_property'(visible, Pred) :- 858 '$get_predicate_attribute'(Pred, defined, 1). 859'$predicate_property'(built_in, Pred) :- 860 '$get_predicate_attribute'(Pred, system, 1). 861'$predicate_property'(exported, Pred) :- 862 '$get_predicate_attribute'(Pred, exported, 1). 863'$predicate_property'(public, Pred) :- 864 '$get_predicate_attribute'(Pred, public, 1). 865'$predicate_property'(foreign, Pred) :- 866 '$get_predicate_attribute'(Pred, foreign, 1). 867'$predicate_property'((dynamic), Pred) :- 868 '$get_predicate_attribute'(Pred, (dynamic), 1). 869'$predicate_property'((static), Pred) :- 870 '$get_predicate_attribute'(Pred, (dynamic), 0). 871'$predicate_property'((volatile), Pred) :- 872 '$get_predicate_attribute'(Pred, (volatile), 1). 873'$predicate_property'((thread_local), Pred) :- 874 '$get_predicate_attribute'(Pred, (thread_local), 1). 875'$predicate_property'((multifile), Pred) :- 876 '$get_predicate_attribute'(Pred, (multifile), 1). 877'$predicate_property'(imported_from(Module), Pred) :- 878 '$get_predicate_attribute'(Pred, imported, Module). 879'$predicate_property'(transparent, Pred) :- 880 '$get_predicate_attribute'(Pred, transparent, 1). 881'$predicate_property'(meta_predicate(Pattern), Pred) :- 882 '$get_predicate_attribute'(Pred, meta_predicate, Pattern). 883'$predicate_property'(file(File), Pred) :- 884 '$get_predicate_attribute'(Pred, file, File). 885'$predicate_property'(line_count(LineNumber), Pred) :- 886 '$get_predicate_attribute'(Pred, line_count, LineNumber). 887'$predicate_property'(notrace, Pred) :- 888 '$get_predicate_attribute'(Pred, trace, 0). 889'$predicate_property'(nodebug, Pred) :- 890 '$get_predicate_attribute'(Pred, hide_childs, 1). 891'$predicate_property'(spying, Pred) :- 892 '$get_predicate_attribute'(Pred, spy, 1). 893'$predicate_property'(number_of_clauses(N), Pred) :- 894 '$get_predicate_attribute'(Pred, number_of_clauses, N). 895'$predicate_property'(number_of_rules(N), Pred) :- 896 '$get_predicate_attribute'(Pred, number_of_rules, N). 897'$predicate_property'(last_modified_generation(Gen), Pred) :- 898 '$get_predicate_attribute'(Pred, last_modified_generation, Gen). 899'$predicate_property'(indexed(Indices), Pred) :- 900 '$get_predicate_attribute'(Pred, indexed, Indices). 901'$predicate_property'(noprofile, Pred) :- 902 '$get_predicate_attribute'(Pred, noprofile, 1). 903'$predicate_property'(iso, Pred) :- 904 '$get_predicate_attribute'(Pred, iso, 1). 905'$predicate_property'(quasi_quotation_syntax, Pred) :- 906 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1). 907'$predicate_property'(defined, Pred) :- 908 '$get_predicate_attribute'(Pred, defined, 1). 909 910system_undefined(user:prolog_trace_interception/4). 911system_undefined(user:prolog_exception_hook/4). 912system_undefined(system:'$c_call_prolog'/0). 913system_undefined(system:window_title/2).
921visible_predicate(Pred) :- 922 Pred = M:Head, 923 current_module(M), 924 ( callable(Head) 925 -> ( '$get_predicate_attribute'(Pred, defined, 1) 926 -> true 927 ; \+ current_prolog_flag(Munknown, fail), 928 functor(Head, Name, Arity), 929 '$find_library'(M, Name, Arity, _LoadModule, _Library) 930 ) 931 ; setof(PI, visible_in_module(M, PI), PIs), 932 '$member'(Name/Arity, PIs), 933 functor(Head, Name, Arity) 934 ). 935 936visible_in_module(M, Name/Arity) :- 937 default_module(M, DefM), 938 DefHead = DefM:Head, 939 '$c_current_predicate'(_, DefHead), 940 '$get_predicate_attribute'(DefHead, defined, 1), 941 \+ hidden_system_predicate(Head), 942 functor(Head, Name, Arity). 943visible_in_module(_, Name/Arity) :- 944 '$in_library'(Name, Arity, _). 945 (Head) :- 947 functor(Head, Name, _), 948 atom(Name), % Avoid []. 949 sub_atom(Name, 0, _, _, $), 950 \+ current_prolog_flag(access_level, system).
true.975clause_property(Clause, Property) :- 976 '$clause_property'(Property, Clause). 977 978'$clause_property'(line_count(LineNumber), Clause) :- 979 '$get_clause_attribute'(Clause, line_count, LineNumber). 980'$clause_property'(file(File), Clause) :- 981 '$get_clause_attribute'(Clause, file, File). 982'$clause_property'(source(File), Clause) :- 983 '$get_clause_attribute'(Clause, owner, File). 984'$clause_property'(size(Bytes), Clause) :- 985 '$get_clause_attribute'(Clause, size, Bytes). 986'$clause_property'(fact, Clause) :- 987 '$get_clause_attribute'(Clause, fact, true). 988'$clause_property'(erased, Clause) :- 989 '$get_clause_attribute'(Clause, erased, true). 990'$clause_property'(predicate(PI), Clause) :- 991 '$get_clause_attribute'(Clause, predicate_indicator, PI). 992'$clause_property'(module(M), Clause) :- 993 '$get_clause_attribute'(Clause, module, M). 994 995 996 /******************************* 997 * REQUIRE * 998 *******************************/ 999 1000:- meta_predicate 1001 require().
1010require(M:List) :- 1011 ( is_list(List) 1012 -> require(List, M) 1013 ; throw(error(type_error(list, List), _)) 1014 ). 1015 1016require([], _). 1017require([N/A|T], M) :- 1018 !, 1019 functor(Head, N, A), 1020 '$require'(M:Head), 1021 require(T, M). 1022require([H|_T], _) :- 1023 throw(error(type_error(predicate_indicator, H), _)). 1024 1025 1026 /******************************** 1027 * MODULES * 1028 *********************************/
1034current_module(Module) :-
1035 '$current_module'(Module, _).1051module_property(Module, Property) :- 1052 nonvar(Module), nonvar(Property), 1053 !, 1054 property_module(Property, Module). 1055module_property(Module, Property) :- % -, file(File) 1056 nonvar(Property), Property = file(File), 1057 !, 1058 ( nonvar(File) 1059 -> '$current_module'(Modules, File), 1060 ( atom(Modules) 1061 -> Module = Modules 1062 ; '$member'(Module, Modules) 1063 ) 1064 ; '$current_module'(Module, File), 1065 File \== [] 1066 ). 1067module_property(Module, Property) :- 1068 current_module(Module), 1069 property_module(Property, Module). 1070 1071property_module(Property, Module) :- 1072 module_property(Property), 1073 ( Property = exported_operators(List) 1074 -> '$exported_ops'(Module, List, []), 1075 List \== [] 1076 ; '$module_property'(Module, Property) 1077 ). 1078 1079module_property(class(_)). 1080module_property(file(_)). 1081module_property(line_count(_)). 1082module_property(exports(_)). 1083module_property(exported_operators(_)). 1084module_property(program_size(_)). 1085module_property(program_space(_)). 1086module_property(last_modified_generation(_)).
1092module(Module) :- 1093 atom(Module), 1094 current_module(Module), 1095 !, 1096 '$set_typein_module'(Module). 1097module(Module) :- 1098 '$set_typein_module'(Module), 1099 print_message(warning, no_current_module(Module)).
1106working_directory(Old, New) :- 1107 '$cwd'(Old), 1108 ( Old == New 1109 -> true 1110 ; '$chdir'(New) 1111 ). 1112 1113 1114 /******************************* 1115 * TRIES * 1116 *******************************/
1122current_trie(Trie) :-
1123 current_blob(Trie, trie),
1124 is_trie(Trie).1140trie_property(Trie, Property) :- 1141 current_trie(Trie), 1142 trie_property(Property), 1143 '$trie_property'(Trie, Property). 1144 1145trie_property(node_count(_)). 1146trie_property(value_count(_)). 1147trie_property(size(_)). 1148trie_property(hashed(_)). 1149 1150 1151 1152 /******************************** 1153 * SYSTEM INTERACTION * 1154 *********************************/ 1155 1156shell(Command) :- 1157 shell(Command, 0).
1164:- if(current_prolog_flag(windows, true)). 1165:- export(win_add_dll_directory/1). 1166win_add_dll_directory(Dir) :- 1167 win_add_dll_directory(Dir, _), 1168 !. 1169win_add_dll_directory(Dir) :- 1170 prolog_to_os_filename(Dir, OSDir), 1171 getenv('PATH', Path0), 1172 atomic_list_concat([Path0, OSDir], ';', Path), 1173 setenv('PATH', Path). 1174:- endif. 1175 1176 /******************************* 1177 * SIGNALS * 1178 *******************************/ 1179 1180:- meta_predicate 1181 on_signal(, , ), 1182 current_signal(, , ).
1186on_signal(Signal, Old, New) :- 1187 atom(Signal), 1188 !, 1189 '$on_signal'(_Num, Signal, Old, New). 1190on_signal(Signal, Old, New) :- 1191 integer(Signal), 1192 !, 1193 '$on_signal'(Signal, _Name, Old, New). 1194on_signal(Signal, _Old, _New) :- 1195 '$type_error'(signal_name, Signal).
1199current_signal(Name, Id, Handler) :- 1200 between(1, 32, Id), 1201 '$on_signal'(Id, Name, Handler, Handler). 1202 1203:- multifile 1204 prolog:called_by/2. 1205 1206prologcalled_by(on_signal(_,_,New), [New+1]) :- 1207 ( new == throw 1208 ; new == default 1209 ), !, fail. 1210 1211 1212 /******************************* 1213 * DLOPEN * 1214 *******************************/
now
Resolve all symbols in the file now instead of lazily.global
Make new symbols globally known.1228open_shared_object(File, Handle) :- 1229 open_shared_object(File, Handle, []). % use pl-load.c defaults 1230 1231open_shared_object(File, Handle, Flags) :- 1232 ( is_list(Flags) 1233 -> true 1234 ; throw(error(type_error(list, Flags), _)) 1235 ), 1236 map_dlflags(Flags, Mask), 1237 '$open_shared_object'(File, Handle, Mask). 1238 1239dlopen_flag(now, 2'01). % see pl-load.c for these constants 1240dlopen_flag(global, 2'10). % Solaris only 1241 1242map_dlflags([], 0). 1243map_dlflags([F|T], M) :- 1244 map_dlflags(T, M0), 1245 ( dlopen_flag(F, I) 1246 -> true 1247 ; throw(error(domain_error(dlopen_flag, F), _)) 1248 ), 1249 M is M0 \/ I. 1250 1251 1252 /******************************* 1253 * I/O * 1254 *******************************/ 1255 1256format(Fmt) :- 1257 format(Fmt, []). 1258 1259 /******************************* 1260 * FILES * 1261 *******************************/ 1262 1263% absolute_file_name(+Term, -AbsoluteFile) 1264 1265absolute_file_name(Name, Abs) :- 1266 atomic(Name), 1267 !, 1268 '$absolute_file_name'(Name, Abs). 1269absolute_file_name(Term, Abs) :- 1270 '$chk_file'(Term, [''], [access(read)], true, File), 1271 !, 1272 '$absolute_file_name'(File, Abs). 1273absolute_file_name(Term, Abs) :- 1274 '$chk_file'(Term, [''], [], true, File), 1275 !, 1276 '$absolute_file_name'(File, Abs). 1277 1278 1279 /******************************** 1280 * MEMORY MANAGEMENT * 1281 *********************************/
1290garbage_collect :-
1291 '$garbage_collect'(0).
1297set_prolog_stack(Stack, Option) :-
1298 Option =.. [Name,Value0],
1299 Value is Value0,
1300 '$set_prolog_stack'(Stack, Name, _Old, Value).1306prolog_stack_property(Stack, Property) :- 1307 stack_property(P), 1308 stack_name(Stack), 1309 Property =.. [P,Value], 1310 '$set_prolog_stack'(Stack, P, Value, Value). 1311 1312stack_name(local). 1313stack_name(global). 1314stack_name(trail). 1315 1316stack_property(limit). 1317stack_property(spare). 1318stack_property(min_free). 1319 1320 1321 /******************************* 1322 * TERM * 1323 *******************************/ 1324 1325:- '$iso'((numbervars/3)).
1333numbervars(Term, From, To) :- 1334 numbervars(Term, From, To, []). 1335 1336 1337 /******************************* 1338 * STRING * 1339 *******************************/
1345term_string(Term, String, Options) :- 1346 nonvar(String), 1347 !, 1348 read_term_from_atom(String, Term, Options). 1349term_string(Term, String, Options) :- 1350 ( '$option'(quoted(_), Options) 1351 -> Options1 = Options 1352 ; '$merge_options'(_{quoted:true}, Options, Options1) 1353 ), 1354 format(string(String), '~W', [Term, Options1]). 1355 1356 1357 /******************************* 1358 * GVAR * 1359 *******************************/
1365nb_setval(Name, Value) :- 1366 duplicate_term(Value, Copy), 1367 nb_linkval(Name, Copy). 1368 1369 1370 /******************************* 1371 * THREADS * 1372 *******************************/ 1373 1374:- meta_predicate 1375 thread_create(, ).
thread_create(Goal, Id, []).
1381thread_create(Goal, Id) :-
1382 thread_create(, Id, []).
1391thread_join(Id) :-
1392 thread_join(Id, Status),
1393 ( Status == true
1394 -> true
1395 ; throw(error(thread_error(Status), _))
1396 )