52
|
1 |
(* test *)
|
50
|
2 |
theory Chap03
|
|
3 |
imports Main
|
|
4 |
begin
|
|
5 |
|
|
6 |
lemma "\<lbrakk> xs @ zs = ys @ xs; [] @ xs = [] @ [] \<rbrakk> \<Longrightarrow> ys = zs"
|
|
7 |
apply simp
|
|
8 |
done
|
|
9 |
|
|
10 |
lemma "\<forall> x. f x = g (f (g x)) \<Longrightarrow> f [] = f [] @ []"
|
|
11 |
apply (simp (no_asm))
|
|
12 |
done
|
|
13 |
|
|
14 |
definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
|
|
15 |
"xor A B \<equiv> (A \<and> \<not>B) \<or> (\<not>A \<and> B)"
|
|
16 |
|
|
17 |
lemma "xor A (\<not>A)"
|
|
18 |
apply(simp only: xor_def)
|
|
19 |
apply(simp add: xor_def)
|
|
20 |
done
|
|
21 |
|
|
22 |
lemma "(let xs = [] in xs@ys@xs) = ys"
|
|
23 |
apply(simp only: Let_def)
|
|
24 |
apply(simp add: Let_def)
|
|
25 |
done
|
|
26 |
|
|
27 |
(* 3.1.8 Conditioal Simplification Rules *)
|
|
28 |
|
|
29 |
lemma hd_Cons_tl: "xs \<noteq> [] \<Longrightarrow> hd xs # tl xs = xs"
|
|
30 |
using [[simp_trace=true]]
|
|
31 |
apply(case_tac xs)
|
|
32 |
apply(simp)
|
|
33 |
apply(simp)
|
|
34 |
done
|
|
35 |
|
|
36 |
lemma "xs \<noteq> [] \<Longrightarrow> hd(rev xs) # tl(rev xs) = rev xs"
|
|
37 |
apply(case_tac xs)
|
|
38 |
using [[simp_trace=true]]
|
|
39 |
apply(simp)
|
|
40 |
apply(simp)
|
|
41 |
done
|
|
42 |
|
|
43 |
(* 3.1.9 Automatic Case Splits *)
|
|
44 |
|
|
45 |
lemma "\<forall> xs. if xs = [] then rev xs = [] else rev xs \<noteq> []"
|
|
46 |
apply(split split_if)
|
|
47 |
apply(simp)
|
|
48 |
done
|
|
49 |
|
|
50 |
lemma "(case xs of [] \<Rightarrow> zs | y#ys \<Rightarrow> y#(ys@zs)) = xs@zs"
|
|
51 |
apply(split list.split)
|
|
52 |
apply(simp split: list.split)
|
|
53 |
done
|
|
54 |
|
|
55 |
lemma "if xs = [] then ys \<noteq> [] else ys = [] \<Longrightarrow> xs @ ys \<noteq> []"
|
|
56 |
apply(split split_if_asm)
|
|
57 |
apply(simp)
|
|
58 |
apply(auto)
|
|
59 |
done
|
|
60 |
|
|
61 |
(* 3.2 Induction Heuristics *)
|
|
62 |
|
|
63 |
primrec itrev :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
|
|
64 |
"itrev [] ys = ys" |
|
|
65 |
"itrev (x#xs) ys = itrev xs (x#ys)"
|
|
66 |
|
|
67 |
lemma "itrev xs [] = rev xs"
|
|
68 |
apply(induct_tac xs)
|
|
69 |
apply(simp)
|
|
70 |
apply(auto)
|
|
71 |
oops
|
|
72 |
|
|
73 |
lemma "itrev xs ys = rev xs @ ys"
|
|
74 |
apply(induct_tac xs)
|
|
75 |
apply(simp_all)
|
|
76 |
oops
|
|
77 |
|
|
78 |
lemma "\<forall> ys. itrev xs ys = rev xs @ ys"
|
|
79 |
apply(induct_tac xs)
|
|
80 |
apply(simp)
|
|
81 |
apply(simp)
|
|
82 |
done
|
|
83 |
|
|
84 |
primrec add1 :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
|
|
85 |
"add1 m 0 = m" |
|
|
86 |
"add1 m (Suc n) = add1 (Suc m) n"
|
|
87 |
|
51
|
88 |
primrec add2 :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
|
|
89 |
"add2 m 0 = m" |
|
|
90 |
"add2 m (Suc n) = Suc (add2 m n)"
|
|
91 |
|
50
|
92 |
value "add1 1 3"
|
|
93 |
value "1 + 3"
|
|
94 |
|
|
95 |
lemma abc [simp]: "add1 m 0 = m"
|
|
96 |
apply(induction m)
|
|
97 |
apply(simp)
|
|
98 |
apply(simp)
|
|
99 |
done
|
|
100 |
|
51
|
101 |
lemma abc2: "\<forall>m. add1 m n = m + n"
|
50
|
102 |
apply(induction n)
|
51
|
103 |
apply(simp)
|
|
104 |
apply(simp del: add1.simps)
|
|
105 |
apply(simp (no_asm) only: add1.simps)
|
|
106 |
apply(simp only: )
|
|
107 |
apply(simp)
|
|
108 |
done
|
|
109 |
|
|
110 |
thm abc2
|
|
111 |
|
|
112 |
lemma abc3: "add1 m n = m + n"
|
|
113 |
apply(induction n arbitrary: m)
|
|
114 |
apply(simp)
|
|
115 |
apply(simp del: add1.simps)
|
|
116 |
apply(simp (no_asm) only: add1.simps)
|
|
117 |
apply(simp only: )
|
|
118 |
done
|
50
|
119 |
|
51
|
120 |
thm abc3
|
|
121 |
|
|
122 |
lemma abc4: "add1 m n = add2 m n"
|
|
123 |
apply(induction n arbitrary: m)
|
|
124 |
apply(simp)
|
|
125 |
apply(simp add: abc3)
|
|
126 |
done
|
|
127 |
|
|
128 |
(* added test *)
|
|
129 |
|
|
130 |
lemma abc5: "add2 m n = m + n"
|
|
131 |
apply(induction n)
|
|
132 |
apply(simp)
|
|
133 |
apply(simp)
|
|
134 |
done
|
|
135 |
|
50
|
136 |
|
|
137 |
(* 3.3 Case Study: Compiling Expressions *)
|
|
138 |
|
|
139 |
type_synonym 'v binop = "'v \<Rightarrow> 'v \<Rightarrow> 'v"
|
|
140 |
datatype ('a, 'v)expr =
|
|
141 |
Cex 'v
|
|
142 |
| Vex 'a
|
|
143 |
| Bex "'v binop" "('a,'v)expr" "('a,'v)expr"
|
|
144 |
|
|
145 |
primrec "value" :: "('a,'v)expr \<Rightarrow> ('a \<Rightarrow> 'v) \<Rightarrow> 'v" where
|
|
146 |
"value (Cex v) env = v" |
|
|
147 |
"value (Vex a) env = env a" |
|
|
148 |
"value (Bex f e1 e2) env = f (value e1 env) (value e2 env)"
|
|
149 |
|
|
150 |
datatype ('a,'v)instr =
|
|
151 |
Const 'v
|
|
152 |
| Load 'a
|
|
153 |
| Apply "'v binop"
|
|
154 |
|
|
155 |
primrec exec :: "('a,'v)instr list \<Rightarrow> ('a\<Rightarrow>'v) \<Rightarrow> 'v list \<Rightarrow> 'v list" where
|
|
156 |
"exec [] s vs = vs" |
|
|
157 |
"exec (i#is) s vs = (case i of
|
|
158 |
Const v \<Rightarrow> exec is s (v#vs)
|
|
159 |
| Load a \<Rightarrow> exec is s ((s a)#vs)
|
|
160 |
| Apply f \<Rightarrow> exec is s ((f (hd vs) (hd(tl vs)))#(tl(tl vs))))"
|
|
161 |
|
|
162 |
primrec compile :: "('a,'v)expr \<Rightarrow> ('a,'v)instr list" where
|
|
163 |
"compile (Cex v) = [Const v]" |
|
|
164 |
"compile (Vex a) = [Load a]" |
|
|
165 |
"compile (Bex f e1 e2) = (compile e2) @ (compile e1) @ [Apply f]"
|
|
166 |
|
|
167 |
theorem "exec (compile e) s [] = [value e s]"
|
|
168 |
(*the theorem needs to be generalized*)
|
|
169 |
oops
|
|
170 |
|
|
171 |
(*more generalized theorem*)
|
|
172 |
theorem "\<forall> vs. exec (compile e) s vs = (value e s) # vs"
|
|
173 |
apply(induct_tac e)
|
|
174 |
apply(simp)
|
|
175 |
apply(simp)
|
|
176 |
oops
|
|
177 |
|
|
178 |
lemma exec_app[simp]: "\<forall> vs. exec (xs@ys) s vs = exec ys s (exec xs s vs)"
|
|
179 |
apply(induct_tac xs)
|
|
180 |
apply(simp)
|
|
181 |
apply(simp)
|
|
182 |
apply(simp split: instr.split)
|
|
183 |
done
|
|
184 |
|
|
185 |
(* 2.5.6 Case Study: Boolean Expressions *)
|
|
186 |
|
|
187 |
datatype boolex = Const bool | Var nat | Neg boolex
|
|
188 |
| And boolex boolex
|
|
189 |
|
|
190 |
primrec "value2" :: "boolex \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> bool" where
|
|
191 |
"value2 (Const b) env = b" |
|
|
192 |
"value2 (Var x) env = env x" |
|
|
193 |
"value2 (Neg b) env = (\<not> value2 b env)" |
|
|
194 |
"value2 (And b c) env = (value2 b env \<and> value2 c env)"
|
|
195 |
|
|
196 |
value "Const true"
|
51
|
197 |
value "Var (Suc(0))"
|
|
198 |
|
|
199 |
|
|
200 |
|
|
201 |
value "value2 (Const False) (\<lambda>x. False)"
|
|
202 |
value "value2 (Var 11) (\<lambda>x. if (x = 10 | x = 11) then True else False)"
|
50
|
203 |
|
51
|
204 |
definition
|
|
205 |
"en1 \<equiv> (\<lambda>x. if x = 10 | x = 11 then True else False)"
|
|
206 |
|
|
207 |
abbreviation
|
|
208 |
"en2 \<equiv> (\<lambda>x. if x = 10 | x = 11 then True else False)"
|
|
209 |
|
|
210 |
value "value2 (And (Var 10) (Var 11)) en2"
|
50
|
211 |
|
51
|
212 |
lemma "value2 (And (Var 10) (Var 11)) en2 = True"
|
|
213 |
apply(simp)
|
|
214 |
done
|
50
|
215 |
|