Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/sources/formale Sprachen/Isabelle/HOL/Nominal/Examples/ (Beweissystem Isabelle Version 2025-1^©) Datei vom 16.11.2025 mit Größe 88 kB

Quelle Fsub.thy Sprache: Isabelle

(*<*)
theory Fsub
imports "HOL-Nominal.Nominal"
begin
(*>*)

text\<open>Authors: Christian Urban,
                Benjamin Pierce,
                Dimitrios Vytiniotis
                Stephanie Weirich
                Steve Zdancewic
                Julien Narboux
                Stefan Berghofer

       with great help from Markus Wenzel.\<close>

section \<open>Types for Names, Nominal Datatype Declaration for Types and Terms\<close>

text \<open>The main point of this solution is to use names everywhere (be they bound,
  binding or free). In System \FSUB{} there are two kinds of names corresponding to
  type-variables and to term-variables. These two kinds of names are represented in
  the nominal datatype package as atom-types \<open>tyvrs\<close> and \<open>vrs\<close>:\<close>

atom_decl tyvrs vrs

text\<open>There are numerous facts that come with this declaration: for example that
  there are infinitely many elements in \<open>tyvrs\<close> and \<open>vrs\<close>.\<close>

text\<open>The constructors for types and terms in System \FSUB{} contain abstractions
  over type-variables and term-variables. The nominal datatype package uses
  \<open>\<guillemotleft>\<dots>\<guillemotright>\<dots>\<close> to indicate where abstractions occur.\<close>

nominal_datatype ty =
    Tvar   "tyvrs"
  | Top
  | Arrow  "ty" "ty"         (infixr \<open>\<rightarrow>\<close> 200)
  | Forall "\tyvrs\ty" "ty"

nominal_datatype trm =
    Var   "vrs"
  | Abs   "\vrs\trm" "ty"
  | TAbs  "\tyvrs\trm" "ty"
  | App   "trm" "trm" (infixl \<open>\<cdot>\<close> 200)
  | TApp  "trm" "ty"  (infixl \<open>\<cdot>\<^sub>\<tau>\<close> 200)

text \<open>To be polite to the eye, some more familiar notation is introduced.
  Because of the change in the order of arguments, one needs to use
  translation rules, instead of syntax annotations at the term-constructors
  as given above for \<^term>\<open>Arrow\<close>.\<close>

abbreviation
  Forall_syn :: "tyvrs \ ty \ ty \ ty" (\(3\_<:_./ _)\ [0, 0, 10] 10)
where
  "\X<:T\<^sub>1. T\<^sub>2 \ ty.Forall X T\<^sub>2 T\<^sub>1"

abbreviation
  Abs_syn    :: "vrs \ ty \ trm \ trm" (\(3\_:_./ _)\ [0, 0, 10] 10)
where
  "\x:T. t \ trm.Abs x t T"

abbreviation
  TAbs_syn   :: "tyvrs \ ty \ trm \ trm" (\(3\_<:_./ _)\ [0, 0, 10] 10)
where
  "\X<:T. t \ trm.TAbs X t T"

text \<open>Again there are numerous facts that are proved automatically for \<^typ>\<open>ty\<close>
  and \<^typ>\<open>trm\<close>: for example that the set of free variables, i.e.~the \<open>support\<close>,
  is finite. However note that nominal-datatype declarations do \emph{not} define
  ``classical" constructor-based datatypes, but rather define $\alpha$-equivalence
  classes---we can for example show that $\alpha$-equivalent \<^typ>\<open>ty\<close>s
  and \<^typ>\<open>trm\<close>s are equal:\<close>

lemma alpha_illustration:
  shows "(\X<:T. Tvar X) = (\Y<:T. Tvar Y)"
  and   "(\x:T. Var x) = (\y:T. Var y)"
  by (simp_all add: ty.inject trm.inject alpha calc_atm fresh_atm)

section \<open>SubTyping Contexts\<close>

nominal_datatype binding =
    VarB vrs ty
  | TVarB tyvrs ty

type_synonym env = "binding list"

text \<open>Typing contexts are represented as lists that ``grow" on the left; we
  thereby deviating from the convention in the POPLmark-paper. The lists contain
  pairs of type-variables and types (this is sufficient for Part 1A).\<close>

text \<open>In order to state validity-conditions for typing-contexts, the notion of
  a \<open>dom\<close> of a typing-context is handy.\<close>

nominal_primrec
  "tyvrs_of" :: "binding \ tyvrs set"
where
  "tyvrs_of (VarB x y) = {}"
| "tyvrs_of (TVarB x y) = {x}"
by auto

nominal_primrec
  "vrs_of" :: "binding \ vrs set"
where
  "vrs_of (VarB x y) = {x}"
| "vrs_of (TVarB x y) = {}"
by auto

primrec
  "ty_dom" :: "env \ tyvrs set"
where
  "ty_dom [] = {}"
| "ty_dom (X#\) = (tyvrs_of X)$ty_dom $"

primrec
  "trm_dom" :: "env \ vrs set"
where
  "trm_dom [] = {}"
| "trm_dom (X#\) = (vrs_of X)$trm_dom $"

lemma vrs_of_eqvt[eqvt]:
  fixes pi ::"tyvrs prm"
  and   pi'::"vrs prm"
  shows "pi $tyvrs_of x) = tyvrs_of (pi\x)"
  and   "pi'\(tyvrs_of x) = tyvrs_of (pi'\x)"
  and   "pi \(vrs_of x) = vrs_of (pi\x)"
  and   "pi'\(vrs_of x) = vrs_of (pi'\x)"
by (nominal_induct x rule: binding.strong_induct) (simp_all add: tyvrs_of.simps eqvts)

lemma doms_eqvt[eqvt]:
  fixes pi::"tyvrs prm"
  and   pi'::"vrs prm"
  shows "pi \(ty_dom $ = ty_dom (pi\\)"
  and   "pi'$ty_dom $ = ty_dom (pi'\\)"
  and   "pi $trm_dom $ = trm_dom (pi\\)"
  and   "pi'$trm_dom $ = trm_dom (pi'\\)"
by (induct \<Gamma>) (simp_all add: eqvts)

lemma finite_vrs:
  shows "finite (tyvrs_of x)"
  and   "finite (vrs_of x)"
by (nominal_induct rule:binding.strong_induct) auto

lemma finite_doms:
  shows "finite (ty_dom \)"
  and   "finite (trm_dom \)"
by (induct \<Gamma>) (auto simp: finite_vrs)

lemma ty_dom_supp:
  shows "(supp (ty_dom \)) = (ty_dom \)"
  and   "(supp (trm_dom \)) = (trm_dom \)"
by (simp only: at_fin_set_supp at_tyvrs_inst at_vrs_inst finite_doms)+

lemma ty_dom_inclusion:
  assumes a: "(TVarB X T)\set \"
  shows "X$ty_dom $"
using a by (induct \<Gamma>) (auto)

lemma ty_binding_existence:
  assumes "X \ (tyvrs_of a)"
  shows "\T.(TVarB X T=a)"
  using assms
by (nominal_induct a rule: binding.strong_induct) (auto)

lemma ty_dom_existence:
  assumes a: "X$ty_dom $"
  shows "\T.(TVarB X T)\set \"
  using a
proof (induction \<Gamma>)
  case Nil then show ?case by simp
next
  case (Cons a \<Gamma>) then show ?case
    using ty_binding_existence by fastforce
qed

lemma doms_append:
  shows "ty_dom (\@\) = ((ty_dom \) \ (ty_dom \))"
  and   "trm_dom (\@\) = ((trm_dom \) \ (trm_dom \))"
  by (induct \<Gamma>) (auto)

lemma ty_vrs_prm_simp:
  fixes pi::"vrs prm"
  and   S::"ty"
  shows "pi\S = S"
by (induct S rule: ty.induct) (auto simp: calc_atm)

lemma fresh_ty_dom_cons:
  fixes X::"tyvrs"
  shows "X$ty_dom (Y#$) = (X$tyvrs_of Y) \ X\(ty_dom $)"
proof (nominal_induct rule:binding.strong_induct)
  case (VarB vrs ty)
  then show ?case by auto
next
  case (TVarB tyvrs ty)
  then show ?case
    by (simp add: at_fin_set_supp at_tyvrs_inst finite_doms(1) fresh_def supp_atm(1))
qed

lemma tyvrs_fresh:
  fixes   X::"tyvrs"
  assumes "X \ a"
  shows   "X \ tyvrs_of a"
  and     "X \ vrs_of a"
  using assms
  by (nominal_induct a rule:binding.strong_induct) (force simp: fresh_singleton)+

lemma fresh_dom:
  fixes X::"tyvrs"
  assumes a: "X\\"
  shows "X$ty_dom $"
using a
proof (induct \<Gamma>)
  case Nil then show ?case by auto
next
  case (Cons a \<Gamma>) then show ?case
    by (meson fresh_list_cons fresh_ty_dom_cons tyvrs_fresh(1))
qed

