Skip to content

Commit 9d3d14f

Browse files
gauravparthagauravpartha
authored
Merge pull request #8 from viperproject/cfg_optimizations
Cfg optimizations (unreachable blocks and block coalescing)
2 parents 87dc3e1 + 7ee0531 commit 9d3d14f

File tree

11 files changed

+3791
-49
lines changed

11 files changed

+3791
-49
lines changed

‎BoogieLang/Ast.thy‎

Lines changed: 217 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,217 @@
1+
section \<open>Semantics of the AST\<close>
2+
3+
theory Ast
4+
imports Main Semantics Lang BackedgeElim
5+
6+
begin
7+
8+
subsection \<open>AST definition\<close>
9+
10+
type_synonym name = string
11+
type_synonym label = string
12+
type_synonym guard = expr
13+
type_synonym invariant = expr
14+
15+
datatype transfer_cmd
16+
= Goto label
17+
| Return
18+
19+
datatype parsed_structured_cmd
20+
= ParsedIf "guard option" "bigblock list" "bigblock list"
21+
| ParsedWhile "guard option" "invariant list" "bigblock list"
22+
| ParsedBreak nat
23+
| WhileWrapper parsed_structured_cmd
24+
25+
and bigblock
26+
= BigBlock "name option" "cmd list" "parsed_structured_cmd option" "transfer_cmd option"
27+
28+
29+
text \<open>A Boogie statement represented as an AST is a list of \<^typ>\<open>bigblock\<close>\<close>
30+
31+
type_synonym ast = "bigblock list"
32+
33+
subsection \<open>AST semantics\<close>
34+
35+
text \<open>We define a continuation-based small-step semantics.\<close>
36+
37+
datatype cont
38+
= KStop
39+
| KSeq "bigblock" cont
40+
| KEndBlock cont
41+
42+
type_synonym 'a ast_config = "bigblock * cont * ('a state)"
43+
44+
fun convert_list_to_cont :: "bigblock list \<Rightarrow> cont \<Rightarrow> cont" where
45+
"convert_list_to_cont [] cont0 = cont0"
46+
| "convert_list_to_cont (x#xs) cont0 = KSeq x (convert_list_to_cont xs cont0)"
47+
48+
text\<open>auxillary function to find the label a Goto statement is referring to\<close>
49+
fun find_label :: "label \<Rightarrow> bigblock list \<Rightarrow> cont \<Rightarrow> ((bigblock * cont) option)" where
50+
"find_label lbl [] cont = None"
51+
| "find_label lbl ((BigBlock bb_name cmds None None) # []) cont =
52+
(if (Some lbl = bb_name) then (Some ((BigBlock bb_name cmds None None), cont)) else (None))"
53+
| "find_label lbl ((BigBlock bb_name cmds None None) # bbs) cont =
54+
(if (Some lbl = bb_name)
55+
then (Some ((BigBlock bb_name cmds None None), (convert_list_to_cont ( bbs) cont)))
56+
else (find_label lbl bbs cont))"
57+
| "find_label lbl ((BigBlock bb_name cmds (Some (ParsedIf guard then_bbs else_bbs)) None) # bbs) cont =
58+
(if (Some lbl = bb_name)
59+
then (Some ((BigBlock bb_name cmds (Some (ParsedIf guard then_bbs else_bbs)) None), (convert_list_to_cont ( bbs) cont)))
60+
else (if (find_label lbl then_bbs cont \<noteq> None)
61+
then (find_label lbl (then_bbs @ bbs) cont)
62+
else (find_label lbl (else_bbs @ bbs) cont)))"
63+
| "find_label lbl ((BigBlock bb_name cmds (Some (ParsedWhile guard invariants body_bbs)) None) # bbs) cont =
64+
(if (Some lbl = bb_name)
65+
then (Some ((BigBlock bb_name cmds (Some (ParsedWhile guard invariants body_bbs)) None), (convert_list_to_cont ( bbs) cont)))
66+
else (if (find_label lbl body_bbs cont \<noteq> None)
67+
then (find_label lbl body_bbs (convert_list_to_cont ((bbs)@[(BigBlock None [] (Some (ParsedWhile guard invariants body_bbs)) None)]) cont))
68+
else (find_label lbl bbs cont)))"
69+
| "find_label lbl ((BigBlock bb_name cmds (Some (ParsedBreak n)) None) # bbs) cont =
70+
(if (Some lbl = bb_name)
71+
then (Some ((BigBlock bb_name cmds (Some (ParsedBreak n)) None), (convert_list_to_cont ( bbs) cont)))
72+
else (find_label lbl bbs cont))"
73+
| "find_label lbl ((BigBlock bb_name cmds (Some (WhileWrapper while_loop)) None) # bbs) cont =
74+
find_label lbl ((BigBlock bb_name cmds (Some while_loop) None) # bbs) cont"
75+
| "find_label lbl ((BigBlock bb_name cmds None (Some transfer_stmt)) # bbs) cont =
76+
(if (Some lbl = bb_name)
77+
then (Some ((BigBlock bb_name cmds None (Some transfer_stmt)), (convert_list_to_cont ( bbs) cont)))
78+
else (find_label lbl bbs cont))"
79+
| "find_label lbl ((BigBlock bb_name cmds (Some s) (Some t)) # bbs) cont = None"
80+
81+
fun get_state :: "'a ast_config \<Rightarrow> 'a state"
82+
where
83+
"get_state (bb, cont, s1) = s1"
84+
85+
fun is_final :: "'a ast_config \<Rightarrow> bool"
86+
where
87+
"is_final ((BigBlock bb_name [] None None), KStop, s1) = True"
88+
| "is_final other = False"
89+
90+
text \<open>Small-step semantics\<close>
91+
92+
inductive red_bigblock :: "'a absval_ty_fun \<Rightarrow> 'm proc_context \<Rightarrow> var_context \<Rightarrow> 'a fun_interp \<Rightarrow> rtype_env \<Rightarrow> ast \<Rightarrow> 'a ast_config \<Rightarrow> 'a ast_config \<Rightarrow> bool"
93+
("_,_,_,_,_,_ \<turnstile> (\<langle>_\<rangle> \<longrightarrow>/ _)" [51,0,0,0] 81)
94+
for A :: "'a absval_ty_fun" and M :: "'m proc_context" and \<Lambda> :: var_context and \<Gamma> :: "'a fun_interp" and \<Omega> :: rtype_env and T :: ast
95+
where
96+
RedSimpleCmds:
97+
"\<lbrakk>(A,M,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>cs, (Normal n_s)\<rangle> [\<rightarrow>] s1) \<and> (cs \<noteq> Nil) \<rbrakk>
98+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name cs str_cmd tr_cmd), cont0, Normal n_s)\<rangle> \<longrightarrow>
99+
((BigBlock bb_name [] str_cmd tr_cmd), cont0, s1)"
100+
101+
| RedFailure_or_Magic:
102+
"\<lbrakk> (s1 = Magic) \<or> (s1 = Failure); \<not> (is_final ((BigBlock bb_name [] str_cmd tr_cmd), cont0, s1)) \<rbrakk>
103+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name [] str_cmd tr_cmd), cont0, s1)\<rangle> \<longrightarrow>
104+
((BigBlock bb_name [] None None), KStop, s1)"
105+
106+
| RedSkip:
107+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name [] None None), (KSeq b cont0), Normal n_s)\<rangle> \<longrightarrow>
108+
(b, cont0, Normal n_s)"
109+
110+
| RedSkipEndBlock:
111+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name [] None None), (KEndBlock cont0), Normal n_s)\<rangle> \<longrightarrow>
112+
((BigBlock bb_name [] None None), cont0, Normal n_s)"
113+
114+
| RedReturn:
115+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>(BigBlock bb_name [] None (Some Return), cont0, Normal n_s)\<rangle> \<longrightarrow>
116+
((BigBlock bb_name [] None None), KStop, Normal n_s)"
117+
118+
| RedParsedIfTrue:
119+
"\<lbrakk>\<And> b. bb_guard = (Some b) \<Longrightarrow> A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>b, n_s\<rangle> \<Down> LitV (LBool True) \<rbrakk>
120+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name []
121+
(Some (ParsedIf bb_guard (then_hd # then_bbs) elsebigblocks)) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
122+
(then_hd, (convert_list_to_cont ( then_bbs) cont0), Normal n_s)"
123+
124+
| RedParsedIfFalse:
125+
"\<lbrakk>\<And>b. bb_guard = (Some b) \<Longrightarrow> A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>b, n_s\<rangle> \<Down> LitV (LBool False) \<rbrakk>
126+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name []
127+
(Some (ParsedIf bb_guard thenbigblocks (else_hd # else_bbs))) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
128+
(else_hd, (convert_list_to_cont ( else_bbs) cont0), Normal n_s)"
129+
130+
| RedParsedWhileWrapper:
131+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile>
132+
\<langle>((BigBlock bb_name []
133+
(Some (WhileWrapper str)) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
134+
((BigBlock bb_name []
135+
(Some str) None), (KEndBlock cont0), Normal n_s)"
136+
137+
| RedParsedWhile_InvFail:
138+
"\<lbrakk>\<And> b. bb_guard = (Some b) \<Longrightarrow> A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>b, n_s\<rangle> \<Down> LitV (LBool True);
139+
bb_invariants = invs1@[I]@invs2;
140+
expr_all_sat A \<Lambda> \<Gamma> \<Omega> n_s invs1;
141+
A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>I, n_s\<rangle> \<Down> BoolV False \<rbrakk>
142+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile>
143+
\<langle>((BigBlock bb_name []
144+
(Some (ParsedWhile bb_guard bb_invariants (bb_hd # body_bbs))) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
145+
((BigBlock bb_name [] None None), KStop, Failure)"
146+
147+
| RedParsedWhileTrue:
148+
"\<lbrakk>\<And> b. bb_guard = (Some b) \<Longrightarrow> A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>b, n_s\<rangle> \<Down> LitV (LBool True);
149+
(expr_all_sat A \<Lambda> \<Gamma> \<Omega> n_s bb_invariants) \<rbrakk>
150+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile>
151+
\<langle>((BigBlock bb_name []
152+
(Some (ParsedWhile bb_guard bb_invariants (bb_hd # body_bbs))) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
153+
(bb_hd, convert_list_to_cont ((body_bbs)@[(BigBlock bb_name [] (Some (ParsedWhile bb_guard bb_invariants (bb_hd # body_bbs))) None)]) cont0, Normal n_s)"
154+
155+
156+
| RedParsedWhileFalse:
157+
"\<lbrakk>\<And> b. bb_guard = (Some b) \<Longrightarrow> A,\<Lambda>,\<Gamma>,\<Omega> \<turnstile> \<langle>b, n_s\<rangle> \<Down> LitV (LBool False);
158+
(expr_all_sat A \<Lambda> \<Gamma> \<Omega> n_s bb_invariants) \<rbrakk>
159+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name []
160+
(Some (ParsedWhile bb_guard bb_invariants bigblocks)) None), cont0, Normal n_s)\<rangle> \<longrightarrow>
161+
((BigBlock bb_name [] None None), cont0, Normal n_s)"
162+
163+
| RedBreak0:
164+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name [] (Some (ParsedBreak 0)) None), (KEndBlock cont0), Normal n_s)\<rangle> \<longrightarrow>
165+
((BigBlock bb_name [] None None), cont0, Normal n_s)"
166+
167+
| RedBreakN:
168+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile>
169+
\<langle>((BigBlock bb_name [] (Some (ParsedBreak n)) None), (KSeq b cont0), Normal n_s)\<rangle> \<longrightarrow>
170+
((BigBlock None [] (Some (ParsedBreak n)) None), cont0, Normal n_s)"
171+
172+
| RedBreakNPlus1:
173+
"A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile>
174+
\<langle>((BigBlock bb_name [] (Some (ParsedBreak (n + 1))) None), (KEndBlock cont0), Normal n_s)\<rangle> \<longrightarrow>
175+
((BigBlock None [] (Some (ParsedBreak n)) None), cont0, Normal n_s)"
176+
177+
| RedGoto:
178+
"\<lbrakk> (find_label label T KStop) = Some (found_bigblock, found_cont) \<rbrakk>
179+
\<Longrightarrow> A,M,\<Lambda>,\<Gamma>,\<Omega>,T \<turnstile> \<langle>((BigBlock bb_name [] None (Some (Goto label))), cont0, Normal n_s)\<rangle> \<longrightarrow>
180+
(found_bigblock, found_cont, (Normal n_s))"
181+
182+
abbreviation red_bigblock_k_step :: "'a absval_ty_fun \<Rightarrow> 'm proc_context \<Rightarrow> var_context \<Rightarrow> 'a fun_interp \<Rightarrow> rtype_env \<Rightarrow> ast \<Rightarrow> 'a ast_config \<Rightarrow> nat \<Rightarrow> 'a ast_config \<Rightarrow> bool"
183+
("_,_,_,_,_,_ \<turnstile>_ -n\<longrightarrow>^_/ _" [51,0,0,0,0] 81)
184+
where "red_bigblock_k_step A M \<Lambda> \<Gamma> \<Omega> T c1 n c2 \<equiv> ((red_bigblock A M \<Lambda> \<Gamma> \<Omega> T)^^n) c1 c2"
185+
186+
subsection \<open>Procedure Correctness\<close>
187+
188+
text\<open>defining correctness of the AST\<close>
189+
190+
fun convert_ast_to_program_point :: "ast \<Rightarrow> bigblock \<times> cont" where
191+
"convert_ast_to_program_point [] = ((BigBlock None [] None None), KStop)"
192+
| "convert_ast_to_program_point (b#bs) = (b, convert_list_to_cont bs KStop)"
193+
194+
fun init_ast :: "ast \<Rightarrow> 'a nstate \<Rightarrow> 'a ast_config"
195+
where
196+
"init_ast [] ns1 = ((BigBlock None [] None None), KStop, Normal ns1)"
197+
| "init_ast (b#bbs) ns1 = (b, convert_list_to_cont ( bbs) KStop, Normal ns1)"
198+
199+
definition valid_configuration
200+
where "valid_configuration A \<Lambda> \<Gamma> \<Omega> posts bb cont state \<equiv>
201+
state \<noteq> Failure \<and>
202+
(is_final (bb, cont, state) \<longrightarrow> (\<forall>ns'. state = Normal ns' \<longrightarrow> expr_all_sat A \<Lambda> \<Gamma> \<Omega> ns' posts))"
203+
204+
definition proc_body_satisfies_spec :: "'a absval_ty_fun \<Rightarrow> 'm proc_context \<Rightarrow> var_context \<Rightarrow> 'a fun_interp \<Rightarrow> rtype_env \<Rightarrow> expr list \<Rightarrow> expr list \<Rightarrow> ast \<Rightarrow> 'a nstate \<Rightarrow> bool"
205+
where "proc_body_satisfies_spec A M \<Lambda> \<Gamma> \<Omega> pres posts ast ns \<equiv>
206+
expr_all_sat A \<Lambda> \<Gamma> \<Omega> ns pres \<longrightarrow>
207+
(\<forall> bb cont state. (rtranclp (red_bigblock A M \<Lambda> \<Gamma> \<Omega> ast) (init_ast ast ns) (bb, cont, state)) \<longrightarrow>
208+
valid_configuration A \<Lambda> \<Gamma> \<Omega> posts bb cont state)"
209+
210+
fun proc_all_pres :: "ast procedure \<Rightarrow> expr list"
211+
where "proc_all_pres p = map fst (proc_pres p)"
212+
213+
fun proc_checked_posts :: "ast procedure \<Rightarrow> expr list"
214+
where "proc_checked_posts p = map fst (filter (\<lambda>x. \<not> snd(x)) (proc_posts p))"
215+
216+
end
217+

0 commit comments

Comments
 (0)