kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/dialect/xsb/standard.pl

@@ -0,0 +1,169 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2019, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(standard,
+          [ error_write/1,              % @Message
+            error_writeln/1,            % @Message
+            console_write/1,            % @Message
+            console_writeln/1,          % @Message
+            warning/1,                  % @Message
+            message/1,                  % @Message
+            messageln/1                 % @Message
+          ]).
+:- if(exists_source(library(dialect/xsb/timed_call))).
+:- use_module(library(dialect/xsb/timed_call)).
+:- export(timed_call/2).
+:- endif.
+
+/** <module> XSB Term Writing to Designated I/O Streams
+
+This module emulates the XSB dedicated  term writing predicates from the
+`standard` module.
+
+@compat XSB has a number of additional streams which we do not have. For
+now we send all messages to   `user_error`. Onlt warning/1 is redirected
+through SWI-Prolog's print_message/2 interface.
+*/
+
+:- create_prolog_flag(warning_action, print_warning, [keep(true)]).
+
+%!  error_write(@Term) is det.
+%!  error_writeln(@Term) is det.
+%
+%   As write/1 and writeln/1 to `user_error`.
+
+error_write(Term) :-
+    write(user_error, Term).
+error_writeln(Term) :-
+    writeln(user_error, Term).
+
+%!  console_write(@Term) is det.
+%!  console_writeln(@Term) is det.
+%
+%   As write/1 and writeln/1 to `user_error`.  The XSB version writes to
+%   ``STDFDBK``.  What does that mean?
+
+console_write(Term) :-
+    write(user_error, Term).
+console_writeln(Term) :-
+    writeln(user_error, Term).
+
+%!  warning(@Message) is det.
+%
+%   Print a warning. The behaviour depends on the flag `warning_action`,
+%   which can be one of:
+%
+%     - print_warning
+%       Re-direct the message to SWI-Prolog's print_message
+%     - error_warning
+%       Throw error(xsb_warning(Message), _)
+%     - silent_warning
+%       Ignore the warning.
+%
+%   If Message is a list or   comma-list,  the elements are concatenated
+%   without a space.
+
+warning(Message) :-
+    current_prolog_flag(warning_action, Action),
+    warning(Action, Message).
+
+warning(silent_warning, _) :-
+    !.
+warning(error_warning, Term) :-
+    !,
+    throw(error(xsb_warning(Term), _)).
+warning(_, Term) :-
+    print_message(warning, xsb_warning(Term)).
+
+:- multifile
+    prolog:message//1.
+
+prolog:message(xsb_warning(Term)) -->
+    [ 'XSB:'-[] ],
+    xsb_warning(Term).
+prolog:error_message(xsb_warning(Term)) -->
+    [ 'XSB:'-[] ],
+    xsb_warning(Term).
+
+xsb_warning(List) -->
+    { is_list(List) },
+    !,
+    xsb_warning_list(List).
+xsb_warning(Var) -->
+    { var(Var) },
+    !,
+    [ '~w'-[Var] ].
+xsb_warning((A,B)) -->
+    !,
+    xsb_warning(A),
+    xsb_warning(B).
+xsb_warning(Term) -->
+    [ '~w'-[Term] ].
+
+xsb_warning_list([]) -->
+    [].
+xsb_warning_list([H|T]) -->
+    [ '~w'-[H] ],
+    xsb_warning_list(T).
+
+%!  message(@Message) is det.
+%!  messageln(@Message) is det.
+%
+%   Write message to `user_error`. As warning/1,   Message can be a list
+%   or comma list.
+%
+%   @compat XSB. XSB writes  to  ``STDMSG``.   Possibly  we  should also
+%   redirect this through SWI-Prolog's print_message/2 interface.
+
+message(Message) :-
+    is_list(Message),
+    !,
+    maplist(message_elem, Message).
+message(Var) :-
+    var(Var),
+    !,
+    message_elem(Var).
+message((A,B)) :-
+    !,
+    message(A),
+    message(B).
+message(Term) :-
+    message_elem(Term).
+
+messageln(Term) :-
+    message(Term),
+    nl(user_error).
+
+message_elem(Term) :-
+    write(user_error, Term).

package/lib/swipl/library/dialect/xsb/storage.pl

