1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2019, VU University Amsterdam
    7			 CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(xsb,
   37          [ add_lib_dir/1,			% +Directories
   38	    add_lib_dir/2,			% +Root, +Directories
   39
   40            compile/2,                          % +File, +Options
   41            load_dyn/1,                         % +File
   42            load_dyn/2,                         % +File, +Direction
   43            load_dync/1,                        % +File
   44            load_dync/2,                        % +File, +Direction
   45
   46            set_global_compiler_options/1,	% +Options
   47            compiler_options/1,			% +Options
   48
   49            xsb_import/2,                       % +Preds, From
   50            xsb_set_prolog_flag/2,              % +Flag, +Value
   51
   52            fail_if/1,				% :Goal
   53
   54            sk_not/1,				% :Goal
   55            gc_tables/1,                        % -Remaining
   56
   57            cputime/1,				% -Seconds
   58            walltime/1,				% -Seconds
   59
   60            (thread_shared)/1,                  % :Spec
   61
   62            debug_ctl/2,                        % +Option, +Value
   63
   64            fmt_write/2,                        % +Fmt, +Term
   65            fmt_write/3,                        % +Stream, +Fmt, +Term
   66
   67            path_sysop/2,                       % +Op, ?Value
   68            path_sysop/3,                       % +Op, ?Value1, ?Value2
   69
   70            abort/1,				% +Message
   71
   72            op(1050,  fy, import),
   73            op(1050,  fx, export),
   74            op(1040, xfx, from),
   75            op(1100,  fy, index),               % ignored
   76            op(1100,  fy, ti),                  % transformational indexing?
   77            op(1100,  fx, mode),                % ignored
   78            op(1045, xfx, as),
   79            op(900,   fy, tnot),
   80            op(900,   fy, not),                 % defined as op in XSB
   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.

  102:- meta_predicate
  103    xsb_import(:, +),                   % Module interaction
  104
  105    compile(:, +),                      % Loading files
  106    load_dyn(:),
  107    load_dyn(:, +),
  108    load_dync(:),
  109    load_dync(:, +),
  110
  111    thread_shared(:),
  112
  113    fail_if(0),                         % Meta predicates
  114    sk_not(0).  115
  116
  117
  118		 /*******************************
  119		 *	    LIBRARY SETUP	*
  120		 *******************************/

 push_xsb_library

Pushes searching for dialect/xsb in front of every library directory that contains such as sub-directory.

  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.

 setup_dialect

Further dialect initialization. Called from expects_dialect/1.

  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
  158% Register XSB specific term-expansion to rename conflicting directives.
  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, _, _)), []).  % what is tbis?
  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)).

 xsb_import(:Predicates, +From)

Make Predicates visible in From. As the XSB library structructure is rather different from SWI-Prolog's, this is a heuristic process.

  199:- dynamic
  200    mapped__module/2.                           % XSB name -> Our name
  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).

 import_from_module(?Clean, +PI, +Into, +From) is semidet

Try to import PI into module Into from Module From. The clean version only deals with cleanly exported predicates. The dirty version is more aggressive.

  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)).

 xsb_set_prolog_flag(+Flag, +Value)

Map some XSB Prolog flags to their SWI-Prolog's equivalents.

  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		 /*******************************
  339		 *      BUILT-IN PREDICATES	*
  340		 *******************************/

 compile(File, Options)

The XSB version compiles a file into .xwam without loading it. We do not have that. Calling qcompile/1 seems the best start.

  347compile(File, _Options) :-
  348    qcompile(File).

 load_dyn(+FileName) is det

 load_dyn(+FileName, +Direction) is det

 load_dync(+FileName) is det

 load_dync(+FileName, +Direction) is det

Proper implementation requires the Quintus all_dynamic option. SWI-Prolog never had that as clause/2 is allowed on static code, which is the main reason to want this.

The dync versions demand source in canonical format. In SWI-Prolog there is little reason to demand this.

  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).

 set_global_compiler_options(+List) is det

Set the XSB global compiler options.

  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).

 compiler_options(+Options) is det

Locally switch the compiler options

  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		 /*******************************
  446		 *            BUILT-INS		*
  447		 *******************************/

 fail_if(:P)

Same as \+ (support XSB legacy code). As the XSB manual claims this is optimized we normally do goal expansion to \+/1.

  454fail_if(P) :-
  455    \+ P.
  456
  457		 /*******************************
  458		 *      TABLING BUILT-INS	*
  459		 *******************************/

 sk_not(:P) is semidet

Sound negation with non-ground P. Equivalent to not_exists/1.

deprecated

- New code should use not_exists/1.

  467sk_not(P) :-
  468    not_exists(P).

 gc_tables(-Remaining) is det

The table abolish predicates leave the actual destruction of the tables to the atom garbage collector to avoid deleting active tables. This predicate runs garbage_collect_atoms/0 and counts the remaining erased tables.

Compatibility

- Due to the heuristic nature of garbage_collect_atoms/0, not all tables may be reclaimed immediately.

  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).

 cputime(-Seconds) is det

True when Seconds is the used CPU time.

  493cputime(Seconds) :-
  494    statistics(cputime, Seconds).

 walltime(-Seconds) is det

True when Seconds is the wall time sice Prolog was started

  500walltime(Seconds) :-
  501    get_time(Now),
  502    statistics(epoch, Epoch),
  503    Seconds is Now - Epoch.

 debug_ctl(+Option, +Value) is det

Control the XSB debugger. The current implementation merely defines the predicate. Much more can be mapped to SWI-Prolog primitives.

  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) ]).

 thread_shared(+Spec)

Declare a dynamic predicate as shared. This is the default for SWI-Prolog.

  528thread_shared(Spec) :-
  529    dynamic(Spec).

 fmt_write(+Fmt, +Term) is det

 fmt_write(+Stream, +Fmt, +Term) is det

C-style formatted write, where the arguments are formed by the arguments of Term. We map this to format/2,3.

bug

- We need to complete the translation of the fmt_write sequences to format/2,3 sequences.

  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).

 path_sysop(+Op, ?Value) is semidet

 path_sysop(+Op, ?Arg1, ?Arg2) is semidet

Unified interface to the operations on files. All these calls succeed iff the corresponding system call succeeds.

Compatibility

- The below implementation covers all operations from XSB 3.8. SWI file name operations are always on POSIX style file names. The implementation may have semantic differences.

  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).

 abort(+Message:atomic)

Abort with a message

  672abort(Message) :-
  673    print_message(error, aborted(Message)),
  674    abort.
  675
  676		 /*******************************
  677		 *           MESSAGES		*
  678		 *******************************/
  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] ]