text \<open>Not all lists of type \<^typ>\<open>env\<close> are well-formed. One condition
  requires that in \<^term>\<open>TVarB X S#\<Gamma>\<close> all free variables of \<^term>\<open>S\<close> must be
  in the \<^term>\<open>ty_dom\<close> of \<^term>\<open>\<Gamma>\<close>, that is \<^term>\<open>S\<close> must be \<open>closed\<close>
  in \<^term>\<open>\<Gamma>\<close>. The set of free variables of \<^term>\<open>S\<close> is the
  \<open>support\<close> of \<^term>\<open>S\<close>.\<close>

definition "closed_in" :: "ty \ env \ bool" (\_ closed'_in _\ [100,100] 100) where
  "S closed_in \ \ (supp S)$ty_dom $"

lemma closed_in_eqvt[eqvt]:
  fixes pi::"tyvrs prm"
  assumes a: "S closed_in \"
  shows "(pi\S) closed_in (pi\\)"
  using a
proof -
  from a have "pi$S closed_in $" by (simp add: perm_bool)
  then show "(pi\S) closed_in (pi\\)" by (simp add: closed_in_def eqvts)
qed

lemma tyvrs_vrs_prm_simp:
  fixes pi::"vrs prm"
  shows "tyvrs_of (pi\a) = tyvrs_of a"
  by (nominal_induct rule:binding.strong_induct) (auto simp: vrs_prm_tyvrs_def)

lemma ty_vrs_fresh:
  fixes x::"vrs"
  and   T::"ty"
  shows "x \ T"
by (simp add: fresh_def supp_def ty_vrs_prm_simp)

lemma ty_dom_vrs_prm_simp:
  fixes pi::"vrs prm"
  and   \<Gamma>::"env"
  shows "(ty_dom (pi\\)) = (ty_dom \)"
by (induct \<Gamma>) (auto simp: tyvrs_vrs_prm_simp)

lemma closed_in_eqvt'[eqvt]:
  fixes pi::"vrs prm"
  assumes a: "S closed_in \"
  shows "(pi\S) closed_in (pi\\)"
  using assms closed_in_def ty_dom_vrs_prm_simp ty_vrs_prm_simp by force

lemma fresh_vrs_of:
  fixes x::"vrs"
  shows "x\vrs_of b = x\b"
  by (nominal_induct b rule: binding.strong_induct)
    (simp_all add: fresh_singleton fresh_set_empty ty_vrs_fresh fresh_atm)

lemma fresh_trm_dom:
  fixes x::"vrs"
  shows "x\ trm_dom \ = x\\"
  by (induct \<Gamma>)
    (simp_all add: fresh_list_cons
     fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
     finite_doms finite_vrs fresh_vrs_of)

lemma closed_in_fresh: "(X::tyvrs) \ ty_dom \ \ T closed_in \ \ X \ T"
  by (auto simp: closed_in_def fresh_def ty_dom_supp)

text \<open>Now validity of a context is a straightforward inductive definition.\<close>

inductive
  valid_rel :: "env \ bool" (\\ _ ok\ [100] 100)
where
  valid_nil[simp]:   "\ [] ok"
| valid_consT[simp]: "\\ \ ok; X$ty_dom $; T closed_in \\ \ \ (TVarB X T#\) ok"
| valid_cons [simp]: "\\ \ ok; x$trm_dom $; T closed_in \\ \ \ (VarB x T#\) ok"

equivariance valid_rel

declare binding.inject [simp add]
declare trm.inject     [simp add]

inductive_cases validE[elim]:
  "\ (TVarB X T#\) ok"
  "\ (VarB x T#\) ok"
  "\ (b#\) ok"

declare binding.inject [simp del]
declare trm.inject     [simp del]

lemma validE_append:
  assumes a: "\ (\@\) ok"
  shows "\ \ ok"
  using a
proof (induct \<Delta>)
  case (Cons a \<Gamma>')
  then show ?case
    by (nominal_induct a rule:binding.strong_induct) auto
qed (auto)

lemma replace_type:
  assumes a: "\ (\@(TVarB X T)#\) ok"
  and     b: "S closed_in \"
  shows "\ (\@(TVarB X S)#\) ok"
using a b
proof(induct \<Delta>)
  case Nil
  then show ?case by (auto intro: valid_cons simp add: doms_append closed_in_def)
next
  case (Cons a \<Gamma>')
  then show ?case
    by (nominal_induct a rule:binding.strong_induct)
       (auto intro!: valid_cons simp add: doms_append closed_in_def)
qed

text \<open>Well-formed contexts have a unique type-binding for a type-variable.\<close>

lemma uniqueness_of_ctxt:
  fixes \<Gamma>::"env"
  assumes a: "\ \ ok"
  and     b: "(TVarB X T)\set \"
  and     c: "(TVarB X S)\set \"
  shows "T=S"
using a b c
proof (induct)
  case (valid_consT \<Gamma> X' T')
  moreover
  { fix \<Gamma>'::"env"
    assume a: "X'\(ty_dom \')"
    have "\(\T.(TVarB X' T)\(set \'))" using a
    proof (induct \<Gamma>')
      case (Cons Y \<Gamma>')
      thus "\ (\T.(TVarB X' T)\set(Y#\'))"
        by (simp add:  fresh_ty_dom_cons
                       fresh_fin_union[OF pt_tyvrs_inst  at_tyvrs_inst fs_tyvrs_inst]
                       finite_vrs finite_doms,
            auto simp: fresh_atm fresh_singleton)
    qed (simp)
  }
  ultimately show "T=S" by (auto simp: binding.inject)
qed (auto)

lemma uniqueness_of_ctxt':
  fixes \<Gamma>::"env"
  assumes a: "\ \ ok"
  and     b: "(VarB x T)\set \"
  and     c: "(VarB x S)\set \"
  shows "T=S"
using a b c
proof (induct)
  case (valid_cons \<Gamma> x' T')
  moreover
  { fix \<Gamma>'::"env"
    assume a: "x'\(trm_dom \')"
    have "\(\T.(VarB x' T)\(set \'))" using a
    proof (induct \<Gamma>')
      case (Cons y \<Gamma>')
      thus "\ (\T.(VarB x' T)\set(y#\'))"
        by (simp add:  fresh_fin_union[OF pt_vrs_inst  at_vrs_inst fs_vrs_inst]
                       finite_vrs finite_doms,
            auto simp: fresh_atm fresh_singleton)
    qed (simp)
  }
  ultimately show "T=S" by (auto simp: binding.inject)
qed (auto)

section \<open>Size and Capture-Avoiding Substitution for Types\<close>

nominal_primrec
  size_ty :: "ty \ nat"
where
  "size_ty (Tvar X) = 1"
| "size_ty (Top) = 1"
| "size_ty (T1 \ T2) = (size_ty T1) + (size_ty T2) + 1"
| "X \ T1 \ size_ty (\X<:T1. T2) = (size_ty T1) + (size_ty T2) + 1"
  by (finite_guess | fresh_guess | simp)+

nominal_primrec
  subst_ty :: "ty \ tyvrs \ ty \ ty" (\_[_ \ _]\<^sub>\\ [300, 0, 0] 300)
where
  "(Tvar X)[Y \ T]\<^sub>\ = (if X=Y then T else Tvar X)"
| "(Top)[Y \ T]\<^sub>\ = Top"
| "(T\<^sub>1 \ T\<^sub>2)[Y \ T]\<^sub>\ = T\<^sub>1[Y \ T]\<^sub>\ \ T\<^sub>2[Y \ T]\<^sub>\"
| "X$Y,T,T\<^sub>1) \ (\X<:T\<^sub>1. T\<^sub>2)[Y \ T]\<^sub>\ = (\X<:T\<^sub>1[Y \ T]\<^sub>\. T\<^sub>2[Y \ T]\<^sub>$"
  by (finite_guess | fresh_guess | simp add: abs_fresh)+

lemma subst_eqvt[eqvt]:
  fixes pi::"tyvrs prm"
  and   T::"ty"
  shows "pi$T[X \ T']\<^sub>$ = (pi\T)[(pi\X) \ (pi\T')]\<^sub>\"
  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
     (perm_simp add: fresh_bij)+

lemma subst_eqvt'[eqvt]:
  fixes pi::"vrs prm"
  and   T::"ty"
  shows "pi$T[X \ T']\<^sub>$ = (pi\T)[(pi\X) \ (pi\T')]\<^sub>\"
  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
     (perm_simp add: fresh_left)+

lemma type_subst_fresh:
  fixes X::"tyvrs"
  assumes "X\T" and "X\P"
  shows   "X\T[Y \ P]\<^sub>\"
  using assms
  by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
    (auto simp: abs_fresh)

lemma fresh_type_subst_fresh:
  assumes "X\T'"
  shows "X\T[X \ T']\<^sub>\"
  using assms
  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
     (auto simp: fresh_atm abs_fresh)

lemma type_subst_identity:
  "X\T \ T[X \ U]\<^sub>\ = T"
  by (nominal_induct T avoiding: X U rule: ty.strong_induct)
    (simp_all add: fresh_atm abs_fresh)

lemma type_substitution_lemma:
  "X \ Y \ X\L \ M[X \ N]\<^sub>\[Y \ L]\<^sub>\ = M[Y \ L]\<^sub>\[X \ N[Y \ L]\<^sub>\]\<^sub>\"
  by (nominal_induct M avoiding: X Y N L rule: ty.strong_induct)
    (auto simp: type_subst_fresh type_subst_identity)

lemma type_subst_rename:
  "Y\T \ ([(Y,X)]\T)[Y \ U]\<^sub>\ = T[X \ U]\<^sub>\"
  by (nominal_induct T avoiding: X Y U rule: ty.strong_induct)
    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux)

nominal_primrec
  subst_tyb :: "binding \ tyvrs \ ty \ binding" (\_[_ \ _]\<^sub>b\ [100,100,100] 100)
where
  "(TVarB X U)[Y \ T]\<^sub>b = TVarB X (U[Y \ T]\<^sub>\)"
| "(VarB X U)[Y \ T]\<^sub>b = VarB X (U[Y \ T]\<^sub>\)"
by auto

lemma binding_subst_fresh:
  fixes X::"tyvrs"
  assumes "X\a"
  and     "X\P"
  shows "X\a[Y \ P]\<^sub>b"
using assms
by (nominal_induct a rule: binding.strong_induct)
   (auto simp: type_subst_fresh)

lemma binding_subst_identity:
  shows "X\B \ B[X \ U]\<^sub>b = B"
by (induct B rule: binding.induct)
   (simp_all add: fresh_atm type_subst_identity)

primrec subst_tyc :: "env \ tyvrs \ ty \ env" (\_[_ \ _]\<^sub>e\ [100,100,100] 100) where
  "([])[Y \ T]\<^sub>e= []"
| "(B#\)[Y \ T]\<^sub>e = (B[Y \ T]\<^sub>b)#(\[Y \ T]\<^sub>e)"

lemma ctxt_subst_fresh':
  fixes X::"tyvrs"
  assumes "X\\"
  and     "X\P"
  shows   "X\\[Y \ P]\<^sub>e"
using assms
by (induct \<Gamma>)
   (auto simp: fresh_list_cons binding_subst_fresh)

lemma ctxt_subst_mem_TVarB: "TVarB X T \ set \ \ TVarB X (T[Y \ U]\<^sub>\) \ set (\[Y \ U]\<^sub>e)"
  by (induct \<Gamma>) auto

lemma ctxt_subst_mem_VarB: "VarB x T \ set \ \ VarB x (T[Y \ U]\<^sub>\) \ set (\[Y \ U]\<^sub>e)"
  by (induct \<Gamma>) auto

lemma ctxt_subst_identity: "X\\ \ \[X \ U]\<^sub>e = \"
  by (induct \<Gamma>) (simp_all add: fresh_list_cons binding_subst_identity)

lemma ctxt_subst_append: "(\ @ \)[X \ T]\<^sub>e = \[X \ T]\<^sub>e @ \[X \ T]\<^sub>e"
  by (induct \<Delta>) simp_all

nominal_primrec
   subst_trm :: "trm \ vrs \ trm \ trm" (\_[_ \ _]\ [300, 0, 0] 300)
where
  "(Var x)[y \ t'] = (if x=y then t' else (Var x))"
| "(t1 \ t2)[y \ t'] = t1[y \ t'] \ t2[y \ t']"
| "(t \\<^sub>\ T)[y \ t'] = t[y \ t'] \\<^sub>\ T"
| "X\(T,t') \ (\X<:T. t)[y \ t'] = (\X<:T. t[y \ t'])"
| "x\(y,t') \ (\x:T. t)[y \ t'] = (\x:T. t[y \ t'])"
  by (finite_guess | simp add: abs_fresh | fresh_guess add: ty_vrs_fresh abs_fresh)+

lemma subst_trm_fresh_tyvar:
  fixes X::"tyvrs"
  shows "X\t \ X\u \ X\t[x \ u]"
  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
    (auto simp: abs_fresh)

lemma subst_trm_fresh_var:
  "x\u \ x\t[x \ u]"
  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
    (simp_all add: abs_fresh fresh_atm ty_vrs_fresh)

lemma subst_trm_eqvt[eqvt]:
  fixes pi::"tyvrs prm"
  and   t::"trm"
  shows "pi\(t[x \ u]) = (pi\t)[(pi\x) \ (pi\u)]"
  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
     (perm_simp add: fresh_left)+

lemma subst_trm_eqvt'[eqvt]:
  fixes pi::"vrs prm"
  and   t::"trm"
  shows "pi\(t[x \ u]) = (pi\t)[(pi\x) \ (pi\u)]"
  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
     (perm_simp add: fresh_left)+

lemma subst_trm_rename:
  "y\t \ ([(y, x)] \ t)[y \ u] = t[x \ u]"
  by (nominal_induct t avoiding: x y u rule: trm.strong_induct)
    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux ty_vrs_fresh perm_fresh_fresh)

nominal_primrec (freshness_context: "T2::ty")
  subst_trm_ty :: "trm \ tyvrs \ ty \ trm" (\_[_ \\<^sub>\ _]\ [300, 0, 0] 300)
where
  "(Var x)[Y \\<^sub>\ T2] = Var x"
| "(t1 \ t2)[Y \\<^sub>\ T2] = t1[Y \\<^sub>\ T2] \ t2[Y \\<^sub>\ T2]"
| "(t1 \\<^sub>\ T)[Y \\<^sub>\ T2] = t1[Y \\<^sub>\ T2] \\<^sub>\ T[Y \ T2]\<^sub>\"
| "X\(Y,T,T2) \ (\X<:T. t)[Y \\<^sub>\ T2] = (\X<:T[Y \ T2]\<^sub>\. t[Y \\<^sub>\ T2])"
| "(\x:T. t)[Y \\<^sub>\ T2] = (\x:T[Y \ T2]\<^sub>\. t[Y \\<^sub>\ T2])"
apply(finite_guess | simp add: abs_fresh ty_vrs_fresh type_subst_fresh)+
apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
done

lemma subst_trm_ty_fresh:
  fixes X::"tyvrs"
  shows "X\t \ X\T \ X\t[Y \\<^sub>\ T]"
  by (nominal_induct t avoiding: Y T rule: trm.strong_induct)
    (auto simp: abs_fresh type_subst_fresh)

lemma subst_trm_ty_fresh':
  "X\T \ X\t[X \\<^sub>\ T]"
  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
    (simp_all add: abs_fresh fresh_type_subst_fresh fresh_atm)

lemma subst_trm_ty_eqvt[eqvt]:
  fixes pi::"tyvrs prm"
  and   t::"trm"
  shows "pi\(t[X \\<^sub>\ T]) = (pi\t)[(pi\X) \\<^sub>\ (pi\T)]"
  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
     (perm_simp add: fresh_bij subst_eqvt)+

lemma subst_trm_ty_eqvt'[eqvt]:
  fixes pi::"vrs prm"
  and   t::"trm"
  shows "pi\(t[X \\<^sub>\ T]) = (pi\t)[(pi\X) \\<^sub>\ (pi\T)]"
  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
     (perm_simp add: fresh_left subst_eqvt')+

lemma subst_trm_ty_rename:
  "Y\t \ ([(Y, X)] \ t)[Y \\<^sub>\ U] = t[X \\<^sub>\ U]"
  by (nominal_induct t avoiding: X Y U rule: trm.strong_induct)
    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux type_subst_rename)

section \<open>Subtyping-Relation\<close>

text \<open>The definition for the subtyping-relation follows quite closely what is written
  in the POPLmark-paper, except for the premises dealing with well-formed contexts and
  the freshness constraint \<^term>\<open>X\<sharp>\<Gamma>\<close> in the \<open>S_Forall\<close>-rule. (The freshness
  constraint is specific to the \emph{nominal approach}. Note, however, that the constraint
  does \emph{not} make the subtyping-relation ``partial"\ldots because we work over
  $\alpha$-equivalence classes.)\<close>

inductive
  subtype_of :: "env \ ty \ ty \ bool" (\_\_<:_\ [100,100,100] 100)
where
  SA_Top[intro]:    "\\ \ ok; S closed_in \\ \ \ \ S <: Top"
| SA_refl_TVar[intro]:   "\\ \ ok; X \ ty_dom \\\ \ \ Tvar X <: Tvar X"
| SA_trans_TVar[intro]:    "$TVarB X S) \ set \; \ \ S <: T\ \ \ \ (Tvar X) <: T"
| SA_arrow[intro]:  "\\ \ T\<^sub>1 <: S\<^sub>1; \ \ S\<^sub>2 <: T\<^sub>2\ \ \ \ (S\<^sub>1 \ S\<^sub>2) <: (T\<^sub>1 \ T\<^sub>2)"
| SA_all[intro]: "\\ \ T\<^sub>1 <: S\<^sub>1; ((TVarB X T\<^sub>1)#$ \ S\<^sub>2 <: T\<^sub>2\ \ \ \ (\X<:S\<^sub>1. S\<^sub>2) <: (\X<:T\<^sub>1. T\<^sub>2)"

lemma subtype_implies_ok:
  fixes X::"tyvrs"
  assumes a: "\ \ S <: T"
  shows "\ \ ok"
using a by (induct) (auto)

lemma subtype_implies_closed:
  assumes a: "\ \ S <: T"
  shows "S closed_in \ \ T closed_in \"
using a
proof (induct)
  case (SA_Top \<Gamma> S)
  have "Top closed_in \" by (simp add: closed_in_def ty.supp)
  moreover
  have "S closed_in \" by fact
  ultimately show "S closed_in \ \ Top closed_in \" by simp
next
  case (SA_trans_TVar X S \<Gamma> T)
  have "(TVarB X S)\set \" by fact
  hence "X \ ty_dom \" by (rule ty_dom_inclusion)
  hence "(Tvar X) closed_in \" by (simp add: closed_in_def ty.supp supp_atm)
  moreover
  have "S closed_in \ \ T closed_in \" by fact
  hence "T closed_in \" by force
  ultimately show "(Tvar X) closed_in \ \ T closed_in \" by simp
qed (auto simp: closed_in_def ty.supp supp_atm abs_supp)

lemma subtype_implies_fresh:
  fixes X::"tyvrs"
  assumes a1: "\ \ S <: T"
  and     a2: "X\\"
  shows "X\S \ X\T"
proof -
  from a1 have "\ \ ok" by (rule subtype_implies_ok)
  with a2 have "X\ty_dom(\)" by (simp add: fresh_dom)
  moreover
  from a1 have "S closed_in \ \ T closed_in \" by (rule subtype_implies_closed)
  hence "supp S \ ((supp (ty_dom \))::tyvrs set)"
    and "supp T \ ((supp (ty_dom \))::tyvrs set)" by (simp_all add: ty_dom_supp closed_in_def)
  ultimately show "X\S \ X\T" by (force simp: supp_prod fresh_def)
qed

lemma valid_ty_dom_fresh:
  fixes X::"tyvrs"
  assumes valid: "\ \ ok"
  shows "X$ty_dom $ = X\\"
  using valid
proof induct
  case valid_nil
  then show ?case by auto
next
  case (valid_consT \<Gamma> X T)
  then show ?case
    by (auto simp: fresh_list_cons closed_in_fresh
     fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms)
next
  case (valid_cons \<Gamma> x T)
  then show ?case
    using fresh_atm by (auto simp: fresh_list_cons closed_in_fresh)
qed

equivariance subtype_of

nominal_inductive subtype_of
  apply (simp_all add: abs_fresh)
  apply (fastforce simp: valid_ty_dom_fresh dest: subtype_implies_ok)
  apply (force simp: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
  done

section \<open>Reflexivity of Subtyping\<close>

lemma subtype_reflexivity:
  assumes a: "\ \ ok"
  and b: "T closed_in \"
  shows "\ \ T <: T"
using a b
proof(nominal_induct T avoiding: \<Gamma> rule: ty.strong_induct)
  case (Forall X T\<^sub>1 T\<^sub>2)
  have ih_T\<^sub>1: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^sub>1 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^sub>1 <: T\<^sub>1" by fact
  have ih_T\<^sub>2: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^sub>2 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>2" by fact
  have fresh_cond: "X\\" by fact
  hence fresh_ty_dom: "X$ty_dom $" by (simp add: fresh_dom)
  have "(\X<:T\<^sub>2. T\<^sub>1) closed_in \" by fact
  hence closed\<^sub>T2: "T\<^sub>2 closed_in \<Gamma>" and closed\<^sub>T1: "T\<^sub>1 closed_in ((TVarB  X T\<^sub>2)#\<Gamma>)"
    by (auto simp: closed_in_def ty.supp abs_supp)
  have ok: "\ \ ok" by fact
  hence ok': "\ ((TVarB X T\<^sub>2)#\) ok" using closed\<^sub>T2 fresh_ty_dom by simp
  have "\ \ T\<^sub>2 <: T\<^sub>2" using ih_T\<^sub>2 closed\<^sub>T2 ok by simp
  moreover
  have "((TVarB X T\<^sub>2)#\) \ T\<^sub>1 <: T\<^sub>1" using ih_T\<^sub>1 closed\<^sub>T1 ok' by simp
  ultimately show "\ \ (\X<:T\<^sub>2. T\<^sub>1) <: (\X<:T\<^sub>2. T\<^sub>1)" using fresh_cond
    by (simp add: subtype_of.SA_all)
qed (auto simp: closed_in_def ty.supp supp_atm)

lemma subtype_reflexivity_semiautomated:
  assumes a: "\ \ ok"
  and     b: "T closed_in \"
  shows "\ \ T <: T"
using a b
apply(nominal_induct T avoiding: \<Gamma> rule: ty.strong_induct)
apply(auto simp: ty.supp abs_supp supp_atm closed_in_def)
  \<comment> \<open>Too bad that this instantiation cannot be found automatically by
  \isakeyword{auto}; \isakeyword{blast} would find it if we had not used
  an explicit definition for \<open>closed_in_def\<close>.\<close>
apply(drule_tac x="(TVarB tyvrs ty2)#\" in meta_spec)
apply(force dest: fresh_dom simp add: closed_in_def)
done

section \<open>Weakening\<close>

text \<open>In order to prove weakening we introduce the notion of a type-context extending
  another. This generalization seems to make the proof for weakening to be
  smoother than if we had strictly adhered to the version in the POPLmark-paper.\<close>

definition extends :: "env \ env \ bool" (\_ extends _\ [100,100] 100) where
  "\ extends \ \ \X Q. (TVarB X Q)\set \ \ (TVarB X Q)\set \"

lemma extends_ty_dom:
  assumes "\ extends \"
  shows "ty_dom \ \ ty_dom \"
  using assms
  by (meson extends_def subsetI ty_dom_existence ty_dom_inclusion)

lemma extends_closed:
  assumes "T closed_in \" and "\ extends \"
  shows "T closed_in \"
  by (meson assms closed_in_def extends_ty_dom order.trans)

lemma extends_memb:
  assumes a: "\ extends \"
  and b: "(TVarB X T) \ set \"
  shows "(TVarB X T) \ set \"
  using a b by (simp add: extends_def)

lemma weakening:
  assumes a: "\ \ S <: T"
  and b: "\ \ ok"
  and c: "\ extends \"
  shows "\ \ S <: T"
  using a b c
proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
  case (SA_Top \<Gamma> S)
  have lh_drv_prem: "S closed_in \" by fact
  have "\ \ ok" by fact
  moreover
  have "\ extends \" by fact
  hence "S closed_in \" using lh_drv_prem by (simp only: extends_closed)
  ultimately show "\ \ S <: Top" by force
next
  case (SA_trans_TVar X S \<Gamma> T)
  have lh_drv_prem: "(TVarB X S) \ set \" by fact
  have ih: "\\. \ \ ok \ \ extends \ \ \ \ S <: T" by fact
  have ok: "\ \ ok" by fact
  have extends: "\ extends \" by fact
  have "(TVarB X S) \ set \" using lh_drv_prem extends by (simp only: extends_memb)
  moreover
  have "\ \ S <: T" using ok extends ih by simp
  ultimately show "\ \ Tvar X <: T" using ok by force
next
  case (SA_refl_TVar \<Gamma> X)
  have lh_drv_prem: "X \ ty_dom \" by fact
  have "\ \ ok" by fact
  moreover
  have "\ extends \" by fact
  hence "X \ ty_dom \" using lh_drv_prem by (force dest: extends_ty_dom)
  ultimately show "\ \ Tvar X <: Tvar X" by force
next
  case (SA_arrow \<Gamma> T\<^sub>1 S\<^sub>1 S\<^sub>2 T\<^sub>2) thus "\<Delta> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T\<^sub>1 \<rightarrow> T\<^sub>2" by blast
next
  case (SA_all \<Gamma> T\<^sub>1 S\<^sub>1 X S\<^sub>2 T\<^sub>2)
  have fresh_cond: "X\\" by fact
  hence fresh_dom: "X$ty_dom $" by (simp add: fresh_dom)
  have ih\<^sub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
  have ih\<^sub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^sub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^sub>2 <: T\<^sub>2" by fact
  have lh_drv_prem: "\ \ T\<^sub>1 <: S\<^sub>1" by fact
  hence closed\<^sub>T1: "T\<^sub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed)
  have ok: "\ \ ok" by fact
  have ext: "\ extends \" by fact
  have "T\<^sub>1 closed_in \" using ext closed\<^sub>T1 by (simp only: extends_closed)
  hence "\ ((TVarB X T\<^sub>1)#\) ok" using fresh_dom ok by force
  moreover
  have "((TVarB X T\<^sub>1)#\) extends ((TVarB X T\<^sub>1)#\)" using ext by (force simp: extends_def)
  ultimately have "((TVarB X T\<^sub>1)#\) \ S\<^sub>2 <: T\<^sub>2" using ih\<^sub>2 by simp
  moreover
  have "\ \ T\<^sub>1 <: S\<^sub>1" using ok ext ih\<^sub>1 by simp
  ultimately show "\ \ (\X<:S\<^sub>1. S\<^sub>2) <: (\X<:T\<^sub>1. T\<^sub>2)" using ok by (force intro: SA_all)
qed

text \<open>In fact all ``non-binding" cases can be solved automatically:\<close>

lemma weakening_more_automated:
  assumes a: "\ \ S <: T"
  and b: "\ \ ok"
  and c: "\ extends \"
  shows "\ \ S <: T"
  using a b c
proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
  case (SA_all \<Gamma> T\<^sub>1 S\<^sub>1 X S\<^sub>2 T\<^sub>2)
  have fresh_cond: "X\\" by fact
  hence fresh_dom: "X$ty_dom $" by (simp add: fresh_dom)
  have ih\<^sub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
  have ih\<^sub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^sub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^sub>2 <: T\<^sub>2" by fact
  have lh_drv_prem: "\ \ T\<^sub>1 <: S\<^sub>1" by fact
  hence closed\<^sub>T1: "T\<^sub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed)
  have ok: "\ \ ok" by fact
  have ext: "\ extends \" by fact
  have "T\<^sub>1 closed_in \" using ext closed\<^sub>T1 by (simp only: extends_closed)
  hence "\ ((TVarB X T\<^sub>1)#\) ok" using fresh_dom ok by force
  moreover
  have "((TVarB X T\<^sub>1)#\) extends ((TVarB X T\<^sub>1)#\)" using ext by (force simp: extends_def)
  ultimately have "((TVarB X T\<^sub>1)#\) \ S\<^sub>2 <: T\<^sub>2" using ih\<^sub>2 by simp
  moreover
  have "\ \ T\<^sub>1 <: S\<^sub>1" using ok ext ih\<^sub>1 by simp
  ultimately show "\ \ (\X<:S\<^sub>1. S\<^sub>2) <: (\X<:T\<^sub>1. T\<^sub>2)" using ok by (force intro: SA_all)
qed (blast intro: extends_closed extends_memb dest: extends_ty_dom)+

section \<open>Transitivity and Narrowing\<close>

text \<open>Some inversion lemmas that are needed in the transitivity and narrowing proof.\<close>

declare ty.inject [simp add]

inductive_cases S_TopE: "\ \ Top <: T"
inductive_cases S_ArrowE_left: "\ \ S\<^sub>1 \ S\<^sub>2 <: T"

declare ty.inject [simp del]

lemma S_ForallE_left:
  shows "\\ \ (\X<:S\<^sub>1. S\<^sub>2) <: T; X\\; X\S\<^sub>1; X\T\
         \<Longrightarrow> T = Top \<or> (\<exists>T\<^sub>1 T\<^sub>2. T = (\<forall>X<:T\<^sub>1. T\<^sub>2) \<and> \<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1 \<and> ((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2)"
  using subtype_of.strong_cases[where X="X"]
  by(force simp: abs_fresh ty.inject alpha)

text \<open>Next we prove the transitivity and narrowing for the subtyping-relation.
The POPLmark-paper says the following:

\begin{quote}
\begin{lemma}[Transitivity and Narrowing] \
\begin{enumerate}
\item If \<^term>\<open>\<Gamma> \<turnstile> S<:Q\<close> and \<^term>\<open>\<Gamma> \<turnstile> Q<:T\<close>, then \<^term>\<open>\<Gamma> \<turnstile> S<:T\<close>.
\item If \<open>\<Gamma>,X<:Q,\<Delta> \<turnstile> M<:N\<close> and \<^term>\<open>\<Gamma> \<turnstile> P<:Q\<close> then \<open>\<Gamma>,X<:P,\<Delta> \<turnstile> M<:N\<close>.
\end{enumerate}
\end{lemma}

The two parts are proved simultaneously, by induction on the size
of \<^term>\<open>Q\<close>.  The argument for part (2) assumes that part (1) has
been established already for the \<^term>\<open>Q\<close> in question; part (1) uses
part (2) only for strictly smaller \<^term>\<open>Q\<close>.
\end{quote}

For the induction on the size of \<^term>\<open>Q\<close>, we use the induction-rule
\<open>measure_induct_rule\<close>:

\begin{center}
@{thm measure_induct_rule[of "size_ty",no_vars]}
\end{center}

That means in order to show a property \<^term>\<open>P a\<close> for all \<^term>\<open>a\<close>,
the induct-rule requires to prove that for all \<^term>\<open>x\<close> \<^term>\<open>P x\<close> holds using the
assumption that for all \<^term>\<open>y\<close> whose size is strictly smaller than
that of \<^term>\<open>x\<close> the property \<^term>\<open>P y\<close> holds.\<close>

lemma
  shows subtype_transitivity: "\\S<:Q \ \\Q<:T \ \\S<:T"
  and subtype_narrow: "(\@[(TVarB X Q)]@\)\M<:N \ \\P<:Q \ (\@[(TVarB X P)]@\)\M<:N"
proof (induct Q arbitrary: \<Gamma> S T \<Delta> X P M N taking: "size_ty" rule: measure_induct_rule)
  case (less Q)
  have IH_trans:
    "\Q' \ S T. \size_ty Q' < size_ty Q; \\S<:Q'; \\Q'<:T\ \ \\S<:T" by fact
  have IH_narrow:
    "\Q' \ \ X M N P. \size_ty Q' < size_ty Q; (\@[(TVarB X Q')]@\)\M<:N; \\P<:Q'\
    \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N" by fact

  { fix \<Gamma> S T
    have "\\ \ S <: Q; \ \ Q <: T\ \ \ \ S <: T"
    proof (induct \<Gamma> S Q\<equiv>Q rule: subtype_of.induct)
      case (SA_Top \<Gamma> S)
      then have rh_drv: "\ \ Top <: T" by simp
      then have T_inst: "T = Top" by (auto elim: S_TopE)
      from \<open>\<turnstile> \<Gamma> ok\<close> and \<open>S closed_in \<Gamma>\<close>
      have "\ \ S <: Top" by auto
      then show "\ \ S <: T" using T_inst by simp
    next
      case (SA_trans_TVar Y U \<Gamma>)
      then have IH_inner: "\ \ U <: T" by simp
      have "(TVarB Y U) \ set \" by fact
      with IH_inner show "\ \ Tvar Y <: T" by auto
    next
      case (SA_refl_TVar \<Gamma> X)
      then show "\ \ Tvar X <: T" by simp
    next
      case (SA_arrow \<Gamma> Q\<^sub>1 S\<^sub>1 S\<^sub>2 Q\<^sub>2)
      then have rh_drv: "\ \ Q\<^sub>1 \ Q\<^sub>2 <: T" by simp
      from \<open>Q\<^sub>1 \<rightarrow> Q\<^sub>2 = Q\<close>
      have Q\<^sub>12_less: "size_ty Q\<^sub>1 < size_ty Q" "size_ty Q\<^sub>2 < size_ty Q" by auto
      have lh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> Q\<^sub>1 <: S\<^sub>1" by fact
      have lh_drv_prm\<^sub>2: "\<Gamma> \<turnstile> S\<^sub>2 <: Q\<^sub>2" by fact
      from rh_drv have "T=Top \ (\T\<^sub>1 T\<^sub>2. T=T\<^sub>1\T\<^sub>2 \ \\T\<^sub>1<:Q\<^sub>1 \ \\Q\<^sub>2<:T\<^sub>2)"
        by (auto elim: S_ArrowE_left)
      moreover
      have "S\<^sub>1 closed_in \" and "S\<^sub>2 closed_in \"
        using lh_drv_prm\<^sub>1 lh_drv_prm\<^sub>2 by (simp_all add: subtype_implies_closed)
      hence "(S\<^sub>1 \ S\<^sub>2) closed_in \" by (simp add: closed_in_def ty.supp)
      moreover
      have "\ \ ok" using rh_drv by (rule subtype_implies_ok)
      moreover
      { assume "\T\<^sub>1 T\<^sub>2. T = T\<^sub>1\T\<^sub>2 \ \ \ T\<^sub>1 <: Q\<^sub>1 \ \ \ Q\<^sub>2 <: T\<^sub>2"
        then obtain T\<^sub>1 T\<^sub>2
          where T_inst: "T = T\<^sub>1 \ T\<^sub>2"
          and   rh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1"
          and   rh_drv_prm\<^sub>2: "\<Gamma> \<turnstile> Q\<^sub>2 <: T\<^sub>2" by force
        from IH_trans[of "Q\<^sub>1"]
        have "\ \ T\<^sub>1 <: S\<^sub>1" using Q\<^sub>12_less rh_drv_prm\<^sub>1 lh_drv_prm\<^sub>1 by simp
        moreover
        from IH_trans[of "Q\<^sub>2"]
        have "\ \ S\<^sub>2 <: T\<^sub>2" using Q\<^sub>12_less rh_drv_prm\<^sub>2 lh_drv_prm\<^sub>2 by simp
        ultimately have "\ \ S\<^sub>1 \ S\<^sub>2 <: T\<^sub>1 \ T\<^sub>2" by auto
        then have "\ \ S\<^sub>1 \ S\<^sub>2 <: T" using T_inst by simp
      }
      ultimately show "\ \ S\<^sub>1 \ S\<^sub>2 <: T" by blast
    next
      case (SA_all \<Gamma> Q\<^sub>1 S\<^sub>1 X S\<^sub>2 Q\<^sub>2)
      then have rh_drv: "\ \ (\X<:Q\<^sub>1. Q\<^sub>2) <: T" by simp
      have lh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> Q\<^sub>1 <: S\<^sub>1" by fact
      have lh_drv_prm\<^sub>2: "((TVarB X Q\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: Q\<^sub>2" by fact
      then have "X\\" by (force dest: subtype_implies_ok simp add: valid_ty_dom_fresh)
      then have fresh_cond: "X\\" "X\Q\<^sub>1" "X\T" using rh_drv lh_drv_prm\<^sub>1
        by (simp_all add: subtype_implies_fresh)
      from rh_drv
      have "T = Top \
          (\<exists>T\<^sub>1 T\<^sub>2. T = (\<forall>X<:T\<^sub>1. T\<^sub>2) \<and> \<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1 \<and> ((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> Q\<^sub>2 <: T\<^sub>2)"
        using fresh_cond by (simp add: S_ForallE_left)
      moreover
      have "S\<^sub>1 closed_in \" and "S\<^sub>2 closed_in ((TVarB X Q\<^sub>1)#\)"
        using lh_drv_prm\<^sub>1 lh_drv_prm\<^sub>2 by (simp_all add: subtype_implies_closed)
      then have "(\X<:S\<^sub>1. S\<^sub>2) closed_in \" by (force simp: closed_in_def ty.supp abs_supp)
      moreover
      have "\ \ ok" using rh_drv by (rule subtype_implies_ok)
      moreover
      { assume "\T\<^sub>1 T\<^sub>2. T=(\X<:T\<^sub>1. T\<^sub>2) \ \\T\<^sub>1<:Q\<^sub>1 \ ((TVarB X T\<^sub>1)#\)\Q\<^sub>2<:T\<^sub>2"
        then obtain T\<^sub>1 T\<^sub>2
          where T_inst: "T = (\X<:T\<^sub>1. T\<^sub>2)"
          and   rh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1"
          and   rh_drv_prm\<^sub>2:"((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> Q\<^sub>2 <: T\<^sub>2" by force
        have "(\X<:Q\<^sub>1. Q\<^sub>2) = Q" by fact
        then have Q\<^sub>12_less: "size_ty Q\<^sub>1 < size_ty Q" "size_ty Q\<^sub>2 < size_ty Q"
          using fresh_cond by auto
        from IH_trans[of "Q\<^sub>1"]
        have "\ \ T\<^sub>1 <: S\<^sub>1" using lh_drv_prm\<^sub>1 rh_drv_prm\<^sub>1 Q\<^sub>12_less by blast
        moreover
        from IH_narrow[of "Q\<^sub>1" "[]"]
        have "((TVarB X T\<^sub>1)#\) \ S\<^sub>2 <: Q\<^sub>2" using Q\<^sub>12_less lh_drv_prm\<^sub>2 rh_drv_prm\<^sub>1 by simp
        with IH_trans[of "Q\<^sub>2"]
        have "((TVarB X T\<^sub>1)#\) \ S\<^sub>2 <: T\<^sub>2" using Q\<^sub>12_less rh_drv_prm\<^sub>2 by simp
        ultimately have "\ \ (\X<:S\<^sub>1. S\<^sub>2) <: (\X<:T\<^sub>1. T\<^sub>2)"
          using fresh_cond by (simp add: subtype_of.SA_all)
        hence "\ \ (\X<:S\<^sub>1. S\<^sub>2) <: T" using T_inst by simp
      }
      ultimately show "\ \ (\X<:S\<^sub>1. S\<^sub>2) <: T" by blast
    qed
  } note transitivity_lemma = this

  { \<comment> \<open>The transitivity proof is now by the auxiliary lemma.\<close>
    case 1
    from \<open>\<Gamma> \<turnstile> S <: Q\<close> and \<open>\<Gamma> \<turnstile> Q <: T\<close>
    show "\ \ S <: T" by (rule transitivity_lemma)
  next
    case 2
    from \<open>(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N\<close>
      and \<open>\<Gamma> \<turnstile> P<:Q\<close>
    show "(\@[(TVarB X P)]@\) \ M <: N"
    proof (induct "\@[(TVarB X Q)]@\" M N arbitrary: \ X \ rule: subtype_of.induct)
      case (SA_Top S \<Gamma> X \<Delta>)
      from \<open>\<Gamma> \<turnstile> P <: Q\<close>
      have "P closed_in \" by (simp add: subtype_implies_closed)
      with \<open>\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok\<close> have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok"
        by (simp add: replace_type)
      moreover
      from \<open>S closed_in (\<Delta>@[(TVarB X Q)]@\<Gamma>)\<close> have "S closed_in (\<Delta>@[(TVarB X P)]@\<Gamma>)"
        by (simp add: closed_in_def doms_append)
      ultimately show "(\@[(TVarB X P)]@\) \ S <: Top" by (simp add: subtype_of.SA_Top)
    next
      case (SA_trans_TVar Y S N \<Gamma> X \<Delta>)
      then have IH_inner: "(\@[(TVarB X P)]@\) \ S <: N"
        and lh_drv_prm: "(TVarB Y S) \ set (\@[(TVarB X Q)]@\)"
        and rh_drv: "\ \ P<:Q"
        and ok\<^sub>Q: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
      then have ok\<^sub>P: "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok)
      show "(\@[(TVarB X P)]@\) \ Tvar Y <: N"
      proof (cases "X=Y")
        case False
        have "X\Y" by fact
        hence "(TVarB Y S)\set (\@[(TVarB X P)]@\)" using lh_drv_prm by (simp add:binding.inject)
        with IH_inner show "(\@[(TVarB X P)]@\) \ Tvar Y <: N" by (simp add: subtype_of.SA_trans_TVar)
      next
        case True
        have memb\<^sub>XQ: "(TVarB X Q)\<in>set (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp
        have memb\<^sub>XP: "(TVarB X P)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" by simp
        have eq: "X=Y" by fact
        hence "S=Q" using ok\<^sub>Q lh_drv_prm memb\<^sub>XQ by (simp only: uniqueness_of_ctxt)
        hence "(\@[(TVarB X P)]@\) \ Q <: N" using IH_inner by simp
        moreover
        have "(\@[(TVarB X P)]@\) extends \" by (simp add: extends_def)
        hence "(\@[(TVarB X P)]@\) \ P <: Q" using rh_drv ok\<^sub>P by (simp only: weakening)
        ultimately have "(\@[(TVarB X P)]@\) \ P <: N" by (simp add: transitivity_lemma)
        then show "(\@[(TVarB X P)]@\) \ Tvar Y <: N" using memb\<^sub>XP eq by auto
      qed
    next
      case (SA_refl_TVar Y \<Gamma> X \<Delta>)
      from \<open>\<Gamma> \<turnstile> P <: Q\<close>
      have "P closed_in \" by (simp add: subtype_implies_closed)
      with \<open>\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok\<close> have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok"
        by (simp add: replace_type)
      moreover
      from \<open>Y \<in> ty_dom (\<Delta>@[(TVarB X Q)]@\<Gamma>)\<close> have "Y \<in> ty_dom (\<Delta>@[(TVarB X P)]@\<Gamma>)"
        by (simp add: doms_append)
      ultimately show "(\@[(TVarB X P)]@\) \ Tvar Y <: Tvar Y" by (simp add: subtype_of.SA_refl_TVar)
    next
      case (SA_arrow S\<^sub>1 Q\<^sub>1 Q\<^sub>2 S\<^sub>2 \<Gamma> X \<Delta>)
      then show "(\@[(TVarB X P)]@\) \ Q\<^sub>1 \ Q\<^sub>2 <: S\<^sub>1 \ S\<^sub>2" by blast
    next
      case (SA_all T\<^sub>1 S\<^sub>1 Y S\<^sub>2 T\<^sub>2 \<Gamma> X \<Delta>)
      have IH_inner\<^sub>1: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^sub>1 <: S\<^sub>1"
        and IH_inner\<^sub>2: "(((TVarB Y T\<^sub>1)#\<Delta>)@[(TVarB X P)]@\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2"
        by (fastforce intro: SA_all)+
      then show "(\@[(TVarB X P)]@\) \ (\Y<:S\<^sub>1. S\<^sub>2) <: (\Y<:T\<^sub>1. T\<^sub>2)" by auto
    qed
  }
qed

section \<open>Typing\<close>

inductive
  typing :: "env \ trm \ ty \ bool" (\_ \ _ : _\ [60,60,60] 60)
where
  T_Var[intro]: "\ VarB x T \ set \; \ \ ok \ \ \ \ Var x : T"
| T_App[intro]: "\ \ \ t\<^sub>1 : T\<^sub>1 \ T\<^sub>2; \ \ t\<^sub>2 : T\<^sub>1 \ \ \ \ t\<^sub>1 \ t\<^sub>2 : T\<^sub>2"
| T_Abs[intro]: "\ VarB x T\<^sub>1 # \ \ t\<^sub>2 : T\<^sub>2 \ \ \ \ (\x:T\<^sub>1. t\<^sub>2) : T\<^sub>1 \ T\<^sub>2"
| T_Sub[intro]: "\ \ \ t : S; \ \ S <: T \ \ \ \ t : T"
| T_TAbs[intro]:"\ TVarB X T\<^sub>1 # \ \ t\<^sub>2 : T\<^sub>2 \ \ \ \ (\X<:T\<^sub>1. t\<^sub>2) : (\X<:T\<^sub>1. T\<^sub>2)"
| T_TApp[intro]:"\X$\,t\<^sub>1,T\<^sub>2); \ \ t\<^sub>1 : (\X<:T\<^sub>11. T\<^sub>12); \ \ T\<^sub>2 <: T\<^sub>11\ \ \ \ t\<^sub>1 \\<^sub>\ T\<^sub>2 : (T\<^sub>12[X \ T\<^sub>2]\<^sub>$"

equivariance typing

lemma better_T_TApp:
  assumes H1: "\ \ t\<^sub>1 : (\X<:T11. T12)"
  and H2: "\ \ T2 <: T11"
  shows "\ \ t\<^sub>1 \\<^sub>\ T2 : (T12[X \ T2]\<^sub>\)"
proof -
  obtain Y::tyvrs where Y: "Y \ (X, T12, \, t\<^sub>1, T2)"
    by (rule exists_fresh) (rule fin_supp)
  then have "Y \ (\, t\<^sub>1, T2)" by simp
  moreover from Y have "(\X<:T11. T12) = (\Y<:T11. [(Y, X)] \ T12)"
    by (auto simp: ty.inject alpha' fresh_prod fresh_atm)
  with H1 have "\ \ t\<^sub>1 : (\Y<:T11. [(Y, X)] \ T12)" by simp
  ultimately have "\ \ t\<^sub>1 \\<^sub>\ T2 : (([(Y, X)] \ T12)[Y \ T2]\<^sub>\)" using H2
    by (rule T_TApp)
  with Y show ?thesis by (simp add: type_subst_rename)
qed

lemma typing_ok:
  assumes "\ \ t : T"
  shows   "\ \ ok"
using assms by (induct) (auto)

nominal_inductive typing
by (auto dest!: typing_ok intro: closed_in_fresh fresh_dom type_subst_fresh
    simp: abs_fresh fresh_type_subst_fresh ty_vrs_fresh valid_ty_dom_fresh fresh_trm_dom)

lemma ok_imp_VarB_closed_in:
  assumes ok: "\ \ ok"
  shows "VarB x T \ set \ \ T closed_in \" using ok
  by induct (auto simp: binding.inject closed_in_def)

lemma tyvrs_of_subst: "tyvrs_of (B[X \ T]\<^sub>b) = tyvrs_of B"
  by (nominal_induct B rule: binding.strong_induct) simp_all

lemma ty_dom_subst: "ty_dom (\[X \ T]\<^sub>e) = ty_dom \"
  by (induct \<Gamma>) (simp_all add: tyvrs_of_subst)

lemma vrs_of_subst: "vrs_of (B[X \ T]\<^sub>b) = vrs_of B"
  by (nominal_induct B rule: binding.strong_induct) simp_all

lemma trm_dom_subst: "trm_dom (\[X \ T]\<^sub>e) = trm_dom \"
  by (induct \<Gamma>) (simp_all add: vrs_of_subst)

lemma subst_closed_in:
  "T closed_in (\ @ TVarB X S # \) \ U closed_in \ \ T[X \ U]\<^sub>\ closed_in (\[X \ U]\<^sub>e @ \)"
proof (nominal_induct T avoiding: X U \<Gamma> rule: ty.strong_induct)
  case (Tvar tyvrs)
  then show ?case
    by (auto simp add: closed_in_def ty.supp supp_atm doms_append ty_dom_subst)
next
  case Top
  then show ?case
    using closed_in_def fresh_def by fastforce
next
  case (Arrow ty1 ty2)
  then show ?case
    by (simp add: closed_in_def ty.supp)
next
  case (Forall tyvrs ty1 ty2)
  then have "supp (ty1[X \ U]\<^sub>\) \ ty_dom (\[X \ U]\<^sub>e @ TVarB tyvrs ty2 # \)"
    apply (simp add: closed_in_def ty.supp abs_supp)
    by (metis Diff_subset_conv Un_left_commute doms_append(1) le_supI2 ty_dom.simps(2) tyvrs_of.simps(2))
  with Forall show ?case
    by (auto simp add: closed_in_def ty.supp abs_supp doms_append)
qed

lemmas subst_closed_in' = subst_closed_in [where \="[]", simplified]

lemma typing_closed_in:
  assumes "\ \ t : T"
  shows   "T closed_in \"
using assms
proof induct
  case (T_Var x T \<Gamma>)
  from \<open>\<turnstile> \<Gamma> ok\<close> and \<open>VarB x T \<in> set \<Gamma>\<close>
  show ?case by (rule ok_imp_VarB_closed_in)
next
  case (T_App \<Gamma> t\<^sub>1 T\<^sub>1 T\<^sub>2 t\<^sub>2)
  then show ?case by (auto simp: ty.supp closed_in_def)
next
  case (T_Abs x T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
  from \<open>VarB x T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
  have "T\<^sub>1 closed_in \" by (auto dest: typing_ok)
  with T_Abs show ?case by (auto simp: ty.supp closed_in_def)
next
  case (T_Sub \<Gamma> t S T)
  from \<open>\<Gamma> \<turnstile> S <: T\<close> show ?case by (simp add: subtype_implies_closed)
next
  case (T_TAbs X T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
  from \<open>TVarB X T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
  have "T\<^sub>1 closed_in \" by (auto dest: typing_ok)
  with T_TAbs show ?case by (auto simp: ty.supp closed_in_def abs_supp)
next
  case (T_TApp X \<Gamma> t\<^sub>1 T2 T11 T12)
  then have "T12 closed_in (TVarB X T11 # \)"
    by (auto simp: closed_in_def ty.supp abs_supp)
  moreover from T_TApp have "T2 closed_in \"
    by (simp add: subtype_implies_closed)
  ultimately show ?case by (rule subst_closed_in')
qed

subsection \<open>Evaluation\<close>

inductive
  val :: "trm \ bool"
where
  Abs[intro]:  "val (\x:T. t)"
| TAbs[intro]: "val (\X<:T. t)"

equivariance val

inductive_cases val_inv_auto[elim]:
  "val (Var x)"
  "val (t1 \ t2)"
  "val (t1 \\<^sub>\ t2)"

inductive
  eval :: "trm \ trm \ bool" (\_ \ _\ [60,60] 60)
where
  E_Abs         : "\ x \ v\<^sub>2; val v\<^sub>2 \ \ (\x:T\<^sub>11. t\<^sub>12) \ v\<^sub>2 \ t\<^sub>12[x \ v\<^sub>2]"
| E_App1 [intro]: "t \ t' \ t \ u \ t' \ u"
| E_App2 [intro]: "\ val v; t \ t' \ \ v \ t \ v \ t'"
| E_TAbs        : "X \ (T\<^sub>11, T\<^sub>2) \ (\X<:T\<^sub>11. t\<^sub>12) \\<^sub>\ T\<^sub>2 \ t\<^sub>12[X \\<^sub>\ T\<^sub>2]"
| E_TApp [intro]: "t \ t' \ t \\<^sub>\ T \ t' \\<^sub>\ T"

lemma better_E_Abs[intro]:
  assumes H: "val v2"
  shows "(\x:T11. t12) \ v2 \ t12[x \ v2]"
proof -
  obtain y::vrs where y: "y \ (x, t12, v2)" by (rule exists_fresh) (rule fin_supp)
  then have "y \ v2" by simp
  then have "(\y:T11. [(y, x)] \ t12) \ v2 \ ([(y, x)] \ t12)[y \ v2]" using H
    by (rule E_Abs)
  moreover from y have "(\x:T11. t12) \ v2 = (\y:T11. [(y, x)] \ t12) \ v2"
    by (auto simp: trm.inject alpha' fresh_prod fresh_atm)
  ultimately have "(\x:T11. t12) \ v2 \ ([(y, x)] \ t12)[y \ v2]"
    by simp
  with y show ?thesis by (simp add: subst_trm_rename)
qed

lemma better_E_TAbs[intro]: "(\X<:T11. t12) \\<^sub>\ T2 \ t12[X \\<^sub>\ T2]"
proof -
  obtain Y::tyvrs where Y: "Y \ (X, t12, T11, T2)" by (rule exists_fresh) (rule fin_supp)
  then have "Y \ (T11, T2)" by simp
  then have "(\Y<:T11. [(Y, X)] \ t12) \\<^sub>\ T2 \ ([(Y, X)] \ t12)[Y \\<^sub>\ T2]"
    by (rule E_TAbs)
  moreover from Y have "(\X<:T11. t12) \\<^sub>\ T2 = (\Y<:T11. [(Y, X)] \ t12) \\<^sub>\ T2"
    by (auto simp: trm.inject alpha' fresh_prod fresh_atm)
  ultimately have "(\X<:T11. t12) \\<^sub>\ T2 \ ([(Y, X)] \ t12)[Y \\<^sub>\ T2]"
    by simp
  with Y show ?thesis by (simp add: subst_trm_ty_rename)
qed

equivariance eval

nominal_inductive eval
  by (simp_all add: abs_fresh ty_vrs_fresh subst_trm_fresh_tyvar
    subst_trm_fresh_var subst_trm_ty_fresh')

inductive_cases eval_inv_auto[elim]:
  "Var x \ t'"
  "(\x:T. t) \ t'"
  "(\X<:T. t) \ t'"

lemma ty_dom_cons:
  shows "ty_dom (\@[VarB X Q]@\) = ty_dom (\@\)"
by (induct \<Gamma>) (auto)

lemma closed_in_cons:
  assumes "S closed_in (\ @ VarB X Q # \)"
  shows "S closed_in (\@\)"
using assms ty_dom_cons closed_in_def by auto

lemma closed_in_weaken: "T closed_in (\ @ \) \ T closed_in (\ @ B # \)"
  by (auto simp: closed_in_def doms_append)

lemma closed_in_weaken': "T closed_in \ \ T closed_in (\ @ \)"
  by (auto simp: closed_in_def doms_append)

lemma valid_subst:
  assumes ok: "\ (\ @ TVarB X Q # \) ok"
  and closed: "P closed_in \"
  shows "\ (\[X \ P]\<^sub>e @ \) ok" using ok closed
proof (induct \<Delta>)
  case Nil
  then show ?case
    by auto
next
  case (Cons a \<Delta>)
  then have *: "\ (a # \ @ TVarB X Q # \) ok"
    by fastforce
  then show ?case
    apply (rule validE)
    using Cons
     apply (simp add: at_tyvrs_inst closed doms_append(1) finite_doms(1) fresh_fin_insert fs_tyvrs_inst pt_tyvrs_inst subst_closed_in ty_dom_subst)
    by (simp add: doms_append(2) subst_closed_in Cons.hyps closed trm_dom_subst)
qed

lemma ty_dom_vrs:
  shows "ty_dom (G @ [VarB x Q] @ D) = ty_dom (G @ D)"
  by (induct G) (auto)

lemma valid_cons':
  assumes "\ (\ @ VarB x Q # \) ok"
  shows "\ (\ @ \) ok"
  using assms
proof (induct "\ @ VarB x Q # \" arbitrary: \ \)
  case valid_nil
  have "[] = \ @ VarB x Q # \" by fact
  then have "False" by auto
  then show ?case by auto
next
  case (valid_consT G X T)
  then show ?case
  proof (cases \<Gamma>)
    case Nil
    with valid_consT show ?thesis by simp
  next
    case (Cons b bs)
    with valid_consT
    have "\ (bs @ \) ok" by simp
    moreover from Cons and valid_consT have "X \ ty_dom (bs @ \)"
      by (simp add: doms_append)
    moreover from Cons and valid_consT have "T closed_in (bs @ \)"
      by (simp add: closed_in_def doms_append)
    ultimately have "\ (TVarB X T # bs @ \) ok"
      by (rule valid_rel.valid_consT)
    with Cons and valid_consT show ?thesis by simp
  qed
next
  case (valid_cons G x T)
  then show ?case
  proof (cases \<Gamma>)
    case Nil
    with valid_cons show ?thesis by simp
  next
    case (Cons b bs)
    with valid_cons
    have "\ (bs @ \) ok" by simp
    moreover from Cons and valid_cons have "x \ trm_dom (bs @ \)"
      by (simp add: doms_append finite_doms
        fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst])
    moreover from Cons and valid_cons have "T closed_in (bs @ \)"
      by (simp add: closed_in_def doms_append)
    ultimately have "\ (VarB x T # bs @ \) ok"
      by (rule valid_rel.valid_cons)
    with Cons and valid_cons show ?thesis by simp
  qed
qed

text \<open>A.5(6)\<close>

lemma type_weaken:
  assumes "(\@\) \ t : T"
  and     "\ (\ @ B # \) ok"
  shows   "(\ @ B # \) \ t : T"
using assms
proof(nominal_induct "\ @ \" t T avoiding: \ \ B rule: typing.strong_induct)
  case (T_Var x T)
  then show ?case by auto
next
  case (T_App X t\<^sub>1 T\<^sub>2 T\<^sub>11 T\<^sub>12)
  then show ?case by force
next
  case (T_Abs y T\<^sub>1 t\<^sub>2 T\<^sub>2 \<Delta> \<Gamma>)
  then have "VarB y T\<^sub>1 # \ @ \ \ t\<^sub>2 : T\<^sub>2" by simp
  then have closed: "T\<^sub>1 closed_in (\ @ \)"
    by (auto dest: typing_ok)
  have "\ (VarB y T\<^sub>1 # \ @ B # \) ok"
    by (simp add: T_Abs closed closed_in_weaken fresh_list_append fresh_list_cons fresh_trm_dom)
  then have "\ ((VarB y T\<^sub>1 # \) @ B # \) ok" by simp
  with _ have "(VarB y T\<^sub>1 # \) @ B # \ \ t\<^sub>2 : T\<^sub>2"
    by (rule T_Abs) simp
  then have "VarB y T\<^sub>1 # \ @ B # \ \ t\<^sub>2 : T\<^sub>2" by simp
  then show ?case by (rule typing.T_Abs)
next
  case (T_Sub t S T \<Delta> \<Gamma>)
  from refl and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
  have "\ @ B # \ \ t : S" by (rule T_Sub)
  moreover from  \<open>(\<Delta> @ \<Gamma>)\<turnstile>S<:T\<close> and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
  have "(\ @ B # \)\S<:T"
    by (rule weakening) (simp add: extends_def T_Sub)
  ultimately show ?case by (rule typing.T_Sub)
next
  case (T_TAbs X T\<^sub>1 t\<^sub>2 T\<^sub>2 \<Delta> \<Gamma>)
  from \<open>TVarB X T\<^sub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
  have closed: "T\<^sub>1 closed_in (\ @ \)"
    by (auto dest: typing_ok)
  have "\ (TVarB X T\<^sub>1 # \ @ B # \) ok"
    by (simp add: T_TAbs at_tyvrs_inst closed closed_in_weaken doms_append finite_doms finite_vrs
        fresh_dom fresh_fin_union fs_tyvrs_inst pt_tyvrs_inst tyvrs_fresh)
  then have "\ ((TVarB X T\<^sub>1 # \) @ B # \) ok" by simp
  with _ have "(TVarB X T\<^sub>1 # \) @ B # \ \ t\<^sub>2 : T\<^sub>2"
    by (rule T_TAbs) simp
  then have "TVarB X T\<^sub>1 # \ @ B # \ \ t\<^sub>2 : T\<^sub>2" by simp
  then show ?case by (rule typing.T_TAbs)
next
  case (T_TApp X t\<^sub>1 T2 T11 T12 \<Delta> \<Gamma>)
  have "\ @ B # \ \ t\<^sub>1 : (\X<:T11. T12)"
    by (rule T_TApp refl)+
  moreover from \<open>(\<Delta> @ \<Gamma>)\<turnstile>T2<:T11\<close> and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
  have "(\ @ B # \)\T2<:T11"
    by (rule weakening) (simp add: extends_def T_TApp)
  ultimately show ?case by (rule better_T_TApp)
qed

lemma type_weaken':
"\ \ t : T \ \ (\@\) ok \ (\@\) \ t : T"
proof (induct \<Delta>)
  case Nil
  then show ?case by auto
next
  case (Cons a \<Delta>)
  then show ?case
    by (metis append_Cons append_Nil type_weaken validE(3))
qed

text \<open>A.6\<close>

lemma strengthening:
  assumes "(\ @ VarB x Q # \) \ S <: T"
  shows  "(\@\) \ S <: T"
  using assms
proof (induct "\ @ VarB x Q # \" S T arbitrary: \)
  case (SA_Top S)
  then have "\ (\ @ \) ok" by (auto dest: valid_cons')
  moreover have "S closed_in (\ @ \)" using SA_Top by (auto dest: closed_in_cons)
  ultimately show ?case using subtype_of.SA_Top by auto
next
  case (SA_refl_TVar X)
  from \<open>\<turnstile> (\<Gamma> @ VarB x Q # \<Delta>) ok\<close>
  have h1:"\ (\ @ \) ok" by (auto dest: valid_cons')
--> --------------------

--> maximum size reached

--> --------------------

quality96%

¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.8Angebot Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können ¤

*Eine klare Vorstellung vom Zielzustand

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.