@@ -0,0 +1,70 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2019, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(storage,
+          [ storage_delete_all/1,
+            storage_insert_fact/3,
+            storage_find_fact/2
+          ]).
+:- use_module(library(nb_set)).
+
+/** <module> Emulate XSB syslib/storage.P
+
+This is a very partial  emulation  of   the  XSB  storage  library using
+SWI-Prolog  non-backtrackable  data   structures.    SWI-Prolog   global
+variables and destructive  operations  are,   like  XSB  storages thread
+local.
+
+@bug A storage is a SWI-Prolog global   variable,  sharing the same name
+space.
+*/
+
+storage_delete_all(Storage) :-
+    (   nb_current(Storage, _Set)
+    ->  nb_delete(Storage)
+    ;   true
+    ).
+
+storage_insert_fact(Storage, Fact, Inserted) :-
+    (   nb_current(Storage, Set)
+    ->  add_nb_set(Fact, Set, Inserted)
+    ;   empty_nb_set(Set0),
+        nb_setval(Storage, Set0),
+        nb_current(Storage, Set1),              % Is a copy
+        add_nb_set(Fact, Set1, Inserted)
+    ).
+
+storage_find_fact(Storage, Fact) :-
+    nb_current(Storage, Set),
+    gen_nb_set(Set, Fact).

package/lib/swipl/library/dialect/xsb/string.pl

@@ -0,0 +1,76 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2019, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(string,
+          [ str_cat/3,
+            concat_atom/2                       % +List, ?Atom
+          ]).
+:- use_module(machine).
+:- use_module(library(error)).
+:- use_module(library(lists)).
+
+%!  concat_atom(+List, ?Atom)
+%
+%   True when the concatination of the   atomic elements in List produce
+%   the atom Atom.  List may contain variables.
+
+concat_atom(List, Atom) :-
+    var(Atom),
+    !,
+    atomic_list_concat(List, Atom).
+concat_atom(List, Atom) :-
+    must_be(list, List),
+    split_atom(List, Atom).
+
+split_atom([], '').
+split_atom([H|T], Atom) :-
+    nonvar(H),
+    !,
+    atom_concat(H, Rest, Atom),
+    split_atom(T, Rest).
+split_atom(List, Atom) :-
+    append(Vars, [H|T], List),
+    atomic(H),
+    !,
+    sub_atom(Atom, Before, _, After, H),
+    sub_atom(Atom, 0, Before, _, BAtom),
+    gen_split(Vars, BAtom),
+    sub_atom(Atom, _, After, 0, AAtom),
+    split_atom(T, AAtom).
+
+gen_split([V], V).
+gen_split([H|T], Atom) :-
+    atom_concat(H, R, Atom),
+    gen_split(T, R).
+

package/lib/swipl/library/dialect/xsb/thread.pl

@@ -0,0 +1,62 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2020, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(xsb_thread,
+          [ par_execute/1,                      % :List
+            n_par_execute/2                     % :Goal, Count
+          ]).
+:- use_module(swi(library/thread)).
+:- use_module(library(apply)).
+
+:- meta_predicate
+    par_execute(:),
+    n_par_execute(0, +).
+
+%!  par_execute(:GoalList)
+%
+%   Execute all elements of GoalList concurrently.
+
+par_execute(M:List) :-
+    length(List, N),
+    concurrent(N, M:List, []).
+
+%!  n_par_execute(:Goal, +N)
+%
+%   Run N copies of Goal concurrently.
+
+n_par_execute(Goal, Count) :-
+    length(GoalList, Count),
+    maplist(=(Goal), GoalList),
+    par_execute(GoalList).
+

package/lib/swipl/library/dialect/xsb/timed_call.pl

