Mercurial > hg > Applications > Tokio

comparison tu.pl @ 0:cfb7c6b24319

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:cfb7c6b24319
1 /*
2 Copyright (C) 1988,2005, Shinji Kono
3 Everyone is permitted to copy and distribute verbatim copies
4 of this license, but changing it is not allowed. You can also
5 use this wording to make the terms for other programs.
6
7 send your comments to kono@ie.u-ryukyu.ac.jp
8 */
9
10
11 /*
12 temporal unifier
13 Tue Oct 15 11:36:12 JST 1985
14 */
15
16 unifyAll(V,V) :- !. % variable case
17 unifyAll('$t'(Now,Nxt),'$t'(Now,Nxt1)) :-!,
18 unifyAll(Nxt,Nxt1).
19 unifyAll('$t'(Now,Nxt),D):-!,
20 unifyNowNext(D,Now,Nxt1),
21 unifyAll(Nxt,Nxt1).
22 unifyAll(D,'$t'(Now,Nxt)):-!,
23 unifyNowNext(D,Now,Nxt1),
24 unifyAll(Nxt,Nxt1).
25 unifyAll([H|L],[H1|L1]) :- !,
26 unifyAll(H,H1),unifyAll(L,L1).
27 unifyAll(Sa,Sb):-
28 functor(Sa,H,N),functor(Sb,H,N),
29 unify_arg(N,N,Sa,Sb).
30
31 unify_arg(0,_N,_,_):-!.
32 unify_arg(M,N,Sa,Sb):-
33 arg(M,Sa,Aa),arg(M,Sb,Ab),
34 unifyAll(Aa,Ab),M1 is M-1,!,
35 unify_arg(M1,N,Sa,Sb).
36
37 unifyNowNext('$t'(Now,Next),Now1,Next1):-!,Now=Now1,Next=Next1.
38 unifyNowNext(X,X1,X1):-atomic(X),!,X=X1.
39 unifyNowNext([H|L],[Hn|Ln],[Hnn|Lnn]):-!,
40 unifyNowNext(H,Hn,Hnn),
41 unifyNowNext(L,Ln,Lnn).
42 unifyNowNext(S,Sn,Snn):-
43 functor(S,H,N),functor(Sn,H,N),functor(Snn,H,N),
44 unifyNowNextArg(N,N,S,Sn,Snn).
45
46 unifyNowNextArg(0,_,_,_,_).
47 unifyNowNextArg(M,N,Sa,Sb,Sc):-
48 arg(M,Sa,Aa),arg(M,Sb,Ab),arg(M,Sc,Ac),
49 unifyNowNext(Aa,Ab,Ac),M1 is M-1,!,
50 unifyNowNextArg(M1,N,Sa,Sb,Sc).
51
52 unifyNow(X,X1):-atomic(X),!,X=X1.
53 unifyNow('$t'(Now,_),Now1):-!,Now=Now1.
54 unifyNow([H|L],[Hn|Ln]):-!,
55 unifyNow(H,Hn),
56 unifyNow(L,Ln).
57 unifyNow(S,Sn):-
58 functor(S,H,N),functor(Sn,H,N),
59 unifyNowArg(N,N,S,Sn).
60
61 unifyNowArg(0,_,_,_).
62 unifyNowArg(M,N,Sa,Sb):-
63 arg(M,Sa,Aa),arg(M,Sb,Ab),
64 unifyNow(Aa,Ab),M1 is M-1,!,
65 unifyNowArg(M1,N,Sa,Sb).
66
67
68 unifyNext(X,X):-atomic(X),!.
69 unifyNext('$t'(_,Next),Next1):-!,Next=Next1.
70 unifyNext([H|L],[Hn|Ln]):-!,
71 unifyNext(H,Hn),
72 unifyNext(L,Ln).
73 unifyNext(S,Sn):-
74 functor(S,H,N),functor(Sn,H,N),
75 unifyNextArg(N,N,S,Sn).
76
77 unifyNextArg(0,_,_,_).
78 unifyNextArg(M,N,Sa,Sb):-
79 arg(M,Sa,Aa),arg(M,Sb,Ab),
80 unifyNext(Aa,Ab),M1 is M-1,!,
81 unifyNextArg(M1,N,Sa,Sb).
82
83
84 % ATOMIC
85 % uatom(X, Atom)
86 uatom(X, X) :- !.
87 uatom('$t'(Atom,Next), Atom) :- uatom(Next, Atom).
88
89 uconst(X, X) :- var(X),!.
90 uconst('$t'(Atom,Next), Atom) :- uatom(Next, Atom).
91 uconst(X, Y) :- nonvar(X),!,X=Y.
92
93 % unil(X) : Hacked version of uatom.
94 unil([]) :- !.
95 unil('$t'([],Next)) :- unil(Next).
96
97
98 % COMPOUND TERM
99 % uskel(X, Skeleton)
100 uskel(X,X) :- !.
101 uskel('$t'(X,Next),S) :-
102 functor(S,H,N),functor(X,H,N),functor(Sn,H,N),
103 uskelArg(N,N,S,X,Sn),
104 uskel(Next,Sn).
105
106 uskelArg(0, _, _, _, _) :- !.
107 uskelArg(M, N, S, X, Sn) :-
108 arg(M, S, '$t'(Now, Next)),
109 arg(M, X, Now),
110 arg(M, Sn, Next),
111 M1 is M-1,
112 uskelArg(M1, N, S, X, Sn).
113
114 % ulist(X, Car, Cdr) : Hacked version of uskel.
115 ulist([H|T], H, T) :- !.
116 ulist('$t'([H|T],Next), '$t'(H,NH), '$t'(T,NT)) :- !, ulist(Next, NH, NT).
117
118
119 % readonly unify
120
121
122 r_unifyAll(G,D):-
123 (var(G) ; var(D)),!,G==D.
124 r_unifyAll(Fl,D):-functor(Fl,'$t',2),!,
125 r_unify_flt(Fl,D).
126 r_unifyAll(D,Fl):-functor(Fl,'$t',2),!,
127 r_unify_flt(Fl,D).
128 r_unifyAll(Sa,Sb):-
129 functor(Sa,H,N),functor(Sb,H,N),
130 r_unify_arg(N,N,Sa,Sb).
131
132 r_unify_arg(0,_N,_,_):-!.
133 r_unify_arg(M,N,Sa,Sb):-
134 arg(M,Sa,Aa),arg(M,Sb,Ab),
135 r_unifyAll(Aa,Ab),M1 is M-1,!,
136 r_unify_arg(M1,N,Sa,Sb).
137
138 r_unify_flt('$t'(Now,Nxt),'$t'(Now1,Nxt1)) :-!,Now==Now1,
139 r_unifyAll(Nxt,Nxt1).
140 r_unify_flt('$t'(Now,Nxt),S) :- nonvar(Now),nonvar(Nxt),
141 r_unifyNowNext(S,Now,Nxt1),
142 r_unifyAll(Nxt,Nxt1).
143
144 r_unifyNowNext(V,_,_) :- var(V),!,fail.
145 r_unifyNowNext('$t'(Now,Next),Now1,Next1):-!,Now==Now1,Next==Next1.
146 r_unifyNowNext(X,X1,X2):-atomic(X),!,X==X1,X==X2.
147 r_unifyNowNext(S,Sn,Snn):-
148 functor(S,H,N),functor(Sn,H,N),functor(Snn,H,N),
149 r_unifyNowNext(N,N,S,Sn,Snn).
150
151 r_unifyNowNextArg(0,_,_,_,_).
152 r_unifyNowNextArg(M,N,Sa,Sb,Sc):-
153 arg(M,Sa,Aa),arg(M,Sb,Ab),arg(M,Sc,Ac),
154 r_unifyNowNext(Aa,Ab,Ac),M1 is M-1,!,
155 r_unifyNowNextArg(M1,N,Sa,Sb,Sc).
156
157
158 /* end of unifier */