|
0
|
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 Tokio compiler to prolog
|
|
|
13 Thu Aug 15 12:17:04 JST 1985
|
|
|
14 Fri Jan 10 16:11:31 JST 1986
|
|
|
15 Fri Sep 5 09:51:36 JST 1986 for 1.2a
|
|
|
16 Thu Mar 26 16:19:10 JST 1987
|
|
|
17 Wed Oct 14 13:35:54 JST 1987 full time F
|
|
|
18 Fri Oct 16 11:28:26 JST 1987 Sicstus
|
|
|
19 $Header$
|
|
|
20 body-compiler
|
|
|
21 */
|
|
|
22
|
|
|
23 c_clause((Head :- Body), (H :- B)) :- !,
|
|
|
24 c_opt(Body, NBody, _), % delete true
|
|
|
25 c_body(NBody, Control,
|
|
|
26 ['$t'(B1,_,_,_)|Q] , ['$t'(true,_,_,_)|T1], before_cut-_),
|
|
|
27 % make queue structure
|
|
|
28 c_head(Head, H0, B2, B1,Control,Q), % inline unification
|
|
|
29 c_opt(B2, B, _), % off tailing true
|
|
|
30 c_make_pred(H0, H, Q, T1).
|
|
|
31 c_clause(Head, H) :- % fact
|
|
|
32 c_head(Head, H0, B2, true,_,_),
|
|
|
33 c_make_pred(H0, H1, Q, Q),
|
|
|
34 c_opt(B2, B, _), % off tailing true
|
|
|
35 (B = true, H = H1,! ; H = (H1 :- B)).
|
|
|
36
|
|
|
37 c_error(A) :-
|
|
|
38 telling(Old),tell(user),
|
|
|
39 call(A),
|
|
|
40 tell(Old).
|
|
|
41
|
|
|
42 /*
|
|
|
43
|
|
|
44 c_head(Head, ModfiedHead, Qhead, Qtail)
|
|
|
45
|
|
|
46 */
|
|
|
47
|
|
|
48 c_head(H,Mh,Qh0,Qt,Control,Q) :-
|
|
|
49 c_control_reference(Control,Qh0,Qh,Q),
|
|
|
50 functor(H,F,A),functor(Mh,F,A),
|
|
|
51 c_args(0,A, H, Mh, Qh, Qt).
|
|
|
52
|
|
|
53 c_args(N, N, _, _, Q, Q) :- !.
|
|
|
54 c_args(K, N, Head, H, Q, Q1) :-
|
|
|
55 K1 is K+1, arg(K1, Head, AK), arg(K1, H, HK),
|
|
|
56 c_unify(AK, HK, Q, Q2, 8),
|
|
|
57 c_args(K1, N, Head, H, Q2, Q1).
|
|
|
58
|
|
|
59 % We needs NOW value however sometines is is hiden in Next time Queue
|
|
|
60 c_control_reference(Control,(Q=['$t'(_N,_F,_K,'$'(_,NowTime,_))|_],Qh),Qh,Q) :-
|
|
|
61 Control = '$'(_Fin,Now,_Empty),nonvar(Now),var(Q),
|
|
|
62 Now = '$REF'(NowTime),!.
|
|
|
63 c_control_reference(_Control,Qh,Qh,_Q).
|
|
|
64
|
|
|
65 /*
|
|
|
66
|
|
|
67 Tokio compiler Queue structure
|
|
|
68
|
|
|
69 [Qnow,Qnext1,Qnext2,......|_],[QnowTail,Qnext1Tail,Qnext2Tail,.....|_]
|
|
|
70 D-list
|
|
|
71 Qnow = '$t'(Next,Fin,Keep,'$'(Fin,Now,Empty))
|
|
|
72
|
|
|
73 predicate(A):- p,q.
|
|
|
74 ---> predicate(A,Q,Q1) :-
|
|
|
75 p(Q,Q2),q(Q2,Q1).
|
|
|
76 */
|
|
|
77
|
|
|
78 c_body(E=E1, Control,
|
|
|
79 ['$t'(N1,F,K,C)|Q],
|
|
|
80 ['$t'(N,F,K,C)|Q], before_cut-before_cut) :- !,
|
|
|
81 c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, N, Control),
|
|
|
82 c_equate(EE,EE1).
|
|
|
83 c_body(E=E1, Control,
|
|
|
84 ['$t'(N1,F,K,C)|Q],
|
|
|
85 ['$t'(N,F,K,C)|Q], after_cut-after_cut) :- !,
|
|
|
86 c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE = EE1,N), Control).
|
|
|
87 c_body(E is E1, Control,
|
|
|
88 ['$t'(N1,F,K,C)|Q],
|
|
|
89 ['$t'(N,F,K,C)|Q], Cut-Cut) :- !,
|
|
|
90 c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE is EE1,N), Control).
|
|
|
91 c_body('$chop'(Former,Later), Control, % later must be atomic
|
|
|
92 ['$t'(('r_subBegin'(Q,QF,QF1,_Sfin),FF),F,K,Control)|Q],
|
|
|
93 ['$t'(FF1,F,K,Control)|Q1],Cut) :- !,
|
|
|
94 Control = '$'(_CFin,CNow,_CEmpty), NC = '$'(_,CNow,_), % subtle code
|
|
|
95 c_body(Former,NC,['$t'(FF,_,_,NC)|QF1],['$t'((L1,FF1),_,_,NC)|QF2],Cut),
|
|
|
96 c_chop_later(Later, L1, Q, Q1, QF, QF2).
|
|
|
97 c_body((A,B), Control, Q, Q1, Cut-Cut1) :- !,
|
|
|
98 c_body(A, Control, Q, Q2, Cut-Cut2),
|
|
|
99 c_body(B, Control, Q2, Q1, Cut2-Cut1).
|
|
|
100 %c_body(empty, '$'(Fin,Now,empty),
|
|
|
101 % [Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1],
|
|
|
102 % [Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1], Cut) :- !, % strong next
|
|
|
103 c_body(empty, Control,
|
|
|
104 ['$t'(('r_empty'(Q),N),F,K,Control)|Q],
|
|
|
105 ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !.
|
|
|
106 c_body(notEmpty, Control,
|
|
|
107 ['$t'(('r_notEmpty'(Q),N),F,K,Control)|Q],
|
|
|
108 ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !.
|
|
|
109 c_body(length(L), Control,
|
|
|
110 ['$t'(N2,F,K,Control)|Q],
|
|
|
111 ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !,
|
|
|
112 c_eval(L, LL, N2, ('r_length'(LL,Q),N), Control).
|
|
|
113 %% c_body(@true, C, Q, Q, Cut-Cut) :-!. % special optimize
|
|
|
114 c_body(next(true), _C, Q, Q, Cut-Cut) :-!.
|
|
|
115 c_body(@A, '$'(Fin,NowTime,notEmpty),
|
|
|
116 [Now|Q],
|
|
|
117 [Now,'$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut) :- !, % strong next
|
|
|
118 c_seperate_next(A, NextA),
|
|
|
119 c_body(NextA, _Control,
|
|
|
120 Q,
|
|
|
121 ['$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut).
|
|
|
122 c_body(next(A), _Control,
|
|
|
123 [Now|Q], [Now|Q1], Cut) :- !, % weak next
|
|
|
124 c_seperate_next(A, NextA),
|
|
|
125 c_body(NextA, _Control1, Q, Q1, Cut).
|
|
|
126 c_body(ifEmpty(A), Control, % fin don't care queue
|
|
|
127 [Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N,F1,K,Control)|Q],
|
|
|
128 Cut-Cut) :- !,
|
|
|
129 c_body(A, Control,
|
|
|
130 ['$t'(F,F2,_,Control)|_],
|
|
|
131 ['$t'(F2,F1,_,Control)|_] , after_cut-_).
|
|
|
132 c_body(ifNotEmpty(A), Control,
|
|
|
133 [Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N1,F,K1,Control1)|Q1],
|
|
|
134 Cut-Cut) :- !,
|
|
|
135 c_body(A, Control,
|
|
|
136 ['$t'(K ,_,_,Control),'$t'(N, _,K2,Control) |Q],
|
|
|
137 ['$t'(K2,_,_,Control),'$t'(N1,_,K1,Control1)|Q1] , after_cut-_).
|
|
|
138 c_body(A, Control, ['$t'(System,F,K,Control)|Q],
|
|
|
139 ['$t'(System1,F,K,Control)|Q], Cut) :-
|
|
|
140 c_system(A, System, System1, Control, Cut), !.
|
|
|
141 c_body(A, Control,
|
|
|
142 ['$t'((A1,Now),F,K,Control)|Q],
|
|
|
143 ['$t'(Now,F,K,Control)|Q1], Cut-Cut) :- !,
|
|
|
144 c_make_pred(A,A1,Q,Q1).
|
|
|
145
|
|
|
146 c_make_pred(X, XX, Q, T) :-
|
|
|
147 functor(X, F, A),
|
|
|
148 A1 is A+1, A2 is A+2,
|
|
|
149 functor(XX, F, A2),
|
|
|
150 c_copy_args(A, X, XX),
|
|
|
151 arg(A1, XX, Q), arg(A2, XX, T).
|
|
|
152
|
|
|
153 c_copy_args(0, _, _) :- !.
|
|
|
154 c_copy_args(K, X, XX) :-
|
|
|
155 arg(K, X, XK), arg(K, XX, XK), K1 is K-1, c_copy_args(K1, X, XX).
|
|
|
156
|
|
|
157 c_system(true,Q, Q, _, Cut-Cut) :- !.
|
|
|
158 c_system('r_read_value'(A,B),('r_read_value'(A1,B),Q), Q, _, Cut-Cut) :- !,
|
|
|
159 c_seperate_now(A,A1).
|
|
|
160 c_system(!, (!,Q), Q, _, _Cut-after_cut) :- !.
|
|
|
161 c_system(prolog(A), (call(A1),Q), Q, _, Cut-Cut) :- !, c_seperate_now(A,A1).
|
|
|
162 %% c_system(A<--B, Q, Q1, Control, Cut-Cut) :- !,
|
|
|
163 %% c_eval(B, V, Q, Q2, Control),
|
|
|
164 %% (A = '$CNT'(V),!,Q1=Q2 ; Q2 = (unifyAll(A,V),Q1)).
|
|
|
165 c_system(*A:=B, Q, Q1, Control, Cut-Cut) :- !,
|
|
|
166 '$'(_Fin,'$REF'(NowTime),_Empty)=Control,
|
|
|
167 c_eval(A, Name, Q, Q2, Control),
|
|
|
168 c_eval(B, Value, Q2, ('r_set_value'(Name,Value,NowTime),Q1), Control).
|
|
|
169 c_system(Op, Q, Q1, Control, Cut-Cut) :- n_predicate(Op,A,B,Op2,AA,BB),!,
|
|
|
170 c_eval(A, AA, Q, Q2, Control), c_eval(B, BB, Q2, (Op2,Q1), Control).
|
|
|
171 c_system(System,(System1,Q), Q, _, Cut-Cut) :- systemp(System),
|
|
|
172 c_seperate_now(System,System1).
|
|
|
173
|
|
|
174 % compile chop operator
|
|
|
175 %
|
|
|
176 % c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1).
|
|
|
177
|
|
|
178 c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1) :-
|
|
|
179
|
|
|
180 % 0r(X, '$'(Q,Q1,QF,QF1))
|
|
|
181
|
|
|
182 functor(Later, LH1, A),
|
|
|
183 A1 is A+1,
|
|
|
184 functor(GenerateLater, LH1, A1),
|
|
|
185 arg(A1, GenerateLater, '$'(Q,Q1,QF,QF1)),
|
|
|
186 c_skel_copy_arg(0, 0, A, Later, GenerateLater),
|
|
|
187
|
|
|
188 % 0r(X, '$'(Q, Q1, QF, QF1)) :- 'r_subFin'(QF, QF1),r(X, Q, Q1).
|
|
|
189
|
|
|
190 functor(Later0, LH1, A),
|
|
|
191 c_make_pred(Later0, Later1, QQ, QQ1),
|
|
|
192 functor(L2, LH1, A1),
|
|
|
193 arg(A1, L2, '$'(QQ,QQ1,QQF,QQF1)),
|
|
|
194 c_skel_copy_arg(0, 0, A, Later0, L2),
|
|
|
195 write_clause( (L2 :- 'r_subFin'(QQF,QQF1), Later1)),
|
|
|
196
|
|
|
197 % 0r(X, '$'(Q, Q1, QF, QF1)) :-
|
|
|
198 % 'r_subNotFin'(
|
|
|
199 % 0r(Xn,'$'(NQ,NQ1,NQF,NQF1)), '$'(NQ,NQ1,NQF,NQF1),
|
|
|
200 % '$'(Q, Q1, QF, QF1)).
|
|
|
201
|
|
|
202 functor(Later00, LH1, A),
|
|
|
203 functor(L3, LH1, A1),
|
|
|
204 arg(A1, L3, '$'(QQ,QQ1,QQF,QQF1)),
|
|
|
205 functor(L4, LH1, A1),
|
|
|
206 arg(A1, L4, '$'(NQQ,NQQ1,NQQF,NQQF1)),
|
|
|
207 c_seperate_next(Later00,Later00Next),
|
|
|
208 c_skel_copy_arg(0, 0, A, Later00Next, L4),
|
|
|
209 c_args(0,A,Later00, L3, Body,
|
|
|
210 'r_subNotFin'( L4, '$'(NQQ,NQQ1,NQQF,NQQF1),
|
|
|
211 QQ, QQ1, QQF, QQF1)),
|
|
|
212 write_clause(( L3 :- Body )).
|
|
|
213
|
|
|
214 %%
|