@@ -0,0 +1,158 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2019, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(timed_call,
+          [ timed_call/2
+          ]).
+:- use_module(library(time)).
+:- use_module(library(debug)).
+:- use_module(library(error)).
+
+/** <module> XSB timed call
+
+This module emulates  the  XSB  built-in   timed_call/2.  As  this  is a
+built-in, this module is re-exported   from library(dialect/xsb). It has
+been placed in a separete module to   facilitate  reuse and allow to not
+load this if the prerequisites   (library(time) and multi-threading) are
+not satisfied.
+*/
+
+%!  timed_call(:Goal, :Options)
+%
+%   Emulation for XSB timed_call/2.  Runs  Goal   as  once/1  with timed
+%   interrupts. The interrupt goals are called   as interrupts using the
+%   semantics of ignore/1: possible choice points are cut and failure is
+%   ignored.  If the interrupt throws an exception this is propagated.
+%
+%   Options is a list of the terms  below.   At  least  one of the terms
+%   max/2 or repeating/2 must be present.
+%
+%      - max(+MaxInterval, :MaxHandler)
+%        Schedule a single interrupt calling MaxHandler at MaxInterval
+%        __milliseconds__ from now.
+%      - repeating(+RepInterval, :RepHandler)
+%        Schedule a repeating interrupt calling RepHandler each
+%        RepInterval __milliseconds__.
+%      - nesting
+%        Nested calls to timed_call/2 are transformed into calls to
+%        once/1.  Without `nesting`, a nested call raises a
+%        `permission_error` exception.
+%
+%   @see call_with_time_limit/2, alarm/4, thread_signal/2.
+%
+%   @compat  This  predicate  is  a  generalization  of  the  SWI-Prolog
+%   library(time) interface. It is left in  the XSB emulation because it
+%   uses non-standard option syntax and the  time is in __milliseconds__
+%   where all SWI-Prolog time handling uses seconds.
+
+:- meta_predicate
+    timed_call(0, :).
+
+timed_call(Goal, _Options) :-
+    ok_nested(Goal),
+    !,
+    debug(timed_call, 'Calling nested ~p', [Goal]),
+    once(Goal).
+timed_call(Goal, Options) :-
+    '$timed_call_nested'(Goal, Options),
+    no_lco.
+
+no_lco.
+
+ok_nested(Goal) :-
+    prolog_current_frame(Fr),
+    prolog_frame_attribute(Fr, parent, Fr2),
+    prolog_frame_attribute(Fr2, parent, Parent),
+    prolog_frame_attribute(Parent, parent_goal,
+                           timed_call:timed_call(_,_:Options)),
+    !,
+    debug(timed_call, 'Nested ~p: found parent timed call with options ~p',
+          [Goal, Options]),
+    (   memberchk(nesting, Options)
+    ->  true
+    ;   permission_error(nest, timed_goal, Goal)
+    ).
+
+
+'$timed_call_nested'(Goal, M:Options) :-
+    memberchk(max(MaxInterval, MaxHandler), Options),
+    !,
+    run_max_goal(Goal, MaxInterval, MaxHandler, M:Options).
+'$timed_call_nested'(Goal, M:Options) :-
+    memberchk(repeating(RepInterval, RepHandler), Options),
+    !,
+    run_repeating_goal(Goal, RepInterval, RepHandler, M:Options).
+'$timed_call_nested'(_Goal, _M:Options) :-
+    domain_error(timed_call_options, Options).
+
+run_max_goal(Goal, MaxInterval, MaxHandler, M:Options) :-
+    (   MaxInterval > 0
+    ->  Time is MaxInterval/1000,
+        setup_call_cleanup(alarm(Time, ignore(M:MaxHandler),
+                                 Id, [install(false)]),
+                           run_opt_releating(Id, Goal, M:Options),
+                           time:remove_alarm_notrace(Id))
+    ;   call(M:MaxHandler)
+    ).
+
+run_opt_releating(AlarmID, Goal, M:Options) :-
+    memberchk(repeating(RepInterval, RepHandler), Options),
+    !,
+    install_alarm(AlarmID),
+    run_repeating_goal(Goal, RepInterval, RepHandler, M:Options).
+run_opt_releating(AlarmID, Goal, _Options) :-
+    install_alarm(AlarmID),
+    call(Goal),
+    !.
+
+run_repeating_goal(Goal, RepInterval, RepHandler, M:_Options) :-
+    (   RepInterval > 0
+    ->  Time is RepInterval/1000,
+        setup_call_cleanup(alarm(Time, repeat_handler(Id, Time, M:RepHandler),
+                                 Id, [install(false)]),
+                           run_alarm_goal(Id, Goal),
+                           time:remove_alarm_notrace(Id))
+    ;   domain_error(repeating_interval, RepInterval)
+    ).
+
+
+repeat_handler(Id, Time, M:RepHandler) :-
+    ignore(M:RepHandler),
+    uninstall_alarm(Id),
+    install_alarm(Id, Time).
+
+run_alarm_goal(AlarmID, Goal) :-
+    install_alarm(AlarmID),
+    call(Goal),
+    !.