# HG changeset patch # User urbanc # Date 1134644018 -3600 # Node ID 73bb08d2823c39edbafaf9bcac422ff610bcdf77 # Parent 080094128a09304304dec5e53f564117e9f50f35 made further tunings diff -r 080094128a09 -r 73bb08d2823c src/HOL/Nominal/Examples/Fsub.thy --- a/src/HOL/Nominal/Examples/Fsub.thy Thu Dec 15 05:47:26 2005 +0100 +++ b/src/HOL/Nominal/Examples/Fsub.thy Thu Dec 15 11:53:38 2005 +0100 @@ -684,6 +684,18 @@ lemma measure_eq [simp]: "(x, y) \ measure f = (f x < f y)" by (simp add: measure_def inv_image_def) +lemma + fixes n :: nat + shows "!!x::'a. A n x ==> P n x" + and "!!y::'b. B n y ==> Q n y" +proof (induct n rule: less_induct) + case (less n) + show ?case sorry +qed + +text {* I want to do an induction over the size(!) of Q + therefore the example above does not help *} + lemma transitivity_and_narrowing: shows "(\\ S T. \ \ S <: Q \ \ \ Q <: T \ \ \ S <: T) \ (\\ \ X P M N. (\@(X,Q)#\) \ M <: N \ \ \ P <: Q \ (\@(X,P)#\) \ M <: N)" @@ -817,110 +829,90 @@ qed qed - (* HERE *) + (* HERE how should I state this lemma with the context? I want to quantify over all \*) have narrowing: - "\\ \ X M N P. (\@(X,Q)#\) \ M <: N \ \ \ P<:Q \ (\@(X,Q)#\) \ M <: N" + "\\ \ X M N P. (\@(X,Q)#\) \ M <: N \ \ \ P<:Q \ (\@(X,P)#\) \ M <: N" proof - fix \ \ X M N P assume a: "(\@(X,Q)#\) \ M <: N" assume b: "\ \ P<:Q" - show "(\@(X,Q)#\) \ M <: N" + show "(\@(X,P)#\) \ M <: N" using a b - proof (nominal_induct \\"\@(X,Q)#\" M N avoiding: \ rule: subtype_of_rel_induct) - case (S_Top \1 S1 \2) + proof (nominal_induct \\"\@(X,Q)#\" M N avoiding: \ \ X rule: subtype_of_rel_induct) + case (S_Top \1 S1 \ \2 X) have lh_drv_prem1: "\ \1 ok" by fact have lh_drv_prem2: "S1 closed_in \1" by fact have \1_inst: "\1=\@(X,Q)#\2" by fact have rh_drv: "\2 \ P <: Q" by fact hence a1: "P closed_in \2" by (simp add: subtype_implies_closed) hence a2: "\ (\@(X,P)#\2) ok" using lh_drv_prem1 a1 \1_inst by (simp add: replace_type) - show ?case show "(\@(X,P)#\2) \ S1 <: Top" - using a1 a3 lh_drv_prem2 by (force simp add: closed_in_def domain_append) - qed + using a1 a2 \1_inst lh_drv_prem2 by (force simp add: closed_in_def domain_append) next - case (goal2 \1 \1 X1 \2 X2 S1 T1) - have lh_drv_prem1: "\ \2 ok" by fact - have lh_drv_prem2: "(X2,S1)\set \2" by fact - have lh_drv_prem3: "\2 \ S1 <: T1" by fact - have IH_inner: - "\\1 \1 X1. \2 = \1@(X1,Q)#\1 \ (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ S1 <: T1)" by fact - show "\2 = (\1@(X1,Q)#\1) \ (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ TyVar X2 <: T1)" - proof (intro strip) - fix P - assume a1: "\2 = \1@(X1,Q)#\1" - and a2: "\1 \ P <: Q" - from a2 have "P closed_in \1" by (simp add: subtype_implies_closed) - hence a3: "\ (\1@(X1,P)#\1) ok" - using lh_drv_prem1 a1 by (rule_tac replace_type, simp_all) - show "(\1@(X1,P)#\1) \ TyVar X2 <: T1" - proof (cases "X1=X2") - case False - have b0: "X1\X2" by fact - from lh_drv_prem3 a1 a2 IH_inner - have b1: "(\1@(X1,P)#\1) \ S1 <: T1" by simp - from lh_drv_prem2 a1 b0 have b2: "(X2,S1)\set (\1@(X1,P)#\1)" by simp - show "(\1@(X1,P)#\1) \ TyVar X2 <: T1" using a3 b2 b1 by (rule S_Var) - next - case True - have b0: "X1=X2" by fact - have a4: "S1=Q" - proof - - have c0: "(X2,Q)\set \2" using b0 a1 by simp - with lh_drv_prem1 lh_drv_prem2 show "S1=Q" by (simp add: uniqueness_of_ctxt) - qed - have a5: "(\1@(X1,P)#\1) extends \1" by (force simp add: extends_def) - have a6: "(\1@(X2,P)#\1) \ P <: Q" using b0 a5 a2 a3 by (simp add: weakening) - have a7: "(\1@(X2,P)#\1) \ Q <: T1" using b0 IH_inner a1 lh_drv_prem3 a2 a4 by simp - have a8: "(\1@(X2,P)#\1) \ P <: T1" using a6 a7 transitivity by blast - have a9: "(X2,P)\set (\1@(X1,P)#\1)" using b0 by simp - show "(\1@(X1,P)#\1) \ TyVar X2 <: T1" using a3 b0 a8 a9 by (force simp add: S_Var) + case (S_Var \1 X1 S1 T1 \ \2 X) + have lh_drv_prem1: "\ \1 ok" by fact + have lh_drv_prem2: "(X1,S1)\set \1" by fact + have lh_drv_prem3: "\1 \ S1 <: T1" by fact + have IH_inner: "\\. \ \ P <: Q \ \1=\@(X,Q)#\ \ (\@(X,P)#\) \ S1 <: T1" by fact + have \1_inst: "\1=\@(X,Q)#\2" by fact + have rh_drv: "\2 \ P <: Q" by fact + hence "P closed_in \2" by (simp add: subtype_implies_closed) + hence a3: "\ (\@(X,P)#\2) ok" using lh_drv_prem1 \1_inst by (simp add: replace_type) + show "(\@(X,P)#\2) \ TyVar X1 <: T1" + proof (cases "X=X1") + case False + have b0: "X\X1" by fact + from lh_drv_prem3 \1_inst rh_drv IH_inner + have b1: "(\@(X,P)#\2) \ S1 <: T1" by simp + from lh_drv_prem2 \1_inst b0 have b2: "(X1,S1)\set (\@(X,P)#\2)" by simp + show "(\@(X,P)#\2) \ TyVar X1 <: T1" using a3 b2 b1 by (rule subtype_of_rel.S_Var) + next + case True + have b0: "X=X1" by fact + have a4: "S1=Q" + proof - + have "(X1,Q)\set \1" using b0 \1_inst by simp + with lh_drv_prem1 lh_drv_prem2 show "S1=Q" by (simp add: uniqueness_of_ctxt) qed + have a5: "(\@(X,P)#\2) extends \2" by (force simp add: extends_def) + have a6: "(\@(X1,P)#\2) \ P <: Q" using b0 a5 rh_drv a3 by (simp add: weakening) + have a7: "(\@(X1,P)#\2) \ Q <: T1" using b0 IH_inner \1_inst lh_drv_prem3 rh_drv a4 by simp + have a8: "(\@(X1,P)#\2) \ P <: T1" using a6 a7 transitivity by blast + have a9: "(X1,P)\set (\@(X,P)#\2)" using b0 by simp + show "(\@(X,P)#\2) \ TyVar X1 <: T1" using a3 b0 a8 a9 by force qed next - case (goal3 \1 \1 X1 \2 X2) - have lh_drv_prem1: "\ \2 ok" by fact - have lh_drv_prem2: "X2 \ domain \2" by fact - show "\2 = (\1@(X1,Q)#\1) \ (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ TyVar X2 <: TyVar X2)" - proof (intro strip) - fix P - assume a1: "\2 = \1@(X1,Q)#\1" - and a2: "\1 \ P <: Q" - from a2 have "P closed_in \1" by (simp add: subtype_implies_closed) - hence a3: "\ (\1@(X1,P)#\1) ok" - using lh_drv_prem1 a1 by (rule_tac replace_type, simp_all) - have b0: "X2 \ domain (\1@(X1,P)#\1)" using lh_drv_prem2 a1 by (simp add: domain_append) - show "(\1@(X1,P)#\1) \ TyVar X2 <: TyVar X2" using a3 b0 by (rule S_Refl) - qed + case (S_Refl \1 X1 \ \2 X) + have lh_drv_prem1: "\ \1 ok" by fact + have lh_drv_prem2: "X1 \ domain \1" by fact + have \1_inst: "\1 = \@(X,Q)#\2" by fact + have "\2 \ P <: Q" by fact + hence "P closed_in \2" by (simp add: subtype_implies_closed) + hence a3: "\ (\@(X,P)#\2) ok" using lh_drv_prem1 \1_inst by (simp add: replace_type) + have b0: "X1 \ domain (\@(X,P)#\2)" using lh_drv_prem2 \1_inst by (simp add: domain_append) + show "(\@(X,P)#\2) \ TyVar X1 <: TyVar X1" using a3 b0 by (rule subtype_of_rel.S_Refl) next - case goal4 thus ?case by blast + case S_Arrow thus ?case by blast next - case (goal5 \1 \1 X1 \2 X2 S1 S2 T1 T2) - have IH_inner1: - "\\1 \1 X1. \2 = \1@(X1,Q)#\1 \ (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ T1 <: S1)" by fact - have IH_inner2: - "\\1 \1 X1. (X2,T1)#\2 = \1@(X1,Q)#\1 \ (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ S2 <: T2)" + case (S_All \1 X1 S1 S2 T1 T2 \ \2 X) + have IH_inner1: "\\ \ X. \ \ P <: Q \ \1 = \@(X,Q)#\ \ (\@(X,P)#\) \ T1 <: S1" by fact + have IH_inner2: "\\ \ X. \ \ P <: Q \ (X1,T1)#\1 = \@(X,Q)#\ \ (\@(X,P)#\) \ S2 <: T2" by fact - have lh_drv_prem1: "\2 \ T1 <: S1" by fact - have lh_drv_prem2: "X2 \ (\2,S1, T1)" by fact - have lh_drv_prem3: "((X2,T1) # \2) \ S2 <: T2" by fact - have freshness: "X2\(\1, \1, X1)" by fact - show "\2 = (\1@(X1,Q)#\1) \ - (\P. \1 \ P <: Q \ (\1@(X1,P)#\1) \ \ [X2<:S1].S2 <: \ [X2<:T1].T2)" - proof (intro strip) - fix P - assume a1: "\2 = \1@(X1,Q)#\1" - and a2: "\1 \ P <: Q" - have b0: "(\1@(X1,P)#\1) \ T1 <: S1" using a1 a2 lh_drv_prem1 IH_inner1 by simp - have b1: "(((X2,T1)#\1)@(X1,P)#\1) \ S2 <: T2" using a1 a2 lh_drv_prem3 IH_inner2 - apply auto - apply (drule_tac x="(X2,T1)#\1" in spec) - apply(simp) - done - have b3: "X2\(\1@(X1,P)#\1)" using lh_drv_prem2 freshness a2 - by (auto simp add: fresh_prod fresh_list_append fresh_list_cons dest: subtype_implies_fresh) - show "(\1@(X1,P)#\1) \ \ [X2<:S1].S2 <: \ [X2<:T1].T2" using b0 b3 b1 by force - qed + have lh_drv_prem1: "\1 \ T1 <: S1" by fact + have lh_drv_prem2: "X1\\1" "X1\S1" "X1\T1" by fact (* check this whether this is the lh_drv_p2 *) + have lh_drv_prem3: "((X1,T1)#\1) \ S2 <: T2" by fact + have \1_inst: "\1 = \@(X,Q)#\2" by fact + have a2: "\2 \ P <: Q" by fact + have b0: "(\@(X,P)#\2) \ T1 <: S1" using \1_inst a2 lh_drv_prem1 IH_inner1 by simp + have b1: "(((X1,T1)#\)@(X,P)#\2) \ S2 <: T2" using \1_inst a2 lh_drv_prem3 IH_inner2 + apply(auto) + apply(drule_tac x="\2" in meta_spec) + apply(drule_tac x="(X1,T1)#\" in meta_spec) + apply(auto) + done + have b3: "X1\(\@(X,P)#\2)" using lh_drv_prem2 \1_inst a2 + by (auto simp add: fresh_prod fresh_list_append fresh_list_cons dest: subtype_implies_fresh) + show "(\@(X,P)#\2) \ \ [X1<:S1].S2 <: \ [X1<:T1].T2" using b0 b3 b1 by force qed qed from transitivity narrowing show ?case by blast