diff -r d93fdf00f8a6 -r 2bffdf62fe7f src/HOL/IMP/Compiler0.thy --- a/src/HOL/IMP/Compiler0.thy Thu Dec 08 20:15:41 2005 +0100 +++ b/src/HOL/IMP/Compiler0.thy Thu Dec 08 20:15:50 2005 +0100 @@ -47,7 +47,7 @@ "_stepan" :: "[instr list,state,nat,nat,state,nat] \ bool" ("_ |-/ (3\_,_\/ -(_)\ \_,_\)" [50,0,0,0,0,0] 50) -translations +translations "P \ \s,m\ -1\ \t,n\" == "((s,m),t,n) : stepa1 P" "P \ \s,m\ -*\ \t,n\" == "((s,m),t,n) : ((stepa1 P)^*)" "P \ \s,m\ -(i)\ \t,n\" == "((s,m),t,n) : ((stepa1 P)^i)" @@ -80,69 +80,64 @@ subsection "Context lifting lemmas" -text {* +text {* Some lemmas for lifting an execution into a prefix and suffix of instructions; only needed for the first proof. *} lemma app_right_1: - assumes A: "is1 \ \s1,i1\ -1\ \s2,i2\" + assumes "is1 \ \s1,i1\ -1\ \s2,i2\" shows "is1 @ is2 \ \s1,i1\ -1\ \s2,i2\" -proof - - from A show ?thesis - by induct force+ -qed + using prems + by induct auto lemma app_left_1: - assumes A: "is2 \ \s1,i1\ -1\ \s2,i2\" + assumes "is2 \ \s1,i1\ -1\ \s2,i2\" shows "is1 @ is2 \ \s1,size is1+i1\ -1\ \s2,size is1+i2\" -proof - - from A show ?thesis - by induct force+ -qed + using prems + by induct auto declare rtrancl_induct2 [induct set: rtrancl] lemma app_right: -assumes A: "is1 \ \s1,i1\ -*\ \s2,i2\" -shows "is1 @ is2 \ \s1,i1\ -*\ \s2,i2\" -proof - - from A show ?thesis - proof induct - show "is1 @ is2 \ \s1,i1\ -*\ \s1,i1\" by simp - next - fix s1' i1' s2 i2 - assume "is1 @ is2 \ \s1,i1\ -*\ \s1',i1'\" - "is1 \ \s1',i1'\ -1\ \s2,i2\" - thus "is1 @ is2 \ \s1,i1\ -*\ \s2,i2\" - by(blast intro:app_right_1 rtrancl_trans) - qed + assumes "is1 \ \s1,i1\ -*\ \s2,i2\" + shows "is1 @ is2 \ \s1,i1\ -*\ \s2,i2\" + using prems +proof induct + show "is1 @ is2 \ \s1,i1\ -*\ \s1,i1\" by simp +next + fix s1' i1' s2 i2 + assume "is1 @ is2 \ \s1,i1\ -*\ \s1',i1'\" + and "is1 \ \s1',i1'\ -1\ \s2,i2\" + thus "is1 @ is2 \ \s1,i1\ -*\ \s2,i2\" + by (blast intro: app_right_1 rtrancl_trans) qed lemma app_left: -assumes A: "is2 \ \s1,i1\ -*\ \s2,i2\" -shows "is1 @ is2 \ \s1,size is1+i1\ -*\ \s2,size is1+i2\" -proof - - from A show ?thesis - proof induct - show "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s1,length is1 + i1\" by simp - next - fix s1' i1' s2 i2 - assume "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s1',length is1 + i1'\" - "is2 \ \s1',i1'\ -1\ \s2,i2\" - thus "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s2,length is1 + i2\" - by(blast intro:app_left_1 rtrancl_trans) - qed + assumes "is2 \ \s1,i1\ -*\ \s2,i2\" + shows "is1 @ is2 \ \s1,size is1+i1\ -*\ \s2,size is1+i2\" +using prems +proof induct + show "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s1,length is1 + i1\" by simp +next + fix s1' i1' s2 i2 + assume "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s1',length is1 + i1'\" + and "is2 \ \s1',i1'\ -1\ \s2,i2\" + thus "is1 @ is2 \ \s1,length is1 + i1\ -*\ \s2,length is1 + i2\" + by (blast intro: app_left_1 rtrancl_trans) qed lemma app_left2: "\ is2 \ \s1,i1\ -*\ \s2,i2\; j1 = size is1+i1; j2 = size is1+i2 \ \ - is1 @ is2 \ \s1,j1\ -*\ \s2,j2\" - by (simp add:app_left) + is1 @ is2 \ \s1,j1\ -*\ \s2,j2\" + by (simp add: app_left) lemma app1_left: - "is \ \s1,i1\ -*\ \s2,i2\ \ - instr # is \ \s1,Suc i1\ -*\ \s2,Suc i2\" - by(erule app_left[of _ _ _ _ _ "[instr]",simplified]) + assumes "is \ \s1,i1\ -*\ \s2,i2\" + shows "instr # is \ \s1,Suc i1\ -*\ \s2,Suc i2\" +proof - + from app_left [OF prems, of "[instr]"] + show ?thesis by simp +qed subsection "Compiler correctness" @@ -154,69 +149,68 @@ The first proof; The statement is very intuitive, but application of induction hypothesis requires the above lifting lemmas *} -theorem assumes A: "\c,s\ \\<^sub>c t" -shows "compile c \ \s,0\ -*\ \t,length(compile c)\" (is "?P c s t") -proof - - from A show ?thesis - proof induct - show "\s. ?P \ s s" by simp - next - show "\a s x. ?P (x :== a) s (s[x\ a s])" by force - next - fix c0 c1 s0 s1 s2 - assume "?P c0 s0 s1" - hence "compile c0 @ compile c1 \ \s0,0\ -*\ \s1,length(compile c0)\" - by(rule app_right) - moreover assume "?P c1 s1 s2" - hence "compile c0 @ compile c1 \ \s1,length(compile c0)\ -*\ - \s2,length(compile c0)+length(compile c1)\" - proof - - show "\is1 is2 s1 s2 i2. - is2 \ \s1,0\ -*\ \s2,i2\ \ - is1 @ is2 \ \s1,size is1\ -*\ \s2,size is1+i2\" - using app_left[of _ 0] by simp - qed - ultimately have "compile c0 @ compile c1 \ \s0,0\ -*\ - \s2,length(compile c0)+length(compile c1)\" - by (rule rtrancl_trans) - thus "?P (c0; c1) s0 s2" by simp - next - fix b c0 c1 s0 s1 - let ?comp = "compile(\ b \ c0 \ c1)" - assume "b s0" and IH: "?P c0 s0 s1" - hence "?comp \ \s0,0\ -1\ \s0,1\" by auto - also from IH - have "?comp \ \s0,1\ -*\ \s1,length(compile c0)+1\" - by(auto intro:app1_left app_right) - also have "?comp \ \s1,length(compile c0)+1\ -1\ \s1,length ?comp\" - by(auto) - finally show "?P (\ b \ c0 \ c1) s0 s1" . - next - fix b c0 c1 s0 s1 - let ?comp = "compile(\ b \ c0 \ c1)" - assume "\b s0" and IH: "?P c1 s0 s1" - hence "?comp \ \s0,0\ -1\ \s0,length(compile c0) + 2\" by auto - also from IH - have "?comp \ \s0,length(compile c0)+2\ -*\ \s1,length ?comp\" - by(force intro!:app_left2 app1_left) - finally show "?P (\ b \ c0 \ c1) s0 s1" . - next - fix b c and s::state - assume "\b s" - thus "?P (\ b \ c) s s" by force - next - fix b c and s0::state and s1 s2 - let ?comp = "compile(\ b \ c)" - assume "b s0" and - IHc: "?P c s0 s1" and IHw: "?P (\ b \ c) s1 s2" - hence "?comp \ \s0,0\ -1\ \s0,1\" by auto - also from IHc - have "?comp \ \s0,1\ -*\ \s1,length(compile c)+1\" - by(auto intro:app1_left app_right) - also have "?comp \ \s1,length(compile c)+1\ -1\ \s1,0\" by simp - also note IHw - finally show "?P (\ b \ c) s0 s2". +theorem + assumes "\c,s\ \\<^sub>c t" + shows "compile c \ \s,0\ -*\ \t,length(compile c)\" (is "?P c s t") + using prems +proof induct + show "\s. ?P \ s s" by simp +next + show "\a s x. ?P (x :== a) s (s[x\ a s])" by force +next + fix c0 c1 s0 s1 s2 + assume "?P c0 s0 s1" + hence "compile c0 @ compile c1 \ \s0,0\ -*\ \s1,length(compile c0)\" + by (rule app_right) + moreover assume "?P c1 s1 s2" + hence "compile c0 @ compile c1 \ \s1,length(compile c0)\ -*\ + \s2,length(compile c0)+length(compile c1)\" + proof - + show "\is1 is2 s1 s2 i2. + is2 \ \s1,0\ -*\ \s2,i2\ \ + is1 @ is2 \ \s1,size is1\ -*\ \s2,size is1+i2\" + using app_left[of _ 0] by simp qed + ultimately have "compile c0 @ compile c1 \ \s0,0\ -*\ + \s2,length(compile c0)+length(compile c1)\" + by (rule rtrancl_trans) + thus "?P (c0; c1) s0 s2" by simp +next + fix b c0 c1 s0 s1 + let ?comp = "compile(\ b \ c0 \ c1)" + assume "b s0" and IH: "?P c0 s0 s1" + hence "?comp \ \s0,0\ -1\ \s0,1\" by auto + also from IH + have "?comp \ \s0,1\ -*\ \s1,length(compile c0)+1\" + by(auto intro:app1_left app_right) + also have "?comp \ \s1,length(compile c0)+1\ -1\ \s1,length ?comp\" + by(auto) + finally show "?P (\ b \ c0 \ c1) s0 s1" . +next + fix b c0 c1 s0 s1 + let ?comp = "compile(\ b \ c0 \ c1)" + assume "\b s0" and IH: "?P c1 s0 s1" + hence "?comp \ \s0,0\ -1\ \s0,length(compile c0) + 2\" by auto + also from IH + have "?comp \ \s0,length(compile c0)+2\ -*\ \s1,length ?comp\" + by (force intro!: app_left2 app1_left) + finally show "?P (\ b \ c0 \ c1) s0 s1" . +next + fix b c and s::state + assume "\b s" + thus "?P (\ b \ c) s s" by force +next + fix b c and s0::state and s1 s2 + let ?comp = "compile(\ b \ c)" + assume "b s0" and + IHc: "?P c s0 s1" and IHw: "?P (\ b \ c) s1 s2" + hence "?comp \ \s0,0\ -1\ \s0,1\" by auto + also from IHc + have "?comp \ \s0,1\ -*\ \s1,length(compile c)+1\" + by (auto intro: app1_left app_right) + also have "?comp \ \s1,length(compile c)+1\ -1\ \s1,0\" by simp + also note IHw + finally show "?P (\ b \ c) s0 s2". qed text {*