annotate chop.pl @ 10:f2aa38ce0787

add state display.
author kono
date Fri, 19 Jan 2001 23:14:00 +0900
parents 1c57a78f1d98
children e1d3145cff7a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
1 /*
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
2 Copyright (C) 1991, Shinji Kono, Sony Computer Science Laboratory, Inc.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
3 The University, Newcastle upton Tyne
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
4
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
5 Everyone is permitted to copy and distribute verbatim copies
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
6 of this license, but changing it is not allowed. You can also
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
7 use this wording to make the terms for other programs.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
8
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
9 send your comments to kono@csl.sony.co.jp
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
10 $Header$
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
11 */
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
12 :-dynamic define/2.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
13 % ITL chop standard form
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
14 % requires ndcomp
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
15
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
16 def(~(P),not(P)). % not
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
17 def((P->Q),(not(P);Q)). % imply
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
18 def(P<->Q,((not(P);Q),(P; not(Q)))). % equiv
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
19 def(P=Q,((not(P);Q),(P; not(Q)))). % equiv
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
20 def((P && Q),((not(empty),P) & Q)). % strong chop
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
21 def('<>'(Q),(true & Q)). % sometime
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
22 def('#'(Q), not(true & not(Q))). % always
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
23 def('[]'(Q), not(true & not(Q))). % always
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
24 def('[a]'(Q), not(true & not(Q) & true)). % always with arbitary fin
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
25 def('<a>'(Q), (true & Q & true)). % sometime with arbitary fin
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
26 def(fin(Q),(true & (empty,Q))). % final state in the interval
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
27 def(keep(Q), not(true & not((empty ; Q)))). % except final state
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
28 def(halt(Q), '[]'(empty=Q)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
29 def(more, not(empty)). % non empty interval
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
30 % discrete stuff
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
31 def(skip, @(empty)). % 1 length interval
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
32 def(infinite, (true & false)). %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
33 def(finite, ~((true & false))). %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
34 def(length(I), X):- I>=0 ,def_length(I,X). % length operator
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
35 def_length(I,empty):-I=<0,!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
36 def_length(I,@ X):-I1 is I-1,def_length(I1,X).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
37 def(less(I), X):- I>=0 ,def_less(I,X). % less than N length
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
38 def_less(I,false):-I=<0,!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
39 def_less(I,next(X)):-I1 is I-1,def_less(I1,X).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
40 def(next(P),(empty; @(P))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
41 % temporal assignments
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
42 def(gets(A,B),keep(@A<->B)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
43 def(stable(A),keep(@A<->A)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
44 def(state(A),(share(A),'[]'(L))):- def_state(A,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
45 def_state([H],H):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
46 def_state([H|L],(H;L1)):-def_state(L,L1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
47 % def(Q=>P,exists(R,(Q = R,stable(R),fin(P = R)))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
48 % easier one
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
49 % def(Q=>P,(Q & (empty,P); ~Q & (empty, ~P))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
50 % def(P<=Q,Q=>P).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
51 % loop stuff and quantifiers
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
52 def(+A ,(A & *((empty;A)))). % weak closure
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
53 def(while(Cond,Do), *(((Cond->Do) , (~Cond->empty)))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
54 def(repeat(Do,until,Cond), (*((Do;empty)) ,@ halt(Cond))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
55 def(all(P,Q),not(exists(P,not(Q)))):-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
56 atomic(P). % more check is necessary
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
57 def(local(P), (P = (P&true))):- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
58 % test predicates
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
59 def(trace(X,List),L) :- !,make_trace(List,X,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
60 make_trace([],_,true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
61 make_trace([1|T],X,(X,@L)):-!, make_trace(T,X,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
62 make_trace([true|T],X,(X,@L)):-!, make_trace(T,X,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
63 make_trace([0|T],X,(not(X),@L)):-!, make_trace(T,X,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
64 make_trace([_|T],X,(not(X),@L)):-!, make_trace(T,X,L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
65 def(even(P),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
66 exists(Q,(Q, keep( @Q = ~Q),'[]'((Q->P))))).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
67 def(evenp(P),(
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
68 *(((P,skip) & skip;empty,P)) & (empty;skip)
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
69 )).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
70 def(phil(L,R),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
71 +('[]'((~L, ~R)) & @ (L, ~R,@ (L,R, @ (R,'[]'( ~L)))) )).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
72 def(X,Y) :- define(X,Y).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
73
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
74 :-dynamic variable/1.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
75
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
76 expand(X,Y) :- init_variable,expand1(X,Y).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
77
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
78 expand1(V,V) :- var(V),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
79 expand1((P,Q),R) :- !,expand1(P,P1),expand1(Q,Q1),and(P1,Q1,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
80 expand1(st(R),st(R)) :- !,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
81 st_variables(In,Out),add_variable(In),add_variable(Out).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
82 % expand1([P|Q],R) :- !,expand1(P,P1),expand1(Q,Q1),and(P1,Q1,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
83 expand1((P;Q),R) :- !,expand1(P,P1),expand1(Q,Q1),or(P1,Q1,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
84 expand1((P&Q),R) :- !,expand1(P,P1),expand1(Q,Q1),chop_expand1(P1,Q1,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
85 chop_expand1(false,_,false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
86 % chop_expand1(_,false,false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
87 chop_expand1(true,true,true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
88 chop_expand1(P,Q,(P&Q)):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
89 expand1(not(Q),NQ):-!,expand1(Q,Q1),negate(Q1,NQ).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
90 expand1(exists(P,Q),exists(P,Q1)):-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
91 nonvar(P),name(P,[X|_]),X = 95,!, % "_" % reuse it...
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
92 expand1(Q,Q1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
93 expand1(exists(P,Q),exists(P,Q1)):-var(P),!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
94 new_var(P),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
95 expand1(Q,Q1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
96 expand1(exists(P,Q),exists(P,Q1)):-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
97 expand1(Q,Q1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
98 expand1([],[]):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
99 expand1([H|L],?(And,true,?(NAnd,false,true_false))):-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
100 % non-deterministic selection
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
101 expand_list([H|L],L1),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
102 all_and(L1,And),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
103 all_not(L1,NAnd).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
104 expand_list([],[]) :-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
105 expand_list([H|L],[H1|L1]) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
106 expand1(H,H1), expand_list(L,L1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
107 all_and([],true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
108 all_and([H|L],F):- all_and(L,F1),and(H,F1,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
109 all_not([],true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
110 all_not([H|L],F):- all_not(L,F1),negate(H,H1),and(H1,F1,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
111 expand1(^(R),^(R)):-!, % 2nd order variable
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
112 add_2var(R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
113 expand1(P,R) :- def(P,Q),!,expand1(Q,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
114 expand1(P,P) :- atomic(P),!, % for empty or skip
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
115 check_atomic(P).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
116 check_atomic(empty):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
117 check_atomic(more):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
118 check_atomic(true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
119 check_atomic(false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
120 check_atomic(true_false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
121 check_atomic(P) :- name(P,PL),PL=[95|_],!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
122 check_atomic(P) :- add_variable(P). % "_"
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
123 expand1(P,R) :- functor(P,H,N),functor(R,H,N),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
124 expand_arg(N,P,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
125 expand_arg(0,_P,_R):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
126 expand_arg(N,P,R):-arg(N,P,PA),arg(N,R,RA),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
127 N1 is N-1,expand1(PA,RA),expand_arg(N1,P,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
128
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
129 % do not use abolish here to avoid erase dynamic property of variable/1
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
130 init_variable :- retract(variable(_)),fail;true.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
131 add_variable([]):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
132 add_variable([X|T]) :- !,add_variable(X),add_variable(T).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
133 add_variable(X) :- variable(X),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
134 add_variable(X) :- assertz(variable(X)),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
135 variable_list(L) :- setof(X,variable(X),L).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
136
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
137 new_var(P) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
138 (retract(sbn(N));N=1),N1 is N+1,asserta(sbn(N1)),!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
139 name(N1,X),S = 95,name(P,[S|X]). % "_"
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
140
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
141 add_2var(R) :- length_limit(N),!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
142 add_variable(over(R,N)),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
143 add_2var(N,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
144 add_2var(R) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
145 add_variable(^(R)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
146 add_2var(0,R):-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
147 add_variable(^(R,0)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
148 add_2var(N,R):- N1 is N-1,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
149 add_variable(^(R,N)),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
150 add_2var(N1,R).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
151
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
152 and(false,_,false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
153 and(_,false,false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
154 and(true,T,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
155 and(T,true,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
156 and(T,T,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
157 and(A,B,(A,B)):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
158
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
159 or(true,_,true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
160 or(_,true,true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
161 or(false,T,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
162 or(T,false,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
163 or(T,T,T):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
164 or(A,B,(A;B)):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
165
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
166 negate(true,false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
167 negate(false,true):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
168 negate(true_false,true_false):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
169 negate(not(N),N):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
170 negate(N,not(N)):-!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
171
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
172 /* */