Up to index of Isabelle/HOL/arrays
theory TypeRel = Decl:(* Title: HOL/MicroJava/J/TypeRel.thy
ID: $Id: TypeRel.html,v 1.1 2002/11/28 16:11:18 kleing Exp $
Author: David von Oheimb, Gerwin Klein
Copyright 1999 Technische Universitaet Muenchen
*)
header {* \isaheader{Relations between Java Types} *}
theory TypeRel = Decl:
consts
subcls1 :: "'c prog => (cname × cname) set" -- "subclass"
widen :: "'c prog => (ty × ty ) set" -- "widening"
cast :: "'c prog => (cname × cname) set" -- "casting"
syntax (xsymbols)
subcls1 :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<prec>C1 _" [71,71,71] 70)
subcls :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<preceq>C _" [71,71,71] 70)
widen :: "'c prog => [ty , ty ] => bool" ("_ \<turnstile> _ \<preceq> _" [71,71,71] 70)
cast :: "'c prog => [cname, cname] => bool" ("_ \<turnstile> _ \<preceq>? _" [71,71,71] 70)
syntax
subcls1 :: "'c prog => [cname, cname] => bool" ("_ |- _ <=C1 _" [71,71,71] 70)
subcls :: "'c prog => [cname, cname] => bool" ("_ |- _ <=C _" [71,71,71] 70)
widen :: "'c prog => [ty , ty ] => bool" ("_ |- _ <= _" [71,71,71] 70)
cast :: "'c prog => [cname, cname] => bool" ("_ |- _ <=? _" [71,71,71] 70)
translations
"G\<turnstile>C \<prec>C1 D" == "(C,D) \<in> subcls1 G"
"G\<turnstile>C \<preceq>C D" == "(C,D) \<in> (subcls1 G)^*"
"G\<turnstile>S \<preceq> T" == "(S,T) \<in> widen G"
"G\<turnstile>C \<preceq>? D" == "(C,D) \<in> cast G"
-- "direct subclass, cf. 8.1.3"
inductive "subcls1 G" intros
subcls1I: "\<lbrakk>class G C = Some (D,rest); C \<noteq> Object\<rbrakk> \<Longrightarrow> G\<turnstile>C\<prec>C1D"
-- "widening, viz. method invocation conversion,cf. 5.3 i.e. sort of syntactic subtyping"
inductive "widen G" intros
refl [intro!, simp]: "G\<turnstile> T \<preceq> T" -- "identity conv., cf. 5.1.1"
subcls: "G\<turnstile> C \<preceq>C D \<Longrightarrow> G\<turnstile> Class C \<preceq> Class D"
null [intro!]: "G\<turnstile> NT \<preceq> RefT R"
arr_obj [intro!, simp]: "G\<turnstile> T.[] \<preceq> Class Object"
array: "G\<turnstile> S \<preceq> T \<Longrightarrow> G\<turnstile> S.[] \<preceq> T.[]"
-- "casting conversion, cf. 5.5 / 5.1.5"
-- "left out casts on primitve types and arrays" (* FIXME: include arrays *)
inductive "cast G" intros
widen: "G\<turnstile>C\<preceq>C D ==> G\<turnstile>C \<preceq>? D"
subcls: "G\<turnstile>D\<preceq>C C ==> G\<turnstile>C \<preceq>? D"
lemma subcls1D:
"G\<turnstile>C\<prec>C1D \<Longrightarrow> C \<noteq> Object \<and> (\<exists>fs ms. class G C = Some (D,fs,ms))"
apply (erule subcls1.elims)
apply auto
done
lemma subcls1_def2:
"subcls1 G = (\<Sigma>C\<in>{C. is_class G C} . {D. C\<noteq>Object \<and> fst (the (class G C))=D})"
by (auto simp add: is_class_def dest: subcls1D intro: subcls1I)
lemma finite_subcls1: "finite (subcls1 G)"
apply(subst subcls1_def2)
apply(rule finite_SigmaI [OF finite_is_class])
apply(rule_tac B = "{fst (the (class G C))}" in finite_subset)
apply auto
done
lemma subcls_is_class: "(C,D) \<in> (subcls1 G)^+ ==> is_class G C"
apply (unfold is_class_def)
apply(erule trancl_trans_induct)
apply (auto dest!: subcls1D)
done
lemma subcls_is_class2 [rule_format (no_asm)]:
"G\<turnstile>C\<preceq>C D \<Longrightarrow> is_class G D \<longrightarrow> is_class G C"
apply (unfold is_class_def)
apply (erule rtrancl_induct)
apply (drule_tac [2] subcls1D)
apply auto
done
consts class_rec ::"'c prog × cname \<Rightarrow>
'a \<Rightarrow> (cname \<Rightarrow> fdecl list \<Rightarrow> 'c mdecl list \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a"
recdef class_rec "same_fst (\<lambda>G. wf ((subcls1 G)^-1)) (\<lambda>G. (subcls1 G)^-1)"
"class_rec (G,C) = (\<lambda>t f. case class G C of None \<Rightarrow> arbitrary
| Some (D,fs,ms) \<Rightarrow> if wf ((subcls1 G)^-1) then
f C fs ms (if C = Object then t else class_rec (G,D) t f) else arbitrary)"
(hints intro: subcls1I)
declare class_rec.simps [simp del]
lemma class_rec_lemma: "\<lbrakk> wf ((subcls1 G)^-1); class G C = Some (D,fs,ms)\<rbrakk> \<Longrightarrow>
class_rec (G,C) t f = f C fs ms (if C=Object then t else class_rec (G,D) t f)";
apply (rule class_rec.simps [THEN trans [THEN fun_cong [THEN fun_cong]]])
apply simp
done
consts
method :: "'c prog × cname => ( sig \<leadsto> cname × ty × 'c)" (* ###curry *)
field :: "'c prog × cname => ( vname \<leadsto> cname × ty )" (* ###curry *)
fields :: "'c prog × cname => ((vname × cname) × ty) list" (* ###curry *)
-- "methods of a class, with inheritance, overriding and hiding, cf. 8.4.6"
defs method_def: "method \<equiv> \<lambda>(G,C). class_rec (G,C) empty (\<lambda>C fs ms ts.
ts ++ map_of (map (\<lambda>(s,m). (s,(C,m))) ms))"
lemma method_rec_lemma: "[|class G C = Some (D,fs,ms); wf ((subcls1 G)^-1)|] ==>
method (G,C) = (if C = Object then empty else method (G,D)) ++
map_of (map (\<lambda>(s,m). (s,(C,m))) ms)"
apply (unfold method_def)
apply (simp split del: split_if)
apply (erule (1) class_rec_lemma [THEN trans]);
apply auto
done
-- "list of fields of a class, including inherited and hidden ones"
defs fields_def: "fields \<equiv> \<lambda>(G,C). class_rec (G,C) [] (\<lambda>C fs ms ts.
map (\<lambda>(fn,ft). ((fn,C),ft)) fs @ ts)"
lemma fields_rec_lemma: "[|class G C = Some (D,fs,ms); wf ((subcls1 G)^-1)|] ==>
fields (G,C) =
map (\<lambda>(fn,ft). ((fn,C),ft)) fs @ (if C = Object then [] else fields (G,D))"
apply (unfold fields_def)
apply (simp split del: split_if)
apply (erule (1) class_rec_lemma [THEN trans]);
apply auto
done
defs field_def: "field == map_of o (map (\<lambda>((fn,fd),ft). (fn,(fd,ft)))) o fields"
lemma field_fields:
"field (G,C) fn = Some (fd, fT) \<Longrightarrow> map_of (fields (G,C)) (fn, fd) = Some fT"
apply (unfold field_def)
apply (rule table_of_remap_SomeD)
apply simp
done
lemma widen_PrimT [simp]:
"G \<turnstile> T \<preceq> PrimT T' = (T = PrimT T')"
by (rule, erule widen.elims) auto
lemma widen_PrimT2 [simp]:
"G \<turnstile> PrimT T \<preceq> T' = (T' = PrimT T)"
by (rule, erule widen.elims) auto
lemma widen_PrimT_RefT [iff]: "(G\<turnstile>PrimT pT\<preceq>RefT rT) = False"
apply (rule iffI)
apply (erule widen.elims)
apply auto
done
lemma widen_RefT: "G\<turnstile>RefT R\<preceq>T ==> \<exists>t. T=RefT t"
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply auto
done
lemma widen_RefT2: "G\<turnstile>S\<preceq>RefT R ==> \<exists>t. S=RefT t"
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply auto
done
lemma widen_Class: "G\<turnstile>Class C\<preceq>T ==> \<exists>D. T=Class D"
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply auto
done
lemma widen_Class_NullT [iff]: "(G\<turnstile>Class C\<preceq>NT) = False"
apply (rule iffI)
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply auto
done
lemma widen_Class_Class [iff]: "(G\<turnstile>Class C\<preceq> Class D) = (G\<turnstile>C\<preceq>C D)"
apply (rule iffI)
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply (auto elim: widen.subcls)
done
lemma widen_Array: "G\<turnstile>S.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> (\<exists>T'. T=T'.[] \<and> G\<turnstile>S\<preceq>T')"
apply (ind_cases "G\<turnstile>S\<preceq>T")
by auto
lemma widen_Array2: "G\<turnstile>S\<preceq>T.[] \<Longrightarrow> S = NT \<or> (\<exists>S'. S=S'.[] \<and> G\<turnstile>S'\<preceq>T)"
apply (ind_cases "G\<turnstile>S\<preceq>T")
by auto
lemma widen_ArrayPrimT: "G\<turnstile>PrimT t.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> T=PrimT t.[]"
by (ind_cases "G\<turnstile>S\<preceq>T") auto
lemma widen_ArrayRefT:
"G\<turnstile>RefT t.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> (\<exists>s. T=RefT s.[] \<and> G\<turnstile>RefT t\<preceq>RefT s)"
apply (ind_cases "G\<turnstile>S\<preceq>T")
apply (auto dest: widen_RefT)
done
lemma widen_ArrayRefT_ArrayRefT_eq [simp]:
"G\<turnstile>RefT T.[]\<preceq>RefT T'.[] = G\<turnstile>RefT T\<preceq>RefT T'"
apply (rule iffI)
apply (drule widen_ArrayRefT)
apply simp
apply (erule widen.array)
done
lemma widen_Array_Array: "G\<turnstile>T.[]\<preceq>T'.[] \<Longrightarrow> G\<turnstile>T\<preceq>T'"
apply (drule widen_Array)
apply auto
done
lemma widen_Array_Class: "G\<turnstile>S.[] \<preceq> Class C \<Longrightarrow> C=Object"
by (auto dest: widen_Array)
lemma widen_Array_NT [iff]:
"G \<turnstile> T.[] \<preceq> NT = False"
by (auto elim: widen.elims)
theorem widen_trans [trans]: "\<lbrakk>G\<turnstile>S\<preceq>U; G\<turnstile>U\<preceq>T\<rbrakk> \<Longrightarrow> G\<turnstile>S\<preceq>T"
proof -
assume "G\<turnstile>S\<preceq>U" thus "\<And>T. G\<turnstile>U\<preceq>T \<Longrightarrow> G\<turnstile>S\<preceq>T"
proof induct
case (refl T T') thus "G\<turnstile>T\<preceq>T'" .
next
case (subcls C D T)
then obtain E where "T = Class E" by (blast dest: widen_Class)
with subcls show "G\<turnstile>Class C\<preceq>T" by (auto elim: rtrancl_trans)
next
case (null R RT)
then obtain rt where "RT = RefT rt" by (blast dest: widen_RefT)
thus "G\<turnstile>NT\<preceq>RT" by auto
next
case (arr_obj T T')
hence "T' = Class Object"
by (cases, auto) (erule converse_rtranclE, auto elim: subcls1.elims)
thus "G \<turnstile> T.[] \<preceq> T'" by simp
next
case (array S U T)
have U: "G \<turnstile> U.[] \<preceq> T" .
hence "T = Class Object \<or> (\<exists>T'. T = T'.[])" by cases auto
thus "G \<turnstile> S.[] \<preceq> T"
proof
assume "T = Class Object" thus ?thesis by simp
next
assume "\<exists>T'. T = T'.[]" then obtain T' where T: "T = T'.[]" ..
with U have "G \<turnstile> U \<preceq> T'" by simp (ind_cases "G \<turnstile> U.[] \<preceq> T'.[]", auto)
moreover have "G \<turnstile> U \<preceq> T' \<Longrightarrow> G \<turnstile> S \<preceq> T'" .
ultimately have "G \<turnstile> S \<preceq> T'" by simp
hence "G \<turnstile> S.[] \<preceq> T'.[]" by (rule widen.array)
thus "G \<turnstile> S.[] \<preceq> T" using T by simp
qed
qed
qed
end
lemma subcls1D:
G |- C <=C1 D ==> C ~= Object & (EX fs ms. class G C = Some (D, fs, ms))
lemma subcls1_def2:
subcls1 G =
(SIGMA C:Collect (is_class G). {D. C ~= Object & fst (the (class G C)) = D})
lemma finite_subcls1:
finite (subcls1 G)
lemma subcls_is_class:
(C, D) : (subcls1 G)^+ ==> is_class G C
lemma subcls_is_class2:
[| G |- C <=C D; is_class G D |] ==> is_class G C
lemma class_rec_lemma:
[| wf ((subcls1 G)^-1); class G C = Some (D, fs, ms) |]
==> class_rec (G, C) t f =
f C fs ms (if C = Object then t else class_rec (G, D) t f)
lemma method_rec_lemma:
[| class G C = Some (D, fs, ms); wf ((subcls1 G)^-1) |]
==> method (G, C) =
(if C = Object then empty else method (G, D)) ++
map_of (map (%(s, m). (s, C, m)) ms)
lemma fields_rec_lemma:
[| class G C = Some (D, fs, ms); wf ((subcls1 G)^-1) |]
==> fields (G, C) =
map (split (%fn. Pair (fn, C))) fs @
(if C = Object then [] else fields (G, D))
lemma field_fields:
field (G, C) fn = Some (fd, fT) ==> map_of (fields (G, C)) (fn, fd) = Some fT
lemma widen_PrimT:
G |- T <= PrimT T' = (T = PrimT T')
lemma widen_PrimT2:
G |- PrimT T <= T' = (T' = PrimT T)
lemma widen_PrimT_RefT:
G |- PrimT pT <= RefT rT = False
lemma widen_RefT:
G |- RefT R <= T ==> EX t. T = RefT t
lemma widen_RefT2:
G |- S <= RefT R ==> EX t. S = RefT t
lemma widen_Class:
G |- Class C <= T ==> EX D. T = Class D
lemma widen_Class_NullT:
G |- Class C <= NT = False
lemma widen_Class_Class:
G |- Class C <= Class D = G |- C <=C D
lemma widen_Array:
G |- S.[] <= T ==> T = Class Object | (EX T'. T = T'.[] & G |- S <= T')
lemma widen_Array2:
G |- S <= T.[] ==> S = NT | (EX S'. S = S'.[] & G |- S' <= T)
lemma widen_ArrayPrimT:
G |- PrimT t.[] <= T ==> T = Class Object | T = PrimT t.[]
lemma widen_ArrayRefT:
G |- RefT t.[] <= T ==> T = Class Object | (EX s. T = RefT s.[] & G |- RefT t <= RefT s)
lemma widen_ArrayRefT_ArrayRefT_eq:
G |- RefT T.[] <= RefT T'.[] = G |- RefT T <= RefT T'
lemma widen_Array_Array:
G |- T.[] <= T'.[] ==> G |- T <= T'
lemma widen_Array_Class:
G |- S.[] <= Class C ==> C = Object
lemma widen_Array_NT:
G |- T.[] <= NT = False
theorem widen_trans:
[| G |- S <= U; G |- U <= T |] ==> G |- S <= T