/* 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:Table, 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, M:Table, Skeleton),
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)
).