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.
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

142 lines
2.9 KiB
Prolog

% Feature Tree Constraints (CFT) ---------------------------------------------
% following Records for Logic Programming (Smolka,Treinen) JLP 1994:18:229-258
% 950512 Thom Fruehwirth ECRC, based on osf.pl, see also kl-one.pl, type.pl
% 980211, 980311 Thom Fruehwirth LMU for Sicstus CHR
:- use_module( library(chr)).
handler cft.
operator(100,xfx,'::'). % Variable::Sort/Expression sort constraint
operator(100,xfx,'@@'). % Variable@@LabelList arity/label constraint
operator(450,xfy,'##'). % Variable##Feature##Value feature constraint
% in X@@A assumes that A is a sorted list of ground features
% in X##F##Y assumes that feature F is a ground term and Y stays a variable or is atomic
constraints (::)/2, (@@)/2, (##)/2.
% CFT Term Dissolution
X::T <=> nonvar(T), \+ atomic(T) | dissolve(X,T).
dissolve(X,T):-
T=..[S|Ls], X::S, dissolve1(X,Ls,A), sort(A,As), X@@As.
dissolve1(X,[],[]).
dissolve1(X,[L1::T1|Ls],[L1|Ls1]):-
X##L1##TV,
(nonvar(T1) -> dissolve(TV,T1) ; TV=T1),
dissolve1(X,Ls,Ls1).
%!!! sort arity list, load member/2
% CFT Axiom scheme
% see section 3, p.235, p.236
% see proof of proposition 6.5, p.245
% (S) sort are pairwise disjoint
X::S1 \ X::S2 <=> S1=S2.
% (F) features are functional
X##L##Y \ X##L##Z <=> Y=Z.
% (A2) arities are unique
% sorting removes duplicate features
X@@A1 \ X@@A2 <=> A1=A2.
% (A1) If X has arity A, exactly the features in A are defined on X
X@@A, X##F##Y ==> member(F,A).
member(X,[Y|L]):- X=Y ; member(X,L).
% (D) determinant
% not implemented yet
% EXAMPLES ---------------------------------------------------------------
% page 236, determinant
eg0([U,V,W]-[X,Y,Z]):-
X::a(f::V,g::Y),
Y::b(f::X,g::Z,h::u),
Z::a(f::W,g::Y,h::Z).
% cyclic structure, adapted from page 1, DEC-PRL RR 32
eg1(P):-
P::person(name::id(first::_,
last::S),
age::30,
spouse::person(name::id(last::S),
spouse::P)).
% cyclic list, adapted from p. 3, DEC-PRL RR 32
eg2(X):-
X::cons(head::1,tail::X).
eg2a(X):- % same result as eg2(X)
X::cons(head::1,tail::X), X::cons(head::1,tail::cons(head::1,tail::X)).
% adapted from p.17, DEC-PRL RR 32
eg3(X):-
X::s1(l1::s),X::s2(l2::s).
/*
| ?- eg0(X); eg1(X) ; eg2(X) ; eg2a(X) ; eg3(X).
X = [_A,_B,_C]-[_D,_E,_F],
_D::a,
_D##f##_B,
_D##g##_E,
_D@@[f,g],
_E::b,
_E##f##_D,
_E##g##_F,
_E##h##_G,
_G::u,
_G@@[],
_E@@[f,g,h],
_F::a,
_F##f##_C,
_F##g##_E,
_F##h##_F,
_F@@[f,g,h] ? ;
X::person,
X##name##_A,
_A::id,
_A##first##_B,
_A##last##_C,
_A@@[first,last],
X##age##_D,
_D::30,
_D@@[],
X##spouse##_E,
_E::person,
_E##name##_F,
_F::id,
_F##last##_C,
_F@@[last],
_E##spouse##X,
_E@@[name,spouse],
X@@[age,name,spouse] ? ;
X::cons,
X##head##_A,
_A::1,
_A@@[],
X##tail##X,
X@@[head,tail] ? ;
X::cons,
X##head##_A,
_A::1,
_A@@[],
X##tail##X,
X@@[head,tail] ? ;
*/
% end of handler cft ----------------------------------------------------------