This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/tabling.yap
vsc 221665bab8 support for tabling
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@951 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2003-12-18 16:38:40 +00:00

135 lines
4.7 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: tabling.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: support tabling predicates *
* *
*************************************************************************/
:- meta_predicate table(:), abolish_trie(:), show_trie(:), resume_trie(:).
table(M:X) :- !,
'$table'(X, M).
table(X) :-
'$current_module'(M),
'$table'(X, M).
'$table'(X, _) :- var(X), !,
write(user_error, '[ Error: argument to table/1 should be a predicate ]'),
nl(user_error),
fail.
'$table'(M:A, _) :- !, '$table'(A, M).
'$table'((A,B), M) :- !, '$table'(A, M), '$table'(B, M).
'$table'(A/N, M) :- integer(N), atom(A), !,
functor(P, A, N),
'$declare_tabled'(P, M).
'$table'(X, _) :- write(user_error, '[ Error: '),
write(user_error, X),
write(user_error, ' is an invalid argument to table/1 ]'),
nl(user_error),
fail.
'$declare_tabled'(P, M) :-
'$undefined'(P, M), !,
'$do_table'(P, M).
'$declare_tabled'(P, M) :-
'$flags'(P,M,F,F),
X is F /\ 0x1991F880, X =:= 0, !,
'$do_table'(P, M).
'$declare_tabled'(P, M) :-
functor(P, A, N),
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N)).
abolish_trie(M:X) :- !,
'$abolish_trie'(X, M).
abolish_trie(X) :-
'$current_module'(M),
'$abolish_trie'(X, M).
'$abolish_trie'(X, _M) :- var(X), !,
write(user_error, '[ Error: argument to abolish_trie/1 should be a predicate ]'),
nl(user_error),
fail.
'$abolish_trie'((A,B), _) :- !, '$abolish_trie'(A, M), '$abolish_trie'(B, M).
'$abolish_trie'(M:A, _) :- !, '$abolish_trie'(A, M).
'$abolish_trie'(A/N, M) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,M,F,F),
(
X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M)
;
write(user_error, '[ Error: '),
write(user_error, M:A/N),
write(user_error, ' is not declared as table ]'),
nl(user_error),
fail
).
'$abolish_trie'(X,M) :- write(user_error, '[ Error: '),
write(user_error, M:X),
write(user_error, ' is an invalid argument to abolish_trie/1 ]'),
nl(user_error),
fail.
show_trie(M:X) :- !,
'$show_trie'(X, M).
show_trie(X) :-
'$current_module'(M),
'$show_trie'(X, M).
'$show_trie'(X, M) :- var(X), !,
'$do_error'(instantiation_error,show_trie(M:X)).
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
'$show_trie'(A/N, M) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,M,F,F),
(
X is F /\ 0x000040, X =\= 0, !, '$show_trie'(T,M,_)
;
write(user_error, '[ Error: '),
write(user_error, M:A/N),
write(user_error, ' is not declared as table ]'),
nl(user_error),
fail
).
'$show_trie'(X, M) :- write(user_error, '[ Error: '),
write(user_error, M:X),
write(user_error, ' is an invalid argument to trie/1 ]'),
nl(user_error),
fail.
resume_trie(M:X) :- !,
'$resume_trie'(X, M).
resume_trie(X) :-
'$current_module'(M),
'$resume_trie'(X, M).
'$resume_trie'(X,_) :- var(X), !,
write(user_error, '[ Error: argument to trie/1 should be a predicate ]'),
nl(user_error),
fail.
'$resume_trie'(A/N,M) :- atom(A), integer(N), !,
functor(T,A,N), '$flags'(T,M,F,F),
(
X is F /\ 0x000040, X =\= 0, !, '$resume_trie'(T,M)
;
write(user_error, '[ Error: '),
write(user_error, A/N),
write(user_error, ' is not declared as table ]'),
nl(user_error),
fail
).
'$resume_trie'(X,M) :- write(user_error, '[ Error: '),
write(user_error, M:X),
write(user_error, ' is an invalid argument to trie/1 ]'),
nl(user_error),
fail.