diff -r 1d1cc715a9e5 -r a084aa91f701 src/HOL/Isar_examples/ExprCompiler.thy --- a/src/HOL/Isar_examples/ExprCompiler.thy Thu Nov 10 20:57:22 2005 +0100 +++ b/src/HOL/Isar_examples/ExprCompiler.thy Thu Nov 10 21:14:05 2005 +0100 @@ -112,29 +112,32 @@ *} lemma exec_append: - "ALL stack. exec (xs @ ys) stack env = - exec ys (exec xs stack env) env" (is "?P xs") -proof (induct xs) - show "?P []" by simp + "exec (xs @ ys) stack env = + exec ys (exec xs stack env) env" +proof (induct xs fixing: stack) + case Nil + show ?case by simp next - fix x xs assume hyp: "?P xs" - show "?P (x # xs)" + case (Cons x xs) + show ?case proof (induct x) - from hyp show "!!val. ?P (Const val # xs)" by simp - from hyp show "!!adr. ?P (Load adr # xs)" by simp - from hyp show "!!fun. ?P (Apply fun # xs)" by simp + case Const show ?case by simp + next + case Load show ?case by simp + next + case Apply show ?case by simp qed qed theorem correctness: "execute (compile e) env = eval e env" proof - - have "ALL stack. exec (compile e) stack env = - eval e env # stack" (is "?P e") + have "!!stack. exec (compile e) stack env = eval e env # stack" proof (induct e) - show "!!adr. ?P (Variable adr)" by simp - show "!!val. ?P (Constant val)" by simp - show "!!fun e1 e2. ?P e1 ==> ?P e2 ==> ?P (Binop fun e1 e2)" - by (simp add: exec_append) + case Variable show ?case by simp + next + case Constant show ?case by simp + next + case Binop then show ?case by (simp add: exec_append) qed thus ?thesis by (simp add: execute_def) qed @@ -149,98 +152,75 @@ *} lemma exec_append': - "ALL stack. exec (xs @ ys) stack env - = exec ys (exec xs stack env) env" (is "?P xs") -proof (induct xs) - show "?P []" (is "ALL s. ?Q s") - proof - fix s have "exec ([] @ ys) s env = exec ys s env" by simp - also have "... = exec ys (exec [] s env) env" by simp - finally show "?Q s" . - qed - fix x xs assume hyp: "?P xs" - show "?P (x # xs)" + "exec (xs @ ys) stack env = exec ys (exec xs stack env) env" +proof (induct xs fixing: stack) + case (Nil s) + have "exec ([] @ ys) s env = exec ys s env" by simp + also have "... = exec ys (exec [] s env) env" by simp + finally show ?case . +next + case (Cons x xs s) + show ?case proof (induct x) - fix val - show "?P (Const val # xs)" (is "ALL s. ?Q s") - proof - fix s - have "exec ((Const val # xs) @ ys) s env = - exec (Const val # xs @ ys) s env" - by simp - also have "... = exec (xs @ ys) (val # s) env" by simp - also from hyp - have "... = exec ys (exec xs (val # s) env) env" .. - also have "... = exec ys (exec (Const val # xs) s env) env" - by simp - finally show "?Q s" . - qed - next - fix adr from hyp show "?P (Load adr # xs)" by simp -- {* same as above *} + case (Const val) + have "exec ((Const val # xs) @ ys) s env = exec (Const val # xs @ ys) s env" + by simp + also have "... = exec (xs @ ys) (val # s) env" by simp + also from Cons have "... = exec ys (exec xs (val # s) env) env" . + also have "... = exec ys (exec (Const val # xs) s env) env" by simp + finally show ?case . next - fix fun - show "?P (Apply fun # xs)" (is "ALL s. ?Q s") - proof - fix s - have "exec ((Apply fun # xs) @ ys) s env = - exec (Apply fun # xs @ ys) s env" - by simp - also have "... = - exec (xs @ ys) (fun (hd s) (hd (tl s)) # (tl (tl s))) env" - by simp - also from hyp have "... = - exec ys (exec xs (fun (hd s) (hd (tl s)) # tl (tl s)) env) env" - .. - also have "... = exec ys (exec (Apply fun # xs) s env) env" by simp - finally show "?Q s" . - qed + case (Load adr) + from Cons show ?case by simp -- {* same as above *} + next + case (Apply fun) + have "exec ((Apply fun # xs) @ ys) s env = + exec (Apply fun # xs @ ys) s env" by simp + also have "... = + exec (xs @ ys) (fun (hd s) (hd (tl s)) # (tl (tl s))) env" by simp + also from Cons have "... = + exec ys (exec xs (fun (hd s) (hd (tl s)) # tl (tl s)) env) env" . + also have "... = exec ys (exec (Apply fun # xs) s env) env" by simp + finally show ?case . qed qed theorem correctness': "execute (compile e) env = eval e env" proof - have exec_compile: - "ALL stack. exec (compile e) stack env = eval e env # stack" - (is "?P e") + "!!stack. exec (compile e) stack env = eval e env # stack" proof (induct e) - fix adr show "?P (Variable adr)" (is "ALL s. ?Q s") - proof - fix s - have "exec (compile (Variable adr)) s env = exec [Load adr] s env" - by simp - also have "... = env adr # s" by simp - also have "env adr = eval (Variable adr) env" by simp - finally show "?Q s" . - qed + case (Variable adr s) + have "exec (compile (Variable adr)) s env = exec [Load adr] s env" + by simp + also have "... = env adr # s" by simp + also have "env adr = eval (Variable adr) env" by simp + finally show ?case . next - fix val show "?P (Constant val)" by simp -- {* same as above *} + case (Constant val s) + show ?case by simp -- {* same as above *} next - fix fun e1 e2 assume hyp1: "?P e1" and hyp2: "?P e2" - show "?P (Binop fun e1 e2)" (is "ALL s. ?Q s") - proof - fix s have "exec (compile (Binop fun e1 e2)) s env - = exec (compile e2 @ compile e1 @ [Apply fun]) s env" by simp - also have "... = exec [Apply fun] - (exec (compile e1) (exec (compile e2) s env) env) env" - by (simp only: exec_append) - also from hyp2 - have "exec (compile e2) s env = eval e2 env # s" .. - also from hyp1 - have "exec (compile e1) ... env = eval e1 env # ..." .. - also have "exec [Apply fun] ... env = + case (Binop fun e1 e2 s) + have "exec (compile (Binop fun e1 e2)) s env = + exec (compile e2 @ compile e1 @ [Apply fun]) s env" by simp + also have "... = exec [Apply fun] + (exec (compile e1) (exec (compile e2) s env) env) env" + by (simp only: exec_append) + also have "exec (compile e2) s env = eval e2 env # s" by fact + also have "exec (compile e1) ... env = eval e1 env # ..." by fact + also have "exec [Apply fun] ... env = fun (hd ...) (hd (tl ...)) # (tl (tl ...))" by simp - also have "... = fun (eval e1 env) (eval e2 env) # s" by simp - also have "fun (eval e1 env) (eval e2 env) = - eval (Binop fun e1 e2) env" - by simp - finally show "?Q s" . - qed + also have "... = fun (eval e1 env) (eval e2 env) # s" by simp + also have "fun (eval e1 env) (eval e2 env) = + eval (Binop fun e1 e2) env" + by simp + finally show ?case . qed have "execute (compile e) env = hd (exec (compile e) [] env)" by (simp add: execute_def) also from exec_compile - have "exec (compile e) [] env = [eval e env]" .. + have "exec (compile e) [] env = [eval e env]" . also have "hd ... = eval e env" by simp finally show ?thesis . qed