35
36:- module(xsb,
37 [ add_lib_dir/1, 38 add_lib_dir/2, 39
40 compile/2, 41 load_dyn/1, 42 load_dyn/2, 43 load_dync/1, 44 load_dync/2, 45
46 set_global_compiler_options/1, 47 compiler_options/1, 48
49 xsb_import/2, 50 xsb_set_prolog_flag/2, 51
52 fail_if/1, 53
54 sk_not/1, 55 gc_tables/1, 56
57 cputime/1, 58 walltime/1, 59
60 (thread_shared)/1, 61
62 debug_ctl/2, 63
64 fmt_write/2, 65 fmt_write/3, 66
67 path_sysop/2, 68 path_sysop/3, 69
70 abort/1, 71
72 op(1050, fy, import),
73 op(1050, fx, export),
74 op(1040, xfx, from),
75 op(1100, fy, index), 76 op(1100, fy, ti), 77 op(1100, fx, mode), 78 op(1045, xfx, as),
79 op(900, fy, tnot),
80 op(900, fy, not), 81 op(1100, fx, thread_shared)
82 ]). 83:- use_module(library(error)). 84:- use_module(library(debug)). 85:- use_module(library(dialect/xsb/source)). 86:- use_module(library(dialect/xsb/consult)). 87:- use_module(library(tables)). 88:- use_module(library(aggregate)). 89:- use_module(library(option)). 90:- use_module(library(apply)). 91:- if(exists_source(library(dialect/xsb/timed_call))). 92:- use_module(library(dialect/xsb/timed_call)). 93:- export(timed_call/2). 94:- endif. 95
101
102:- meta_predicate
103 xsb_import(:, +), 104
105 compile(:, +), 106 load_dyn(:),
107 load_dyn(:, +),
108 load_dync(:),
109 load_dync(:, +),
110
111 thread_shared(:),
112
113 fail_if(0), 114 sk_not(0). 115
116
117
118 121
126
127push_xsb_library :-
128 ( absolute_file_name(library(dialect/xsb), Dir,
129 [ file_type(directory),
130 access(read),
131 solutions(all),
132 file_errors(fail)
133 ]),
134 asserta((user:file_search_path(library, Dir) :-
135 prolog_load_context(dialect, xsb))),
136 fail
137 ; true
138 ).
139
140:- push_xsb_library. 141
145
146:- public setup_dialect/0. 147
148setup_dialect :-
149 style_check(-discontiguous).
150
151:- multifile
152 user:term_expansion/2,
153 user:goal_expansion/2. 154
155:- dynamic
156 moved_directive/2. 157
159
160user:term_expansion(In, Out) :-
161 prolog_load_context(dialect, xsb),
162 xsb_term_expansion(In, Out).
163
164xsb_term_expansion((:- Directive), []) :-
165 prolog_load_context(file, File),
166 retract(moved_directive(File, Directive)),
167 debug(xsb(header), 'Moved to head: ~p', [Directive]),
168 !.
169xsb_term_expansion((:- import Preds from From),
170 (:- xsb_import(Preds, From))).
171xsb_term_expansion((:- index(_PI, _, _)), []). 172xsb_term_expansion((:- index(_PI, _How)), []).
173xsb_term_expansion((:- index(_PI)), []).
174xsb_term_expansion((:- ti(_PI)), []).
175xsb_term_expansion((:- mode(_Modes)), []).
176
177user:goal_expansion(In, Out) :-
178 prolog_load_context(dialect, xsb),
179 ( xsb_mapped_predicate(In, Out)
180 -> true
181 ; xsb_inlined_goal(In, Out)
182 ).
183
184xsb_mapped_predicate(expand_file_name(File, Expanded),
185 xsb_expand_file_name(File, Expanded)).
186xsb_mapped_predicate(set_prolog_flag(Flag, Value),
187 xsb_set_prolog_flag(Flag, Value)).
188xsb_mapped_predicate(abolish_module_tables(UserMod),
189 abolish_module_tables(user)) :-
190 UserMod == usermod.
191
192xsb_inlined_goal(fail_if(P), \+(P)).
193
198
199:- dynamic
200 mapped__module/2. 201
202xsb_import(Into:Preds, From) :-
203 mapped__module(From, Mapped),
204 !,
205 xsb_import(Preds, Into, Mapped).
206xsb_import(Into:Preds, From) :-
207 xsb_import(Preds, Into, From).
208
209xsb_import(Var, _Into, _From) :-
210 var(Var),
211 !,
212 instantiation_error(Var).
213xsb_import((A,B), Into, From) :-
214 !,
215 xsb_import(A, Into, From),
216 xsb_import(B, Into, From).
217xsb_import(Name/Arity, Into, From) :-
218 functor(Head, Name, Arity),
219 xsb_mapped_predicate(Head, NewHead),
220 functor(NewHead, NewName, Arity),
221 !,
222 xsb_import(NewName/Arity, Into, From).
223xsb_import(PI, Into, usermod) :-
224 !,
225 export(user:PI),
226 @(import(user:PI), Into).
227xsb_import(Name/Arity, Into, _From) :-
228 functor(Head, Name, Arity),
229 predicate_property(Into:Head, iso),
230 !,
231 debug(xsb(import), '~p: already visible (ISO)', [Into:Name/Arity]).
232xsb_import(PI, Into, From) :-
233 import_from_module(clean, PI, Into, From),
234 !.
235xsb_import(PI, Into, From) :-
236 prolog_load_context(file, Here),
237 absolute_file_name(From, Path,
238 [ extensions(['P', pl, prolog]),
239 access(read),
240 relative_to(Here),
241 file_errors(fail)
242 ]),
243 !,
244 debug(xsb(import), '~p: importing from ~p', [Into:PI, Path]),
245 load_module(Into:Path, PI).
246xsb_import(PI, Into, From) :-
247 absolute_file_name(library(From), Path,
248 [ extensions(['P', pl, prolog]),
249 access(read),
250 file_errors(fail)
251 ]),
252 !,
253 debug(xsb(import), '~p: importing from ~p', [Into:PI, Path]),
254 load_module(Into:Path, PI).
255xsb_import(Name/Arity, Into, _From) :-
256 functor(Head, Name, Arity),
257 predicate_property(Into:Head, visible),
258 !,
259 debug(xsb(import), '~p: already visible', [Into:Name/Arity]).
260xsb_import(PI, Into, From) :-
261 import_from_module(dirty, PI, Into, From),
262 !.
263xsb_import(_Name/_Arity, _Into, From) :-
264 existence_error(xsb_module, From).
265
271
272import_from_module(clean, PI, Into, From) :-
273 module_property(From, exports(List)),
274 memberchk(PI, List),
275 !,
276 debug(xsb(import), '~p: importing from module ~p', [Into:PI, From]),
277 @(import(From:PI), Into).
278import_from_module(dirty, PI, Into, From) :-
279 current_predicate(From:PI),
280 !,
281 debug(xsb(import), '~p: importing from module ~p', [Into:PI, From]),
282 ( check_exported(From, PI)
283 -> @(import(From:PI), Into)
284 ; true
285 ).
286import_from_module(dirty, PI, _Into, From) :-
287 module_property(From, file(File)),
288 !,
289 print_message(error, xsb(not_in_module(File, From, PI))).
290
291check_exported(Module, PI) :-
292 module_property(Module, exports(List)),
293 memberchk(PI, List),
294 !.
295check_exported(Module, PI) :-
296 module_property(Module, file(File)),
297 print_message(error, xsb(not_in_module(File, Module, PI))).
298
299load_module(Into:Path, PI) :-
300 use_module(Into:Path, []),
301 ( module_property(Module, file(Path))
302 -> file_base_name(Path, File),
303 file_name_extension(Base, _, File),
304 ( Base == Module
305 -> true
306 ; atom_concat(xsb_, Base, Module)
307 -> map_module(Base, Module)
308 ; print_message(warning,
309 xsb(file_loaded_into_mismatched_module(Path, Module))),
310 map_module(Base, Module)
311 )
312 ; print_message(warning, xsb(loaded_unknown_module(Path)))
313 ),
314 import_from_module(_, PI, Into, Module).
315
316map_module(XSB, Module) :-
317 mapped__module(XSB, Module),
318 !.
319map_module(XSB, Module) :-
320 assertz(mapped__module(XSB, Module)).
321
322
326
327xsb_set_prolog_flag(unify_with_occurs_check, XSBVal) :-
328 !,
329 map_bool(XSBVal, Val),
330 set_prolog_flag(occurs_check, Val).
331xsb_set_prolog_flag(Flag, Value) :-
332 set_prolog_flag(Flag, Value).
333
334map_bool(on, true).
335map_bool(off, false).
336
337
338 341
346
347compile(File, _Options) :-
348 qcompile(File).
349
361
362load_dyn(File) :-
363 '$style_check'(Style, Style),
364 setup_call_cleanup(
365 style_check(-singleton),
366 load_files(File),
367 '$style_check'(_, Style)).
368
369load_dyn(File, Dir) :- must_be(oneof([z]), Dir), load_dyn(File).
370load_dync(File) :- load_dyn(File).
371load_dync(File, Dir) :- load_dyn(File, Dir).
372
376
377:- multifile xsb_compiler_option/1. 378:- dynamic xsb_compiler_option/1. 379
380set_global_compiler_options(List) :-
381 must_be(list, List),
382 maplist(set_global_compiler_option, List).
383
384set_global_compiler_option(+Option) :-
385 !,
386 valid_compiler_option(Option),
387 ( xsb_compiler_option(Option)
388 -> true
389 ; assertz(xsb_compiler_option(Option))
390 ).
391set_global_compiler_option(-Option) :-
392 !,
393 valid_compiler_option(Option),
394 retractall(xsb_compiler_option(Option)).
395set_global_compiler_option(-Option) :-
396 valid_compiler_option(Option),
397 ( xsb_compiler_option(Option)
398 -> true
399 ; assertz(xsb_compiler_option(Option))
400 ).
401
402valid_compiler_option(Option) :-
403 must_be(oneof([ singleton_warnings_off,
404 optimize,
405 allow_redefinition,
406 xpp_on,
407 spec_off
408 ]), Option).
409
413
414compiler_options(Options) :-
415 must_be(list, Options),
416 maplist(compiler_option, Options).
417
418compiler_option(+Option) :-
419 !,
420 valid_compiler_option(Option),
421 set_compiler_option(Option).
422compiler_option(-Option) :-
423 !,
424 valid_compiler_option(Option),
425 clear_compiler_option(Option).
426compiler_option(Option) :-
427 valid_compiler_option(Option),
428 set_compiler_option(Option).
429
430set_compiler_option(singleton_warnings_off) :-
431 style_check(-singleton).
432set_compiler_option(optimize) :-
433 set_prolog_flag(optimise, true).
434set_compiler_option(allow_redefinition).
435set_compiler_option(xpp_on).
436set_compiler_option(spec_off).
437
438clear_compiler_option(singleton_warnings_off) :-
439 style_check(+singleton).
440clear_compiler_option(optimize) :-
441 set_prolog_flag(optimise, false).
442clear_compiler_option(allow_redefinition).
443clear_compiler_option(xpp_on).
444
445 448
453
454fail_if(P) :-
455 \+ P.
456
457 460
466
467sk_not(P) :-
468 not_exists(P).
469
479
480gc_tables(Remaining) :-
481 garbage_collect_atoms,
482 aggregate_all(count, remaining_table(_), Remaining).
483
484remaining_table(Trie) :-
485 current_blob(Trie, trie),
486 '$is_answer_trie'(Trie, _Type),
487 '$atom_references'(Trie, 0).
488
492
493cputime(Seconds) :-
494 statistics(cputime, Seconds).
495
499
500walltime(Seconds) :-
501 get_time(Now),
502 statistics(epoch, Epoch),
503 Seconds is Now - Epoch.
504
509
510debug_ctl(prompt, off) :-
511 !,
512 leash(-all).
513debug_ctl(prompt, on) :-
514 !,
515 leash(+full).
516debug_ctl(hide, Preds) :-
517 !,
518 '$hide'(Preds).
519debug_ctl(Option, Value) :-
520 debug(xsb(compat), 'XSB: not implemented: ~p',
521 [ debug_ctl(Option, Value) ]).
522
527
528thread_shared(Spec) :-
529 dynamic(Spec).
530
531
540
541fmt_write(Fmt, Term) :-
542 fmt_write(current_output, Fmt, Term).
543
544fmt_write(Stream, Fmt, Term) :-
545 ( compound(Term)
546 -> Term =.. [_|Args]
547 ; Args = [Term]
548 ),
549 fmt_write_format(Fmt, Format),
550 format(Stream, Format, Args).
551
552:- dynamic
553 fmt_write_cache/2. 554
555fmt_write_format(Fmt, Format) :-
556 fmt_write_cache(Fmt, Format),
557 !.
558fmt_write_format(Fmt, Format) :-
559 string_codes(Fmt, FmtCodes),
560 phrase(format_fmt(Codes, []), FmtCodes),
561 atom_codes(Format, Codes),
562 asserta(fmt_write_cache(Fmt, Format)).
563
564format_fmt(Format, Tail) -->
565 "%",
566 ( format_esc(Format, Tail0)
567 -> !
568 ; here(Rest),
569 { print_message(warning, xsb(fmt_write(ignored(Rest)))),
570 fail
571 }
572 ),
573 format_fmt(Tail0, Tail).
574format_fmt([0'~,0'~|T0], T) -->
575 "~",
576 !,
577 format_fmt(T0, T).
578format_fmt([H|T0], T) -->
579 [H],
580 !,
581 format_fmt(T0, T).
582format_fmt(T, T) --> [].
583
584format_esc(Fmt, Tail) -->
585 format_esc(Fmt0),
586 !,
587 { append(Fmt0, Tail, Fmt)
588 }.
589
590format_esc(`~16r`) --> "x".
591format_esc(`~d`) --> "d".
592format_esc(`~f`) --> "f".
593format_esc(`~s`) --> "s".
594format_esc(`%`) --> "%".
595
596here(Rest, Rest, Rest).
597
607
608path_sysop(isplain, File) :-
609 exists_file(File).
610path_sysop(isdir, Dir) :-
611 exists_directory(Dir).
612path_sysop(rm, File) :-
613 delete_file(File).
614path_sysop(rmdir, Dir) :-
615 delete_directory(Dir).
616path_sysop(rmdir_rec, Dir) :-
617 delete_directory_and_contents(Dir).
618path_sysop(cwd, CWD) :-
619 working_directory(CWD, CWD).
620path_sysop(chdir, CWD) :-
621 working_directory(_, CWD).
622path_sysop(mkdir, Dir) :-
623 make_directory(Dir).
624path_sysop(exists, Entry) :-
625 access_file(Entry, exist).
626path_sysop(readable, Entry) :-
627 access_file(Entry, read).
628path_sysop(writable, Entry) :-
629 access_file(Entry, write).
630path_sysop(executable, Entry) :-
631 access_file(Entry, execute).
632path_sysop(tmpfilename, Name) :-
633 tmp_file(swi, Name).
634path_sysop(isabsolute, Name) :-
635 is_absolute_file_name(Name).
636
637
638path_sysop(rename, Old, New) :-
639 rename_file(Old, New).
640path_sysop(copy, From, To) :-
641 copy_file(From, To).
642path_sysop(link, From, To) :-
643 link_file(From, To, symbolic).
644path_sysop(modtime, Path, Time) :-
645 time_file(Path, Time).
646path_sysop(newerthan, Path1, Path2) :-
647 time_file(Path1, Time1),
648 ( catch(time_file(Path2, Time2), error(existence_error(_,_),_), fail)
649 -> Time1 > Time2
650 ; true
651 ).
652path_sysop(size, Path, Size) :-
653 size_file(Path, Size).
654path_sysop(extension, Path, Ext) :-
655 file_name_extension(_, Ext, Path).
656path_sysop(basename, Path, Base) :-
657 file_base_name(Path, File),
658 file_name_extension(Base, _, File).
659path_sysop(dirname, Path, Dir) :-
660 file_directory_name(Path, Dir0),
661 ( sub_atom(Dir0, _, _, 0, /)
662 -> Dir = Dir0
663 ; atom_concat(Dir0, /, Dir)
664 ).
665path_sysop(expand, Name, Path) :-
666 absolute_file_name(Name, Path).
667
671
672abort(Message) :-
673 print_message(error, aborted(Message)),
674 abort.
675
676 679
680:- multifile
681 prolog:message//1. 682
683prolog:message(xsb(not_in_module(File, Module, PI))) -->
684 [ 'XSB: ~p, implementing ~p does not export ~p'-[File, Module, PI] ].
685prolog:message(xsb(file_loaded_into_mismatched_module(File, Module))) -->
686 [ 'XSB: File ~p defines module ~p'-[File, Module] ].
687prolog:message(xsb(ignored(debug_ctl(Option, Value)))) -->
688 [ 'XSB: debug_ctl(~p,~p) is not implemented'-[Option,Value] ]