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, 62 module_property/2, 63 module/1, 64 current_trie/1, 65 trie_property/2, 66 working_directory/2, 67 shell/1, 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, 79 call_with_inference_limit/3, 80 numbervars/3, 81 term_string/3, 82 nb_setval/2, 83 thread_create/2, 84 thread_join/1 85 ]). 86
87 90
92
93:- meta_predicate
94 map_bits(2, +, +, -). 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) :- 105 !,
106 bit(Pred, Name, Bits),
107 !,
108 New is Old \/ Bits.
109map_bits(Pred, -Name, Old, New) :- 110 !,
111 bit(Pred, Name, Bits),
112 !,
113 New is Old /\ (\Bits).
114map_bits(Pred, ?(Name), Old, Old) :- 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. 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). 156style_name(discontiguous, 0x0008).
157style_name(charset, 0x0020).
158style_name(no_effect, 0x0080).
159style_name(var_branches, 0x0100).
160
162
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.
183
184
192
193:- multifile
194 prolog:debug_control_hook/1. 195
201
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(:). 282
297
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).
351
355
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).
386
387
392
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 412
417
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 431
432dwim_match(A1, A2) :-
433 dwim_match(A1, A2, _).
434
435atom_prefix(Atom, Prefix) :-
436 sub_atom(Atom, 0, _, _, Prefix).
437
438
439 442
453
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.
467
472
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)).
503
504
508
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).
553
554
558
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).
576
577
583
584prolog_load_context(module, Module) :-
585 '$current_source_module'(Module).
586prolog_load_context(file, F) :-
587 source_location(F, _).
588prolog_load_context(source, F) :- 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), 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).
622
626
627unload_file(File) :-
628 ( canonical_source_file(File, Path)
629 -> '$unload_file'(Path)
630 ; true
631 ).
632
633
634 637
642
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 663
669
670:- meta_predicate
671 call_with_depth_limit(0, +, -). 672
673call_with_depth_limit(G, Limit, Result) :-
674 '$depth_limit'(Limit, OLimit, OReached),
675 ( catch(G, 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 ).
680
692
693:- meta_predicate
694 call_with_inference_limit(0, +, -). 695
696call_with_inference_limit(G, Limit, Result) :-
697 '$inference_limit'(Limit, OLimit),
698 ( catch(G, 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 710
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(Module:unknown, 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 !.
761
765
766:- meta_predicate
767 predicate_property(:, ?). 768
769:- '$iso'(predicate_property/2). 770
771predicate_property(Pred, Property) :- 772 nonvar(Property),
773 !,
774 property_predicate(Property, Pred).
775predicate_property(Pred, Property) :- 776 define_or_generate(Pred),
777 '$predicate_property'(Property, Pred).
778
784
785property_predicate(undefined, Pred) :-
786 !,
787 Pred = Module:Head,
788 current_module(Module),
789 '$c_current_predicate'(_, Pred),
790 \+ '$defined_predicate'(Pred), 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(M:unknown, 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).
832
833
839
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).
914
920
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(M:unknown, 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
946hidden_system_predicate(Head) :-
947 functor(Head, Name, _),
948 atom(Name), 949 sub_atom(Name, 0, _, _, $),
950 \+ current_prolog_flag(access_level, system).
951
952
974
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 999
1000:- meta_predicate
1001 require(:). 1002
1009
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 1029
1033
1034current_module(Module) :-
1035 '$current_module'(Module, _).
1036
1050
1051module_property(Module, Property) :-
1052 nonvar(Module), nonvar(Property),
1053 !,
1054 property_module(Property, Module).
1055module_property(Module, Property) :- 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(_)).
1087
1091
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)).
1100
1105
1106working_directory(Old, New) :-
1107 '$cwd'(Old),
1108 ( Old == New
1109 -> true
1110 ; '$chdir'(New)
1111 ).
1112
1113
1114 1117
1121
1122current_trie(Trie) :-
1123 current_blob(Trie, trie),
1124 is_trie(Trie).
1125
1139
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 1155
1156shell(Command) :-
1157 shell(Command, 0).
1158
1163
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 1179
1180:- meta_predicate
1181 on_signal(+, :, :),
1182 current_signal(?, ?, :). 1183
1185
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).
1196
1198
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
1206prolog:called_by(on_signal(_,_,New), [New+1]) :-
1207 ( new == throw
1208 ; new == default
1209 ), !, fail.
1210
1211
1212 1215
1227
1228open_shared_object(File, Handle) :-
1229 open_shared_object(File, Handle, []). 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). 1240dlopen_flag(global, 2'10). 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 1255
1256format(Fmt) :-
1257 format(Fmt, []).
1258
1259 1262
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 1282
1289
1290garbage_collect :-
1291 '$garbage_collect'(0).
1292
1296
1297set_prolog_stack(Stack, Option) :-
1298 Option =.. [Name,Value0],
1299 Value is Value0,
1300 '$set_prolog_stack'(Stack, Name, _Old, Value).
1301
1305
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 1324
1325:- '$iso'((numbervars/3)). 1326
1332
1333numbervars(Term, From, To) :-
1334 numbervars(Term, From, To, []).
1335
1336
1337 1340
1344
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 1360
1364
1365nb_setval(Name, Value) :-
1366 duplicate_term(Value, Copy),
1367 nb_linkval(Name, Copy).
1368
1369
1370 1373
1374:- meta_predicate
1375 thread_create(0, -). 1376
1380
1381thread_create(Goal, Id) :-
1382 thread_create(Goal, Id, []).
1383
1390
1391thread_join(Id) :-
1392 thread_join(Id, Status),
1393 ( Status == true
1394 -> true
1395 ; throw(error(thread_error(Status), _))
1396 )