37
38:- module('$syspreds',
39 [ leash/1,
40 visible/1,
41 style_check/1,
42 flag/3,
43 atom_prefix/2,
44 dwim_match/2,
45 source_file_property/2,
46 source_file/1,
47 source_file/2,
48 unload_file/1,
49 exists_source/1, 50 exists_source/2, 51 prolog_load_context/2,
52 stream_position_data/3,
53 current_predicate/2,
54 '$defined_predicate'/1,
55 predicate_property/2,
56 '$predicate_property'/2,
57 (dynamic)/2, 58 clause_property/2,
59 current_module/1, 60 module_property/2, 61 module/1, 62 current_trie/1, 63 trie_property/2, 64 working_directory/2, 65 shell/1, 66 on_signal/3,
67 current_signal/3,
68 format/1,
69 garbage_collect/0,
70 set_prolog_stack/2,
71 prolog_stack_property/2,
72 absolute_file_name/2,
73 tmp_file_stream/3, 74 call_with_depth_limit/3, 75 call_with_inference_limit/3, 76 rule/2, 77 rule/3, 78 numbervars/3, 79 term_string/3, 80 thread_create/2, 81 thread_join/1, 82 sig_block/1, 83 sig_unblock/1, 84 transaction/1, 85 transaction/2, 86 transaction/3, 87 snapshot/1, 88 undo/1, 89 set_prolog_gc_thread/1, 90
91 '$wrap_predicate'/5 92 ]). 93
94:- meta_predicate
95 dynamic(:, +),
96 transaction(0),
97 transaction(0,0,+),
98 snapshot(0),
99 rule(:, -),
100 rule(:, -, ?),
101 sig_block(:),
102 sig_unblock(:). 103
104
105 108
110
111:- meta_predicate
112 map_bits(2, +, +, -). 113
114map_bits(_, Var, _, _) :-
115 var(Var),
116 !,
117 '$instantiation_error'(Var).
118map_bits(_, [], Bits, Bits) :- !.
119map_bits(Pred, [H|T], Old, New) :-
120 map_bits(Pred, H, Old, New0),
121 map_bits(Pred, T, New0, New).
122map_bits(Pred, +Name, Old, New) :- 123 !,
124 bit(Pred, Name, Bits),
125 !,
126 New is Old \/ Bits.
127map_bits(Pred, -Name, Old, New) :- 128 !,
129 bit(Pred, Name, Bits),
130 !,
131 New is Old /\ (\Bits).
132map_bits(Pred, ?(Name), Old, Old) :- 133 !,
134 bit(Pred, Name, Bits),
135 Old /\ Bits > 0.
136map_bits(_, Term, _, _) :-
137 '$type_error'('+|-|?(Flag)', Term).
138
139bit(Pred, Name, Bits) :-
140 call(Pred, Name, Bits),
141 !.
142bit(_:Pred, Name, _) :-
143 '$domain_error'(Pred, Name).
144
145:- public port_name/2. 146
147port_name( call, 2'000000001).
148port_name( exit, 2'000000010).
149port_name( fail, 2'000000100).
150port_name( redo, 2'000001000).
151port_name( unify, 2'000010000).
152port_name( break, 2'000100000).
153port_name( cut_call, 2'001000000).
154port_name( cut_exit, 2'010000000).
155port_name( exception, 2'100000000).
156port_name( cut, 2'011000000).
157port_name( all, 2'000111111).
158port_name( full, 2'000101111).
159port_name( half, 2'000101101). 160
161leash(Ports) :-
162 '$leash'(Old, Old),
163 map_bits(port_name, Ports, Old, New),
164 '$leash'(_, New).
165
166visible(Ports) :-
167 '$visible'(Old, Old),
168 map_bits(port_name, Ports, Old, New),
169 '$visible'(_, New).
170
171style_name(atom, 0x0001) :-
172 print_message(warning, decl_no_effect(style_check(atom))).
173style_name(singleton, 0x0042). 174style_name(discontiguous, 0x0008).
175style_name(charset, 0x0020).
176style_name(no_effect, 0x0080).
177style_name(var_branches, 0x0100).
178
180
181style_check(Var) :-
182 var(Var),
183 !,
184 '$instantiation_error'(Var).
185style_check(?(Style)) :-
186 !,
187 ( var(Style)
188 -> enum_style_check(Style)
189 ; enum_style_check(Style)
190 -> true
191 ).
192style_check(Spec) :-
193 '$style_check'(Old, Old),
194 map_bits(style_name, Spec, Old, New),
195 '$style_check'(_, New).
196
197enum_style_check(Style) :-
198 '$style_check'(Bits, Bits),
199 style_name(Style, Bit),
200 Bit /\ Bits =\= 0.
201
202
207
208flag(Name, Old, New) :-
209 Old == New,
210 !,
211 get_flag(Name, Old).
212flag(Name, Old, New) :-
213 with_mutex('$flag', update_flag(Name, Old, New)).
214
215update_flag(Name, Old, New) :-
216 get_flag(Name, Old),
217 ( atom(New)
218 -> set_flag(Name, New)
219 ; Value is New,
220 set_flag(Name, Value)
221 ).
222
223
224 227
228dwim_match(A1, A2) :-
229 dwim_match(A1, A2, _).
230
231atom_prefix(Atom, Prefix) :-
232 sub_atom(Atom, 0, _, _, Prefix).
233
234
235 238
249
250source_file(File) :-
251 ( current_prolog_flag(access_level, user)
252 -> Level = user
253 ; true
254 ),
255 ( ground(File)
256 -> ( '$time_source_file'(File, Time, Level)
257 ; absolute_file_name(File, Abs),
258 '$time_source_file'(Abs, Time, Level)
259 ), !
260 ; '$time_source_file'(File, Time, Level)
261 ),
262 float(Time).
263
268
269:- meta_predicate source_file(:, ?). 270
271source_file(M:Head, File) :-
272 nonvar(M), nonvar(Head),
273 !,
274 ( '$c_current_predicate'(_, M:Head),
275 predicate_property(M:Head, multifile)
276 -> multi_source_file(M:Head, File)
277 ; '$source_file'(M:Head, File)
278 ).
279source_file(M:Head, File) :-
280 ( nonvar(File)
281 -> true
282 ; source_file(File)
283 ),
284 '$source_file_predicates'(File, Predicates),
285 '$member'(M:Head, Predicates).
286
287multi_source_file(Head, File) :-
288 State = state([]),
289 nth_clause(Head, _, Clause),
290 clause_property(Clause, source(File)),
291 arg(1, State, Found),
292 ( memberchk(File, Found)
293 -> fail
294 ; nb_linkarg(1, State, [File|Found])
295 ).
296
297
301
302source_file_property(File, P) :-
303 nonvar(File),
304 !,
305 canonical_source_file(File, Path),
306 property_source_file(P, Path).
307source_file_property(File, P) :-
308 property_source_file(P, File).
309
310property_source_file(modified(Time), File) :-
311 '$time_source_file'(File, Time, user).
312property_source_file(source(Source), File) :-
313 ( '$source_file_property'(File, from_state, true)
314 -> Source = state
315 ; '$source_file_property'(File, resource, true)
316 -> Source = resource
317 ; Source = file
318 ).
319property_source_file(module(M), File) :-
320 ( nonvar(M)
321 -> '$current_module'(M, File)
322 ; nonvar(File)
323 -> '$current_module'(ML, File),
324 ( atom(ML)
325 -> M = ML
326 ; '$member'(M, ML)
327 )
328 ; '$current_module'(M, File)
329 ).
330property_source_file(load_context(Module, Location, Options), File) :-
331 '$time_source_file'(File, _, user),
332 clause(system:'$load_context_module'(File, Module, Options), true, Ref),
333 ( clause_property(Ref, file(FromFile)),
334 clause_property(Ref, line_count(FromLine))
335 -> Location = FromFile:FromLine
336 ; Location = user
337 ).
338property_source_file(includes(Master, Stamp), File) :-
339 system:'$included'(File, _Line, Master, Stamp).
340property_source_file(included_in(Master, Line), File) :-
341 system:'$included'(Master, Line, File, _).
342property_source_file(derived_from(DerivedFrom, Stamp), File) :-
343 system:'$derived_source'(File, DerivedFrom, Stamp).
344property_source_file(reloading, File) :-
345 source_file(File),
346 '$source_file_property'(File, reloading, true).
347property_source_file(load_count(Count), File) :-
348 source_file(File),
349 '$source_file_property'(File, load_count, Count).
350property_source_file(number_of_clauses(Count), File) :-
351 source_file(File),
352 '$source_file_property'(File, number_of_clauses, Count).
353
354
358
359canonical_source_file(Spec, File) :-
360 atom(Spec),
361 '$time_source_file'(Spec, _, _),
362 !,
363 File = Spec.
364canonical_source_file(Spec, File) :-
365 system:'$included'(_Master, _Line, Spec, _),
366 !,
367 File = Spec.
368canonical_source_file(Spec, File) :-
369 absolute_file_name(Spec, File,
370 [ file_type(prolog),
371 access(read),
372 file_errors(fail)
373 ]),
374 source_file(File).
375
376
390
391exists_source(Source) :-
392 exists_source(Source, _Path).
393
394exists_source(Source, Path) :-
395 absolute_file_name(Source, Path,
396 [ file_type(prolog),
397 access(read),
398 file_errors(fail)
399 ]).
400
401
407
408prolog_load_context(module, Module) :-
409 '$current_source_module'(Module).
410prolog_load_context(file, File) :-
411 input_file(File).
412prolog_load_context(source, F) :- 413 input_file(F0),
414 '$input_context'(Context),
415 '$top_file'(Context, F0, F).
416prolog_load_context(stream, S) :-
417 ( system:'$load_input'(_, S0)
418 -> S = S0
419 ).
420prolog_load_context(directory, D) :-
421 input_file(F),
422 file_directory_name(F, D).
423prolog_load_context(dialect, D) :-
424 current_prolog_flag(emulated_dialect, D).
425prolog_load_context(term_position, TermPos) :-
426 source_location(_, L),
427 ( nb_current('$term_position', Pos),
428 compound(Pos), 429 stream_position_data(line_count, Pos, L)
430 -> TermPos = Pos
431 ; TermPos = '$stream_position'(0,L,0,0)
432 ).
433prolog_load_context(script, Bool) :-
434 ( '$toplevel':loaded_init_file(script, Path),
435 input_file(File),
436 same_file(File, Path)
437 -> Bool = true
438 ; Bool = false
439 ).
440prolog_load_context(variable_names, Bindings) :-
441 ( nb_current('$variable_names', Bindings0)
442 -> Bindings = Bindings0
443 ; Bindings = []
444 ).
445prolog_load_context(term, Term) :-
446 nb_current('$term', Term).
447prolog_load_context(reloading, true) :-
448 prolog_load_context(source, F),
449 '$source_file_property'(F, reloading, true).
450
451input_file(File) :-
452 ( system:'$load_input'(_, Stream)
453 -> stream_property(Stream, file_name(File))
454 ),
455 !.
456input_file(File) :-
457 source_location(File, _).
458
459
463
464:- dynamic system:'$resolved_source_path'/2. 465
466unload_file(File) :-
467 ( canonical_source_file(File, Path)
468 -> '$unload_file'(Path),
469 retractall(system:'$resolved_source_path'(_, Path))
470 ; true
471 ).
472
473:- if(current_prolog_flag(open_shared_object, true)). 474
475 478
495
496:- meta_predicate
497 use_foreign_library(:),
498 use_foreign_library(:, +). 499:- public
500 use_foreign_library_noi/1. 501
502use_foreign_library(FileSpec) :-
503 ensure_shlib,
504 initialization(use_foreign_library_noi(FileSpec), now).
505
507use_foreign_library_noi(FileSpec) :-
508 ensure_shlib,
509 shlib:load_foreign_library(FileSpec).
510
511use_foreign_library(FileSpec, Options) :-
512 ensure_shlib,
513 initialization(shlib:load_foreign_library(FileSpec, Options), now).
514
515ensure_shlib :-
516 '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
517 '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
518 !.
519ensure_shlib :-
520 use_module(library(shlib), []).
521
522:- export(use_foreign_library/1). 523:- export(use_foreign_library/2). 524
525:- elif(current_predicate('$activate_static_extension'/1)). 526
529
530:- meta_predicate
531 use_foreign_library(:). 532:- public
533 use_foreign_library_noi/1. 534:- dynamic
535 loading/1,
536 foreign_predicate/2. 537
538use_foreign_library(FileSpec) :-
539 initialization(use_foreign_library_noi(FileSpec), now).
540
541use_foreign_library_noi(Module:foreign(Extension)) :-
542 setup_call_cleanup(
543 asserta(loading(foreign(Extension)), Ref),
544 @('$activate_static_extension'(Extension), Module),
545 erase(Ref)).
546
547:- export(use_foreign_library/1). 548
549system:'$foreign_registered'(M, H) :-
550 ( loading(Lib)
551 -> true
552 ; Lib = '<spontaneous>'
553 ),
554 assert(foreign_predicate(Lib, M:H)).
555
559
560current_foreign_library(File, Public) :-
561 setof(Pred, foreign_predicate(File, Pred), Public).
562
563:- export(current_foreign_library/2). 564
565:- endif. 566
567 570
575
576stream_position_data(Prop, Term, Value) :-
577 nonvar(Prop),
578 !,
579 ( stream_position_field(Prop, Pos)
580 -> arg(Pos, Term, Value)
581 ; throw(error(domain_error(stream_position_data, Prop)))
582 ).
583stream_position_data(Prop, Term, Value) :-
584 stream_position_field(Prop, Pos),
585 arg(Pos, Term, Value).
586
587stream_position_field(char_count, 1).
588stream_position_field(line_count, 2).
589stream_position_field(line_position, 3).
590stream_position_field(byte_count, 4).
591
592
593 596
602
603:- meta_predicate
604 call_with_depth_limit(0, +, -). 605
606call_with_depth_limit(G, Limit, Result) :-
607 '$depth_limit'(Limit, OLimit, OReached),
608 ( catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
609 '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
610 ( Det == ! -> ! ; true )
611 ; '$depth_limit_false'(OLimit, OReached, Result)
612 ).
613
624
625:- meta_predicate
626 call_with_inference_limit(0, +, -). 627
628call_with_inference_limit(G, Limit, Result) :-
629 '$inference_limit'(Limit, OLimit),
630 ( catch(G, Except,
631 system:'$inference_limit_except'(OLimit, Except, Result0)),
632 ( Result0 == inference_limit_exceeded
633 -> !
634 ; system:'$inference_limit_true'(Limit, OLimit, Result0),
635 ( Result0 == ! -> ! ; true )
636 ),
637 Result = Result0
638 ; system:'$inference_limit_false'(OLimit)
639 ).
640
641
642 645
658
659
660:- meta_predicate
661 current_predicate(?, :),
662 '$defined_predicate'(:). 663
664current_predicate(Name, Module:Head) :-
665 (var(Module) ; var(Head)),
666 !,
667 generate_current_predicate(Name, Module, Head).
668current_predicate(Name, Term) :-
669 '$c_current_predicate'(Name, Term),
670 '$defined_predicate'(Term),
671 !.
672current_predicate(Name, Module:Head) :-
673 default_module(Module, DefModule),
674 '$c_current_predicate'(Name, DefModule:Head),
675 '$defined_predicate'(DefModule:Head),
676 !.
677current_predicate(Name, Module:Head) :-
678 '$autoload':autoload_in(Module, general),
679 \+ current_prolog_flag(Module:unknown, fail),
680 ( compound(Head)
681 -> compound_name_arity(Head, Name, Arity)
682 ; Name = Head, Arity = 0
683 ),
684 '$find_library'(Module, Name, Arity, _LoadModule, _Library),
685 !.
686
687generate_current_predicate(Name, Module, Head) :-
688 current_module(Module),
689 QHead = Module:Head,
690 '$c_current_predicate'(Name, QHead),
691 '$get_predicate_attribute'(QHead, defined, 1).
692
693'$defined_predicate'(Head) :-
694 '$get_predicate_attribute'(Head, defined, 1),
695 !.
696
700
701:- meta_predicate
702 predicate_property(:, ?). 703
704:- multifile
705 '$predicate_property'/2. 706
707:- '$iso'(predicate_property/2). 708
709predicate_property(Pred, Property) :- 710 nonvar(Property),
711 !,
712 property_predicate(Property, Pred).
713predicate_property(Pred, Property) :- 714 define_or_generate(Pred),
715 '$predicate_property'(Property, Pred).
716
722
723property_predicate(undefined, Pred) :-
724 !,
725 Pred = Module:Head,
726 current_module(Module),
727 '$c_current_predicate'(_, Pred),
728 \+ '$defined_predicate'(Pred), 729 \+ current_predicate(_, Pred),
730 goal_name_arity(Head, Name, Arity),
731 \+ system_undefined(Module:Name/Arity).
732property_predicate(visible, Pred) :-
733 !,
734 visible_predicate(Pred).
735property_predicate(autoload(File), Head) :-
736 !,
737 \+ current_prolog_flag(autoload, false),
738 '$autoload':autoloadable(Head, File).
739property_predicate(implementation_module(IM), M:Head) :-
740 !,
741 atom(M),
742 ( default_module(M, DM),
743 '$get_predicate_attribute'(DM:Head, defined, 1)
744 -> ( '$get_predicate_attribute'(DM:Head, imported, ImportM)
745 -> IM = ImportM
746 ; IM = M
747 )
748 ; \+ current_prolog_flag(M:unknown, fail),
749 goal_name_arity(Head, Name, Arity),
750 '$find_library'(_, Name, Arity, LoadModule, _File)
751 -> IM = LoadModule
752 ; M = IM
753 ).
754property_predicate(iso, _:Head) :-
755 callable(Head),
756 !,
757 goal_name_arity(Head, Name, Arity),
758 current_predicate(system:Name/Arity),
759 '$predicate_property'(iso, system:Head).
760property_predicate(built_in, Module:Head) :-
761 callable(Head),
762 !,
763 goal_name_arity(Head, Name, Arity),
764 current_predicate(Module:Name/Arity),
765 '$predicate_property'(built_in, Module:Head).
766property_predicate(Property, Pred) :-
767 define_or_generate(Pred),
768 '$predicate_property'(Property, Pred).
769
770goal_name_arity(Head, Name, Arity) :-
771 compound(Head),
772 !,
773 compound_name_arity(Head, Name, Arity).
774goal_name_arity(Head, Head, 0).
775
776
782
783define_or_generate(M:Head) :-
784 callable(Head),
785 atom(M),
786 '$get_predicate_attribute'(M:Head, defined, 1),
787 !.
788define_or_generate(M:Head) :-
789 callable(Head),
790 nonvar(M), M \== system,
791 !,
792 '$define_predicate'(M:Head).
793define_or_generate(Pred) :-
794 current_predicate(_, Pred),
795 '$define_predicate'(Pred).
796
797
798'$predicate_property'(interpreted, Pred) :-
799 '$get_predicate_attribute'(Pred, foreign, 0).
800'$predicate_property'(visible, Pred) :-
801 '$get_predicate_attribute'(Pred, defined, 1).
802'$predicate_property'(built_in, Pred) :-
803 '$get_predicate_attribute'(Pred, system, 1).
804'$predicate_property'(exported, Pred) :-
805 '$get_predicate_attribute'(Pred, exported, 1).
806'$predicate_property'(public, Pred) :-
807 '$get_predicate_attribute'(Pred, public, 1).
808'$predicate_property'(non_terminal, Pred) :-
809 '$get_predicate_attribute'(Pred, non_terminal, 1).
810'$predicate_property'(foreign, Pred) :-
811 '$get_predicate_attribute'(Pred, foreign, 1).
812'$predicate_property'((dynamic), Pred) :-
813 '$get_predicate_attribute'(Pred, (dynamic), 1).
814'$predicate_property'((static), Pred) :-
815 '$get_predicate_attribute'(Pred, (dynamic), 0).
816'$predicate_property'((volatile), Pred) :-
817 '$get_predicate_attribute'(Pred, (volatile), 1).
818'$predicate_property'((thread_local), Pred) :-
819 '$get_predicate_attribute'(Pred, (thread_local), 1).
820'$predicate_property'((multifile), Pred) :-
821 '$get_predicate_attribute'(Pred, (multifile), 1).
822'$predicate_property'((discontiguous), Pred) :-
823 '$get_predicate_attribute'(Pred, (discontiguous), 1).
824'$predicate_property'(imported_from(Module), Pred) :-
825 '$get_predicate_attribute'(Pred, imported, Module).
826'$predicate_property'(transparent, Pred) :-
827 '$get_predicate_attribute'(Pred, transparent, 1).
828'$predicate_property'(meta_predicate(Pattern), Pred) :-
829 '$get_predicate_attribute'(Pred, transparent, 1),
830 '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
831'$predicate_property'(mode(Pattern), Pred) :-
832 '$get_predicate_attribute'(Pred, transparent, 0),
833 '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
834'$predicate_property'(file(File), Pred) :-
835 '$get_predicate_attribute'(Pred, file, File).
836'$predicate_property'(line_count(LineNumber), Pred) :-
837 '$get_predicate_attribute'(Pred, line_count, LineNumber).
838'$predicate_property'(notrace, Pred) :-
839 '$get_predicate_attribute'(Pred, trace, 0).
840'$predicate_property'(nodebug, Pred) :-
841 '$get_predicate_attribute'(Pred, hide_childs, 1).
842'$predicate_property'(spying, Pred) :-
843 '$get_predicate_attribute'(Pred, spy, 1).
844'$predicate_property'(number_of_clauses(N), Pred) :-
845 '$get_predicate_attribute'(Pred, number_of_clauses, N).
846'$predicate_property'(number_of_rules(N), Pred) :-
847 '$get_predicate_attribute'(Pred, number_of_rules, N).
848'$predicate_property'(last_modified_generation(Gen), Pred) :-
849 '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
850'$predicate_property'(indexed(Indices), Pred) :-
851 '$get_predicate_attribute'(Pred, indexed, Indices).
852'$predicate_property'(noprofile, Pred) :-
853 '$get_predicate_attribute'(Pred, noprofile, 1).
854'$predicate_property'(ssu, Pred) :-
855 '$get_predicate_attribute'(Pred, ssu, 1).
856'$predicate_property'(iso, Pred) :-
857 '$get_predicate_attribute'(Pred, iso, 1).
858'$predicate_property'(det, Pred) :-
859 '$get_predicate_attribute'(Pred, det, 1).
860'$predicate_property'(sig_atomic, Pred) :-
861 '$get_predicate_attribute'(Pred, sig_atomic, 1).
862'$predicate_property'(quasi_quotation_syntax, Pred) :-
863 '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
864'$predicate_property'(defined, Pred) :-
865 '$get_predicate_attribute'(Pred, defined, 1).
866'$predicate_property'(tabled, Pred) :-
867 '$get_predicate_attribute'(Pred, tabled, 1).
868'$predicate_property'(tabled(Flag), Pred) :-
869 '$get_predicate_attribute'(Pred, tabled, 1),
870 table_flag(Flag, Pred).
871'$predicate_property'(incremental, Pred) :-
872 '$get_predicate_attribute'(Pred, incremental, 1).
873'$predicate_property'(monotonic, Pred) :-
874 '$get_predicate_attribute'(Pred, monotonic, 1).
875'$predicate_property'(opaque, Pred) :-
876 '$get_predicate_attribute'(Pred, opaque, 1).
877'$predicate_property'(lazy, Pred) :-
878 '$get_predicate_attribute'(Pred, lazy, 1).
879'$predicate_property'(abstract(N), Pred) :-
880 '$get_predicate_attribute'(Pred, abstract, N).
881'$predicate_property'(size(Bytes), Pred) :-
882 '$get_predicate_attribute'(Pred, size, Bytes).
883'$predicate_property'(primary_index(Arg), Pred) :-
884 '$get_predicate_attribute'(Pred, primary_index, Arg).
885
886system_undefined(user:prolog_trace_interception/4).
887system_undefined(prolog:prolog_exception_hook/5).
888system_undefined(system:'$c_call_prolog'/0).
889system_undefined(system:window_title/2).
890
891table_flag(variant, Pred) :-
892 '$tbl_implementation'(Pred, M:Head),
893 M:'$tabled'(Head, variant).
894table_flag(subsumptive, Pred) :-
895 '$tbl_implementation'(Pred, M:Head),
896 M:'$tabled'(Head, subsumptive).
897table_flag(shared, Pred) :-
898 '$get_predicate_attribute'(Pred, tshared, 1).
899table_flag(incremental, Pred) :-
900 '$get_predicate_attribute'(Pred, incremental, 1).
901table_flag(monotonic, Pred) :-
902 '$get_predicate_attribute'(Pred, monotonic, 1).
903table_flag(subgoal_abstract(N), Pred) :-
904 '$get_predicate_attribute'(Pred, subgoal_abstract, N).
905table_flag(answer_abstract(N), Pred) :-
906 '$get_predicate_attribute'(Pred, subgoal_abstract, N).
907table_flag(subgoal_abstract(N), Pred) :-
908 '$get_predicate_attribute'(Pred, max_answers, N).
909
910
916
917visible_predicate(Pred) :-
918 Pred = M:Head,
919 current_module(M),
920 ( callable(Head)
921 -> ( '$get_predicate_attribute'(Pred, defined, 1)
922 -> true
923 ; \+ current_prolog_flag(M:unknown, fail),
924 '$head_name_arity'(Head, Name, Arity),
925 '$find_library'(M, Name, Arity, _LoadModule, _Library)
926 )
927 ; setof(PI, visible_in_module(M, PI), PIs),
928 '$member'(Name/Arity, PIs),
929 functor(Head, Name, Arity)
930 ).
931
932visible_in_module(M, Name/Arity) :-
933 default_module(M, DefM),
934 DefHead = DefM:Head,
935 '$c_current_predicate'(_, DefHead),
936 '$get_predicate_attribute'(DefHead, defined, 1),
937 \+ hidden_system_predicate(Head),
938 functor(Head, Name, Arity).
939visible_in_module(_, Name/Arity) :-
940 '$in_library'(Name, Arity, _).
941
942hidden_system_predicate(Head) :-
943 functor(Head, Name, _),
944 atom(Name), 945 sub_atom(Name, 0, _, _, $),
946 \+ current_prolog_flag(access_level, system).
947
948
970
971clause_property(Clause, Property) :-
972 '$clause_property'(Property, Clause).
973
974'$clause_property'(line_count(LineNumber), Clause) :-
975 '$get_clause_attribute'(Clause, line_count, LineNumber).
976'$clause_property'(file(File), Clause) :-
977 '$get_clause_attribute'(Clause, file, File).
978'$clause_property'(source(File), Clause) :-
979 '$get_clause_attribute'(Clause, owner, File).
980'$clause_property'(size(Bytes), Clause) :-
981 '$get_clause_attribute'(Clause, size, Bytes).
982'$clause_property'(fact, Clause) :-
983 '$get_clause_attribute'(Clause, fact, true).
984'$clause_property'(erased, Clause) :-
985 '$get_clause_attribute'(Clause, erased, true).
986'$clause_property'(predicate(PI), Clause) :-
987 '$get_clause_attribute'(Clause, predicate_indicator, PI).
988'$clause_property'(module(M), Clause) :-
989 '$get_clause_attribute'(Clause, module, M).
990
1002
1003dynamic(M:Predicates, Options) :-
1004 '$must_be'(list, Predicates),
1005 options_properties(Options, Props),
1006 set_pprops(Predicates, M, [dynamic|Props]).
1007
1008set_pprops([], _, _).
1009set_pprops([H|T], M, Props) :-
1010 set_pprops1(Props, M:H),
1011 strip_module(M:H, M2, P),
1012 '$pi_head'(M2:P, Pred),
1013 '$set_table_wrappers'(Pred),
1014 set_pprops(T, M, Props).
1015
1016set_pprops1([], _).
1017set_pprops1([H|T], P) :-
1018 ( atom(H)
1019 -> '$set_predicate_attribute'(P, H, true)
1020 ; H =.. [Name,Value]
1021 -> '$set_predicate_attribute'(P, Name, Value)
1022 ),
1023 set_pprops1(T, P).
1024
1025options_properties(Options, Props) :-
1026 G = opt_prop(_,_,_,_),
1027 findall(G, G, Spec),
1028 options_properties(Spec, Options, Props).
1029
1030options_properties([], _, []).
1031options_properties([opt_prop(Name, Type, SetValue, Prop)|T],
1032 Options, [Prop|PT]) :-
1033 Opt =.. [Name,V],
1034 '$option'(Opt, Options),
1035 '$must_be'(Type, V),
1036 V = SetValue,
1037 !,
1038 options_properties(T, Options, PT).
1039options_properties([_|T], Options, PT) :-
1040 options_properties(T, Options, PT).
1041
1042opt_prop(incremental, boolean, Bool, incremental(Bool)).
1043opt_prop(abstract, between(0,0), 0, abstract).
1044opt_prop(multifile, boolean, true, multifile).
1045opt_prop(discontiguous, boolean, true, discontiguous).
1046opt_prop(volatile, boolean, true, volatile).
1047opt_prop(thread, oneof(atom, [local,shared],[local,shared]),
1048 local, thread_local).
1049
1050 1053
1057
1058current_module(Module) :-
1059 '$current_module'(Module, _).
1060
1074
1075module_property(Module, Property) :-
1076 nonvar(Module), nonvar(Property),
1077 !,
1078 property_module(Property, Module).
1079module_property(Module, Property) :- 1080 nonvar(Property), Property = file(File),
1081 !,
1082 ( nonvar(File)
1083 -> '$current_module'(Modules, File),
1084 ( atom(Modules)
1085 -> Module = Modules
1086 ; '$member'(Module, Modules)
1087 )
1088 ; '$current_module'(Module, File),
1089 File \== []
1090 ).
1091module_property(Module, Property) :-
1092 current_module(Module),
1093 property_module(Property, Module).
1094
1095property_module(Property, Module) :-
1096 module_property(Property),
1097 ( Property = exported_operators(List)
1098 -> '$exported_ops'(Module, List, [])
1099 ; '$module_property'(Module, Property)
1100 ).
1101
1102module_property(class(_)).
1103module_property(file(_)).
1104module_property(line_count(_)).
1105module_property(exports(_)).
1106module_property(exported_operators(_)).
1107module_property(size(_)).
1108module_property(program_size(_)).
1109module_property(program_space(_)).
1110module_property(last_modified_generation(_)).
1111
1115
1116module(Module) :-
1117 atom(Module),
1118 current_module(Module),
1119 !,
1120 '$set_typein_module'(Module).
1121module(Module) :-
1122 '$set_typein_module'(Module),
1123 print_message(warning, no_current_module(Module)).
1124
1129
1130working_directory(Old, New) :-
1131 '$cwd'(Old),
1132 ( Old == New
1133 -> true
1134 ; '$chdir'(New)
1135 ).
1136
1137
1138 1141
1145
1146current_trie(Trie) :-
1147 current_blob(Trie, trie),
1148 is_trie(Trie).
1149
1183
1184trie_property(Trie, Property) :-
1185 current_trie(Trie),
1186 trie_property(Property),
1187 '$trie_property'(Trie, Property).
1188
1189trie_property(node_count(_)).
1190trie_property(value_count(_)).
1191trie_property(size(_)).
1192trie_property(hashed(_)).
1193trie_property(compiled_size(_)).
1194 1195trie_property(lookup_count(_)). 1196trie_property(gen_call_count(_)).
1197trie_property(invalidated(_)). 1198trie_property(reevaluated(_)).
1199trie_property(deadlock(_)). 1200trie_property(wait(_)).
1201trie_property(idg_affected_count(_)).
1202trie_property(idg_dependent_count(_)).
1203trie_property(idg_size(_)).
1204
1205
1206 1209
1210shell(Command) :-
1211 shell(Command, 0).
1212
1213
1214 1217
1218:- meta_predicate
1219 on_signal(+, :, :),
1220 current_signal(?, ?, :). 1221
1223
1224on_signal(Signal, Old, New) :-
1225 atom(Signal),
1226 !,
1227 '$on_signal'(_Num, Signal, Old, New).
1228on_signal(Signal, Old, New) :-
1229 integer(Signal),
1230 !,
1231 '$on_signal'(Signal, _Name, Old, New).
1232on_signal(Signal, _Old, _New) :-
1233 '$type_error'(signal_name, Signal).
1234
1236
1237current_signal(Name, Id, Handler) :-
1238 between(1, 32, Id),
1239 '$on_signal'(Id, Name, Handler, Handler).
1240
1241:- multifile
1242 prolog:called_by/2. 1243
1244prolog:called_by(on_signal(_,_,New), [New+1]) :-
1245 ( new == throw
1246 ; new == default
1247 ), !, fail.
1248
1249
1250 1253
1254format(Fmt) :-
1255 format(Fmt, []).
1256
1257 1260
1262
1263absolute_file_name(Name, Abs) :-
1264 atomic(Name),
1265 !,
1266 '$absolute_file_name'(Name, Abs).
1267absolute_file_name(Term, Abs) :-
1268 '$chk_file'(Term, [''], [access(read)], true, File),
1269 !,
1270 '$absolute_file_name'(File, Abs).
1271absolute_file_name(Term, Abs) :-
1272 '$chk_file'(Term, [''], [], true, File),
1273 !,
1274 '$absolute_file_name'(File, Abs).
1275
1281
1282tmp_file_stream(Enc, File, Stream) :-
1283 atom(Enc), var(File), var(Stream),
1284 !,
1285 '$tmp_file_stream'('', Enc, File, Stream).
1286tmp_file_stream(File, Stream, Options) :-
1287 current_prolog_flag(encoding, DefEnc),
1288 '$option'(encoding(Enc), Options, DefEnc),
1289 '$option'(extension(Ext), Options, ''),
1290 '$tmp_file_stream'(Ext, Enc, File, Stream),
1291 set_stream(Stream, file_name(File)).
1292
1293
1294 1297
1304
1305garbage_collect :-
1306 '$garbage_collect'(0).
1307
1311
1312set_prolog_stack(Stack, Option) :-
1313 Option =.. [Name,Value0],
1314 Value is Value0,
1315 '$set_prolog_stack'(Stack, Name, _Old, Value).
1316
1320
1321prolog_stack_property(Stack, Property) :-
1322 stack_property(P),
1323 stack_name(Stack),
1324 Property =.. [P,Value],
1325 '$set_prolog_stack'(Stack, P, Value, Value).
1326
1327stack_name(local).
1328stack_name(global).
1329stack_name(trail).
1330
1331stack_property(limit).
1332stack_property(spare).
1333stack_property(min_free).
1334stack_property(low).
1335stack_property(factor).
1336
1337
1338 1341
1347
1348rule(Head, Rule) :-
1349 '$rule'(Head, Rule0),
1350 conditional_rule(Rule0, Rule1),
1351 Rule = Rule1.
1352rule(Head, Rule, Ref) :-
1353 '$rule'(Head, Rule0, Ref),
1354 conditional_rule(Rule0, Rule1),
1355 Rule = Rule1.
1356
1357conditional_rule(?=>(Head, (!, Body)), Rule) =>
1358 Rule = (Head => Body).
1359conditional_rule(?=>(Head, !), Rule) =>
1360 Rule = (Head => true).
1361conditional_rule(?=>(Head, Body0), Rule),
1362 split_on_cut(Body0, Cond, Body) =>
1363 Rule = (Head,Cond=>Body).
1364conditional_rule(Head, Rule) =>
1365 Rule = Head.
1366
1367split_on_cut((Cond0,!,Body0), Cond, Body) =>
1368 Cond = Cond0,
1369 Body = Body0.
1370split_on_cut((!,Body0), Cond, Body) =>
1371 Cond = true,
1372 Body = Body0.
1373split_on_cut((A,B), Cond, Body) =>
1374 Cond = (A,Cond1),
1375 split_on_cut(B, Cond1, Body).
1376split_on_cut(_, _, _) =>
1377 fail.
1378
1379
1380 1383
1384:- '$iso'((numbervars/3)). 1385
1391
1392numbervars(Term, From, To) :-
1393 numbervars(Term, From, To, []).
1394
1395
1396 1399
1403
1404term_string(Term, String, Options) :-
1405 nonvar(String),
1406 !,
1407 read_term_from_atom(String, Term, Options).
1408term_string(Term, String, Options) :-
1409 ( '$option'(quoted(_), Options)
1410 -> Options1 = Options
1411 ; '$merge_options'(_{quoted:true}, Options, Options1)
1412 ),
1413 format(string(String), '~W', [Term, Options1]).
1414
1415
1416 1419
1420:- meta_predicate
1421 thread_create(0, -). 1422
1426
1427thread_create(Goal, Id) :-
1428 thread_create(Goal, Id, []).
1429
1436
1437thread_join(Id) :-
1438 thread_join(Id, Status),
1439 ( Status == true
1440 -> true
1441 ; throw(error(thread_error(Id, Status), _))
1442 ).
1443
1447
1451
1452sig_block(Pattern) :-
1453 ( nb_current('$sig_blocked', List)
1454 -> true
1455 ; List = []
1456 ),
1457 nb_setval('$sig_blocked', [Pattern|List]).
1458
1459sig_unblock(Pattern) :-
1460 ( nb_current('$sig_blocked', List)
1461 -> unblock(List, Pattern, NewList),
1462 ( List == NewList
1463 -> true
1464 ; nb_setval('$sig_blocked', NewList),
1465 '$sig_unblock'
1466 )
1467 ; true
1468 ).
1469
1470unblock([], _, []).
1471unblock([H|T], P, List) :-
1472 ( subsumes_term(P, H)
1473 -> unblock(T, P, List)
1474 ; List = [H|T1],
1475 unblock(T, P, T1)
1476 ).
1477
1478:- public signal_is_blocked/1. 1479
1480signal_is_blocked(Head) :-
1481 nb_current('$sig_blocked', List),
1482 memberchk(Head, List).
1483
1498
1499set_prolog_gc_thread(Status) :-
1500 var(Status),
1501 !,
1502 '$instantiation_error'(Status).
1503set_prolog_gc_thread(_) :-
1504 \+ current_prolog_flag(threads, true),
1505 !.
1506set_prolog_gc_thread(false) :-
1507 !,
1508 set_prolog_flag(gc_thread, false),
1509 ( current_prolog_flag(threads, true)
1510 -> ( '$gc_stop'
1511 -> thread_join(gc)
1512 ; true
1513 )
1514 ; true
1515 ).
1516set_prolog_gc_thread(true) :-
1517 !,
1518 set_prolog_flag(gc_thread, true).
1519set_prolog_gc_thread(stop) :-
1520 !,
1521 ( current_prolog_flag(threads, true)
1522 -> ( '$gc_stop'
1523 -> thread_join(gc)
1524 ; true
1525 )
1526 ; true
1527 ).
1528set_prolog_gc_thread(Status) :-
1529 '$domain_error'(gc_thread, Status).
1530
1537
1538transaction(Goal) :-
1539 '$transaction'(Goal, []).
1540transaction(Goal, Options) :-
1541 '$transaction'(Goal, Options).
1542transaction(Goal, Constraint, Mutex) :-
1543 '$transaction'(Goal, Constraint, Mutex).
1544snapshot(Goal) :-
1545 '$snapshot'(Goal).
1546
1547
1548 1551
1552:- meta_predicate
1553 undo(0). 1554
1559
1560undo(Goal) :-
1561 '$undo'(Goal).
1562
1563:- public
1564 '$run_undo'/1. 1565
1566'$run_undo'([One]) :-
1567 !,
1568 ( call(One)
1569 -> true
1570 ; true
1571 ).
1572'$run_undo'(List) :-
1573 run_undo(List, _, Error),
1574 ( var(Error)
1575 -> true
1576 ; throw(Error)
1577 ).
1578
1579run_undo([], E, E).
1580run_undo([H|T], E0, E) :-
1581 ( catch(H, E1, true)
1582 -> ( var(E1)
1583 -> true
1584 ; '$urgent_exception'(E0, E1, E2)
1585 )
1586 ; true
1587 ),
1588 run_undo(T, E2, E).
1589
1590
1595
1596:- meta_predicate
1597 '$wrap_predicate'(:, +, -, -, +). 1598
1599'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
1600 callable_name_arguments(Head, PName, Args),
1601 callable_name_arity(Head, PName, Arity),
1602 ( is_most_general_term(Head)
1603 -> true
1604 ; '$domain_error'(most_general_term, Head)
1605 ),
1606 atomic_list_concat(['$wrap$', PName], WrapName),
1607 PI = M:WrapName/Arity,
1608 dynamic(PI),
1609 '$notransact'(PI),
1610 volatile(PI),
1611 module_transparent(PI),
1612 WHead =.. [WrapName|Args],
1613 '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
1614
1615callable_name_arguments(Head, PName, Args) :-
1616 atom(Head),
1617 !,
1618 PName = Head,
1619 Args = [].
1620callable_name_arguments(Head, PName, Args) :-
1621 compound_name_arguments(Head, PName, Args).
1622
1623callable_name_arity(Head, PName, Arity) :-
1624 atom(Head),
1625 !,
1626 PName = Head,
1627 Arity = 0.
1628callable_name_arity(Head, PName, Arity) :-
1629 compound_name_arity(Head, PName, Arity)