diff -r 8d5221bf765b -r 1f99296758c2 src/HOL/MicroJava/BV/LBVComplete.thy --- a/src/HOL/MicroJava/BV/LBVComplete.thy Tue Aug 08 16:57:44 2000 +0200 +++ b/src/HOL/MicroJava/BV/LBVComplete.thy Wed Aug 09 11:53:00 2000 +0200 @@ -6,11 +6,7 @@ header {* Completeness of the LBV *} -theory LBVComplete = BVSpec + LBVSpec: - - -ML_setup {* bind_thm ("widen_RefT", widen_RefT) *} -ML_setup {* bind_thm ("widen_RefT2", widen_RefT2) *} +theory LBVComplete = BVSpec + LBVSpec + StepMono: constdefs @@ -66,52 +62,60 @@ make_cert b (Phi C sig)" -lemma length_ofn: "\\n. length (option_filter_n l P n) = length l" +lemmas [simp del] = split_paired_Ex + +lemma length_ofn [rulify]: "\\n. length (option_filter_n l P n) = length l" by (induct l) auto -lemma is_approx_option_filter_n: -"\\n. is_approx (option_filter_n a P n) a" (is "?P a") -proof (induct a) - show "?P []" by (auto simp add: is_approx_def) - fix l ls - assume Cons: "?P ls" - - show "?P (l#ls)" - proof (unfold is_approx_def, intro allI conjI impI) - fix n - show "length (option_filter_n (l # ls) P n) = length (l # ls)" - by (simp only: length_ofn) +lemma is_approx_option_filter: "is_approx (option_filter l P) l" +proof - + { + fix a n + have "\\n. is_approx (option_filter_n a P n) a" (is "?P a") + proof (induct a) + show "?P []" by (auto simp add: is_approx_def) + + fix l ls + assume Cons: "?P ls" - fix m - assume "m < length (option_filter_n (l # ls) P n)" - hence m: "m < Suc (length ls)" by (simp only: length_ofn) simp - - show "option_filter_n (l # ls) P n ! m = None \\ - option_filter_n (l # ls) P n ! m = Some ((l # ls) ! m)" - proof (cases "m") - assume "m = 0" - with m show ?thesis by simp - next - fix m' assume Suc: "m = Suc m'" - from Cons - show ?thesis - proof (unfold is_approx_def, elim allE impE conjE) - from m Suc - show "m' < length (option_filter_n ls P (Suc n))" by (simp add: length_ofn) - - assume "option_filter_n ls P (Suc n) ! m' = None \\ - option_filter_n ls P (Suc n) ! m' = Some (ls ! m')" - with m Suc - show ?thesis by auto + show "?P (l#ls)" + proof (unfold is_approx_def, intro allI conjI impI) + fix n + show "length (option_filter_n (l # ls) P n) = length (l # ls)" + by (simp only: length_ofn) + + fix m + assume "m < length (option_filter_n (l # ls) P n)" + hence m: "m < Suc (length ls)" by (simp only: length_ofn) simp + + show "option_filter_n (l # ls) P n ! m = None \\ + option_filter_n (l # ls) P n ! m = Some ((l # ls) ! m)" + proof (cases "m") + assume "m = 0" + with m show ?thesis by simp + next + fix m' assume Suc: "m = Suc m'" + from Cons + show ?thesis + proof (unfold is_approx_def, elim allE impE conjE) + from m Suc + show "m' < length (option_filter_n ls P (Suc n))" by (simp add: length_ofn) + + assume "option_filter_n ls P (Suc n) ! m' = None \\ + option_filter_n ls P (Suc n) ! m' = Some (ls ! m')" + with m Suc + show ?thesis by auto + qed + qed qed qed - qed + } + + thus ?thesis + by (auto simp add: option_filter_def) qed -lemma is_approx_option_filter: "is_approx (option_filter l P) l" - by (simp add: option_filter_def is_approx_option_filter_n) - lemma option_filter_Some: "\\n < length l; P n\\ \\ option_filter l P ! n = Some (l!n)" proof - @@ -200,11 +204,8 @@ by (clarsimp simp add: fits_def contains_dead_def contains_targets_def) - -lemmas [trans] = sup_state_trans - lemma wtl_inst_mono: -"\\wtl_inst i G rT s1 s1' cert mpc pc; fits ins cert phi; pc < length ins; wf_prog wf_mb G; +"\\wtl_inst i G rT s1 s1' cert mpc pc; fits ins cert phi; pc < length ins; G \\ s2 <=s s1; i = ins!pc\\ \\ \\ s2'. wtl_inst (ins!pc) G rT s2 s2' cert mpc pc \\ (G \\ s2' <=s s1')"; proof - @@ -270,6 +271,42 @@ with pc show ?thesis by simp qed + +lemma wtl_option_mono: +"\\wtl_inst_option i G rT s1 s1' cert mpc pc; fits ins cert phi; + pc < length ins; G \\ s2 <=s s1; i = ins!pc\\ \\ + \\ s2'. wtl_inst_option (ins!pc) G rT s2 s2' cert mpc pc \\ (G \\ s2' <=s s1')" +proof - + assume wtl: "wtl_inst_option i G rT s1 s1' cert mpc pc" and + fits: "fits ins cert phi" "pc < length ins" + "G \\ s2 <=s s1" "i = ins!pc" + + show ?thesis + proof (cases "cert!pc") + case None + with wtl fits; + show ?thesis; + by - (rule wtl_inst_mono [elimify], (simp add: wtl_inst_option_def)+); + next + case Some + with wtl fits; + + have G: "G \\ s2 <=s a" + by - (rule sup_state_trans, (simp add: wtl_inst_option_def)+) + + from Some wtl + have "wtl_inst i G rT a s1' cert mpc pc"; by (simp add: wtl_inst_option_def) + + with G fits + have "\\ s2'. wtl_inst (ins!pc) G rT a s2' cert mpc pc \\ (G \\ s2' <=s s1')" + by - (rule wtl_inst_mono, (simp add: wtl_inst_option_def)+); + + with Some G; + show ?thesis; by (simp add: wtl_inst_option_def); + qed +qed + + lemma wt_instr_imp_wtl_inst: "\\wt_instr (ins!pc) G rT phi max_pc pc; fits ins cert phi; @@ -296,7 +333,7 @@ from wt fits pc have cert: "!!pc'. \\pc' \\ succs (ins!pc) pc; pc' < max_pc; pc' \\ pc+1\\ \\ cert!pc' \\ None \\ G \\ ?s' <=s the (cert!pc')" - by (auto dest: fitsD simp add: wt_instr_def simp del: split_paired_Ex) + by (auto dest: fitsD simp add: wt_instr_def) show ?thesis proof (cases "pc+1 \\ succs (ins!pc) pc") @@ -358,143 +395,87 @@ qed -lemma wtl_option_mono: -"\\wtl_inst_option i G rT s1 s1' cert mpc pc; fits ins cert phi; pc < length ins; - wf_prog wf_mb G; G \\ s2 <=s s1; i = ins!pc\\ \\ - \\ s2'. wtl_inst_option (ins!pc) G rT s2 s2' cert mpc pc \\ (G \\ s2' <=s s1')" -proof - - assume wtl: "wtl_inst_option i G rT s1 s1' cert mpc pc" and - fits: "fits ins cert phi" "pc < length ins" - "wf_prog wf_mb G" "G \\ s2 <=s s1" "i = ins!pc" - - show ?thesis - proof (cases "cert!pc") - case None - with wtl fits; - show ?thesis; - by - (rule wtl_inst_mono [elimify], (simp add: wtl_inst_option_def)+); - next - case Some - with wtl fits; - - have G: "G \\ s2 <=s a" - by - (rule sup_state_trans, (simp add: wtl_inst_option_def)+) - - from Some wtl - have "wtl_inst i G rT a s1' cert mpc pc"; by (simp add: wtl_inst_option_def) +text {* + \medskip + Main induction over the instruction list. +*} - with G fits - have "\\ s2'. wtl_inst (ins!pc) G rT a s2' cert mpc pc \\ (G \\ s2' <=s s1')" - by - (rule wtl_inst_mono, (simp add: wtl_inst_option_def)+); - - with Some G; - show ?thesis; by (simp add: wtl_inst_option_def); - qed -qed - - -(* main induction over instruction list *) theorem wt_imp_wtl_inst_list: -"\\ pc. (\\pc'. pc' < length ins \\ wt_instr (ins ! pc') G rT phi (pc+length ins) (pc+pc')) \\ - wf_prog wf_mb G \\ - fits all_ins cert phi \\ (\\ l. pc = length l \\ all_ins=l@ins) \\ pc < length all_ins \\ +"\\ pc. (\\pc'. pc' < length all_ins \\ wt_instr (all_ins ! pc') G rT phi (length all_ins) pc') \\ + fits all_ins cert phi \\ + (\\l. pc = length l \\ all_ins = l@ins) \\ + pc < length all_ins \\ (\\ s. (G \\ s <=s (phi!pc)) \\ - (\\s'. wtl_inst_list ins G rT s s' cert (pc+length ins) pc))" -(is "\\pc. ?C pc ins" is "?P ins"); -proof (induct "?P" "ins"); - case Nil; - show "?P []"; by simp; -next; - case Cons; + (\\s'. wtl_inst_list ins G rT s s' cert (length all_ins) pc))" +(is "\\pc. ?wt \\ ?fits \\ ?l pc ins \\ ?len pc \\ ?wtl pc ins" is "\\pc. ?C pc ins" is "?P ins") +proof (induct "?P" "ins") + case Nil + show "?P []" by simp +next + fix i ins' + assume Cons: "?P ins'" - show "?P (a#list)"; - proof (intro allI impI, elim exE conjE); - fix pc s l; - assume 1: "wf_prog wf_mb G" "fits all_ins cert phi"; - assume 2: "pc < length all_ins" "G \\ s <=s phi ! pc" - "all_ins = l @ a # list" "pc = length l"; + show "?P (i#ins')" + proof (intro allI impI, elim exE conjE) + fix pc s l + assume wt : "\\pc'. pc' < length all_ins \\ + wt_instr (all_ins ! pc') G rT phi (length all_ins) pc'" + assume fits: "fits all_ins cert phi" + assume G : "G \\ s <=s phi ! pc" + assume l : "pc < length all_ins" - from Cons; - have IH: "?C (Suc pc) list"; by blast; + assume pc : "all_ins = l@i#ins'" "pc = length l" + hence i : "all_ins ! pc = i" + by (simp add: nth_append) - assume 3: "\\pc'. pc' < length (a # list) \\ - wt_instr ((a # list) ! pc') G rT phi (pc + length (a # list)) (pc + pc')"; - hence 4: "\\pc'. pc' < length list \\ - wt_instr (list ! pc') G rT phi (Suc pc + length list) (Suc pc + pc')"; by auto; + from l wt + have "wt_instr (all_ins!pc) G rT phi (length all_ins) pc" by blast - from 2; - have 5: "a = all_ins ! pc"; by (simp add: nth_append); - - - show "\\s'. wtl_inst_list (a # list) G rT s s' cert (pc + length (a # list)) pc"; - proof (cases list); - case Nil; - - with 1 2 3 5; - have "\\s'. wtl_inst_option a G rT (phi ! pc) s' cert (Suc (length l)) pc"; - by - (rule wt_instr_imp_wtl_option [elimify], force+); + with fits l + obtain s1 where + "wtl_inst_option (all_ins!pc) G rT (phi!pc) s1 cert (length all_ins) pc" and + s1: "G \\ s1 <=s phi ! (Suc pc)" + by - (drule wt_instr_imp_wtl_option, assumption+, simp, elim exE conjE, simp) + + with fits l + obtain s2 where + o: "wtl_inst_option (all_ins!pc) G rT s s2 cert (length all_ins) pc" + and "G \\ s2 <=s s1" + by - (drule wtl_option_mono, assumption+, simp, elim exE conjE, rule that) - with Nil 1 2 5; - have "\\s'. wtl_inst_option a G rT s s' cert (Suc (length l)) pc"; - by elim (rule wtl_option_mono [elimify], force+); - - with Nil 2; - show ?thesis; by auto; - next; - fix i' ins'; - assume Cons2: "list = i' # ins'"; - - with IH 1 2 3; - have * : "\\ s. (G \\ s <=s (phi!(Suc pc))) \\ - (\\s'. wtl_inst_list list G rT s s' cert ((Suc pc)+length list) (Suc pc))"; - by (elim impE) force+; + with s1 + have G': "G \\ s2 <=s phi ! (Suc pc)" + by - (rule sup_state_trans, auto) - from 3; - have "wt_instr a G rT phi (pc + length (a # list)) pc"; by auto; - - with 1 2 5; - have "\\s1'. wtl_inst_option a G rT (phi!pc) s1' cert (Suc (pc + length list)) pc \\ G \\ s1' <=s phi ! Suc pc"; - by - (rule wt_instr_imp_wtl_option [elimify], assumption+, simp+); - - hence "\\s1. wtl_inst_option a G rT s s1 cert (Suc (pc + length list)) pc \\ - (G \\ s1 <=s (phi ! (Suc pc)))" (* \\ (\\s. cert ! Suc pc = Some s \\ G \\ s1 <=s s))"; *) - proof elim; - fix s1'; - assume "wtl_inst_option a G rT (phi!pc) s1' cert (Suc (pc + length list)) pc" and - a :"G \\ s1' <=s phi ! Suc pc"; - with 1 2 5; - have "\\s1. wtl_inst_option a G rT s s1 cert (Suc (pc + length list)) pc \\ - ((G \\ s1 <=s s1'))" (* \\ (\\s. cert ! Suc pc = Some s \\ G \\ s1 <=s s))"; *) - by - (rule wtl_option_mono [elimify], simp+); + from Cons + have "?C (Suc pc) ins'" by blast + with wt fits pc + have IH: "?len (Suc pc) \\ ?wtl (Suc pc) ins'" by auto - with a; - show ?thesis; - proof (elim, intro); - fix s1; - assume "G \\ s1 <=s s1'" "G \\ s1' <=s phi ! Suc pc"; - show "G \\ s1 <=s phi ! Suc pc"; by (rule sup_state_trans); - qed auto; - qed - - thus ?thesis - proof (elim exE conjE); - fix s1; - assume wto: "wtl_inst_option a G rT s s1 cert (Suc (pc + length list)) pc"; - assume Gs1: "G \\ s1 <=s phi ! Suc pc" (* \\ (\\s. cert ! Suc pc = Some s \\ G \\ s1 <=s s)"; *) - - with * - have "\\s'. wtl_inst_list list G rT s1 s' cert ((Suc pc)+length list) (Suc pc)"; by blast - - with wto; - show ?thesis; by (auto simp del: split_paired_Ex); - qed + show "\\s'. wtl_inst_list (i#ins') G rT s s' cert (length all_ins) pc" + proof (cases "?len (Suc pc)") + case False + with pc + have "ins' = []" by simp + with i o + show ?thesis by auto + next + case True + with IH + have "?wtl (Suc pc) ins'" by blast + with G' + obtain s' where + "wtl_inst_list ins' G rT s2 s' cert (length all_ins) (Suc pc)" + by - (elim allE impE, auto) + with i o + show ?thesis by auto qed qed qed - + lemma fits_imp_wtl_method_complete: -"\\wt_method G C pTs rT mxl ins phi; fits ins cert phi; wf_prog wf_mb G\\ \\ wtl_method G C pTs rT mxl ins cert"; +"\\wt_method G C pTs rT mxl ins phi; fits ins cert phi; wf_prog wf_mb G\\ \\ wtl_method G C pTs rT mxl ins cert" by (simp add: wt_method_def wtl_method_def del: split_paired_Ex) (rule wt_imp_wtl_inst_list [rulify, elimify], auto simp add: wt_start_def simp del: split_paired_Ex); @@ -560,5 +541,6 @@ qed; qed +lemmas [simp] = split_paired_Ex end