kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/make.pl

@@ -0,0 +1,197 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2003-2024, University of Amsterdam
+                              VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions b.v.
+    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(make,
+          [ make/0,
+            make_reload_file/1      % +File
+          ]).
+:- autoload(library(apply),[maplist/2]).
+:- autoload(library(check),[list_undefined/0,list_void_declarations/0]).
+:- use_module(library(debug),[debug/3]).
+:- autoload(library(lists),[list_to_set/2,member/2]).
+:- autoload(library(option),[merge_options/3]).
+
+
+:- set_prolog_flag(generate_debug_info, false).
+
+/** <module>  Reload modified source files
+
+This module provides the SWI-Prolog   `make'  facility that synchronises
+Prolog internal database after loaded files have been edited.
+
+@bug    Dependency tracking is incomplete.  Notably, there is no
+        dependency tracking if compilation of one module depends
+        on goal_expansion/2 or term_expansion/2 rules provided by
+        another.
+*/
+
+:- multifile
+    prolog:make_hook/2.
+
+
+%!  make
+%
+%   Reload all source files that have   been changed since they were
+%   loaded. This predicate peforms the following steps:
+%
+%     1. Compute the set of files that need to be reloaded.
+%     2. Call the hook prolog:make_hook(before, Files)
+%     3. Reload the files
+%     4. Call the hook prolog:make_hook(after, Files)
+%     5. If (4) fails, call list_undefined/0.
+%
+%   The hooks are called  with  an  empty   list  if  no  files need
+%   reloading.
+
+make :-
+    notrace(make_no_trace).
+
+make_no_trace :-
+    '$update_library_index'([]),
+    findall(File, modified_file(File), Reload0),
+    list_to_set(Reload0, Reload),
+    (   prolog:make_hook(before, Reload)
+    ->  true
+    ;   true
+    ),
+    print_message(silent, make(reload(Reload))),
+    maplist(make_reload_file, Reload),
+    print_message(silent, make(done(Reload))),
+    (   prolog:make_hook(after, Reload)
+    ->  true
+    ;   list_undefined,
+        list_void_declarations
+    ).
+
+%!  modified_file(-File) is nondet.
+%
+%   True when File is modified after it has been loaded.
+%
+%   (*) A file is considered modified if   the  modification time of the
+%   file is at least 1ms later that when  it was loaded. The 1ms relaxed
+%   matching is used to compensate for   inconsistent float handling and
+%   possible timing jitter.
+%
+%   @see https://github.com/SWI-Prolog/swipl-devel/issues/303
+
+modified_file(File) :-
+    source_file_property(Source, modified(Time)),
+    \+ source_file_property(Source, included_in(_,_)),
+    Time > 0.0,                     % See source_file/1
+    (   source_file_property(Source, derived_from(File, LoadTime))
+    ->  true
+    ;   File = Source,
+        LoadTime = Time
+    ),
+    (   catch(time_file(File, Modified), _, fail),
+        Modified - LoadTime > 0.001             % (*)
+    ->  true
+    ;   file_includes(Source, Included, IncLoadTime, [Source]),
+        catch(time_file(Included, Modified), _, fail),
+        Modified - IncLoadTime > 0.001          % (*)
+    ->  true
+    ).
+
+file_includes(Source, Included, IncLoadTime, Seen) :-
+    source_file_property(Source, includes(Included0, IncLoadTime0)),
+    \+ memberchk(Included0, Seen),
+    (   Included = Included0,
+        IncLoadTime = IncLoadTime0
+    ;   file_includes(Included0, Included, IncLoadTime, [Included0|Seen])
+    ).
+
+%!  make_reload_file(File)
+%
+%   Reload file into the proper module.
+%
+%   @bug    If modules import each other, we must load them in the
+%           proper order for import/export dependencies.
+
+:- public reload_file/1.                % Used by PDT
+reload_file(File) :- make_reload_file(File).
+
+make_reload_file(File) :-
+    source_base_name(File, Compile),
+    findall(M-Opts,
+            source_file_property(File, load_context(M, _, Opts)),
+            Modules),
+    (   Modules = [First-OptsFirst|Rest]
+    ->  Extra = [ silent(false),
+                  register(false)
+                ],
+        merge_options([if(true)|Extra], OptsFirst, OFirst),
+        debug(make, 'Make: First load ~q', [load_files(First:Compile, OFirst)]),
+        load_files(First:Compile, OFirst),
+        forall(member(Context-Opts, Rest),
+               ( merge_options([if(not_loaded)|Extra], Opts, O),
+                 debug(make, 'Make: re-import: ~q',
+                       [load_files(Context:Compile, O)]),
+                 load_files(Context:Compile, O)
+               ))
+    ;   load_files(user:Compile)
+    ).
+
+source_base_name(File, Compile) :-
+    file_name_extension(Compile, Ext, File),
+    user:prolog_file_type(Ext, prolog),
+    !.
+source_base_name(File, File).
+
+
+%!  prolog:make_hook(+When, +Files) is semidet.
+%
+%   This hook is called by make/0. It   is called with the following
+%   values for When:
+%
+%     - before
+%     The hook is called before reloading starts. The default
+%     action is to do nothing.
+%
+%     - after
+%     The hook is called after reloading completed.  The default
+%     action is to call list_undefined/1 as:
+%
+%       ==
+%       list_undefined([scan(local)]).
+%       ==
+%
+%   The hook can be  used  to   change  program  validation, stop or
+%   restart services, etc.
+%
+%   @arg Files is a list holding the canonical file names of the
+%        files that need to be reloaded.  This list can be empty.
+

