View source with formatted comments or as raw
    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-2020, 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(tables,
   37          [ abolish_all_tables/0,
   38            abolish_module_tables/1,            % +Module
   39            abolish_table_pred/1,               % :CallableOrPI
   40            abolish_table_call/1,               % :Callable
   41            abolish_table_call/2,               % :Callable, +Options
   42            abolish_table_subgoals/2,           % :Callable, +Options
   43
   44            tfindall/3,                         % +Template, :Goal, -Answers
   45            't not'/1,                          % :Goal
   46
   47            get_call/3,				% :CallTerm, -AnswerTrie, -Templ
   48            get_calls/3,			% :CallTerm, -AnswerTrie, -Templ
   49            get_returns/2,			% +AnswerTrie, -Return
   50            get_returns/3,			% +AnswerTrie, -Return, -NodeID
   51            get_returns_and_dls/3,		% +AnswerTrie, -Return, -DL
   52            get_returns_and_tvs/3,		% +AnswerTrie, -Return, -TVs
   53            get_returns_for_call/2,             % :CallTerm, ?AnswerTerm
   54            get_residual/2,			% :CallTerm, -DelayList
   55
   56            set_pil_on/0,
   57            set_pil_off/0,
   58
   59            op(900, fy, tnot)
   60          ]).   61:- autoload(library(apply), [maplist/3]).   62:- autoload(library(error), [type_error/2, must_be/2, domain_error/2]).   63:- autoload(library(lists), [append/3]).   64
   65/** <module> XSB interface to tables
   66
   67This module provides an  XSB  compatible   library  to  access tables as
   68created by tabling (see table/1). The aim   of  this library is first of
   69all compatibility with XSB.  This library contains some old and internal
   70XSB predicates that are marked deprecated.
   71*/
   72
   73:- meta_predicate
   74    abolish_table_pred(:),
   75    abolish_table_call(:),
   76    abolish_table_call(:, +),
   77    abolish_table_subgoals(:, +),
   78    tfindall(+, 0, -),
   79    't not'(0),
   80    get_call(:, -, -),
   81    get_calls(:, -, -),
   82    get_returns_for_call(:, :),
   83    get_returns_and_dls(+, -, :),
   84    get_residual(:, -).   85
   86%!  't not'(:Goal)
   87%
   88%   Tabled negation.
   89%
   90%   @deprecated This is a synonym to tnot/1.
   91
   92't not'(Goal) :-
   93    tnot(Goal).
   94
   95%!  tfindall(+Template, :Goal, -Answers)
   96%
   97%   This predicate emerged in XSB  in  an   attempt  to  provide a safer
   98%   alternative to findall/3. This doesn't really   work  in XSB and the
   99%   SWI-Prolog emulation is a simple call   to findall/3. Note that Goal
  100%   may not be a variant of an _incomplete_ table.
  101%
  102%   @deprecated Use findall/3
  103
  104tfindall(Template, Goal, Answers) :-
  105    findall(Template, Goal, Answers).
  106
  107%!  set_pil_on.
  108%!  set_pil_off.
  109%
  110%   Dummy predicates for XSB compatibility.
  111%
  112%   @deprecated These predicates have no effect.
  113
  114set_pil_on.
  115set_pil_off.
  116
  117%!  get_call(:CallTerm, -Trie, -Return) is semidet.
  118%
  119%   True when Trie is an answer trie   for a variant of CallTerm. Return
  120%   is a term ret/N with  N  variables   that  share  with  variables in
  121%   CallTerm. The Trie contains zero  or   more  instances of the Return
  122%   term. See also get_calls/3.
  123
  124get_call(Goal0, Trie, Return) :-
  125    '$tbl_implementation'(Goal0, M:Goal),
  126    M:'$table_mode'(Goal, Table, Moded),
  127    current_table(M:Goal, Trie),
  128    '$tbl_table_status'(Trie, _Status, M:Table, Skeleton),
  129    extend_return(Moded, Skeleton, Return).
  130
  131extend_return(Moded, Skeleton, Return) :-
  132    '$tbl_trienode'(Reserved),
  133    Moded == Reserved,
  134    !,
  135    Return = Skeleton.
  136extend_return(Moded, Skeleton, Return) :-
  137    var(Moded),
  138    !,
  139    Skeleton =.. [ret|Args0],
  140    append(Args0, [Moded], Args),
  141    Return =.. [ret|Args].
  142extend_return(Moded, Skeleton, Return) :-
  143    Moded =.. [_|Extra],
  144    Skeleton =.. [ret|Args0],
  145    append(Args0, Extra, Args),
  146    Return =.. [ret|Args].
  147
  148%!  get_calls(:CallTerm, -Trie, -Return) is nondet.
  149%
  150%   True when Trie is an answer  trie   for  a variant that unifies with
  151%   CallTerm and Skeleton is the  answer   skeleton.  See get_call/3 for
  152%   details.
  153
  154get_calls(Goal0, Trie, Return) :-
  155    '$tbl_variant_table'(VariantTrie),
  156    '$tbl_implementation'(Goal0, M:Goal),
  157    M:'$table_mode'(Goal, Table, Moded),
  158    trie_gen(VariantTrie, M:Table, Trie),
  159    '$tbl_table_status'(Trie, _Status, M:Table, Skeleton),
  160    extend_return(Moded, Skeleton, Return).
  161
  162%!  get_returns(+ATrie, -Return) is nondet.
  163%
  164%   True when Return is an answer template for the AnswerTrie.
  165%
  166%   @arg Return is a term ret(...).  See get_calls/3.
  167
  168get_returns(ATrie, Return) :-
  169    '$tbl_table_status'(ATrie, _Status, M:Table, Skeleton),
  170    M:'$table_mode'(_Goal, Table, Moded),
  171    '$tbl_trienode'(Reserved),
  172    Moded \== Reserved,
  173    !,
  174    extend_return(Moded, Skeleton, Return),
  175    '$tabling':moded_gen_answer(ATrie, Skeleton, Moded).
  176get_returns(ATrie, Return) :-
  177    trie_gen(ATrie, Return).
  178
  179%!  get_returns(+AnswerTrie, -Return, -NodeID) is nondet.
  180%
  181%   True when Return is an answer template for the AnswerTrie and the
  182%   answer is represented by the trie node NodeID.
  183%
  184%   @arg Return is a term ret(...).  See get_calls/3.
  185
  186get_returns(AnswerTrie, Return, NodeID) :-
  187    '$trie_gen_node'(AnswerTrie, Return, NodeID).
  188
  189%!  get_returns_and_tvs(+AnswerTrie, -Return, -TruthValue) is nondet.
  190%
  191%   Identical to get_returns/2, but also obtains   the  truth value of a
  192%   given  answer,  setting  TruthValue  to  `t`    if   the  answer  is
  193%   unconditional and to `u` if  it   is  conditional.  If a conditional
  194%   answer has multiple delay lists, this   predicate  will succeed only
  195%   once, so that using  this  predicate   may  be  more  efficient than
  196%   get_residual/2 (although less informative)
  197
  198get_returns_and_tvs(ATrie, Return, TruthValue) :-
  199    '$tbl_table_status'(ATrie, _Status, M:Table, Skeleton),
  200    M:'$table_mode'(_Goal, Table, Moded),
  201    '$tbl_trienode'(Reserved),
  202    Moded \== Reserved,
  203    !,
  204    extend_return(Moded, Skeleton, Return),
  205    trie_gen(ATrie, Skeleton),
  206    '$tbl_answer_dl'(ATrie, Skeleton, Moded, AN),
  207    (   AN == true
  208    ->  TruthValue = t
  209    ;   TruthValue = u
  210    ).
  211get_returns_and_tvs(AnswerTrie, Return, TruthValue) :-
  212    '$tbl_answer_dl'(AnswerTrie, Return, AN),
  213    (   AN == true
  214    ->  TruthValue = t
  215    ;   TruthValue = u
  216    ).
  217
  218%!  get_returns_and_dls(+AnswerTrie, -Return, :DelayLists) is nondet.
  219%
  220%   True when Return appears in AnswerTrie   with  the given DelayLists.
  221%   DelayLists is a list of lists,  where   the  inner lists expresses a
  222%   conjunctive condition and and outer list a disjunction.
  223
  224get_returns_and_dls(AnswerTrie, Return, M:DelayLists) :-
  225    '$tbl_answer'(AnswerTrie, Return, Condition),
  226    condition_delay_lists(Condition, M, DelayLists).
  227
  228condition_delay_lists(true, _, []) :-
  229    !.
  230condition_delay_lists((A;B), M, List) :-
  231    !,
  232    phrase(semicolon_list((A;B)), L0),
  233    maplist(conj_list(M), L0, List).
  234condition_delay_lists(One, M, [List]) :-
  235    conj_list(M, One, List).
  236
  237semicolon_list((A;B)) -->
  238    !,
  239    semicolon_list(A),
  240    semicolon_list(B).
  241semicolon_list(G) -->
  242    [G].
  243
  244
  245%!  get_residual(:CallTerm, -DelayList) is nondet.
  246%
  247%   True if CallTerm appears in a  table and has DelayList. SWI-Prolog's
  248%   representation for a delay  is  a   body  term,  more specifically a
  249%   disjunction   of   conjunctions.   The     XSB   representation   is
  250%   non-deterministic and uses a list to represent the conjunction.
  251%
  252%   The  delay  condition  is  a  disjunction  of  conjunctions  and  is
  253%   represented as such in the native   SWI-Prolog interface as a nested
  254%   term of ;/2 and ,/2, using `true`   if  the answer is unconditional.
  255%   This   XSB   predicate   returns     the   associated   conjunctions
  256%   non-deterministically as a list.
  257%
  258%   See also call_residual_program/2 from library(wfs).
  259
  260get_residual(Goal0, DelayList) :-
  261    '$tbl_implementation'(Goal0, Goal),
  262    Goal = M:Head,
  263    '$tbl_trienode'(Reserved),
  264    M:'$table_mode'(Head, Variant, Moded),
  265    '$tbl_variant_table'(VariantTrie),
  266    trie_gen(VariantTrie, M:Variant, Trie),
  267    '$tbl_table_status'(Trie, _Status, M:Variant, Skeleton),
  268    (   Reserved == Moded
  269    ->  '$tbl_answer'(Trie, Skeleton, Condition)
  270    ;   '$tbl_answer'(Trie, Skeleton, Moded, Condition)
  271    ),
  272    condition_delay_list(Condition, M, DelayList).
  273
  274condition_delay_list(true, _, List) :-
  275    !,
  276    List = [].
  277condition_delay_list((A;B), M, List) :-
  278    !,
  279    (   condition_delay_list(A, M, List)
  280    ;   condition_delay_list(B, M, List)
  281    ).
  282condition_delay_list(Conj, M, List) :-
  283    !,
  284    conj_list(M, Conj, List).
  285
  286conj_list(M, Conj, List) :-
  287    phrase(comma_list(Conj, M), List).
  288
  289comma_list((A,B), M) -->
  290    !,
  291    comma_list(A, M),
  292    comma_list(B, M).
  293comma_list(M:G, M) -->
  294    !,
  295    [G].
  296comma_list(tnot(M:G), M) -->
  297    !,
  298    [tnot(G)].
  299comma_list(system:G, _) -->
  300    !,
  301    [G].
  302comma_list(G, _) -->
  303    [G].
  304
  305
  306%!  get_returns_for_call(:CallTerm, -AnswerTerm) is nondet.
  307%
  308%   True if AnswerTerm appears in the tables for the _variant_ CallTerm.
  309
  310get_returns_for_call(CallTerm, M:AnswerTerm) :-
  311    current_table(CallTerm, Trie),
  312    '$tbl_table_status'(Trie, _Status, Q:AnswerTerm0, Skeleton),
  313    (   Q == M
  314    ->  AnswerTerm = AnswerTerm0
  315    ;   AnswerTerm = Q:AnswerTerm0
  316    ),
  317    '$tbl_answer_update_dl'(Trie, Skeleton).
  318
  319
  320		 /*******************************
  321		 *             TABLES		*
  322		 *******************************/
  323
  324%!  abolish_table_pred(:CallTermOrPI)
  325%
  326%   Invalidates all tabled subgoals for  the   predicate  denoted by the
  327%   predicate or term indicator Pred.
  328%
  329%   @tbd If Pred has a subgoal that   contains a conditional answer, the
  330%   default  behavior  will  be  to   transitively  abolish  any  tabled
  331%   predicates  with  subgoals  having  answers    that  depend  on  any
  332%   conditional answers of S.
  333
  334abolish_table_pred(M:Name/Arity) :-
  335    !,
  336    functor(Head, Name, Arity),
  337    abolish_table_subgoals(M:Head).
  338abolish_table_pred(M:Head) :-
  339    callable(Head),
  340    !,
  341    functor(Head, Name, Arity),
  342    functor(Generic, Name, Arity),
  343    abolish_table_subgoals(M:Generic).
  344abolish_table_pred(PI) :-
  345    type_error(callable_or_predicate_indicator, PI).
  346
  347%!  abolish_table_call(+Head) is det.
  348%!  abolish_table_call(+Head, +Options) is det.
  349%
  350%   Same as abolish_table_subgoals/1.  See also abolish_table_pred/1.
  351%
  352%   @deprecated Use abolish_table_subgoals/[1,2].
  353
  354abolish_table_call(Head) :-
  355    abolish_table_subgoals(Head).
  356
  357abolish_table_call(Head, Options) :-
  358    abolish_table_subgoals(Head, Options).
  359
  360%!  abolish_table_subgoals(:Head, +Options)
  361%
  362%   Behaves  as  abolish_table_subgoals/1,  but    allows   the  default
  363%   `table_gc_action` to be over-ridden with a flag, which can be either
  364%   `abolish_tables_transitively` or `abolish_tables_singly`.
  365%
  366%   @compat Options is compatible with XSB, but does not follow the ISO
  367%   option handling conventions.
  368
  369abolish_table_subgoals(Head, Options) :-
  370    must_be(list, Options),
  371    (   Options == []
  372    ->  abolish_table_subgoals(Head)
  373    ;   memberchk(abolish_tables_transitively, Options)
  374    ->  abolish_table_subgoals(Head)
  375    ;   memberchk(abolish_tables_singly, Options)
  376    ->  abolish_table_subgoals(Head)
  377    ;   domain_error([abolish_tables_transitively,abolish_tables_singly], Options)
  378    )