Version 1.0.0-rc17 has been released. Some changes are:
[bpt/coccinelle.git] / ctl / test_ctl.ml
CommitLineData
f537ebc4 1(*
17ba0788
C
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
f537ebc4
C
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
9 *
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
13 *
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
18 *
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
21 *
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
24 *)
25
26
feec80c3 27# 0 "./test_ctl.ml"
34e49164
C
28
29(* ********************************************************************** *)
30(* Module: EXAMPLE_ENGINE (instance of CTL_ENGINE) *)
31(* ********************************************************************** *)
32
33(* Simple env.: meta.vars and values are strings *)
34module SIMPLE_ENV =
35 struct
36 type value = string;;
37 type mvar = string;;
38 let eq_mvar x x' = x = x';;
39 let eq_val v v' = v = v';;
40 let merge_val v v' = v;;
41 end
42;;
43
44(* Simple predicates *)
ae4735db 45module WRAPPER_PRED =
34e49164
C
46 struct
47 type predicate = string
48 end
49
ae4735db 50module EXAMPLE_ENGINE =
34e49164
C
51 Wrapper_ctl.CTL_ENGINE_BIS (SIMPLE_ENV) (Ctl_engine.OGRAPHEXT_GRAPH) (WRAPPER_PRED)
52
53let top_wit = []
54
55(* ******************************************************************** *)
56(* *)
57(* EXAMPLES *)
58(* *)
59(* ******************************************************************** *)
60
61(* For convenience in the examples *)
62(* FIX ME: remove *)
63open Ctl_engine.OGRAPHEXT_GRAPH;;
64open EXAMPLE_ENGINE;;
65open Ast_ctl;;
66
67(* ---------------------------------------------------------------------- *)
68(* Helpers *)
69(* ---------------------------------------------------------------------- *)
70
71(* FIX ME: move to ENGINE module *)
72let (-->) x v = Subst (x,v);;
73
74(* FIX ME: move to ENGINE module *)
75let (-/->) x v = NegSubst(x,v);;
76
ae4735db 77let mkgraph nodes edges =
34e49164 78 let g = ref (new Ograph_extended.ograph_extended) in
ae4735db
C
79 let addn (n,x) =
80 (* let (g',i) = (!g)#add_node x in *)
81 (* now I need to force the nodei of a node, because of the state(vx) predicates
34e49164
C
82 hence add_node -> add_nodei
83 *)
84 let (g', i) = !g#add_nodei n x in
85 assert (i = n);
86 g := g'; (n,i) in
ae4735db 87 let adde anodes (n1,n2,x) =
34e49164
C
88 let g' = (!g)#add_arc ((List.assoc n1 anodes,List.assoc n2 anodes),x) in
89 g := g'; () in
90 let add_nodes = List.map addn nodes in
91 let _add_edges = List.map (adde add_nodes) edges in
92 !g
93;;
94
95
96(* CTL parameterised on basic predicates and metavar's*)
ae4735db 97type ('pred,'mvar) old_gen_ctl =
34e49164
C
98 | False_
99 | True_
100 | Pred_ of 'pred
101 | Not_ of ('pred,'mvar) old_gen_ctl
102 | Exists_ of 'mvar * ('pred,'mvar) old_gen_ctl (* !!! *)
103 | And_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
104 | Or_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
105 | Implies_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
106 | AF_ of ('pred,'mvar) old_gen_ctl
107 | AX_ of ('pred,'mvar) old_gen_ctl
108 | AG_ of ('pred,'mvar) old_gen_ctl
109 | AU_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
110 | EF_ of ('pred,'mvar) old_gen_ctl
111 | EX_ of ('pred,'mvar) old_gen_ctl
112 | EG_ of ('pred,'mvar) old_gen_ctl
113 | EU_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
114 | Let_ of string * ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl
115 | Ref_ of string
116
117let rec mkanno phi0 =
118 let anno phi = (phi,None) in
119 match phi0 with
120 | False_ -> anno False
121 | True_ -> anno True
122 | Pred_(p) -> anno (Pred(p))
123 | Not_(phi) -> anno (Not(mkanno phi))
124 | Exists_(v,phi) -> anno (Exists(v,mkanno phi))
125 | And_(phi1,phi2) -> anno (And(mkanno phi1,mkanno phi2))
126 | Or_(phi1,phi2) -> anno (Or(mkanno phi1,mkanno phi2))
127 | Implies_(phi1,phi2) -> anno (Implies(mkanno phi1,mkanno phi2))
128 | AF_(phi1) -> anno (AF(mkanno phi1))
129 | AX_(phi1) -> anno (AX(mkanno phi1))
130 | AG_(phi1) -> anno (AG(mkanno phi1))
131 | AU_(phi1,phi2) -> anno (AU(mkanno phi1,mkanno phi2))
132 | EF_(phi1) -> anno (EF(mkanno phi1))
133 | EX_(phi1) -> anno (EX(mkanno phi1))
134 | EG_(phi1) -> anno (EG(mkanno phi1))
135 | EU_(phi1,phi2) -> anno (EU(mkanno phi1,mkanno phi2))
136 | Let_ (x,phi1,phi2) -> anno (Let(x,mkanno phi1,mkanno phi2))
137 | Ref_(s) -> anno (Ref(s))
138
139
140(* ******************************************************************** *)
141(* Example 1 *)
142(* CTL: f(x) /\ AF(Ey.g(y)) *)
143(* ******************************************************************** *)
144
145let ex1lab s =
146 match s with
147 | "f(x)" -> [(0,["x" --> "1"]); (1,["x" --> "2"])]
148 | "g(y)" -> [(3,["y" --> "1"]); (4,["y" --> "2"])]
149 | "f(1)" -> [(0,[])]
150 | "f(2)" -> [(1,[])]
151 | "g(1)" -> [(3,[])]
152 | "g(2)" -> [(4,[])]
153 | _ -> []
154;;
155
ae4735db
C
156let ex1graph =
157 let nodes =
34e49164
C
158 [(0,"f(1)");(1,"f(2)");(2,"< >");(3,"g(1)");(4,"g(2)");(5,"<exit>")] in
159 let edges = [(0,2); (1,2); (2,3); (2,4); (3,5); (4,5); (5,5)] in
160 mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges)
161;;
162
163let ex1states = List.map fst (ex1graph#nodes)#tolist;;
164
165let ex1model = (ex1graph,ex1lab,ex1states);;
166let ex1model_wrapped = (ex1graph,wrap_label ex1lab,ex1states);;
167
168let ex1s0 = Exists_("v0",Pred_ ("f(x)",UnModif "v0"));;
169let ex1s1 = Exists_("v1",Pred_ ("g(y)",Modif "v1"));;
170let ex1s2 = Exists_("y",ex1s1);;
171let ex1s3 = AF_(ex1s2);;
172let ex1s4 = And_(ex1s0,ex1s3);;
173
174let ex1s3a = AX_(ex1s2);;
175let ex1s4a = AX_(AX_(ex1s2));;
176let ex1s5a = And_(ex1s0,ex1s4a);;
177
178let ex1s0b = Pred_ ("g(y)", Modif "v0");;
179let ex1s1b = Exists_ ("v0",ex1s0b);;
180let ex1s2b = Exists_ ("y",ex1s1b);;
181let ex1s3b = AF_(ex1s2b);;
182let ex1s4b = AX_(ex1s3b);;
183let ex1s5b = Pred_ ("f(x)", UnModif "v3");;
184let ex1s6b = Exists_ ("v3", ex1s5b);;
185let ex1s7b = Exists_ ("x", ex1s6b);;
186let ex1s8b = And_(ex1s7b,ex1s4b);;
187
188let ex1s7c = And_(ex1s6b,ex1s4b);;
189let ex1s8c = Exists_("x",ex1s7c);;
190
191let ex1phi1 = ex1s4;;
192let ex1phi2 = ex1s5a;;
ae4735db 193let ex1phi3 =
34e49164
C
194 And_
195 (Exists_ ("x",
196 (Exists_ ("v3",
197 Pred_ ("f(x)", UnModif "v3")))),
198 AX_
199 (AF_
200 (Exists_ ("y", (* change this to Y and have strange behaviour *)
201 (Exists_ ("v0",
202 Pred_ ("g(y)", Modif "v0")
203 ))))));;
204
ae4735db 205let ex1phi4 =
34e49164
C
206 Exists_ ("x",
207 And_ (
208 (Exists_ ("v3",
209 Pred_ ("f(x)", UnModif "v3"))),
210 AX_
211 (AF_
212 (Exists_ ("y", (* change this to Y and have strange behaviour *)
213 (Exists_ ("v0",
214 Pred_ ("g(y)", Modif "v0")
215 )))))));;
216
217
218let ex1phi5 = AU_(True_,Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))));;
219
ae4735db 220let ex1phi6 =
34e49164
C
221 AU_(
222 Not_(Exists_("x",Exists_("v1",Pred_("f(x)",UnModif "v1")))),
223 Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0")))
224 );;
225
226(* use with ex1nc *)
ae4735db 227let ex1phi7 =
34e49164
C
228 AU_(
229 Not_(Or_(Pred_("f(1)",Control),Pred_("f(2)",Control))),
230 Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0")))
231 );;
232
233let ex1 phi = satbis ex1model (mkanno phi);;
234let ex1nc phi = satbis_noclean ex1model (mkanno phi);;
235
236
237(* ******************************************************************** *)
238(* Example 2 *)
239(* ******************************************************************** *)
240
241let ex2lab s =
242 match s with
243 | "p" -> [0,[]]
244 | "{" -> [(1,[]); (2,[])]
245 | "}" -> [(3,[]); (4,[])]
ae4735db 246 | "paren(v)" -> [(1,["v" --> "1"]); (2,["v" --> "2"]);
34e49164
C
247 (3,["v" --> "2"]); (4,["v" --> "1"])]
248 | _ -> []
249;;
250
ae4735db
C
251let ex2graph =
252 let nodes =
34e49164
C
253 [(0,"p");(1,"{");(2,"{");(3,"}");(4,"}");(5,"<exit>")] in
254 let edges = [(0,1); (1,2); (2,3); (3,4); (4,5); (5,5)] in
255 mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges)
256;;
257
258let ex2states = List.map fst (ex2graph#nodes)#tolist;;
259
260let ex2model = (ex2graph,ex2lab,ex2states);;
261let ex2model_wrapped = (ex2graph,wrap_label ex2lab,ex2states);;
262
263let ex2s0 = Pred_("p",Control);;
264let ex2s1 = Pred_("{",Control);;
265let ex2s2 = Pred_("paren(v)",Control);;
266let ex2s3 = And_(ex2s1,ex2s2);;
267let ex2s4 = Pred_("}",Control);;
268let ex2s5 = Pred_("paren(v)",Control);;
269let ex2s6 = And_(ex2s4,ex2s5);;
270let ex2s7 = AF_(ex2s6);;
271let ex2s8 = And_(ex2s3,ex2s7);;
272let ex2s9 = Exists_("v",ex2s8);;
273let ex2s10 = AX_(ex2s9);;
274let ex2s11 = And_(ex2s0,ex2s10);;
275
276let ex2phi1 = ex2s11;;
277
278let ex2 phi = satbis_noclean ex2model (mkanno phi)
279
280(*
281 +--- s11:& ---+
282 | |
283 s0:p s10:AX
284 |
285 s9:exists v
286 |
287 +---------- s8:& --------+
288 | |
289 +-- s3:& --+ s7:AF
290 | | |
291 s1:"{" s2:paren(v) +-- s6:& -+
292 | |
293 s4:"}" s5:paren(v)
294
295 s0 : p : (0,_,_)
296 s1 : "{" : (1,_,_); (2,_,_)
297 s2 : paren(v) : (1,v=1,_); (2,v=2,_); (3,v=2,_); (4,v=1,_)
298 s3 : "{" & paren(v) : (1,v=1,_); (2,v=2,_)
299 s4 : "}" : (3,_,_); (4,_,_)
300 s5 : paren(v) : (1,v=1,_); (2,v=2,_); (3,v=2,_); (4,v=1,_)
301 s6 : "}" & paren(v) : (3,v=2,_); (4,v=1,_)
302 s7 : AF(...) : (0;1;2;3,v=2,_); (0;1;2;3;4,v=1,_)
303 s8 : (...&...) & AF(...) : (1,v=1,_); (2,v=2,_)
304 s9 : exists ... : (1,_,(1,v=1)); (2,_,(2,v=2))
305 s10 : AX(...) : (0,_,(1,v=1)); (1,_,(2,v=2))
306 s11 : p & AX(...) : (0,_,(1,v=1))
307*)