package/lib/swipl/library/modules.pl

@@ -0,0 +1,129 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2014-2021, VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    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(modules,
+          [ in_temporary_module/3,              % ?Module, :Setup, :Goal
+            current_temporary_module/1          % ?Module
+          ]).
+
+
+/** <module> Module utility predicates
+*/
+
+:- meta_predicate
+    in_temporary_module(?, 0, 0).
+
+%!  in_temporary_module(?Module, :Setup, :Goal)
+%
+%   Run Goal on temporary loaded sources  and discard the module and
+%   loaded predicates after completion.  This predicate performs the
+%   following steps:
+%
+%     1. If Module is unbound, create a unique identifier for it.
+%     2. Turn Module into a _temporary_ module using set_module/1.
+%        Note that this requires the module to be non-existent or
+%        empty.  If Module is specified, it should typically be set
+%        to a unique value as obtained from e.g. uuid/1.
+%     3. Run Setup in the context of Module.
+%     4. If setup succeeded possible choice points are discarded
+%        and Goal is started.
+%
+%   The  logical  result  of  this   predicate    is   the  same  as
+%   `(Setup@Module -> Goal@Module)`, i.e., both   Setup and Goal are
+%   resolved relative to the current  module,   but  executed in the
+%   context of Module.  If  Goal  must   be  called  in  Module, use
+%   `call(Goal)`.
+%
+%   The module and all  its  predicates   are  destroyed  after Goal
+%   terminates, as defined by setup_call_cleanup/3.
+%
+%   *Discussion* This predicate is intended to   load programs in an
+%   isolated   environment   and   reclaim   all   resources.   This
+%   unfortunately is incomplete:
+%
+%     - Running the code may leave side effects such as creating
+%       records, flags, changing Prolog flags, etc.  The system
+%       has no provisions to track this.
+%     - So called _functors_ (name/arity pairs) are not yet subject
+%       to garbage collection.  Functors are both used to define
+%       predicates and to create compound terms.
+%
+%   @see    library(sandbox) determines whether unknown goals are safe
+%           to call.
+%   @see    load_files/2 offers the option sandboxed(true) to load code
+%           from unknown sources safely.
+
+in_temporary_module(Module, Setup, Goal) :-
+    setup_call_cleanup(
+        prepare_temporary_module(Module),
+        (   @(Setup, Module)
+        ->  @(Goal,  Module)
+        ),
+        destroy_module(Module)).
+
+prepare_temporary_module(Module) :-
+    var(Module),
+    !,
+    (   thread_id(Tid),
+        repeat,
+        I is random(1<<62),
+        atomic_list_concat([tmp, Tid, I], -, Module),
+        catch(set_module(Module:class(temporary)),
+              error(permission_error(_,_,_),_), fail)
+    ->  b_setval('$tmp_module', Module)
+    ).
+prepare_temporary_module(Module) :-
+    set_module(Module:class(temporary)),
+    b_setval('$tmp_module', Module).
+
+:- if(current_prolog_flag(threads, true)).
+thread_id(Id) :-
+    thread_self(Self),
+    thread_property(Self, id(Id)).
+:- else.
+thread_id(main).
+:- endif.
+
+destroy_module(Module) :-
+    retractall(system:'$load_context_module'(_File, Module, _Options)),
+    '$destroy_module'(Module).
+
+%!  current_temporary_module(-Module) is semidet.
+%
+%   True when we are executing in the given temporary module context.
+
+current_temporary_module(Module) :-
+    nb_current('$tmp_module', Module).
+

