|
2
|
1 /*
|
|
|
2 Copyright (C) 1991, Shinji Kono, Sony Computer Science Laboratory, Inc.
|
|
|
3 The University, Newcastle upton Tyne
|
|
|
4
|
|
|
5 Everyone is permitted to copy and distribute verbatim copies
|
|
|
6 of this license, but changing it is not allowed. You can also
|
|
|
7 use this wording to make the terms for other programs.
|
|
|
8
|
|
|
9 send your comments to kono@csl.sony.co.jp
|
|
22
|
10 $Id: kiss.pl,v 1.3 2007/08/30 05:16:36 kono Exp $
|
|
2
|
11 */
|
|
|
12
|
|
|
13 % :- dynamic st_variables/2.
|
|
|
14
|
|
20
|
15 set_input_var(L) :- r_abolish(input_variable_list,1),
|
|
2
|
16 asserta(input_variable_list(L)).
|
|
|
17
|
|
|
18 kiss :-
|
|
|
19 (variable_list(L);L=[]),
|
|
|
20 (st_variables(In,_);In=[]),
|
|
|
21 delete(L,In,Out),
|
|
|
22 write('# '),write_kiss_var_list(In),write((->)),
|
|
|
23 write_kiss_var_list(Out),nl,
|
|
|
24 % write('.v '),length(L,Ll),write(Ll),nl,
|
|
|
25 write('.p '),itl_transition(X),write(X),nl,
|
|
|
26 write('.s '),itl_state_number(Y),write(Y),nl,
|
|
|
27 write('.i '),length(In,Inl),write(Inl),nl,
|
|
|
28 write('.o '),length(Out,Outl),write(Outl),nl,
|
|
|
29 kiss(In,Out).
|
|
|
30
|
|
|
31 kiss(In,Out) :-
|
|
|
32 state(S,Cond,D),
|
|
|
33 write_kiss(S,Cond,D,In,Out),fail.
|
|
|
34 kiss(_,_) :- write('.e'),nl.
|
|
|
35
|
|
|
36 write_kiss_var_list([]):-!.
|
|
|
37 write_kiss_var_list([H|L]):-!,write(H),put(32), % " "
|
|
|
38 write_kiss_var_list(L).
|
|
|
39
|
|
|
40 write_kiss(S,Cond,D,In,Out) :-
|
|
|
41 write_kiss_var(In,Cond),put(32), % " "
|
|
|
42 write_kiss_state(S),
|
|
|
43 write_kiss_state(D),
|
|
|
44 write_kiss_var(Out,Cond),nl,!.
|
|
|
45
|
|
|
46 write_kiss_state(0) :- !,
|
|
|
47 write(se),put(9).
|
|
|
48 write_kiss_state(true) :-!,
|
|
|
49 write(st),put(9).
|
|
|
50 write_kiss_state(false) :- !,
|
|
|
51 write(sf),put(9).
|
|
|
52 write_kiss_state(S) :- !,
|
|
|
53 write(s),write(S),put(9).
|
|
|
54
|
|
|
55 delete([],_,[]) :-!.
|
|
|
56 delete([H|X],L,Y) :- member(H,L),!,delete(X,L,Y).
|
|
|
57 delete([H|X],L,[H|Y]) :- delete(X,L,Y).
|
|
|
58
|
|
|
59 write_kiss_var([],_):-!.
|
|
|
60 write_kiss_var([H|L],Cond) :- member(H,Cond),!,write(1),
|
|
|
61 write_kiss_var(L,Cond).
|
|
|
62 write_kiss_var([H|L],Cond) :- member(not(H),Cond),!,write(0),
|
|
|
63 write_kiss_var(L,Cond).
|
|
|
64 write_kiss_var([_|L],Cond) :- write(-),
|
|
|
65 write_kiss_var(L,Cond).
|
|
|
66
|
|
|
67 tgen :-
|
|
|
68 (variable_list(L);L=[]),
|
|
|
69 (st_variables(In,_);In=[]),
|
|
|
70 delete(L,In,Out),
|
|
|
71 write(('?-'(static(L)))),put(46),nl, % "."
|
|
|
72 make_print_state(L,L1,LL),
|
|
|
73 write((print_state :- L1,write(LL))),put(46),nl,
|
|
|
74 tgen(In,Out).
|
|
|
75 tgen(In,Out) :-
|
|
|
76 state(S,Cond,D),
|
|
|
77 write_tclause(S,Cond,D,In,Out),fail.
|
|
|
78 tgen(_,_).
|
|
|
79
|
|
|
80 make_print_state([H],(H1= *(H)),((H) = H1)):-!.
|
|
|
81 make_print_state([H|L],((H1= *(H)),L1),(((H) = H1),LL1)):-
|
|
|
82 make_print_state(L,L1,LL1).
|
|
|
83
|
|
|
84 write_tclause(S,[empty|Cond],true,In,Out) :-!,
|
|
|
85 write_tstate(S), write(' :- '), % write(empty),put(44), % ","
|
|
|
86 write_tcondition(In,Out,Cond),
|
|
|
87 write(true), put(46),nl. % true, empty or false "."
|
|
|
88 write_tclause(_S,[empty|_Cond],false,_In,_Out) :-!.
|
|
|
89 %write_tclause(S,[empty|Cond],false,In,_Out) :-!,
|
|
|
90 % write_tstate(S), write(' :- '),write(empty),put(44),
|
|
|
91 % write_tcondition(In,[],Cond), % don't touch output
|
|
|
92 % write(fail),put(46),nl. % true, empty or false
|
|
|
93 write_tclause(S,[empty|Cond],D,In,Out) :-!,
|
|
|
94 write_tstate(S), write(' :- '), % write(empty),put(44), % ","
|
|
|
95 write_tcondition(In,Out,Cond),
|
|
|
96 write_tstate(D),put(46),nl. % true, empty or false "."
|
|
|
97 write_tclause(_S,[more|_Cond],false,_In,_Out) :-!.
|
|
|
98 %write_tclause(S,[more|Cond],false,In,_Out) :-!,
|
|
|
99 % write_tstate(S), write(' :- '),write(more),put(44), % ","
|
|
|
100 % write_tcondition(In,[],Cond), % don't touch output
|
|
|
101 % write(fail), put(46),nl.
|
|
|
102 write_tclause(S,[more|Cond],true,In,Out) :-!,
|
|
|
103 write_tstate(S), write(' :- '),write(more),put(44),
|
|
|
104 write_tcondition(In,Out,Cond),
|
|
|
105 write(true), put(46),nl.
|
|
|
106 write_tclause(S,[more|Cond],D,In,Out) :-!,
|
|
|
107 write_tstate(S), write(' :- '),write(more),put(44),
|
|
|
108 write_tcondition(In,Out,Cond),
|
|
|
109 write((@)),write_tstate(D),
|
|
|
110 put(46),nl.
|
|
|
111
|
|
|
112 write_tcondition(In,Out,Cond) :-
|
|
|
113 write_tvar(In,Cond,'= '),
|
|
|
114 write_tvar(Out,Cond,':= ').
|
|
|
115 write_tvar([],_,_):-!.
|
|
|
116 write_tvar([H|L],Cond,Eq) :- member(H,Cond),!,
|
|
|
117 write(*(H)),write(Eq),write(1),put(44),
|
|
|
118 write_tvar(L,Cond,Eq).
|
|
|
119 write_tvar([H|L],Cond,Eq) :- member(not(H),Cond),!,
|
|
|
120 write(*(H)),write(Eq),write(0),put(44),
|
|
|
121 write_tvar(L,Cond,Eq).
|
|
|
122 write_tvar([_|L],Cond,Eq) :-
|
|
|
123 write_tvar(L,Cond,Eq).
|
|
|
124
|
|
|
125 write_tstate(0) :- !,
|
|
|
126 write(empty).
|
|
|
127 write_tstate(true) :-!,
|
|
|
128 write(true).
|
|
|
129 write_tstate(false) :- !,
|
|
|
130 write(fail).
|
|
|
131 write_tstate(S) :- !,
|
|
|
132 write(s),write(S).
|
|
|
133
|
|
|
134 /*
|
|
|
135
|
|
|
136 KISS2 format
|
|
|
137
|
|
|
138 .i 4
|
|
|
139 .o 2
|
|
|
140 .p 60
|
|
|
141 .s 10
|
|
|
142 --01 st0 st0 00
|
|
|
143
|
|
|
144 */
|
|
|
145
|
|
|
146 read_kiss(File) :-
|
|
|
147 read_kiss(File,empty).
|
|
|
148
|
|
|
149 read_kiss(File,Emode) :-
|
|
|
150 see(File),
|
|
|
151 get0(C), read_kiss_header(C,C1,IL,OL),
|
|
|
152 nonvar(IL),nonvar(OL),
|
|
|
153 make_vars(IL,"i",0,In),
|
|
|
154 make_vars(OL,"o",0,Out),
|
|
|
155 init_read_kiss(In,Out,IL,OL),
|
|
|
156 read_kiss_body(C1,In,Out,Emode),
|
|
|
157 seen.
|
|
|
158 read_kiss(_,_) :- write('Error'),nl,seen.
|
|
|
159
|
|
|
160 make_vars(N,_,_,[]) :- N =< 0,!.
|
|
|
161 make_vars(N,V,M,[H|L]) :-!,
|
|
|
162 name(M,LM),append(V,LM,LH), name(H,LH),
|
|
|
163 N1 is N-1,M1 is M+1,
|
|
|
164 make_vars(N1,V,M1,L).
|
|
|
165
|
|
|
166 read_kiss(File,In,Out,Emode) :-
|
|
|
167 see(File),
|
|
|
168 read_kiss(In,Out,Emode),!,
|
|
|
169 seen.
|
|
|
170 read_kiss(_,_,_,_) :- write('Error'),nl,seen.
|
|
|
171
|
|
|
172 read_kiss(In,Out,Emode) :-
|
|
|
173 get0(C), read_kiss_header(C,C1,IL1,OL1),
|
|
|
174 ((var(In),make_vars(IL1,"i",0,In));true),
|
|
|
175 ((var(Out),make_vars(OL1,"o",0,Out));true),
|
|
|
176 init_read_kiss(In,Out,IL,OL),
|
|
|
177 check_vars(IL,OL,IL1,OL1),
|
|
|
178 read_kiss_body(C1,In,Out,Emode).
|
|
|
179
|
|
|
180 init_read_kiss(In,Out,IL,OL) :-
|
|
20
|
181 r_abolish(st_variables,2),
|
|
|
182 r_abolish(st,3),
|
|
2
|
183 assert(st_variables(In,Out)),
|
|
|
184 assert(st(true,true,true)),
|
|
|
185 length(In,IL),length(Out,OL).
|
|
|
186
|
|
|
187 check_vars(IL,0,IL,_) :-!. % ignore output
|
|
|
188 check_vars(IL,OL,IL,OL) :-!.
|
|
|
189 check_vars(IL,_OL,IL1,_OL1) :-IL=\=IL1,
|
|
|
190 write('Input variable number is wrong'),nl,fail.
|
|
|
191 check_vars(_IL,OL,_IL1,OL1) :-OL=\=OL1,
|
|
|
192 write('Output variable number is wrong'),nl,fail.
|
|
|
193
|
|
|
194 read_kiss_header(C,C2,IL,OL) :-[C]=".",!, get(C0),
|
|
|
195 read_kiss_header1(C0,C1,IL,OL),
|
|
|
196 read_kiss_header(C1,C2,IL,OL).
|
|
|
197 read_kiss_header(C,C,_,_) :-([C]="0";[C]="1";[C]="-"),!.
|
|
|
198 read_kiss_header(C,C1,IL,OL) :-
|
|
|
199 skip_line(C,C0),
|
|
|
200 read_kiss_header(C0,C1,IL,OL).
|
|
|
201
|
|
19
|
202 read_kiss_header1(C,C2,IL,_OL):-[C]="i",!,get(C0),
|
|
|
203 read_number(C0,C1,IL),skip_line(C1,C2).
|
|
|
204 read_kiss_header1(C,C2,_IL,OL):-[C]="o",!,get(C0),
|
|
|
205 read_number(C0,C1,OL),skip_line(C1,C2).
|
|
|
206 read_kiss_header1(C,C1,_,_):-[C]="p",!,
|
|
|
207 skip_line(C,C1).
|
|
|
208 read_kiss_header1(C,C1,_,_):-[C]="s",!,
|
|
|
209 skip_line(C,C1).
|
|
|
210 read_kiss_header1(C,C1,_,_):-
|
|
|
211 skip_line(C,C1).
|
|
|
212
|
|
2
|
213 read_kiss_body(-1,_,_,_) :-!.
|
|
|
214 read_kiss_body(C,In,Out,Emode) :-
|
|
|
215 ([C]="0";[C]="1";[C]="-"),!,
|
|
|
216 read_kiss_var(In ,C, _, In1),get(C1),
|
|
|
217 read_kiss_state(C1,C2,S),
|
|
|
218 read_kiss_state(C2,C3,D),
|
|
|
219 read_kiss_var(Out,C3,C4,Out1),
|
|
|
220 assert_state(Emode,S,In1,Out1,D),
|
|
|
221 skip_line(C4,C5),
|
|
|
222 read_kiss_body(C5,In,Out,Emode).
|
|
|
223 read_kiss_body(C,In,Out,Emode) :-
|
|
|
224 skip_line(C,C1),
|
|
|
225 read_kiss_body(C1,In,Out,Emode).
|
|
|
226
|
|
|
227 assert_state(_,S,In1,Out1,D) :-
|
|
|
228 st(S,_,_),!,
|
|
|
229 assertz(st(S,(In1,Out1),D)).
|
|
|
230 assert_state(empty,S,In1,Out1,D) :-!,
|
|
|
231 assertz(st(S,empty,empty)),
|
|
|
232 assertz(st(S,(In1,Out1),D)).
|
|
|
233 assert_state(_,S,In1,Out1,D) :-
|
|
|
234 assertz(st(S,(In1,Out1),D)).
|
|
|
235
|
|
|
236 read_kiss_var([],C, C, true):-!.
|
|
|
237 read_kiss_var([_],C, C1, true):- [C]="-",!,get0(C1).
|
|
|
238 read_kiss_var([H],C, C1, not(H)):- [C]="0",!,get0(C1).
|
|
|
239 read_kiss_var([H],C, C1, H):- [C]="1",!,get0(C1).
|
|
|
240 read_kiss_var([H|L],C, C1, O):-
|
|
|
241 kiss_var([C],H,O,O1),!,get0(C0),
|
|
|
242 read_kiss_var(L,C0,C1,O1).
|
|
|
243 read_kiss_var(L,_, C1, O):- get0(C),
|
|
|
244 read_kiss_var(L,C, C1, O).
|
|
|
245
|
|
|
246 kiss_var("-",_,O,O).
|
|
|
247 kiss_var("0",H,(not(H),O),O).
|
|
|
248 kiss_var("1",H,(H,O),O).
|
|
|
249
|
|
|
250 read_number(C,C1,N) :- read_number1(C,C1,NL),name(N,NL).
|
|
|
251 read_number(_,_,0) :- write('A number is expected.'),nl.
|
|
|
252 read_number1(C,C1,[C|L]) :-
|
|
|
253 ([C]="0"; [C]="1"; [C]="2"; [C]="3"; [C]="4"; [C]="5";
|
|
|
254 [C]="6"; [C]="7"; [C]="8"; [C]="9"),!,get0(C2),
|
|
|
255 read_number1(C2,C1,L).
|
|
|
256 read_number1(C,C,[]).
|
|
|
257
|
|
|
258 read_kiss_state(C,C1,N) :- read_kiss_state1(C,C1,NL),name(N,NL).
|
|
|
259 read_kiss_state(_,_,0) :- write('A kiss_state is expected.'),nl.
|
|
|
260 read_kiss_state1(C,C1,[C|L]) :-
|
|
|
261 [Z]="0",C>=Z, !,
|
|
|
262 get0(C2),
|
|
|
263 read_kiss_state1(C2,C1,L).
|
|
|
264 read_kiss_state1(C,C1,[]) :-
|
|
|
265 skip_space(C,C1),!.
|
|
|
266
|
|
20
|
267 skip_space(C,C1):- ([C]=[32];[C]=[9]),!,
|
|
2
|
268 get(C0),skip_space(C0,C1).
|
|
|
269 skip_space(C,C).
|
|
|
270
|
|
|
271 skip_line(10,C) :- !,get0(C).
|
|
|
272 skip_line(-1,C) :- !,C= -1.
|
|
|
273 skip_line(_,C) :- get0(C0),skip_line(C0,C).
|
|
|
274
|
|
|
275 /* end */
|
