37
38:- module('$syspreds',
39 [ leash/1,
40 visible/1,
41 style_check/1,
42 (spy)/1,
43 (nospy)/1,
44 nospyall/0,
45 debugging/0,
46 flag/3,
47 atom_prefix/2,
48 dwim_match/2,
49 source_file_property/2,
50 source_file/1,
51 source_file/2,
52 unload_file/1,
53 exists_source/1, 54 exists_source/2, 55 use_foreign_library/1, 56 use_foreign_library/2, 57 prolog_load_context/2,
58 stream_position_data/3,
59 current_predicate/2,
60 '$defined_predicate'/1,
61 predicate_property/2,
62 '$predicate_property'/2,
63 (dynamic)/2, 64 clause_property/2,
65 current_module/1, 66 module_property/2, 67 module/1, 68 current_trie/1, 69 trie_property/2, 70 working_directory/2, 71 shell/1, 72 on_signal/3,
73 current_signal/3,
74 open_shared_object/2,
75 open_shared_object/3,
76 format/1,
77 garbage_collect/0,
78 set_prolog_stack/2,
79 prolog_stack_property/2,
80 absolute_file_name/2,
81 tmp_file_stream/3, 82 call_with_depth_limit/3, 83 call_with_inference_limit/3, 84 rule/2, 85 rule/3, 86 numbervars/3, 87 term_string/3, 88 nb_setval/2, 89 thread_create/2, 90 thread_join/1, 91 transaction/1, 92 transaction/2, 93 transaction/3, 94 snapshot/1, 95 set_prolog_gc_thread/1, 96
97 '$wrap_predicate'/5 98 ]). 99
100:- meta_predicate
101 dynamic(:, +),
102 use_foreign_library(:),
103 use_foreign_library(:, +),
104 transaction(0),
105 transaction(0,0,+),
106 snapshot(0),
107 rule(:, -),
108 rule(:, -, ?). 109
110
111 114
116
117:- meta_predicate
118 map_bits(2, +, +, -). 119
120map_bits(_, Var, _, _) :-
121 var(Var),
122 !,
123 '$instantiation_error'(Var).
124map_bits(_, [], Bits, Bits) :- !.
125map_bits(Pred, [H|T], Old, New) :-
126 map_bits(Pred, H, Old, New0),
127 map_bits(Pred, T, New0, New).
128map_bits(Pred, +Name, Old, New) :- 129 !,
130 bit(Pred, Name, Bits),
131 !,
132 New is Old \/ Bits.
133map_bits(Pred, -Name, Old, New) :- 134 !,
135 bit(Pred, Name, Bits),
136 !,
137 New is Old /\ (\Bits).
138map_bits(Pred, ?(Name), Old, Old) :- 139 !,
140 bit(Pred, Name, Bits),
141 Old /\ Bits > 0.
142map_bits(_, Term, _, _) :-
143 '$type_error'('+|-|?(Flag)', Term).
144
145bit(Pred, Name, Bits) :-
146 call(Pred, Name, Bits),
147 !.
148bit(_:Pred, Name, _) :-
149 '$domain_error'(Pred, Name).
150
151:- public port_name/2. 152
153port_name( call, 2'000000001).
154port_name( exit, 2'000000010).
155port_name( fail, 2'000000100).
156port_name( redo, 2'000001000).
157port_name( unify, 2'000010000).
158port_name( break, 2'000100000).
159port_name( cut_call, 2'001000000).
160port_name( cut_exit, 2'010000000).
161port_name( exception, 2'100000000).
162port_name( cut, 2'011000000).
163port_name( all, 2'000111111).
164port_name( full, 2'000101111).
165port_name( half, 2'000101101). 166
167leash(Ports) :-
168 '$leash'(Old, Old),
169 map_bits(port_name, Ports, Old, New),
170 '$leash'(_, New).
171
172visible(Ports) :-
173 '$visible'(Old, Old),
174 map_bits(port_name, Ports, Old, New),
175 '$visible'(_, New).
176
177style_name(atom, 0x0001) :-
178 print_message(warning, decl_no_effect(style_check(atom))).
179style_name(singleton, 0x0042). 180style_name(discontiguous, 0x0008).
181style_name(charset, 0x0020).
182style_name(no_effect, 0x0080).
183style_name(var_branches, 0x0100).
184
186
187style_check(Var) :-
188 var(Var),
189 !,
190 '$instantiation_error'(Var).
191style_check(?(Style)) :-
192 !,
193 ( var(Style)
194 -> enum_style_check(Style)
195 ; enum_style_check(Style)
196 -> true
197 ).
198style_check(Spec) :-
199 '$style_check'(Old, Old),
200 map_bits(style_name, Spec, Old, New),
201 '$style_check'(_, New).
202
203enum_style_check(Style) :-
204 '$style_check'(Bits, Bits),
205 style_name(Style, Bit),
206 Bit /\ Bits =\= 0.
207
208
214
215:- multifile
216 prolog:debug_control_hook/1. 217
218:- meta_predicate
219 spy(:),
220 nospy(:). 221
236
237spy(_:X) :-
238 var(X),
239 throw(error(instantiation_error, _)).
240spy(_:[]) :- !.
241spy(M:[H|T]) :-
242 !,
243 spy(M:H),
244 spy(M:T).
245spy(Spec) :-
246 notrace(prolog:debug_control_hook(spy(Spec))),
247 !.
248spy(Spec) :-
249 '$find_predicate'(Spec, Preds),
250 '$member'(PI, Preds),
251 pi_to_head(PI, Head),
252 '$define_predicate'(Head),
253 '$spy'(Head),
254 fail.
255spy(_).
256
257nospy(_:X) :-
258 var(X),
259 throw(error(instantiation_error, _)).
260nospy(_:[]) :- !.
261nospy(M:[H|T]) :-
262 !,
263 nospy(M:H),
264 nospy(M:T).
265nospy(Spec) :-
266 notrace(prolog:debug_control_hook(nospy(Spec))),
267 !.
268nospy(Spec) :-
269 '$find_predicate'(Spec, Preds),
270 '$member'(PI, Preds),
271 pi_to_head(PI, Head),
272 '$nospy'(Head),
273 fail.
274nospy(_).
275
276nospyall :-
277 notrace(prolog:debug_control_hook(nospyall)),
278 fail.
279nospyall :-
280 spy_point(Head),
281 '$nospy'(Head),
282 fail.
283nospyall.
284
285pi_to_head(M:PI, M:Head) :-
286 !,
287 pi_to_head(PI, Head).
288pi_to_head(Name/Arity, Head) :-
289 functor(Head, Name, Arity).
290
294
295debugging :-
296 notrace(prolog:debug_control_hook(debugging)),
297 !.
298debugging :-
299 current_prolog_flag(debug, true),
300 !,
301 print_message(informational, debugging(on)),
302 findall(H, spy_point(H), SpyPoints),
303 print_message(informational, spying(SpyPoints)).
304debugging :-
305 print_message(informational, debugging(off)).
306
307spy_point(Module:Head) :-
308 current_predicate(_, Module:Head),
309 '$get_predicate_attribute'(Module:Head, spy, 1),
310 \+ predicate_property(Module:Head, imported_from(_)).
311
316
317flag(Name, Old, New) :-
318 Old == New,
319 !,
320 get_flag(Name, Old).
321flag(Name, Old, New) :-
322 with_mutex('$flag', update_flag(Name, Old, New)).
323
324update_flag(Name, Old, New) :-
325 get_flag(Name, Old),
326 ( atom(New)
327 -> set_flag(Name, New)
328 ; Value is New,
329 set_flag(Name, Value)
330 ).
331
332
333 336
337dwim_match(A1, A2) :-
338 dwim_match(A1, A2, _).
339
340atom_prefix(Atom, Prefix) :-
341 sub_atom(Atom, 0, _, _, Prefix).
342
343
344 347
358
359source_file(File) :-
360 ( current_prolog_flag(access_level, user)
361 -> Level = user
362 ; true
363 ),
364 ( ground(File)
365 -> ( '$time_source_file'(File, Time, Level)
366 ; absolute_file_name(File, Abs),
367 '$time_source_file'(Abs, Time, Level)
368 ), !
369 ; '$time_source_file'(File, Time, Level)
370 ),
371 Time > 0.0.
372
377
378:- meta_predicate source_file(:, ?). 379
380source_file(M:Head, File) :-
381 nonvar(M), nonvar(Head),
382 !,
383 ( '$c_current_predicate'(_, M:Head),
384 predicate_property(M:Head, multifile)
385 -> multi_source_files(M:Head, Files),
386 '$member'(File, Files)
387 ; '$source_file'(M:Head, File)
388 ).
389source_file(M:Head, File) :-
390 ( nonvar(File)
391 -> true
392 ; source_file(File)
393 ),
394 '$source_file_predicates'(File, Predicates),
395 '$member'(M:Head, Predicates).
396
397:- thread_local found_src_file/1. 398
399multi_source_files(Head, Files) :-
400 call_cleanup(
401 findall(File, multi_source_file(Head, File), Files),
402 retractall(found_src_file(_))).
403
404multi_source_file(Head, File) :-
405 nth_clause(Head, _, Clause),
406 clause_property(Clause, source(File)),
407 \+ found_src_file(File),
408 asserta(found_src_file(File)).
409
410
414
415source_file_property(File, P) :-
416 nonvar(File),
417 !,
418 canonical_source_file(File, Path),
419 property_source_file(P, Path).
420source_file_property(File, P) :-
421 property_source_file(P, File).
422
423property_source_file(modified(Time), File) :-
424 '$time_source_file'(File, Time, user).
425property_source_file(source(Source), File) :-
426 ( '$source_file_property'(File, from_state, true)
427 -> Source = state
428 ; '$source_file_property'(File, resource, true)
429 -> Source = resource
430 ; Source = file
431 ).
432property_source_file(module(M), File) :-
433 ( nonvar(M)
434 -> '$current_module'(M, File)
435 ; nonvar(File)
436 -> '$current_module'(ML, File),
437 ( atom(ML)
438 -> M = ML
439 ; '$member'(M, ML)
440 )
441 ; '$current_module'(M, File)
442 ).
443property_source_file(load_context(Module, Location, Options), File) :-
444 '$time_source_file'(File, _, user),
445 clause(system:'$load_context_module'(File, Module, Options), true, Ref),
446 ( clause_property(Ref, file(FromFile)),
447 clause_property(Ref, line_count(FromLine))
448 -> Location = FromFile:FromLine
449 ; Location = user
450 ).
451property_source_file(includes(Master, Stamp), File) :-
452 system:'$included'(File, _Line, Master, Stamp).
453property_source_file(included_in(Master, Line), File) :-
454 system:'$included'(Master, Line, File, _).
455property_source_file(derived_from(DerivedFrom, Stamp), File) :-
456 system:'$derived_source'(File, DerivedFrom, Stamp).
457property_source_file(reloading, File) :-
458 source_file(File),
459 '$source_file_property'(File, reloading, true).
460property_source_file(load_count(Count), File) :-
461 source_file(File),
462 '$source_file_property'(File, load_count, Count).
463property_source_file(number_of_clauses(Count), File) :-
464 source_file(File),
465 '$source_file_property'(File, number_of_clauses, Count).
466
467
471
472canonical_source_file(Spec, File) :-
473 atom(Spec),
474 '$time_source_file'(Spec, _, _),
475 !,
476 File = Spec.
477canonical_source_file(Spec, File) :-
478 system:'$included'(_Master, _Line, Spec, _),
479 !,
480 File = Spec.
481canonical_source_file(Spec, File) :-
482 absolute_file_name(Spec,
483 [ file_type(prolog),
484 access(read),
485 file_errors(fail)
486 ],
487 File),
488 source_file(File).
489
490
504
505exists_source(Source) :-
506 exists_source(Source, _Path).
507
508exists_source(Source, Path) :-
509 absolute_file_name(Source, Path,
510 [ file_type(prolog),
511 access(read),
512 file_errors(fail)
513 ]).
514
515
521
522prolog_load_context(module, Module) :-
523 '$current_source_module'(Module).
524prolog_load_context(file, File) :-
525 input_file(File).
526prolog_load_context(source, F) :- 527 input_file(F0),
528 '$input_context'(Context),
529 '$top_file'(Context, F0, F).
530prolog_load_context(stream, S) :-
531 ( system:'$load_input'(_, S0)
532 -> S = S0
533 ).
534prolog_load_context(directory, D) :-
535 input_file(F),
536 file_directory_name(F, D).
537prolog_load_context(dialect, D) :-
538 current_prolog_flag(emulated_dialect, D).
539prolog_load_context(term_position, TermPos) :-
540 source_location(_, L),
541 ( nb_current('$term_position', Pos),
542 compound(Pos), 543 stream_position_data(line_count, Pos, L)
544 -> TermPos = Pos
545 ; TermPos = '$stream_position'(0,L,0,0)
546 ).
547prolog_load_context(script, Bool) :-
548 ( '$toplevel':loaded_init_file(script, Path),
549 input_file(File),
550 same_file(File, Path)
551 -> Bool = true
552 ; Bool = false
553 ).
554prolog_load_context(variable_names, Bindings) :-
555 nb_current('$variable_names', Bindings).
556prolog_load_context(term, Term) :-
557 nb_current('$term', Term).
558prolog_load_context(reloading, true) :-
559 prolog_load_context(source, F),
560 '$source_file_property'(F, reloading, true).
561
562input_file(File) :-
563 ( system:'$load_input'(_, Stream)
564 -> stream_property(Stream, file_name(File))
565 ),
566 !.
567input_file(File) :-
568 source_location(File, _).
569
570
574
575:- dynamic system:'$resolved_source_path'/2. 576
577unload_file(File) :-
578 ( canonical_source_file(File, Path)
579 -> '$unload_file'(Path),
580 retractall(system:'$resolved_source_path'(_, Path))
581 ; true
582 ).
583
584 587
604
605use_foreign_library(FileSpec) :-
606 ensure_shlib,
607 initialization(shlib:load_foreign_library(FileSpec), now).
608
609use_foreign_library(FileSpec, Entry) :-
610 ensure_shlib,
611 initialization(shlib:load_foreign_library(FileSpec, Entry), now).
612
613ensure_shlib :-
614 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
615 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
616 !.
617ensure_shlib :-
618 use_module(library(shlib), []).
619
620
621 624
629
630stream_position_data(Prop, Term, Value) :-
631 nonvar(Prop),
632 !,
633 ( stream_position_field(Prop, Pos)
634 -> arg(Pos, Term, Value)
635 ; throw(error(domain_error(stream_position_data, Prop)))
636 ).
637stream_position_data(Prop, Term, Value) :-
638 stream_position_field(Prop, Pos),
639 arg(Pos, Term, Value).
640
641stream_position_field(char_count, 1).
642stream_position_field(line_count, 2).
643stream_position_field(line_position, 3).
644stream_position_field(byte_count, 4).
645
646
647 650
656
657:- meta_predicate
658 call_with_depth_limit(0, +, -). 659
660call_with_depth_limit(G, Limit, Result) :-
661 '$depth_limit'(Limit, OLimit, OReached),
662 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
663 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
664 ( Det == ! -> ! ; true )
665 ; '$depth_limit_false'(OLimit, OReached, Result)
666 ).
667
678
679:- meta_predicate
680 call_with_inference_limit(0, +, -). 681
682call_with_inference_limit(G, Limit, Result) :-
683 '$inference_limit'(Limit, OLimit),
684 ( catch(G, Except,
685 system:'$inference_limit_except'(OLimit, Except, Result0)),
686 ( Result0 == inference_limit_exceeded
687 -> !
688 ; system:'$inference_limit_true'(Limit, OLimit, Result0),
689 ( Result0 == ! -> ! ; true )
690 ),
691 Result = Result0
692 ; system:'$inference_limit_false'(OLimit)
693 ).
694
695
696 699
712
713
714:- meta_predicate
715 current_predicate(?, :),
716 '$defined_predicate'(:). 717
718current_predicate(Name, Module:Head) :-
719 (var(Module) ; var(Head)),
720 !,
721 generate_current_predicate(Name, Module, Head).
722current_predicate(Name, Term) :-
723 '$c_current_predicate'(Name, Term),
724 '$defined_predicate'(Term),
725 !.
726current_predicate(Name, Module:Head) :-
727 default_module(Module, DefModule),
728 '$c_current_predicate'(Name, DefModule:Head),
729 '$defined_predicate'(DefModule:Head),
730 !.
731current_predicate(Name, Module:Head) :-
732 '$autoload':autoload_in(Module, general),
733 \+ current_prolog_flag(Module:unknown, fail),
734 ( compound(Head)
735 -> compound_name_arity(Head, Name, Arity)
736 ; Name = Head, Arity = 0
737 ),
738 '$find_library'(Module, Name, Arity, _LoadModule, _Library),
739 !.
740
741generate_current_predicate(Name, Module, Head) :-
742 current_module(Module),
743 QHead = Module:Head,
744 '$c_current_predicate'(Name, QHead),
745 '$get_predicate_attribute'(QHead, defined, 1).
746
747'$defined_predicate'(Head) :-
748 '$get_predicate_attribute'(Head, defined, 1),
749 !.
750
754
755:- meta_predicate
756 predicate_property(:, ?). 757
758:- multifile
759 '$predicate_property'/2. 760
761:- '$iso'(predicate_property/2). 762
763predicate_property(Pred, Property) :- 764 nonvar(Property),
765 !,
766 property_predicate(Property, Pred).
767predicate_property(Pred, Property) :- 768 define_or_generate(Pred),
769 '$predicate_property'(Property, Pred).
770
776
777property_predicate(undefined, Pred) :-
778 !,
779 Pred = Module:Head,
780 current_module(Module),
781 '$c_current_predicate'(_, Pred),
782 \+ '$defined_predicate'(Pred), 783 \+ current_predicate(_, Pred),
784 goal_name_arity(Head, Name, Arity),
785 \+ system_undefined(Module:Name/Arity).
786property_predicate(visible, Pred) :-
787 !,
788 visible_predicate(Pred).
789property_predicate(autoload(File), Head) :-
790 !,
791 \+ current_prolog_flag(autoload, false),
792 '$autoload':autoloadable(Head, File).
793property_predicate(implementation_module(IM), M:Head) :-
794 !,
795 atom(M),
796 ( default_module(M, DM),
797 '$get_predicate_attribute'(DM:Head, defined, 1)
798 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM)
799 -> IM = ImportM
800 ; IM = M
801 )
802 ; \+ current_prolog_flag(M:unknown, fail),
803 goal_name_arity(Head, Name, Arity),
804 '$find_library'(_, Name, Arity, LoadModule, _File)
805 -> IM = LoadModule
806 ; M = IM
807 ).
808property_predicate(iso, _:Head) :-
809 callable(Head),
810 !,
811 goal_name_arity(Head, Name, Arity),
812 current_predicate(system:Name/Arity),
813 '$predicate_property'(iso, system:Head).
814property_predicate(built_in, Module:Head) :-
815 callable(Head),
816 !,
817 goal_name_arity(Head, Name, Arity),
818 current_predicate(Module:Name/Arity),
819 '$predicate_property'(built_in, Module:Head).
820property_predicate(Property, Pred) :-
821 define_or_generate(Pred),
822 '$predicate_property'(Property, Pred).
823
824goal_name_arity(Head, Name, Arity) :-
825 compound(Head),
826 !,
827 compound_name_arity(Head, Name, Arity).
828goal_name_arity(Head, Head, 0).
829
830
836
837define_or_generate(M:Head) :-
838 callable(Head),
839 atom(M),
840 '$get_predicate_attribute'(M:Head, defined, 1),
841 !.
842define_or_generate(M:Head) :-
843 callable(Head),
844 nonvar(M), M \== system,
845 !,
846 '$define_predicate'(M:Head).
847define_or_generate(Pred) :-
848 current_predicate(_, Pred),
849 '$define_predicate'(Pred).
850
851
852'$predicate_property'(interpreted, Pred) :-
853 '$get_predicate_attribute'(Pred, foreign, 0).
854'$predicate_property'(visible, Pred) :-
855 '$get_predicate_attribute'(Pred, defined, 1).
856'$predicate_property'(built_in, Pred) :-
857 '$get_predicate_attribute'(Pred, system, 1).
858'$predicate_property'(exported, Pred) :-
859 '$get_predicate_attribute'(Pred, exported, 1).
860'$predicate_property'(public, Pred) :-
861 '$get_predicate_attribute'(Pred, public, 1).
862'$predicate_property'(non_terminal, Pred) :-
863 '$get_predicate_attribute'(Pred, non_terminal, 1).
864'$predicate_property'(foreign, Pred) :-
865 '$get_predicate_attribute'(Pred, foreign, 1).
866'$predicate_property'((dynamic), Pred) :-
867 '$get_predicate_attribute'(Pred, (dynamic), 1).
868'$predicate_property'((static), Pred) :-
869 '$get_predicate_attribute'(Pred, (dynamic), 0).
870'$predicate_property'((volatile), Pred) :-
871 '$get_predicate_attribute'(Pred, (volatile), 1).
872'$predicate_property'((thread_local), Pred) :-
873 '$get_predicate_attribute'(Pred, (thread_local), 1).
874'$predicate_property'((multifile), Pred) :-
875 '$get_predicate_attribute'(Pred, (multifile), 1).
876'$predicate_property'(imported_from(Module), Pred) :-
877 '$get_predicate_attribute'(Pred, imported, Module).
878'$predicate_property'(transparent, Pred) :-
879 '$get_predicate_attribute'(Pred, transparent, 1).
880'$predicate_property'(meta_predicate(Pattern), Pred) :-
881 '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
882'$predicate_property'(file(File), Pred) :-
883 '$get_predicate_attribute'(Pred, file, File).
884'$predicate_property'(line_count(LineNumber), Pred) :-
885 '$get_predicate_attribute'(Pred, line_count, LineNumber).
886'$predicate_property'(notrace, Pred) :-
887 '$get_predicate_attribute'(Pred, trace, 0).
888'$predicate_property'(nodebug, Pred) :-
889 '$get_predicate_attribute'(Pred, hide_childs, 1).
890'$predicate_property'(spying, Pred) :-
891 '$get_predicate_attribute'(Pred, spy, 1).
892'$predicate_property'(number_of_clauses(N), Pred) :-
893 '$get_predicate_attribute'(Pred, number_of_clauses, N).
894'$predicate_property'(number_of_rules(N), Pred) :-
895 '$get_predicate_attribute'(Pred, number_of_rules, N).
896'$predicate_property'(last_modified_generation(Gen), Pred) :-
897 '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
898'$predicate_property'(indexed(Indices), Pred) :-
899 '$get_predicate_attribute'(Pred, indexed, Indices).
900'$predicate_property'(noprofile, Pred) :-
901 '$get_predicate_attribute'(Pred, noprofile, 1).
902'$predicate_property'(ssu, Pred) :-
903 '$get_predicate_attribute'(Pred, ssu, 1).
904'$predicate_property'(iso, Pred) :-
905 '$get_predicate_attribute'(Pred, iso, 1).
906'$predicate_property'(quasi_quotation_syntax, Pred) :-
907 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
908'$predicate_property'(defined, Pred) :-
909 '$get_predicate_attribute'(Pred, defined, 1).
910'$predicate_property'(tabled, Pred) :-
911 '$get_predicate_attribute'(Pred, tabled, 1).
912'$predicate_property'(tabled(Flag), Pred) :-
913 '$get_predicate_attribute'(Pred, tabled, 1),
914 table_flag(Flag, Pred).
915'$predicate_property'(incremental, Pred) :-
916 '$get_predicate_attribute'(Pred, incremental, 1).
917'$predicate_property'(monotonic, Pred) :-
918 '$get_predicate_attribute'(Pred, monotonic, 1).
919'$predicate_property'(opaque, Pred) :-
920 '$get_predicate_attribute'(Pred, opaque, 1).
921'$predicate_property'(lazy, Pred) :-
922 '$get_predicate_attribute'(Pred, lazy, 1).
923'$predicate_property'(abstract(N), Pred) :-
924 '$get_predicate_attribute'(Pred, abstract, N).
925'$predicate_property'(size(Bytes), Pred) :-
926 '$get_predicate_attribute'(Pred, size, Bytes).
927
928system_undefined(user:prolog_trace_interception/4).
929system_undefined(user:prolog_exception_hook/4).
930system_undefined(system:'$c_call_prolog'/0).
931system_undefined(system:window_title/2).
932
933table_flag(variant, Pred) :-
934 '$tbl_implementation'(Pred, M:Head),
935 M:'$tabled'(Head, variant).
936table_flag(subsumptive, Pred) :-
937 '$tbl_implementation'(Pred, M:Head),
938 M:'$tabled'(Head, subsumptive).
939table_flag(shared, Pred) :-
940 '$get_predicate_attribute'(Pred, tshared, 1).
941table_flag(incremental, Pred) :-
942 '$get_predicate_attribute'(Pred, incremental, 1).
943table_flag(monotonic, Pred) :-
944 '$get_predicate_attribute'(Pred, monotonic, 1).
945table_flag(subgoal_abstract(N), Pred) :-
946 '$get_predicate_attribute'(Pred, subgoal_abstract, N).
947table_flag(answer_abstract(N), Pred) :-
948 '$get_predicate_attribute'(Pred, subgoal_abstract, N).
949table_flag(subgoal_abstract(N), Pred) :-
950 '$get_predicate_attribute'(Pred, max_answers, N).
951
952
958
959visible_predicate(Pred) :-
960 Pred = M:Head,
961 current_module(M),
962 ( callable(Head)
963 -> ( '$get_predicate_attribute'(Pred, defined, 1)
964 -> true
965 ; \+ current_prolog_flag(M:unknown, fail),
966 functor(Head, Name, Arity),
967 '$find_library'(M, Name, Arity, _LoadModule, _Library)
968 )
969 ; setof(PI, visible_in_module(M, PI), PIs),
970 '$member'(Name/Arity, PIs),
971 functor(Head, Name, Arity)
972 ).
973
974visible_in_module(M, Name/Arity) :-
975 default_module(M, DefM),
976 DefHead = DefM:Head,
977 '$c_current_predicate'(_, DefHead),
978 '$get_predicate_attribute'(DefHead, defined, 1),
979 \+ hidden_system_predicate(Head),
980 functor(Head, Name, Arity).
981visible_in_module(_, Name/Arity) :-
982 '$in_library'(Name, Arity, _).
983
984hidden_system_predicate(Head) :-
985 functor(Head, Name, _),
986 atom(Name), 987 sub_atom(Name, 0, _, _, $),
988 \+ current_prolog_flag(access_level, system).
989
990
1012
1013clause_property(Clause, Property) :-
1014 '$clause_property'(Property, Clause).
1015
1016'$clause_property'(line_count(LineNumber), Clause) :-
1017 '$get_clause_attribute'(Clause, line_count, LineNumber).
1018'$clause_property'(file(File), Clause) :-
1019 '$get_clause_attribute'(Clause, file, File).
1020'$clause_property'(source(File), Clause) :-
1021 '$get_clause_attribute'(Clause, owner, File).
1022'$clause_property'(size(Bytes), Clause) :-
1023 '$get_clause_attribute'(Clause, size, Bytes).
1024'$clause_property'(fact, Clause) :-
1025 '$get_clause_attribute'(Clause, fact, true).
1026'$clause_property'(erased, Clause) :-
1027 '$get_clause_attribute'(Clause, erased, true).
1028'$clause_property'(predicate(PI), Clause) :-
1029 '$get_clause_attribute'(Clause, predicate_indicator, PI).
1030'$clause_property'(module(M), Clause) :-
1031 '$get_clause_attribute'(Clause, module, M).
1032
1044
1045dynamic(M:Predicates, Options) :-
1046 '$must_be'(list, Predicates),
1047 options_properties(Options, Props),
1048 set_pprops(Predicates, M, [dynamic|Props]).
1049
1050set_pprops([], _, _).
1051set_pprops([H|T], M, Props) :-
1052 set_pprops1(Props, M:H),
1053 strip_module(M:H, M2, P),
1054 '$pi_head'(M2:P, Pred),
1055 '$set_table_wrappers'(Pred),
1056 set_pprops(T, M, Props).
1057
1058set_pprops1([], _).
1059set_pprops1([H|T], P) :-
1060 ( atom(H)
1061 -> '$set_predicate_attribute'(P, H, true)
1062 ; H =.. [Name,Value]
1063 -> '$set_predicate_attribute'(P, Name, Value)
1064 ),
1065 set_pprops1(T, P).
1066
1067options_properties(Options, Props) :-
1068 G = opt_prop(_,_,_,_),
1069 findall(G, G, Spec),
1070 options_properties(Spec, Options, Props).
1071
1072options_properties([], _, []).
1073options_properties([opt_prop(Name, Type, SetValue, Prop)|T],
1074 Options, [Prop|PT]) :-
1075 Opt =.. [Name,V],
1076 '$option'(Opt, Options),
1077 '$must_be'(Type, V),
1078 V = SetValue,
1079 !,
1080 options_properties(T, Options, PT).
1081options_properties([_|T], Options, PT) :-
1082 options_properties(T, Options, PT).
1083
1084opt_prop(incremental, boolean, Bool, incremental(Bool)).
1085opt_prop(abstract, between(0,0), 0, abstract).
1086opt_prop(multifile, boolean, true, multifile).
1087opt_prop(discontiguous, boolean, true, discontiguous).
1088opt_prop(volatile, boolean, true, volatile).
1089opt_prop(thread, oneof(atom, [local,shared],[local,shared]),
1090 local, thread_local).
1091
1092 1095
1099
1100current_module(Module) :-
1101 '$current_module'(Module, _).
1102
1116
1117module_property(Module, Property) :-
1118 nonvar(Module), nonvar(Property),
1119 !,
1120 property_module(Property, Module).
1121module_property(Module, Property) :- 1122 nonvar(Property), Property = file(File),
1123 !,
1124 ( nonvar(File)
1125 -> '$current_module'(Modules, File),
1126 ( atom(Modules)
1127 -> Module = Modules
1128 ; '$member'(Module, Modules)
1129 )
1130 ; '$current_module'(Module, File),
1131 File \== []
1132 ).
1133module_property(Module, Property) :-
1134 current_module(Module),
1135 property_module(Property, Module).
1136
1137property_module(Property, Module) :-
1138 module_property(Property),
1139 ( Property = exported_operators(List)
1140 -> '$exported_ops'(Module, List, [])
1141 ; '$module_property'(Module, Property)
1142 ).
1143
1144module_property(class(_)).
1145module_property(file(_)).
1146module_property(line_count(_)).
1147module_property(exports(_)).
1148module_property(exported_operators(_)).
1149module_property(size(_)).
1150module_property(program_size(_)).
1151module_property(program_space(_)).
1152module_property(last_modified_generation(_)).
1153
1157
1158module(Module) :-
1159 atom(Module),
1160 current_module(Module),
1161 !,
1162 '$set_typein_module'(Module).
1163module(Module) :-
1164 '$set_typein_module'(Module),
1165 print_message(warning, no_current_module(Module)).
1166
1171
1172working_directory(Old, New) :-
1173 '$cwd'(Old),
1174 ( Old == New
1175 -> true
1176 ; '$chdir'(New)
1177 ).
1178
1179
1180 1183
1187
1188current_trie(Trie) :-
1189 current_blob(Trie, trie),
1190 is_trie(Trie).
1191
1225
1226trie_property(Trie, Property) :-
1227 current_trie(Trie),
1228 trie_property(Property),
1229 '$trie_property'(Trie, Property).
1230
1231trie_property(node_count(_)).
1232trie_property(value_count(_)).
1233trie_property(size(_)).
1234trie_property(hashed(_)).
1235trie_property(compiled_size(_)).
1236 1237trie_property(lookup_count(_)). 1238trie_property(gen_call_count(_)).
1239trie_property(invalidated(_)). 1240trie_property(reevaluated(_)).
1241trie_property(deadlock(_)). 1242trie_property(wait(_)).
1243trie_property(idg_affected_count(_)).
1244trie_property(idg_dependent_count(_)).
1245trie_property(idg_size(_)).
1246
1247
1248 1251
1252shell(Command) :-
1253 shell(Command, 0).
1254
1255
1256 1259
1260:- meta_predicate
1261 on_signal(+, :, :),
1262 current_signal(?, ?, :). 1263
1265
1266on_signal(Signal, Old, New) :-
1267 atom(Signal),
1268 !,
1269 '$on_signal'(_Num, Signal, Old, New).
1270on_signal(Signal, Old, New) :-
1271 integer(Signal),
1272 !,
1273 '$on_signal'(Signal, _Name, Old, New).
1274on_signal(Signal, _Old, _New) :-
1275 '$type_error'(signal_name, Signal).
1276
1278
1279current_signal(Name, Id, Handler) :-
1280 between(1, 32, Id),
1281 '$on_signal'(Id, Name, Handler, Handler).
1282
1283:- multifile
1284 prolog:called_by/2. 1285
1286prolog:called_by(on_signal(_,_,New), [New+1]) :-
1287 ( new == throw
1288 ; new == default
1289 ), !, fail.
1290
1291
1292 1295
1307
1308open_shared_object(File, Handle) :-
1309 open_shared_object(File, Handle, []). 1310
1311open_shared_object(File, Handle, Flags) :-
1312 ( is_list(Flags)
1313 -> true
1314 ; throw(error(type_error(list, Flags), _))
1315 ),
1316 map_dlflags(Flags, Mask),
1317 '$open_shared_object'(File, Handle, Mask).
1318
1319dlopen_flag(now, 2'01). 1320dlopen_flag(global, 2'10). 1321
1322map_dlflags([], 0).
1323map_dlflags([F|T], M) :-
1324 map_dlflags(T, M0),
1325 ( dlopen_flag(F, I)
1326 -> true
1327 ; throw(error(domain_error(dlopen_flag, F), _))
1328 ),
1329 M is M0 \/ I.
1330
1331
1332 1335
1336format(Fmt) :-
1337 format(Fmt, []).
1338
1339 1342
1344
1345absolute_file_name(Name, Abs) :-
1346 atomic(Name),
1347 !,
1348 '$absolute_file_name'(Name, Abs).
1349absolute_file_name(Term, Abs) :-
1350 '$chk_file'(Term, [''], [access(read)], true, File),
1351 !,
1352 '$absolute_file_name'(File, Abs).
1353absolute_file_name(Term, Abs) :-
1354 '$chk_file'(Term, [''], [], true, File),
1355 !,
1356 '$absolute_file_name'(File, Abs).
1357
1363
1364tmp_file_stream(Enc, File, Stream) :-
1365 atom(Enc), var(File), var(Stream),
1366 !,
1367 '$tmp_file_stream'('', Enc, File, Stream).
1368tmp_file_stream(File, Stream, Options) :-
1369 current_prolog_flag(encoding, DefEnc),
1370 '$option'(encoding(Enc), Options, DefEnc),
1371 '$option'(extension(Ext), Options, ''),
1372 '$tmp_file_stream'(Ext, Enc, File, Stream),
1373 set_stream(Stream, file_name(File)).
1374
1375
1376 1379
1386
1387garbage_collect :-
1388 '$garbage_collect'(0).
1389
1393
1394set_prolog_stack(Stack, Option) :-
1395 Option =.. [Name,Value0],
1396 Value is Value0,
1397 '$set_prolog_stack'(Stack, Name, _Old, Value).
1398
1402
1403prolog_stack_property(Stack, Property) :-
1404 stack_property(P),
1405 stack_name(Stack),
1406 Property =.. [P,Value],
1407 '$set_prolog_stack'(Stack, P, Value, Value).
1408
1409stack_name(local).
1410stack_name(global).
1411stack_name(trail).
1412
1413stack_property(limit).
1414stack_property(spare).
1415stack_property(min_free).
1416stack_property(low).
1417stack_property(factor).
1418
1419
1420 1423
1429
1430rule(Head, Rule) :-
1431 '$rule'(Head, Rule0),
1432 conditional_rule(Rule0, Rule1),
1433 Rule = Rule1.
1434rule(Head, Rule, Ref) :-
1435 '$rule'(Head, Rule0, Ref),
1436 conditional_rule(Rule0, Rule1),
1437 Rule = Rule1.
1438
1439conditional_rule(?=>(Head, Body0), (Head,Cond=>Body)) :-
1440 split_on_cut(Body0, Cond, Body),
1441 !.
1442conditional_rule(Rule, Rule).
1443
1444split_on_cut(Var, _, _) :-
1445 var(Var),
1446 !,
1447 fail.
1448split_on_cut((Cond,!,Body), Cond, Body) :-
1449 !.
1450split_on_cut((A,B), (A,Cond), Body) :-
1451 split_on_cut(B, Cond, Body).
1452
1453
1454
1455 1458
1459:- '$iso'((numbervars/3)). 1460
1466
1467numbervars(Term, From, To) :-
1468 numbervars(Term, From, To, []).
1469
1470
1471 1474
1478
1479term_string(Term, String, Options) :-
1480 nonvar(String),
1481 !,
1482 read_term_from_atom(String, Term, Options).
1483term_string(Term, String, Options) :-
1484 ( '$option'(quoted(_), Options)
1485 -> Options1 = Options
1486 ; '$merge_options'(_{quoted:true}, Options, Options1)
1487 ),
1488 format(string(String), '~W', [Term, Options1]).
1489
1490
1491 1494
1498
1499nb_setval(Name, Value) :-
1500 duplicate_term(Value, Copy),
1501 nb_linkval(Name, Copy).
1502
1503
1504 1507
1508:- meta_predicate
1509 thread_create(0, -). 1510
1514
1515thread_create(Goal, Id) :-
1516 thread_create(Goal, Id, []).
1517
1524
1525thread_join(Id) :-
1526 thread_join(Id, Status),
1527 ( Status == true
1528 -> true
1529 ; throw(error(thread_error(Id, Status), _))
1530 ).
1531
1546
1547set_prolog_gc_thread(Status) :-
1548 var(Status),
1549 !,
1550 '$instantiation_error'(Status).
1551set_prolog_gc_thread(false) :-
1552 !,
1553 set_prolog_flag(gc_thread, false),
1554 ( current_prolog_flag(threads, true)
1555 -> ( '$gc_stop'
1556 -> thread_join(gc)
1557 ; true
1558 )
1559 ; true
1560 ).
1561set_prolog_gc_thread(true) :-
1562 !,
1563 set_prolog_flag(gc_thread, true).
1564set_prolog_gc_thread(stop) :-
1565 !,
1566 ( current_prolog_flag(threads, true)
1567 -> ( '$gc_stop'
1568 -> thread_join(gc)
1569 ; true
1570 )
1571 ; true
1572 ).
1573set_prolog_gc_thread(Status) :-
1574 '$domain_error'(gc_thread, Status).
1575
1582
1583transaction(Goal) :-
1584 '$transaction'(Goal, []).
1585transaction(Goal, Options) :-
1586 '$transaction'(Goal, Options).
1587transaction(Goal, Constraint, Mutex) :-
1588 '$transaction'(Goal, Constraint, Mutex).
1589snapshot(Goal) :-
1590 '$snapshot'(Goal).
1591
1592
1597
1598:- meta_predicate
1599 '$wrap_predicate'(:, +, -, -, +). 1600
1601'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
1602 callable_name_arguments(Head, PName, Args),
1603 callable_name_arity(Head, PName, Arity),
1604 ( is_most_general_term(Head)
1605 -> true
1606 ; '$domain_error'(most_general_term, Head)
1607 ),
1608 atomic_list_concat(['$wrap$', PName], WrapName),
1609 volatile(M:WrapName/Arity),
1610 module_transparent(M:WrapName/Arity),
1611 WHead =.. [WrapName|Args],
1612 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
1613
1614callable_name_arguments(Head, PName, Args) :-
1615 atom(Head),
1616 !,
1617 PName = Head,
1618 Args = [].
1619callable_name_arguments(Head, PName, Args) :-
1620 compound_name_arguments(Head, PName, Args).
1621
1622callable_name_arity(Head, PName, Arity) :-
1623 atom(Head),
1624 !,
1625 PName = Head,
1626 Arity = 0.
1627callable_name_arity(Head, PName, Arity) :-
1628 compound_name_arity(Head, PName, Arity)