diff -r 1bd21b082466 -r f75dfc606ac7 src/HOL/Bali/Evaln.thy --- a/src/HOL/Bali/Evaln.thy Wed Jul 10 14:51:18 2002 +0200 +++ b/src/HOL/Bali/Evaln.thy Wed Jul 10 15:07:02 2002 +0200 @@ -103,6 +103,12 @@ Lit: "G\Norm s \Lit v-\v\n\ Norm s" + UnOp: "\G\Norm s0 \e-\v\n\ s1\ + \ G\Norm s0 \UnOp unop e-\(eval_unop unop v)\n\ s1" + + BinOp: "\G\Norm s0 \e1-\v1\n\ s1; G\s1 \e2-\v2\n\ s2\ + \ G\Norm s0 \BinOp binop e1 e2-\(eval_binop binop v1 v2)\n\ s2" + Super: "G\Norm s \Super-\val_this s\n\ Norm s" Acc: "\G\Norm s0 \va=\(v,f)\n\ s1\ \ @@ -128,7 +134,8 @@ G\Norm s0 \Methd D sig-\v\Suc n\ s1" Body: "\G\Norm s0\Init D\n\ s1; G\s1 \c\n\ s2\\ - G\Norm s0 \Body D c-\the (locals (store s2) Result)\n\abupd (absorb Ret) s2" + G\Norm s0 \Body D c + -\the (locals (store s2) Result)\n\abupd (absorb Ret) s2" (* evaluation of expression lists *) @@ -148,7 +155,7 @@ G\Norm s0 \Expr e\n\ s1" Lab: "\G\Norm s0 \c \n\ s1\ \ - G\Norm s0 \l\ c\n\ abupd (absorb (Break l)) s1" + G\Norm s0 \l\ c\n\ abupd (absorb l) s1" Comp: "\G\Norm s0 \c1 \n\ s1; G\ s1 \c2 \n\ s2\ \ @@ -203,6 +210,8 @@ "G\Norm s \In3 ([]) \\n\ vs'" "G\Norm s \In3 (e#es) \\n\ vs'" "G\Norm s \In1l (Lit w) \\n\ vs'" + "G\Norm s \In1l (UnOp unop e) \\n\ vs'" + "G\Norm s \In1l (BinOp binop e1 e2) \\n\ vs'" "G\Norm s \In2 (LVar vn) \\n\ vs'" "G\Norm s \In1l (Cast T e) \\n\ vs'" "G\Norm s \In1l (e InstOf T) \\n\ vs'" @@ -262,6 +271,62 @@ *} declare evaln_AbruptIs [intro!] +lemma evaln_Callee: "G\Norm s\In1l (Callee l e)\\n\ (v,s') = False" +proof - + { fix s t v s' + assume eval: "G\s \t\\n\ (v,s')" and + normal: "normal s" and + callee: "t=In1l (Callee l e)" + then have "False" + proof (induct) + qed (auto) + } + then show ?thesis + by (cases s') fastsimp +qed + +lemma evaln_InsInitE: "G\Norm s\In1l (InsInitE c e)\\n\ (v,s') = False" +proof - + { fix s t v s' + assume eval: "G\s \t\\n\ (v,s')" and + normal: "normal s" and + callee: "t=In1l (InsInitE c e)" + then have "False" + proof (induct) + qed (auto) + } + then show ?thesis + by (cases s') fastsimp +qed + +lemma evaln_InsInitV: "G\Norm s\In2 (InsInitV c w)\\n\ (v,s') = False" +proof - + { fix s t v s' + assume eval: "G\s \t\\n\ (v,s')" and + normal: "normal s" and + callee: "t=In2 (InsInitV c w)" + then have "False" + proof (induct) + qed (auto) + } + then show ?thesis + by (cases s') fastsimp +qed + +lemma evaln_FinA: "G\Norm s\In1r (FinA a c)\\n\ (v,s') = False" +proof - + { fix s t v s' + assume eval: "G\s \t\\n\ (v,s')" and + normal: "normal s" and + callee: "t=In1r (FinA a c)" + then have "False" + proof (induct) + qed (auto) + } + then show ?thesis + by (cases s') fastsimp +qed + lemma evaln_abrupt_lemma: "G\s \e\\n\ (v,s') \ fst s = Some xc \ s' = s \ v = arbitrary3 e" apply (erule evaln_cases , auto) @@ -437,6 +502,14 @@ case Lit show ?case by (rule eval.Lit) next + case UnOp + with wf show ?case + by - (erule wt_elim_cases, rule eval.UnOp,auto dest: eval_type_sound) + next + case BinOp + with wf show ?case + by - (erule wt_elim_cases, blast intro!: eval.BinOp dest: eval_type_sound) + next case Super show ?case by (rule eval.Super) next @@ -494,11 +567,11 @@ check_method_access G accC' statT mode \name = mn, parTs = pTs'\ a' s3" by simp have evaln_methd: - "G\?InitLvars \Methd invDeclC \name = mn, parTs = pTs'\-\v\n\ s4" . + "G\?InitLvars \Methd invDeclC \name = mn, parTs = pTs'\-\v\n\ s4" . have hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 a')" . have hyp_args: "PROP ?EqEval s1 s2 (In3 args) (In3 vs)" . have hyp_methd: "PROP ?EqEval ?InitLvars s4 - (In1l (Methd invDeclC \name = mn, parTs = pTs'\)) (In1 v)". + (In1l (Methd invDeclC \name = mn, parTs = pTs'\)) (In1 v)". have conf_s0: "Norm s0\\(G, L)" . have wt: "\prg=G, cls=accC, lcl=L\ \In1l ({accC',statT,mode}e\mn( {pTs'}args))\T" . @@ -556,7 +629,7 @@ moreover from eq_s3'_s3 False keep_abrupt evaln_methd init_lvars obtain "s4=s3'" - "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" + "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" by auto moreover note False ultimately have @@ -591,7 +664,7 @@ moreover from eq_s3'_s3 np evaln_methd init_lvars obtain "s4=s3'" - "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" + "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" by auto moreover note np ultimately have @@ -674,7 +747,7 @@ \Body invDeclC (stmt (mbody (mthd dynM)))\-mthdT" and mthdT_widen: "G\mthdT\resTy dynM" by - (drule wf_mdecl_bodyD, - simp cong add: lname.case_cong ename.case_cong) + auto simp: cong add: lname.case_cong ename.case_cong) with dynM' iscls_invDeclC invDeclC' have "\prg=G,cls=invDeclC,lcl=L'\ @@ -873,10 +946,28 @@ show ?case by (rule eval.Try) next - case Fin - with wf show ?case - by -(erule wt_elim_cases, blast intro!: eval.Fin - dest: eval_type_sound intro: conforms_NormI) + case (Fin c1 c2 n s0 s1 s2 x1 L accC T) + have hyp_c1: "PROP ?EqEval (Norm s0) (x1,s1) (In1r c1) \" . + have hyp_c2: "PROP ?EqEval (Norm s1) (s2) (In1r c2) \" . + have conf_s0: "Norm s0\\(G, L)" . + have wt: "\prg = G, cls = accC, lcl = L\\In1r (c1 Finally c2)\T" . + then obtain + wt_c1: "\prg = G, cls = accC, lcl = L\\c1\\" and + wt_c2: "\prg = G, cls = accC, lcl = L\\c2\\" + by (rule wt_elim_cases) blast + from conf_s0 wt_c1 + have eval_c1: "G\Norm s0 \c1\ (x1, s1)" + by (rule hyp_c1) + with wf wt_c1 conf_s0 + obtain conf_s1: "Norm s1\\(G, L)" and + error_free_s1: "error_free (x1,s1)" + by (auto dest!: eval_type_sound intro: conforms_NormI) + from conf_s1 wt_c2 + have eval_c2: "G\Norm s1 \c2\ s2" + by (rule hyp_c2) + with eval_c1 error_free_s1 + show "G\Norm s0 \c1 Finally c2\ abupd (abrupt_if (x1 \ None) x1) s2" + by (auto intro: eval.Fin simp add: error_free_def) next case (Init C c n s0 s1 s2 s3 L accC T) have cls: "the (class G C) = c" . @@ -994,8 +1085,6 @@ show ?thesis . qed -text {* *} (* FIXME *) - lemma eval_evaln: assumes eval: "G\s0 \t\\ (v,s1)" and wt: "\prg=G,cls=accC,lcl=L\\t\T" and @@ -1029,7 +1118,7 @@ then obtain n where "G\Norm s0 \c\n\ s1" by (rules elim!: wt_elim_cases) - then have "G\Norm s0 \l\ c\n\ abupd (absorb (Break l)) s1" + then have "G\Norm s0 \l\ c\n\ abupd (absorb l) s1" by (rule evaln.Lab) then show ?case .. next @@ -1209,16 +1298,22 @@ by (auto intro!: evaln.Try le_maxI1 le_maxI2) then show ?case .. next - case (Fin c1 c2 s0 s1 s2 x1 L accC T) - with wf obtain n1 n2 where + case (Fin c1 c2 s0 s1 s2 s3 x1 L accC T) + have s3: "s3 = (if \err. x1 = Some (Error err) + then (x1, s1) + else abupd (abrupt_if (x1 \ None) x1) s2)" . + from Fin wf obtain n1 n2 where "G\Norm s0 \c1\n1\ (x1, s1)" - "G\Norm s1 \c2\n2\ s2" + "G\Norm s1 \c2\n2\ s2" and + error_free_s1: "error_free (x1,s1)" by (blast elim!: wt_elim_cases dest: eval_type_sound intro: conforms_NormI) then have "G\Norm s0 \c1 Finally c2\max n1 n2\ abupd (abrupt_if (x1 \ None) x1) s2" by (blast intro: evaln.Fin dest: evaln_max2) - then show ?case .. + with error_free_s1 s3 + show "\n. G\Norm s0 \c1 Finally c2\n\ s3" + by (auto simp add: error_free_def) next case (Init C c s0 s1 s2 s3 L accC T) have cls: "the (class G C) = c" . @@ -1340,6 +1435,24 @@ by (rule evaln.Lit) then show ?case .. next + case (UnOp e s0 s1 unop v L accC T) + with wf obtain n where + "G\Norm s0 \e-\v\n\ s1" + by (rules elim!: wt_elim_cases) + hence "G\Norm s0 \UnOp unop e-\eval_unop unop v\n\ s1" + by (rule evaln.UnOp) + then show ?case .. + next + case (BinOp binop e1 e2 s0 s1 s2 v1 v2 L accC T) + with wf obtain n1 n2 where + "G\Norm s0 \e1-\v1\n1\ s1" + "G\s1 \e2-\v2\n2\ s2" + by (blast elim!: wt_elim_cases dest: eval_type_sound) + hence "G\Norm s0 \BinOp binop e1 e2-\(eval_binop binop v1 v2)\max n1 n2 + \ s2" + by (blast intro!: evaln.BinOp dest: evaln_max2) + then show ?case .. + next case (Super s L accC T) have "G\Norm s \Super-\val_this s\n\ Norm s" by (rule evaln.Super) @@ -1414,7 +1527,7 @@ have hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 a')" . have hyp_args: "PROP ?EqEval s1 s2 (In3 args) (In3 vs)" . have hyp_methd: "PROP ?EqEval s3' s4 - (In1l (Methd invDeclC \name = mn, parTs = pTs'\)) (In1 v)". + (In1l (Methd invDeclC \name = mn, parTs = pTs'\)) (In1 v)". have conf_s0: "Norm s0\\(G, L)" . have wt: "\prg=G, cls=accC, lcl=L\ \In1l ({accC',statT,mode}e\mn( {pTs'}args))\T" . @@ -1475,7 +1588,7 @@ moreover from eq_s3'_s3 False keep_abrupt eval_methd init_lvars obtain "s4=s3'" - "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" + "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" by auto moreover note False evaln.Abrupt ultimately obtain m where @@ -1514,7 +1627,7 @@ moreover from eq_s3'_s3 np eval_methd init_lvars obtain "s4=s3'" - "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" + "In1 v=arbitrary3 (In1l (Methd invDeclC \name = mn, parTs = pTs'\))" by auto moreover note np ultimately obtain m where @@ -1600,7 +1713,7 @@ "\prg=G,cls=invDeclC,lcl=L'\ \Body invDeclC (stmt (mbody (mthd dynM)))\-mthdT" by - (drule wf_mdecl_bodyD, - simp cong add: lname.case_cong ename.case_cong) + auto simp: cong add: lname.case_cong ename.case_cong) with dynM' iscls_invDeclC invDeclC' have "\prg=G,cls=invDeclC,lcl=L'\