src/HOL/MicroJava/Comp/LemmasComp.thy
changeset 14045 a34d89ce6097
parent 14025 d9b155757dc8
child 14952 47455995693d
equal deleted inserted replaced
14044:bbd2f7b00736 14045:a34d89ce6097
     6 
     6 
     7 (* Lemmas for compiler correctness proof *)
     7 (* Lemmas for compiler correctness proof *)
     8 
     8 
     9 theory LemmasComp = TranslComp:
     9 theory LemmasComp = TranslComp:
    10 
    10 
       
    11 
       
    12 declare split_paired_All [simp del]
       
    13 declare split_paired_Ex [simp del]
       
    14 
       
    15 
    11 (**********************************************************************)
    16 (**********************************************************************)
    12 (* misc lemmas *)
    17 (* misc lemmas *)
       
    18 
       
    19 
    13 
    20 
    14 lemma split_pairs: "(\<lambda>(a,b). (F a b)) (ab) = F (fst ab) (snd ab)"
    21 lemma split_pairs: "(\<lambda>(a,b). (F a b)) (ab) = F (fst ab) (snd ab)"
    15 proof -
    22 proof -
    16   have "(\<lambda>(a,b). (F a b)) (fst ab,snd ab) = F (fst ab) (snd ab)"
    23   have "(\<lambda>(a,b). (F a b)) (fst ab,snd ab) = F (fst ab) (snd ab)"
    17     by (simp add: split_def)
    24     by (simp add: split_def)
    30 by (case_tac st, simp only: c_hupd_conv gx_conv)
    37 by (case_tac st, simp only: c_hupd_conv gx_conv)
    31 
    38 
    32 (* not added to simpset because of interference with c_hupd_conv *)
    39 (* not added to simpset because of interference with c_hupd_conv *)
    33 lemma c_hupd_hp_invariant: "gh (c_hupd hp (None, st)) = hp"
    40 lemma c_hupd_hp_invariant: "gh (c_hupd hp (None, st)) = hp"
    34 by (case_tac st, simp add: c_hupd_conv gh_def)
    41 by (case_tac st, simp add: c_hupd_conv gh_def)
       
    42 
       
    43 
       
    44 lemma unique_map_fst [rule_format]: "(\<forall> x \<in> set xs. (fst x = fst (f x) )) \<longrightarrow>
       
    45   unique (map f xs) = unique xs"
       
    46 proof (induct xs)
       
    47   case Nil show ?case by simp
       
    48 next
       
    49   case (Cons a list)
       
    50   show ?case
       
    51   proof
       
    52     assume fst_eq: "\<forall>x\<in>set (a # list). fst x = fst (f x)"
       
    53 
       
    54     have fst_set: "(fst a \<in> fst ` set list) = (fst (f a) \<in> fst ` f ` set list)" 
       
    55     proof 
       
    56       assume as: "fst a \<in> fst ` set list" 
       
    57       then obtain x where fst_a_x: "x\<in>set list \<and> fst a = fst x" 
       
    58 	by (auto simp add: image_iff)
       
    59       then have "fst (f a) = fst (f x)" by (simp add: fst_eq)
       
    60       with as show "(fst (f a) \<in> fst ` f ` set list)" by (simp add: fst_a_x)
       
    61     next
       
    62       assume as: "fst (f a) \<in> fst ` f ` set list"
       
    63       then obtain x where fst_a_x: "x\<in>set list \<and> fst (f a) = fst (f x)"
       
    64 	by (auto simp add: image_iff)
       
    65       then have "fst a = fst x" by (simp add: fst_eq)
       
    66       with as show "fst a \<in> fst ` set list" by (simp add: fst_a_x)
       
    67     qed
       
    68 
       
    69     with fst_eq Cons 
       
    70     show "unique (map f (a # list)) = unique (a # list)"
       
    71       by (simp add: unique_def fst_set)
       
    72   qed
       
    73 qed
       
    74 
       
    75 lemma comp_unique: "unique (comp G) = unique G"
       
    76 apply (simp add: comp_def)
       
    77 apply (rule unique_map_fst)
       
    78 apply (simp add: compClass_def split_beta)
       
    79 done
    35 
    80 
    36 
    81 
    37 (**********************************************************************)
    82 (**********************************************************************)
    38 (* invariance of properties under compilation *)
    83 (* invariance of properties under compilation *)
    39 
    84 
    51 apply (simp add: class_def comp_def compClass_def)
    96 apply (simp add: class_def comp_def compClass_def)
    52 apply (simp add: map_of_in_set)
    97 apply (simp add: map_of_in_set)
    53 apply (simp add: image_compose [THEN sym] o_def split_beta del: image_compose)
    98 apply (simp add: image_compose [THEN sym] o_def split_beta del: image_compose)
    54 done
    99 done
    55 
   100 
    56 lemma comp_is_class: "is_class G C = is_class (comp G) C"
   101 lemma comp_is_class: "is_class (comp G) C = is_class G C"
    57 by (case_tac "class G C", auto simp: is_class_def comp_class_None dest: comp_class_imp)
   102 by (case_tac "class G C", auto simp: is_class_def comp_class_None dest: comp_class_imp)
    58 
   103 
    59 
   104 
    60 lemma comp_is_type: "is_type G T = is_type (comp G) T"
   105 lemma comp_is_type: "is_type (comp G) T = is_type G T"
    61   by ((cases T),simp,(induct G)) ((simp),(simp only: comp_is_class),(simp add: comp_is_class),(simp only: comp_is_class))
   106   by ((cases T),simp,(induct G)) ((simp),(simp only: comp_is_class),(simp add: comp_is_class),(simp only: comp_is_class))
    62 
   107 
    63 lemma SIGMA_cong: "\<lbrakk> A = B; !!x. x \<in> B \<Longrightarrow> C x = D x \<rbrakk> \<Longrightarrow> (\<Sigma> x \<in> A. C x) = (\<Sigma> x \<in> B. D x)"
   108 lemma SIGMA_cong: "\<lbrakk> A = B; !!x. x \<in> B \<Longrightarrow> C x = D x \<rbrakk> 
       
   109   \<Longrightarrow> (\<Sigma> x \<in> A. C x) = (\<Sigma> x \<in> B. D x)"
    64 by auto
   110 by auto
    65 
   111 
    66 lemma comp_classname: "is_class G C \<Longrightarrow> fst (the (class G C)) = fst (the (class (comp G) C))"
   112 lemma comp_classname: "is_class G C 
       
   113   \<Longrightarrow> fst (the (class G C)) = fst (the (class (comp G) C))"
    67 by (case_tac "class G C", auto simp: is_class_def dest: comp_class_imp)
   114 by (case_tac "class G C", auto simp: is_class_def dest: comp_class_imp)
    68 
   115 
    69 
   116 
    70 lemma comp_subcls1: "subcls1 G = subcls1 (comp G)"
   117 lemma comp_subcls1: "subcls1 (comp G) = subcls1 G"
    71 apply (simp add: subcls1_def2 comp_is_class)
   118 apply (simp add: subcls1_def2 comp_is_class)
    72 apply (rule SIGMA_cong, simp)
   119 apply (rule SIGMA_cong, simp)
    73 apply (simp add: comp_is_class [THEN sym])
   120 apply (simp add: comp_is_class)
    74 apply (simp add: comp_classname)
   121 apply (simp add: comp_classname)
    75 done
   122 done
    76 
   123 
    77 lemma comp_subcls: "(subcls1 G)^* = (subcls1 (comp G))^*"
   124 lemma comp_widen: "((ty1,ty2) \<in> widen (comp G)) = ((ty1,ty2) \<in> widen G)"
    78   by (induct G) (simp_all add: comp_def comp_subcls1)
       
    79 
       
    80 lemma comp_widen: "((ty1,ty2) \<in> widen G) = ((ty1,ty2) \<in> widen (comp G))"
       
    81   apply rule
   125   apply rule
       
   126   apply (cases "(ty1,ty2)" "comp G" rule: widen.cases) 
       
   127   apply (simp_all add: comp_subcls1 widen.null)
    82   apply (cases "(ty1,ty2)" G rule: widen.cases) 
   128   apply (cases "(ty1,ty2)" G rule: widen.cases) 
    83   apply (simp_all add: comp_subcls widen.null)
   129   apply (simp_all add: comp_subcls1 widen.null)
    84   apply (cases "(ty1,ty2)" "comp G" rule: widen.cases) 
       
    85   apply (simp_all add: comp_subcls widen.null)
       
    86   done
   130   done
    87 
   131 
    88 lemma comp_cast: "((ty1,ty2) \<in> cast G) = ((ty1,ty2) \<in> cast (comp G))"
   132 lemma comp_cast: "((ty1,ty2) \<in> cast (comp G)) = ((ty1,ty2) \<in> cast G)"
    89   apply rule
   133   apply rule
       
   134   apply (cases "(ty1,ty2)" "comp G" rule: cast.cases) 
       
   135   apply (simp_all add: comp_subcls1 cast.widen cast.subcls)
       
   136   apply (rule cast.widen) apply (simp add: comp_widen)
    90   apply (cases "(ty1,ty2)" G rule: cast.cases)
   137   apply (cases "(ty1,ty2)" G rule: cast.cases)
    91   apply (simp_all add: comp_subcls cast.widen cast.subcls)
   138   apply (simp_all add: comp_subcls1 cast.widen cast.subcls)
    92   apply (cases "(ty1,ty2)" "comp G" rule: cast.cases) 
   139   apply (rule cast.widen) apply (simp add: comp_widen)
    93   apply (simp_all add: comp_subcls cast.widen cast.subcls)
       
    94   done
   140   done
    95 
   141 
    96 lemma comp_cast_ok: "cast_ok G = cast_ok (comp G)"
   142 lemma comp_cast_ok: "cast_ok (comp G) = cast_ok G"
    97   by (simp add: expand_fun_eq cast_ok_def comp_widen)
   143   by (simp add: expand_fun_eq cast_ok_def comp_widen)
    98 
   144 
    99 
   145 
   100 lemma comp_wf_fdecl: "wf_fdecl G fd  \<Longrightarrow> wf_fdecl (comp G) fd"
   146 lemma compClass_fst [simp]: "(fst (compClass G C)) = (fst C)"
   101 apply (case_tac fd)
   147 by (simp add: compClass_def split_beta)
   102 apply (simp add: wf_fdecl_def comp_is_type)
   148 
   103 done
   149 lemma compClass_fst_snd [simp]: "(fst (snd (compClass G C))) = (fst (snd C))"
   104 
   150 by (simp add: compClass_def split_beta)
   105 lemma comp_wf_syscls: "wf_syscls G = wf_syscls (comp G)"
   151 
       
   152 lemma compClass_fst_snd_snd [simp]: "(fst (snd (snd (compClass G C)))) = (fst (snd (snd C)))"
       
   153 by (simp add: compClass_def split_beta)
       
   154 
       
   155 lemma comp_wf_fdecl [simp]: "wf_fdecl (comp G) fd = wf_fdecl G fd"
       
   156 by (case_tac fd, simp add: wf_fdecl_def comp_is_type)
       
   157 
       
   158 
       
   159 lemma compClass_forall [simp]: "
       
   160   (\<forall>x\<in>set (snd (snd (snd (compClass G C)))). P (fst x) (fst (snd x))) =
       
   161   (\<forall>x\<in>set (snd (snd (snd C))). P (fst x) (fst (snd x)))"
       
   162 by (simp add: compClass_def compMethod_def split_beta)
       
   163 
       
   164 lemma comp_wf_mhead: "wf_mhead (comp G) S rT =  wf_mhead G S rT"
       
   165 by (simp add: wf_mhead_def split_beta comp_is_type)
       
   166 
       
   167 lemma comp_ws_cdecl: "
       
   168   ws_cdecl (TranslComp.comp G) (compClass G C) = ws_cdecl G C"
       
   169 apply (simp add: ws_cdecl_def split_beta comp_is_class comp_subcls1)
       
   170 apply (simp (no_asm_simp) add: comp_wf_mhead)
       
   171 apply (simp add: compClass_def compMethod_def split_beta unique_map_fst)
       
   172 done
       
   173 
       
   174 
       
   175 lemma comp_wf_syscls: "wf_syscls (comp G) = wf_syscls G"
   106 apply (simp add: wf_syscls_def comp_def compClass_def split_beta)
   176 apply (simp add: wf_syscls_def comp_def compClass_def split_beta)
   107 apply (simp only: image_compose [THEN sym])
   177 apply (simp only: image_compose [THEN sym])
   108 apply (subgoal_tac "(Fun.comp fst (\<lambda>(C, cno::cname, fdls::fdecl list, jmdls). (C, cno, fdls, map (compMethod G C) jmdls))) = fst")
   178 apply (subgoal_tac "(Fun.comp fst (\<lambda>(C, cno::cname, fdls::fdecl list, jmdls).
   109 (*
   179   (C, cno, fdls, map (compMethod G C) jmdls))) = fst")
   110 apply (subgoal_tac "(fst o (\<lambda>(C, cno::cname, fdls::fdecl list, jmdls). (C, cno, fdls, map (compMethod G C) jmdls))) = fst")
       
   111 *)
       
   112 apply (simp del: image_compose)
   180 apply (simp del: image_compose)
   113 apply (simp add: expand_fun_eq split_beta)
   181 apply (simp add: expand_fun_eq split_beta)
   114 done
   182 done
   115 
   183 
   116 
   184 
   117 lemma comp_wf_mhead: "wf_mhead G S rT =  wf_mhead (comp G) S rT"
   185 lemma comp_ws_prog: "ws_prog (comp G) = ws_prog G"
   118 by (simp add: wf_mhead_def split_beta comp_is_type)
   186 apply (rule sym)
   119 
   187 apply (simp add: ws_prog_def comp_ws_cdecl comp_unique)
   120 lemma comp_wf_mdecl: "\<lbrakk> wf_mdecl wf_mb G C jmdl;
   188 apply (simp add: comp_wf_syscls)
   121   (wf_mb G C jmdl) \<longrightarrow> (wf_mb_comp (comp G) C (compMethod G C jmdl)) \<rbrakk> 
   189 apply (auto simp add: comp_ws_cdecl [THEN sym] TranslComp.comp_def)
   122  \<Longrightarrow> 
   190 done
   123   wf_mdecl wf_mb_comp (comp G) C (compMethod G C jmdl)"
       
   124 by (simp add: wf_mdecl_def wf_mhead_def comp_is_type split_beta compMethod_def)
       
   125 
   191 
   126 
   192 
   127 lemma comp_class_rec: " wf ((subcls1 G)^-1) \<Longrightarrow> 
   193 lemma comp_class_rec: " wf ((subcls1 G)^-1) \<Longrightarrow> 
   128 class_rec (comp G) C t f = 
   194 class_rec (comp G) C t f = 
   129   class_rec G C t (\<lambda> C' fs' ms' r'. f C' fs' (map (compMethod G C') ms') r')"
   195   class_rec G C t (\<lambda> C' fs' ms' r'. f C' fs' (map (compMethod G C') ms') r')"
   157 apply auto
   223 apply auto
   158 apply (simp add: comp_subcls1)
   224 apply (simp add: comp_subcls1)
   159 done
   225 done
   160 
   226 
   161 lemma comp_fields: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   227 lemma comp_fields: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   162   fields (G,C) = fields (comp G,C)" 
   228   fields (comp G,C) = fields (G,C)" 
   163 by (simp add: fields_def comp_class_rec)
   229 by (simp add: fields_def comp_class_rec)
   164 
   230 
   165 lemma comp_field: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   231 lemma comp_field: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   166   field (G,C) = field (comp G,C)" 
   232   field (comp G,C) = field (G,C)" 
   167 by (simp add: field_def comp_fields)
   233 by (simp add: field_def comp_fields)
   168 
   234 
   169 
   235 
   170 
   236 
   171 lemma class_rec_relation [rule_format (no_asm)]: "\<lbrakk>  wf_prog wf_mb G;
   237 lemma class_rec_relation [rule_format (no_asm)]: "\<lbrakk>  ws_prog G;
   172   \<forall> fs ms. R (f1 Object fs ms t1) (f2 Object fs ms t2);
   238   \<forall> fs ms. R (f1 Object fs ms t1) (f2 Object fs ms t2);
   173    \<forall> C fs ms r1 r2. (R r1 r2) \<longrightarrow> (R (f1 C fs ms r1) (f2 C fs ms r2)) \<rbrakk>
   239    \<forall> C fs ms r1 r2. (R r1 r2) \<longrightarrow> (R (f1 C fs ms r1) (f2 C fs ms r2)) \<rbrakk>
   174   \<Longrightarrow> ((class G C) \<noteq> None) \<longrightarrow> 
   240   \<Longrightarrow> ((class G C) \<noteq> None) \<longrightarrow> 
   175   R (class_rec G C t1 f1) (class_rec G C t2 f2)"
   241   R (class_rec G C t1 f1) (class_rec G C t2 f2)"
   176 apply (frule wf_subcls1) (* establish wf ((subcls1 G)^-1) *)
   242 apply (frule wf_subcls1) (* establish wf ((subcls1 G)^-1) *)
   192     apply (subgoal_tac "(\<exists>D' rT' mb'. class G D = Some (D', rT', mb'))")
   258     apply (subgoal_tac "(\<exists>D' rT' mb'. class G D = Some (D', rT', mb'))")
   193     apply blast
   259     apply blast
   194 
   260 
   195   (* subgoals *)
   261   (* subgoals *)
   196 
   262 
   197 apply (frule class_wf) apply assumption
   263 apply (frule class_wf_struct) apply assumption
   198 apply (simp add: wf_cdecl_def is_class_def)
   264 apply (simp add: ws_cdecl_def is_class_def)
   199 
   265 
   200 apply (simp add: subcls1_def2 is_class_def)
   266 apply (simp add: subcls1_def2 is_class_def)
       
   267 apply auto
   201 done
   268 done
   202 
   269 
   203 
   270 
   204 syntax
   271 syntax
   205   mtd_mb :: "cname \<times> ty \<times> 'c \<Rightarrow> 'c"
   272   mtd_mb :: "cname \<times> ty \<times> 'c \<Rightarrow> 'c"
   206 translations
   273 translations
   207   "mtd_mb" => "Fun.comp snd snd"
   274   "mtd_mb" => "Fun.comp snd snd"
   208 
   275 
   209 
   276 lemma map_of_map_fst: "\<lbrakk> inj f;
   210 lemma map_of_map_fst: "\<lbrakk> map_of (map f xs) k = Some e; inj f;
       
   211   \<forall>x\<in>set xs. fst (f x) = fst x; \<forall>x\<in>set xs. fst (g x) = fst x \<rbrakk>
   277   \<forall>x\<in>set xs. fst (f x) = fst x; \<forall>x\<in>set xs. fst (g x) = fst x \<rbrakk>
   212   \<Longrightarrow>  map_of (map g xs) k = Some (snd (g ((inv f) (k, e))))"
   278   \<Longrightarrow>  map_of (map g xs) k 
       
   279   = option_map (\<lambda> e. (snd (g ((inv f) (k, e))))) (map_of (map f xs) k)"
   213 apply (induct xs)
   280 apply (induct xs)
   214 apply simp
   281 apply simp
   215 apply (simp del: split_paired_All)
   282 apply (simp del: split_paired_All)
   216 apply (case_tac "k = fst a")
   283 apply (case_tac "k = fst a")
   217 apply (simp del: split_paired_All)
   284 apply (simp del: split_paired_All)
   218 apply (subgoal_tac "(fst a, e)  = f a")
   285 apply (subgoal_tac "(inv f (fst a, snd (f a))) = a", simp)
   219 apply simp
   286 apply (subgoal_tac "(fst a, snd (f a)) = f a", simp)
   220 apply (rule_tac s= "(fst (f a), snd (f a))" in trans)
   287 apply (erule conjE)+
   221 apply simp
   288 apply (drule_tac s ="fst (f a)" and t="fst a" in sym)
   222 apply (rule surjective_pairing [THEN sym])
   289 apply simp
   223 apply (simp del: split_paired_All)
   290 apply (simp add: surjective_pairing)
   224 done
   291 done
   225 
   292 
   226 
   293 
   227 lemma comp_method [rule_format (no_asm)]: "\<lbrakk> wf_prog wf_mb G; is_class G C\<rbrakk> \<Longrightarrow> 
   294 lemma comp_method [rule_format (no_asm)]: "\<lbrakk> ws_prog G; is_class G C\<rbrakk> \<Longrightarrow> 
   228   (method (G, C) S) = Some (D, rT, mb) \<longrightarrow> 
   295   ((method (comp G, C) S) = 
   229   (method (comp G, C) S) = Some (D, rT, mtd_mb (compMethod G D (S, rT, mb)))"
   296   option_map (\<lambda> (D,rT,b).  (D, rT, mtd_mb (compMethod G D (S, rT, b))))
       
   297              (method (G, C) S))"
   230 apply (simp add: method_def)
   298 apply (simp add: method_def)
   231 apply (frule wf_subcls1)
   299 apply (frule wf_subcls1)
   232 apply (simp add: comp_class_rec)
   300 apply (simp add: comp_class_rec)
   233 apply (simp add: map_compose [THEN sym] split_iter split_compose del: map_compose)
   301 apply (simp add: map_compose [THEN sym] split_iter split_compose del: map_compose)
   234 apply (rule_tac R="%x y. (x S) = Some (D, rT, mb) \<longrightarrow> (y S) = Some (D, rT, snd (snd (compMethod G D (S, rT, mb))))" in  class_rec_relation) apply assumption
   302 apply (rule_tac R="%x y. ((x S) = (option_map (\<lambda>(D, rT, b). 
   235 
   303   (D, rT, snd (snd (compMethod G D (S, rT, b))))) (y S)))" 
   236 apply (intro strip)
   304   in class_rec_relation)
   237 apply simp
   305 apply assumption
   238 
   306 
   239 apply (frule_tac f="(\<lambda>(s, m). (s, Object, m))" 
   307 apply (intro strip)
   240   and g="(Fun.comp (\<lambda>(s, m). (s, Object, m)) (compMethod G Object))" in map_of_map_fst)
   308 apply simp
   241 (*
   309 
   242 apply (frule_tac f="(\<lambda>(s, m). (s, Object, m))" 
   310 apply (rule trans)
   243   and g="((\<lambda>(s, m). (s, Object, m)) \<circ> compMethod G Object)" in map_of_map_fst)
   311 
   244 *)
   312 apply (rule_tac f="(\<lambda>(s, m). (s, Object, m))" and
   245 apply (simp add: inj_on_def)
   313   g="(Fun.comp (\<lambda>(s, m). (s, Object, m)) (compMethod G Object))" 
       
   314   in map_of_map_fst)
       
   315 defer				(* inj \<dots> *)
       
   316 apply (simp add: inj_on_def split_beta) 
   246 apply (simp add: split_beta compMethod_def)
   317 apply (simp add: split_beta compMethod_def)
   247 apply (simp add: split_beta compMethod_def)
   318 apply (simp add: map_of_map [THEN sym])
       
   319 apply (simp add: split_beta)
       
   320 apply (simp add: map_compose [THEN sym] Fun.comp_def split_beta)
       
   321 apply (subgoal_tac "(\<lambda>x\<Colon>(vname list \<times> fdecl list \<times> stmt \<times> expr) mdecl.
       
   322                     (fst x, Object,
       
   323                      snd (compMethod G Object
       
   324                            (inv (\<lambda>(s\<Colon>sig, m\<Colon>ty \<times> vname list \<times> fdecl list \<times> stmt \<times> expr).
       
   325                                     (s, Object, m))
       
   326                              (S, Object, snd x)))))
       
   327   = (\<lambda>x. (fst x, Object, fst (snd x),
       
   328                         snd (snd (compMethod G Object (S, snd x)))))")
   248 apply (simp only:)
   329 apply (simp only:)
   249 apply (subgoal_tac "(inv (\<lambda>(s, m). (s, Object, m)) (S, D, rT, mb)) = (S, rT, mb)")
   330 apply (simp add: expand_fun_eq)
       
   331 apply (intro strip)
       
   332 apply (subgoal_tac "(inv (\<lambda>(s, m). (s, Object, m)) (S, Object, snd x)) = (S, snd x)")
   250 apply (simp only:)
   333 apply (simp only:)
   251 apply (simp add: compMethod_def split_beta)
   334 apply (simp add: compMethod_def split_beta)
   252 apply (simp add: map_of_map) apply (erule exE)+ apply simp
   335 apply (rule inv_f_eq) 
   253 apply (simp add: map_of_map) apply (erule exE)+ apply simp
   336 defer
   254 apply (rule inv_f_eq) apply (simp add: inj_on_def) apply simp
   337 defer
   255 
   338 
   256 apply (intro strip)
   339 apply (intro strip)
   257 apply (simp add: map_add_Some_iff map_of_map del: split_paired_Ex)
   340 apply (simp add: map_add_Some_iff map_of_map del: split_paired_Ex)
       
   341 apply (simp add: map_add_def)
       
   342 apply (subgoal_tac "inj (\<lambda>(s, m). (s, Ca, m))")
       
   343 apply (drule_tac g="(Fun.comp (\<lambda>(s, m). (s, Ca, m)) (compMethod G Ca))" and xs=ms
       
   344   and k=S in map_of_map_fst) 
       
   345 apply (simp add: split_beta) 
       
   346 apply (simp add: compMethod_def split_beta)
       
   347 apply (case_tac "(map_of (map (\<lambda>(s, m). (s, Ca, m)) ms) S)")
       
   348 apply simp
       
   349 apply simp apply (simp add: split_beta map_of_map) apply (erule exE) apply (erule conjE)+
       
   350 apply (drule_tac t=a in sym)
       
   351 apply (subgoal_tac "(inv (\<lambda>(s, m). (s, Ca, m)) (S, a)) = (S, snd a)")
       
   352 apply simp
   258 apply (subgoal_tac "\<forall>x\<in>set ms. fst ((Fun.comp (\<lambda>(s, m). (s, Ca, m)) (compMethod G Ca)) x) = fst x")
   353 apply (subgoal_tac "\<forall>x\<in>set ms. fst ((Fun.comp (\<lambda>(s, m). (s, Ca, m)) (compMethod G Ca)) x) = fst x")
   259 (*
   354    prefer 2 apply (simp (no_asm_simp) add: compMethod_def split_beta)
   260 apply (subgoal_tac "\<forall>x\<in>set ms. fst (((\<lambda>(s, m). (s, Ca, m)) \<circ> compMethod G Ca) x) = fst x")
       
   261 *)
       
   262 apply (erule disjE)
       
   263 apply (rule disjI1)
       
   264 apply (simp add: map_of_map2)
   355 apply (simp add: map_of_map2)
   265 apply (simp (no_asm_simp) add: compMethod_def split_beta)
   356 apply (simp (no_asm_simp) add: compMethod_def split_beta)
   266 
   357 
   267 apply (rule disjI2)
   358   -- "remaining subgoals"
   268 apply (simp add: map_of_map2)
   359 apply (auto intro: inv_f_eq simp add: inj_on_def is_class_def)
   269 
   360 done
   270   -- "subgoal"
   361 
   271 apply (simp (no_asm_simp) add: compMethod_def split_beta)
   362 
   272 
   363 
   273 apply (simp add: is_class_def)
   364 lemma comp_wf_mrT: "\<lbrakk> ws_prog G; is_class G D\<rbrakk> \<Longrightarrow> 
   274 done
   365   wf_mrT (TranslComp.comp G) (C, D, fs, map (compMethod G a) ms) =
   275 
   366   wf_mrT G (C, D, fs, ms)"
   276 
   367 apply (simp add: wf_mrT_def compMethod_def split_beta)
   277 constdefs comp_method_result :: "java_mb prog \<Rightarrow> sig \<Rightarrow> 
   368 apply (simp add: comp_widen)
   278   (cname \<times> ty \<times> java_mb) option \<Rightarrow> (cname \<times> ty \<times> jvm_method) option"
   369 apply (rule iffI)
   279   "comp_method_result G S m ==  case m of 
   370 apply (intro strip)
   280     None \<Rightarrow> None
   371 apply simp
   281   | Some (D, rT, mb) \<Rightarrow> Some (D, rT, mtd_mb (compMethod G D (S, rT, mb)))"
   372 apply (drule bspec) apply assumption
   282 
   373 apply (drule_tac x=D' in spec) apply (drule_tac x=rT' in spec) apply (drule mp)
   283 
   374 prefer 2 apply assumption
   284 lemma map_of_map_compMethod: "map_of (map (\<lambda>(s, m). (s, C, m)) (map (compMethod G C) ms)) S =
   375 apply (simp add: comp_method [of G D])
   285           (case map_of (map (\<lambda>(s, m). (s, C, m)) ms) S of None \<Rightarrow> None
       
   286            | Some (D, rT, mb) \<Rightarrow> Some (D, rT, mtd_mb (compMethod G D (S, rT, mb))))"
       
   287 apply (induct ms)
       
   288 apply simp
       
   289 apply (simp only: map_compose [THEN sym])
       
   290 apply (simp add: o_def split_beta del: map.simps)
       
   291 apply (simp (no_asm_simp) only: map.simps map_of.simps)
       
   292 apply (simp add: compMethod_def split_beta)
       
   293 done
       
   294 
       
   295   (* the following is more expressive than comp_method and should replace it *)
       
   296 lemma comp_method_eq [rule_format (no_asm)]: "wf_prog wf_mb G \<Longrightarrow> is_class G C \<longrightarrow>
       
   297 method (comp G, C) S = comp_method_result G S (method (G,C) S)"
       
   298 apply (subgoal_tac "wf ((subcls1 G)^-1)") prefer 2 apply (rule wf_subcls1, assumption) 
       
   299 
       
   300 apply (rule subcls_induct)
       
   301 apply assumption
       
   302 apply (intro strip)
       
   303 apply (subgoal_tac "\<exists> D fs ms. class G C = Some (D, fs, ms)") 
       
   304    prefer 2 apply (simp add: is_class_def)
       
   305 apply (erule exE)+
   376 apply (erule exE)+
   306 
   377 apply (subgoal_tac "z =(fst z, fst (snd z), snd (snd z))")
   307 apply (case_tac "C = Object")
   378 apply (rule exI)
   308 
   379 apply (simp)
   309   (* C = Object *)
   380 apply (simp add: split_paired_all)
   310 apply (subst method_rec_lemma) apply assumption+ apply simp 
   381 apply (intro strip)
   311 apply (subst method_rec_lemma) apply (frule comp_class_imp) apply assumption+ 
   382 apply (simp add: comp_method)
   312    apply (simp add: comp_subcls1) 
   383 apply auto
   313 apply (simp add: comp_method_result_def)
       
   314 apply (rule map_of_map_compMethod) 
       
   315 
       
   316   (* C \<noteq> Object *)
       
   317 apply (subgoal_tac "(C, D) \<in> (subcls1 G)\<^sup>+") 
       
   318    prefer 2 apply (frule subcls1I, assumption+) apply blast
       
   319 apply (subgoal_tac "is_class G D")
       
   320 apply (drule spec, drule mp, assumption, drule mp, assumption)
       
   321 apply (frule wf_subcls1) 
       
   322 apply (subgoal_tac "wf ((subcls1 (comp G))\<inverse>)")
       
   323 apply (frule_tac G=G in method_rec_lemma, assumption)
       
   324 apply (frule comp_class_imp)
       
   325 apply (frule_tac G="comp G" in method_rec_lemma, assumption)
       
   326 apply (simp only:)
       
   327 apply (simp (no_asm_simp) add: comp_method_result_def expand_fun_eq)
       
   328 
       
   329 apply (case_tac "(method (G, D) ++  map_of (map (\<lambda>(s, m). (s, C, m)) ms)) S")
       
   330 
       
   331   (* case None *)
       
   332 apply (simp (no_asm_simp) add: map_add_None)
       
   333 apply (simp add: map_of_map_compMethod comp_method_result_def) 
       
   334 
       
   335   (* case Some *)
       
   336 apply (simp add: map_add_Some_iff)
       
   337 apply (erule disjE)
       
   338   apply (simp add: split_beta map_of_map_compMethod)
       
   339   apply (simp add: map_add_def comp_method_result_def map_of_map_compMethod)
       
   340 
       
   341   (* show subgoals *)
       
   342 apply (simp add: comp_subcls1) 
       
   343   (* show is_class G D *)
       
   344 apply (simp add: wf_prog_def wf_cdecl_def)
       
   345 apply (subgoal_tac "(C, D, fs, ms)\<in>set G")
       
   346 apply blast
       
   347 apply (simp add: class_def map_of_SomeD)
       
   348 done
       
   349 
       
   350   (* ### this proof is horrid and has to be redone *)
       
   351 lemma unique_map_fst [rule_format]: "(\<forall> x \<in> set xs. (fst x = fst (f x) )) \<longrightarrow>
       
   352   unique xs = unique (map f xs)"
       
   353 apply (induct_tac "xs")
       
   354 apply simp
       
   355 apply (intro strip)
       
   356 apply simp
       
   357 apply (case_tac a, simp)
       
   358 apply (case_tac "f (aa, b)")
       
   359 apply (simp only:)
       
   360 apply (simp only: unique_Cons)
       
   361 
       
   362 apply simp
       
   363 apply (subgoal_tac "(\<exists>y. (ab, y) \<in> set list) = (\<exists>y. (ab, y) \<in> f ` set list)")
       
   364 apply blast
       
   365 apply (rule iffI)
       
   366 
       
   367 apply clarify
       
   368 apply (rule_tac x="(snd (f(ab, y)))" in exI)
       
   369 apply simp
       
   370 apply (subgoal_tac "(ab, snd (f (ab, y))) = (fst (f (ab, y)), snd (f (ab, y)))")
       
   371 apply (simp only:)
       
   372 apply (simp add: surjective_pairing [THEN sym])
       
   373 apply (subgoal_tac "fst (f (ab, y)) = fst (ab, y)")
       
   374 apply simp
       
   375 apply (drule bspec) apply assumption apply simp
       
   376 
       
   377 apply clarify
       
   378 apply (drule bspec) apply assumption apply simp
       
   379 apply (subgoal_tac "ac = ab")
       
   380 apply simp
       
   381 apply blast
       
   382 apply (drule sym)
       
   383 apply (drule sym)
       
   384 apply (drule_tac f=fst in arg_cong)
       
   385 apply simp
       
   386 done
       
   387 
       
   388 lemma comp_unique: "unique G = unique (comp G)"
       
   389 apply (simp add: comp_def)
       
   390 apply (rule unique_map_fst)
       
   391 apply (simp add: compClass_def split_beta)
       
   392 done
   384 done
   393 
   385 
   394 
   386 
   395 (**********************************************************************)
   387 (**********************************************************************)
   396   (* DIVERSE OTHER LEMMAS *)
   388   (* DIVERSE OTHER LEMMAS *)
   397 (**********************************************************************)
   389 (**********************************************************************)
   398 
   390 
   399 
       
   400 (* already proved less elegantly in CorrComp.thy;
       
   401   to be moved into a common super-theory *)
       
   402 lemma max_spec_preserves_length:
   391 lemma max_spec_preserves_length:
   403   "max_spec G C (mn, pTs) = {((md,rT),pTs')} 
   392   "max_spec G C (mn, pTs) = {((md,rT),pTs')} 
   404   \<Longrightarrow> length pTs = length pTs'"
   393   \<Longrightarrow> length pTs = length pTs'"
   405 apply (frule max_spec2mheads)
   394 apply (frule max_spec2mheads)
   406 apply (erule exE)+
   395 apply (erule exE)+
   407 apply (simp add: list_all2_def)
   396 apply (simp add: list_all2_def)
   408 done
   397 done
   409 
   398 
   410 
   399 
   411 (* already proved in CorrComp.thy \<longrightarrow> into common supertheory *)
       
   412 lemma ty_exprs_length [simp]: "(E\<turnstile>es[::]Ts \<longrightarrow> length es = length Ts)"
   400 lemma ty_exprs_length [simp]: "(E\<turnstile>es[::]Ts \<longrightarrow> length es = length Ts)"
   413 apply (subgoal_tac "(E\<turnstile>e::T \<longrightarrow> True) \<and> (E\<turnstile>es[::]Ts \<longrightarrow> length es = length Ts) \<and> (E\<turnstile>s\<surd> \<longrightarrow> True)")
   401 apply (subgoal_tac "(E\<turnstile>e::T \<longrightarrow> True) \<and> (E\<turnstile>es[::]Ts \<longrightarrow> length es = length Ts) \<and> (E\<turnstile>s\<surd> \<longrightarrow> True)")
   414 apply blast
   402 apply blast
   415 apply (rule ty_expr_ty_exprs_wt_stmt.induct)
   403 apply (rule ty_expr_ty_exprs_wt_stmt.induct)
   416 apply auto
   404 apply auto
   423 apply (frule max_spec2mheads)
   411 apply (frule max_spec2mheads)
   424 apply (erule exE)+
   412 apply (erule exE)+
   425 apply (simp add: method_rT_def)
   413 apply (simp add: method_rT_def)
   426 done
   414 done
   427 
   415 
       
   416   (**********************************************************************************)
       
   417 
       
   418 declare compClass_fst [simp del]
       
   419 declare compClass_fst_snd [simp del]
       
   420 declare compClass_fst_snd_snd [simp del]
       
   421 
       
   422 declare split_paired_All [simp add]
       
   423 declare split_paired_Ex [simp add]
   428 
   424 
   429 end
   425 end