125 lines
2.7 KiB
Perl
125 lines
2.7 KiB
Perl
|
% Order Sorted Feature Constraints -------------------------------------------
|
||
|
% following DEC-PRL Research Report 32, May 1993, by H. Ait-Kaci, A. Podelski
|
||
|
% and S.C. Goldstein on "Order-Sorted Feature Theory Unification"
|
||
|
% see also cft.pl, kl-one.pl, type.pl
|
||
|
% 940603 ECRC, 980211, 980312 Thom Fruehwirth LMU for Sicstus CHR
|
||
|
|
||
|
:- use_module( library(chr)).
|
||
|
|
||
|
handler osf.
|
||
|
|
||
|
option(already_in_store, on).
|
||
|
|
||
|
operator(150,xfx,'=>'). % label has value constraint
|
||
|
operator(100,xfx,'::'). % sort constraint
|
||
|
operator(100,xfx,'..'). % feature constraint
|
||
|
operator(450,xfx,'##'). % equality constraint
|
||
|
operator(450,fx,'theory'). % OSF theory clause
|
||
|
|
||
|
constraints (::)/2, (##)/2.
|
||
|
|
||
|
|
||
|
% OSF Term Dissolution
|
||
|
X::T <=> nonvar(T), \+ atomic(T) | dissolve(X,T).
|
||
|
|
||
|
dissolve(X,T):- T=..[S|Ls], X::S, dissolve1(X,Ls).
|
||
|
dissolve1(X,[]).
|
||
|
dissolve1(X,[L1=>T1|Ls]):- X..L1##Y, dissolve0(Y,T1), dissolve1(X,Ls).
|
||
|
dissolve0(Y,T):- var(T), !, Y=T.
|
||
|
dissolve0(Y,X::T):- !, Y=X, dissolve(Y,T).
|
||
|
dissolve0(Y,T):- Y::T.
|
||
|
|
||
|
|
||
|
% OSF Clause Normalization Rules
|
||
|
% see Figure 1, p. 6 of DEC-PRL RR 32
|
||
|
|
||
|
% (1) sort intersection
|
||
|
X::S1, X::S2 <=> atomic(S1),atomic(S2) | sort_intersection(S1,S2,S3), X::S3.
|
||
|
|
||
|
% (2) inconsistent sort
|
||
|
% reflected down to built-in constraints true and fail
|
||
|
X::bot <=> fail.
|
||
|
X::top <=> true.
|
||
|
|
||
|
% (3) variable elimination
|
||
|
% reflected down to built-in constraint for equality
|
||
|
X##Y <=> var(X) | X=Y.
|
||
|
|
||
|
% (4) feature decomposition
|
||
|
X..L##Y \ X..L##Z <=> Y=Z.
|
||
|
|
||
|
|
||
|
% OSF Theory Unification
|
||
|
% preliminary version, theory represented by Prolog facts
|
||
|
X::S#Id, X.._##_ ==> atomic(S),theory X::T,functor(T,S,_) | X::T.
|
||
|
|
||
|
|
||
|
% EXAMPLES ---------------------------------------------------------------
|
||
|
|
||
|
% cyclic structure, page 1, DEC-PRL RR 32
|
||
|
eg1(P):-
|
||
|
P::person(name=>id(first=>string,
|
||
|
last=>S::string),
|
||
|
age=>30,
|
||
|
spouse=>person(name=>id(last=>S),
|
||
|
spouse=>P)).
|
||
|
|
||
|
% cyclic structure, p. 3, DEC-PRL RR 32
|
||
|
eg2(X):-
|
||
|
X::cons(head=>1,tail=>X).
|
||
|
eg2a(X):- % same as eg2(X)
|
||
|
X::cons(head=>1,tail=>X), X::cons(head=>1,tail=>cons(head=>1,tail=>X)).
|
||
|
|
||
|
% p.17, DEC-PRL RR 32
|
||
|
eg3(X):-
|
||
|
X::s1(l1=>s),X::s2(l2=>s).
|
||
|
|
||
|
sort_intersection(s1,s2,s3).
|
||
|
sort_intersection(s2,s1,s3).
|
||
|
|
||
|
% non-empty theory
|
||
|
theory YS1::s1(l1=>Y1::s).
|
||
|
theory YS2::s2(l2=>Y2::s).
|
||
|
theory YS3::s3(l1=>Y3::s(l=>Y4::s),l2=>Y3).
|
||
|
theory YS::s(l=>Y5::s).
|
||
|
|
||
|
/*
|
||
|
| ?- eg1(X) ; eg2(X) ; eg2a(X) ; eg3(X).
|
||
|
|
||
|
X::person,
|
||
|
X..name##_A,
|
||
|
_A::id,
|
||
|
_A..first##_B,
|
||
|
_B::string,
|
||
|
_A..last##_C,
|
||
|
_C::string,
|
||
|
X..age##_D,
|
||
|
_D::30,
|
||
|
X..spouse##_E,
|
||
|
_E::person,
|
||
|
_E..name##_F,
|
||
|
_F::id,
|
||
|
_F..last##_C,
|
||
|
_E..spouse##X ? ;
|
||
|
|
||
|
X::cons,
|
||
|
X..head##_A,
|
||
|
_A::1,
|
||
|
X..tail##X ? ;
|
||
|
|
||
|
X::cons,
|
||
|
X..head##_A,
|
||
|
_A::1,
|
||
|
X..tail##X ? ;
|
||
|
|
||
|
X..l1##_A,
|
||
|
_A::s,
|
||
|
X::s3,
|
||
|
_A..l##_B,
|
||
|
_B::s,
|
||
|
X..l2##_A ?
|
||
|
|
||
|
*/
|
||
|
|
||
|
% end of handler osf ----------------------------------------------------------
|