diff -r 3533e3e9267f -r 1024a2d80ac0 src/HOL/MicroJava/BV/Convert.thy --- a/src/HOL/MicroJava/BV/Convert.thy Wed Aug 30 21:44:12 2000 +0200 +++ b/src/HOL/MicroJava/BV/Convert.thy Wed Aug 30 21:47:39 2000 +0200 @@ -1,63 +1,106 @@ (* Title: HOL/MicroJava/BV/Convert.thy ID: $Id$ - Author: Cornelia Pusch + Author: Cornelia Pusch and Gerwin Klein Copyright 1999 Technische Universitaet Muenchen +*) -The supertype relation lifted to type options, type lists and state types. -*) +header "Lifted Type Relations" theory Convert = JVMExec: +text "The supertype relation lifted to type err, type lists and state types." + +datatype 'a err = Err | Ok 'a + types - locvars_type = "ty option list" + locvars_type = "ty err list" opstack_type = "ty list" state_type = "opstack_type \ locvars_type" -constdefs + +consts + strict :: "('a \ 'b err) \ ('a err \ 'b err)" +primrec + "strict f Err = Err" + "strict f (Ok x) = f x" + +consts + opt_map :: "('a \ 'b) \ ('a option \ 'b option)" +primrec + "opt_map f None = None" + "opt_map f (Some x) = Some (f x)" + +consts + val :: "'a err \ 'a" +primrec + "val (Ok s) = s" - (* lifts a relation to option with None as top element *) - lift_top :: "('a \ 'a \ bool) \ ('a option \ 'a option \ bool)" + +constdefs + (* lifts a relation to err with Err as top element *) + lift_top :: "('a \ 'b \ bool) \ ('a err \ 'b err \ bool)" "lift_top P a' a \ case a of - None \ True - | Some t \ (case a' of None \ False | Some t' \ P t' t)" + Err \ True + | Ok t \ (case a' of Err \ False | Ok t' \ P t' t)" + + (* lifts a relation to option with None as bottom element *) + lift_bottom :: "('a \ 'b \ bool) \ ('a option \ 'b option \ bool)" + "lift_bottom P a' a \ case a' of + None \ True + | Some t' \ (case a of None \ False | Some t \ P t' t)" + + sup_ty_opt :: "['code prog,ty err,ty err] \ bool" ("_ \_ <=o _") + "sup_ty_opt G \ lift_top (\t t'. G \ t \ t')" + + sup_loc :: "['code prog,locvars_type,locvars_type] \ bool" + ("_ \ _ <=l _" [71,71] 70) + "G \ LT <=l LT' \ list_all2 (\t t'. (G \ t <=o t')) LT LT'" + + sup_state :: "['code prog,state_type,state_type] \ bool" + ("_ \ _ <=s _" [71,71] 70) + "G \ s <=s s' \ (G \ map Ok (fst s) <=l map Ok (fst s')) \ G \ snd s <=l snd s'" + + sup_state_opt :: "['code prog,state_type option,state_type option] \ bool" + ("_ \ _ <=' _" [71,71] 70) + "sup_state_opt G \ lift_bottom (\t t'. G \ t <=s t')" - sup_ty_opt :: "['code prog,ty option,ty option] \ bool" ("_ \_ <=o _") - "sup_ty_opt G \ lift_top (\t t'. G \ t \ t')" +lemma not_Err_eq [iff]: + "(x \ Err) = (\a. x = Ok a)" + by (cases x) auto - sup_loc :: "['code prog,locvars_type,locvars_type] \ bool" ("_ \ _ <=l _" [71,71] 70) - "G \ LT <=l LT' \ list_all2 (\t t'. (G \ t <=o t')) LT LT'" - - sup_state :: "['code prog,state_type,state_type] \ bool" ("_ \ _ <=s _" [71,71] 70) - "G \ s <=s s' \ (G \ map Some (fst s) <=l map Some (fst s')) \ G \ snd s <=l snd s'" +lemma not_Some_eq [iff]: + "(\y. x \ Ok y) = (x = Err)" + by (cases x) auto lemma lift_top_refl [simp]: "[| !!x. P x x |] ==> lift_top P x x" - by (simp add: lift_top_def split: option.splits) + by (simp add: lift_top_def split: err.splits) lemma lift_top_trans [trans]: - "[| !!x y z. [| P x y; P y z |] ==> P x z; lift_top P x y; lift_top P y z |] ==> lift_top P x z" + "[| !!x y z. [| P x y; P y z |] ==> P x z; lift_top P x y; lift_top P y z |] + ==> lift_top P x z" proof - assume [trans]: "!!x y z. [| P x y; P y z |] ==> P x z" assume a: "lift_top P x y" assume b: "lift_top P y z" - { assume "z = None" + { assume "z = Err" hence ?thesis by (simp add: lift_top_def) } note z_none = this - { assume "x = None" + { assume "x = Err" with a b have ?thesis - by (simp add: lift_top_def split: option.splits) + by (simp add: lift_top_def split: err.splits) } note x_none = this { fix r t - assume x: "x = Some r" and z: "z = Some t" + assume x: "x = Ok r" and z: "z = Ok t" with a b - obtain s where y: "y = Some s" - by (simp add: lift_top_def split: option.splits) + obtain s where y: "y = Ok s" + by (simp add: lift_top_def split: err.splits) from a x y have "P r s" by (simp add: lift_top_def) @@ -75,21 +118,82 @@ show ?thesis by blast qed -lemma lift_top_None_any [simp]: - "lift_top P None any = (any = None)" - by (simp add: lift_top_def split: option.splits) +lemma lift_top_Err_any [simp]: + "lift_top P Err any = (any = Err)" + by (simp add: lift_top_def split: err.splits) + +lemma lift_top_Ok_Ok [simp]: + "lift_top P (Ok a) (Ok b) = P a b" + by (simp add: lift_top_def split: err.splits) + +lemma lift_top_any_Ok [simp]: + "lift_top P any (Ok b) = (\a. any = Ok a \ P a b)" + by (simp add: lift_top_def split: err.splits) + +lemma lift_top_Ok_any: + "lift_top P (Ok a) any = (any = Err \ (\b. any = Ok b \ P a b))" + by (simp add: lift_top_def split: err.splits) -lemma lift_top_Some_Some [simp]: - "lift_top P (Some a) (Some b) = P a b" - by (simp add: lift_top_def split: option.splits) + +lemma lift_bottom_refl [simp]: + "[| !!x. P x x |] ==> lift_bottom P x x" + by (simp add: lift_bottom_def split: option.splits) + +lemma lift_bottom_trans [trans]: + "[| !!x y z. [| P x y; P y z |] ==> P x z; lift_bottom P x y; lift_bottom P y z |] + ==> lift_bottom P x z" +proof - + assume [trans]: "!!x y z. [| P x y; P y z |] ==> P x z" + assume a: "lift_bottom P x y" + assume b: "lift_bottom P y z" + + { assume "x = None" + hence ?thesis by (simp add: lift_bottom_def) + } note z_none = this -lemma lift_top_any_Some [simp]: - "lift_top P any (Some b) = (\a. any = Some a \ P a b)" - by (simp add: lift_top_def split: option.splits) + { assume "z = None" + with a b + have ?thesis + by (simp add: lift_bottom_def split: option.splits) + } note x_none = this + + { fix r t + assume x: "x = Some r" and z: "z = Some t" + with a b + obtain s where y: "y = Some s" + by (simp add: lift_bottom_def split: option.splits) + + from a x y + have "P r s" by (simp add: lift_bottom_def) + also + from b y z + have "P s t" by (simp add: lift_bottom_def) + finally + have "P r t" . -lemma lift_top_Some_any: - "lift_top P (Some a) any = (any = None \ (\b. any = Some b \ P a b))" - by (simp add: lift_top_def split: option.splits) + with x z + have ?thesis by (simp add: lift_bottom_def) + } + + with x_none z_none + show ?thesis by blast +qed + +lemma lift_bottom_any_None [simp]: + "lift_bottom P any None = (any = None)" + by (simp add: lift_bottom_def split: option.splits) + +lemma lift_bottom_Some_Some [simp]: + "lift_bottom P (Some a) (Some b) = P a b" + by (simp add: lift_bottom_def split: option.splits) + +lemma lift_bottom_any_Some [simp]: + "lift_bottom P (Some a) any = (\b. any = Some b \ P a b)" + by (simp add: lift_bottom_def split: option.splits) + +lemma lift_bottom_Some_any: + "lift_bottom P any (Some b) = (any = None \ (\a. any = Some a \ P a b))" + by (simp add: lift_bottom_def split: option.splits) @@ -105,18 +209,21 @@ "G \ s <=s s" by (simp add: sup_state_def) +theorem sup_state_opt_refl [simp]: + "G \ s <=' s" + by (simp add: sup_state_opt_def) -theorem anyConvNone [simp]: - "(G \ None <=o any) = (any = None)" +theorem anyConvErr [simp]: + "(G \ Err <=o any) = (any = Err)" by (simp add: sup_ty_opt_def) -theorem SomeanyConvSome [simp]: - "(G \ (Some ty') <=o (Some ty)) = (G \ ty' \ ty)" +theorem OkanyConvOk [simp]: + "(G \ (Ok ty') <=o (Ok ty)) = (G \ ty' \ ty)" by (simp add: sup_ty_opt_def) -theorem sup_ty_opt_Some: - "G \ a <=o (Some b) \ \ x. a = Some x" +theorem sup_ty_opt_Ok: + "G \ a <=o (Ok b) \ \ x. a = Ok x" by (clarsimp simp add: sup_ty_opt_def) lemma widen_PrimT_conv1 [simp]: @@ -124,8 +231,8 @@ by (auto elim: widen.elims) theorem sup_PTS_eq: - "(G \ Some (PrimT p) <=o X) = (X=None \ X = Some (PrimT p))" - by (auto simp add: sup_ty_opt_def lift_top_Some_any) + "(G \ Ok (PrimT p) <=o X) = (X=Err \ X = Ok (PrimT p))" + by (auto simp add: sup_ty_opt_def lift_top_Ok_any) @@ -138,7 +245,7 @@ by (simp add: sup_loc_def list_all2_Cons1) theorem sup_loc_Cons2: - "(G \ YT <=l (X#XT)) = (\Y YT'. YT=Y#YT' \ (G \ Y <=o X) \ (G \ YT' <=l XT))"; + "(G \ YT <=l (X#XT)) = (\Y YT'. YT=Y#YT' \ (G \ Y <=o X) \ (G \ YT' <=l XT))" by (simp add: sup_loc_def list_all2_Cons2) @@ -178,8 +285,8 @@ theorem all_nth_sup_loc: - "\b. length a = length b \ (\ n. n < length a \ (G \ (a!n) <=o (b!n))) \ (G \ a <=l b)" - (is "?P a") + "\b. length a = length b \ (\ n. n < length a \ (G \ (a!n) <=o (b!n))) \ + (G \ a <=l b)" (is "?P a") proof (induct a) show "?P []" by simp @@ -206,12 +313,13 @@ theorem sup_loc_append: - "[| length a = length b |] ==> (G \ (a@x) <=l (b@y)) = ((G \ a <=l b) \ (G \ x <=l y))" + "length a = length b ==> + (G \ (a@x) <=l (b@y)) = ((G \ a <=l b) \ (G \ x <=l y))" proof - assume l: "length a = length b" - have "\b. length a = length b \ (G \ (a@x) <=l (b@y)) = ((G \ a <=l b) \ (G \ x <=l y))" - (is "?P a") + have "\b. length a = length b \ (G \ (a@x) <=l (b@y)) = ((G \ a <=l b) \ + (G \ x <=l y))" (is "?P a") proof (induct a) show "?P []" by simp @@ -219,7 +327,7 @@ show "?P (l#ls)" proof (intro strip) fix b - assume "length (l#ls) = length (b::ty option list)" + assume "length (l#ls) = length (b::ty err list)" with IH show "(G \ ((l#ls)@x) <=l (b@y)) = ((G \ (l#ls) <=l b) \ (G \ x <=l y))" by - (cases b, auto) @@ -276,8 +384,8 @@ theorem sup_loc_update [rulify]: - "\ n y. (G \ a <=o b) \ n < length y \ (G \ x <=l y) \ (G \ x[n := a] <=l y[n := b])" - (is "?P x") + "\ n y. (G \ a <=o b) \ n < length y \ (G \ x <=l y) \ + (G \ x[n := a] <=l y[n := b])" (is "?P x") proof (induct x) show "?P []" by simp @@ -294,23 +402,28 @@ theorem sup_state_length [simp]: - "G \ s2 <=s s1 \ length (fst s2) = length (fst s1) \ length (snd s2) = length (snd s1)" + "G \ s2 <=s s1 ==> + length (fst s2) = length (fst s1) \ length (snd s2) = length (snd s1)" by (auto dest: sup_loc_length simp add: sup_state_def); theorem sup_state_append_snd: - "length a = length b \ (G \ (i,a@x) <=s (j,b@y)) = ((G \ (i,a) <=s (j,b)) \ (G \ (i,x) <=s (j,y)))" + "length a = length b ==> + (G \ (i,a@x) <=s (j,b@y)) = ((G \ (i,a) <=s (j,b)) \ (G \ (i,x) <=s (j,y)))" by (auto simp add: sup_state_def sup_loc_append) theorem sup_state_append_fst: - "length a = length b \ (G \ (a@x,i) <=s (b@y,j)) = ((G \ (a,i) <=s (b,j)) \ (G \ (x,i) <=s (y,j)))" + "length a = length b ==> + (G \ (a@x,i) <=s (b@y,j)) = ((G \ (a,i) <=s (b,j)) \ (G \ (x,i) <=s (y,j)))" by (auto simp add: sup_state_def sup_loc_append) theorem sup_state_Cons1: - "(G \ (x#xt, a) <=s (yt, b)) = (\y yt'. yt=y#yt' \ (G \ x \ y) \ (G \ (xt,a) <=s (yt',b)))" + "(G \ (x#xt, a) <=s (yt, b)) = + (\y yt'. yt=y#yt' \ (G \ x \ y) \ (G \ (xt,a) <=s (yt',b)))" by (auto simp add: sup_state_def map_eq_Cons) theorem sup_state_Cons2: - "(G \ (xt, a) <=s (y#yt, b)) = (\x xt'. xt=x#xt' \ (G \ x \ y) \ (G \ (xt',a) <=s (yt,b)))" + "(G \ (xt, a) <=s (y#yt, b)) = + (\x xt'. xt=x#xt' \ (G \ x \ y) \ (G \ (xt',a) <=s (yt,b)))" by (auto simp add: sup_state_def map_eq_Cons sup_loc_Cons2) theorem sup_state_ignore_fst: @@ -324,11 +437,32 @@ show ?thesis by (simp add: m sup_state_def) qed + +lemma sup_state_opt_None_any [iff]: + "(G \ None <=' any) = True" + by (simp add: sup_state_opt_def lift_bottom_def) + +lemma sup_state_opt_any_None [iff]: + "(G \ any <=' None) = (any = None)" + by (simp add: sup_state_opt_def) + +lemma sup_state_opt_Some_Some [iff]: + "(G \ (Some a) <=' (Some b)) = (G \ a <=s b)" + by (simp add: sup_state_opt_def del: split_paired_Ex) + +lemma sup_state_opt_any_Some [iff]: + "(G \ (Some a) <=' any) = (\b. any = Some b \ G \ a <=s b)" + by (simp add: sup_state_opt_def) + +lemma sup_state_opt_Some_any: + "(G \ any <=' (Some b)) = (any = None \ (\a. any = Some a \ G \ a <=s b))" + by (simp add: sup_state_opt_def lift_bottom_Some_any) + + theorem sup_ty_opt_trans [trans]: "\G \ a <=o b; G \ b <=o c\ \ G \ a <=o c" by (auto intro: lift_top_trans widen_trans simp add: sup_ty_opt_def) - theorem sup_loc_trans [trans]: "\G \ a <=l b; G \ b <=l c\ \ G \ a <=l c" proof - @@ -359,4 +493,9 @@ "\G \ a <=s b; G \ b <=s c\ \ G \ a <=s c" by (auto intro: sup_loc_trans simp add: sup_state_def) +theorem sup_state_opt_trans [trans]: + "\G \ a <=' b; G \ b <=' c\ \ G \ a <=' c" + by (auto intro: lift_bottom_trans sup_state_trans simp add: sup_state_opt_def) + + end