package/lib/swipl/library/nb_rbtrees.pl

@@ -0,0 +1,267 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2007-2014, University of 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(nb_rbtrees,
+          [ nb_rb_insert/3,             % !T0, +Key, +Value
+            nb_rb_get_node/3,           % +Tree, +Key, -Node
+            nb_rb_node_value/2,         % +Node, -Value
+            nb_rb_set_node_value/2      % +Node, +Value
+          ]).
+
+/** <module> Non-backtrackable operations on red black trees
+
+This library is  an  extension   to  rbtrees.pl,  implementing Red-black
+trees. This library adds  non-backtrackable   destructive  update  to RB
+trees which allows us to fill RB trees in a failure driven loop.
+
+This module builds on top of the   rbtrees.pl  and used code copied from
+library written by Vitor Santos Costa.
+
+@author Jan Wielemaker
+*/
+
+                 /*******************************
+                 *       TREE INSERTION         *
+                 *******************************/
+
+%!  nb_rb_insert(!RBTree, +Key, +Value)
+%
+%   Add  Key-Value  to  the  tree   RBTree  using  non-backtrackable
+%   destructive assignment.
+
+nb_rb_insert(Tree, Key0, Val0) :-
+    duplicate_term(Key0, Key),
+    duplicate_term(Val0, Val),
+    Tree = t(Nil, T),
+    insert(T, Key, Val, Nil, NT, Flag),
+    (   Flag == shared
+    ->  true
+    ;   nb_linkarg(2, Tree, NT)
+    ).
+
+insert(Tree0,Key,Val,Nil,Tree, Flag) :-
+    insert2(Tree0,Key,Val,Nil,TreeI,Flag),
+    (   Flag == shared
+    ->  Tree = Tree0
+    ;   fix_root(TreeI,Tree)
+    ).
+
+%
+% make sure the root is always black.
+%
+fix_root(black(L,K,V,R),black(L,K,V,R)).
+fix_root(red(L,K,V,R),black(L,K,V,R)).
+
+
+%
+% Cormen et al present the algorithm as
+% (1) standard tree insertion;
+% (2) from the viewpoint of the newly inserted node:
+%     partially fix the tree;
+%     move upwards
+% until reaching the root.
+%
+% We do it a little bit different:
+%
+% (1) standard tree insertion;
+% (2) move upwards:
+%      when reaching a black node;
+%        if the tree below may be broken, fix it.
+% We take advantage of Prolog unification
+% to do several operations in a single go.
+%
+
+
+
+%
+% actual insertion
+%
+insert2(black('',_,_,''), K, V, Nil, T, Status) :-
+    !,
+    T = red(Nil,K,V,Nil),
+    Status = not_done.
+insert2(In, K, V, Nil, NT, Flag) :-
+    In = red(L,K0,V0,R),
+    !,
+    (   K @< K0
+    ->  insert2(L, K, V, Nil, NL, Flag),
+        (   Flag == shared
+        ->  NT = In
+        ;   NT = red(NL,K0,V0,R)
+        )
+    ;   insert2(R, K, V, Nil, NR, Flag),
+        (   Flag == shared
+        ->  NT = In
+        ;   NT = red(L,K0,V0,NR)
+        )
+    ).
+insert2(In, K, V, Nil, NT, Flag) :-
+    In = black(L,K0,V0,R),
+    (   K @< K0
+    ->  insert2(L, K, V, Nil, IL, Flag0),
+        (   Flag0 == shared
+        ->  NT = In
+        ;   fix_left(Flag0, black(IL,K0,V0,R), NT0, Flag1),
+            (   Flag1 == share
+            ->  nb_linkarg(1, In, IL),
+                Flag = shared,
+                NT = In
+            ;   NT = NT0,
+                Flag = Flag1
+            )
+        )
+    ;   insert2(R, K, V, Nil, IR, Flag0),
+        (   Flag0 == shared
+        ->  NT = In
+        ;   fix_right(Flag0, black(L,K0,V0,IR), NT0, Flag1),
+            (   Flag1 == share
+            ->  nb_linkarg(4, In, IR),
+                Flag = shared,
+                NT = In
+            ;   NT = NT0,
+                Flag = Flag1
+            )
+        )
+    ).
+
+%
+% How to fix if we have inserted on the left
+%
+fix_left(shared,T,T,shared) :- !.
+fix_left(done,T,T,done) :- !.
+fix_left(not_done,Tmp,Final,Done) :-
+    fix_left(Tmp,Final,Done).
+
+%
+% case 1 of RB: just need to change colors.
+%
+fix_left(black(red(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,red(De,KD,VD,Ep)),
+        red(black(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,black(De,KD,VD,Ep)),
+        not_done) :- !.
+fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,red(De,KD,VD,Ep)),
+        red(black(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,Ep)),
+        not_done) :- !.
+%
+% case 2 of RB: got a knee so need to do rotations
+%
+fix_left(black(red(Al,KA,VA,red(Be,KB,VB,Ga)),KC,VC,De),
+        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
+        done) :- !.
+%
+% case 3 of RB: got a line
+%
+fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De),
+        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
+        done) :- !.
+%
+% case 4 of RB: nothig to do
+%
+fix_left(T,T,share).                    % shared?
+
+%
+% How to fix if we have inserted on the right
+%
+fix_right(shared,T,T,shared) :- !.
+fix_right(done,T,T,done) :- !.
+fix_right(not_done,Tmp,Final,Done) :-
+    fix_right(Tmp,Final,Done).
+
+%
+% case 1 of RB: just need to change colors.
+%
+fix_right(black(red(Ep,KD,VD,De),KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
+        red(black(Ep,KD,VD,De),KC,VC,black(red(Ga,KB,VB,Be),KA,VA,Al)),
+        not_done) :- !.
+fix_right(black(red(Ep,KD,VD,De),KC,VC,red(Ga,Ka,Va,red(Be,KB,VB,Al))),
+        red(black(Ep,KD,VD,De),KC,VC,black(Ga,Ka,Va,red(Be,KB,VB,Al))),
+        not_done) :- !.
+%
+% case 2 of RB: got a knee so need to do rotations
+%
+fix_right(black(De,KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
+        black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
+        done) :- !.
+%
+% case 3 of RB: got a line
+%
+fix_right(black(De,KC,VC,red(Ga,KB,VB,red(Be,KA,VA,Al))),
+        black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
+        done) :- !.
+%
+% case 4 of RB: nothing to do.
+%
+fix_right(T,T,share).
+
+
+                 /*******************************
+                 *            UPDATE            *
+                 *******************************/
+
+%!  nb_rb_get_node(+RBTree, +Key, -Node) is semidet.
+%
+%   True if Node is the node in   RBTree associated to Key. Fails if
+%   Key is not in RBTree. This  predicate   is  intended  to be used
+%   together with nb_rb_set_node_value/2 to   update  the associated
+%   key destructively.
+
+nb_rb_get_node(t(_Nil, Tree), Key, Node) :-
+    find_node(Key, Tree, Node).
+
+find_node(Key, Tree, Node) :-
+    Tree \== '',
+    arg(2, Tree, K),
+    compare(Diff, Key, K),
+    find_node(Diff, Key, Tree, Node).
+
+find_node(=, _, Node, Node).
+find_node(<, Key, Tree, Node) :-
+    arg(1, Tree, Left),
+    find_node(Key, Left, Node).
+find_node(>, Key, Tree, Node) :-
+    arg(4, Tree, Right),
+    find_node(Key, Right, Node).
+
+%!  nb_rb_node_value(+Node, -Value) is det.
+%
+%   Value is the value associated to Node.
+
+nb_rb_node_value(Node, Value) :-
+    arg(3, Node, Value).
+
+%!  nb_rb_set_node_value(!Node, +Value) is det.
+%
+%   Associate Value with Node.
+
+nb_rb_set_node_value(Node, Value) :-
+    nb_setarg(3, Node, Value).