converted to Isar, simplifying recursion on class hierarchy
authoroheimb
Thu Feb 01 20:53:13 2001 +0100 (2001-02-01)
changeset 11026a50365d21144
parent 11025 a70b796d9af8
child 11027 17e9f0ba15ee
converted to Isar, simplifying recursion on class hierarchy
src/HOL/IsaMakefile
src/HOL/MicroJava/BV/BVSpec.thy
src/HOL/MicroJava/J/Conform.ML
src/HOL/MicroJava/J/Conform.thy
src/HOL/MicroJava/J/Decl.ML
src/HOL/MicroJava/J/Decl.thy
src/HOL/MicroJava/J/Eval.ML
src/HOL/MicroJava/J/Eval.thy
src/HOL/MicroJava/J/Example.ML
src/HOL/MicroJava/J/Example.thy
src/HOL/MicroJava/J/JBasis.ML
src/HOL/MicroJava/J/JBasis.thy
src/HOL/MicroJava/J/JTypeSafe.ML
src/HOL/MicroJava/J/JTypeSafe.thy
src/HOL/MicroJava/J/State.ML
src/HOL/MicroJava/J/State.thy
src/HOL/MicroJava/J/Term.thy
src/HOL/MicroJava/J/Type.thy
src/HOL/MicroJava/J/TypeRel.ML
src/HOL/MicroJava/J/TypeRel.thy
src/HOL/MicroJava/J/Value.thy
src/HOL/MicroJava/J/WellForm.ML
src/HOL/MicroJava/J/WellForm.thy
src/HOL/MicroJava/J/WellType.ML
src/HOL/MicroJava/J/WellType.thy
src/HOL/MicroJava/ROOT.ML
     1.1 --- a/src/HOL/IsaMakefile	Thu Feb 01 20:51:48 2001 +0100
     1.2 +++ b/src/HOL/IsaMakefile	Thu Feb 01 20:53:13 2001 +0100
     1.3 @@ -87,7 +87,7 @@
     1.4    Lfp.thy List.ML List.thy Main.ML Main.thy Map.ML Map.thy Nat.ML \
     1.5    Nat.thy NatArith.ML NatArith.thy NatDef.ML NatDef.thy Numeral.thy \
     1.6    Option.ML Option.thy Ord.ML Ord.thy Power.ML Power.thy PreList.thy \
     1.7 -  Product_Type.ML Product_Type.thy ROOT.ML Recdef.thy Record.thy \
     1.8 +  Product_Type_lemmas.ML Product_Type.thy ROOT.ML Recdef.thy Record.thy \
     1.9    Relation.ML Relation.thy Relation_Power.ML Relation_Power.thy \
    1.10    SVC_Oracle.ML SVC_Oracle.thy Set.ML Set.thy SetInterval.ML \
    1.11    SetInterval.thy String.thy Sum_Type.ML Sum_Type.thy \
    1.12 @@ -96,7 +96,8 @@
    1.13    Tools/datatype_rep_proofs.ML Tools/induct_attrib.ML Tools/induct_method.ML \
    1.14    Tools/inductive_package.ML Tools/meson.ML Tools/numeral_syntax.ML \
    1.15    Tools/primrec_package.ML Tools/recdef_package.ML \
    1.16 -  Tools/record_package.ML Tools/svc_funcs.ML Tools/typedef_package.ML \
    1.17 +  Tools/record_package.ML Tools/split_rule.ML \
    1.18 +  Tools/svc_funcs.ML Tools/typedef_package.ML \
    1.19    Transitive_Closure.thy Transitive_Closure_lemmas.ML Wellfounded_Recursion.ML \
    1.20    Wellfounded_Recursion.thy Wellfounded_Relations.ML \
    1.21    Wellfounded_Relations.thy arith_data.ML blastdata.ML cladata.ML \
    1.22 @@ -420,15 +421,11 @@
    1.23  HOL-MicroJava: HOL $(LOG)/HOL-MicroJava.gz
    1.24  
    1.25  $(LOG)/HOL-MicroJava.gz: $(OUT)/HOL MicroJava/ROOT.ML MicroJava/Digest.thy \
    1.26 -  MicroJava/J/Conform.ML MicroJava/J/Conform.thy \
    1.27 -  MicroJava/J/Eval.thy MicroJava/J/Eval.ML MicroJava/J/JBasis.ML \
    1.28 -  MicroJava/J/JBasis.thy MicroJava/J/JTypeSafe.thy MicroJava/J/JTypeSafe.ML \
    1.29 -  MicroJava/J/Decl.thy MicroJava/J/Decl.ML MicroJava/J/State.ML \
    1.30 -  MicroJava/J/State.thy MicroJava/J/Term.thy \
    1.31 -  MicroJava/J/Type.thy MicroJava/J/TypeRel.ML MicroJava/J/TypeRel.thy \
    1.32 -  MicroJava/J/WellForm.thy MicroJava/J/WellForm.ML MicroJava/J/Value.thy \
    1.33 -  MicroJava/J/WellType.ML MicroJava/J/WellType.thy \
    1.34 -  MicroJava/J/Example.ML MicroJava/J/Example.thy \
    1.35 +  MicroJava/J/Conform.thy MicroJava/J/Eval.thy MicroJava/J/JBasis.thy \
    1.36 +  MicroJava/J/JTypeSafe.thy MicroJava/J/Decl.thy MicroJava/J/State.thy \
    1.37 +  MicroJava/J/Term.thy MicroJava/J/Type.thy MicroJava/J/TypeRel.thy \
    1.38 +  MicroJava/J/WellForm.thy MicroJava/J/Value.thy \
    1.39 +  MicroJava/J/WellType.thy MicroJava/J/Example.thy \
    1.40    MicroJava/JVM/JVMExec.thy MicroJava/JVM/JVMInstructions.thy\
    1.41    MicroJava/JVM/JVMState.thy MicroJava/JVM/JVMExecInstr.thy\
    1.42    MicroJava/BV/BVSpec.thy MicroJava/BV/Step.thy\
     2.1 --- a/src/HOL/MicroJava/BV/BVSpec.thy	Thu Feb 01 20:51:48 2001 +0100
     2.2 +++ b/src/HOL/MicroJava/BV/BVSpec.thy	Thu Feb 01 20:53:13 2001 +0100
     2.3 @@ -12,30 +12,30 @@
     2.4  constdefs
     2.5  wt_instr :: "[instr,jvm_prog,ty,method_type,nat,p_count,p_count] => bool"
     2.6  "wt_instr i G rT phi mxs max_pc pc == 
     2.7 -    app i G mxs rT (phi!pc) \\<and>
     2.8 -   (\\<forall> pc' \\<in> set (succs i pc). pc' < max_pc \\<and> (G \\<turnstile> step i G (phi!pc) <=' phi!pc'))"
     2.9 +    app i G mxs rT (phi!pc) \<and>
    2.10 +   (\<forall> pc' \<in> set (succs i pc). pc' < max_pc \<and> (G \<turnstile> step i G (phi!pc) <=' phi!pc'))"
    2.11  
    2.12  wt_start :: "[jvm_prog,cname,ty list,nat,method_type] => bool"
    2.13  "wt_start G C pTs mxl phi == 
    2.14 -    G \\<turnstile> Some ([],(OK (Class C))#((map OK pTs))@(replicate mxl Err)) <=' phi!0"
    2.15 +    G \<turnstile> Some ([],(OK (Class C))#((map OK pTs))@(replicate mxl Err)) <=' phi!0"
    2.16  
    2.17  
    2.18  wt_method :: "[jvm_prog,cname,ty list,ty,nat,nat,instr list,method_type] => bool"
    2.19  "wt_method G C pTs rT mxs mxl ins phi ==
    2.20  	let max_pc = length ins
    2.21          in
    2.22 -	0 < max_pc \\<and> wt_start G C pTs mxl phi \\<and> 
    2.23 -	(\\<forall>pc. pc<max_pc --> wt_instr (ins ! pc) G rT phi mxs max_pc pc)"
    2.24 +	0 < max_pc \<and> wt_start G C pTs mxl phi \<and> 
    2.25 +	(\<forall>pc. pc<max_pc --> wt_instr (ins ! pc) G rT phi mxs max_pc pc)"
    2.26  
    2.27  wt_jvm_prog :: "[jvm_prog,prog_type] => bool"
    2.28  "wt_jvm_prog G phi ==
    2.29 -   wf_prog (\\<lambda>G C (sig,rT,(maxs,maxl,b)).
    2.30 +   wf_prog (\<lambda>G C (sig,rT,(maxs,maxl,b)).
    2.31                wt_method G C (snd sig) rT maxs maxl b (phi C sig)) G"
    2.32  
    2.33  
    2.34  
    2.35  lemma wt_jvm_progD:
    2.36 -"wt_jvm_prog G phi ==> (\\<exists>wt. wf_prog wt G)"
    2.37 +"wt_jvm_prog G phi ==> (\<exists>wt. wf_prog wt G)"
    2.38  by (unfold wt_jvm_prog_def, blast)
    2.39  
    2.40  lemma wt_jvm_prog_impl_wt_instr:
    2.41 @@ -48,54 +48,17 @@
    2.42  lemma wt_jvm_prog_impl_wt_start:
    2.43  "[| wt_jvm_prog G phi; is_class G C;
    2.44      method (G,C) sig = Some (C,rT,maxs,maxl,ins) |] ==> 
    2.45 - 0 < (length ins) \\<and> wt_start G C (snd sig) maxl (phi C sig)"
    2.46 + 0 < (length ins) \<and> wt_start G C (snd sig) maxl (phi C sig)"
    2.47  by (unfold wt_jvm_prog_def, drule method_wf_mdecl, 
    2.48      simp, simp, simp add: wf_mdecl_def wt_method_def)
    2.49  
    2.50  text {* for most instructions wt\_instr collapses: *}
    2.51  lemma  
    2.52  "succs i pc = [pc+1] ==> wt_instr i G rT phi mxs max_pc pc = 
    2.53 - (app i G mxs rT (phi!pc) \\<and> pc+1 < max_pc \\<and> (G \\<turnstile> step i G (phi!pc) <=' phi!(pc+1)))"
    2.54 + (app i G mxs rT (phi!pc) \<and> pc+1 < max_pc \<and> (G \<turnstile> step i G (phi!pc) <=' phi!(pc+1)))"
    2.55  by (simp add: wt_instr_def) 
    2.56  
    2.57  
    2.58 -(* ### move to WellForm *)
    2.59 -
    2.60 -lemma methd:
    2.61 -  "[| wf_prog wf_mb G; (C,S,fs,mdecls) \\<in> set G; (sig,rT,code) \\<in> set mdecls |]
    2.62 -  ==> method (G,C) sig = Some(C,rT,code) \\<and> is_class G C"
    2.63 -proof -
    2.64 -  assume wf: "wf_prog wf_mb G" 
    2.65 -  assume C:  "(C,S,fs,mdecls) \\<in> set G"
    2.66 -
    2.67 -  assume m: "(sig,rT,code) \\<in> set mdecls"
    2.68 -  moreover
    2.69 -  from wf
    2.70 -  have "class G Object = Some (arbitrary, [], [])"
    2.71 -    by simp 
    2.72 -  moreover
    2.73 -  from wf C
    2.74 -  have c: "class G C = Some (S,fs,mdecls)"
    2.75 -    by (auto simp add: wf_prog_def class_def is_class_def intro: map_of_SomeI)
    2.76 -  ultimately
    2.77 -  have O: "C \\<noteq> Object"
    2.78 -    by auto
    2.79 -      
    2.80 -  from wf C
    2.81 -  have "unique mdecls"
    2.82 -    by (unfold wf_prog_def wf_cdecl_def) auto
    2.83 -
    2.84 -  hence "unique (map (\\<lambda>(s,m). (s,C,m)) mdecls)"
    2.85 -    by - (induct mdecls, auto)
    2.86 -
    2.87 -  with m
    2.88 -  have "map_of (map (\\<lambda>(s,m). (s,C,m)) mdecls) sig = Some (C,rT,code)"
    2.89 -    by (force intro: map_of_SomeI)
    2.90 -
    2.91 -  with wf C m c O
    2.92 -  show ?thesis
    2.93 -    by (auto simp add: is_class_def dest: method_rec [of _ _ C])
    2.94 -qed
    2.95  
    2.96  
    2.97  end
     3.1 --- a/src/HOL/MicroJava/J/Conform.ML	Thu Feb 01 20:51:48 2001 +0100
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,236 +0,0 @@
     3.4 -(*  Title:      HOL/MicroJava/J/Conform.ML
     3.5 -    ID:         $Id$
     3.6 -    Author:     David von Oheimb
     3.7 -    Copyright   1999 Technische Universitaet Muenchen
     3.8 -*)
     3.9 -
    3.10 -section "hext";
    3.11 -
    3.12 -Goalw [hext_def] 
    3.13 -" \\<forall>a C fs . h  a = Some (C,fs) -->  \
    3.14 -\     (\\<exists>fs'. h' a = Some (C,fs')) ==> h\\<le>|h'"; 
    3.15 -by Auto_tac;
    3.16 -qed "hextI";
    3.17 -
    3.18 -Goalw [hext_def] "[|h\\<le>|h'; h a = Some (C,fs) |] ==> \\<exists>fs'. h' a = Some (C,fs')";
    3.19 -by (Force_tac 1);
    3.20 -qed "hext_objD";
    3.21 -
    3.22 -Goal "h\\<le>|h";
    3.23 -by (rtac hextI 1);
    3.24 -by (Fast_tac 1);
    3.25 -qed "hext_refl";
    3.26 -
    3.27 -Goal "h a = None ==> h\\<le>|h(a\\<mapsto>x)";
    3.28 -by (rtac hextI 1);
    3.29 -by Auto_tac;
    3.30 -qed "hext_new";
    3.31 -
    3.32 -Goal "[|h\\<le>|h'; h'\\<le>|h''|] ==> h\\<le>|h''";
    3.33 -by (rtac hextI 1);
    3.34 -by (fast_tac (HOL_cs addDs [hext_objD]) 1);
    3.35 -qed "hext_trans";
    3.36 -
    3.37 -Addsimps [hext_refl, hext_new];
    3.38 -
    3.39 -Goal "h a = Some (C,fs) ==> h\\<le>|h(a\\<mapsto>(C,fs'))";
    3.40 -by (rtac hextI 1);
    3.41 -by Auto_tac;
    3.42 -qed "hext_upd_obj";
    3.43 -
    3.44 -
    3.45 -section "conf";
    3.46 -
    3.47 -Goalw [conf_def] "G,h\\<turnstile>Null::\\<preceq>T = G\\<turnstile>RefT NullT\\<preceq>T"; 
    3.48 -by (Simp_tac 1);
    3.49 -qed "conf_Null";
    3.50 -Addsimps [conf_Null];
    3.51 -
    3.52 -Goalw [conf_def] "typeof (\\<lambda>v. None) v = Some T --> G,h\\<turnstile>v::\\<preceq>T";
    3.53 -by (rtac val_.induct 1);
    3.54 -by Auto_tac;
    3.55 -qed_spec_mp "conf_litval";
    3.56 -Addsimps[conf_litval];
    3.57 -
    3.58 -Goalw [conf_def] "[|h a = Some obj; G\\<turnstile>obj_ty obj\\<preceq>T|] ==> G,h\\<turnstile>Addr a::\\<preceq>T";
    3.59 -by (Asm_full_simp_tac 1);
    3.60 -qed "conf_AddrI";
    3.61 -
    3.62 -Goalw [conf_def] "[|h a = Some (C,fs); G\\<turnstile>C\\<preceq>C D|] ==> G,h\\<turnstile>Addr a::\\<preceq> Class D"; 
    3.63 -by (Asm_full_simp_tac 1);
    3.64 -qed "conf_obj_AddrI";
    3.65 -
    3.66 -Goalw [conf_def] "is_type G T --> G,h\\<turnstile>default_val T::\\<preceq>T";
    3.67 -by (res_inst_tac [("y","T")] ty.exhaust 1);
    3.68 -by  (etac ssubst 1);
    3.69 -by  (res_inst_tac [("y","prim_ty")] prim_ty.exhaust 1);
    3.70 -by    (auto_tac (claset(), simpset() addsimps [widen.null]));
    3.71 -qed_spec_mp "defval_conf";
    3.72 -
    3.73 -Goalw [conf_def] 
    3.74 -"h a = Some (C,fs) ==> (G,h(a\\<mapsto>(C,fs'))\\<turnstile>x::\\<preceq>T) = (G,h\\<turnstile>x::\\<preceq>T)";
    3.75 -by (rtac val_.induct 1);
    3.76 -by Auto_tac;
    3.77 -qed "conf_upd_obj";
    3.78 -
    3.79 -Goalw [conf_def] "wf_prog wf_mb G ==> G,h\\<turnstile>x::\\<preceq>T --> G\\<turnstile>T\\<preceq>T' --> G,h\\<turnstile>x::\\<preceq>T'";
    3.80 -by (rtac val_.induct 1);
    3.81 -by (auto_tac (claset() addIs [widen_trans], simpset()));
    3.82 -qed_spec_mp "conf_widen";
    3.83 -
    3.84 -Goalw [conf_def] "h\\<le>|h' ==> G,h\\<turnstile>v::\\<preceq>T --> G,h'\\<turnstile>v::\\<preceq>T";
    3.85 -by (rtac val_.induct 1);
    3.86 -by (auto_tac (claset() addDs [hext_objD], simpset()));
    3.87 -qed_spec_mp "conf_hext";
    3.88 -
    3.89 -Goalw [conf_def] "[|h a = None; G,h\\<turnstile>Addr t::\\<preceq>T|] ==> t\\<noteq>a";
    3.90 -by Auto_tac;
    3.91 -qed "new_locD";
    3.92 -
    3.93 -Goalw [conf_def]
    3.94 - "G,h\\<turnstile>a'::\\<preceq>RefT T --> a' = Null |  \
    3.95 -\ (\\<exists>a obj T'. a' = Addr a \\<and>  h a = Some obj \\<and>  obj_ty obj = T' \\<and>  G\\<turnstile>T'\\<preceq>RefT T)";
    3.96 -by(induct_tac "a'" 1);
    3.97 -by(Auto_tac);
    3.98 -qed_spec_mp "conf_RefTD";
    3.99 -
   3.100 -Goal "G,h\\<turnstile>a'::\\<preceq>RefT NullT ==> a' = Null";
   3.101 -by (dtac conf_RefTD 1);
   3.102 -by Auto_tac;
   3.103 -qed "conf_NullTD";
   3.104 -
   3.105 -Goal "[|a' \\<noteq> Null; G,h\\<turnstile>a'::\\<preceq>RefT t|] ==> \
   3.106 -\ \\<exists>a C fs. a' = Addr a \\<and>  h a = Some (C,fs) \\<and>  G\\<turnstile>Class C\\<preceq>RefT t";
   3.107 -by (dtac conf_RefTD 1);
   3.108 -by Auto_tac;
   3.109 -qed "non_npD";
   3.110 -
   3.111 -Goal "!!G. [|a' \\<noteq> Null; G,h\\<turnstile>a'::\\<preceq> Class C; C \\<noteq> Object|] ==> \
   3.112 -\ (\\<exists>a C' fs. a' = Addr a \\<and>  h a = Some (C',fs) \\<and>  G\\<turnstile>C'\\<preceq>C C)";
   3.113 -by (fast_tac (claset() addDs [non_npD]) 1);
   3.114 -qed "non_np_objD";
   3.115 -
   3.116 -Goal "a' \\<noteq> Null ==> wf_prog wf_mb G ==> G,h\\<turnstile>a'::\\<preceq>RefT t -->\
   3.117 -\ (\\<forall>C. t = ClassT C --> C \\<noteq> Object) --> \
   3.118 -\ (\\<exists>a C fs. a' = Addr a \\<and>  h a = Some (C,fs) \\<and>  G\\<turnstile>Class C\\<preceq>RefT t)";
   3.119 -by(res_inst_tac [("y","t")] ref_ty.exhaust 1);
   3.120 - by (fast_tac (claset() addDs [conf_NullTD]) 1);
   3.121 -by (fast_tac (claset() addDs [non_np_objD]) 1);
   3.122 -qed_spec_mp "non_np_objD'";
   3.123 -
   3.124 -Goal "wf_prog wf_mb G ==> \\<forall>Ts Ts'. list_all2 (conf G h) vs Ts --> list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') Ts Ts' -->  list_all2 (conf G h) vs Ts'";
   3.125 -by(induct_tac "vs" 1);
   3.126 - by(ALLGOALS Clarsimp_tac);
   3.127 -by(forward_tac [list_all2_lengthD RS sym] 1);
   3.128 -by(full_simp_tac (simpset()addsimps[length_Suc_conv]) 1);
   3.129 -by(Safe_tac);
   3.130 -by(forward_tac [list_all2_lengthD RS sym] 1);
   3.131 -by(full_simp_tac (simpset()addsimps[length_Suc_conv]) 1);
   3.132 -by(Clarify_tac 1);
   3.133 -by(fast_tac (claset() addEs [conf_widen]) 1);
   3.134 -qed_spec_mp "conf_list_gext_widen";
   3.135 -
   3.136 -
   3.137 -section "lconf";
   3.138 -
   3.139 -Goalw[lconf_def] "[| G,h\\<turnstile>vs[::\\<preceq>]Ts; Ts n = Some T |] ==> G,h\\<turnstile>(the (vs n))::\\<preceq>T";
   3.140 -by (Force_tac 1);
   3.141 -qed "lconfD";
   3.142 -
   3.143 -Goalw [lconf_def] "[| G,h\\<turnstile>l[::\\<preceq>]L; h\\<le>|h' |] ==> G,h'\\<turnstile>l[::\\<preceq>]L";
   3.144 -by  (fast_tac (claset() addEs [conf_hext]) 1);
   3.145 -qed "lconf_hext";
   3.146 -AddEs [lconf_hext];
   3.147 -
   3.148 -Goalw [lconf_def] "!!X. [| G,h\\<turnstile>l[::\\<preceq>]lT; \
   3.149 -\ G,h\\<turnstile>v::\\<preceq>T; lT va = Some T |] ==> G,h\\<turnstile>l(va\\<mapsto>v)[::\\<preceq>]lT";
   3.150 -by Auto_tac;
   3.151 -qed "lconf_upd";
   3.152 -
   3.153 -Goal "\\<forall>x. P x --> R (dv x) x ==> (\\<forall>x. map_of fs f = Some x --> P x) --> \
   3.154 -\ (\\<forall>T. map_of fs f = Some T --> \
   3.155 -\ (\\<exists>v. map_of (map (\\<lambda>(f,ft). (f, dv ft)) fs) f = Some v \\<and>  R v T))";
   3.156 -by( induct_tac "fs" 1);
   3.157 -by Auto_tac;
   3.158 -qed_spec_mp "lconf_init_vars_lemma";
   3.159 -
   3.160 -Goalw [lconf_def, init_vars_def] 
   3.161 -"\\<forall>n. \\<forall>T. map_of fs n = Some T --> is_type G T ==> G,h\\<turnstile>init_vars fs[::\\<preceq>]map_of fs";
   3.162 -by Auto_tac;
   3.163 -by( rtac lconf_init_vars_lemma 1);
   3.164 -by(   atac 3);
   3.165 -by(  strip_tac 1);
   3.166 -by(  etac defval_conf 1);
   3.167 -by Auto_tac;
   3.168 -qed "lconf_init_vars";
   3.169 -AddSIs [lconf_init_vars];
   3.170 -
   3.171 -Goalw [lconf_def] "[|G,s\\<turnstile>l[::\\<preceq>]L; G,s\\<turnstile>v::\\<preceq>T|] ==> G,s\\<turnstile>l(vn\\<mapsto>v)[::\\<preceq>]L(vn\\<mapsto>T)";
   3.172 -by Auto_tac;
   3.173 -qed "lconf_ext";
   3.174 -
   3.175 -Goalw [lconf_def] "G,h\\<turnstile>l[::\\<preceq>]L ==> \\<forall>vs Ts. nodups vns --> length Ts = length vns --> list_all2 (\\<lambda>v T. G,h\\<turnstile>v::\\<preceq>T) vs Ts --> G,h\\<turnstile>l(vns[\\<mapsto>]vs)[::\\<preceq>]L(vns[\\<mapsto>]Ts)";
   3.176 -by( induct_tac "vns" 1);
   3.177 -by(  ALLGOALS Clarsimp_tac);
   3.178 -by( forward_tac [list_all2_lengthD] 1);
   3.179 -by( auto_tac (claset(), simpset() addsimps [length_Suc_conv]));
   3.180 -qed_spec_mp "lconf_ext_list";
   3.181 -
   3.182 -
   3.183 -section "oconf";
   3.184 -
   3.185 -Goalw [oconf_def] "G,h\\<turnstile>obj\\<surd> ==> h\\<le>|h' ==> G,h'\\<turnstile>obj\\<surd>"; 
   3.186 -by (Fast_tac 1);
   3.187 -qed "oconf_hext";
   3.188 -
   3.189 -Goalw [oconf_def,lconf_def] "G,h\\<turnstile>(C,fs)\\<surd> = \
   3.190 -\ (\\<forall>T f. map_of(fields (G,C)) f = Some T --> (\\<exists>v. fs f = Some v \\<and>  G,h\\<turnstile>v::\\<preceq>T))";
   3.191 -by Auto_tac;
   3.192 -qed "oconf_obj";
   3.193 -bind_thm ("oconf_objD", oconf_obj RS iffD1 RS spec RS spec RS mp);
   3.194 -
   3.195 -
   3.196 -section "hconf";
   3.197 -
   3.198 -Goalw [hconf_def] "[|G\\<turnstile>h h\\<surd>; h a = Some obj|] ==> G,h\\<turnstile>obj\\<surd>";
   3.199 -by (Fast_tac 1);
   3.200 -qed "hconfD";
   3.201 -
   3.202 -Goalw [hconf_def] "\\<forall>a obj. h a=Some obj --> G,h\\<turnstile>obj\\<surd> ==> G\\<turnstile>h h\\<surd>";
   3.203 -by (Fast_tac 1);
   3.204 -qed "hconfI";
   3.205 -
   3.206 -
   3.207 -section "conforms";
   3.208 -
   3.209 -Goalw [conforms_def] "(h, l)::\\<preceq>(G, lT) ==> G\\<turnstile>h h\\<surd>";
   3.210 -by (Asm_full_simp_tac 1);
   3.211 -qed "conforms_heapD";
   3.212 -
   3.213 -Goalw [conforms_def] "(h, l)::\\<preceq>(G, lT) ==> G,h\\<turnstile>l[::\\<preceq>]lT";
   3.214 -by (Asm_full_simp_tac 1);
   3.215 -qed "conforms_localD";
   3.216 -
   3.217 -Goalw [conforms_def] "[|G\\<turnstile>h h\\<surd>; G,h\\<turnstile>l[::\\<preceq>]lT|] ==> (h, l)::\\<preceq>(G, lT)"; 
   3.218 -by Auto_tac;
   3.219 -qed "conformsI";
   3.220 -
   3.221 -Goal "[|(h,l)::\\<preceq>(G,lT); h\\<le>|h'; G\\<turnstile>h h'\\<surd> |] ==> (h',l)::\\<preceq>(G,lT)";
   3.222 -by( fast_tac (HOL_cs addDs [conforms_localD] 
   3.223 -  addSEs [conformsI, lconf_hext]) 1);
   3.224 -qed "conforms_hext";
   3.225 -
   3.226 -Goal "[|(h,l)::\\<preceq>(G, lT); G,h(a\\<mapsto>obj)\\<turnstile>obj\\<surd>; h\\<le>|h(a\\<mapsto>obj)|] ==> (h(a\\<mapsto>obj),l)::\\<preceq>(G, lT)";
   3.227 -by( rtac conforms_hext 1);
   3.228 -by   Auto_tac;
   3.229 -by( rtac hconfI 1);
   3.230 -by( dtac conforms_heapD 1);
   3.231 -by( (auto_tac (HOL_cs addEs [oconf_hext] addDs [hconfD],
   3.232 -		simpset()delsimps[split_paired_All])));
   3.233 -qed "conforms_upd_obj";
   3.234 -
   3.235 -Goalw [conforms_def] 
   3.236 -"[|(h, l)::\\<preceq>(G, lT); G,h\\<turnstile>v::\\<preceq>T; lT va = Some T|] ==> \
   3.237 -\ (h, l(va\\<mapsto>v))::\\<preceq>(G, lT)";
   3.238 -by( auto_tac (claset() addEs [lconf_upd], simpset()));
   3.239 -qed "conforms_upd_local";
     4.1 --- a/src/HOL/MicroJava/J/Conform.thy	Thu Feb 01 20:51:48 2001 +0100
     4.2 +++ b/src/HOL/MicroJava/J/Conform.thy	Thu Feb 01 20:53:13 2001 +0100
     4.3 @@ -6,30 +6,30 @@
     4.4  Conformity relations for type safety of Java
     4.5  *)
     4.6  
     4.7 -Conform = State + WellType +
     4.8 +theory Conform = State + WellType:
     4.9  
    4.10 -types	'c env_ = "'c prog \\<times> (vname \\<leadsto> ty)" (* same as env of WellType.thy *)
    4.11 +types	'c env_ = "'c prog \<times> (vname \<leadsto> ty)" (* same as env of WellType.thy *)
    4.12  
    4.13  constdefs
    4.14  
    4.15 -  hext :: "aheap => aheap => bool" ("_ \\<le>| _" [51,51] 50)
    4.16 - "h\\<le>|h' == \\<forall>a C fs. h a = Some(C,fs) --> (\\<exists>fs'. h' a = Some(C,fs'))"
    4.17 +  hext :: "aheap => aheap => bool" ("_ \<le>| _" [51,51] 50)
    4.18 + "h\<le>|h' == \<forall>a C fs. h a = Some(C,fs) --> (\<exists>fs'. h' a = Some(C,fs'))"
    4.19  
    4.20 -  conf :: "'c prog => aheap => val => ty => bool"	("_,_ \\<turnstile> _ ::\\<preceq> _" [51,51,51,51] 50)
    4.21 - "G,h\\<turnstile>v::\\<preceq>T == \\<exists>T'. typeof (option_map obj_ty o h) v = Some T' \\<and> G\\<turnstile>T'\\<preceq>T"
    4.22 +  conf :: "'c prog => aheap => val => ty => bool"	("_,_ \<turnstile> _ ::\<preceq> _" [51,51,51,51] 50)
    4.23 + "G,h\<turnstile>v::\<preceq>T == \<exists>T'. typeof (option_map obj_ty o h) v = Some T' \<and> G\<turnstile>T'\<preceq>T"
    4.24  
    4.25 -  lconf :: "'c prog => aheap => ('a \\<leadsto> val) => ('a \\<leadsto> ty) => bool"
    4.26 -                                                ("_,_ \\<turnstile> _ [::\\<preceq>] _" [51,51,51,51] 50)
    4.27 - "G,h\\<turnstile>vs[::\\<preceq>]Ts == \\<forall>n T. Ts n = Some T --> (\\<exists>v. vs n = Some v \\<and> G,h\\<turnstile>v::\\<preceq>T)"
    4.28 +  lconf :: "'c prog => aheap => ('a \<leadsto> val) => ('a \<leadsto> ty) => bool"
    4.29 +                                                ("_,_ \<turnstile> _ [::\<preceq>] _" [51,51,51,51] 50)
    4.30 + "G,h\<turnstile>vs[::\<preceq>]Ts == \<forall>n T. Ts n = Some T --> (\<exists>v. vs n = Some v \<and> G,h\<turnstile>v::\<preceq>T)"
    4.31  
    4.32 -  oconf :: "'c prog => aheap => obj => bool" ("_,_ \\<turnstile> _ \\<surd>" [51,51,51] 50)
    4.33 - "G,h\\<turnstile>obj\\<surd> == G,h\\<turnstile>snd obj[::\\<preceq>]map_of (fields (G,fst obj))"
    4.34 +  oconf :: "'c prog => aheap => obj => bool" ("_,_ \<turnstile> _ \<surd>" [51,51,51] 50)
    4.35 + "G,h\<turnstile>obj\<surd> == G,h\<turnstile>snd obj[::\<preceq>]map_of (fields (G,fst obj))"
    4.36  
    4.37 -  hconf :: "'c prog => aheap => bool" ("_ \\<turnstile>h _ \\<surd>" [51,51] 50)
    4.38 - "G\\<turnstile>h h\\<surd>    == \\<forall>a obj. h a = Some obj --> G,h\\<turnstile>obj\\<surd>"
    4.39 +  hconf :: "'c prog => aheap => bool" ("_ \<turnstile>h _ \<surd>" [51,51] 50)
    4.40 + "G\<turnstile>h h\<surd>    == \<forall>a obj. h a = Some obj --> G,h\<turnstile>obj\<surd>"
    4.41  
    4.42 -  conforms :: "state => java_mb env_ => bool"	("_ ::\\<preceq> _" [51,51] 50)
    4.43 - "s::\\<preceq>E == prg E\\<turnstile>h heap s\\<surd> \\<and> prg E,heap s\\<turnstile>locals s[::\\<preceq>]localT E"
    4.44 +  conforms :: "state => java_mb env_ => bool"	("_ ::\<preceq> _" [51,51] 50)
    4.45 + "s::\<preceq>E == prg E\<turnstile>h heap s\<surd> \<and> prg E,heap s\<turnstile>locals s[::\<preceq>]localT E"
    4.46  
    4.47  
    4.48  syntax (HTML)
    4.49 @@ -39,7 +39,7 @@
    4.50    conf     :: "'c prog => aheap => val => ty => bool"
    4.51                ("_,_ |- _ ::<= _"  [51,51,51,51] 50)
    4.52  
    4.53 -  lconf    :: "'c prog => aheap => ('a \\<leadsto> val) => ('a \\<leadsto> ty) => bool"
    4.54 +  lconf    :: "'c prog => aheap => ('a \<leadsto> val) => ('a \<leadsto> ty) => bool"
    4.55                ("_,_ |- _ [::<=] _" [51,51,51,51] 50)
    4.56  
    4.57    oconf    :: "'c prog => aheap => obj => bool"
    4.58 @@ -51,4 +51,257 @@
    4.59    conforms :: "state => java_mb env_ => bool"
    4.60                ("_ ::<= _" [51,51] 50)
    4.61  
    4.62 +
    4.63 +section "hext"
    4.64 +
    4.65 +lemma hextI: 
    4.66 +" \<forall>a C fs . h  a = Some (C,fs) -->   
    4.67 +      (\<exists>fs'. h' a = Some (C,fs')) ==> h\<le>|h'"
    4.68 +apply (unfold hext_def)
    4.69 +apply auto
    4.70 +done
    4.71 +
    4.72 +lemma hext_objD: "[|h\<le>|h'; h a = Some (C,fs) |] ==> \<exists>fs'. h' a = Some (C,fs')"
    4.73 +apply (unfold hext_def)
    4.74 +apply (force)
    4.75 +done
    4.76 +
    4.77 +lemma hext_refl [simp]: "h\<le>|h"
    4.78 +apply (rule hextI)
    4.79 +apply (fast)
    4.80 +done
    4.81 +
    4.82 +lemma hext_new [simp]: "h a = None ==> h\<le>|h(a\<mapsto>x)"
    4.83 +apply (rule hextI)
    4.84 +apply auto
    4.85 +done
    4.86 +
    4.87 +lemma hext_trans: "[|h\<le>|h'; h'\<le>|h''|] ==> h\<le>|h''"
    4.88 +apply (rule hextI)
    4.89 +apply (fast dest: hext_objD)
    4.90 +done
    4.91 +
    4.92 +lemma hext_upd_obj: "h a = Some (C,fs) ==> h\<le>|h(a\<mapsto>(C,fs'))"
    4.93 +apply (rule hextI)
    4.94 +apply auto
    4.95 +done
    4.96 +
    4.97 +
    4.98 +section "conf"
    4.99 +
   4.100 +lemma conf_Null [simp]: "G,h\<turnstile>Null::\<preceq>T = G\<turnstile>RefT NullT\<preceq>T"
   4.101 +apply (unfold conf_def)
   4.102 +apply (simp (no_asm))
   4.103 +done
   4.104 +
   4.105 +lemma conf_litval [rule_format (no_asm), simp]: 
   4.106 +  "typeof (\<lambda>v. None) v = Some T --> G,h\<turnstile>v::\<preceq>T"
   4.107 +apply (unfold conf_def)
   4.108 +apply (rule val.induct)
   4.109 +apply auto
   4.110 +done
   4.111 +
   4.112 +lemma conf_AddrI: "[|h a = Some obj; G\<turnstile>obj_ty obj\<preceq>T|] ==> G,h\<turnstile>Addr a::\<preceq>T"
   4.113 +apply (unfold conf_def)
   4.114 +apply (simp)
   4.115 +done
   4.116 +
   4.117 +lemma conf_obj_AddrI: "[|h a = Some (C,fs); G\<turnstile>C\<preceq>C D|] ==> G,h\<turnstile>Addr a::\<preceq> Class D"
   4.118 +apply (unfold conf_def)
   4.119 +apply (simp)
   4.120 +done
   4.121 +
   4.122 +lemma defval_conf [rule_format (no_asm)]: "is_type G T --> G,h\<turnstile>default_val T::\<preceq>T"
   4.123 +apply (unfold conf_def)
   4.124 +apply (rule_tac "y" = "T" in ty.exhaust)
   4.125 +apply  (erule ssubst)
   4.126 +apply  (rule_tac "y" = "prim_ty" in prim_ty.exhaust)
   4.127 +apply    (auto simp add: widen.null)
   4.128 +done
   4.129 +
   4.130 +lemma conf_upd_obj: 
   4.131 +"h a = Some (C,fs) ==> (G,h(a\<mapsto>(C,fs'))\<turnstile>x::\<preceq>T) = (G,h\<turnstile>x::\<preceq>T)"
   4.132 +apply (unfold conf_def)
   4.133 +apply (rule val.induct)
   4.134 +apply auto
   4.135 +done
   4.136 +
   4.137 +lemma conf_widen [rule_format (no_asm)]: "wf_prog wf_mb G ==> G,h\<turnstile>x::\<preceq>T --> G\<turnstile>T\<preceq>T' --> G,h\<turnstile>x::\<preceq>T'"
   4.138 +apply (unfold conf_def)
   4.139 +apply (rule val.induct)
   4.140 +apply (auto intro: widen_trans)
   4.141 +done
   4.142 +
   4.143 +lemma conf_hext [rule_format (no_asm)]: "h\<le>|h' ==> G,h\<turnstile>v::\<preceq>T --> G,h'\<turnstile>v::\<preceq>T"
   4.144 +apply (unfold conf_def)
   4.145 +apply (rule val.induct)
   4.146 +apply (auto dest: hext_objD)
   4.147 +done
   4.148 +
   4.149 +lemma new_locD: "[|h a = None; G,h\<turnstile>Addr t::\<preceq>T|] ==> t\<noteq>a"
   4.150 +apply (unfold conf_def)
   4.151 +apply auto
   4.152 +done
   4.153 +
   4.154 +lemma conf_RefTD [rule_format (no_asm)]: 
   4.155 + "G,h\<turnstile>a'::\<preceq>RefT T --> a' = Null |   
   4.156 +  (\<exists>a obj T'. a' = Addr a \<and>  h a = Some obj \<and>  obj_ty obj = T' \<and>  G\<turnstile>T'\<preceq>RefT T)"
   4.157 +apply (unfold conf_def)
   4.158 +apply(induct_tac "a'")
   4.159 +apply(auto)
   4.160 +done
   4.161 +
   4.162 +lemma conf_NullTD: "G,h\<turnstile>a'::\<preceq>RefT NullT ==> a' = Null"
   4.163 +apply (drule conf_RefTD)
   4.164 +apply auto
   4.165 +done
   4.166 +
   4.167 +lemma non_npD: "[|a' \<noteq> Null; G,h\<turnstile>a'::\<preceq>RefT t|] ==>  
   4.168 +  \<exists>a C fs. a' = Addr a \<and>  h a = Some (C,fs) \<and>  G\<turnstile>Class C\<preceq>RefT t"
   4.169 +apply (drule conf_RefTD)
   4.170 +apply auto
   4.171 +done
   4.172 +
   4.173 +lemma non_np_objD: "!!G. [|a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C; C \<noteq> Object|] ==>  
   4.174 +  (\<exists>a C' fs. a' = Addr a \<and>  h a = Some (C',fs) \<and>  G\<turnstile>C'\<preceq>C C)"
   4.175 +apply (fast dest: non_npD)
   4.176 +done
   4.177 +
   4.178 +lemma non_np_objD' [rule_format (no_asm)]: "a' \<noteq> Null ==> wf_prog wf_mb G ==> G,h\<turnstile>a'::\<preceq>RefT t --> 
   4.179 +  (\<forall>C. t = ClassT C --> C \<noteq> Object) -->  
   4.180 +  (\<exists>a C fs. a' = Addr a \<and>  h a = Some (C,fs) \<and>  G\<turnstile>Class C\<preceq>RefT t)"
   4.181 +apply(rule_tac "y" = "t" in ref_ty.exhaust)
   4.182 + apply (fast dest: conf_NullTD)
   4.183 +apply (fast dest: non_np_objD)
   4.184 +done
   4.185 +
   4.186 +lemma conf_list_gext_widen [rule_format (no_asm)]: "wf_prog wf_mb G ==> \<forall>Ts Ts'. list_all2 (conf G h) vs Ts --> list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') Ts Ts' -->  list_all2 (conf G h) vs Ts'"
   4.187 +apply(induct_tac "vs")
   4.188 + apply(clarsimp)
   4.189 +apply(clarsimp)
   4.190 +apply(frule list_all2_lengthD [THEN sym])
   4.191 +apply(simp (no_asm_use) add: length_Suc_conv)
   4.192 +apply(safe)
   4.193 +apply(frule list_all2_lengthD [THEN sym])
   4.194 +apply(simp (no_asm_use) add: length_Suc_conv)
   4.195 +apply(clarify)
   4.196 +apply(fast elim: conf_widen)
   4.197 +done
   4.198 +
   4.199 +
   4.200 +section "lconf"
   4.201 +
   4.202 +lemma lconfD: "[| G,h\<turnstile>vs[::\<preceq>]Ts; Ts n = Some T |] ==> G,h\<turnstile>(the (vs n))::\<preceq>T"
   4.203 +apply (unfold lconf_def)
   4.204 +apply (force)
   4.205 +done
   4.206 +
   4.207 +lemma lconf_hext [elim]: "[| G,h\<turnstile>l[::\<preceq>]L; h\<le>|h' |] ==> G,h'\<turnstile>l[::\<preceq>]L"
   4.208 +apply (unfold lconf_def)
   4.209 +apply  (fast elim: conf_hext)
   4.210 +done
   4.211 +
   4.212 +lemma lconf_upd: "!!X. [| G,h\<turnstile>l[::\<preceq>]lT;  
   4.213 +  G,h\<turnstile>v::\<preceq>T; lT va = Some T |] ==> G,h\<turnstile>l(va\<mapsto>v)[::\<preceq>]lT"
   4.214 +apply (unfold lconf_def)
   4.215 +apply auto
   4.216 +done
   4.217 +
   4.218 +lemma lconf_init_vars_lemma [rule_format (no_asm)]: "\<forall>x. P x --> R (dv x) x ==> (\<forall>x. map_of fs f = Some x --> P x) -->  
   4.219 +  (\<forall>T. map_of fs f = Some T -->  
   4.220 +  (\<exists>v. map_of (map (\<lambda>(f,ft). (f, dv ft)) fs) f = Some v \<and>  R v T))"
   4.221 +apply( induct_tac "fs")
   4.222 +apply auto
   4.223 +done
   4.224 +
   4.225 +lemma lconf_init_vars [intro!]: 
   4.226 +"\<forall>n. \<forall>T. map_of fs n = Some T --> is_type G T ==> G,h\<turnstile>init_vars fs[::\<preceq>]map_of fs"
   4.227 +apply (unfold lconf_def init_vars_def)
   4.228 +apply auto
   4.229 +apply( rule lconf_init_vars_lemma)
   4.230 +apply(   erule_tac [3] asm_rl)
   4.231 +apply(  intro strip)
   4.232 +apply(  erule defval_conf)
   4.233 +apply auto
   4.234 +done
   4.235 +
   4.236 +lemma lconf_ext: "[|G,s\<turnstile>l[::\<preceq>]L; G,s\<turnstile>v::\<preceq>T|] ==> G,s\<turnstile>l(vn\<mapsto>v)[::\<preceq>]L(vn\<mapsto>T)"
   4.237 +apply (unfold lconf_def)
   4.238 +apply auto
   4.239 +done
   4.240 +
   4.241 +lemma lconf_ext_list [rule_format (no_asm)]: "G,h\<turnstile>l[::\<preceq>]L ==> \<forall>vs Ts. nodups vns --> length Ts = length vns --> list_all2 (\<lambda>v T. G,h\<turnstile>v::\<preceq>T) vs Ts --> G,h\<turnstile>l(vns[\<mapsto>]vs)[::\<preceq>]L(vns[\<mapsto>]Ts)"
   4.242 +apply (unfold lconf_def)
   4.243 +apply( induct_tac "vns")
   4.244 +apply(  clarsimp)
   4.245 +apply( clarsimp)
   4.246 +apply( frule list_all2_lengthD)
   4.247 +apply( auto simp add: length_Suc_conv)
   4.248 +done
   4.249 +
   4.250 +
   4.251 +section "oconf"
   4.252 +
   4.253 +lemma oconf_hext: "G,h\<turnstile>obj\<surd> ==> h\<le>|h' ==> G,h'\<turnstile>obj\<surd>"
   4.254 +apply (unfold oconf_def)
   4.255 +apply (fast)
   4.256 +done
   4.257 +
   4.258 +lemma oconf_obj: "G,h\<turnstile>(C,fs)\<surd> =  
   4.259 +  (\<forall>T f. map_of(fields (G,C)) f = Some T --> (\<exists>v. fs f = Some v \<and>  G,h\<turnstile>v::\<preceq>T))"
   4.260 +apply (unfold oconf_def lconf_def)
   4.261 +apply auto
   4.262 +done
   4.263 +
   4.264 +lemmas oconf_objD = oconf_obj [THEN iffD1, THEN spec, THEN spec, THEN mp]
   4.265 +
   4.266 +
   4.267 +section "hconf"
   4.268 +
   4.269 +lemma hconfD: "[|G\<turnstile>h h\<surd>; h a = Some obj|] ==> G,h\<turnstile>obj\<surd>"
   4.270 +apply (unfold hconf_def)
   4.271 +apply (fast)
   4.272 +done
   4.273 +
   4.274 +lemma hconfI: "\<forall>a obj. h a=Some obj --> G,h\<turnstile>obj\<surd> ==> G\<turnstile>h h\<surd>"
   4.275 +apply (unfold hconf_def)
   4.276 +apply (fast)
   4.277 +done
   4.278 +
   4.279 +
   4.280 +section "conforms"
   4.281 +
   4.282 +lemma conforms_heapD: "(h, l)::\<preceq>(G, lT) ==> G\<turnstile>h h\<surd>"
   4.283 +apply (unfold conforms_def)
   4.284 +apply (simp)
   4.285 +done
   4.286 +
   4.287 +lemma conforms_localD: "(h, l)::\<preceq>(G, lT) ==> G,h\<turnstile>l[::\<preceq>]lT"
   4.288 +apply (unfold conforms_def)
   4.289 +apply (simp)
   4.290 +done
   4.291 +
   4.292 +lemma conformsI: "[|G\<turnstile>h h\<surd>; G,h\<turnstile>l[::\<preceq>]lT|] ==> (h, l)::\<preceq>(G, lT)"
   4.293 +apply (unfold conforms_def)
   4.294 +apply auto
   4.295 +done
   4.296 +
   4.297 +lemma conforms_hext: "[|(h,l)::\<preceq>(G,lT); h\<le>|h'; G\<turnstile>h h'\<surd> |] ==> (h',l)::\<preceq>(G,lT)"
   4.298 +apply( fast dest: conforms_localD elim!: conformsI lconf_hext)
   4.299 +done
   4.300 +
   4.301 +lemma conforms_upd_obj: "[|(h,l)::\<preceq>(G, lT); G,h(a\<mapsto>obj)\<turnstile>obj\<surd>; h\<le>|h(a\<mapsto>obj)|] ==> (h(a\<mapsto>obj),l)::\<preceq>(G, lT)"
   4.302 +apply( rule conforms_hext)
   4.303 +apply   auto
   4.304 +apply( rule hconfI)
   4.305 +apply( drule conforms_heapD)
   4.306 +apply( tactic {* auto_tac (HOL_cs addEs [thm "oconf_hext"] addDs [thm "hconfD"], simpset() delsimps [split_paired_All]) *})
   4.307 +done
   4.308 +
   4.309 +lemma conforms_upd_local: 
   4.310 +"[|(h, l)::\<preceq>(G, lT); G,h\<turnstile>v::\<preceq>T; lT va = Some T|] ==> (h, l(va\<mapsto>v))::\<preceq>(G, lT)"
   4.311 +apply (unfold conforms_def)
   4.312 +apply( auto elim: lconf_upd)
   4.313 +done
   4.314 +
   4.315  end
     5.1 --- a/src/HOL/MicroJava/J/Decl.ML	Thu Feb 01 20:51:48 2001 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,11 +0,0 @@
     5.4 -(*  Title:      HOL/MicroJava/J/Decl.ML
     5.5 -    ID:         $Id$
     5.6 -    Author:     David von Oheimb
     5.7 -    Copyright   1999 Technische Universitaet Muenchen
     5.8 -*)
     5.9 -
    5.10 -Goalw [is_class_def, class_def] "finite {C. is_class G C}";
    5.11 -by (fold_goals_tac [dom_def]);
    5.12 -by (rtac finite_dom_map_of 1);
    5.13 -qed "finite_is_class";
    5.14 -
     6.1 --- a/src/HOL/MicroJava/J/Decl.thy	Thu Feb 01 20:51:48 2001 +0100
     6.2 +++ b/src/HOL/MicroJava/J/Decl.thy	Thu Feb 01 20:53:13 2001 +0100
     6.3 @@ -6,52 +6,58 @@
     6.4  Class declarations and programs
     6.5  *)
     6.6  
     6.7 -Decl = Type +
     6.8 +theory Decl = Type:
     6.9  
    6.10  types	fdecl		(* field declaration, cf. 8.3 (, 9.3) *)
    6.11 -	= "vname \\<times> ty"
    6.12 +	= "vname \<times> ty"
    6.13  
    6.14  
    6.15  types	sig		(* signature of a method, cf. 8.4.2 *)
    6.16 -	= "mname \\<times> ty list"
    6.17 +	= "mname \<times> ty list"
    6.18  
    6.19  	'c mdecl		(* method declaration in a class *)
    6.20 -	= "sig \\<times> ty \\<times> 'c"
    6.21 +	= "sig \<times> ty \<times> 'c"
    6.22  
    6.23  types	'c class		(* class *)
    6.24 -	= "cname \\<times> fdecl list \\<times> 'c mdecl list"
    6.25 +	= "cname \<times> fdecl list \<times> 'c mdecl list"
    6.26  	(* superclass, fields, methods*)
    6.27  
    6.28  	'c cdecl		(* class declaration, cf. 8.1 *)
    6.29 -	= "cname \\<times> 'c class"
    6.30 +	= "cname \<times> 'c class"
    6.31  
    6.32  consts
    6.33  
    6.34    Object  :: cname	(* name of root class *)
    6.35 -  ObjectC :: 'c cdecl	(* decl of root class *)
    6.36 +  ObjectC :: "'c cdecl"	(* decl of root class *)
    6.37  
    6.38  defs 
    6.39  
    6.40 - ObjectC_def "ObjectC == (Object, (arbitrary, [], []))"
    6.41 + ObjectC_def: "ObjectC == (Object, (arbitrary, [], []))"
    6.42  
    6.43  
    6.44  types 'c prog = "'c cdecl list"
    6.45  
    6.46  
    6.47  translations
    6.48 -  "fdecl"   <= (type) "vname \\<times> ty"
    6.49 -  "sig"     <= (type) "mname \\<times> ty list"
    6.50 -  "mdecl c" <= (type) "sig \\<times> ty \\<times> c"
    6.51 -  "class c" <= (type) "cname \\<times> fdecl list \\<times> (c mdecl) list"
    6.52 -  "cdecl c" <= (type) "cname \\<times> (c class)"
    6.53 +  "fdecl"   <= (type) "vname \<times> ty"
    6.54 +  "sig"     <= (type) "mname \<times> ty list"
    6.55 +  "mdecl c" <= (type) "sig \<times> ty \<times> c"
    6.56 +  "class c" <= (type) "cname \<times> fdecl list \<times> (c mdecl) list"
    6.57 +  "cdecl c" <= (type) "cname \<times> (c class)"
    6.58    "prog  c" <= (type) "(c cdecl) list"
    6.59  
    6.60  constdefs
    6.61  
    6.62 -  class		:: "'c prog => (cname \\<leadsto> 'c class)"
    6.63 -  "class        \\<equiv> map_of"
    6.64 +  class		:: "'c prog => (cname \<leadsto> 'c class)"
    6.65 +  "class        \<equiv> map_of"
    6.66    is_class	:: "'c prog => cname => bool"
    6.67 - "is_class G C  \\<equiv> class G C \\<noteq> None"
    6.68 + "is_class G C  \<equiv> class G C \<noteq> None"
    6.69 +
    6.70 +lemma finite_is_class: "finite {C. is_class G C}"
    6.71 +apply (unfold is_class_def class_def)
    6.72 +apply (fold dom_def)
    6.73 +apply (rule finite_dom_map_of)
    6.74 +done
    6.75  
    6.76  consts
    6.77  
     7.1 --- a/src/HOL/MicroJava/J/Eval.ML	Thu Feb 01 20:51:48 2001 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,54 +0,0 @@
     7.4 -(*  Title:      HOL/MicroJava/J/Eval.ML
     7.5 -    ID:         $Id$
     7.6 -    Author:     David von Oheimb
     7.7 -    Copyright   1999 Technische Universitaet Muenchen
     7.8 -*)
     7.9 -
    7.10 -val eval_evals_exec_induct = complete_split_rule eval_evals_exec.induct;
    7.11 -
    7.12 -Goal "[|new_Addr (heap s) = (a,x); \
    7.13 -\      s' = c_hupd (heap s(a\\<mapsto>(C,init_vars (fields (G,C))))) (x,s)|] ==> \
    7.14 -\      G\\<turnstile>Norm s -NewC C\\<succ>Addr a-> s'";
    7.15 -by (Asm_simp_tac 1);
    7.16 -br eval_evals_exec.NewC 1;
    7.17 -by Auto_tac;
    7.18 -qed "NewCI";
    7.19 -
    7.20 -Goal "!!s s'. (G\\<turnstile>(x,s) -e \\<succ>  v -> (x',s') --> x'=None --> x=None) \\<and> \
    7.21 -\             (G\\<turnstile>(x,s) -es[\\<succ>]vs-> (x',s') --> x'=None --> x=None) \\<and> \
    7.22 -\             (G\\<turnstile>(x,s) -c       -> (x',s') --> x'=None --> x=None)";
    7.23 -by(split_all_tac 1);
    7.24 -by(rtac eval_evals_exec_induct 1);
    7.25 -by(rewtac c_hupd_def);
    7.26 -by(ALLGOALS Asm_full_simp_tac);
    7.27 -qed "eval_evals_exec_no_xcpt";
    7.28 -
    7.29 -Goal "G\\<turnstile>(x,s) -e\\<succ>v-> (None,s') ==> x=None";
    7.30 -by (dtac (eval_evals_exec_no_xcpt RS conjunct1 RS mp) 1);
    7.31 -by (Fast_tac 1);
    7.32 -qed "eval_no_xcpt";
    7.33 -
    7.34 -Goal "G\\<turnstile>(x,s) -e[\\<succ>]v-> (None,s') ==> x=None";
    7.35 -by (dtac (eval_evals_exec_no_xcpt RS conjunct2 RS conjunct1 RS mp) 1);
    7.36 -by (Fast_tac 1);
    7.37 -qed "evals_no_xcpt";
    7.38 -
    7.39 -Goal 
    7.40 -"!!s s'. (G\\<turnstile>(x,s) -e \\<succ>  v -> (x',s') --> x=Some xc --> x'=Some xc \\<and> s'=s) \\<and> \
    7.41 -\        (G\\<turnstile>(x,s) -es[\\<succ>]vs-> (x',s') --> x=Some xc --> x'=Some xc \\<and> s'=s) \\<and> \
    7.42 -\        (G\\<turnstile>(x,s) -c       -> (x',s') --> x=Some xc --> x'=Some xc \\<and> s'=s)";
    7.43 -by (split_all_tac 1);
    7.44 -by (rtac eval_evals_exec_induct 1);
    7.45 -by (rewtac c_hupd_def);
    7.46 -by (ALLGOALS Asm_full_simp_tac);
    7.47 -qed "eval_evals_exec_xcpt";
    7.48 -
    7.49 -Goal "G\\<turnstile>(Some xc,s) -e\\<succ>v-> (x',s') ==> x'=Some xc \\<and>  s'=s";
    7.50 -by (dtac (eval_evals_exec_xcpt RS conjunct1 RS mp) 1);
    7.51 -by (Fast_tac 1);
    7.52 -qed "eval_xcpt";  
    7.53 -
    7.54 -Goal "G\\<turnstile>(Some xc,s) -s0-> (x',s') ==> x'=Some xc \\<and>  s'=s";
    7.55 -by (dtac (eval_evals_exec_xcpt RS conjunct2 RS conjunct2 RS mp) 1);
    7.56 -by (Fast_tac 1);
    7.57 -qed "exec_xcpt";
    7.58 \ No newline at end of file
     8.1 --- a/src/HOL/MicroJava/J/Eval.thy	Thu Feb 01 20:51:48 2001 +0100
     8.2 +++ b/src/HOL/MicroJava/J/Eval.thy	Thu Feb 01 20:53:13 2001 +0100
     8.3 @@ -7,20 +7,21 @@
     8.4  execution of Java expressions and statements
     8.5  *)
     8.6  
     8.7 -Eval = State + WellType +
     8.8 +theory Eval = State + WellType:
     8.9 +
    8.10  consts
    8.11 -  eval  :: "java_mb prog => (xstate \\<times> expr      \\<times> val      \\<times> xstate) set"
    8.12 -  evals :: "java_mb prog => (xstate \\<times> expr list \\<times> val list \\<times> xstate) set"
    8.13 -  exec  :: "java_mb prog => (xstate \\<times> stmt                 \\<times> xstate) set"
    8.14 +  eval  :: "java_mb prog => (xstate \<times> expr      \<times> val      \<times> xstate) set"
    8.15 +  evals :: "java_mb prog => (xstate \<times> expr list \<times> val list \<times> xstate) set"
    8.16 +  exec  :: "java_mb prog => (xstate \<times> stmt                 \<times> xstate) set"
    8.17  
    8.18  syntax
    8.19    eval :: "[java_mb prog,xstate,expr,val,xstate] => bool "
    8.20 -          ("_ \\<turnstile> _ -_\\<succ>_-> _" [51,82,60,82,82] 81)
    8.21 +          ("_ \<turnstile> _ -_\<succ>_-> _" [51,82,60,82,82] 81)
    8.22    evals:: "[java_mb prog,xstate,expr list,
    8.23                          val list,xstate] => bool "
    8.24 -          ("_ \\<turnstile> _ -_[\\<succ>]_-> _" [51,82,60,51,82] 81)
    8.25 +          ("_ \<turnstile> _ -_[\<succ>]_-> _" [51,82,60,51,82] 81)
    8.26    exec :: "[java_mb prog,xstate,stmt,    xstate] => bool "
    8.27 -          ("_ \\<turnstile> _ -_-> _" [51,82,60,82] 81)
    8.28 +          ("_ \<turnstile> _ -_-> _" [51,82,60,82] 81)
    8.29  
    8.30  syntax (HTML)
    8.31    eval :: "[java_mb prog,xstate,expr,val,xstate] => bool "
    8.32 @@ -33,112 +34,159 @@
    8.33  
    8.34  
    8.35  translations
    8.36 -  "G\\<turnstile>s -e \\<succ> v-> (x,s')" <= "(s, e, v, x, s') \\<in> eval  G"
    8.37 -  "G\\<turnstile>s -e \\<succ> v->    s' " == "(s, e, v,    s') \\<in> eval  G"
    8.38 -  "G\\<turnstile>s -e[\\<succ>]v-> (x,s')" <= "(s, e, v, x, s') \\<in> evals G"
    8.39 -  "G\\<turnstile>s -e[\\<succ>]v->    s' " == "(s, e, v,    s') \\<in> evals G"
    8.40 -  "G\\<turnstile>s -c    -> (x,s')" <= "(s, c, x, s') \\<in> exec G"
    8.41 -  "G\\<turnstile>s -c    ->    s' " == "(s, c,    s') \\<in> exec G"
    8.42 +  "G\<turnstile>s -e \<succ> v-> (x,s')" <= "(s, e, v, x, s') \<in> eval  G"
    8.43 +  "G\<turnstile>s -e \<succ> v->    s' " == "(s, e, v,    s') \<in> eval  G"
    8.44 +  "G\<turnstile>s -e[\<succ>]v-> (x,s')" <= "(s, e, v, x, s') \<in> evals G"
    8.45 +  "G\<turnstile>s -e[\<succ>]v->    s' " == "(s, e, v,    s') \<in> evals G"
    8.46 +  "G\<turnstile>s -c    -> (x,s')" <= "(s, c, x, s') \<in> exec G"
    8.47 +  "G\<turnstile>s -c    ->    s' " == "(s, c,    s') \<in> exec G"
    8.48  
    8.49 -inductive "eval G" "evals G" "exec G" intrs
    8.50 +inductive "eval G" "evals G" "exec G" intros
    8.51  
    8.52  (* evaluation of expressions *)
    8.53  
    8.54    (* cf. 15.5 *)
    8.55 -  XcptE "G\\<turnstile>(Some xc,s) -e\\<succ>arbitrary-> (Some xc,s)"
    8.56 +  XcptE:"G\<turnstile>(Some xc,s) -e\<succ>arbitrary-> (Some xc,s)"
    8.57  
    8.58    (* cf. 15.8.1 *)
    8.59 -  NewC  "[| h = heap s; (a,x) = new_Addr h;
    8.60 -            h'= h(a\\<mapsto>(C,init_vars (fields (G,C)))) |] ==>
    8.61 -         G\\<turnstile>Norm s -NewC C\\<succ>Addr a-> c_hupd h' (x,s)"
    8.62 +  NewC: "[| h = heap s; (a,x) = new_Addr h;
    8.63 +            h'= h(a\<mapsto>(C,init_vars (fields (G,C)))) |] ==>
    8.64 +         G\<turnstile>Norm s -NewC C\<succ>Addr a-> c_hupd h' (x,s)"
    8.65  
    8.66    (* cf. 15.15 *)
    8.67 -  Cast  "[| G\\<turnstile>Norm s0 -e\\<succ>v-> (x1,s1);
    8.68 -            x2 = raise_if (\\<not> cast_ok G C (heap s1) v) ClassCast x1 |] ==>
    8.69 -         G\\<turnstile>Norm s0 -Cast C e\\<succ>v-> (x2,s1)"
    8.70 +  Cast: "[| G\<turnstile>Norm s0 -e\<succ>v-> (x1,s1);
    8.71 +            x2 = raise_if (\<not> cast_ok G C (heap s1) v) ClassCast x1 |] ==>
    8.72 +         G\<turnstile>Norm s0 -Cast C e\<succ>v-> (x2,s1)"
    8.73  
    8.74    (* cf. 15.7.1 *)
    8.75 -  Lit   "G\\<turnstile>Norm s -Lit v\\<succ>v-> Norm s"
    8.76 +  Lit:  "G\<turnstile>Norm s -Lit v\<succ>v-> Norm s"
    8.77  
    8.78 -  BinOp "[| G\\<turnstile>Norm s -e1\\<succ>v1-> s1;
    8.79 -            G\\<turnstile>s1     -e2\\<succ>v2-> s2;
    8.80 +  BinOp:"[| G\<turnstile>Norm s -e1\<succ>v1-> s1;
    8.81 +            G\<turnstile>s1     -e2\<succ>v2-> s2;
    8.82              v = (case bop of Eq  => Bool (v1 = v2)
    8.83                             | Add => Intg (the_Intg v1 + the_Intg v2)) |] ==>
    8.84 -         G\\<turnstile>Norm s -BinOp bop e1 e2\\<succ>v-> s2"
    8.85 +         G\<turnstile>Norm s -BinOp bop e1 e2\<succ>v-> s2"
    8.86  
    8.87    (* cf. 15.13.1, 15.2 *)
    8.88 -  LAcc  "G\\<turnstile>Norm s -LAcc v\\<succ>the (locals s v)-> Norm s"
    8.89 +  LAcc: "G\<turnstile>Norm s -LAcc v\<succ>the (locals s v)-> Norm s"
    8.90  
    8.91    (* cf. 15.25.1 *)
    8.92 -  LAss  "[| G\\<turnstile>Norm s -e\\<succ>v-> (x,(h,l));
    8.93 -            l' = (if x = None then l(va\\<mapsto>v) else l) |] ==>
    8.94 -         G\\<turnstile>Norm s -va::=e\\<succ>v-> (x,(h,l'))"
    8.95 +  LAss: "[| G\<turnstile>Norm s -e\<succ>v-> (x,(h,l));
    8.96 +            l' = (if x = None then l(va\<mapsto>v) else l) |] ==>
    8.97 +         G\<turnstile>Norm s -va::=e\<succ>v-> (x,(h,l'))"
    8.98  
    8.99  
   8.100    (* cf. 15.10.1, 15.2 *)
   8.101 -  FAcc  "[| G\\<turnstile>Norm s0 -e\\<succ>a'-> (x1,s1); 
   8.102 +  FAcc: "[| G\<turnstile>Norm s0 -e\<succ>a'-> (x1,s1); 
   8.103              v = the (snd (the (heap s1 (the_Addr a'))) (fn,T)) |] ==>
   8.104 -         G\\<turnstile>Norm s0 -{T}e..fn\\<succ>v-> (np a' x1,s1)"
   8.105 +         G\<turnstile>Norm s0 -{T}e..fn\<succ>v-> (np a' x1,s1)"
   8.106  
   8.107    (* cf. 15.25.1 *)
   8.108 -  FAss  "[| G\\<turnstile>     Norm s0  -e1\\<succ>a'-> (x1,s1); a = the_Addr a';
   8.109 -            G\\<turnstile>(np a' x1,s1) -e2\\<succ>v -> (x2,s2);
   8.110 +  FAss: "[| G\<turnstile>     Norm s0  -e1\<succ>a'-> (x1,s1); a = the_Addr a';
   8.111 +            G\<turnstile>(np a' x1,s1) -e2\<succ>v -> (x2,s2);
   8.112              h  = heap s2; (c,fs) = the (h a);
   8.113 -            h' = h(a\\<mapsto>(c,(fs((fn,T)\\<mapsto>v)))) |] ==>
   8.114 -         G\\<turnstile>Norm s0 -{T}e1..fn:=e2\\<succ>v-> c_hupd h' (x2,s2)"
   8.115 +            h' = h(a\<mapsto>(c,(fs((fn,T)\<mapsto>v)))) |] ==>
   8.116 +         G\<turnstile>Norm s0 -{T}e1..fn:=e2\<succ>v-> c_hupd h' (x2,s2)"
   8.117  
   8.118    (* cf. 15.11.4.1, 15.11.4.2, 15.11.4.4, 15.11.4.5, 14.15 *)
   8.119 -  Call  "[| G\\<turnstile>Norm s0 -e\\<succ>a'-> s1; a = the_Addr a';
   8.120 -            G\\<turnstile>s1 -ps[\\<succ>]pvs-> (x,(h,l)); dynT = fst (the (h a));
   8.121 +  Call: "[| G\<turnstile>Norm s0 -e\<succ>a'-> s1; a = the_Addr a';
   8.122 +            G\<turnstile>s1 -ps[\<succ>]pvs-> (x,(h,l)); dynT = fst (the (h a));
   8.123              (md,rT,pns,lvars,blk,res) = the (method (G,dynT) (mn,pTs));
   8.124 -            G\\<turnstile>(np a' x,(h,(init_vars lvars)(pns[\\<mapsto>]pvs)(This\\<mapsto>a'))) -blk-> s3;
   8.125 -            G\\<turnstile> s3 -res\\<succ>v -> (x4,s4) |] ==>
   8.126 -         G\\<turnstile>Norm s0 -{C}e..mn({pTs}ps)\\<succ>v-> (x4,(heap s4,l))"
   8.127 +            G\<turnstile>(np a' x,(h,(init_vars lvars)(pns[\<mapsto>]pvs)(This\<mapsto>a'))) -blk-> s3;
   8.128 +            G\<turnstile> s3 -res\<succ>v -> (x4,s4) |] ==>
   8.129 +         G\<turnstile>Norm s0 -{C}e..mn({pTs}ps)\<succ>v-> (x4,(heap s4,l))"
   8.130  
   8.131  
   8.132  (* evaluation of expression lists *)
   8.133  
   8.134    (* cf. 15.5 *)
   8.135 -  XcptEs "G\\<turnstile>(Some xc,s) -e[\\<succ>]arbitrary-> (Some xc,s)"
   8.136 +  XcptEs:"G\<turnstile>(Some xc,s) -e[\<succ>]arbitrary-> (Some xc,s)"
   8.137  
   8.138    (* cf. 15.11.??? *)
   8.139 -  Nil   "G\\<turnstile>Norm s0 -[][\\<succ>][]-> Norm s0"
   8.140 +  Nil:  "G\<turnstile>Norm s0 -[][\<succ>][]-> Norm s0"
   8.141  
   8.142    (* cf. 15.6.4 *)
   8.143 -  Cons  "[| G\\<turnstile>Norm s0 -e  \\<succ> v -> s1;
   8.144 -            G\\<turnstile>     s1 -es[\\<succ>]vs-> s2 |] ==>
   8.145 -         G\\<turnstile>Norm s0 -e#es[\\<succ>]v#vs-> s2"
   8.146 +  Cons: "[| G\<turnstile>Norm s0 -e  \<succ> v -> s1;
   8.147 +            G\<turnstile>     s1 -es[\<succ>]vs-> s2 |] ==>
   8.148 +         G\<turnstile>Norm s0 -e#es[\<succ>]v#vs-> s2"
   8.149  
   8.150  (* execution of statements *)
   8.151  
   8.152    (* cf. 14.1 *)
   8.153 -  XcptS "G\\<turnstile>(Some xc,s) -c-> (Some xc,s)"
   8.154 +  XcptS:"G\<turnstile>(Some xc,s) -c-> (Some xc,s)"
   8.155  
   8.156    (* cf. 14.5 *)
   8.157 -  Skip  "G\\<turnstile>Norm s -Skip-> Norm s"
   8.158 +  Skip: "G\<turnstile>Norm s -Skip-> Norm s"
   8.159  
   8.160    (* cf. 14.7 *)
   8.161 -  Expr  "[| G\\<turnstile>Norm s0 -e\\<succ>v-> s1 |] ==>
   8.162 -         G\\<turnstile>Norm s0 -Expr e-> s1"
   8.163 +  Expr: "[| G\<turnstile>Norm s0 -e\<succ>v-> s1 |] ==>
   8.164 +         G\<turnstile>Norm s0 -Expr e-> s1"
   8.165  
   8.166    (* cf. 14.2 *)
   8.167 -  Comp  "[| G\\<turnstile>Norm s0 -c1-> s1;
   8.168 -            G\\<turnstile>     s1 -c2-> s2|] ==>
   8.169 -         G\\<turnstile>Norm s0 -c1;; c2-> s2"
   8.170 +  Comp: "[| G\<turnstile>Norm s0 -c1-> s1;
   8.171 +            G\<turnstile>     s1 -c2-> s2|] ==>
   8.172 +         G\<turnstile>Norm s0 -c1;; c2-> s2"
   8.173  
   8.174    (* cf. 14.8.2 *)
   8.175 -  Cond  "[| G\\<turnstile>Norm s0  -e\\<succ>v-> s1;
   8.176 -            G\\<turnstile> s1 -(if the_Bool v then c1 else c2)-> s2|] ==>
   8.177 -         G\\<turnstile>Norm s0 -If(e) c1 Else c2-> s2"
   8.178 +  Cond: "[| G\<turnstile>Norm s0  -e\<succ>v-> s1;
   8.179 +            G\<turnstile> s1 -(if the_Bool v then c1 else c2)-> s2|] ==>
   8.180 +         G\<turnstile>Norm s0 -If(e) c1 Else c2-> s2"
   8.181  
   8.182    (* cf. 14.10, 14.10.1 *)
   8.183 -  LoopF "[| G\\<turnstile>Norm s0 -e\\<succ>v-> s1; \\<not>the_Bool v |] ==>
   8.184 -         G\\<turnstile>Norm s0 -While(e) c-> s1"
   8.185 -  LoopT "[| G\\<turnstile>Norm s0 -e\\<succ>v-> s1;  the_Bool v;
   8.186 -	    G\\<turnstile>s1 -c-> s2; G\\<turnstile>s2 -While(e) c-> s3 |] ==>
   8.187 -         G\\<turnstile>Norm s0 -While(e) c-> s3"
   8.188 +  LoopF:"[| G\<turnstile>Norm s0 -e\<succ>v-> s1; \<not>the_Bool v |] ==>
   8.189 +         G\<turnstile>Norm s0 -While(e) c-> s1"
   8.190 +  LoopT:"[| G\<turnstile>Norm s0 -e\<succ>v-> s1;  the_Bool v;
   8.191 +	    G\<turnstile>s1 -c-> s2; G\<turnstile>s2 -While(e) c-> s3 |] ==>
   8.192 +         G\<turnstile>Norm s0 -While(e) c-> s3"
   8.193 +
   8.194 +lemmas eval_evals_exec_induct = eval_evals_exec.induct [complete_split]
   8.195 +
   8.196 +lemma NewCI: "[|new_Addr (heap s) = (a,x);  
   8.197 +       s' = c_hupd (heap s(a\<mapsto>(C,init_vars (fields (G,C))))) (x,s)|] ==>  
   8.198 +       G\<turnstile>Norm s -NewC C\<succ>Addr a-> s'"
   8.199 +apply (simp (no_asm_simp))
   8.200 +apply (rule eval_evals_exec.NewC)
   8.201 +apply auto
   8.202 +done
   8.203 +
   8.204 +lemma eval_evals_exec_no_xcpt: 
   8.205 + "!!s s'. (G\<turnstile>(x,s) -e \<succ>  v -> (x',s') --> x'=None --> x=None) \<and>  
   8.206 +          (G\<turnstile>(x,s) -es[\<succ>]vs-> (x',s') --> x'=None --> x=None) \<and>  
   8.207 +          (G\<turnstile>(x,s) -c       -> (x',s') --> x'=None --> x=None)"
   8.208 +apply(simp (no_asm_simp) only: split_tupled_all)
   8.209 +apply(rule eval_evals_exec_induct)
   8.210 +apply(unfold c_hupd_def)
   8.211 +apply(simp_all)
   8.212 +done
   8.213  
   8.214 -monos
   8.215 -  if_def2
   8.216 +lemma eval_no_xcpt: "G\<turnstile>(x,s) -e\<succ>v-> (None,s') ==> x=None"
   8.217 +apply (drule eval_evals_exec_no_xcpt [THEN conjunct1, THEN mp])
   8.218 +apply (fast)
   8.219 +done
   8.220 +
   8.221 +lemma evals_no_xcpt: "G\<turnstile>(x,s) -e[\<succ>]v-> (None,s') ==> x=None"
   8.222 +apply (drule eval_evals_exec_no_xcpt [THEN conjunct2, THEN conjunct1, THEN mp])
   8.223 +apply (fast)
   8.224 +done
   8.225  
   8.226 -end
   8.227 +lemma eval_evals_exec_xcpt: 
   8.228 +"!!s s'. (G\<turnstile>(x,s) -e \<succ>  v -> (x',s') --> x=Some xc --> x'=Some xc \<and> s'=s) \<and>  
   8.229 +         (G\<turnstile>(x,s) -es[\<succ>]vs-> (x',s') --> x=Some xc --> x'=Some xc \<and> s'=s) \<and>  
   8.230 +         (G\<turnstile>(x,s) -c       -> (x',s') --> x=Some xc --> x'=Some xc \<and> s'=s)"
   8.231 +apply (simp (no_asm_simp) only: split_tupled_all)
   8.232 +apply (rule eval_evals_exec_induct)
   8.233 +apply (unfold c_hupd_def)
   8.234 +apply (simp_all)
   8.235 +done
   8.236 +
   8.237 +lemma eval_xcpt: "G\<turnstile>(Some xc,s) -e\<succ>v-> (x',s') ==> x'=Some xc \<and>  s'=s"
   8.238 +apply (drule eval_evals_exec_xcpt [THEN conjunct1, THEN mp])
   8.239 +apply (fast)
   8.240 +done
   8.241 +
   8.242 +lemma exec_xcpt: "G\<turnstile>(Some xc,s) -s0-> (x',s') ==> x'=Some xc \<and>  s'=s"
   8.243 +apply (drule eval_evals_exec_xcpt [THEN conjunct2, THEN conjunct2, THEN mp])
   8.244 +apply (fast)
   8.245 +done
   8.246 +
   8.247 +end
   8.248 \ No newline at end of file
     9.1 --- a/src/HOL/MicroJava/J/Example.ML	Thu Feb 01 20:51:48 2001 +0100
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,267 +0,0 @@
     9.4 -
     9.5 -Addsimps [inj_cnam_, inj_vnam_];
     9.6 -Addsimps [Base_not_Object,Ext_not_Object];
     9.7 -Addsimps [Base_not_Object RS not_sym,Ext_not_Object RS not_sym];
     9.8 -
     9.9 -bind_thm ("map_of_Cons", hd (tl (thms "map_of.simps")));
    9.10 -Goal "map_of ((aa,bb)#ps) aa = Some bb";
    9.11 -by (Simp_tac 1);
    9.12 -qed "map_of_Cons1";
    9.13 -Goal "aa\\<noteq>k ==> map_of ((k,bb)#ps) aa = map_of ps aa";
    9.14 -by (Asm_simp_tac 1);
    9.15 -qed "map_of_Cons2";
    9.16 -Delsimps[map_of_Cons]; (* sic! *)
    9.17 -Addsimps[map_of_Cons1, map_of_Cons2];
    9.18 -
    9.19 -Goalw [ObjectC_def,class_def] "class tprg Object = Some (arbitrary, [], [])";
    9.20 -by (Simp_tac 1);
    9.21 -qed "class_tprg_Object";
    9.22 -
    9.23 -Goalw [ObjectC_def, BaseC_def, ExtC_def, class_def] 
    9.24 -"class tprg Base = Some (Object, \
    9.25 -	\ [(vee, PrimT Boolean)], \
    9.26 -        \ [((foo, [Class Base]), Class Base, foo_Base)])";
    9.27 -by (Simp_tac 1);
    9.28 -qed "class_tprg_Base";
    9.29 -
    9.30 -Goalw [ObjectC_def, BaseC_def, ExtC_def, class_def] 
    9.31 -"class tprg Ext = Some (Base, \
    9.32 -	\ [(vee, PrimT Integer)], \
    9.33 -        \ [((foo, [Class Base]), Class Ext, foo_Ext)])";
    9.34 -by (Simp_tac 1);
    9.35 -qed "class_tprg_Ext";
    9.36 -
    9.37 -Addsimps [class_tprg_Object, class_tprg_Base, class_tprg_Ext];
    9.38 -
    9.39 -Goal "(Object,C) \\<in> (subcls1 tprg)^+ ==> R";
    9.40 -by (auto_tac (claset() addSDs [tranclD,subcls1D],simpset()));
    9.41 -qed "not_Object_subcls";
    9.42 -AddSEs [not_Object_subcls];
    9.43 -
    9.44 -Goal "tprg\\<turnstile>Object\\<preceq>C C ==> C = Object";
    9.45 -be rtrancl_induct 1;
    9.46 -by  Auto_tac;
    9.47 -bd subcls1D 1;
    9.48 -by Auto_tac;
    9.49 -qed "subcls_ObjectD";
    9.50 -AddSDs[subcls_ObjectD];
    9.51 -
    9.52 -Goal "(Base, Ext) \\<in> (subcls1 tprg)^+ ==> R";
    9.53 -by (auto_tac (claset() addSDs [tranclD,subcls1D],simpset()));
    9.54 -qed "not_Base_subcls_Ext";
    9.55 -AddSEs [not_Base_subcls_Ext];
    9.56 -
    9.57 -Goalw [ObjectC_def, BaseC_def, ExtC_def, class_def] 
    9.58 -"class tprg C = Some z ==> C=Object \\<or> C=Base \\<or> C=Ext";
    9.59 -by (auto_tac (claset(),simpset()addsplits[split_if_asm]addsimps[map_of_Cons]));
    9.60 -qed "class_tprgD";
    9.61 -
    9.62 -Goal "(C,C) \\<in> (subcls1 tprg)^+ ==> R";
    9.63 -by (auto_tac (claset() addSDs [tranclD,subcls1D],simpset()));
    9.64 -by (ftac class_tprgD 1);
    9.65 -by (auto_tac (claset() addSDs [],simpset()));
    9.66 -bd (thm"rtranclD") 1;
    9.67 -by Auto_tac;
    9.68 -qed "not_class_subcls_class";
    9.69 -AddSEs [not_class_subcls_class];
    9.70 -
    9.71 -goalw thy [ObjectC_def, BaseC_def, ExtC_def] "unique tprg";
    9.72 -by (Simp_tac 1);
    9.73 -qed "unique_classes";
    9.74 -
    9.75 -bind_thm ("subcls_direct", subcls1I RS r_into_rtrancl);
    9.76 -
    9.77 -Goal "tprg\\<turnstile>Ext\\<preceq>C Base";
    9.78 -br subcls_direct 1;
    9.79 -by Auto_tac;
    9.80 -qed "Ext_subcls_Base";
    9.81 -Addsimps [Ext_subcls_Base];
    9.82 -
    9.83 -Goal "tprg\\<turnstile>Class Ext\\<preceq> Class Base";
    9.84 -br widen.subcls 1;
    9.85 -by (Simp_tac 1);
    9.86 -qed "Ext_widen_Base";
    9.87 -Addsimps [Ext_widen_Base];
    9.88 -
    9.89 -AddSIs ty_expr_ty_exprs_wt_stmt.intrs;
    9.90 -
    9.91 -
    9.92 -Goal "acyclic (subcls1 tprg)";
    9.93 -br acyclicI 1;
    9.94 -by Safe_tac ;
    9.95 -qed "acyclic_subcls1_";
    9.96 -
    9.97 -val wf_subcls1_=acyclic_subcls1_ RS(finite_subcls1 RS finite_acyclic_wf_converse);
    9.98 -
    9.99 -
   9.100 -val fields_rec_ = wf_subcls1_ RSN (1, fields_rec_lemma);
   9.101 -
   9.102 -Goal "fields (tprg, Object) = []";
   9.103 -by (stac fields_rec_ 1);
   9.104 -by   Auto_tac;
   9.105 -qed "fields_Object";
   9.106 -Addsimps [fields_Object];
   9.107 -
   9.108 -Addsimps [is_class_def];
   9.109 -
   9.110 -Goal "fields (tprg,Base) = [((vee, Base), PrimT Boolean)]";
   9.111 -by (stac fields_rec_ 1);
   9.112 -by   Auto_tac;
   9.113 -qed "fields_Base";
   9.114 -Addsimps [fields_Base];
   9.115 -
   9.116 -Goal "fields (tprg, Ext)  = [((vee, Ext ), PrimT Integer)] @\
   9.117 -                                    \ fields (tprg, Base)";
   9.118 -br trans 1;
   9.119 -br  fields_rec_ 1;
   9.120 -by   Auto_tac;
   9.121 -qed "fields_Ext";
   9.122 -Addsimps [fields_Ext];
   9.123 -
   9.124 -val method_rec_ = wf_subcls1_ RS method_rec_lemma;
   9.125 -
   9.126 -Goal "method (tprg,Object) = map_of []";
   9.127 -by (stac method_rec_ 1);
   9.128 -by  Auto_tac;
   9.129 -qed "method_Object";
   9.130 -Addsimps [method_Object];
   9.131 -
   9.132 -Goal "method (tprg, Base) = map_of \
   9.133 -\ [((foo, [Class Base]), Base, (Class Base, foo_Base))]";
   9.134 -br trans 1;
   9.135 -br  method_rec_ 1;
   9.136 -by  Auto_tac;
   9.137 -qed "method_Base";
   9.138 -Addsimps [method_Base];
   9.139 -
   9.140 -Goal "method (tprg, Ext) = (method (tprg, Base) ++ map_of \
   9.141 -\ [((foo, [Class Base]), Ext , (Class Ext, foo_Ext))])";
   9.142 -br trans 1;
   9.143 -br  method_rec_ 1;
   9.144 -by  Auto_tac;
   9.145 -qed "method_Ext";
   9.146 -Addsimps [method_Ext];
   9.147 -
   9.148 -Goalw [wf_mdecl_def,wf_mhead_def,wf_java_mdecl_def,foo_Base_def] 
   9.149 -"wf_mdecl wf_java_mdecl tprg Base ((foo, [Class Base]), (Class Base, foo_Base))";
   9.150 -by Auto_tac;
   9.151 -qed "wf_foo_Base";
   9.152 -
   9.153 -Goalw [wf_mdecl_def,wf_mhead_def,wf_java_mdecl_def,foo_Ext_def] 
   9.154 -"wf_mdecl wf_java_mdecl tprg Ext ((foo, [Class Base]), (Class Ext, foo_Ext))";
   9.155 -by Auto_tac;
   9.156 -br  ty_expr_ty_exprs_wt_stmt.Cast 1;
   9.157 -by   (Simp_tac 2);
   9.158 -br   cast.subcls 2;
   9.159 -by   (rewtac field_def);
   9.160 -by   Auto_tac;
   9.161 -qed "wf_foo_Ext";
   9.162 -
   9.163 -Goalw [wf_cdecl_def, wf_fdecl_def, ObjectC_def] 
   9.164 -"wf_cdecl wf_java_mdecl tprg ObjectC";
   9.165 -by (Simp_tac 1);
   9.166 -qed "wf_ObjectC";
   9.167 -
   9.168 -Goalw [wf_cdecl_def, wf_fdecl_def, BaseC_def] 
   9.169 -"wf_cdecl wf_java_mdecl tprg BaseC";
   9.170 -by (Simp_tac 1);
   9.171 -by (fold_goals_tac [BaseC_def]);
   9.172 -br (wf_foo_Base RS conjI) 1;
   9.173 -by Auto_tac;
   9.174 -qed "wf_BaseC";
   9.175 -
   9.176 -Goalw [wf_cdecl_def, wf_fdecl_def, ExtC_def] 
   9.177 -"wf_cdecl wf_java_mdecl tprg ExtC";
   9.178 -by (Simp_tac 1);
   9.179 -by (fold_goals_tac [ExtC_def]);
   9.180 -br (wf_foo_Ext RS conjI) 1;
   9.181 -by Auto_tac;
   9.182 -bd (thm"rtranclD") 1;
   9.183 -by Auto_tac;
   9.184 -qed "wf_ExtC";
   9.185 -
   9.186 -Goalw [wf_prog_def,Let_def] 
   9.187 -"wf_prog wf_java_mdecl tprg";
   9.188 -by(simp_tac (simpset() addsimps [wf_ObjectC,wf_BaseC,wf_ExtC,unique_classes])1);
   9.189 -qed "wf_tprg";
   9.190 -
   9.191 -Goalw [appl_methds_def] 
   9.192 -"appl_methds tprg Base (foo, [NT]) = \
   9.193 -\ {((Class Base, Class Base), [Class Base])}";
   9.194 -by (Simp_tac 1);
   9.195 -by (subgoal_tac "tprg\\<turnstile>NT\\<preceq> Class Base" 1);
   9.196 -by  (auto_tac (claset(), simpset() addsimps [map_of_Cons,foo_Base_def]));
   9.197 -qed "appl_methds_foo_Base";
   9.198 -
   9.199 -Goalw [max_spec_def] "max_spec tprg Base (foo, [NT]) = \
   9.200 -\ {((Class Base, Class Base), [Class Base])}";
   9.201 -by (auto_tac (claset(), simpset() addsimps [appl_methds_foo_Base]));
   9.202 -qed "max_spec_foo_Base";
   9.203 -
   9.204 -fun t thm = resolve_tac ty_expr_ty_exprs_wt_stmt.intrs 1 thm;
   9.205 -Goalw [test_def] "(tprg, empty(e\\<mapsto>Class Base))\\<turnstile>\ 
   9.206 -\ Expr(e::=NewC Ext);; Expr({Base}LAcc e..foo({?pTs'}[Lit Null]))\\<surd>";
   9.207 -(* ?pTs' = [Class Base] *)
   9.208 -by t;		(* ;; *)
   9.209 -by  t;		(* Expr *)
   9.210 -by  t;		(* LAss *)
   9.211 -by    t;	(* LAcc *)
   9.212 -by     (Simp_tac 1);
   9.213 -by    (Simp_tac 1);
   9.214 -by   t;	(* NewC *)
   9.215 -by   (Simp_tac 1);
   9.216 -by  (Simp_tac 1);
   9.217 -by t;	(* Expr *)
   9.218 -by t;	(* Call *)
   9.219 -by   t;	(* LAcc *)
   9.220 -by    (Simp_tac 1);
   9.221 -by   (Simp_tac 1);
   9.222 -by  t;	(* Cons *)
   9.223 -by   t;	(* Lit *)
   9.224 -by   (Simp_tac 1);
   9.225 -by  t;	(* Nil *)
   9.226 -by (Simp_tac 1);
   9.227 -br max_spec_foo_Base 1;
   9.228 -qed "wt_test";
   9.229 -
   9.230 -fun e thm = resolve_tac (NewCI::eval_evals_exec.intrs) 1 thm;
   9.231 -
   9.232 -Delsplits[split_if];
   9.233 -Addsimps[init_vars_def,c_hupd_def,cast_ok_def];
   9.234 -Goalw [test_def] 
   9.235 -" [|new_Addr (heap (snd s0)) = (a, None)|] ==> \
   9.236 -\ tprg\\<turnstile>s0 -test-> ?s";
   9.237 -(* ?s = s3 *)
   9.238 -by e;		(* ;; *)
   9.239 -by  e;		(* Expr *)
   9.240 -by  e;		(* LAss *)
   9.241 -by   e;	(* NewC *)
   9.242 -by    (Force_tac 1);
   9.243 -by   (Force_tac 1);
   9.244 -by  (Simp_tac 1);
   9.245 -be thin_rl 1;
   9.246 -by e;	(* Expr *)
   9.247 -by e;	(* Call *)
   9.248 -by       e;	(* LAcc *)
   9.249 -by      (Force_tac 1);
   9.250 -by     e;	(* Cons *)
   9.251 -by      e;	(* Lit *)
   9.252 -by     e;	(* Nil *)
   9.253 -by    (Simp_tac 1);
   9.254 -by   (force_tac (claset(), simpset() addsimps [foo_Ext_def]) 1);
   9.255 -by  (Simp_tac 1);
   9.256 -by  e;	(* Expr *)
   9.257 -by  e;	(* FAss *)
   9.258 -by       e;(* Cast *)
   9.259 -by        e;(* LAcc *)
   9.260 -by       (Simp_tac 1);
   9.261 -by      (Simp_tac 1);
   9.262 -by     (Simp_tac 1);
   9.263 -by     e;(* XcptE *)
   9.264 -by    (Simp_tac 1);
   9.265 -by   (EVERY'[rtac (surjective_pairing RS sym RSN (2,trans)), stac Pair_eq,
   9.266 -             Force_tac] 1);
   9.267 -by  (Simp_tac 1);
   9.268 -by (Simp_tac 1);
   9.269 -by e;	(* XcptE *)
   9.270 -bind_thm ("exec_test", simplify (simpset()) (result()));
    10.1 --- a/src/HOL/MicroJava/J/Example.thy	Thu Feb 01 20:51:48 2001 +0100
    10.2 +++ b/src/HOL/MicroJava/J/Example.thy	Thu Feb 01 20:53:13 2001 +0100
    10.3 @@ -28,7 +28,7 @@
    10.4  }
    10.5  *)
    10.6  
    10.7 -Example = Eval + 
    10.8 +theory Example = Eval:
    10.9  
   10.10  datatype cnam_ = Base_ | Ext_
   10.11  datatype vnam_ = vee_ | x_ | e_
   10.12 @@ -38,18 +38,23 @@
   10.13    cnam_ :: "cnam_ => cname"
   10.14    vnam_ :: "vnam_ => vnam"
   10.15  
   10.16 -rules (* cnam_ and vnam_ are intended to be isomorphic to cnam and vnam *)
   10.17 +axioms (* cnam_ and vnam_ are intended to be isomorphic to cnam and vnam *)
   10.18 +
   10.19 +  inj_cnam_:  "(cnam_ x = cnam_ y) = (x = y)"
   10.20 +  inj_vnam_:  "(vnam_ x = vnam_ y) = (x = y)"
   10.21  
   10.22 -  inj_cnam_  "(cnam_ x = cnam_ y) = (x = y)"
   10.23 -  inj_vnam_  "(vnam_ x = vnam_ y) = (x = y)"
   10.24 +  surj_cnam_: "\<exists>m. n = cnam_ m"
   10.25 +  surj_vnam_: "\<exists>m. n = vnam_ m"
   10.26  
   10.27 -  surj_cnam_ "\\<exists>m. n = cnam_ m"
   10.28 -  surj_vnam_ "\\<exists>m. n = vnam_ m"
   10.29 +declare inj_cnam_ [simp] inj_vnam_ [simp]
   10.30  
   10.31  syntax
   10.32  
   10.33 -  Base,  Ext	:: cname
   10.34 -  vee, x, e	:: vname
   10.35 +  Base :: cname
   10.36 +  Ext  :: cname
   10.37 +  vee  :: vname
   10.38 +  x    :: vname
   10.39 +  e    :: vname
   10.40  
   10.41  translations
   10.42  
   10.43 @@ -59,51 +64,323 @@
   10.44    "x"	 == "VName (vnam_ x_)"
   10.45    "e"	 == "VName (vnam_ e_)"
   10.46  
   10.47 -rules
   10.48 -  Base_not_Object "Base \\<noteq> Object"
   10.49 -  Ext_not_Object  "Ext  \\<noteq> Object"
   10.50 +axioms
   10.51 +
   10.52 +  Base_not_Object: "Base \<noteq> Object"
   10.53 +  Ext_not_Object:  "Ext  \<noteq> Object"
   10.54 +
   10.55 +declare Base_not_Object [simp] Ext_not_Object [simp]
   10.56 +declare Base_not_Object [THEN not_sym, simp] 
   10.57 +declare Ext_not_Object  [THEN not_sym, simp]
   10.58  
   10.59  consts
   10.60  
   10.61 -  foo_Base       :: java_mb
   10.62 -  foo_Ext        :: java_mb
   10.63 -  BaseC, ExtC    :: java_mb cdecl
   10.64 -  test		 :: stmt
   10.65 -  foo	         :: mname
   10.66 -  a,b		 :: loc
   10.67 +  foo_Base::  java_mb
   10.68 +  foo_Ext ::  java_mb
   10.69 +  BaseC   :: "java_mb cdecl"
   10.70 +  ExtC    :: "java_mb cdecl"
   10.71 +  test	  ::  stmt
   10.72 +  foo	  ::  mname
   10.73 +  a	  ::  loc
   10.74 +  b       ::  loc
   10.75  
   10.76  defs
   10.77  
   10.78 -  foo_Base_def "foo_Base == ([x],[],Skip,LAcc x)"
   10.79 -  BaseC_def "BaseC == (Base, (Object, 
   10.80 +  foo_Base_def:"foo_Base == ([x],[],Skip,LAcc x)"
   10.81 +  BaseC_def:"BaseC == (Base, (Object, 
   10.82  			     [(vee, PrimT Boolean)], 
   10.83  			     [((foo,[Class Base]),Class Base,foo_Base)]))"
   10.84 -  foo_Ext_def "foo_Ext == ([x],[],Expr( {Ext}Cast Ext
   10.85 +  foo_Ext_def:"foo_Ext == ([x],[],Expr( {Ext}Cast Ext
   10.86  				       (LAcc x)..vee:=Lit (Intg #1)),
   10.87  				   Lit Null)"
   10.88 -  ExtC_def  "ExtC  == (Ext,  (Base  , 
   10.89 +  ExtC_def: "ExtC  == (Ext,  (Base  , 
   10.90  			     [(vee, PrimT Integer)], 
   10.91  			     [((foo,[Class Base]),Class Ext,foo_Ext)]))"
   10.92  
   10.93 -  test_def "test == Expr(e::=NewC Ext);; 
   10.94 +  test_def:"test == Expr(e::=NewC Ext);; 
   10.95                      Expr({Base}LAcc e..foo({[Class Base]}[Lit Null]))"
   10.96  
   10.97  
   10.98  syntax
   10.99  
  10.100 -  NP		:: xcpt
  10.101 -  tprg 	 	:: java_mb prog
  10.102 -  obj1, obj2	:: obj
  10.103 -  s0,s1,s2,s3,s4:: state
  10.104 +  NP	:: xcpt
  10.105 +  tprg 	::"java_mb prog"
  10.106 +  obj1	:: obj
  10.107 +  obj2	:: obj
  10.108 +  s0 	:: state
  10.109 +  s1 	:: state
  10.110 +  s2 	:: state
  10.111 +  s3 	:: state
  10.112 +  s4 	:: state
  10.113  
  10.114  translations
  10.115  
  10.116    "NP"   == "NullPointer"
  10.117    "tprg" == "[ObjectC, BaseC, ExtC]"
  10.118 -  "obj1"    <= "(Ext, empty((vee, Base)\\<mapsto>Bool False)
  10.119 -			   ((vee, Ext )\\<mapsto>Intg #0))"
  10.120 +  "obj1"    <= "(Ext, empty((vee, Base)\<mapsto>Bool False)
  10.121 +			   ((vee, Ext )\<mapsto>Intg #0))"
  10.122    "s0" == " Norm    (empty, empty)"
  10.123 -  "s1" == " Norm    (empty(a\\<mapsto>obj1),empty(e\\<mapsto>Addr a))"
  10.124 -  "s2" == " Norm    (empty(a\\<mapsto>obj1),empty(x\\<mapsto>Null)(This\\<mapsto>Addr a))"
  10.125 -  "s3" == "(Some NP, empty(a\\<mapsto>obj1),empty(e\\<mapsto>Addr a))"
  10.126 +  "s1" == " Norm    (empty(a\<mapsto>obj1),empty(e\<mapsto>Addr a))"
  10.127 +  "s2" == " Norm    (empty(a\<mapsto>obj1),empty(x\<mapsto>Null)(This\<mapsto>Addr a))"
  10.128 +  "s3" == "(Some NP, empty(a\<mapsto>obj1),empty(e\<mapsto>Addr a))"
  10.129 +
  10.130 +
  10.131 +ML {* bind_thm ("map_of_Cons", hd (tl (thms "map_of.simps"))) *}
  10.132 +lemma map_of_Cons1 [simp]: "map_of ((aa,bb)#ps) aa = Some bb"
  10.133 +apply (simp (no_asm))
  10.134 +done
  10.135 +lemma map_of_Cons2 [simp]: "aa\<noteq>k ==> map_of ((k,bb)#ps) aa = map_of ps aa"
  10.136 +apply (simp (no_asm_simp))
  10.137 +done
  10.138 +declare map_of_Cons [simp del]; (* sic! *)
  10.139 +
  10.140 +lemma class_tprg_Object [simp]: "class tprg Object = Some (arbitrary, [], [])"
  10.141 +apply (unfold ObjectC_def class_def)
  10.142 +apply (simp (no_asm))
  10.143 +done
  10.144 +
  10.145 +lemma class_tprg_Base [simp]: 
  10.146 +"class tprg Base = Some (Object,  
  10.147 +	  [(vee, PrimT Boolean)],  
  10.148 +          [((foo, [Class Base]), Class Base, foo_Base)])"
  10.149 +apply (unfold ObjectC_def BaseC_def ExtC_def class_def)
  10.150 +apply (simp (no_asm))
  10.151 +done
  10.152 +
  10.153 +lemma class_tprg_Ext [simp]: 
  10.154 +"class tprg Ext = Some (Base,  
  10.155 +	  [(vee, PrimT Integer)],  
  10.156 +          [((foo, [Class Base]), Class Ext, foo_Ext)])"
  10.157 +apply (unfold ObjectC_def BaseC_def ExtC_def class_def)
  10.158 +apply (simp (no_asm))
  10.159 +done
  10.160 +
  10.161 +lemma not_Object_subcls [elim!]: "(Object,C) \<in> (subcls1 tprg)^+ ==> R"
  10.162 +apply (auto dest!: tranclD subcls1D)
  10.163 +done
  10.164 +
  10.165 +lemma subcls_ObjectD [dest!]: "tprg\<turnstile>Object\<preceq>C C ==> C = Object"
  10.166 +apply (erule rtrancl_induct)
  10.167 +apply  auto
  10.168 +apply (drule subcls1D)
  10.169 +apply auto
  10.170 +done
  10.171 +
  10.172 +lemma not_Base_subcls_Ext [elim!]: "(Base, Ext) \<in> (subcls1 tprg)^+ ==> R"
  10.173 +apply (auto dest!: tranclD subcls1D)
  10.174 +done
  10.175 +
  10.176 +lemma class_tprgD: 
  10.177 +"class tprg C = Some z ==> C=Object \<or> C=Base \<or> C=Ext"
  10.178 +apply (unfold ObjectC_def BaseC_def ExtC_def class_def)
  10.179 +apply (auto split add: split_if_asm simp add: map_of_Cons)
  10.180 +done
  10.181 +
  10.182 +lemma not_class_subcls_class [elim!]: "(C,C) \<in> (subcls1 tprg)^+ ==> R"
  10.183 +apply (auto dest!: tranclD subcls1D)
  10.184 +apply (frule class_tprgD)
  10.185 +apply (auto dest!:)
  10.186 +apply (drule rtranclD)
  10.187 +apply auto
  10.188 +done
  10.189 +
  10.190 +lemma unique_classes: "unique tprg"
  10.191 +apply (simp (no_asm) add: ObjectC_def BaseC_def ExtC_def)
  10.192 +done
  10.193 +
  10.194 +lemmas subcls_direct = subcls1I [THEN r_into_rtrancl]
  10.195 +
  10.196 +lemma Ext_subcls_Base [simp]: "tprg\<turnstile>Ext\<preceq>C Base"
  10.197 +apply (rule subcls_direct)
  10.198 +apply auto
  10.199 +done
  10.200 +
  10.201 +lemma Ext_widen_Base [simp]: "tprg\<turnstile>Class Ext\<preceq> Class Base"
  10.202 +apply (rule widen.subcls)
  10.203 +apply (simp (no_asm))
  10.204 +done
  10.205 +
  10.206 +declare ty_expr_ty_exprs_wt_stmt.intros [intro!]
  10.207 +
  10.208 +lemma acyclic_subcls1_: "acyclic (subcls1 tprg)"
  10.209 +apply (rule acyclicI)
  10.210 +apply safe
  10.211 +done
  10.212 +
  10.213 +lemmas wf_subcls1_ = acyclic_subcls1_ [THEN finite_subcls1 [THEN finite_acyclic_wf_converse]]
  10.214 +
  10.215 +lemmas fields_rec_ = wf_subcls1_ [THEN [2] fields_rec_lemma]
  10.216 +
  10.217 +lemma fields_Object [simp]: "fields (tprg, Object) = []"
  10.218 +apply (subst fields_rec_)
  10.219 +apply   auto
  10.220 +done
  10.221 +
  10.222 +declare is_class_def [simp]
  10.223 +
  10.224 +lemma fields_Base [simp]: "fields (tprg,Base) = [((vee, Base), PrimT Boolean)]"
  10.225 +apply (subst fields_rec_)
  10.226 +apply   auto
  10.227 +done
  10.228 +
  10.229 +lemma fields_Ext [simp]: 
  10.230 +  "fields (tprg, Ext)  = [((vee, Ext ), PrimT Integer)] @ fields (tprg, Base)"
  10.231 +apply (rule trans)
  10.232 +apply  (rule fields_rec_)
  10.233 +apply   auto
  10.234 +done
  10.235 +
  10.236 +lemmas method_rec_ = wf_subcls1_ [THEN [2] method_rec_lemma]
  10.237 +
  10.238 +lemma method_Object [simp]: "method (tprg,Object) = map_of []"
  10.239 +apply (subst method_rec_)
  10.240 +apply  auto
  10.241 +done
  10.242 +
  10.243 +lemma method_Base [simp]: "method (tprg, Base) = map_of  
  10.244 +  [((foo, [Class Base]), Base, (Class Base, foo_Base))]"
  10.245 +apply (rule trans)
  10.246 +apply  (rule method_rec_)
  10.247 +apply  auto
  10.248 +done
  10.249 +
  10.250 +lemma method_Ext [simp]: "method (tprg, Ext) = (method (tprg, Base) ++ map_of  
  10.251 +  [((foo, [Class Base]), Ext , (Class Ext, foo_Ext))])"
  10.252 +apply (rule trans)
  10.253 +apply  (rule method_rec_)
  10.254 +apply  auto
  10.255 +done
  10.256 +
  10.257 +lemma wf_foo_Base: 
  10.258 +"wf_mdecl wf_java_mdecl tprg Base ((foo, [Class Base]), (Class Base, foo_Base))"
  10.259 +apply (unfold wf_mdecl_def wf_mhead_def wf_java_mdecl_def foo_Base_def)
  10.260 +apply auto
  10.261 +done
  10.262 +
  10.263 +lemma wf_foo_Ext: 
  10.264 +"wf_mdecl wf_java_mdecl tprg Ext ((foo, [Class Base]), (Class Ext, foo_Ext))"
  10.265 +apply (unfold wf_mdecl_def wf_mhead_def wf_java_mdecl_def foo_Ext_def)
  10.266 +apply auto
  10.267 +apply  (rule ty_expr_ty_exprs_wt_stmt.Cast)
  10.268 +prefer 2
  10.269 +apply   (simp)
  10.270 +apply   (rule_tac [2] cast.subcls)
  10.271 +apply   (unfold field_def)
  10.272 +apply   auto
  10.273 +done
  10.274 +
  10.275 +lemma wf_ObjectC: 
  10.276 +"wf_cdecl wf_java_mdecl tprg ObjectC"
  10.277 +apply (unfold wf_cdecl_def wf_fdecl_def ObjectC_def)
  10.278 +apply (simp (no_asm))
  10.279 +done
  10.280 +
  10.281 +lemma wf_BaseC: 
  10.282 +"wf_cdecl wf_java_mdecl tprg BaseC"
  10.283 +apply (unfold wf_cdecl_def wf_fdecl_def BaseC_def)
  10.284 +apply (simp (no_asm))
  10.285 +apply (fold BaseC_def)
  10.286 +apply (rule wf_foo_Base [THEN conjI])
  10.287 +apply auto
  10.288 +done
  10.289 +
  10.290 +lemma wf_ExtC: 
  10.291 +"wf_cdecl wf_java_mdecl tprg ExtC"
  10.292 +apply (unfold wf_cdecl_def wf_fdecl_def ExtC_def)
  10.293 +apply (simp (no_asm))
  10.294 +apply (fold ExtC_def)
  10.295 +apply (rule wf_foo_Ext [THEN conjI])
  10.296 +apply auto
  10.297 +apply (drule rtranclD)
  10.298 +apply auto
  10.299 +done
  10.300 +
  10.301 +lemma wf_tprg: 
  10.302 +"wf_prog wf_java_mdecl tprg"
  10.303 +apply (unfold wf_prog_def Let_def)
  10.304 +apply(simp add: wf_ObjectC wf_BaseC wf_ExtC unique_classes)
  10.305 +done
  10.306 +
  10.307 +lemma appl_methds_foo_Base: 
  10.308 +"appl_methds tprg Base (foo, [NT]) =  
  10.309 +  {((Class Base, Class Base), [Class Base])}"
  10.310 +apply (unfold appl_methds_def)
  10.311 +apply (simp (no_asm))
  10.312 +apply (subgoal_tac "tprg\<turnstile>NT\<preceq> Class Base")
  10.313 +apply  (auto simp add: map_of_Cons foo_Base_def)
  10.314 +done
  10.315 +
  10.316 +lemma max_spec_foo_Base: "max_spec tprg Base (foo, [NT]) =  
  10.317 +  {((Class Base, Class Base), [Class Base])}"
  10.318 +apply (unfold max_spec_def)
  10.319 +apply (auto simp add: appl_methds_foo_Base)
  10.320 +done
  10.321 +
  10.322 +ML {* fun t thm = resolve_tac (thms "ty_expr_ty_exprs_wt_stmt.intros") 1 thm *}
  10.323 +lemma wt_test: "(tprg, empty(e\<mapsto>Class Base))\<turnstile>  
  10.324 +  Expr(e::=NewC Ext);; Expr({Base}LAcc e..foo({?pTs'}[Lit Null]))\<surd>"
  10.325 +apply (tactic t) (* ;; *)
  10.326 +apply  (tactic t) (* Expr *)
  10.327 +apply  (tactic t) (* LAss *)
  10.328 +apply    (tactic t) (* LAcc *)
  10.329 +apply     (simp (no_asm))
  10.330 +apply    (simp (no_asm))
  10.331 +apply   (tactic t) (* NewC *)
  10.332 +apply   (simp (no_asm))
  10.333 +apply  (simp (no_asm))
  10.334 +apply (tactic t) (* Expr *)
  10.335 +apply (tactic t) (* Call *)
  10.336 +apply   (tactic t) (* LAcc *)
  10.337 +apply    (simp (no_asm))
  10.338 +apply   (simp (no_asm))
  10.339 +apply  (tactic t) (* Cons *)
  10.340 +apply   (tactic t) (* Lit *)
  10.341 +apply   (simp (no_asm))
  10.342 +apply  (tactic t) (* Nil *)
  10.343 +apply (simp (no_asm))
  10.344 +apply (rule max_spec_foo_Base)
  10.345 +done
  10.346 +
  10.347 +ML {* fun e t = resolve_tac (thm "NewCI"::thms "eval_evals_exec.intros") 1 t *}
  10.348 +
  10.349 +declare split_if [split del]
  10.350 +declare init_vars_def [simp] c_hupd_def [simp] cast_ok_def [simp]
  10.351 +lemma exec_test: 
  10.352 +" [|new_Addr (heap (snd s0)) = (a, None)|] ==>  
  10.353 +  tprg\<turnstile>s0 -test-> ?s"
  10.354 +apply (unfold test_def)
  10.355 +(* ?s = s3 *)
  10.356 +apply (tactic e) (* ;; *)
  10.357 +apply  (tactic e) (* Expr *)
  10.358 +apply  (tactic e) (* LAss *)
  10.359 +apply   (tactic e) (* NewC *)
  10.360 +apply    force
  10.361 +apply   force
  10.362 +apply  (simp (no_asm))
  10.363 +apply (erule thin_rl)
  10.364 +apply (tactic e) (* Expr *)
  10.365 +apply (tactic e) (* Call *)
  10.366 +apply       (tactic e) (* LAcc *)
  10.367 +apply      force
  10.368 +apply     (tactic e) (* Cons *)
  10.369 +apply      (tactic e) (* Lit *)
  10.370 +apply     (tactic e) (* Nil *)
  10.371 +apply    (simp (no_asm))
  10.372 +apply   (force simp add: foo_Ext_def)
  10.373 +apply  (simp (no_asm))
  10.374 +apply  (tactic e) (* Expr *)
  10.375 +apply  (tactic e) (* FAss *)
  10.376 +apply       (tactic e) (* Cast *)
  10.377 +apply        (tactic e) (* LAcc *)
  10.378 +apply       (simp (no_asm))
  10.379 +apply      (simp (no_asm))
  10.380 +apply     (simp (no_asm))
  10.381 +apply     (tactic e) (* XcptE *)
  10.382 +apply    (simp (no_asm))
  10.383 +apply   (rule surjective_pairing [THEN sym, THEN[2]trans], subst Pair_eq, force)
  10.384 +apply  (simp (no_asm))
  10.385 +apply (simp (no_asm))
  10.386 +apply (tactic e) (* XcptE *)
  10.387 +done
  10.388 +
  10.389  end
    11.1 --- a/src/HOL/MicroJava/J/JBasis.ML	Thu Feb 01 20:51:48 2001 +0100
    11.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.3 @@ -1,80 +0,0 @@
    11.4 -(*  Title:      HOL/MicroJava/J/JBasis.ML
    11.5 -    ID:         $Id$
    11.6 -    Author:     David von Oheimb
    11.7 -    Copyright   1999 TU Muenchen
    11.8 -*)
    11.9 -
   11.10 -(*###TO Product_Type*)
   11.11 -Goalw [split_def] "Eps (split P) = (SOME xy. P (fst xy) (snd xy))";
   11.12 -by (rtac refl 1);
   11.13 -qed "select_split";
   11.14 -
   11.15 -Addsimps [Let_def];
   11.16 -
   11.17 -bind_thm ("if_def2", read_instantiate [("P","\\<lambda>x. x")] split_if);
   11.18 -
   11.19 -(* ### To HOL.ML *)
   11.20 -Goal "[| ?!x. P x; P y |] ==> Eps P = y"; 
   11.21 -by (rtac some_equality 1);
   11.22 -by  (atac 1);
   11.23 -by (etac ex1E 1);
   11.24 -by (etac all_dupE 1);
   11.25 -by (fast_tac HOL_cs 1);
   11.26 -qed "ex1_some_eq_trivial";
   11.27 -
   11.28 -
   11.29 -section "unique";
   11.30 -
   11.31 -Goal "(x, y) : set xys --> x : fst ` set xys";
   11.32 -by (induct_tac "xys" 1);
   11.33 -by  Auto_tac;
   11.34 -qed_spec_mp "fst_in_set_lemma";
   11.35 -
   11.36 -Goalw [unique_def] "unique []";
   11.37 -by (Simp_tac 1);
   11.38 -qed "unique_Nil";
   11.39 -
   11.40 -Goalw [unique_def] "unique ((x,y)#l) = (unique l & (!y. (x,y) ~: set l))";
   11.41 -by  (auto_tac (claset() addDs [fst_in_set_lemma],simpset()));
   11.42 -qed "unique_Cons";
   11.43 -
   11.44 -Addsimps [unique_Nil,unique_Cons];
   11.45 -
   11.46 -Goal "unique l' ==> unique l --> \
   11.47 -\ (!(x,y):set l. !(x',y'):set l'. x' ~= x) --> unique (l @ l')";
   11.48 -by (induct_tac "l" 1);
   11.49 -by  (auto_tac (claset() addDs [fst_in_set_lemma],simpset()));
   11.50 -qed_spec_mp "unique_append";
   11.51 -
   11.52 -Goal "unique l --> inj f --> unique (map (%(k,x). (f k, g k x)) l)";
   11.53 -by (induct_tac "l" 1);
   11.54 -by  (auto_tac (claset() addDs [fst_in_set_lemma],simpset()addsimps[inj_eq]));
   11.55 -qed_spec_mp "unique_map_inj";
   11.56 -
   11.57 -(* More about Maps *)
   11.58 -
   11.59 -(*###Addsimps [fun_upd_same, fun_upd_other];*)
   11.60 -
   11.61 -Goal "unique l --> (k, x) : set l --> map_of l k = Some x";
   11.62 -by (induct_tac "l" 1);
   11.63 -by  Auto_tac;
   11.64 -qed_spec_mp "map_of_SomeI";
   11.65 -
   11.66 -Goal "(\\<forall>(x,y)\\<in>set l. P x y) --> (\\<forall>x. \\<forall>y. map_of l x = Some y --> P x y)";
   11.67 -by(induct_tac "l" 1);
   11.68 -by(ALLGOALS Simp_tac);
   11.69 -by Safe_tac;
   11.70 -by Auto_tac;
   11.71 -bind_thm("Ball_set_table",result() RS mp);
   11.72 -
   11.73 -Goal "map_of (map (\\<lambda>((k,k'),x). (k,(k',x))) t) k = Some (k',x) --> \
   11.74 -\map_of t (k, k') = Some x";
   11.75 -by (induct_tac "t" 1);
   11.76 -by  Auto_tac;
   11.77 -qed_spec_mp "table_of_remap_SomeD";
   11.78 -
   11.79 -(* ### To Map.ML *)
   11.80 -Goal "map_of (map (\\<lambda>(a,b). (a,f b)) xs) x = option_map f (map_of xs x)";
   11.81 -by (induct_tac "xs" 1);
   11.82 -by Auto_tac;
   11.83 -qed "map_of_map";
    12.1 --- a/src/HOL/MicroJava/J/JBasis.thy	Thu Feb 01 20:51:48 2001 +0100
    12.2 +++ b/src/HOL/MicroJava/J/JBasis.thy	Thu Feb 01 20:53:13 2001 +0100
    12.3 @@ -6,11 +6,69 @@
    12.4  Some auxiliary definitions.
    12.5  *)
    12.6  
    12.7 -JBasis = Main + 
    12.8 +theory JBasis = Main: 
    12.9  
   12.10 +lemmas [simp] = Let_def
   12.11 +
   12.12 +section "unique"
   12.13 + 
   12.14  constdefs
   12.15  
   12.16    unique  :: "('a \\<times> 'b) list => bool"
   12.17   "unique  == nodups \\<circ> map fst"
   12.18  
   12.19 +
   12.20 +lemma fst_in_set_lemma [rule_format (no_asm)]: 
   12.21 +      "(x, y) : set xys --> x : fst ` set xys"
   12.22 +apply (induct_tac "xys")
   12.23 +apply  auto
   12.24 +done
   12.25 +
   12.26 +lemma unique_Nil [simp]: "unique []"
   12.27 +apply (unfold unique_def)
   12.28 +apply (simp (no_asm))
   12.29 +done
   12.30 +
   12.31 +lemma unique_Cons [simp]: "unique ((x,y)#l) = (unique l & (!y. (x,y) ~: set l))"
   12.32 +apply (unfold unique_def)
   12.33 +apply (auto dest: fst_in_set_lemma)
   12.34 +done
   12.35 +
   12.36 +lemma unique_append [rule_format (no_asm)]: "unique l' ==> unique l --> 
   12.37 + (!(x,y):set l. !(x',y'):set l'. x' ~= x) --> unique (l @ l')"
   12.38 +apply (induct_tac "l")
   12.39 +apply  (auto dest: fst_in_set_lemma)
   12.40 +done
   12.41 +
   12.42 +lemma unique_map_inj [rule_format (no_asm)]: 
   12.43 +  "unique l --> inj f --> unique (map (%(k,x). (f k, g k x)) l)"
   12.44 +apply (induct_tac "l")
   12.45 +apply  (auto dest: fst_in_set_lemma simp add: inj_eq)
   12.46 +done
   12.47 +
   12.48 +section "More about Maps"
   12.49 +
   12.50 +lemma map_of_SomeI [rule_format (no_asm)]: 
   12.51 +  "unique l --> (k, x) : set l --> map_of l k = Some x"
   12.52 +apply (induct_tac "l")
   12.53 +apply  auto
   12.54 +done
   12.55 +
   12.56 +lemma Ball_set_table_: 
   12.57 +  "(\\<forall>(x,y)\\<in>set l. P x y) --> (\\<forall>x. \\<forall>y. map_of l x = Some y --> P x y)"
   12.58 +apply(induct_tac "l")
   12.59 +apply(simp_all (no_asm))
   12.60 +apply safe
   12.61 +apply auto
   12.62 +done
   12.63 +lemmas Ball_set_table = Ball_set_table_ [THEN mp];
   12.64 +
   12.65 +lemma table_of_remap_SomeD [rule_format (no_asm)]: 
   12.66 +"map_of (map (\<lambda>((k,k'),x). (k,(k',x))) t) k = Some (k',x) --> 
   12.67 + map_of t (k, k') = Some x"
   12.68 +apply (induct_tac "t")
   12.69 +apply  auto
   12.70 +done
   12.71 +
   12.72  end
   12.73 +
    13.1 --- a/src/HOL/MicroJava/J/JTypeSafe.ML	Thu Feb 01 20:51:48 2001 +0100
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,330 +0,0 @@
    13.4 -(*  Title:      HOL/MicroJava/J/JTypeSafe.ML
    13.5 -    ID:         $Id$
    13.6 -    Author:     David von Oheimb
    13.7 -    Copyright   1999 Technische Universitaet Muenchen
    13.8 -
    13.9 -Type safety proof
   13.10 -*)
   13.11 -
   13.12 -
   13.13 -
   13.14 -Addsimps [split_beta];
   13.15 -
   13.16 -Goal "[|h a = None; (h, l)::\\<preceq>(G, lT); wf_prog wf_mb G; is_class G C|] ==> \
   13.17 -\ (h(a\\<mapsto>(C,(init_vars (fields (G,C))))), l)::\\<preceq>(G, lT)";
   13.18 -by( etac conforms_upd_obj 1);
   13.19 -by(  rewtac oconf_def);
   13.20 -by(  auto_tac (claset() addSDs [fields_is_type], simpset()));
   13.21 -qed "NewC_conforms";
   13.22 - 
   13.23 -Goalw [cast_ok_def]
   13.24 - "[| wf_prog wf_mb G; G,h\\<turnstile>v::\\<preceq>Class C; G\\<turnstile>C\\<preceq>? D; cast_ok G D h v|] \
   13.25 -\ ==> G,h\\<turnstile>v::\\<preceq>Class D";
   13.26 -by( case_tac "v = Null" 1);
   13.27 -by(  Asm_full_simp_tac 1);
   13.28 -by(  dtac widen_RefT 1);
   13.29 -by(  Clarify_tac 1);
   13.30 -by( datac non_npD 1 1);
   13.31 -by( auto_tac (claset() addSIs [conf_AddrI], simpset() addsimps [obj_ty_def]));
   13.32 -qed "Cast_conf";
   13.33 -
   13.34 -Goal "[| wf_prog wf_mb G; field (G,C) fn = Some (fd, ft); (h,l)::\\<preceq>(G,lT); \
   13.35 -\ x' = None --> G,h\\<turnstile>a'::\\<preceq> Class C; np a' x' = None |] ==> \
   13.36 -\ G,h\\<turnstile>the (snd (the (h (the_Addr a'))) (fn, fd))::\\<preceq>ft";
   13.37 -by( dtac np_NoneD 1);
   13.38 -by( etac conjE 1);
   13.39 -by( mp_tac 1);
   13.40 -by( dtac non_np_objD 1);
   13.41 -by   Auto_tac;
   13.42 -by( dtac (conforms_heapD RS hconfD) 1);
   13.43 -by(  atac 1);
   13.44 -by( datac widen_cfs_fields 2 1);
   13.45 -by( datac oconf_objD 1 1);
   13.46 -by Auto_tac;
   13.47 -qed "FAcc_type_sound";
   13.48 -
   13.49 -Goal
   13.50 - "[| wf_prog wf_mb G; a = the_Addr a'; (c, fs) = the (h a); \
   13.51 -\   (G, lT)\\<turnstile>v::T'; G\\<turnstile>T'\\<preceq>ft; \
   13.52 -\   (G, lT)\\<turnstile>aa::Class C; \
   13.53 -\   field (G,C) fn = Some (fd, ft); h''\\<le>|h'; \
   13.54 -\   x' = None --> G,h'\\<turnstile>a'::\\<preceq> Class C; h'\\<le>|h; \
   13.55 -\   (h, l)::\\<preceq>(G, lT); G,h\\<turnstile>x::\\<preceq>T'; np a' x' = None|] ==> \
   13.56 -\ h''\\<le>|h(a\\<mapsto>(c,(fs((fn,fd)\\<mapsto>x)))) \\<and>  \
   13.57 -\ (h(a\\<mapsto>(c,(fs((fn,fd)\\<mapsto>x)))), l)::\\<preceq>(G, lT) \\<and>  \
   13.58 -\ G,h(a\\<mapsto>(c,(fs((fn,fd)\\<mapsto>x))))\\<turnstile>x::\\<preceq>T'";
   13.59 -by( dtac np_NoneD 1);
   13.60 -by( etac conjE 1);
   13.61 -by( Asm_full_simp_tac 1);
   13.62 -by( dtac non_np_objD 1);
   13.63 -by(   atac 1);
   13.64 -by(  SELECT_GOAL Auto_tac 1);
   13.65 -by( Clarify_tac 1);
   13.66 -by( Full_simp_tac 1);
   13.67 -by( EVERY [ftac hext_objD 1, atac 1]);
   13.68 -by( etac exE 1);
   13.69 -by( Asm_full_simp_tac 1);
   13.70 -by( Clarify_tac 1);
   13.71 -by( rtac conjI 1);
   13.72 -by(  fast_tac (HOL_cs addEs [hext_trans, hext_upd_obj]) 1);
   13.73 -by( rtac conjI 1);
   13.74 -by(  fast_tac (HOL_cs addEs [conf_upd_obj RS iffD2]) 2);
   13.75 -
   13.76 -by( rtac conforms_upd_obj 1);
   13.77 -by   Auto_tac;
   13.78 -by(  rtac hextI 2);
   13.79 -by(  Force_tac 2);
   13.80 -by( rtac oconf_hext 1);
   13.81 -by(  etac hext_upd_obj 2);
   13.82 -by( dtac widen_cfs_fields 1);
   13.83 -by(   atac 1);
   13.84 -by(  atac 1);
   13.85 -by( rtac (oconf_obj RS iffD2) 1);
   13.86 -by( Simp_tac 1);
   13.87 -by( strip_tac 1);
   13.88 -by( case_tac "(aaa, b) = (fn, fd)" 1);
   13.89 -by(  Asm_full_simp_tac 1);
   13.90 -by(  fast_tac (HOL_cs addIs [conf_widen]) 1);
   13.91 -by( fast_tac (HOL_cs addDs [conforms_heapD RS hconfD, oconf_objD]) 1);
   13.92 -qed "FAss_type_sound";
   13.93 -
   13.94 -Goalw [wf_mhead_def] "[| wf_prog wf_mb G; list_all2 (conf G h) pvs pTs; \
   13.95 - \ list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') pTs pTs'; wf_mhead G (mn,pTs') rT; \
   13.96 -\ length pTs' = length pns; nodups pns; \
   13.97 -\ Ball (set lvars) (split (\\<lambda>vn. is_type G)) \
   13.98 -\ |] ==> G,h\\<turnstile>init_vars lvars(pns[\\<mapsto>]pvs)[::\\<preceq>]map_of lvars(pns[\\<mapsto>]pTs')";
   13.99 -by( Clarsimp_tac 1);
  13.100 -by( rtac lconf_ext_list 1);
  13.101 -by(    rtac (Ball_set_table RS lconf_init_vars) 1);
  13.102 -by(    Force_tac 1);
  13.103 -by(   atac 1);
  13.104 -by(  atac 1);
  13.105 -by( (etac conf_list_gext_widen THEN_ALL_NEW atac) 1);
  13.106 -qed "Call_lemma2";
  13.107 -
  13.108 -Goalw [wf_java_prog_def]
  13.109 - "[| wf_java_prog G; a' \\<noteq> Null; (h, l)::\\<preceq>(G, lT); class G C = Some y; \
  13.110 -\    max_spec G C (mn,pTsa) = {((mda,rTa),pTs')}; xc\\<le>|xh; xh\\<le>|h; \
  13.111 -\    list_all2 (conf G h) pvs pTsa;\
  13.112 -\    (md, rT, pns, lvars, blk, res) = \
  13.113 -\              the (method (G,fst (the (h (the_Addr a')))) (mn, pTs'));\
  13.114 -\ \\<forall>lT. (h, init_vars lvars(pns[\\<mapsto>]pvs)(This\\<mapsto>a'))::\\<preceq>(G, lT) --> \
  13.115 -\ (G, lT)\\<turnstile>blk\\<surd> -->  h\\<le>|xi \\<and>  (xi, xl)::\\<preceq>(G, lT); \
  13.116 -\ \\<forall>lT. (xi, xl)::\\<preceq>(G, lT) --> (\\<forall>T. (G, lT)\\<turnstile>res::T --> \
  13.117 -\         xi\\<le>|h' \\<and> (h', xj)::\\<preceq>(G, lT) \\<and> (x' = None --> G,h'\\<turnstile>v::\\<preceq>T)); \
  13.118 -\ G,xh\\<turnstile>a'::\\<preceq> Class C |] ==> \
  13.119 -\ xc\\<le>|h' \\<and> (h', l)::\\<preceq>(G, lT) \\<and>  (x' = None --> G,h'\\<turnstile>v::\\<preceq>rTa)";
  13.120 -by( dtac max_spec2mheads 1);
  13.121 -by( Clarify_tac 1);
  13.122 -by( datac non_np_objD' 2 1);
  13.123 -by(  Clarsimp_tac 1);
  13.124 -by( Clarsimp_tac 1);
  13.125 -by( EVERY'[ftac hext_objD, atac] 1);
  13.126 -by( Clarsimp_tac 1);
  13.127 -by( datac Call_lemma 3 1);
  13.128 -by( clarsimp_tac (claset(),simpset() addsimps [wf_java_mdecl_def])1);
  13.129 -by( thin_tac "method ?sig ?x = ?y" 1);
  13.130 -by( EVERY'[dtac spec, etac impE] 1);
  13.131 -by(  mp_tac 2);
  13.132 -by(  rtac conformsI 1);
  13.133 -by(   etac conforms_heapD 1);
  13.134 -by(  rtac lconf_ext 1);
  13.135 -by(   force_tac (claset() addSEs [Call_lemma2],simpset()) 1);
  13.136 -by(  EVERY'[etac conf_hext, etac conf_obj_AddrI, atac] 1);
  13.137 -by( thin_tac "?E\\<turnstile>?blk\\<surd>" 1);
  13.138 -by( etac conjE 1);
  13.139 -by( EVERY'[dtac spec, mp_tac] 1);
  13.140 -(*by( thin_tac "?E::\\<preceq>(G, pT')" 1);*)
  13.141 -by( EVERY'[dtac spec, mp_tac] 1);
  13.142 -by( thin_tac "?E\\<turnstile>res::?rT" 1);
  13.143 -by( Clarify_tac 1);
  13.144 -by( rtac conjI 1);
  13.145 -by(  fast_tac (HOL_cs addIs [hext_trans]) 1);
  13.146 -by( rtac conjI 1);
  13.147 -by(  rtac impI 2);
  13.148 -by(  mp_tac 2);
  13.149 -by(  forward_tac [conf_widen] 2);
  13.150 -by(    atac 4);
  13.151 -by(   atac 2);
  13.152 -by(  fast_tac (HOL_cs addSEs [widen_trans]) 2);
  13.153 -by( etac conforms_hext 1);
  13.154 -by(  etac hext_trans 1);
  13.155 -by(  atac 1);
  13.156 -by( etac conforms_heapD 1);
  13.157 -qed "Call_type_sound";
  13.158 -
  13.159 -
  13.160 -
  13.161 -Unify.search_bound := 40;
  13.162 -Unify.trace_bound  := 40;
  13.163 -Delsplits[split_if];
  13.164 -Delsimps[fun_upd_apply];
  13.165 -Addsimps[fun_upd_same];
  13.166 -val forward_hyp_tac = ALLGOALS (TRY o (EVERY' [dtac spec, mp_tac,
  13.167 -	(mp_tac ORELSE' (dtac spec THEN' mp_tac)), REPEAT o (etac conjE)]));
  13.168 -Goal
  13.169 -"wf_java_prog G ==> \
  13.170 -\ (G\\<turnstile>(x,(h,l)) -e  \\<succ>v  -> (x', (h',l')) --> \
  13.171 -\     (\\<forall>lT.    (h ,l )::\\<preceq>(G,lT) --> (\\<forall>T . (G,lT)\\<turnstile>e  :: T --> \
  13.172 -\     h\\<le>|h' \\<and> (h',l')::\\<preceq>(G,lT) \\<and> (x'=None --> G,h'\\<turnstile>v  ::\\<preceq> T )))) \\<and> \
  13.173 -\ (G\\<turnstile>(x,(h,l)) -es[\\<succ>]vs-> (x', (h',l')) --> \
  13.174 -\     (\\<forall>lT.    (h ,l )::\\<preceq>(G,lT) --> (\\<forall>Ts. (G,lT)\\<turnstile>es[::]Ts --> \
  13.175 -\     h\\<le>|h' \\<and> (h',l')::\\<preceq>(G,lT) \\<and> (x'=None --> list_all2 (\\<lambda>v T. G,h'\\<turnstile>v::\\<preceq>T) vs Ts)))) \\<and> \
  13.176 -\ (G\\<turnstile>(x,(h,l)) -c       -> (x', (h',l')) --> \
  13.177 -\     (\\<forall>lT.    (h ,l )::\\<preceq>(G,lT) -->       (G,lT)\\<turnstile>c  \\<surd> --> \
  13.178 -\     h\\<le>|h' \\<and> (h',l')::\\<preceq>(G,lT)))";
  13.179 -by( rtac eval_evals_exec_induct 1);
  13.180 -by( rewtac c_hupd_def);
  13.181 -
  13.182 -(* several simplifications, XcptE, XcptEs, XcptS, Skip, Nil?? *)
  13.183 -by( ALLGOALS Asm_full_simp_tac);
  13.184 -by( ALLGOALS strip_tac);
  13.185 -by( ALLGOALS (eresolve_tac ty_expr_ty_exprs_wt_stmt.elims 
  13.186 -		THEN_ALL_NEW Full_simp_tac));
  13.187 -by( ALLGOALS (EVERY' [REPEAT o (etac conjE), REPEAT o hyp_subst_tac]));
  13.188 -by( rewtac wf_java_prog_def);
  13.189 -
  13.190 -(* Level 7 *)
  13.191 -
  13.192 -(* 15 NewC *)
  13.193 -by( dtac new_AddrD 1);
  13.194 -by( etac disjE 1);
  13.195 -by(  Asm_simp_tac 2);
  13.196 -by( Clarsimp_tac 1);
  13.197 -by( rtac conjI 1);
  13.198 -by(  force_tac (claset() addSEs [NewC_conforms],simpset()) 1);
  13.199 -by( rtac conf_obj_AddrI 1);
  13.200 -by(  rtac rtrancl_refl 2);
  13.201 -by( Simp_tac 1);
  13.202 -
  13.203 -(* for Cast *)
  13.204 -by( defer_tac 1);
  13.205 -
  13.206 -(* 14 Lit *)
  13.207 -by( etac conf_litval 1);
  13.208 -
  13.209 -(* 13 BinOp *)
  13.210 -by forward_hyp_tac;
  13.211 -by forward_hyp_tac;
  13.212 -by( EVERY'[rtac conjI, eatac hext_trans 1] 1);
  13.213 -by( etac conjI 1);
  13.214 -by( Clarsimp_tac 1);
  13.215 -by( dtac eval_no_xcpt 1);
  13.216 -by( asm_full_simp_tac (simpset() addsplits [binop.split]) 1);
  13.217 -
  13.218 -(* 12 LAcc *)
  13.219 -by( fast_tac (claset() addEs [conforms_localD RS lconfD]) 1);
  13.220 -
  13.221 -(* for FAss *)
  13.222 -by( EVERY'[eresolve_tac ty_expr_ty_exprs_wt_stmt.elims THEN_ALL_NEW Full_simp_tac, 
  13.223 -			REPEAT o (etac conjE), hyp_subst_tac] 3);
  13.224 -
  13.225 -(* for if *)
  13.226 -by( (case_tac "the_Bool v" THEN_ALL_NEW Asm_full_simp_tac) 8);
  13.227 -
  13.228 -by forward_hyp_tac;
  13.229 -
  13.230 -(* 11+1 if *)
  13.231 -by(  fast_tac (HOL_cs addIs [hext_trans]) 8);
  13.232 -by( fast_tac (HOL_cs addIs [hext_trans]) 8);
  13.233 -
  13.234 -(* 10 Expr *)
  13.235 -by( Fast_tac 6);
  13.236 -
  13.237 -(* 9 ??? *)
  13.238 -by( ALLGOALS Asm_full_simp_tac);
  13.239 -
  13.240 -(* 8 Cast *)
  13.241 -by( EVERY'[rtac impI, dtac raise_if_NoneD, Clarsimp_tac, 
  13.242 -           fast_tac (claset() addEs [Cast_conf])] 8);
  13.243 -
  13.244 -(* 7 LAss *)
  13.245 -by( asm_simp_tac (simpset() addsplits [split_if]) 1);
  13.246 -by( EVERY'[eresolve_tac ty_expr_ty_exprs_wt_stmt.elims THEN_ALL_NEW Full_simp_tac] 1);
  13.247 -by( blast_tac (claset() addIs [conforms_upd_local, conf_widen]) 1);
  13.248 -
  13.249 -(* 6 FAcc *)
  13.250 -by( fast_tac (claset() addSEs [FAcc_type_sound]) 1);
  13.251 -
  13.252 -(* 5 While *)
  13.253 -by(thin_tac "?a \\<longrightarrow> ?b" 5);
  13.254 -by(datac ty_expr_ty_exprs_wt_stmt.Loop 1 5);
  13.255 -by(force_tac (claset() addEs [hext_trans], simpset()) 5);
  13.256 -
  13.257 -by forward_hyp_tac;
  13.258 -
  13.259 -(* 4 Cons *)
  13.260 -by( fast_tac (claset() addDs [evals_no_xcpt] addIs [conf_hext,hext_trans]) 3);
  13.261 -
  13.262 -(* 3 ;; *)
  13.263 -by( fast_tac (claset() addIs [hext_trans]) 3);
  13.264 -
  13.265 -(* 2 FAss *)
  13.266 -by( case_tac "x2 = None" 1);
  13.267 -by(  Asm_simp_tac 2);
  13.268 -by(  fast_tac (claset() addIs [hext_trans]) 2);
  13.269 -by( Asm_full_simp_tac 1);
  13.270 -by( dtac eval_no_xcpt 1);
  13.271 -by( SELECT_GOAL (etac FAss_type_sound 1 THEN rtac refl 1 THEN ALLGOALS atac) 1);
  13.272 -
  13.273 -by prune_params_tac;
  13.274 -(* Level 52 *)
  13.275 -
  13.276 -(* 1 Call *)
  13.277 -by( case_tac "x" 1);
  13.278 -by(  Clarsimp_tac 2);
  13.279 -by(  dtac exec_xcpt 2);
  13.280 -by(  Asm_full_simp_tac 2);
  13.281 -by(  dtac eval_xcpt 2);
  13.282 -by(  Asm_full_simp_tac 2);
  13.283 -by(  fast_tac (HOL_cs addEs [hext_trans]) 2);
  13.284 -by( Clarify_tac 1);
  13.285 -by( dtac evals_no_xcpt 1);
  13.286 -by( Asm_full_simp_tac 1);
  13.287 -by( case_tac "a' = Null" 1);
  13.288 -by(  Asm_full_simp_tac 1);
  13.289 -by(  dtac exec_xcpt 1);
  13.290 -by(  Asm_full_simp_tac 1);
  13.291 -by(  dtac eval_xcpt 1);
  13.292 -by(  Asm_full_simp_tac 1);
  13.293 -by(  fast_tac (HOL_cs addEs [hext_trans]) 1);
  13.294 -by( datac ty_expr_is_type 1 1);
  13.295 -by(Clarsimp_tac 1);
  13.296 -by(rewtac is_class_def);
  13.297 -by(Clarsimp_tac 1);
  13.298 -by( (rtac (rewrite_rule [wf_java_prog_def] Call_type_sound) 
  13.299 -    THEN_ALL_NEW Asm_simp_tac) 1);
  13.300 -qed "eval_evals_exec_type_sound";
  13.301 -
  13.302 -Goal "!!E s s'. \
  13.303 -\ [| G=prg E; wf_java_prog G; G\\<turnstile>(x,s) -e\\<succ>v -> (x',s'); s::\\<preceq>E; E\\<turnstile>e::T |] \
  13.304 -\ ==> s'::\\<preceq>E \\<and> (x'=None --> G,heap s'\\<turnstile>v::\\<preceq>T)";
  13.305 -by( split_all_tac 1);
  13.306 -bd (eval_evals_exec_type_sound RS conjunct1 RS mp RS spec RS mp) 1;
  13.307 -by Auto_tac;
  13.308 -qed "eval_type_sound";
  13.309 -
  13.310 -Goal "!!E s s'. \
  13.311 -\ [| G=prg E; wf_java_prog G; G\\<turnstile>(x,s) -s0-> (x',s'); s::\\<preceq>E; E\\<turnstile>s0\\<surd> |] \
  13.312 -\ ==> s'::\\<preceq>E";
  13.313 -by( split_all_tac 1);
  13.314 -bd (eval_evals_exec_type_sound RS conjunct2 RS conjunct2 RS mp RS spec RS mp) 1;
  13.315 -by   Auto_tac;
  13.316 -qed "exec_type_sound";
  13.317 -
  13.318 -Goal "[|G=prg E; wf_java_prog G; G\\<turnstile>(x,s) -e\\<succ>a'-> Norm s'; a' \\<noteq> Null;\
  13.319 -\         s::\\<preceq>E; E\\<turnstile>e::Class C; method (G,C) sig \\<noteq> None|] ==> \
  13.320 -\ method (G,fst (the (heap s' (the_Addr a')))) sig \\<noteq> None";
  13.321 -by( datac eval_type_sound 4 1);
  13.322 -by(Clarsimp_tac 1);
  13.323 -by(rewtac wf_java_prog_def);
  13.324 -by( forward_tac [widen_methd] 1);
  13.325 -by(   atac 1);
  13.326 -by(  Fast_tac 2);
  13.327 -by( dtac non_npD 1);
  13.328 -by Auto_tac;
  13.329 -qed "all_methods_understood";
  13.330 -
  13.331 -Delsimps [split_beta];
  13.332 -Addsimps[fun_upd_apply];
  13.333 -
    14.1 --- a/src/HOL/MicroJava/J/JTypeSafe.thy	Thu Feb 01 20:51:48 2001 +0100
    14.2 +++ b/src/HOL/MicroJava/J/JTypeSafe.thy	Thu Feb 01 20:53:13 2001 +0100
    14.3 @@ -3,7 +3,357 @@
    14.4      Author:     David von Oheimb
    14.5      Copyright   1999 Technische Universitaet Muenchen
    14.6  
    14.7 -Type Safety of Java
    14.8 +Type Safety Proof for MicroJava
    14.9  *)
   14.10  
   14.11 -JTypeSafe = Eval + Conform
   14.12 +theory JTypeSafe = Eval + Conform:
   14.13 +
   14.14 +declare split_beta [simp]
   14.15 +
   14.16 +lemma NewC_conforms: 
   14.17 +"[|h a = None; (h, l)::\<preceq>(G, lT); wf_prog wf_mb G; is_class G C|] ==>  
   14.18 +  (h(a\<mapsto>(C,(init_vars (fields (G,C))))), l)::\<preceq>(G, lT)"
   14.19 +apply( erule conforms_upd_obj)
   14.20 +apply(  unfold oconf_def)
   14.21 +apply(  auto dest!: fields_is_type)
   14.22 +done
   14.23 + 
   14.24 +lemma Cast_conf: 
   14.25 + "[| wf_prog wf_mb G; G,h\<turnstile>v::\<preceq>Class C; G\<turnstile>C\<preceq>? D; cast_ok G D h v|]  
   14.26 +  ==> G,h\<turnstile>v::\<preceq>Class D" 
   14.27 +apply (unfold cast_ok_def)
   14.28 +apply( case_tac "v = Null")
   14.29 +apply(  simp)
   14.30 +apply(  drule widen_RefT)
   14.31 +apply(  clarify)
   14.32 +apply( drule (1) non_npD)
   14.33 +apply( auto intro!: conf_AddrI simp add: obj_ty_def)
   14.34 +done
   14.35 +
   14.36 +lemma FAcc_type_sound: 
   14.37 +"[| wf_prog wf_mb G; field (G,C) fn = Some (fd, ft); (h,l)::\<preceq>(G,lT);  
   14.38 +  x' = None --> G,h\<turnstile>a'::\<preceq> Class C; np a' x' = None |] ==>  
   14.39 +  G,h\<turnstile>the (snd (the (h (the_Addr a'))) (fn, fd))::\<preceq>ft"
   14.40 +apply( drule np_NoneD)
   14.41 +apply( erule conjE)
   14.42 +apply( erule (1) notE impE)
   14.43 +apply( drule non_np_objD)
   14.44 +apply   auto
   14.45 +apply( drule conforms_heapD [THEN hconfD])
   14.46 +apply(  assumption)
   14.47 +apply( drule (2) widen_cfs_fields)
   14.48 +apply( drule (1) oconf_objD)
   14.49 +apply auto
   14.50 +done
   14.51 +
   14.52 +lemma FAss_type_sound: 
   14.53 + "[| wf_prog wf_mb G; a = the_Addr a'; (c, fs) = the (h a);  
   14.54 +    (G, lT)\<turnstile>v::T'; G\<turnstile>T'\<preceq>ft;  
   14.55 +    (G, lT)\<turnstile>aa::Class C;  
   14.56 +    field (G,C) fn = Some (fd, ft); h''\<le>|h';  
   14.57 +    x' = None --> G,h'\<turnstile>a'::\<preceq> Class C; h'\<le>|h;  
   14.58 +    (h, l)::\<preceq>(G, lT); G,h\<turnstile>x::\<preceq>T'; np a' x' = None|] ==>  
   14.59 +  h''\<le>|h(a\<mapsto>(c,(fs((fn,fd)\<mapsto>x)))) \<and>   
   14.60 +  (h(a\<mapsto>(c,(fs((fn,fd)\<mapsto>x)))), l)::\<preceq>(G, lT) \<and>   
   14.61 +  G,h(a\<mapsto>(c,(fs((fn,fd)\<mapsto>x))))\<turnstile>x::\<preceq>T'"
   14.62 +apply( drule np_NoneD)
   14.63 +apply( erule conjE)
   14.64 +apply( simp)
   14.65 +apply( drule non_np_objD)
   14.66 +apply(   assumption)
   14.67 +apply(  force)
   14.68 +apply( clarify)
   14.69 +apply( simp (no_asm_use))
   14.70 +apply( frule (1) hext_objD)
   14.71 +apply( erule exE)
   14.72 +apply( simp)
   14.73 +apply( clarify)
   14.74 +apply( rule conjI)
   14.75 +apply(  fast elim: hext_trans hext_upd_obj)
   14.76 +apply( rule conjI)
   14.77 +prefer 2
   14.78 +apply(  fast elim: conf_upd_obj [THEN iffD2])
   14.79 +
   14.80 +apply( rule conforms_upd_obj)
   14.81 +apply   auto
   14.82 +apply(  rule_tac [2] hextI)
   14.83 +prefer 2
   14.84 +apply(  force)
   14.85 +apply( rule oconf_hext)
   14.86 +apply(  erule_tac [2] hext_upd_obj)
   14.87 +apply( drule (2) widen_cfs_fields)
   14.88 +apply( rule oconf_obj [THEN iffD2])
   14.89 +apply( simp (no_asm))
   14.90 +apply( intro strip)
   14.91 +apply( case_tac "(aaa, b) = (fn, fd)")
   14.92 +apply(  simp)
   14.93 +apply(  fast intro: conf_widen)
   14.94 +apply( fast dest: conforms_heapD [THEN hconfD] oconf_objD)
   14.95 +done
   14.96 +
   14.97 +lemma Call_lemma2: "[| wf_prog wf_mb G; list_all2 (conf G h) pvs pTs;  
   14.98 +   list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') pTs pTs'; wf_mhead G (mn,pTs') rT;  
   14.99 +  length pTs' = length pns; nodups pns;  
  14.100 +  Ball (set lvars) (split (\<lambda>vn. is_type G))  
  14.101 +  |] ==> G,h\<turnstile>init_vars lvars(pns[\<mapsto>]pvs)[::\<preceq>]map_of lvars(pns[\<mapsto>]pTs')"
  14.102 +apply (unfold wf_mhead_def)
  14.103 +apply( clarsimp)
  14.104 +apply( rule lconf_ext_list)
  14.105 +apply(    rule Ball_set_table [THEN lconf_init_vars])
  14.106 +apply(    force)
  14.107 +apply(   assumption)
  14.108 +apply(  assumption)
  14.109 +apply( erule (2) conf_list_gext_widen)
  14.110 +done
  14.111 +
  14.112 +lemma Call_type_sound: 
  14.113 + "[| wf_java_prog G; a' \<noteq> Null; (h, l)::\<preceq>(G, lT); class G C = Some y;  
  14.114 +     max_spec G C (mn,pTsa) = {((mda,rTa),pTs')}; xc\<le>|xh; xh\<le>|h;  
  14.115 +     list_all2 (conf G h) pvs pTsa; 
  14.116 +     (md, rT, pns, lvars, blk, res) =  
  14.117 +               the (method (G,fst (the (h (the_Addr a')))) (mn, pTs')); 
  14.118 +  \<forall>lT. (h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))::\<preceq>(G, lT) -->  
  14.119 +  (G, lT)\<turnstile>blk\<surd> -->  h\<le>|xi \<and>  (xi, xl)::\<preceq>(G, lT);  
  14.120 +  \<forall>lT. (xi, xl)::\<preceq>(G, lT) --> (\<forall>T. (G, lT)\<turnstile>res::T -->  
  14.121 +          xi\<le>|h' \<and> (h', xj)::\<preceq>(G, lT) \<and> (x' = None --> G,h'\<turnstile>v::\<preceq>T));  
  14.122 +  G,xh\<turnstile>a'::\<preceq> Class C |] ==>  
  14.123 +  xc\<le>|h' \<and> (h', l)::\<preceq>(G, lT) \<and>  (x' = None --> G,h'\<turnstile>v::\<preceq>rTa)"
  14.124 +apply (unfold wf_java_prog_def)
  14.125 +apply( drule max_spec2mheads)
  14.126 +apply( clarify)
  14.127 +apply( drule (2) non_np_objD')
  14.128 +apply(  clarsimp)
  14.129 +apply( clarsimp)
  14.130 +apply( frule (1) hext_objD)
  14.131 +apply( clarsimp)
  14.132 +apply( drule (3) Call_lemma)
  14.133 +apply( clarsimp simp add: wf_java_mdecl_def)
  14.134 +apply( erule_tac V = "method ?sig ?x = ?y" in thin_rl)
  14.135 +apply( drule spec, erule impE)
  14.136 +apply(  erule_tac [2] notE impE, tactic "assume_tac 2")
  14.137 +apply(  rule conformsI)
  14.138 +apply(   erule conforms_heapD)
  14.139 +apply(  rule lconf_ext)
  14.140 +apply(   force elim!: Call_lemma2)
  14.141 +apply(  erule conf_hext, erule (1) conf_obj_AddrI)
  14.142 +apply( erule_tac V = "?E\<turnstile>?blk\<surd>" in thin_rl)
  14.143 +apply( erule conjE)
  14.144 +apply( drule spec, erule (1) impE)
  14.145 +apply( drule spec, erule (1) impE)
  14.146 +apply( erule_tac V = "?E\<turnstile>res::?rT" in thin_rl)
  14.147 +apply( clarify)
  14.148 +apply( rule conjI)
  14.149 +apply(  fast intro: hext_trans)
  14.150 +apply( rule conjI)
  14.151 +apply(  rule_tac [2] impI)
  14.152 +apply(  erule_tac [2] notE impE, tactic "assume_tac 2")
  14.153 +apply(  frule_tac [2] conf_widen)
  14.154 +apply(    tactic "assume_tac 4")
  14.155 +apply(   tactic "assume_tac 2")
  14.156 +prefer 2
  14.157 +apply(  fast elim!: widen_trans)
  14.158 +apply( erule conforms_hext)
  14.159 +apply(  erule (1) hext_trans)
  14.160 +apply( erule conforms_heapD)
  14.161 +done
  14.162 +
  14.163 +declare split_if [split del]
  14.164 +declare fun_upd_apply [simp del]
  14.165 +declare fun_upd_same [simp]
  14.166 +ML{*
  14.167 +val forward_hyp_tac = ALLGOALS (TRY o (EVERY' [dtac spec, mp_tac,
  14.168 +	(mp_tac ORELSE' (dtac spec THEN' mp_tac)), REPEAT o (etac conjE)]))
  14.169 +*}
  14.170 +ML{*
  14.171 +Unify.search_bound := 40;
  14.172 +Unify.trace_bound  := 40
  14.173 +*}
  14.174 +theorem eval_evals_exec_type_sound: 
  14.175 +"wf_java_prog G ==>  
  14.176 +  (G\<turnstile>(x,(h,l)) -e  \<succ>v  -> (x', (h',l')) -->  
  14.177 +      (\<forall>lT.   (h ,l )::\<preceq>(G,lT) --> (\<forall>T . (G,lT)\<turnstile>e  :: T -->  
  14.178 +      h\<le>|h' \<and> (h',l')::\<preceq>(G,lT) \<and> (x'=None --> G,h'\<turnstile>v  ::\<preceq> T )))) \<and>  
  14.179 +  (G\<turnstile>(x,(h,l)) -es[\<succ>]vs-> (x', (h',l')) -->  
  14.180 +      (\<forall>lT.   (h ,l )::\<preceq>(G,lT) --> (\<forall>Ts. (G,lT)\<turnstile>es[::]Ts -->  
  14.181 +      h\<le>|h' \<and> (h',l')::\<preceq>(G,lT) \<and> (x'=None --> list_all2 (\<lambda>v T. G,h'\<turnstile>v::\<preceq>T) vs Ts)))) \<and>  
  14.182 +  (G\<turnstile>(x,(h,l)) -c       -> (x', (h',l')) -->  
  14.183 +      (\<forall>lT.   (h ,l )::\<preceq>(G,lT) -->       (G,lT)\<turnstile>c  \<surd> -->  
  14.184 +      h\<le>|h' \<and> (h',l')::\<preceq>(G,lT)))"
  14.185 +apply( rule eval_evals_exec_induct)
  14.186 +apply( unfold c_hupd_def)
  14.187 +
  14.188 +(* several simplifications, XcptE, XcptEs, XcptS, Skip, Nil?? *)
  14.189 +apply( simp_all)
  14.190 +apply( tactic "ALLGOALS strip_tac")
  14.191 +apply( tactic {* ALLGOALS (eresolve_tac (thms "ty_expr_ty_exprs_wt_stmt.elims") THEN_ALL_NEW Full_simp_tac) *})
  14.192 +apply( tactic "ALLGOALS (EVERY' [REPEAT o (etac conjE), REPEAT o hyp_subst_tac])")
  14.193 +apply( unfold wf_java_prog_def)
  14.194 +
  14.195 +(* Level 7 *)
  14.196 +
  14.197 +(* 15 NewC *)
  14.198 +apply( drule new_AddrD)
  14.199 +apply( erule disjE)
  14.200 +prefer 2
  14.201 +apply(  simp (no_asm_simp))
  14.202 +apply( clarsimp)
  14.203 +apply( rule conjI)
  14.204 +apply(  force elim!: NewC_conforms)
  14.205 +apply( rule conf_obj_AddrI)
  14.206 +apply(  rule_tac [2] rtrancl_refl)
  14.207 +apply( simp (no_asm))
  14.208 +
  14.209 +(* for Cast *)
  14.210 +defer 1
  14.211 +
  14.212 +(* 14 Lit *)
  14.213 +apply( erule conf_litval)
  14.214 +
  14.215 +(* 13 BinOp *)
  14.216 +apply (tactic "forward_hyp_tac")
  14.217 +apply (tactic "forward_hyp_tac")
  14.218 +apply( rule conjI, erule (1) hext_trans)
  14.219 +apply( erule conjI)
  14.220 +apply( clarsimp)
  14.221 +apply( drule eval_no_xcpt)
  14.222 +apply( simp split add: binop.split)
  14.223 +
  14.224 +(* 12 LAcc *)
  14.225 +apply( fast elim: conforms_localD [THEN lconfD])
  14.226 +
  14.227 +(* for FAss *)
  14.228 +apply( tactic {* EVERY'[eresolve_tac (thms "ty_expr_ty_exprs_wt_stmt.elims") THEN_ALL_NEW Full_simp_tac, REPEAT o (etac conjE), hyp_subst_tac] 3*})
  14.229 +
  14.230 +(* for if *)
  14.231 +apply( tactic {* (case_tac "the_Bool v" THEN_ALL_NEW Asm_full_simp_tac) 8*})
  14.232 +
  14.233 +apply (tactic "forward_hyp_tac")
  14.234 +
  14.235 +(* 11+1 if *)
  14.236 +prefer 8
  14.237 +apply(  fast intro: hext_trans)
  14.238 +prefer 8
  14.239 +apply(  fast intro: hext_trans)
  14.240 +
  14.241 +(* 10 Expr *)
  14.242 +prefer 6
  14.243 +apply( fast)
  14.244 +
  14.245 +(* 9 ??? *)
  14.246 +apply( simp_all)
  14.247 +
  14.248 +(* 8 Cast *)
  14.249 +prefer 8
  14.250 +apply (rule impI)
  14.251 +apply (drule raise_if_NoneD)
  14.252 +apply (clarsimp)
  14.253 +apply (fast elim: Cast_conf)
  14.254 +
  14.255 +(* 7 LAss *)
  14.256 +apply (fold fun_upd_def)
  14.257 +apply( tactic {* (eresolve_tac (thms "ty_expr_ty_exprs_wt_stmt.elims") THEN_ALL_NEW Full_simp_tac) 1 *})
  14.258 +apply( blast intro: conforms_upd_local conf_widen)
  14.259 +
  14.260 +(* 6 FAcc *)
  14.261 +apply( fast elim!: FAcc_type_sound)
  14.262 +
  14.263 +(* 5 While *)
  14.264 +prefer 5
  14.265 +apply(erule_tac V = "?a \<longrightarrow> ?b" in thin_rl)
  14.266 +apply(drule (1) ty_expr_ty_exprs_wt_stmt.Loop)
  14.267 +apply(force elim: hext_trans)
  14.268 +
  14.269 +apply (tactic "forward_hyp_tac")
  14.270 +
  14.271 +(* 4 Cons *)
  14.272 +prefer 3
  14.273 +apply( fast dest: evals_no_xcpt intro: conf_hext hext_trans)
  14.274 +
  14.275 +(* 3 ;; *)
  14.276 +prefer 3
  14.277 +apply( fast intro: hext_trans)
  14.278 +
  14.279 +(* 2 FAss *)
  14.280 +apply( case_tac "x2 = None")
  14.281 +prefer 2
  14.282 +apply(  simp (no_asm_simp))
  14.283 +apply(  fast intro: hext_trans)
  14.284 +apply( simp)
  14.285 +apply( drule eval_no_xcpt)
  14.286 +apply( erule FAss_type_sound, simp (no_asm) (*###rule refl*), assumption+)
  14.287 +
  14.288 +apply( tactic prune_params_tac)
  14.289 +(* Level 52 *)
  14.290 +
  14.291 +(* 1 Call *)
  14.292 +apply( case_tac "x")
  14.293 +prefer 2
  14.294 +apply(  clarsimp)
  14.295 +apply(  drule exec_xcpt)
  14.296 +apply(  simp)
  14.297 +apply(  drule_tac eval_xcpt)
  14.298 +apply(  simp)
  14.299 +apply(  fast elim: hext_trans)
  14.300 +apply( clarify)
  14.301 +apply( drule evals_no_xcpt)
  14.302 +apply( simp)
  14.303 +apply( case_tac "a' = Null")
  14.304 +apply(  simp)
  14.305 +apply(  drule exec_xcpt)
  14.306 +apply(  simp)
  14.307 +apply(  drule eval_xcpt)
  14.308 +apply(  simp)
  14.309 +apply(  fast elim: hext_trans)
  14.310 +apply( drule (1) ty_expr_is_type)
  14.311 +apply(clarsimp)
  14.312 +apply(unfold is_class_def)
  14.313 +apply(clarsimp)
  14.314 +apply(rule Call_type_sound [unfolded wf_java_prog_def]);
  14.315 +prefer 11
  14.316 +apply blast
  14.317 +apply (simp (no_asm_simp))+
  14.318 +done
  14.319 +ML{*
  14.320 +Unify.search_bound := 20;
  14.321 +Unify.trace_bound  := 20
  14.322 +*}
  14.323 +
  14.324 +lemma eval_type_sound: "!!E s s'.  
  14.325 +  [| G=prg E; wf_java_prog G; G\<turnstile>(x,s) -e\<succ>v -> (x',s'); s::\<preceq>E; E\<turnstile>e::T |]  
  14.326 +  ==> s'::\<preceq>E \<and> (x'=None --> G,heap s'\<turnstile>v::\<preceq>T)"
  14.327 +apply( simp (no_asm_simp) only: split_tupled_all)
  14.328 +apply (drule eval_evals_exec_type_sound 
  14.329 +             [THEN conjunct1, THEN mp, THEN spec, THEN mp])
  14.330 +apply auto
  14.331 +done
  14.332 +
  14.333 +lemma exec_type_sound: "!!E s s'.  
  14.334 +  [| G=prg E; wf_java_prog G; G\<turnstile>(x,s) -s0-> (x',s'); s::\<preceq>E; E\<turnstile>s0\<surd> |]  
  14.335 +  ==> s'::\<preceq>E"
  14.336 +apply( simp (no_asm_simp) only: split_tupled_all)
  14.337 +apply (drule eval_evals_exec_type_sound 
  14.338 +             [THEN conjunct2, THEN conjunct2, THEN mp, THEN spec, THEN mp])
  14.339 +apply   auto
  14.340 +done
  14.341 +
  14.342 +theorem all_methods_understood: 
  14.343 +"[|G=prg E; wf_java_prog G; G\<turnstile>(x,s) -e\<succ>a'-> Norm s'; a' \<noteq> Null; 
  14.344 +          s::\<preceq>E; E\<turnstile>e::Class C; method (G,C) sig \<noteq> None|] ==>  
  14.345 +  method (G,fst (the (heap s' (the_Addr a')))) sig \<noteq> None"
  14.346 +apply( drule (4) eval_type_sound)
  14.347 +apply(clarsimp)
  14.348 +apply(unfold wf_java_prog_def)
  14.349 +apply( frule widen_methd)
  14.350 +apply(   assumption)
  14.351 +prefer 2
  14.352 +apply(  fast)
  14.353 +apply( drule non_npD)
  14.354 +apply auto
  14.355 +done
  14.356 +
  14.357 +declare split_beta [simp del]
  14.358 +declare fun_upd_apply [simp]
  14.359 +
  14.360 +end
  14.361 +
  14.362 +
    15.1 --- a/src/HOL/MicroJava/J/State.ML	Thu Feb 01 20:51:48 2001 +0100
    15.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.3 @@ -1,81 +0,0 @@
    15.4 -(*  Title:      HOL/MicroJava/J/State.ML
    15.5 -    ID:         $Id$
    15.6 -    Author:     David von Oheimb
    15.7 -    Copyright   1999 Technische Universitaet Muenchen
    15.8 -*)
    15.9 -
   15.10 -Goalw [obj_ty_def] "obj_ty (C,fs) = Class C";
   15.11 -by (Simp_tac 1);
   15.12 -qed "obj_ty_def2";
   15.13 -Addsimps [obj_ty_def2];
   15.14 -
   15.15 -Goalw [new_Addr_def] 
   15.16 -"(a,x) = new_Addr h ==> h a = None \\<and> x = None | x = Some OutOfMemory";
   15.17 -by(asm_full_simp_tac (simpset() addsimps [Pair_fst_snd_eq,select_split]) 1);
   15.18 -by(rtac someI 1);
   15.19 -by(rtac disjI2 1);
   15.20 -by(res_inst_tac [("r","snd (?a,Some OutOfMemory)")] trans 1);
   15.21 -by Auto_tac;
   15.22 -qed "new_AddrD";
   15.23 -
   15.24 -
   15.25 -Goalw [raise_if_def] "raise_if True x y \\<noteq> None";
   15.26 -by Auto_tac;
   15.27 -qed "raise_if_True";
   15.28 -
   15.29 -Goalw [raise_if_def] "raise_if False x y = y";
   15.30 -by Auto_tac;
   15.31 -qed "raise_if_False";
   15.32 -
   15.33 -Goalw [raise_if_def] "raise_if c x (Some y) \\<noteq> None";
   15.34 -by Auto_tac;
   15.35 -qed "raise_if_Some";
   15.36 -
   15.37 -Goalw [raise_if_def] "raise_if c z (if x = None then Some y else x) \\<noteq> None";
   15.38 -by(induct_tac "x" 1);
   15.39 -by Auto_tac;
   15.40 -qed "raise_if_Some2";
   15.41 -
   15.42 -Addsimps [raise_if_True,raise_if_False,raise_if_Some,raise_if_Some2];
   15.43 -
   15.44 -Goalw [raise_if_def] 
   15.45 -  "raise_if c x y = Some z \\<longrightarrow> c \\<and>  Some z = Some x |  y = Some z"; 
   15.46 -by Auto_tac;
   15.47 -qed_spec_mp "raise_if_SomeD";
   15.48 -
   15.49 -Goalw [raise_if_def] "raise_if c x y = None --> \\<not> c \\<and>  y = None";
   15.50 -by Auto_tac;
   15.51 -qed_spec_mp "raise_if_NoneD";
   15.52 -
   15.53 -Goalw [np_def, raise_if_def] "np a' x' = None --> x' = None \\<and>  a' \\<noteq> Null"; 
   15.54 -by Auto_tac;
   15.55 -qed_spec_mp "np_NoneD";
   15.56 -
   15.57 -Goalw [np_def, raise_if_def] "a' \\<noteq> Null --> np a' x' = x'";
   15.58 -by Auto_tac;
   15.59 -qed_spec_mp "np_None";
   15.60 -
   15.61 -Goalw [np_def, raise_if_def] "np a' (Some xc) = Some xc";
   15.62 -by Auto_tac;
   15.63 -qed "np_Some";
   15.64 -
   15.65 -Goalw [np_def, raise_if_def] "np Null None = Some NullPointer";
   15.66 -by Auto_tac;
   15.67 -qed "np_Null";
   15.68 -
   15.69 -Goalw [np_def, raise_if_def] "np (Addr a) None = None";
   15.70 -by Auto_tac;
   15.71 -qed "np_Addr";
   15.72 -
   15.73 -Addsimps[np_None, np_Some,np_Null,np_Addr];
   15.74 -
   15.75 -Goalw [raise_if_def] "(np Null (raise_if c xc None)) = \
   15.76 -\ Some (if c then xc else NullPointer)";
   15.77 -by (Simp_tac 1);
   15.78 -qed "np_raise_if";
   15.79 -Addsimps[np_raise_if];
   15.80 -
   15.81 -
   15.82 -
   15.83 -
   15.84 -
    16.1 --- a/src/HOL/MicroJava/J/State.thy	Thu Feb 01 20:51:48 2001 +0100
    16.2 +++ b/src/HOL/MicroJava/J/State.thy	Thu Feb 01 20:53:13 2001 +0100
    16.3 @@ -6,34 +6,34 @@
    16.4  State for evaluation of Java expressions and statements
    16.5  *)
    16.6  
    16.7 -State = TypeRel + Value +
    16.8 +theory State = TypeRel + Value:
    16.9  
   16.10  types	fields_
   16.11 -	= "(vname \\<times> cname \\<leadsto> val)" (* field name, defining class, value *)
   16.12 +	= "(vname \<times> cname \<leadsto> val)" (* field name, defining class, value *)
   16.13  
   16.14 -        obj = "cname \\<times> fields_"	(* class instance with class name and fields *)
   16.15 +        obj = "cname \<times> fields_"	(* class instance with class name and fields *)
   16.16  
   16.17  constdefs
   16.18    obj_ty	:: "obj => ty"
   16.19   "obj_ty obj  == Class (fst obj)"
   16.20  
   16.21 -  init_vars	:: "('a \\<times> ty) list => ('a \\<leadsto> val)"
   16.22 - "init_vars	== map_of o map (\\<lambda>(n,T). (n,default_val T))"
   16.23 +  init_vars	:: "('a \<times> ty) list => ('a \<leadsto> val)"
   16.24 + "init_vars	== map_of o map (\<lambda>(n,T). (n,default_val T))"
   16.25    
   16.26  datatype xcpt		(* exceptions *)
   16.27  	= NullPointer
   16.28  	| ClassCast
   16.29  	| OutOfMemory
   16.30  
   16.31 -types	aheap  = "loc \\<leadsto> obj" (* "heap" used in a translation below *)
   16.32 -        locals = "vname \\<leadsto> val"	
   16.33 +types	aheap  = "loc \<leadsto> obj" (* "heap" used in a translation below *)
   16.34 +        locals = "vname \<leadsto> val"	
   16.35  
   16.36          state		(* simple state, i.e. variable contents *)
   16.37 -	= "aheap \\<times> locals"
   16.38 +	= "aheap \<times> locals"
   16.39  	(* heap, local parameter including This *)
   16.40  
   16.41  	xstate		(* state including exception information *)
   16.42 -	 = "xcpt option \\<times> state"
   16.43 +	 = "xcpt option \<times> state"
   16.44  
   16.45  syntax
   16.46    heap		:: "state => aheap"
   16.47 @@ -47,19 +47,98 @@
   16.48  
   16.49  constdefs
   16.50  
   16.51 -  new_Addr	:: "aheap => loc \\<times> xcpt option"
   16.52 - "new_Addr h == SOME (a,x). (h a = None \\<and>  x = None) |  x = Some OutOfMemory"
   16.53 +  new_Addr	:: "aheap => loc \<times> xcpt option"
   16.54 + "new_Addr h == SOME (a,x). (h a = None \<and>  x = None) |  x = Some OutOfMemory"
   16.55  
   16.56    raise_if	:: "bool => xcpt => xcpt option => xcpt option"
   16.57 - "raise_if c x xo == if c \\<and>  (xo = None) then Some x else xo"
   16.58 + "raise_if c x xo == if c \<and>  (xo = None) then Some x else xo"
   16.59  
   16.60    np		:: "val => xcpt option => xcpt option"
   16.61   "np v == raise_if (v = Null) NullPointer"
   16.62  
   16.63    c_hupd	:: "aheap => xstate => xstate"
   16.64 - "c_hupd h'== \\<lambda>(xo,(h,l)). if xo = None then (None,(h',l)) else (xo,(h,l))"
   16.65 + "c_hupd h'== \<lambda>(xo,(h,l)). if xo = None then (None,(h',l)) else (xo,(h,l))"
   16.66  
   16.67    cast_ok	:: "'c prog => cname => aheap => val => bool"
   16.68 - "cast_ok G C h v == v = Null \\<or> G\\<turnstile>obj_ty (the (h (the_Addr v)))\\<preceq> Class C"
   16.69 + "cast_ok G C h v == v = Null \<or> G\<turnstile>obj_ty (the (h (the_Addr v)))\<preceq> Class C"
   16.70 +
   16.71 +lemma obj_ty_def2 [simp]: "obj_ty (C,fs) = Class C"
   16.72 +apply (unfold obj_ty_def)
   16.73 +apply (simp (no_asm))
   16.74 +done
   16.75 +
   16.76 +lemma new_AddrD: 
   16.77 +"(a,x) = new_Addr h ==> h a = None \<and> x = None | x = Some OutOfMemory"
   16.78 +apply (unfold new_Addr_def)
   16.79 +apply(simp add: Pair_fst_snd_eq Eps_split)
   16.80 +apply(rule someI)
   16.81 +apply(rule disjI2)
   16.82 +apply(rule_tac "r" = "snd (?a,Some OutOfMemory)" in trans)
   16.83 +apply auto
   16.84 +done
   16.85 +
   16.86 +
   16.87 +lemma raise_if_True [simp]: "raise_if True x y \<noteq> None"
   16.88 +apply (unfold raise_if_def)
   16.89 +apply auto
   16.90 +done
   16.91 +
   16.92 +lemma raise_if_False [simp]: "raise_if False x y = y"
   16.93 +apply (unfold raise_if_def)
   16.94 +apply auto
   16.95 +done
   16.96 +
   16.97 +lemma raise_if_Some [simp]: "raise_if c x (Some y) \<noteq> None"
   16.98 +apply (unfold raise_if_def)
   16.99 +apply auto
  16.100 +done
  16.101 +
  16.102 +lemma raise_if_Some2 [simp]: "raise_if c z (if x = None then Some y else x) \<noteq> None"
  16.103 +apply (unfold raise_if_def)
  16.104 +apply(induct_tac "x")
  16.105 +apply auto
  16.106 +done
  16.107 +
  16.108 +lemma raise_if_SomeD [rule_format (no_asm)]: 
  16.109 +  "raise_if c x y = Some z \<longrightarrow> c \<and>  Some z = Some x |  y = Some z"
  16.110 +apply (unfold raise_if_def)
  16.111 +apply auto
  16.112 +done
  16.113 +
  16.114 +lemma raise_if_NoneD [rule_format (no_asm)]: "raise_if c x y = None --> \<not> c \<and>  y = None"
  16.115 +apply (unfold raise_if_def)
  16.116 +apply auto
  16.117 +done
  16.118 +
  16.119 +lemma np_NoneD [rule_format (no_asm)]: "np a' x' = None --> x' = None \<and>  a' \<noteq> Null"
  16.120 +apply (unfold np_def raise_if_def)
  16.121 +apply auto
  16.122 +done
  16.123 +
  16.124 +lemma np_None [rule_format (no_asm), simp]: "a' \<noteq> Null --> np a' x' = x'"
  16.125 +apply (unfold np_def raise_if_def)
  16.126 +apply auto
  16.127 +done
  16.128 +
  16.129 +lemma np_Some [simp]: "np a' (Some xc) = Some xc"
  16.130 +apply (unfold np_def raise_if_def)
  16.131 +apply auto
  16.132 +done
  16.133 +
  16.134 +lemma np_Null [simp]: "np Null None = Some NullPointer"
  16.135 +apply (unfold np_def raise_if_def)
  16.136 +apply auto
  16.137 +done
  16.138 +
  16.139 +lemma np_Addr [simp]: "np (Addr a) None = None"
  16.140 +apply (unfold np_def raise_if_def)
  16.141 +apply auto
  16.142 +done
  16.143 +
  16.144 +lemma np_raise_if [simp]: "(np Null (raise_if c xc None)) =  
  16.145 +  Some (if c then xc else NullPointer)"
  16.146 +apply (unfold raise_if_def)
  16.147 +apply (simp (no_asm))
  16.148 +done
  16.149  
  16.150  end
    17.1 --- a/src/HOL/MicroJava/J/Term.thy	Thu Feb 01 20:51:48 2001 +0100
    17.2 +++ b/src/HOL/MicroJava/J/Term.thy	Thu Feb 01 20:53:13 2001 +0100
    17.3 @@ -6,7 +6,7 @@
    17.4  Java expressions and statements
    17.5  *)
    17.6  
    17.7 -Term = Value +
    17.8 +theory Term = Value:
    17.9  
   17.10  datatype binop = Eq | Add    (* function codes for binary operation *)
   17.11  
   17.12 @@ -21,7 +21,7 @@
   17.13    | FAss cname expr vname 
   17.14                      expr     (* field ass. *) ("{_}_.._:=_" [10,90,99,90]90)
   17.15    | Call cname expr mname 
   17.16 -    (ty list) (expr list)    (* method call*) ("{_}_.._'( {_}_')"
   17.17 +    "ty list" "expr list"    (* method call*) ("{_}_.._'( {_}_')"
   17.18                                                              [10,90,99,10,10] 90)
   17.19  
   17.20  datatype stmt
   17.21 @@ -32,3 +32,4 @@
   17.22    | Loop expr stmt       ("While '(_') _"     [80,79]70)
   17.23  
   17.24  end
   17.25 +
    18.1 --- a/src/HOL/MicroJava/J/Type.thy	Thu Feb 01 20:51:48 2001 +0100
    18.2 +++ b/src/HOL/MicroJava/J/Type.thy	Thu Feb 01 20:53:13 2001 +0100
    18.3 @@ -6,13 +6,14 @@
    18.4  Java types
    18.5  *)
    18.6  
    18.7 -Type = JBasis +
    18.8 +theory Type = JBasis:
    18.9  
   18.10 -types cname   (* class name *)
   18.11 -      vnam    (* variable or field name *)
   18.12 -      mname   (* method name *)
   18.13 -
   18.14 -arities cname, vnam, mname :: term
   18.15 +typedecl cname  (* class name *)
   18.16 +typedecl vnam   (* variable or field name *)
   18.17 +typedecl mname  (* method name *)
   18.18 +arities  cname :: "term"
   18.19 +         vnam  :: "term"
   18.20 +         mname :: "term"
   18.21  
   18.22  datatype vname    (* names for This pointer and local/field variables *)
   18.23    = This
    19.1 --- a/src/HOL/MicroJava/J/TypeRel.ML	Thu Feb 01 20:51:48 2001 +0100
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,134 +0,0 @@
    19.4 -(*  Title:      HOL/MicroJava/J/TypeRel.ML
    19.5 -    ID:         $Id$
    19.6 -    Author:     David von Oheimb
    19.7 -    Copyright   1999 Technische Universitaet Muenchen
    19.8 -*)
    19.9 -
   19.10 -Goalw [subcls1_def] 
   19.11 -  "G\\<turnstile>C\\<prec>C1D \\<Longrightarrow> C \\<noteq> Object \\<and> (\\<exists>fs ms. class G C = Some (D,fs,ms))";
   19.12 -by Auto_tac;
   19.13 -qed "subcls1D";
   19.14 -Goalw [subcls1_def] "\\<lbrakk>class G C = Some (D,rest); C \\<noteq> Object\\<rbrakk> \\<Longrightarrow> G\\<turnstile>C\\<prec>C1D";
   19.15 -by Auto_tac;
   19.16 -qed "subcls1I";
   19.17 -
   19.18 -Goalw [subcls1_def, is_class_def]  
   19.19 -"subcls1 G = (\\<Sigma>C\\<in>{C. is_class G C} . {D. C\\<noteq>Object \\<and> fst (the (class G C))=D})";
   19.20 -by Auto_tac;
   19.21 -qed "subcls1_def2";
   19.22 -
   19.23 -Goal "finite (subcls1 G)";
   19.24 -by(stac subcls1_def2 1);
   19.25 -by( rtac (finite_is_class RS finite_SigmaI) 1);
   19.26 -by(res_inst_tac [("B","{fst (the (class G C))}")] finite_subset 1);
   19.27 -by  Auto_tac;
   19.28 -qed "finite_subcls1";
   19.29 -
   19.30 -
   19.31 -Goalw [is_class_def] "(C,D) \\<in> (subcls1 G)^+ ==> is_class G C";
   19.32 -by(etac trancl_trans_induct 1);
   19.33 -by (auto_tac (HOL_cs addSDs [subcls1D],simpset()));
   19.34 -qed "subcls_is_class";
   19.35 -
   19.36 -Goalw [is_class_def] "G\\<turnstile>C\\<preceq>C D \\<Longrightarrow> is_class G D \\<longrightarrow> is_class G C";
   19.37 -by (etac rtrancl_induct 1);
   19.38 -by  (dtac subcls1D 2);
   19.39 -by  Auto_tac;
   19.40 -qed_spec_mp "subcls_is_class2"; 
   19.41 -
   19.42 -(* A particular thm about wf;
   19.43 -   looks like it is an odd instance of something more general
   19.44 -*)
   19.45 -Goalw [wf_def] "wf{((A,x),(B,y)) . A=B \\<and> wf(R(A)) \\<and> (x,y)\\<in>R(A)}";
   19.46 -by(full_simp_tac (simpset() delcongs [imp_cong]) 1);
   19.47 -by(strip_tac 1);
   19.48 -by(rename_tac "A x" 1);
   19.49 -by(case_tac "wf(R A)" 1);
   19.50 -by (eres_inst_tac [("a","x")] wf_induct 1);
   19.51 -by (EVERY1[etac allE, etac allE, etac mp, rtac allI, rtac allI]);
   19.52 -by (Fast_tac 1);
   19.53 -by(rewrite_goals_tac [wf_def]);
   19.54 -by(Blast_tac 1);
   19.55 -qed "wf_rel_lemma";
   19.56 -
   19.57 -
   19.58 -(* Proving the termination conditions *)
   19.59 -
   19.60 -goalw thy [subcls1_rel_def] "wf subcls1_rel";
   19.61 -by(rtac (wf_rel_lemma RS wf_subset) 1);
   19.62 -by(Force_tac 1);
   19.63 -qed "wf_subcls1_rel";
   19.64 -
   19.65 -val method_TC = prove_goalw_cterm [subcls1_rel_def]
   19.66 - (cterm_of (sign_of thy) (HOLogic.mk_Trueprop (hd (tl (method.tcs)))))
   19.67 - (K [auto_tac (claset() addIs [subcls1I], simpset())]);
   19.68 -
   19.69 -val fields_TC = prove_goalw_cterm [subcls1_rel_def]
   19.70 - (cterm_of (sign_of thy) (HOLogic.mk_Trueprop (hd (tl (fields.tcs)))))
   19.71 - (K [auto_tac (claset() addIs [subcls1I], simpset())]);
   19.72 -
   19.73 -Goalw [field_def] 
   19.74 -"field (G,C) fn = Some (fd, fT) \\<Longrightarrow> map_of (fields (G,C)) (fn, fd) = Some fT";
   19.75 -by (rtac table_of_remap_SomeD 1);
   19.76 -by (Asm_full_simp_tac 1);
   19.77 -qed "field_fields";
   19.78 -
   19.79 -AddSIs   [widen.refl,widen.null];
   19.80 -Addsimps [widen.refl];
   19.81 -
   19.82 -Goal "(G\\<turnstile>PrimT pT\\<preceq>RefT rT) = False";
   19.83 -br iffI 1;
   19.84 -be widen.elim 1;
   19.85 -by Auto_tac;
   19.86 -qed "widen_PrimT_RefT";
   19.87 -AddIffs [widen_PrimT_RefT];
   19.88 -
   19.89 -Goal "G\\<turnstile>S\\<preceq>T ==> S=RefT R --> (\\<exists>t. T=RefT t)";
   19.90 -by (etac widen.elim 1);
   19.91 -by Auto_tac;
   19.92 -qed "widen_RefT_lemma";
   19.93 -Goal "G\\<turnstile>RefT R\\<preceq>T ==> \\<exists>t. T=RefT t"; 
   19.94 -by (dtac widen_RefT_lemma 1);
   19.95 -by Auto_tac;
   19.96 -qed "widen_RefT";
   19.97 -
   19.98 -Goal "G\\<turnstile>S\\<preceq>T ==> T=RefT R --> (\\<exists>t. S=RefT t)";
   19.99 -by (etac widen.elim 1);
  19.100 -by Auto_tac;
  19.101 -qed "widen_RefT2_lemma";
  19.102 -Goal "G\\<turnstile>S\\<preceq>RefT R ==> \\<exists>t. S=RefT t";
  19.103 -by (dtac widen_RefT2_lemma 1);
  19.104 -by Auto_tac;
  19.105 -qed "widen_RefT2";
  19.106 -
  19.107 -Goal "G\\<turnstile>S\\<preceq>T ==> S = Class C --> (\\<exists>D. T=Class D)";
  19.108 -by (etac widen.elim 1);
  19.109 -by Auto_tac;
  19.110 -qed "widen_Class_lemma";
  19.111 -Goal "G\\<turnstile>Class C\\<preceq>T ==> \\<exists>D. T=Class D";
  19.112 -by (dtac widen_Class_lemma 1);
  19.113 -by Auto_tac;
  19.114 -qed "widen_Class";
  19.115 -
  19.116 -Goal "(G\\<turnstile>Class C\\<preceq>RefT NullT) = False"; 
  19.117 -br iffI 1;
  19.118 -be widen.elim 1;
  19.119 -by(Auto_tac);
  19.120 -qed "widen_Class_NullT";
  19.121 -AddIffs [widen_Class_NullT];
  19.122 -
  19.123 -Goal "(G\\<turnstile>Class C\\<preceq> Class D) = (G\\<turnstile>C\\<preceq>C D)";
  19.124 -br iffI 1;
  19.125 -be widen.elim 1;
  19.126 -by(Auto_tac);
  19.127 -bes widen.intrs 1;
  19.128 -qed "widen_Class_Class";
  19.129 -AddIffs [widen_Class_Class];
  19.130 -
  19.131 -Goal "G\\<turnstile>S\\<preceq>U ==> \\<forall>T. G\\<turnstile>U\\<preceq>T --> G\\<turnstile>S\\<preceq>T";
  19.132 -by( etac widen.induct 1);
  19.133 -by   Safe_tac;
  19.134 -by(  ALLGOALS (forward_tac [widen_Class, widen_RefT]));
  19.135 -by  Safe_tac;
  19.136 -by(eatac rtrancl_trans 1 1);
  19.137 -qed_spec_mp "widen_trans";
    20.1 --- a/src/HOL/MicroJava/J/TypeRel.thy	Thu Feb 01 20:51:48 2001 +0100
    20.2 +++ b/src/HOL/MicroJava/J/TypeRel.thy	Thu Feb 01 20:53:13 2001 +0100
    20.3 @@ -6,18 +6,18 @@
    20.4  The relations between Java types
    20.5  *)
    20.6  
    20.7 -TypeRel = Decl +
    20.8 +theory TypeRel = Decl:
    20.9  
   20.10  consts
   20.11 -  subcls1 :: "'c prog => (cname \\<times> cname) set"  (* subclass *)
   20.12 -  widen   :: "'c prog => (ty    \\<times> ty   ) set"  (* widening *)
   20.13 -  cast    :: "'c prog => (cname \\<times> cname) set"  (* casting *)
   20.14 +  subcls1 :: "'c prog => (cname \<times> cname) set"  (* subclass *)
   20.15 +  widen   :: "'c prog => (ty    \<times> ty   ) set"  (* widening *)
   20.16 +  cast    :: "'c prog => (cname \<times> cname) set"  (* casting *)
   20.17  
   20.18  syntax
   20.19 -  subcls1 :: "'c prog => [cname, cname] => bool" ("_ \\<turnstile> _ \\<prec>C1 _" [71,71,71] 70)
   20.20 -  subcls  :: "'c prog => [cname, cname] => bool" ("_ \\<turnstile> _ \\<preceq>C _" [71,71,71] 70)
   20.21 -  widen   :: "'c prog => [ty   , ty   ] => bool" ("_ \\<turnstile> _ \\<preceq> _" [71,71,71] 70)
   20.22 -  cast    :: "'c prog => [cname, cname] => bool" ("_ \\<turnstile> _ \\<preceq>? _" [71,71,71] 70)
   20.23 +  subcls1 :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<prec>C1 _" [71,71,71] 70)
   20.24 +  subcls  :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<preceq>C _" [71,71,71] 70)
   20.25 +  widen   :: "'c prog => [ty   , ty   ] => bool" ("_ \<turnstile> _ \<preceq> _" [71,71,71] 70)
   20.26 +  cast    :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<preceq>? _" [71,71,71] 70)
   20.27  
   20.28  syntax (HTML)
   20.29    subcls1 :: "'c prog => [cname, cname] => bool" ("_ |- _ <=C1 _" [71,71,71] 70)
   20.30 @@ -26,58 +26,215 @@
   20.31    cast    :: "'c prog => [cname, cname] => bool" ("_ |- _ <=? _" [71,71,71] 70)
   20.32  
   20.33  translations
   20.34 -  "G\\<turnstile>C \\<prec>C1 D" == "(C,D) \\<in> subcls1 G"
   20.35 -  "G\\<turnstile>C \\<preceq>C  D" == "(C,D) \\<in> (subcls1 G)^*"
   20.36 -  "G\\<turnstile>S \\<preceq>   T" == "(S,T) \\<in> widen   G"
   20.37 -  "G\\<turnstile>C \\<preceq>?  D" == "(C,D) \\<in> cast    G"
   20.38 +  "G\<turnstile>C \<prec>C1 D" == "(C,D) \<in> subcls1 G"
   20.39 +  "G\<turnstile>C \<preceq>C  D" == "(C,D) \<in> (subcls1 G)^*"
   20.40 +  "G\<turnstile>S \<preceq>   T" == "(S,T) \<in> widen   G"
   20.41 +  "G\<turnstile>C \<preceq>?  D" == "(C,D) \<in> cast    G"
   20.42  
   20.43  defs
   20.44  
   20.45    (* direct subclass, cf. 8.1.3 *)
   20.46 - subcls1_def"subcls1 G \\<equiv> {(C,D). C\\<noteq>Object \\<and> (\\<exists>c. class G C=Some c \\<and> fst c=D)}"
   20.47 + subcls1_def: "subcls1 G \<equiv> {(C,D). C\<noteq>Object \<and> (\<exists>c. class G C=Some c \<and> fst c=D)}"
   20.48    
   20.49 +lemma subcls1D: 
   20.50 +  "G\<turnstile>C\<prec>C1D \<Longrightarrow> C \<noteq> Object \<and> (\<exists>fs ms. class G C = Some (D,fs,ms))"
   20.51 +apply (unfold subcls1_def)
   20.52 +apply auto
   20.53 +done
   20.54 +
   20.55 +lemma subcls1I: "\<lbrakk>class G C = Some (D,rest); C \<noteq> Object\<rbrakk> \<Longrightarrow> G\<turnstile>C\<prec>C1D"
   20.56 +apply (unfold subcls1_def)
   20.57 +apply auto
   20.58 +done
   20.59 +
   20.60 +lemma subcls1_def2: 
   20.61 +"subcls1 G = (\<Sigma>C\<in>{C. is_class G C} . {D. C\<noteq>Object \<and> fst (the (class G C))=D})"
   20.62 +apply (unfold subcls1_def is_class_def)
   20.63 +apply auto
   20.64 +done
   20.65 +
   20.66 +lemma finite_subcls1: "finite (subcls1 G)"
   20.67 +apply(subst subcls1_def2)
   20.68 +apply(rule finite_SigmaI [OF finite_is_class])
   20.69 +apply(rule_tac B = "{fst (the (class G C))}" in finite_subset)
   20.70 +apply  auto
   20.71 +done
   20.72 +
   20.73 +lemma subcls_is_class: "(C,D) \<in> (subcls1 G)^+ ==> is_class G C"
   20.74 +apply (unfold is_class_def)
   20.75 +apply(erule trancl_trans_induct)
   20.76 +apply (auto dest!: subcls1D)
   20.77 +done
   20.78 +
   20.79 +lemma subcls_is_class2 [rule_format (no_asm)]: "G\<turnstile>C\<preceq>C D \<Longrightarrow> is_class G D \<longrightarrow> is_class G C"
   20.80 +apply (unfold is_class_def)
   20.81 +apply (erule rtrancl_induct)
   20.82 +apply  (drule_tac [2] subcls1D)
   20.83 +apply  auto
   20.84 +done
   20.85 +
   20.86 +consts class_rec ::"'c prog \<times> cname \<Rightarrow> 
   20.87 +        'a \<Rightarrow> (cname \<Rightarrow> fdecl list \<Rightarrow> 'c mdecl list \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a"
   20.88 +recdef class_rec "same_fst (\<lambda>G. wf ((subcls1 G)^-1)) (\<lambda>G. (subcls1 G)^-1)"
   20.89 +      "class_rec (G,C) = (\<lambda>t f. case class G C of None \<Rightarrow> arbitrary 
   20.90 +                         | Some (D,fs,ms) \<Rightarrow> if wf ((subcls1 G)^-1) then 
   20.91 +      f C fs ms (if C = Object then t else class_rec (G,D) t f) else arbitrary)"
   20.92 +recdef_tc class_rec_tc: class_rec
   20.93 +  apply (unfold same_fst_def)
   20.94 +  apply (auto intro: subcls1I)
   20.95 +  done
   20.96 +
   20.97 +lemma class_rec_lemma: "\<lbrakk> wf ((subcls1 G)^-1); class G C = Some (D,fs,ms)\<rbrakk> \<Longrightarrow>
   20.98 + class_rec (G,C) t f = f C fs ms (if C=Object then t else class_rec (G,D) t f)";
   20.99 +  apply (rule class_rec_tc [THEN class_rec.simps 
  20.100 +              [THEN trans [THEN fun_cong [THEN fun_cong]]]])
  20.101 +  apply (rule ext, rule ext)
  20.102 +  apply auto
  20.103 +  done
  20.104 +
  20.105  consts
  20.106  
  20.107 -  method	:: "'c prog \\<times> cname => ( sig   \\<leadsto> cname \\<times> ty \\<times> 'c)"
  20.108 -  field	:: "'c prog \\<times> cname => ( vname \\<leadsto> cname \\<times> ty)"
  20.109 -  fields	:: "'c prog \\<times> cname => ((vname \\<times> cname) \\<times>  ty) list"
  20.110 -
  20.111 -constdefs       (* auxiliary relation for recursive definitions below *)
  20.112 -
  20.113 -  subcls1_rel	:: "(('c prog \\<times> cname) \\<times> ('c prog \\<times> cname)) set"
  20.114 - "subcls1_rel == {((G,C),(G',C')). G = G' \\<and>  wf ((subcls1 G)^-1) \\<and>  G\\<turnstile>C'\\<prec>C1C}"
  20.115 +  method :: "'c prog \<times> cname => ( sig   \<leadsto> cname \<times> ty \<times> 'c)" (* ###curry *)
  20.116 +  field  :: "'c prog \<times> cname => ( vname \<leadsto> cname \<times> ty     )" (* ###curry *)
  20.117 +  fields :: "'c prog \<times> cname => ((vname \<times> cname) \<times> ty) list" (* ###curry *)
  20.118  
  20.119  (* methods of a class, with inheritance, overriding and hiding, cf. 8.4.6 *)
  20.120 -recdef method "subcls1_rel"
  20.121 - "method (G,C) = (if wf((subcls1 G)^-1) then (case class G C of None =>arbitrary
  20.122 -                   | Some (D,fs,ms) => (if C = Object then empty else 
  20.123 -                                           if is_class G D then method (G,D) 
  20.124 -                                                           else arbitrary) ++
  20.125 -                                           map_of (map (\\<lambda>(s,  m ). 
  20.126 -                                                        (s,(C,m))) ms))
  20.127 -                  else arbitrary)"
  20.128 +defs method_def: "method \<equiv> \<lambda>(G,C). class_rec (G,C) empty (\<lambda>C fs ms ts.
  20.129 +                           ts ++ map_of (map (\<lambda>(s,m). (s,(C,m))) ms))"
  20.130 +
  20.131 +lemma method_rec_lemma: "[|class G C = Some (D,fs,ms); wf ((subcls1 G)^-1)|] ==>
  20.132 +  method (G,C) = (if C = Object then empty else method (G,D)) ++  
  20.133 +  map_of (map (\<lambda>(s,m). (s,(C,m))) ms)"
  20.134 +apply (unfold method_def)
  20.135 +apply (simp split del: split_if)
  20.136 +apply (erule (1) class_rec_lemma [THEN trans]);
  20.137 +apply auto
  20.138 +done
  20.139 +
  20.140  
  20.141  (* list of fields of a class, including inherited and hidden ones *)
  20.142 -recdef fields  "subcls1_rel"
  20.143 - "fields (G,C) = (if wf((subcls1 G)^-1) then (case class G C of None =>arbitrary
  20.144 -                   | Some (D,fs,ms) => map (\\<lambda>(fn,ft). ((fn,C),ft)) fs@
  20.145 -                                           (if C = Object then [] else 
  20.146 -                                           if is_class G D then fields (G,D) 
  20.147 -                                                           else arbitrary))
  20.148 -                  else arbitrary)"
  20.149 -defs
  20.150 +defs fields_def: "fields \<equiv> \<lambda>(G,C). class_rec (G,C) []    (\<lambda>C fs ms ts.
  20.151 +                           map (\<lambda>(fn,ft). ((fn,C),ft)) fs @ ts)"
  20.152 +
  20.153 +lemma fields_rec_lemma: "[|class G C = Some (D,fs,ms); wf ((subcls1 G)^-1)|] ==>
  20.154 + fields (G,C) = 
  20.155 +  map (\<lambda>(fn,ft). ((fn,C),ft)) fs @ (if C = Object then [] else fields (G,D))"
  20.156 +apply (unfold fields_def)
  20.157 +apply (simp split del: split_if)
  20.158 +apply (erule (1) class_rec_lemma [THEN trans]);
  20.159 +apply auto
  20.160 +done
  20.161 +
  20.162 +
  20.163 +defs field_def: "field == map_of o (map (\<lambda>((fn,fd),ft). (fn,(fd,ft)))) o fields"
  20.164 +
  20.165 +lemma field_fields: 
  20.166 +"field (G,C) fn = Some (fd, fT) \<Longrightarrow> map_of (fields (G,C)) (fn, fd) = Some fT"
  20.167 +apply (unfold field_def)
  20.168 +apply (rule table_of_remap_SomeD)
  20.169 +apply simp
  20.170 +done
  20.171 +
  20.172 +
  20.173 +inductive "widen G" intros (*widening, viz. method invocation conversion,cf. 5.3
  20.174 +			     i.e. sort of syntactic subtyping *)
  20.175 +  refl   [intro!, simp]:       "G\<turnstile>      T \<preceq> T" 	 (* identity conv., cf. 5.1.1 *)
  20.176 +  subcls         : "G\<turnstile>C\<preceq>C D ==> G\<turnstile>Class C \<preceq> Class D"
  20.177 +  null   [intro!]:             "G\<turnstile>     NT \<preceq> RefT R"
  20.178  
  20.179 -  field_def "field == map_of o (map (\\<lambda>((fn,fd),ft). (fn,(fd,ft)))) o fields"
  20.180 +inductive "cast G" intros (* casting conversion, cf. 5.5 / 5.1.5 *)
  20.181 +                          (* left out casts on primitve types    *)
  20.182 +  widen:  "G\<turnstile>C\<preceq>C D ==> G\<turnstile>C \<preceq>? D"
  20.183 +  subcls: "G\<turnstile>D\<preceq>C C ==> G\<turnstile>C \<preceq>? D"
  20.184 +
  20.185 +lemma widen_PrimT_RefT [iff]: "(G\<turnstile>PrimT pT\<preceq>RefT rT) = False"
  20.186 +apply (rule iffI)
  20.187 +apply (erule widen.elims)
  20.188 +apply auto
  20.189 +done
  20.190 +
  20.191 +lemma widen_RefT: "G\<turnstile>RefT R\<preceq>T ==> \<exists>t. T=RefT t"
  20.192 +apply (ind_cases "G\<turnstile>S\<preceq>T")
  20.193 +apply auto
  20.194 +done
  20.195 +
  20.196 +lemma widen_RefT2: "G\<turnstile>S\<preceq>RefT R ==> \<exists>t. S=RefT t"
  20.197 +apply (ind_cases "G\<turnstile>S\<preceq>T")
  20.198 +apply auto
  20.199 +done
  20.200 +
  20.201 +lemma widen_Class: "G\<turnstile>Class C\<preceq>T ==> \<exists>D. T=Class D"
  20.202 +apply (ind_cases "G\<turnstile>S\<preceq>T")
  20.203 +apply auto
  20.204 +done
  20.205 +
  20.206 +lemma widen_Class_NullT [iff]: "(G\<turnstile>Class C\<preceq>NT) = False"
  20.207 +apply (rule iffI)
  20.208 +apply (ind_cases "G\<turnstile>S\<preceq>T")
  20.209 +apply auto
  20.210 +done
  20.211  
  20.212 -inductive "widen G" intrs (*widening, viz. method invocation conversion, cf. 5.3
  20.213 -			     i.e. sort of syntactic subtyping *)
  20.214 -  refl	             "G\\<turnstile>      T \\<preceq> T" 	 (* identity conv., cf. 5.1.1 *)
  20.215 -  subcls "G\\<turnstile>C\\<preceq>C D ==> G\\<turnstile>Class C \\<preceq> Class D"
  20.216 -  null	             "G\\<turnstile>     NT \\<preceq> RefT R"
  20.217 +lemma widen_Class_Class [iff]: "(G\<turnstile>Class C\<preceq> Class D) = (G\<turnstile>C\<preceq>C D)"
  20.218 +apply (rule iffI)
  20.219 +apply (ind_cases "G\<turnstile>S\<preceq>T")
  20.220 +apply (auto elim: widen.subcls)
  20.221 +done
  20.222 +
  20.223 +lemma widen_trans [rule_format (no_asm)]: "G\<turnstile>S\<preceq>U ==> \<forall>T. G\<turnstile>U\<preceq>T --> G\<turnstile>S\<preceq>T"
  20.224 +apply (erule widen.induct)
  20.225 +apply   safe
  20.226 +apply  (frule widen_Class)
  20.227 +apply  (frule_tac [2] widen_RefT)
  20.228 +apply  safe
  20.229 +apply(erule (1) rtrancl_trans)
  20.230 +done
  20.231 +
  20.232 +ML {* InductAttrib.print_global_rules(the_context()) *}
  20.233 +ML {* set show_tags *}
  20.234  
  20.235 -inductive "cast G" intrs (* casting conversion, cf. 5.5 / 5.1.5 *)
  20.236 -                         (* left out casts on primitve types    *)
  20.237 -  widen	 "G\\<turnstile>C\\<preceq>C D ==> G\\<turnstile>C \\<preceq>? D"
  20.238 -  subcls "G\\<turnstile>D\\<preceq>C C ==> G\\<turnstile>C \\<preceq>? D"
  20.239 +(*####theorem widen_trans: "\<lbrakk>G\<turnstile>S\<preceq>U; G\<turnstile>U\<preceq>T\<rbrakk> \<Longrightarrow> G\<turnstile>S\<preceq>T"
  20.240 +proof -
  20.241 +  assume "G\<turnstile>S\<preceq>U"
  20.242 +  thus "\<And>T. G\<turnstile>U\<preceq>T \<Longrightarrow> G\<turnstile>S\<preceq>T" (*(is "PROP ?P S U")*)
  20.243 +  proof (induct (*cases*) (open) (*?P S U*) rule: widen.induct [consumes 1])
  20.244 +    case refl
  20.245 +    fix T' assume "G\<turnstile>T\<preceq>T'" thus "G\<turnstile>T\<preceq>T'".
  20.246 +      (* fix T' show "PROP ?P T T".*)
  20.247 +  next
  20.248 +    case subcls
  20.249 +    fix T assume "G\<turnstile>Class D\<preceq>T"
  20.250 +    then obtain E where "T = Class E" by (blast dest: widen_Class)
  20.251 +    from prems show "G\<turnstile>Class C\<preceq>T" proof (auto elim: rtrancl_trans) qed
  20.252 +  next
  20.253 +    case null
  20.254 +    fix RT assume "G\<turnstile>RefT R\<preceq>RT"
  20.255 +    then obtain rt where "RT = RefT rt" by (blast dest: widen_RefT)
  20.256 +    thus "G\<turnstile>NT\<preceq>RT" by auto
  20.257 +  qed
  20.258 +qed
  20.259 +*)
  20.260 +
  20.261 +theorem widen_trans: "\<lbrakk>G\<turnstile>S\<preceq>U; G\<turnstile>U\<preceq>T\<rbrakk> \<Longrightarrow> G\<turnstile>S\<preceq>T"
  20.262 +proof -
  20.263 +  assume "G\<turnstile>S\<preceq>U"
  20.264 +  thus "\<And>T. G\<turnstile>U\<preceq>T \<Longrightarrow> G\<turnstile>S\<preceq>T" (*(is "PROP ?P S U")*)
  20.265 +  proof (induct (*cases*) (open) (*?P S U*)) (* rule: widen.induct *)
  20.266 +    case refl
  20.267 +    fix T' assume "G\<turnstile>T\<preceq>T'" thus "G\<turnstile>T\<preceq>T'".
  20.268 +      (* fix T' show "PROP ?P T T".*)
  20.269 +  next
  20.270 +    case subcls
  20.271 +    fix T assume "G\<turnstile>Class D\<preceq>T"
  20.272 +    then obtain E where "T = Class E" by (blast dest: widen_Class)
  20.273 +    from prems show "G\<turnstile>Class C\<preceq>T" proof (auto elim: rtrancl_trans) qed
  20.274 +  next
  20.275 +    case null
  20.276 +    fix RT assume "G\<turnstile>RefT R\<preceq>RT"
  20.277 +    then obtain rt where "RT = RefT rt" by (blast dest: widen_RefT)
  20.278 +    thus "G\<turnstile>NT\<preceq>RT" by auto
  20.279 +  qed
  20.280 +qed
  20.281 +
  20.282 +
  20.283  
  20.284  end
    21.1 --- a/src/HOL/MicroJava/J/Value.thy	Thu Feb 01 20:51:48 2001 +0100
    21.2 +++ b/src/HOL/MicroJava/J/Value.thy	Thu Feb 01 20:53:13 2001 +0100
    21.3 @@ -1,4 +1,4 @@
    21.4 -(*  Title:      HOL/MicroJava/J/Term.thy
    21.5 +(*  Title:      HOL/MicroJava/J/Value.thy
    21.6      ID:         $Id$
    21.7      Author:     David von Oheimb
    21.8      Copyright   1999 Technische Universitaet Muenchen
    21.9 @@ -6,12 +6,12 @@
   21.10  Java values
   21.11  *)
   21.12  
   21.13 -Value = Type +
   21.14 +theory Value = Type:
   21.15  
   21.16 -types   loc     (* locations, i.e. abstract references on objects *)
   21.17 -arities loc :: term
   21.18 +typedecl loc (* locations, i.e. abstract references on objects *)
   21.19 +arities loc :: "term"
   21.20  
   21.21 -datatype val_   (* name non 'val' because of clash with ML token *)
   21.22 +datatype val
   21.23    = Unit        (* dummy result value of void methods *)
   21.24    | Null        (* null reference *)
   21.25    | Bool bool   (* Boolean value *)
   21.26 @@ -19,9 +19,6 @@
   21.27                     of clash with HOL/Set.thy *)
   21.28    | Addr loc    (* addresses, i.e. locations of objects *)
   21.29  
   21.30 -types	val = val_
   21.31 -translations "val" <= (type) "val_"
   21.32 -
   21.33  consts
   21.34    the_Bool :: "val => bool"
   21.35    the_Intg :: "val => int"
    22.1 --- a/src/HOL/MicroJava/J/WellForm.ML	Thu Feb 01 20:51:48 2001 +0100
    22.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.3 @@ -1,349 +0,0 @@
    22.4 -(*  Title:      HOL/MicroJava/J/WellForm.ML
    22.5 -    ID:         $Id$
    22.6 -    Author:     David von Oheimb
    22.7 -    Copyright   1999 Technische Universitaet Muenchen
    22.8 -*)
    22.9 -
   22.10 -Goalw [wf_prog_def, class_def]
   22.11 - "[|class G C = Some c; wf_prog wf_mb G|] ==> wf_cdecl wf_mb G (C,c)";
   22.12 -by (Asm_full_simp_tac 1);
   22.13 -by (fast_tac (set_cs addDs [map_of_SomeD]) 1);
   22.14 -qed "class_wf";
   22.15 -
   22.16 -Goalw [wf_prog_def, ObjectC_def, class_def]
   22.17 -	"wf_prog wf_mb G ==> class G Object = Some (arbitrary, [], [])";
   22.18 -by (auto_tac (claset() addIs [map_of_SomeI], simpset()));
   22.19 -qed "class_Object";
   22.20 -Addsimps [class_Object];
   22.21 -
   22.22 -Goalw [is_class_def] "wf_prog wf_mb G ==> is_class G Object";
   22.23 -by (Asm_simp_tac 1);
   22.24 -qed "is_class_Object";
   22.25 -Addsimps [is_class_Object];
   22.26 -
   22.27 -Goal "[|G\\<turnstile>C\\<prec>C1D; wf_prog wf_mb G|] ==> D \\<noteq> C \\<and> \\<not>(D,C)\\<in>(subcls1 G)^+";
   22.28 -by( forward_tac [r_into_trancl] 1);
   22.29 -by( dtac subcls1D 1);
   22.30 -by(Clarify_tac 1);
   22.31 -by( datac class_wf 1 1);
   22.32 -by( rewtac wf_cdecl_def);
   22.33 -by(force_tac (claset(), simpset() addsimps [thm"reflcl_trancl" RS sym] 
   22.34 -				  delsimps [thm"reflcl_trancl"]) 1);
   22.35 -qed "subcls1_wfD";
   22.36 -
   22.37 -Goalw [wf_cdecl_def] 
   22.38 -"!!r. \\<lbrakk>wf_cdecl wf_mb G (C,D,r); C \\<noteq> Object\\<rbrakk> \\<Longrightarrow> is_class G D";
   22.39 -by (auto_tac (claset(), simpset() addsplits [option.split_asm]));
   22.40 -qed "wf_cdecl_supD";
   22.41 -
   22.42 -Goal "[|wf_prog wf_mb G; (C,D)\\<in>(subcls1 G)^+|] ==> \\<not>(D,C)\\<in>(subcls1 G)^+";
   22.43 -by(etac tranclE 1);
   22.44 -by(TRYALL(fast_tac (claset() addSDs [subcls1_wfD] addIs [trancl_trans])));
   22.45 -qed "subcls_asym";
   22.46 -
   22.47 -Goal "[|wf_prog wf_mb G; (C,D)\\<in>(subcls1 G)^+|] ==> C \\<noteq> D";
   22.48 -by (etac trancl_trans_induct 1);
   22.49 -by  (auto_tac (claset() addDs [subcls1_wfD,subcls_asym],simpset()));
   22.50 -qed "subcls_irrefl";
   22.51 -
   22.52 -Goalw [acyclic_def] "wf_prog wf_mb G ==> acyclic (subcls1 G)";
   22.53 -by (fast_tac (claset() addDs [subcls_irrefl]) 1);
   22.54 -qed "acyclic_subcls1";
   22.55 -
   22.56 -Goal "wf_prog wf_mb G ==> wf ((subcls1 G)^-1)";
   22.57 -by (rtac finite_acyclic_wf 1);
   22.58 -by ( stac finite_converse 1);
   22.59 -by ( rtac finite_subcls1 1);
   22.60 -by (stac acyclic_converse 1);
   22.61 -by (etac acyclic_subcls1 1);
   22.62 -qed "wf_subcls1";
   22.63 -
   22.64 -val major::prems = goal thy
   22.65 -  "[|wf_prog wf_mb G; !!C. \\<forall>D. (C,D)\\<in>(subcls1 G)^+ --> P D ==> P C|] ==> P C";
   22.66 -by(cut_facts_tac [major RS wf_subcls1] 1);
   22.67 -by(dtac wf_trancl 1);
   22.68 -by(asm_full_simp_tac (HOL_ss addsimps [trancl_converse]) 1);
   22.69 -by(eres_inst_tac [("a","C")] wf_induct 1);
   22.70 -by(resolve_tac prems 1);
   22.71 -by(Auto_tac);
   22.72 -qed "subcls_induct";
   22.73 -
   22.74 -val prems = goalw thy [is_class_def] "[|is_class G C; wf_prog wf_mb G; P Object; \
   22.75 -\!!C D fs ms. [|C \\<noteq> Object; is_class G C; class G C = Some (D,fs,ms) \\<and> \
   22.76 -\   wf_cdecl wf_mb G (C,D,fs,ms) \\<and> G\\<turnstile>C\\<prec>C1D \\<and> is_class G D \\<and> P D|] ==> P C\
   22.77 -\ |] ==> P C";
   22.78 -by( cut_facts_tac prems 1);
   22.79 -by( rtac impE 1);
   22.80 -by(   atac 2);
   22.81 -by(  atac 2);
   22.82 -by( etac thin_rl 1);
   22.83 -by( rtac subcls_induct 1);
   22.84 -by(  atac 1);
   22.85 -by( rtac impI 1);
   22.86 -by( case_tac "C = Object" 1);
   22.87 -by(  Fast_tac 1);
   22.88 -by Safe_tac;
   22.89 -by( ftac class_wf 1);
   22.90 -by(  atac 1);
   22.91 -by( ftac wf_cdecl_supD 1);
   22.92 -by(  atac 1);
   22.93 -
   22.94 -by( subgoal_tac "G\\<turnstile>C\\<prec>C1a" 1);
   22.95 -by( etac subcls1I 2);
   22.96 -by( rtac (hd (tl (tl (tl prems)))) 1);
   22.97 -by (rewtac is_class_def);
   22.98 -by Auto_tac;
   22.99 -qed "subcls1_induct";
  22.100 -
  22.101 -Goal "[|wf ((subcls1 G)^-1); \\<forall>D fs ms. class G C = Some (D,fs,ms) \\<longrightarrow> C \\<noteq> Object --> is_class G D|] ==> method (G,C) = \
  22.102 -\ (case class G C of None => arbitrary | Some (D,fs,ms) => \
  22.103 -\ (if C = Object then empty else method (G,D)) ++ \
  22.104 -\ map_of (map (\\<lambda>(s,m). (s,(C,m))) ms))";
  22.105 -by( stac (method_TC RS (wf_subcls1_rel RS (hd method.simps))) 1);
  22.106 -by( asm_simp_tac (simpset() addsplits[option.split]) 1);
  22.107 -by Auto_tac;
  22.108 -qed "method_rec_lemma";
  22.109 -
  22.110 -Goal "wf_prog wf_mb G ==> method (G,C) = \
  22.111 -\ (case class G C of None => arbitrary | Some (D,fs,ms) => \
  22.112 -\ (if C = Object then empty else method (G,D)) ++ \
  22.113 -\ map_of (map (\\<lambda>(s,m). (s,(C,m))) ms))";
  22.114 -by(rtac method_rec_lemma 1);
  22.115 -by( clarsimp_tac (claset(), simpset() addsimps [wf_subcls1,empty_def] 
  22.116 -		addsplits [option.split]) 1);
  22.117 -by( case_tac "C = Object" 1);
  22.118 -by(  Force_tac 1);
  22.119 -by Safe_tac;
  22.120 -by( datac class_wf 1 1);
  22.121 -by( datac wf_cdecl_supD 1 1);
  22.122 -by( Asm_full_simp_tac 1);
  22.123 -qed "method_rec";
  22.124 -
  22.125 -Goal "[|wf ((subcls1 G)^-1); class G C = Some (D,fs,ms); C \\<noteq> Object \\<longrightarrow> is_class G D|] ==> fields (G,C) = \
  22.126 -\ map (\\<lambda>(fn,ft). ((fn,C),ft)) fs @ (if C = Object then [] else fields (G,D))";
  22.127 -by(rtac trans 1);
  22.128 -by(rtac (fields_TC RS (wf_subcls1_rel RS (hd fields.simps))) 1);
  22.129 -by( asm_simp_tac (simpset() addsplits[option.split]) 1);
  22.130 -qed "fields_rec_lemma";
  22.131 -
  22.132 -Goal "[|class G C = Some (D,fs,ms); wf_prog wf_mb G|] ==> fields (G,C) = \
  22.133 -\ map (\\<lambda>(fn,ft). ((fn,C),ft)) fs @ (if C = Object then [] else fields (G,D))";
  22.134 -by(rtac trans 1);
  22.135 -by(rtac fields_rec_lemma 1);
  22.136 -by(   asm_simp_tac (simpset() addsimps [wf_subcls1]) 1);
  22.137 -ba  1;
  22.138 -br refl 2;
  22.139 -by( datac class_wf 1 1);
  22.140 -by(rtac impI 1);
  22.141 -by( eatac wf_cdecl_supD 1 1);
  22.142 -qed "fields_rec";
  22.143 -
  22.144 -Goal "wf_prog wf_mb G ==> method (G,Object) = empty";
  22.145 -by(stac method_rec 1);
  22.146 -by Auto_tac;
  22.147 -qed "method_Object";
  22.148 -
  22.149 -Goal "wf_prog wf_mb G ==> fields (G,Object) = []";
  22.150 -by(stac fields_rec 1);
  22.151 -by Auto_tac;
  22.152 -qed "fields_Object";
  22.153 -
  22.154 -Addsimps [method_Object, fields_Object];
  22.155 -
  22.156 -Goalw [field_def] "wf_prog wf_mb G ==> field (G,Object) = empty";
  22.157 -by(Asm_simp_tac 1);
  22.158 -qed "field_Object";
  22.159 -Addsimps [field_Object];
  22.160 -
  22.161 -Goal "[|is_class G C; wf_prog wf_mb G|] ==> G\\<turnstile>C\\<preceq>C Object";
  22.162 -by(etac subcls1_induct 1);
  22.163 -by(  atac 1);
  22.164 -by( Fast_tac 1);
  22.165 -by(auto_tac (HOL_cs addSDs [wf_cdecl_supD], simpset()));
  22.166 -by(eatac rtrancl_into_rtrancl2 1 1);
  22.167 -qed "subcls_C_Object";
  22.168 -
  22.169 -Goalw [wf_mhead_def] "wf_mhead G sig rT ==> is_type G rT";
  22.170 -by Auto_tac;
  22.171 -qed "is_type_rTI";
  22.172 -
  22.173 -Goal "[|is_class G C; wf_prog wf_mb G|] ==> \
  22.174 -\ \\<forall>((fn,fd),fT)\\<in>set (fields (G,C)). G\\<turnstile>C\\<preceq>C fd";
  22.175 -by( etac subcls1_induct 1);
  22.176 -by(   atac 1);
  22.177 -by(  Asm_simp_tac 1);
  22.178 -by( safe_tac HOL_cs);
  22.179 -by( stac fields_rec 1);
  22.180 -by(   atac 1);
  22.181 -by(  atac 1);
  22.182 -by( simp_tac (simpset() delsplits [split_if]) 1);
  22.183 -by( rtac ballI 1);
  22.184 -by( split_all_tac 1);
  22.185 -by( Simp_tac 1);
  22.186 -by( etac UnE 1);
  22.187 -by(  Force_tac 1);
  22.188 -by( etac (r_into_rtrancl RS rtrancl_trans) 1);
  22.189 -by Auto_tac;
  22.190 -qed "widen_fields_defpl'";
  22.191 -
  22.192 -Goal "[|((fn,fd),fT) \\<in> set (fields (G,C)); wf_prog wf_mb G; is_class G C|] ==> \
  22.193 -\ G\\<turnstile>C\\<preceq>C fd";
  22.194 -by( datac widen_fields_defpl' 1 1);
  22.195 -by (Fast_tac 1);
  22.196 -qed "widen_fields_defpl";
  22.197 -
  22.198 -Goal "[|is_class G C; wf_prog wf_mb G|] ==> unique (fields (G,C))";
  22.199 -by( etac subcls1_induct 1);
  22.200 -by(   atac 1);
  22.201 -by(  safe_tac (HOL_cs addSDs [wf_cdecl_supD]));
  22.202 -by(  Asm_simp_tac 1);
  22.203 -by( dtac subcls1_wfD 1);
  22.204 -by(  atac 1);
  22.205 -by( stac fields_rec 1);
  22.206 -by   Auto_tac;
  22.207 -by( rotate_tac ~1 1);
  22.208 -by( forward_tac [class_wf] 1);
  22.209 -by  Auto_tac;
  22.210 -by( asm_full_simp_tac (simpset() addsimps [wf_cdecl_def]) 1);
  22.211 -by( etac unique_append 1);
  22.212 -by(  rtac unique_map_inj 1);
  22.213 -by(   Clarsimp_tac 1);
  22.214 -by  (rtac injI 1);
  22.215 -by(  Asm_full_simp_tac 1);
  22.216 -by(auto_tac (claset() addSDs [widen_fields_defpl], simpset()));
  22.217 -qed "unique_fields";
  22.218 -
  22.219 -Goal "[|wf_prog wf_mb G; (C',C)\\<in>(subcls1 G)^*|] ==> \
  22.220 -\ x \\<in> set (fields (G,C)) --> x \\<in> set (fields (G,C'))";
  22.221 -by(etac converse_rtrancl_induct 1);
  22.222 -by( safe_tac (HOL_cs addSDs [subcls1D]));
  22.223 -by(stac fields_rec 1);
  22.224 -by(  Auto_tac);
  22.225 -qed_spec_mp "fields_mono_lemma";
  22.226 -
  22.227 -Goal
  22.228 -"\\<lbrakk>map_of (fields (G,C)) fn = Some f; G\\<turnstile>D\\<preceq>C C; is_class G D; wf_prog wf_mb G\\<rbrakk>\
  22.229 -\ \\<Longrightarrow> map_of (fields (G,D)) fn = Some f";
  22.230 -by (rtac map_of_SomeI 1);
  22.231 -by  (eatac unique_fields 1 1);
  22.232 -by (eatac fields_mono_lemma 1 1);
  22.233 -by (etac map_of_SomeD 1);
  22.234 -qed "fields_mono";
  22.235 -
  22.236 -Goal 
  22.237 -"[|field (G,C) fn = Some (fd, fT); G\\<turnstile>D\\<preceq>C C; wf_prog wf_mb G|]==> \
  22.238 -\ map_of (fields (G,D)) (fn, fd) = Some fT";
  22.239 -by (dtac field_fields 1);
  22.240 -by (dtac (thm"rtranclD") 1);
  22.241 -by Safe_tac;
  22.242 -by (ftac subcls_is_class 1);
  22.243 -by (dtac trancl_into_rtrancl 1);
  22.244 -by (fast_tac (HOL_cs addDs [fields_mono]) 1);
  22.245 -qed "widen_cfs_fields";
  22.246 -
  22.247 -Goal "wf_prog wf_mb G ==> is_class G C \\<Longrightarrow>  \
  22.248 -\    method (G,C) sig = Some (md,mh,m)\
  22.249 -\  --> G\\<turnstile>C\\<preceq>C md \\<and> wf_mdecl wf_mb G md (sig,(mh,m))";
  22.250 -by( etac subcls1_induct 1);
  22.251 -by(   atac 1);
  22.252 -by(  Force_tac 1);
  22.253 -by( forw_inst_tac [("C","C")] method_rec 1);
  22.254 -by( Clarify_tac 1);
  22.255 -by( rotate_tac ~1 1);
  22.256 -by( Asm_full_simp_tac 1);
  22.257 -by( dtac override_SomeD 1);
  22.258 -by( etac disjE 1);
  22.259 -by(  thin_tac "?P --> ?Q" 1);
  22.260 -by(  Clarify_tac 2);
  22.261 -by(  rtac rtrancl_trans 2);
  22.262 -by(   atac 3);
  22.263 -by(  rtac r_into_rtrancl 2);
  22.264 -by(  fast_tac (HOL_cs addIs [subcls1I]) 2);
  22.265 -by (rotate_tac ~1 1);
  22.266 -by (ftac map_of_SomeD 1);
  22.267 -by( rewtac wf_cdecl_def);
  22.268 -by (Clarsimp_tac 1);
  22.269 -qed_spec_mp "method_wf_mdecl";
  22.270 -
  22.271 -Goal "[|G\\<turnstile>T\\<preceq>C T'; wf_prog wf_mb G|] ==> \
  22.272 -\  \\<forall>D rT b. method (G,T') sig = Some (D,rT ,b) -->\
  22.273 -\ (\\<exists>D' rT' b'. method (G,T) sig = Some (D',rT',b') \\<and> G\\<turnstile>rT'\\<preceq>rT)";
  22.274 -by( dtac (thm"rtranclD") 1);
  22.275 -by( etac disjE 1);
  22.276 -by(  Fast_tac 1);
  22.277 -by( etac conjE 1);
  22.278 -by( etac trancl_trans_induct 1);
  22.279 -by(  Clarify_tac 2);
  22.280 -by(  EVERY[smp_tac 3 2]);
  22.281 -by(  fast_tac (HOL_cs addEs [widen_trans]) 2);
  22.282 -by( Clarify_tac 1);
  22.283 -by( dtac subcls1D 1);
  22.284 -by( Clarify_tac 1);
  22.285 -by( stac method_rec 1);
  22.286 -by(  atac 1);
  22.287 -by( rewtac override_def);
  22.288 -by( asm_simp_tac (simpset() delsimps [split_paired_Ex]) 1);
  22.289 -by( case_tac "\\<exists>z. map_of(map (\\<lambda>(s,m). (s, ?C, m)) ms) sig = Some z" 1);
  22.290 -by(  etac exE 1);
  22.291 -by(  asm_full_simp_tac (HOL_ss addsimps [not_None_eq RS sym]) 2);
  22.292 -by(  ALLGOALS (rotate_tac ~1 THEN' forward_tac[ssubst] THEN' (fn n=>atac(n+1))));
  22.293 -by(  ALLGOALS (asm_simp_tac (simpset() delsimps [split_paired_Ex])));
  22.294 -by( dtac class_wf 1);
  22.295 -by(  atac 1);
  22.296 -by( split_all_tac 1);
  22.297 -by( rewtac wf_cdecl_def);
  22.298 -by( dtac map_of_SomeD 1);
  22.299 -by Auto_tac;
  22.300 -qed_spec_mp "subcls_widen_methd";
  22.301 -
  22.302 -Goal
  22.303 - "[| G\\<turnstile> C\\<preceq>C D; wf_prog wf_mb G; \
  22.304 -\    method (G,D) sig = Some (md, rT, b) |] \
  22.305 -\ ==> \\<exists>mD' rT' b'. method (G,C) sig= Some(mD',rT',b') \\<and> G\\<turnstile>rT'\\<preceq>rT";
  22.306 -by(auto_tac (claset() addDs [subcls_widen_methd,method_wf_mdecl],
  22.307 -             simpset() addsimps [wf_mdecl_def,wf_mhead_def,split_def]));
  22.308 -qed "subtype_widen_methd";
  22.309 -
  22.310 -Goal "wf_prog wf_mb G ==> is_class G C \\<Longrightarrow> \\<forall>D. method (G,C) sig = Some(D,mh,code) --> is_class G D \\<and> method (G,D) sig = Some(D,mh,code)";
  22.311 -by (etac subcls1_induct 1);
  22.312 -  ba 1;
  22.313 - by (Asm_full_simp_tac 1);
  22.314 -by (stac method_rec 1);
  22.315 - ba 1;
  22.316 -by (Clarify_tac 1);
  22.317 -by (eres_inst_tac [("x","Da")] allE 1);
  22.318 -by (Clarsimp_tac 1);
  22.319 - by (asm_full_simp_tac (simpset() addsimps [map_of_map]) 1);
  22.320 - by (Clarify_tac 1);
  22.321 - by (stac method_rec 1);
  22.322 -  ba 1;
  22.323 - by (asm_full_simp_tac (simpset() addsimps [override_def,map_of_map] addsplits [option.split]) 1);
  22.324 -qed_spec_mp "method_in_md";
  22.325 -
  22.326 -Goal "[|is_class G C; wf_prog wf_mb G|] ==> \
  22.327 -\ \\<forall>f\\<in>set (fields (G,C)). is_type G (snd f)";
  22.328 -by( etac subcls1_induct 1);
  22.329 -by(   atac 1);
  22.330 -by(  Asm_simp_tac 1);
  22.331 -by( stac fields_rec 1);
  22.332 -by(   Fast_tac 1);
  22.333 -by(  atac 1);
  22.334 -by( Clarsimp_tac 1);
  22.335 -by( Safe_tac);
  22.336 -by(  Force_tac 2);
  22.337 -by( dtac class_wf 1);
  22.338 -by(  atac 1);
  22.339 -by( rewtac wf_cdecl_def);
  22.340 -by( Clarsimp_tac 1);
  22.341 -by( EVERY[dtac bspec 1, atac 1]);
  22.342 -by( rewtac wf_fdecl_def);
  22.343 -by Auto_tac;
  22.344 -qed_spec_mp "fields_is_type_lemma";
  22.345 -
  22.346 -Goal "[|map_of (fields (G,C)) fn = Some f; wf_prog wf_mb G; is_class G C|] ==> \
  22.347 -\ is_type G f";
  22.348 -by(dtac map_of_SomeD 1);
  22.349 -by(datac fields_is_type_lemma 2 1);
  22.350 -by(Auto_tac);
  22.351 -qed "fields_is_type";
  22.352 -
    23.1 --- a/src/HOL/MicroJava/J/WellForm.thy	Thu Feb 01 20:51:48 2001 +0100
    23.2 +++ b/src/HOL/MicroJava/J/WellForm.thy	Thu Feb 01 20:53:13 2001 +0100
    23.3 @@ -14,31 +14,410 @@
    23.4  * for uniformity, Object is assumed to be declared like any other class
    23.5  *)
    23.6  
    23.7 -WellForm = TypeRel +
    23.8 +theory WellForm = TypeRel:
    23.9  
   23.10 -types 'c wf_mb = 'c prog => cname => 'c mdecl => bool
   23.11 +types 'c wf_mb = "'c prog => cname => 'c mdecl => bool"
   23.12  
   23.13  constdefs
   23.14   wf_fdecl :: "'c prog => fdecl => bool"
   23.15 -"wf_fdecl G == \\<lambda>(fn,ft). is_type G ft"
   23.16 +"wf_fdecl G == \<lambda>(fn,ft). is_type G ft"
   23.17  
   23.18   wf_mhead :: "'c prog => sig => ty => bool"
   23.19 -"wf_mhead G == \\<lambda>(mn,pTs) rT. (\\<forall>T\\<in>set pTs. is_type G T) \\<and> is_type G rT"
   23.20 +"wf_mhead G == \<lambda>(mn,pTs) rT. (\<forall>T\<in>set pTs. is_type G T) \<and> is_type G rT"
   23.21  
   23.22   wf_mdecl :: "'c wf_mb => 'c wf_mb"
   23.23 -"wf_mdecl wf_mb G C == \\<lambda>(sig,rT,mb). wf_mhead G sig rT \\<and> wf_mb G C (sig,rT,mb)"
   23.24 +"wf_mdecl wf_mb G C == \<lambda>(sig,rT,mb). wf_mhead G sig rT \<and> wf_mb G C (sig,rT,mb)"
   23.25  
   23.26   wf_cdecl :: "'c wf_mb => 'c prog => 'c cdecl => bool"
   23.27  "wf_cdecl wf_mb G ==
   23.28 -   \\<lambda>(C,(D,fs,ms)).
   23.29 -  (\\<forall>f\\<in>set fs. wf_fdecl G         f) \\<and>  unique fs \\<and>
   23.30 -  (\\<forall>m\\<in>set ms. wf_mdecl wf_mb G C m) \\<and>  unique ms \\<and>
   23.31 -  (C \\<noteq> Object \\<longrightarrow> is_class G D \\<and>  \\<not>G\\<turnstile>D\\<preceq>C C \\<and>
   23.32 -                   (\\<forall>(sig,rT,b)\\<in>set ms. \\<forall>D' rT' b'.
   23.33 -                      method(G,D) sig = Some(D',rT',b') --> G\\<turnstile>rT\\<preceq>rT'))"
   23.34 +   \<lambda>(C,(D,fs,ms)).
   23.35 +  (\<forall>f\<in>set fs. wf_fdecl G         f) \<and>  unique fs \<and>
   23.36 +  (\<forall>m\<in>set ms. wf_mdecl wf_mb G C m) \<and>  unique ms \<and>
   23.37 +  (C \<noteq> Object \<longrightarrow> is_class G D \<and>  \<not>G\<turnstile>D\<preceq>C C \<and>
   23.38 +                   (\<forall>(sig,rT,b)\<in>set ms. \<forall>D' rT' b'.
   23.39 +                      method(G,D) sig = Some(D',rT',b') --> G\<turnstile>rT\<preceq>rT'))"
   23.40  
   23.41   wf_prog :: "'c wf_mb => 'c prog => bool"
   23.42  "wf_prog wf_mb G ==
   23.43 -   let cs = set G in ObjectC \\<in> cs \\<and> (\\<forall>c\\<in>cs. wf_cdecl wf_mb G c) \\<and> unique G"
   23.44 +   let cs = set G in ObjectC \<in> cs \<and> (\<forall>c\<in>cs. wf_cdecl wf_mb G c) \<and> unique G"
   23.45 +
   23.46 +lemma class_wf: 
   23.47 + "[|class G C = Some c; wf_prog wf_mb G|] ==> wf_cdecl wf_mb G (C,c)"
   23.48 +apply (unfold wf_prog_def class_def)
   23.49 +apply (simp)
   23.50 +apply (fast dest: map_of_SomeD)
   23.51 +done
   23.52 +
   23.53 +lemma class_Object [simp]: 
   23.54 +	"wf_prog wf_mb G ==> class G Object = Some (arbitrary, [], [])"
   23.55 +apply (unfold wf_prog_def ObjectC_def class_def)
   23.56 +apply (auto intro: map_of_SomeI)
   23.57 +done
   23.58 +
   23.59 +lemma is_class_Object [simp]: "wf_prog wf_mb G ==> is_class G Object"
   23.60 +apply (unfold is_class_def)
   23.61 +apply (simp (no_asm_simp))
   23.62 +done
   23.63 +
   23.64 +lemma subcls1_wfD: "[|G\<turnstile>C\<prec>C1D; wf_prog wf_mb G|] ==> D \<noteq> C \<and> \<not>(D,C)\<in>(subcls1 G)^+"
   23.65 +apply( frule r_into_trancl)
   23.66 +apply( drule subcls1D)
   23.67 +apply(clarify)
   23.68 +apply( drule (1) class_wf)
   23.69 +apply( unfold wf_cdecl_def)
   23.70 +apply(force simp add: reflcl_trancl [THEN sym] simp del: reflcl_trancl)
   23.71 +done
   23.72 +
   23.73 +lemma wf_cdecl_supD: 
   23.74 +"!!r. \<lbrakk>wf_cdecl wf_mb G (C,D,r); C \<noteq> Object\<rbrakk> \<Longrightarrow> is_class G D"
   23.75 +apply (unfold wf_cdecl_def)
   23.76 +apply (auto split add: option.split_asm)
   23.77 +done
   23.78 +
   23.79 +lemma subcls_asym: "[|wf_prog wf_mb G; (C,D)\<in>(subcls1 G)^+|] ==> \<not>(D,C)\<in>(subcls1 G)^+"
   23.80 +apply(erule tranclE)
   23.81 +apply(fast dest!: subcls1_wfD )
   23.82 +apply(fast dest!: subcls1_wfD intro: trancl_trans)
   23.83 +done
   23.84 +
   23.85 +lemma subcls_irrefl: "[|wf_prog wf_mb G; (C,D)\<in>(subcls1 G)^+|] ==> C \<noteq> D"
   23.86 +apply (erule trancl_trans_induct)
   23.87 +apply  (auto dest: subcls1_wfD subcls_asym)
   23.88 +done
   23.89 +
   23.90 +lemma acyclic_subcls1: "wf_prog wf_mb G ==> acyclic (subcls1 G)"
   23.91 +apply (unfold acyclic_def)
   23.92 +apply (fast dest: subcls_irrefl)
   23.93 +done
   23.94 +
   23.95 +lemma wf_subcls1: "wf_prog wf_mb G ==> wf ((subcls1 G)^-1)"
   23.96 +apply (rule finite_acyclic_wf)
   23.97 +apply ( subst finite_converse)
   23.98 +apply ( rule finite_subcls1)
   23.99 +apply (subst acyclic_converse)
  23.100 +apply (erule acyclic_subcls1)
  23.101 +done
  23.102 +
  23.103 +lemma subcls_induct: 
  23.104 +"[|wf_prog wf_mb G; !!C. \<forall>D. (C,D)\<in>(subcls1 G)^+ --> P D ==> P C|] ==> P C"
  23.105 +(is "?A \<Longrightarrow> PROP ?P \<Longrightarrow> _")
  23.106 +proof -
  23.107 +  assume p: "PROP ?P"
  23.108 +  assume ?A thus ?thesis apply -
  23.109 +apply(drule wf_subcls1)
  23.110 +apply(drule wf_trancl)
  23.111 +apply(simp only: trancl_converse)
  23.112 +apply(erule_tac a = C in wf_induct)
  23.113 +apply(rule p)
  23.114 +apply(auto)
  23.115 +done
  23.116 +qed
  23.117 +
  23.118 +lemma subcls1_induct:
  23.119 +"[|is_class G C; wf_prog wf_mb G; P Object;  
  23.120 +   !!C D fs ms. [|C \<noteq> Object; is_class G C; class G C = Some (D,fs,ms) \<and>  
  23.121 +    wf_cdecl wf_mb G (C,D,fs,ms) \<and> G\<turnstile>C\<prec>C1D \<and> is_class G D \<and> P D|] ==> P C 
  23.122 + |] ==> P C"
  23.123 +(is "?A \<Longrightarrow> ?B \<Longrightarrow> ?C \<Longrightarrow> PROP ?P \<Longrightarrow> _")
  23.124 +proof -
  23.125 +  assume p: "PROP ?P"
  23.126 +  assume ?A ?B ?C thus ?thesis apply -
  23.127 +apply(unfold is_class_def)
  23.128 +apply( rule impE)
  23.129 +prefer 2
  23.130 +apply(   assumption)
  23.131 +prefer 2
  23.132 +apply(  assumption)
  23.133 +apply( erule thin_rl)
  23.134 +apply( rule subcls_induct)
  23.135 +apply(  assumption)
  23.136 +apply( rule impI)
  23.137 +apply( case_tac "C = Object")
  23.138 +apply(  fast)
  23.139 +apply safe
  23.140 +apply( frule (1) class_wf)
  23.141 +apply( frule (1) wf_cdecl_supD)
  23.142 +
  23.143 +apply( subgoal_tac "G\<turnstile>C\<prec>C1a")
  23.144 +apply( erule_tac [2] subcls1I)
  23.145 +apply(  rule p)
  23.146 +apply (unfold is_class_def)
  23.147 +apply auto
  23.148 +done
  23.149 +qed
  23.150 +
  23.151 +lemmas method_rec = wf_subcls1 [THEN [2] method_rec_lemma];
  23.152 +
  23.153 +lemmas fields_rec = wf_subcls1 [THEN [2] fields_rec_lemma];
  23.154 +
  23.155 +lemma method_Object [simp]: "wf_prog wf_mb G ==> method (G,Object) = empty"
  23.156 +apply(subst method_rec)
  23.157 +apply auto
  23.158 +done
  23.159 +
  23.160 +lemma fields_Object [simp]: "wf_prog wf_mb G ==> fields (G,Object) = []"
  23.161 +apply(subst fields_rec)
  23.162 +apply auto
  23.163 +done
  23.164 +
  23.165 +lemma field_Object [simp]: "wf_prog wf_mb G ==> field (G,Object) = empty"
  23.166 +apply (unfold field_def)
  23.167 +apply(simp (no_asm_simp))
  23.168 +done
  23.169 +
  23.170 +lemma subcls_C_Object: "[|is_class G C; wf_prog wf_mb G|] ==> G\<turnstile>C\<preceq>C Object"
  23.171 +apply(erule subcls1_induct)
  23.172 +apply(  assumption)
  23.173 +apply( fast)
  23.174 +apply(auto dest!: wf_cdecl_supD)
  23.175 +apply(erule (1) rtrancl_into_rtrancl2)
  23.176 +done
  23.177 +
  23.178 +lemma is_type_rTI: "wf_mhead G sig rT ==> is_type G rT"
  23.179 +apply (unfold wf_mhead_def)
  23.180 +apply auto
  23.181 +done
  23.182 +
  23.183 +lemma widen_fields_defpl': "[|is_class G C; wf_prog wf_mb G|] ==>  
  23.184 +  \<forall>((fn,fd),fT)\<in>set (fields (G,C)). G\<turnstile>C\<preceq>C fd"
  23.185 +apply( erule subcls1_induct)
  23.186 +apply(   assumption)
  23.187 +apply(  simp (no_asm_simp))
  23.188 +apply( tactic "safe_tac HOL_cs")
  23.189 +apply( subst fields_rec)
  23.190 +apply(   assumption)
  23.191 +apply(  assumption)
  23.192 +apply( simp (no_asm) split del: split_if)
  23.193 +apply( rule ballI)
  23.194 +apply( simp (no_asm_simp) only: split_tupled_all)
  23.195 +apply( simp (no_asm))
  23.196 +apply( erule UnE)
  23.197 +apply(  force)
  23.198 +apply( erule r_into_rtrancl [THEN rtrancl_trans])
  23.199 +apply auto
  23.200 +done
  23.201 +
  23.202 +lemma widen_fields_defpl: "[|((fn,fd),fT) \<in> set (fields (G,C)); wf_prog wf_mb G; is_class G C|] ==>  
  23.203 +  G\<turnstile>C\<preceq>C fd"
  23.204 +apply( drule (1) widen_fields_defpl')
  23.205 +apply (fast)
  23.206 +done
  23.207 +
  23.208 +lemma unique_fields: "[|is_class G C; wf_prog wf_mb G|] ==> unique (fields (G,C))"
  23.209 +apply( erule subcls1_induct)
  23.210 +apply(   assumption)
  23.211 +apply(  safe dest!: wf_cdecl_supD)
  23.212 +apply(  simp (no_asm_simp))
  23.213 +apply( drule subcls1_wfD)
  23.214 +apply(  assumption)
  23.215 +apply( subst fields_rec)
  23.216 +apply   auto
  23.217 +apply( rotate_tac -1)
  23.218 +apply( frule class_wf)
  23.219 +apply  auto
  23.220 +apply( simp add: wf_cdecl_def)
  23.221 +apply( erule unique_append)
  23.222 +apply(  rule unique_map_inj)
  23.223 +apply(   clarsimp)
  23.224 +apply  (rule injI)
  23.225 +apply(  simp)
  23.226 +apply(auto dest!: widen_fields_defpl)
  23.227 +done
  23.228 +
  23.229 +lemma fields_mono_lemma [rule_format (no_asm)]: "[|wf_prog wf_mb G; (C',C)\<in>(subcls1 G)^*|] ==>  
  23.230 +  x \<in> set (fields (G,C)) --> x \<in> set (fields (G,C'))"
  23.231 +apply(erule converse_rtrancl_induct)
  23.232 +apply( safe dest!: subcls1D)
  23.233 +apply(subst fields_rec)
  23.234 +apply(  auto)
  23.235 +done
  23.236 +
  23.237 +lemma fields_mono: 
  23.238 +"\<lbrakk>map_of (fields (G,C)) fn = Some f; G\<turnstile>D\<preceq>C C; is_class G D; wf_prog wf_mb G\<rbrakk> 
  23.239 +  \<Longrightarrow> map_of (fields (G,D)) fn = Some f"
  23.240 +apply (rule map_of_SomeI)
  23.241 +apply  (erule (1) unique_fields)
  23.242 +apply (erule (1) fields_mono_lemma)
  23.243 +apply (erule map_of_SomeD)
  23.244 +done
  23.245 +
  23.246 +lemma widen_cfs_fields: 
  23.247 +"[|field (G,C) fn = Some (fd, fT); G\<turnstile>D\<preceq>C C; wf_prog wf_mb G|]==>  
  23.248 +  map_of (fields (G,D)) (fn, fd) = Some fT"
  23.249 +apply (drule field_fields)
  23.250 +apply (drule rtranclD)
  23.251 +apply safe
  23.252 +apply (frule subcls_is_class)
  23.253 +apply (drule trancl_into_rtrancl)
  23.254 +apply (fast dest: fields_mono)
  23.255 +done
  23.256 +
  23.257 +lemma method_wf_mdecl [rule_format (no_asm)]: "wf_prog wf_mb G ==> is_class G C \<Longrightarrow>   
  23.258 +     method (G,C) sig = Some (md,mh,m) 
  23.259 +   --> G\<turnstile>C\<preceq>C md \<and> wf_mdecl wf_mb G md (sig,(mh,m))"
  23.260 +apply( erule subcls1_induct)
  23.261 +apply(   assumption)
  23.262 +apply(  force)
  23.263 +apply( clarify)
  23.264 +apply( frule_tac C = C in method_rec)
  23.265 +apply(  assumption)
  23.266 +apply( rotate_tac -1)
  23.267 +apply( simp)
  23.268 +apply( drule override_SomeD)
  23.269 +apply( erule disjE)
  23.270 +apply(  erule_tac V = "?P --> ?Q" in thin_rl)
  23.271 +apply (frule map_of_SomeD)
  23.272 +apply (clarsimp simp add: wf_cdecl_def)
  23.273 +apply( clarify)
  23.274 +apply( rule rtrancl_trans)
  23.275 +prefer 2
  23.276 +apply(  assumption)
  23.277 +apply( rule r_into_rtrancl)
  23.278 +apply( fast intro: subcls1I)
  23.279 +done
  23.280 +
  23.281 +lemma subcls_widen_methd [rule_format (no_asm)]: 
  23.282 +  "[|G\<turnstile>T\<preceq>C T'; wf_prog wf_mb G|] ==>  
  23.283 +   \<forall>D rT b. method (G,T') sig = Some (D,rT ,b) --> 
  23.284 +  (\<exists>D' rT' b'. method (G,T) sig = Some (D',rT',b') \<and> G\<turnstile>rT'\<preceq>rT)"
  23.285 +apply( drule rtranclD)
  23.286 +apply( erule disjE)
  23.287 +apply(  fast)
  23.288 +apply( erule conjE)
  23.289 +apply( erule trancl_trans_induct)
  23.290 +prefer 2
  23.291 +apply(  clarify)
  23.292 +apply(  drule spec, drule spec, drule spec, erule (1) impE)
  23.293 +apply(  fast elim: widen_trans)
  23.294 +apply( clarify)
  23.295 +apply( drule subcls1D)
  23.296 +apply( clarify)
  23.297 +apply( subst method_rec)
  23.298 +apply(  assumption)
  23.299 +apply( unfold override_def)
  23.300 +apply( simp (no_asm_simp) del: split_paired_Ex)
  23.301 +apply( case_tac "\<exists>z. map_of(map (\<lambda>(s,m). (s, ?C, m)) ms) sig = Some z")
  23.302 +apply(  erule exE)
  23.303 +apply(  rotate_tac -1, frule ssubst, erule_tac [2] asm_rl)
  23.304 +prefer 2
  23.305 +apply(  rotate_tac -1, frule ssubst, erule_tac [2] asm_rl)
  23.306 +apply(  tactic "asm_full_simp_tac (HOL_ss addsimps [not_None_eq RS sym]) 1")
  23.307 +apply(  simp_all (no_asm_simp) del: split_paired_Ex)
  23.308 +apply( drule (1) class_wf)
  23.309 +apply( simp (no_asm_simp) only: split_tupled_all)
  23.310 +apply( unfold wf_cdecl_def)
  23.311 +apply( drule map_of_SomeD)
  23.312 +apply auto
  23.313 +done
  23.314 +
  23.315 +lemma subtype_widen_methd: 
  23.316 + "[| G\<turnstile> C\<preceq>C D; wf_prog wf_mb G;  
  23.317 +     method (G,D) sig = Some (md, rT, b) |]  
  23.318 +  ==> \<exists>mD' rT' b'. method (G,C) sig= Some(mD',rT',b') \<and> G\<turnstile>rT'\<preceq>rT"
  23.319 +apply(auto dest: subcls_widen_methd method_wf_mdecl simp add: wf_mdecl_def wf_mhead_def split_def)
  23.320 +done
  23.321 +
  23.322 +lemma method_in_md [rule_format (no_asm)]: "wf_prog wf_mb G ==> is_class G C \<Longrightarrow> \<forall>D. method (G,C) sig = Some(D,mh,code) --> is_class G D \<and> method (G,D) sig = Some(D,mh,code)"
  23.323 +apply (erule (1) subcls1_induct)
  23.324 + apply (simp)
  23.325 +apply (erule conjE)
  23.326 +apply (subst method_rec)
  23.327 +  apply (assumption)
  23.328 + apply (assumption)
  23.329 +apply (clarify)
  23.330 +apply (erule_tac "x" = "Da" in allE)
  23.331 +apply (clarsimp)
  23.332 + apply (simp add: map_of_map)
  23.333 + apply (clarify)
  23.334 + apply (subst method_rec)
  23.335 +   apply (assumption)
  23.336 +  apply (assumption)
  23.337 + apply (simp add: override_def map_of_map split add: option.split)
  23.338 +done
  23.339 +
  23.340 +lemma widen_methd: 
  23.341 +"[| method (G,C) sig = Some (md,rT,b); wf_prog wf_mb G; G\<turnstile>T''\<preceq>C C|] 
  23.342 +  ==> \<exists>md' rT' b'. method (G,T'') sig = Some (md',rT',b') \<and> G\<turnstile>rT'\<preceq>rT"
  23.343 +apply( drule subcls_widen_methd)
  23.344 +apply   auto
  23.345 +done
  23.346 +
  23.347 +lemma Call_lemma: 
  23.348 +"[|method (G,C) sig = Some (md,rT,b); G\<turnstile>T''\<preceq>C C; wf_prog wf_mb G;  
  23.349 +  class G C = Some y|] ==> \<exists>T' rT' b. method (G,T'') sig = Some (T',rT',b) \<and>  
  23.350 +  G\<turnstile>rT'\<preceq>rT \<and> G\<turnstile>T''\<preceq>C T' \<and> wf_mhead G sig rT' \<and> wf_mb G T' (sig,rT',b)"
  23.351 +apply( drule (2) widen_methd)
  23.352 +apply( clarify)
  23.353 +apply( frule subcls_is_class2)
  23.354 +apply (unfold is_class_def)
  23.355 +apply (simp (no_asm_simp))
  23.356 +apply( drule method_wf_mdecl)
  23.357 +apply( unfold wf_mdecl_def)
  23.358 +apply( unfold is_class_def)
  23.359 +apply auto
  23.360 +done
  23.361 +
  23.362 +
  23.363 +lemma fields_is_type_lemma [rule_format (no_asm)]: "[|is_class G C; wf_prog wf_mb G|] ==>  
  23.364 +  \<forall>f\<in>set (fields (G,C)). is_type G (snd f)"
  23.365 +apply( erule (1) subcls1_induct)
  23.366 +apply(  simp (no_asm_simp))
  23.367 +apply( subst fields_rec)
  23.368 +apply(   fast)
  23.369 +apply(  assumption)
  23.370 +apply( clarsimp)
  23.371 +apply( safe)
  23.372 +prefer 2
  23.373 +apply(  force)
  23.374 +apply( drule (1) class_wf)
  23.375 +apply( unfold wf_cdecl_def)
  23.376 +apply( clarsimp)
  23.377 +apply( drule (1) bspec)
  23.378 +apply( unfold wf_fdecl_def)
  23.379 +apply auto
  23.380 +done
  23.381 +
  23.382 +lemma fields_is_type: "[|map_of (fields (G,C)) fn = Some f; wf_prog wf_mb G; is_class G C|] ==>  
  23.383 +  is_type G f"
  23.384 +apply(drule map_of_SomeD)
  23.385 +apply(drule (2) fields_is_type_lemma)
  23.386 +apply(auto)
  23.387 +done
  23.388 +
  23.389 +lemma methd:
  23.390 +  "[| wf_prog wf_mb G; (C,S,fs,mdecls) \<in> set G; (sig,rT,code) \<in> set mdecls |]
  23.391 +  ==> method (G,C) sig = Some(C,rT,code) \<and> is_class G C"
  23.392 +proof -
  23.393 +  assume wf: "wf_prog wf_mb G" 
  23.394 +  assume C:  "(C,S,fs,mdecls) \<in> set G"
  23.395 +
  23.396 +  assume m: "(sig,rT,code) \<in> set mdecls"
  23.397 +  moreover
  23.398 +  from wf
  23.399 +  have "class G Object = Some (arbitrary, [], [])"
  23.400 +    by simp 
  23.401 +  moreover
  23.402 +  from wf C
  23.403 +  have c: "class G C = Some (S,fs,mdecls)"
  23.404 +    by (auto simp add: wf_prog_def class_def is_class_def intro: map_of_SomeI)
  23.405 +  ultimately
  23.406 +  have O: "C \<noteq> Object"
  23.407 +    by auto
  23.408 +      
  23.409 +  from wf C
  23.410 +  have "unique mdecls"
  23.411 +    by (unfold wf_prog_def wf_cdecl_def) auto
  23.412 +
  23.413 +  hence "unique (map (\<lambda>(s,m). (s,C,m)) mdecls)"
  23.414 +    by - (induct mdecls, auto)
  23.415 +
  23.416 +  with m
  23.417 +  have "map_of (map (\<lambda>(s,m). (s,C,m)) mdecls) sig = Some (C,rT,code)"
  23.418 +    by (force intro: map_of_SomeI)
  23.419 +
  23.420 +  with wf C m c O
  23.421 +  show ?thesis
  23.422 +    by (auto simp add: is_class_def dest: method_rec)
  23.423 +qed
  23.424  
  23.425  end
    24.1 --- a/src/HOL/MicroJava/J/WellType.ML	Thu Feb 01 20:51:48 2001 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,75 +0,0 @@
    24.4 -(*  Title:      HOL/MicroJava/J/WellType.ML
    24.5 -    ID:         $Id$
    24.6 -    Author:     David von Oheimb
    24.7 -    Copyright   1999 Technische Universitaet Muenchen
    24.8 -*)
    24.9 -
   24.10 -Goal
   24.11 -"[| method (G,C) sig = Some (md,rT,b); wf_prog wf_mb G; G\\<turnstile>T''\\<preceq>C C|]\
   24.12 -\ ==> \\<exists>md' rT' b'. method (G,T'') sig = Some (md',rT',b') \\<and> G\\<turnstile>rT'\\<preceq>rT";
   24.13 -by( dtac subcls_widen_methd 1);
   24.14 -by   Auto_tac;
   24.15 -qed "widen_methd";
   24.16 -
   24.17 -
   24.18 -Goal
   24.19 -"[|method (G,C) sig = Some (md,rT,b); G\\<turnstile>T''\\<preceq>C C; wf_prog wf_mb G; \
   24.20 -\ class G C = Some y|] ==> \\<exists>T' rT' b. method (G,T'') sig = Some (T',rT',b) \\<and> \
   24.21 -\ G\\<turnstile>rT'\\<preceq>rT \\<and> G\\<turnstile>T''\\<preceq>C T' \\<and> wf_mhead G sig rT' \\<and> wf_mb G T' (sig,rT',b)"; 
   24.22 -by( datac widen_methd 2 1);
   24.23 -by( Clarify_tac 1);
   24.24 -by( ftac subcls_is_class2 1);
   24.25 -by (rewtac is_class_def);
   24.26 -by (Asm_simp_tac 1);
   24.27 -by( dtac method_wf_mdecl 1);
   24.28 -by( rewtac wf_mdecl_def);
   24.29 -by( rewtac is_class_def);
   24.30 -by Auto_tac;
   24.31 -qed "Call_lemma";
   24.32 -
   24.33 -Goal "wf_prog wf_mb G ==> method (G,Object) sig = None";
   24.34 -by (Asm_simp_tac 1);
   24.35 -qed "method_Object";
   24.36 -Addsimps [method_Object];
   24.37 -
   24.38 -Goalw [max_spec_def] 
   24.39 -  "x \\<in> max_spec G C sig ==> x \\<in> appl_methds G C sig";
   24.40 -by (Fast_tac 1);
   24.41 -qed"max_spec2appl_meths";
   24.42 -
   24.43 -Goalw [appl_methds_def] 
   24.44 -"((md,rT),pTs')\\<in>appl_methds G C (mn, pTs) ==> \
   24.45 -\ \\<exists>D b. md = Class D \\<and> method (G,C) (mn, pTs') = Some (D,rT,b) \
   24.46 -\ \\<and> list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') pTs pTs'";
   24.47 -by (Fast_tac 1);
   24.48 -qed "appl_methsD";
   24.49 -
   24.50 -bind_thm ("max_spec2mheads", insertI1 RSN (2,(equalityD2 RS subsetD)) RS 
   24.51 -                      max_spec2appl_meths RS appl_methsD);
   24.52 -
   24.53 -Goal "(\\<forall>a. v \\<noteq> Addr a) --> (\\<exists>T. typeof t v = Some T \\<and> is_type G T)";
   24.54 -by (rtac val_.induct 1);
   24.55 -by (Fast_tac 5);
   24.56 -by Auto_tac;
   24.57 -qed_spec_mp "is_type_typeof";
   24.58 -Addsimps [is_type_typeof];
   24.59 -
   24.60 -Goal "typeof (\\<lambda>a. None) v = Some T \\<longrightarrow> is_type G T";
   24.61 -by (rtac val_.induct 1);
   24.62 -by     Auto_tac;
   24.63 -qed_spec_mp "typeof_empty_is_type";
   24.64 -
   24.65 -Goal "wf_prog wf_mb G \\<Longrightarrow> ((G,L)\\<turnstile>e::T \\<longrightarrow> is_type G T) \\<and> \
   24.66 -\      ((G,L)\\<turnstile>es[::]Ts \\<longrightarrow> Ball (set Ts) (is_type G)) \\<and> ((G,L)\\<turnstile>c \\<surd> \\<longrightarrow> True)";
   24.67 -by (rtac ty_expr_ty_exprs_wt_stmt.induct 1);
   24.68 -by Auto_tac;
   24.69 -by (   etac typeof_empty_is_type 1);
   24.70 -by (  asm_full_simp_tac (simpset() addsplits [split_if_asm]) 1);
   24.71 -by ( dtac field_fields 1);
   24.72 -by ( datac fields_is_type 1 1);
   24.73 -by (  Asm_simp_tac 1);
   24.74 -ba 1;
   24.75 -by (auto_tac (claset() addSDs [max_spec2mheads,method_wf_mdecl,is_type_rTI], simpset()addsimps[wf_mdecl_def]));
   24.76 -qed "wt_is_type";
   24.77 -
   24.78 -bind_thm ("ty_expr_is_type", permute_prems 0 1 (wt_is_type RS conjunct1 RS mp));
    25.1 --- a/src/HOL/MicroJava/J/WellType.thy	Thu Feb 01 20:51:48 2001 +0100
    25.2 +++ b/src/HOL/MicroJava/J/WellType.thy	Thu Feb 01 20:53:13 2001 +0100
    25.3 @@ -15,41 +15,59 @@
    25.4  
    25.5  *)
    25.6  
    25.7 -WellType = Term + WellForm +
    25.8 +theory WellType = Term + WellForm:
    25.9  
   25.10  types	lenv (* local variables, including method parameters and This *)
   25.11 -	= "vname \\<leadsto> ty"
   25.12 +	= "vname \<leadsto> ty"
   25.13          'c env
   25.14 -	= "'c prog \\<times> lenv"
   25.15 +	= "'c prog \<times> lenv"
   25.16  
   25.17  syntax
   25.18    prg    :: "'c env => 'c prog"
   25.19 -  localT :: "'c env => (vname \\<leadsto> ty)"
   25.20 +  localT :: "'c env => (vname \<leadsto> ty)"
   25.21  
   25.22  translations	
   25.23    "prg"    => "fst"
   25.24    "localT" => "snd"
   25.25  
   25.26  consts
   25.27 -  more_spec :: "'c prog => (ty \\<times> 'x) \\<times> ty list =>
   25.28 -                (ty \\<times> 'x) \\<times> ty list => bool"
   25.29 -  appl_methds :: "'c prog =>  cname => sig => ((ty \\<times> ty) \\<times> ty list) set"
   25.30 -  max_spec :: "'c prog =>  cname => sig => ((ty \\<times> ty) \\<times> ty list) set"
   25.31 +  more_spec :: "'c prog => (ty \<times> 'x) \<times> ty list =>
   25.32 +                (ty \<times> 'x) \<times> ty list => bool"
   25.33 +  appl_methds :: "'c prog =>  cname => sig => ((ty \<times> ty) \<times> ty list) set"
   25.34 +  max_spec :: "'c prog =>  cname => sig => ((ty \<times> ty) \<times> ty list) set"
   25.35  
   25.36  defs
   25.37 -  more_spec_def "more_spec G == \\<lambda>((d,h),pTs). \\<lambda>((d',h'),pTs'). G\\<turnstile>d\\<preceq>d' \\<and>
   25.38 -		                            list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') pTs pTs'"
   25.39 +  more_spec_def: "more_spec G == \<lambda>((d,h),pTs). \<lambda>((d',h'),pTs'). G\<turnstile>d\<preceq>d' \<and>
   25.40 +		                            list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') pTs pTs'"
   25.41    
   25.42    (* applicable methods, cf. 15.11.2.1 *)
   25.43 -  appl_methds_def "appl_methds G C == \\<lambda>(mn, pTs).
   25.44 +  appl_methds_def: "appl_methds G C == \<lambda>(mn, pTs).
   25.45  		                 {((Class md,rT),pTs') |md rT mb pTs'.
   25.46 -		                  method (G,C)  (mn, pTs') = Some (md,rT,mb) \\<and>
   25.47 -		                  list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') pTs pTs'}"
   25.48 +		                  method (G,C)  (mn, pTs') = Some (md,rT,mb) \<and>
   25.49 +		                  list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') pTs pTs'}"
   25.50  
   25.51    (* maximally specific methods, cf. 15.11.2.2 *)
   25.52 -  max_spec_def "max_spec G C sig == {m. m \\<in>appl_methds G C sig \\<and> 
   25.53 -                                      (\\<forall>m'\\<in>appl_methds G C sig.
   25.54 -                                        more_spec G m' m --> m' = m)}"
   25.55 +  max_spec_def: "max_spec G C sig == {m. m \<in>appl_methds G C sig \<and> 
   25.56 +                                       (\<forall>m'\<in>appl_methds G C sig.
   25.57 +                                         more_spec G m' m --> m' = m)}"
   25.58 +
   25.59 +lemma max_spec2appl_meths: 
   25.60 +  "x \<in> max_spec G C sig ==> x \<in> appl_methds G C sig"
   25.61 +apply (unfold max_spec_def)
   25.62 +apply (fast)
   25.63 +done
   25.64 +
   25.65 +lemma appl_methsD: 
   25.66 +"((md,rT),pTs')\<in>appl_methds G C (mn, pTs) ==>  
   25.67 +  \<exists>D b. md = Class D \<and> method (G,C) (mn, pTs') = Some (D,rT,b)  
   25.68 +  \<and> list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') pTs pTs'"
   25.69 +apply (unfold appl_methds_def)
   25.70 +apply (fast)
   25.71 +done
   25.72 +
   25.73 +lemmas max_spec2mheads = insertI1 [THEN [2] equalityD2 [THEN subsetD], 
   25.74 +                         THEN max_spec2appl_meths, THEN appl_methsD]
   25.75 +
   25.76  
   25.77  consts
   25.78    typeof :: "(loc => ty option) => val => ty option"
   25.79 @@ -61,19 +79,30 @@
   25.80  	"typeof dt (Intg i) = Some (PrimT Integer)"
   25.81  	"typeof dt (Addr a) = dt a"
   25.82  
   25.83 +lemma is_type_typeof [rule_format (no_asm), simp]: "(\<forall>a. v \<noteq> Addr a) --> (\<exists>T. typeof t v = Some T \<and> is_type G T)"
   25.84 +apply (rule val.induct)
   25.85 +apply     auto
   25.86 +done
   25.87 +
   25.88 +lemma typeof_empty_is_type [rule_format (no_asm)]: 
   25.89 +  "typeof (\<lambda>a. None) v = Some T \<longrightarrow> is_type G T"
   25.90 +apply (rule val.induct)
   25.91 +apply     auto
   25.92 +done
   25.93 +
   25.94  types
   25.95 -	java_mb = "vname list \\<times> (vname \\<times> ty) list \\<times> stmt \\<times> expr"
   25.96 +	java_mb = "vname list \<times> (vname \<times> ty) list \<times> stmt \<times> expr"
   25.97  	(* method body with parameter names, local variables, block, result expression *)
   25.98  
   25.99  consts
  25.100 -  ty_expr :: "java_mb env => (expr      \\<times> ty     ) set"
  25.101 -  ty_exprs:: "java_mb env => (expr list \\<times> ty list) set"
  25.102 +  ty_expr :: "java_mb env => (expr      \<times> ty     ) set"
  25.103 +  ty_exprs:: "java_mb env => (expr list \<times> ty list) set"
  25.104    wt_stmt :: "java_mb env =>  stmt                 set"
  25.105  
  25.106  syntax
  25.107 -  ty_expr :: "java_mb env => [expr     , ty     ] => bool" ("_ \\<turnstile> _ :: _"   [51,51,51]50)
  25.108 -  ty_exprs:: "java_mb env => [expr list, ty list] => bool" ("_ \\<turnstile> _ [::] _" [51,51,51]50)
  25.109 -  wt_stmt :: "java_mb env =>  stmt                => bool" ("_ \\<turnstile> _ \\<surd>"      [51,51   ]50)
  25.110 +  ty_expr :: "java_mb env => [expr     , ty     ] => bool" ("_ \<turnstile> _ :: _"   [51,51,51]50)
  25.111 +  ty_exprs:: "java_mb env => [expr list, ty list] => bool" ("_ \<turnstile> _ [::] _" [51,51,51]50)
  25.112 +  wt_stmt :: "java_mb env =>  stmt                => bool" ("_ \<turnstile> _ \<surd>"      [51,51   ]50)
  25.113  
  25.114  syntax (HTML)
  25.115    ty_expr :: "java_mb env => [expr     , ty     ] => bool" ("_ |- _ :: _"   [51,51,51]50)
  25.116 @@ -82,107 +111,123 @@
  25.117  
  25.118  
  25.119  translations
  25.120 -	"E\\<turnstile>e :: T" == "(e,T) \\<in> ty_expr  E"
  25.121 -	"E\\<turnstile>e[::]T" == "(e,T) \\<in> ty_exprs E"
  25.122 -	"E\\<turnstile>c \\<surd>"    == "c     \\<in> wt_stmt  E"
  25.123 +	"E\<turnstile>e :: T" == "(e,T) \<in> ty_expr  E"
  25.124 +	"E\<turnstile>e[::]T" == "(e,T) \<in> ty_exprs E"
  25.125 +	"E\<turnstile>c \<surd>"    == "c     \<in> wt_stmt  E"
  25.126    
  25.127 -inductive "ty_expr E" "ty_exprs E" "wt_stmt E" intrs
  25.128 +inductive "ty_expr E" "ty_exprs E" "wt_stmt E" intros
  25.129  
  25.130  (* well-typed expressions *)
  25.131  
  25.132    (* cf. 15.8 *)
  25.133 -  NewC	"[| is_class (prg E) C |] ==>
  25.134 -         E\\<turnstile>NewC C::Class C"
  25.135 +  NewC:	"[| is_class (prg E) C |] ==>
  25.136 +         E\<turnstile>NewC C::Class C"
  25.137  
  25.138    (* cf. 15.15 *)
  25.139 -  Cast  "[| E\\<turnstile>e::Class C; is_class (prg E) D;
  25.140 -            prg E\\<turnstile>C\\<preceq>? D |] ==>
  25.141 -         E\\<turnstile>Cast D e::Class D"
  25.142 +  Cast:	"[| E\<turnstile>e::Class C; is_class (prg E) D;
  25.143 +            prg E\<turnstile>C\<preceq>? D |] ==>
  25.144 +         E\<turnstile>Cast D e::Class D"
  25.145  
  25.146    (* cf. 15.7.1 *)
  25.147 -  Lit	  "[| typeof (\\<lambda>v. None) x = Some T |] ==>
  25.148 -         E\\<turnstile>Lit x::T"
  25.149 +  Lit:	  "[| typeof (\<lambda>v. None) x = Some T |] ==>
  25.150 +         E\<turnstile>Lit x::T"
  25.151  
  25.152    
  25.153    (* cf. 15.13.1 *)
  25.154 -  LAcc  "[| localT E v = Some T; is_type (prg E) T |] ==>
  25.155 -         E\\<turnstile>LAcc v::T"
  25.156 +  LAcc:	"[| localT E v = Some T; is_type (prg E) T |] ==>
  25.157 +         E\<turnstile>LAcc v::T"
  25.158  
  25.159 -  BinOp "[| E\\<turnstile>e1::T;
  25.160 -            E\\<turnstile>e2::T;
  25.161 +  BinOp:"[| E\<turnstile>e1::T;
  25.162 +            E\<turnstile>e2::T;
  25.163              if bop = Eq then T' = PrimT Boolean
  25.164 -                        else T' = T \\<and> T = PrimT Integer|] ==>
  25.165 -         E\\<turnstile>BinOp bop e1 e2::T'"
  25.166 +                        else T' = T \<and> T = PrimT Integer|] ==>
  25.167 +         E\<turnstile>BinOp bop e1 e2::T'"
  25.168  
  25.169    (* cf. 15.25, 15.25.1 *)
  25.170 -  LAss  "[| E\\<turnstile>LAcc v::T;
  25.171 -	          E\\<turnstile>e::T';
  25.172 -            prg E\\<turnstile>T'\\<preceq>T |] ==>
  25.173 -         E\\<turnstile>v::=e::T'"
  25.174 +  LAss: "[| E\<turnstile>LAcc v::T;
  25.175 +	          E\<turnstile>e::T';
  25.176 +            prg E\<turnstile>T'\<preceq>T |] ==>
  25.177 +         E\<turnstile>v::=e::T'"
  25.178  
  25.179    (* cf. 15.10.1 *)
  25.180 -  FAcc  "[| E\\<turnstile>a::Class C; 
  25.181 +  FAcc: "[| E\<turnstile>a::Class C; 
  25.182              field (prg E,C) fn = Some (fd,fT) |] ==>
  25.183 -         E\\<turnstile>{fd}a..fn::fT"
  25.184 +         E\<turnstile>{fd}a..fn::fT"
  25.185  
  25.186    (* cf. 15.25, 15.25.1 *)
  25.187 -  FAss  "[| E\\<turnstile>{fd}a..fn::T;
  25.188 -            E\\<turnstile>v        ::T';
  25.189 -            prg E\\<turnstile>T'\\<preceq>T |] ==>
  25.190 -         E\\<turnstile>{fd}a..fn:=v::T'"
  25.191 +  FAss: "[| E\<turnstile>{fd}a..fn::T;
  25.192 +            E\<turnstile>v        ::T';
  25.193 +            prg E\<turnstile>T'\<preceq>T |] ==>
  25.194 +         E\<turnstile>{fd}a..fn:=v::T'"
  25.195  
  25.196  
  25.197    (* cf. 15.11.1, 15.11.2, 15.11.3 *)
  25.198 -  Call  "[| E\\<turnstile>a::Class C;
  25.199 -            E\\<turnstile>ps[::]pTs;
  25.200 +  Call: "[| E\<turnstile>a::Class C;
  25.201 +            E\<turnstile>ps[::]pTs;
  25.202              max_spec (prg E) C (mn, pTs) = {((md,rT),pTs')} |] ==>
  25.203 -         E\\<turnstile>{C}a..mn({pTs'}ps)::rT"
  25.204 +         E\<turnstile>{C}a..mn({pTs'}ps)::rT"
  25.205  
  25.206  (* well-typed expression lists *)
  25.207  
  25.208    (* cf. 15.11.??? *)
  25.209 -  Nil  "E\\<turnstile>[][::][]"
  25.210 +  Nil: "E\<turnstile>[][::][]"
  25.211  
  25.212    (* cf. 15.11.??? *)
  25.213 -  Cons "[| E\\<turnstile>e::T;
  25.214 -           E\\<turnstile>es[::]Ts |] ==>
  25.215 -        E\\<turnstile>e#es[::]T#Ts"
  25.216 +  Cons:"[| E\<turnstile>e::T;
  25.217 +           E\<turnstile>es[::]Ts |] ==>
  25.218 +        E\<turnstile>e#es[::]T#Ts"
  25.219  
  25.220  (* well-typed statements *)
  25.221  
  25.222 -  Skip "E\\<turnstile>Skip\\<surd>"
  25.223 +  Skip:"E\<turnstile>Skip\<surd>"
  25.224  
  25.225 -  Expr "[| E\\<turnstile>e::T |] ==>
  25.226 -        E\\<turnstile>Expr e\\<surd>"
  25.227 +  Expr:"[| E\<turnstile>e::T |] ==>
  25.228 +        E\<turnstile>Expr e\<surd>"
  25.229  
  25.230 -  Comp "[| E\\<turnstile>s1\\<surd>; 
  25.231 -           E\\<turnstile>s2\\<surd> |] ==>
  25.232 -        E\\<turnstile>s1;; s2\\<surd>"
  25.233 +  Comp:"[| E\<turnstile>s1\<surd>; 
  25.234 +           E\<turnstile>s2\<surd> |] ==>
  25.235 +        E\<turnstile>s1;; s2\<surd>"
  25.236  
  25.237    (* cf. 14.8 *)
  25.238 -  Cond "[| E\\<turnstile>e::PrimT Boolean;
  25.239 -           E\\<turnstile>s1\\<surd>;
  25.240 -           E\\<turnstile>s2\\<surd> |] ==>
  25.241 -         E\\<turnstile>If(e) s1 Else s2\\<surd>"
  25.242 +  Cond:"[| E\<turnstile>e::PrimT Boolean;
  25.243 +           E\<turnstile>s1\<surd>;
  25.244 +           E\<turnstile>s2\<surd> |] ==>
  25.245 +         E\<turnstile>If(e) s1 Else s2\<surd>"
  25.246  
  25.247    (* cf. 14.10 *)
  25.248 -  Loop "[| E\\<turnstile>e::PrimT Boolean;
  25.249 -           E\\<turnstile>s\\<surd> |] ==>
  25.250 -        E\\<turnstile>While(e) s\\<surd>"
  25.251 +  Loop:"[| E\<turnstile>e::PrimT Boolean;
  25.252 +           E\<turnstile>s\<surd> |] ==>
  25.253 +        E\<turnstile>While(e) s\<surd>"
  25.254  
  25.255  constdefs
  25.256  
  25.257 - wf_java_mdecl :: java_mb prog => cname => java_mb mdecl => bool
  25.258 -"wf_java_mdecl G C == \\<lambda>((mn,pTs),rT,(pns,lvars,blk,res)).
  25.259 -	length pTs = length pns \\<and>
  25.260 -	nodups pns \\<and>
  25.261 -	unique lvars \\<and>
  25.262 -	(\\<forall>pn\\<in>set pns. map_of lvars pn = None) \\<and>
  25.263 -	(\\<forall>(vn,T)\\<in>set lvars. is_type G T) &
  25.264 -	(let E = (G,map_of lvars(pns[\\<mapsto>]pTs)(This\\<mapsto>Class C)) in
  25.265 -	 E\\<turnstile>blk\\<surd> \\<and> (\\<exists>T. E\\<turnstile>res::T \\<and> G\\<turnstile>T\\<preceq>rT))"
  25.266 + wf_java_mdecl :: "java_mb prog => cname => java_mb mdecl => bool"
  25.267 +"wf_java_mdecl G C == \<lambda>((mn,pTs),rT,(pns,lvars,blk,res)).
  25.268 +	length pTs = length pns \<and>
  25.269 +	nodups pns \<and>
  25.270 +	unique lvars \<and>
  25.271 +	(\<forall>pn\<in>set pns. map_of lvars pn = None) \<and>
  25.272 +	(\<forall>(vn,T)\<in>set lvars. is_type G T) &
  25.273 +	(let E = (G,map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class C)) in
  25.274 +	 E\<turnstile>blk\<surd> \<and> (\<exists>T. E\<turnstile>res::T \<and> G\<turnstile>T\<preceq>rT))"
  25.275  
  25.276 - wf_java_prog :: java_mb prog => bool
  25.277 + wf_java_prog :: "java_mb prog => bool"
  25.278  "wf_java_prog G == wf_prog wf_java_mdecl G"
  25.279  
  25.280 +
  25.281 +lemma wt_is_type: "wf_prog wf_mb G \<Longrightarrow> ((G,L)\<turnstile>e::T \<longrightarrow> is_type G T) \<and>  
  25.282 +       ((G,L)\<turnstile>es[::]Ts \<longrightarrow> Ball (set Ts) (is_type G)) \<and> ((G,L)\<turnstile>c \<surd> \<longrightarrow> True)"
  25.283 +apply (rule ty_expr_ty_exprs_wt_stmt.induct)
  25.284 +apply auto
  25.285 +apply (   erule typeof_empty_is_type)
  25.286 +apply (  simp split add: split_if_asm)
  25.287 +apply ( drule field_fields)
  25.288 +apply ( drule (1) fields_is_type)
  25.289 +apply (  simp (no_asm_simp))
  25.290 +apply  (assumption)
  25.291 +apply (auto dest!: max_spec2mheads method_wf_mdecl is_type_rTI simp add: wf_mdecl_def)
  25.292 +done
  25.293 +
  25.294 +lemmas ty_expr_is_type = wt_is_type [THEN conjunct1,THEN mp, COMP swap_prems_rl]
  25.295 +
  25.296  end
    26.1 --- a/src/HOL/MicroJava/ROOT.ML	Thu Feb 01 20:51:48 2001 +0100
    26.2 +++ b/src/HOL/MicroJava/ROOT.ML	Thu Feb 01 20:53:13 2001 +0100
    26.3 @@ -1,9 +1,6 @@
    26.4  
    26.5  goals_limit := 1;
    26.6  
    26.7 -Unify.search_bound := 40;
    26.8 -Unify.trace_bound  := 40;
    26.9 -
   26.10  add_path "J";
   26.11  add_path "JVM";
   26.12  add_path "BV";