kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/tables.pl

@@ -0,0 +1,381 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2019-2020, VU University Amsterdam
+                              CWI, 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(tables,
+          [ abolish_all_tables/0,
+            abolish_module_tables/1,            % +Module
+            abolish_table_pred/1,               % :CallableOrPI
+            abolish_table_call/1,               % :Callable
+            abolish_table_call/2,               % :Callable, +Options
+            abolish_table_subgoals/2,           % :Callable, +Options
+
+            tfindall/3,                         % +Template, :Goal, -Answers
+            't not'/1,                          % :Goal
+
+            get_call/3,				% :CallTerm, -AnswerTrie, -Templ
+            get_calls/3,			% :CallTerm, -AnswerTrie, -Templ
+            get_returns/2,			% +AnswerTrie, -Return
+            get_returns/3,			% +AnswerTrie, -Return, -NodeID
+            get_returns_and_dls/3,		% +AnswerTrie, -Return, -DL
+            get_returns_and_tvs/3,		% +AnswerTrie, -Return, -TVs
+            get_returns_for_call/2,             % :CallTerm, ?AnswerTerm
+            get_residual/2,			% :CallTerm, -DelayList
+
+            set_pil_on/0,
+            set_pil_off/0,
+
+            op(900, fy, tnot)
+          ]).
+:- autoload(library(apply), [maplist/3]).
+:- autoload(library(error), [type_error/2, must_be/2, domain_error/2]).
+:- autoload(library(lists), [append/3]).
+
+/** <module> XSB interface to tables
+
+This module provides an  XSB  compatible   library  to  access tables as
+created by tabling (see table/1). The aim   of  this library is first of
+all compatibility with XSB.  This library contains some old and internal
+XSB predicates that are marked deprecated.
+*/
+
+:- meta_predicate
+    abolish_table_pred(:),
+    abolish_table_call(:),
+    abolish_table_call(:, +),
+    abolish_table_subgoals(:, +),
+    tfindall(+, 0, -),
+    't not'(0),
+    get_call(:, -, -),
+    get_calls(:, -, -),
+    get_returns_for_call(:, :),
+    get_returns_and_dls(+, -, :),
+    get_residual(:, -).
+
+%!  't not'(:Goal)
+%
+%   Tabled negation.
+%
+%   @deprecated This is a synonym to tnot/1.
+
+'t not'(Goal) :-
+    tnot(Goal).
+
+%!  tfindall(+Template, :Goal, -Answers)
+%
+%   This predicate emerged in XSB  in  an   attempt  to  provide a safer
+%   alternative to findall/3. This doesn't really   work  in XSB and the
+%   SWI-Prolog emulation is a simple call   to findall/3. Note that Goal
+%   may not be a variant of an _incomplete_ table.
+%
+%   @deprecated Use findall/3
+
+tfindall(Template, Goal, Answers) :-
+    findall(Template, Goal, Answers).
+
+%!  set_pil_on.
+%!  set_pil_off.
+%
+%   Dummy predicates for XSB compatibility.
+%
+%   @deprecated These predicates have no effect.
+
+set_pil_on.
+set_pil_off.
+
+%!  get_call(:CallTerm, -Trie, -Return) is semidet.
+%
+%   True when Trie is an answer trie   for a variant of CallTerm. Return
+%   is a term ret/N with  N  variables   that  share  with  variables in
+%   CallTerm. The Trie contains zero  or   more  instances of the Return
+%   term. See also get_calls/3.
+
+get_call(Goal0, Trie, Return) :-
+    '$tbl_implementation'(Goal0, M:Goal),
+    M:'$table_mode'(Goal, Table, Moded),
+    current_table(M:Goal, Trie),
+    '$tbl_table_status'(Trie, _Status, M:Table, Skeleton),
+    extend_return(Moded, Skeleton, Return).
+
+extend_return(Moded, Skeleton, Return) :-
+    '$tbl_trienode'(Reserved),
+    Moded == Reserved,
+    !,
+    Return = Skeleton.
+extend_return(Moded, Skeleton, Return) :-
+    var(Moded),
+    !,
+    Skeleton =.. [ret|Args0],
+    append(Args0, [Moded], Args),
+    Return =.. [ret|Args].
+extend_return(Moded, Skeleton, Return) :-
+    Moded =.. [_|Extra],
+    Skeleton =.. [ret|Args0],
+    append(Args0, Extra, Args),
+    Return =.. [ret|Args].
+
+%!  get_calls(:CallTerm, -Trie, -Return) is nondet.
+%
+%   True when Trie is an answer  trie   for  a variant that unifies with
+%   CallTerm and Skeleton is the  answer   skeleton.  See get_call/3 for
+%   details.
+
+get_calls(Goal0, Trie, Return) :-
+    '$tbl_variant_table'(VariantTrie),
+    '$tbl_implementation'(Goal0, M:Goal),
+    M:'$table_mode'(Goal, Table, Moded),
+    trie_gen(VariantTrie, M:Table, Trie),
+    '$tbl_table_status'(Trie, _Status, ATable, Skeleton),
+    term_attvars(ATable+Skeleton, AttVars),
+    maplist(del_attrs, AttVars),
+    ATable = M:Table,
+    extend_return(Moded, Skeleton, Return).
+
+%!  get_returns(+ATrie, -Return) is nondet.
+%
+%   True when Return is an answer template for the AnswerTrie.
+%
+%   @arg Return is a term ret(...).  See get_calls/3.
+
+get_returns(ATrie, Return) :-
+    '$tbl_table_status'(ATrie, _Status, M:Table, Skeleton),
+    M:'$table_mode'(_Goal, Table, Moded),
+    '$tbl_trienode'(Reserved),
+    Moded \== Reserved,
+    !,
+    extend_return(Moded, Skeleton, Return),
+    '$tabling':moded_gen_answer(ATrie, Skeleton, Moded).
+get_returns(ATrie, Return) :-
+    trie_gen(ATrie, Return).
+
+%!  get_returns(+AnswerTrie, -Return, -NodeID) is nondet.
+%
+%   True when Return is an answer template for the AnswerTrie and the
+%   answer is represented by the trie node NodeID.
+%
+%   @arg Return is a term ret(...).  See get_calls/3.
+
+get_returns(AnswerTrie, Return, NodeID) :-
+    '$trie_gen_node'(AnswerTrie, Return, NodeID).
+
+%!  get_returns_and_tvs(+AnswerTrie, -Return, -TruthValue) is nondet.
+%
+%   Identical to get_returns/2, but also obtains   the  truth value of a
+%   given  answer,  setting  TruthValue  to  `t`    if   the  answer  is
+%   unconditional and to `u` if  it   is  conditional.  If a conditional
+%   answer has multiple delay lists, this   predicate  will succeed only
+%   once, so that using  this  predicate   may  be  more  efficient than
+%   get_residual/2 (although less informative)
+
+get_returns_and_tvs(ATrie, Return, TruthValue) :-
+    '$tbl_table_status'(ATrie, _Status, M:Table, Skeleton),
+    M:'$table_mode'(_Goal, Table, Moded),
+    '$tbl_trienode'(Reserved),
+    Moded \== Reserved,
+    !,
+    extend_return(Moded, Skeleton, Return),
+    trie_gen(ATrie, Skeleton),
+    '$tbl_answer_dl'(ATrie, Skeleton, Moded, AN),
+    (   AN == true
+    ->  TruthValue = t
+    ;   TruthValue = u
+    ).
+get_returns_and_tvs(AnswerTrie, Return, TruthValue) :-
+    '$tbl_answer_dl'(AnswerTrie, Return, AN),
+    (   AN == true
+    ->  TruthValue = t
+    ;   TruthValue = u
+    ).
+
+%!  get_returns_and_dls(+AnswerTrie, -Return, :DelayLists) is nondet.
+%
+%   True when Return appears in AnswerTrie   with  the given DelayLists.
+%   DelayLists is a list of lists,  where   the  inner lists expresses a
+%   conjunctive condition and and outer list a disjunction.
+
+get_returns_and_dls(AnswerTrie, Return, M:DelayLists) :-
+    '$tbl_answer'(AnswerTrie, Return, Condition),
+    condition_delay_lists(Condition, M, DelayLists).
+
+condition_delay_lists(true, _, []) :-
+    !.
+condition_delay_lists((A;B), M, List) :-
+    !,
+    phrase(semicolon_list((A;B)), L0),
+    maplist(conj_list(M), L0, List).
+condition_delay_lists(One, M, [List]) :-
+    conj_list(M, One, List).
+
+semicolon_list((A;B)) -->
+    !,
+    semicolon_list(A),
+    semicolon_list(B).
+semicolon_list(G) -->
+    [G].
+
+
+%!  get_residual(:CallTerm, -DelayList) is nondet.
+%
+%   True if CallTerm appears in a  table and has DelayList. SWI-Prolog's
+%   representation for a delay  is  a   body  term,  more specifically a
+%   disjunction   of   conjunctions.   The     XSB   representation   is
+%   non-deterministic and uses a list to represent the conjunction.
+%
+%   The  delay  condition  is  a  disjunction  of  conjunctions  and  is
+%   represented as such in the native   SWI-Prolog interface as a nested
+%   term of ;/2 and ,/2, using `true`   if  the answer is unconditional.
+%   This   XSB   predicate   returns     the   associated   conjunctions
+%   non-deterministically as a list.
+%
+%   See also call_residual_program/2 from library(wfs).
+
+get_residual(Goal0, DelayList) :-
+    '$tbl_implementation'(Goal0, Goal),
+    Goal = M:Head,
+    '$tbl_trienode'(Reserved),
+    M:'$table_mode'(Head, Variant, Moded),
+    '$tbl_variant_table'(VariantTrie),
+    trie_gen(VariantTrie, M:Variant, Trie),
+    '$tbl_table_status'(Trie, _Status, M:Variant, Skeleton),
+    (   Reserved == Moded
+    ->  '$tbl_answer'(Trie, Skeleton, Condition)
+    ;   '$tbl_answer'(Trie, Skeleton, Moded, Condition)
+    ),
+    condition_delay_list(Condition, M, DelayList).
+
+condition_delay_list(true, _, List) :-
+    !,
+    List = [].
+condition_delay_list((A;B), M, List) :-
+    !,
+    (   condition_delay_list(A, M, List)
+    ;   condition_delay_list(B, M, List)
+    ).
+condition_delay_list(Conj, M, List) :-
+    !,
+    conj_list(M, Conj, List).
+
+conj_list(M, Conj, List) :-
+    phrase(comma_list(Conj, M), List).
+
+comma_list((A,B), M) -->
+    !,
+    comma_list(A, M),
+    comma_list(B, M).
+comma_list(M:G, M) -->
+    !,
+    [G].
+comma_list(tnot(M:G), M) -->
+    !,
+    [tnot(G)].
+comma_list(system:G, _) -->
+    !,
+    [G].
+comma_list(G, _) -->
+    [G].
+
+
+%!  get_returns_for_call(:CallTerm, -AnswerTerm) is nondet.
+%
+%   True if AnswerTerm appears in the tables for the _variant_ CallTerm.
+
+get_returns_for_call(CallTerm, M:AnswerTerm) :-
+    current_table(CallTerm, Trie),
+    '$tbl_table_status'(Trie, _Status, Q:AnswerTerm0, Skeleton),
+    (   Q == M
+    ->  AnswerTerm = AnswerTerm0
+    ;   AnswerTerm = Q:AnswerTerm0
+    ),
+    '$tbl_answer_update_dl'(Trie, Skeleton).
+
+
+		 /*******************************
+		 *             TABLES		*
+		 *******************************/
+
+%!  abolish_table_pred(:CallTermOrPI)
+%
+%   Invalidates all tabled subgoals for  the   predicate  denoted by the
+%   predicate or term indicator Pred.
+%
+%   @tbd If Pred has a subgoal that   contains a conditional answer, the
+%   default  behavior  will  be  to   transitively  abolish  any  tabled
+%   predicates  with  subgoals  having  answers    that  depend  on  any
+%   conditional answers of S.
+
+abolish_table_pred(M:Name/Arity) :-
+    !,
+    functor(Head, Name, Arity),
+    abolish_table_subgoals(M:Head).
+abolish_table_pred(M:Head) :-
+    callable(Head),
+    !,
+    functor(Head, Name, Arity),
+    functor(Generic, Name, Arity),
+    abolish_table_subgoals(M:Generic).
+abolish_table_pred(PI) :-
+    type_error(callable_or_predicate_indicator, PI).
+
+%!  abolish_table_call(+Head) is det.
+%!  abolish_table_call(+Head, +Options) is det.
+%
+%   Same as abolish_table_subgoals/1.  See also abolish_table_pred/1.
+%
+%   @deprecated Use abolish_table_subgoals/[1,2].
+
+abolish_table_call(Head) :-
+    abolish_table_subgoals(Head).
+
+abolish_table_call(Head, Options) :-
+    abolish_table_subgoals(Head, Options).
+
+%!  abolish_table_subgoals(:Head, +Options)
+%
+%   Behaves  as  abolish_table_subgoals/1,  but    allows   the  default
+%   `table_gc_action` to be over-ridden with a flag, which can be either
+%   `abolish_tables_transitively` or `abolish_tables_singly`.
+%
+%   @compat Options is compatible with XSB, but does not follow the ISO
+%   option handling conventions.
+
+abolish_table_subgoals(Head, Options) :-
+    must_be(list, Options),
+    (   Options == []
+    ->  abolish_table_subgoals(Head)
+    ;   memberchk(abolish_tables_transitively, Options)
+    ->  abolish_table_subgoals(Head)
+    ;   memberchk(abolish_tables_singly, Options)
+    ->  abolish_table_subgoals(Head)
+    ;   domain_error([abolish_tables_transitively,abolish_tables_singly], Options)
+    ).