From 25fe37178786109cd49f840554fd73cf2b597837 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 5 Nov 2025 18:54:40 +0100
Subject: [PATCH 01/71] Add classifiers

---
 Capless/Classifier.lean | 83 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)
 create mode 100644 Capless/Classifier.lean

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
new file mode 100644
index 00000000..3cfd5088
--- /dev/null
+++ b/Capless/Classifier.lean
@@ -0,0 +1,83 @@
+inductive Classifier : Type where
+  | top : Classifier
+  | child : Nat -> Classifier -> Classifier
+
+inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
+  | id: Subclass a a
+  | sub_l : Subclass a b -> Subclass (.child _ a) b
+
+inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
+  | children : (Ne n m) -> Disjoint (child n a) (child m a)
+  | sub_l : Disjoint a b -> Disjoint (child _ a) b
+  | sub_r : Disjoint a b -> Disjoint a (child _ b)
+
+inductive Kind : Type where
+  | classifier : Classifier -> Kind
+  | union : Kind -> Kind -> Kind
+  | excl : Kind -> Classifier -> Kind
+
+inductive Kind.Disjoint : Kind -> Kind -> Prop where
+  | base : Classifier.Disjoint a b -> Disjoint (classifier a) (classifier b)
+  | union : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
+  | excl_this : Classifier.Subclass a b -> Disjoint (excl c b) (classifier a)
+  | excl_union : Disjoint a (excl b1 k) -> Disjoint a (excl b2 k) -> Disjoint a (excl (union b1 b2) k)
+  | excl : Disjoint a b -> Disjoint a (excl b k)
+  | symm : Disjoint a b -> Disjoint b a
+
+inductive Kind.Subkind : Kind -> Kind -> Prop where
+  | base : Classifier.Subclass a b -> Subkind (classifier a) (classifier b)
+  | union_l : Subkind a1 b -> Subkind a2 b -> Subkind (union a1 a2) b
+  | union_r1 : Subkind a b1 -> Subkind a (union b1 b2)
+  | union_r2 : Subkind a b2 -> Subkind a (union b1 b2)
+  | excl_l : Subkind a b -> Subkind (excl a c) b
+  | excl_r : Subkind a b -> Kind.Disjoint a (classifier k) -> Subkind a (excl b k)
+
+
+theorem Classifier.subclass_top : Subclass k .top := by
+  induction k
+  case top => exact .id
+  case child n c ih => exact .sub_l ih
+
+theorem Classifier.subclass_of_top : Subclass .top k -> k = .top := by
+  intro h
+  cases h <;> simp
+
+theorem Classifier.disjoint_symm : Disjoint a b -> Disjoint b a := by
+  intro h
+  induction h
+  case children neq => exact .children (Ne.symm neq)
+  case sub_l => constructor; assumption
+  case sub_r => constructor; assumption
+
+theorem Classifier.disjoint_top : Disjoint a .top -> False := by
+  intro h
+  cases h
+  . rename_i x a h; exact disjoint_top h
+
+theorem Classifier.subclass_down : Subclass a b -> (a = b) ∨ (∃ n, Subclass a (.child n b)) := by
+  intro h
+  induction a
+  case top => cases h; simp
+  case child n p ih =>
+    cases h
+    case id => simp
+    case sub_l l =>
+      cases ih l
+      . rename_i h1
+        right; exists n; rewrite [h1]; constructor
+      . rename_i h1
+        cases h1
+        rename_i w h1
+        right; exists w
+        apply Subclass.sub_l h1
+
+theorem Classifier.disjoint_up : Disjoint (child n a) b -> Disjoint a b ∨ Subclass b a := by
+  intro h
+  cases h
+  case children ne =>
+    right; constructor; constructor
+  case sub_l => left; assumption
+  case sub_r r =>
+    cases disjoint_up r
+    . left; apply Disjoint.sub_r; assumption
+    . right; apply Subclass.sub_l; assumption

From 30c5610a2fb99d3d42b7ec33522e1a49512dccd7 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 5 Nov 2025 19:21:11 +0100
Subject: [PATCH 02/71] Update types

---
 Capless/Classifier.lean    |  2 ++
 Capless/Type/Basic.lean    | 38 +++++++++++++++++++-------------------
 Capless/Type/Core.lean     |  7 ++++---
 Capless/Type/Renaming.lean | 13 ++++++++-----
 4 files changed, 33 insertions(+), 27 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 3cfd5088..9baf0276 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -1,3 +1,5 @@
+namespace Capless
+
 inductive Classifier : Type where
   | top : Classifier
   | child : Nat -> Classifier -> Classifier
diff --git a/Capless/Type/Basic.lean b/Capless/Type/Basic.lean
index aa96764d..aa3d492d 100644
--- a/Capless/Type/Basic.lean
+++ b/Capless/Type/Basic.lean
@@ -47,9 +47,9 @@ mutual
 theorem EType.crename_rename_comm (E : EType n m k) (f : FinFun n n') (g : FinFun k k') :
   (E.rename f).crename g = (E.crename g).rename f :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.crename_rename_comm T f g.ext
-    simp [EType.rename, EType.crename, ih]
+    simp [EType.rename, EType.crename, ih, CBound.crename_rename_comm]
   | EType.type T => by
     have ih := CType.crename_rename_comm T f g
     simp [EType.rename, EType.crename, ih]
@@ -111,9 +111,9 @@ mutual
 theorem EType.rename_rename (E : EType n m k) (f : FinFun n n') (g : FinFun n' n'') :
   (E.rename f).rename g = E.rename (g ∘ f) :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.rename_rename T f g
-    simp [EType.rename, ih]
+    simp [EType.rename, ih, CBound.rename_rename]
   | EType.type T => by
     have ih := CType.rename_rename T f g
     simp [EType.rename, ih]
@@ -169,7 +169,7 @@ mutual
 theorem EType.trename_rename_comm (E : EType n m k) (f : FinFun n n') (g : FinFun m m') :
   (E.trename g).rename f = (E.rename f).trename g :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.trename_rename_comm T f g
     simp [EType.trename, EType.rename, ih]
   | EType.type T => by
@@ -213,9 +213,9 @@ mutual
 theorem EType.crename_crename (E : EType n m k) (f : FinFun k k') (g : FinFun k' k'') :
   (E.crename f).crename g = E.crename (g ∘ f) :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.crename_crename T f.ext g.ext
-    simp [EType.crename, CType.crename, ih, FinFun.ext_comp_ext]
+    simp [EType.crename, CType.crename, ih, FinFun.ext_comp_ext, CBound.crename_crename]
   | EType.type T => by
     have ih := CType.crename_crename T f g
     simp [EType.crename, CType.crename, ih]
@@ -257,7 +257,7 @@ mutual
 theorem EType.crename_trename_comm (E : EType n m k) (f : FinFun k k') (g : FinFun m m') :
   (E.crename f).trename g = (E.trename g).crename f :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.crename_trename_comm T f.ext g
     simp [EType.crename, EType.trename, ih]
   | EType.type T => by
@@ -389,7 +389,7 @@ mutual
 theorem EType.trename_trename (E : EType n m k) (f : FinFun m m') (g : FinFun m' m'') :
   (E.trename f).trename g = E.trename (g ∘ f) :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.trename_trename T f g
     simp [EType.trename, ih]
   | EType.type T => by
@@ -492,14 +492,14 @@ theorem EType.cweaken_eq_inv {E : EType n m k}
     simp [CaptureSet.cweaken, SType.cweaken]; aesop
 
 theorem EType.ex_cweaken_eq_inv {E : EType n m k}
-  (heq : EType.ex (CType.capt C S) = E.cweaken) :
-  ∃ C0 S0, E = EType.ex (CType.capt C0 S0) ∧ C0.cweaken1 = C ∧ S0.cweaken1 = S := by
+  (heq : EType.ex B (CType.capt C S) = E.cweaken) :
+  ∃ B0 C0 S0, E = EType.ex B0 (CType.capt C0 S0) ∧ B0.cweaken = B ∧ C0.cweaken1 = C ∧ S0.cweaken1 = S := by
   cases E
   case type => simp [cweaken, crename] at heq
-  case ex T =>
+  case ex B T =>
     cases T; rename_i C0 S0
-    simp [EType.cweaken, EType.crename, CType.crename] at heq
-    exists C0, S0
+    simp [EType.cweaken, EType.crename, CType.crename, CBound.cweaken] at heq
+    exists B, C0, S0
     simp [CaptureSet.cweaken1, SType.cweaken1]; aesop
 
 mutual
@@ -507,9 +507,9 @@ mutual
 theorem EType.rename_id {E : EType n m k} :
   E.rename FinFun.id = E :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.rename_id (T := T)
-    simp [EType.rename, ih]
+    simp [EType.rename, CBound.rename_id, ih]
   | EType.type T => by
     have ih := CType.rename_id (T := T)
     simp [EType.rename, ih]
@@ -552,7 +552,7 @@ mutual
 theorem EType.trename_id {E : EType n m k} :
   E.trename FinFun.id = E :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.trename_id (T := T)
     simp [EType.trename, ih]
   | EType.type T => by
@@ -596,9 +596,9 @@ mutual
 theorem EType.crename_id {E : EType n m k} :
   E.crename FinFun.id = E :=
   match E with
-  | EType.ex T => by
+  | EType.ex B T => by
     have ih := CType.crename_id (T := T)
-    simp [EType.crename, FinFun.id_ext, ih]
+    simp [EType.crename, FinFun.id_ext, CBound.crename_id, ih]
   | EType.type T => by
     have ih := CType.crename_id (T := T)
     simp [EType.crename, ih]
diff --git a/Capless/Type/Core.lean b/Capless/Type/Core.lean
index fd908379..2e10994f 100644
--- a/Capless/Type/Core.lean
+++ b/Capless/Type/Core.lean
@@ -1,5 +1,6 @@
 import Capless.CaptureSet
 import Capless.Basic
+import Capless.Classifier
 namespace Capless
 
 /-!
@@ -19,11 +20,11 @@ mutual
 /-- Capture bound. -/
 inductive CBound : Nat -> Nat -> Type where
 | upper : CaptureSet n k -> CBound n k
-| star : CBound n k
+| kind : Kind -> CBound n k
 
 /-- Existential type. -/
 inductive EType : Nat -> Nat -> Nat -> Type where
-| ex : CType n m (k+1) -> EType n m k
+| ex : CBound n k -> CType n m (k+1) -> EType n m k
 | type : CType n m k -> EType n m k
 
 /-- Capturing type. -/
@@ -51,7 +52,7 @@ notation:50 "∀(x:" T ")" U => SType.forall T U
 notation:50 "∀[X<:" S "]" T => SType.tforall S T
 notation:50 "∀[c<:" B "]" T => SType.cforall B T
 notation:max S " ^ " C => CType.capt C S
-notation:40 "∃c." T => EType.ex T
+notation:40 "∃c<:" B "." T => EType.ex B T
 notation:40 "Label[" S "]" => SType.label S
 notation:60 "□" T => SType.box T
 
diff --git a/Capless/Type/Renaming.lean b/Capless/Type/Renaming.lean
index 243c6d93..4de9f184 100644
--- a/Capless/Type/Renaming.lean
+++ b/Capless/Type/Renaming.lean
@@ -14,12 +14,12 @@ This file defines the renaming operations for types.
 def CBound.rename (b : CBound n k) (f : FinFun n n') : CBound n' k :=
   match b with
   | upper C => upper (C.rename f)
-  | star => star
+  | kind k => kind k
 
 def CBound.crename (b : CBound n k) (f : FinFun k k') : CBound n k' :=
   match b with
   | upper C => upper (C.crename f)
-  | star => star
+  | kind k => kind k
 
 def CBound.weaken (b : CBound n k) : CBound (n+1) k :=
   b.rename FinFun.weaken
@@ -27,10 +27,13 @@ def CBound.weaken (b : CBound n k) : CBound (n+1) k :=
 def CBound.cweaken (b : CBound n k) : CBound n (k+1) :=
   b.crename FinFun.weaken
 
+def CBound.cweaken1 (b : CBound n (k + 1)) : CBound n (k+2) :=
+  b.crename FinFun.weaken.ext
+
 mutual
 
 def EType.rename : EType n m k -> FinFun n n' -> EType n' m k
-| EType.ex T, f => EType.ex (T.rename f)
+| EType.ex B T, f => EType.ex (B.rename f) (T.rename f)
 | EType.type T, f => EType.type (T.rename f)
 
 def CType.rename : CType n m k -> FinFun n n' -> CType n' m k
@@ -50,7 +53,7 @@ end
 mutual
 
 def EType.trename : EType n m k -> FinFun m m' -> EType n m' k
-| EType.ex T, f => EType.ex (T.trename f)
+| EType.ex B T, f => EType.ex B (T.trename f)
 | EType.type T, f => EType.type (T.trename f)
 
 def CType.trename : CType n m k -> FinFun m m' -> CType n m' k
@@ -70,7 +73,7 @@ end
 mutual
 
 def EType.crename : EType n m k -> FinFun k k' -> EType n m k'
-| EType.ex T, f => EType.ex (T.crename f.ext)
+| EType.ex B T, f => EType.ex (B.crename f) (T.crename f.ext)
 | EType.type T, f => EType.type (T.crename f)
 
 def CType.crename : CType n m k -> FinFun k k' -> CType n m k'

From 54e32f29f4d76615be6a825964309d43856010b9 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 7 Nov 2025 17:13:06 +0100
Subject: [PATCH 03/71] Subtyping

---
 Capless/Subtyping.lean | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/Capless/Subtyping.lean b/Capless/Subtyping.lean
index f2b45a64..18e7e5a1 100644
--- a/Capless/Subtyping.lean
+++ b/Capless/Subtyping.lean
@@ -1,6 +1,7 @@
 import Capless.Context
 import Capless.Subcapturing
 import Capless.Type
+import Capless.Classifier
 
 /-!
 # Subtyping Rules of Capless
@@ -14,15 +15,15 @@ inductive Subbound : Context n m k -> CBound n k -> CBound n k -> Prop where
 | set :
   (Γ ⊢ C1 <:c C2) ->
   Subbound Γ (CBound.upper C1) (CBound.upper C2)
-| star :
-  Subbound Γ B CBound.star
+| kind :
+  Kind.Subkind k1 k2 -> Subbound Γ (CBound.kind k1) (CBound.kind k2)
 
 mutual
 
 inductive ESubtyp : Context n m k -> EType n m k -> EType n m k -> Prop where
 | exist :
-  CSubtyp (Context.cvar Γ (CBinding.bound CBound.star)) T1 T2 ->
-  ESubtyp Γ (EType.ex T1) (EType.ex T2)
+  CSubtyp (Context.cvar Γ (CBinding.bound B)) T1 T2 ->
+  ESubtyp Γ (EType.ex B T1) (EType.ex B T2)
 | type :
   CSubtyp Γ T1 T2 ->
   ESubtyp Γ (EType.type T1) (EType.type T2)

From 1098a004ae3d44d03b213a701580f8a7e3d130eb Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 11 Nov 2025 15:04:22 +0100
Subject: [PATCH 04/71] Add bounds proofs to renaming

---
 Capless/CaptureBound.lean                  | 16 ++++++++
 Capless/Classifier.lean                    | 24 ++++++++++-
 Capless/Context.lean                       |  1 -
 Capless/Renaming/Capture/CaptureBound.lean | 47 ++++++++++++++++++++++
 Capless/Renaming/Capture/Subtyping.lean    |  5 ++-
 Capless/Renaming/Capture/Typing.lean       |  3 ++
 Capless/Renaming/Term/CaptureBound.lean    | 46 +++++++++++++++++++++
 Capless/Renaming/Term/Subtyping.lean       |  2 +-
 Capless/Renaming/Term/Typing.lean          |  2 +
 Capless/Renaming/Type/CaptureBound.lean    | 47 ++++++++++++++++++++++
 Capless/Renaming/Type/Subtyping.lean       |  2 +-
 Capless/Renaming/Type/Typing.lean          |  3 ++
 Capless/Store.lean                         |  4 +-
 Capless/Subst/Capture/Subtyping.lean       |  2 +-
 Capless/Subst/Term/Subtyping.lean          |  2 +-
 Capless/Subtyping/Basic.lean               |  9 ++++-
 Capless/Type/Core.lean                     |  2 +-
 Capless/Typing.lean                        | 10 +++--
 18 files changed, 210 insertions(+), 17 deletions(-)
 create mode 100644 Capless/CaptureBound.lean
 create mode 100644 Capless/Renaming/Capture/CaptureBound.lean
 create mode 100644 Capless/Renaming/Term/CaptureBound.lean
 create mode 100644 Capless/Renaming/Type/CaptureBound.lean

diff --git a/Capless/CaptureBound.lean b/Capless/CaptureBound.lean
new file mode 100644
index 00000000..ac9e482a
--- /dev/null
+++ b/Capless/CaptureBound.lean
@@ -0,0 +1,16 @@
+import Capless.CaptureSet
+import Capless.Type
+import Capless.Subcapturing
+
+namespace Capless
+
+inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
+  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
+  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
+  | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
+  | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
+  | empty : CaptureKind Γ .empty K
+
+inductive CaptureBound : Context n m k -> CaptureSet n k -> CBound n k -> Prop where
+  | subcapt: Subcapt Γ C1 C2 -> CaptureBound Γ C1 (CBound.upper C2)
+  | subkind : CaptureKind Γ C K -> CaptureBound Γ C (CBound.kind K)
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 9baf0276..bb8ee4be 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -33,7 +33,7 @@ inductive Kind.Subkind : Kind -> Kind -> Prop where
   | union_r2 : Subkind a b2 -> Subkind a (union b1 b2)
   | excl_l : Subkind a b -> Subkind (excl a c) b
   | excl_r : Subkind a b -> Kind.Disjoint a (classifier k) -> Subkind a (excl b k)
-
+  | trans : Subkind a b -> Subkind b c -> Subkind a c
 
 theorem Classifier.subclass_top : Subclass k .top := by
   induction k
@@ -83,3 +83,25 @@ theorem Classifier.disjoint_up : Disjoint (child n a) b -> Disjoint a b ∨ Subc
     cases disjoint_up r
     . left; apply Disjoint.sub_r; assumption
     . right; apply Subclass.sub_l; assumption
+
+theorem Kind.subkind_refl : Kind.Subkind k k := by
+  cases k
+  case classifier a =>
+    constructor
+    constructor
+  case union a b =>
+    apply Subkind.union_l
+    apply Subkind.union_r1
+    apply subkind_refl
+    apply Subkind.union_r2
+    apply subkind_refl
+  case excl k a =>
+    apply Subkind.excl_r
+    apply Subkind.excl_l
+    apply subkind_refl
+    apply Disjoint.excl_this
+    constructor
+
+/- Classifiers fixed for boundary. -/
+def Classifier.control := Classifier.child 0 Classifier.top
+def Kind.control := Kind.classifier .control
diff --git a/Capless/Context.lean b/Capless/Context.lean
index ce28b6d5..2407061f 100644
--- a/Capless/Context.lean
+++ b/Capless/Context.lean
@@ -49,7 +49,6 @@ notation:30 Γ ",x:" T => Context.var Γ T
 notation:30 Γ ",X<:" T => Context.tvar Γ (TBinding.bound T)
 notation:30 Γ ",X:=" T => Context.tvar Γ (TBinding.inst T)
 notation:30 Γ ",c<:" B => Context.cvar Γ (CBinding.bound B)
-notation:30 Γ ",c<:*" => Context.cvar Γ (CBinding.bound CBound.star)
 notation:30 Γ ",c:=" C => Context.cvar Γ (CBinding.inst C)
 
 /-!
diff --git a/Capless/Renaming/Capture/CaptureBound.lean b/Capless/Renaming/Capture/CaptureBound.lean
new file mode 100644
index 00000000..2e341ae7
--- /dev/null
+++ b/Capless/Renaming/Capture/CaptureBound.lean
@@ -0,0 +1,47 @@
+import Capless.CaptureBound
+import Capless.Renaming.Capture.Subcapturing
+
+/-!
+# Capture Variable Renaming for Capture Bounding
+
+This module proves that capture bound relationships are preserved under capture variable
+renaming. The main theorem `Subcapt.crename` shows that subcapturing judgments
+remain valid when capture variables are renamed consistently between contexts.
+-/
+namespace Capless
+
+theorem CaptureKind.crename
+  (h : CaptureKind Γ C K)
+  (ρ : CVarMap Γ f Δ) :
+  CaptureKind Δ (C.crename f) K := by
+  induction h
+  case var hb hk ih =>
+    simp [CaptureSet.crename_singleton]
+    apply var
+    have hb1 := ρ.map _ _ hb
+    simp [EType.crename, CType.crename] at hb1
+    exact hb1
+    apply ih ρ
+  case cvar hc =>
+    apply cvar
+    exact ρ.cmap _ _ hc
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih ρ
+  case union hc1 hc2 ih1 ih2 =>
+    apply union <;> aesop
+  case empty => apply empty
+
+theorem CaptureBound.crename
+  (h : CaptureBound Γ C B)
+  (ρ : CVarMap Γ f Δ) :
+  CaptureBound Δ (C.crename f) (B.crename f) := by
+  cases h
+  case subcapt hs =>
+    apply subcapt
+    apply Subcapt.crename hs ρ
+  case subkind hk =>
+    apply subkind
+    apply CaptureKind.crename hk ρ
+
+end Capless
diff --git a/Capless/Renaming/Capture/Subtyping.lean b/Capless/Renaming/Capture/Subtyping.lean
index b0e86d16..6d857b4b 100644
--- a/Capless/Renaming/Capture/Subtyping.lean
+++ b/Capless/Renaming/Capture/Subtyping.lean
@@ -21,9 +21,10 @@ theorem Subbound.crename
     simp [CBound.crename]
     apply Subbound.set
     apply Subcapt.crename <;> easy
-  case star =>
+  case kind =>
     simp [CBound.crename]
-    apply Subbound.star
+    apply Subbound.kind
+    trivial
 
 def SSubtyp.crename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Renaming/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean
index 043bc487..c65afeab 100644
--- a/Capless/Renaming/Capture/Typing.lean
+++ b/Capless/Renaming/Capture/Typing.lean
@@ -1,6 +1,7 @@
 import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Capture.Subtyping
+import Capless.Renaming.Capture.CaptureBound
 
 /-!
 # Capture Variable Renaming for Typing
@@ -27,6 +28,8 @@ theorem Typed.crename
   case pack ih =>
     simp [Term.crename, EType.crename]
     apply pack
+    apply CaptureBound.crename _ ρ
+    trivial
     have ih := ih (ρ.cext _)
     simp [Term.crename, EType.crename] at ih
     exact ih
diff --git a/Capless/Renaming/Term/CaptureBound.lean b/Capless/Renaming/Term/CaptureBound.lean
new file mode 100644
index 00000000..aed6c4cd
--- /dev/null
+++ b/Capless/Renaming/Term/CaptureBound.lean
@@ -0,0 +1,46 @@
+import Capless.CaptureBound
+import Capless.Renaming.Term.Subcapturing
+
+/-!
+# Variable Renaming for Capture Bounding
+
+This module proves that capture bound relationships are preserved under variable
+renaming. The main theorem `Subcapt.rename` shows that subcapturing judgments
+remain valid when variables are renamed consistently between contexts.
+-/
+namespace Capless
+
+theorem CaptureKind.rename
+  (h : CaptureKind Γ C K)
+  (ρ : VarMap Γ f Δ) :
+  CaptureKind Δ (C.rename f) K := by
+  induction h
+  case var hb hk ih =>
+    apply var
+    have hb1 := ρ.map _ _ hb
+    simp [EType.crename, CType.crename] at hb1
+    exact hb1
+    apply ih ρ
+  case cvar hc =>
+    apply cvar
+    exact ρ.cmap _ _ hc
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih ρ
+  case union hc1 hc2 ih1 ih2 =>
+    apply union <;> aesop
+  case empty => apply empty
+
+theorem CaptureBound.rename
+  (h : CaptureBound Γ C B)
+  (ρ : VarMap Γ f Δ) :
+  CaptureBound Δ (C.rename f) (B.rename f) := by
+  cases h
+  case subcapt hs =>
+    apply subcapt
+    apply Subcapt.rename hs ρ
+  case subkind hk =>
+    apply subkind
+    apply CaptureKind.rename hk ρ
+
+end Capless
diff --git a/Capless/Renaming/Term/Subtyping.lean b/Capless/Renaming/Term/Subtyping.lean
index 4e946418..ef370b79 100644
--- a/Capless/Renaming/Term/Subtyping.lean
+++ b/Capless/Renaming/Term/Subtyping.lean
@@ -20,7 +20,7 @@ theorem Subbound.rename
     simp [CBound.rename]
     constructor
     apply Subcapt.rename <;> easy
-  case star => simp [CBound.rename]; constructor
+  case kind => simp [CBound.rename]; constructor; trivial
 
 def SSubtyp.rename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Renaming/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean
index 219997a5..aea928d6 100644
--- a/Capless/Renaming/Term/Typing.lean
+++ b/Capless/Renaming/Term/Typing.lean
@@ -1,6 +1,7 @@
 import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Term.Subtyping
+import Capless.Renaming.Term.CaptureBound
 
 /-!
 # Term Variable Renaming for Typing
@@ -26,6 +27,7 @@ theorem Typed.rename
   case pack ih =>
     simp [Term.rename, EType.rename]
     apply Typed.pack
+    apply CaptureBound.rename <;> trivial
     have ih := ih (ρ.cext _)
     simp [Term.rename, EType.rename] at ih
     exact ih
diff --git a/Capless/Renaming/Type/CaptureBound.lean b/Capless/Renaming/Type/CaptureBound.lean
new file mode 100644
index 00000000..b7cfe43e
--- /dev/null
+++ b/Capless/Renaming/Type/CaptureBound.lean
@@ -0,0 +1,47 @@
+import Capless.CaptureBound
+import Capless.Renaming.Type.Subcapturing
+
+/-!
+# Type Variable Renaming for Capture Bounding
+
+This module proves that capture bound relationships are preserved under type variable
+renaming. The main theorem `Subcapt.trename` shows that subcapturing judgments
+remain valid when type variables are renamed consistently between contexts.
+-/
+namespace Capless
+
+theorem CaptureKind.trename
+  (h : CaptureKind Γ C K)
+  (ρ : TVarMap Γ f Δ) :
+  CaptureKind Δ C K := by
+  induction h
+  case var hb hk ih =>
+    apply var
+    have hb1 := ρ.map _ _ hb
+    simp [EType.trename, CType.trename] at hb1
+    exact hb1
+    apply ih ρ
+  case cvar hc =>
+    apply cvar
+    exact ρ.cmap _ _ hc
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih ρ
+  case union hc1 hc2 ih1 ih2 =>
+    apply union <;> aesop
+  case empty => apply empty
+
+
+theorem CaptureBound.trename
+  (h : CaptureBound Γ C B)
+  (ρ : TVarMap Γ f Δ) :
+  CaptureBound Δ C B := by
+  cases h
+  case subcapt hs =>
+    apply subcapt
+    apply Subcapt.trename hs ρ
+  case subkind hk =>
+    apply subkind
+    apply CaptureKind.trename hk ρ
+
+end Capless
diff --git a/Capless/Renaming/Type/Subtyping.lean b/Capless/Renaming/Type/Subtyping.lean
index b2d89e2e..b553c1cb 100644
--- a/Capless/Renaming/Type/Subtyping.lean
+++ b/Capless/Renaming/Type/Subtyping.lean
@@ -20,7 +20,7 @@ theorem Subbound.trename
   case set =>
     apply Subbound.set
     apply Subcapt.trename <;> trivial
-  case star => apply Subbound.star
+  case kind => apply Subbound.kind; assumption
 
 def SSubtyp.trename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean
index 7b0bfae9..493d2459 100644
--- a/Capless/Renaming/Type/Typing.lean
+++ b/Capless/Renaming/Type/Typing.lean
@@ -1,6 +1,7 @@
 import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Type.Subtyping
+import Capless.Renaming.Type.CaptureBound
 
 /-!
 # Type Variable Renaming for Typing
@@ -27,6 +28,8 @@ theorem Typed.trename
   case pack ih =>
     simp [Term.trename, EType.trename]
     apply pack
+    apply CaptureBound.trename _ ρ
+    trivial
     have ih := ih (ρ.cext _)
     simp [Term.trename, EType.trename] at ih
     trivial
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 9a33dc39..f24824ae 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -136,10 +136,10 @@ inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k
   TypedCont Γ E cont E' C ->
   TypedCont Γ (EType.type T) (Cont.cons t cont) E' (C ∪ Ct)
 | conse {Ct : CaptureSet n k} :
-  Typed ((Γ.cvar (CBinding.bound CBound.star)).var T) t (EType.weaken (EType.cweaken E)) Ct.cweaken.weaken ->
+  Typed ((Γ.cvar (CBinding.bound B)).var T) t (EType.weaken (EType.cweaken E)) Ct.cweaken.weaken ->
   WellScoped Γ cont Ct ->
   TypedCont Γ E cont E' C ->
-  TypedCont Γ (EType.ex T) (Cont.conse t cont) E' (C ∪ Ct)
+  TypedCont Γ (EType.ex B T) (Cont.conse t cont) E' (C ∪ Ct)
 | scope :
   Context.LBound Γ x S ->
   TypedCont Γ (S^{}) cont E' C ->
diff --git a/Capless/Subst/Capture/Subtyping.lean b/Capless/Subst/Capture/Subtyping.lean
index 28bd5a4d..466e9531 100644
--- a/Capless/Subst/Capture/Subtyping.lean
+++ b/Capless/Subst/Capture/Subtyping.lean
@@ -177,7 +177,7 @@ theorem ESubtyp.csubst
     apply hs.csubst; trivial
 
 theorem CSubtyp.cinstantiate {Γ : Context n m k}
-  (h : CSubtyp (Γ.cvar (CBinding.bound CBound.star)) T1 T2) :
+  (h : CSubtyp (Γ.cvar (CBinding.bound B)) T1 T2) :
   CSubtyp (Γ.cvar (CBinding.inst C)) T1 T2 := by
   rw [<- CType.crename_id (T := T1), <- CType.crename_id (T := T2)]
   apply? CSubtyp.csubst
diff --git a/Capless/Subst/Term/Subtyping.lean b/Capless/Subst/Term/Subtyping.lean
index f07b4004..752bf04f 100644
--- a/Capless/Subst/Term/Subtyping.lean
+++ b/Capless/Subst/Term/Subtyping.lean
@@ -16,7 +16,7 @@ theorem Subbound.subst
   case set =>
     constructor
     apply Subcapt.subst <;> easy
-  case star => constructor
+  case kind => constructor
 
 def SSubtyp.subst_motive1
   (Γ : Context n m k)
diff --git a/Capless/Subtyping/Basic.lean b/Capless/Subtyping/Basic.lean
index a18289ca..bf53220f 100644
--- a/Capless/Subtyping/Basic.lean
+++ b/Capless/Subtyping/Basic.lean
@@ -1,4 +1,5 @@
 import Capless.Subtyping
+import Capless.Classifier
 import Capless.Subcapturing
 import Capless.Subcapturing.Basic
 
@@ -15,6 +16,8 @@ theorem Subbound.refl {B : CBound n k} :
   cases B <;> constructor
   case upper =>
     apply Subcapt.refl
+  case kind =>
+    apply Kind.subkind_refl
 
 theorem Subbound.trans
   (h1 : Subbound Γ B1 B2)
@@ -22,6 +25,8 @@ theorem Subbound.trans
   Subbound Γ B1 B3 := by
   cases h1 <;> cases h2 <;> constructor
   apply Subcapt.trans <;> easy
+  rename_i k1 k2 h1 k3 h2
+  apply Kind.Subkind.trans h1 h2
 
 theorem ESubtyp.type_inv_subcapt'
   (heq : E1 = EType.type (CType.capt C S))
@@ -42,8 +47,8 @@ theorem ESubtyp.type_inv_subcapt
   ESubtyp.type_inv_subcapt' rfl h
 
 theorem ESubtyp.ex_inv_subcapt
-  (h : ESubtyp Γ E (EType.ex (CType.capt C S))) :
-  ∃ C0 S0, E = EType.ex (CType.capt C0 S0) ∧ Subcapt (Γ.cvar (CBinding.bound CBound.star)) C0 C := by
+  (h : ESubtyp Γ E (EType.ex B (CType.capt C S))) :
+  ∃ C0 S0, E = EType.ex B (CType.capt C0 S0) ∧ Subcapt (Γ.cvar (CBinding.bound B)) C0 C := by
   cases h
   case exist hs =>
     cases hs
diff --git a/Capless/Type/Core.lean b/Capless/Type/Core.lean
index 2e10994f..d6a5080f 100644
--- a/Capless/Type/Core.lean
+++ b/Capless/Type/Core.lean
@@ -52,7 +52,7 @@ notation:50 "∀(x:" T ")" U => SType.forall T U
 notation:50 "∀[X<:" S "]" T => SType.tforall S T
 notation:50 "∀[c<:" B "]" T => SType.cforall B T
 notation:max S " ^ " C => CType.capt C S
-notation:40 "∃c<:" B "." T => EType.ex B T
+notation:40 "∃[c<:" B "]" T => EType.ex B T
 notation:40 "Label[" S "]" => SType.label S
 notation:60 "□" T => SType.box T
 
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 3378d1b7..942838c4 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Context
 import Capless.Subtyping
 import Capless.Type
 import Capless.Term
+import Capless.CaptureBound
 
 /-!
 # Typing Rules of Capless
@@ -21,8 +22,9 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Context.LBound Γ x S ->
   Typed Γ (Term.var x) (Label[S]^{x=x}) {x=x}
 | pack :
+  CaptureBound Γ C B ->
   Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} ->
-  Typed Γ (Term.pack C x) (∃c.T) {}
+  Typed Γ (Term.pack C x) (∃[c<:B]T) {}
 | sub :
   Typed Γ t E1 C1 ->
   (Γ ⊢ C1 <:c C2) ->
@@ -56,8 +58,8 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed (Γ,x: T) u E.weaken C.weaken ->  -- which means that x ∉ C and x ∉ fv(E)
   Typed Γ (let x=t in u) E C
 | letex :
-  Typed Γ t (EType.ex T) C ->
-  Typed ((Γ,c<:*),x: T) u E.cweaken.weaken C.cweaken.weaken ->
+  Typed Γ t (EType.ex B T) C ->
+  Typed ((Γ,c<:B),x: T) u E.cweaken.weaken C.cweaken.weaken ->
   Typed Γ (let (c,x)=t in u) E C
 | bindt :
   Typed (Γ,X:=S) t E.tweaken C ->
@@ -67,7 +69,7 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed Γ (let c=C in t) E C0
 | boundary {Γ : Context n m k} {S : SType n m k} :
   Typed
-    ((Γ,c<:CBound.star),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:CBound.kind .control),x: Label[S.cweaken]^{c=0})
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0} ∪ {x=0}) ->
   Typed Γ (boundary: S in t) (S^CaptureSet.empty) C

From c2b1353ca5612fc2c7906c08eb3bc7c52aa7e116 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 11 Nov 2025 20:02:16 +0100
Subject: [PATCH 05/71] Up to renaming

---
 Capless/CaptureBound.lean                  | 50 ++++++++++++++++++++++
 Capless/Renaming/Capture/CaptureBound.lean |  4 ++
 Capless/Renaming/Capture/Subtyping.lean    |  6 +++
 Capless/Renaming/Term/CaptureBound.lean    |  4 ++
 Capless/Renaming/Term/Subtyping.lean       |  5 +++
 Capless/Renaming/Type/CaptureBound.lean    |  4 ++
 Capless/Renaming/Type/Subtyping.lean       |  4 ++
 Capless/Subtyping.lean                     |  4 +-
 Capless/Subtyping/Basic.lean               |  5 +++
 9 files changed, 85 insertions(+), 1 deletion(-)

diff --git a/Capless/CaptureBound.lean b/Capless/CaptureBound.lean
index ac9e482a..ad848c10 100644
--- a/Capless/CaptureBound.lean
+++ b/Capless/CaptureBound.lean
@@ -7,6 +7,7 @@ namespace Capless
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
+  | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K -- Should cover all the cinst cases, otherwise we can prove
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
   | empty : CaptureKind Γ .empty K
@@ -14,3 +15,52 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
 inductive CaptureBound : Context n m k -> CaptureSet n k -> CBound n k -> Prop where
   | subcapt: Subcapt Γ C1 C2 -> CaptureBound Γ C1 (CBound.upper C2)
   | subkind : CaptureKind Γ C K -> CaptureBound Γ C (CBound.kind K)
+
+-- theorem CaptureKind.union_elim (hk: CaptureKind Γ (C1 ∪ C2) K) : (CaptureKind Γ C1 K) ∧ (CaptureKind Γ C2 K) := by
+--   generalize h : C1 ∪ C2 = C at hk
+--   induction hk <;> cases h
+--   case sub hs hk ih =>
+--     have ⟨h1, h2⟩ := ih (Eq.refl (C1 ∪ C2))
+--     apply sub hs at h1
+--     apply sub hs at h2
+--     apply And.intro <;> assumption
+--   case union h1 h2 ih1 ih2 => apply And.intro <;> assumption
+
+-- theorem CaptureKind.subset (hk: CaptureKind Γ C2 K) (hsub: C1 ⊆ C2) : CaptureKind Γ C1 K := by
+--   induction hsub
+--   case empty => apply empty
+--   case rfl => assumption
+--   case union_l h1 h2 ih1 ih2 =>
+--     apply union
+--     apply ih1 hk
+--     apply ih2 hk
+--   case union_rl h ih =>
+--     apply ih
+--     cases hk
+--     case union h1 h2 => assumption
+--     case sub hs hk =>
+--       have ⟨h1, _⟩ := hs.union_elim
+--       apply sub hk h1
+--   case union_rr h ih =>
+--     apply ih
+--     cases hk
+--     case union h1 h2 => assumption
+--     case sub hs hk =>
+--       have ⟨_, h2⟩ := hs.union_elim
+--       apply sub hk h2
+
+-- theorem CaptureKind.subcapt  (hk: CaptureKind Γ C2 K) (hs: Subcapt Γ C1 C2): CaptureKind Γ C1 K := by
+--   induction hs
+--   case trans h1 h2 ih1 ih2 =>
+--     apply ih1
+--     apply ih2
+--     apply hk
+--   case subset hsub => apply hk.subset hsub
+--   case union h1 h2 ih1 ih2 =>
+--     apply union
+--     apply ih1 hk
+--     apply ih2 hk
+--   case var hb =>
+--     apply var hb hk
+--   case cinstl hb =>
+--     apply cinst
diff --git a/Capless/Renaming/Capture/CaptureBound.lean b/Capless/Renaming/Capture/CaptureBound.lean
index 2e341ae7..d3f3f3d7 100644
--- a/Capless/Renaming/Capture/CaptureBound.lean
+++ b/Capless/Renaming/Capture/CaptureBound.lean
@@ -28,6 +28,10 @@ theorem CaptureKind.crename
   case sub hs hk ih =>
     apply sub hs
     apply ih ρ
+  case csub hs hk ih =>
+    have hs1 := hs.crename ρ
+    apply csub hs1
+    apply ih ρ
   case union hc1 hc2 ih1 ih2 =>
     apply union <;> aesop
   case empty => apply empty
diff --git a/Capless/Renaming/Capture/Subtyping.lean b/Capless/Renaming/Capture/Subtyping.lean
index 6d857b4b..ef8cf3b0 100644
--- a/Capless/Renaming/Capture/Subtyping.lean
+++ b/Capless/Renaming/Capture/Subtyping.lean
@@ -2,6 +2,7 @@ import Capless.Tactics
 import Capless.Subtyping
 import Capless.Renaming.Basic
 import Capless.Renaming.Capture.Subcapturing
+import Capless.Renaming.Capture.CaptureBound
 
 /-!
 # Capture Variable Renaming for Subtyping
@@ -25,6 +26,11 @@ theorem Subbound.crename
     simp [CBound.crename]
     apply Subbound.kind
     trivial
+  case set_kind =>
+    simp [CBound.crename]
+    apply Subbound.set_kind
+    apply CaptureKind.crename _ ρ
+    trivial
 
 def SSubtyp.crename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Renaming/Term/CaptureBound.lean b/Capless/Renaming/Term/CaptureBound.lean
index aed6c4cd..5176d57c 100644
--- a/Capless/Renaming/Term/CaptureBound.lean
+++ b/Capless/Renaming/Term/CaptureBound.lean
@@ -27,6 +27,10 @@ theorem CaptureKind.rename
   case sub hs hk ih =>
     apply sub hs
     apply ih ρ
+  case csub hs hk ih =>
+    have hs1 := hs.rename ρ
+    apply csub hs1
+    apply ih ρ
   case union hc1 hc2 ih1 ih2 =>
     apply union <;> aesop
   case empty => apply empty
diff --git a/Capless/Renaming/Term/Subtyping.lean b/Capless/Renaming/Term/Subtyping.lean
index ef370b79..ba460bd7 100644
--- a/Capless/Renaming/Term/Subtyping.lean
+++ b/Capless/Renaming/Term/Subtyping.lean
@@ -1,6 +1,7 @@
 import Capless.Subtyping
 import Capless.Renaming.Basic
 import Capless.Renaming.Term.Subcapturing
+import Capless.Renaming.Term.CaptureBound
 
 /-!
 # Term Variable Renaming for Subtyping
@@ -21,6 +22,10 @@ theorem Subbound.rename
     constructor
     apply Subcapt.rename <;> easy
   case kind => simp [CBound.rename]; constructor; trivial
+  case set_kind =>
+    simp [CBound.rename]
+    constructor
+    apply CaptureKind.rename <;> easy
 
 def SSubtyp.rename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Renaming/Type/CaptureBound.lean b/Capless/Renaming/Type/CaptureBound.lean
index b7cfe43e..666a718c 100644
--- a/Capless/Renaming/Type/CaptureBound.lean
+++ b/Capless/Renaming/Type/CaptureBound.lean
@@ -27,6 +27,10 @@ theorem CaptureKind.trename
   case sub hs hk ih =>
     apply sub hs
     apply ih ρ
+  case csub hs hk ih =>
+    have hs1 := hs.trename ρ
+    apply csub hs1
+    apply ih ρ
   case union hc1 hc2 ih1 ih2 =>
     apply union <;> aesop
   case empty => apply empty
diff --git a/Capless/Renaming/Type/Subtyping.lean b/Capless/Renaming/Type/Subtyping.lean
index b553c1cb..f1513c2a 100644
--- a/Capless/Renaming/Type/Subtyping.lean
+++ b/Capless/Renaming/Type/Subtyping.lean
@@ -2,6 +2,7 @@ import Capless.Tactics
 import Capless.Subtyping
 import Capless.Renaming.Basic
 import Capless.Renaming.Type.Subcapturing
+import Capless.Renaming.Type.CaptureBound
 
 /-!
 # Type Variable Renaming for Subtyping
@@ -21,6 +22,9 @@ theorem Subbound.trename
     apply Subbound.set
     apply Subcapt.trename <;> trivial
   case kind => apply Subbound.kind; assumption
+  case set_kind =>
+    constructor
+    apply CaptureKind.trename <;> easy
 
 def SSubtyp.trename_motive1
   (Γ : Context n m k)
diff --git a/Capless/Subtyping.lean b/Capless/Subtyping.lean
index 18e7e5a1..148d9f79 100644
--- a/Capless/Subtyping.lean
+++ b/Capless/Subtyping.lean
@@ -2,6 +2,7 @@ import Capless.Context
 import Capless.Subcapturing
 import Capless.Type
 import Capless.Classifier
+import Capless.CaptureBound
 
 /-!
 # Subtyping Rules of Capless
@@ -17,7 +18,8 @@ inductive Subbound : Context n m k -> CBound n k -> CBound n k -> Prop where
   Subbound Γ (CBound.upper C1) (CBound.upper C2)
 | kind :
   Kind.Subkind k1 k2 -> Subbound Γ (CBound.kind k1) (CBound.kind k2)
-
+| set_kind :
+  CaptureKind Γ C K -> Subbound Γ (CBound.upper C) (CBound.kind K)
 mutual
 
 inductive ESubtyp : Context n m k -> EType n m k -> EType n m k -> Prop where
diff --git a/Capless/Subtyping/Basic.lean b/Capless/Subtyping/Basic.lean
index bf53220f..464156e0 100644
--- a/Capless/Subtyping/Basic.lean
+++ b/Capless/Subtyping/Basic.lean
@@ -25,8 +25,13 @@ theorem Subbound.trans
   Subbound Γ B1 B3 := by
   cases h1 <;> cases h2 <;> constructor
   apply Subcapt.trans <;> easy
+  rename_i hsub K hk
+  apply CaptureKind.csub hsub hk
   rename_i k1 k2 h1 k3 h2
   apply Kind.Subkind.trans h1 h2
+  rename_i hk K2 hs
+  apply CaptureKind.sub hs hk
+
 
 theorem ESubtyp.type_inv_subcapt'
   (heq : E1 = EType.type (CType.capt C S))

From eac3850c3c568427854a687e684f66985f311f10 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 11 Nov 2025 20:21:52 +0100
Subject: [PATCH 06/71] Substitution done?

---
 Capless/Subst/Basic.lean                | 44 +++++++++++++++++++++----
 Capless/Subst/Capture/CaptureBound.lean | 40 ++++++++++++++++++++++
 Capless/Subst/Capture/Subtyping.lean    |  6 +++-
 Capless/Subst/Capture/Typing.lean       | 13 +++++---
 Capless/Subst/Term/CaptureBound.lean    | 42 +++++++++++++++++++++++
 Capless/Subst/Term/Subtyping.lean       |  9 ++++-
 Capless/Subst/Term/Typing.lean          |  5 +--
 Capless/Subst/Type/CaptureBound.lean    | 41 +++++++++++++++++++++++
 Capless/Subst/Type/Subtyping.lean       |  3 ++
 Capless/Subst/Type/Typing.lean          |  5 +--
 Capless/Weakening/CaptureBound.lean     | 22 +++++++++++++
 11 files changed, 212 insertions(+), 18 deletions(-)
 create mode 100644 Capless/Subst/Capture/CaptureBound.lean
 create mode 100644 Capless/Subst/Term/CaptureBound.lean
 create mode 100644 Capless/Subst/Type/CaptureBound.lean
 create mode 100644 Capless/Weakening/CaptureBound.lean

diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index b7edf098..64cf5ae8 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -5,6 +5,8 @@ import Capless.Type.Basic
 import Capless.Typing
 import Capless.Typing.Basic
 import Capless.Weakening.Subtyping
+import Capless.Weakening.Subcapturing
+import Capless.Weakening.CaptureBound
 import Capless.Weakening.Typing
 import Capless.Inversion.Context
 
@@ -592,9 +594,11 @@ def CVarSubst.cext {Γ : Context n m k}
       simp [FinFun.ext_zero]
       rename_i cb
       cases cb
-      case star =>
+      case kind k =>
         simp [CBinding.crename, CBound.crename]
         constructor
+        apply CaptureKind.cvar
+        constructor
       case upper D0 =>
         constructor
         apply Subcapt.cbound
@@ -727,6 +731,8 @@ def CVarSubst.narrow
       apply Subbound.trans (B2:=B'.cweaken)
       { cases B' <;> constructor
         apply Subcapt.cbound
+        constructor
+        constructor
         constructor }
       { apply Subbound.cweaken; easy }
     case inr h =>
@@ -740,6 +746,11 @@ def CVarSubst.narrow
       have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
       simp [CBinding.cweaken] at hb1'
       exact hb1'
+      simp [CBound.crename] at hb
+      apply CaptureKind.cvar
+      have h1 := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
+      simp [CBinding.cweaken, CBinding.crename, CBound.crename] at h1
+      assumption
 
 def TVarSubst.narrow
   (hs : SSubtyp Γ S' S) :
@@ -890,7 +901,9 @@ def CVarSubst.open :
       simp [CBound.crename_crename]
       simp [FinFun.open_comp_weaken, CBound.crename_id]
       rename_i cb; cases cb
-      case star => constructor
+      case kind K =>
+        apply Subbound.set_kind
+        apply CaptureKind.cvar hb1
       case upper D0 =>
         constructor
         apply Subcapt.cbound
@@ -902,9 +915,10 @@ def CVarSubst.open :
     simp [SType.crename_id]
     trivial
 
-def CVarSubst.instantiate {Γ : Context n m k} :
+def CVarSubst.instantiate {Γ : Context n m k}
+  (hk : CaptureBound Γ C B) :
   CVarSubst
-    (Γ.cvar (CBinding.bound CBound.star))
+    (Γ.cvar (CBinding.bound B))
     FinFun.id
     (Γ.cvar (CBinding.inst C)) := by
   constructor
@@ -940,8 +954,20 @@ def CVarSubst.instantiate {Γ : Context n m k} :
     case inl h =>
       have ⟨he1, he2⟩ := h
       subst he1
-      cases b0 <;> cases he2
+      cases hk <;> cases b0 <;> cases he2
       constructor
+      rename_i C2 hsub
+      apply Subcapt.trans
+      apply Subcapt.cinstr .here
+      simp [CaptureSet.crename_id]
+      exact hsub.cweaken (b:=CBinding.inst C)
+      constructor
+      rename_i hk
+      have h1 := CaptureKind.cweaken (b:=.inst C) hk
+      apply CaptureKind.csub (C2:=C.cweaken)
+      apply Subcapt.cinstr
+      apply Context.CBound.here
+      assumption
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases he2
@@ -949,7 +975,12 @@ def CVarSubst.instantiate {Γ : Context n m k} :
       rename_i cb
       simp [FinFun.id, CBound.crename_id]
       cases cb
-      case star => constructor
+      case kind K1 =>
+        simp [CBound.crename]
+        constructor
+        apply CaptureKind.cvar
+        exact hb1.there_cvar (b':=.inst C)
+        -- have hb2 := hb1
       case upper D0 =>
         constructor
         apply Subcapt.cbound
@@ -957,5 +988,4 @@ def CVarSubst.instantiate {Γ : Context n m k} :
         rw [<- CBound.cweaken_upper]
         rw [<- CBinding.cweaken_bound]
         constructor; easy
-
 end Capless
diff --git a/Capless/Subst/Capture/CaptureBound.lean b/Capless/Subst/Capture/CaptureBound.lean
new file mode 100644
index 00000000..1e491feb
--- /dev/null
+++ b/Capless/Subst/Capture/CaptureBound.lean
@@ -0,0 +1,40 @@
+import Capless.CaptureBound
+import Capless.Subst.Basic
+import Capless.Subst.Capture.Subcapturing
+
+/-
+Substitution theorems for capture variable substitution in capture kind judgments.
+-/
+
+namespace Capless
+
+theorem CaptureKind.csubst
+  (h : CaptureKind Γ C K)
+  (σ : CVarSubst Γ f Δ) :
+  CaptureKind Δ (C.crename f) K := by
+  induction h
+  case var hb hk ih =>
+    have hb1 := σ.map _ _ hb
+    apply CaptureKind.var hb1 (ih σ)
+  case cvar hb =>
+    cases σ.cmap_bound _ _ hb
+    assumption
+  case csub hsub hk ih =>
+    have hsub1 := hsub.csubst σ
+    apply csub hsub1 (ih σ)
+  case sub hs hk ih =>
+    apply sub hs (ih σ)
+  case union h1 h2 ih1 ih2 =>
+    apply union (ih1 σ) (ih2 σ)
+  case empty =>
+    apply empty
+
+theorem CaptureBound.csubst
+  (h : CaptureBound Γ C B)
+  (σ: CVarSubst Γ f Δ) :
+  CaptureBound Δ (C.crename f) (B.crename f) := by
+    cases h <;> constructor
+    apply Subcapt.csubst _ σ ; assumption
+    apply CaptureKind.csubst _ σ ; assumption
+
+end Capless
diff --git a/Capless/Subst/Capture/Subtyping.lean b/Capless/Subst/Capture/Subtyping.lean
index 466e9531..4ac835b1 100644
--- a/Capless/Subst/Capture/Subtyping.lean
+++ b/Capless/Subst/Capture/Subtyping.lean
@@ -1,5 +1,6 @@
 import Capless.Subtyping
 import Capless.Subst.Basic
+import Capless.Subst.Capture.CaptureBound
 
 /-
 Substitution theorems for capture variable substitution in subtyping judgments.
@@ -14,6 +15,8 @@ theorem Subbound.csubst
   Subbound Δ (B1.crename f) (B2.crename f) := by
   cases h <;> constructor
   apply Subcapt.csubst <;> easy
+  assumption
+  apply CaptureKind.csubst <;> easy
 
 def SSubtyp.csubst_motive1
   (Γ : Context n m k)
@@ -177,7 +180,8 @@ theorem ESubtyp.csubst
     apply hs.csubst; trivial
 
 theorem CSubtyp.cinstantiate {Γ : Context n m k}
-  (h : CSubtyp (Γ.cvar (CBinding.bound B)) T1 T2) :
+  (h : CSubtyp (Γ.cvar (CBinding.bound B)) T1 T2)
+  (hb : CaptureBound Γ C B) :
   CSubtyp (Γ.cvar (CBinding.inst C)) T1 T2 := by
   rw [<- CType.crename_id (T := T1), <- CType.crename_id (T := T2)]
   apply? CSubtyp.csubst
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index 4620ef99..dcbe1c17 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -1,5 +1,6 @@
 import Capless.Subst.Basic
 import Capless.Subst.Capture.Subtyping
+import Capless.Subst.Capture.CaptureBound
 import Capless.Typing
 
 /-
@@ -19,9 +20,9 @@ theorem Typed.csubst
       have hb1 := σ.map _ _ hb
       simp [CType.crename] at hb1
       apply Typed.var; trivial
-    case pack ih =>
+    case pack hb _ ih =>
       simp [Term.crename, EType.crename]
-      apply pack
+      apply pack (hb.csubst σ)
       have ih := ih σ.cext
       simp [EType.crename] at ih
       exact ih
@@ -139,7 +140,8 @@ theorem Typed.copen
   apply? CVarSubst.open
 
 theorem Typed.cinstantiate {Γ : Context n m k}
-  (h : Typed (Γ,c<:CBound.star) t E Ct) :
+  (h : Typed (Γ,c<:B) t E Ct)
+  (hb: CaptureBound Γ C B) :
   Typed (Γ,c:= C) t E Ct := by
   rw [<- Term.crename_id (t := t), <- EType.crename_id (E := E)]
   rw [<- CaptureSet.crename_id (C := Ct)]
@@ -147,7 +149,8 @@ theorem Typed.cinstantiate {Γ : Context n m k}
   apply? CVarSubst.instantiate
 
 theorem Typed.cinstantiate_extvar {Γ : Context n m k}
-  (h : Typed ((Γ,c<:CBound.star).var P) t E Ct) :
+  (h : Typed ((Γ,c<:B).var P) t E Ct)
+  (hb: CaptureBound Γ C B) :
   Typed ((Γ,c:=C).var P) t E Ct := by
   rw [<- Term.crename_id (t := t), <- EType.crename_id (E := E)]
   rw [<- CaptureSet.crename_id (C := Ct)]
@@ -156,6 +159,6 @@ theorem Typed.cinstantiate_extvar {Γ : Context n m k}
     arg 3
     rw [<- CType.crename_id (T := P)]
   apply CVarSubst.ext
-  apply CVarSubst.instantiate
+  apply? CVarSubst.instantiate
 
 end Capless
diff --git a/Capless/Subst/Term/CaptureBound.lean b/Capless/Subst/Term/CaptureBound.lean
new file mode 100644
index 00000000..40f4c869
--- /dev/null
+++ b/Capless/Subst/Term/CaptureBound.lean
@@ -0,0 +1,42 @@
+import Capless.CaptureBound
+import Capless.Subst.Basic
+import Capless.Subst.Term.Subcapturing
+
+/-
+Substitution theorems for term variable substitution in capture kind judgments.
+-/
+
+namespace Capless
+
+theorem CaptureKind.subst
+  (h : CaptureKind Γ C K)
+  (σ : VarSubst Γ f Δ) :
+  CaptureKind Δ (C.rename f) K := by
+  induction h
+  case var hb hk ih =>
+    have hb1 := σ.map _ _ hb
+    simp [EType.rename, CType.rename] at hb1
+    have h := Typing.inv_subcapt hb1
+    apply csub h (ih σ)
+  case cvar hb =>
+    have hb1 := σ.cmap _ _ hb
+    apply cvar hb1
+  case csub hsub hk ih =>
+    have hsub1 := hsub.subst σ
+    apply csub hsub1 (ih σ)
+  case sub hs hk ih =>
+    apply sub hs (ih σ)
+  case union h1 h2 ih1 ih2 =>
+    apply union (ih1 σ) (ih2 σ)
+  case empty =>
+    apply empty
+
+theorem CaptureBound.subst
+  (h : CaptureBound Γ C B)
+  (σ: VarSubst Γ f Δ) :
+  CaptureBound Δ (C.rename f) (B.rename f) := by
+    cases h <;> constructor
+    apply Subcapt.subst _ σ ; assumption
+    apply CaptureKind.subst _ σ ; assumption
+
+end Capless
diff --git a/Capless/Subst/Term/Subtyping.lean b/Capless/Subst/Term/Subtyping.lean
index 752bf04f..bd7d4540 100644
--- a/Capless/Subst/Term/Subtyping.lean
+++ b/Capless/Subst/Term/Subtyping.lean
@@ -1,6 +1,7 @@
 import Capless.Subst.Basic
 import Capless.Subtyping
 import Capless.Subst.Term.Subcapturing
+import Capless.Subst.Term.CaptureBound
 
 /-
 Substitution theorems for term variable substitution in subtyping judgments.
@@ -16,7 +17,13 @@ theorem Subbound.subst
   case set =>
     constructor
     apply Subcapt.subst <;> easy
-  case kind => constructor
+  case kind =>
+    constructor
+    assumption
+  case set_kind hk =>
+    constructor
+    apply CaptureKind.subst <;> easy
+
 
 def SSubtyp.subst_motive1
   (Γ : Context n m k)
diff --git a/Capless/Subst/Term/Typing.lean b/Capless/Subst/Term/Typing.lean
index 56123414..4a1102a5 100644
--- a/Capless/Subst/Term/Typing.lean
+++ b/Capless/Subst/Term/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Typing
 import Capless.Subst.Basic
 import Capless.Subst.Term.Subtyping
 import Capless.Renaming.Term.Typing
+import Capless.Renaming.Term.CaptureBound
 
 /-
 Substitution theorems for term variable substitution in typing judgments.
@@ -21,9 +22,9 @@ theorem Typed.subst
     simp [CType.rename] at hb1
     apply Typed.precise_capture
     trivial
-  case pack ih =>
+  case pack hb _ ih =>
     simp [Term.rename, EType.rename]
-    apply pack
+    apply pack (hb.subst σ)
     have ih := ih σ.cext
     simp [EType.rename] at ih
     exact ih
diff --git a/Capless/Subst/Type/CaptureBound.lean b/Capless/Subst/Type/CaptureBound.lean
new file mode 100644
index 00000000..e7e0ae95
--- /dev/null
+++ b/Capless/Subst/Type/CaptureBound.lean
@@ -0,0 +1,41 @@
+import Capless.CaptureBound
+import Capless.Subst.Basic
+import Capless.Subst.Type.Subcapturing
+
+/-
+Substitution theorems for type variable substitution in capture kind judgments.
+-/
+
+namespace Capless
+
+theorem CaptureKind.tsubst
+  (h : CaptureKind Γ C K)
+  (σ : TVarSubst Γ f Δ) :
+  CaptureKind Δ C K := by
+  induction h
+  case var hb hk ih =>
+    have hb1 := σ.map _ _ hb
+    simp [CType.trename] at hb1
+    apply var hb1 (ih σ)
+  case cvar hb =>
+    have hb1 := σ.cmap _ _ hb
+    apply cvar hb1
+  case csub hsub hk ih =>
+    have hsub1 := hsub.tsubst σ
+    apply csub hsub1 (ih σ)
+  case sub hs hk ih =>
+    apply sub hs (ih σ)
+  case union h1 h2 ih1 ih2 =>
+    apply union (ih1 σ) (ih2 σ)
+  case empty =>
+    apply empty
+
+theorem CaptureBound.tsubst
+  (h : CaptureBound Γ C B)
+  (σ: TVarSubst Γ f Δ) :
+  CaptureBound Δ C B := by
+    cases h <;> constructor
+    apply Subcapt.tsubst _ σ ; assumption
+    apply CaptureKind.tsubst _ σ ; assumption
+
+end Capless
diff --git a/Capless/Subst/Type/Subtyping.lean b/Capless/Subst/Type/Subtyping.lean
index b1bcc55d..3806189a 100644
--- a/Capless/Subst/Type/Subtyping.lean
+++ b/Capless/Subst/Type/Subtyping.lean
@@ -1,6 +1,7 @@
 import Capless.Subst.Basic
 import Capless.Subtyping
 import Capless.Subst.Type.Subcapturing
+import Capless.Subst.Type.CaptureBound
 
 /-
 Substitution theorems for type variable substitution in subtyping judgments.
@@ -14,6 +15,8 @@ theorem Subbound.tsubst
   Subbound Δ B1 B2 := by
   cases h <;> constructor
   apply Subcapt.tsubst <;> easy
+  assumption
+  apply CaptureKind.tsubst <;> easy
 
 def SSubtyp.tsubst_motive1
   (Γ : Context n m k)
diff --git a/Capless/Subst/Type/Typing.lean b/Capless/Subst/Type/Typing.lean
index 99535b7f..f8d36a51 100644
--- a/Capless/Subst/Type/Typing.lean
+++ b/Capless/Subst/Type/Typing.lean
@@ -1,5 +1,6 @@
 import Capless.Subst.Basic
 import Capless.Subst.Type.Subtyping
+import Capless.Subst.Type.CaptureBound
 import Capless.Typing
 
 /-
@@ -19,9 +20,9 @@ theorem Typed.tsubst
       have hb1 := σ.map _ _ hb
       simp [CType.trename] at hb1
       apply Typed.var; trivial
-    case pack ih =>
+    case pack hb _ ih =>
       simp [Term.trename, EType.trename]
-      apply pack
+      apply pack (hb.tsubst σ)
       have ih := ih σ.cext
       simp [EType.trename] at ih
       exact ih
diff --git a/Capless/Weakening/CaptureBound.lean b/Capless/Weakening/CaptureBound.lean
new file mode 100644
index 00000000..b084219e
--- /dev/null
+++ b/Capless/Weakening/CaptureBound.lean
@@ -0,0 +1,22 @@
+import Capless.CaptureBound
+import Capless.Weakening.Basic
+import Capless.Renaming.Term.CaptureBound
+import Capless.Renaming.Type.CaptureBound
+import Capless.Renaming.Capture.CaptureBound
+
+namespace Capless
+
+def CaptureKind.weaken
+  (h : CaptureKind Γ C K) :
+   CaptureKind (Γ,x: T) C.weaken K := by
+  apply h.rename VarMap.weaken
+
+def CaptureKind.tweaken
+  (h : CaptureKind Γ C K) :
+  CaptureKind (Γ.tvar b) C K := by
+  apply h.trename TVarMap.weaken
+
+def CaptureKind.cweaken
+  (h : CaptureKind Γ C K) :
+  CaptureKind (Γ.cvar b) C.cweaken K := by
+  apply h.crename CVarMap.weaken

From 74845c0ec091ab00a86f81e98b61ffea615fccee Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 11 Nov 2025 22:03:24 +0100
Subject: [PATCH 07/71] Some progress on boundary

---
 Capless/CaptureBound.lean     |  1 +
 Capless/Inversion/Typing.lean | 33 ++++++++++++++++++---------------
 Capless/Typing/Boundary.lean  | 19 +++++++++++++------
 3 files changed, 32 insertions(+), 21 deletions(-)

diff --git a/Capless/CaptureBound.lean b/Capless/CaptureBound.lean
index ad848c10..6835baa6 100644
--- a/Capless/CaptureBound.lean
+++ b/Capless/CaptureBound.lean
@@ -6,6 +6,7 @@ namespace Capless
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
+  -- | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
   | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K -- Should cover all the cinst cases, otherwise we can prove
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
diff --git a/Capless/Inversion/Typing.lean b/Capless/Inversion/Typing.lean
index 40526430..fe06efe5 100644
--- a/Capless/Inversion/Typing.lean
+++ b/Capless/Inversion/Typing.lean
@@ -272,9 +272,9 @@ theorem Typed.letin_inv {Γ : Context n m k}
 theorem Typed.letex_inv' {Γ : Context n m k}
   (he : t0 = Term.letex t u)
   (h : Typed Γ t0 E Ct0) :
-  ∃ T E0,
-    Typed Γ t (EType.ex T) Ct0 ∧
-    Typed ((Γ.cvar (CBinding.bound CBound.star)).var T) u E0.cweaken.weaken Ct0.cweaken.weaken ∧
+  ∃ B T E0,
+    Typed Γ t (EType.ex B T) Ct0 ∧
+    Typed ((Γ.cvar (CBinding.bound B)).var T) u E0.cweaken.weaken Ct0.cweaken.weaken ∧
     ESubtyp Γ E0 E := by
   induction h <;> try (solve | cases he)
   case letex =>
@@ -285,7 +285,7 @@ theorem Typed.letex_inv' {Γ : Context n m k}
     apply ESubtyp.refl
   case sub hs ih =>
     have ih := ih he
-    obtain ⟨T, E0, ht, hu, hs0⟩ := ih
+    obtain ⟨B, T, E0, ht, hu, hs0⟩ := ih
     have hs1 := ESubtyp.trans hs0 hs
     repeat apply Exists.intro
     repeat any_goals apply And.intro
@@ -301,9 +301,9 @@ theorem Typed.letex_inv' {Γ : Context n m k}
 
 theorem Typed.letex_inv {Γ : Context n m k}
   (h : Typed Γ (Term.letex t u) E Ct) :
-  ∃ T E0,
-    Typed Γ t (EType.ex T) Ct ∧
-    Typed ((Γ,c<:*).var T) u E0.cweaken.weaken Ct.cweaken.weaken ∧
+  ∃ B T E0,
+    Typed Γ t (EType.ex B T) Ct ∧
+    Typed ((Γ,c<:B).var T) u E0.cweaken.weaken Ct.cweaken.weaken ∧
     ESubtyp Γ E0 E :=
   Typed.letex_inv' rfl h
 
@@ -408,9 +408,10 @@ theorem Typed.canonical_form_clam
 theorem Typed.canonical_form_pack'
   (ht : Γ.IsTight)
   (he1 : t0 = Term.pack C x)
-  (he2 : E0 = EType.ex T)
+  (he2 : E0 = EType.ex B T)
   (h : Typed Γ t0 E0 Ct) :
-  Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} := by
+  CaptureBound Γ C B ∧
+    Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} := by
   induction h <;> try (solve | cases he1 | cases he2)
   case pack =>
     cases he1; cases he2
@@ -419,17 +420,19 @@ theorem Typed.canonical_form_pack'
     subst he2
     cases hs
     rename_i hs
-    have ih := ih ht he1 rfl
+    have ⟨ihb, ih⟩ := ih ht he1 rfl
+    apply And.intro
+    assumption
     apply Typed.sub
     exact ih
     apply Subcapt.refl
     constructor
-    apply hs.cinstantiate
+    apply hs.cinstantiate ihb
 
 theorem Typed.canonical_form_pack
   (ht : Γ.IsTight)
-  (h : Typed Γ (Term.pack C x) (EType.ex T) Ct) :
-  Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} :=
+  (h : Typed Γ (Term.pack C x) (EType.ex B T) Ct) :
+  CaptureBound Γ C B ∧ Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} :=
   Typed.canonical_form_pack' ht rfl rfl h
 
 theorem Typed.forall_inv' {v : Term n m k}
@@ -681,7 +684,7 @@ theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
   (he : t0 = (boundary:S in t))
   (ht : Typed Γ t0 E Ct) :
   Typed
-    ((Γ,c<:*),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:(.kind Kind.control)),x: Label[S.cweaken]^{c=0})
     t
     (S.cweaken.weaken^{})
     (Ct.cweaken.weaken ∪ {c=0} ∪ {x=0}) ∧
@@ -706,7 +709,7 @@ theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
 theorem Typed.boundary_inv {Γ : Context n m k} {S : SType n m k}
   (ht : Typed Γ (boundary:S in t) E Ct) :
   Typed
-    ((Γ,c<:*),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:(.kind Kind.control)),x: Label[S.cweaken]^{c=0})
     t
     (S.cweaken.weaken^{})
     (Ct.cweaken.weaken ∪ {c=0} ∪ {x=0}) ∧
diff --git a/Capless/Typing/Boundary.lean b/Capless/Typing/Boundary.lean
index b1e58900..81d2bdce 100644
--- a/Capless/Typing/Boundary.lean
+++ b/Capless/Typing/Boundary.lean
@@ -10,9 +10,9 @@ It is a prerequisite for the (ENTER) case in the preservation theorem.
 
 def VarRename.boundary {Γ : Context n m k} {S : SType n m k} :
   VarMap
-    ((Γ,c<:*),x:(Label[S.cweaken])^{c=0})
+    ((Γ,c<:CBound.kind .control),x:(Label[S.cweaken])^{c=0})
     FinFun.weaken.ext
-    (((Γ.label S),c<:*),x:(Label[S.weaken.cweaken])^{c=0}) := by
+    (((Γ.label S),c<:CBound.kind .control),x:(Label[S.weaken.cweaken])^{c=0}) := by
   constructor
   case map =>
     intro x E hb
@@ -65,9 +65,9 @@ def VarRename.boundary {Γ : Context n m k} {S : SType n m k} :
 
 def CVarRename.boundary {Γ : Context n m k} {S : SType n m k} :
   CVarMap
-    (((Γ.label S),c<:*),x:(Label[S.weaken.cweaken])^{c=0})
+    (((Γ.label S),c<:CBound.kind .control),x:(Label[S.weaken.cweaken])^{c=0})
     FinFun.weaken.ext
-    ((((Γ.label S),c:={x=0}),c<:*),x:(Label[S.weaken.cweaken.cweaken])^{c=0}) := by
+    ((((Γ.label S),c:={x=0}),c<:CBound.kind .control),x:(Label[S.weaken.cweaken.cweaken])^{c=0}) := by
   constructor
   case map =>
     intro x T hb
@@ -141,7 +141,7 @@ theorem TBinding.cweaken_copen_id {b : TBinding n m k} :
 
 def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
   CVarSubst
-    ((((Γ.label S),c:={x=0}),c<:*),x:(Label[S.weaken.cweaken.cweaken])^{c=0})
+    ((((Γ.label S),c:={x=0}),c<:.kind .control),x:(Label[S.weaken.cweaken.cweaken])^{c=0})
     (FinFun.open 0)
     (((Γ.label S),c:={x=0}),x:(Label[S.weaken.cweaken])^{c=0}) := by
   constructor
@@ -193,8 +193,15 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
     case inl h =>
       have ⟨he1, he2⟩ := h
       rename_i cb0
-      cases cb0; cases he2
+      cases cb0; repeat cases he2
       constructor
+      subst he1
+      simp [FinFun.open]
+      apply CaptureKind.csub
+      apply Subcapt.cinstr (.there_var .here)
+      simp [CaptureSet.crename, FinFun.weaken]
+      apply CaptureKind.var (.there_var .here)
+
     case inr h =>
       have ⟨b2, c2, hb2, he3, he4⟩ := h
       rename_i cb0

From b513df7e86647f857c4ffd392877e023aa1a15ef Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 12 Nov 2025 12:31:38 +0100
Subject: [PATCH 08/71] Add ContextKind label rule, prove boundary typing

---
 Capless/CaptureBound.lean                  |  2 +-
 Capless/Renaming/Capture/CaptureBound.lean |  4 ++++
 Capless/Renaming/Term/CaptureBound.lean    |  4 ++++
 Capless/Renaming/Type/CaptureBound.lean    |  4 ++++
 Capless/Subst/Capture/CaptureBound.lean    |  3 +++
 Capless/Subst/Term/CaptureBound.lean       |  3 +++
 Capless/Subst/Type/CaptureBound.lean       |  3 +++
 Capless/Typing/Boundary.lean               | 11 ++++++++---
 8 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/Capless/CaptureBound.lean b/Capless/CaptureBound.lean
index 6835baa6..19e4d244 100644
--- a/Capless/CaptureBound.lean
+++ b/Capless/CaptureBound.lean
@@ -6,7 +6,7 @@ namespace Capless
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  -- | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
+  | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
   | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K -- Should cover all the cinst cases, otherwise we can prove
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
diff --git a/Capless/Renaming/Capture/CaptureBound.lean b/Capless/Renaming/Capture/CaptureBound.lean
index d3f3f3d7..e8a64941 100644
--- a/Capless/Renaming/Capture/CaptureBound.lean
+++ b/Capless/Renaming/Capture/CaptureBound.lean
@@ -22,6 +22,10 @@ theorem CaptureKind.crename
     simp [EType.crename, CType.crename] at hb1
     exact hb1
     apply ih ρ
+  case label hl =>
+    apply label
+    have hl1 := ρ.lmap _ _ hl
+    exact hl1
   case cvar hc =>
     apply cvar
     exact ρ.cmap _ _ hc
diff --git a/Capless/Renaming/Term/CaptureBound.lean b/Capless/Renaming/Term/CaptureBound.lean
index 5176d57c..41688c00 100644
--- a/Capless/Renaming/Term/CaptureBound.lean
+++ b/Capless/Renaming/Term/CaptureBound.lean
@@ -21,6 +21,10 @@ theorem CaptureKind.rename
     simp [EType.crename, CType.crename] at hb1
     exact hb1
     apply ih ρ
+  case label hl =>
+    apply label
+    have hl1 := ρ.lmap _ _ hl
+    exact hl1
   case cvar hc =>
     apply cvar
     exact ρ.cmap _ _ hc
diff --git a/Capless/Renaming/Type/CaptureBound.lean b/Capless/Renaming/Type/CaptureBound.lean
index 666a718c..6b7c2ab1 100644
--- a/Capless/Renaming/Type/CaptureBound.lean
+++ b/Capless/Renaming/Type/CaptureBound.lean
@@ -21,6 +21,10 @@ theorem CaptureKind.trename
     simp [EType.trename, CType.trename] at hb1
     exact hb1
     apply ih ρ
+  case label hl =>
+    apply label
+    have hl1 := ρ.lmap _ _ hl
+    exact hl1
   case cvar hc =>
     apply cvar
     exact ρ.cmap _ _ hc
diff --git a/Capless/Subst/Capture/CaptureBound.lean b/Capless/Subst/Capture/CaptureBound.lean
index 1e491feb..912c8811 100644
--- a/Capless/Subst/Capture/CaptureBound.lean
+++ b/Capless/Subst/Capture/CaptureBound.lean
@@ -16,6 +16,9 @@ theorem CaptureKind.csubst
   case var hb hk ih =>
     have hb1 := σ.map _ _ hb
     apply CaptureKind.var hb1 (ih σ)
+  case label hl =>
+    have hl1 := σ.lmap _ _ hl
+    apply label hl1
   case cvar hb =>
     cases σ.cmap_bound _ _ hb
     assumption
diff --git a/Capless/Subst/Term/CaptureBound.lean b/Capless/Subst/Term/CaptureBound.lean
index 40f4c869..2ff4c15c 100644
--- a/Capless/Subst/Term/CaptureBound.lean
+++ b/Capless/Subst/Term/CaptureBound.lean
@@ -18,6 +18,9 @@ theorem CaptureKind.subst
     simp [EType.rename, CType.rename] at hb1
     have h := Typing.inv_subcapt hb1
     apply csub h (ih σ)
+  case label hl =>
+    have hl1 := σ.lmap _ _ hl
+    apply label hl1
   case cvar hb =>
     have hb1 := σ.cmap _ _ hb
     apply cvar hb1
diff --git a/Capless/Subst/Type/CaptureBound.lean b/Capless/Subst/Type/CaptureBound.lean
index e7e0ae95..acd4dddf 100644
--- a/Capless/Subst/Type/CaptureBound.lean
+++ b/Capless/Subst/Type/CaptureBound.lean
@@ -17,6 +17,9 @@ theorem CaptureKind.tsubst
     have hb1 := σ.map _ _ hb
     simp [CType.trename] at hb1
     apply var hb1 (ih σ)
+  case label hl =>
+    have hl1 := σ.lmap _ _ hl
+    apply label hl1
   case cvar hb =>
     have hb1 := σ.cmap _ _ hb
     apply cvar hb1
diff --git a/Capless/Typing/Boundary.lean b/Capless/Typing/Boundary.lean
index 81d2bdce..33bb318b 100644
--- a/Capless/Typing/Boundary.lean
+++ b/Capless/Typing/Boundary.lean
@@ -200,7 +200,8 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       apply CaptureKind.csub
       apply Subcapt.cinstr (.there_var .here)
       simp [CaptureSet.crename, FinFun.weaken]
-      apply CaptureKind.var (.there_var .here)
+      apply CaptureKind.label
+      apply Context.LBound.there_var (.there_cvar .here)
 
     case inr h =>
       have ⟨b2, c2, hb2, he3, he4⟩ := h
@@ -209,7 +210,11 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       cases he4
       rename_i cb0
       cases cb0
-      case star => constructor
+      case kind K =>
+        constructor
+        simp [FinFun.open]
+        apply CaptureKind.cvar
+        apply Context.CBound.there_var hb2
       case upper D0 =>
         constructor
         simp [FinFun.open]
@@ -317,7 +322,7 @@ theorem CaptureSet.open_weaken_ext {C : CaptureSet (n+1) k} :
   simp [CaptureSet.rename_id]
 
 theorem Typed.boundary_body_typing {Γ : Context n m k} {S : SType n m k}
-  (ht : Typed ((Γ,c<:*),x:(Label[S.cweaken])^{c=0}) t E Ct) :
+  (ht : Typed ((Γ,c<:(.kind .control)),x:(Label[S.cweaken])^{c=0}) t E Ct) :
   Typed ((Γ.label S),c:={x=0}) t E Ct := by
   have h := ht.rename VarRename.boundary
   have h := h.crename CVarRename.boundary

From 256ddbab114e00bc621ed7199569116f26f7449d Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 12 Nov 2025 12:37:40 +0100
Subject: [PATCH 09/71] Update preservation

---
 Capless/Soundness/Preservation.lean      | 8 ++++----
 Capless/Weakening/TypedCont/Capture.lean | 4 ++--
 Capless/Weakening/TypedCont/Term.lean    | 4 ++--
 Capless/Weakening/TypedCont/Type.lean    | 2 +-
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/Capless/Soundness/Preservation.lean b/Capless/Soundness/Preservation.lean
index 3865b948..abf2297f 100644
--- a/Capless/Soundness/Preservation.lean
+++ b/Capless/Soundness/Preservation.lean
@@ -159,7 +159,7 @@ theorem preservation
   case push_ex =>
     cases ht
     case mk hs hsc ht hc =>
-      have ⟨T, E0, htt, htu, hsub⟩ := Typed.letex_inv ht
+      have ⟨B, T, E0, htt, htu, hsub⟩ := Typed.letex_inv ht
       constructor
       constructor
       { exact hs }
@@ -193,9 +193,9 @@ theorem preservation
       cases hc
       case conse hu hsc hc0 =>
         have hg := TypedStore.is_tight hs
-        have hx := Typed.canonical_form_pack hg ht
-        rename_i C _ _ _ _ _ _ _
-        have hu1 := hu.cinstantiate_extvar (C := C)
+        have ⟨hb, hx⟩ := Typed.canonical_form_pack hg ht
+        rename_i C _ _ _ _ _ _ _ _
+        have hu1 := hu.cinstantiate_extvar (C := C) hb
         have hu2 := hu1.open hx
         simp [EType.weaken, EType.open, EType.rename_rename] at hu2
         simp [FinFun.open_comp_weaken] at hu2
diff --git a/Capless/Weakening/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean
index 545e8a31..98b6ce6b 100644
--- a/Capless/Weakening/TypedCont/Capture.lean
+++ b/Capless/Weakening/TypedCont/Capture.lean
@@ -30,8 +30,8 @@ judgments. This is essential for soundness in the presence of capture-polymorphi
 namespace Capless
 
 theorem EType.cweaken_ex (T : CType n m (k+1)) :
-  (EType.ex T).cweaken = EType.ex T.cweaken1 := by
-  simp [EType.cweaken, EType.crename, CType.cweaken1]
+  (EType.ex B T).cweaken = EType.ex B.cweaken T.cweaken1 := by
+  simp [EType.cweaken, EType.crename, CType.cweaken1, CBound.cweaken]
 
 -- theorem EType.cweaken_type (T : CType n m k) :
 --   (EType.type T).cweaken = EType.type T.cweaken := by
diff --git a/Capless/Weakening/TypedCont/Term.lean b/Capless/Weakening/TypedCont/Term.lean
index 498b77ed..2336c817 100644
--- a/Capless/Weakening/TypedCont/Term.lean
+++ b/Capless/Weakening/TypedCont/Term.lean
@@ -40,8 +40,8 @@ theorem CaptureSet.weaken1_weaken (C : CaptureSet n k) :
   rw [<- FinFun.comp_weaken]
 
 theorem EType.weaken_ex (T : CType n m (k+1)) :
-  (EType.ex T).weaken = EType.ex T.weaken := by
-  simp [EType.weaken, EType.rename, CType.weaken]
+  (EType.ex B T).weaken = EType.ex B.weaken T.weaken := by
+  simp [EType.weaken, EType.rename, CType.weaken, CBound.weaken]
 
 theorem EType.weaken_cweaken (E : EType n m k) :
   E.cweaken.weaken = E.weaken.cweaken := by
diff --git a/Capless/Weakening/TypedCont/Type.lean b/Capless/Weakening/TypedCont/Type.lean
index 23682dd9..98c57463 100644
--- a/Capless/Weakening/TypedCont/Type.lean
+++ b/Capless/Weakening/TypedCont/Type.lean
@@ -30,7 +30,7 @@ This is crucial for maintaining soundness when type abstractions are introduced.
 namespace Capless
 
 theorem EType.tweaken_ex (T : CType n m (k+1)) :
-  (EType.ex T).tweaken = EType.ex T.tweaken := by
+  (EType.ex B T).tweaken = EType.ex B T.tweaken := by
   simp [EType.tweaken, EType.trename, CType.tweaken]
 
 -- theorem EType.tweaken_type (T : CType n m k) :

From 46b734770c3501abda387b3268e9d1b50d43d63b Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 14 Nov 2025 22:09:57 +0100
Subject: [PATCH 10/71] Broken projections

---
 Capless/CaptureSet.lean   |  61 +++++++--
 Capless/Classifier.lean   | 257 +++++++++++++++++++++++++++++++-------
 Capless/Subcapturing.lean |   3 +
 3 files changed, 263 insertions(+), 58 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 5c521057..16806b87 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -2,6 +2,7 @@ import Mathlib.Data.Finset.Basic
 import Mathlib.Data.Finset.Image
 import Mathlib.Data.Finset.PImage
 import Capless.Basic
+import Capless.Classifier
 import Capless.Tactics
 namespace Capless
 
@@ -11,6 +12,15 @@ namespace Capless
 This file contains the definition of capture sets.
 -/
 
+inductive Singleton : Nat -> Nat -> Type where
+  | singl : Fin n -> Singleton n k
+  | csingl : Fin k -> Singleton n k
+
+/-- Projected captures -/
+inductive Proj : Nat -> Nat -> Type where
+  | proj : Singleton n k -> Kind -> Proj n k
+  | capt : Singleton n k -> Proj n k
+
 /-- Capture sets in System Capless.
 
 The type of capture sets is parameterized by:
@@ -29,15 +39,14 @@ Since the capture sets are indexed with the number of available binders, and eac
 inductive CaptureSet : Nat -> Nat -> Type where
 | empty : CaptureSet n k
 | union : CaptureSet n k -> CaptureSet n k -> CaptureSet n k
-| singleton : Fin n -> CaptureSet n k
-| csingleton : Fin k -> CaptureSet n k
+| singleton : Proj n k -> CaptureSet n k
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
 
-notation:max "{x=" x "}" => CaptureSet.singleton x
-notation:max "{c=" c "}" => CaptureSet.csingleton c
+notation:max "{x=" x "}" => CaptureSet.singleton (Proj.capt (Singleton.singl x))
+notation:max "{c=" c "}" => CaptureSet.singleton (Proj.capt (Singleton.csingl c))
 
 @[simp]
 instance : Union (CaptureSet n k) where
@@ -62,25 +71,55 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 instance : HasSubset (CaptureSet n k) where
   Subset := CaptureSet.Subset
 
+-- @[simp]
+-- def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
+  -- match C with
+  -- | empty => empty
+  -- | union C1 C2 => union (C1.proj K) (C2.proj K)
+  -- | singleton
+
+
 /-!
 ## Renaming operations
 -/
 
+@[simp]
+def Singleton.rename (s: Singleton n k) (f : FinFun n n') : Singleton n' k :=
+  match s with
+  | singl x => singl $ f x
+  | csingl c => csingl c
+
+@[simp]
+def Proj.rename (s: Proj n k) (f : FinFun n n') : Proj n' k :=
+  match s with
+  | proj x k => proj (x.rename f) k
+  | capt x => capt $ x.rename f
+
 @[simp]
 def CaptureSet.rename (C : CaptureSet n k) (f : FinFun n n') : CaptureSet n' k :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.rename f) ∪ (C2.rename f)
-  | singleton x => {x=f x}
-  | csingleton c => {c=c}
+  | singleton x => singleton $ x.rename f
+
+@[simp]
+def Singleton.crename (s: Singleton n k) (f : FinFun k k') : Singleton n k' :=
+  match s with
+  | singl x => singl x
+  | csingl c => csingl $ f c
+
+@[simp]
+def Proj.crename (s: Proj n k) (f : FinFun k k') : Proj n k' :=
+  match s with
+  | proj x k => proj (x.crename f) k
+  | capt x => capt $ x.crename f
 
 @[simp]
 def CaptureSet.crename (C : CaptureSet n k) (f : FinFun k k') : CaptureSet n k' :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.crename f) ∪ (C2.crename f)
-  | singleton x => {x=x}
-  | csingleton c => {c=f c}
+  | singleton x => singleton $ x.crename f
 
 def CaptureSet.weaken (C : CaptureSet n k) : CaptureSet (n+1) k :=
   C.rename FinFun.weaken
@@ -176,12 +215,12 @@ theorem CaptureSet.subset_refl {C : CaptureSet n k} :
   C ⊆ C := by constructor
 
 theorem CaptureSet.cweaken_csingleton {c : Fin k} :
-  (CaptureSet.csingleton c : CaptureSet n k).cweaken = CaptureSet.csingleton (c.succ) := by
-  simp [csingleton, cweaken, crename, FinFun.weaken]
+  ({c=c} : CaptureSet n k).cweaken = {c=c.succ} := by
+  simp [singleton, cweaken, crename, FinFun.weaken]
 
 theorem CaptureSet.weaken_csingleton :
   ({c=c} : CaptureSet n k).weaken = {c=c} := by
-  simp [csingleton, weaken]
+  simp [singleton, weaken]
 
 theorem CaptureSet.rename_id {C : CaptureSet n k} :
   C.rename FinFun.id = C := by
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index bb8ee4be..e89fafaa 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -3,15 +3,39 @@ namespace Capless
 inductive Classifier : Type where
   | top : Classifier
   | child : Nat -> Classifier -> Classifier
+deriving DecidableEq
 
-inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
-  | id: Subclass a a
-  | sub_l : Subclass a b -> Subclass (.child _ a) b
+instance : LawfulBEq Classifier where
+  rfl := by
+    intro a
+    induction a <;> simp [BEq.beq]
+  eq_of_beq := by
+    intro a b h
+    induction a <;> induction b <;> simp_all [BEq.beq]
 
-inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
-  | children : (Ne n m) -> Disjoint (child n a) (child m a)
-  | sub_l : Disjoint a b -> Disjoint (child _ a) b
-  | sub_r : Disjoint a b -> Disjoint a (child _ b)
+@[simp]
+def Classifier.depth (c: Classifier) : Nat :=
+  match c with
+  | top => 0
+  | child _ p => 1 + p.depth
+
+@[simp]
+def Classifier.subclass (c1: Classifier) (c2: Classifier) : Bool :=
+  if c1 == c2 then true
+  else
+    match c1 with
+    | .top => false
+    | .child _ p => p.subclass c2
+
+@[simp]
+def Classifier.disjoint (c1: Classifier) (c2: Classifier) : Bool :=
+  match c1 with
+    | top => false
+    | child n p => match c2 with
+      | top => false
+      | child m q =>
+        if p == q then n != m
+        else (child n p).disjoint q || p.disjoint (child m q)
 
 inductive Kind : Type where
   | classifier : Classifier -> Kind
@@ -19,15 +43,15 @@ inductive Kind : Type where
   | excl : Kind -> Classifier -> Kind
 
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
-  | base : Classifier.Disjoint a b -> Disjoint (classifier a) (classifier b)
+  | base : a.disjoint b -> Disjoint (classifier a) (classifier b)
   | union : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
-  | excl_this : Classifier.Subclass a b -> Disjoint (excl c b) (classifier a)
+  | excl_this : a.subclass b -> Disjoint (excl c b) (classifier a)
   | excl_union : Disjoint a (excl b1 k) -> Disjoint a (excl b2 k) -> Disjoint a (excl (union b1 b2) k)
   | excl : Disjoint a b -> Disjoint a (excl b k)
   | symm : Disjoint a b -> Disjoint b a
 
 inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | base : Classifier.Subclass a b -> Subkind (classifier a) (classifier b)
+  | base : a.subclass b -> Subkind (classifier a) (classifier b)
   | union_l : Subkind a1 b -> Subkind a2 b -> Subkind (union a1 a2) b
   | union_r1 : Subkind a b1 -> Subkind a (union b1 b2)
   | union_r2 : Subkind a b2 -> Subkind a (union b1 b2)
@@ -35,60 +59,193 @@ inductive Kind.Subkind : Kind -> Kind -> Prop where
   | excl_r : Subkind a b -> Kind.Disjoint a (classifier k) -> Subkind a (excl b k)
   | trans : Subkind a b -> Subkind b c -> Subkind a c
 
-theorem Classifier.subclass_top : Subclass k .top := by
+theorem Classifier.subclass_top : Classifier.subclass k .top := by
+  induction k
+  case top => trivial
+  case child n p => simp_all
+
+theorem Classifier.subclass_of_top : Classifier.top.subclass k -> k = .top := by
+  intro h
   induction k
-  case top => exact .id
-  case child n c ih => exact .sub_l ih
+  case top => trivial
+  case child n p ih =>
+    simp at h
+
+theorem Classifier.disjoint_symm : Classifier.disjoint a b -> b.disjoint a := by
+  intro h
+  induction a generalizing b
+  case top =>
+    simp_all
+  case child n p ih =>
+    induction b <;> simp at h
+    rename_i m q ihb
+    simp
+    split <;> subst_vars
+    simp at h
+    false_or_by_contra
+    apply h.elim (Eq.symm _)
+    assumption
+    split at h
+    rename_i h0 h1
+    apply h0.elim (Eq.symm h1)
+    cases h
+    { right; apply ihb; assumption }
+    { left; apply ih; assumption }
 
-theorem Classifier.subclass_of_top : Subclass .top k -> k = .top := by
+theorem Classifier.neq_child : q ≠ (child n q) := by
   intro h
-  cases h <;> simp
+  induction q
+  case top => cases h
+  case child m p ih =>
+    injections
+    apply ih
+    subst_vars
+    assumption
 
-theorem Classifier.disjoint_symm : Disjoint a b -> Disjoint b a := by
+theorem Classifier.disjoint_top : Classifier.disjoint a .top -> False := by
   intro h
-  induction h
-  case children neq => exact .children (Ne.symm neq)
-  case sub_l => constructor; assumption
-  case sub_r => constructor; assumption
+  induction a
+  case top => simp at h
+  case child n p ih => simp at h
 
-theorem Classifier.disjoint_top : Disjoint a .top -> False := by
+theorem Classifier.subclass_down : subclass a b -> (a = b) ∨ (∃ n, subclass a (.child n b)) := by
   intro h
-  cases h
-  . rename_i x a h; exact disjoint_top h
+  induction a generalizing b
+  case top => left; symm; apply subclass_of_top; assumption
+  case child n p ih =>
+    simp at h
+    cases h
+    case inl h0 => subst_vars; left; trivial
+    case inr h0 =>
+      right
+      cases ih h0
+      { subst_vars; exists n; simp; }
+      { rename_i h1; have ⟨n, h1⟩ := h1; exists n; simp; right; assumption }
 
-theorem Classifier.subclass_down : Subclass a b -> (a = b) ∨ (∃ n, Subclass a (.child n b)) := by
+theorem Classifier.subclass_inv : subclass a b -> (a = b) ∨ (∃ n p, a = child n p ∧ p.subclass b) := by
   intro h
   induction a
-  case top => cases h; simp
+  case top => left; symm; apply subclass_of_top h
+  case child n p ih =>
+    simp at h
+    cases h
+    case inl h => left; assumption
+    case inr h =>
+      right
+      apply Exists.intro n
+      apply Exists.intro p
+      apply And.intro
+      rfl
+      cases ih h
+      subst_vars
+      assumption
+      rename_i h
+      have ⟨n0, p0, hp, h0⟩ := h
+      subst_vars
+      assumption
+
+
+theorem Classifier.subclass_depth : subclass a b -> a.depth >= b.depth := by
+  induction a generalizing b
+  case top => simp; intro; subst_vars; simp
+  case child n p ih =>
+    intro h
+    simp at h
+    cases h
+    case inl h => subst_vars; simp
+    case inr h => simp; have h0 := ih h; omega
+
+theorem Classifier.subclass_child : subclass a (child n a) -> False := by
+  intro h
+  have h0 := subclass_depth h
+  simp at h0
+  omega
+
+theorem Classifier.subclass_up : subclass a (child m b) -> subclass a b := by
+  intro h
+  induction a generalizing b
+  case top => have h0 := subclass_depth h; simp at h
   case child n p ih =>
+    simp at h
     cases h
-    case id => simp
-    case sub_l l =>
-      cases ih l
-      . rename_i h1
-        right; exists n; rewrite [h1]; constructor
-      . rename_i h1
-        cases h1
-        rename_i w h1
-        right; exists w
-        apply Subclass.sub_l h1
-
-theorem Classifier.disjoint_up : Disjoint (child n a) b -> Disjoint a b ∨ Subclass b a := by
+    case inl h =>
+      have ⟨hn, h⟩ := h
+      subst_vars
+      simp
+      right
+      unfold subclass
+      simp
+    case inr h =>
+      have h0 := ih h
+      simp
+      right
+      assumption
+
+theorem Classifier.disjoint_antisymm : disjoint a a = false := by
+  induction a <;> simp
+
+theorem Classifier.disjoint_subclass : subclass a b -> disjoint a b = false := by
+  intro h
+  induction a generalizing b
+  case top => simp_all; apply disjoint_antisymm
+  case child n p iha =>
+    induction b
+    case top => simp
+    case child m q ihb =>
+      simp
+      split
+      subst_vars
+      simp at h
+      cases h; assumption; rename_i h; have h0 := subclass_child (a := q) (n := m); contradiction
+      apply And.intro
+      apply (ihb (subclass_up h))
+      cases subclass_inv h
+      case inl h => injections; contradiction
+      case inr h =>
+        have ⟨n0, p0, hp, hh⟩ := h
+        injections
+        subst_vars
+        apply iha
+        assumption
+
+theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
   intro h
-  cases h
-  case children ne =>
-    right; constructor; constructor
-  case sub_l => left; assumption
-  case sub_r r =>
-    cases disjoint_up r
-    . left; apply Disjoint.sub_r; assumption
-    . right; apply Subclass.sub_l; assumption
+  induction a generalizing b m
+  case top => simp at h
+  case child n p ih =>
+    induction b generalizing m
+    case top => exfalso; apply disjoint_top h
+    case child k q ihb =>
+      simp at h
+      split at h
+      subst_vars
+      simp
+      split
+      exfalso; apply neq_child; assumption
+      left; assumption
+      cases h
+      case inl h =>
+        have h0 := ihb (m := k) h
+        simp
+        split
+        subst_vars
+        { have h1 : (child n (child k q)).subclass (child k q)  := by simp
+          have h2 := disjoint_subclass h1
+          rw [Bool.eq_false_iff] at h2
+          contradiction }
+        { left; left; assumption }
+      case inr h =>
+        simp
+        split
+        { subst_vars; simp at h }
+        { left; right; assumption }
+
 
 theorem Kind.subkind_refl : Kind.Subkind k k := by
   cases k
   case classifier a =>
     constructor
-    constructor
+    unfold Classifier.subclass; simp
   case union a b =>
     apply Subkind.union_l
     apply Subkind.union_r1
@@ -100,8 +257,14 @@ theorem Kind.subkind_refl : Kind.Subkind k k := by
     apply Subkind.excl_l
     apply subkind_refl
     apply Disjoint.excl_this
-    constructor
+    unfold Classifier.subclass; simp
 
 /- Classifiers fixed for boundary. -/
 def Classifier.control := Classifier.child 0 Classifier.top
 def Kind.control := Kind.classifier .control
+
+/- Merging kinds -/
+@[simp]
+def Kind.merge (K1: Kind) (K2: Kind) : Kind := by
+  match K1 with
+  |
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 204cf811..ef1cbdb8 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -34,6 +34,9 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
+-- | proj :
+--   Subcapt Γ C1 C2 ->
+--   Subcapt Γ
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 

From b2208dab4fbbcfc2397a8a7528259e80e55a5f0b Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 16:19:29 +0100
Subject: [PATCH 11/71] Make projections deep inside capture sets

---
 Capless/CaptureSet.lean | 71 ++++++++++++++++++++++++-----------------
 1 file changed, 41 insertions(+), 30 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 16806b87..b38a3d73 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -15,11 +15,7 @@ This file contains the definition of capture sets.
 inductive Singleton : Nat -> Nat -> Type where
   | singl : Fin n -> Singleton n k
   | csingl : Fin k -> Singleton n k
-
-/-- Projected captures -/
-inductive Proj : Nat -> Nat -> Type where
-  | proj : Singleton n k -> Kind -> Proj n k
-  | capt : Singleton n k -> Proj n k
+  | proj : Singleton n k -> Kind -> Singleton n k
 
 /-- Capture sets in System Capless.
 
@@ -39,14 +35,15 @@ Since the capture sets are indexed with the number of available binders, and eac
 inductive CaptureSet : Nat -> Nat -> Type where
 | empty : CaptureSet n k
 | union : CaptureSet n k -> CaptureSet n k -> CaptureSet n k
-| singleton : Proj n k -> CaptureSet n k
+| singleton : Singleton n k -> CaptureSet n k
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
 
-notation:max "{x=" x "}" => CaptureSet.singleton (Proj.capt (Singleton.singl x))
-notation:max "{c=" c "}" => CaptureSet.singleton (Proj.capt (Singleton.csingl c))
+notation:max "{x=" x "}" => CaptureSet.singleton (Singleton.singl x)
+notation:max "{c=" c "}" => CaptureSet.singleton (Singleton.csingl c)
+notation:max "{s=" s "}" => CaptureSet.singleton s
 
 @[simp]
 instance : Union (CaptureSet n k) where
@@ -71,13 +68,16 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 instance : HasSubset (CaptureSet n k) where
   Subset := CaptureSet.Subset
 
--- @[simp]
--- def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
-  -- match C with
-  -- | empty => empty
-  -- | union C1 C2 => union (C1.proj K) (C2.proj K)
-  -- | singleton
+/-!
+## Projections
+-/
 
+@[simp]
+def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
+  match C with
+  | empty => empty
+  | union C1 C2 => union (C1.proj K) (C2.proj K)
+  | singleton s => singleton $ s.proj K
 
 /-!
 ## Renaming operations
@@ -88,12 +88,7 @@ def Singleton.rename (s: Singleton n k) (f : FinFun n n') : Singleton n' k :=
   match s with
   | singl x => singl $ f x
   | csingl c => csingl c
-
-@[simp]
-def Proj.rename (s: Proj n k) (f : FinFun n n') : Proj n' k :=
-  match s with
-  | proj x k => proj (x.rename f) k
-  | capt x => capt $ x.rename f
+  | proj s k => (s.rename f).proj k
 
 @[simp]
 def CaptureSet.rename (C : CaptureSet n k) (f : FinFun n n') : CaptureSet n' k :=
@@ -107,12 +102,8 @@ def Singleton.crename (s: Singleton n k) (f : FinFun k k') : Singleton n k' :=
   match s with
   | singl x => singl x
   | csingl c => csingl $ f c
+  | proj s k => (s.crename f).proj k
 
-@[simp]
-def Proj.crename (s: Proj n k) (f : FinFun k k') : Proj n k' :=
-  match s with
-  | proj x k => proj (x.crename f) k
-  | capt x => capt $ x.crename f
 
 @[simp]
 def CaptureSet.crename (C : CaptureSet n k) (f : FinFun k k') : CaptureSet n k' :=
@@ -175,9 +166,13 @@ theorem CaptureSet.rename_empty :
 theorem CaptureSet.crename_empty :
   ({} : CaptureSet n k).crename f = {} := by simp
 
+theorem Singleton.crename_rename_comm {s : Singleton n k} {f: FinFun n n'} {g: FinFun k k'} :
+  (s.rename f).crename g = (s.crename g).rename f := by
+  induction s <;> aesop
+
 theorem CaptureSet.crename_rename_comm {C : CaptureSet n k} {f : FinFun n n'} {g : FinFun k k'} :
   (C.rename f).crename g = (C.crename g).rename f := by
-  induction C <;> aesop
+  induction C <;> aesop (add safe apply Singleton.crename_rename_comm)
 
 theorem CaptureSet.copen_rename_comm {C : CaptureSet n (k+1)} {x : Fin k} {f : FinFun n n'} :
   (C.copen x).rename f = (C.rename f).copen x := by
@@ -187,9 +182,13 @@ theorem CaptureSet.cweaken_rename_comm {C : CaptureSet n k} {f : FinFun n n'} :
   (C.cweaken).rename f = (C.rename f).cweaken := by
   simp [cweaken, crename_rename_comm]
 
+theorem Singleton.rename_rename {s : Singleton n k} :
+  (s.rename f).rename g = s.rename (g ∘ f) := by
+  induction s <;> aesop
+
 theorem CaptureSet.rename_rename {C : CaptureSet n k} :
   (C.rename f).rename g = C.rename (g ∘ f) := by
-  induction C <;> aesop
+  induction C <;> aesop (add safe 1 Singleton.rename_rename)
 
 theorem CaptureSet.weaken_rename {C : CaptureSet n k} :
   (C.rename f).weaken = C.weaken.rename f.ext := by
@@ -199,9 +198,13 @@ theorem CaptureSet.weaken_crename {C : CaptureSet n k} :
   (C.crename f).weaken = C.weaken.crename f := by
   simp [weaken, crename_rename_comm]
 
+theorem Singleton.crename_crename {s : Singleton n k} :
+  (s.crename f).crename g = s.crename (g ∘ f) := by
+  induction s <;> aesop
+
 theorem CaptureSet.crename_crename {C : CaptureSet n k} :
   (C.crename f).crename g = C.crename (g ∘ f) := by
-  induction C <;> aesop
+  induction C <;> aesop (add safe 1 Singleton.crename_crename)
 
 theorem CaptureSet.crename_copen {C : CaptureSet n (k+1)} :
   (C.copen c).crename f = (C.crename f.ext).copen (f c) :=
@@ -222,13 +225,21 @@ theorem CaptureSet.weaken_csingleton :
   ({c=c} : CaptureSet n k).weaken = {c=c} := by
   simp [singleton, weaken]
 
+theorem Singleton.rename_id {s : Singleton n k} :
+  s.rename FinFun.id = s := by
+  induction s <;> aesop
+
 theorem CaptureSet.rename_id {C : CaptureSet n k} :
   C.rename FinFun.id = C := by
-  induction C <;> aesop
+  induction C <;> aesop (add safe 1 Singleton.rename_id)
+
+theorem Singleton.crename_id {s : Singleton n k} :
+  s.crename FinFun.id = s := by
+  induction s <;> aesop
 
 theorem CaptureSet.crename_id {C : CaptureSet n k} :
   C.crename FinFun.id = C := by
-  induction C <;> aesop
+  induction C <;> aesop (add safe 1 Singleton.crename_id)
 
 theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   (h : C1 ⊆ C2) :

From f04e47628ab3973761d3609c42e156d434205c8c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 16:35:39 +0100
Subject: [PATCH 12/71] Add projection rules

---
 Capless/CaptureBound.lean       | 58 ---------------------------------
 Capless/Classifier.lean         |  6 ----
 Capless/Subcapturing.lean       | 23 +++++++++++--
 Capless/Subcapturing/Basic.lean | 10 ++++++
 4 files changed, 30 insertions(+), 67 deletions(-)

diff --git a/Capless/CaptureBound.lean b/Capless/CaptureBound.lean
index 19e4d244..e5973e2b 100644
--- a/Capless/CaptureBound.lean
+++ b/Capless/CaptureBound.lean
@@ -4,64 +4,6 @@ import Capless.Subcapturing
 
 namespace Capless
 
-inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
-  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
-  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
-  | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K -- Should cover all the cinst cases, otherwise we can prove
-  | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
-  | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
-  | empty : CaptureKind Γ .empty K
-
 inductive CaptureBound : Context n m k -> CaptureSet n k -> CBound n k -> Prop where
   | subcapt: Subcapt Γ C1 C2 -> CaptureBound Γ C1 (CBound.upper C2)
   | subkind : CaptureKind Γ C K -> CaptureBound Γ C (CBound.kind K)
-
--- theorem CaptureKind.union_elim (hk: CaptureKind Γ (C1 ∪ C2) K) : (CaptureKind Γ C1 K) ∧ (CaptureKind Γ C2 K) := by
---   generalize h : C1 ∪ C2 = C at hk
---   induction hk <;> cases h
---   case sub hs hk ih =>
---     have ⟨h1, h2⟩ := ih (Eq.refl (C1 ∪ C2))
---     apply sub hs at h1
---     apply sub hs at h2
---     apply And.intro <;> assumption
---   case union h1 h2 ih1 ih2 => apply And.intro <;> assumption
-
--- theorem CaptureKind.subset (hk: CaptureKind Γ C2 K) (hsub: C1 ⊆ C2) : CaptureKind Γ C1 K := by
---   induction hsub
---   case empty => apply empty
---   case rfl => assumption
---   case union_l h1 h2 ih1 ih2 =>
---     apply union
---     apply ih1 hk
---     apply ih2 hk
---   case union_rl h ih =>
---     apply ih
---     cases hk
---     case union h1 h2 => assumption
---     case sub hs hk =>
---       have ⟨h1, _⟩ := hs.union_elim
---       apply sub hk h1
---   case union_rr h ih =>
---     apply ih
---     cases hk
---     case union h1 h2 => assumption
---     case sub hs hk =>
---       have ⟨_, h2⟩ := hs.union_elim
---       apply sub hk h2
-
--- theorem CaptureKind.subcapt  (hk: CaptureKind Γ C2 K) (hs: Subcapt Γ C1 C2): CaptureKind Γ C1 K := by
---   induction hs
---   case trans h1 h2 ih1 ih2 =>
---     apply ih1
---     apply ih2
---     apply hk
---   case subset hsub => apply hk.subset hsub
---   case union h1 h2 ih1 ih2 =>
---     apply union
---     apply ih1 hk
---     apply ih2 hk
---   case var hb =>
---     apply var hb hk
---   case cinstl hb =>
---     apply cinst
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index e89fafaa..c53ef640 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -262,9 +262,3 @@ theorem Kind.subkind_refl : Kind.Subkind k k := by
 /- Classifiers fixed for boundary. -/
 def Classifier.control := Classifier.child 0 Classifier.top
 def Kind.control := Kind.classifier .control
-
-/- Merging kinds -/
-@[simp]
-def Kind.merge (K1: Kind) (K2: Kind) : Kind := by
-  match K1 with
-  |
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index ef1cbdb8..5339c062 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -10,6 +10,7 @@ import Capless.CaptureSet
 
 namespace Capless
 
+mutual
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
 | trans :
   Subcapt Γ C1 C2 ->
@@ -34,10 +35,26 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
--- | proj :
---   Subcapt Γ C1 C2 ->
---   Subcapt Γ
+| proj :
+  Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
+| proj_sub {C : CaptureSet n k} {K1 K2 : Kind}:
+  K1.Subkind K2 -> Subcapt Γ (C.proj K1) (C.proj K2)
+| proj_l : Subcapt Γ (C.proj K) C
+| proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
+| proj_disj : Kind.Disjoint K1 K2 -> CaptureKind Γ C K1 -> Subcapt Γ (C.proj K2) .empty
+
+inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
+  -- | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
+  | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
+  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
+  | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K
+  | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
+  | empty : CaptureKind Γ .empty K
+  | proj_kind {C : CaptureSet n k} : CaptureKind Γ (C.proj K) K
+  | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
+end
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
+notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 
 end Capless
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 0960cc00..2e88de4a 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -23,4 +23,14 @@ theorem Subcapt.join
   { apply Subcapt.trans; exact h2
     apply Subcapt.subset; apply CaptureSet.Subset.union_rr; apply CaptureSet.subset_refl }
 
+theorem CaptureKind.var (hb : Context.Bound Γ x (S^C)) (hk : CaptureKind Γ C K) : CaptureKind Γ {x=x} K := by
+  apply csub
+  apply Subcapt.var hb
+  assumption
+
+theorem CaptureKind.proj_disj (hd : Kind.Disjoint K1 K2) (hk : CaptureKind Γ C K1) : CaptureKind Γ (C.proj K2) K3 := by
+  apply csub
+  apply Subcapt.proj_disj hd hk
+  apply empty
+
 end Capless

From dc8c425710d65b83a45201eb325c83d2d9761733 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 18:21:41 +0100
Subject: [PATCH 13/71] Update lean to 4.25.1

---
 lake-manifest.json | 54 +++++++++++++++++++++++-----------------------
 lakefile.lean      |  6 +++---
 lean-toolchain     |  2 +-
 3 files changed, 31 insertions(+), 31 deletions(-)

diff --git a/lake-manifest.json b/lake-manifest.json
index 1dcc6aaa..ba58f1cb 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,57 +5,47 @@
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "e25fe66cf13e902ba550533ef681cc35a9f18dc2",
+   "rev": "3611075024b3529e5798e53c733671039f06f0bd",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.21.0-rc3",
+   "inputRev": "v4.25.1",
    "inherited": false,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover/doc-gen4",
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "baed49c0d4851bafe4d3a3bffb2252a603ea990e",
+   "rev": "0f3b6c1d1b611d40c738f49ebf1d9ab9ee820e15",
    "name": "«doc-gen4»",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.21.0-rc3",
+   "inputRev": "v4.25.1",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/mathlib4.git",
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "87e776fcdaac566a75f44d485042443d57959bcb",
+   "rev": "0df2e3c2047ada0d7a2e33dbc6ba2788a44a6062",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": null,
+   "inputRev": "v4.25.1",
    "inherited": false,
    "configFile": "lakefile.lean"},
-  {"url": "https://github.com/leanprover-community/batteries",
-   "type": "git",
-   "subDir": null,
-   "scope": "leanprover-community",
-   "rev": "08681ddeb7536a50dea8026c6693cb9b07f01717",
-   "name": "batteries",
-   "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.21.0-rc3",
-   "inherited": true,
-   "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover/lean4-cli",
    "type": "git",
    "subDir": null,
    "scope": "leanprover",
-   "rev": "a0abd472348dd725adbb26732e79b26e7e220913",
+   "rev": "cd188c6ecfbf6c00cf639e4d4fb18bf773ce8c2c",
    "name": "Cli",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "main",
+   "inputRev": "v4.25.1",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/fgdorais/lean4-unicode-basic",
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "9f94839235c03d3e04aaed60d277a287f9c84873",
+   "rev": "c120f43ef14fb577096e39ebed0cb25af2b5682d",
    "name": "UnicodeBasic",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -65,7 +55,7 @@
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "dbfe2b7630c5f7c5c1cf71e7747ffc0a30337f69",
+   "rev": "29a4b34f8caa7c95934ab4494d8866fde1850c0b",
    "name": "BibtexQuery",
    "manifestFile": "lake-manifest.json",
    "inputRev": "master",
@@ -75,7 +65,7 @@
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "8ba0ef10d178ab95a5d6fe3cfbd586c6ecef2717",
+   "rev": "38ac5945d744903ffcc473ce1030223991b11cf6",
    "name": "MD4Lean",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -85,7 +75,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "1603151ac0db4e822908e18094f16acc250acaff",
+   "rev": "0203092c2e5e26edf967000f0e177cf31c72e17a",
    "name": "plausible",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -95,7 +85,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "6c62474116f525d2814f0157bb468bf3a4f9f120",
+   "rev": "2ed4ba69b6127de8f5c2af83cccacd3c988b06bf",
    "name": "LeanSearchClient",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -105,17 +95,17 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "6980f6ca164de593cb77cd03d8eac549cc444156",
+   "rev": "135329b50b116dcc2c021c318c365e82a048856f",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v0.0.62",
+   "inputRev": "v0.0.80",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/aesop",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "1b1abe64060b3e3250218646023e47950d8cd396",
+   "rev": "a2e4d9e9aebdbdce1ce6b6f0a19dd49e0120c990",
    "name": "aesop",
    "manifestFile": "lake-manifest.json",
    "inputRev": "master",
@@ -125,11 +115,21 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "d6afe6744246a799a3564dc84a878dab0c4a56d8",
+   "rev": "9bff22d64abde45944c7b1f55bce6c89dd8307e6",
    "name": "Qq",
    "manifestFile": "lake-manifest.json",
    "inputRev": "master",
    "inherited": true,
+   "configFile": "lakefile.toml"},
+  {"url": "https://github.com/leanprover-community/batteries",
+   "type": "git",
+   "subDir": null,
+   "scope": "leanprover-community",
+   "rev": "ffad3f5b7ebe1ac3e09779ec8a863a5138c1246c",
+   "name": "batteries",
+   "manifestFile": "lake-manifest.json",
+   "inputRev": "main",
+   "inherited": true,
    "configFile": "lakefile.toml"}],
  "name": "capless",
  "lakeDir": ".lake"}
diff --git a/lakefile.lean b/lakefile.lean
index 3e12716f..a7a94fd8 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -11,13 +11,13 @@ package «capless» where
   -- add any additional package configuration options here
 
 require mathlib from git
-  "https://github.com/leanprover-community/mathlib4.git"
+  "https://github.com/leanprover-community/mathlib4.git" @ "v4.25.1"
 
 require «doc-gen4» from git
-  "https://github.com/leanprover/doc-gen4" @ "v4.21.0-rc3"
+  "https://github.com/leanprover/doc-gen4" @ "v4.25.1"
 
 require «importGraph» from git -- requires graphviz
-  "https://github.com/leanprover-community/import-graph" @ "v4.21.0-rc3"
+  "https://github.com/leanprover-community/import-graph" @ "v4.25.1"
 
 @[default_target]
 lean_lib «Capless» where
diff --git a/lean-toolchain b/lean-toolchain
index 765d8d7f..96c38be8 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.21.0-rc3
\ No newline at end of file
+leanprover/lean4:v4.25.1
\ No newline at end of file

From ed452b4cd74d95cd5f091cc81ff609d3f947be0f Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 18:42:21 +0100
Subject: [PATCH 14/71] Renaming fixed

---
 Capless/CaptureSet.lean                    | 28 ++++---
 Capless/Renaming/Capture/CaptureBound.lean | 31 +------
 Capless/Renaming/Capture/Subcapturing.lean | 95 +++++++++++++++-------
 Capless/Renaming/Term/CaptureBound.lean    | 29 -------
 Capless/Renaming/Term/Subcapturing.lean    | 77 ++++++++++--------
 Capless/Renaming/Type/CaptureBound.lean    | 30 -------
 Capless/Renaming/Type/Subcapturing.lean    | 56 +++++++------
 Capless/Subcapturing.lean                  |  3 +
 8 files changed, 162 insertions(+), 187 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index b38a3d73..28f5b60b 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -68,17 +68,6 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 instance : HasSubset (CaptureSet n k) where
   Subset := CaptureSet.Subset
 
-/-!
-## Projections
--/
-
-@[simp]
-def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
-  match C with
-  | empty => empty
-  | union C1 C2 => union (C1.proj K) (C2.proj K)
-  | singleton s => singleton $ s.proj K
-
 /-!
 ## Renaming operations
 -/
@@ -261,4 +250,21 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
   induction C <;> aesop
 
+/-!
+## Projections
+-/
+
+@[simp]
+def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
+  match C with
+  | empty => empty
+  | union C1 C2 => union (C1.proj K) (C2.proj K)
+  | singleton s => singleton $ s.proj K
+
+theorem CaptureSet.proj_crename_comm {C: CaptureSet n k} : (C.crename f).proj K = (C.proj K).crename f := by
+  induction C <;> aesop
+
+theorem CaptureSet.proj_rename_comm {C: CaptureSet n k} : (C.rename f).proj K = (C.proj K).rename f := by
+  induction C <;> aesop
+
 end Capless
diff --git a/Capless/Renaming/Capture/CaptureBound.lean b/Capless/Renaming/Capture/CaptureBound.lean
index e8a64941..40c88cab 100644
--- a/Capless/Renaming/Capture/CaptureBound.lean
+++ b/Capless/Renaming/Capture/CaptureBound.lean
@@ -10,36 +10,6 @@ remain valid when capture variables are renamed consistently between contexts.
 -/
 namespace Capless
 
-theorem CaptureKind.crename
-  (h : CaptureKind Γ C K)
-  (ρ : CVarMap Γ f Δ) :
-  CaptureKind Δ (C.crename f) K := by
-  induction h
-  case var hb hk ih =>
-    simp [CaptureSet.crename_singleton]
-    apply var
-    have hb1 := ρ.map _ _ hb
-    simp [EType.crename, CType.crename] at hb1
-    exact hb1
-    apply ih ρ
-  case label hl =>
-    apply label
-    have hl1 := ρ.lmap _ _ hl
-    exact hl1
-  case cvar hc =>
-    apply cvar
-    exact ρ.cmap _ _ hc
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih ρ
-  case csub hs hk ih =>
-    have hs1 := hs.crename ρ
-    apply csub hs1
-    apply ih ρ
-  case union hc1 hc2 ih1 ih2 =>
-    apply union <;> aesop
-  case empty => apply empty
-
 theorem CaptureBound.crename
   (h : CaptureBound Γ C B)
   (ρ : CVarMap Γ f Δ) :
@@ -52,4 +22,5 @@ theorem CaptureBound.crename
     apply subkind
     apply CaptureKind.crename hk ρ
 
+
 end Capless
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index 25dd2ecc..73c5634a 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -17,41 +17,78 @@ theorem CaptureSet.Subset.crename {C1 C2 : CaptureSet n k}
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
 
+mutual
+
+theorem CaptureKind.crename
+  (h : CaptureKind Γ C K)
+  (ρ : CVarMap Γ f Δ) :
+  CaptureKind Δ (C.crename f) K :=
+  match h with
+  | .label hl =>
+    have hl1 := ρ.lmap _ _ hl
+    CaptureKind.label hl1
+  | .cvar hc =>
+    CaptureKind.cvar (ρ.cmap _ _ hc)
+  | .sub hs hk => CaptureKind.sub hs (hk.crename ρ)
+  | .csub hs hk => by
+    have hk1 := hk.crename ρ
+    have hs1 := hs.crename ρ
+    apply CaptureKind.csub hs1
+    apply hk1
+  | .empty => CaptureKind.empty
+  | .proj_kind => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply CaptureKind.proj_kind
+  | .proj hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply CaptureKind.proj
+    apply hk.crename ρ
+
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
   (ρ : CVarMap Γ f Δ) :
-  Subcapt Δ (C1.crename f) (C2.crename f) := by
-  induction h
-  case trans ih1 ih2 => apply trans <;> aesop
-  case subset hsub =>
-    apply subset
-    apply CaptureSet.Subset.crename; trivial
-  case union ih1 ih2 =>
-    simp [CaptureSet.crename_union]
-    apply union <;> aesop
-  case var hb =>
-    simp [CaptureSet.crename_singleton]
-    apply var
+  Subcapt Δ (C1.crename f) (C2.crename f) :=
+  match h with
+  | .trans a b => by
+    apply Subcapt.trans (a.crename ρ) (b.crename ρ)
+  | .subset hsub => by
+    apply Subcapt.subset
+    apply CaptureSet.crename_monotone hsub
+  | .union a b => by
+    simp
+    apply Subcapt.union (a.crename ρ) (b.crename ρ)
+  | .var hb => by
     have hb1 := ρ.map _ _ hb
-    simp [EType.crename, CType.crename] at hb1
-    assumption
-  case cinstl hb =>
-    simp [CaptureSet.crename_csingleton]
+    simp [CType.crename] at hb1
+    apply Subcapt.var hb1
+  | .cinstl hb => by
     have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cinstl
-    assumption
-  case cinstr hb =>
-    simp [CaptureSet.crename_csingleton]
+    apply Subcapt.cinstl hb1
+  | .cinstr hb => by
     have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cinstr
-    assumption
-  case cbound hb =>
-    simp [CaptureSet.crename_csingleton]
+    apply Subcapt.cinstr hb1
+  | .cbound hb => by
     have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cbound
-    assumption
+    apply Subcapt.cbound hb1
+  | .proj hs => by
+    repeat rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj
+    apply hs.crename ρ
+  | .proj_sub hs => by
+    repeat rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_sub hs
+  | .proj_l => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_l
+  | .proj_r hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_r
+    apply hk.crename ρ
+  | .proj_disj hd hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_disj hd
+    apply hk.crename ρ
+
+end
 
 end Capless
diff --git a/Capless/Renaming/Term/CaptureBound.lean b/Capless/Renaming/Term/CaptureBound.lean
index 41688c00..4f5af7e7 100644
--- a/Capless/Renaming/Term/CaptureBound.lean
+++ b/Capless/Renaming/Term/CaptureBound.lean
@@ -10,35 +10,6 @@ remain valid when variables are renamed consistently between contexts.
 -/
 namespace Capless
 
-theorem CaptureKind.rename
-  (h : CaptureKind Γ C K)
-  (ρ : VarMap Γ f Δ) :
-  CaptureKind Δ (C.rename f) K := by
-  induction h
-  case var hb hk ih =>
-    apply var
-    have hb1 := ρ.map _ _ hb
-    simp [EType.crename, CType.crename] at hb1
-    exact hb1
-    apply ih ρ
-  case label hl =>
-    apply label
-    have hl1 := ρ.lmap _ _ hl
-    exact hl1
-  case cvar hc =>
-    apply cvar
-    exact ρ.cmap _ _ hc
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih ρ
-  case csub hs hk ih =>
-    have hs1 := hs.rename ρ
-    apply csub hs1
-    apply ih ρ
-  case union hc1 hc2 ih1 ih2 =>
-    apply union <;> aesop
-  case empty => apply empty
-
 theorem CaptureBound.rename
   (h : CaptureBound Γ C B)
   (ρ : VarMap Γ f Δ) :
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index 950dc793..1d98627e 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -18,41 +18,52 @@ theorem CaptureSet.Subset.rename {C1 C2 : CaptureSet n k}
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
 
+mutual
+theorem CaptureKind.rename
+  (h : Γ ⊢ C :k K)
+  (ρ : VarMap Γ f Δ) : Δ ⊢ (C.rename f) :k K :=
+  match h with
+  | .empty => .empty
+  | .label hl => .label (ρ.lmap _ _ hl)
+  | .cvar hb => .cvar (ρ.cmap _ _ hb)
+  | .csub hs hk => .csub (hs.rename ρ) (hk.rename ρ)
+  | .sub hs hk => .sub hs (hk.rename ρ)
+  | .proj_kind => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply CaptureKind.proj_kind
+  | .proj hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply CaptureKind.proj (hk.rename ρ)
+
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
   (ρ : VarMap Γ f Δ) :
-  Subcapt Δ (C1.rename f) (C2.rename f) := by
-  induction h
-  case trans ih1 ih2 => apply trans <;> aesop
-  case subset hsub =>
-    apply subset
-    apply CaptureSet.Subset.rename; trivial
-  case union ih1 ih2 =>
-    simp [CaptureSet.rename_union]
-    apply union <;> aesop
-  case var hb =>
-    simp [CaptureSet.rename_singleton]
-    apply var
-    have hb1 := ρ.map _ _ hb
-    simp [EType.rename, CType.rename] at hb1
-    assumption
-  case cinstl hb =>
-    simp [CaptureSet.rename_csingleton]
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cinstl
-    assumption
-  case cinstr hb =>
-    simp [CaptureSet.rename_csingleton]
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cinstr
-    assumption
-  case cbound hb =>
-    simp [CaptureSet.rename_csingleton]
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename, CBound.rename] at hb1
-    apply cbound
-    easy
+  Subcapt Δ (C1.rename f) (C2.rename f) :=
+  match h with
+  | .trans ha hb => .trans (ha.rename ρ) (hb.rename ρ)
+  | .subset hs => by
+    apply Subcapt.subset
+    apply CaptureSet.Subset.rename hs
+  | .union ha hb => .union (ha.rename ρ) (hb.rename ρ)
+  | .var hb => .var (ρ.map _ _ hb)
+  | .cinstl hb => .cinstl (ρ.cmap _ _ hb)
+  | .cinstr hb => .cinstr (ρ.cmap _ _ hb)
+  | .cbound hb => .cbound (ρ.cmap _ _ hb)
+  | .proj h1 => by
+    repeat rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj (h1.rename ρ)
+  | .proj_sub hs => by
+    repeat rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_sub hs
+  | .proj_l => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_l
+  | .proj_r hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_r (hk.rename ρ)
+  | .proj_disj hd hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_disj hd (hk.rename ρ)
+end
 
 end Capless
diff --git a/Capless/Renaming/Type/CaptureBound.lean b/Capless/Renaming/Type/CaptureBound.lean
index 6b7c2ab1..2acd7ddb 100644
--- a/Capless/Renaming/Type/CaptureBound.lean
+++ b/Capless/Renaming/Type/CaptureBound.lean
@@ -10,36 +10,6 @@ remain valid when type variables are renamed consistently between contexts.
 -/
 namespace Capless
 
-theorem CaptureKind.trename
-  (h : CaptureKind Γ C K)
-  (ρ : TVarMap Γ f Δ) :
-  CaptureKind Δ C K := by
-  induction h
-  case var hb hk ih =>
-    apply var
-    have hb1 := ρ.map _ _ hb
-    simp [EType.trename, CType.trename] at hb1
-    exact hb1
-    apply ih ρ
-  case label hl =>
-    apply label
-    have hl1 := ρ.lmap _ _ hl
-    exact hl1
-  case cvar hc =>
-    apply cvar
-    exact ρ.cmap _ _ hc
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih ρ
-  case csub hs hk ih =>
-    have hs1 := hs.trename ρ
-    apply csub hs1
-    apply ih ρ
-  case union hc1 hc2 ih1 ih2 =>
-    apply union <;> aesop
-  case empty => apply empty
-
-
 theorem CaptureBound.trename
   (h : CaptureBound Γ C B)
   (ρ : TVarMap Γ f Δ) :
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 602cc6ec..b9e3e019 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -11,33 +11,39 @@ remain valid when type variables are renamed consistently between contexts.
 -/
 namespace Capless
 
+mutual
+
+
+theorem CaptureKind.trename
+  (h : CaptureKind Γ C K)
+  (ρ : TVarMap Γ f Δ) :
+  CaptureKind Δ C K :=
+  match h with
+  | .label hl => .label (ρ.lmap _ _ hl)
+  | .cvar hb => .cvar (ρ.cmap _ _ hb)
+  | .csub hs hk => .csub (hs.trename ρ) (hk.trename ρ)
+  | .sub hs hk => .sub hs (hk.trename ρ)
+  | .empty => .empty
+  | .proj_kind => .proj_kind
+  | .proj hk => .proj (hk.trename ρ)
+
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
   (ρ : TVarMap Γ f Δ) :
-  Subcapt Δ C1 C2 := by
-  induction h
-  case trans ih1 ih2 => apply trans <;> aesop
-  case subset hs =>
-    apply subset
-    trivial
-  case union ih1 ih2 =>
-    apply union <;> aesop
-  case var hb =>
-    apply var
-    have hb1 := ρ.map _ _ hb
-    simp [EType.trename, CType.trename] at hb1
-    exact hb1
-  case cinstl hb =>
-    apply cinstl
-    have hb1 := ρ.cmap _ _ hb
-    exact hb1
-  case cinstr hb =>
-    apply cinstr
-    have hb1 := ρ.cmap _ _ hb
-    exact hb1
-  case cbound hb =>
-    apply cbound
-    have hb1 := ρ.cmap _ _ hb
-    exact hb1
+  Subcapt Δ C1 C2 :=
+  match h with
+  | .trans ha hb => .trans (ha.trename ρ) (hb.trename ρ)
+  | .subset hs => .subset hs
+  | .union ha hb => .union (ha.trename ρ) (hb.trename ρ)
+  | .var hb => .var (ρ.map _ _ hb)
+  | .cinstl hb => .cinstl (ρ.cmap _ _ hb)
+  | .cinstr hb => .cinstr (ρ.cmap _ _ hb)
+  | .cbound hb => .cbound (ρ.cmap _ _ hb)
+  | .proj h1 => .proj (h1.trename ρ)
+  | .proj_sub hs => .proj_sub hs
+  | .proj_l => .proj_l
+  | .proj_r hk => .proj_r (hk.trename ρ)
+  | .proj_disj hd hk => .proj_disj hd (hk.trename ρ)
+end
 
 end Capless
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 5339c062..afa5ae01 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -52,8 +52,11 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | empty : CaptureKind Γ .empty K
   | proj_kind {C : CaptureSet n k} : CaptureKind Γ (C.proj K) K
   | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
+
 end
 
+
+
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 

From 2c18105ebd8d6c594edf174318de73dde8373051 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 19:21:02 +0100
Subject: [PATCH 15/71] Update Substitution

---
 Capless/Subst/Basic.lean                |  8 +--
 Capless/Subst/Capture/CaptureBound.lean | 24 -------
 Capless/Subst/Capture/Subcapturing.lean | 76 +++++++++++++++------
 Capless/Subst/Capture/Typing.lean       |  4 +-
 Capless/Subst/Term/CaptureBound.lean    | 26 -------
 Capless/Subst/Term/Subcapturing.lean    | 90 +++++++++++++++++--------
 Capless/Subst/Term/Typing.lean          |  5 +-
 Capless/Subst/Type/CaptureBound.lean    | 25 -------
 Capless/Subst/Type/Subcapturing.lean    | 58 +++++++++++-----
 lakefile.lean                           |  3 +-
 10 files changed, 172 insertions(+), 147 deletions(-)

diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index 64cf5ae8..037ac237 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -357,12 +357,12 @@ def TVarSubst.text {Γ : Context n m k}
         simp [FinFun.ext]
         apply SSubtyp.tvar
         cases T
-        case bound T =>
+        case a.bound T =>
           simp at hbnd
           rw [hbnd]
           rw [<-SType.tweaken_trename]
           constructor
-        case inst T =>
+        case a.inst T =>
           simp at hbnd
       case inr hb' =>
         obtain ⟨T', X',  hb', heq, heq'⟩ := hb'
@@ -851,7 +851,7 @@ def TVarSubst.open :
       trivial
   , lmap := fun l S hb => by
       cases hb
-      simp [SType.tweaken, SType.trename_trename, FinFun.open_comp_weaken, SType.trename_id, FinFun.open]
+      simp [SType.tweaken, SType.trename_trename, FinFun.open_comp_weaken, SType.trename_id]
       assumption
   }
 
@@ -890,7 +890,7 @@ def CVarSubst.open :
       have ⟨he1, he2⟩ := h
       cases he1; cases b0 <;> cases he2
       simp [FinFun.open]
-      simp [CBound.crename, CaptureSet.crename_csingleton]
+      simp [CBound.crename]
       simp [FinFun.weaken, FinFun.open]
       constructor; apply Subcapt.refl
     case inr h =>
diff --git a/Capless/Subst/Capture/CaptureBound.lean b/Capless/Subst/Capture/CaptureBound.lean
index 912c8811..493da89f 100644
--- a/Capless/Subst/Capture/CaptureBound.lean
+++ b/Capless/Subst/Capture/CaptureBound.lean
@@ -8,30 +8,6 @@ Substitution theorems for capture variable substitution in capture kind judgment
 
 namespace Capless
 
-theorem CaptureKind.csubst
-  (h : CaptureKind Γ C K)
-  (σ : CVarSubst Γ f Δ) :
-  CaptureKind Δ (C.crename f) K := by
-  induction h
-  case var hb hk ih =>
-    have hb1 := σ.map _ _ hb
-    apply CaptureKind.var hb1 (ih σ)
-  case label hl =>
-    have hl1 := σ.lmap _ _ hl
-    apply label hl1
-  case cvar hb =>
-    cases σ.cmap_bound _ _ hb
-    assumption
-  case csub hsub hk ih =>
-    have hsub1 := hsub.csubst σ
-    apply csub hsub1 (ih σ)
-  case sub hs hk ih =>
-    apply sub hs (ih σ)
-  case union h1 h2 ih1 ih2 =>
-    apply union (ih1 σ) (ih2 σ)
-  case empty =>
-    apply empty
-
 theorem CaptureBound.csubst
   (h : CaptureBound Γ C B)
   (σ: CVarSubst Γ f Δ) :
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index a6d054be..3453f5f7 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -7,35 +7,73 @@ Substitution theorems for capture variable substitution in subcapturing judgment
 
 namespace Capless
 
+mutual
+theorem CaptureKind.csubst
+  (h : CaptureKind Γ C K)
+  (σ : CVarSubst Γ f Δ) :
+  CaptureKind Δ (C.crename f) K :=
+  match h with
+  | .label hl =>
+    have hl1 := σ.lmap _ _ hl
+    .label hl1
+  | .cvar hb => by
+    cases σ.cmap_bound _ _ hb
+    assumption
+  | .csub hsub hk =>
+    have hsub1 := hsub.csubst σ
+    .csub hsub1 (hk.csubst σ)
+  | .sub hs hk => .sub hs (hk.csubst σ)
+  | .empty => .empty
+  | .proj_kind => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply CaptureKind.proj_kind
+  | .proj hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply CaptureKind.proj $ hk.csubst σ
+
+
 theorem Subcapt.csubst
   (h : Subcapt Γ C1 C2)
   (σ : CVarSubst Γ f Δ) :
-  Subcapt Δ (C1.crename f) (C2.crename f) := by
-  induction h
-  case trans => apply trans <;> aesop
-  case subset hsub =>
-    apply subset
+  Subcapt Δ (C1.crename f) (C2.crename f) :=
+  match h with
+  | .trans ha hb => .trans (ha.csubst σ) (hb.csubst σ)
+  | .subset hsub => by
+    apply Subcapt.subset
     apply (CaptureSet.crename_monotone hsub)
-  case union h1 h2 =>
-    have ih1 := h1 σ
-    have ih2 := h2 σ
+  | .union h1 h2 => by
+    have ih1 := h1.csubst σ
+    have ih2 := h2.csubst σ
     rw [CaptureSet.crename_union]
-    apply union <;> trivial
-  case var hb =>
+    apply Subcapt.union <;> trivial
+  | .var hb =>
     have ht := σ.map _ _ hb
-    simp [EType.crename, CType.crename] at ht
-    apply var <;> aesop
-  case cinstl hb =>
+    Subcapt.var ht
+  | .cinstl hb =>
     have hb1 := σ.cmap _ _ hb
-    apply cinstl
-    trivial
-  case cinstr hb =>
+    .cinstl hb1
+  | .cinstr hb =>
     have hb1 := σ.cmap _ _ hb
-    apply cinstr
-    trivial
-  case cbound hb =>
+    .cinstr hb1
+  | .cbound hb => by
     have hb1 := σ.cmap_bound _ _ hb
     cases hb1
     easy
+  | .proj h1 => by
+    repeat rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj (h1.csubst σ)
+  | .proj_sub hs => by
+    repeat rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_sub hs
+  | .proj_l => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_l
+  | .proj_r hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_r (hk.csubst σ)
+  | .proj_disj hd hk => by
+    rw [← CaptureSet.proj_crename_comm]
+    apply Subcapt.proj_disj hd (hk.csubst σ)
+end
 
 end Capless
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index dcbe1c17..1ba6b826 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -56,7 +56,7 @@ theorem Typed.csubst
         simp [Term.crename, EType.crename, CType.crename, SType.crename] at ih1
         exact ih1 }
       { have ih2 := ih2 σ
-        simp [Term.crename, EType.crename, CType.crename, SType.crename] at ih2
+        simp [Term.crename, EType.crename] at ih2
         exact ih2 }
     case tapp ih =>
       simp [Term.crename]
@@ -121,7 +121,7 @@ theorem Typed.csubst
       apply ih2; assumption
     case boundary ih =>
       simp [Term.crename]
-      simp [EType.crename, CType.crename, SType.crename]
+      simp [EType.crename, CType.crename]
       apply boundary
       have ih := ih (σ.cext.ext _)
       simp [CBinding.crename, EType.crename, CType.crename, SType.crename, FinFun.ext] at ih
diff --git a/Capless/Subst/Term/CaptureBound.lean b/Capless/Subst/Term/CaptureBound.lean
index 2ff4c15c..724ac6bd 100644
--- a/Capless/Subst/Term/CaptureBound.lean
+++ b/Capless/Subst/Term/CaptureBound.lean
@@ -8,32 +8,6 @@ Substitution theorems for term variable substitution in capture kind judgments.
 
 namespace Capless
 
-theorem CaptureKind.subst
-  (h : CaptureKind Γ C K)
-  (σ : VarSubst Γ f Δ) :
-  CaptureKind Δ (C.rename f) K := by
-  induction h
-  case var hb hk ih =>
-    have hb1 := σ.map _ _ hb
-    simp [EType.rename, CType.rename] at hb1
-    have h := Typing.inv_subcapt hb1
-    apply csub h (ih σ)
-  case label hl =>
-    have hl1 := σ.lmap _ _ hl
-    apply label hl1
-  case cvar hb =>
-    have hb1 := σ.cmap _ _ hb
-    apply cvar hb1
-  case csub hsub hk ih =>
-    have hsub1 := hsub.subst σ
-    apply csub hsub1 (ih σ)
-  case sub hs hk ih =>
-    apply sub hs (ih σ)
-  case union h1 h2 ih1 ih2 =>
-    apply union (ih1 σ) (ih2 σ)
-  case empty =>
-    apply empty
-
 theorem CaptureBound.subst
   (h : CaptureBound Γ C B)
   (σ: VarSubst Γ f Δ) :
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index be51941e..9d822fc4 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -9,40 +9,76 @@ Substitution theorems for term variable substitution in subcapturing judgments.
 
 namespace Capless
 
+mutual
+theorem CaptureKind.subst
+  (h : CaptureKind Γ C K)
+  (σ : VarSubst Γ f Δ) :
+  CaptureKind Δ (C.rename f) K :=
+  match h with
+  | .label hl =>
+    have hl1 := σ.lmap _ _ hl
+    .label hl1
+  | .cvar hb => by
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.rename, CBound.rename] at hb1
+    apply CaptureKind.cvar hb1
+  | .csub hsub hk =>
+    have hsub1 := hsub.subst σ
+    .csub hsub1 (hk.subst σ)
+  | .sub hs hk => .sub hs (hk.subst σ)
+  | .empty => .empty
+  | .proj_kind => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply CaptureKind.proj_kind
+  | .proj hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply CaptureKind.proj $ hk.subst σ
+
+
 theorem Subcapt.subst
   (h : Subcapt Γ C1 C2)
   (σ : VarSubst Γ f Δ) :
-  Subcapt Δ (C1.rename f) (C2.rename f) := by
-  induction h
-  case trans => apply trans <;> aesop
-  case subset hsub =>
-    apply subset
-    apply! CaptureSet.Subset.rename
-  case union h1 h2 =>
-    simp [CaptureSet.rename_union]
-    apply union <;> aesop
-  case var hb =>
+  Subcapt Δ (C1.rename f) (C2.rename f) :=
+  match h with
+  | .trans ha hb => .trans (ha.subst σ) (hb.subst σ)
+  | .subset hsub => by
+    apply Subcapt.subset
+    apply CaptureSet.Subset.rename hsub
+  | .union h1 h2 => by
+    have ih1 := h1.subst σ
+    have ih2 := h2.subst σ
+    rw [CaptureSet.rename_union]
+    apply Subcapt.union <;> trivial
+  | .var hb => by
     have ht := σ.map _ _ hb
-    simp [EType.rename, CType.rename] at ht
+    simp [CType.rename] at ht
     have h := Typing.inv_subcapt ht
-    simp [CaptureSet.rename_singleton]; trivial
-  case cinstl hb =>
-    have hb1 := σ.cmap _ _ hb
-    simp [CaptureSet.rename_csingleton]
-    apply cinstl
-    simp [CBinding.rename] at hb1
     trivial
-  case cinstr hb =>
+  | .cinstl hb =>
     have hb1 := σ.cmap _ _ hb
-    simp [CaptureSet.rename_csingleton]
-    apply cinstr
-    simp [CBinding.rename] at hb1
-    trivial
-  case cbound hb =>
+    .cinstl hb1
+  | .cinstr hb =>
+    have hb1 := σ.cmap _ _ hb
+    .cinstr hb1
+  | .cbound hb => by
     have hb1 := σ.cmap _ _ hb
-    simp [CaptureSet.rename_csingleton]
-    apply cbound
-    simp [CBinding.rename] at hb1
-    easy
+    simp [CBinding.rename, CBound.rename] at hb1
+    apply Subcapt.cbound hb1
+  | .proj h1 => by
+    repeat rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj (h1.subst σ)
+  | .proj_sub hs => by
+    repeat rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_sub hs
+  | .proj_l => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_l
+  | .proj_r hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_r (hk.subst σ)
+  | .proj_disj hd hk => by
+    rw [← CaptureSet.proj_rename_comm]
+    apply Subcapt.proj_disj hd (hk.subst σ)
+end
 
 end Capless
diff --git a/Capless/Subst/Term/Typing.lean b/Capless/Subst/Term/Typing.lean
index 4a1102a5..3c6e18c1 100644
--- a/Capless/Subst/Term/Typing.lean
+++ b/Capless/Subst/Term/Typing.lean
@@ -59,7 +59,7 @@ theorem Typed.subst
       simp [Term.rename, EType.rename, CType.rename, SType.rename] at ih1
       exact ih1 }
     { have ih2 := ih2 σ
-      simp [Term.rename, EType.rename, CType.rename, SType.rename] at ih2
+      simp [Term.rename, EType.rename] at ih2
       exact ih2 }
   case tapp ih =>
     simp [Term.rename]
@@ -125,12 +125,11 @@ theorem Typed.subst
     apply ih2; assumption
   case boundary ih =>
     simp [Term.rename]
-    simp [EType.rename, CType.rename, SType.rename] at *
+    simp [EType.rename, CType.rename] at *
     apply boundary
     have ih := ih (σ.cext.ext _)
     simp
       [ CBinding.rename
-      , EType.rename
       , CType.rename
       , SType.rename
       , <- SType.weaken_rename
diff --git a/Capless/Subst/Type/CaptureBound.lean b/Capless/Subst/Type/CaptureBound.lean
index acd4dddf..e68dca7c 100644
--- a/Capless/Subst/Type/CaptureBound.lean
+++ b/Capless/Subst/Type/CaptureBound.lean
@@ -8,31 +8,6 @@ Substitution theorems for type variable substitution in capture kind judgments.
 
 namespace Capless
 
-theorem CaptureKind.tsubst
-  (h : CaptureKind Γ C K)
-  (σ : TVarSubst Γ f Δ) :
-  CaptureKind Δ C K := by
-  induction h
-  case var hb hk ih =>
-    have hb1 := σ.map _ _ hb
-    simp [CType.trename] at hb1
-    apply var hb1 (ih σ)
-  case label hl =>
-    have hl1 := σ.lmap _ _ hl
-    apply label hl1
-  case cvar hb =>
-    have hb1 := σ.cmap _ _ hb
-    apply cvar hb1
-  case csub hsub hk ih =>
-    have hsub1 := hsub.tsubst σ
-    apply csub hsub1 (ih σ)
-  case sub hs hk ih =>
-    apply sub hs (ih σ)
-  case union h1 h2 ih1 ih2 =>
-    apply union (ih1 σ) (ih2 σ)
-  case empty =>
-    apply empty
-
 theorem CaptureBound.tsubst
   (h : CaptureBound Γ C B)
   (σ: TVarSubst Γ f Δ) :
diff --git a/Capless/Subst/Type/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean
index 218c9dbe..a7912e25 100644
--- a/Capless/Subst/Type/Subcapturing.lean
+++ b/Capless/Subst/Type/Subcapturing.lean
@@ -7,28 +7,54 @@ Substitution theorems for type variable substitution in subcapturing judgments.
 
 namespace Capless
 
+mutual
+
+theorem CaptureKind.tsubst
+  (h : CaptureKind Γ C K)
+  (σ : TVarSubst Γ f Δ) :
+  CaptureKind Δ C K :=
+  match h with
+  | .label hl =>
+    have hl1 := σ.lmap _ _ hl
+    .label hl1
+  | .cvar hb =>
+    have hb1 := σ.cmap _ _ hb
+    .cvar hb1
+  | .csub hsub hk =>
+    have hsub1 := hsub.tsubst σ
+    .csub hsub1 (hk.tsubst σ)
+  | .sub hs hk =>
+    .sub hs (hk.tsubst σ)
+  | .empty => .empty
+  | .proj hk => .proj $ hk.tsubst σ
+  | .proj_kind => .proj_kind
+
 theorem Subcapt.tsubst
   (h : Subcapt Γ C1 C2)
   (σ : TVarSubst Γ f Δ) :
-  Subcapt Δ C1 C2 := by
-  induction h
-  case trans => apply trans <;> aesop
-  case subset hsub =>
-    apply subset; easy
-  case union h1 h2 =>
-    apply union <;> aesop
-  case var hb =>
+  Subcapt Δ C1 C2 :=
+  match h with
+  | .trans ha hb => .trans (ha.tsubst σ) (hb.tsubst σ)
+  | .subset hsub => .subset hsub
+  | .union h1 h2 => .union (h1.tsubst σ) (h2.tsubst σ)
+  | .var hb => by
     have ht := σ.map _ _ hb
-    simp [EType.trename, CType.trename] at ht
-    apply var <;> aesop
-  case cinstl hb =>
+    apply Subcapt.var <;> aesop
+  | .cinstl hb =>
     have hb1 := σ.cmap _ _ hb
-    apply cinstl; easy
-  case cinstr hb =>
+    .cinstl hb1
+  | .cinstr hb =>
     have hb1 := σ.cmap _ _ hb
-    apply cinstr; easy
-  case cbound hb =>
+    .cinstr hb1
+  | .cbound hb =>
     have hb1 := σ.cmap _ _ hb
-    apply cbound; easy
+    .cbound hb1
+  | .proj hk => .proj $ hk.tsubst σ
+  | .proj_sub hs => .proj_sub hs
+  | .proj_l => .proj_l
+  | .proj_r hs => .proj_r $ hs.tsubst σ
+  | .proj_disj hd hk => .proj_disj hd $ hk.tsubst σ
+
+end
 
 end Capless
diff --git a/lakefile.lean b/lakefile.lean
index a7a94fd8..82412506 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -6,7 +6,8 @@ package «capless» where
   leanOptions := #[
     ⟨`pp.unicode.fun, true⟩,
     ⟨`autoImplicit, true⟩,
-    ⟨`linter.unusedVariables, false⟩
+    ⟨`linter.unusedVariables, false⟩,
+    ⟨`linter.unusedSimpArgs, false⟩,
   ]
   -- add any additional package configuration options here
 

From 2100a41581b110b3d8e51cb9bdcfc26391817097 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 18 Nov 2025 19:40:19 +0100
Subject: [PATCH 16/71] Broken wellscoped

---
 Capless/Store.lean            |  3 +++
 Capless/WellScoped/Basic.lean | 45 ++++++++++++++++++++++-------------
 2 files changed, 31 insertions(+), 17 deletions(-)

diff --git a/Capless/Store.lean b/Capless/Store.lean
index f24824ae..41fae939 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -120,6 +120,9 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   WellScoped Γ cont C ->
   WellScoped Γ cont {c=c}
+| ckind :
+  Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
+  WellScoped Γ cont {c=c}
 | label :
   Context.LBound Γ x S ->
   Cont.HasLabel cont x tail ->
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 0e991b16..accb19cb 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -70,24 +70,35 @@ theorem WellScoped.scope
 theorem WellScoped.subcapt
   (hsc : WellScoped Γ cont C)
   (hs : Γ ⊢ C' <:c C) :
-  WellScoped Γ cont C' := by
-  induction hs generalizing cont
-  case trans => aesop
-  case subset => apply WellScoped.subset <;> easy
-  case union => apply union <;> aesop
-  case var => apply WellScoped.singleton <;> aesop
-  case cinstl =>
+  WellScoped Γ cont C' :=
+  match hs with
+  | .trans ha hb => .subcapt (.subcapt hsc hb) ha
+  | .subset hs => .subset hsc hs
+  | .union ha hb => .union (.subcapt hsc ha) (.subcapt hsc hb)
+  | .var hb => .singleton hb hsc
+  | .cinstl hb1 => by
     cases hsc
-    rename_i hb1 _ _ hb2
-    have h := Context.cbound_injective hb1 hb2
-    cases h
-    rename_i h
-    exact h
-    rename_i hb1 _ _ hb2
-    have h := Context.cbound_injective hb1 hb2
-    cases h
-  case cinstr => apply WellScoped.csingleton <;> aesop
-  case cbound => apply WellScoped.cbound <;> aesop
+    case csingleton =>
+      rename_i hb2
+      have h := Context.cbound_injective hb1 hb2
+      cases h
+      rename_i h
+      exact h
+    case cbound =>
+      rename_i hb2
+      have h := Context.cbound_injective hb1 hb2
+      cases h
+    case ckind =>
+      rename_i hb2
+      have h := Context.cbound_injective hb1 hb2
+      cases h
+  | .cinstr hb => .csingleton hb hsc
+  | .cbound hb => .cbound hb hsc
+  | .proj h1 => _
+  | .proj_sub _ => _
+  | .proj_l => _
+  | .proj_r _ => _
+  | .proj_disj _ _ => _
 
 theorem WellScoped.var_inv
   (hsc : WellScoped Γ cont {x=x})

From 7f706c7e8dd3f2d098ade1f4ffec37f99f950ffb Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 19 Nov 2025 16:26:38 +0100
Subject: [PATCH 17/71] Introduce projection as syntactic form, add subsetting
 rules

---
 Capless/CaptureSet.lean   | 96 ++++++++++++++-------------------------
 Capless/Subcapturing.lean |  1 -
 2 files changed, 34 insertions(+), 63 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 28f5b60b..3c683601 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -12,11 +12,6 @@ namespace Capless
 This file contains the definition of capture sets.
 -/
 
-inductive Singleton : Nat -> Nat -> Type where
-  | singl : Fin n -> Singleton n k
-  | csingl : Fin k -> Singleton n k
-  | proj : Singleton n k -> Kind -> Singleton n k
-
 /-- Capture sets in System Capless.
 
 The type of capture sets is parameterized by:
@@ -35,14 +30,16 @@ Since the capture sets are indexed with the number of available binders, and eac
 inductive CaptureSet : Nat -> Nat -> Type where
 | empty : CaptureSet n k
 | union : CaptureSet n k -> CaptureSet n k -> CaptureSet n k
-| singleton : Singleton n k -> CaptureSet n k
+| singleton : Fin n -> CaptureSet n k
+| csingleton : Fin k -> CaptureSet n k
+| proj : CaptureSet n k -> Kind -> CaptureSet n k
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
 
-notation:max "{x=" x "}" => CaptureSet.singleton (Singleton.singl x)
-notation:max "{c=" c "}" => CaptureSet.singleton (Singleton.csingl c)
+notation:max "{x=" x "}" => CaptureSet.singleton x
+notation:max "{c=" c "}" => CaptureSet.csingleton c
 notation:max "{s=" s "}" => CaptureSet.singleton s
 
 @[simp]
@@ -63,6 +60,12 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | union_rr :
   Subset C C2 ->
   Subset C (C1 ∪ C2)
+/- projection distributivity -/
+| proj_empty : Subset .empty (.proj .empty K)
+| empty_proj : Subset (.proj .empty K) .empty
+| proj_union : Subset (.proj (C1 ∪ C2) K) (.union (C1.proj K) (C2.proj K))
+| union_proj : Subset  (.union (C1.proj K) (C2.proj K)) (.proj (C1 ∪ C2) K)
+| proj_proj : Subset (.proj (.proj C K1) K2) (.proj (.proj C K2) K1)
 
 @[simp]
 instance : HasSubset (CaptureSet n k) where
@@ -72,34 +75,23 @@ instance : HasSubset (CaptureSet n k) where
 ## Renaming operations
 -/
 
-@[simp]
-def Singleton.rename (s: Singleton n k) (f : FinFun n n') : Singleton n' k :=
-  match s with
-  | singl x => singl $ f x
-  | csingl c => csingl c
-  | proj s k => (s.rename f).proj k
-
 @[simp]
 def CaptureSet.rename (C : CaptureSet n k) (f : FinFun n n') : CaptureSet n' k :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.rename f) ∪ (C2.rename f)
-  | singleton x => singleton $ x.rename f
-
-@[simp]
-def Singleton.crename (s: Singleton n k) (f : FinFun k k') : Singleton n k' :=
-  match s with
-  | singl x => singl x
-  | csingl c => csingl $ f c
-  | proj s k => (s.crename f).proj k
-
+  | singleton x => singleton $ f x
+  | csingleton c => csingleton c
+  | proj c k => (c.rename f).proj k
 
 @[simp]
 def CaptureSet.crename (C : CaptureSet n k) (f : FinFun k k') : CaptureSet n k' :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.crename f) ∪ (C2.crename f)
-  | singleton x => singleton $ x.crename f
+  | singleton x => singleton x
+  | csingleton c => csingleton $ f c
+  | proj c k => (c.crename f).proj k
 
 def CaptureSet.weaken (C : CaptureSet n k) : CaptureSet (n+1) k :=
   C.rename FinFun.weaken
@@ -155,13 +147,10 @@ theorem CaptureSet.rename_empty :
 theorem CaptureSet.crename_empty :
   ({} : CaptureSet n k).crename f = {} := by simp
 
-theorem Singleton.crename_rename_comm {s : Singleton n k} {f: FinFun n n'} {g: FinFun k k'} :
-  (s.rename f).crename g = (s.crename g).rename f := by
-  induction s <;> aesop
 
 theorem CaptureSet.crename_rename_comm {C : CaptureSet n k} {f : FinFun n n'} {g : FinFun k k'} :
   (C.rename f).crename g = (C.crename g).rename f := by
-  induction C <;> aesop (add safe apply Singleton.crename_rename_comm)
+  induction C <;> aesop
 
 theorem CaptureSet.copen_rename_comm {C : CaptureSet n (k+1)} {x : Fin k} {f : FinFun n n'} :
   (C.copen x).rename f = (C.rename f).copen x := by
@@ -171,13 +160,9 @@ theorem CaptureSet.cweaken_rename_comm {C : CaptureSet n k} {f : FinFun n n'} :
   (C.cweaken).rename f = (C.rename f).cweaken := by
   simp [cweaken, crename_rename_comm]
 
-theorem Singleton.rename_rename {s : Singleton n k} :
-  (s.rename f).rename g = s.rename (g ∘ f) := by
-  induction s <;> aesop
-
 theorem CaptureSet.rename_rename {C : CaptureSet n k} :
   (C.rename f).rename g = C.rename (g ∘ f) := by
-  induction C <;> aesop (add safe 1 Singleton.rename_rename)
+  induction C <;> aesop
 
 theorem CaptureSet.weaken_rename {C : CaptureSet n k} :
   (C.rename f).weaken = C.weaken.rename f.ext := by
@@ -187,13 +172,9 @@ theorem CaptureSet.weaken_crename {C : CaptureSet n k} :
   (C.crename f).weaken = C.weaken.crename f := by
   simp [weaken, crename_rename_comm]
 
-theorem Singleton.crename_crename {s : Singleton n k} :
-  (s.crename f).crename g = s.crename (g ∘ f) := by
-  induction s <;> aesop
-
 theorem CaptureSet.crename_crename {C : CaptureSet n k} :
   (C.crename f).crename g = C.crename (g ∘ f) := by
-  induction C <;> aesop (add safe 1 Singleton.crename_crename)
+  induction C <;> aesop
 
 theorem CaptureSet.crename_copen {C : CaptureSet n (k+1)} :
   (C.copen c).crename f = (C.crename f.ext).copen (f c) :=
@@ -214,21 +195,13 @@ theorem CaptureSet.weaken_csingleton :
   ({c=c} : CaptureSet n k).weaken = {c=c} := by
   simp [singleton, weaken]
 
-theorem Singleton.rename_id {s : Singleton n k} :
-  s.rename FinFun.id = s := by
-  induction s <;> aesop
-
 theorem CaptureSet.rename_id {C : CaptureSet n k} :
   C.rename FinFun.id = C := by
-  induction C <;> aesop (add safe 1 Singleton.rename_id)
-
-theorem Singleton.crename_id {s : Singleton n k} :
-  s.crename FinFun.id = s := by
-  induction s <;> aesop
+  induction C <;> aesop
 
 theorem CaptureSet.crename_id {C : CaptureSet n k} :
   C.crename FinFun.id = C := by
-  induction C <;> aesop (add safe 1 Singleton.crename_id)
+  induction C <;> aesop
 
 theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   (h : C1 ⊆ C2) :
@@ -237,6 +210,12 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   case union_rr =>
     simp
     apply! Subset.union_rr
+  case proj_union =>
+    simp
+    apply Subset.proj_union
+  case union_proj =>
+    simp
+    apply Subset.union_proj
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
@@ -245,6 +224,12 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   case union_rr =>
     simp
     apply! Subset.union_rr
+  case proj_union =>
+    simp
+    apply Subset.proj_union
+  case union_proj =>
+    simp
+    apply Subset.union_proj
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
@@ -254,17 +239,4 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 ## Projections
 -/
 
-@[simp]
-def CaptureSet.proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
-  match C with
-  | empty => empty
-  | union C1 C2 => union (C1.proj K) (C2.proj K)
-  | singleton s => singleton $ s.proj K
-
-theorem CaptureSet.proj_crename_comm {C: CaptureSet n k} : (C.crename f).proj K = (C.proj K).crename f := by
-  induction C <;> aesop
-
-theorem CaptureSet.proj_rename_comm {C: CaptureSet n k} : (C.rename f).proj K = (C.proj K).rename f := by
-  induction C <;> aesop
-
 end Capless
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index afa5ae01..c5815430 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -52,7 +52,6 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | empty : CaptureKind Γ .empty K
   | proj_kind {C : CaptureSet n k} : CaptureKind Γ (C.proj K) K
   | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
-
 end
 
 

From ce1e920787248f238dfd65a4d035ad4f52bc5204 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 19 Nov 2025 16:31:10 +0100
Subject: [PATCH 18/71] Fix renaming

---
 Capless/Renaming/Capture/Subcapturing.lean | 20 +++++++++++++-------
 Capless/Renaming/Term/Subcapturing.lean    | 20 +++++++++++++-------
 Capless/Subst/Capture/Subcapturing.lean    | 14 +++++++-------
 Capless/Subst/Term/Subcapturing.lean       | 14 +++++++-------
 4 files changed, 40 insertions(+), 28 deletions(-)

diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index 73c5634a..41f610d4 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -16,6 +16,12 @@ theorem CaptureSet.Subset.crename {C1 C2 : CaptureSet n k}
   C1.crename f ⊆ C2.crename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
+  case proj_union =>
+    simp
+    apply proj_union
+  case union_proj =>
+    simp
+    apply union_proj
 
 mutual
 
@@ -37,10 +43,10 @@ theorem CaptureKind.crename
     apply hk1
   | .empty => CaptureKind.empty
   | .proj_kind => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply CaptureKind.proj_kind
   | .proj hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply CaptureKind.proj
     apply hk.crename ρ
 
@@ -71,21 +77,21 @@ theorem Subcapt.crename
     have hb1 := ρ.cmap _ _ hb
     apply Subcapt.cbound hb1
   | .proj hs => by
-    repeat rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj
     apply hs.crename ρ
   | .proj_sub hs => by
-    repeat rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_sub hs
   | .proj_l => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_l
   | .proj_r hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_r
     apply hk.crename ρ
   | .proj_disj hd hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_disj hd
     apply hk.crename ρ
 
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index 1d98627e..b7e798db 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -17,6 +17,12 @@ theorem CaptureSet.Subset.rename {C1 C2 : CaptureSet n k}
   C1.rename f ⊆ C2.rename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
+  case proj_union =>
+    simp
+    apply proj_union
+  case union_proj =>
+    simp
+    apply union_proj
 
 mutual
 theorem CaptureKind.rename
@@ -29,10 +35,10 @@ theorem CaptureKind.rename
   | .csub hs hk => .csub (hs.rename ρ) (hk.rename ρ)
   | .sub hs hk => .sub hs (hk.rename ρ)
   | .proj_kind => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply CaptureKind.proj_kind
   | .proj hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply CaptureKind.proj (hk.rename ρ)
 
 theorem Subcapt.rename
@@ -50,19 +56,19 @@ theorem Subcapt.rename
   | .cinstr hb => .cinstr (ρ.cmap _ _ hb)
   | .cbound hb => .cbound (ρ.cmap _ _ hb)
   | .proj h1 => by
-    repeat rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj (h1.rename ρ)
   | .proj_sub hs => by
-    repeat rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_sub hs
   | .proj_l => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_l
   | .proj_r hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_r (hk.rename ρ)
   | .proj_disj hd hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_disj hd (hk.rename ρ)
 end
 
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index 3453f5f7..1c0c3da3 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -25,10 +25,10 @@ theorem CaptureKind.csubst
   | .sub hs hk => .sub hs (hk.csubst σ)
   | .empty => .empty
   | .proj_kind => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply CaptureKind.proj_kind
   | .proj hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply CaptureKind.proj $ hk.csubst σ
 
 
@@ -60,19 +60,19 @@ theorem Subcapt.csubst
     cases hb1
     easy
   | .proj h1 => by
-    repeat rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj (h1.csubst σ)
   | .proj_sub hs => by
-    repeat rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_sub hs
   | .proj_l => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_l
   | .proj_r hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_r (hk.csubst σ)
   | .proj_disj hd hk => by
-    rw [← CaptureSet.proj_crename_comm]
+    simp
     apply Subcapt.proj_disj hd (hk.csubst σ)
 end
 
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index 9d822fc4..77822a66 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -28,10 +28,10 @@ theorem CaptureKind.subst
   | .sub hs hk => .sub hs (hk.subst σ)
   | .empty => .empty
   | .proj_kind => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply CaptureKind.proj_kind
   | .proj hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply CaptureKind.proj $ hk.subst σ
 
 
@@ -65,19 +65,19 @@ theorem Subcapt.subst
     simp [CBinding.rename, CBound.rename] at hb1
     apply Subcapt.cbound hb1
   | .proj h1 => by
-    repeat rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj (h1.subst σ)
   | .proj_sub hs => by
-    repeat rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_sub hs
   | .proj_l => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_l
   | .proj_r hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_r (hk.subst σ)
   | .proj_disj hd hk => by
-    rw [← CaptureSet.proj_rename_comm]
+    simp
     apply Subcapt.proj_disj hd (hk.subst σ)
 end
 

From 078f7d25523832d34886423cee23e5fd32981f3d Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 19 Nov 2025 22:25:30 +0100
Subject: [PATCH 19/71] What am i doing with the subset op

---
 Capless/CaptureSet.lean       | 158 +++++++++++++++++++++++++++++++---
 Capless/Classifier.lean       |  20 ++++-
 Capless/Store.lean            |   3 +
 Capless/WellScoped/Basic.lean |  50 ++++++++++-
 4 files changed, 210 insertions(+), 21 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 3c683601..37a3e73d 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -61,16 +61,147 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
   Subset C C2 ->
   Subset C (C1 ∪ C2)
 /- projection distributivity -/
-| proj_empty : Subset .empty (.proj .empty K)
-| empty_proj : Subset (.proj .empty K) .empty
-| proj_union : Subset (.proj (C1 ∪ C2) K) (.union (C1.proj K) (C2.proj K))
-| union_proj : Subset  (.union (C1.proj K) (C2.proj K)) (.proj (C1 ∪ C2) K)
-| proj_proj : Subset (.proj (.proj C K1) K2) (.proj (.proj C K2) K1)
+| proj_empty : Subset C D -> Subset C .empty -> Subset (.proj C K) D
+| proj_union_l : Subset (.union (C1.proj K) (C2.proj K)) C -> Subset (.proj (C1 ∪ C2) K) C
+| proj_union_eq : Subset (.union (C1.proj K) (C2.proj K)) (.proj (C1 ∪ C2) K)
+| proj_union_rl : Subset C (C1.proj K) -> Subset C (.proj (C1 ∪ C2) K)
+| proj_union_rr : Subset C (C2.proj K) -> Subset C (.proj (C1 ∪ C2) K)
+| proj_proj_l : Subset (.proj (.proj C1 K1) K2) C2 -> Subset (.proj (.proj C1 K2) K1) C2
+| proj_proj_r : Subset C1 (.proj (.proj C2 K1) K2) -> Subset C1 (.proj (.proj C2 K2) K1)
+
+theorem CaptureSet.Subset.union_l_inv (h1 : Subset (C1 ∪ C2) C3) : (Subset C1 C3) ∧ (Subset C2 C3) := by
+  generalize h0 : C1 ∪ C2 = C at h1
+  induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
+  case rfl =>
+    apply And.intro
+    apply union_rl .rfl
+    apply union_rr .rfl
+  case union_rl ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply union_rl; assumption)
+  case union_rr ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply union_rr; assumption)
+  case proj_union_rl ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_union_rl; assumption)
+  case proj_union_rr ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_union_rr; assumption)
+  case proj_union_eq =>
+    have ⟨_, _⟩ := h0
+    subst_vars; simp_all
+    apply And.intro
+    apply proj_union_rl .rfl
+    apply proj_union_rr .rfl
+  case proj_proj_r ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_proj_r; assumption)
+
+theorem CaptureSet.Subset.proj_union_l_inv (h1 : Subset (.proj (C1 ∪ C2) K)  C3) : (Subset (C1.proj K) C3) ∧ (Subset (C2.proj K) C3) := by
+  generalize h0 : (C1 ∪ C2).proj K = C at h1
+  induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
+  case rfl =>
+    apply And.intro
+    apply proj_union_rl .rfl
+    apply proj_union_rr .rfl
+  case union_rl ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply union_rl; assumption)
+  case union_rr ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply union_rr; assumption)
+  case proj_empty ha hc iha ihc =>
+    have ⟨_, _⟩ := h0
+    subst_vars; simp_all
+    have ⟨hl, hr⟩ := ha.union_l_inv
+    have ⟨_, _⟩ := hc.union_l_inv
+    apply And.intro <;> apply proj_empty <;> assumption
+  case proj_union_l ha =>
+    have ⟨_, _⟩ := h0
+    subst_vars; simp_all
+    have ⟨hl, hr⟩ := ha.union_l_inv
+    apply And.intro <;> assumption
+  case proj_union_rl ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_union_rl; assumption)
+  case proj_union_rr ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_union_rr; assumption)
+  case proj_proj_r ha ih =>
+    have ⟨hl, hr⟩ := ih
+    apply And.intro <;> (apply proj_proj_r; assumption)
+
+
+theorem CaptureSet.Subset.trans (h1 : Subset C1 C2) (h2 : Subset C2 C3) : Subset C1 C3 := by
+  induction h1 generalizing C3
+  case empty => apply empty
+  case rfl => assumption
+  case union_l ha hb iha ihb =>
+    apply union_l (iha h2) (ihb h2)
+  case union_rl ha ih =>
+    have ⟨hl, hr⟩ := h2.union_l_inv; apply ih; assumption
+  case union_rr ha ih =>
+    have ⟨hl, hr⟩ := h2.union_l_inv; apply ih; assumption
+  case proj_empty ha hc iha ihc =>
+    apply proj_empty
+    apply ihc .empty
+    assumption
+  case proj_union_l ha ih =>
+    apply proj_union_l
+    apply ih h2
+  case proj_union_rl ha ih =>
+    have ⟨hl, hr⟩ := h2.proj_union_l_inv
+    apply ih; assumption
+  case proj_union_rr ha ih =>
+    have ⟨hl, hr⟩ := h2.proj_union_l_inv
+    apply ih; assumption
+  case proj_union_eq =>
+    have ⟨hl, hr⟩ := h2.proj_union_l_inv
+    apply union_l <;> assumption
+  case proj_proj_l ha ih =>
+    apply proj_proj_l
+    apply ih h2
+  case proj_proj_r ha ih =>
+    apply ih
+    apply proj_proj_l h2
+
+theorem CaptureSet.Subset.proj_union_l_rev (h1 : Subset (.proj (C1 ∪ C2) K) C) : Subset (.union (C1.proj K) (C2.proj K)) C := by
+  have ⟨hl, hr⟩ := h1.proj_union_l_inv
+  apply union_l <;> assumption
+
+theorem CaptureSet.Subset.proj_union_r_rev (h1 : Subset C (.proj (C1 ∪ C2) K)) : Subset C (.union (C1.proj K) (C2.proj K)) := by
+  cases h1
+  case empty => apply empty
+  case rfl => apply proj_union_l .rfl
+  case union_l ha hb =>
+    apply union_l (ha.proj_union_r_rev) (hb.proj_union_r_rev)
+  case proj_empty ha hc =>
+    apply proj_empty
+    apply hc.proj_union_r_rev
+    assumption
+  case proj_union_l ha =>
+    -- apply proj_union_l
+    -- apply ha.proj_union_r_rev
+    sorry
+  case proj_union_rl ha =>
+    apply union_rl ha
+  case proj_union_rr ha =>
+    apply union_rr ha
+  case proj_union_eq =>
+    apply rfl
+  case proj_proj_l ha =>
+
+
 
 @[simp]
 instance : HasSubset (CaptureSet n k) where
   Subset := CaptureSet.Subset
 
+@[simp]
+instance : IsTrans (CaptureSet n k) Subset where
+  trans a b c ha hb := CaptureSet.Subset.trans ha hb
+
 /-!
 ## Renaming operations
 -/
@@ -210,12 +341,13 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   case union_rr =>
     simp
     apply! Subset.union_rr
-  case proj_union =>
+  case proj_union_l ha hb iha ihb =>
     simp
-    apply Subset.proj_union
-  case union_proj =>
+    apply Subset.proj_union_l; assumption
+  case proj_proj_l ha iha =>
     simp
-    apply Subset.union_proj
+    apply Subset.proj_proj_l; assumption
+
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
@@ -224,12 +356,12 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   case union_rr =>
     simp
     apply! Subset.union_rr
-  case proj_union =>
+  case proj_union_l ha hb iha ihb =>
     simp
-    apply Subset.proj_union
-  case union_proj =>
+    apply Subset.proj_union_l; assumption
+  case proj_proj_l ha iha =>
     simp
-    apply Subset.union_proj
+    apply Subset.proj_proj_l; assumption
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index c53ef640..ed968537 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -42,6 +42,9 @@ inductive Kind : Type where
   | union : Kind -> Kind -> Kind
   | excl : Kind -> Classifier -> Kind
 
+/-- The top kind -/
+def Kind.any := Kind.classifier .top
+
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
   | base : a.disjoint b -> Disjoint (classifier a) (classifier b)
   | union : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
@@ -241,7 +244,7 @@ theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
         { left; right; assumption }
 
 
-theorem Kind.subkind_refl : Kind.Subkind k k := by
+theorem Kind.Subkind.rfl : Kind.Subkind k k := by
   cases k
   case classifier a =>
     constructor
@@ -249,16 +252,25 @@ theorem Kind.subkind_refl : Kind.Subkind k k := by
   case union a b =>
     apply Subkind.union_l
     apply Subkind.union_r1
-    apply subkind_refl
+    apply rfl
     apply Subkind.union_r2
-    apply subkind_refl
+    apply rfl
   case excl k a =>
     apply Subkind.excl_r
     apply Subkind.excl_l
-    apply subkind_refl
+    apply rfl
     apply Disjoint.excl_this
     unfold Classifier.subclass; simp
 
+theorem Kind.subkind_any : Kind.Subkind K .any := by
+  induction K
+  case classifier a =>
+    apply Subkind.base; apply Classifier.subclass_top
+  case union a b iha ihb =>
+    apply Subkind.union_l <;> assumption
+  case excl K c ih =>
+    apply Subkind.excl_l ih
+
 /- Classifiers fixed for boundary. -/
 def Classifier.control := Classifier.child 0 Classifier.top
 def Kind.control := Kind.classifier .control
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 41fae939..f7a67a0f 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -123,6 +123,9 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c}
+| proj :
+  WellScoped Γ cont C ->
+  WellScoped Γ cont (C.proj K)
 | label :
   Context.LBound Γ x S ->
   Cont.HasLabel cont x tail ->
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index accb19cb..4f3f79b8 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -24,6 +24,33 @@ theorem WellScoped.subset
   case union_rr =>
     cases hsc
     aesop
+  case proj_empty =>
+    constructor
+  case empty_proj =>
+    constructor
+    constructor
+  case proj_union =>
+    constructor
+    cases hsc
+    rename_i ha hb
+    constructor
+    cases ha; assumption
+    cases hb; assumption
+  case union_proj =>
+    constructor <;> constructor
+    cases hsc
+    rename_i h1
+    cases h1; assumption
+    cases hsc
+    rename_i h1
+    cases h1; assumption
+  case proj_proj =>
+    cases hsc
+    rename_i h1
+    cases h1
+    constructor
+    constructor
+    assumption
 
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
@@ -34,10 +61,13 @@ theorem WellScoped.cons
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
+  case ckind ih => apply ckind <;> aesop
   case label =>
     apply label
     easy
     constructor; easy
+  case proj =>
+    constructor; easy
 
 theorem WellScoped.conse
   (hsc : WellScoped Γ cont C) :
@@ -48,10 +78,12 @@ theorem WellScoped.conse
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
+  case ckind ih => apply ckind <;> aesop
   case label =>
     apply label
     easy
     constructor; easy
+  case proj => constructor; easy
 
 theorem WellScoped.scope
   (hsc : WellScoped Γ cont C) :
@@ -62,10 +94,12 @@ theorem WellScoped.scope
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
+  case ckind ih => apply ckind <;> aesop
   case label =>
     apply label
     easy
     constructor; easy
+  case proj => constructor; easy
 
 theorem WellScoped.subcapt
   (hsc : WellScoped Γ cont C)
@@ -94,10 +128,18 @@ theorem WellScoped.subcapt
       cases h
   | .cinstr hb => .csingleton hb hsc
   | .cbound hb => .cbound hb hsc
-  | .proj h1 => _
-  | .proj_sub _ => _
-  | .proj_l => _
-  | .proj_r _ => _
+  | .proj h1 => by
+    constructor
+    cases hsc
+    apply WellScoped.subcapt _ h1; assumption
+  | .proj_sub hs => by
+    constructor
+    cases hsc
+    assumption
+  | .proj_l => by constructor; assumption
+  | .proj_r hs => by
+    cases hsc
+    assumption
   | .proj_disj _ _ => _
 
 theorem WellScoped.var_inv

From e96ea6ac64bc8542478f9fb628c9a4485fe2709f Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 20 Nov 2025 17:21:48 +0100
Subject: [PATCH 20/71] Something about projections

---
 Capless/CaptureSet.lean | 222 ++++++++++++++++++++--------------------
 1 file changed, 109 insertions(+), 113 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 37a3e73d..2cb2465b 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -60,14 +60,12 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | union_rr :
   Subset C C2 ->
   Subset C (C1 ∪ C2)
+| trans : Subset C1 C2 -> Subset C2 C3 -> Subset C1 C3
 /- projection distributivity -/
-| proj_empty : Subset C D -> Subset C .empty -> Subset (.proj C K) D
-| proj_union_l : Subset (.union (C1.proj K) (C2.proj K)) C -> Subset (.proj (C1 ∪ C2) K) C
-| proj_union_eq : Subset (.union (C1.proj K) (C2.proj K)) (.proj (C1 ∪ C2) K)
-| proj_union_rl : Subset C (C1.proj K) -> Subset C (.proj (C1 ∪ C2) K)
-| proj_union_rr : Subset C (C2.proj K) -> Subset C (.proj (C1 ∪ C2) K)
-| proj_proj_l : Subset (.proj (.proj C1 K1) K2) C2 -> Subset (.proj (.proj C1 K2) K1) C2
-| proj_proj_r : Subset C1 (.proj (.proj C2 K1) K2) -> Subset C1 (.proj (.proj C2 K2) K1)
+| proj_empty : Subset (.proj .empty K) .empty
+| proj_union_l : Subset (.union (.proj C1 K) (.proj C2 K)) (.proj (C1 ∪ C2) K)
+| proj_union_r : Subset (.proj (C1 ∪ C2) K) (.union (.proj C1 K) (.proj C2 K))
+| proj : Subset C D -> Subset (.proj C K) (.proj D K)
 
 theorem CaptureSet.Subset.union_l_inv (h1 : Subset (C1 ∪ C2) C3) : (Subset C1 C3) ∧ (Subset C2 C3) := by
   generalize h0 : C1 ∪ C2 = C at h1
@@ -82,117 +80,48 @@ theorem CaptureSet.Subset.union_l_inv (h1 : Subset (C1 ∪ C2) C3) : (Subset C1
   case union_rr ha ih =>
     have ⟨hl, hr⟩ := ih
     apply And.intro <;> (apply union_rr; assumption)
-  case proj_union_rl ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_union_rl; assumption)
-  case proj_union_rr ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_union_rr; assumption)
-  case proj_union_eq =>
+  case trans h1 h2 ih1 ih2 =>
+    have ⟨_, _⟩ := ih2
+    apply And.intro <;> apply! trans _ h1
+  case proj_union_l =>
     have ⟨_, _⟩ := h0
     subst_vars; simp_all
-    apply And.intro
-    apply proj_union_rl .rfl
-    apply proj_union_rr .rfl
-  case proj_proj_r ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_proj_r; assumption)
+    apply And.intro <;> apply proj
+    apply union_rl .rfl
+    apply union_rr .rfl
 
 theorem CaptureSet.Subset.proj_union_l_inv (h1 : Subset (.proj (C1 ∪ C2) K)  C3) : (Subset (C1.proj K) C3) ∧ (Subset (C2.proj K) C3) := by
   generalize h0 : (C1 ∪ C2).proj K = C at h1
   induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
   case rfl =>
-    apply And.intro
-    apply proj_union_rl .rfl
-    apply proj_union_rr .rfl
+    apply And.intro <;> apply proj
+    apply union_rl .rfl
+    apply union_rr .rfl
   case union_rl ha ih =>
     have ⟨hl, hr⟩ := ih
     apply And.intro <;> (apply union_rl; assumption)
   case union_rr ha ih =>
     have ⟨hl, hr⟩ := ih
     apply And.intro <;> (apply union_rr; assumption)
-  case proj_empty ha hc iha ihc =>
-    have ⟨_, _⟩ := h0
+  case trans ha hb iha ihb =>
+    have ⟨_, _⟩ := ihb
+    apply And.intro <;> apply! trans
+  case proj_union_r =>
+    have ⟨⟨_, _⟩, _⟩ := h0
     subst_vars; simp_all
-    have ⟨hl, hr⟩ := ha.union_l_inv
-    have ⟨_, _⟩ := hc.union_l_inv
-    apply And.intro <;> apply proj_empty <;> assumption
-  case proj_union_l ha =>
+    apply And.intro
+    apply union_rl .rfl
+    apply union_rr .rfl
+  case proj ha ih =>
     have ⟨_, _⟩ := h0
     subst_vars; simp_all
-    have ⟨hl, hr⟩ := ha.union_l_inv
-    apply And.intro <;> assumption
-  case proj_union_rl ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_union_rl; assumption)
-  case proj_union_rr ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_union_rr; assumption)
-  case proj_proj_r ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply proj_proj_r; assumption)
-
-
-theorem CaptureSet.Subset.trans (h1 : Subset C1 C2) (h2 : Subset C2 C3) : Subset C1 C3 := by
-  induction h1 generalizing C3
-  case empty => apply empty
-  case rfl => assumption
-  case union_l ha hb iha ihb =>
-    apply union_l (iha h2) (ihb h2)
-  case union_rl ha ih =>
-    have ⟨hl, hr⟩ := h2.union_l_inv; apply ih; assumption
-  case union_rr ha ih =>
-    have ⟨hl, hr⟩ := h2.union_l_inv; apply ih; assumption
-  case proj_empty ha hc iha ihc =>
-    apply proj_empty
-    apply ihc .empty
-    assumption
-  case proj_union_l ha ih =>
-    apply proj_union_l
-    apply ih h2
-  case proj_union_rl ha ih =>
-    have ⟨hl, hr⟩ := h2.proj_union_l_inv
-    apply ih; assumption
-  case proj_union_rr ha ih =>
-    have ⟨hl, hr⟩ := h2.proj_union_l_inv
-    apply ih; assumption
-  case proj_union_eq =>
-    have ⟨hl, hr⟩ := h2.proj_union_l_inv
-    apply union_l <;> assumption
-  case proj_proj_l ha ih =>
-    apply proj_proj_l
-    apply ih h2
-  case proj_proj_r ha ih =>
-    apply ih
-    apply proj_proj_l h2
-
-theorem CaptureSet.Subset.proj_union_l_rev (h1 : Subset (.proj (C1 ∪ C2) K) C) : Subset (.union (C1.proj K) (C2.proj K)) C := by
-  have ⟨hl, hr⟩ := h1.proj_union_l_inv
-  apply union_l <;> assumption
-
-theorem CaptureSet.Subset.proj_union_r_rev (h1 : Subset C (.proj (C1 ∪ C2) K)) : Subset C (.union (C1.proj K) (C2.proj K)) := by
-  cases h1
-  case empty => apply empty
-  case rfl => apply proj_union_l .rfl
-  case union_l ha hb =>
-    apply union_l (ha.proj_union_r_rev) (hb.proj_union_r_rev)
-  case proj_empty ha hc =>
-    apply proj_empty
-    apply hc.proj_union_r_rev
-    assumption
-  case proj_union_l ha =>
-    -- apply proj_union_l
-    -- apply ha.proj_union_r_rev
-    sorry
-  case proj_union_rl ha =>
-    apply union_rl ha
-  case proj_union_rr ha =>
-    apply union_rr ha
-  case proj_union_eq =>
-    apply rfl
-  case proj_proj_l ha =>
-
+    have ⟨_, _⟩ := ha.union_l_inv
+    apply And.intro <;> apply! proj
 
+theorem CaptureSet.Subset.union_monotone (hc : Subset C1 C2) (hd : Subset D1 D2) : Subset (C1 ∪ D1) (C2 ∪ D2) := by
+  apply union_l
+  apply! union_rl
+  apply! union_rr
 
 @[simp]
 instance : HasSubset (CaptureSet n k) where
@@ -341,12 +270,10 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   case union_rr =>
     simp
     apply! Subset.union_rr
-  case proj_union_l ha hb iha ihb =>
-    simp
-    apply Subset.proj_union_l; assumption
-  case proj_proj_l ha iha =>
-    simp
-    apply Subset.proj_proj_l; assumption
+  case proj_empty => simp; apply! Subset.proj_empty
+  case proj_union_l => simp; apply! Subset.proj_union_l
+  case proj_union_r => simp; apply! Subset.proj_union_r
+  case proj => simp; apply! Subset.proj
 
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
@@ -356,12 +283,10 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   case union_rr =>
     simp
     apply! Subset.union_rr
-  case proj_union_l ha hb iha ihb =>
-    simp
-    apply Subset.proj_union_l; assumption
-  case proj_proj_l ha iha =>
-    simp
-    apply Subset.proj_proj_l; assumption
+  case proj_empty => simp; apply! Subset.proj_empty
+  case proj_union_l => simp; apply! Subset.proj_union_l
+  case proj_union_r => simp; apply! Subset.proj_union_r
+  case proj => simp; apply! Subset.proj
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
@@ -371,4 +296,75 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 ## Projections
 -/
 
+/-- A capture set that only has projections on top of singletons. -/
+inductive ProjectedSingletonsOnly: (isSingleton : Bool) -> CaptureSet n k -> Prop where
+  | empty : ProjectedSingletonsOnly false (.empty)
+  | singleton : ProjectedSingletonsOnly true (.singleton s)
+  | csingleton : ProjectedSingletonsOnly true (.csingleton s)
+  | proj : ProjectedSingletonsOnly true C -> ProjectedSingletonsOnly true (C.proj K)
+  | union : ProjectedSingletonsOnly a C1 -> ProjectedSingletonsOnly b C2 -> ProjectedSingletonsOnly false (.union C1 C2)
+
+theorem CaptureSet.push_projection_down (h1 : ProjectedSingletonsOnly a C) : ∃ C1, ProjectedSingletonsOnly a C1 ∧ C1 ⊆ (C.proj K) ∧ (C.proj K) ⊆ C1 := by
+  induction h1 generalizing K
+  case union ha hb iha ihb =>
+    have ⟨Ca, ha1, ha2, ha3⟩ := iha (K:=K)
+    have ⟨Cb, hb1, hb2, hb3⟩ := ihb (K:=K)
+    exists (.union Ca Cb)
+    apply And.intro
+    apply! ProjectedSingletonsOnly.union
+    apply And.intro
+    apply Subset.trans _ .proj_union_l
+    apply Subset.union_monotone ha2 hb2
+    apply Subset.trans .proj_union_r _
+    apply! Subset.union_monotone
+  case proj C K2 ha iha =>
+    have ⟨Ca, ha1, ha2, ha3⟩ := iha (K:=K2)
+    exists Ca.proj K
+    apply And.intro
+    apply! ProjectedSingletonsOnly.proj
+    apply And.intro <;> apply! Subset.proj
+  case empty =>
+    exists .empty
+    apply And.intro .empty
+    apply And.intro .empty .proj_empty
+  case singleton n =>
+    exists (.proj (.singleton n) K)
+    apply And.intro (.proj .singleton)
+    apply And.intro <;> apply Subset.rfl
+  case csingleton n =>
+    exists (.proj (.csingleton n) K)
+    apply And.intro (.proj .csingleton)
+    apply And.intro <;> apply Subset.rfl
+
+/-- There always exists a capture set equivalent to the given C, whose projections are only on top of singletons. -/
+theorem CaptureSet.exists_projected_singleton_only (C : CaptureSet n k) : ∃ C1 a, ProjectedSingletonsOnly a C1 ∧ C1 ⊆ C ∧ C ⊆ C1 := by
+  induction C
+  case empty =>
+    exists .empty, false
+    apply And.intro
+    apply ProjectedSingletonsOnly.empty
+    apply And.intro <;> apply Subset.rfl
+  case union a b ha hb =>
+    have ⟨Ca, _, ha1, ha2, ha3⟩ := ha
+    have ⟨Cb, _, hb1, hb2, hb3⟩ := hb
+    exists (.union Ca Cb), false
+    apply And.intro
+    apply! ProjectedSingletonsOnly.union
+    apply And.intro <;> apply! Subset.union_monotone
+  case singleton n =>
+    exists .singleton n, true
+    apply And.intro ProjectedSingletonsOnly.singleton
+    apply And.intro <;> apply Subset.rfl
+  case csingleton k =>
+    exists .csingleton k, true
+    apply And.intro ProjectedSingletonsOnly.csingleton
+    apply And.intro <;> apply Subset.rfl
+  case proj C K ih =>
+    have ⟨Ca, a, ha1, ha2, ha3⟩ := ih
+    have ⟨Cb, hb1, hb2, hb3⟩ := CaptureSet.push_projection_down ha1 (K:=K)
+    exists Cb, a
+    apply And.intro hb1
+    apply And.intro
+    apply Subset.trans hb2 (.proj ha2)
+    apply Subset.trans (.proj ha3) hb3
 end Capless

From 66822bfa000b2919edc71a32df7d9a821225476e Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 20 Nov 2025 19:33:15 +0100
Subject: [PATCH 21/71] Proj rules need some help

---
 Capless/CaptureSet.lean        |  12 ++++
 Capless/Classifier.lean        |   2 +-
 Capless/Context.lean           |  28 ++++-----
 Capless/Inversion/Context.lean |  36 +++++------
 Capless/Store.lean             |  48 ++++++++-------
 Capless/Subcapturing.lean      |   7 ++-
 Capless/Term.lean              |  12 ++--
 Capless/Typing.lean            |   7 ++-
 Capless/WellScoped/Basic.lean  | 107 +++++++++++++++------------------
 9 files changed, 135 insertions(+), 124 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 2cb2465b..3969f4d5 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -65,6 +65,8 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | proj_empty : Subset (.proj .empty K) .empty
 | proj_union_l : Subset (.union (.proj C1 K) (.proj C2 K)) (.proj (C1 ∪ C2) K)
 | proj_union_r : Subset (.proj (C1 ∪ C2) K) (.union (.proj C1 K) (.proj C2 K))
+| proj_proj : Subset (.proj (.proj C K1) K2) (.proj (.proj C K2) K1) -- allows us to consider only the relevant projection
+| proj_l : Subset (.proj C K) C -- allows introducing projections anywhere
 | proj : Subset C D -> Subset (.proj C K) (.proj D K)
 
 theorem CaptureSet.Subset.union_l_inv (h1 : Subset (C1 ∪ C2) C3) : (Subset C1 C3) ∧ (Subset C2 C3) := by
@@ -112,6 +114,12 @@ theorem CaptureSet.Subset.proj_union_l_inv (h1 : Subset (.proj (C1 ∪ C2) K)  C
     apply And.intro
     apply union_rl .rfl
     apply union_rr .rfl
+  case proj_l =>
+    have ⟨_, _⟩ := h0
+    subst_vars; simp_all
+    apply And.intro
+    apply union_rl .proj_l
+    apply union_rr .proj_l
   case proj ha ih =>
     have ⟨_, _⟩ := h0
     subst_vars; simp_all
@@ -273,6 +281,8 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
   case proj_empty => simp; apply! Subset.proj_empty
   case proj_union_l => simp; apply! Subset.proj_union_l
   case proj_union_r => simp; apply! Subset.proj_union_r
+  case proj_proj => simp; apply! Subset.proj_proj
+  case proj_l => simp; apply! Subset.proj_l
   case proj => simp; apply! Subset.proj
 
 
@@ -286,6 +296,8 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   case proj_empty => simp; apply! Subset.proj_empty
   case proj_union_l => simp; apply! Subset.proj_union_l
   case proj_union_r => simp; apply! Subset.proj_union_r
+  case proj_proj => simp; apply! Subset.proj_proj
+  case proj_l => simp; apply! Subset.proj_l
   case proj => simp; apply! Subset.proj
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index ed968537..6180e578 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -273,4 +273,4 @@ theorem Kind.subkind_any : Kind.Subkind K .any := by
 
 /- Classifiers fixed for boundary. -/
 def Classifier.control := Classifier.child 0 Classifier.top
-def Kind.control := Kind.classifier .control
+def Kind.only_control := Kind.classifier .control
diff --git a/Capless/Context.lean b/Capless/Context.lean
index 2407061f..7c9092b3 100644
--- a/Capless/Context.lean
+++ b/Capless/Context.lean
@@ -36,7 +36,7 @@ inductive CBinding : Nat -> Nat -> Type where
 inductive Context : Nat -> Nat -> Nat -> Type where
 | empty : Context 0 0 0
 | var : Context n m k -> CType n m k -> Context (n+1) m k
-| label : Context n m k -> SType n m k -> Context (n+1) m k
+| label : Context n m k -> Classifier -> SType n m k -> Context (n+1) m k
 | tvar : Context n m k -> TBinding n m k -> Context n (m+1) k
 | cvar : Context n m k -> CBinding n k -> Context n m (k+1)
 
@@ -126,7 +126,7 @@ inductive Context.Bound : Context n m k -> Fin n -> CType n m k -> Prop where
   Bound (cvar Γ b) x E.cweaken
 | there_label :
   Bound Γ x E ->
-  Bound (label Γ S) (Fin.succ x) E.weaken
+  Bound (label Γ c S) (Fin.succ x) E.weaken
 
 inductive Context.TBound : Context n m k -> Fin m -> TBinding n m k -> Prop where
 | here : TBound (tvar Γ0 b) 0 b.tweaken
@@ -141,7 +141,7 @@ inductive Context.TBound : Context n m k -> Fin m -> TBinding n m k -> Prop wher
   TBound (cvar Γ b') x b.cweaken
 | there_label :
   TBound Γ x b ->
-  TBound (label Γ S) x b.weaken
+  TBound (label Γ c S) x b.weaken
 
 inductive Context.CBound : Context n m k -> Fin k -> CBinding n k -> Prop where
 | here : CBound (cvar Γ0 b) 0 b.cweaken
@@ -156,22 +156,22 @@ inductive Context.CBound : Context n m k -> Fin k -> CBinding n k -> Prop where
   CBound (cvar Γ b') (Fin.succ x) b.cweaken
 | there_label :
   CBound Γ x b ->
-  CBound (label Γ S) x b.weaken
+  CBound (label Γ c S) x b.weaken
 
-inductive Context.LBound : Context n m k -> Fin n -> SType n m k -> Prop where
-| here : LBound (label Γ0 S) 0 S.weaken
+inductive Context.LBound : Context n m k -> Fin n -> Classifier -> SType n m k -> Prop where
+| here : LBound (label Γ0 c S) 0 c S.weaken
 | there_var :
-  LBound Γ x S ->
-  LBound (var Γ E) x.succ S.weaken
+  LBound Γ x c S ->
+  LBound (var Γ E) x.succ c S.weaken
 | there_tvar :
-  LBound Γ x S ->
-  LBound (tvar Γ b) x S.tweaken
+  LBound Γ x c S ->
+  LBound (tvar Γ b) x c S.tweaken
 | there_cvar :
-  LBound Γ x S ->
-  LBound (cvar Γ b) x S.cweaken
+  LBound Γ x c S ->
+  LBound (cvar Γ b) x c S.cweaken
 | there_label :
-  LBound Γ x S ->
-  LBound (label Γ S') x.succ S.weaken
+  LBound Γ x c S ->
+  LBound (label Γ c' S') x.succ c S.weaken
 
 /-!
 
diff --git a/Capless/Inversion/Context.lean b/Capless/Inversion/Context.lean
index 17954fe6..e2b3c3b3 100644
--- a/Capless/Inversion/Context.lean
+++ b/Capless/Inversion/Context.lean
@@ -163,19 +163,19 @@ theorem Context.cvar_tbound_inv_bound
     simp [TBinding.cweaken, TBinding.crename] at he0
 
 theorem Context.label_tbound_inv'
-  (he : Γ0 = Γ.label l)
+  (he : Γ0 = Γ.label c l)
   (hb : Context.TBound Γ0 X b) :
   ∃ b0, Context.TBound Γ X b0 ∧ b = b0.weaken := by
   cases hb <;> try (solve | cases he)
   case there_label b0 hb0 => aesop
 
 theorem Context.label_tbound_inv
-  (hb : Context.TBound (Γ.label l) X b) :
+  (hb : Context.TBound (Γ.label c l) X b) :
   ∃ b0, Context.TBound Γ X b0 ∧ b = b0.weaken :=
   Context.label_tbound_inv' rfl hb
 
 theorem Context.label_tbound_inv_bound
-  (hb : Context.TBound (Γ.label l) X (TBinding.bound S)) :
+  (hb : Context.TBound (Γ.label c l) X (TBinding.bound S)) :
   ∃ S0, Context.TBound Γ X (TBinding.bound S0) ∧ S = SType.weaken S0 := by
   have ⟨b0, hb0, he0⟩ := Context.label_tbound_inv hb
   cases b0
@@ -325,31 +325,31 @@ theorem Context.tbound_inj
 
 theorem Context.var_lbound_succ_inv'
   (he1 : Γ0 = Γ.var T) (he2 : x0 = x.succ)
-  (hb : Context.LBound Γ0 x0 S) :
-  ∃ S0, Context.LBound Γ x S0 ∧ S = S0.weaken := by
+  (hb : Context.LBound Γ0 x0 c S) :
+  ∃ S0, Context.LBound Γ x c S0 ∧ S = S0.weaken := by
   cases hb <;> try (solve | cases he1 | cases he2)
   case there_var => aesop
 
 theorem Context.var_lbound_succ_inv
-  (hb : Context.LBound (Γ.var T) x.succ S) :
-  ∃ S0, Context.LBound Γ x S0 ∧ S = S0.weaken := by
+  (hb : Context.LBound (Γ.var T) x.succ c S) :
+  ∃ S0, Context.LBound Γ x c S0 ∧ S = S0.weaken := by
   apply Context.var_lbound_succ_inv' rfl rfl hb
 
 theorem Context.label_lbound_succ_inv'
-  (he1 : Γ0 = Γ.label l) (he2 : x0 = x.succ)
-  (hb : Context.LBound Γ0 x0 S) :
-  ∃ S0, Context.LBound Γ x S0 ∧ S = S0.weaken := by
+  (he1 : Γ0 = Γ.label c' l) (he2 : x0 = x.succ)
+  (hb : Context.LBound Γ0 x0 c S) :
+  ∃ S0, Context.LBound Γ x c S0 ∧ S = S0.weaken := by
   cases hb <;> try (solve | cases he1 | cases he2)
   case there_label => aesop
 
 theorem Context.label_lbound_succ_inv
-  (hb : Context.LBound (Γ.label l) x.succ S) :
-  ∃ S0, Context.LBound Γ x S0 ∧ S = S0.weaken := by
+  (hb : Context.LBound (Γ.label c' l) x.succ c S) :
+  ∃ S0, Context.LBound Γ x c S0 ∧ S = S0.weaken := by
   apply Context.label_lbound_succ_inv' rfl rfl hb
 
 theorem Context.bound_lbound_absurd
   (hb1 : Context.Bound Γ x T)
-  (hb2 : Context.LBound Γ x S) : False := by
+  (hb2 : Context.LBound Γ x c S) : False := by
   induction Γ
   case empty => cases hb1
   case var ih =>
@@ -372,14 +372,14 @@ theorem Context.bound_lbound_absurd
       apply ih <;> assumption
 
 theorem Context.label_bound_succ_inv'
-  (he1 : Γ0 = Γ.label l) (he2 : x0 = x.succ)
+  (he1 : Γ0 = Γ.label c' l) (he2 : x0 = x.succ)
   (hb : Context.Bound Γ0 x0 T) :
   ∃ T0, Context.Bound Γ x T0 ∧ T = T0.weaken := by
   cases hb <;> try (solve | cases he1 | cases he2)
   case there_label => aesop
 
 theorem Context.label_bound_succ_inv
-  (hb : Context.Bound (Γ.label l) x.succ T) :
+  (hb : Context.Bound (Γ.label c' l) x.succ T) :
   ∃ T0, Context.Bound Γ x T0 ∧ T = T0.weaken := by
   apply Context.label_bound_succ_inv' rfl rfl hb
 
@@ -429,10 +429,10 @@ theorem Context.bound_injective
     aesop
 
 theorem Context.lbound_inj
-  (hb1 : Context.LBound Γ x S1)
-  (hb2 : Context.LBound Γ x S2) : S1 = S2 := by
+  (hb1 : Context.LBound Γ x c1 S1)
+  (hb2 : Context.LBound Γ x c2 S2) : c1 = c2 ∧ S1 = S2 := by
   induction hb1
-  case here => cases hb2; rfl
+  case here => cases hb2; apply And.intro <;> rfl
   case there_var ih =>
     have ⟨S2, hb2, he2⟩ := Context.var_lbound_succ_inv hb2
     have ih := ih hb2
diff --git a/Capless/Store.lean b/Capless/Store.lean
index f7a67a0f..52b995ad 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -37,6 +37,7 @@ inductive Store : Nat -> Nat -> Nat -> Type where
   Store n m (k+1)
 | label :
   Store n m k ->
+  Classifier ->
   SType n m k ->
   Store (n+1) m k
 
@@ -80,7 +81,7 @@ inductive TypedStore : Store n m k -> Context n m k -> Prop where
   TypedStore (Store.cval σ C) (Γ.cvar (CBinding.inst C))
 | label :
   TypedStore σ Γ ->
-  TypedStore (Store.label σ S) (Γ.label S)
+  TypedStore (Store.label σ c S) (Γ.label c S)
 
 /-- Checks whether a label is in the scope of a continuation stack. This corresponds to the paper definition of finding whether there exists a `scope` form for that label in the evaluation context, like in the (BREAKOUT) rule of Fig. 6.
  -/
@@ -107,7 +108,11 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | union :
   WellScoped Γ cont C1 ->
   WellScoped Γ cont C2 ->
-  WellScoped Γ cont (C1 ∪ C2)
+  WellScoped Γ cont (.union C1 C2)
+| proj :
+  WellScoped Γ cont C1 ->
+  (.proj C2 K) ⊆ C1 ->
+  WellScoped Γ cont (.proj C2 K)
 | singleton :
   Context.Bound Γ x (S^C) ->
   WellScoped Γ cont C ->
@@ -123,13 +128,14 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c}
-| proj :
-  WellScoped Γ cont C ->
-  WellScoped Γ cont (C.proj K)
 | label :
-  Context.LBound Γ x S ->
+  Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
   WellScoped Γ cont {x=x}
+| label_disj :
+  Context.LBound Γ x c S ->
+  Kind.Disjoint K (.classifier c) ->
+  WellScoped Γ cont (.proj {x=x} K)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
 inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
@@ -147,7 +153,7 @@ inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k
   TypedCont Γ E cont E' C ->
   TypedCont Γ (EType.ex B T) (Cont.conse t cont) E' (C ∪ Ct)
 | scope :
-  Context.LBound Γ x S ->
+  Context.LBound Γ x c S ->
   TypedCont Γ (S^{}) cont E' C ->
   (Γ ⊢ T0 <: S^{}) ->
   TypedCont Γ (EType.type T0) (Cont.scope x cont) E' C
@@ -181,7 +187,7 @@ inductive Store.Bound : Store n m k -> (Fin n) -> Term n m k -> Prop where
   Store.Bound (Store.cval σ C) x t.cweaken
 | there_label :
   Store.Bound σ x t ->
-  Store.Bound (Store.label σ S) (Fin.succ x) t.weaken
+  Store.Bound (Store.label σ c S) (Fin.succ x) t.weaken
 
 inductive Store.TBound : Store n m k -> (Fin m) -> SType n m k -> Prop where
 | here :
@@ -197,7 +203,7 @@ inductive Store.TBound : Store n m k -> (Fin m) -> SType n m k -> Prop where
   Store.TBound (Store.cval σ C) x S.cweaken
 | there_label :
   Store.TBound σ x S ->
-  Store.TBound (Store.label σ S') x S.weaken
+  Store.TBound (Store.label σ c S') x S.weaken
 
 inductive Store.CBound : Store n m k -> (Fin k) -> CaptureSet n k -> Prop where
 | here :
@@ -213,23 +219,23 @@ inductive Store.CBound : Store n m k -> (Fin k) -> CaptureSet n k -> Prop where
   Store.CBound (Store.cval σ C') (Fin.succ x) C.cweaken
 | there_label :
   Store.CBound σ x C ->
-  Store.CBound (Store.label σ S) x C.weaken
+  Store.CBound (Store.label σ c S) x C.weaken
 
-inductive Store.LBound : Store n m k -> (Fin n) -> SType n m k -> Prop where
+inductive Store.LBound : Store n m k -> (Fin n) -> Classifier -> SType n m k -> Prop where
 | here :
-  Store.LBound (Store.label σ S) 0 S.weaken
+  Store.LBound (Store.label σ c S) 0 c S.weaken
 | there_val :
-  Store.LBound σ x S ->
-  Store.LBound (Store.val σ t hv) x.succ S.weaken
+  Store.LBound σ x c S ->
+  Store.LBound (Store.val σ t hv) x.succ c S.weaken
 | there_tval :
-  Store.LBound σ x S ->
-  Store.LBound (Store.tval σ S') x S.tweaken
+  Store.LBound σ x c S ->
+  Store.LBound (Store.tval σ S') x c S.tweaken
 | there_cval :
-  Store.LBound σ x S ->
-  Store.LBound (Store.cval σ C) x S.cweaken
+  Store.LBound σ x c S ->
+  Store.LBound (Store.cval σ C) x c S.cweaken
 | there_label :
-  Store.LBound σ x S ->
-  Store.LBound (Store.label σ S') x.succ S.weaken
+  Store.LBound σ x c S ->
+  Store.LBound (Store.label σ c' S') x.succ c S.weaken
 
 /-!
 ## Weakening of Continuation Stack
@@ -274,7 +280,7 @@ inductive Context.IsTight : Context n m k -> Prop where
   Context.IsTight (Γ.cvar (CBinding.inst C))
 | label :
   Context.IsTight Γ ->
-  Context.IsTight (Γ.label S)
+  Context.IsTight (Γ.label c S)
 
 /-- The typing context of a store is always tight. -/
 theorem TypedStore.is_tight
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index c5815430..d213c4e1 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -36,16 +36,15 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
 | proj :
-  Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
+  Subcapt Γ {s=s} C2 -> Subcapt Γ ({s=s}.proj K) (C2.proj K)
 | proj_sub {C : CaptureSet n k} {K1 K2 : Kind}:
   K1.Subkind K2 -> Subcapt Γ (C.proj K1) (C.proj K2)
-| proj_l : Subcapt Γ (C.proj K) C
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
 | proj_disj : Kind.Disjoint K1 K2 -> CaptureKind Γ C K1 -> Subcapt Γ (C.proj K2) .empty
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   -- | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  | label : Context.LBound Γ x S -> CaptureKind Γ {x=x} Kind.control
+  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.classifier c)
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
   | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
@@ -54,6 +53,8 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
 end
 
+theorem Subcapt.proj_l :  Subcapt Γ (C.proj K) C := by
+  apply Subcapt.subset .proj_l
 
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
diff --git a/Capless/Term.lean b/Capless/Term.lean
index 33bd8453..b1622469 100644
--- a/Capless/Term.lean
+++ b/Capless/Term.lean
@@ -61,8 +61,8 @@ inductive Term : Nat -> Nat -> Nat -> Type where
 | bindt : SType n m k -> Term n (m+1) k -> Term n m k
 /-- Capture binding. -/
 | bindc : CaptureSet n k -> Term n m (k+1) -> Term n m k
-/-- Boundary form `boundary[S] as <c,x> in t`. -/
-| boundary : SType n m k -> Term (n+1) m (k+1) -> Term n m k
+/-- Boundary form `boundary[c] as <c,x> in t`. -/
+| boundary : Classifier -> SType n m k -> Term (n+1) m (k+1) -> Term n m k
 
 /-!
 ## Notations
@@ -75,7 +75,7 @@ notation:40 "let" "x=" t " in " u => Term.letin t u
 notation:40 "let" "(c,x)=" t " in " u => Term.letex t u
 notation:40 "let" "X=" S " in " t => Term.bindt S t
 notation:40 "let" "c=" C " in " t => Term.bindc C t
-notation:40 "boundary:" S " in " t => Term.boundary S t
+notation:40 "boundary[" c "]:" S " in " t => Term.boundary c S t
 
 /-- Whether this term is a value? -/
 @[aesop safe constructors]
@@ -105,7 +105,7 @@ def Term.rename (t : Term n m k) (f : FinFun n n') : Term n' m k :=
   | Term.letex t u => Term.letex (t.rename f) (u.rename f.ext)
   | Term.bindt S t => Term.bindt (S.rename f) (t.rename f)
   | Term.bindc c t => Term.bindc (c.rename f) (t.rename f)
-  | Term.boundary S t => Term.boundary (S.rename f) (t.rename f.ext)
+  | Term.boundary c S t => Term.boundary c (S.rename f) (t.rename f.ext)
 
 def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   match t with
@@ -122,7 +122,7 @@ def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   | Term.letex t u => Term.letex (t.trename f) (u.trename f)
   | Term.bindt S t => Term.bindt (S.trename f) (t.trename f.ext)
   | Term.bindc c t => Term.bindc c (t.trename f)
-  | Term.boundary S t => Term.boundary (S.trename f) (t.trename f)
+  | Term.boundary c S t => Term.boundary c (S.trename f) (t.trename f)
 
 def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   match t with
@@ -139,7 +139,7 @@ def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   | Term.letex t u => Term.letex (t.crename f) (u.crename f.ext)
   | Term.bindt S t => Term.bindt (S.crename f) (t.crename f)
   | Term.bindc c t => Term.bindc (c.crename f) (t.crename f.ext)
-  | Term.boundary S t => Term.boundary (S.crename f) (t.crename f.ext)
+  | Term.boundary c S t => Term.boundary c (S.crename f) (t.crename f.ext)
 
 def Term.weaken (t : Term n m k) : Term (n+1) m k := t.rename FinFun.weaken
 
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 942838c4..4b0e6380 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -19,7 +19,7 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Context.Bound Γ x (S^C) ->
   Typed Γ (Term.var x) (S^{x=x}) {x=x}
 | label :
-  Context.LBound Γ x S ->
+  Context.LBound Γ x c S ->
   Typed Γ (Term.var x) (Label[S]^{x=x}) {x=x}
 | pack :
   CaptureBound Γ C B ->
@@ -68,11 +68,12 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed (Γ,c:=C) t E.cweaken C0.cweaken ->
   Typed Γ (let c=C in t) E C0
 | boundary {Γ : Context n m k} {S : SType n m k} :
+  c.subclass .control ->
   Typed
-    ((Γ,c<:CBound.kind .control),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:CBound.kind (.classifier c)),x: Label[S.cweaken]^{c=0})
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0} ∪ {x=0}) ->
-  Typed Γ (boundary: S in t) (S^CaptureSet.empty) C
+  Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
 
 notation:40 Γ " ⊢ " t:80 " : " E " @ " C => Typed Γ t E C
 
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 4f3f79b8..9774406d 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,53 +11,55 @@ This file contains basic properties of the well-scopedness relation.
 namespace Capless
 
 theorem WellScoped.subset
-  (hsc : WellScoped Γ cont C)
-  (hs : C' ⊆ C) :
-  WellScoped Γ cont C' := by
+  (hsc : WellScoped Γ cont C2)
+  (hs : C1 ⊆ C2) : WellScoped Γ cont C1 := by
   induction hs
   case empty => apply empty
-  case rfl => easy
-  case union_l => apply WellScoped.union <;> aesop
-  case union_rl =>
-    cases hsc
-    aesop
-  case union_rr =>
-    cases hsc
-    aesop
-  case proj_empty =>
-    constructor
-  case empty_proj =>
-    constructor
-    constructor
-  case proj_union =>
-    constructor
-    cases hsc
-    rename_i ha hb
-    constructor
-    cases ha; assumption
-    cases hb; assumption
-  case union_proj =>
-    constructor <;> constructor
+  case rfl => apply hsc
+  case union_l ha hb iha ihb => apply union (iha hsc) (ihb hsc)
+  case union_rl ha iha => cases hsc; aesop
+  case union_rr ha iha => cases hsc; aesop
+  case trans ha hb iha ihb => apply iha $ ihb hsc
+  case proj_empty => apply proj .empty .proj_empty
+  case proj_union_l =>
     cases hsc
     rename_i h1
-    cases h1; assumption
+    have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h1
+    apply union <;> apply proj <;> aesop
+  case proj_union_r =>
     cases hsc
-    rename_i h1
-    cases h1; assumption
+    rename_i h1 h2
+    apply proj
+    apply union h1 h2
+    apply CaptureSet.Subset.proj_union_r
   case proj_proj =>
     cases hsc
-    rename_i h1
-    cases h1
-    constructor
-    constructor
-    assumption
+    rename_i h1 h2
+    apply proj h1
+    apply CaptureSet.Subset.trans .proj_proj h2
+  case proj_l =>
+    apply proj hsc .proj_l
+  case proj ha ih =>
+    cases hsc
+    case proj =>
+      rename_i h1 ih2
+      apply proj h1
+      apply CaptureSet.Subset.trans _ ih2
+      apply! CaptureSet.Subset.proj
+    case label_disj =>
+      apply proj
+      apply! label_disj
+      apply! CaptureSet.Subset.proj
+
+
 
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
   WellScoped Γ (Cont.cons u cont) C := by
   induction hsc
   case empty => apply empty
-  case union ih1 ih2 => apply union <;> aesop
+  case union => apply union <;> aesop
+  case proj => apply proj <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
@@ -66,15 +68,16 @@ theorem WellScoped.cons
     apply label
     easy
     constructor; easy
-  case proj =>
-    constructor; easy
+  case label_disj hb hd =>
+    apply! label_disj
 
 theorem WellScoped.conse
   (hsc : WellScoped Γ cont C) :
   WellScoped Γ (Cont.conse u cont) C := by
   induction hsc
   case empty => apply empty
-  case union ih1 ih2 => apply union <;> aesop
+  case union => apply union <;> aesop
+  case proj => apply proj <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
@@ -83,14 +86,15 @@ theorem WellScoped.conse
     apply label
     easy
     constructor; easy
-  case proj => constructor; easy
+  case label_disj => apply! label_disj
 
 theorem WellScoped.scope
   (hsc : WellScoped Γ cont C) :
   WellScoped Γ (Cont.scope x cont) C := by
   induction hsc
   case empty => apply empty
-  case union ih1 ih2 => apply union <;> aesop
+  case union => apply union <;> aesop
+  case proj => apply proj <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
@@ -99,7 +103,7 @@ theorem WellScoped.scope
     apply label
     easy
     constructor; easy
-  case proj => constructor; easy
+  case label_disj => apply! label_disj
 
 theorem WellScoped.subcapt
   (hsc : WellScoped Γ cont C)
@@ -111,27 +115,13 @@ theorem WellScoped.subcapt
   | .union ha hb => .union (.subcapt hsc ha) (.subcapt hsc hb)
   | .var hb => .singleton hb hsc
   | .cinstl hb1 => by
-    cases hsc
-    case csingleton =>
-      rename_i hb2
-      have h := Context.cbound_injective hb1 hb2
-      cases h
-      rename_i h
-      exact h
-    case cbound =>
-      rename_i hb2
-      have h := Context.cbound_injective hb1 hb2
-      cases h
-    case ckind =>
-      rename_i hb2
-      have h := Context.cbound_injective hb1 hb2
-      cases h
+    cases hsc <;> (rename_i hb2; cases Context.cbound_injective hb1 hb2)
+    assumption
   | .cinstr hb => .csingleton hb hsc
   | .cbound hb => .cbound hb hsc
   | .proj h1 => by
-    constructor
     cases hsc
-    apply WellScoped.subcapt _ h1; assumption
+    rename_i s D2 K D3 hsc hs
   | .proj_sub hs => by
     constructor
     cases hsc
@@ -140,7 +130,8 @@ theorem WellScoped.subcapt
   | .proj_r hs => by
     cases hsc
     assumption
-  | .proj_disj _ _ => _
+  | .proj_disj hd hk => by sorry
+
 
 theorem WellScoped.var_inv
   (hsc : WellScoped Γ cont {x=x})

From 9b93a59e8c92365770259da7775dc4b2518fbd6d Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 24 Nov 2025 18:31:00 +0100
Subject: [PATCH 22/71] WIP depth

---
 Capless/CaptureSet.lean       | 49 +++++++++++++++++++++++++----------
 Capless/Store.lean            |  1 +
 Capless/WellScoped/Basic.lean | 12 ++++++---
 3 files changed, 44 insertions(+), 18 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 3969f4d5..8884acef 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -34,6 +34,14 @@ inductive CaptureSet : Nat -> Nat -> Type where
 | csingleton : Fin k -> CaptureSet n k
 | proj : CaptureSet n k -> Kind -> CaptureSet n k
 
+@[simp]
+def CaptureSet.depth : CaptureSet n k -> Nat
+  | empty => 0
+  | union a b => 1 + max a.depth b.depth
+  | singleton _ => 1
+  | csingleton _ => 1
+  | proj c _ => 1 + c.depth
+
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
@@ -316,67 +324,80 @@ inductive ProjectedSingletonsOnly: (isSingleton : Bool) -> CaptureSet n k -> Pro
   | proj : ProjectedSingletonsOnly true C -> ProjectedSingletonsOnly true (C.proj K)
   | union : ProjectedSingletonsOnly a C1 -> ProjectedSingletonsOnly b C2 -> ProjectedSingletonsOnly false (.union C1 C2)
 
-theorem CaptureSet.push_projection_down (h1 : ProjectedSingletonsOnly a C) : ∃ C1, ProjectedSingletonsOnly a C1 ∧ C1 ⊆ (C.proj K) ∧ (C.proj K) ⊆ C1 := by
+theorem CaptureSet.push_projection_down (h1 : ProjectedSingletonsOnly a C) : ∃ C1, ProjectedSingletonsOnly a C1 ∧ C1.depth ≤ (C.proj K).depth ∧ C1 ⊆ (C.proj K) ∧ (C.proj K) ⊆ C1 := by
   induction h1 generalizing K
   case union ha hb iha ihb =>
-    have ⟨Ca, ha1, ha2, ha3⟩ := iha (K:=K)
-    have ⟨Cb, hb1, hb2, hb3⟩ := ihb (K:=K)
+    have ⟨Ca, ha1, ha2, ha3, ha4⟩ := iha (K:=K)
+    have ⟨Cb, hb1, hb2, hb3, hb4⟩ := ihb (K:=K)
     exists (.union Ca Cb)
     apply And.intro
     apply! ProjectedSingletonsOnly.union
     apply And.intro
+    simp at ha2 hb2
+    simp; omega
+    apply And.intro
     apply Subset.trans _ .proj_union_l
-    apply Subset.union_monotone ha2 hb2
+    apply Subset.union_monotone ha3 hb3
     apply Subset.trans .proj_union_r _
     apply! Subset.union_monotone
   case proj C K2 ha iha =>
-    have ⟨Ca, ha1, ha2, ha3⟩ := iha (K:=K2)
+    have ⟨Ca, ha1, ha2, ha3, ha4⟩ := iha (K:=K2)
     exists Ca.proj K
     apply And.intro
     apply! ProjectedSingletonsOnly.proj
+    apply And.intro
+    simp at ha2
+    simp; assumption
     apply And.intro <;> apply! Subset.proj
   case empty =>
     exists .empty
     apply And.intro .empty
+    apply And.intro; simp
     apply And.intro .empty .proj_empty
   case singleton n =>
     exists (.proj (.singleton n) K)
     apply And.intro (.proj .singleton)
+    apply And.intro; simp
     apply And.intro <;> apply Subset.rfl
   case csingleton n =>
     exists (.proj (.csingleton n) K)
     apply And.intro (.proj .csingleton)
+    apply And.intro; simp
     apply And.intro <;> apply Subset.rfl
 
 /-- There always exists a capture set equivalent to the given C, whose projections are only on top of singletons. -/
-theorem CaptureSet.exists_projected_singleton_only (C : CaptureSet n k) : ∃ C1 a, ProjectedSingletonsOnly a C1 ∧ C1 ⊆ C ∧ C ⊆ C1 := by
+theorem CaptureSet.exists_projected_singleton_only (C : CaptureSet n k) : ∃ C1 a, ProjectedSingletonsOnly a C1 ∧ C1.depth ≤ C.depth ∧ C1 ⊆ C ∧ C ⊆ C1 := by
   induction C
   case empty =>
     exists .empty, false
-    apply And.intro
-    apply ProjectedSingletonsOnly.empty
+    apply And.intro ProjectedSingletonsOnly.empty
+    apply And.intro; simp
     apply And.intro <;> apply Subset.rfl
   case union a b ha hb =>
-    have ⟨Ca, _, ha1, ha2, ha3⟩ := ha
-    have ⟨Cb, _, hb1, hb2, hb3⟩ := hb
+    have ⟨Ca, _, ha1, ha2, ha3, ha4⟩ := ha
+    have ⟨Cb, _, hb1, hb2, hb3, hb4⟩ := hb
     exists (.union Ca Cb), false
     apply And.intro
     apply! ProjectedSingletonsOnly.union
+    apply And.intro; simp; omega
     apply And.intro <;> apply! Subset.union_monotone
   case singleton n =>
     exists .singleton n, true
     apply And.intro ProjectedSingletonsOnly.singleton
+    apply And.intro; simp
     apply And.intro <;> apply Subset.rfl
   case csingleton k =>
     exists .csingleton k, true
     apply And.intro ProjectedSingletonsOnly.csingleton
+    apply And.intro; simp
     apply And.intro <;> apply Subset.rfl
   case proj C K ih =>
-    have ⟨Ca, a, ha1, ha2, ha3⟩ := ih
-    have ⟨Cb, hb1, hb2, hb3⟩ := CaptureSet.push_projection_down ha1 (K:=K)
+    have ⟨Ca, a, ha1, ha2, ha3, ha4⟩ := ih
+    have ⟨Cb, hb1, hb2, hb3, hb4⟩ := CaptureSet.push_projection_down ha1 (K:=K)
     exists Cb, a
     apply And.intro hb1
+    apply And.intro; simp at hb2; simp; omega
     apply And.intro
-    apply Subset.trans hb2 (.proj ha2)
-    apply Subset.trans (.proj ha3) hb3
+    apply Subset.trans hb3 (.proj ha3)
+    apply Subset.trans (.proj ha4) hb4
 end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 52b995ad..ca69d8d6 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -112,6 +112,7 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | proj :
   WellScoped Γ cont C1 ->
   (.proj C2 K) ⊆ C1 ->
+  C1.depth ≤ C2.depth + 1 ->
   WellScoped Γ cont (.proj C2 K)
 | singleton :
   Context.Bound Γ x (S^C) ->
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 9774406d..578030be 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -20,12 +20,16 @@ theorem WellScoped.subset
   case union_rl ha iha => cases hsc; aesop
   case union_rr ha iha => cases hsc; aesop
   case trans ha hb iha ihb => apply iha $ ihb hsc
-  case proj_empty => apply proj .empty .proj_empty
+  case proj_empty =>
+    apply proj .empty .proj_empty
+    simp
   case proj_union_l =>
     cases hsc
-    rename_i h1
-    have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h1
-    apply union <;> apply proj <;> aesop
+    rename_i h1 h2 h3
+    have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h3
+    apply union
+    { apply proj h1 hl;  }
+
   case proj_union_r =>
     cases hsc
     rename_i h1 h2

From 57e4a35912fa46fdf0b2e3b3d923c719e7fd0db8 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 25 Nov 2025 20:01:49 +0100
Subject: [PATCH 23/71] ?

---
 Capless/CaptureSet.lean       | 496 ++++++++++++++++++++++------------
 Capless/Store.lean            |  18 +-
 Capless/Subcapturing.lean     |   7 +-
 Capless/WellScoped/Basic.lean | 152 ++++++++---
 4 files changed, 455 insertions(+), 218 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 8884acef..e848860a 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -48,105 +48,153 @@ instance : EmptyCollection (CaptureSet n k) where
 
 notation:max "{x=" x "}" => CaptureSet.singleton x
 notation:max "{c=" c "}" => CaptureSet.csingleton c
-notation:max "{s=" s "}" => CaptureSet.singleton s
 
 @[simp]
 instance : Union (CaptureSet n k) where
   union := CaptureSet.union
 
 /-- Subset relation on capture sets. -/
-inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
-| empty : Subset {} C
-| rfl : Subset C C
+inductive CaptureSet.Subset : Nat -> CaptureSet n k → CaptureSet n k → Prop where
+| empty : Subset 0 {} C
+| rfl : Subset 0 C C
 | union_l :
-  Subset C1 C ->
-  Subset C2 C ->
-  Subset (C1 ∪ C2) C
+  Subset a C1 C ->
+  Subset b C2 C ->
+  Subset (1 + a + b) (C1 ∪ C2) C
 | union_rl :
-  Subset C C1 ->
-  Subset C (C1 ∪ C2)
+  Subset a C C1 ->
+  Subset (1 + a) C (C1 ∪ C2)
 | union_rr :
-  Subset C C2 ->
-  Subset C (C1 ∪ C2)
-| trans : Subset C1 C2 -> Subset C2 C3 -> Subset C1 C3
+  Subset a C C2 ->
+  Subset (1 + a) C (C1 ∪ C2)
+| trans : Subset a C1 C2 -> Subset b C2 C3 -> Subset (1 + a + b) C1 C3
 /- projection distributivity -/
-| proj_empty : Subset (.proj .empty K) .empty
-| proj_union_l : Subset (.union (.proj C1 K) (.proj C2 K)) (.proj (C1 ∪ C2) K)
-| proj_union_r : Subset (.proj (C1 ∪ C2) K) (.union (.proj C1 K) (.proj C2 K))
-| proj_proj : Subset (.proj (.proj C K1) K2) (.proj (.proj C K2) K1) -- allows us to consider only the relevant projection
-| proj_l : Subset (.proj C K) C -- allows introducing projections anywhere
-| proj : Subset C D -> Subset (.proj C K) (.proj D K)
-
-theorem CaptureSet.Subset.union_l_inv (h1 : Subset (C1 ∪ C2) C3) : (Subset C1 C3) ∧ (Subset C2 C3) := by
-  generalize h0 : C1 ∪ C2 = C at h1
+| proj_empty : Subset 0 (.proj .empty K) .empty
+| proj_union_l : Subset 0 (.union (.proj C1 K) (.proj C2 K)) (.proj (C1 ∪ C2) K)
+| proj_union_r : Subset 0 (.proj (C1 ∪ C2) K) (.union (.proj C1 K) (.proj C2 K))
+| proj : Subset a C D -> Subset (1 + a) (.proj C K) (.proj D K)
+
+@[simp]
+instance : HasSubset (CaptureSet n k) where
+  Subset A B := ∃ n: Nat, CaptureSet.Subset n A B
+
+/- Existentialification -/
+
+theorem CaptureSet.Subset.empty' : CaptureSet.empty ⊆ C := by exists 0; apply empty
+theorem CaptureSet.Subset.rfl' {C : CaptureSet n k} : C ⊆ C := by exists 0; apply rfl
+theorem CaptureSet.Subset.union_l' {C1 C2 C : CaptureSet n k} (h1 : C1 ⊆ C) (h2 : C2 ⊆ C) : (C1 ∪ C2) ⊆ C := by
+  have ⟨n1, _⟩ := h1
+  have ⟨n2, _⟩ := h2
+  exists 1 + n1 + n2; apply! union_l
+theorem CaptureSet.Subset.union_rl' {C1 C2 C : CaptureSet n k} (h1 : C ⊆ C1) : C ⊆ (C1 ∪ C2) := by
+  have ⟨n1, _⟩ := h1
+  exists 1 + n1; apply! union_rl
+theorem CaptureSet.Subset.union_rr' {C1 C2 C : CaptureSet n k} (h1 : C ⊆ C2) : C ⊆ (C1 ∪ C2) := by
+  have ⟨n1, _⟩ := h1
+  exists 1 + n1; apply! union_rr
+theorem CaptureSet.Subset.trans' {C1 C2 C3 : CaptureSet n k} (h1 : C1 ⊆ C2) (h2 : C2 ⊆ C3) : C1 ⊆ C3 := by
+  have ⟨n1, _⟩ := h1
+  have ⟨n2, _⟩ := h2
+  exists 1 + n1 + n2; apply! trans
+theorem CaptureSet.Subset.proj_empty' : (CaptureSet.proj CaptureSet.empty K : CaptureSet n k) ⊆ CaptureSet.empty := by
+  exists 0; apply proj_empty
+theorem CaptureSet.Subset.proj_union_l' {C1 C2 : CaptureSet n k} : (CaptureSet.union (CaptureSet.proj C1 K) (CaptureSet.proj C2 K)) ⊆ (CaptureSet.proj (C1 ∪ C2) K) := by
+  exists 0; apply proj_union_l
+theorem CaptureSet.Subset.proj_union_r' {C1 C2 : CaptureSet n k} : (CaptureSet.proj (C1 ∪ C2) K) ⊆ (CaptureSet.union (CaptureSet.proj C1 K) (CaptureSet.proj C2 K)) := by
+  exists 0; apply proj_union_r
+theorem CaptureSet.Subset.proj' {C D : CaptureSet n k} (h : C ⊆ D) : (CaptureSet.proj C K) ⊆ (CaptureSet.proj D K) := by
+  have ⟨n1, _⟩ := h
+  exists 1 + n1; apply! proj
+
+
+
+@[simp]
+instance : IsTrans (CaptureSet n k) (HasSubset.Subset) where
+  trans a b c ha hb := by
+    have ⟨a, ha⟩ := ha
+    have ⟨b, hb⟩ := hb
+    exists (1 + a + b)
+    apply CaptureSet.Subset.trans ha hb
+
+theorem CaptureSet.Subset.union_l_inv {C1 C2 C3 : CaptureSet n k} (h1' : (C1 ∪ C2) ⊆ C3) : (C1 ⊆ C3) ∧ (C2 ⊆ C3) := by
+  generalize h0 : C1 ∪ C2 = C at h1'
+  have ⟨n, h1⟩ := h1'
   induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
   case rfl =>
     apply And.intro
-    apply union_rl .rfl
-    apply union_rr .rfl
+    apply Exists.intro 1 $ union_rl .rfl
+    apply Exists.intro 1 $ union_rr .rfl
+  case union_l a _ _ b _ h1 h2 ih1 ih2 =>
+    apply And.intro
+    exists a
+    exists b
   case union_rl ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply union_rl; assumption)
+    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
+    apply And.intro
+    apply Exists.intro (1 + l) $ .union_rl hl
+    apply Exists.intro (1 + r) $ .union_rl hr
   case union_rr ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply union_rr; assumption)
-  case trans h1 h2 ih1 ih2 =>
-    have ⟨_, _⟩ := ih2
-    apply And.intro <;> apply! trans _ h1
+    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
+    apply And.intro
+    apply Exists.intro (1 + l) $ .union_rr hl
+    apply Exists.intro (1 + r) $ .union_rr hr
+  case trans b _ h1 _ h2 ih2 =>
+    have ⟨⟨l, hl⟩, r, hr⟩ := ih2 _ h2
+    apply And.intro
+    exists (1 + l + b); apply trans hl h1
+    exists (1 + r + b); apply trans hr h1
   case proj_union_l =>
     have ⟨_, _⟩ := h0
     subst_vars; simp_all
-    apply And.intro <;> apply proj
-    apply union_rl .rfl
-    apply union_rr .rfl
+    apply And.intro
+    exists 1 + 1; apply proj; apply union_rl .rfl
+    exists 1 + 1; apply proj; apply union_rr .rfl
 
-theorem CaptureSet.Subset.proj_union_l_inv (h1 : Subset (.proj (C1 ∪ C2) K)  C3) : (Subset (C1.proj K) C3) ∧ (Subset (C2.proj K) C3) := by
-  generalize h0 : (C1 ∪ C2).proj K = C at h1
+theorem CaptureSet.Subset.proj_union_l_inv {C1 C2 C3 : CaptureSet n k} (h1' : (.proj (C1 ∪ C2) K) ⊆ C3) : ((C1.proj K) ⊆ C3) ∧ ((C2.proj K) ⊆ C3) := by
+  generalize h0 : (C1 ∪ C2).proj K = C at h1'
+  have ⟨n, h1⟩ := h1'
   induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
   case rfl =>
-    apply And.intro <;> apply proj
-    apply union_rl .rfl
-    apply union_rr .rfl
+    apply And.intro
+    exists 1 + 1; apply proj $ union_rl .rfl
+    exists 1 + 1; apply proj $ union_rr .rfl
   case union_rl ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply union_rl; assumption)
+    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
+    apply And.intro
+    exists 1 + l; apply! union_rl
+    exists 1 + r; apply! union_rl
   case union_rr ha ih =>
-    have ⟨hl, hr⟩ := ih
-    apply And.intro <;> (apply union_rr; assumption)
-  case trans ha hb iha ihb =>
-    have ⟨_, _⟩ := ihb
-    apply And.intro <;> apply! trans
+    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
+    apply And.intro
+    exists 1 + l; apply! union_rr
+    exists 1 + r; apply! union_rr
+  case trans b _ ha hb iha ihb =>
+    have ⟨⟨l, hl⟩, r, hr⟩ := ihb _ iha
+    apply And.intro
+    exists (1 + l + b); apply! trans
+    exists (1 + r + b); apply! trans
   case proj_union_r =>
     have ⟨⟨_, _⟩, _⟩ := h0
     subst_vars; simp_all
     apply And.intro
-    apply union_rl .rfl
-    apply union_rr .rfl
-  case proj_l =>
-    have ⟨_, _⟩ := h0
-    subst_vars; simp_all
-    apply And.intro
-    apply union_rl .proj_l
-    apply union_rr .proj_l
+    exists 1; apply union_rl .rfl
+    exists 1; apply union_rr .rfl
   case proj ha ih =>
     have ⟨_, _⟩ := h0
     subst_vars; simp_all
-    have ⟨_, _⟩ := ha.union_l_inv
-    apply And.intro <;> apply! proj
+    have ⟨⟨l, hl⟩, r, hr⟩ := union_l_inv $ Exists.intro _ ha
+    apply And.intro
+    exists 1 + l; apply! proj
+    exists 1 + r; apply! proj
 
-theorem CaptureSet.Subset.union_monotone (hc : Subset C1 C2) (hd : Subset D1 D2) : Subset (C1 ∪ D1) (C2 ∪ D2) := by
+theorem CaptureSet.Subset.union_monotone {C1 C2 D1 D2 : CaptureSet n k} (hc : C1 ⊆ C2) (hd : D1 ⊆ D2) : (C1 ∪ D1) ⊆ (C2 ∪ D2) := by
+  have ⟨n1, hc1⟩ := hc
+  have ⟨n2, hc2⟩ := hd
+  exists 1 + (1 + n1) + (1 + n2)
   apply union_l
   apply! union_rl
   apply! union_rr
 
-@[simp]
-instance : HasSubset (CaptureSet n k) where
-  Subset := CaptureSet.Subset
-
-@[simp]
-instance : IsTrans (CaptureSet n k) Subset where
-  trans a b c ha hb := CaptureSet.Subset.trans ha hb
-
 /-!
 ## Renaming operations
 -/
@@ -261,7 +309,7 @@ theorem CaptureSet.cweaken_crename {C : CaptureSet n k} :
   simp [cweaken, crename_crename, FinFun.comp_weaken]
 
 theorem CaptureSet.subset_refl {C : CaptureSet n k} :
-  C ⊆ C := by constructor
+  C ⊆ C := by exists 0; constructor
 
 theorem CaptureSet.cweaken_csingleton {c : Fin k} :
   ({c=c} : CaptureSet n k).cweaken = {c=c.succ} := by
@@ -280,33 +328,70 @@ theorem CaptureSet.crename_id {C : CaptureSet n k} :
   induction C <;> aesop
 
 theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
-  (h : C1 ⊆ C2) :
+  (h' : C1 ⊆ C2) :
   C1.crename f ⊆ C2.crename f := by
-  induction h <;> try (solve | constructor | simp; constructor <;> trivial)
-  case union_rr =>
-    simp
+  have ⟨n, h⟩ := h'
+  induction h <;> simp
+  case empty => exists 0; constructor
+  case rfl => exists 0; constructor
+  case proj_empty => exists 0; constructor
+  case proj_union_l => exists 0; constructor
+  case proj_union_r => exists 0; apply Subset.proj_union_r
+  case union_l ha hb iha ihb =>
+    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
+    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
+    exists 1 + l + r
+    apply! Subset.union_l
+  case union_rl ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
+    apply! Subset.union_rl
+  case union_rr ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
     apply! Subset.union_rr
-  case proj_empty => simp; apply! Subset.proj_empty
-  case proj_union_l => simp; apply! Subset.proj_union_l
-  case proj_union_r => simp; apply! Subset.proj_union_r
-  case proj_proj => simp; apply! Subset.proj_proj
-  case proj_l => simp; apply! Subset.proj_l
-  case proj => simp; apply! Subset.proj
-
+  case trans ha hb iha ihb =>
+    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
+    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
+    exists 1 + l + r
+    apply! Subset.trans
+  case proj ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
+    apply! Subset.proj
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
-  (h : C1 ⊆ C2) :
+  (h' : C1 ⊆ C2) :
   C1.cweaken ⊆ C2.cweaken := by
-  induction h <;> try (solve | constructor | simp; constructor <;> trivial)
-  case union_rr =>
-    simp
+  have ⟨n, h⟩ := h'
+  induction h <;> simp
+  case empty => exists 0; constructor
+  case rfl => exists 0; constructor
+  case proj_empty => exists 0; constructor
+  case proj_union_l => exists 0; constructor
+  case proj_union_r => exists 0; apply Subset.proj_union_r
+  case union_l ha hb iha ihb =>
+    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
+    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
+    exists 1 + l + r
+    apply! Subset.union_l
+  case union_rl ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
+    apply! Subset.union_rl
+  case union_rr ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
     apply! Subset.union_rr
-  case proj_empty => simp; apply! Subset.proj_empty
-  case proj_union_l => simp; apply! Subset.proj_union_l
-  case proj_union_r => simp; apply! Subset.proj_union_r
-  case proj_proj => simp; apply! Subset.proj_proj
-  case proj_l => simp; apply! Subset.proj_l
-  case proj => simp; apply! Subset.proj
+  case trans ha hb iha ihb =>
+    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
+    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
+    exists 1 + l + r
+    apply! Subset.trans
+  case proj ha ih =>
+    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
+    exists 1 + l
+    apply! Subset.proj
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
@@ -316,88 +401,167 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 ## Projections
 -/
 
+inductive ProjectedSingleton: CaptureSet n k -> (CaptureSet n k) -> Prop where
+  | var : ProjectedSingleton {x=x} {x=x}
+  | cvar : ProjectedSingleton {c=c} {c=c}
+  | proj : ProjectedSingleton s C -> ProjectedSingleton s (.proj C K)
+
+inductive ProjectedSingletonWith : (CaptureSet n k) -> (K : Kind) -> (CaptureSet n k) -> Prop where
+  | here : ProjectedSingleton s C -> ProjectedSingletonWith s K (.proj C K)
+  | there : ProjectedSingletonWith s K C -> ProjectedSingletonWith s K (.proj C K')
+
+def ProjectedSingletonWith.erase (hp : ProjectedSingletonWith s K C) : ProjectedSingleton s C := by
+  induction hp <;> apply! ProjectedSingleton.proj
+
 /-- A capture set that only has projections on top of singletons. -/
-inductive ProjectedSingletonsOnly: (isSingleton : Bool) -> CaptureSet n k -> Prop where
-  | empty : ProjectedSingletonsOnly false (.empty)
-  | singleton : ProjectedSingletonsOnly true (.singleton s)
-  | csingleton : ProjectedSingletonsOnly true (.csingleton s)
-  | proj : ProjectedSingletonsOnly true C -> ProjectedSingletonsOnly true (C.proj K)
-  | union : ProjectedSingletonsOnly a C1 -> ProjectedSingletonsOnly b C2 -> ProjectedSingletonsOnly false (.union C1 C2)
-
-theorem CaptureSet.push_projection_down (h1 : ProjectedSingletonsOnly a C) : ∃ C1, ProjectedSingletonsOnly a C1 ∧ C1.depth ≤ (C.proj K).depth ∧ C1 ⊆ (C.proj K) ∧ (C.proj K) ⊆ C1 := by
-  induction h1 generalizing K
-  case union ha hb iha ihb =>
-    have ⟨Ca, ha1, ha2, ha3, ha4⟩ := iha (K:=K)
-    have ⟨Cb, hb1, hb2, hb3, hb4⟩ := ihb (K:=K)
-    exists (.union Ca Cb)
-    apply And.intro
-    apply! ProjectedSingletonsOnly.union
-    apply And.intro
-    simp at ha2 hb2
-    simp; omega
-    apply And.intro
-    apply Subset.trans _ .proj_union_l
-    apply Subset.union_monotone ha3 hb3
-    apply Subset.trans .proj_union_r _
+inductive ProjectedSingletonsOnly: CaptureSet n k -> Prop where
+  | empty : ProjectedSingletonsOnly .empty
+  | singleton : ProjectedSingleton s C -> ProjectedSingletonsOnly C
+  | union : ProjectedSingletonsOnly C1 -> ProjectedSingletonsOnly C2 -> ProjectedSingletonsOnly (.union C1 C2)
+
+@[simp]
+def CaptureSet.push_proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
+  match C with
+  | .empty => .empty
+  | .singleton c => proj (.singleton c) K
+  | .csingleton c => proj (.csingleton c) K
+  | .proj C1 K1 => proj (.proj C1 K1) K
+  | .union C1 C2 => .union (C1.push_proj K) (C2.push_proj K)
+
+@[simp]
+def CaptureSet.canonicalize (C : CaptureSet n k) : CaptureSet n k :=
+  match C with
+  | .empty => .empty
+  | .singleton c => .singleton c
+  | .csingleton c => .csingleton c
+  | .union C1 C2 => .union (C1.canonicalize) (C2.canonicalize)
+  | .proj C1 K => C1.canonicalize.push_proj K
+
+theorem CaptureSet.push_proj_is_superset (C : CaptureSet n k) : (C.proj K) ⊆ C.push_proj K := by
+  induction C <;> simp only [push_proj]
+  case empty => exists 0; apply Subset.proj_empty
+  case union C1 C2 ih1 ih2 =>
+    apply IsTrans.trans (r := HasSubset.Subset)
+    exists 0; apply Subset.proj_union_r
     apply! Subset.union_monotone
-  case proj C K2 ha iha =>
-    have ⟨Ca, ha1, ha2, ha3, ha4⟩ := iha (K:=K2)
-    exists Ca.proj K
-    apply And.intro
-    apply! ProjectedSingletonsOnly.proj
-    apply And.intro
-    simp at ha2
-    simp; assumption
-    apply And.intro <;> apply! Subset.proj
-  case empty =>
-    exists .empty
-    apply And.intro .empty
-    apply And.intro; simp
-    apply And.intro .empty .proj_empty
-  case singleton n =>
-    exists (.proj (.singleton n) K)
-    apply And.intro (.proj .singleton)
-    apply And.intro; simp
-    apply And.intro <;> apply Subset.rfl
-  case csingleton n =>
-    exists (.proj (.csingleton n) K)
-    apply And.intro (.proj .csingleton)
-    apply And.intro; simp
-    apply And.intro <;> apply Subset.rfl
-
-/-- There always exists a capture set equivalent to the given C, whose projections are only on top of singletons. -/
-theorem CaptureSet.exists_projected_singleton_only (C : CaptureSet n k) : ∃ C1 a, ProjectedSingletonsOnly a C1 ∧ C1.depth ≤ C.depth ∧ C1 ⊆ C ∧ C ⊆ C1 := by
-  induction C
-  case empty =>
-    exists .empty, false
-    apply And.intro ProjectedSingletonsOnly.empty
-    apply And.intro; simp
-    apply And.intro <;> apply Subset.rfl
-  case union a b ha hb =>
-    have ⟨Ca, _, ha1, ha2, ha3, ha4⟩ := ha
-    have ⟨Cb, _, hb1, hb2, hb3, hb4⟩ := hb
-    exists (.union Ca Cb), false
-    apply And.intro
+  case singleton => exists 0; apply Subset.rfl
+  case csingleton => exists 0; apply Subset.rfl
+  case proj => apply Subset.proj' Subset.rfl'
+
+theorem CaptureSet.canonicalize_is_superset {C : CaptureSet n k} : C ⊆ C.canonicalize := by
+  induction C <;> (simp; try apply Subset.rfl')
+  case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
+  case proj C1 K ih =>
+    apply Subset.trans'
+    apply Subset.proj' ih
+    apply push_proj_is_superset
+
+theorem CaptureSet.push_proj_is_subset {C : CaptureSet n k} : C.push_proj K ⊆ C.proj K := by
+  induction C <;> (simp; try apply Subset.rfl')
+  case empty => apply Subset.empty'
+  case union C1 C2 ih1 ih2 =>
+    apply Subset.trans' _ Subset.proj_union_l'
+    apply! Subset.union_monotone
+
+theorem CaptureSet.canonicalize_is_subset {C : CaptureSet n k} : C.canonicalize ⊆ C := by
+  induction C <;> (simp; try apply Subset.rfl')
+  case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
+  case proj C1 K ih =>
+    apply Subset.trans' C1.canonicalize.push_proj_is_subset
+    apply Subset.proj' ih
+
+theorem CaptureSet.push_proj_singleton {C : CaptureSet n k} (hp: ProjectedSingletonsOnly C) : ProjectedSingletonsOnly (C.push_proj K) := by
+  induction hp <;> try simp_all
+  case empty => constructor
+  case singleton hp =>
+    induction hp
+    case var => apply ProjectedSingletonsOnly.singleton (.proj .var)
+    case cvar => apply ProjectedSingletonsOnly.singleton (.proj .cvar)
+    case proj =>
+      apply ProjectedSingletonsOnly.singleton
+      apply ProjectedSingleton.proj
+      apply! ProjectedSingleton.proj
+  case union C1 C2 ih1 ih2 =>
     apply! ProjectedSingletonsOnly.union
-    apply And.intro; simp; omega
-    apply And.intro <;> apply! Subset.union_monotone
-  case singleton n =>
-    exists .singleton n, true
-    apply And.intro ProjectedSingletonsOnly.singleton
-    apply And.intro; simp
-    apply And.intro <;> apply Subset.rfl
-  case csingleton k =>
-    exists .csingleton k, true
-    apply And.intro ProjectedSingletonsOnly.csingleton
-    apply And.intro; simp
-    apply And.intro <;> apply Subset.rfl
+
+theorem CaptureSet.canonicalize_is_projected_singletons_only {C : CaptureSet n k} : ProjectedSingletonsOnly C.canonicalize := by
+  induction C <;> try simp
+  case empty => apply ProjectedSingletonsOnly.empty
+  case singleton => apply ProjectedSingletonsOnly.singleton .var
+  case csingleton => apply ProjectedSingletonsOnly.singleton .cvar
+  case union C1 C2 ih1 ih2 => apply ProjectedSingletonsOnly.union ih1 ih2
   case proj C K ih =>
-    have ⟨Ca, a, ha1, ha2, ha3, ha4⟩ := ih
-    have ⟨Cb, hb1, hb2, hb3, hb4⟩ := CaptureSet.push_projection_down ha1 (K:=K)
-    exists Cb, a
-    apply And.intro hb1
-    apply And.intro; simp at hb2; simp; omega
-    apply And.intro
-    apply Subset.trans hb3 (.proj ha3)
-    apply Subset.trans (.proj ha4) hb4
+    apply push_proj_singleton
+    assumption
+
+lemma CaptureSet.push_proj_depth {C : CaptureSet n k} : (C.push_proj K).depth ≤ 1 + C.depth := by
+  induction C <;> simp; omega
+
+theorem CaptureSet.canonicalize_depth {C : CaptureSet n k} : C.canonicalize.depth ≤ C.depth := by
+  induction C <;> simp
+  case union ih1 ih2 => omega
+  case proj C K ih =>
+    apply IsTrans.trans
+    apply C.canonicalize.push_proj_depth
+    simp; exact ih
+
+lemma CaptureSet.push_proj_singleton_eq {C : CaptureSet n k} (hp : ProjectedSingleton s C) : (C.push_proj K) = (C.proj K) := by
+  induction hp <;> simp
+
+theorem CaptureSet.canonicalize_projected_singletons {C : CaptureSet n k} (hp : ProjectedSingletonsOnly C) : C.canonicalize = C := by
+  induction hp
+  case singleton s C hs =>
+    induction hs <;> simp
+    case proj ha ih =>
+      rw [ih]
+      apply! push_proj_singleton_eq
+  case empty => simp
+  case union ha hb iha ihb =>
+    simp; aesop
+
+theorem CaptureSet.canonicalize_idempt {C : CaptureSet n k} : C.canonicalize.canonicalize = C.canonicalize := by
+  have h := C.canonicalize_is_projected_singletons_only
+  rw [C.canonicalize.canonicalize_projected_singletons h]
+
+theorem CaptureSet.Subset.canonicalize {A B : CaptureSet n k} (hs : A ⊆ B) : A.canonicalize ⊆ B.canonicalize := by
+  apply trans'
+  apply A.canonicalize_is_subset
+  apply trans' hs
+  apply B.canonicalize_is_superset
+
+inductive EmptyOnly : CaptureSet n k -> Prop where
+  | base : EmptyOnly .empty
+  | union : EmptyOnly C1 -> EmptyOnly C2 -> EmptyOnly (C1.union C2)
+
+theorem CaptureSet.Subset.empty_only' {C : CaptureSet n k} (hs : Subset t C D) (he : EmptyOnly D.canonicalize) : EmptyOnly C.canonicalize := by
+  cases hs
+  case empty => constructor
+  case rfl => assumption
+  case union_l ha hb =>
+    apply EmptyOnly.union (empty_only' ha he) (empty_only' hb he)
+  case trans ha hb =>
+    have h1 := empty_only' hb he
+    apply empty_only' ha h1
+  case union_rl ha =>
+    cases he
+    apply! empty_only'
+  case union_rr ha =>
+    cases he
+    apply! empty_only'
+  case proj_empty => repeat constructor
+  case proj_union_l =>
+    cases he
+    apply EmptyOnly.union <;> simp <;> assumption
+  case proj_union_r =>
+    cases he
+    simp
+    apply EmptyOnly.union <;> assumption
+  case proj =>
+
+
+theorem CaptureSet.Subset.empty_only {C : CaptureSet n k} (hs : C ⊆ D) (he : EmptyOnly D) : EmptyOnly C := by
+  have ⟨_, hs1⟩ := hs
+  apply empty_only' hs1 he
+
+
 end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index ca69d8d6..56931e66 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -109,26 +109,25 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont C1 ->
   WellScoped Γ cont C2 ->
   WellScoped Γ cont (.union C1 C2)
-| proj :
-  WellScoped Γ cont C1 ->
-  (.proj C2 K) ⊆ C1 ->
-  C1.depth ≤ C2.depth + 1 ->
-  WellScoped Γ cont (.proj C2 K)
 | singleton :
   Context.Bound Γ x (S^C) ->
-  WellScoped Γ cont C ->
+  WellScoped Γ cont C.canonicalize ->
   WellScoped Γ cont {x=x}
 | csingleton :
   Context.CBound Γ c (CBinding.inst C) ->
-  WellScoped Γ cont C ->
+  WellScoped Γ cont C.canonicalize ->
   WellScoped Γ cont {c=c}
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  WellScoped Γ cont C ->
+  WellScoped Γ cont C.canonicalize ->
   WellScoped Γ cont {c=c}
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c}
+| proj_singleton :
+  WellScoped Γ cont C ->
+  ProjectedSingleton C C' ->
+  WellScoped Γ cont C'
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
@@ -136,7 +135,8 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | label_disj :
   Context.LBound Γ x c S ->
   Kind.Disjoint K (.classifier c) ->
-  WellScoped Γ cont (.proj {x=x} K)
+  ProjectedSingletonWith {x=x} K C' ->
+  WellScoped Γ cont C'
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
 inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index d213c4e1..9e31000f 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -36,9 +36,10 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
 | proj :
-  Subcapt Γ {s=s} C2 -> Subcapt Γ ({s=s}.proj K) (C2.proj K)
+  Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
 | proj_sub {C : CaptureSet n k} {K1 K2 : Kind}:
   K1.Subkind K2 -> Subcapt Γ (C.proj K1) (C.proj K2)
+| proj_l : Subcapt Γ (C.proj K) C
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
 | proj_disj : Kind.Disjoint K1 K2 -> CaptureKind Γ C K1 -> Subcapt Γ (C.proj K2) .empty
 
@@ -53,10 +54,6 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
 end
 
-theorem Subcapt.proj_l :  Subcapt Γ (C.proj K) C := by
-  apply Subcapt.subset .proj_l
-
-
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 578030be..05622d1a 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -10,50 +10,126 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
-theorem WellScoped.subset
-  (hsc : WellScoped Γ cont C2)
-  (hs : C1 ⊆ C2) : WellScoped Γ cont C1 := by
-  induction hs
+theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.push_proj K) := by
+  induction hsc <;> try simp_all
   case empty => apply empty
-  case rfl => apply hsc
-  case union_l ha hb iha ihb => apply union (iha hsc) (ihb hsc)
-  case union_rl ha iha => cases hsc; aesop
-  case union_rr ha iha => cases hsc; aesop
-  case trans ha hb iha ihb => apply iha $ ihb hsc
-  case proj_empty =>
-    apply proj .empty .proj_empty
-    simp
-  case proj_union_l =>
-    cases hsc
-    rename_i h1 h2 h3
-    have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h3
+  case union iha ihb => apply! union
+  case singleton hb ha ih =>
+    apply proj_singleton
+    apply singleton hb ha
+    apply ProjectedSingleton.proj .var
+  case csingleton hb ha ih =>
+    apply proj_singleton
+    apply csingleton hb ha
+    apply ProjectedSingleton.proj .cvar
+  case cbound hb ha ih =>
+    apply proj_singleton
+    apply cbound hb ha
+    apply ProjectedSingleton.proj .cvar
+  case ckind hb =>
+    apply proj_singleton
+    apply ckind hb
+    apply ProjectedSingleton.proj .cvar
+  case proj_singleton h1 hp ih =>
+    apply proj_singleton h1
+    rw [CaptureSet.push_proj_singleton_eq hp]
+    apply! ProjectedSingleton.proj
+  case label hb hs =>
+    apply proj_singleton
+    apply label hb hs
+    apply ProjectedSingleton.proj .var
+  case label_disj hb hd hp  =>
+    apply label_disj hb hd
+    rw [CaptureSet.push_proj_singleton_eq $ hp.erase]
+    apply! ProjectedSingletonWith.there
+
+-- theorem WellScoped.singleton_inv (hsc : WellScoped Γ cont C') (hs : C ⊆ C') (hp : ProjectedSingleton S C) : WellScoped Γ cont C := by
+--   induction hsc
+--   case empty =>
+
+theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
+  (hs : C1 ⊆ C2)
+  (hp1 : ProjectedSingletonsOnly C1)
+  (hp2 : ProjectedSingletonsOnly C2) : WellScoped Γ cont C1 := by
+  induction hp1
+  case empty => apply empty
+  case union ha hb iha ihb =>
+    have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hs
     apply union
-    { apply proj h1 hl;  }
+    apply! iha
+    apply! ihb
+  case singleton =>
+    induction hp2
+    case empty =>
+      have h1 := CaptureSet.Subset.empty_only hs .base
+      induction h1
+      case base => apply empty
+      case union h1 h2 ih1 ih2 => cases ih2
+      case proj ih h1 =>
+        cases h1
+
+
 
-  case proj_union_r =>
+theorem WellScoped.subset {C1 C2 : CaptureSet n k}
+  (hsc : WellScoped Γ cont C2.canonicalize)
+  (hs : C1 ⊆ C2) : WellScoped Γ cont C1.canonicalize := by
+  induction hs <;> simp_all
+  case empty => apply empty
+  case union_l ha hb iha ihb => apply! union
+  case union_rl ha iha =>
     cases hsc
-    rename_i h1 h2
-    apply proj
-    apply union h1 h2
-    apply CaptureSet.Subset.proj_union_r
-  case proj_proj =>
+    case proj_singleton hp => cases hp
+    case label_disj hp => cases hp
+    case union ha hb =>
+      apply! iha
+  case union_rr ha iha =>
     cases hsc
-    rename_i h1 h2
-    apply proj h1
-    apply CaptureSet.Subset.trans .proj_proj h2
+    case proj_singleton hp => cases hp
+    case label_disj hp => cases hp
+    case union ha hb => apply! iha
   case proj_l =>
-    apply proj hsc .proj_l
-  case proj ha ih =>
-    cases hsc
-    case proj =>
-      rename_i h1 ih2
-      apply proj h1
-      apply CaptureSet.Subset.trans _ ih2
-      apply! CaptureSet.Subset.proj
-    case label_disj =>
-      apply proj
-      apply! label_disj
-      apply! CaptureSet.Subset.proj
+    apply hsc.push_proj
+  case proj C D K hs ih =>
+    -- induction D <;> simp_all
+    -- case empty =>
+
+
+
+  -- case trans ha hb iha ihb => apply iha $ ihb hsc
+  -- case proj_empty =>
+  --   apply proj .empty .proj_empty
+  --   simp
+  -- case proj_union_l =>
+  --   cases hsc
+  --   rename_i h1 h2 h3
+  --   have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h3
+  --   apply union
+  --   { apply proj h1 hl;  }
+
+  -- case proj_union_r =>
+  --   cases hsc
+  --   rename_i h1 h2
+  --   apply proj
+  --   apply union h1 h2
+  --   apply CaptureSet.Subset.proj_union_r
+  -- case proj_proj =>
+  --   cases hsc
+  --   rename_i h1 h2
+  --   apply proj h1
+  --   apply CaptureSet.Subset.trans .proj_proj h2
+  -- case proj_l =>
+  --   apply proj hsc .proj_l
+  -- case proj ha ih =>
+  --   cases hsc
+  --   case proj =>
+  --     rename_i h1 ih2
+  --     apply proj h1
+  --     apply CaptureSet.Subset.trans _ ih2
+  --     apply! CaptureSet.Subset.proj
+  --   case label_disj =>
+  --     apply proj
+  --     apply! label_disj
+  --     apply! CaptureSet.Subset.proj
 
 
 

From ca82f7aa80ac2c7ed2e682c6d61d73a7af0b2798 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 26 Nov 2025 15:00:58 +0100
Subject: [PATCH 24/71] Subset working???

---
 Capless/CaptureSet.lean       |  82 +++++++++++++++--------
 Capless/WellScoped/Basic.lean | 122 +++++++++++++---------------------
 2 files changed, 101 insertions(+), 103 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index e848860a..d6b2a644 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -529,39 +529,67 @@ theorem CaptureSet.Subset.canonicalize {A B : CaptureSet n k} (hs : A ⊆ B) : A
   apply trans' hs
   apply B.canonicalize_is_superset
 
-inductive EmptyOnly : CaptureSet n k -> Prop where
-  | base : EmptyOnly .empty
-  | union : EmptyOnly C1 -> EmptyOnly C2 -> EmptyOnly (C1.union C2)
 
-theorem CaptureSet.Subset.empty_only' {C : CaptureSet n k} (hs : Subset t C D) (he : EmptyOnly D.canonicalize) : EmptyOnly C.canonicalize := by
-  cases hs
-  case empty => constructor
+inductive HasSingleton : CaptureSet n k -> CaptureSet n k -> Prop where
+  | var : HasSingleton {x=x} {x=x}
+  | cvar : HasSingleton {c=c} {c=c}
+  | union_l : HasSingleton s C1 -> HasSingleton s (.union C1 C2)
+  | union_r : HasSingleton s C2 -> HasSingleton s (.union C1 C2)
+  | proj : HasSingleton s C -> HasSingleton (s.proj K) (C.proj K)
+
+theorem CaptureSet.Subset.subset_has_singleton' {C1 C2 : CaptureSet n k} (hh1 : HasSingleton s C1) (hs : Subset t C1 C2) : HasSingleton s C2 := by
+  induction hs generalizing s
+  case empty => cases hh1
   case rfl => assumption
-  case union_l ha hb =>
-    apply EmptyOnly.union (empty_only' ha he) (empty_only' hb he)
-  case trans ha hb =>
-    have h1 := empty_only' hb he
-    apply empty_only' ha h1
-  case union_rl ha =>
-    cases he
-    apply! empty_only'
-  case union_rr ha =>
-    cases he
-    apply! empty_only'
-  case proj_empty => repeat constructor
+  case union_l ih1 ih2 =>
+    cases hh1
+    apply! ih1
+    apply! ih2
+  case union_rl ih => apply HasSingleton.union_l; apply ih hh1
+  case union_rr ih => apply HasSingleton.union_r; apply ih hh1
+  case trans ha hb iha ihb =>
+    apply ihb $ iha hh1
+  case proj_empty => cases hh1; rename_i hh1; cases hh1
   case proj_union_l =>
-    cases he
-    apply EmptyOnly.union <;> simp <;> assumption
+    cases hh1
+    { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_l }
+    { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_r }
   case proj_union_r =>
-    cases he
+    cases hh1
+    rename_i hh1
+    cases hh1
+    { apply HasSingleton.union_l; constructor; assumption }
+    { apply HasSingleton.union_r; constructor; assumption }
+  case proj ih =>
+    cases hh1
+    constructor
+    apply! ih
+
+theorem CaptureSet.subset_has_singleton {C1 C2 : CaptureSet n k} (hs : C1 ⊆ C2) (hh : HasSingleton C C1) : HasSingleton C C2 := by
+  have ⟨_, h⟩ := hs
+  apply Subset.subset_has_singleton' hh h
+
+theorem CaptureSet.projected_singleton_has_singleton (hp : ProjectedSingleton s C) : HasSingleton C C := by
+  induction hp
+  case var => constructor
+  case cvar => constructor
+  case proj hp => constructor; assumption
+
+theorem CaptureSet.projected_singleton_unique_singleton (hp : ProjectedSingleton s C) (hh : HasSingleton C' C) : C' = C := by
+  induction hp generalizing C'
+  case var => cases hh; rfl
+  case cvar => cases hh; rfl
+  case proj hp ih =>
+    cases hh
+    rename_i hh
+    have ih1 := ih hh
+    subst_vars
     simp
-    apply EmptyOnly.union <;> assumption
-  case proj =>
-
 
-theorem CaptureSet.Subset.empty_only {C : CaptureSet n k} (hs : C ⊆ D) (he : EmptyOnly D) : EmptyOnly C := by
-  have ⟨_, hs1⟩ := hs
-  apply empty_only' hs1 he
 
+theorem CaptureSet.Subset.empty_projected_singleton {C : CaptureSet n k} (hs : C ⊆ .empty) (hp : ProjectedSingleton s C) : False := by
+  have ⟨n, h⟩ := hs
+  have h2 := CaptureSet.Subset.subset_has_singleton' (projected_singleton_has_singleton hp) h
+  cases h2
 
 end Capless
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 05622d1a..c607d871 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -43,9 +43,40 @@ theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (
     rw [CaptureSet.push_proj_singleton_eq $ hp.erase]
     apply! ProjectedSingletonWith.there
 
--- theorem WellScoped.singleton_inv (hsc : WellScoped Γ cont C') (hs : C ⊆ C') (hp : ProjectedSingleton S C) : WellScoped Γ cont C := by
---   induction hsc
---   case empty =>
+theorem WellScoped.has_singleton
+  (hsc : WellScoped Γ cont C2)
+  (hh : HasSingleton C C2) :
+  WellScoped Γ cont C := by
+  induction hsc generalizing C
+  case empty => cases hh
+  case union ha hb iha ihb =>
+    cases hh
+    case union_l hh => apply! iha
+    case union_r hh => apply! ihb
+  case singleton =>
+    cases hh
+    apply! singleton
+  case csingleton =>
+    cases hh
+    apply! csingleton
+  case cbound =>
+    cases hh
+    apply! cbound
+  case ckind =>
+    cases hh
+    apply! ckind
+  case proj_singleton hsc hp ih =>
+    have hh1 := CaptureSet.projected_singleton_unique_singleton hp hh
+    subst_vars
+    apply! proj_singleton
+  case label hb hl =>
+    cases hh
+    apply! label
+  case label_disj hb hd hp =>
+    have hh1 := CaptureSet.projected_singleton_unique_singleton hp.erase hh
+    subst_vars
+    apply! label_disj
+
 
 theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
   (hs : C1 ⊆ C2)
@@ -58,80 +89,16 @@ theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
     apply union
     apply! iha
     apply! ihb
-  case singleton =>
-    induction hp2
-    case empty =>
-      have h1 := CaptureSet.Subset.empty_only hs .base
-      induction h1
-      case base => apply empty
-      case union h1 h2 ih1 ih2 => cases ih2
-      case proj ih h1 =>
-        cases h1
-
-
+  case singleton hp =>
+    have hp2 := CaptureSet.subset_has_singleton hs (CaptureSet.projected_singleton_has_singleton hp)
+    apply has_singleton hsc hp2
 
 theorem WellScoped.subset {C1 C2 : CaptureSet n k}
   (hsc : WellScoped Γ cont C2.canonicalize)
   (hs : C1 ⊆ C2) : WellScoped Γ cont C1.canonicalize := by
-  induction hs <;> simp_all
-  case empty => apply empty
-  case union_l ha hb iha ihb => apply! union
-  case union_rl ha iha =>
-    cases hsc
-    case proj_singleton hp => cases hp
-    case label_disj hp => cases hp
-    case union ha hb =>
-      apply! iha
-  case union_rr ha iha =>
-    cases hsc
-    case proj_singleton hp => cases hp
-    case label_disj hp => cases hp
-    case union ha hb => apply! iha
-  case proj_l =>
-    apply hsc.push_proj
-  case proj C D K hs ih =>
-    -- induction D <;> simp_all
-    -- case empty =>
-
-
-
-  -- case trans ha hb iha ihb => apply iha $ ihb hsc
-  -- case proj_empty =>
-  --   apply proj .empty .proj_empty
-  --   simp
-  -- case proj_union_l =>
-  --   cases hsc
-  --   rename_i h1 h2 h3
-  --   have ⟨hl, hr⟩ := CaptureSet.Subset.proj_union_l_inv h3
-  --   apply union
-  --   { apply proj h1 hl;  }
-
-  -- case proj_union_r =>
-  --   cases hsc
-  --   rename_i h1 h2
-  --   apply proj
-  --   apply union h1 h2
-  --   apply CaptureSet.Subset.proj_union_r
-  -- case proj_proj =>
-  --   cases hsc
-  --   rename_i h1 h2
-  --   apply proj h1
-  --   apply CaptureSet.Subset.trans .proj_proj h2
-  -- case proj_l =>
-  --   apply proj hsc .proj_l
-  -- case proj ha ih =>
-  --   cases hsc
-  --   case proj =>
-  --     rename_i h1 ih2
-  --     apply proj h1
-  --     apply CaptureSet.Subset.trans _ ih2
-  --     apply! CaptureSet.Subset.proj
-  --   case label_disj =>
-  --     apply proj
-  --     apply! label_disj
-  --     apply! CaptureSet.Subset.proj
-
-
+  have h := CaptureSet.Subset.canonicalize hs
+  apply subset' hsc h
+  repeat apply CaptureSet.canonicalize_is_projected_singletons_only
 
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
@@ -139,11 +106,12 @@ theorem WellScoped.cons
   induction hsc
   case empty => apply empty
   case union => apply union <;> aesop
-  case proj => apply proj <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
+  case proj_singleton ha hp ih =>
+    apply proj_singleton <;> aesop
   case label =>
     apply label
     easy
@@ -157,7 +125,8 @@ theorem WellScoped.conse
   induction hsc
   case empty => apply empty
   case union => apply union <;> aesop
-  case proj => apply proj <;> aesop
+  case proj_singleton ha hp ih =>
+    apply proj_singleton <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
@@ -174,7 +143,8 @@ theorem WellScoped.scope
   induction hsc
   case empty => apply empty
   case union => apply union <;> aesop
-  case proj => apply proj <;> aesop
+  case proj_singleton ha hp ih =>
+    apply proj_singleton <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop

From 505721c493b81e3268642864b5e09b0e4a2f3f9c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 26 Nov 2025 18:12:53 +0100
Subject: [PATCH 25/71] WIP link disjoint and subkind

---
 Capless/Classifier.lean       | 188 ++++++++++++++++++++++++++++++++--
 Capless/Store.lean            |   4 +-
 Capless/WellScoped/Basic.lean |  34 ++++--
 3 files changed, 209 insertions(+), 17 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 6180e578..b9338bab 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -1,3 +1,6 @@
+import Capless.Basic
+import Capless.Tactics
+
 namespace Capless
 
 inductive Classifier : Type where
@@ -47,11 +50,16 @@ def Kind.any := Kind.classifier .top
 
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
   | base : a.disjoint b -> Disjoint (classifier a) (classifier b)
-  | union : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
-  | excl_this : a.subclass b -> Disjoint (excl c b) (classifier a)
-  | excl_union : Disjoint a (excl b1 k) -> Disjoint a (excl b2 k) -> Disjoint a (excl (union b1 b2) k)
-  | excl : Disjoint a b -> Disjoint a (excl b k)
-  | symm : Disjoint a b -> Disjoint b a
+  | union_l : Disjoint a1 b -> Disjoint a2 b -> Disjoint (union a1 a2) b
+  | union_r : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
+  | excl_this_l : a.subclass b -> Disjoint (excl c b) (classifier a)
+  | excl_this_r : a.subclass b -> Disjoint (classifier a) (excl c b)
+  | excl_union_l : Disjoint (excl a1 k) b -> Disjoint (excl a2 k) b -> Disjoint (excl (union a1 a2) k) b
+  | excl_union_r : Disjoint a (excl b1 k) -> Disjoint a (excl b2 k) -> Disjoint a (excl (union b1 b2) k)
+  | excl_l : Disjoint a b -> Disjoint (excl a k) b
+  | excl_r : Disjoint a b -> Disjoint a (excl b k)
+  | empty_l : a.subclass b -> Disjoint (excl (classifier a) b) K
+  | empty_r : a.subclass b -> Disjoint K (excl (classifier a) b)
 
 inductive Kind.Subkind : Kind -> Kind -> Prop where
   | base : a.subclass b -> Subkind (classifier a) (classifier b)
@@ -184,6 +192,17 @@ theorem Classifier.subclass_up : subclass a (child m b) -> subclass a b := by
       right
       assumption
 
+theorem Classifier.subclass_trans : subclass a b -> subclass b c -> subclass a c := by
+  intro h1 h2
+  induction b
+  case top => simp_all
+  case child n k ih =>
+    have h11 := subclass_up h1
+    simp at h2
+    cases h2
+    case inl h2 => subst_vars; simp_all
+    case inr h2 => apply ih h11 h2
+
 theorem Classifier.disjoint_antisymm : disjoint a a = false := by
   induction a <;> simp
 
@@ -243,6 +262,32 @@ theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
         { subst_vars; simp at h }
         { left; right; assumption }
 
+theorem Classifier.subclass_disjoint : subclass a1 a2 -> disjoint b a2 -> disjoint b a1 := by
+  intro hs hd
+  induction a1
+  case top =>
+    simp at hs; subst_vars; exfalso; apply disjoint_top hd
+  case child n k ih =>
+    simp at hs
+    cases hs
+    case inl h => subst_vars; simp_all
+    case inr h => apply disjoint_up; apply ih h
+
+theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
+  induction hd
+  case base hd =>
+    apply base
+    apply Classifier.disjoint_symm hd
+  case union_l => apply! union_r
+  case union_r => apply! union_l
+  case excl_this_l => apply! excl_this_r
+  case excl_this_r => apply! excl_this_l
+  case excl_union_l => apply! excl_union_r
+  case excl_union_r => apply! excl_union_l
+  case excl_l => apply! excl_r
+  case excl_r => apply! excl_l
+  case empty_l => apply! empty_r
+  case empty_r => apply! empty_l
 
 theorem Kind.Subkind.rfl : Kind.Subkind k k := by
   cases k
@@ -259,7 +304,7 @@ theorem Kind.Subkind.rfl : Kind.Subkind k k := by
     apply Subkind.excl_r
     apply Subkind.excl_l
     apply rfl
-    apply Disjoint.excl_this
+    apply Disjoint.excl_this_l
     unfold Classifier.subclass; simp
 
 theorem Kind.subkind_any : Kind.Subkind K .any := by
@@ -271,6 +316,137 @@ theorem Kind.subkind_any : Kind.Subkind K .any := by
   case excl K c ih =>
     apply Subkind.excl_l ih
 
+theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (.union K1 K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
+  cases hd
+  case union_l ha hb =>
+    have ⟨_, _⟩ := ha.union_r_inv
+    have ⟨_, _⟩ := hb.union_r_inv
+    apply And.intro <;> apply! union_l
+  case union_r ha hb => apply! And.intro
+  case excl_union_l ha hb =>
+    have ⟨_, _⟩ := ha.union_r_inv
+    have ⟨_, _⟩ := hb.union_r_inv
+    apply And.intro <;> apply! excl_union_l
+  case excl_l ha =>
+    have ⟨_, _⟩ := ha.union_r_inv
+    apply And.intro <;> apply! excl_l
+  case empty_l ha =>
+    apply And.intro <;> apply! empty_l
+
+
+theorem Kind.Disjoint.subclassed_excl_swap (hd : Disjoint K1 (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
+  cases hd
+  case union_l ha hb =>
+    apply excl_union_l
+    apply ha.subclassed_excl_swap hsub
+    apply hb.subclassed_excl_swap hsub
+  case excl_this_r ha =>
+    have h1 := Classifier.subclass_trans ha hsub
+    apply empty_l h1
+  case excl_union_l ha hb =>
+
+
+
+theorem Kind.Disjoint.subclassed_excl (hd : Disjoint (.excl K1 a) (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
+  cases hd
+  case excl_union_l ha hb =>
+    apply excl_union_l
+    apply ha.subclassed_excl hsub
+    apply hb.subclassed_excl hsub
+  case excl_union_r ha hb =>
+    apply union_r
+    apply ha.subclassed_excl hsub
+    apply hb.subclassed_excl hsub
+  case excl_r ha => assumption
+  case excl_l ha =>
+
+
+
+
+
+theorem Kind.Disjoint.disjointed_excl (hd : Disjoint K1 (.excl K2 a)) (hda : Disjoint K1 (.classifier a)) : Disjoint K1 K2 := by
+  cases hd
+  case union_l ha hb =>
+    have ⟨hl, hr⟩ := hda.symm.union_r_inv
+    apply union_l (ha.disjointed_excl hl.symm) (hb.disjointed_excl hr.symm)
+  case excl_this_r ha =>
+    cases hda
+    have h := Classifier.disjoint_subclass ha
+    simp_all
+  case excl_union_l ha hb =>
+    cases hda
+    case excl_this_l hsub =>
+      -- apply excl_union_l
+
+    case excl_l hda =>
+      have ⟨hl, hr⟩ := hda.symm.union_r_inv
+      apply excl_union_l
+      apply ha.disjointed_excl hl.symm.excl_l
+      apply hb.disjointed_excl hr.symm.excl_l
+
+
+
+theorem Kind.Disjoint.of_subkind (hd : Disjoint K K2) (hs : Subkind K1 K2) : Disjoint K K1 := by
+  induction hs generalizing K
+  case trans ha hb iha ihb =>
+    apply iha $ ihb hd
+  case base a b hs =>
+    generalize h : Kind.classifier b = K2 at hd
+    induction hd <;> try (subst_vars; simp_all)
+    case base hd =>
+      apply base
+      apply! Classifier.subclass_disjoint
+    case union_l ha hb => apply! union_l
+    case excl_this_l hs1 => apply excl_this_l; apply! Classifier.subclass_trans
+    case excl_union_l => apply! excl_union_l
+    case excl_l => apply! excl_l
+  case union_l ha hb iha ihb =>
+    apply union_r
+    apply! iha
+    apply! ihb
+  case union_r1 ha ih =>
+    have ⟨_, _⟩ := hd.union_r_inv
+    apply! ih
+  case union_r2 ha ih =>
+    have ⟨_, _⟩ := hd.union_r_inv
+    apply! ih
+  case excl_l ha ih => apply excl_r; apply! ih
+  case excl_r A B k hs ha ih =>
+    generalize h : Kind.excl B k = K2 at hd
+    induction hd <;> try (subst_vars; simp_all)
+    case union_l => apply! union_l
+    case excl_this_r hs =>
+      have ⟨_, _⟩ := h
+      subst_vars; simp_all
+      have ha1 := ha.symm
+      sorry
+    case excl_union_r =>
+      have ⟨_, _⟩ := h
+      subst_vars; simp_all
+      apply ih
+
+
+
+    case excl_union_l => apply! excl_union_l
+    case excl_l => apply! excl_l
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
 /- Classifiers fixed for boundary. -/
 def Classifier.control := Classifier.child 0 Classifier.top
 def Kind.only_control := Kind.classifier .control
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 56931e66..e54b9ab2 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -126,8 +126,8 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont {c=c}
 | proj_singleton :
   WellScoped Γ cont C ->
-  ProjectedSingleton C C' ->
-  WellScoped Γ cont C'
+  ProjectedSingleton C (.proj C' K) ->
+  WellScoped Γ cont (.proj C' K)
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index c607d871..11f8ebc2 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -10,10 +10,22 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
+theorem WellScoped.implies_canonical (hsc : WellScoped Γ cont C) : ProjectedSingletonsOnly C := by
+  induction hsc
+  case empty => constructor
+  case union ha hb iha ihb => apply! ProjectedSingletonsOnly.union
+  case singleton => apply ProjectedSingletonsOnly.singleton; constructor
+  case csingleton => apply ProjectedSingletonsOnly.singleton; constructor
+  case cbound => apply ProjectedSingletonsOnly.singleton; constructor
+  case ckind => apply ProjectedSingletonsOnly.singleton; constructor
+  case proj_singleton => apply! ProjectedSingletonsOnly.singleton
+  case label => apply ProjectedSingletonsOnly.singleton; constructor
+  case label_disj _ _ hsw => apply ProjectedSingletonsOnly.singleton; apply hsw.erase
+
 theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.push_proj K) := by
-  induction hsc <;> try simp_all
+  induction hsc generalizing K <;> try simp_all
   case empty => apply empty
-  case union iha ihb => apply! union
+  case union iha ihb => apply union iha ihb
   case singleton hb ha ih =>
     apply proj_singleton
     apply singleton hb ha
@@ -32,7 +44,7 @@ theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (
     apply ProjectedSingleton.proj .cvar
   case proj_singleton h1 hp ih =>
     apply proj_singleton h1
-    rw [CaptureSet.push_proj_singleton_eq hp]
+    rw [← CaptureSet.push_proj_singleton_eq hp]
     apply! ProjectedSingleton.proj
   case label hb hs =>
     apply proj_singleton
@@ -43,6 +55,9 @@ theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (
     rw [CaptureSet.push_proj_singleton_eq $ hp.erase]
     apply! ProjectedSingletonWith.there
 
+theorem WellScoped.push_proj_sub {C : CaptureSet n k} (hsc : WellScoped Γ cont (C.push_proj K2)) (hsk : K1.Subkind K2) : WellScoped Γ cont (C.push_proj K1) := by
+  --  hsc.implies_canonical
+
 theorem WellScoped.has_singleton
   (hsc : WellScoped Γ cont C2)
   (hh : HasSingleton C C2) :
@@ -156,23 +171,24 @@ theorem WellScoped.scope
   case label_disj => apply! label_disj
 
 theorem WellScoped.subcapt
-  (hsc : WellScoped Γ cont C)
+  (hsc : WellScoped Γ cont C.canonicalize)
   (hs : Γ ⊢ C' <:c C) :
-  WellScoped Γ cont C' :=
+  WellScoped Γ cont C'.canonicalize :=
   match hs with
   | .trans ha hb => .subcapt (.subcapt hsc hb) ha
   | .subset hs => .subset hsc hs
   | .union ha hb => .union (.subcapt hsc ha) (.subcapt hsc hb)
   | .var hb => .singleton hb hsc
   | .cinstl hb1 => by
-    cases hsc <;> (rename_i hb2; cases Context.cbound_injective hb1 hb2)
+    simp at hsc
+    cases hsc <;> (rename_i hb2; try cases Context.cbound_injective hb1 hb2)
     assumption
+    cases hb2
   | .cinstr hb => .csingleton hb hsc
   | .cbound hb => .cbound hb hsc
-  | .proj h1 => by
-    cases hsc
-    rename_i s D2 K D3 hsc hs
+  | .proj h1 => by sorry
   | .proj_sub hs => by
+    simp_all
     constructor
     cases hsc
     assumption

From 374edb4c8fa3746be4620f14ddb6361280ae65a5 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 28 Nov 2025 20:45:23 +0100
Subject: [PATCH 26/71] Lots of things undone in classifier

---
 Capless/Classifier.lean       | 570 ++++++++++++++++++++++++++--------
 Capless/WellScoped/Basic.lean |  18 +-
 2 files changed, 453 insertions(+), 135 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index b9338bab..1f625695 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -48,18 +48,82 @@ inductive Kind : Type where
 /-- The top kind -/
 def Kind.any := Kind.classifier .top
 
-inductive Kind.Disjoint : Kind -> Kind -> Prop where
-  | base : a.disjoint b -> Disjoint (classifier a) (classifier b)
-  | union_l : Disjoint a1 b -> Disjoint a2 b -> Disjoint (union a1 a2) b
-  | union_r : Disjoint a b1 -> Disjoint a b2 -> Disjoint a (union b1 b2)
-  | excl_this_l : a.subclass b -> Disjoint (excl c b) (classifier a)
-  | excl_this_r : a.subclass b -> Disjoint (classifier a) (excl c b)
-  | excl_union_l : Disjoint (excl a1 k) b -> Disjoint (excl a2 k) b -> Disjoint (excl (union a1 a2) k) b
-  | excl_union_r : Disjoint a (excl b1 k) -> Disjoint a (excl b2 k) -> Disjoint a (excl (union b1 b2) k)
-  | excl_l : Disjoint a b -> Disjoint (excl a k) b
-  | excl_r : Disjoint a b -> Disjoint a (excl b k)
-  | empty_l : a.subclass b -> Disjoint (excl (classifier a) b) K
-  | empty_r : a.subclass b -> Disjoint K (excl (classifier a) b)
+def KindFun : Type := Kind -> Kind
+
+@[simp]
+def KindFun.excl (f : KindFun) (c : Classifier) := (fun (x: Kind) => x.excl c) ∘ f
+
+@[simp]
+def KindFun.prepend (f: KindFun) (c : Classifier) := f ∘ (fun (x: Kind) => x.excl c)
+
+inductive UnderExcl : KindFun -> Prop where
+  | empty : UnderExcl id
+  | excl : UnderExcl f -> UnderExcl (f.excl c)
+
+theorem UnderExcl.prepend (hu : UnderExcl f) : UnderExcl (f.prepend c) := by
+  induction hu
+  case empty =>
+    simp
+    apply excl .empty
+  case excl hu ih =>
+    simp
+    rw [Function.comp_assoc]
+    apply excl ih
+
+theorem UnderExcl.one {c : Classifier} : UnderExcl (.excl id c) := .excl .empty
+
+theorem UnderExcl.injective (hu : UnderExcl f) : Function.Injective f := by
+  induction hu
+  case empty => apply Function.injective_id
+  case excl hu ih =>
+    intro a b h
+    simp at h
+    apply ih h
+
+inductive Kind.Disjoint : Nat -> Kind -> Kind -> Prop where
+  | base :
+    a.disjoint b ->
+    Disjoint 0 (classifier a) (classifier b)
+  | union_l :
+    UnderExcl f ->
+    Disjoint n (f a1) b ->
+    Disjoint m (f a2) b ->
+    Disjoint (1 + n + m) (f $ union a1 a2) b
+  | union_r :
+    UnderExcl f->
+    Disjoint n a (f b1) ->
+    Disjoint m a (f b2) ->
+    Disjoint (1 + n + m) a (f $ union b1 b2)
+  | excl_this_l :
+    a.subclass b ->
+    Disjoint 0 (excl c b) (classifier a)
+  | excl_this_r :
+    a.subclass b ->
+    Disjoint 0 (classifier a) (excl c b)
+  | excl_l :
+    UnderExcl f ->
+    Disjoint n a b ->
+    Disjoint (1 + n) (f a) b
+  | excl_r :
+    UnderExcl f ->
+    Disjoint n a b ->
+    Disjoint (1 + n) a (f b)
+  | excl_up_l :
+    UnderExcl f ->
+    Disjoint n (f $ .excl k1 a) k2 ->
+    Disjoint (1 + n) (.excl (f k1) a) k2
+  | excl_up_r :
+    UnderExcl f ->
+    Disjoint n k1 (f $ .excl k2 a) ->
+    Disjoint (1 + n) k1 (.excl (f k2) a)
+  | empty_l :
+    UnderExcl f ->
+    a.subclass b ->
+    Disjoint 0 (excl (f $ classifier a) b) K
+  | empty_r :
+    UnderExcl f ->
+    a.subclass b ->
+    Disjoint 0 K (excl (f $ classifier a) b)
 
 inductive Kind.Subkind : Kind -> Kind -> Prop where
   | base : a.subclass b -> Subkind (classifier a) (classifier b)
@@ -67,7 +131,7 @@ inductive Kind.Subkind : Kind -> Kind -> Prop where
   | union_r1 : Subkind a b1 -> Subkind a (union b1 b2)
   | union_r2 : Subkind a b2 -> Subkind a (union b1 b2)
   | excl_l : Subkind a b -> Subkind (excl a c) b
-  | excl_r : Subkind a b -> Kind.Disjoint a (classifier k) -> Subkind a (excl b k)
+  | excl_r : Subkind a b -> Kind.Disjoint n a (classifier k) -> Subkind a (excl b k)
   | trans : Subkind a b -> Subkind b c -> Subkind a c
 
 theorem Classifier.subclass_top : Classifier.subclass k .top := by
@@ -273,22 +337,6 @@ theorem Classifier.subclass_disjoint : subclass a1 a2 -> disjoint b a2 -> disjoi
     case inl h => subst_vars; simp_all
     case inr h => apply disjoint_up; apply ih h
 
-theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
-  induction hd
-  case base hd =>
-    apply base
-    apply Classifier.disjoint_symm hd
-  case union_l => apply! union_r
-  case union_r => apply! union_l
-  case excl_this_l => apply! excl_this_r
-  case excl_this_r => apply! excl_this_l
-  case excl_union_l => apply! excl_union_r
-  case excl_union_r => apply! excl_union_l
-  case excl_l => apply! excl_r
-  case excl_r => apply! excl_l
-  case empty_l => apply! empty_r
-  case empty_r => apply! empty_l
-
 theorem Kind.Subkind.rfl : Kind.Subkind k k := by
   cases k
   case classifier a =>
@@ -316,119 +364,373 @@ theorem Kind.subkind_any : Kind.Subkind K .any := by
   case excl K c ih =>
     apply Subkind.excl_l ih
 
-theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (.union K1 K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
-  cases hd
-  case union_l ha hb =>
-    have ⟨_, _⟩ := ha.union_r_inv
-    have ⟨_, _⟩ := hb.union_r_inv
+theorem Kind.Disjoint.symm (hd : Disjoint n K1 K2) : Disjoint n K2 K1 := by
+  induction hd
+  case base hd =>
+    have hd1 := Classifier.disjoint_symm hd
+    apply! base
+  case union_l => apply! union_r
+  case union_r => apply! union_l
+  case excl_this_l => apply! excl_this_r
+  case excl_this_r => apply! excl_this_l
+  -- case excl_union_l => apply! excl_union_r
+  -- case excl_union_r => apply! excl_union_l
+  case excl_l => apply! excl_r
+  case excl_r => apply! excl_l
+  case excl_up_l => apply! excl_up_r
+  case excl_up_r => apply! excl_up_l
+  case empty_l => apply! empty_r
+  case empty_r => apply! empty_l
+
+theorem Kind.Disjoint.union_r_inv (hd : Disjoint n K (.union K1 K2)) : ∃ n1 n2 : Nat, n1 ≤ n ∧ n2 ≤ n ∧ Disjoint n1 K K1 ∧ Disjoint n2 K K2 := by
+  generalize h : Kind.union K1 K2 = K at hd
+  cases hd <;> (subst_vars; try contradiction; try simp at hd)
+  case union_l hu ha hb =>
+    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
+    have ⟨nb1, nb2, ⟨_, _, _, _⟩⟩ := hb.union_r_inv
+    exists 1 + na1 + nb1, 1 + na2 + nb2
+    apply And.intro; omega
+    apply And.intro; omega
     apply And.intro <;> apply! union_l
-  case union_r ha hb => apply! And.intro
-  case excl_union_l ha hb =>
-    have ⟨_, _⟩ := ha.union_r_inv
-    have ⟨_, _⟩ := hb.union_r_inv
-    apply And.intro <;> apply! excl_union_l
-  case excl_l ha =>
-    have ⟨_, _⟩ := ha.union_r_inv
+  case union_r hu ha hb =>
+    cases hu <;> try cases h
+    rename_i n m
+    exists n, m
+    apply And.intro; omega
+    apply And.intro; omega
+    apply! And.intro
+  case excl_l hu ha =>
+    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
+    exists 1 + na1, 1 + na2
+    apply And.intro; omega
+    apply And.intro; omega
     apply And.intro <;> apply! excl_l
+  case excl_r hu ha =>
+    cases hu <;> try cases h
+    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
+    exists na1, na2
+    apply And.intro; omega
+    apply And.intro; omega
+    apply! And.intro
+  case excl_up_l ha =>
+    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
+    exists 1 + na1, 1 + na2
+    apply And.intro; omega
+    apply And.intro; omega
+    apply And.intro <;> apply! excl_up_l
   case empty_l ha =>
+    exists 0, 0
+    apply And.intro; omega
+    apply And.intro; omega
     apply And.intro <;> apply! empty_l
 
+theorem UnderExcl.excl_fold {f : KindFun} (hu : UnderExcl f) : (f.excl c) k = (f k).excl c := by
+  induction hu <;> simp_all
 
-theorem Kind.Disjoint.subclassed_excl_swap (hd : Disjoint K1 (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
-  cases hd
-  case union_l ha hb =>
-    apply excl_union_l
-    apply ha.subclassed_excl_swap hsub
-    apply hb.subclassed_excl_swap hsub
-  case excl_this_r ha =>
-    have h1 := Classifier.subclass_trans ha hsub
-    apply empty_l h1
-  case excl_union_l ha hb =>
-
-
-
-theorem Kind.Disjoint.subclassed_excl (hd : Disjoint (.excl K1 a) (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
-  cases hd
-  case excl_union_l ha hb =>
-    apply excl_union_l
-    apply ha.subclassed_excl hsub
-    apply hb.subclassed_excl hsub
-  case excl_union_r ha hb =>
-    apply union_r
-    apply ha.subclassed_excl hsub
-    apply hb.subclassed_excl hsub
-  case excl_r ha => assumption
-  case excl_l ha =>
-
-
-
-
-
-theorem Kind.Disjoint.disjointed_excl (hd : Disjoint K1 (.excl K2 a)) (hda : Disjoint K1 (.classifier a)) : Disjoint K1 K2 := by
-  cases hd
-  case union_l ha hb =>
-    have ⟨hl, hr⟩ := hda.symm.union_r_inv
-    apply union_l (ha.disjointed_excl hl.symm) (hb.disjointed_excl hr.symm)
-  case excl_this_r ha =>
-    cases hda
-    have h := Classifier.disjoint_subclass ha
-    simp_all
-  case excl_union_l ha hb =>
-    cases hda
-    case excl_this_l hsub =>
-      -- apply excl_union_l
-
-    case excl_l hda =>
-      have ⟨hl, hr⟩ := hda.symm.union_r_inv
-      apply excl_union_l
-      apply ha.disjointed_excl hl.symm.excl_l
-      apply hb.disjointed_excl hr.symm.excl_l
-
-
-
-theorem Kind.Disjoint.of_subkind (hd : Disjoint K K2) (hs : Subkind K1 K2) : Disjoint K K1 := by
-  induction hs generalizing K
-  case trans ha hb iha ihb =>
-    apply iha $ ihb hd
-  case base a b hs =>
-    generalize h : Kind.classifier b = K2 at hd
-    induction hd <;> try (subst_vars; simp_all)
-    case base hd =>
-      apply base
-      apply! Classifier.subclass_disjoint
-    case union_l ha hb => apply! union_l
-    case excl_this_l hs1 => apply excl_this_l; apply! Classifier.subclass_trans
-    case excl_union_l => apply! excl_union_l
-    case excl_l => apply! excl_l
-  case union_l ha hb iha ihb =>
-    apply union_r
-    apply! iha
-    apply! ihb
-  case union_r1 ha ih =>
-    have ⟨_, _⟩ := hd.union_r_inv
-    apply! ih
-  case union_r2 ha ih =>
-    have ⟨_, _⟩ := hd.union_r_inv
-    apply! ih
-  case excl_l ha ih => apply excl_r; apply! ih
-  case excl_r A B k hs ha ih =>
-    generalize h : Kind.excl B k = K2 at hd
-    induction hd <;> try (subst_vars; simp_all)
-    case union_l => apply! union_l
-    case excl_this_r hs =>
-      have ⟨_, _⟩ := h
+theorem UnderExcl.compose (hu1 : UnderExcl f) (hu2 : UnderExcl g) : UnderExcl (f ∘ g) := by
+  induction hu1
+  case empty =>
+    rw [Function.id_comp]
+    assumption
+  case excl hu ih =>
+    rw [KindFun.excl]
+    rw [Function.comp_assoc]
+    rw [← KindFun.excl]
+    constructor; assumption
+
+theorem UnderExcl.prefix (hf : UnderExcl f) (hg : UnderExcl g) (he : f k1 = g k2) : (∃ h, UnderExcl h ∧ f = g ∘ h) ∨ (∃ h, UnderExcl h ∧ g = f ∘ h) := by
+  induction hf generalizing g k1 k2
+  case empty =>
+    right
+    exists g
+  case excl f' c hf ih =>
+    simp at he
+    cases hg
+    case empty => simp at he; subst_vars; simp_all; left; apply! excl
+    case excl g' c' hg =>
+      simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all
+      cases ih hg he
+      case inl ih =>
+        have ⟨h, hh1, hh2⟩ := ih
+        left
+        exists h
+        apply And.intro; assumption
+        rw [Function.comp_assoc, hh2]
+      case inr ih =>
+        have ⟨h, hh1, hh2⟩ := ih
+        right
+        exists h
+        apply And.intro; assumption
+        rw [Function.comp_assoc, hh2]
+
+theorem UnderExcl.union_eq (hf : UnderExcl f) (hg : UnderExcl g) (he : g k = f (.union k1 k2)) : ∃ h, UnderExcl h ∧ f = g ∘ h := by
+  induction hg generalizing f k k1 k2
+  case empty =>
+    exists f
+  case excl g' c hg ih =>
+    simp at he
+    cases hf
+    case empty => cases he
+    case excl f' c' hf =>
+      simp at he; have ⟨_, _⟩ := he; subst_vars
+      rename_i hf'
+      unfold KindFun.excl
+      have ⟨h, ⟨_, hh⟩⟩ := ih hf hf'
+      exists h
+      apply And.intro; assumption
+      rw [Function.comp_assoc]
+      rw [hh]
+  -- case empty =>
+  --   induction hg
+  --   case empty => simp_all; apply empty
+  --   case excl hg ih => simp_all
+  -- case excl f c hf ihf =>
+
+    -- induction hg generalizing f c k k1 k2
+    -- case empty => simp_all; constructor; apply hf
+    -- case excl hg ihg =>
+    --   simp at he; have ⟨_, _⟩ := he; subst_vars
+
+theorem Kind.Disjoint.excl_up_r_inv (hd : Disjoint n a (.excl (f b) c)) (hf : UnderExcl f) : ∃ m, Disjoint m a (f (.excl b c)) := by sorry
+  -- generalize he : (f b).excl c = K at hd
+  -- cases hd <;> (subst_vars; try simp_all)
+  -- case union_l hu ha hb =>
+  --   -- have ⟨ma, _, _⟩ := ha.excl_up_r_inv hf
+  --   -- have ⟨mb, _, _⟩ := hb.excl_up_r_inv hf
+  --   exists 1 + ma + mb
+  --   apply And.intro; omega
+  --   apply! union_l
+  -- case union_r hu ha hb =>
+  --   have ⟨h, hh1, _⟩ := UnderExcl.union_eq hu hf.excl he
+  --   subst_vars
+  --   have he1 := hf.excl.injective he
+  --   subst_vars
+
+
+
+
+
+theorem Kind.Disjoint.subclassed_excl_swap (hd : Disjoint n (g (.excl K1 b)) K2) (hg : UnderExcl g) (hsub : b.subclass a) : ∃ m, Disjoint m (g K1) (.excl K2 a) := by
+  generalize he : g (Kind.excl K1 b) = K at hd
+  cases hd <;> (subst_vars; try contradiction; try simp at hd)
+  case base hd =>
+    cases hg <;> cases he
+  case union_l hu ha hb =>
+    -- have hq : g (K1.excl b) = (g.excl b) K1 := by simp
+    have ⟨h, hh1, hh2⟩ := UnderExcl.union_eq hu hg.prepend he
+    subst_vars; simp_all
+    have ⟨ma, ha⟩ := ha.subclassed_excl_swap hg hsub
+    have ⟨mb, hb⟩ := hb.subclassed_excl_swap hg hsub
+    have he1 := hg.injective he
+    injections; subst K1
+    exists 1 + ma + mb
+    apply union_l (hg.compose hh1) ha hb
+  case union_r f _ _ _ _ hu ha hb =>
+    have ⟨ma, _⟩ := ha.subclassed_excl_swap hg hsub
+    have ⟨mb, _⟩ := hb.subclassed_excl_swap hg hsub
+    exists 1 + ma + mb
+    rw [← hu.excl_fold] at *
+    apply! union_r hu.excl
+  case excl_this_l ha =>
+    cases hg <;> (simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all)
+    case empty =>
+      exists 0
+      apply empty_r .empty
+      apply! Classifier.subclass_trans
+    case excl g _ hg =>
+      exists 1 + 0
+      apply excl_r .one
+      apply! excl_this_l
+  -- case excl_union_l ha hb =>
+  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
+  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
+  --   exists 1 + ma + mb
+  --   apply! union_l
+  -- case excl_union_r ha hb =>
+  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
+  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
+  case excl_l f n a hu ha =>
+    cases hg.prefix hu he
+    case inl ih =>
+      have ⟨h, hh1, hh2⟩ := ih
       subst_vars; simp_all
-      have ha1 := ha.symm
-      sorry
-    case excl_union_r =>
-      have ⟨_, _⟩ := h
+      have he1 := hu.injective he
+      subst_vars
+      have ⟨ma, _⟩ := ha.subclassed_excl_swap hh1 hsub
+      exists 1 + ma
+      apply! excl_l
+    case inr ih =>
+      have ⟨h, hh1, hh2⟩ := ih
       subst_vars; simp_all
-      apply ih
-
-
-
-    case excl_union_l => apply! excl_union_l
-    case excl_l => apply! excl_l
+      have he1 := hg.injective he
+      cases hh1
+      case empty =>
+        simp at he1; subst_vars; simp_all
+        have ⟨ma, ha1⟩ := ha.subclassed_excl_swap .empty hsub
+        exists 1 + ma
+        apply! excl_l
+      case excl h' c hh1 =>
+        simp at he1; have ⟨_, _⟩ := he1; subst_vars; simp_all
+        exists 1 + (1 + n)
+        apply excl_r .one
+        apply excl_l (hg.compose hh1) ha
+    -- induction hu
+    -- case empty =>
+    --   subst_vars
+    --   apply! ha.subclassed_excl_swap
+    -- case excl hu ih =>
+    --   simp at he;
+    --   cases hg <;> (simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all)
+    --   case empty =>
+    --     exists 1 + (1 + n)
+    --     apply excl_r .one
+    --     apply! excl_l
+    --   case excl hg =>
+
+      -- have ⟨_, _⟩ := he; subst_vars; simp_all
+      -- rename_i n _ _ _
+      -- exists 1 + (1 + n)
+      -- apply excl_r UnderExcl.empty.excl
+      -- apply excl_l hu ha
+  -- case excl_r c1 hu ha =>
+  --   have ⟨ma, ha1⟩ := ha.subclassed_excl_swap hsub
+  --   rw [← hu.excl_fold]
+  --   simp
+  --   exists 1 + (1 + ma)
+  --   apply excl_up_r hu
+  --   apply! excl_r
+  case excl_up_l hu ha =>
+    simp at h; have ⟨_, _⟩ := h; subst_vars; simp_all
+
+    -- have
+    -- induction hu
+    -- case empty =>
+    --   simp_all; have ⟨_, _⟩ := h; subst_vars; simp_all
+    --   apply ha.subclassed_excl_swap hsub
+    -- case excl hu _ =>
+    --   simp_all; have ⟨_, _⟩ := h; subst_vars; simp_all
+      -- have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
+
+
+    -- have ⟨ma, ha1⟩ := ha.subclassed_excl_swap hsub
+
+
+
+
+
+
+
+
+
+  -- case excl_this ha =>
+  --   exists 1 + 0
+  --   apply symm
+  --   apply empty
+  --   apply Classifier.subclass_trans ha hsub
+  -- case excl_union na a nb b ha hb =>
+  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
+  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
+  --   exists 1 + ma + mb
+  --   apply! union
+  -- case
+
+-- theorem Kind.Disjoint.subclassed_excl (hd : Disjoint (.excl K1 a) (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
+--   cases hd
+--   case excl_union_l ha hb =>
+--     apply excl_union_l
+--     apply ha.subclassed_excl hsub
+--     apply hb.subclassed_excl hsub
+--   case excl_union_r ha hb =>
+--     apply union_r
+--     apply ha.subclassed_excl hsub
+--     apply hb.subclassed_excl hsub
+--   case excl_r ha => assumption
+--   case excl_l ha =>
+
+
+
+
+
+-- theorem Kind.Disjoint.disjointed_excl (hd : Disjoint K1 (.excl K2 a)) (hda : Disjoint K1 (.classifier a)) : Disjoint K1 K2 := by
+--   cases hd
+--   case union_l ha hb =>
+--     have ⟨hl, hr⟩ := hda.symm.union_r_inv
+--     apply union_l (ha.disjointed_excl hl.symm) (hb.disjointed_excl hr.symm)
+--   case excl_this_r ha =>
+--     cases hda
+--     have h := Classifier.disjoint_subclass ha
+--     simp_all
+--   case excl_union_l ha hb =>
+--     cases hda
+--     case excl_this_l hsub =>
+--       -- apply excl_union_l
+
+--     case excl_l hda =>
+--       have ⟨hl, hr⟩ := hda.symm.union_r_inv
+--       apply excl_union_l
+--       apply ha.disjointed_excl hl.symm.excl_l
+--       apply hb.disjointed_excl hr.symm.excl_l
+
+
+
+-- theorem Kind.Disjoint.of_subkind (hd : Disjoint n K K2) (hs : Subkind K1 K2) : ∃ m, Disjoint m K K1 := by
+--   induction hs generalizing K n
+--   case trans ha hb iha ihb =>
+--     have ⟨m, hb⟩ := ihb hd
+--     apply! iha (n:=m)
+--   case base a b hs =>
+--     generalize h : Kind.classifier b = K2 at hd
+--     induction hd <;> try (subst_vars; simp_all)
+--     case base hd =>
+--       exists 0
+--       apply base
+--       apply! Classifier.subclass_disjoint
+--     case union_l ha hb =>
+--       have ⟨n, _⟩ := ha
+--       have ⟨m, _⟩ := hb
+--       exists 1 + n + m
+--       apply! union_l
+--     case excl_this_l hs1 =>
+--       exists 0
+--       apply excl_this_l; apply! Classifier.subclass_trans
+--     case excl_l ha =>
+--       have ⟨n, _⟩ := ha
+--       exists 1 + n
+--       apply! excl_l
+--     case union_r hu _ _ ha hb => cases hu <;> cases h
+--     case excl_r n _ _ hu ha ih =>
+--       cases hu <;> cases h
+--       exists n
+
+--   case union_l ha hb iha ihb =>
+--     apply union_r
+--     apply! iha
+--     apply! ihb
+--   case union_r1 ha ih =>
+--     have ⟨_, _⟩ := hd.union_r_inv
+--     apply! ih
+--   case union_r2 ha ih =>
+--     have ⟨_, _⟩ := hd.union_r_inv
+--     apply! ih
+--   case excl_l ha ih => apply excl_r; apply! ih
+--   case excl_r A B k hs ha ih =>
+--     generalize h : Kind.excl B k = K2 at hd
+--     induction hd <;> try (subst_vars; simp_all)
+--     case union_l => apply! union_l
+--     case excl_this_r hs =>
+--       have ⟨_, _⟩ := h
+--       subst_vars; simp_all
+--       have ha1 := ha.symm
+--       sorry
+--     case excl_union_r =>
+--       have ⟨_, _⟩ := h
+--       subst_vars; simp_all
+--       apply ih
+
+
+
+  --   case excl_union_l => apply! excl_union_l
+  --   case excl_l => apply! excl_l
 
 
 
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 11f8ebc2..d476facb 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -56,7 +56,23 @@ theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (
     apply! ProjectedSingletonWith.there
 
 theorem WellScoped.push_proj_sub {C : CaptureSet n k} (hsc : WellScoped Γ cont (C.push_proj K2)) (hsk : K1.Subkind K2) : WellScoped Γ cont (C.push_proj K1) := by
-  --  hsc.implies_canonical
+  induction C <;> simp_all
+  case union ih1 ih2 =>
+    cases hsc
+    case label_disj hsw => cases hsw
+    case union ha hb => apply union (ih1 ha) (ih2 hb)
+  case proj ih =>
+    cases hsc
+    case proj_singleton hsc hp =>
+      cases hp
+      rename_i hp
+      apply proj_singleton hsc $ .proj hp
+    case label_disj hb hd hsw =>
+      cases hsw
+      case here hs =>
+
+
+
 
 theorem WellScoped.has_singleton
   (hsc : WellScoped Γ cont C2)

From 374beece6405043d2bb3745d0e152e9f0cbd95c1 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 1 Dec 2025 17:47:41 +0100
Subject: [PATCH 27/71] Update mathlib commit

---
 lake-manifest.json | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lake-manifest.json b/lake-manifest.json
index ba58f1cb..26313734 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -25,7 +25,7 @@
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "0df2e3c2047ada0d7a2e33dbc6ba2788a44a6062",
+   "rev": "77b45269e0888a839059d6678a32631c8066da21",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
    "inputRev": "v4.25.1",
@@ -95,7 +95,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "135329b50b116dcc2c021c318c365e82a048856f",
+   "rev": "658f43ce96423382c226ad17db8041f7e99ddf31",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
    "inputRev": "v0.0.80",

From b30905d9964d94a43e821e23c884eb9d3ceba53c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 2 Dec 2025 01:40:44 +0100
Subject: [PATCH 28/71] Big rework

---
 Capless/Classifier.lean | 1283 +++++++++++++++++----------------------
 1 file changed, 558 insertions(+), 725 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 1f625695..a8545773 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -8,736 +8,375 @@ inductive Classifier : Type where
   | child : Nat -> Classifier -> Classifier
 deriving DecidableEq
 
-instance : LawfulBEq Classifier where
-  rfl := by
-    intro a
-    induction a <;> simp [BEq.beq]
-  eq_of_beq := by
-    intro a b h
-    induction a <;> induction b <;> simp_all [BEq.beq]
-
-@[simp]
-def Classifier.depth (c: Classifier) : Nat :=
-  match c with
-  | top => 0
-  | child _ p => 1 + p.depth
-
-@[simp]
-def Classifier.subclass (c1: Classifier) (c2: Classifier) : Bool :=
-  if c1 == c2 then true
-  else
-    match c1 with
-    | .top => false
-    | .child _ p => p.subclass c2
-
-@[simp]
-def Classifier.disjoint (c1: Classifier) (c2: Classifier) : Bool :=
-  match c1 with
-    | top => false
-    | child n p => match c2 with
-      | top => false
-      | child m q =>
-        if p == q then n != m
-        else (child n p).disjoint q || p.disjoint (child m q)
+inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
+  | eq : Subclass a a
+  | parent_l : Subclass a b -> Subclass (child n a) b
 
-inductive Kind : Type where
-  | classifier : Classifier -> Kind
-  | union : Kind -> Kind -> Kind
-  | excl : Kind -> Classifier -> Kind
-
-/-- The top kind -/
-def Kind.any := Kind.classifier .top
-
-def KindFun : Type := Kind -> Kind
-
-@[simp]
-def KindFun.excl (f : KindFun) (c : Classifier) := (fun (x: Kind) => x.excl c) ∘ f
+inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
+  | base : n != m -> Disjoint (child n p) (child m p)
+  | left : Disjoint a b -> Disjoint (child n a) b
+  | right : Disjoint a b -> Disjoint a (child m b)
 
-@[simp]
-def KindFun.prepend (f: KindFun) (c : Classifier) := f ∘ (fun (x: Kind) => x.excl c)
-
-inductive UnderExcl : KindFun -> Prop where
-  | empty : UnderExcl id
-  | excl : UnderExcl f -> UnderExcl (f.excl c)
-
-theorem UnderExcl.prepend (hu : UnderExcl f) : UnderExcl (f.prepend c) := by
-  induction hu
-  case empty =>
-    simp
-    apply excl .empty
-  case excl hu ih =>
-    simp
-    rw [Function.comp_assoc]
-    apply excl ih
-
-theorem UnderExcl.one {c : Classifier} : UnderExcl (.excl id c) := .excl .empty
-
-theorem UnderExcl.injective (hu : UnderExcl f) : Function.Injective f := by
-  induction hu
-  case empty => apply Function.injective_id
-  case excl hu ih =>
-    intro a b h
-    simp at h
-    apply ih h
-
-inductive Kind.Disjoint : Nat -> Kind -> Kind -> Prop where
-  | base :
-    a.disjoint b ->
-    Disjoint 0 (classifier a) (classifier b)
-  | union_l :
-    UnderExcl f ->
-    Disjoint n (f a1) b ->
-    Disjoint m (f a2) b ->
-    Disjoint (1 + n + m) (f $ union a1 a2) b
-  | union_r :
-    UnderExcl f->
-    Disjoint n a (f b1) ->
-    Disjoint m a (f b2) ->
-    Disjoint (1 + n + m) a (f $ union b1 b2)
-  | excl_this_l :
-    a.subclass b ->
-    Disjoint 0 (excl c b) (classifier a)
-  | excl_this_r :
-    a.subclass b ->
-    Disjoint 0 (classifier a) (excl c b)
-  | excl_l :
-    UnderExcl f ->
-    Disjoint n a b ->
-    Disjoint (1 + n) (f a) b
-  | excl_r :
-    UnderExcl f ->
-    Disjoint n a b ->
-    Disjoint (1 + n) a (f b)
-  | excl_up_l :
-    UnderExcl f ->
-    Disjoint n (f $ .excl k1 a) k2 ->
-    Disjoint (1 + n) (.excl (f k1) a) k2
-  | excl_up_r :
-    UnderExcl f ->
-    Disjoint n k1 (f $ .excl k2 a) ->
-    Disjoint (1 + n) k1 (.excl (f k2) a)
-  | empty_l :
-    UnderExcl f ->
-    a.subclass b ->
-    Disjoint 0 (excl (f $ classifier a) b) K
-  | empty_r :
-    UnderExcl f ->
-    a.subclass b ->
-    Disjoint 0 K (excl (f $ classifier a) b)
-
-inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | base : a.subclass b -> Subkind (classifier a) (classifier b)
-  | union_l : Subkind a1 b -> Subkind a2 b -> Subkind (union a1 a2) b
-  | union_r1 : Subkind a b1 -> Subkind a (union b1 b2)
-  | union_r2 : Subkind a b2 -> Subkind a (union b1 b2)
-  | excl_l : Subkind a b -> Subkind (excl a c) b
-  | excl_r : Subkind a b -> Kind.Disjoint n a (classifier k) -> Subkind a (excl b k)
-  | trans : Subkind a b -> Subkind b c -> Subkind a c
-
-theorem Classifier.subclass_top : Classifier.subclass k .top := by
-  induction k
-  case top => trivial
-  case child n p => simp_all
-
-theorem Classifier.subclass_of_top : Classifier.top.subclass k -> k = .top := by
-  intro h
-  induction k
-  case top => trivial
-  case child n p ih =>
-    simp at h
-
-theorem Classifier.disjoint_symm : Classifier.disjoint a b -> b.disjoint a := by
-  intro h
-  induction a generalizing b
-  case top =>
-    simp_all
-  case child n p ih =>
-    induction b <;> simp at h
-    rename_i m q ihb
-    simp
-    split <;> subst_vars
-    simp at h
-    false_or_by_contra
-    apply h.elim (Eq.symm _)
-    assumption
-    split at h
-    rename_i h0 h1
-    apply h0.elim (Eq.symm h1)
-    cases h
-    { right; apply ihb; assumption }
-    { left; apply ih; assumption }
-
-theorem Classifier.neq_child : q ≠ (child n q) := by
-  intro h
-  induction q
-  case top => cases h
-  case child m p ih =>
-    injections
-    apply ih
-    subst_vars
-    assumption
-
-theorem Classifier.disjoint_top : Classifier.disjoint a .top -> False := by
-  intro h
+theorem Classifier.Subclass.of_top : Subclass a .top := by
   induction a
-  case top => simp at h
-  case child n p ih => simp at h
-
-theorem Classifier.subclass_down : subclass a b -> (a = b) ∨ (∃ n, subclass a (.child n b)) := by
-  intro h
-  induction a generalizing b
-  case top => left; symm; apply subclass_of_top; assumption
-  case child n p ih =>
-    simp at h
-    cases h
-    case inl h0 => subst_vars; left; trivial
-    case inr h0 =>
-      right
-      cases ih h0
-      { subst_vars; exists n; simp; }
-      { rename_i h1; have ⟨n, h1⟩ := h1; exists n; simp; right; assumption }
-
-theorem Classifier.subclass_inv : subclass a b -> (a = b) ∨ (∃ n p, a = child n p ∧ p.subclass b) := by
-  intro h
-  induction a
-  case top => left; symm; apply subclass_of_top h
-  case child n p ih =>
-    simp at h
-    cases h
-    case inl h => left; assumption
-    case inr h =>
-      right
-      apply Exists.intro n
-      apply Exists.intro p
-      apply And.intro
-      rfl
-      cases ih h
-      subst_vars
-      assumption
-      rename_i h
-      have ⟨n0, p0, hp, h0⟩ := h
-      subst_vars
-      assumption
-
-
-theorem Classifier.subclass_depth : subclass a b -> a.depth >= b.depth := by
-  induction a generalizing b
-  case top => simp; intro; subst_vars; simp
-  case child n p ih =>
-    intro h
-    simp at h
-    cases h
-    case inl h => subst_vars; simp
-    case inr h => simp; have h0 := ih h; omega
-
-theorem Classifier.subclass_child : subclass a (child n a) -> False := by
-  intro h
-  have h0 := subclass_depth h
-  simp at h0
-  omega
-
-theorem Classifier.subclass_up : subclass a (child m b) -> subclass a b := by
-  intro h
-  induction a generalizing b
-  case top => have h0 := subclass_depth h; simp at h
-  case child n p ih =>
-    simp at h
-    cases h
-    case inl h =>
-      have ⟨hn, h⟩ := h
-      subst_vars
-      simp
-      right
-      unfold subclass
-      simp
-    case inr h =>
-      have h0 := ih h
-      simp
-      right
-      assumption
-
-theorem Classifier.subclass_trans : subclass a b -> subclass b c -> subclass a c := by
-  intro h1 h2
-  induction b
-  case top => simp_all
-  case child n k ih =>
-    have h11 := subclass_up h1
-    simp at h2
-    cases h2
-    case inl h2 => subst_vars; simp_all
-    case inr h2 => apply ih h11 h2
-
-theorem Classifier.disjoint_antisymm : disjoint a a = false := by
-  induction a <;> simp
-
-theorem Classifier.disjoint_subclass : subclass a b -> disjoint a b = false := by
-  intro h
-  induction a generalizing b
-  case top => simp_all; apply disjoint_antisymm
-  case child n p iha =>
-    induction b
-    case top => simp
-    case child m q ihb =>
-      simp
-      split
-      subst_vars
-      simp at h
-      cases h; assumption; rename_i h; have h0 := subclass_child (a := q) (n := m); contradiction
-      apply And.intro
-      apply (ihb (subclass_up h))
-      cases subclass_inv h
-      case inl h => injections; contradiction
-      case inr h =>
-        have ⟨n0, p0, hp, hh⟩ := h
-        injections
-        subst_vars
-        apply iha
-        assumption
-
-theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
-  intro h
-  induction a generalizing b m
-  case top => simp at h
-  case child n p ih =>
-    induction b generalizing m
-    case top => exfalso; apply disjoint_top h
-    case child k q ihb =>
-      simp at h
-      split at h
-      subst_vars
-      simp
-      split
-      exfalso; apply neq_child; assumption
-      left; assumption
-      cases h
-      case inl h =>
-        have h0 := ihb (m := k) h
-        simp
-        split
-        subst_vars
-        { have h1 : (child n (child k q)).subclass (child k q)  := by simp
-          have h2 := disjoint_subclass h1
-          rw [Bool.eq_false_iff] at h2
-          contradiction }
-        { left; left; assumption }
-      case inr h =>
-        simp
-        split
-        { subst_vars; simp at h }
-        { left; right; assumption }
-
-theorem Classifier.subclass_disjoint : subclass a1 a2 -> disjoint b a2 -> disjoint b a1 := by
-  intro hs hd
-  induction a1
-  case top =>
-    simp at hs; subst_vars; exfalso; apply disjoint_top hd
-  case child n k ih =>
-    simp at hs
-    cases hs
-    case inl h => subst_vars; simp_all
-    case inr h => apply disjoint_up; apply ih h
+  case top => apply eq
+  case child n k ih => apply parent_l ih
+
+theorem Classifier.Subclass.parent_r (hs : Subclass a (child n b)) : Subclass a b := by
+  cases hs
+  case eq => apply parent_l .eq
+  case parent_l hp =>
+    apply parent_l hp.parent_r
+
+theorem Classifier.Subclass.trans (h1 : Subclass a b) (h2 : Subclass b c) : Subclass a c := by
+  induction h2
+  case eq => assumption
+  case parent_l hp ih => apply ih h1.parent_r
+
+theorem Classifier.Subclass.down_r (hs : Subclass a b) : a = b ∨ ∃ n, Subclass a (child n b) := by
+  induction hs
+  case eq => simp
+  case parent_l ih =>
+    rename_i n _
+    right
+    cases ih
+    case inl ih => subst_vars; exists n; constructor
+    case inr ih =>
+      have ⟨m, ih⟩ := ih
+      exists m
+      apply parent_l ih
 
-theorem Kind.Subkind.rfl : Kind.Subkind k k := by
-  cases k
-  case classifier a =>
-    constructor
-    unfold Classifier.subclass; simp
-  case union a b =>
-    apply Subkind.union_l
-    apply Subkind.union_r1
-    apply rfl
-    apply Subkind.union_r2
-    apply rfl
-  case excl k a =>
-    apply Subkind.excl_r
-    apply Subkind.excl_l
-    apply rfl
-    apply Disjoint.excl_this_l
-    unfold Classifier.subclass; simp
-
-theorem Kind.subkind_any : Kind.Subkind K .any := by
-  induction K
-  case classifier a =>
-    apply Subkind.base; apply Classifier.subclass_top
-  case union a b iha ihb =>
-    apply Subkind.union_l <;> assumption
-  case excl K c ih =>
-    apply Subkind.excl_l ih
-
-theorem Kind.Disjoint.symm (hd : Disjoint n K1 K2) : Disjoint n K2 K1 := by
+theorem Classifier.Disjoint.symm (hd : Disjoint a b) : Disjoint b a := by
   induction hd
-  case base hd =>
-    have hd1 := Classifier.disjoint_symm hd
-    apply! base
-  case union_l => apply! union_r
-  case union_r => apply! union_l
-  case excl_this_l => apply! excl_this_r
-  case excl_this_r => apply! excl_this_l
-  -- case excl_union_l => apply! excl_union_r
-  -- case excl_union_r => apply! excl_union_l
-  case excl_l => apply! excl_r
-  case excl_r => apply! excl_l
-  case excl_up_l => apply! excl_up_r
-  case excl_up_r => apply! excl_up_l
-  case empty_l => apply! empty_r
-  case empty_r => apply! empty_l
-
-theorem Kind.Disjoint.union_r_inv (hd : Disjoint n K (.union K1 K2)) : ∃ n1 n2 : Nat, n1 ≤ n ∧ n2 ≤ n ∧ Disjoint n1 K K1 ∧ Disjoint n2 K K2 := by
-  generalize h : Kind.union K1 K2 = K at hd
-  cases hd <;> (subst_vars; try contradiction; try simp at hd)
-  case union_l hu ha hb =>
-    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
-    have ⟨nb1, nb2, ⟨_, _, _, _⟩⟩ := hb.union_r_inv
-    exists 1 + na1 + nb1, 1 + na2 + nb2
-    apply And.intro; omega
-    apply And.intro; omega
-    apply And.intro <;> apply! union_l
-  case union_r hu ha hb =>
-    cases hu <;> try cases h
-    rename_i n m
-    exists n, m
-    apply And.intro; omega
-    apply And.intro; omega
-    apply! And.intro
-  case excl_l hu ha =>
-    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
-    exists 1 + na1, 1 + na2
-    apply And.intro; omega
-    apply And.intro; omega
-    apply And.intro <;> apply! excl_l
-  case excl_r hu ha =>
-    cases hu <;> try cases h
-    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
-    exists na1, na2
-    apply And.intro; omega
-    apply And.intro; omega
-    apply! And.intro
-  case excl_up_l ha =>
-    have ⟨na1, na2, ⟨_, _, _, _⟩⟩ := ha.union_r_inv
-    exists 1 + na1, 1 + na2
-    apply And.intro; omega
-    apply And.intro; omega
-    apply And.intro <;> apply! excl_up_l
-  case empty_l ha =>
-    exists 0, 0
-    apply And.intro; omega
-    apply And.intro; omega
-    apply And.intro <;> apply! empty_l
-
-theorem UnderExcl.excl_fold {f : KindFun} (hu : UnderExcl f) : (f.excl c) k = (f k).excl c := by
-  induction hu <;> simp_all
-
-theorem UnderExcl.compose (hu1 : UnderExcl f) (hu2 : UnderExcl g) : UnderExcl (f ∘ g) := by
-  induction hu1
-  case empty =>
-    rw [Function.id_comp]
-    assumption
-  case excl hu ih =>
-    rw [KindFun.excl]
-    rw [Function.comp_assoc]
-    rw [← KindFun.excl]
-    constructor; assumption
-
-theorem UnderExcl.prefix (hf : UnderExcl f) (hg : UnderExcl g) (he : f k1 = g k2) : (∃ h, UnderExcl h ∧ f = g ∘ h) ∨ (∃ h, UnderExcl h ∧ g = f ∘ h) := by
-  induction hf generalizing g k1 k2
-  case empty =>
-    right
-    exists g
-  case excl f' c hf ih =>
-    simp at he
-    cases hg
-    case empty => simp at he; subst_vars; simp_all; left; apply! excl
-    case excl g' c' hg =>
-      simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all
-      cases ih hg he
-      case inl ih =>
-        have ⟨h, hh1, hh2⟩ := ih
-        left
-        exists h
-        apply And.intro; assumption
-        rw [Function.comp_assoc, hh2]
-      case inr ih =>
-        have ⟨h, hh1, hh2⟩ := ih
-        right
-        exists h
-        apply And.intro; assumption
-        rw [Function.comp_assoc, hh2]
-
-theorem UnderExcl.union_eq (hf : UnderExcl f) (hg : UnderExcl g) (he : g k = f (.union k1 k2)) : ∃ h, UnderExcl h ∧ f = g ∘ h := by
-  induction hg generalizing f k k1 k2
-  case empty =>
-    exists f
-  case excl g' c hg ih =>
-    simp at he
-    cases hf
-    case empty => cases he
-    case excl f' c' hf =>
-      simp at he; have ⟨_, _⟩ := he; subst_vars
-      rename_i hf'
-      unfold KindFun.excl
-      have ⟨h, ⟨_, hh⟩⟩ := ih hf hf'
-      exists h
-      apply And.intro; assumption
-      rw [Function.comp_assoc]
-      rw [hh]
-  -- case empty =>
-  --   induction hg
-  --   case empty => simp_all; apply empty
-  --   case excl hg ih => simp_all
-  -- case excl f c hf ihf =>
-
-    -- induction hg generalizing f c k k1 k2
-    -- case empty => simp_all; constructor; apply hf
-    -- case excl hg ihg =>
-    --   simp at he; have ⟨_, _⟩ := he; subst_vars
-
-theorem Kind.Disjoint.excl_up_r_inv (hd : Disjoint n a (.excl (f b) c)) (hf : UnderExcl f) : ∃ m, Disjoint m a (f (.excl b c)) := by sorry
-  -- generalize he : (f b).excl c = K at hd
-  -- cases hd <;> (subst_vars; try simp_all)
-  -- case union_l hu ha hb =>
-  --   -- have ⟨ma, _, _⟩ := ha.excl_up_r_inv hf
-  --   -- have ⟨mb, _, _⟩ := hb.excl_up_r_inv hf
-  --   exists 1 + ma + mb
-  --   apply And.intro; omega
-  --   apply! union_l
-  -- case union_r hu ha hb =>
-  --   have ⟨h, hh1, _⟩ := UnderExcl.union_eq hu hf.excl he
-  --   subst_vars
-  --   have he1 := hf.excl.injective he
-  --   subst_vars
-
-
-
-
-
-theorem Kind.Disjoint.subclassed_excl_swap (hd : Disjoint n (g (.excl K1 b)) K2) (hg : UnderExcl g) (hsub : b.subclass a) : ∃ m, Disjoint m (g K1) (.excl K2 a) := by
-  generalize he : g (Kind.excl K1 b) = K at hd
-  cases hd <;> (subst_vars; try contradiction; try simp at hd)
-  case base hd =>
-    cases hg <;> cases he
-  case union_l hu ha hb =>
-    -- have hq : g (K1.excl b) = (g.excl b) K1 := by simp
-    have ⟨h, hh1, hh2⟩ := UnderExcl.union_eq hu hg.prepend he
-    subst_vars; simp_all
-    have ⟨ma, ha⟩ := ha.subclassed_excl_swap hg hsub
-    have ⟨mb, hb⟩ := hb.subclassed_excl_swap hg hsub
-    have he1 := hg.injective he
-    injections; subst K1
-    exists 1 + ma + mb
-    apply union_l (hg.compose hh1) ha hb
-  case union_r f _ _ _ _ hu ha hb =>
-    have ⟨ma, _⟩ := ha.subclassed_excl_swap hg hsub
-    have ⟨mb, _⟩ := hb.subclassed_excl_swap hg hsub
-    exists 1 + ma + mb
-    rw [← hu.excl_fold] at *
-    apply! union_r hu.excl
-  case excl_this_l ha =>
-    cases hg <;> (simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all)
-    case empty =>
-      exists 0
-      apply empty_r .empty
-      apply! Classifier.subclass_trans
-    case excl g _ hg =>
-      exists 1 + 0
-      apply excl_r .one
-      apply! excl_this_l
-  -- case excl_union_l ha hb =>
-  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
-  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
-  --   exists 1 + ma + mb
-  --   apply! union_l
-  -- case excl_union_r ha hb =>
-  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
-  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
-  case excl_l f n a hu ha =>
-    cases hg.prefix hu he
+  case base hne =>
+    apply base; aesop
+  case left => apply! right
+  case right => apply! left
+
+theorem Classifier.Disjoint.refines_subclass_r
+  (hd : Disjoint b a2)
+  (hs : Subclass a1 a2) : Disjoint b a1 := by
+  induction hs
+  case eq => assumption
+  case parent_l hs ih =>
+    apply right $ ih hd
+
+theorem Classifier.subclass_or_disjoint :
+  Subclass a b ∨ Subclass b a ∨ Disjoint a b := by
+  induction a
+  case top => right; left; apply Subclass.of_top
+  case child n k ih =>
+    cases ih
     case inl ih =>
-      have ⟨h, hh1, hh2⟩ := ih
-      subst_vars; simp_all
-      have he1 := hu.injective he
-      subst_vars
-      have ⟨ma, _⟩ := ha.subclassed_excl_swap hh1 hsub
-      exists 1 + ma
-      apply! excl_l
+      left; constructor; assumption
     case inr ih =>
-      have ⟨h, hh1, hh2⟩ := ih
-      subst_vars; simp_all
-      have he1 := hg.injective he
-      cases hh1
-      case empty =>
-        simp at he1; subst_vars; simp_all
-        have ⟨ma, ha1⟩ := ha.subclassed_excl_swap .empty hsub
-        exists 1 + ma
-        apply! excl_l
-      case excl h' c hh1 =>
-        simp at he1; have ⟨_, _⟩ := he1; subst_vars; simp_all
-        exists 1 + (1 + n)
-        apply excl_r .one
-        apply excl_l (hg.compose hh1) ha
-    -- induction hu
-    -- case empty =>
-    --   subst_vars
-    --   apply! ha.subclassed_excl_swap
-    -- case excl hu ih =>
-    --   simp at he;
-    --   cases hg <;> (simp at he; have ⟨_, _⟩ := he; subst_vars; simp_all)
-    --   case empty =>
-    --     exists 1 + (1 + n)
-    --     apply excl_r .one
-    --     apply! excl_l
-    --   case excl hg =>
-
-      -- have ⟨_, _⟩ := he; subst_vars; simp_all
-      -- rename_i n _ _ _
-      -- exists 1 + (1 + n)
-      -- apply excl_r UnderExcl.empty.excl
-      -- apply excl_l hu ha
-  -- case excl_r c1 hu ha =>
-  --   have ⟨ma, ha1⟩ := ha.subclassed_excl_swap hsub
-  --   rw [← hu.excl_fold]
-  --   simp
-  --   exists 1 + (1 + ma)
-  --   apply excl_up_r hu
-  --   apply! excl_r
-  case excl_up_l hu ha =>
-    simp at h; have ⟨_, _⟩ := h; subst_vars; simp_all
-
-    -- have
-    -- induction hu
-    -- case empty =>
-    --   simp_all; have ⟨_, _⟩ := h; subst_vars; simp_all
-    --   apply ha.subclassed_excl_swap hsub
-    -- case excl hu _ =>
-    --   simp_all; have ⟨_, _⟩ := h; subst_vars; simp_all
-      -- have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
-
-
-    -- have ⟨ma, ha1⟩ := ha.subclassed_excl_swap hsub
-
-
-
-
-
-
-
-
-
-  -- case excl_this ha =>
-  --   exists 1 + 0
-  --   apply symm
-  --   apply empty
-  --   apply Classifier.subclass_trans ha hsub
-  -- case excl_union na a nb b ha hb =>
-  --   have ⟨ma, _⟩ := ha.subclassed_excl_swap hsub
-  --   have ⟨mb, _⟩ := hb.subclassed_excl_swap hsub
-  --   exists 1 + ma + mb
-  --   apply! union
-  -- case
-
--- theorem Kind.Disjoint.subclassed_excl (hd : Disjoint (.excl K1 a) (.excl K2 b)) (hsub : b.subclass a) : Disjoint (.excl K1 a) K2 := by
---   cases hd
---   case excl_union_l ha hb =>
---     apply excl_union_l
---     apply ha.subclassed_excl hsub
---     apply hb.subclassed_excl hsub
---   case excl_union_r ha hb =>
---     apply union_r
---     apply ha.subclassed_excl hsub
---     apply hb.subclassed_excl hsub
---   case excl_r ha => assumption
---   case excl_l ha =>
-
-
-
-
-
--- theorem Kind.Disjoint.disjointed_excl (hd : Disjoint K1 (.excl K2 a)) (hda : Disjoint K1 (.classifier a)) : Disjoint K1 K2 := by
---   cases hd
---   case union_l ha hb =>
---     have ⟨hl, hr⟩ := hda.symm.union_r_inv
---     apply union_l (ha.disjointed_excl hl.symm) (hb.disjointed_excl hr.symm)
---   case excl_this_r ha =>
---     cases hda
---     have h := Classifier.disjoint_subclass ha
+      cases ih
+      case inl ih =>
+        cases ih.down_r
+        { subst_vars; left; apply Subclass.parent_l .eq }
+        { rename_i ih1; have ⟨m, ih1⟩ := ih1;
+          generalize h : (n == m) = h0;
+          cases h0
+          right; right;
+          apply Disjoint.refines_subclass_r; apply Disjoint.base (m:=m); aesop; assumption
+          have h0 := LawfulBEq.eq_of_beq h; subst_vars; right; left; assumption
+        }
+      case inr ih =>
+        right; right; apply Disjoint.left ih
+
+
+-- instance : LawfulBEq Classifier where
+--   rfl := by
+--     intro a
+--     induction a <;> simp [BEq.beq]
+--   eq_of_beq := by
+--     intro a b h
+--     induction a <;> induction b <;> simp_all [BEq.beq]
+
+-- @[simp]
+-- def Classifier.depth (c: Classifier) : Nat :=
+--   match c with
+--   | top => 0
+--   | child _ p => 1 + p.depth
+
+-- @[simp]
+-- def Classifier.subclass (c1: Classifier) (c2: Classifier) : Bool :=
+--   if c1 == c2 then true
+--   else
+--     match c1 with
+--     | .top => false
+--     | .child _ p => p.subclass c2
+
+-- @[simp]
+-- def Classifier.disjoint (c1: Classifier) (c2: Classifier) : Bool :=
+--   match c1 with
+--     | top => false
+--     | child n p => match c2 with
+--       | top => false
+--       | child m q =>
+--         if p == q then n != m
+--         else (child n p).disjoint q || p.disjoint (child m q)
+
+-- inductive Kind : Type where
+--   -- a tree dropping some classifiers
+--   | empty
+--   | singleton : Classifier -> List Classifier -> Kind
+--   | union : Kind -> Kind -> Kind
+
+-- /-- The top kind -/
+-- def Kind.any := singleton .top []
+
+-- theorem Classifier.subclass_rfl : Classifier.subclass k k := by
+--   unfold Classifier.subclass
+--   simp
+
+
+-- theorem Classifier.subclass_top : Classifier.subclass k .top := by
+--   induction k
+--   case top => trivial
+--   case child n p => simp_all
+
+-- theorem Classifier.subclass_of_top : Classifier.top.subclass k -> k = .top := by
+--   intro h
+--   induction k
+--   case top => trivial
+--   case child n p ih =>
+--     simp at h
+
+-- theorem Classifier.disjoint_symm : Classifier.disjoint a b -> b.disjoint a := by
+--   intro h
+--   induction a generalizing b
+--   case top =>
 --     simp_all
---   case excl_union_l ha hb =>
---     cases hda
---     case excl_this_l hsub =>
---       -- apply excl_union_l
-
---     case excl_l hda =>
---       have ⟨hl, hr⟩ := hda.symm.union_r_inv
---       apply excl_union_l
---       apply ha.disjointed_excl hl.symm.excl_l
---       apply hb.disjointed_excl hr.symm.excl_l
-
-
-
--- theorem Kind.Disjoint.of_subkind (hd : Disjoint n K K2) (hs : Subkind K1 K2) : ∃ m, Disjoint m K K1 := by
---   induction hs generalizing K n
---   case trans ha hb iha ihb =>
---     have ⟨m, hb⟩ := ihb hd
---     apply! iha (n:=m)
---   case base a b hs =>
---     generalize h : Kind.classifier b = K2 at hd
---     induction hd <;> try (subst_vars; simp_all)
---     case base hd =>
---       exists 0
---       apply base
---       apply! Classifier.subclass_disjoint
---     case union_l ha hb =>
---       have ⟨n, _⟩ := ha
---       have ⟨m, _⟩ := hb
---       exists 1 + n + m
---       apply! union_l
---     case excl_this_l hs1 =>
---       exists 0
---       apply excl_this_l; apply! Classifier.subclass_trans
---     case excl_l ha =>
---       have ⟨n, _⟩ := ha
---       exists 1 + n
---       apply! excl_l
---     case union_r hu _ _ ha hb => cases hu <;> cases h
---     case excl_r n _ _ hu ha ih =>
---       cases hu <;> cases h
---       exists n
-
---   case union_l ha hb iha ihb =>
---     apply union_r
---     apply! iha
---     apply! ihb
---   case union_r1 ha ih =>
---     have ⟨_, _⟩ := hd.union_r_inv
---     apply! ih
---   case union_r2 ha ih =>
---     have ⟨_, _⟩ := hd.union_r_inv
---     apply! ih
---   case excl_l ha ih => apply excl_r; apply! ih
---   case excl_r A B k hs ha ih =>
---     generalize h : Kind.excl B k = K2 at hd
---     induction hd <;> try (subst_vars; simp_all)
---     case union_l => apply! union_l
---     case excl_this_r hs =>
---       have ⟨_, _⟩ := h
---       subst_vars; simp_all
---       have ha1 := ha.symm
---       sorry
---     case excl_union_r =>
---       have ⟨_, _⟩ := h
---       subst_vars; simp_all
---       apply ih
-
-
-
-  --   case excl_union_l => apply! excl_union_l
-  --   case excl_l => apply! excl_l
-
-
-
-
-
-
-
+--   case child n p ih =>
+--     induction b <;> simp at h
+--     rename_i m q ihb
+--     simp
+--     split <;> subst_vars
+--     simp at h
+--     false_or_by_contra
+--     apply h.elim (Eq.symm _)
+--     assumption
+--     split at h
+--     rename_i h0 h1
+--     apply h0.elim (Eq.symm h1)
+--     cases h
+--     { right; apply ihb; assumption }
+--     { left; apply ih; assumption }
+
+-- theorem Classifier.neq_child : q ≠ (child n q) := by
+--   intro h
+--   induction q
+--   case top => cases h
+--   case child m p ih =>
+--     injections
+--     apply ih
+--     subst_vars
+--     assumption
+
+-- theorem Classifier.disjoint_top : Classifier.disjoint a .top -> False := by
+--   intro h
+--   induction a
+--   case top => simp at h
+--   case child n p ih => simp at h
+
+-- theorem Classifier.subclass_down : subclass a b -> (a = b) ∨ (∃ n, subclass a (.child n b)) := by
+--   intro h
+--   induction a generalizing b
+--   case top => left; symm; apply subclass_of_top; assumption
+--   case child n p ih =>
+--     simp at h
+--     cases h
+--     case inl h0 => subst_vars; left; trivial
+--     case inr h0 =>
+--       right
+--       cases ih h0
+--       { subst_vars; exists n; simp; }
+--       { rename_i h1; have ⟨n, h1⟩ := h1; exists n; simp; right; assumption }
+
+-- theorem Classifier.subclass_inv : subclass a b -> (a = b) ∨ (∃ n p, a = child n p ∧ p.subclass b) := by
+--   intro h
+--   induction a
+--   case top => left; symm; apply subclass_of_top h
+--   case child n p ih =>
+--     simp at h
+--     cases h
+--     case inl h => left; assumption
+--     case inr h =>
+--       right
+--       apply Exists.intro n
+--       apply Exists.intro p
+--       apply And.intro
+--       rfl
+--       cases ih h
+--       subst_vars
+--       assumption
+--       rename_i h
+--       have ⟨n0, p0, hp, h0⟩ := h
+--       subst_vars
+--       assumption
+
+
+-- theorem Classifier.subclass_depth : subclass a b -> a.depth >= b.depth := by
+--   induction a generalizing b
+--   case top => simp; intro; subst_vars; simp
+--   case child n p ih =>
+--     intro h
+--     simp at h
+--     cases h
+--     case inl h => subst_vars; simp
+--     case inr h => simp; have h0 := ih h; omega
+
+-- theorem Classifier.subclass_child : subclass a (child n a) -> False := by
+--   intro h
+--   have h0 := subclass_depth h
+--   simp at h0
+--   omega
+
+-- theorem Classifier.subclass_up : subclass a (child m b) -> subclass a b := by
+--   intro h
+--   induction a generalizing b
+--   case top => have h0 := subclass_depth h; simp at h
+--   case child n p ih =>
+--     simp at h
+--     cases h
+--     case inl h =>
+--       have ⟨hn, h⟩ := h
+--       subst_vars
+--       simp
+--       right
+--       unfold subclass
+--       simp
+--     case inr h =>
+--       have h0 := ih h
+--       simp
+--       right
+--       assumption
+
+-- theorem Classifier.subclass_trans : subclass a b -> subclass b c -> subclass a c := by
+--   intro h1 h2
+--   induction b
+--   case top => simp_all
+--   case child n k ih =>
+--     have h11 := subclass_up h1
+--     simp at h2
+--     cases h2
+--     case inl h2 => subst_vars; simp_all
+--     case inr h2 => apply ih h11 h2
+
+-- theorem Classifier.disjoint_antisymm : disjoint a a = false := by
+--   induction a <;> simp
+
+-- theorem Classifier.disjoint_subclass : subclass a b -> disjoint a b = false := by
+--   intro h
+--   induction a generalizing b
+--   case top => simp_all; apply disjoint_antisymm
+--   case child n p iha =>
+--     induction b
+--     case top => simp
+--     case child m q ihb =>
+--       simp
+--       split
+--       subst_vars
+--       simp at h
+--       cases h; assumption; rename_i h; have h0 := subclass_child (a := q) (n := m); contradiction
+--       apply And.intro
+--       apply (ihb (subclass_up h))
+--       cases subclass_inv h
+--       case inl h => injections; contradiction
+--       case inr h =>
+--         have ⟨n0, p0, hp, hh⟩ := h
+--         injections
+--         subst_vars
+--         apply iha
+--         assumption
+
+-- theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
+--   intro h
+--   induction a generalizing b m
+--   case top => simp at h
+--   case child n p ih =>
+--     induction b generalizing m
+--     case top => exfalso; apply disjoint_top h
+--     case child k q ihb =>
+--       simp at h
+--       split at h
+--       subst_vars
+--       simp
+--       split
+--       exfalso; apply neq_child; assumption
+--       left; assumption
+--       cases h
+--       case inl h =>
+--         have h0 := ihb (m := k) h
+--         simp
+--         split
+--         subst_vars
+--         { have h1 : (child n (child k q)).subclass (child k q)  := by simp
+--           have h2 := disjoint_subclass h1
+--           rw [Bool.eq_false_iff] at h2
+--           contradiction }
+--         { left; left; assumption }
+--       case inr h =>
+--         simp
+--         split
+--         { subst_vars; simp at h }
+--         { left; right; assumption }
+
+-- theorem Classifier.subclass_disjoint : subclass a1 a2 -> disjoint b a2 -> disjoint b a1 := by
+--   intro hs hd
+--   induction a1
+--   case top =>
+--     simp at hs; subst_vars; exfalso; apply disjoint_top hd
+--   case child n k ih =>
+--     simp at hs
+--     cases hs
+--     case inl h => subst_vars; simp_all
+--     case inr h => apply disjoint_up; apply ih h
+
+-- theorem Classifier.subclass_child_inj : subclass (child n p) (child m p) -> n = m := by
+--   intro h
+--   unfold subclass at h
+--   split at h
+--   case isTrue h0 => have h1 := LawfulBEq.eq_of_beq h0; injections
+--   case isFalse =>
+--     simp at h
+--     have h0 := subclass_depth h
+--     simp at h0
+--     omega
+
+-- theorem Classifier.disjoint_or_subclass : subclass a b ∨ subclass b a ∨ disjoint a b := by
+--   induction a
+--   case top => right; left; apply subclass_top
+--   case child n p ih =>
+--     cases ih
+--     case inl ih =>
+--       left
+--       unfold subclass; simp; right; assumption
+--     case inr ih =>
+--       cases ih
+--       case inl ih =>
+--         cases subclass_down ih
+--         case inl =>
+--           subst_vars
+--           left
+--           unfold subclass; simp; right; assumption
+--         case inr ih =>
+--           have ⟨m, ih⟩ := ih
+--           generalize h : (m == n) = h0
+--           cases h0
+--           case false =>
+--             right; right;
+--             unfold disjoint; simp
+--             split
+--             rename_i h0 _;
+--             cases Classifier.subclass_of_top ih
+--             split
+--             subst_vars
+--             have ih0 := subclass_child_inj ih
+--             subst_vars
+--             simp
+--             aesop
 
 
 
@@ -748,7 +387,201 @@ theorem Kind.Disjoint.subclassed_excl_swap (hd : Disjoint n (g (.excl K1 b)) K2)
 
 
 
+inductive Kind : Type where
+| empty : Kind
+| singleton : Classifier -> List Classifier -> Kind
+| union : Kind -> Kind -> Kind
+
+inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
+  | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
+  | there : HasSuperclassOf b xs -> HasSuperclassOf b (a :: xs)
+
+inductive IsEmpty : Kind -> Prop where
+  | empty : IsEmpty .empty
+  | absurd : HasSuperclassOf a es -> IsEmpty (.singleton a es)
+  | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
+
+inductive Kind.Disjoint : Kind -> Kind -> Prop where
+  | empty_l : Disjoint .empty K
+  | empty_r : Disjoint K .empty
+  -- empty classifiers are disjoint with everything else
+  | absurd_l : HasSuperclassOf a es -> Disjoint (singleton a es) K2
+  | absurd_r : HasSuperclassOf a es -> Disjoint K1 (singleton a es)
+  -- Otherwise, the root has to be a subclass of the other's exclude list
+  | root_l : HasSuperclassOf r1 es2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+  | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+  -- union case
+  | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
+  | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+
+-- Note that RHS is always singleton
+inductive Kind.Subtract : Nat -> Kind -> Kind -> Kind -> Prop where
+  -- empty singletons are subkinds of everything
+  | absurd_l : HasSuperclassOf a es ->
+    Subtract 0 (singleton a es) K .empty
+  | absurd_r : HasSuperclassOf a es ->
+    Subtract 0 K (singleton a es) .empty
+  | empty_l : Subtract 0 .empty K .empty
+  | empty_r : Subtract 0 K .empty K
+  -- if excl is empty on RHS, LHS must be a subclass
+  | subclass_empty : r1.Subclass r2 ->
+    Subtract 0 (singleton r1 es1) (singleton r2 []) .empty
+  -- if excl is non-empty on RHS, it must _only_ contain either irrelevant nodes, or subclasses of the LHS's excl list
+  | excl_subclass_r :
+    a.Subclass r2 -> -- not absurd
+    HasSuperclassOf a es1 ->
+    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
+    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
+  | excl_disjoint_r :
+    a.Subclass r2 -> -- not absurd
+    r1.Disjoint a ->
+    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
+    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
+  -- otherwise, we have to add a residue
+  | disjoint :
+    r1.Disjoint r2 ->
+    Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 es1)
+  | subclass :
+    r2.Subclass r1 ->
+    Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 (r2 :: es1))
+  | residue :
+    a.Subclass r2 ->
+    a.Subclass r1 ->
+    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
+    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) (.union R (singleton a es1))
+  | union_l :
+    Subtract n K1 K R1 ->
+    Subtract m K2 K R2 ->
+    Subtract (1 + max n m) (.union K1 K2) K (.union R1 R2)
+  | union_rl :
+    Subtract n K K1 R1 ->
+    Subtract m R1 K2 R2 ->
+    Subtract (1 + max n m) K (union K1 K2) R2
+  | union_rr :
+    Subtract n K K2 R2 ->
+    Subtract m R2 K1 R1 ->
+    Subtract (1 + max n m) K (union K1 K2) R1
 
-/- Classifiers fixed for boundary. -/
-def Classifier.control := Classifier.child 0 Classifier.top
-def Kind.only_control := Kind.classifier .control
+inductive Kind.Subkind : Kind -> Kind -> Prop where
+  | subtract : Subtract n K1 K2 R -> IsEmpty R -> Subkind K1 K2
+
+-- theorem Kind.Subtract.singleton_empty_subclass
+--   (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty) :
+--     HasSuperclassOf r1 es1
+
+-- theorem Kind.Subtract.empty_excl_append_singleton
+--   (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty)
+--   : ∃ m, Subtract m (singleton r1 (a :: es1)) (singleton r2 es2) .empty := by
+--   cases hs
+--   case absurd_l hs =>
+--     exists 0
+--     apply excl_empty $ .there hs
+--   case subclass_l =>
+--     exists 0
+--     apply! subclass_l
+--   case excl_subclass_r hs ha ih =>
+--     have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
+--     exists 1 + m
+--     apply! excl_subclass_r ha (.there hs)
+--   case excl_disjoint_r hd ih =>
+--     have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
+--     exists 1 + m
+--     apply! excl_disjoint_r hd
+
+theorem Kind.Subtract.rfl_singleton :
+  ∃ m, Subtract m (singleton r es) (singleton r es) .empty := by
+  induction es
+  case nil =>
+    exists 0
+    apply subclass_l $ Classifier.subclass_rfl
+  case cons h t ih =>
+    have ⟨_, ih1⟩ := ih
+    have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a:=h)
+    exists 1 + m
+    apply! excl_subclass_r $ .here Classifier.subclass_rfl
+
+theorem Kind.Subtract.is_empty_l (he: IsEmpty K) : ∃ m K0, Subtract m K K1 K0 ∧ IsEmpty K0 := by
+  induction he
+  case empty =>
+    exists 0, .empty
+    apply And.intro .empty_l .empty
+  case excl_super =>
+    exists 0, .empty
+    apply And.intro
+    apply! excl_empty
+    apply IsEmpty.empty
+  case union ha hb =>
+    have ⟨n1, R1, _, _⟩ := ha
+    have ⟨n2, R2, _, _⟩ := hb
+    exists 1 + max n1 n2, .union R1 R2
+    apply And.intro; apply! union_l; apply! IsEmpty.union
+
+theorem Kind.Subtract.rfl : ∃ m K1, Subtract m K K K1 ∧ IsEmpty K1 := by
+  induction K
+  case empty =>
+    exists 0, .empty
+    apply And.intro; apply empty_r;
+    constructor
+  case singleton r es =>
+    have ⟨m, _⟩ := rfl_singleton (r:=r) (es:=es)
+    exists m, .empty
+    apply And.intro; assumption; constructor
+  case union K1 K2 ih1 ih2 =>
+    have ⟨m1, R1, h1, he1⟩ := ih1
+    have ⟨m2, R2, h2, he2⟩ := ih2
+    have ⟨k1, RK1, _, _⟩ := is_empty_l he1 (K1:=K2)
+    have ⟨k2, RK2, _, _⟩ := is_empty_l he2 (K1:=K1)
+    exists 1 + max (1 + max m1 k1) (1 + max m2 k2), .union RK1 RK2
+    apply And.intro
+    apply union_l
+    apply! union_rl
+    apply! union_rr
+    constructor; assumption; assumption
+
+theorem Kind.Subkind.rfl : Subkind K K := by
+  have ⟨m, K, h, he⟩ := Subtract.rfl (K:=K)
+  apply! subtract
+
+theorem Kind.Subkind.refines_is_empty
+  (hs : Subkind K1 K2)
+  (he : IsEmpty K2) : IsEmpty K1 := by
+  cases hs
+  rename_i he1 hsub
+  induction hsub
+  case excl_empty => apply! IsEmpty.excl_super
+  case subclass_l => cases he; rename_i he; cases he
+  case excl_subclass_r hsc hsub ih =>
+    apply ih _ he1
+
+
+theorem Kind.Disjoint.is_empty_r
+  (he : IsEmpty K)
+  : Disjoint K1 K := by
+  induction he
+  case empty => apply! empty_r
+  case excl_super => apply! excl_empty_r
+  case union => apply! union_r
+
+theorem Kind.Disjoint.refines_subkind'
+  (hd : Disjoint K K2)
+  (hs : Subtract n K1 K2 R)
+  (he : IsEmpty R)
+  : Disjoint K K1 := by
+  induction hd generalizing n R
+  case empty_l => apply! empty_l
+  case empty_r =>
+    cases hs
+    case excl_empty => apply! excl_empty_r
+    case empty_l => apply! empty_r
+    case empty_r => apply! is_empty_r
+    case union_l hs1 hs2 =>
+      cases he
+      apply union_r
+      apply! refines_subkind' .empty_r
+      apply! refines_subkind' .empty_r
+  case excl_empty_l => apply! excl_empty_l
+  case excl_empty_r hsc =>
+    -- cases hs
+    -- case excl_empty => apply! excl_empty_r
+    -- case subclass_l => cases hsc
+    -- case excl_subclass_r hsc2 hs =>

From f8b148ff91a967c24812c0d2c802f2eb729ed979 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 2 Dec 2025 11:47:11 +0100
Subject: [PATCH 29/71] Rules too strict? Should perhaps weaken

---
 Capless/Classifier.lean | 509 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 452 insertions(+), 57 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index a8545773..d374dc8f 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -9,9 +9,29 @@ inductive Classifier : Type where
 deriving DecidableEq
 
 inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
-  | eq : Subclass a a
+  | rfl : Subclass a a
   | parent_l : Subclass a b -> Subclass (child n a) b
 
+inductive Classifier.StrictSub : Classifier -> Classifier -> Prop where
+  | child : StrictSub (child n a) a
+  | parent_l : StrictSub a b -> StrictSub (child n a) b
+
+theorem Classifier.Subclass.might_strict (hs : Subclass a b) : a = b ∨ StrictSub a b := by
+  induction hs
+  case rfl => left; simp
+  case parent_l hp ih =>
+    right
+    cases ih
+    case inl => subst_vars; constructor
+    case inr => apply! StrictSub.parent_l
+
+theorem Classifier.StrictSub.weaken (hs : StrictSub a b) : Subclass a b := by
+  induction hs
+  case child => apply Subclass.parent_l .rfl
+  case parent_l hp ih => apply Subclass.parent_l ih
+
+theorem Classifier.StrictSub.size (hs : StrictSub a b) : sizeOf a > sizeOf b := by induction hs <;> (simp; try omega)
+
 inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
   | base : n != m -> Disjoint (child n p) (child m p)
   | left : Disjoint a b -> Disjoint (child n a) b
@@ -19,23 +39,23 @@ inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
 
 theorem Classifier.Subclass.of_top : Subclass a .top := by
   induction a
-  case top => apply eq
+  case top => apply rfl
   case child n k ih => apply parent_l ih
 
 theorem Classifier.Subclass.parent_r (hs : Subclass a (child n b)) : Subclass a b := by
   cases hs
-  case eq => apply parent_l .eq
+  case rfl => apply parent_l rfl
   case parent_l hp =>
     apply parent_l hp.parent_r
 
 theorem Classifier.Subclass.trans (h1 : Subclass a b) (h2 : Subclass b c) : Subclass a c := by
   induction h2
-  case eq => assumption
+  case rfl => assumption
   case parent_l hp ih => apply ih h1.parent_r
 
 theorem Classifier.Subclass.down_r (hs : Subclass a b) : a = b ∨ ∃ n, Subclass a (child n b) := by
   induction hs
-  case eq => simp
+  case rfl => simp
   case parent_l ih =>
     rename_i n _
     right
@@ -46,6 +66,23 @@ theorem Classifier.Subclass.down_r (hs : Subclass a b) : a = b ∨ ∃ n, Subcla
       exists m
       apply parent_l ih
 
+theorem Classifier.Subclass.size (hs : Subclass a b) : sizeOf a ≥ sizeOf b := by
+  induction hs <;> (simp; try omega)
+
+theorem Classifier.Subclass.antisymm (h1 : Subclass a b) (h2 : Subclass b a) : a = b := by
+  induction h1
+  case rfl => simp
+  case parent_l hp ih =>
+    have hp1 := hp.size
+    have h21 := h2.size
+    simp at h21
+    omega
+
+theorem Classifier.StrictSub.antisymm (hs : StrictSub a b) (hs2 : Subclass b a) : False := by
+  have h := hs.size
+  have h2 := hs2.size
+  omega
+
 theorem Classifier.Disjoint.symm (hd : Disjoint a b) : Disjoint b a := by
   induction hd
   case base hne =>
@@ -57,10 +94,55 @@ theorem Classifier.Disjoint.refines_subclass_r
   (hd : Disjoint b a2)
   (hs : Subclass a1 a2) : Disjoint b a1 := by
   induction hs
-  case eq => assumption
+  case rfl => assumption
   case parent_l hs ih =>
     apply right $ ih hd
 
+theorem Classifier.Disjoint.left_inv (hd : Disjoint (child n a) b) : Subclass b a ∨ Disjoint a b := by
+  cases hd
+  case base m _ => left; constructor; constructor;
+  case left => right; assumption
+  case right hd =>
+    cases hd.left_inv
+    case inl hd => left; constructor; assumption
+    case inr hd => right; apply! right
+
+theorem Classifier.Disjoint.not_subclass (hd : Disjoint a b) (hs : Subclass a b) : False := by
+  induction a generalizing b
+  case top =>
+    induction b
+    case top => cases hd
+    case child n p ih => cases hs
+  case child n p ih =>
+    induction b
+    case top => cases hs; cases hd; apply! ih
+    case child m q ih2 =>
+      cases hs
+      case rfl =>
+        cases hd
+        case base => aesop
+        case left hs => apply ih2 hs.symm $ .parent_l .rfl
+        case right hs => apply ih2 hs $ .parent_l .rfl
+      case parent_l hs =>
+        cases hd
+        case base => have h := hs.size; simp at h; omega
+        case left => apply! ih
+        case right hd =>
+          cases hd.left_inv
+          case inl hd =>
+            have h := hs.parent_r.antisymm hd
+            subst_vars
+            have h := hs.size; simp at h; omega
+          case inr hd =>
+            apply ih hd hs.parent_r
+
+theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b) : Disjoint a c := by
+  induction hs
+  case rfl => assumption
+  case parent_l hp ih =>
+    apply right
+    apply ih hd
+
 theorem Classifier.subclass_or_disjoint :
   Subclass a b ∨ Subclass b a ∨ Disjoint a b := by
   induction a
@@ -73,7 +155,7 @@ theorem Classifier.subclass_or_disjoint :
       cases ih
       case inl ih =>
         cases ih.down_r
-        { subst_vars; left; apply Subclass.parent_l .eq }
+        { subst_vars; left; apply Subclass.parent_l .rfl }
         { rename_i ih1; have ⟨m, ih1⟩ := ih1;
           generalize h : (n == m) = h0;
           cases h0
@@ -396,11 +478,25 @@ inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
   | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
   | there : HasSuperclassOf b xs -> HasSuperclassOf b (a :: xs)
 
+theorem HasSuperclassOf.subclass (hsc : HasSuperclassOf a es) (hs : Classifier.Subclass b a) : HasSuperclassOf b es := by
+  induction hsc
+  case here hsub => apply here  $ hs.trans hsub
+  case there ih => apply! there
+
 inductive IsEmpty : Kind -> Prop where
   | empty : IsEmpty .empty
   | absurd : HasSuperclassOf a es -> IsEmpty (.singleton a es)
   | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
 
+theorem IsEmpty.singleton_must_excl (hsc : IsEmpty (.singleton a [])) : False := by cases hsc; rename_i hsc; cases hsc
+
+theorem IsEmpty.singleton_cases (hsc : IsEmpty (.singleton a (x :: es))) : a.Subclass x ∨ HasSuperclassOf a es := by
+  cases hsc
+  case absurd hsc =>
+    cases hsc
+    case here => left; assumption
+    case there => right; assumption
+
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
   | empty_l : Disjoint .empty K
   | empty_r : Disjoint K .empty
@@ -410,6 +506,7 @@ inductive Kind.Disjoint : Kind -> Kind -> Prop where
   -- Otherwise, the root has to be a subclass of the other's exclude list
   | root_l : HasSuperclassOf r1 es2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
   | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+  | root : Classifier.Disjoint r1 r2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
   -- union case
   | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
   | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
@@ -420,7 +517,7 @@ inductive Kind.Subtract : Nat -> Kind -> Kind -> Kind -> Prop where
   | absurd_l : HasSuperclassOf a es ->
     Subtract 0 (singleton a es) K .empty
   | absurd_r : HasSuperclassOf a es ->
-    Subtract 0 K (singleton a es) .empty
+    Subtract 0 K (singleton a es) K
   | empty_l : Subtract 0 .empty K .empty
   | empty_r : Subtract 0 K .empty K
   -- if excl is empty on RHS, LHS must be a subclass
@@ -428,24 +525,28 @@ inductive Kind.Subtract : Nat -> Kind -> Kind -> Kind -> Prop where
     Subtract 0 (singleton r1 es1) (singleton r2 []) .empty
   -- if excl is non-empty on RHS, it must _only_ contain either irrelevant nodes, or subclasses of the LHS's excl list
   | excl_subclass_r :
-    a.Subclass r2 -> -- not absurd
+    a.StrictSub r2 -> -- not absurd
     HasSuperclassOf a es1 ->
     Subtract n (singleton r1 es1) (singleton r2 es2) R ->
     Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
   | excl_disjoint_r :
-    a.Subclass r2 -> -- not absurd
+    a.StrictSub r2 -> -- not absurd
     r1.Disjoint a ->
     Subtract n (singleton r1 es1) (singleton r2 es2) R ->
     Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
+  | excl_irrelevant_r :
+    a.Disjoint r2 -> -- not absurd
+    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
+    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
   -- otherwise, we have to add a residue
   | disjoint :
     r1.Disjoint r2 ->
     Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 es1)
   | subclass :
-    r2.Subclass r1 ->
+    r2.StrictSub r1 ->
     Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 (r2 :: es1))
   | residue :
-    a.Subclass r2 ->
+    a.StrictSub r2 ->
     a.Subclass r1 ->
     Subtract n (singleton r1 es1) (singleton r2 es2) R ->
     Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) (.union R (singleton a es1))
@@ -469,46 +570,61 @@ inductive Kind.Subkind : Kind -> Kind -> Prop where
 --   (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty) :
 --     HasSuperclassOf r1 es1
 
--- theorem Kind.Subtract.empty_excl_append_singleton
---   (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty)
---   : ∃ m, Subtract m (singleton r1 (a :: es1)) (singleton r2 es2) .empty := by
---   cases hs
---   case absurd_l hs =>
---     exists 0
---     apply excl_empty $ .there hs
---   case subclass_l =>
---     exists 0
---     apply! subclass_l
---   case excl_subclass_r hs ha ih =>
---     have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
---     exists 1 + m
---     apply! excl_subclass_r ha (.there hs)
---   case excl_disjoint_r hd ih =>
---     have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
---     exists 1 + m
---     apply! excl_disjoint_r hd
+theorem Kind.Subtract.empty_excl_append_singleton
+  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty)
+  : ∃ m, Subtract m (singleton r1 (a :: es1)) (singleton r2 es2) .empty := by
+  cases hs
+  case absurd_l hs =>
+    exists 0
+    apply absurd_l $ .there hs
+  case subclass_empty =>
+    exists 0
+    apply! subclass_empty
+  case excl_subclass_r hs ha ih =>
+    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
+    exists 1 + m
+    apply! excl_subclass_r ha (.there hs)
+  case excl_disjoint_r hd ih =>
+    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
+    exists 1 + m
+    apply! excl_disjoint_r hd
+  case excl_irrelevant_r hd ih =>
+    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
+    exists 1 + m
+    apply! excl_irrelevant_r
 
 theorem Kind.Subtract.rfl_singleton :
   ∃ m, Subtract m (singleton r es) (singleton r es) .empty := by
   induction es
   case nil =>
     exists 0
-    apply subclass_l $ Classifier.subclass_rfl
+    apply subclass_empty .rfl
   case cons h t ih =>
     have ⟨_, ih1⟩ := ih
-    have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a:=h)
-    exists 1 + m
-    apply! excl_subclass_r $ .here Classifier.subclass_rfl
+    cases Classifier.subclass_or_disjoint (a := r) (b := h)
+    case inl hs => exists 0; apply absurd_l $ .here hs
+    case inr hs =>
+      cases hs
+      case inl hs =>
+        have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a := h)
+        cases hs.might_strict
+        subst_vars; exists 0; apply absurd_l; apply HasSuperclassOf.here .rfl
+        exists 1 + m
+        apply! excl_subclass_r _ $ .here .rfl
+      case inr hs =>
+        have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a := h)
+        exists 1 + m
+        apply! excl_irrelevant_r hs.symm
 
 theorem Kind.Subtract.is_empty_l (he: IsEmpty K) : ∃ m K0, Subtract m K K1 K0 ∧ IsEmpty K0 := by
   induction he
   case empty =>
     exists 0, .empty
     apply And.intro .empty_l .empty
-  case excl_super =>
+  case absurd =>
     exists 0, .empty
     apply And.intro
-    apply! excl_empty
+    apply! absurd_l
     apply IsEmpty.empty
   case union ha hb =>
     have ⟨n1, R1, _, _⟩ := ha
@@ -538,6 +654,58 @@ theorem Kind.Subtract.rfl : ∃ m K1, Subtract m K K K1 ∧ IsEmpty K1 := by
     apply! union_rr
     constructor; assumption; assumption
 
+theorem Kind.Subtract.singleton_empty_inv
+  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) R)
+  (he : IsEmpty R)
+  : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
+  cases hs
+  case absurd_l => left; assumption
+  case absurd_r => cases he; left; assumption
+  case subclass_empty => right; assumption
+  case excl_subclass_r hsc hss hs =>
+    cases hs.singleton_empty_inv he <;> simp_all
+  case excl_disjoint_r hd hss hs =>
+    cases hs.singleton_empty_inv he <;> simp_all
+  case excl_irrelevant_r hd hs =>
+    cases hs.singleton_empty_inv he <;> simp_all
+  case disjoint hd => left; cases he; assumption
+  case subclass hss =>
+    cases he.singleton_cases
+    case inl he => cases hss.antisymm he
+    case inr he => left; assumption
+  case residue hsub hss hs =>
+    cases he
+    case union he _ => cases hs.singleton_empty_inv he <;> simp_all
+
+theorem Kind.Subtract.absurd_r_inv
+  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) R)
+  (hsc : HasSuperclassOf r2 es2) : HasSuperclassOf r1 es1 ∨ R = singleton r1 es1 := by
+  cases hs
+  case absurd_l => left; assumption
+  case absurd_r => right; rfl
+  case subclass_empty => cases hsc
+  case excl_subclass_r hss hs =>
+    cases hsc
+    case here hsc => cases hss.antisymm hsc
+    case there hsc => apply hs.absurd_r_inv hsc
+  case excl_disjoint_r hss hs =>
+    cases hsc
+    case here hsc => cases hss.antisymm hsc
+    case there hsc => apply hs.absurd_r_inv hsc
+  case excl_irrelevant_r hd hs =>
+    cases hsc
+    case here hsc => cases hd.symm.not_subclass hsc
+    case there hsc => apply hs.absurd_r_inv hsc
+  case disjoint => cases hsc
+  case subclass => cases hsc
+  case residue hss hs =>
+    cases hsc
+    case here hsc => cases hss.antisymm hsc
+    case there hsc =>
+
+
+
+
 theorem Kind.Subkind.rfl : Subkind K K := by
   have ⟨m, K, h, he⟩ := Subtract.rfl (K:=K)
   apply! subtract
@@ -547,40 +715,267 @@ theorem Kind.Subkind.refines_is_empty
   (he : IsEmpty K2) : IsEmpty K1 := by
   cases hs
   rename_i he1 hsub
-  induction hsub
-  case excl_empty => apply! IsEmpty.excl_super
-  case subclass_l => cases he; rename_i he; cases he
-  case excl_subclass_r hsc hsub ih =>
-    apply ih _ he1
-
+  induction hsub <;> try cases he.singleton_must_excl
+  case absurd_l => apply! IsEmpty.absurd
+  case absurd_r => assumption
+  case empty_l => assumption
+  case empty_r => assumption
+  case excl_subclass_r hsub hsc hs ih =>
+    cases he
+    rename_i he
+    cases he
+    case here he => have h := hsub.antisymm he; contradiction
+    case there he => apply ih (.absurd he) he1
+  case excl_disjoint_r hsub hsc hs ih =>
+    cases he.singleton_cases
+    case inl he => have h := hsub.antisymm he; contradiction
+    case inr he => apply ih (.absurd he) he1
+  case excl_irrelevant_r hsub hs ih =>
+    cases he.singleton_cases
+    case inl he => have h := hsub.symm.not_subclass he; contradiction
+    case inr he => apply ih (.absurd he) he1
+  case residue hsc hs hsub ih =>
+    cases he.singleton_cases
+    case inl he => have h := hsc.antisymm he; contradiction
+    case inr he => cases he1; apply! ih (.absurd he)
+  case union_l hsa hsb iha ihb =>
+    cases he1
+    constructor
+    apply! iha
+    apply! ihb
+  case union_rl ha hb iha ihb =>
+    cases he
+    apply! iha _ (ihb _ he1)
+  case union_rr ha hb iha ihb =>
+    cases he
+    apply! iha _ (ihb _ he1)
 
 theorem Kind.Disjoint.is_empty_r
   (he : IsEmpty K)
   : Disjoint K1 K := by
   induction he
   case empty => apply! empty_r
-  case excl_super => apply! excl_empty_r
+  case absurd => apply! absurd_r
   case union => apply! union_r
 
+theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
+  induction hd
+  case empty_l => apply! empty_r
+  case empty_r => apply! empty_l
+  case absurd_l => apply! absurd_r
+  case absurd_r => apply! absurd_l
+  case root_l => apply! root_r
+  case root_r => apply! root_l
+  case root h => apply! root h.symm
+  case union_l => apply! union_r
+  case union_r => apply! union_l
+
+theorem Kind.Disjoint.subtract_inv
+  (hd : Disjoint K K2)
+  (hs : Subtract n K1 K2 R)
+  (hr : Disjoint K R)
+  : Disjoint K K1 := by
+  induction hs
+  case absurd_l => apply! absurd_r
+  case absurd_r => assumption
+  case empty_l => assumption
+  case empty_r => assumption
+  case subclass_empty r1 es1 r2 hsub =>
+    generalize h : singleton r2 [] = K2 at hd
+    induction hd <;> (subst_vars; try simp_all)
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd => cases hd
+    case root_l hd => cases hd
+    case root_r hd => apply! root_r $ hd.subclass _
+    case root hd => apply! root $ hd.to_subclass _
+    case union_l ha hb iha ihb =>
+      apply union_l (iha .empty_r) (ihb .empty_r)
+  case excl_subclass_r a es1 _ r1 r2 es2 _  hss hsc hs ih =>
+    generalize h : singleton r2 (a :: es2) = K2 at hd
+    induction hd <;> (subst_vars; try simp_all; try (have ⟨_, _⟩ := h; subst_vars; simp_all))
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd =>
+
+    case root_l hd => cases hd
+    case root_r hd => apply! root_r $ hd.subclass _
+    case root hd => apply! root $ hd.to_subclass _
+    case union_l ha hb iha ihb =>
+      apply union_l (iha .empty_r) (ihb .empty_r)
+
+
+
+
 theorem Kind.Disjoint.refines_subkind'
   (hd : Disjoint K K2)
   (hs : Subtract n K1 K2 R)
   (he : IsEmpty R)
   : Disjoint K K1 := by
-  induction hd generalizing n R
-  case empty_l => apply! empty_l
-  case empty_r =>
-    cases hs
-    case excl_empty => apply! excl_empty_r
-    case empty_l => apply! empty_r
-    case empty_r => apply! is_empty_r
-    case union_l hs1 hs2 =>
-      cases he
-      apply union_r
-      apply! refines_subkind' .empty_r
-      apply! refines_subkind' .empty_r
-  case excl_empty_l => apply! excl_empty_l
-  case excl_empty_r hsc =>
+  -- induction hd generalizing n K1 R
+  -- case empty_l => apply! empty_l
+  -- case empty_r =>
+  --   cases hs
+  --   case absurd_l => apply! absurd_r
+  --   case empty_l => apply! empty_r
+  --   case empty_r => apply! is_empty_r
+  --   case union_l hs1 hs2 =>
+  --     cases he
+  --     apply union_r
+  --     apply! refines_subkind' .empty_r
+  --     apply! refines_subkind' .empty_r
+  -- case absurd_l => apply! absurd_l
+  -- case absurd_r =>
+  --   apply is_empty_r
+  --   apply Subkind.refines_is_empty $ .subtract hs he
+  --   apply! IsEmpty.absurd
+  -- case root_l hsc =>
+  --   cases hs
+  --   case absurd_l => apply! absurd_r
+  --   case absurd_r => apply! is_empty_r
+  --   case empty_l => apply! empty_r
+  --   case subclass_empty => cases hsc
+  --   case excl_subclass_r hsc1 hss hs =>
+  induction hs
+  case absurd_l => apply! absurd_r
+  case absurd_r => apply! is_empty_r
+  case empty_l => apply empty_r
+  case empty_r => apply! is_empty_r
+  case subclass_empty hsub =>
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd => cases hd
+    case root_l hsc => cases hsc
+    case root_r hsc => apply! root_r $ hsc.subclass _
+    case root hd => apply root $ hd.to_subclass hsub
+    case union_l ha hb =>
+      apply union_l (ha.refines_subkind' (.subclass_empty hsub) he) (hb.refines_subkind' (.subclass_empty hsub) he)
+  case excl_subclass_r hss hsub hs ih =>
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd =>
+      cases hd
+      case here hd => cases hss.antisymm hd
+      case there hd => apply ih _ he; apply! absurd_r
+    case root_l hsc =>
+      cases hsc
+      case here hd => apply root_l $ hsub.subclass hd
+      case there hd => apply ih _ he; apply root_l hd
+    case root_r hsc =>
+      cases hs.singleton_empty_inv he
+      case inl h => apply! absurd_r
+      case inr h => apply root_r $ hsc.subclass h
+    case root hd =>
+      cases hs.singleton_empty_inv he
+      case inl h => apply! absurd_r
+      case inr h => apply root $ hd.to_subclass h
+    case union_l ha hb =>
+      apply union_l (ha.refines_subkind' (.excl_subclass_r hss hsub hs) he) (hb.refines_subkind' (.excl_subclass_r hss hsub hs) he)
+  case excl_disjoint_r hss hd1 hs ih =>
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd =>
+      cases hd
+      case here hd => cases hss.antisymm hd
+      case there hd => apply ih _ he; apply! absurd_r
+    case root_l hsc =>
+      cases hsc
+      case here hd => apply root $ (hd1.to_subclass hd).symm
+      case there hd => apply ih _ he; apply root_l hd
+    case root_r hsc =>
+      cases hs.singleton_empty_inv he
+      case inl h => apply! absurd_r
+      case inr h => apply root_r $ hsc.subclass h
+    case root hd =>
+      cases hs.singleton_empty_inv he
+      case inl => apply! absurd_r
+      case inr h => apply root $ hd.to_subclass h
+    case union_l ha hb =>
+      apply union_l (ha.refines_subkind' (.excl_disjoint_r hss hd1 hs) he) (hb.refines_subkind' (.excl_disjoint_r hss hd1 hs) he)
+  case excl_irrelevant_r hd1 hs ih =>
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd =>
+      cases hd
+      case here hd => cases hd1.symm.not_subclass hd
+      case there hd => apply ih _ he; apply! absurd_r
+    case root_l hsc =>
+      cases hsc
+      case here hd =>
+        have hd2 := hd1.symm.to_subclass hd
+        cases hs.singleton_empty_inv he
+        case inl => apply! absurd_r
+        case inr h => apply root $ hd2.symm.to_subclass h
+      case there hd => apply ih _ he; apply root_l hd
+    case root_r hsc =>
+      cases hs.singleton_empty_inv he
+      case inl h => apply! absurd_r
+      case inr h => apply root_r $ hsc.subclass h
+    case root hd =>
+      cases hs.singleton_empty_inv he
+      case inl => apply! absurd_r
+      case inr h => apply root $ hd.to_subclass h
+    case union_l ha hb =>
+      apply union_l (ha.refines_subkind' (.excl_irrelevant_r hd1 hs) he) (hb.refines_subkind' (.excl_irrelevant_r hd1 hs) he)
+  case disjoint hd => apply! is_empty_r
+  case subclass hss =>
+    cases he.singleton_cases
+    case inl h => cases hss.antisymm h
+    case inr h => apply! absurd_r
+  case residue hss hsub hs ih =>
+    cases he
+    rename_i he he1
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case absurd_r hd =>
+      cases hd
+      case here hd => cases hss.antisymm hd
+      case there hd => apply ih _ he; apply! absurd_r
+    case root_l hsc =>
+      cases hsc
+      case here hd =>
+        cases he1
+        rename_i he1
+        apply root_l $ he1.subclass hd
+      case there hd => apply ih _ he; apply root_l hd
+    case root_r hsc =>
+      cases hs.singleton_empty_inv he
+      case inl h => apply! absurd_r
+      case inr h => apply root_r $ hsc.subclass h
+    case root hd =>
+      cases hs.singleton_empty_inv he
+      case inl => apply! absurd_r
+      case inr h => apply root $ hd.to_subclass h
+    case union_l ha hb =>
+      apply union_l (ha.refines_subkind' (.residue hss hsub hs) (.union he he1))
+      apply hb.refines_subkind' (.residue hss hsub hs) (.union he he1)
+  case union_l ha hb iha ihb =>
+    cases he
+    apply union_r
+    apply! iha
+    apply! ihb
+  case union_rl ha hb iha ihb =>
+    cases hd
+    case empty_l => apply! empty_l
+    case absurd_l => apply! absurd_l
+    case union_l hua hub =>
+      apply union_l (hua.refines_subkind' (.union_rl ha hb) he) (hub.refines_subkind' (.union_rl ha hb) he)
+    case union_r hua hub =>
+      apply iha hua
+
+
+
+
+
+
+termination_by structural K
+
+
     -- cases hs
     -- case excl_empty => apply! excl_empty_r
     -- case subclass_l => cases hsc

From c388cd0cccd8d9ce5128c3ee6f9345458f80537f Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 2 Dec 2025 14:23:39 +0100
Subject: [PATCH 30/71] Simplify classifiers, no more unions for now

---
 Capless/Classifier.lean | 1021 ++++++++++-----------------------------
 1 file changed, 251 insertions(+), 770 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index d374dc8f..cad16978 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -98,6 +98,10 @@ theorem Classifier.Disjoint.refines_subclass_r
   case parent_l hs ih =>
     apply right $ ih hd
 
+theorem Classifier.Disjoint.refines_subclass_l (hd : Disjoint a2 b) (hs : Subclass a1 a2) : Disjoint a1 b := by
+  apply symm
+  apply refines_subclass_r hd.symm hs
+
 theorem Classifier.Disjoint.left_inv (hd : Disjoint (child n a) b) : Subclass b a ∨ Disjoint a b := by
   cases hd
   case base m _ => left; constructor; constructor;
@@ -134,7 +138,7 @@ theorem Classifier.Disjoint.not_subclass (hd : Disjoint a b) (hs : Subclass a b)
             subst_vars
             have h := hs.size; simp at h; omega
           case inr hd =>
-            apply ih hd hs.parent_r
+            apply ih (b:=q) hd hs.parent_r
 
 theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b) : Disjoint a c := by
   induction hs
@@ -143,7 +147,7 @@ theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b)
     apply right
     apply ih hd
 
-theorem Classifier.subclass_or_disjoint :
+theorem Classifier.subclass_or_disjoint a b:
   Subclass a b ∨ Subclass b a ∨ Disjoint a b := by
   induction a
   case top => right; left; apply Subclass.of_top
@@ -167,312 +171,16 @@ theorem Classifier.subclass_or_disjoint :
         right; right; apply Disjoint.left ih
 
 
--- instance : LawfulBEq Classifier where
---   rfl := by
---     intro a
---     induction a <;> simp [BEq.beq]
---   eq_of_beq := by
---     intro a b h
---     induction a <;> induction b <;> simp_all [BEq.beq]
-
--- @[simp]
--- def Classifier.depth (c: Classifier) : Nat :=
---   match c with
---   | top => 0
---   | child _ p => 1 + p.depth
-
--- @[simp]
--- def Classifier.subclass (c1: Classifier) (c2: Classifier) : Bool :=
---   if c1 == c2 then true
---   else
---     match c1 with
---     | .top => false
---     | .child _ p => p.subclass c2
-
--- @[simp]
--- def Classifier.disjoint (c1: Classifier) (c2: Classifier) : Bool :=
---   match c1 with
---     | top => false
---     | child n p => match c2 with
---       | top => false
---       | child m q =>
---         if p == q then n != m
---         else (child n p).disjoint q || p.disjoint (child m q)
-
--- inductive Kind : Type where
---   -- a tree dropping some classifiers
---   | empty
---   | singleton : Classifier -> List Classifier -> Kind
---   | union : Kind -> Kind -> Kind
-
--- /-- The top kind -/
--- def Kind.any := singleton .top []
-
--- theorem Classifier.subclass_rfl : Classifier.subclass k k := by
---   unfold Classifier.subclass
---   simp
-
-
--- theorem Classifier.subclass_top : Classifier.subclass k .top := by
---   induction k
---   case top => trivial
---   case child n p => simp_all
-
--- theorem Classifier.subclass_of_top : Classifier.top.subclass k -> k = .top := by
---   intro h
---   induction k
---   case top => trivial
---   case child n p ih =>
---     simp at h
-
--- theorem Classifier.disjoint_symm : Classifier.disjoint a b -> b.disjoint a := by
---   intro h
---   induction a generalizing b
---   case top =>
---     simp_all
---   case child n p ih =>
---     induction b <;> simp at h
---     rename_i m q ihb
---     simp
---     split <;> subst_vars
---     simp at h
---     false_or_by_contra
---     apply h.elim (Eq.symm _)
---     assumption
---     split at h
---     rename_i h0 h1
---     apply h0.elim (Eq.symm h1)
---     cases h
---     { right; apply ihb; assumption }
---     { left; apply ih; assumption }
-
--- theorem Classifier.neq_child : q ≠ (child n q) := by
---   intro h
---   induction q
---   case top => cases h
---   case child m p ih =>
---     injections
---     apply ih
---     subst_vars
---     assumption
-
--- theorem Classifier.disjoint_top : Classifier.disjoint a .top -> False := by
---   intro h
---   induction a
---   case top => simp at h
---   case child n p ih => simp at h
-
--- theorem Classifier.subclass_down : subclass a b -> (a = b) ∨ (∃ n, subclass a (.child n b)) := by
---   intro h
---   induction a generalizing b
---   case top => left; symm; apply subclass_of_top; assumption
---   case child n p ih =>
---     simp at h
---     cases h
---     case inl h0 => subst_vars; left; trivial
---     case inr h0 =>
---       right
---       cases ih h0
---       { subst_vars; exists n; simp; }
---       { rename_i h1; have ⟨n, h1⟩ := h1; exists n; simp; right; assumption }
-
--- theorem Classifier.subclass_inv : subclass a b -> (a = b) ∨ (∃ n p, a = child n p ∧ p.subclass b) := by
---   intro h
---   induction a
---   case top => left; symm; apply subclass_of_top h
---   case child n p ih =>
---     simp at h
---     cases h
---     case inl h => left; assumption
---     case inr h =>
---       right
---       apply Exists.intro n
---       apply Exists.intro p
---       apply And.intro
---       rfl
---       cases ih h
---       subst_vars
---       assumption
---       rename_i h
---       have ⟨n0, p0, hp, h0⟩ := h
---       subst_vars
---       assumption
-
-
--- theorem Classifier.subclass_depth : subclass a b -> a.depth >= b.depth := by
---   induction a generalizing b
---   case top => simp; intro; subst_vars; simp
---   case child n p ih =>
---     intro h
---     simp at h
---     cases h
---     case inl h => subst_vars; simp
---     case inr h => simp; have h0 := ih h; omega
-
--- theorem Classifier.subclass_child : subclass a (child n a) -> False := by
---   intro h
---   have h0 := subclass_depth h
---   simp at h0
---   omega
-
--- theorem Classifier.subclass_up : subclass a (child m b) -> subclass a b := by
---   intro h
---   induction a generalizing b
---   case top => have h0 := subclass_depth h; simp at h
---   case child n p ih =>
---     simp at h
---     cases h
---     case inl h =>
---       have ⟨hn, h⟩ := h
---       subst_vars
---       simp
---       right
---       unfold subclass
---       simp
---     case inr h =>
---       have h0 := ih h
---       simp
---       right
---       assumption
-
--- theorem Classifier.subclass_trans : subclass a b -> subclass b c -> subclass a c := by
---   intro h1 h2
---   induction b
---   case top => simp_all
---   case child n k ih =>
---     have h11 := subclass_up h1
---     simp at h2
---     cases h2
---     case inl h2 => subst_vars; simp_all
---     case inr h2 => apply ih h11 h2
-
--- theorem Classifier.disjoint_antisymm : disjoint a a = false := by
---   induction a <;> simp
-
--- theorem Classifier.disjoint_subclass : subclass a b -> disjoint a b = false := by
---   intro h
---   induction a generalizing b
---   case top => simp_all; apply disjoint_antisymm
---   case child n p iha =>
---     induction b
---     case top => simp
---     case child m q ihb =>
---       simp
---       split
---       subst_vars
---       simp at h
---       cases h; assumption; rename_i h; have h0 := subclass_child (a := q) (n := m); contradiction
---       apply And.intro
---       apply (ihb (subclass_up h))
---       cases subclass_inv h
---       case inl h => injections; contradiction
---       case inr h =>
---         have ⟨n0, p0, hp, hh⟩ := h
---         injections
---         subst_vars
---         apply iha
---         assumption
-
--- theorem Classifier.disjoint_up : disjoint a b -> disjoint a (child m b) := by
---   intro h
---   induction a generalizing b m
---   case top => simp at h
---   case child n p ih =>
---     induction b generalizing m
---     case top => exfalso; apply disjoint_top h
---     case child k q ihb =>
---       simp at h
---       split at h
---       subst_vars
---       simp
---       split
---       exfalso; apply neq_child; assumption
---       left; assumption
---       cases h
---       case inl h =>
---         have h0 := ihb (m := k) h
---         simp
---         split
---         subst_vars
---         { have h1 : (child n (child k q)).subclass (child k q)  := by simp
---           have h2 := disjoint_subclass h1
---           rw [Bool.eq_false_iff] at h2
---           contradiction }
---         { left; left; assumption }
---       case inr h =>
---         simp
---         split
---         { subst_vars; simp at h }
---         { left; right; assumption }
-
--- theorem Classifier.subclass_disjoint : subclass a1 a2 -> disjoint b a2 -> disjoint b a1 := by
---   intro hs hd
---   induction a1
---   case top =>
---     simp at hs; subst_vars; exfalso; apply disjoint_top hd
---   case child n k ih =>
---     simp at hs
---     cases hs
---     case inl h => subst_vars; simp_all
---     case inr h => apply disjoint_up; apply ih h
-
--- theorem Classifier.subclass_child_inj : subclass (child n p) (child m p) -> n = m := by
---   intro h
---   unfold subclass at h
---   split at h
---   case isTrue h0 => have h1 := LawfulBEq.eq_of_beq h0; injections
---   case isFalse =>
---     simp at h
---     have h0 := subclass_depth h
---     simp at h0
---     omega
-
--- theorem Classifier.disjoint_or_subclass : subclass a b ∨ subclass b a ∨ disjoint a b := by
---   induction a
---   case top => right; left; apply subclass_top
---   case child n p ih =>
---     cases ih
---     case inl ih =>
---       left
---       unfold subclass; simp; right; assumption
---     case inr ih =>
---       cases ih
---       case inl ih =>
---         cases subclass_down ih
---         case inl =>
---           subst_vars
---           left
---           unfold subclass; simp; right; assumption
---         case inr ih =>
---           have ⟨m, ih⟩ := ih
---           generalize h : (m == n) = h0
---           cases h0
---           case false =>
---             right; right;
---             unfold disjoint; simp
---             split
---             rename_i h0 _;
---             cases Classifier.subclass_of_top ih
---             split
---             subst_vars
---             have ih0 := subclass_child_inj ih
---             subst_vars
---             simp
---             aesop
-
-
-
-
-
-
-
-
-
-
 inductive Kind : Type where
-| empty : Kind
+-- | empty : Kind
 | singleton : Classifier -> List Classifier -> Kind
-| union : Kind -> Kind -> Kind
+-- | union : Kind -> Kind -> Kind
+
+@[simp]
+def Kind.excl (k : Kind) c :=
+  match k with
+  | singleton r es => singleton r (c :: es)
+
 
 inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
   | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
@@ -483,23 +191,9 @@ theorem HasSuperclassOf.subclass (hsc : HasSuperclassOf a es) (hs : Classifier.S
   case here hsub => apply here  $ hs.trans hsub
   case there ih => apply! there
 
-inductive IsEmpty : Kind -> Prop where
-  | empty : IsEmpty .empty
-  | absurd : HasSuperclassOf a es -> IsEmpty (.singleton a es)
-  | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
-
-theorem IsEmpty.singleton_must_excl (hsc : IsEmpty (.singleton a [])) : False := by cases hsc; rename_i hsc; cases hsc
-
-theorem IsEmpty.singleton_cases (hsc : IsEmpty (.singleton a (x :: es))) : a.Subclass x ∨ HasSuperclassOf a es := by
-  cases hsc
-  case absurd hsc =>
-    cases hsc
-    case here => left; assumption
-    case there => right; assumption
-
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
-  | empty_l : Disjoint .empty K
-  | empty_r : Disjoint K .empty
+  -- | empty_l : Disjoint .empty K
+  -- | empty_r : Disjoint K .empty
   -- empty classifiers are disjoint with everything else
   | absurd_l : HasSuperclassOf a es -> Disjoint (singleton a es) K2
   | absurd_r : HasSuperclassOf a es -> Disjoint K1 (singleton a es)
@@ -508,475 +202,262 @@ inductive Kind.Disjoint : Kind -> Kind -> Prop where
   | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
   | root : Classifier.Disjoint r1 r2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
   -- union case
-  | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
-  | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+  -- | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
+  -- | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
 
--- Note that RHS is always singleton
-inductive Kind.Subtract : Nat -> Kind -> Kind -> Kind -> Prop where
-  -- empty singletons are subkinds of everything
+inductive Kind.Subkind : Kind -> Kind -> Prop where
   | absurd_l : HasSuperclassOf a es ->
-    Subtract 0 (singleton a es) K .empty
-  | absurd_r : HasSuperclassOf a es ->
-    Subtract 0 K (singleton a es) K
-  | empty_l : Subtract 0 .empty K .empty
-  | empty_r : Subtract 0 K .empty K
-  -- if excl is empty on RHS, LHS must be a subclass
-  | subclass_empty : r1.Subclass r2 ->
-    Subtract 0 (singleton r1 es1) (singleton r2 []) .empty
-  -- if excl is non-empty on RHS, it must _only_ contain either irrelevant nodes, or subclasses of the LHS's excl list
-  | excl_subclass_r :
-    a.StrictSub r2 -> -- not absurd
+    Subkind (singleton a es) K
+  -- | empty_l : Subkind .empty K
+  | subclass_no_excl :
+    r1.Subclass r2 ->
+    Subkind (singleton r1 es1) (singleton r2 [])
+  | excl_subclass :
+    Subkind (singleton r1 es1) (singleton r2 es2) ->
+    a.StrictSub r2 ->
     HasSuperclassOf a es1 ->
-    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
-    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
-  | excl_disjoint_r :
-    a.StrictSub r2 -> -- not absurd
-    r1.Disjoint a ->
-    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
-    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
-  | excl_irrelevant_r :
-    a.Disjoint r2 -> -- not absurd
-    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
-    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) R
-  -- otherwise, we have to add a residue
-  | disjoint :
-    r1.Disjoint r2 ->
-    Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 es1)
-  | subclass :
-    r2.StrictSub r1 ->
-    Subtract 0 (singleton r1 es1) (singleton r2 []) (singleton r1 (r2 :: es1))
-  | residue :
+    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+  | excl_disjoint :
+    Subkind (singleton r1 es1) (singleton r2 es2) ->
     a.StrictSub r2 ->
-    a.Subclass r1 ->
-    Subtract n (singleton r1 es1) (singleton r2 es2) R ->
-    Subtract (1 + n) (singleton r1 es1) (singleton r2 (a :: es2)) (.union R (singleton a es1))
-  | union_l :
-    Subtract n K1 K R1 ->
-    Subtract m K2 K R2 ->
-    Subtract (1 + max n m) (.union K1 K2) K (.union R1 R2)
-  | union_rl :
-    Subtract n K K1 R1 ->
-    Subtract m R1 K2 R2 ->
-    Subtract (1 + max n m) K (union K1 K2) R2
-  | union_rr :
-    Subtract n K K2 R2 ->
-    Subtract m R2 K1 R1 ->
-    Subtract (1 + max n m) K (union K1 K2) R1
-
-inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | subtract : Subtract n K1 K2 R -> IsEmpty R -> Subkind K1 K2
-
--- theorem Kind.Subtract.singleton_empty_subclass
---   (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty) :
---     HasSuperclassOf r1 es1
-
-theorem Kind.Subtract.empty_excl_append_singleton
-  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) .empty)
-  : ∃ m, Subtract m (singleton r1 (a :: es1)) (singleton r2 es2) .empty := by
+    a.Disjoint r1 ->
+    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+  | excl_irrelevant :
+    Subkind (singleton r1 es1) (singleton r2 es2) ->
+    a.Disjoint r2 ->
+    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+
+theorem Kind.Subkind.singleton_weaken_l (hs : Subkind (.singleton a es) K) : Subkind (.singleton a (e :: es)) K := by
   cases hs
-  case absurd_l hs =>
-    exists 0
-    apply absurd_l $ .there hs
-  case subclass_empty =>
-    exists 0
-    apply! subclass_empty
-  case excl_subclass_r hs ha ih =>
-    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
-    exists 1 + m
-    apply! excl_subclass_r ha (.there hs)
-  case excl_disjoint_r hd ih =>
-    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
-    exists 1 + m
-    apply! excl_disjoint_r hd
-  case excl_irrelevant_r hd ih =>
-    have ⟨m, _⟩ := ih.empty_excl_append_singleton (a:=a)
-    exists 1 + m
-    apply! excl_irrelevant_r
-
-theorem Kind.Subtract.rfl_singleton :
-  ∃ m, Subtract m (singleton r es) (singleton r es) .empty := by
-  induction es
-  case nil =>
-    exists 0
-    apply subclass_empty .rfl
-  case cons h t ih =>
-    have ⟨_, ih1⟩ := ih
-    cases Classifier.subclass_or_disjoint (a := r) (b := h)
-    case inl hs => exists 0; apply absurd_l $ .here hs
-    case inr hs =>
-      cases hs
-      case inl hs =>
-        have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a := h)
-        cases hs.might_strict
-        subst_vars; exists 0; apply absurd_l; apply HasSuperclassOf.here .rfl
-        exists 1 + m
-        apply! excl_subclass_r _ $ .here .rfl
-      case inr hs =>
-        have ⟨m, _⟩ := ih1.empty_excl_append_singleton (a := h)
-        exists 1 + m
-        apply! excl_irrelevant_r hs.symm
-
-theorem Kind.Subtract.is_empty_l (he: IsEmpty K) : ∃ m K0, Subtract m K K1 K0 ∧ IsEmpty K0 := by
-  induction he
-  case empty =>
-    exists 0, .empty
-    apply And.intro .empty_l .empty
-  case absurd =>
-    exists 0, .empty
-    apply And.intro
-    apply! absurd_l
-    apply IsEmpty.empty
-  case union ha hb =>
-    have ⟨n1, R1, _, _⟩ := ha
-    have ⟨n2, R2, _, _⟩ := hb
-    exists 1 + max n1 n2, .union R1 R2
-    apply And.intro; apply! union_l; apply! IsEmpty.union
-
-theorem Kind.Subtract.rfl : ∃ m K1, Subtract m K K K1 ∧ IsEmpty K1 := by
-  induction K
-  case empty =>
-    exists 0, .empty
-    apply And.intro; apply empty_r;
-    constructor
-  case singleton r es =>
-    have ⟨m, _⟩ := rfl_singleton (r:=r) (es:=es)
-    exists m, .empty
-    apply And.intro; assumption; constructor
-  case union K1 K2 ih1 ih2 =>
-    have ⟨m1, R1, h1, he1⟩ := ih1
-    have ⟨m2, R2, h2, he2⟩ := ih2
-    have ⟨k1, RK1, _, _⟩ := is_empty_l he1 (K1:=K2)
-    have ⟨k2, RK2, _, _⟩ := is_empty_l he2 (K1:=K1)
-    exists 1 + max (1 + max m1 k1) (1 + max m2 k2), .union RK1 RK2
-    apply And.intro
-    apply union_l
-    apply! union_rl
-    apply! union_rr
-    constructor; assumption; assumption
-
-theorem Kind.Subtract.singleton_empty_inv
-  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) R)
-  (he : IsEmpty R)
-  : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
-  cases hs
-  case absurd_l => left; assumption
-  case absurd_r => cases he; left; assumption
-  case subclass_empty => right; assumption
-  case excl_subclass_r hsc hss hs =>
-    cases hs.singleton_empty_inv he <;> simp_all
-  case excl_disjoint_r hd hss hs =>
-    cases hs.singleton_empty_inv he <;> simp_all
-  case excl_irrelevant_r hd hs =>
-    cases hs.singleton_empty_inv he <;> simp_all
-  case disjoint hd => left; cases he; assumption
-  case subclass hss =>
-    cases he.singleton_cases
-    case inl he => cases hss.antisymm he
-    case inr he => left; assumption
-  case residue hsub hss hs =>
-    cases he
-    case union he _ => cases hs.singleton_empty_inv he <;> simp_all
-
-theorem Kind.Subtract.absurd_r_inv
-  (hs : Subtract n (singleton r1 es1) (singleton r2 es2) R)
-  (hsc : HasSuperclassOf r2 es2) : HasSuperclassOf r1 es1 ∨ R = singleton r1 es1 := by
-  cases hs
-  case absurd_l => left; assumption
-  case absurd_r => right; rfl
-  case subclass_empty => cases hsc
-  case excl_subclass_r hss hs =>
-    cases hsc
-    case here hsc => cases hss.antisymm hsc
-    case there hsc => apply hs.absurd_r_inv hsc
-  case excl_disjoint_r hss hs =>
-    cases hsc
-    case here hsc => cases hss.antisymm hsc
-    case there hsc => apply hs.absurd_r_inv hsc
-  case excl_irrelevant_r hd hs =>
-    cases hsc
-    case here hsc => cases hd.symm.not_subclass hsc
-    case there hsc => apply hs.absurd_r_inv hsc
-  case disjoint => cases hsc
-  case subclass => cases hsc
-  case residue hss hs =>
-    cases hsc
-    case here hsc => cases hss.antisymm hsc
-    case there hsc =>
-
-
+  case absurd_l => apply! absurd_l $ .there _
+  case subclass_no_excl hsub => apply! subclass_no_excl
+  case excl_subclass hss hsc hs => apply! hs.singleton_weaken_l.excl_subclass _ (.there _)
+  case excl_disjoint hss hd hs => apply! hs.singleton_weaken_l.excl_disjoint
+  case excl_irrelevant hd hs => apply! hs.singleton_weaken_l.excl_irrelevant
 
 
 theorem Kind.Subkind.rfl : Subkind K K := by
-  have ⟨m, K, h, he⟩ := Subtract.rfl (K:=K)
-  apply! subtract
-
-theorem Kind.Subkind.refines_is_empty
-  (hs : Subkind K1 K2)
-  (he : IsEmpty K2) : IsEmpty K1 := by
-  cases hs
-  rename_i he1 hsub
-  induction hsub <;> try cases he.singleton_must_excl
-  case absurd_l => apply! IsEmpty.absurd
-  case absurd_r => assumption
-  case empty_l => assumption
-  case empty_r => assumption
-  case excl_subclass_r hsub hsc hs ih =>
-    cases he
-    rename_i he
-    cases he
-    case here he => have h := hsub.antisymm he; contradiction
-    case there he => apply ih (.absurd he) he1
-  case excl_disjoint_r hsub hsc hs ih =>
-    cases he.singleton_cases
-    case inl he => have h := hsub.antisymm he; contradiction
-    case inr he => apply ih (.absurd he) he1
-  case excl_irrelevant_r hsub hs ih =>
-    cases he.singleton_cases
-    case inl he => have h := hsub.symm.not_subclass he; contradiction
-    case inr he => apply ih (.absurd he) he1
-  case residue hsc hs hsub ih =>
-    cases he.singleton_cases
-    case inl he => have h := hsc.antisymm he; contradiction
-    case inr he => cases he1; apply! ih (.absurd he)
-  case union_l hsa hsb iha ihb =>
-    cases he1
-    constructor
-    apply! iha
-    apply! ihb
-  case union_rl ha hb iha ihb =>
-    cases he
-    apply! iha _ (ihb _ he1)
-  case union_rr ha hb iha ihb =>
-    cases he
-    apply! iha _ (ihb _ he1)
-
-theorem Kind.Disjoint.is_empty_r
-  (he : IsEmpty K)
-  : Disjoint K1 K := by
-  induction he
-  case empty => apply! empty_r
-  case absurd => apply! absurd_r
-  case union => apply! union_r
+  cases K
+  case singleton r es =>
+    induction es
+    case nil => apply subclass_no_excl .rfl
+    case cons h t ih =>
+      cases Classifier.subclass_or_disjoint r h
+      case inl hsub =>
+        apply! absurd_l $ .here _
+      case inr hsub =>
+        cases hsub
+        case inl hsub =>
+          cases hsub.might_strict
+          case inl he =>  subst_vars; apply! absurd_l $ .here _
+          case inr hsub => apply ih.singleton_weaken_l.excl_subclass hsub (.here .rfl)
+        case inr hd =>  apply ih.singleton_weaken_l.excl_irrelevant hd.symm
+
+-- theorem Kind.Subkind.refines_is_empty
+--   (hs : Subkind K1 K2)
+--   (he : IsEmpty K2) : IsEmpty K1 := by
+--   cases hs
+--   rename_i he1 hsub
+--   induction hsub <;> try cases he.singleton_must_excl
+--   case absurd_l => apply! IsEmpty.absurd
+--   case absurd_r => assumption
+--   case empty_l => assumption
+--   case empty_r => assumption
+--   case excl_subclass_r hsub hsc hs ih =>
+--     cases he
+--     rename_i he
+--     cases he
+--     case here he => have h := hsub.antisymm he; contradiction
+--     case there he => apply ih (.absurd he) he1
+--   case excl_disjoint_r hsub hsc hs ih =>
+--     cases he.singleton_cases
+--     case inl he => have h := hsub.antisymm he; contradiction
+--     case inr he => apply ih (.absurd he) he1
+--   case excl_irrelevant_r hsub hs ih =>
+--     cases he.singleton_cases
+--     case inl he => have h := hsub.symm.not_subclass he; contradiction
+--     case inr he => apply ih (.absurd he) he1
+--   case residue hsc hs hsub ih =>
+--     cases he.singleton_cases
+--     case inl he => have h := hsc.antisymm he; contradiction
+--     case inr he => cases he1; apply! ih (.absurd he)
+--   case union_l hsa hsb iha ihb =>
+--     cases he1
+--     constructor
+--     apply! iha
+--     apply! ihb
+--   case union_rl ha hb iha ihb =>
+--     cases he
+--     apply! iha _ (ihb _ he1)
+--   case union_rr ha hb iha ihb =>
+--     cases he
+--     apply! iha _ (ihb _ he1)
+
+-- theorem Kind.Disjoint.is_empty_r
+--   (he : IsEmpty K)
+--   : Disjoint K1 K := by
+--   induction he
+--   case empty => apply! empty_r
+--   case absurd => apply! absurd_r
+--   case union => apply! union_r
 
 theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
   induction hd
-  case empty_l => apply! empty_r
-  case empty_r => apply! empty_l
+  -- case empty_l => apply! empty_r
+  -- case empty_r => apply! empty_l
   case absurd_l => apply! absurd_r
   case absurd_r => apply! absurd_l
   case root_l => apply! root_r
   case root_r => apply! root_l
   case root h => apply! root h.symm
-  case union_l => apply! union_r
-  case union_r => apply! union_l
-
-theorem Kind.Disjoint.subtract_inv
-  (hd : Disjoint K K2)
-  (hs : Subtract n K1 K2 R)
-  (hr : Disjoint K R)
-  : Disjoint K K1 := by
-  induction hs
-  case absurd_l => apply! absurd_r
-  case absurd_r => assumption
-  case empty_l => assumption
-  case empty_r => assumption
-  case subclass_empty r1 es1 r2 hsub =>
-    generalize h : singleton r2 [] = K2 at hd
-    induction hd <;> (subst_vars; try simp_all)
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd => cases hd
-    case root_l hd => cases hd
-    case root_r hd => apply! root_r $ hd.subclass _
-    case root hd => apply! root $ hd.to_subclass _
-    case union_l ha hb iha ihb =>
-      apply union_l (iha .empty_r) (ihb .empty_r)
-  case excl_subclass_r a es1 _ r1 r2 es2 _  hss hsc hs ih =>
-    generalize h : singleton r2 (a :: es2) = K2 at hd
-    induction hd <;> (subst_vars; try simp_all; try (have ⟨_, _⟩ := h; subst_vars; simp_all))
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd =>
-
-    case root_l hd => cases hd
-    case root_r hd => apply! root_r $ hd.subclass _
-    case root hd => apply! root $ hd.to_subclass _
-    case union_l ha hb iha ihb =>
-      apply union_l (iha .empty_r) (ihb .empty_r)
-
-
-
-
-theorem Kind.Disjoint.refines_subkind'
-  (hd : Disjoint K K2)
-  (hs : Subtract n K1 K2 R)
-  (he : IsEmpty R)
-  : Disjoint K K1 := by
-  -- induction hd generalizing n K1 R
-  -- case empty_l => apply! empty_l
-  -- case empty_r =>
-  --   cases hs
-  --   case absurd_l => apply! absurd_r
-  --   case empty_l => apply! empty_r
-  --   case empty_r => apply! is_empty_r
-  --   case union_l hs1 hs2 =>
-  --     cases he
-  --     apply union_r
-  --     apply! refines_subkind' .empty_r
-  --     apply! refines_subkind' .empty_r
-  -- case absurd_l => apply! absurd_l
-  -- case absurd_r =>
-  --   apply is_empty_r
-  --   apply Subkind.refines_is_empty $ .subtract hs he
-  --   apply! IsEmpty.absurd
-  -- case root_l hsc =>
-  --   cases hs
-  --   case absurd_l => apply! absurd_r
-  --   case absurd_r => apply! is_empty_r
-  --   case empty_l => apply! empty_r
-  --   case subclass_empty => cases hsc
-  --   case excl_subclass_r hsc1 hss hs =>
-  induction hs
-  case absurd_l => apply! absurd_r
-  case absurd_r => apply! is_empty_r
-  case empty_l => apply empty_r
-  case empty_r => apply! is_empty_r
-  case subclass_empty hsub =>
-    cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd => cases hd
-    case root_l hsc => cases hsc
-    case root_r hsc => apply! root_r $ hsc.subclass _
-    case root hd => apply root $ hd.to_subclass hsub
-    case union_l ha hb =>
-      apply union_l (ha.refines_subkind' (.subclass_empty hsub) he) (hb.refines_subkind' (.subclass_empty hsub) he)
-  case excl_subclass_r hss hsub hs ih =>
+  -- case union_l => apply! union_r
+  -- case union_r => apply! union_l
+
+theorem Kind.Subkind.absurd_r
+  (hs : Subkind (singleton r1 es1) (singleton r2 es2))
+  (hsc : HasSuperclassOf r2 es2)
+  : HasSuperclassOf r1 es1 := by
+  cases hs
+  case absurd_l => assumption
+  case subclass_no_excl => cases hsc
+  case excl_subclass hsc1 hss hs =>
+    cases hsc
+    case here hsub => cases hss.antisymm hsub
+    case there hsc => apply hs.absurd_r hsc
+  case excl_disjoint hd hss hs =>
+    cases hsc
+    case here hsub => cases hss.antisymm hsub
+    case there hsc => apply hs.absurd_r hsc
+  case excl_irrelevant hd hs =>
+    cases hsc
+    case here hsub => cases hd.symm.not_subclass hsub
+    case there hsc => apply hs.absurd_r hsc
+
+theorem Kind.Subkind.root_is_subclass (hs : Subkind (singleton r1 es1) (singleton r2 es2)) : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
+  cases hs
+  case absurd_l => left; assumption
+  case subclass_no_excl => right; assumption
+  case excl_subclass hsc hss hs =>
+    cases hs.root_is_subclass <;> aesop
+  case excl_disjoint hs =>
+    cases hs.root_is_subclass <;> aesop
+  case excl_irrelevant hs =>
+    cases hs.root_is_subclass <;> aesop
+
+theorem Kind.Subkind.refine_has_superclass
+  (hs : Subkind (singleton r1 es1) (singleton r2 es2))
+  (hsc : HasSuperclassOf a es2)
+  : HasSuperclassOf r1 es1 ∨ r1.Disjoint a ∨ HasSuperclassOf a es1 := by
+  cases hs
+  case absurd_l => aesop
+  case subclass_no_excl => cases hsc
+  case excl_subclass hsc hss hs =>
+    cases hsc
+    case here hsub => have h := hsc.subclass hsub; aesop
+    case there hsc => apply hs.refine_has_superclass hsc
+  case excl_disjoint hd hss hs =>
+    cases hsc
+    case here hsub => have h:= (hd.refines_subclass_l hsub).symm; aesop
+    case there hsc => apply hs.refine_has_superclass hsc
+  case excl_irrelevant hd hs =>
+    cases hsc
+    case here hsub =>
+      cases hs.root_is_subclass
+      case inl => aesop
+      case inr hsub2 => have h := ((hd.refines_subclass_l hsub).refines_subclass_r hsub2).symm; aesop
+    case there hsc => apply hs.refine_has_superclass hsc
+
+theorem Kind.Disjoint.refine_by_subkind
+  (hd : Disjoint K2 L)
+  (hs : Subkind K1 K2)
+  : Disjoint K1 L := by
+  induction hs generalizing L
+  case absurd_l => apply! absurd_l
+  case subclass_no_excl hsub =>
     cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd =>
-      cases hd
-      case here hd => cases hss.antisymm hd
-      case there hd => apply ih _ he; apply! absurd_r
-    case root_l hsc =>
-      cases hsc
-      case here hd => apply root_l $ hsub.subclass hd
-      case there hd => apply ih _ he; apply root_l hd
-    case root_r hsc =>
-      cases hs.singleton_empty_inv he
-      case inl h => apply! absurd_r
-      case inr h => apply root_r $ hsc.subclass h
-    case root hd =>
-      cases hs.singleton_empty_inv he
-      case inl h => apply! absurd_r
-      case inr h => apply root $ hd.to_subclass h
-    case union_l ha hb =>
-      apply union_l (ha.refines_subkind' (.excl_subclass_r hss hsub hs) he) (hb.refines_subkind' (.excl_subclass_r hss hsub hs) he)
-  case excl_disjoint_r hss hd1 hs ih =>
+    case absurd_l hsc => cases hsc
+    case absurd_r hsc => apply! absurd_r
+    case root_l hsc => apply! root_l $ hsc.subclass _
+    case root_r hsc =>  cases hsc
+    case root hd => apply! root $ hd.refines_subclass_l _
+  case excl_subclass hs hss hsc ih =>
     cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd =>
-      cases hd
-      case here hd => cases hss.antisymm hd
-      case there hd => apply ih _ he; apply! absurd_r
-    case root_l hsc =>
+    case absurd_l hsc =>
       cases hsc
-      case here hd => apply root $ (hd1.to_subclass hd).symm
-      case there hd => apply ih _ he; apply root_l hd
-    case root_r hsc =>
-      cases hs.singleton_empty_inv he
-      case inl h => apply! absurd_r
-      case inr h => apply root_r $ hsc.subclass h
+      case here hsub => cases hss.antisymm hsub
+      case there hsc => apply absurd_l $ hs.absurd_r hsc
+    case absurd_r => apply! absurd_r
+    case root_l hsc1 =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr hsub => apply! root_l $ hsc1.subclass _
+    case root_r hsc1 =>
+      cases hsc1
+      case here hsub => apply! root_r $ hsc.subclass _
+      case there hsc1 =>
+        cases hs.refine_has_superclass hsc1
+        case inl => apply! absurd_l
+        case inr h1 =>
+          cases h1
+          case inl h1 => apply! root
+          case inr h1 => apply! root_r
     case root hd =>
-      cases hs.singleton_empty_inv he
-      case inl => apply! absurd_r
-      case inr h => apply root $ hd.to_subclass h
-    case union_l ha hb =>
-      apply union_l (ha.refines_subkind' (.excl_disjoint_r hss hd1 hs) he) (hb.refines_subkind' (.excl_disjoint_r hss hd1 hs) he)
-  case excl_irrelevant_r hd1 hs ih =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr h1 => apply! root $ hd.refines_subclass_l _
+  case excl_disjoint hs hss hd1 ih =>
     cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd =>
-      cases hd
-      case here hd => cases hd1.symm.not_subclass hd
-      case there hd => apply ih _ he; apply! absurd_r
-    case root_l hsc =>
+    case absurd_l hsc =>
       cases hsc
-      case here hd =>
-        have hd2 := hd1.symm.to_subclass hd
-        cases hs.singleton_empty_inv he
-        case inl => apply! absurd_r
-        case inr h => apply root $ hd2.symm.to_subclass h
-      case there hd => apply ih _ he; apply root_l hd
-    case root_r hsc =>
-      cases hs.singleton_empty_inv he
-      case inl h => apply! absurd_r
-      case inr h => apply root_r $ hsc.subclass h
-    case root hd =>
-      cases hs.singleton_empty_inv he
-      case inl => apply! absurd_r
-      case inr h => apply root $ hd.to_subclass h
-    case union_l ha hb =>
-      apply union_l (ha.refines_subkind' (.excl_irrelevant_r hd1 hs) he) (hb.refines_subkind' (.excl_irrelevant_r hd1 hs) he)
-  case disjoint hd => apply! is_empty_r
-  case subclass hss =>
-    cases he.singleton_cases
-    case inl h => cases hss.antisymm h
-    case inr h => apply! absurd_r
-  case residue hss hsub hs ih =>
-    cases he
-    rename_i he he1
+      case here hsub => cases hss.antisymm hsub
+      case there hsc => apply absurd_l $ hs.absurd_r hsc
+    case absurd_r => apply! absurd_r
+    case root_l hsc1 =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr hsub => apply! root_l $ hsc1.subclass _
+    case root_r hsc1 =>
+      cases hsc1
+      case here hsub => apply! root $ hd1.symm.refines_subclass_r _
+      case there hsc1 =>
+        cases hs.refine_has_superclass hsc1
+        case inl => apply! absurd_l
+        case inr h1 =>
+          cases h1
+          case inl h1 => apply! root
+          case inr h1 => apply! root_r
+    case root hd2 =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr => apply! root $ hd2.refines_subclass_l _
+  case excl_irrelevant hs hd ih =>
     cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case absurd_r hd =>
-      cases hd
-      case here hd => cases hss.antisymm hd
-      case there hd => apply ih _ he; apply! absurd_r
-    case root_l hsc =>
+    case absurd_l hsc =>
       cases hsc
-      case here hd =>
-        cases he1
-        rename_i he1
-        apply root_l $ he1.subclass hd
-      case there hd => apply ih _ he; apply root_l hd
-    case root_r hsc =>
-      cases hs.singleton_empty_inv he
-      case inl h => apply! absurd_r
-      case inr h => apply root_r $ hsc.subclass h
-    case root hd =>
-      cases hs.singleton_empty_inv he
-      case inl => apply! absurd_r
-      case inr h => apply root $ hd.to_subclass h
-    case union_l ha hb =>
-      apply union_l (ha.refines_subkind' (.residue hss hsub hs) (.union he he1))
-      apply hb.refines_subkind' (.residue hss hsub hs) (.union he he1)
-  case union_l ha hb iha ihb =>
-    cases he
-    apply union_r
-    apply! iha
-    apply! ihb
-  case union_rl ha hb iha ihb =>
-    cases hd
-    case empty_l => apply! empty_l
-    case absurd_l => apply! absurd_l
-    case union_l hua hub =>
-      apply union_l (hua.refines_subkind' (.union_rl ha hb) he) (hub.refines_subkind' (.union_rl ha hb) he)
-    case union_r hua hub =>
-      apply iha hua
-
-
-
-
-
-
-termination_by structural K
-
-
-    -- cases hs
-    -- case excl_empty => apply! excl_empty_r
-    -- case subclass_l => cases hsc
-    -- case excl_subclass_r hsc2 hs =>
+      case here hsub => cases hd.symm.not_subclass hsub
+      case there hsc => apply absurd_l $ hs.absurd_r hsc
+    case absurd_r => apply! absurd_r
+    case root_l hsc1 =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr hsub => apply! root_l $ hsc1.subclass _
+    case root_r hsc1 =>
+      cases hsc1
+      case here hsub =>
+        cases hs.root_is_subclass
+        case inl => apply! absurd_l
+        case inr hsub2 =>
+          apply root
+          apply Classifier.Disjoint.symm
+          apply! (hd.refines_subclass_l _).refines_subclass_r _
+      case there hsc1 =>
+        cases hs.refine_has_superclass hsc1
+        case inl => apply! absurd_l
+        case inr h1 =>
+          cases h1
+          case inl h1 => apply! root
+          case inr h1 => apply! root_r
+    case root hd2 =>
+      cases hs.root_is_subclass
+      case inl => apply! absurd_l
+      case inr => apply! root $ hd2.refines_subclass_l _

From 79b848a76e146f39dbc696baeded14c4eb302136 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 2 Dec 2025 14:42:50 +0100
Subject: [PATCH 31/71] Continue

---
 Capless/Classifier.lean   | 5 +++++
 Capless/Subcapturing.lean | 2 +-
 Capless/Typing.lean       | 2 +-
 3 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index cad16978..06a26c4e 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -8,6 +8,8 @@ inductive Classifier : Type where
   | child : Nat -> Classifier -> Classifier
 deriving DecidableEq
 
+def Classifier.control := child 0 .top
+
 inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
   | rfl : Subclass a a
   | parent_l : Subclass a b -> Subclass (child n a) b
@@ -176,6 +178,9 @@ inductive Kind : Type where
 | singleton : Classifier -> List Classifier -> Kind
 -- | union : Kind -> Kind -> Kind
 
+@[simp]
+def Kind.classifier (c : Classifier) := singleton c []
+
 @[simp]
 def Kind.excl (k : Kind) c :=
   match k with
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 9e31000f..49c4c512 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -45,7 +45,7 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   -- | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.classifier c)
+  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
   | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 4b0e6380..5ec5cf98 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -68,7 +68,7 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed (Γ,c:=C) t E.cweaken C0.cweaken ->
   Typed Γ (let c=C in t) E C0
 | boundary {Γ : Context n m k} {S : SType n m k} :
-  c.subclass .control ->
+  c.Subclass .control ->
   Typed
     ((Γ,c<:CBound.kind (.classifier c)),x: Label[S.cweaken]^{c=0})
     t

From e592a63747f5aa6a2f59ed213d17f92bcce83bb7 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 2 Dec 2025 21:13:55 +0100
Subject: [PATCH 32/71] Stuck...

---
 Capless/CaptureSet.lean         | 706 +++++++++++++++-----------------
 Capless/Store.lean              |  16 +-
 Capless/Subcapturing.lean       |  42 +-
 Capless/Subcapturing/Basic.lean | 129 +++++-
 Capless/WellScoped/Basic.lean   | 373 +++++++++++------
 5 files changed, 705 insertions(+), 561 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index d6b2a644..bad434bf 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -12,6 +12,11 @@ namespace Capless
 This file contains the definition of capture sets.
 -/
 
+inductive Singleton : Nat -> Nat -> Type where
+| var : Fin n -> Singleton n k
+| cvar : Fin k -> Singleton n k
+| proj : Singleton n k -> Kind -> Singleton n k
+
 /-- Capture sets in System Capless.
 
 The type of capture sets is parameterized by:
@@ -30,167 +35,78 @@ Since the capture sets are indexed with the number of available binders, and eac
 inductive CaptureSet : Nat -> Nat -> Type where
 | empty : CaptureSet n k
 | union : CaptureSet n k -> CaptureSet n k -> CaptureSet n k
-| singleton : Fin n -> CaptureSet n k
-| csingleton : Fin k -> CaptureSet n k
-| proj : CaptureSet n k -> Kind -> CaptureSet n k
+| singleton : Singleton n k -> CaptureSet n k
 
 @[simp]
-def CaptureSet.depth : CaptureSet n k -> Nat
-  | empty => 0
-  | union a b => 1 + max a.depth b.depth
-  | singleton _ => 1
-  | csingleton _ => 1
-  | proj c _ => 1 + c.depth
+def CaptureSet.proj (c : CaptureSet n k) (K : Kind) :=
+  match c with
+  | empty => empty
+  | union c1 c2 => union (c1.proj K) (c2.proj K)
+  | singleton s => singleton $ s.proj K
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
 
-notation:max "{x=" x "}" => CaptureSet.singleton x
-notation:max "{c=" c "}" => CaptureSet.csingleton c
+notation:max "{x=" x "}" => CaptureSet.singleton (Singleton.var x)
+notation:max "{c=" c "}" => CaptureSet.singleton (Singleton.cvar c)
 
 @[simp]
 instance : Union (CaptureSet n k) where
   union := CaptureSet.union
 
 /-- Subset relation on capture sets. -/
-inductive CaptureSet.Subset : Nat -> CaptureSet n k → CaptureSet n k → Prop where
-| empty : Subset 0 {} C
-| rfl : Subset 0 C C
+inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
+| empty : Subset {} C
+| rfl : Subset C C
 | union_l :
-  Subset a C1 C ->
-  Subset b C2 C ->
-  Subset (1 + a + b) (C1 ∪ C2) C
+  Subset C1 C ->
+  Subset C2 C ->
+  Subset (C1 ∪ C2) C
 | union_rl :
-  Subset a C C1 ->
-  Subset (1 + a) C (C1 ∪ C2)
+  Subset C C1 ->
+  Subset C (C1 ∪ C2)
 | union_rr :
-  Subset a C C2 ->
-  Subset (1 + a) C (C1 ∪ C2)
-| trans : Subset a C1 C2 -> Subset b C2 C3 -> Subset (1 + a + b) C1 C3
-/- projection distributivity -/
-| proj_empty : Subset 0 (.proj .empty K) .empty
-| proj_union_l : Subset 0 (.union (.proj C1 K) (.proj C2 K)) (.proj (C1 ∪ C2) K)
-| proj_union_r : Subset 0 (.proj (C1 ∪ C2) K) (.union (.proj C1 K) (.proj C2 K))
-| proj : Subset a C D -> Subset (1 + a) (.proj C K) (.proj D K)
+  Subset C C2 ->
+  Subset C (C1 ∪ C2)
 
 @[simp]
 instance : HasSubset (CaptureSet n k) where
-  Subset A B := ∃ n: Nat, CaptureSet.Subset n A B
-
-/- Existentialification -/
-
-theorem CaptureSet.Subset.empty' : CaptureSet.empty ⊆ C := by exists 0; apply empty
-theorem CaptureSet.Subset.rfl' {C : CaptureSet n k} : C ⊆ C := by exists 0; apply rfl
-theorem CaptureSet.Subset.union_l' {C1 C2 C : CaptureSet n k} (h1 : C1 ⊆ C) (h2 : C2 ⊆ C) : (C1 ∪ C2) ⊆ C := by
-  have ⟨n1, _⟩ := h1
-  have ⟨n2, _⟩ := h2
-  exists 1 + n1 + n2; apply! union_l
-theorem CaptureSet.Subset.union_rl' {C1 C2 C : CaptureSet n k} (h1 : C ⊆ C1) : C ⊆ (C1 ∪ C2) := by
-  have ⟨n1, _⟩ := h1
-  exists 1 + n1; apply! union_rl
-theorem CaptureSet.Subset.union_rr' {C1 C2 C : CaptureSet n k} (h1 : C ⊆ C2) : C ⊆ (C1 ∪ C2) := by
-  have ⟨n1, _⟩ := h1
-  exists 1 + n1; apply! union_rr
-theorem CaptureSet.Subset.trans' {C1 C2 C3 : CaptureSet n k} (h1 : C1 ⊆ C2) (h2 : C2 ⊆ C3) : C1 ⊆ C3 := by
-  have ⟨n1, _⟩ := h1
-  have ⟨n2, _⟩ := h2
-  exists 1 + n1 + n2; apply! trans
-theorem CaptureSet.Subset.proj_empty' : (CaptureSet.proj CaptureSet.empty K : CaptureSet n k) ⊆ CaptureSet.empty := by
-  exists 0; apply proj_empty
-theorem CaptureSet.Subset.proj_union_l' {C1 C2 : CaptureSet n k} : (CaptureSet.union (CaptureSet.proj C1 K) (CaptureSet.proj C2 K)) ⊆ (CaptureSet.proj (C1 ∪ C2) K) := by
-  exists 0; apply proj_union_l
-theorem CaptureSet.Subset.proj_union_r' {C1 C2 : CaptureSet n k} : (CaptureSet.proj (C1 ∪ C2) K) ⊆ (CaptureSet.union (CaptureSet.proj C1 K) (CaptureSet.proj C2 K)) := by
-  exists 0; apply proj_union_r
-theorem CaptureSet.Subset.proj' {C D : CaptureSet n k} (h : C ⊆ D) : (CaptureSet.proj C K) ⊆ (CaptureSet.proj D K) := by
-  have ⟨n1, _⟩ := h
-  exists 1 + n1; apply! proj
+  Subset := CaptureSet.Subset
 
+theorem CaptureSet.Subset.union_l_inv (hs : Subset (.union a1 a2) b) : Subset a1 b ∧ Subset a2 b := by
+  cases hs
+  case rfl =>
+    apply And.intro
+    apply union_rl .rfl
+    apply union_rr .rfl
+  case union_l => apply! And.intro
+  case union_rl ha =>
+    have ⟨_, _⟩ := ha.union_l_inv
+    apply And.intro <;> apply! union_rl
+  case union_rr ha =>
+    have ⟨_, _⟩ := ha.union_l_inv
+    apply And.intro <;> apply! union_rr
+
+theorem CaptureSet.Subset.trans (hs1 : Subset a b) (hs2 : Subset b c) : Subset a c := by
+  induction hs1
+  case empty => constructor
+  case rfl => assumption
+  case union_l ha hb iha ihb =>
+    apply! union_l (iha _) (ihb _)
+  case union_rl ha iha =>
+    have ⟨_, _⟩ := hs2.union_l_inv
+    apply! iha
+  case union_rr ha iha =>
+    have ⟨_, _⟩ := hs2.union_l_inv
+    apply! iha
 
 
 @[simp]
 instance : IsTrans (CaptureSet n k) (HasSubset.Subset) where
-  trans a b c ha hb := by
-    have ⟨a, ha⟩ := ha
-    have ⟨b, hb⟩ := hb
-    exists (1 + a + b)
-    apply CaptureSet.Subset.trans ha hb
-
-theorem CaptureSet.Subset.union_l_inv {C1 C2 C3 : CaptureSet n k} (h1' : (C1 ∪ C2) ⊆ C3) : (C1 ⊆ C3) ∧ (C2 ⊆ C3) := by
-  generalize h0 : C1 ∪ C2 = C at h1'
-  have ⟨n, h1⟩ := h1'
-  induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
-  case rfl =>
-    apply And.intro
-    apply Exists.intro 1 $ union_rl .rfl
-    apply Exists.intro 1 $ union_rr .rfl
-  case union_l a _ _ b _ h1 h2 ih1 ih2 =>
-    apply And.intro
-    exists a
-    exists b
-  case union_rl ha ih =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
-    apply And.intro
-    apply Exists.intro (1 + l) $ .union_rl hl
-    apply Exists.intro (1 + r) $ .union_rl hr
-  case union_rr ha ih =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
-    apply And.intro
-    apply Exists.intro (1 + l) $ .union_rr hl
-    apply Exists.intro (1 + r) $ .union_rr hr
-  case trans b _ h1 _ h2 ih2 =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ih2 _ h2
-    apply And.intro
-    exists (1 + l + b); apply trans hl h1
-    exists (1 + r + b); apply trans hr h1
-  case proj_union_l =>
-    have ⟨_, _⟩ := h0
-    subst_vars; simp_all
-    apply And.intro
-    exists 1 + 1; apply proj; apply union_rl .rfl
-    exists 1 + 1; apply proj; apply union_rr .rfl
-
-theorem CaptureSet.Subset.proj_union_l_inv {C1 C2 C3 : CaptureSet n k} (h1' : (.proj (C1 ∪ C2) K) ⊆ C3) : ((C1.proj K) ⊆ C3) ∧ ((C2.proj K) ⊆ C3) := by
-  generalize h0 : (C1 ∪ C2).proj K = C at h1'
-  have ⟨n, h1⟩ := h1'
-  induction h1 generalizing C1 C2 <;> (subst_vars; simp_all)
-  case rfl =>
-    apply And.intro
-    exists 1 + 1; apply proj $ union_rl .rfl
-    exists 1 + 1; apply proj $ union_rr .rfl
-  case union_rl ha ih =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
-    apply And.intro
-    exists 1 + l; apply! union_rl
-    exists 1 + r; apply! union_rl
-  case union_rr ha ih =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ih _ ha
-    apply And.intro
-    exists 1 + l; apply! union_rr
-    exists 1 + r; apply! union_rr
-  case trans b _ ha hb iha ihb =>
-    have ⟨⟨l, hl⟩, r, hr⟩ := ihb _ iha
-    apply And.intro
-    exists (1 + l + b); apply! trans
-    exists (1 + r + b); apply! trans
-  case proj_union_r =>
-    have ⟨⟨_, _⟩, _⟩ := h0
-    subst_vars; simp_all
-    apply And.intro
-    exists 1; apply union_rl .rfl
-    exists 1; apply union_rr .rfl
-  case proj ha ih =>
-    have ⟨_, _⟩ := h0
-    subst_vars; simp_all
-    have ⟨⟨l, hl⟩, r, hr⟩ := union_l_inv $ Exists.intro _ ha
-    apply And.intro
-    exists 1 + l; apply! proj
-    exists 1 + r; apply! proj
+  trans a b c := CaptureSet.Subset.trans
 
-theorem CaptureSet.Subset.union_monotone {C1 C2 D1 D2 : CaptureSet n k} (hc : C1 ⊆ C2) (hd : D1 ⊆ D2) : (C1 ∪ D1) ⊆ (C2 ∪ D2) := by
-  have ⟨n1, hc1⟩ := hc
-  have ⟨n2, hc2⟩ := hd
-  exists 1 + (1 + n1) + (1 + n2)
+theorem CaptureSet.Subset.union_monotone {C1 C2 D1 D2 : CaptureSet n k} (hc : Subset C1 C2) (hd : Subset D1 D2) : Subset (C1 ∪ D1) (C2 ∪ D2) := by
   apply union_l
   apply! union_rl
   apply! union_rr
@@ -199,23 +115,58 @@ theorem CaptureSet.Subset.union_monotone {C1 C2 D1 D2 : CaptureSet n k} (hc : C1
 ## Renaming operations
 -/
 
+@[simp]
+def Singleton.rename (s : Singleton n k) (f : FinFun n n') : Singleton n' k :=
+  match s with
+  | var n => var $ f n
+  | cvar k => cvar k
+  | proj s K => (s.rename f).proj K
+
+@[simp]
+def Singleton.crename (s : Singleton n k) (f : FinFun k k') : Singleton n k' :=
+  match s with
+  | var n => var n
+  | cvar k => cvar $ f k
+  | proj s K => (s.crename f).proj K
+
+@[simp]
+theorem Singleton.rename_id {s : Singleton n k} :
+  s.rename FinFun.id = s := by
+  induction s <;> simp_all [FinFun.id]
+
+@[simp]
+theorem Singleton.crename_id {s : Singleton n k} :
+  s.crename FinFun.id = s := by
+  induction s <;> simp_all [FinFun.id]
+
+@[simp]
+theorem Singleton.rename_rename {s : Singleton n k} :
+  (s.rename f).rename g = s.rename (g ∘ f) := by
+  induction s <;> simp_all
+
+@[simp]
+theorem Singleton.crename_crename {s : Singleton n k} :
+  (s.crename f).crename g = s.crename (g ∘ f) := by
+  induction s <;> simp_all
+
+@[simp]
+theorem Singleton.crename_rename_comm {s : Singleton n k} {f : FinFun n n'} {g : FinFun k k'} :
+  (s.rename f).crename g = (s.crename g).rename f := by
+  induction s <;> simp_all
+
 @[simp]
 def CaptureSet.rename (C : CaptureSet n k) (f : FinFun n n') : CaptureSet n' k :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.rename f) ∪ (C2.rename f)
-  | singleton x => singleton $ f x
-  | csingleton c => csingleton c
-  | proj c k => (c.rename f).proj k
+  | singleton s => singleton $ s.rename f
 
 @[simp]
 def CaptureSet.crename (C : CaptureSet n k) (f : FinFun k k') : CaptureSet n k' :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.crename f) ∪ (C2.crename f)
-  | singleton x => singleton x
-  | csingleton c => csingleton $ f c
-  | proj c k => (c.crename f).proj k
+  | singleton s => singleton $ s.crename f
 
 def CaptureSet.weaken (C : CaptureSet n k) : CaptureSet (n+1) k :=
   C.rename FinFun.weaken
@@ -308,9 +259,6 @@ theorem CaptureSet.cweaken_crename {C : CaptureSet n k} :
   (C.crename f).cweaken = C.cweaken.crename f.ext := by
   simp [cweaken, crename_crename, FinFun.comp_weaken]
 
-theorem CaptureSet.subset_refl {C : CaptureSet n k} :
-  C ⊆ C := by exists 0; constructor
-
 theorem CaptureSet.cweaken_csingleton {c : Fin k} :
   ({c=c} : CaptureSet n k).cweaken = {c=c.succ} := by
   simp [singleton, cweaken, crename, FinFun.weaken]
@@ -328,268 +276,252 @@ theorem CaptureSet.crename_id {C : CaptureSet n k} :
   induction C <;> aesop
 
 theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
-  (h' : C1 ⊆ C2) :
+  (h : C1 ⊆ C2) :
   C1.crename f ⊆ C2.crename f := by
-  have ⟨n, h⟩ := h'
   induction h <;> simp
-  case empty => exists 0; constructor
-  case rfl => exists 0; constructor
-  case proj_empty => exists 0; constructor
-  case proj_union_l => exists 0; constructor
-  case proj_union_r => exists 0; apply Subset.proj_union_r
+  case empty => constructor
+  case rfl => constructor
   case union_l ha hb iha ihb =>
-    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
-    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
-    exists 1 + l + r
     apply! Subset.union_l
   case union_rl ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
     apply! Subset.union_rl
   case union_rr ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
     apply! Subset.union_rr
-  case trans ha hb iha ihb =>
-    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
-    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
-    exists 1 + l + r
-    apply! Subset.trans
-  case proj ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
-    apply! Subset.proj
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
-  (h' : C1 ⊆ C2) :
+  (h : C1 ⊆ C2) :
   C1.cweaken ⊆ C2.cweaken := by
-  have ⟨n, h⟩ := h'
   induction h <;> simp
-  case empty => exists 0; constructor
-  case rfl => exists 0; constructor
-  case proj_empty => exists 0; constructor
-  case proj_union_l => exists 0; constructor
-  case proj_union_r => exists 0; apply Subset.proj_union_r
+  case empty => constructor
+  case rfl => constructor
   case union_l ha hb iha ihb =>
-    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
-    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
-    exists 1 + l + r
     apply! Subset.union_l
   case union_rl ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
     apply! Subset.union_rl
   case union_rr ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
     apply! Subset.union_rr
-  case trans ha hb iha ihb =>
-    have ⟨l, hl⟩ := iha $ Exists.intro _ ha
-    have ⟨r, hr⟩ := ihb $ Exists.intro _ hb
-    exists 1 + l + r
-    apply! Subset.trans
-  case proj ha ih =>
-    have ⟨l, hl⟩ := ih $ Exists.intro _ ha
-    exists 1 + l
-    apply! Subset.proj
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
   induction C <;> aesop
 
-/-!
-## Projections
--/
-
-inductive ProjectedSingleton: CaptureSet n k -> (CaptureSet n k) -> Prop where
-  | var : ProjectedSingleton {x=x} {x=x}
-  | cvar : ProjectedSingleton {c=c} {c=c}
-  | proj : ProjectedSingleton s C -> ProjectedSingleton s (.proj C K)
-
-inductive ProjectedSingletonWith : (CaptureSet n k) -> (K : Kind) -> (CaptureSet n k) -> Prop where
-  | here : ProjectedSingleton s C -> ProjectedSingletonWith s K (.proj C K)
-  | there : ProjectedSingletonWith s K C -> ProjectedSingletonWith s K (.proj C K')
-
-def ProjectedSingletonWith.erase (hp : ProjectedSingletonWith s K C) : ProjectedSingleton s C := by
-  induction hp <;> apply! ProjectedSingleton.proj
-
-/-- A capture set that only has projections on top of singletons. -/
-inductive ProjectedSingletonsOnly: CaptureSet n k -> Prop where
-  | empty : ProjectedSingletonsOnly .empty
-  | singleton : ProjectedSingleton s C -> ProjectedSingletonsOnly C
-  | union : ProjectedSingletonsOnly C1 -> ProjectedSingletonsOnly C2 -> ProjectedSingletonsOnly (.union C1 C2)
-
-@[simp]
-def CaptureSet.push_proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
-  match C with
-  | .empty => .empty
-  | .singleton c => proj (.singleton c) K
-  | .csingleton c => proj (.csingleton c) K
-  | .proj C1 K1 => proj (.proj C1 K1) K
-  | .union C1 C2 => .union (C1.push_proj K) (C2.push_proj K)
-
-@[simp]
-def CaptureSet.canonicalize (C : CaptureSet n k) : CaptureSet n k :=
-  match C with
-  | .empty => .empty
-  | .singleton c => .singleton c
-  | .csingleton c => .csingleton c
-  | .union C1 C2 => .union (C1.canonicalize) (C2.canonicalize)
-  | .proj C1 K => C1.canonicalize.push_proj K
-
-theorem CaptureSet.push_proj_is_superset (C : CaptureSet n k) : (C.proj K) ⊆ C.push_proj K := by
-  induction C <;> simp only [push_proj]
-  case empty => exists 0; apply Subset.proj_empty
-  case union C1 C2 ih1 ih2 =>
-    apply IsTrans.trans (r := HasSubset.Subset)
-    exists 0; apply Subset.proj_union_r
-    apply! Subset.union_monotone
-  case singleton => exists 0; apply Subset.rfl
-  case csingleton => exists 0; apply Subset.rfl
-  case proj => apply Subset.proj' Subset.rfl'
-
-theorem CaptureSet.canonicalize_is_superset {C : CaptureSet n k} : C ⊆ C.canonicalize := by
-  induction C <;> (simp; try apply Subset.rfl')
-  case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
-  case proj C1 K ih =>
-    apply Subset.trans'
-    apply Subset.proj' ih
-    apply push_proj_is_superset
-
-theorem CaptureSet.push_proj_is_subset {C : CaptureSet n k} : C.push_proj K ⊆ C.proj K := by
-  induction C <;> (simp; try apply Subset.rfl')
-  case empty => apply Subset.empty'
-  case union C1 C2 ih1 ih2 =>
-    apply Subset.trans' _ Subset.proj_union_l'
-    apply! Subset.union_monotone
-
-theorem CaptureSet.canonicalize_is_subset {C : CaptureSet n k} : C.canonicalize ⊆ C := by
-  induction C <;> (simp; try apply Subset.rfl')
-  case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
-  case proj C1 K ih =>
-    apply Subset.trans' C1.canonicalize.push_proj_is_subset
-    apply Subset.proj' ih
-
-theorem CaptureSet.push_proj_singleton {C : CaptureSet n k} (hp: ProjectedSingletonsOnly C) : ProjectedSingletonsOnly (C.push_proj K) := by
-  induction hp <;> try simp_all
-  case empty => constructor
-  case singleton hp =>
-    induction hp
-    case var => apply ProjectedSingletonsOnly.singleton (.proj .var)
-    case cvar => apply ProjectedSingletonsOnly.singleton (.proj .cvar)
-    case proj =>
-      apply ProjectedSingletonsOnly.singleton
-      apply ProjectedSingleton.proj
-      apply! ProjectedSingleton.proj
-  case union C1 C2 ih1 ih2 =>
-    apply! ProjectedSingletonsOnly.union
-
-theorem CaptureSet.canonicalize_is_projected_singletons_only {C : CaptureSet n k} : ProjectedSingletonsOnly C.canonicalize := by
-  induction C <;> try simp
-  case empty => apply ProjectedSingletonsOnly.empty
-  case singleton => apply ProjectedSingletonsOnly.singleton .var
-  case csingleton => apply ProjectedSingletonsOnly.singleton .cvar
-  case union C1 C2 ih1 ih2 => apply ProjectedSingletonsOnly.union ih1 ih2
-  case proj C K ih =>
-    apply push_proj_singleton
-    assumption
-
-lemma CaptureSet.push_proj_depth {C : CaptureSet n k} : (C.push_proj K).depth ≤ 1 + C.depth := by
-  induction C <;> simp; omega
-
-theorem CaptureSet.canonicalize_depth {C : CaptureSet n k} : C.canonicalize.depth ≤ C.depth := by
-  induction C <;> simp
-  case union ih1 ih2 => omega
-  case proj C K ih =>
-    apply IsTrans.trans
-    apply C.canonicalize.push_proj_depth
-    simp; exact ih
-
-lemma CaptureSet.push_proj_singleton_eq {C : CaptureSet n k} (hp : ProjectedSingleton s C) : (C.push_proj K) = (C.proj K) := by
-  induction hp <;> simp
-
-theorem CaptureSet.canonicalize_projected_singletons {C : CaptureSet n k} (hp : ProjectedSingletonsOnly C) : C.canonicalize = C := by
-  induction hp
-  case singleton s C hs =>
-    induction hs <;> simp
-    case proj ha ih =>
-      rw [ih]
-      apply! push_proj_singleton_eq
-  case empty => simp
-  case union ha hb iha ihb =>
-    simp; aesop
-
-theorem CaptureSet.canonicalize_idempt {C : CaptureSet n k} : C.canonicalize.canonicalize = C.canonicalize := by
-  have h := C.canonicalize_is_projected_singletons_only
-  rw [C.canonicalize.canonicalize_projected_singletons h]
-
-theorem CaptureSet.Subset.canonicalize {A B : CaptureSet n k} (hs : A ⊆ B) : A.canonicalize ⊆ B.canonicalize := by
-  apply trans'
-  apply A.canonicalize_is_subset
-  apply trans' hs
-  apply B.canonicalize_is_superset
-
-
-inductive HasSingleton : CaptureSet n k -> CaptureSet n k -> Prop where
-  | var : HasSingleton {x=x} {x=x}
-  | cvar : HasSingleton {c=c} {c=c}
-  | union_l : HasSingleton s C1 -> HasSingleton s (.union C1 C2)
-  | union_r : HasSingleton s C2 -> HasSingleton s (.union C1 C2)
-  | proj : HasSingleton s C -> HasSingleton (s.proj K) (C.proj K)
-
-theorem CaptureSet.Subset.subset_has_singleton' {C1 C2 : CaptureSet n k} (hh1 : HasSingleton s C1) (hs : Subset t C1 C2) : HasSingleton s C2 := by
-  induction hs generalizing s
-  case empty => cases hh1
-  case rfl => assumption
-  case union_l ih1 ih2 =>
-    cases hh1
-    apply! ih1
-    apply! ih2
-  case union_rl ih => apply HasSingleton.union_l; apply ih hh1
-  case union_rr ih => apply HasSingleton.union_r; apply ih hh1
-  case trans ha hb iha ihb =>
-    apply ihb $ iha hh1
-  case proj_empty => cases hh1; rename_i hh1; cases hh1
-  case proj_union_l =>
-    cases hh1
-    { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_l }
-    { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_r }
-  case proj_union_r =>
-    cases hh1
-    rename_i hh1
-    cases hh1
-    { apply HasSingleton.union_l; constructor; assumption }
-    { apply HasSingleton.union_r; constructor; assumption }
-  case proj ih =>
-    cases hh1
-    constructor
-    apply! ih
-
-theorem CaptureSet.subset_has_singleton {C1 C2 : CaptureSet n k} (hs : C1 ⊆ C2) (hh : HasSingleton C C1) : HasSingleton C C2 := by
-  have ⟨_, h⟩ := hs
-  apply Subset.subset_has_singleton' hh h
-
-theorem CaptureSet.projected_singleton_has_singleton (hp : ProjectedSingleton s C) : HasSingleton C C := by
-  induction hp
-  case var => constructor
-  case cvar => constructor
-  case proj hp => constructor; assumption
-
-theorem CaptureSet.projected_singleton_unique_singleton (hp : ProjectedSingleton s C) (hh : HasSingleton C' C) : C' = C := by
-  induction hp generalizing C'
-  case var => cases hh; rfl
-  case cvar => cases hh; rfl
-  case proj hp ih =>
-    cases hh
-    rename_i hh
-    have ih1 := ih hh
-    subst_vars
-    simp
-
-
-theorem CaptureSet.Subset.empty_projected_singleton {C : CaptureSet n k} (hs : C ⊆ .empty) (hp : ProjectedSingleton s C) : False := by
-  have ⟨n, h⟩ := hs
-  have h2 := CaptureSet.Subset.subset_has_singleton' (projected_singleton_has_singleton hp) h
-  cases h2
-
-end Capless
+-- /-!
+-- ## Projections
+-- -/
+
+inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
+  | var : HasSingleton (.var n) (.var n)
+  | cvar : HasSingleton (.cvar k) (.cvar k)
+  | proj : HasSingleton s s' -> HasSingleton (.proj s K) s'
+
+inductive HasSingletonProj : Singleton n k -> Singleton n k -> Kind -> Prop where
+  | here : HasSingleton s s' -> HasSingletonProj (.proj s K) s' K
+  | there : HasSingletonProj s s' K -> HasSingletonProj (.proj s K') s' K
+
+theorem HasSingleton.is_not_proj (hh : HasSingleton s (.proj s' K)) : False := by
+  cases hh
+  case proj hh => apply hh.is_not_proj
+
+theorem HasSingleton.is_target (hs1 : HasSingleton s t) (hs2 : HasSingleton t u) : t = u := by
+  induction hs1
+  case var => cases hs2; rfl
+  case cvar => cases hs2; rfl
+  case proj ih => apply! ih
+
+theorem HasSingletonProj.erase (hs : HasSingletonProj s s' K) : HasSingleton s s' := by
+  induction hs
+  case here => apply! HasSingleton.proj
+  case there ih => apply! HasSingleton.proj
+
+-- inductive ProjectedSingleton: CaptureSet n k -> (CaptureSet n k) -> Prop where
+--   | var : ProjectedSingleton {x=x} {x=x}
+--   | cvar : ProjectedSingleton {c=c} {c=c}
+--   | proj : ProjectedSingleton s C -> ProjectedSingleton s (.proj C K)
+
+-- inductive ProjectedSingletonWith : (CaptureSet n k) -> (K : Kind) -> (CaptureSet n k) -> Prop where
+--   | here : ProjectedSingleton s C -> ProjectedSingletonWith s K (.proj C K)
+--   | there : ProjectedSingletonWith s K C -> ProjectedSingletonWith s K (.proj C K')
+
+-- def ProjectedSingletonWith.erase (hp : ProjectedSingletonWith s K C) : ProjectedSingleton s C := by
+--   induction hp <;> apply! ProjectedSingleton.proj
+
+-- /-- A capture set that only has projections on top of singletons. -/
+-- inductive ProjectedSingletonsOnly: CaptureSet n k -> Prop where
+--   | empty : ProjectedSingletonsOnly .empty
+--   | singleton : ProjectedSingleton s C -> ProjectedSingletonsOnly C
+--   | union : ProjectedSingletonsOnly C1 -> ProjectedSingletonsOnly C2 -> ProjectedSingletonsOnly (.union C1 C2)
+
+-- @[simp]
+-- def CaptureSet.push_proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
+--   match C with
+--   | .empty => .empty
+--   | .singleton c => proj (.singleton c) K
+--   | .csingleton c => proj (.csingleton c) K
+--   | .proj C1 K1 => proj (.proj C1 K1) K
+--   | .union C1 C2 => .union (C1.push_proj K) (C2.push_proj K)
+
+-- @[simp]
+-- def CaptureSet.canonicalize (C : CaptureSet n k) : CaptureSet n k :=
+--   match C with
+--   | .empty => .empty
+--   | .singleton c => .singleton c
+--   | .csingleton c => .csingleton c
+--   | .union C1 C2 => .union (C1.canonicalize) (C2.canonicalize)
+--   | .proj C1 K => C1.canonicalize.push_proj K
+
+-- theorem CaptureSet.push_proj_is_superset (C : CaptureSet n k) : (C.proj K) ⊆ C.push_proj K := by
+--   induction C <;> simp only [push_proj]
+--   case empty => exists 0; apply Subset.proj_empty
+--   case union C1 C2 ih1 ih2 =>
+--     apply IsTrans.trans (r := HasSubset.Subset)
+--     exists 0; apply Subset.proj_union_r
+--     apply! Subset.union_monotone
+--   case singleton => exists 0; apply Subset.rfl
+--   case csingleton => exists 0; apply Subset.rfl
+--   case proj => apply Subset.proj' Subset.rfl'
+
+-- theorem CaptureSet.canonicalize_is_superset {C : CaptureSet n k} : C ⊆ C.canonicalize := by
+--   induction C <;> (simp; try apply Subset.rfl')
+--   case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
+--   case proj C1 K ih =>
+--     apply Subset.trans'
+--     apply Subset.proj' ih
+--     apply push_proj_is_superset
+
+-- theorem CaptureSet.push_proj_is_subset {C : CaptureSet n k} : C.push_proj K ⊆ C.proj K := by
+--   induction C <;> (simp; try apply Subset.rfl')
+--   case empty => apply Subset.empty'
+--   case union C1 C2 ih1 ih2 =>
+--     apply Subset.trans' _ Subset.proj_union_l'
+--     apply! Subset.union_monotone
+
+-- theorem CaptureSet.canonicalize_is_subset {C : CaptureSet n k} : C.canonicalize ⊆ C := by
+--   induction C <;> (simp; try apply Subset.rfl')
+--   case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
+--   case proj C1 K ih =>
+--     apply Subset.trans' C1.canonicalize.push_proj_is_subset
+--     apply Subset.proj' ih
+
+-- theorem CaptureSet.push_proj_singleton {C : CaptureSet n k} (hp: ProjectedSingletonsOnly C) : ProjectedSingletonsOnly (C.push_proj K) := by
+--   induction hp <;> try simp_all
+--   case empty => constructor
+--   case singleton hp =>
+--     induction hp
+--     case var => apply ProjectedSingletonsOnly.singleton (.proj .var)
+--     case cvar => apply ProjectedSingletonsOnly.singleton (.proj .cvar)
+--     case proj =>
+--       apply ProjectedSingletonsOnly.singleton
+--       apply ProjectedSingleton.proj
+--       apply! ProjectedSingleton.proj
+--   case union C1 C2 ih1 ih2 =>
+--     apply! ProjectedSingletonsOnly.union
+
+-- theorem CaptureSet.canonicalize_is_projected_singletons_only {C : CaptureSet n k} : ProjectedSingletonsOnly C.canonicalize := by
+--   induction C <;> try simp
+--   case empty => apply ProjectedSingletonsOnly.empty
+--   case singleton => apply ProjectedSingletonsOnly.singleton .var
+--   case csingleton => apply ProjectedSingletonsOnly.singleton .cvar
+--   case union C1 C2 ih1 ih2 => apply ProjectedSingletonsOnly.union ih1 ih2
+--   case proj C K ih =>
+--     apply push_proj_singleton
+--     assumption
+
+-- lemma CaptureSet.push_proj_depth {C : CaptureSet n k} : (C.push_proj K).depth ≤ 1 + C.depth := by
+--   induction C <;> simp; omega
+
+-- theorem CaptureSet.canonicalize_depth {C : CaptureSet n k} : C.canonicalize.depth ≤ C.depth := by
+--   induction C <;> simp
+--   case union ih1 ih2 => omega
+--   case proj C K ih =>
+--     apply IsTrans.trans
+--     apply C.canonicalize.push_proj_depth
+--     simp; exact ih
+
+-- lemma CaptureSet.push_proj_singleton_eq {C : CaptureSet n k} (hp : ProjectedSingleton s C) : (C.push_proj K) = (C.proj K) := by
+--   induction hp <;> simp
+
+-- theorem CaptureSet.canonicalize_projected_singletons {C : CaptureSet n k} (hp : ProjectedSingletonsOnly C) : C.canonicalize = C := by
+--   induction hp
+--   case singleton s C hs =>
+--     induction hs <;> simp
+--     case proj ha ih =>
+--       rw [ih]
+--       apply! push_proj_singleton_eq
+--   case empty => simp
+--   case union ha hb iha ihb =>
+--     simp; aesop
+
+-- theorem CaptureSet.canonicalize_idempt {C : CaptureSet n k} : C.canonicalize.canonicalize = C.canonicalize := by
+--   have h := C.canonicalize_is_projected_singletons_only
+--   rw [C.canonicalize.canonicalize_projected_singletons h]
+
+-- theorem CaptureSet.Subset.canonicalize {A B : CaptureSet n k} (hs : A ⊆ B) : A.canonicalize ⊆ B.canonicalize := by
+--   apply trans'
+--   apply A.canonicalize_is_subset
+--   apply trans' hs
+--   apply B.canonicalize_is_superset
+
+
+-- inductive HasSingleton : CaptureSet n k -> CaptureSet n k -> Prop where
+--   | var : HasSingleton {x=x} {x=x}
+--   | cvar : HasSingleton {c=c} {c=c}
+--   | union_l : HasSingleton s C1 -> HasSingleton s (.union C1 C2)
+--   | union_r : HasSingleton s C2 -> HasSingleton s (.union C1 C2)
+--   | proj : HasSingleton s C -> HasSingleton (s.proj K) (C.proj K)
+
+-- theorem CaptureSet.Subset.subset_has_singleton' {C1 C2 : CaptureSet n k} (hh1 : HasSingleton s C1) (hs : Subset t C1 C2) : HasSingleton s C2 := by
+--   induction hs generalizing s
+--   case empty => cases hh1
+--   case rfl => assumption
+--   case union_l ih1 ih2 =>
+--     cases hh1
+--     apply! ih1
+--     apply! ih2
+--   case union_rl ih => apply HasSingleton.union_l; apply ih hh1
+--   case union_rr ih => apply HasSingleton.union_r; apply ih hh1
+--   case trans ha hb iha ihb =>
+--     apply ihb $ iha hh1
+--   case proj_empty => cases hh1; rename_i hh1; cases hh1
+--   case proj_union_l =>
+--     cases hh1
+--     { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_l }
+--     { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_r }
+--   case proj_union_r =>
+--     cases hh1
+--     rename_i hh1
+--     cases hh1
+--     { apply HasSingleton.union_l; constructor; assumption }
+--     { apply HasSingleton.union_r; constructor; assumption }
+--   case proj ih =>
+--     cases hh1
+--     constructor
+--     apply! ih
+
+-- theorem CaptureSet.subset_has_singleton {C1 C2 : CaptureSet n k} (hs : C1 ⊆ C2) (hh : HasSingleton C C1) : HasSingleton C C2 := by
+--   have ⟨_, h⟩ := hs
+--   apply Subset.subset_has_singleton' hh h
+
+-- theorem CaptureSet.projected_singleton_has_singleton (hp : ProjectedSingleton s C) : HasSingleton C C := by
+--   induction hp
+--   case var => constructor
+--   case cvar => constructor
+--   case proj hp => constructor; assumption
+
+-- theorem CaptureSet.projected_singleton_unique_singleton (hp : ProjectedSingleton s C) (hh : HasSingleton C' C) : C' = C := by
+--   induction hp generalizing C'
+--   case var => cases hh; rfl
+--   case cvar => cases hh; rfl
+--   case proj hp ih =>
+--     cases hh
+--     rename_i hh
+--     have ih1 := ih hh
+--     subst_vars
+--     simp
+
+
+-- theorem CaptureSet.Subset.empty_projected_singleton {C : CaptureSet n k} (hs : C ⊆ .empty) (hp : ProjectedSingleton s C) : False := by
+--   have ⟨n, h⟩ := hs
+--   have h2 := CaptureSet.Subset.subset_has_singleton' (projected_singleton_has_singleton hp) h
+--   cases h2
+
+-- end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index e54b9ab2..95307293 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -111,23 +111,23 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont (.union C1 C2)
 | singleton :
   Context.Bound Γ x (S^C) ->
-  WellScoped Γ cont C.canonicalize ->
+  WellScoped Γ cont C ->
   WellScoped Γ cont {x=x}
 | csingleton :
   Context.CBound Γ c (CBinding.inst C) ->
-  WellScoped Γ cont C.canonicalize ->
+  WellScoped Γ cont C ->
   WellScoped Γ cont {c=c}
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  WellScoped Γ cont C.canonicalize ->
+  WellScoped Γ cont C ->
   WellScoped Γ cont {c=c}
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c}
 | proj_singleton :
-  WellScoped Γ cont C ->
-  ProjectedSingleton C (.proj C' K) ->
-  WellScoped Γ cont (.proj C' K)
+  WellScoped Γ cont (.singleton s) ->
+  HasSingleton (.proj s' K) s ->
+  WellScoped Γ cont (.singleton $ .proj s' K)
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
@@ -135,8 +135,8 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | label_disj :
   Context.LBound Γ x c S ->
   Kind.Disjoint K (.classifier c) ->
-  ProjectedSingletonWith {x=x} K C' ->
-  WellScoped Γ cont C'
+  HasSingletonProj s (.var x) K ->
+  WellScoped Γ cont (.singleton s)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
 inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 49c4c512..16cb676a 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -10,7 +10,20 @@ import Capless.CaptureSet
 
 namespace Capless
 
-mutual
+
+inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
+  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
+  -- | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
+  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
+  | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
+  | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
+  | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
+  | empty : CaptureKind Γ .empty K
+  | singleton_proj_kind : CaptureKind Γ (.singleton $ .proj s K) K
+  | singleton_proj : CaptureKind Γ (.singleton s) K -> CaptureKind Γ (.singleton $ s.proj K1) K
+  -- | singleton_proj_disj : CaptureKind Γ (.singleton s) K1 -> K1.Disjoint K2 -> CaptureKind Γ (.singleton $ s.proj K2) K
+  | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
+
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
 | trans :
   Subcapt Γ C1 C2 ->
@@ -35,24 +48,17 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
-| proj :
-  Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
-| proj_sub {C : CaptureSet n k} {K1 K2 : Kind}:
-  K1.Subkind K2 -> Subcapt Γ (C.proj K1) (C.proj K2)
-| proj_l : Subcapt Γ (C.proj K) C
-| proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
-| proj_disj : Kind.Disjoint K1 K2 -> CaptureKind Γ C K1 -> Subcapt Γ (C.proj K2) .empty
+-- | proj :
+--   Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
+| singleton_proj_sub {s : Singleton n k} {K1 K2 : Kind}:
+  K1.Subkind K2 -> Subcapt Γ (.singleton $ s.proj K1) (.singleton $ s.proj K2)
+| singleton_proj_l : Subcapt Γ (.singleton $ .proj s K) (.singleton s)
+| proj_r : Subcapt Γ C D -> CaptureKind Γ C K -> Subcapt Γ C (D.proj K)
+| singleton_proj_disj :
+  Kind.Disjoint K1 K2 ->
+  CaptureKind Γ (.singleton s) K1 ->
+  Subcapt Γ (.singleton $ s.proj K2) .empty
 
-inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
-  -- | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
-  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
-  | csub : Subcapt Γ C1 C2 -> CaptureKind Γ C2 K -> CaptureKind Γ C1 K
-  | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
-  | empty : CaptureKind Γ .empty K
-  | proj_kind {C : CaptureSet n k} : CaptureKind Γ (C.proj K) K
-  | proj : CaptureKind Γ C K -> CaptureKind Γ (C.proj K1) K
-end
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 2e88de4a..c581ad9c 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -1,4 +1,5 @@
 import Capless.Subcapturing
+import Capless.Inversion.Context
 
 /-!
 # Basic Properties of Subcapturing
@@ -8,10 +9,10 @@ This file contains basic properties of the subcapturing relation.
 
 namespace Capless
 
-theorem Subcapt.refl :
+theorem Subcapt.rfl :
   Subcapt Γ C C := by
   apply subset
-  apply CaptureSet.subset_refl
+  apply CaptureSet.Subset.rfl
 
 theorem Subcapt.join
   (h1 : Γ ⊢ C1 <:c D1)
@@ -19,18 +20,122 @@ theorem Subcapt.join
   Γ ⊢ C1 ∪ C2 <:c D1 ∪ D2 := by
   apply Subcapt.union
   { apply Subcapt.trans; exact h1
-    apply Subcapt.subset; apply CaptureSet.Subset.union_rl; apply CaptureSet.subset_refl }
+    apply Subcapt.subset; apply CaptureSet.Subset.union_rl; apply CaptureSet.Subset.rfl }
   { apply Subcapt.trans; exact h2
-    apply Subcapt.subset; apply CaptureSet.Subset.union_rr; apply CaptureSet.subset_refl }
+    apply Subcapt.subset; apply CaptureSet.Subset.union_rr; apply CaptureSet.Subset.rfl }
+
+theorem Subcapt.proj_sub {C : CaptureSet n k}
+  (hsk : K1.Subkind K2)
+  : Subcapt Γ (C.proj K1) (C.proj K2) := by
+  induction C
+  case empty => simp; apply subset .rfl
+  case singleton s => apply singleton_proj_sub hsk
+  case union ha hb iha ihb =>
+    simp
+    apply join iha ihb
+
+theorem Subcapt.proj_l : Subcapt Γ (C.proj K) C := by
+  induction C
+  case empty => simp; apply rfl
+  case singleton => apply singleton_proj_l
+  case union ha hb iha ihb =>
+    simp
+    apply! join
+
+-- theorem CaptureKind.var (hb : Context.Bound Γ x (S^C)) (hk : CaptureKind Γ C K) : CaptureKind Γ {x=x} K := by
+--   apply csub
+--   apply Subcapt.var hb
+--   assumption
+
+theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
+  match hk with
+  | .cvar _ => by cases heq
+  | .union ha hb => by
+    injections
+    subst_vars
+    apply! And.intro
+  | .sub hsk hk => by
+    have ⟨_, _⟩ := hk.union_l_inv' heq
+    apply And.intro <;> apply! CaptureKind.sub
+  | .empty => by cases heq
+  | .singleton_proj_kind => by cases heq
+  | .singleton_proj hk => by cases heq
+termination_by structural hk
+
+
+-- mutual
+theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D :=
+  match hs with
+  | .trans ha hb => by
+    have ⟨_, _⟩ := ha.union_l_inv' heq
+    apply And.intro <;> apply! Subcapt.trans _
+  | .subset hsub => by
+    rw [heq] at hsub
+    have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hsub
+    apply And.intro <;> apply! Subcapt.subset
+  | .union ha hb => by
+    injections
+    subst_vars
+    apply And.intro ha hb
+  | .cinstl hb => by
+    subst_vars
+    have h1 : Subcapt Γ C1 (C1 ∪ C2) := Subcapt.subset $ .union_rl .rfl
+    have h2 : Subcapt Γ C2 (C1 ∪ C2) := Subcapt.subset $ .union_rr .rfl
+    apply And.intro <;> apply! Subcapt.trans _ (.cinstl hb)
+  | .proj_r hs hk => by
+    have ⟨_, _⟩ := hs.union_l_inv' heq
+    have ⟨_, _⟩ := hk.union_l_inv' heq
+    apply And.intro <;> apply! Subcapt.proj_r
+termination_by structural hs
+-- end
+
+theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
+theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
+
+theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
+  induction C
+  case empty => apply empty
+  case union  => apply! union
+  case singleton => apply! singleton_proj_kind
+
+theorem CaptureKind.proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj K1) K := by
+  induction C
+  case empty => simp; apply empty
+  case union ha hb =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! union (ha _) (hb _)
+  case singleton => apply! singleton_proj
+
+
+theorem Subcapt.proj (hs : Subcapt Γ C1 C2) : Subcapt Γ (C1.proj K) (C2.proj K) := by
+  apply proj_r
+  apply trans .proj_l hs
+  apply CaptureKind.proj_kind
+
+theorem Subcapt.proj_disj
+  (hd : Kind.Disjoint K1 K2)
+  (hk : CaptureKind Γ C K1)
+  : Subcapt Γ (C.proj K2) .empty := by
+  induction C
+  case empty => simp; apply rfl
+  case union ha hb =>
+    simp
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! union (ha _) (hb _)
+  case singleton => apply! singleton_proj_disj
+
+-- theorem CaptureKind.proj_disj  (hk : CaptureKind Γ C K1) (hd : Kind.Disjoint K1 K2) : CaptureKind Γ (C.proj K2) K3 := by
+--   induction C
+--   case empty => simp; apply empty
+--   case union ha hb iha ihb =>
+--     simp
+--     have ⟨_, _⟩ := hk.union_l_inv
+--     apply! union (iha _) (ihb _)
+--   case singleton => apply! singleton_proj_disj
+
+
+
 
-theorem CaptureKind.var (hb : Context.Bound Γ x (S^C)) (hk : CaptureKind Γ C K) : CaptureKind Γ {x=x} K := by
-  apply csub
-  apply Subcapt.var hb
-  assumption
 
-theorem CaptureKind.proj_disj (hd : Kind.Disjoint K1 K2) (hk : CaptureKind Γ C K1) : CaptureKind Γ (C.proj K2) K3 := by
-  apply csub
-  apply Subcapt.proj_disj hd hk
-  apply empty
 
 end Capless
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index d476facb..6f5a8a70 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -10,126 +10,80 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
-theorem WellScoped.implies_canonical (hsc : WellScoped Γ cont C) : ProjectedSingletonsOnly C := by
-  induction hsc
-  case empty => constructor
-  case union ha hb iha ihb => apply! ProjectedSingletonsOnly.union
-  case singleton => apply ProjectedSingletonsOnly.singleton; constructor
-  case csingleton => apply ProjectedSingletonsOnly.singleton; constructor
-  case cbound => apply ProjectedSingletonsOnly.singleton; constructor
-  case ckind => apply ProjectedSingletonsOnly.singleton; constructor
-  case proj_singleton => apply! ProjectedSingletonsOnly.singleton
-  case label => apply ProjectedSingletonsOnly.singleton; constructor
-  case label_disj _ _ hsw => apply ProjectedSingletonsOnly.singleton; apply hsw.erase
-
-theorem WellScoped.push_proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.push_proj K) := by
+theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.proj K) := by
   induction hsc generalizing K <;> try simp_all
   case empty => apply empty
   case union iha ihb => apply union iha ihb
   case singleton hb ha ih =>
     apply proj_singleton
     apply singleton hb ha
-    apply ProjectedSingleton.proj .var
+    apply HasSingleton.proj .var
   case csingleton hb ha ih =>
     apply proj_singleton
     apply csingleton hb ha
-    apply ProjectedSingleton.proj .cvar
+    apply HasSingleton.proj .cvar
   case cbound hb ha ih =>
     apply proj_singleton
     apply cbound hb ha
-    apply ProjectedSingleton.proj .cvar
+    apply HasSingleton.proj .cvar
   case ckind hb =>
     apply proj_singleton
     apply ckind hb
-    apply ProjectedSingleton.proj .cvar
+    apply HasSingleton.proj .cvar
   case proj_singleton h1 hp ih =>
     apply proj_singleton h1
-    rw [← CaptureSet.push_proj_singleton_eq hp]
-    apply! ProjectedSingleton.proj
+    apply! HasSingleton.proj
   case label hb hs =>
     apply proj_singleton
     apply label hb hs
-    apply ProjectedSingleton.proj .var
+    apply HasSingleton.proj .var
   case label_disj hb hd hp  =>
     apply label_disj hb hd
-    rw [CaptureSet.push_proj_singleton_eq $ hp.erase]
-    apply! ProjectedSingletonWith.there
-
-theorem WellScoped.push_proj_sub {C : CaptureSet n k} (hsc : WellScoped Γ cont (C.push_proj K2)) (hsk : K1.Subkind K2) : WellScoped Γ cont (C.push_proj K1) := by
-  induction C <;> simp_all
-  case union ih1 ih2 =>
-    cases hsc
-    case label_disj hsw => cases hsw
-    case union ha hb => apply union (ih1 ha) (ih2 hb)
-  case proj ih =>
-    cases hsc
-    case proj_singleton hsc hp =>
-      cases hp
-      rename_i hp
-      apply proj_singleton hsc $ .proj hp
-    case label_disj hb hd hsw =>
-      cases hsw
-      case here hs =>
-
-
-
+    apply! HasSingletonProj.there
 
 theorem WellScoped.has_singleton
-  (hsc : WellScoped Γ cont C2)
+  (hsc : WellScoped Γ cont (.singleton C2))
   (hh : HasSingleton C C2) :
-  WellScoped Γ cont C := by
-  induction hsc generalizing C
-  case empty => cases hh
-  case union ha hb iha ihb =>
-    cases hh
-    case union_l hh => apply! iha
-    case union_r hh => apply! ihb
-  case singleton =>
-    cases hh
-    apply! singleton
-  case csingleton =>
-    cases hh
-    apply! csingleton
-  case cbound =>
-    cases hh
-    apply! cbound
-  case ckind =>
-    cases hh
-    apply! ckind
-  case proj_singleton hsc hp ih =>
-    have hh1 := CaptureSet.projected_singleton_unique_singleton hp hh
-    subst_vars
-    apply! proj_singleton
-  case label hb hl =>
-    cases hh
-    apply! label
-  case label_disj hb hd hp =>
-    have hh1 := CaptureSet.projected_singleton_unique_singleton hp.erase hh
-    subst_vars
-    apply! label_disj
+  WellScoped Γ cont (.singleton C) := by
+  induction hh
+  case var => assumption
+  case cvar => assumption
+  case proj =>
+    apply proj_singleton
+    apply hsc
+    apply! HasSingleton.proj
+
 
+-- theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
+--   (hs : C1 ⊆ C2)
+--   (hp1 : ProjectedSingletonsOnly C1)
+--   (hp2 : ProjectedSingletonsOnly C2) : WellScoped Γ cont C1 := by
+--   induction hp1
+--   case empty => apply empty
+--   case union ha hb iha ihb =>
+--     have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hs
+--     apply union
+--     apply! iha
+--     apply! ihb
+--   case singleton hp =>
+--     have hp2 := CaptureSet.subset_has_singleton hs (CaptureSet.projected_singleton_has_singleton hp)
+--     apply has_singleton hsc hp2
 
-theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
-  (hs : C1 ⊆ C2)
-  (hp1 : ProjectedSingletonsOnly C1)
-  (hp2 : ProjectedSingletonsOnly C2) : WellScoped Γ cont C1 := by
-  induction hp1
+theorem WellScoped.subset {C1 C2 : CaptureSet n k}
+  (hsc : WellScoped Γ cont C2)
+  (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
+  induction hs
   case empty => apply empty
-  case union ha hb iha ihb =>
-    have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hs
-    apply union
+  case rfl => assumption
+  case union_l ha hb iha ihb =>
+    apply! union (iha _) (ihb _)
+  case union_rl ha iha =>
+    cases hsc
+    apply! iha
+  case union_rr ha iha =>
+    cases hsc
     apply! iha
-    apply! ihb
-  case singleton hp =>
-    have hp2 := CaptureSet.subset_has_singleton hs (CaptureSet.projected_singleton_has_singleton hp)
-    apply has_singleton hsc hp2
 
-theorem WellScoped.subset {C1 C2 : CaptureSet n k}
-  (hsc : WellScoped Γ cont C2.canonicalize)
-  (hs : C1 ⊆ C2) : WellScoped Γ cont C1.canonicalize := by
-  have h := CaptureSet.Subset.canonicalize hs
-  apply subset' hsc h
-  repeat apply CaptureSet.canonicalize_is_projected_singletons_only
 
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
@@ -186,57 +140,204 @@ theorem WellScoped.scope
     constructor; easy
   case label_disj => apply! label_disj
 
-theorem WellScoped.subcapt
-  (hsc : WellScoped Γ cont C.canonicalize)
-  (hs : Γ ⊢ C' <:c C) :
-  WellScoped Γ cont C'.canonicalize :=
-  match hs with
-  | .trans ha hb => .subcapt (.subcapt hsc hb) ha
-  | .subset hs => .subset hsc hs
-  | .union ha hb => .union (.subcapt hsc ha) (.subcapt hsc hb)
-  | .var hb => .singleton hb hsc
-  | .cinstl hb1 => by
-    simp at hsc
-    cases hsc <;> (rename_i hb2; try cases Context.cbound_injective hb1 hb2)
-    assumption
-    cases hb2
-  | .cinstr hb => .csingleton hb hsc
-  | .cbound hb => .cbound hb hsc
-  | .proj h1 => by sorry
-  | .proj_sub hs => by
-    simp_all
+theorem WellScoped.subkind {C : CaptureSet n k}
+  (hsc : WellScoped Γ cont (C.proj K2))
+  (hs : K1.Subkind K2)
+  : WellScoped Γ cont (C.proj K1) := by
+  generalize h : C.proj K2 = D at hsc
+  cases hsc
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    simp
     constructor
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply union (ha.subkind hs) (hb.subkind hs)
+  case singleton =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+  case csingleton =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+  case cbound =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+  case ckind =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+  case proj_singleton hh hsc =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply proj_singleton hsc
+    cases hh
+    apply! HasSingleton.proj
+  case label =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+  case label_disj hb hd hp =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    subst_vars; simp_all
+    -- apply label_disj hb hd
+    cases hp
+    case here hp =>
+      apply! label_disj hb (hd.refine_by_subkind _) $ .here _
+    case there hp =>
+      apply! label_disj hb hd $ .there _
+
+-- theorem WellScoped.capture_kind (hk : CaptureKind Γ C K) : WellScoped Γ cont C := by
+--   induction hk
+--   case var => apply! singleton
+--   case cvar => apply! ckind
+--   case cbound => apply! cbound
+--   case cinstr => apply! csingleton
+--   case sub => assumption
+--   case empty => apply! empty
+--   case singleton_proj_kind
+
+theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : Γ ⊢ C :k K) : WellScoped Γ cont C := by
+  induction hk
+  case var hb hk ih =>
     cases hsc
-    assumption
-  | .proj_l => by constructor; assumption
-  | .proj_r hs => by
+    case proj_singleton hsc hs =>
+      cases hs
+      rename_i hs
+      cases hs
+      assumption
+    case label_disj hb1 hd hsp =>
+      cases hsp
+      case here hs =>
+        cases hs
+        cases Context.bound_lbound_absurd hb hb1
+      case there hsp => cases hsp
+  case cvar hb => apply! ckind
+  case cbound hb hk ih =>
+    cases hsc
+    case proj_singleton hsc hs =>
+      cases hs
+      rename_i hs
+      cases hs
+      assumption
+    case label_disj hsp =>
+      cases hsp
+      case here hs _ => cases hs
+      case there hsp => cases hsp
+  case cinstr hb hk ih =>
     cases hsc
-    assumption
-  | .proj_disj hd hk => by sorry
+    case proj_singleton hsc hs =>
+      cases hs
+      rename_i hs
+      cases hs
+      assumption
+    case label_disj hsp =>
+      cases hsp
+      case here hs _ => cases hs
+      case there hsp => cases hsp
+  case sub hsk hk ih =>
+    apply! ih $ hsc.subkind _
+  case empty => apply! empty
+  case singleton_proj_kind =>
+    cases hsc
+    case proj_singleton hsc hs =>
+      cases hs
+      rename_i hs
+      cases hs
+      apply! proj_singleton hsc $ .proj _
+    case label_disj hb hd hsp =>
+      cases hsp
+      case here hs =>
+        cases hs
+        apply! label_disj hb hd $ .here _
+      case there hsp =>
+        apply! label_disj
+  case singleton_proj hk ih =>
+    cases hsc
+    case proj_singleton hsc hs =>
+      cases hs
+      apply! proj_singleton hsc
+    case label_disj hb hd hsp =>
+      cases hsp
+      case here hs =>
+        cases hs
+        rename_i hs
+        have h := label_disj hb hd (.here hs) (cont:=cont)
+        have h1 := ih h
+        apply h1.proj
+      case there hsp => apply! label_disj
+  -- case singleton_proj_disj hk hd ih =>
+  --   cases hsc
+  --   case proj_singleton hsc hs =>
+  --     cases hs
+  --     apply! proj_singleton
+  --   case label_disj hb hd hsp =>
+  --     cases hsp
+  --     case here hs =>
+  case union ha hb iha ihb =>
+    simp at hsc
+    cases hsc
+    apply! union (iha _) (ihb _)
 
+theorem WellScoped.subcapt
+  (hsc : WellScoped Γ cont C)
+  (hs : Γ ⊢ C' <:c C) :
+  WellScoped Γ cont C' := by
+  induction hs
+  case trans ih1 ih2 => exact ih1 (ih2 hsc)
+  case subset hs => exact hsc.subset hs
+  case union ih1 ih2 => exact .union (ih1 hsc) (ih2 hsc)
+  case var hb => exact .singleton hb hsc
+  case cinstl hb1 =>
+    cases hsc
+    case csingleton hb =>
+      have h := Context.cbound_injective hb1 hb; injections; subst_vars
+      assumption
+    case cbound hb => cases Context.cbound_injective hb1 hb
+    case ckind hb => cases Context.cbound_injective hb1 hb
+    case label_disj hsp => cases hsp
+  case cinstr hb => exact .csingleton hb hsc
+  case cbound hb => exact .cbound hb hsc
+  case singleton_proj_sub hs =>
+    rename_i s K1 K2
+    have h : (CaptureSet.singleton (s.proj K2)) = (CaptureSet.singleton s).proj K2 := by simp
+    rw [h] at hsc
+    exact hsc.subkind hs
+  case singleton_proj_l => exact hsc.proj
+  case proj_r C D K hs hk ih =>
+    cases hk
+    case cvar => apply! ckind
+    case var hb hk =>
 
-theorem WellScoped.var_inv
-  (hsc : WellScoped Γ cont {x=x})
-  (hbx : Γ.Bound x (S^C)) :
-  WellScoped Γ cont C := by
-  cases hsc
-  case singleton =>
-    rename_i hbx'
-    have h := Context.bound_injective hbx hbx'
-    cases h
-    trivial
-  case label =>
-    exfalso
-    apply Context.bound_lbound_absurd <;> easy
+      sorry
+    case cbound => sorry
+    case cinstr => sorry
+    case sub => sorry
+    case empty => sorry
+    case singleton_proj_kind => sorry
+    case singleton_proj => sorry
+    -- case singleton_proj_disj => sorry
+    case union => sorry
+  case singleton_proj_disj hd hk => sorry
+-- termination_by?
 
-theorem WellScoped.label_inv
-  (hsc : WellScoped Γ cont {x=x})
-  (hbl : Γ.LBound x S) :
-  ∃ tail, cont.HasLabel x tail := by
-  cases hsc
-  case singleton =>
-    exfalso
-    apply Context.bound_lbound_absurd <;> easy
-  case label => aesop
+-- theorem WellScoped.subkind
+
+-- theorem WellScoped.var_inv
+--   (hsc : WellScoped Γ cont {x=x})
+--   (hbx : Γ.Bound x (S^C)) :
+--   WellScoped Γ cont C := by
+--   cases hsc
+--   case singleton =>
+--     rename_i hbx'
+--     have h := Context.bound_injective hbx hbx'
+--     cases h
+--     trivial
+--   case label =>
+--     exfalso
+--     apply Context.bound_lbound_absurd <;> easy
+
+-- theorem WellScoped.label_inv
+--   (hsc : WellScoped Γ cont {x=x})
+--   (hbl : Γ.LBound x S) :
+--   ∃ tail, cont.HasLabel x tail := by
+--   cases hsc
+--   case singleton =>
+--     exfalso
+--     apply Context.bound_lbound_absurd <;> easy
+--   case label => aesop
 
 end Capless

From 70db8c14ed7b102d942600173256bd9bc9df0f4d Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 3 Dec 2025 18:44:41 +0100
Subject: [PATCH 33/71] subcapt is going on

---
 Capless/CaptureSet.lean       |  98 +++++--
 Capless/Store.lean            |  33 +--
 Capless/WellScoped/Basic.lean | 495 ++++++++++++++++------------------
 3 files changed, 327 insertions(+), 299 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index bad434bf..4bdbab61 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -309,29 +309,81 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 -- ## Projections
 -- -/
 
-inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
-  | var : HasSingleton (.var n) (.var n)
-  | cvar : HasSingleton (.cvar k) (.cvar k)
-  | proj : HasSingleton s s' -> HasSingleton (.proj s K) s'
-
-inductive HasSingletonProj : Singleton n k -> Singleton n k -> Kind -> Prop where
-  | here : HasSingleton s s' -> HasSingletonProj (.proj s K) s' K
-  | there : HasSingletonProj s s' K -> HasSingletonProj (.proj s K') s' K
-
-theorem HasSingleton.is_not_proj (hh : HasSingleton s (.proj s' K)) : False := by
-  cases hh
-  case proj hh => apply hh.is_not_proj
-
-theorem HasSingleton.is_target (hs1 : HasSingleton s t) (hs2 : HasSingleton t u) : t = u := by
-  induction hs1
-  case var => cases hs2; rfl
-  case cvar => cases hs2; rfl
-  case proj ih => apply! ih
-
-theorem HasSingletonProj.erase (hs : HasSingletonProj s s' K) : HasSingleton s s' := by
-  induction hs
-  case here => apply! HasSingleton.proj
-  case there ih => apply! HasSingleton.proj
+-- `n` with projections widen `C'` to given `C`
+inductive WidenVar : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Prop where
+  | var : WidenVar n (.var n) C C
+  | proj : WidenVar n s C' C -> WidenVar n (s.proj K) C' (C.proj K)
+
+-- `n` with projections widen to given `C`, including a projection to `K`
+inductive WidenVarWith : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Kind -> Prop where
+  | here : WidenVar n s C' C -> WidenVarWith n (s.proj K) C' (C.proj K) K
+  | there : WidenVarWith n s C' C K -> WidenVarWith n (s.proj K') C' (C.proj K') K
+
+-- `k` with projections widen `C'` to given `C`
+inductive WidenCVar : Fin k -> Singleton k k -> CaptureSet k k -> CaptureSet k k -> Prop where
+  | var : WidenCVar k (.cvar k) C C
+  | proj : WidenCVar k s C' C -> WidenCVar k (s.proj K) C' (C.proj K)
+
+-- `k` with projections widen to given `C`, including a projection to `K`
+inductive WidenCVarWith : Fin k -> Singleton k k -> CaptureSet k k -> CaptureSet k k -> Kind -> Prop where
+  | here : WidenCVar k s C' C -> WidenCVarWith k (s.proj K) C' (C.proj K) K
+  | there : WidenCVarWith k s C' C K -> WidenCVarWith k (s.proj K') C' (C.proj K') K
+
+inductive Singleton.IsVar : Singleton n k -> Fin n -> Prop where
+  | var : IsVar (.var n) n
+  | proj : IsVar s n -> IsVar (s.proj K) n
+
+theorem Singleton.IsVar.proj_inv (hv : IsVar (s.proj K) n) : IsVar s n := by cases hv; assumption
+
+theorem WidenVar.is_var (hw : WidenVar n s C' C) : s.IsVar n := by
+  induction hw
+  case var => constructor
+  case proj ih => apply ih.proj
+
+inductive Singleton.IsVarWith : Singleton n k -> Fin n -> Kind -> Prop where
+  | here : IsVar s n -> IsVarWith (s.proj K) n K
+  | there : IsVarWith s n K -> IsVarWith (s.proj K') n K
+
+theorem WidenVarWith.is_var_with (hw : WidenVarWith k s C' C K) : s.IsVarWith k K := by
+  induction hw
+  case here hw => apply Singleton.IsVarWith.here hw.is_var
+  case there ih => apply ih.there
+
+inductive Singleton.IsCVar : Singleton n k -> Fin k -> Prop where
+  | var : IsCVar (.cvar n) n
+  | proj : IsCVar s n -> IsCVar (s.proj K) n
+
+theorem Singleton.IsCVar.proj_inv (hv : IsCVar (s.proj K) n) : IsCVar s n := by cases hv; assumption
+
+theorem WidenCVar.is_cvar (hw : WidenCVar n s C' C) : s.IsCVar n := by
+  induction hw
+  case var => constructor
+  case proj ih => apply ih.proj
+
+
+-- inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
+--   | var : HasSingleton (.var n) (.var n)
+--   | cvar : HasSingleton (.cvar k) (.cvar k)
+--   | proj : HasSingleton s s' -> HasSingleton (.proj s K) s'
+
+-- inductive HasSingletonProj : Singleton n k -> Singleton n k -> Kind -> Prop where
+--   | here : HasSingleton s s' -> HasSingletonProj (.proj s K) s' K
+--   | there : HasSingletonProj s s' K -> HasSingletonProj (.proj s K') s' K
+
+-- theorem HasSingleton.is_not_proj (hh : HasSingleton s (.proj s' K)) : False := by
+--   cases hh
+--   case proj hh => apply hh.is_not_proj
+
+-- theorem HasSingleton.is_target (hs1 : HasSingleton s t) (hs2 : HasSingleton t u) : t = u := by
+--   induction hs1
+--   case var => cases hs2; rfl
+--   case cvar => cases hs2; rfl
+--   case proj ih => apply! ih
+
+-- theorem HasSingletonProj.erase (hs : HasSingletonProj s s' K) : HasSingleton s s' := by
+--   induction hs
+--   case here => apply! HasSingleton.proj
+--   case there ih => apply! HasSingleton.proj
 
 -- inductive ProjectedSingleton: CaptureSet n k -> (CaptureSet n k) -> Prop where
 --   | var : ProjectedSingleton {x=x} {x=x}
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 95307293..fadc081f 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -101,7 +101,9 @@ inductive Cont.HasLabel : Cont n m k -> Fin n -> Cont n m k -> Prop where
   Cont.HasLabel cont l tail ->
   Cont.HasLabel (Cont.scope l' cont) l tail
 
-/-- Checks whether a capture set is well-scoped under a context and a continuation stack. A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`). This is an invariant to be maintained thoroughout evaluation. -/
+/-- Checks whether a capture set is well-scoped under a context and a continuation stack.
+ -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
+ -- This is an invariant to be maintained thoroughout evaluation. -/
 inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop where
 | empty :
   WellScoped Γ cont {}
@@ -111,31 +113,32 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont (.union C1 C2)
 | singleton :
   Context.Bound Γ x (S^C) ->
-  WellScoped Γ cont C ->
-  WellScoped Γ cont {x=x}
+  WidenVar x s C C1 ->
+  WellScoped Γ cont C1 ->
+  WellScoped Γ cont (.singleton s)
 | csingleton :
   Context.CBound Γ c (CBinding.inst C) ->
-  WellScoped Γ cont C ->
-  WellScoped Γ cont {c=c}
+  WidenCVar c s C C1 ->
+  WellScoped Γ cont C1 ->
+  WellScoped Γ cont (.singleton s)
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  WellScoped Γ cont C ->
-  WellScoped Γ cont {c=c}
+  WidenCVar c s C C1 ->
+  WellScoped Γ cont C1 ->
+  WellScoped Γ cont (.singleton s)
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
-  WellScoped Γ cont {c=c}
-| proj_singleton :
-  WellScoped Γ cont (.singleton s) ->
-  HasSingleton (.proj s' K) s ->
-  WellScoped Γ cont (.singleton $ .proj s' K)
+  s.IsCVar c ->
+  WellScoped Γ cont (.singleton s)
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
-  WellScoped Γ cont {x=x}
-| label_disj :
+  s.IsVar x ->
+  WellScoped Γ cont (.singleton s)
+| label_disj : -- label is within context but not reachable from stack
   Context.LBound Γ x c S ->
   Kind.Disjoint K (.classifier c) ->
-  HasSingletonProj s (.var x) K ->
+  s.IsVarWith x K ->
   WellScoped Γ cont (.singleton s)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 6f5a8a70..1bdc7672 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,63 +11,15 @@ This file contains basic properties of the well-scopedness relation.
 namespace Capless
 
 theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.proj K) := by
-  induction hsc generalizing K <;> try simp_all
+  induction hsc generalizing K <;> simp
   case empty => apply empty
   case union iha ihb => apply union iha ihb
-  case singleton hb ha ih =>
-    apply proj_singleton
-    apply singleton hb ha
-    apply HasSingleton.proj .var
-  case csingleton hb ha ih =>
-    apply proj_singleton
-    apply csingleton hb ha
-    apply HasSingleton.proj .cvar
-  case cbound hb ha ih =>
-    apply proj_singleton
-    apply cbound hb ha
-    apply HasSingleton.proj .cvar
-  case ckind hb =>
-    apply proj_singleton
-    apply ckind hb
-    apply HasSingleton.proj .cvar
-  case proj_singleton h1 hp ih =>
-    apply proj_singleton h1
-    apply! HasSingleton.proj
-  case label hb hs =>
-    apply proj_singleton
-    apply label hb hs
-    apply HasSingleton.proj .var
-  case label_disj hb hd hp  =>
-    apply label_disj hb hd
-    apply! HasSingletonProj.there
-
-theorem WellScoped.has_singleton
-  (hsc : WellScoped Γ cont (.singleton C2))
-  (hh : HasSingleton C C2) :
-  WellScoped Γ cont (.singleton C) := by
-  induction hh
-  case var => assumption
-  case cvar => assumption
-  case proj =>
-    apply proj_singleton
-    apply hsc
-    apply! HasSingleton.proj
-
-
--- theorem WellScoped.subset' (hsc : WellScoped Γ cont C2)
---   (hs : C1 ⊆ C2)
---   (hp1 : ProjectedSingletonsOnly C1)
---   (hp2 : ProjectedSingletonsOnly C2) : WellScoped Γ cont C1 := by
---   induction hp1
---   case empty => apply empty
---   case union ha hb iha ihb =>
---     have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hs
---     apply union
---     apply! iha
---     apply! ihb
---   case singleton hp =>
---     have hp2 := CaptureSet.subset_has_singleton hs (CaptureSet.projected_singleton_has_singleton hp)
---     apply has_singleton hsc hp2
+  case singleton hb hw hsc ih => apply singleton hb hw.proj ih
+  case csingleton hb hw hsc ih => apply csingleton hb hw.proj ih
+  case cbound hb hw hsc ih => apply cbound hb hw.proj ih
+  case ckind hb hw => apply ckind hb hw.proj
+  case label hb hl hw => apply label hb hl hw.proj
+  case label_disj hb hd hw => apply label_disj hb hd hw.there
 
 theorem WellScoped.subset {C1 C2 : CaptureSet n k}
   (hsc : WellScoped Γ cont C2)
@@ -84,7 +36,6 @@ theorem WellScoped.subset {C1 C2 : CaptureSet n k}
     cases hsc
     apply! iha
 
-
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
   WellScoped Γ (Cont.cons u cont) C := by
@@ -95,12 +46,10 @@ theorem WellScoped.cons
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case proj_singleton ha hp ih =>
-    apply proj_singleton <;> aesop
-  case label =>
-    apply label
-    easy
-    constructor; easy
+  case label hb hl hw =>
+    apply label hb
+    constructor; assumption
+    apply hw
   case label_disj hb hd =>
     apply! label_disj
 
@@ -110,16 +59,14 @@ theorem WellScoped.conse
   induction hsc
   case empty => apply empty
   case union => apply union <;> aesop
-  case proj_singleton ha hp ih =>
-    apply proj_singleton <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case label =>
-    apply label
-    easy
-    constructor; easy
+  case label hb hl hw =>
+    apply label hb
+    constructor; assumption
+    apply hw
   case label_disj => apply! label_disj
 
 theorem WellScoped.scope
@@ -128,216 +75,242 @@ theorem WellScoped.scope
   induction hsc
   case empty => apply empty
   case union => apply union <;> aesop
-  case proj_singleton ha hp ih =>
-    apply proj_singleton <;> aesop
   case singleton ih => apply singleton <;> aesop
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case label =>
-    apply label
-    easy
-    constructor; easy
+  case label hb hl hw =>
+    apply label hb
+    constructor; assumption
+    apply hw
   case label_disj => apply! label_disj
 
-theorem WellScoped.subkind {C : CaptureSet n k}
-  (hsc : WellScoped Γ cont (C.proj K2))
+theorem WellScoped.subkind' {C D : CaptureSet n k}
+  (hsc : WellScoped Γ cont D)
+  (heq : D = C.proj K2)
   (hs : K1.Subkind K2)
   : WellScoped Γ cont (C.proj K1) := by
-  generalize h : C.proj K2 = D at hsc
-  cases hsc
-  case empty =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    simp
-    constructor
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply union (ha.subkind hs) (hb.subkind hs)
-  case singleton =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-  case csingleton =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-  case cbound =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-  case ckind =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-  case proj_singleton hh hsc =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply proj_singleton hsc
-    cases hh
-    apply! HasSingleton.proj
-  case label =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-  case label_disj hb hd hp =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    subst_vars; simp_all
-    -- apply label_disj hb hd
-    cases hp
-    case here hp =>
-      apply! label_disj hb (hd.refine_by_subkind _) $ .here _
-    case there hp =>
-      apply! label_disj hb hd $ .there _
+  induction hsc <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq; simp)
+  { apply empty }
+  { have ⟨_, _⟩ := heq; subst_vars; simp_all
+    rename_i ih1 _ ih2
+    apply union (ih1 _) (ih2 _) <;> rfl }
+  { subst_vars
+    rename_i hw
+    cases hw
+    rename_i hb _ _ _ hw hsc ih
+    apply singleton hb (.proj hw) (ih _)
+    rfl }
+  { subst_vars
+    rename_i hw
+    cases hw
+    rename_i hb _ _ _ hw hsc ih
+    apply csingleton hb (.proj hw) (ih _)
+    rfl }
+  { subst_vars
+    rename_i hw
+    cases hw
+    rename_i hb _ _ _ hw hsc ih
+    apply cbound hb (.proj hw) (ih _)
+    rfl }
+  { subst_vars
+    rename_i hw
+    apply! ckind _ hw.proj_inv.proj
+  }
+  { subst_vars
+    rename_i hw
+    apply! label _ _ hw.proj_inv.proj
+  }
+  { subst_vars
+    rename_i hw
+    cases hw
+    case here hw => apply! label_disj _ (hw.refine_by_subkind _) (.here _)
+    case there hw => apply! label_disj _ _ (.there _)
+  }
 
--- theorem WellScoped.capture_kind (hk : CaptureKind Γ C K) : WellScoped Γ cont C := by
---   induction hk
---   case var => apply! singleton
---   case cvar => apply! ckind
---   case cbound => apply! cbound
---   case cinstr => apply! csingleton
---   case sub => assumption
---   case empty => apply! empty
---   case singleton_proj_kind
+theorem WellScoped.subkind {C: CaptureSet n k} (hsc : WellScoped Γ cont (C.proj K2)) (hs : K1.Subkind K2) : WellScoped Γ cont (C.proj K1) := by
+  apply subkind' hsc _ hs
+  rfl
 
-theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : Γ ⊢ C :k K) : WellScoped Γ cont C := by
-  induction hk
-  case var hb hk ih =>
-    cases hsc
-    case proj_singleton hsc hs =>
-      cases hs
-      rename_i hs
-      cases hs
-      assumption
-    case label_disj hb1 hd hsp =>
-      cases hsp
-      case here hs =>
-        cases hs
-        cases Context.bound_lbound_absurd hb hb1
-      case there hsp => cases hsp
-  case cvar hb => apply! ckind
-  case cbound hb hk ih =>
-    cases hsc
-    case proj_singleton hsc hs =>
-      cases hs
-      rename_i hs
-      cases hs
-      assumption
-    case label_disj hsp =>
-      cases hsp
-      case here hs _ => cases hs
-      case there hsp => cases hsp
-  case cinstr hb hk ih =>
-    cases hsc
-    case proj_singleton hsc hs =>
-      cases hs
-      rename_i hs
-      cases hs
-      assumption
-    case label_disj hsp =>
-      cases hsp
-      case here hs _ => cases hs
-      case there hsp => cases hsp
-  case sub hsk hk ih =>
-    apply! ih $ hsc.subkind _
-  case empty => apply! empty
-  case singleton_proj_kind =>
-    cases hsc
-    case proj_singleton hsc hs =>
-      cases hs
-      rename_i hs
-      cases hs
-      apply! proj_singleton hsc $ .proj _
-    case label_disj hb hd hsp =>
-      cases hsp
-      case here hs =>
-        cases hs
-        apply! label_disj hb hd $ .here _
-      case there hsp =>
-        apply! label_disj
-  case singleton_proj hk ih =>
-    cases hsc
-    case proj_singleton hsc hs =>
-      cases hs
-      apply! proj_singleton hsc
-    case label_disj hb hd hsp =>
-      cases hsp
-      case here hs =>
-        cases hs
-        rename_i hs
-        have h := label_disj hb hd (.here hs) (cont:=cont)
-        have h1 := ih h
-        apply h1.proj
-      case there hsp => apply! label_disj
-  -- case singleton_proj_disj hk hd ih =>
-  --   cases hsc
-  --   case proj_singleton hsc hs =>
-  --     cases hs
-  --     apply! proj_singleton
-  --   case label_disj hb hd hsp =>
-  --     cases hsp
-  --     case here hs =>
+theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
+  induction hsub
+  case trans ha hb iha ihb => apply! iha $ ihb _
+  case subset hsub => apply! hsc.subset
   case union ha hb iha ihb =>
-    simp at hsc
-    cases hsc
     apply! union (iha _) (ihb _)
-
-theorem WellScoped.subcapt
-  (hsc : WellScoped Γ cont C)
-  (hs : Γ ⊢ C' <:c C) :
-  WellScoped Γ cont C' := by
-  induction hs
-  case trans ih1 ih2 => exact ih1 (ih2 hsc)
-  case subset hs => exact hsc.subset hs
-  case union ih1 ih2 => exact .union (ih1 hsc) (ih2 hsc)
-  case var hb => exact .singleton hb hsc
-  case cinstl hb1 =>
+  case var hb => apply! singleton _ .var
+  case cinstl hb =>
     cases hsc
-    case csingleton hb =>
-      have h := Context.cbound_injective hb1 hb; injections; subst_vars
+    case singleton hv => cases hv
+    case csingleton hb1 _ _ _ hv =>
+      cases hv
+      cases Context.cbound_injective hb1 hb
       assumption
-    case cbound hb => cases Context.cbound_injective hb1 hb
-    case ckind hb => cases Context.cbound_injective hb1 hb
-    case label_disj hsp => cases hsp
-  case cinstr hb => exact .csingleton hb hsc
-  case cbound hb => exact .cbound hb hsc
-  case singleton_proj_sub hs =>
-    rename_i s K1 K2
-    have h : (CaptureSet.singleton (s.proj K2)) = (CaptureSet.singleton s).proj K2 := by simp
-    rw [h] at hsc
-    exact hsc.subkind hs
-  case singleton_proj_l => exact hsc.proj
-  case proj_r C D K hs hk ih =>
-    cases hk
-    case cvar => apply! ckind
-    case var hb hk =>
+    case cbound hb1 _ _ _ hv =>
+      cases hv
+      cases Context.cbound_injective hb1 hb
+    case ckind hb1 hv =>
+      cases hv
+      cases Context.cbound_injective hb1 hb
+    case label hv => cases hv
+    case label_disj hv => cases hv
+  case cinstr hb =>
+    apply csingleton hb _ _
+
+
+
+
+
+
+
+-- theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : Γ ⊢ C :k K) : WellScoped Γ cont C := by
+--   induction hk
+--   case var hb hk ih =>
+--     cases hsc
+--     case proj_singleton hsc hs =>
+--       cases hs
+--       rename_i hs
+--       cases hs
+--       assumption
+--     case label_disj hb1 hd hsp =>
+--       cases hsp
+--       case here hs =>
+--         cases hs
+--         cases Context.bound_lbound_absurd hb hb1
+--       case there hsp => cases hsp
+--   case cvar hb => apply! ckind
+--   case cbound hb hk ih =>
+--     cases hsc
+--     case proj_singleton hsc hs =>
+--       cases hs
+--       rename_i hs
+--       cases hs
+--       assumption
+--     case label_disj hsp =>
+--       cases hsp
+--       case here hs _ => cases hs
+--       case there hsp => cases hsp
+--   case cinstr hb hk ih =>
+--     cases hsc
+--     case proj_singleton hsc hs =>
+--       cases hs
+--       rename_i hs
+--       cases hs
+--       assumption
+--     case label_disj hsp =>
+--       cases hsp
+--       case here hs _ => cases hs
+--       case there hsp => cases hsp
+--   case sub hsk hk ih =>
+--     apply! ih $ hsc.subkind _
+--   case empty => apply! empty
+--   case singleton_proj_kind =>
+--     cases hsc
+--     case proj_singleton hsc hs =>
+--       cases hs
+--       rename_i hs
+--       cases hs
+--       apply! proj_singleton hsc $ .proj _
+--     case label_disj hb hd hsp =>
+--       cases hsp
+--       case here hs =>
+--         cases hs
+--         apply! label_disj hb hd $ .here _
+--       case there hsp =>
+--         apply! label_disj
+--   case singleton_proj hk ih =>
+--     cases hsc
+--     case proj_singleton hsc hs =>
+--       cases hs
+--       apply! proj_singleton hsc
+--     case label_disj hb hd hsp =>
+--       cases hsp
+--       case here hs =>
+--         cases hs
+--         rename_i hs
+--         have h := label_disj hb hd (.here hs) (cont:=cont)
+--         have h1 := ih h
+--         apply h1.proj
+--       case there hsp => apply! label_disj
+--   -- case singleton_proj_disj hk hd ih =>
+--   --   cases hsc
+--   --   case proj_singleton hsc hs =>
+--   --     cases hs
+--   --     apply! proj_singleton
+--   --   case label_disj hb hd hsp =>
+--   --     cases hsp
+--   --     case here hs =>
+--   case union ha hb iha ihb =>
+--     simp at hsc
+--     cases hsc
+--     apply! union (iha _) (ihb _)
+
+-- theorem WellScoped.subcapt
+--   (hsc : WellScoped Γ cont C)
+--   (hs : Γ ⊢ C' <:c C) :
+--   WellScoped Γ cont C' := by
+--   induction hs
+--   case trans ih1 ih2 => exact ih1 (ih2 hsc)
+--   case subset hs => exact hsc.subset hs
+--   case union ih1 ih2 => exact .union (ih1 hsc) (ih2 hsc)
+--   case var hb => exact .singleton hb hsc
+--   case cinstl hb1 =>
+--     cases hsc
+--     case csingleton hb =>
+--       have h := Context.cbound_injective hb1 hb; injections; subst_vars
+--       assumption
+--     case cbound hb => cases Context.cbound_injective hb1 hb
+--     case ckind hb => cases Context.cbound_injective hb1 hb
+--     case label_disj hsp => cases hsp
+--   case cinstr hb => exact .csingleton hb hsc
+--   case cbound hb => exact .cbound hb hsc
+--   case singleton_proj_sub hs =>
+--     rename_i s K1 K2
+--     have h : (CaptureSet.singleton (s.proj K2)) = (CaptureSet.singleton s).proj K2 := by simp
+--     rw [h] at hsc
+--     exact hsc.subkind hs
+--   case singleton_proj_l => exact hsc.proj
+--   case proj_r C D K hs hk ih =>
+--     cases hk
+--     case cvar => apply! ckind
+--     case var hb hk =>
 
-      sorry
-    case cbound => sorry
-    case cinstr => sorry
-    case sub => sorry
-    case empty => sorry
-    case singleton_proj_kind => sorry
-    case singleton_proj => sorry
-    -- case singleton_proj_disj => sorry
-    case union => sorry
-  case singleton_proj_disj hd hk => sorry
--- termination_by?
+--       sorry
+--     case cbound => sorry
+--     case cinstr => sorry
+--     case sub => sorry
+--     case empty => sorry
+--     case singleton_proj_kind => sorry
+--     case singleton_proj => sorry
+--     -- case singleton_proj_disj => sorry
+--     case union => sorry
+--   case singleton_proj_disj hd hk => sorry
+-- -- termination_by?
 
--- theorem WellScoped.subkind
+-- -- theorem WellScoped.subkind
 
--- theorem WellScoped.var_inv
---   (hsc : WellScoped Γ cont {x=x})
---   (hbx : Γ.Bound x (S^C)) :
---   WellScoped Γ cont C := by
---   cases hsc
---   case singleton =>
---     rename_i hbx'
---     have h := Context.bound_injective hbx hbx'
---     cases h
---     trivial
---   case label =>
---     exfalso
---     apply Context.bound_lbound_absurd <;> easy
+-- -- theorem WellScoped.var_inv
+-- --   (hsc : WellScoped Γ cont {x=x})
+-- --   (hbx : Γ.Bound x (S^C)) :
+-- --   WellScoped Γ cont C := by
+-- --   cases hsc
+-- --   case singleton =>
+-- --     rename_i hbx'
+-- --     have h := Context.bound_injective hbx hbx'
+-- --     cases h
+-- --     trivial
+-- --   case label =>
+-- --     exfalso
+-- --     apply Context.bound_lbound_absurd <;> easy
 
--- theorem WellScoped.label_inv
---   (hsc : WellScoped Γ cont {x=x})
---   (hbl : Γ.LBound x S) :
---   ∃ tail, cont.HasLabel x tail := by
---   cases hsc
---   case singleton =>
---     exfalso
---     apply Context.bound_lbound_absurd <;> easy
---   case label => aesop
+-- -- theorem WellScoped.label_inv
+-- --   (hsc : WellScoped Γ cont {x=x})
+-- --   (hbl : Γ.LBound x S) :
+-- --   ∃ tail, cont.HasLabel x tail := by
+-- --   cases hsc
+-- --   case singleton =>
+-- --     exfalso
+-- --     apply Context.bound_lbound_absurd <;> easy
+-- --   case label => aesop
 
 end Capless

From 0bc1cf536c52287686f731c76da8dbf425a8d9a5 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 4 Dec 2025 19:55:32 +0100
Subject: [PATCH 34/71] Need to find more structure to continue proving. Maybe
 drop proj_r and add proj back?

---
 Capless/CaptureSet.lean         |  39 ++-
 Capless/Classifier.lean         |  95 +++++++
 Capless/Store.lean              |   4 +
 Capless/Subcapturing.lean       |   4 +-
 Capless/Subcapturing/Basic.lean | 423 +++++++++++++++++++++++++++++++-
 Capless/WellScoped/Basic.lean   | 136 +++++++++-
 6 files changed, 676 insertions(+), 25 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 4bdbab61..3c5c260f 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -311,7 +311,7 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 
 -- `n` with projections widen `C'` to given `C`
 inductive WidenVar : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Prop where
-  | var : WidenVar n (.var n) C C
+  | var : WidenVar x (.var x) C C
   | proj : WidenVar n s C' C -> WidenVar n (s.proj K) C' (C.proj K)
 
 -- `n` with projections widen to given `C`, including a projection to `K`
@@ -320,18 +320,18 @@ inductive WidenVarWith : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet
   | there : WidenVarWith n s C' C K -> WidenVarWith n (s.proj K') C' (C.proj K') K
 
 -- `k` with projections widen `C'` to given `C`
-inductive WidenCVar : Fin k -> Singleton k k -> CaptureSet k k -> CaptureSet k k -> Prop where
-  | var : WidenCVar k (.cvar k) C C
-  | proj : WidenCVar k s C' C -> WidenCVar k (s.proj K) C' (C.proj K)
+inductive WidenCVar : Fin k -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Prop where
+  | var : WidenCVar c (.cvar c) C C
+  | proj : WidenCVar c s C' C -> WidenCVar c (s.proj K) C' (C.proj K)
 
 -- `k` with projections widen to given `C`, including a projection to `K`
-inductive WidenCVarWith : Fin k -> Singleton k k -> CaptureSet k k -> CaptureSet k k -> Kind -> Prop where
-  | here : WidenCVar k s C' C -> WidenCVarWith k (s.proj K) C' (C.proj K) K
-  | there : WidenCVarWith k s C' C K -> WidenCVarWith k (s.proj K') C' (C.proj K') K
+inductive WidenCVarWith : Fin k -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Kind -> Prop where
+  | here : WidenCVar c s C' C -> WidenCVarWith c (s.proj K) C' (C.proj K) K
+  | there : WidenCVarWith c s C' C K -> WidenCVarWith c (s.proj K') C' (C.proj K') K
 
 inductive Singleton.IsVar : Singleton n k -> Fin n -> Prop where
-  | var : IsVar (.var n) n
-  | proj : IsVar s n -> IsVar (s.proj K) n
+  | var : IsVar (.var x) x
+  | proj : IsVar s x -> IsVar (s.proj K) x
 
 theorem Singleton.IsVar.proj_inv (hv : IsVar (s.proj K) n) : IsVar s n := by cases hv; assumption
 
@@ -349,6 +349,10 @@ theorem WidenVarWith.is_var_with (hw : WidenVarWith k s C' C K) : s.IsVarWith k
   case here hw => apply Singleton.IsVarWith.here hw.is_var
   case there ih => apply ih.there
 
+inductive Singleton.IsAbsurdVar : Singleton n k -> Fin n -> Prop where
+  | here : K1.Disjoint K2 -> s.IsVarWith x K1 -> IsAbsurdVar (.proj s K2) x
+  | there : IsAbsurdVar s x -> IsAbsurdVar (s.proj K) x
+
 inductive Singleton.IsCVar : Singleton n k -> Fin k -> Prop where
   | var : IsCVar (.cvar n) n
   | proj : IsCVar s n -> IsCVar (s.proj K) n
@@ -360,6 +364,23 @@ theorem WidenCVar.is_cvar (hw : WidenCVar n s C' C) : s.IsCVar n := by
   case var => constructor
   case proj ih => apply ih.proj
 
+theorem CaptureSet.proj_singleton : (singleton s).proj K = (singleton $ s.proj K) := by simp
+
+theorem CaptureSet.proj_inj {C D : CaptureSet n k} (heq : C.proj K = D.proj K) : C = D := by
+  induction C generalizing D
+  case empty =>
+    simp at heq
+    unfold proj at heq; split at heq <;> simp at heq
+    rfl
+  case union ha hb =>
+    simp at heq
+    cases D <;> simp at heq
+    have ⟨_, _⟩ := heq
+    rw [ha _, hb _]
+    repeat assumption
+  case singleton =>
+    cases D <;> simp at heq
+    aesop
 
 -- inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
 --   | var : HasSingleton (.var n) (.var n)
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 06a26c4e..49033a96 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -85,6 +85,16 @@ theorem Classifier.StrictSub.antisymm (hs : StrictSub a b) (hs2 : Subclass b a)
   have h2 := hs2.size
   omega
 
+theorem Classifier.StrictSub.subclass_r (hss : StrictSub a b) (hs : Subclass b c) : StrictSub a c := by
+  induction hss
+  case child n a =>
+    induction hs generalizing n
+    case rfl => apply child
+    case parent_l m k ih =>
+      apply parent_l ih
+  case parent_l n a ih =>
+    apply! parent_l $ ih _
+
 theorem Classifier.Disjoint.symm (hd : Disjoint a b) : Disjoint b a := by
   induction hd
   case base hne =>
@@ -466,3 +476,88 @@ theorem Kind.Disjoint.refine_by_subkind
       cases hs.root_is_subclass
       case inl => apply! absurd_l
       case inr => apply! root $ hd2.refines_subclass_l _
+
+theorem Kind.Subkind.trans (ha : Subkind K1 K2) (hb : Subkind K2 K3) : Subkind K1 K3 := by
+  induction hb generalizing K1
+  case absurd_l hsc =>
+    apply absurd_l $ ha.absurd_r hsc
+  case subclass_no_excl hs =>
+    cases ha.root_is_subclass
+    case inl hsc => apply! absurd_l
+    case inr hsub => apply! subclass_no_excl $ hsub.trans _
+  case excl_subclass hk hss hsc ih =>
+    cases K1 with
+    | singleton r1 es1 =>
+      cases ha.refine_has_superclass hsc
+      case inl hsc2 => apply! absurd_l
+      case inr h =>
+        cases h
+        case inl hd => apply! excl_disjoint (ih _) _ hd.symm
+        case inr hsc2 => apply! excl_subclass (ih _) _ hsc2
+  case excl_disjoint hk hss hd ih =>
+    cases K1 with
+    | singleton r1 es1 =>
+      cases ha.root_is_subclass
+      case inl hsc => apply! absurd_l
+      case inr hsub => apply! excl_disjoint (ih _) _ $ hd.refines_subclass_r _
+  case excl_irrelevant hk hd ih =>
+    apply! excl_irrelevant (ih _) _
+
+theorem Kind.subkind_disjoint_absurd (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : HasSuperclassOf K1.1 K1.2 := by
+  induction ha
+  case absurd_l hsc => exact hsc
+  case subclass_no_excl hsub =>
+    cases hb
+    case absurd_l hsc => exact hsc
+    case absurd_r hsc => cases hsc
+    case root_l hsc => cases hsc
+    case root_r hsc => exact hsc.subclass hsub
+    case root hd => exact absurd hsub hd.not_subclass
+  case excl_subclass hs hss hsc ih =>
+    cases hb
+    case absurd_l hsc2 => exact hsc2
+    case absurd_r hsc2 =>
+      cases hsc2
+      case here hsub => exact (hss.antisymm hsub).elim
+      case there hsc2 => exact ih (.absurd_r hsc2)
+    case root_l hsc2 =>
+      cases hsc2
+      case here hsub => exact hsc.subclass hsub
+      case there hsc2 => exact ih (.root_l hsc2)
+    case root_r hsc2 => exact ih (.root_r hsc2)
+    case root hd => exact ih (.root hd)
+  case excl_disjoint hs hss hd ih =>
+    cases hb
+    case absurd_l hsc => exact hsc
+    case absurd_r hsc =>
+      cases hsc
+      case here hsub => exact (hss.antisymm hsub).elim
+      case there hsc => exact ih (.absurd_r hsc)
+    case root_l hsc =>
+      cases hsc
+      case here hsub => exact absurd hsub hd.symm.not_subclass
+      case there hsc => exact ih (.root_l hsc)
+    case root_r hsc => exact ih (.root_r hsc)
+    case root hd2 => exact ih (.root hd2)
+  case excl_irrelevant hs hd ih =>
+    cases hb
+    case absurd_l hsc => exact hsc
+    case absurd_r hsc =>
+      cases hsc
+      case here hsub => exact absurd hsub hd.symm.not_subclass
+      case there hsc => exact ih (.absurd_r hsc)
+    case root_l hsc =>
+      cases hsc
+      case here hsub =>
+        cases hs.root_is_subclass
+        case inl hsc2 => exact hsc2
+        case inr hsub2 => exact absurd hsub2 (hd.refines_subclass_l hsub).not_subclass
+      case there hsc => exact ih (.root_l hsc)
+    case root_r hsc => exact ih (.root_r hsc)
+    case root hd2 => exact ih (.root hd2)
+
+theorem Kind.Subkind.absurd_disjoint (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : Subkind K1 K3 := by
+  cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
+
+theorem Kind.Disjoint.absurd_subkind (hb : Disjoint K1 K2) (ha : Subkind K1 K2) : Disjoint K1 K3 := by
+  cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
diff --git a/Capless/Store.lean b/Capless/Store.lean
index fadc081f..697e97b9 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -140,6 +140,10 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   Kind.Disjoint K (.classifier c) ->
   s.IsVarWith x K ->
   WellScoped Γ cont (.singleton s)
+| label_absurd : -- label is projected to absurdity
+  Context.LBound Γ x c S ->
+  s.IsAbsurdVar x ->
+  WellScoped Γ cont (.singleton s)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
 inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 16cb676a..4b2f5c97 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -13,7 +13,7 @@ namespace Capless
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  -- | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
+  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
   | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
   | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
@@ -21,7 +21,7 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | empty : CaptureKind Γ .empty K
   | singleton_proj_kind : CaptureKind Γ (.singleton $ .proj s K) K
   | singleton_proj : CaptureKind Γ (.singleton s) K -> CaptureKind Γ (.singleton $ s.proj K1) K
-  -- | singleton_proj_disj : CaptureKind Γ (.singleton s) K1 -> K1.Disjoint K2 -> CaptureKind Γ (.singleton $ s.proj K2) K
+  | singleton_proj_disj : CaptureKind Γ (.singleton s) K1 -> K1.Disjoint K2 -> CaptureKind Γ (.singleton $ s.proj K2) K
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index c581ad9c..0f199dd2 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -124,15 +124,434 @@ theorem Subcapt.proj_disj
     apply! union (ha _) (hb _)
   case singleton => apply! singleton_proj_disj
 
--- theorem CaptureKind.proj_disj  (hk : CaptureKind Γ C K1) (hd : Kind.Disjoint K1 K2) : CaptureKind Γ (C.proj K2) K3 := by
+inductive Instantiated : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
+  | rfl : Instantiated Γ C C
+  | trans : Instantiated Γ C1 C2 -> Instantiated Γ C2 C3 -> Instantiated Γ C1 C3
+  | csubst : Γ.CBound c (.inst C) -> Instantiated Γ {c=c} C
+  | union : Instantiated Γ C1 D1 -> Instantiated Γ C2 D2 -> Instantiated Γ (C1 ∪ C2) (D1 ∪ D2)
+
+theorem Instantiated.empty (hi : Instantiated Γ .empty C) : C = .empty := by
+  generalize h : CaptureSet.empty = D at hi
+  induction hi <;> (subst_vars; simp_all)
+
+theorem Instantiated.union_inv (hi : Instantiated Γ (C1 ∪ C2) D) : ∃ D1 D2, D = D1 ∪ D2 ∧ Instantiated Γ C1 D1 ∧ Instantiated Γ C2 D2 := by
+  generalize h : (C1 ∪ C2) = C at hi
+  induction hi generalizing C1 C2 <;> (subst_vars; simp_all)
+  case rfl => apply And.intro <;> apply rfl
+  case trans ha hb =>
+    have ⟨D1, D2, hb1, hb2, hb3⟩ := hb
+    subst_vars
+    rename_i ih
+    have ⟨E1, E2, ha1, ha2, ha3⟩ := ih $ .refl _
+    exists E1, E2
+    apply And.intro; assumption
+    apply And.intro <;> apply! trans
+
+theorem Instantiated.singleton_var_eq (hi : Instantiated Γ {x=x} C1) : C1 = {x=x} := by
+  generalize heq : ({x=x} : CaptureSet _ _) = D at hi
+  induction hi
+  case rfl => simp_all
+  case trans ih1 ih2 =>
+    subst heq
+    rw [ih1 (.refl _)] at ih2
+    exact ih2 (.refl _)
+  case csubst => simp [CaptureSet.singleton, Singleton.var, Singleton.cvar] at heq
+  case union => simp [CaptureSet.singleton] at heq
+
+theorem Instantiated.singleton_proj_eq (hi : Instantiated Γ (.singleton (.proj s K)) C1) : C1 = .singleton (.proj s K) := by
+  generalize heq : (CaptureSet.singleton (.proj s K)) = D at hi
+  induction hi
+  case rfl => simp_all
+  case trans ih1 ih2 =>
+    subst heq
+    rw [ih1 (.refl _)] at ih2
+    exact ih2 (.refl _)
+  case csubst => simp [CaptureSet.singleton, Singleton.proj, Singleton.cvar] at heq
+  case union => simp [CaptureSet.singleton] at heq
+
+theorem Instantiated.singleton_var_inv (hi : Instantiated Γ {x=x} C1) : {x=x} ⊆ C1 := by
+  rw [hi.singleton_var_eq]; apply CaptureSet.Subset.rfl
+
+theorem Instantiated.subset_has_var (hi : Instantiated Γ C C1) (hc : {x=x} ⊆ C1) (hs1 : C ⊆ D) : ∃ D1, Instantiated Γ D D1 ∧ {x=x} ⊆ D1 := by
+  induction hs1 generalizing C1
+  case empty => cases hi.empty; cases hc
+  case rfl => exists C1
+  case union_l ha hb =>
+    have ⟨D1, D2, _, hl, hr⟩ := hi.union_inv
+    subst_vars; simp_all
+    cases hc
+    case union_rl hc =>
+      have ⟨E1, _, _⟩ := ha hl hc
+      exists E1
+    case union_rr hc =>
+      have ⟨E1, _, _⟩ := hb hr hc
+      exists E1
+  case union_rl R1 R2 _ ha =>
+    have ⟨D1, hi, hs⟩ := ha hi hc
+    exists (D1 ∪ R2)
+    apply And.intro; apply! union _ .rfl ; apply! CaptureSet.Subset.union_rl
+  case union_rr R1 R2 _ ha =>
+    have ⟨D1, hi, hs⟩ := ha hi hc
+    exists (R2 ∪ D1)
+    apply And.intro; apply! union .rfl ; apply! CaptureSet.Subset.union_rr
+
+theorem Subcapt.var_inv'
+  (hs : Subcapt Γ C1 D)
+  (hsub : Instantiated Γ C1 C2 ∧ {x=x} ⊆ C2)
+  (hb : Γ.Bound x S^C) : (∃ D1, Instantiated Γ D D1 ∧ {x=x} ⊆ D1) ∨ (Subcapt Γ C D) := by
+  induction hs
+  case trans h1 h2 ih1 ih2 =>
+    cases ih1 hsub hb
+    case inl ih1 =>
+      have ⟨D1, ha1⟩ := ih1
+      apply! ih2
+    case inr ih1 => right; apply! trans
+  case subset hs =>
+    have ⟨hi, hsx⟩ := hsub
+    left
+    apply! hi.subset_has_var
+  case union iha ihb =>
+    have ⟨hi, hsx⟩ := hsub
+    have ⟨D1, D2, _, hl, hr⟩ := hi.union_inv
+    subst_vars
+    cases hsx
+    case union_rl hsx => apply iha (And.intro hl hsx) hb
+    case union_rr hsx => apply ihb (And.intro hr hsx) hb
+  case var hb1 =>
+    have ⟨hi, hsx⟩ := hsub
+    -- hi : Instantiated Γ {x'=x'} C2, hsx : {x=x} ⊆ C2
+    -- From singleton_var_eq: C2 = {x'=x'}
+    rw [hi.singleton_var_eq] at hsx
+    -- hsx : {x=x} ⊆ {x'=x'}, so x = x'
+    cases hsx
+    case rfl =>
+      -- x = x', so hb and hb1 are about the same variable
+      cases Context.bound_injective hb hb1
+      -- C = C' (the capture sets are equal)
+      right
+      apply Subcapt.rfl
+  case cinstl hcb =>
+    -- C1 = C' for some capture set, D = {c=c}
+    -- We need to show {x=x} is in D's instantiation or Subcapt Γ C D
+    have ⟨hi, hsx⟩ := hsub
+    left
+    -- D = {c=c}, and we have hcb : CBound c (inst C')
+    -- Instantiated Γ {c=c} C' via csubst, then Instantiated Γ C' C2 via hi
+    -- So Instantiated Γ {c=c} C2 via trans
+    exists C2
+    constructor
+    · exact .trans (.csubst hcb) hi
+    · exact hsx
+  case cinstr hcb =>
+    -- C1 = {c=c}, D = C' (the instantiated capture set)
+    have ⟨hi, hsx⟩ := hsub
+    left
+    -- hi : Instantiated Γ {c=c} C2, hsx : {x=x} ⊆ C2
+    -- D = C', we need Instantiated Γ C' D1 and {x=x} ⊆ D1
+    -- We can use C2 as D1 if we can show Instantiated Γ C' C2
+    -- But hi goes from {c=c} to C2, not from C' to C2
+    -- However, {c=c} instantiates to C' via csubst, so hi factors through C'
+    -- Let's just use rfl on C' and show {x=x} ⊆ C' via hi
+    sorry
+  case cbound hcb =>
+    -- C1 = {c=c}, D = C' (the upper bound)
+    have ⟨hi, hsx⟩ := hsub
+    -- Similar issue - we need to relate hi to instantiation of D
+    sorry
+  case singleton_proj_sub hsk =>
+    have ⟨hi, hsx⟩ := hsub
+    -- C1 = singleton (s.proj K1), D = singleton (s.proj K2)
+    -- hi : Instantiated Γ (singleton (s.proj K1)) C2
+    -- By singleton_proj_eq, C2 = singleton (s.proj K1)
+    rw [hi.singleton_proj_eq] at hsx
+    -- Now hsx : {x=x} ⊆ singleton (s.proj K1)
+    -- {x=x} = singleton (var x), singleton (s.proj K1) = singleton (proj s K1)
+    -- These can only be equal via rfl if var x = proj s K1, which is impossible
+    -- Lean can figure this out automatically with cases
+    cases hsx
+  case singleton_proj_l =>
+    have ⟨hi, hsx⟩ := hsub
+    -- C1 = singleton (s.proj K), D = singleton s
+    rw [hi.singleton_proj_eq] at hsx
+    cases hsx
+  case proj_r hs hk ih =>
+    have ⟨hi, hsx⟩ := hsub
+    cases ih hsub hb
+    case inl h =>
+      left
+      have ⟨D1, hd1, hd2⟩ := h
+      sorry
+    case inr h =>
+      right
+      apply Subcapt.trans h
+      apply Subcapt.proj_r .rfl
+      sorry -- Need CaptureKind Γ D K, but we only have CaptureKind Γ C K
+  case singleton_proj_disj hd hk =>
+    have ⟨hi, hsx⟩ := hsub
+    -- C1 = singleton (s.proj K2), D = .empty
+    -- By singleton_proj_eq, C2 = singleton (s.proj K2)
+    rw [hi.singleton_proj_eq] at hsx
+    -- hsx : {x=x} ⊆ singleton (s.proj K2) is impossible
+    cases hsx
+
+
+
+
+
+theorem CaptureKind.var_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by
+  induction hk <;> (subst_vars; try simp_all)
+  case var hb1 hk ih =>
+    cases Context.bound_injective hb hb1
+    assumption
+  case label hb1 => cases Context.bound_lbound_absurd hb hb1
+  case sub hsk hk ih => apply! sub
+
+theorem CaptureKind.var_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by apply! hk.var_inv' (.refl _)
+
+-- theorem CaptureKind.proj_inv' (hk : CaptureKind Γ D K) (heq : D = C.proj K1) : K1.Subkind K ∨ (∃ K2, K1.Disjoint K2 ∧ CaptureKind Γ C K2) ∨ CaptureKind Γ C K := by
+--   induction hk generalizing C K1
+--   case var hb hk ih =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--   case label hb ih =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--   case cvar =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--   case cbound =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--   case cinstr =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--   case sub hsk hk ih =>
+--     cases ih heq
+--     case inl hsk1 => left; apply hsk1.trans hsk
+--     case inr h =>
+--       cases h
+--       case inl hd =>
+--         obtain ⟨K2, hd, hk2⟩ := hd
+--         -- K1.Disjoint K2 and CaptureKind Γ C K2, we have hsk : K' -> K
+--         -- We need to show K1.Subkind K or disjoint or CaptureKind C K
+--         -- Use singleton_proj_disj + sub to get CaptureKind (C.proj K1) K
+--         right; left; exists K2;
+--       case inr hk2 => right; right; apply sub hsk hk2
+--   case empty =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--     right; right; apply empty
+--   case singleton_proj_kind =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--     have ⟨_, _⟩ := heq; subst_vars;
+--     left; apply Kind.Subkind.rfl
+--   case singleton_proj hk ih =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--     have ⟨_, _⟩ := heq; subst_vars;
+--     right; right; assumption
+--   case singleton_proj_disj hk hd ih =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--     have ⟨_, _⟩ := heq; subst_vars;
+--     -- hk : CaptureKind Γ (.singleton s) K1', hd : K1'.Disjoint K1
+--     -- Need K1.Disjoint K2 and CaptureKind Γ (.singleton s) K2, use K1' as K2
+--     right; left; exact ⟨_, hd.symm, hk⟩
+--   case union ha hb iha ihb =>
+--     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+--     have ⟨_, _⟩ := heq; subst_vars;
+--     cases iha $ .refl _
+--     case inl hsub => left; assumption
+--     case inr h1 =>
+--       cases ihb $ .refl _
+--       case inl hsub => left; assumption
+--       case inr h2 =>
+--         cases h1
+--         case inl hd1 =>
+--           cases h2
+--           case inl hd2 =>
+--             right; left
+--             obtain ⟨K2a, hda, hka⟩ := hd1
+--             obtain ⟨K2b, hdb, hkb⟩ := hd2
+--             -- Use absurd_disjoint: K1 disjoint K2a means K1 subkind anything
+
+--           case inr hk2 =>
+--             right; left
+--             obtain ⟨K2, hd, hk1⟩ := hd1
+--             exact ⟨K2, hd, union hk1 (hd.absurd_subkind hk2)⟩
+--         case inr hk1 =>
+--           cases h2
+--           case inl hd2 =>
+--             right; left
+--             obtain ⟨K2, hd, hk2⟩ := hd2
+--             exact ⟨K2, hd, union (hd.absurd_subkind hk1) hk2⟩
+--           case inr hk2 => right; right; apply! union
+
+-- theorem CaptureKind.proj_inv (hk : CaptureKind Γ (C.proj K1) K) : K1.Subkind K ∨ (∃ K2, K1.Disjoint K2 ∧ CaptureKind Γ C K2) ∨ CaptureKind Γ C K := by
+--   apply hk.proj_inv' $ .refl _
+
+-- theorem CaptureKind.proj_disj (hk : CaptureKind Γ C K1) (hd : K1.Disjoint K2) : CaptureKind Γ (C.proj K2) K3 := by
 --   induction C
 --   case empty => simp; apply empty
---   case union ha hb iha ihb =>
+--   case union iha ihb =>
 --     simp
 --     have ⟨_, _⟩ := hk.union_l_inv
 --     apply! union (iha _) (ihb _)
 --   case singleton => apply! singleton_proj_disj
 
+-- theorem CaptureKind.widen_var
+--   (hk : CaptureKind Γ (.singleton s) K)
+--   (hb : Γ.Bound x S^C)
+--   (hw : WidenVar x s C C') : CaptureKind Γ C' K := by
+--   induction hw generalizing K
+--   case var => apply! hk.var_inv
+--   case proj hw ih =>
+--     rw [← CaptureSet.proj_singleton] at hk
+--     cases hk.proj_inv
+--     case inl hsk => apply sub hsk; apply proj_kind
+--     case inr hs =>
+--       cases hs
+--       case inl hd =>
+--         obtain ⟨K2, hd, hk2⟩ := hd
+--         -- hd : K'.Disjoint K2, hk2 : CaptureKind Γ (.singleton s) K2
+--         -- ih gives us CaptureKind Γ C K2, then proj_disj gives us CaptureKind Γ (C.proj K') K
+--         exact proj_disj (ih hk2 hb) hd.symm
+--       case inr hk' => apply proj; apply! ih
+
+-- theorem CaptureKind.cbound_inv' (hk : CaptureKind Γ D K) (heq : D = {c=c}) (hb : Γ.CBound c (.bound (.upper C))) : CaptureKind Γ C K := by
+--   induction hk <;> (subst_vars; try simp_all)
+--   case cvar hb1 => cases Context.cbound_injective hb hb1
+--   case cbound hb1 _ _ =>
+--     cases Context.cbound_injective hb hb1
+--     assumption
+--   case cinstr hb1 _ _ => cases Context.cbound_injective hb hb1
+--   case sub hsk _ ih => apply! sub
+
+-- theorem CaptureKind.cbound_inv (hk : CaptureKind Γ {c=c} K) (hb : Γ.CBound c (.bound (.upper C))) : CaptureKind Γ C K := by apply! hk.cbound_inv' (.refl _)
+
+-- theorem CaptureKind.cinstr_inv' (hk : CaptureKind Γ D K) (heq : D = {c=c}) (hb : Γ.CBound c (.inst C)) : CaptureKind Γ C K := by
+--   induction hk <;> (subst_vars; try simp_all)
+--   case cvar hb1 => cases Context.cbound_injective hb hb1
+--   case cbound hb1 _ _ => cases Context.cbound_injective hb hb1
+--   case cinstr hb1 _ _ =>
+--     cases Context.cbound_injective hb hb1
+--     assumption
+--   case sub hsk _ ih => apply! sub
+
+-- theorem CaptureKind.cinstr_inv (hk : CaptureKind Γ {c=c} K) (hb : Γ.CBound c (.inst C)) : CaptureKind Γ C K := by apply! hk.cinstr_inv' (.refl _)
+
+-- theorem CaptureKind.widen_cbound
+--   (hk : CaptureKind Γ (.singleton s) K)
+--   (hb : Γ.CBound c (.bound (.upper C)))
+--   (hw : WidenCVar c s C C') : CaptureKind Γ C' K := by
+--   induction hw generalizing K
+--   case var => apply! hk.cbound_inv
+--   case proj hw ih =>
+--     rw [← CaptureSet.proj_singleton] at hk
+--     cases hk.proj_inv
+--     case inl hsk => apply sub hsk; apply proj_kind
+--     case inr hs =>
+--       cases hs
+--       case inl hd =>
+--         obtain ⟨K2, hd, hk2⟩ := hd
+--         exact proj_disj (ih hk2 hb) hd.symm
+--       case inr hk' => apply proj; apply! ih
+
+-- theorem CaptureKind.widen_cinstr
+--   (hk : CaptureKind Γ (.singleton s) K)
+--   (hb : Γ.CBound c (.inst C))
+--   (hw : WidenCVar c s C C') : CaptureKind Γ C' K := by
+--   induction hw generalizing K
+--   case var => apply! hk.cinstr_inv
+--   case proj hw ih =>
+--     rw [← CaptureSet.proj_singleton] at hk
+--     cases hk.proj_inv
+--     case inl hsk => apply sub hsk; apply proj_kind
+--     case inr hs =>
+--       cases hs
+--       case inl hd =>
+--         obtain ⟨K2, hd, hk2⟩ := hd
+--         exact proj_disj (ih hk2 hb) hd.symm
+--       case inr hk' => apply proj; apply! ih
+
+-- theorem CaptureKind.lbound_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.LBound x c S) : Kind.Subkind (.classifier c) K := by
+--   induction hk <;> (subst_vars; try simp_all)
+--   case var hb1 _ _ => cases Context.bound_lbound_absurd hb1 hb
+--   case label hb1 =>
+--     have ⟨heq, _⟩ := Context.lbound_inj hb hb1
+--     subst_vars
+--     apply Kind.Subkind.rfl
+--   case sub hsk _ ih => apply ih.trans hsk
+
+-- theorem CaptureKind.lbound_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.LBound x c S) : Kind.Subkind (.classifier c) K := by apply! hk.lbound_inv' (.refl _)
+
+-- inductive IsAbsurdLabel : Context n m k -> Singleton n k -> Fin n -> Prop where
+--   | with_c : Γ.LBound x c S -> K.Disjoint (.classifier c) -> s.IsVarWith x K -> IsAbsurdLabel Γ s x
+--   | with_self : Γ.LBound x c S -> K1.Disjoint K2 -> s.IsVarWith x K1 -> IsAbsurdLabel Γ (.proj s K2) x
+--   | proj : IsAbsurdLabel Γ s x -> IsAbsurdLabel Γ (s.proj K) x
+
+-- theorem CaptureKind.widen_lbound (hk : CaptureKind Γ (.singleton s) K) (hb : Γ.LBound x c S) (hi : s.IsVar x) : (Kind.classifier c).Subkind K ∨ IsAbsurdLabel Γ s x ∨ ∃ K1, K1.Subkind K ∧ s.IsVarWith x K1 := by
+--   induction hi generalizing K
+--   case var =>
+--     left
+--     exact hk.lbound_inv hb
+--   case proj s K' hi ih =>
+--     rw [← CaptureSet.proj_singleton] at hk
+--     cases hk.proj_inv
+--     case inl hsk =>
+--       right
+--       exact ⟨K', hsk, .here hi⟩
+--     case inr hs =>
+--       cases hs
+--       case inl hd =>
+--         -- K'.Disjoint K2 and CaptureKind Γ (.singleton s) K2
+--         -- This is an absurd projection case - K' projects something of disjoint kind K2
+--         obtain ⟨K2, hd, hk2⟩ := hd
+--         -- hk2 : CaptureKind Γ (.singleton s) K2, hd : K'.Disjoint K2
+--         -- Since singleton_proj_disj gives any kind K, we know the original hk : CaptureKind Γ ((singleton s).proj K') K
+--         -- was constructed with an arbitrary K. We return right with K' as the witness.
+--         -- K'.Subkind K follows from the fact that the disjoint projection has any kind.
+--         -- We can use singleton_proj_disj hk2 hd.symm to reconstruct a CaptureKind with our target kind,
+--         -- and then show K'.Subkind K via proj_kind + sub.
+--         -- Actually, we can just show K' is the projection that witnesses IsVarWith
+--         right
+--         -- We need K'.Subkind K. Since hk came from singleton_proj_disj, the overall kind K is arbitrary.
+--         -- But we don't have direct access to that. Let's use proj_kind which gives CaptureKind for K' kind.
+--         -- From hk : CaptureKind Γ ((singleton s).proj K') K, by cases on construction...
+--         -- Actually the simplest: use singleton_proj_disj + sub to derive K'.Subkind K is not directly available.
+--         -- Let's try: we know the result has kind K and there's a projection to K', so K'.Subkind K.
+--         -- Wait - we're in the case where proj_inv returned the disjoint case, not the subkind case.
+--         -- So we DON'T have K'.Subkind K directly from proj_inv.
+--         -- But we can construct it: from singleton_proj_disj we get CaptureKind for any kind,
+--         -- and from singleton_proj_kind we get CaptureKind Γ (singleton (s.proj K')) K'.
+--         -- Combining with sub we'd need K'.Subkind K which is what we want to prove...
+--         -- This is circular. Let me try a different approach: return that K' is absurd.
+--         -- If K' is disjoint from K2 and K2 has a real classifier, then K' must be absurd.
+--         -- Actually no, that's not right either.
+--         -- Let me just return K'.Subkind K using Kind.Subkind.rfl won't work since K' ≠ K in general.
+--         -- The real answer: in the absurd disjoint case, the projection has ANY kind including K.
+--         -- So we should be able to show K' ≤ K. But how?
+--         -- From hk we know the proj has kind K. proj_kind says proj has kind K'.
+--         -- So by transitivity if we had proj_kind + sub (K' to K), we'd have the proof.
+--         -- But we need that sub evidence... which comes from the fact that hk has kind K.
+--         -- This is exactly what we'd get if proj_inv returned K'.Subkind K in the first case!
+--         -- The issue is proj_inv returns the disjoint case separately.
+--         -- Let me use a workaround: we can show K' is subkind of K using the actual hk.
+--         -- hk : CaptureKind Γ ((singleton s).proj K') K
+--         -- singleton_proj_kind : CaptureKind Γ ((singleton s).proj K') K'
+--         -- If we had K' ≠ K with CaptureKind for both, that's fine - both can hold.
+--         -- But we need to PROVE K'.Subkind K...
+--         -- Actually, let's use CaptureKind.sub backwards: if we have CaptureKind C K' and CaptureKind C K,
+--         -- and the only way to go from K' to K is via sub, then we'd need the subkind.
+--         -- But that's also not directly provable.
+--         --
+--         -- SOLUTION: The disjoint case in proj_inv should actually imply K'.Subkind K
+--         -- because the only way to get kind K from (singleton (s.proj K')) when the inner has
+--         -- disjoint kind K2 is via singleton_proj_disj which gives any K,
+--         -- but then sub can lift K' to K.
+--         -- The cleanest fix is to change proj_inv to include K'.Subkind K in the disjoint case.
+--         -- For now, let me use Kind.Subkind.rfl and see if K' = K in our context (it should be when proj_inv returns case 2)
+--         -- Actually no, we're stuck. Let me add a helper or change proj_inv's return type.
+--         sorry
+--       case inr hk' =>
+--         cases ih hk' hb with
+--         | inl hsub => left; exact hsub
+--         | inr h =>
+--           right
+--           obtain ⟨K1, hsk1, hvw⟩ := h
+--           exact ⟨K1, hsk1, .there hvw⟩
 
 
 
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 1bdc7672..ed637e23 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -1,5 +1,6 @@
 import Capless.Store
 import Capless.Subcapturing
+import Capless.Subcapturing.Basic
 import Capless.Inversion.Context
 
 /-!
@@ -20,6 +21,7 @@ theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.pro
   case ckind hb hw => apply ckind hb hw.proj
   case label hb hl hw => apply label hb hl hw.proj
   case label_disj hb hd hw => apply label_disj hb hd hw.there
+  case label_absurd hb ha => apply label_absurd hb ha.there
 
 theorem WellScoped.subset {C1 C2 : CaptureSet n k}
   (hsc : WellScoped Γ cont C2)
@@ -52,6 +54,7 @@ theorem WellScoped.cons
     apply hw
   case label_disj hb hd =>
     apply! label_disj
+  case label_absurd => apply! label_absurd
 
 theorem WellScoped.conse
   (hsc : WellScoped Γ cont C) :
@@ -68,6 +71,7 @@ theorem WellScoped.conse
     constructor; assumption
     apply hw
   case label_disj => apply! label_disj
+  case label_absurd => apply! label_absurd
 
 theorem WellScoped.scope
   (hsc : WellScoped Γ cont C) :
@@ -84,15 +88,16 @@ theorem WellScoped.scope
     constructor; assumption
     apply hw
   case label_disj => apply! label_disj
+  case label_absurd => apply! label_absurd
 
 theorem WellScoped.subkind' {C D : CaptureSet n k}
   (hsc : WellScoped Γ cont D)
   (heq : D = C.proj K2)
   (hs : K1.Subkind K2)
   : WellScoped Γ cont (C.proj K1) := by
-  induction hsc <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq; simp)
+  induction hsc generalizing C <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq; simp)
   { apply empty }
-  { have ⟨_, _⟩ := heq; subst_vars; simp_all
+  { have ⟨_, _⟩ := heq; subst_vars;
     rename_i ih1 _ ih2
     apply union (ih1 _) (ih2 _) <;> rfl }
   { subst_vars
@@ -115,23 +120,97 @@ theorem WellScoped.subkind' {C D : CaptureSet n k}
     rfl }
   { subst_vars
     rename_i hw
-    apply! ckind _ hw.proj_inv.proj
-  }
+    apply! ckind _ hw.proj_inv.proj }
   { subst_vars
     rename_i hw
-    apply! label _ _ hw.proj_inv.proj
-  }
+    apply! label _ _ hw.proj_inv.proj }
   { subst_vars
     rename_i hw
     cases hw
     case here hw => apply! label_disj _ (hw.refine_by_subkind _) (.here _)
-    case there hw => apply! label_disj _ _ (.there _)
-  }
+    case there hw => apply! label_disj _ _ (.there _) }
+  { subst_vars
+    rename_i hb _ _ hw
+    cases hw
+    case here hd hw =>
+      apply label_absurd hb (.here _ hw)
+      apply! (hd.symm.refine_by_subkind _).symm
+    case there hw => apply! label_absurd hb (.there _) }
 
 theorem WellScoped.subkind {C: CaptureSet n k} (hsc : WellScoped Γ cont (C.proj K2)) (hs : K1.Subkind K2) : WellScoped Γ cont (C.proj K1) := by
   apply subkind' hsc _ hs
   rfl
 
+-- theorem WellScoped.capture_kind'
+--   (hsc : WellScoped Γ cont D)
+--   (heq : D = C.proj K)
+--   (hk : CaptureKind Γ C K)
+--   : WellScoped Γ cont C := by
+--   induction hsc generalizing C <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq)
+--   { apply empty }
+--   { have ⟨_, _⟩ := heq; subst_vars
+--     rename_i h1 ih1 h2 ih2
+--     have ⟨_, _⟩ := hk.union_l_inv
+--     -- apply union (ih1 _ hk) (ih2 _ hk)
+--     apply! union (ih1 (.refl _) _) (ih2 (.refl _) _) }
+--   { rename_i hb hw hsc ih _ _;
+--     subst_vars;
+--     cases hw;
+--     apply singleton hb
+--     assumption
+--     apply ih (.refl _)
+--     apply hk.widen_var hb
+--     assumption }
+--   { rename_i hb hw hsc ih _ _;
+--     subst_vars;
+--     cases hw;
+--     apply csingleton hb
+--     assumption
+--     apply ih (.refl _)
+--     apply hk.widen_cinstr hb
+--     assumption }
+--   { rename_i hb hw hsc ih _ _;
+--     subst_vars;
+--     cases hw;
+--     apply cbound hb
+--     assumption
+--     apply ih (.refl _)
+--     apply hk.widen_cbound hb
+--     assumption }
+--   { rename_i hb hi _ _
+--     cases hi <;> cases heq
+--     apply! ckind
+--   }
+--   { rename_i hb hl hi _ _
+--     cases hi <;> cases heq
+--     apply! label }
+--   { rename_i hb hd hi _ _
+--     cases hi <;> cases heq
+--     case here.refl hi =>
+--       cases hk.widen_lbound hb hi
+--       case inl hsub => cases Kind.subkind_disjoint_absurd hsub hd.symm
+--       case inr hi =>
+--         have ⟨K1, _, hi⟩ := hi
+--         apply label_disj hb _ hi
+--         apply! hd.refine_by_subkind
+--     case there.refl hi => apply! label_disj
+--   }
+
+-- theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : CaptureKind Γ C K) : WellScoped Γ cont C := by apply! hsc.capture_kind' $ .refl _
+
+theorem WellScoped.union_inv (hsc : WellScoped Γ cont (C1 ∪ C2)) : WellScoped Γ cont C1 ∧ WellScoped Γ cont C2 := by
+  cases hsc; aesop
+
+theorem WellScoped.singleton_inv (hsc : WellScoped Γ cont {x=x}) (hb : Γ.Bound x S^C) : WellScoped Γ cont C := by
+  cases hsc
+  case singleton hb1 hs hw => cases hw; cases Context.bound_injective hb hb1; assumption
+  case csingleton hw => cases hw
+  case cbound hw => cases hw
+  case ckind hw => cases hw
+  case label hb1 _ hw => cases hw; cases Context.bound_lbound_absurd hb hb1
+  case label_disj hb1 _ hw => cases hw
+  case label_absurd hb1 _ hw => cases hw
+
 theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
   induction hsub
   case trans ha hb iha ihb => apply! iha $ ihb _
@@ -142,11 +221,11 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
   case cinstl hb =>
     cases hsc
     case singleton hv => cases hv
-    case csingleton hb1 _ _ _ hv =>
+    case csingleton hb1 _ hv =>
       cases hv
       cases Context.cbound_injective hb1 hb
       assumption
-    case cbound hb1 _ _ _ hv =>
+    case cbound hb1 _ hv =>
       cases hv
       cases Context.cbound_injective hb1 hb
     case ckind hb1 hv =>
@@ -154,8 +233,41 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
       cases Context.cbound_injective hb1 hb
     case label hv => cases hv
     case label_disj hv => cases hv
-  case cinstr hb =>
-    apply csingleton hb _ _
+    case label_absurd hb ha => cases ha
+  case cinstr hb => apply! csingleton _ .var
+  case cbound hb => apply! cbound _ .var
+  case singleton_proj_sub hk =>
+    rw [← CaptureSet.proj_singleton] at hsc
+    apply! hsc.subkind
+  case singleton_proj_l => apply! hsc.proj
+  case proj_r C D K hsub hk ih =>
+    induction hk
+    case union ha hb iha ihb =>
+      have ⟨_, _⟩ := hsub.union_l_inv
+      apply union
+      { apply iha
+        assumption
+        intro cont h
+        have ⟨_, _⟩ := (ih h).union_inv
+        assumption
+        assumption }
+      { apply ihb
+        assumption
+        intro cont h
+        have ⟨_, _⟩ := (ih h).union_inv
+        assumption
+        assumption }
+    case var hb hk ih2 =>
+
+
+
+
+
+
+
+
+
+
 
 
 

From 077166cfd0c0b73c23956fa7f6011961b2410336 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 5 Dec 2025 15:39:39 +0100
Subject: [PATCH 35/71] Abandon ship

---
 Capless/CaptureSet.lean         |   8 ++
 Capless/Subcapturing.lean       |   5 +-
 Capless/Subcapturing/Basic.lean | 227 +++-----------------------------
 Capless/WellScoped/Basic.lean   |  29 ++--
 4 files changed, 39 insertions(+), 230 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 3c5c260f..788dea60 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -382,6 +382,14 @@ theorem CaptureSet.proj_inj {C D : CaptureSet n k} (heq : C.proj K = D.proj K) :
     cases D <;> simp at heq
     aesop
 
+theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K) := by
+  induction hsub <;> try simp
+  case empty => apply empty
+  case rfl => apply rfl
+  case union_l ha hb => apply! union_l
+  case union_rl ha => apply! union_rl
+  case union_rr hb => apply! union_rr
+
 -- inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
 --   | var : HasSingleton (.var n) (.var n)
 --   | cvar : HasSingleton (.cvar k) (.cvar k)
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 4b2f5c97..7559aab6 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -21,7 +21,6 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | empty : CaptureKind Γ .empty K
   | singleton_proj_kind : CaptureKind Γ (.singleton $ .proj s K) K
   | singleton_proj : CaptureKind Γ (.singleton s) K -> CaptureKind Γ (.singleton $ s.proj K1) K
-  | singleton_proj_disj : CaptureKind Γ (.singleton s) K1 -> K1.Disjoint K2 -> CaptureKind Γ (.singleton $ s.proj K2) K
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
@@ -48,12 +47,10 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c} C
--- | proj :
---   Subcapt Γ C1 C2 -> Subcapt Γ (C1.proj K) (C2.proj K)
 | singleton_proj_sub {s : Singleton n k} {K1 K2 : Kind}:
   K1.Subkind K2 -> Subcapt Γ (.singleton $ s.proj K1) (.singleton $ s.proj K2)
 | singleton_proj_l : Subcapt Γ (.singleton $ .proj s K) (.singleton s)
-| proj_r : Subcapt Γ C D -> CaptureKind Γ C K -> Subcapt Γ C (D.proj K)
+| singleton_proj : Subcapt Γ (.singleton s) C -> Subcapt Γ (.singleton $ s.proj K) (C.proj K)
 | singleton_proj_disj :
   Kind.Disjoint K1 K2 ->
   CaptureKind Γ (.singleton s) K1 ->
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 0f199dd2..ab20e762 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -42,11 +42,6 @@ theorem Subcapt.proj_l : Subcapt Γ (C.proj K) C := by
     simp
     apply! join
 
--- theorem CaptureKind.var (hb : Context.Bound Γ x (S^C)) (hk : CaptureKind Γ C K) : CaptureKind Γ {x=x} K := by
---   apply csub
---   apply Subcapt.var hb
---   assumption
-
 theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
   match hk with
   | .cvar _ => by cases heq
@@ -63,35 +58,31 @@ theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2)
 termination_by structural hk
 
 
--- mutual
-theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D :=
-  match hs with
-  | .trans ha hb => by
-    have ⟨_, _⟩ := ha.union_l_inv' heq
-    apply And.intro <;> apply! Subcapt.trans _
-  | .subset hsub => by
-    rw [heq] at hsub
-    have ⟨_, _⟩ := CaptureSet.Subset.union_l_inv hsub
-    apply And.intro <;> apply! Subcapt.subset
-  | .union ha hb => by
-    injections
-    subst_vars
-    apply And.intro ha hb
-  | .cinstl hb => by
-    subst_vars
+theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := by
+  induction hs <;> (subst_vars; simp_all)
+  case trans ha hb iha ihb =>
+    have ⟨_, _⟩ := ihb
+    apply And.intro <;> apply! trans
+  case subset hsub =>
+    have ⟨_, _⟩ := hsub.union_l_inv
+    apply And.intro <;> apply! subset
+  case cinstl Γ _ hb =>
     have h1 : Subcapt Γ C1 (C1 ∪ C2) := Subcapt.subset $ .union_rl .rfl
     have h2 : Subcapt Γ C2 (C1 ∪ C2) := Subcapt.subset $ .union_rr .rfl
-    apply And.intro <;> apply! Subcapt.trans _ (.cinstl hb)
-  | .proj_r hs hk => by
-    have ⟨_, _⟩ := hs.union_l_inv' heq
-    have ⟨_, _⟩ := hk.union_l_inv' heq
-    apply And.intro <;> apply! Subcapt.proj_r
-termination_by structural hs
--- end
+    apply And.intro <;> apply! trans _ (.cinstl hb)
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
 
+theorem Subcapt.proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by
+  induction C
+  case empty => simp; apply subset .empty
+  case union ha hb iha ihb =>
+    have ⟨_, _⟩ := hs.union_l_inv
+    simp
+    apply! union (iha _) (ihb _)
+  case singleton => apply! singleton_proj
+
 theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
   induction C
   case empty => apply empty
@@ -106,12 +97,6 @@ theorem CaptureKind.proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj K1)
     apply! union (ha _) (hb _)
   case singleton => apply! singleton_proj
 
-
-theorem Subcapt.proj (hs : Subcapt Γ C1 C2) : Subcapt Γ (C1.proj K) (C2.proj K) := by
-  apply proj_r
-  apply trans .proj_l hs
-  apply CaptureKind.proj_kind
-
 theorem Subcapt.proj_disj
   (hd : Kind.Disjoint K1 K2)
   (hk : CaptureKind Γ C K1)
@@ -124,180 +109,6 @@ theorem Subcapt.proj_disj
     apply! union (ha _) (hb _)
   case singleton => apply! singleton_proj_disj
 
-inductive Instantiated : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
-  | rfl : Instantiated Γ C C
-  | trans : Instantiated Γ C1 C2 -> Instantiated Γ C2 C3 -> Instantiated Γ C1 C3
-  | csubst : Γ.CBound c (.inst C) -> Instantiated Γ {c=c} C
-  | union : Instantiated Γ C1 D1 -> Instantiated Γ C2 D2 -> Instantiated Γ (C1 ∪ C2) (D1 ∪ D2)
-
-theorem Instantiated.empty (hi : Instantiated Γ .empty C) : C = .empty := by
-  generalize h : CaptureSet.empty = D at hi
-  induction hi <;> (subst_vars; simp_all)
-
-theorem Instantiated.union_inv (hi : Instantiated Γ (C1 ∪ C2) D) : ∃ D1 D2, D = D1 ∪ D2 ∧ Instantiated Γ C1 D1 ∧ Instantiated Γ C2 D2 := by
-  generalize h : (C1 ∪ C2) = C at hi
-  induction hi generalizing C1 C2 <;> (subst_vars; simp_all)
-  case rfl => apply And.intro <;> apply rfl
-  case trans ha hb =>
-    have ⟨D1, D2, hb1, hb2, hb3⟩ := hb
-    subst_vars
-    rename_i ih
-    have ⟨E1, E2, ha1, ha2, ha3⟩ := ih $ .refl _
-    exists E1, E2
-    apply And.intro; assumption
-    apply And.intro <;> apply! trans
-
-theorem Instantiated.singleton_var_eq (hi : Instantiated Γ {x=x} C1) : C1 = {x=x} := by
-  generalize heq : ({x=x} : CaptureSet _ _) = D at hi
-  induction hi
-  case rfl => simp_all
-  case trans ih1 ih2 =>
-    subst heq
-    rw [ih1 (.refl _)] at ih2
-    exact ih2 (.refl _)
-  case csubst => simp [CaptureSet.singleton, Singleton.var, Singleton.cvar] at heq
-  case union => simp [CaptureSet.singleton] at heq
-
-theorem Instantiated.singleton_proj_eq (hi : Instantiated Γ (.singleton (.proj s K)) C1) : C1 = .singleton (.proj s K) := by
-  generalize heq : (CaptureSet.singleton (.proj s K)) = D at hi
-  induction hi
-  case rfl => simp_all
-  case trans ih1 ih2 =>
-    subst heq
-    rw [ih1 (.refl _)] at ih2
-    exact ih2 (.refl _)
-  case csubst => simp [CaptureSet.singleton, Singleton.proj, Singleton.cvar] at heq
-  case union => simp [CaptureSet.singleton] at heq
-
-theorem Instantiated.singleton_var_inv (hi : Instantiated Γ {x=x} C1) : {x=x} ⊆ C1 := by
-  rw [hi.singleton_var_eq]; apply CaptureSet.Subset.rfl
-
-theorem Instantiated.subset_has_var (hi : Instantiated Γ C C1) (hc : {x=x} ⊆ C1) (hs1 : C ⊆ D) : ∃ D1, Instantiated Γ D D1 ∧ {x=x} ⊆ D1 := by
-  induction hs1 generalizing C1
-  case empty => cases hi.empty; cases hc
-  case rfl => exists C1
-  case union_l ha hb =>
-    have ⟨D1, D2, _, hl, hr⟩ := hi.union_inv
-    subst_vars; simp_all
-    cases hc
-    case union_rl hc =>
-      have ⟨E1, _, _⟩ := ha hl hc
-      exists E1
-    case union_rr hc =>
-      have ⟨E1, _, _⟩ := hb hr hc
-      exists E1
-  case union_rl R1 R2 _ ha =>
-    have ⟨D1, hi, hs⟩ := ha hi hc
-    exists (D1 ∪ R2)
-    apply And.intro; apply! union _ .rfl ; apply! CaptureSet.Subset.union_rl
-  case union_rr R1 R2 _ ha =>
-    have ⟨D1, hi, hs⟩ := ha hi hc
-    exists (R2 ∪ D1)
-    apply And.intro; apply! union .rfl ; apply! CaptureSet.Subset.union_rr
-
-theorem Subcapt.var_inv'
-  (hs : Subcapt Γ C1 D)
-  (hsub : Instantiated Γ C1 C2 ∧ {x=x} ⊆ C2)
-  (hb : Γ.Bound x S^C) : (∃ D1, Instantiated Γ D D1 ∧ {x=x} ⊆ D1) ∨ (Subcapt Γ C D) := by
-  induction hs
-  case trans h1 h2 ih1 ih2 =>
-    cases ih1 hsub hb
-    case inl ih1 =>
-      have ⟨D1, ha1⟩ := ih1
-      apply! ih2
-    case inr ih1 => right; apply! trans
-  case subset hs =>
-    have ⟨hi, hsx⟩ := hsub
-    left
-    apply! hi.subset_has_var
-  case union iha ihb =>
-    have ⟨hi, hsx⟩ := hsub
-    have ⟨D1, D2, _, hl, hr⟩ := hi.union_inv
-    subst_vars
-    cases hsx
-    case union_rl hsx => apply iha (And.intro hl hsx) hb
-    case union_rr hsx => apply ihb (And.intro hr hsx) hb
-  case var hb1 =>
-    have ⟨hi, hsx⟩ := hsub
-    -- hi : Instantiated Γ {x'=x'} C2, hsx : {x=x} ⊆ C2
-    -- From singleton_var_eq: C2 = {x'=x'}
-    rw [hi.singleton_var_eq] at hsx
-    -- hsx : {x=x} ⊆ {x'=x'}, so x = x'
-    cases hsx
-    case rfl =>
-      -- x = x', so hb and hb1 are about the same variable
-      cases Context.bound_injective hb hb1
-      -- C = C' (the capture sets are equal)
-      right
-      apply Subcapt.rfl
-  case cinstl hcb =>
-    -- C1 = C' for some capture set, D = {c=c}
-    -- We need to show {x=x} is in D's instantiation or Subcapt Γ C D
-    have ⟨hi, hsx⟩ := hsub
-    left
-    -- D = {c=c}, and we have hcb : CBound c (inst C')
-    -- Instantiated Γ {c=c} C' via csubst, then Instantiated Γ C' C2 via hi
-    -- So Instantiated Γ {c=c} C2 via trans
-    exists C2
-    constructor
-    · exact .trans (.csubst hcb) hi
-    · exact hsx
-  case cinstr hcb =>
-    -- C1 = {c=c}, D = C' (the instantiated capture set)
-    have ⟨hi, hsx⟩ := hsub
-    left
-    -- hi : Instantiated Γ {c=c} C2, hsx : {x=x} ⊆ C2
-    -- D = C', we need Instantiated Γ C' D1 and {x=x} ⊆ D1
-    -- We can use C2 as D1 if we can show Instantiated Γ C' C2
-    -- But hi goes from {c=c} to C2, not from C' to C2
-    -- However, {c=c} instantiates to C' via csubst, so hi factors through C'
-    -- Let's just use rfl on C' and show {x=x} ⊆ C' via hi
-    sorry
-  case cbound hcb =>
-    -- C1 = {c=c}, D = C' (the upper bound)
-    have ⟨hi, hsx⟩ := hsub
-    -- Similar issue - we need to relate hi to instantiation of D
-    sorry
-  case singleton_proj_sub hsk =>
-    have ⟨hi, hsx⟩ := hsub
-    -- C1 = singleton (s.proj K1), D = singleton (s.proj K2)
-    -- hi : Instantiated Γ (singleton (s.proj K1)) C2
-    -- By singleton_proj_eq, C2 = singleton (s.proj K1)
-    rw [hi.singleton_proj_eq] at hsx
-    -- Now hsx : {x=x} ⊆ singleton (s.proj K1)
-    -- {x=x} = singleton (var x), singleton (s.proj K1) = singleton (proj s K1)
-    -- These can only be equal via rfl if var x = proj s K1, which is impossible
-    -- Lean can figure this out automatically with cases
-    cases hsx
-  case singleton_proj_l =>
-    have ⟨hi, hsx⟩ := hsub
-    -- C1 = singleton (s.proj K), D = singleton s
-    rw [hi.singleton_proj_eq] at hsx
-    cases hsx
-  case proj_r hs hk ih =>
-    have ⟨hi, hsx⟩ := hsub
-    cases ih hsub hb
-    case inl h =>
-      left
-      have ⟨D1, hd1, hd2⟩ := h
-      sorry
-    case inr h =>
-      right
-      apply Subcapt.trans h
-      apply Subcapt.proj_r .rfl
-      sorry -- Need CaptureKind Γ D K, but we only have CaptureKind Γ C K
-  case singleton_proj_disj hd hk =>
-    have ⟨hi, hsx⟩ := hsub
-    -- C1 = singleton (s.proj K2), D = .empty
-    -- By singleton_proj_eq, C2 = singleton (s.proj K2)
-    rw [hi.singleton_proj_eq] at hsx
-    -- hsx : {x=x} ⊆ singleton (s.proj K2) is impossible
-    cases hsx
-
-
-
-
-
 theorem CaptureKind.var_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by
   induction hk <;> (subst_vars; try simp_all)
   case var hb1 hk ih =>
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index ed637e23..dfe588d4 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -240,24 +240,17 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
     rw [← CaptureSet.proj_singleton] at hsc
     apply! hsc.subkind
   case singleton_proj_l => apply! hsc.proj
-  case proj_r C D K hsub hk ih =>
-    induction hk
-    case union ha hb iha ihb =>
-      have ⟨_, _⟩ := hsub.union_l_inv
-      apply union
-      { apply iha
-        assumption
-        intro cont h
-        have ⟨_, _⟩ := (ih h).union_inv
-        assumption
-        assumption }
-      { apply ihb
-        assumption
-        intro cont h
-        have ⟨_, _⟩ := (ih h).union_inv
-        assumption
-        assumption }
-    case var hb hk ih2 =>
+  case singleton_proj C K hs ih =>
+    generalize h : C.proj K = D at hsc
+    cases hsc
+    case empty =>
+      unfold CaptureSet.proj at h; split at h <;> simp at h
+      rw [← CaptureSet.proj_singleton]; apply proj; apply ih .empty
+    case union iha ihb =>
+      unfold CaptureSet.proj at h; split at h <;> simp at h
+      have ⟨_, _⟩ := h; subst_vars; simp_all
+
+
 
 
 

From 2eee99e848b976431eb7f8e51a27516dba169c71 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 5 Dec 2025 18:59:02 +0100
Subject: [PATCH 36/71] :(

---
 Capless/Classifier.lean | 1238 +++++++++++++++++++++++++++------------
 1 file changed, 873 insertions(+), 365 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 49033a96..26eba345 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -182,382 +182,890 @@ theorem Classifier.subclass_or_disjoint a b:
       case inr ih =>
         right; right; apply Disjoint.left ih
 
+def Classifier.subclass (a : Classifier) (b : Classifier) :=
+  if a == b then true
+  else match a with
+    | .top => false
+    | .child n p => p.subclass b
+
+theorem Classifier.subclass_is_Subclass : Subclass a b ↔ a.subclass b := by
+  apply Iff.intro
+  . intro hs
+    induction hs
+    case rfl => unfold subclass; simp
+    case parent_l n p => unfold subclass; simp; right; assumption
+  . intro hs
+    unfold subclass at hs
+    split at hs
+    case isTrue h =>
+      have h1 := LawfulBEq.eq_of_beq h
+      subst_vars
+      constructor
+    case isFalse h =>
+      split at hs
+      . contradiction
+      . rename_i p
+        constructor
+        rw [subclass_is_Subclass (a:=p)]
+        assumption
+
+def Classifier.disjoint (a : Classifier) (b : Classifier) :=
+  match a with
+  | .top => false
+  | .child n p =>
+    match b with
+    | .top => false
+    | .child m q =>
+      if p == q then n != m
+      else disjoint (.child n p) q || disjoint p (.child m q)
+
+theorem Classifier.disjoint_is_Disjoint {a b : Classifier} : Disjoint a b ↔ a.disjoint b := by
+  apply Iff.intro
+  . intro hs
+    induction hs with
+    | base hne =>
+      unfold disjoint
+      simp [hne]
+    | @left a' b' n ha ih =>
+      unfold disjoint
+      match b' with
+      | .top => cases ha.not_subclass .of_top
+      | .child m q =>
+        simp only
+        split
+        . rename_i heq
+          have h1 := LawfulBEq.eq_of_beq heq
+          subst_vars
+          cases ha.symm.not_subclass $ .parent_l .rfl
+        . simp [ih]
+    | @right a' b' m ha ih =>
+      unfold disjoint
+      match a' with
+      | .top =>
+        have : ∀ c, ¬ Disjoint top c := fun c h => by
+          induction c with
+          | top => cases h
+          | child n p ih =>
+            cases h with
+            | right ha => exact ih ha
+        exact absurd ha (this _)
+      | .child n p =>
+        simp only
+        split
+        . rename_i heq
+          have heq' := LawfulBEq.eq_of_beq heq
+          subst heq'
+          cases ha.not_subclass $ .parent_l .rfl
+        . simp [ih]
+  . intro hs
+    unfold disjoint at hs
+    split at hs
+    . cases hs
+    . split at hs
+      . cases hs
+      . split at hs
+        . rename_i h
+          have h1 := LawfulBEq.eq_of_beq h
+          subst_vars
+          apply! Disjoint.base
+        . simp at hs
+          cases hs
+          case inl hs =>
+            apply Disjoint.right
+            rw [disjoint_is_Disjoint]
+            assumption
+          case inr hs =>
+            apply Disjoint.left
+            rw [disjoint_is_Disjoint]
+            assumption
+termination_by sizeOf a + sizeOf b
+
+-- **
+-- Kinds
+-- **
 
 inductive Kind : Type where
--- | empty : Kind
-| singleton : Classifier -> List Classifier -> Kind
--- | union : Kind -> Kind -> Kind
+  | empty : Kind
+  | node : Classifier -> List Classifier -> Kind -- .only[K].except[K1, ..., Kn]
+  | union : Kind -> Kind -> Kind
 
-@[simp]
-def Kind.classifier (c : Classifier) := singleton c []
+def Kind.sup (a: Kind) (b: Kind) : Kind := a.union b
 
-@[simp]
-def Kind.excl (k : Kind) c :=
-  match k with
-  | singleton r es => singleton r (c :: es)
+def Kind.inf (a: Kind) (b: Kind) : Kind :=
+  match a with
+  | .empty => b
+  | .union a1 a2 => union (a1.inf b) (a2.inf b)
+  | .node r1 ex1 =>
+    match b with
+    | .empty => .empty
+    | .union b1 b2 => union (inf (.node r1 ex1) b1) (inf (.node r1 ex1) b2)
+    | .node r2 ex2 =>
+      if r1.subclass r2 then .node r1 (ex1 ++ ex2)
+      else if r2.subclass r1 then .node r2 (ex1 ++ ex2)
+      else .empty
 
+inductive ContainsSupOf : List Classifier -> Classifier -> Prop where
+  | here : b.Subclass a -> ContainsSupOf (a :: xs) b
+  | there : ContainsSupOf xs b -> ContainsSupOf (a :: xs) b
 
-inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
-  | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
-  | there : HasSuperclassOf b xs -> HasSuperclassOf b (a :: xs)
+theorem ContainsSupOf.append_l (h : ContainsSupOf xs b) : ContainsSupOf (xs ++ ys) b := by
+  induction h with
+  | here hs => exact .here hs
+  | there _ ih => exact .there ih
 
-theorem HasSuperclassOf.subclass (hsc : HasSuperclassOf a es) (hs : Classifier.Subclass b a) : HasSuperclassOf b es := by
-  induction hsc
-  case here hsub => apply here  $ hs.trans hsub
-  case there ih => apply! there
+theorem ContainsSupOf.append_r (h : ContainsSupOf ys b) : ContainsSupOf (xs ++ ys) b := by
+  induction xs with
+  | nil => exact h
+  | cons _ _ ih => exact .there ih
 
-inductive Kind.Disjoint : Kind -> Kind -> Prop where
-  -- | empty_l : Disjoint .empty K
-  -- | empty_r : Disjoint K .empty
-  -- empty classifiers are disjoint with everything else
-  | absurd_l : HasSuperclassOf a es -> Disjoint (singleton a es) K2
-  | absurd_r : HasSuperclassOf a es -> Disjoint K1 (singleton a es)
-  -- Otherwise, the root has to be a subclass of the other's exclude list
-  | root_l : HasSuperclassOf r1 es2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
-  | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
-  | root : Classifier.Disjoint r1 r2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
-  -- union case
-  -- | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
-  -- | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+theorem ContainsSupOf.trans_subclass (h : ContainsSupOf xs a) (hs : b.Subclass a) : ContainsSupOf xs b := by
+  induction h with
+  | here hs' => exact .here (hs.trans hs')
+  | there _ ih => exact .there (ih hs)
+
+theorem ContainsSupOf.of_append (h : ContainsSupOf (xs ++ ys) b) : ContainsSupOf xs b ∨ ContainsSupOf ys b := by
+  induction xs with
+  | nil => exact .inr h
+  | cons a xs ih =>
+    cases h with
+    | here hs => exact .inl (.here hs)
+    | there h =>
+      cases ih h with
+      | inl h => exact .inl (.there h)
+      | inr h => exact .inr h
+
+inductive IsEmpty : Kind -> Prop where
+  | empty : IsEmpty .empty
+  | absurd : ContainsSupOf exs r -> IsEmpty (.node r exs)
+  | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
+
+inductive Intersect : Kind -> Kind -> Kind -> Prop where
+  | empty_l : Intersect .empty K .empty
+  | empty_r : Intersect K .empty .empty
+  | union_l : Intersect K1 K R1 -> Intersect K2 K R2 -> Intersect (K1.union K2) K (R1.union R2)
+  | union_r : Intersect K K1 R1 -> Intersect K K2 R2 -> Intersect K (K1.union K2) (R1.union R2)
+  | singleton_l : r1.Subclass r2 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r1 (ex1 ++ ex2))
+  | singleton_r : r2.Subclass r1 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r2 (ex1 ++ ex2))
+  | singleton_disj : r1.Disjoint r2 -> Intersect (.node r1 ex1) (.node r2 ex2) .empty
 
 inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | absurd_l : HasSuperclassOf a es ->
-    Subkind (singleton a es) K
-  -- | empty_l : Subkind .empty K
-  | subclass_no_excl :
-    r1.Subclass r2 ->
-    Subkind (singleton r1 es1) (singleton r2 [])
-  | excl_subclass :
-    Subkind (singleton r1 es1) (singleton r2 es2) ->
-    a.StrictSub r2 ->
-    HasSuperclassOf a es1 ->
-    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
-  | excl_disjoint :
-    Subkind (singleton r1 es1) (singleton r2 es2) ->
-    a.StrictSub r2 ->
+  | empty_l : Subkind .empty K
+  | union_l : Subkind K1 K -> Subkind K2 K -> Subkind (.union K1 K2) K
+  | absurd_l : ContainsSupOf ex1 r1 -> Subkind (.node r1 ex1) K
+  | excl_subclass_r :
+    a.StrictSub r2 -> -- not absurd
+    ContainsSupOf ex1 a ->
+    Subkind (.node r1 ex1) (.node r2 ex2) ->
+    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+  | excl_disjoint_r :
+    a.StrictSub r2 -> -- not absurd
     a.Disjoint r1 ->
-    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
-  | excl_irrelevant :
-    Subkind (singleton r1 es1) (singleton r2 es2) ->
+    Subkind (.node r1 ex1) (.node r2 ex2) ->
+    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+  | excl_irrelevant_r :
     a.Disjoint r2 ->
-    Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+    Subkind (.node r1 ex1) (.node r2 ex2) ->
+    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+  | subclass_r :
+    r1.Subclass r2 ->
+    Subkind (.node r1 ex1) (.node r2 [])
+  -- | union_r : Intersect K K1 R -> Subkind R K2 -> Subkind K (.union K1 K2) -- wrong. needs subtract
 
-theorem Kind.Subkind.singleton_weaken_l (hs : Subkind (.singleton a es) K) : Subkind (.singleton a (e :: es)) K := by
-  cases hs
-  case absurd_l => apply! absurd_l $ .there _
-  case subclass_no_excl hsub => apply! subclass_no_excl
-  case excl_subclass hss hsc hs => apply! hs.singleton_weaken_l.excl_subclass _ (.there _)
-  case excl_disjoint hss hd hs => apply! hs.singleton_weaken_l.excl_disjoint
-  case excl_irrelevant hd hs => apply! hs.singleton_weaken_l.excl_irrelevant
-
-
-theorem Kind.Subkind.rfl : Subkind K K := by
-  cases K
-  case singleton r es =>
-    induction es
-    case nil => apply subclass_no_excl .rfl
-    case cons h t ih =>
-      cases Classifier.subclass_or_disjoint r h
-      case inl hsub =>
-        apply! absurd_l $ .here _
-      case inr hsub =>
-        cases hsub
-        case inl hsub =>
-          cases hsub.might_strict
-          case inl he =>  subst_vars; apply! absurd_l $ .here _
-          case inr hsub => apply ih.singleton_weaken_l.excl_subclass hsub (.here .rfl)
-        case inr hd =>  apply ih.singleton_weaken_l.excl_irrelevant hd.symm
-
--- theorem Kind.Subkind.refines_is_empty
---   (hs : Subkind K1 K2)
---   (he : IsEmpty K2) : IsEmpty K1 := by
---   cases hs
---   rename_i he1 hsub
---   induction hsub <;> try cases he.singleton_must_excl
---   case absurd_l => apply! IsEmpty.absurd
---   case absurd_r => assumption
---   case empty_l => assumption
---   case empty_r => assumption
---   case excl_subclass_r hsub hsc hs ih =>
---     cases he
---     rename_i he
---     cases he
---     case here he => have h := hsub.antisymm he; contradiction
---     case there he => apply ih (.absurd he) he1
---   case excl_disjoint_r hsub hsc hs ih =>
---     cases he.singleton_cases
---     case inl he => have h := hsub.antisymm he; contradiction
---     case inr he => apply ih (.absurd he) he1
---   case excl_irrelevant_r hsub hs ih =>
---     cases he.singleton_cases
---     case inl he => have h := hsub.symm.not_subclass he; contradiction
---     case inr he => apply ih (.absurd he) he1
---   case residue hsc hs hsub ih =>
---     cases he.singleton_cases
---     case inl he => have h := hsc.antisymm he; contradiction
---     case inr he => cases he1; apply! ih (.absurd he)
---   case union_l hsa hsb iha ihb =>
---     cases he1
---     constructor
---     apply! iha
---     apply! ihb
---   case union_rl ha hb iha ihb =>
---     cases he
---     apply! iha _ (ihb _ he1)
---   case union_rr ha hb iha ihb =>
---     cases he
---     apply! iha _ (ihb _ he1)
-
--- theorem Kind.Disjoint.is_empty_r
---   (he : IsEmpty K)
---   : Disjoint K1 K := by
---   induction he
---   case empty => apply! empty_r
---   case absurd => apply! absurd_r
---   case union => apply! union_r
-
-theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
-  induction hd
-  -- case empty_l => apply! empty_r
-  -- case empty_r => apply! empty_l
-  case absurd_l => apply! absurd_r
-  case absurd_r => apply! absurd_l
-  case root_l => apply! root_r
-  case root_r => apply! root_l
-  case root h => apply! root h.symm
-  -- case union_l => apply! union_r
-  -- case union_r => apply! union_l
-
-theorem Kind.Subkind.absurd_r
-  (hs : Subkind (singleton r1 es1) (singleton r2 es2))
-  (hsc : HasSuperclassOf r2 es2)
-  : HasSuperclassOf r1 es1 := by
-  cases hs
-  case absurd_l => assumption
-  case subclass_no_excl => cases hsc
-  case excl_subclass hsc1 hss hs =>
-    cases hsc
-    case here hsub => cases hss.antisymm hsub
-    case there hsc => apply hs.absurd_r hsc
-  case excl_disjoint hd hss hs =>
-    cases hsc
-    case here hsub => cases hss.antisymm hsub
-    case there hsc => apply hs.absurd_r hsc
-  case excl_irrelevant hd hs =>
-    cases hsc
-    case here hsub => cases hd.symm.not_subclass hsub
-    case there hsc => apply hs.absurd_r hsc
-
-theorem Kind.Subkind.root_is_subclass (hs : Subkind (singleton r1 es1) (singleton r2 es2)) : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
-  cases hs
-  case absurd_l => left; assumption
-  case subclass_no_excl => right; assumption
-  case excl_subclass hsc hss hs =>
-    cases hs.root_is_subclass <;> aesop
-  case excl_disjoint hs =>
-    cases hs.root_is_subclass <;> aesop
-  case excl_irrelevant hs =>
-    cases hs.root_is_subclass <;> aesop
-
-theorem Kind.Subkind.refine_has_superclass
-  (hs : Subkind (singleton r1 es1) (singleton r2 es2))
-  (hsc : HasSuperclassOf a es2)
-  : HasSuperclassOf r1 es1 ∨ r1.Disjoint a ∨ HasSuperclassOf a es1 := by
-  cases hs
-  case absurd_l => aesop
-  case subclass_no_excl => cases hsc
-  case excl_subclass hsc hss hs =>
-    cases hsc
-    case here hsub => have h := hsc.subclass hsub; aesop
-    case there hsc => apply hs.refine_has_superclass hsc
-  case excl_disjoint hd hss hs =>
-    cases hsc
-    case here hsub => have h:= (hd.refines_subclass_l hsub).symm; aesop
-    case there hsc => apply hs.refine_has_superclass hsc
-  case excl_irrelevant hd hs =>
-    cases hsc
-    case here hsub =>
-      cases hs.root_is_subclass
-      case inl => aesop
-      case inr hsub2 => have h := ((hd.refines_subclass_l hsub).refines_subclass_r hsub2).symm; aesop
-    case there hsc => apply hs.refine_has_superclass hsc
-
-theorem Kind.Disjoint.refine_by_subkind
-  (hd : Disjoint K2 L)
-  (hs : Subkind K1 K2)
-  : Disjoint K1 L := by
-  induction hs generalizing L
-  case absurd_l => apply! absurd_l
-  case subclass_no_excl hsub =>
-    cases hd
-    case absurd_l hsc => cases hsc
-    case absurd_r hsc => apply! absurd_r
-    case root_l hsc => apply! root_l $ hsc.subclass _
-    case root_r hsc =>  cases hsc
-    case root hd => apply! root $ hd.refines_subclass_l _
-  case excl_subclass hs hss hsc ih =>
-    cases hd
-    case absurd_l hsc =>
-      cases hsc
-      case here hsub => cases hss.antisymm hsub
-      case there hsc => apply absurd_l $ hs.absurd_r hsc
-    case absurd_r => apply! absurd_r
-    case root_l hsc1 =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr hsub => apply! root_l $ hsc1.subclass _
-    case root_r hsc1 =>
-      cases hsc1
-      case here hsub => apply! root_r $ hsc.subclass _
-      case there hsc1 =>
-        cases hs.refine_has_superclass hsc1
-        case inl => apply! absurd_l
-        case inr h1 =>
-          cases h1
-          case inl h1 => apply! root
-          case inr h1 => apply! root_r
-    case root hd =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr h1 => apply! root $ hd.refines_subclass_l _
-  case excl_disjoint hs hss hd1 ih =>
-    cases hd
-    case absurd_l hsc =>
-      cases hsc
-      case here hsub => cases hss.antisymm hsub
-      case there hsc => apply absurd_l $ hs.absurd_r hsc
-    case absurd_r => apply! absurd_r
-    case root_l hsc1 =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr hsub => apply! root_l $ hsc1.subclass _
-    case root_r hsc1 =>
-      cases hsc1
-      case here hsub => apply! root $ hd1.symm.refines_subclass_r _
-      case there hsc1 =>
-        cases hs.refine_has_superclass hsc1
-        case inl => apply! absurd_l
-        case inr h1 =>
-          cases h1
-          case inl h1 => apply! root
-          case inr h1 => apply! root_r
-    case root hd2 =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr => apply! root $ hd2.refines_subclass_l _
-  case excl_irrelevant hs hd ih =>
+inductive Kind.Disjoint : Kind -> Kind -> Prop where
+  | empty_l: Disjoint .empty K
+  | empty_r : Disjoint K .empty
+  | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
+  | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+  | absurd_l : ContainsSupOf ex1 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+  | absurd_r : ContainsSupOf ex2 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+  | root : r1.Disjoint r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+  | excl_l : ContainsSupOf ex2 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+  | excl_r : ContainsSupOf ex1 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+
+theorem Kind.Disjoint.union_l_inv (hd : Disjoint (K1.union K2) K) : Disjoint K1 K ∧ Disjoint K2 K := by
+  generalize hk : Kind.union K1 K2 = K' at hd
+  induction hd with
+  | empty_l => cases hk
+  | empty_r => exact ⟨.empty_r, .empty_r⟩
+  | union_l hd1 hd2 =>
+    cases hk
+    exact ⟨hd1, hd2⟩
+  | union_r hd1 hd2 ih1 ih2 =>
+    have ⟨hd1', hd2'⟩ := ih1 hk
+    have ⟨hd1'', hd2''⟩ := ih2 hk
+    exact ⟨.union_r hd1' hd1'', .union_r hd2' hd2''⟩
+  | absurd_l => cases hk
+  | absurd_r => cases hk
+  | root => cases hk
+  | excl_l => cases hk
+  | excl_r => cases hk
+
+theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (K1.union K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
+  generalize hk : Kind.union K1 K2 = K' at hd
+  induction hd with
+  | empty_l => exact ⟨.empty_l, .empty_l⟩
+  | empty_r => cases hk
+  | union_l hd1 hd2 ih1 ih2 =>
+    have ⟨hd1', hd2'⟩ := ih1 hk
+    have ⟨hd1'', hd2''⟩ := ih2 hk
+    exact ⟨.union_l hd1' hd1'', .union_l hd2' hd2''⟩
+  | union_r hd1 hd2 =>
+    cases hk
+    exact ⟨hd1, hd2⟩
+  | absurd_l => cases hk
+  | absurd_r => cases hk
+  | root => cases hk
+  | excl_l => cases hk
+  | excl_r => cases hk
+
+theorem Kind.Disjoint.implies_empty_intersect (hd : K1.Disjoint K2) (hi : Intersect K1 K2 R) : IsEmpty R := by
+  induction hi with
+  | empty_l => exact .empty
+  | empty_r => exact .empty
+  | union_l hi1 hi2 ih1 ih2 =>
+    have ⟨hd1, hd2⟩ := hd.union_l_inv
+    exact .union (ih1 hd1) (ih2 hd2)
+  | union_r hi1 hi2 ih1 ih2 =>
+    have ⟨hd1, hd2⟩ := hd.union_r_inv
+    exact .union (ih1 hd1) (ih2 hd2)
+  | singleton_l hs =>
+    cases hd with
+    | absurd_l ha => exact .absurd (.append_l ha)
+    | absurd_r ha => exact .absurd (.append_r (ha.trans_subclass hs))
+    | root hd => cases hd.not_subclass hs
+    | excl_l ha => exact .absurd (.append_r ha)
+    | excl_r ha => exact .absurd (.append_l (ha.trans_subclass hs))
+  | singleton_r hs =>
+    cases hd with
+    | absurd_l ha => exact .absurd (.append_l (ha.trans_subclass hs))
+    | absurd_r ha => exact .absurd (.append_r ha)
+    | root hd => cases hd.symm.not_subclass hs
+    | excl_l ha => exact .absurd (.append_r (ha.trans_subclass hs))
+    | excl_r ha => exact .absurd (.append_l ha)
+  | singleton_disj => exact .empty
+
+theorem Kind.Disjoint.from_empty_intersect (hi : Intersect K1 K2 R) (he : IsEmpty R) : K1.Disjoint K2 := by
+  induction hi with
+  | empty_l => exact .empty_l
+  | empty_r => exact .empty_r
+  | union_l hi1 hi2 ih1 ih2 =>
+    cases he with
+    | union he1 he2 => exact .union_l (ih1 he1) (ih2 he2)
+  | union_r hi1 hi2 ih1 ih2 =>
+    cases he with
+    | union he1 he2 => exact .union_r (ih1 he1) (ih2 he2)
+  | singleton_l hs =>
+    cases he with
+    | absurd ha =>
+      cases ha.of_append with
+      | inl ha => exact .absurd_l ha
+      | inr ha => exact .excl_l ha
+  | singleton_r hs =>
+    cases he with
+    | absurd ha =>
+      cases ha.of_append with
+      | inl ha => exact .excl_r ha
+      | inr ha => exact .absurd_r ha
+  | singleton_disj hd => exact .root hd
+
+theorem Kind.Disjoint.symm (hd : K1.Disjoint K2) : Disjoint K2 K1 := by
+  induction hd with
+  | empty_l => exact .empty_r
+  | empty_r => exact .empty_l
+  | union_l _ _ ih1 ih2 => exact .union_r ih1 ih2
+  | union_r _ _ ih1 ih2 => exact .union_l ih1 ih2
+  | absurd_l ha => exact .absurd_r ha
+  | absurd_r ha => exact .absurd_l ha
+  | root hd => exact .root hd.symm
+  | excl_l ha => exact .excl_r ha
+  | excl_r ha => exact .excl_l ha
+
+theorem Kind.Disjoint.append_excl_l (hd : Disjoint (.node r1 ex2) K) : Disjoint (.node r1 (ex1 ++ ex2)) K := by
+  cases hd
+  case empty_r => apply! empty_r
+  case union_r ha hb => apply union_r ha.append_excl_l hb.append_excl_l
+  case absurd_l ha => apply absurd_l ha.append_r
+  case absurd_r => apply! absurd_r
+  case root => apply! root
+  case excl_l => apply! excl_l
+  case excl_r ha => apply excl_r ha.append_r
+
+theorem Kind.Disjoint.refine_subroot_l (hd : Disjoint (.node r1 ex1) K) (hs : r2.Subclass r1) : Disjoint (.node r2 ex1) K := by
+  cases hd
+  case empty_r => apply! empty_r
+  case union_r ha hb => apply! union_r (ha.refine_subroot_l _) (hb.refine_subroot_l _)
+  case absurd_l ha => apply! absurd_l $ ha.trans_subclass _
+  case absurd_r => apply! absurd_r
+  case root hdr => apply root; apply! hdr.refines_subclass_l _
+  case excl_l hc => apply! excl_l $ hc.trans_subclass _
+  case excl_r => apply! excl_r
+
+-- If K1 is disjoint from K', and R is the intersection of K with K1, then R is disjoint from K'
+theorem Kind.Disjoint.intersect_disjoint (hd : K1.Disjoint K') (hi : Intersect K K1 R) : R.Disjoint K' := by
+  induction hi
+  case empty_l => apply! empty_l
+  case empty_r => apply! empty_l
+  case union_l iha ihb => apply! union_l (iha _) (ihb _)
+  case union_r iha ihb =>
+    have ⟨_, _⟩ := hd.union_l_inv
+    apply! union_l (iha _) (ihb _)
+  case singleton_l hs => apply append_excl_l; apply! hd.refine_subroot_l _
+  case singleton_r hs => apply hd.append_excl_l
+  case singleton_disj hdr => apply empty_l
+
+theorem Kind.Disjoint.absurd_l' (hs : ContainsSupOf ex1 r1) : Disjoint (.node r1 ex1) K := by
+  induction K
+  case empty => apply empty_r
+  case node => apply! absurd_l
+  case union ha hb => apply! union_r
+
+theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
+  induction hs
+  case empty_l => constructor
+  case union_l ha hb => apply! IsEmpty.union (ha _) (hb _)
+  case absurd_l => apply! IsEmpty.absurd
+  case excl_subclass_r hss hc hs ih =>
+    cases he
+    rename_i he
+    cases he
+    case here he => cases hss.antisymm he
+    case there he => apply! ih (.absurd _)
+  case excl_disjoint_r hss _ _ ih =>
+    cases he
+    rename_i he
+    cases he
+    case here he => cases hss.antisymm he
+    case there he => apply! ih (.absurd _)
+  case excl_irrelevant_r hd hs ih =>
+    cases he
+    rename_i he
+    cases he
+    case here he => cases hd.symm.not_subclass he
+    case there he => apply! ih (.absurd _)
+  case subclass_r => cases he; rename_i he; cases he
+  case union_r hi hs ih =>
+    cases he
+
+
+
+
+theorem Kind.Disjoint.refine_subkind_l' (hd : K1.Disjoint (.node r2 ex2)) (hs : Subkind L K1) : L.Disjoint (.node r2 ex2) := by
+  induction hs with
+  | empty_l => exact .empty_l
+  | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
+  | absurd_l ha =>
+    apply absurd_l' ha
+  | excl_subclass_r hss hc hs ih =>
     cases hd
-    case absurd_l hsc =>
-      cases hsc
-      case here hsub => cases hd.symm.not_subclass hsub
-      case there hsc => apply absurd_l $ hs.absurd_r hsc
-    case absurd_r => apply! absurd_r
-    case root_l hsc1 =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr hsub => apply! root_l $ hsc1.subclass _
-    case root_r hsc1 =>
-      cases hsc1
-      case here hsub =>
-        cases hs.root_is_subclass
-        case inl => apply! absurd_l
-        case inr hsub2 =>
-          apply root
-          apply Classifier.Disjoint.symm
-          apply! (hd.refines_subclass_l _).refines_subclass_r _
-      case there hsc1 =>
-        cases hs.refine_has_superclass hsc1
-        case inl => apply! absurd_l
-        case inr h1 =>
-          cases h1
-          case inl h1 => apply! root
-          case inr h1 => apply! root_r
-    case root hd2 =>
-      cases hs.root_is_subclass
-      case inl => apply! absurd_l
-      case inr => apply! root $ hd2.refines_subclass_l _
-
-theorem Kind.Subkind.trans (ha : Subkind K1 K2) (hb : Subkind K2 K3) : Subkind K1 K3 := by
-  induction hb generalizing K1
-  case absurd_l hsc =>
-    apply absurd_l $ ha.absurd_r hsc
-  case subclass_no_excl hs =>
-    cases ha.root_is_subclass
-    case inl hsc => apply! absurd_l
-    case inr hsub => apply! subclass_no_excl $ hsub.trans _
-  case excl_subclass hk hss hsc ih =>
-    cases K1 with
-    | singleton r1 es1 =>
-      cases ha.refine_has_superclass hsc
-      case inl hsc2 => apply! absurd_l
-      case inr h =>
-        cases h
-        case inl hd => apply! excl_disjoint (ih _) _ hd.symm
-        case inr hsc2 => apply! excl_subclass (ih _) _ hsc2
-  case excl_disjoint hk hss hd ih =>
-    cases K1 with
-    | singleton r1 es1 =>
-      cases ha.root_is_subclass
-      case inl hsc => apply! absurd_l
-      case inr hsub => apply! excl_disjoint (ih _) _ $ hd.refines_subclass_r _
-  case excl_irrelevant hk hd ih =>
-    apply! excl_irrelevant (ih _) _
-
-theorem Kind.subkind_disjoint_absurd (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : HasSuperclassOf K1.1 K1.2 := by
-  induction ha
-  case absurd_l hsc => exact hsc
-  case subclass_no_excl hsub =>
-    cases hb
-    case absurd_l hsc => exact hsc
-    case absurd_r hsc => cases hsc
-    case root_l hsc => cases hsc
-    case root_r hsc => exact hsc.subclass hsub
-    case root hd => exact absurd hsub hd.not_subclass
-  case excl_subclass hs hss hsc ih =>
-    cases hb
-    case absurd_l hsc2 => exact hsc2
-    case absurd_r hsc2 =>
-      cases hsc2
-      case here hsub => exact (hss.antisymm hsub).elim
-      case there hsc2 => exact ih (.absurd_r hsc2)
-    case root_l hsc2 =>
-      cases hsc2
-      case here hsub => exact hsc.subclass hsub
-      case there hsc2 => exact ih (.root_l hsc2)
-    case root_r hsc2 => exact ih (.root_r hsc2)
-    case root hd => exact ih (.root hd)
-  case excl_disjoint hs hss hd ih =>
-    cases hb
-    case absurd_l hsc => exact hsc
-    case absurd_r hsc =>
-      cases hsc
-      case here hsub => exact (hss.antisymm hsub).elim
-      case there hsc => exact ih (.absurd_r hsc)
-    case root_l hsc =>
-      cases hsc
-      case here hsub => exact absurd hsub hd.symm.not_subclass
-      case there hsc => exact ih (.root_l hsc)
-    case root_r hsc => exact ih (.root_r hsc)
-    case root hd2 => exact ih (.root hd2)
-  case excl_irrelevant hs hd ih =>
-    cases hb
-    case absurd_l hsc => exact hsc
-    case absurd_r hsc =>
-      cases hsc
-      case here hsub => exact absurd hsub hd.symm.not_subclass
-      case there hsc => exact ih (.absurd_r hsc)
-    case root_l hsc =>
-      cases hsc
-      case here hsub =>
-        cases hs.root_is_subclass
-        case inl hsc2 => exact hsc2
-        case inr hsub2 => exact absurd hsub2 (hd.refines_subclass_l hsub).not_subclass
-      case there hsc => exact ih (.root_l hsc)
-    case root_r hsc => exact ih (.root_r hsc)
-    case root hd2 => exact ih (.root hd2)
-
-theorem Kind.Subkind.absurd_disjoint (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : Subkind K1 K3 := by
-  cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
-
-theorem Kind.Disjoint.absurd_subkind (hb : Disjoint K1 K2) (ha : Subkind K1 K2) : Disjoint K1 K3 := by
-  cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
+    case absurd_l hc =>
+      cases hc
+      case here hc => cases hss.antisymm hc
+      case there hc =>
+
+
+  | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
+  | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
+  | subclass_r hsub => exact hd.refine_subclass_node hsub
+  | @union_r K K1' R K2' hi hs' ih =>
+    have ⟨hd1, hd2⟩ := hd.union_l_inv
+    exact refine_union_r hi hs' hd1 hd2 ih
+
+-- theorem Kind.Disjoint.excl_cons_l (hd : Disjoint (.node r1 (a :: ex1)) K2) : Disjoint (.node r1 ex1) K2 := by
+--   cases hd with
+--   | empty_r => exact .empty_r
+--   | union_r hd1 hd2 => exact .union_r (excl_cons_l hd1) (excl_cons_l hd2)
+--   | absurd_l ha =>
+--     cases ha with
+--     | here hs => exact .absurd_l (.here hs)
+--     | there ha => exact .absurd_l ha
+--   | absurd_r ha => exact .absurd_r ha
+--   | root hd => exact .root hd
+--   | excl_l ha => exact .excl_l ha
+--   | excl_r ha =>
+--     cases ha with
+--     | here hs => exact .excl_r (.here hs)
+--     | there ha => exact .excl_r ha
+
+-- theorem Kind.Disjoint.refine_subclass_node (hsub : r1.Subclass r2) (hd : Disjoint (.node r2 []) K2) : Disjoint (.node r1 ex1) K2 := by
+--   induction K2 with
+--   | empty => exact .empty_r
+--   | node r3 ex3 =>
+--     cases hd with
+--     | absurd_l ha => cases ha
+--     | absurd_r ha => exact .absurd_r ha
+--     | root hd => exact .root (hd.refines_subclass_l hsub)
+--     | excl_l ha => exact .excl_l (ha.trans_subclass hsub)
+--     | excl_r ha => cases ha
+--   | union K2a K2b ih1 ih2 =>
+--     cases hd with
+--     | union_r hd1 hd2 => exact .union_r (ih1 hd1) (ih2 hd2)
+
+-- -- Helper for union_r case: if K ⊆ K1' ∪ K2' via union_r, and both K1' and K2' are disjoint from K2, then K is disjoint from K2
+-- -- We prove by induction on K
+-- theorem Kind.Disjoint.refine_union_r
+--     (hi : Intersect K K1' R) (hs : Subkind R K2') (hd1 : K1'.Disjoint K2) (hd2 : K2'.Disjoint K2)
+--     (ih : ∀ K2, K2'.Disjoint K2 → R.Disjoint K2) : K.Disjoint K2 := by
+--   induction K generalizing K1' R K2' K2 with
+--   | empty => exact .empty_l
+--   | union Ka Kb iha ihb =>
+--     cases hi with
+--     | union_l hia hib =>
+--       have ⟨hra, hrb⟩ := hs.union_l_inv
+--       have iha' := iha hia hra.1 hd1 hd2 (fun K2 hd2' => (ih K2 hd2').union_l_inv.1)
+--       have ihb' := ihb hib hrb.1 hd1 hd2 (fun K2 hd2' => (ih K2 hd2').union_l_inv.2)
+--       exact .union_l iha' ihb'
+--   | node r ex =>
+--     cases hi with
+--     | empty_r =>
+--       -- K1' = .empty, R = .empty
+--       -- hd1 : .empty.Disjoint K2
+--       -- hd2 : K2'.Disjoint K2
+--       -- hs : Subkind .empty K2'
+--       -- We need (.node r ex).Disjoint K2
+--       -- This case is actually impossible to prove in general!
+--       -- Unless we have more information about the relationship between K and K2'
+--       sorry
+--     | singleton_l hsub =>
+--       -- K1' = .node r2 ex2, R = .node r (ex ++ ex2)
+--       -- r.Subclass r2
+--       cases K2 with
+--       | empty => exact .empty_r
+--       | node r3 ex3 =>
+--         cases hd1 with
+--         | absurd_l ha => exact .absurd_l (ha.trans_subclass hsub)
+--         | absurd_r ha => exact .absurd_r ha
+--         | root hd => exact .root (hd.refines_subclass_l hsub)
+--         | excl_l ha => exact .excl_l (ha.trans_subclass hsub)
+--         | excl_r ha => exact .excl_r ha
+--       | union K2a K2b =>
+--         have ⟨hd1a, hd1b⟩ := hd1.union_r_inv
+--         have ⟨hd2a, hd2b⟩ := hd2.union_r_inv
+--         exact .union_r (refine_union_r (.singleton_l hsub) hs hd1a hd2a (fun K2 hd2' => ih K2 hd2'))
+--                        (refine_union_r (.singleton_l hsub) hs hd1b hd2b (fun K2 hd2' => ih K2 hd2'))
+--     | singleton_r hsub =>
+--       -- K1' = .node r2 ex2, R = .node r2 (ex ++ ex2)
+--       -- r2.Subclass r
+--       cases K2 with
+--       | empty => exact .empty_r
+--       | node r3 ex3 =>
+--         -- The intersection took r2, but K has r with r2 ⊆ r
+--         -- We need K.Disjoint K2, but K might be strictly bigger than the intersection
+--         cases hd2 with
+--         | absurd_l ha =>
+--           -- K2' is absurd, so R (which is a subkind of K2') must be absurd too
+--           -- But R = .node r2 (ex ++ ex2), so we need ContainsSupOf (ex ++ ex2) r2
+--           -- which would make R absurd. If R is absurd, then from the subkind
+--           -- we can derive things...
+--           sorry
+--         | absurd_r ha => exact .absurd_r ha
+--         | root hd =>
+--           -- hd : r2'.Disjoint r3 where r2' is root of K2'
+--           -- We need r.Disjoint r3, given r2.Subclass r
+--           sorry
+--         | excl_l ha =>
+--           sorry
+--         | excl_r ha => exact .excl_r ha
+--       | union K2a K2b =>
+--         sorry
+--     | singleton_disj hdisj =>
+--       -- r.Disjoint r2, so intersection is empty
+--       -- R = .empty
+--       -- But we need K = .node r ex to be disjoint from K2
+--       -- We can't conclude this from K1'.Disjoint K2 alone
+--       sorry
+
+-- theorem Kind.Disjoint.refine_subkind_l (hd : K1.Disjoint K2) (hs : Subkind L K1) : L.Disjoint K2 := by
+--   induction hs generalizing K2 with
+--   | empty_l => exact .empty_l
+--   | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
+--   | absurd_l ha => exact .absurd_l ha
+--   | excl_subclass_r _ _ _ ih => exact ih (hd.excl_cons_l)
+--   | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
+--   | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
+--   | subclass_r hsub => exact hd.refine_subclass_node hsub
+--   | @union_r K K1' R K2' hi hs' ih =>
+--     have ⟨hd1, hd2⟩ := hd.union_l_inv
+--     exact refine_union_r hi hs' hd1 hd2 ih
+
+-- theorem Kind.Disjoint.refine_subkind_r (hd : Disjoint K1 K2) (hs : Subkind L K2) : K1.Disjoint L := by apply (hd.symm.refine_subkind_l hs).symm
+
+-- theorem Kind.Disjoint.refine
+
+-- inductive Kind : Type where
+-- -- | empty : Kind
+-- | singleton : Classifier -> List Classifier -> Kind
+-- -- | union : Kind -> Kind -> Kind
+
+-- @[simp]
+-- def Kind.classifier (c : Classifier) := singleton c []
+
+-- @[simp]
+-- def Kind.excl (k : Kind) c :=
+--   match k with
+--   | singleton r es => singleton r (c :: es)
+
+
+-- inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
+--   | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
+--   | there : HasSuperclassOf b xs -> HasSuperclassOf b (a :: xs)
+
+-- theorem HasSuperclassOf.subclass (hsc : HasSuperclassOf a es) (hs : Classifier.Subclass b a) : HasSuperclassOf b es := by
+--   induction hsc
+--   case here hsub => apply here  $ hs.trans hsub
+--   case there ih => apply! there
+
+-- inductive Kind.Disjoint : Kind -> Kind -> Prop where
+--   -- | empty_l : Disjoint .empty K
+--   -- | empty_r : Disjoint K .empty
+--   -- empty classifiers are disjoint with everything else
+--   | absurd_l : HasSuperclassOf a es -> Disjoint (singleton a es) K2
+--   | absurd_r : HasSuperclassOf a es -> Disjoint K1 (singleton a es)
+--   -- Otherwise, the root has to be a subclass of the other's exclude list
+--   | root_l : HasSuperclassOf r1 es2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+--   | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+--   | root : Classifier.Disjoint r1 r2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
+--   -- union case
+--   -- | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
+--   -- | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+
+-- inductive Kind.Subkind : Kind -> Kind -> Prop where
+--   | absurd_l : HasSuperclassOf a es ->
+--     Subkind (singleton a es) K
+--   -- | empty_l : Subkind .empty K
+--   | subclass_no_excl :
+--     r1.Subclass r2 ->
+--     Subkind (singleton r1 es1) (singleton r2 [])
+--   | excl_subclass :
+--     Subkind (singleton r1 es1) (singleton r2 es2) ->
+--     a.StrictSub r2 ->
+--     HasSuperclassOf a es1 ->
+--     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+--   | excl_disjoint :
+--     Subkind (singleton r1 es1) (singleton r2 es2) ->
+--     a.StrictSub r2 ->
+--     a.Disjoint r1 ->
+--     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+--   | excl_irrelevant :
+--     Subkind (singleton r1 es1) (singleton r2 es2) ->
+--     a.Disjoint r2 ->
+--     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
+
+-- theorem Kind.Subkind.singleton_weaken_l (hs : Subkind (.singleton a es) K) : Subkind (.singleton a (e :: es)) K := by
+--   cases hs
+--   case absurd_l => apply! absurd_l $ .there _
+--   case subclass_no_excl hsub => apply! subclass_no_excl
+--   case excl_subclass hss hsc hs => apply! hs.singleton_weaken_l.excl_subclass _ (.there _)
+--   case excl_disjoint hss hd hs => apply! hs.singleton_weaken_l.excl_disjoint
+--   case excl_irrelevant hd hs => apply! hs.singleton_weaken_l.excl_irrelevant
+
+
+-- theorem Kind.Subkind.rfl : Subkind K K := by
+--   cases K
+--   case singleton r es =>
+--     induction es
+--     case nil => apply subclass_no_excl .rfl
+--     case cons h t ih =>
+--       cases Classifier.subclass_or_disjoint r h
+--       case inl hsub =>
+--         apply! absurd_l $ .here _
+--       case inr hsub =>
+--         cases hsub
+--         case inl hsub =>
+--           cases hsub.might_strict
+--           case inl he =>  subst_vars; apply! absurd_l $ .here _
+--           case inr hsub => apply ih.singleton_weaken_l.excl_subclass hsub (.here .rfl)
+--         case inr hd =>  apply ih.singleton_weaken_l.excl_irrelevant hd.symm
+
+-- -- theorem Kind.Subkind.refines_is_empty
+-- --   (hs : Subkind K1 K2)
+-- --   (he : IsEmpty K2) : IsEmpty K1 := by
+-- --   cases hs
+-- --   rename_i he1 hsub
+-- --   induction hsub <;> try cases he.singleton_must_excl
+-- --   case absurd_l => apply! IsEmpty.absurd
+-- --   case absurd_r => assumption
+-- --   case empty_l => assumption
+-- --   case empty_r => assumption
+-- --   case excl_subclass_r hsub hsc hs ih =>
+-- --     cases he
+-- --     rename_i he
+-- --     cases he
+-- --     case here he => have h := hsub.antisymm he; contradiction
+-- --     case there he => apply ih (.absurd he) he1
+-- --   case excl_disjoint_r hsub hsc hs ih =>
+-- --     cases he.singleton_cases
+-- --     case inl he => have h := hsub.antisymm he; contradiction
+-- --     case inr he => apply ih (.absurd he) he1
+-- --   case excl_irrelevant_r hsub hs ih =>
+-- --     cases he.singleton_cases
+-- --     case inl he => have h := hsub.symm.not_subclass he; contradiction
+-- --     case inr he => apply ih (.absurd he) he1
+-- --   case residue hsc hs hsub ih =>
+-- --     cases he.singleton_cases
+-- --     case inl he => have h := hsc.antisymm he; contradiction
+-- --     case inr he => cases he1; apply! ih (.absurd he)
+-- --   case union_l hsa hsb iha ihb =>
+-- --     cases he1
+-- --     constructor
+-- --     apply! iha
+-- --     apply! ihb
+-- --   case union_rl ha hb iha ihb =>
+-- --     cases he
+-- --     apply! iha _ (ihb _ he1)
+-- --   case union_rr ha hb iha ihb =>
+-- --     cases he
+-- --     apply! iha _ (ihb _ he1)
+
+-- -- theorem Kind.Disjoint.is_empty_r
+-- --   (he : IsEmpty K)
+-- --   : Disjoint K1 K := by
+-- --   induction he
+-- --   case empty => apply! empty_r
+-- --   case absurd => apply! absurd_r
+-- --   case union => apply! union_r
+
+-- theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
+--   induction hd
+--   -- case empty_l => apply! empty_r
+--   -- case empty_r => apply! empty_l
+--   case absurd_l => apply! absurd_r
+--   case absurd_r => apply! absurd_l
+--   case root_l => apply! root_r
+--   case root_r => apply! root_l
+--   case root h => apply! root h.symm
+--   -- case union_l => apply! union_r
+--   -- case union_r => apply! union_l
+
+-- theorem Kind.Subkind.absurd_r
+--   (hs : Subkind (singleton r1 es1) (singleton r2 es2))
+--   (hsc : HasSuperclassOf r2 es2)
+--   : HasSuperclassOf r1 es1 := by
+--   cases hs
+--   case absurd_l => assumption
+--   case subclass_no_excl => cases hsc
+--   case excl_subclass hsc1 hss hs =>
+--     cases hsc
+--     case here hsub => cases hss.antisymm hsub
+--     case there hsc => apply hs.absurd_r hsc
+--   case excl_disjoint hd hss hs =>
+--     cases hsc
+--     case here hsub => cases hss.antisymm hsub
+--     case there hsc => apply hs.absurd_r hsc
+--   case excl_irrelevant hd hs =>
+--     cases hsc
+--     case here hsub => cases hd.symm.not_subclass hsub
+--     case there hsc => apply hs.absurd_r hsc
+
+-- theorem Kind.Subkind.root_is_subclass (hs : Subkind (singleton r1 es1) (singleton r2 es2)) : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
+--   cases hs
+--   case absurd_l => left; assumption
+--   case subclass_no_excl => right; assumption
+--   case excl_subclass hsc hss hs =>
+--     cases hs.root_is_subclass <;> aesop
+--   case excl_disjoint hs =>
+--     cases hs.root_is_subclass <;> aesop
+--   case excl_irrelevant hs =>
+--     cases hs.root_is_subclass <;> aesop
+
+-- theorem Kind.Subkind.refine_has_superclass
+--   (hs : Subkind (singleton r1 es1) (singleton r2 es2))
+--   (hsc : HasSuperclassOf a es2)
+--   : HasSuperclassOf r1 es1 ∨ r1.Disjoint a ∨ HasSuperclassOf a es1 := by
+--   cases hs
+--   case absurd_l => aesop
+--   case subclass_no_excl => cases hsc
+--   case excl_subclass hsc hss hs =>
+--     cases hsc
+--     case here hsub => have h := hsc.subclass hsub; aesop
+--     case there hsc => apply hs.refine_has_superclass hsc
+--   case excl_disjoint hd hss hs =>
+--     cases hsc
+--     case here hsub => have h:= (hd.refines_subclass_l hsub).symm; aesop
+--     case there hsc => apply hs.refine_has_superclass hsc
+--   case excl_irrelevant hd hs =>
+--     cases hsc
+--     case here hsub =>
+--       cases hs.root_is_subclass
+--       case inl => aesop
+--       case inr hsub2 => have h := ((hd.refines_subclass_l hsub).refines_subclass_r hsub2).symm; aesop
+--     case there hsc => apply hs.refine_has_superclass hsc
+
+-- theorem Kind.Disjoint.refine_by_subkind
+--   (hd : Disjoint K2 L)
+--   (hs : Subkind K1 K2)
+--   : Disjoint K1 L := by
+--   induction hs generalizing L
+--   case absurd_l => apply! absurd_l
+--   case subclass_no_excl hsub =>
+--     cases hd
+--     case absurd_l hsc => cases hsc
+--     case absurd_r hsc => apply! absurd_r
+--     case root_l hsc => apply! root_l $ hsc.subclass _
+--     case root_r hsc =>  cases hsc
+--     case root hd => apply! root $ hd.refines_subclass_l _
+--   case excl_subclass hs hss hsc ih =>
+--     cases hd
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsub => cases hss.antisymm hsub
+--       case there hsc => apply absurd_l $ hs.absurd_r hsc
+--     case absurd_r => apply! absurd_r
+--     case root_l hsc1 =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr hsub => apply! root_l $ hsc1.subclass _
+--     case root_r hsc1 =>
+--       cases hsc1
+--       case here hsub => apply! root_r $ hsc.subclass _
+--       case there hsc1 =>
+--         cases hs.refine_has_superclass hsc1
+--         case inl => apply! absurd_l
+--         case inr h1 =>
+--           cases h1
+--           case inl h1 => apply! root
+--           case inr h1 => apply! root_r
+--     case root hd =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr h1 => apply! root $ hd.refines_subclass_l _
+--   case excl_disjoint hs hss hd1 ih =>
+--     cases hd
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsub => cases hss.antisymm hsub
+--       case there hsc => apply absurd_l $ hs.absurd_r hsc
+--     case absurd_r => apply! absurd_r
+--     case root_l hsc1 =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr hsub => apply! root_l $ hsc1.subclass _
+--     case root_r hsc1 =>
+--       cases hsc1
+--       case here hsub => apply! root $ hd1.symm.refines_subclass_r _
+--       case there hsc1 =>
+--         cases hs.refine_has_superclass hsc1
+--         case inl => apply! absurd_l
+--         case inr h1 =>
+--           cases h1
+--           case inl h1 => apply! root
+--           case inr h1 => apply! root_r
+--     case root hd2 =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr => apply! root $ hd2.refines_subclass_l _
+--   case excl_irrelevant hs hd ih =>
+--     cases hd
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsub => cases hd.symm.not_subclass hsub
+--       case there hsc => apply absurd_l $ hs.absurd_r hsc
+--     case absurd_r => apply! absurd_r
+--     case root_l hsc1 =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr hsub => apply! root_l $ hsc1.subclass _
+--     case root_r hsc1 =>
+--       cases hsc1
+--       case here hsub =>
+--         cases hs.root_is_subclass
+--         case inl => apply! absurd_l
+--         case inr hsub2 =>
+--           apply root
+--           apply Classifier.Disjoint.symm
+--           apply! (hd.refines_subclass_l _).refines_subclass_r _
+--       case there hsc1 =>
+--         cases hs.refine_has_superclass hsc1
+--         case inl => apply! absurd_l
+--         case inr h1 =>
+--           cases h1
+--           case inl h1 => apply! root
+--           case inr h1 => apply! root_r
+--     case root hd2 =>
+--       cases hs.root_is_subclass
+--       case inl => apply! absurd_l
+--       case inr => apply! root $ hd2.refines_subclass_l _
+
+-- theorem Kind.Subkind.trans (ha : Subkind K1 K2) (hb : Subkind K2 K3) : Subkind K1 K3 := by
+--   induction hb generalizing K1
+--   case absurd_l hsc =>
+--     apply absurd_l $ ha.absurd_r hsc
+--   case subclass_no_excl hs =>
+--     cases ha.root_is_subclass
+--     case inl hsc => apply! absurd_l
+--     case inr hsub => apply! subclass_no_excl $ hsub.trans _
+--   case excl_subclass hk hss hsc ih =>
+--     cases K1 with
+--     | singleton r1 es1 =>
+--       cases ha.refine_has_superclass hsc
+--       case inl hsc2 => apply! absurd_l
+--       case inr h =>
+--         cases h
+--         case inl hd => apply! excl_disjoint (ih _) _ hd.symm
+--         case inr hsc2 => apply! excl_subclass (ih _) _ hsc2
+--   case excl_disjoint hk hss hd ih =>
+--     cases K1 with
+--     | singleton r1 es1 =>
+--       cases ha.root_is_subclass
+--       case inl hsc => apply! absurd_l
+--       case inr hsub => apply! excl_disjoint (ih _) _ $ hd.refines_subclass_r _
+--   case excl_irrelevant hk hd ih =>
+--     apply! excl_irrelevant (ih _) _
+
+-- theorem Kind.subkind_disjoint_absurd (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : HasSuperclassOf K1.1 K1.2 := by
+--   induction ha
+--   case absurd_l hsc => exact hsc
+--   case subclass_no_excl hsub =>
+--     cases hb
+--     case absurd_l hsc => exact hsc
+--     case absurd_r hsc => cases hsc
+--     case root_l hsc => cases hsc
+--     case root_r hsc => exact hsc.subclass hsub
+--     case root hd => exact absurd hsub hd.not_subclass
+--   case excl_subclass hs hss hsc ih =>
+--     cases hb
+--     case absurd_l hsc2 => exact hsc2
+--     case absurd_r hsc2 =>
+--       cases hsc2
+--       case here hsub => exact (hss.antisymm hsub).elim
+--       case there hsc2 => exact ih (.absurd_r hsc2)
+--     case root_l hsc2 =>
+--       cases hsc2
+--       case here hsub => exact hsc.subclass hsub
+--       case there hsc2 => exact ih (.root_l hsc2)
+--     case root_r hsc2 => exact ih (.root_r hsc2)
+--     case root hd => exact ih (.root hd)
+--   case excl_disjoint hs hss hd ih =>
+--     cases hb
+--     case absurd_l hsc => exact hsc
+--     case absurd_r hsc =>
+--       cases hsc
+--       case here hsub => exact (hss.antisymm hsub).elim
+--       case there hsc => exact ih (.absurd_r hsc)
+--     case root_l hsc =>
+--       cases hsc
+--       case here hsub => exact absurd hsub hd.symm.not_subclass
+--       case there hsc => exact ih (.root_l hsc)
+--     case root_r hsc => exact ih (.root_r hsc)
+--     case root hd2 => exact ih (.root hd2)
+--   case excl_irrelevant hs hd ih =>
+--     cases hb
+--     case absurd_l hsc => exact hsc
+--     case absurd_r hsc =>
+--       cases hsc
+--       case here hsub => exact absurd hsub hd.symm.not_subclass
+--       case there hsc => exact ih (.absurd_r hsc)
+--     case root_l hsc =>
+--       cases hsc
+--       case here hsub =>
+--         cases hs.root_is_subclass
+--         case inl hsc2 => exact hsc2
+--         case inr hsub2 => exact absurd hsub2 (hd.refines_subclass_l hsub).not_subclass
+--       case there hsc => exact ih (.root_l hsc)
+--     case root_r hsc => exact ih (.root_r hsc)
+--     case root hd2 => exact ih (.root hd2)
+
+-- theorem Kind.Subkind.absurd_disjoint (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : Subkind K1 K3 := by
+--   cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
+
+-- theorem Kind.Disjoint.absurd_subkind (hb : Disjoint K1 K2) (ha : Subkind K1 K2) : Disjoint K1 K3 := by
+--   cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)

From 40529dcc33a27a59382bff06e8ff7b83cb52285b Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 8 Dec 2025 18:49:09 +0100
Subject: [PATCH 37/71] Progress on Classifiers

---
 Capless/Classifier.lean | 480 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 425 insertions(+), 55 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 26eba345..6d96e9fd 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -348,28 +348,119 @@ inductive Intersect : Kind -> Kind -> Kind -> Prop where
   | singleton_r : r2.Subclass r1 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r2 (ex1 ++ ex2))
   | singleton_disj : r1.Disjoint r2 -> Intersect (.node r1 ex1) (.node r2 ex2) .empty
 
-inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | empty_l : Subkind .empty K
-  | union_l : Subkind K1 K -> Subkind K2 K -> Subkind (.union K1 K2) K
-  | absurd_l : ContainsSupOf ex1 r1 -> Subkind (.node r1 ex1) K
+inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
+  | empty_l : Subtract .empty K .empty
+  | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
+  | absurd_l : ContainsSupOf ex1 r1 -> Subtract (.node r1 ex1) K .empty
   | excl_subclass_r :
-    a.StrictSub r2 -> -- not absurd
+    a.StrictSub r2 ->
     ContainsSupOf ex1 a ->
-    Subkind (.node r1 ex1) (.node r2 ex2) ->
-    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+    Subtract (.node r1 ex1) (.node r2 ex2) R ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
   | excl_disjoint_r :
-    a.StrictSub r2 -> -- not absurd
+    a.StrictSub r2 ->
     a.Disjoint r1 ->
-    Subkind (.node r1 ex1) (.node r2 ex2) ->
-    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+    Subtract (.node r1 ex1) (.node r2 ex2) R ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
   | excl_irrelevant_r :
     a.Disjoint r2 ->
-    Subkind (.node r1 ex1) (.node r2 ex2) ->
-    Subkind (.node r1 ex1) (.node r2 (a :: ex2))
+    Subtract (.node r1 ex1) (.node r2 ex2) R ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
+  | excl_r :
+    a.Disjoint r2 ->
+    a.Subclass r1 ->
+    Subtract (.node r1 ex1) (.node r2 ex2) R ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.union R (.node a ex1))
+  | subclass_l :
+    r2.Subclass r1 ->
+    Subtract (.node r1 ex1) (.node r2 []) (.node r1 (r2 :: ex1))
   | subclass_r :
     r1.Subclass r2 ->
-    Subkind (.node r1 ex1) (.node r2 [])
-  -- | union_r : Intersect K K1 R -> Subkind R K2 -> Subkind K (.union K1 K2) -- wrong. needs subtract
+    Subtract (.node r1 ex1) (.node r2 []) .empty
+  | irrelevant_r :
+    r1.Disjoint r2 ->
+    Subtract (.node r1 ex1) (.node r2 []) (.node r1 ex1)
+  | union_r :
+    Subtract (.node r1 ex1) K1 R1 ->
+    Subtract R1 K2 R2 ->
+    Subtract (.node r1 ex1) (.union K1 K2) R2
+
+inductive Kind.Subkind : Kind -> Kind -> Prop where
+  | subtract : Subtract K1 K2 R -> IsEmpty R -> Subkind K1 K2
+
+theorem Kind.Subtract.from_empty (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsEmpty R := by
+  induction hs
+  case empty_l => constructor
+  case union_l ih1 ih2 =>
+    cases he with
+    | union he1 he2 => exact .union (ih1 he1) (ih2 he2)
+  case absurd_l => constructor
+  case excl_subclass_r ih => exact ih he
+  case excl_disjoint_r ih => exact ih he
+  case excl_irrelevant_r ih => exact ih he
+  case excl_r _ hsub _ ih =>
+    cases he with
+    | absurd ha => exact .union (ih (.absurd ha)) (.absurd (ha.trans_subclass hsub))
+  case subclass_l hsub =>
+    cases he with
+    | absurd ha => apply! IsEmpty.absurd $ .there _
+  case subclass_r => constructor
+  case irrelevant_r =>
+    cases he with
+    | absurd ha => exact .absurd ha
+  case union_r ih1 ih2 =>
+    cases he with
+    | absurd ha => exact ih2 (ih1 (.absurd ha))
+
+theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2 : IsEmpty K2) : IsEmpty K1 := by
+  induction hs
+  case empty_l => constructor
+  case union_l ih1 ih2 =>
+    cases he with
+    | union he1 he2 => exact .union (ih1 he1 hek2) (ih2 he2 hek2)
+  case absurd_l ha => exact .absurd ha
+  case excl_subclass_r hss hc _ ih =>
+    cases hek2 with
+    | absurd ha =>
+      cases ha
+      case here hsub => exact (hss.antisymm hsub).elim
+      case there ha => exact ih he (.absurd ha)
+  case excl_disjoint_r hss _ _ ih =>
+    cases hek2 with
+    | absurd ha =>
+      cases ha
+      case here hsub => exact (hss.antisymm hsub).elim
+      case there ha => exact ih he (.absurd ha)
+  case excl_irrelevant_r hd _ ih =>
+    cases hek2 with
+    | absurd ha =>
+      cases ha
+      case here hsub => exact (hd.symm.not_subclass hsub).elim
+      case there ha => exact ih he (.absurd ha)
+  case excl_r hd hsub _ ih =>
+    cases he with
+    | union heR heA =>
+      cases hek2 with
+      | absurd ha =>
+        cases ha
+        case here hsub2 => exact (hd.symm.not_subclass hsub2).elim
+        case there ha => exact ih heR (.absurd ha)
+  case subclass_l =>
+    cases hek2 with
+    | absurd ha => cases ha
+  case subclass_r =>
+    cases hek2 with
+    | absurd ha => cases ha
+  case irrelevant_r =>
+    cases hek2 with
+    | absurd ha => cases ha
+  case union_r ih1 ih2 =>
+    cases hek2 with
+    | union he2a he2b => exact ih1 (ih2 he he2b) he2a
+
+theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
+  cases hs
+  apply! Subtract.empty_r_inv
 
 inductive Kind.Disjoint : Kind -> Kind -> Prop where
   | empty_l: Disjoint .empty K
@@ -519,56 +610,335 @@ theorem Kind.Disjoint.absurd_l' (hs : ContainsSupOf ex1 r1) : Disjoint (.node r1
   case node => apply! absurd_l
   case union ha hb => apply! union_r
 
-theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
+theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K2 R) : Disjoint R K := by
   induction hs
-  case empty_l => constructor
-  case union_l ha hb => apply! IsEmpty.union (ha _) (hb _)
-  case absurd_l => apply! IsEmpty.absurd
-  case excl_subclass_r hss hc hs ih =>
-    cases he
-    rename_i he
-    cases he
-    case here he => cases hss.antisymm he
-    case there he => apply! ih (.absurd _)
-  case excl_disjoint_r hss _ _ ih =>
-    cases he
-    rename_i he
+  case empty_l => exact .empty_l
+  case union_l ih1 ih2 =>
+    have ⟨hd1, hd2⟩ := hd.union_l_inv
+    exact .union_l (ih1 hd1) (ih2 hd2)
+  case absurd_l => exact .empty_l
+  case excl_subclass_r ih => exact ih hd
+  case excl_disjoint_r ih => exact ih hd
+  case excl_irrelevant_r ih => exact ih hd
+  case excl_r _ hsub _ ih => exact .union_l (ih hd) (hd.refine_subroot_l hsub)
+  case subclass_l hsub => apply! append_excl_l (ex1:=[_])
+  case subclass_r => exact .empty_l
+  case irrelevant_r => exact hd
+  case union_r ih1 ih2 => exact ih2 (ih1 hd)
+
+theorem Kind.Subtract.empty_or_subroot (hs : Subtract (.node r1 ex1) (.node r2 ex2) R) (he : IsEmpty R) : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
+  cases hs
+  case absurd_l => left; assumption
+  case excl_subclass_r hss hsc hs =>
+    cases hs.empty_or_subroot he <;> aesop
+  case excl_disjoint_r hss hsc hs =>
+    cases hs.empty_or_subroot he <;> aesop
+  case excl_irrelevant_r hd hs =>
+    cases hs.empty_or_subroot he <;> aesop
+  case excl_r hs =>
     cases he
-    case here he => cases hss.antisymm he
-    case there he => apply! ih (.absurd _)
-  case excl_irrelevant_r hd hs ih =>
+    rename_i he1 he2
+    cases hs.empty_or_subroot he1 <;> aesop
+  case subclass_l hs =>
     cases he
     rename_i he
     cases he
-    case here he => cases hd.symm.not_subclass he
-    case there he => apply! ih (.absurd _)
-  case subclass_r => cases he; rename_i he; cases he
-  case union_r hi hs ih =>
-    cases he
+    case here he => cases hs.antisymm he; right; constructor
+    case there => aesop
+  case subclass_r => aesop
+  case irrelevant_r => cases he; aesop
+
+-- theorem Kind.Disjoint.refine_subclass_l (hd : Disjoint (.node r2 ex2) K) (hs : Classifier.Subclass r1 r2) : ContainsSupOf ex2 r2 ∨ Disjoint (.node r1 ex1) K := by
+--   cases hd
+--   case empty_r => right; apply! empty_r
+--   case union_r h1 h2 =>
+--     cases h1.refine_subclass_l hs (ex1:=ex1); aesop
+--     cases h2.refine_subclass_l hs (ex1:=ex1); aesop
+--     right; apply! union_r
+--   case absurd_l hsc => aesop
+--   case absurd_r hsc => right; apply! absurd_r
+--   case root hd => right; apply root $ hd.refines_subclass_l hs
+--   case excl_l hsc => right; apply excl_l $ hsc.trans_subclass hs
+--   case excl_r r2' ex2' hsc =>
+--     induction hsc
+--     case here a xs r2' hss =>
+--       cases Classifier.subclass_or_disjoint a r1
+--       case inl hs1 =>
+
+theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
+  induction hs generalizing K
+  case empty_l => apply empty_l
+  case union_l ih1 ih2 =>
+    have ⟨_, _⟩ := hdr.union_l_inv
+    apply! union_l (ih1 _ _) (ih2 _ _)
+  case absurd_l => apply! absurd_l'
+  case excl_subclass_r ex1 a r1 r2 ex2 _  hss hsc hs ih =>
+    generalize h : node r2 (a :: ex2) = L at hd2
+    induction hd2 generalizing K2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      simp_all
+      have ⟨_, _⟩ := hdr.union_r_inv
+      apply! union_r (ha _) (hb _)
+    case absurd_l hsc =>
+      cases hsc
+      case here hsc => cases hss.antisymm hsc
+      case there hsc =>
+        apply ih _ hdr
+        apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root hd1 => apply ih (.root hd1) hdr
+    case excl_l hsc => apply! ih (.excl_l _)
+    case excl_r hsc =>
+      cases hsc
+      case here hs => apply excl_r $ hsc.trans_subclass hs
+      case there hsc => apply! ih (excl_r _)
+  case excl_disjoint_r r1 ex1 r2 ex2 _ a hss hd hs ih =>
+    generalize h : node r2 (a :: ex2) = L at hd2
+    induction hd2 generalizing K2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      simp_all
+      have ⟨_, _⟩ := hdr.union_r_inv
+      apply! union_r (ha _) (hb _)
+    case absurd_l hsc =>
+      cases hsc
+      case here hsc => cases hss.antisymm hsc
+      case there hsc =>
+        apply ih _ hdr
+        apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root hd1 => apply ih (.root hd1) hdr
+    case excl_l hsc => apply! ih (.excl_l _)
+    case excl_r hsc =>
+      cases hsc
+      case here hs => apply! root $ hd.symm.refines_subclass_r _
+      case there hsc => apply! ih (excl_r _)
+  case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
+    generalize h : node r2 (a :: ex2) = L at hd2
+    induction hd2 generalizing K2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      simp_all
+      have ⟨_, _⟩ := hdr.union_r_inv
+      apply! union_r (ha _) (hb _)
+    case absurd_l hsc =>
+      cases hsc
+      case here hsc => cases hd.symm.not_subclass hsc
+      case there hsc =>
+        apply ih _ hdr
+        apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root hd1 => apply ih (.root hd1) hdr
+    case excl_l hsc => apply! ih (.excl_l _)
+    case excl_r hsc =>
+      cases hsc
+      case here hs => apply ih _ hdr; apply root; apply! hd.symm.refines_subclass_r
+      case there hsc => apply! ih (excl_r _)
+  case excl_r r1 ex1 r2 ex2 _ a hd hsc hs ih =>
+    have ⟨hdr', hd'⟩ := hdr.union_l_inv
+    generalize h : node r2 (a :: ex2) = L at hd2
+    induction hd2 generalizing K2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      simp_all
+      have ⟨_, _⟩ := hdr.union_r_inv
+      have ⟨_, _⟩ := hdr'.union_r_inv
+      have ⟨hl, hr⟩ := hd'.union_r_inv
+      apply! union_r (ha _ _ _) (hb _ _ _)
+    case absurd_l hsc =>
+      cases hsc
+      case here hsc => cases hd.symm.not_subclass hsc
+      case there hsc =>
+        apply ih _ hdr'
+        apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root hd1 => apply ih (.root hd1) hdr'
+    case excl_l hsc => apply! ih (.excl_l _)
+    case excl_r hsc =>
+      cases hsc
+      case here hs =>
+
+        --  apply! root $ hd.symm.refines_subclass_r _
+      case there hsc => apply! ih (excl_r _)
+
+
+
+
+
+-- theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
+--   induction hs generalizing K
+--   case empty_l => exact .empty_l
+--   case union_l ih1 ih2 =>
+--     cases he with
+--     | union he1 he2 => exact .union_l (ih1 hd he1) (ih2 hd he2)
+--   case absurd_l hc => exact absurd_l' hc
+--   case excl_subclass_r ex1 a r1 r2 ex2 _ hss hsc hs ih =>
+--     generalize h : node r2 (a :: ex2) = L at hd
+--     induction hd generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc => cases hss.antisymm hsc
+--       case there hsc =>
+--         cases hs.empty_r_inv he (.absurd hsc)
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply root $ hd.refines_subclass_l hss
+--     case excl_l hsc =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply! excl_l $ hsc.trans_subclass hss
+--     case excl_r hsc1 =>
+--       cases hsc1
+--       case here hsc1 => apply excl_r $ hsc.trans_subclass hsc1
+--       case there hsc1 => apply ih _ he; apply! excl_r
+--   case excl_disjoint_r r1 ex1 r2 ex2 _ a hss hd hs ih =>
+--     simp_all
+--     generalize h : node r2 (a :: ex2) = L at hd
+--     induction hd generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc => cases hss.antisymm hsc
+--       case there hsc =>
+--         cases hs.empty_r_inv he (.absurd hsc)
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply root $ hd.refines_subclass_l hss
+--     case excl_l hsc =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply! excl_l $ hsc.trans_subclass hss
+--     case excl_r hsc1 =>
+--       cases hsc1
+--       case here hsc1 => apply root $ (hd.refines_subclass_l hsc1).symm
+--       case there hsc1 => apply ih _; apply! excl_r
+--   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd1 hs ih =>
+--     simp_all
+--     generalize h : node r2 (a :: ex2) = L at hd
+--     induction hd generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc => cases hd1.symm.not_subclass hsc
+--       case there hsc =>
+--         cases hs.empty_r_inv he (.absurd hsc)
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply root $ hd.refines_subclass_l hss
+--     case excl_l hsc =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply! excl_l $ hsc.trans_subclass hss
+--     case excl_r hsc1 =>
+--       cases hsc1
+--       case here hsc1 => apply ih; apply root; apply hd1.symm.refines_subclass_r hsc1
+--       case there hsc1 => apply ih _; apply! excl_r
+--   case excl_r r1 ex1 r2 ex2 _ a hd1 hsc hs ih =>
+--     cases he
+--     rename_i he he1
+--     cases he1
+--     simp_all
+--     rename_i he1
+--     generalize h : node r2 (a :: ex2) = L at hd
+--     induction hd generalizing K2 <;> try cases h
+--     case empty_r.refl => apply! empty_r
+--     case union_r.refl ha hb => subst_vars; simp_all; apply! union_r ha hb
+--     case absurd_l.refl hsc =>
+--       cases hsc
+--       case here hsc => cases hd1.symm.not_subclass hsc
+--       case there hsc =>
+--         cases hs.empty_r_inv he (.absurd hsc)
+--         apply! absurd_l
+--     case absurd_r.refl => apply! absurd_r
+--     case root.refl hd =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply root $ hd.refines_subclass_l hss
+--     case excl_l.refl hsc =>
+--       cases hs.empty_or_subroot he
+--       case inl hsc => apply! absurd_l
+--       case inr hss => apply! excl_l $ hsc.trans_subclass hss
+--     case excl_r.refl hsc1 =>
+--       cases hsc1
+--       case here hsc1 => apply ih; apply root; apply hd1.symm.refines_subclass_r hsc1
+--       case there hsc1 => apply ih _; apply! excl_r
+--   case subclass_l r1 ex1 r2 hs =>
+--     cases he
+--     rename_i he
+--     cases he
+--     case here he => cases hs.antisymm he; have h := hd.append_excl_l (ex1:=ex1); simp at h; assumption
+--     case there => apply! absurd_l'
+--   case subclass_r r1 ex1 r2 hs =>
+--     generalize h : node r2 [] = L at hd
+--     induction hd <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb => simp_all; apply! union_r
+--     case absurd_l hsc => cases hsc
+--     case absurd_r => apply! absurd_r
+--     case root hd => apply! root $ hd.refines_subclass_l _
+--     case excl_l hsc => apply! excl_l $ hsc.trans_subclass _
+--     case excl_r hsc => cases hsc
+--   case irrelevant_r hd =>
+--     cases he
+--     apply! absurd_l'
+--   case union_r ha hb =>
 
+    -- have ⟨hl, hr⟩ := hd.union_l_inv
+    -- simp_all
+    -- apply ha hl
 
 
 
-theorem Kind.Disjoint.refine_subkind_l' (hd : K1.Disjoint (.node r2 ex2)) (hs : Subkind L K1) : L.Disjoint (.node r2 ex2) := by
-  induction hs with
-  | empty_l => exact .empty_l
-  | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
-  | absurd_l ha =>
-    apply absurd_l' ha
-  | excl_subclass_r hss hc hs ih =>
-    cases hd
-    case absurd_l hc =>
-      cases hc
-      case here hc => cases hss.antisymm hc
-      case there hc =>
-
-
-  | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
-  | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
-  | subclass_r hsub => exact hd.refine_subclass_node hsub
-  | @union_r K K1' R K2' hi hs' ih =>
-    have ⟨hd1, hd2⟩ := hd.union_l_inv
-    exact refine_union_r hi hs' hd1 hd2 ih
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+-- theorem Kind.Disjoint.refine_subkind_l' (hd : K1.Disjoint (.node r2 ex2)) (hs : Subkind L K1) : L.Disjoint (.node r2 ex2) := by
+--   induction hs with
+--   | empty_l => exact .empty_l
+--   | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
+--   | absurd_l ha =>
+--     apply absurd_l' ha
+--   | excl_subclass_r hss hc hs ih =>
+--     cases hd
+--     case absurd_l hc =>
+--       cases hc
+--       case here hc => cases hss.antisymm hc
+--       case there hc =>
+
+
+--   | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
+--   | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
+--   | subclass_r hsub => exact hd.refine_subclass_node hsub
+--   | @union_r K K1' R K2' hi hs' ih =>
+--     have ⟨hd1, hd2⟩ := hd.union_l_inv
+--     exact refine_union_r hi hs' hd1 hd2 ih
 
 -- theorem Kind.Disjoint.excl_cons_l (hd : Disjoint (.node r1 (a :: ex1)) K2) : Disjoint (.node r1 ex1) K2 := by
 --   cases hd with

From c14ac14a3b4d45bd203efc9a0fb51f0fcd67772f Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 8 Dec 2025 23:26:48 +0100
Subject: [PATCH 38/71] So many cases to handle...

---
 Capless/Classifier.lean | 180 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 177 insertions(+), 3 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 6d96e9fd..1e63c78f 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -362,6 +362,9 @@ inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
     a.Disjoint r1 ->
     Subtract (.node r1 ex1) (.node r2 ex2) R ->
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
+  | excl_absurd_r :
+    r2.Subclass a  ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
   | excl_irrelevant_r :
     a.Disjoint r2 ->
     Subtract (.node r1 ex1) (.node r2 ex2) R ->
@@ -380,6 +383,7 @@ inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   | irrelevant_r :
     r1.Disjoint r2 ->
     Subtract (.node r1 ex1) (.node r2 []) (.node r1 ex1)
+  | empty_r : Subtract (.node r1 ex1) .empty (.node r1 ex1)
   | union_r :
     Subtract (.node r1 ex1) K1 R1 ->
     Subtract R1 K2 R2 ->
@@ -408,6 +412,7 @@ theorem Kind.Subtract.from_empty (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsE
   case irrelevant_r =>
     cases he with
     | absurd ha => exact .absurd ha
+  case empty_r => assumption
   case union_r ih1 ih2 =>
     cases he with
     | absurd ha => exact ih2 (ih1 (.absurd ha))
@@ -431,6 +436,7 @@ theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2
       cases ha
       case here hsub => exact (hss.antisymm hsub).elim
       case there ha => exact ih he (.absurd ha)
+  case excl_absurd_r hs => assumption
   case excl_irrelevant_r hd _ ih =>
     cases hek2 with
     | absurd ha =>
@@ -454,6 +460,7 @@ theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2
   case irrelevant_r =>
     cases hek2 with
     | absurd ha => cases ha
+  case empty_r => assumption
   case union_r ih1 ih2 =>
     cases hek2 with
     | union he2a he2b => exact ih1 (ih2 he he2b) he2a
@@ -619,11 +626,13 @@ theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K
   case absurd_l => exact .empty_l
   case excl_subclass_r ih => exact ih hd
   case excl_disjoint_r ih => exact ih hd
+  case excl_absurd_r hs => assumption
   case excl_irrelevant_r ih => exact ih hd
   case excl_r _ hsub _ ih => exact .union_l (ih hd) (hd.refine_subroot_l hsub)
   case subclass_l hsub => apply! append_excl_l (ex1:=[_])
   case subclass_r => exact .empty_l
   case irrelevant_r => exact hd
+  case empty_r => assumption
   case union_r ih1 ih2 => exact ih2 (ih1 hd)
 
 theorem Kind.Subtract.empty_or_subroot (hs : Subtract (.node r1 ex1) (.node r2 ex2) R) (he : IsEmpty R) : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
@@ -633,6 +642,7 @@ theorem Kind.Subtract.empty_or_subroot (hs : Subtract (.node r1 ex1) (.node r2 e
     cases hs.empty_or_subroot he <;> aesop
   case excl_disjoint_r hss hsc hs =>
     cases hs.empty_or_subroot he <;> aesop
+  case excl_absurd_r hs => cases he; aesop
   case excl_irrelevant_r hd hs =>
     cases hs.empty_or_subroot he <;> aesop
   case excl_r hs =>
@@ -665,6 +675,34 @@ theorem Kind.Subtract.empty_or_subroot (hs : Subtract (.node r1 ex1) (.node r2 e
 --       cases Classifier.subclass_or_disjoint a r1
 --       case inl hs1 =>
 
+theorem Kind.Disjoint.append_l_disj_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hda : a.Disjoint r2) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
+  cases hd
+  case absurd_l hsc =>
+    cases hsc
+    case here hs => apply! root $ hda.refines_subclass_l _
+    case there hsc => apply! absurd_l
+  case absurd_r => apply! absurd_r
+  case root => apply! root
+  case excl_l hsc => apply! excl_l
+  case excl_r hsc =>
+    cases hsc
+    case here hs => cases hda.symm.not_subclass hs
+    case there => apply! excl_r
+
+theorem Kind.Disjoint.append_l_contained_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hsc: ContainsSupOf ex2 a) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
+  cases hd
+  case absurd_l hsc =>
+    cases hsc
+    case here hs => apply! excl_l $ hsc.trans_subclass _
+    case there hsc => apply! absurd_l
+  case absurd_r => apply! absurd_r
+  case root => apply! root
+  case excl_l hsc => apply! excl_l
+  case excl_r hsc =>
+    cases hsc
+    case here hs => apply! absurd_r $ hsc.trans_subclass _
+    case there => apply! excl_r
+
 theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
   induction hs generalizing K
   case empty_l => apply empty_l
@@ -714,6 +752,7 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
       cases hsc
       case here hs => apply! root $ hd.symm.refines_subclass_r _
       case there hsc => apply! ih (excl_r _)
+  case excl_absurd_r hs => assumption
   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
     generalize h : node r2 (a :: ex2) = L at hd2
     induction hd2 generalizing K2 <;> try cases h
@@ -758,15 +797,150 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
     case excl_r hsc =>
       cases hsc
       case here hs =>
-
-        --  apply! root $ hd.symm.refines_subclass_r _
+        cases hd'
+        case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
+        case absurd_r hsc => apply! absurd_r
+        case root hd => cases hd.symm.not_subclass hs
+        case excl_l hsc =>  apply! absurd_r $ hsc.trans_subclass _
+        case excl_r hsc => apply! excl_r
       case there hsc => apply! ih (excl_r _)
+  case subclass_l r1 ex1 r2 hs =>
+    generalize h : node r2 [] = L at hd2
+    induction hd2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      have ⟨_, _⟩ := hdr.union_r_inv
+      simp_all
+      apply! union_r
+    case absurd_l hsc => cases hsc
+    case absurd_r => apply! absurd_r
+    case root hd => apply! hdr.append_l_disj_inv
+    case excl_l hsc => apply! hdr.append_l_contained_inv
+    case excl_r hsc => cases hsc
+  case subclass_r r1 ex1 r2 hs =>
+    generalize h : node r2 [] = L at hd2
+    induction hd2 <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      have ⟨_, _⟩ := hdr.union_r_inv
+      simp_all
+      apply! union_r
+    case absurd_l hsc => cases hsc
+    case absurd_r => apply! absurd_r
+    case root hd => apply! root $ hd.refines_subclass_l _
+    case excl_l hsc => apply! excl_l $ hsc.trans_subclass _
+    case excl_r hsc => cases hsc
+  case irrelevant_r r1 ex1 r2 hd => assumption
+  case empty_r => assumption
+  case union_r ha hb =>
+    have ⟨hl, hr⟩ := hd2.union_l_inv
+    apply ha hl _
+    apply hb hr hdr
+
+theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
+  induction he
+  case empty => apply empty_l
+  case absurd => apply! absurd_l'
+  case union ha hb => apply! union_l
+
+theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
+  apply refine_disjoint_subtract_l hd hs
+  apply is_empty_l he
+
+theorem Kind.Disjoint.refine_subkind_l (hd : Disjoint K2 K) (hs : Subkind K1 K2) : Disjoint K1 K := by
+  cases hs
+  apply! hd.refine_subkind_l'
+
+theorem Kind.Subkind.refine_disjoint_l (hs : Subkind K1 K2) (hd : Disjoint K2 K) : Disjoint K1 K := hd.refine_subkind_l hs
 
+theorem Kind.Subtract.exists' : ∃ R, Subtract (node r1 ex1) (node r2 ex2) R := by
+  induction ex2
+  case nil =>
+    cases r1.subclass_or_disjoint r2
+    case inl hs => exists empty; apply subclass_r hs
+    case inr hs =>
+      cases hs
+      case inl hs => exists (node r1 (r2 :: ex1)); apply subclass_l hs
+      case inr hd => exists (node r1 ex1); apply irrelevant_r hd
+  case cons head tail ih =>
+    cases head.subclass_or_disjoint r2
+    case inl hs =>
+      cases hs.might_strict
+      case inl he => cases he; exists node r1 ex1; apply excl_absurd_r hs
+      case inr hss =>
+
+theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
+  induction b generalizing a
+  case empty =>
+    induction a
+    case empty => exists empty; apply! empty_l
+    case node r1 ex1 => exists node r1 ex1; apply empty_r
+    case union ha hb =>
+      have ⟨r1, h1⟩ := ha
+      have ⟨r2, h2⟩ := hb
+      exists .union r1 r2
+      apply! union_l
+  case union hb1 hb2 =>
+    induction a
+    case empty => exists empty; apply! empty_l
+    case node r1 ex1 =>
+      have ⟨r1, h1⟩ := hb1 (a := node r1 ex1)
+      have ⟨r2, h2⟩ := hb2 (a := r1)
+      exists r2; apply! union_r
+    case union ha1 ha2 =>
+      have ⟨r1, h1⟩ := ha1
+      have ⟨r2, h2⟩ := ha2
+      exists .union r1 r2
+      apply! union_l
+  case node r2 ex2 =>
+    induction a
+    case empty => exists empty; apply! empty_l
+    case node r1 ex1 =>
+      have ⟨r1, h1⟩ := hb1 (a := node r1 ex1)
+      have ⟨r2, h2⟩ := hb2 (a := r1)
+      exists r2; apply! union_r
+    case union ha1 ha2 =>
+      have ⟨r1, h1⟩ := ha1
+      have ⟨r2, h2⟩ := ha2
+      exists .union r1 r2
+      apply! union_l
+
+
+
+
+
+theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3)  : Subkind K1 K2 := by
+  cases hs1
+  cases hs2
+  rename_i
+
+
+-- theorem Kind.Subkind.empty_l : Subkind .empty K := by
+--   constructor
+--   constructor
+--   constructor
+
+-- theorem Kind.Subtract.union_r_inv (hs : Subtract K (.union K1 K2) R) : ∃ R1 R2, Subtract K K1 R1 ∧  Subtract R1 K2 R2 ∧ Subkind R2 R ∧ Subkind R R2 := by
+--   cases hs
+--   case empty_l =>
+--     exists empty, empty
+--     apply And.intro .empty_l
+--     apply And.intro .empty_l
+--     apply And.intro .empty_l
+--     exact .empty_l
+--   case union_l ha hb =>
 
 
+-- theorem Kind.Subtract.rfl (hs : Subtract K K R) : IsEmpty R := by
+--   cases hs
+--   case empty_l => constructor
+--   case union_l ha hb =>
 
+-- theorem Kind.Intersect.is_subkind (hi : Intersect K1 K2 R) : Subkind R K1 ∧ Subkind R K2 := by
+--   induction hi
+--   case empty_l => apply And.intro <;> apply Subkind.empty_l
+--   case empty_r => apply
 
--- theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
 --   induction hs generalizing K
 --   case empty_l => exact .empty_l
 --   case union_l ih1 ih2 =>

From 7f5b37f1f2cfdb32ce803e0d68852d94b2b36237 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 9 Dec 2025 17:32:55 +0100
Subject: [PATCH 39/71] Some progress

---
 Capless/Classifier.lean | 438 ++++++++++++++++++++--------------------
 1 file changed, 216 insertions(+), 222 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 1e63c78f..85c7ed6f 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -334,11 +334,14 @@ theorem ContainsSupOf.of_append (h : ContainsSupOf (xs ++ ys) b) : ContainsSupOf
       | inl h => exact .inl (.there h)
       | inr h => exact .inr h
 
-inductive IsEmpty : Kind -> Prop where
+inductive Kind.IsEmpty : Kind -> Prop where
   | empty : IsEmpty .empty
   | absurd : ContainsSupOf exs r -> IsEmpty (.node r exs)
   | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
 
+theorem Kind.IsEmpty.is_absurd (he : IsEmpty (.node r exs)) : ContainsSupOf exs r := by
+  cases he; assumption
+
 inductive Intersect : Kind -> Kind -> Kind -> Prop where
   | empty_l : Intersect .empty K .empty
   | empty_r : Intersect K .empty .empty
@@ -351,119 +354,131 @@ inductive Intersect : Kind -> Kind -> Kind -> Prop where
 inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   | empty_l : Subtract .empty K .empty
   | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
-  | absurd_l : ContainsSupOf ex1 r1 -> Subtract (.node r1 ex1) K .empty
-  | excl_subclass_r :
-    a.StrictSub r2 ->
-    ContainsSupOf ex1 a ->
-    Subtract (.node r1 ex1) (.node r2 ex2) R ->
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
-  | excl_disjoint_r :
-    a.StrictSub r2 ->
-    a.Disjoint r1 ->
-    Subtract (.node r1 ex1) (.node r2 ex2) R ->
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
+  | empty_r : Subtract (.node r1 ex1) .empty (.node r1 ex1)
+  | union_r :
+    Subtract (.node r1 ex1) K1 R1 ->
+    Subtract R1 K2 R2 ->
+    Subtract (.node r1 ex1) (.union K1 K2) R2
+  -- The singleton cases
+  -- Basically we follow a few broad strokes:
+  -- - A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
+  -- - For B of the form (.node r []) (no exclusion):
+  --   - If r < A, refine A
+  --   - If r > A, empty
+  --   - If r ⊥ A, A
+  -- Base case first
+  | tree : Subtract (.node r1 ex1) (.node r2 []) (.node r1 (r2 :: ex1))
+  -- Exclusion case
+  -- First, handle the cases where (B \ C) doesn't make sense
   | excl_absurd_r :
-    r2.Subclass a  ->
+    r2.Subclass a -> -- (B \ a) is just empty
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
   | excl_irrelevant_r :
-    a.Disjoint r2 ->
+    r2.Disjoint a -> -- (B \ a) = B
     Subtract (.node r1 ex1) (.node r2 ex2) R ->
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
-  | excl_r :
-    a.Disjoint r2 ->
-    a.Subclass r1 ->
+  -- Now, for cases where a is a subtree of r2
+  -- We use the formula A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
+  | excl_subclass_r :
+    a.Subclass r2 ->
+    a.Subclass r1 -> -- A ∩ B ∩ C = a with all the exclusions
     Subtract (.node r1 ex1) (.node r2 ex2) R ->
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.union R (.node a ex1))
-  | subclass_l :
-    r2.Subclass r1 ->
-    Subtract (.node r1 ex1) (.node r2 []) (.node r1 (r2 :: ex1))
-  | subclass_r :
-    r1.Subclass r2 ->
-    Subtract (.node r1 ex1) (.node r2 []) .empty
-  | irrelevant_r :
-    r1.Disjoint r2 ->
-    Subtract (.node r1 ex1) (.node r2 []) (.node r1 ex1)
-  | empty_r : Subtract (.node r1 ex1) .empty (.node r1 ex1)
-  | union_r :
-    Subtract (.node r1 ex1) K1 R1 ->
-    Subtract R1 K2 R2 ->
-    Subtract (.node r1 ex1) (.union K1 K2) R2
+                                        -- ^ we'd need (ex1 ++ ex2) here to be exact,
+                                        -- but if an element is in the ex2 subtree
+                                        -- and not already excluded from A, it is part
+                                        -- of (A \ B), so it's okay to keep anyway.
+  | excl_subclass_l :
+    a.Subclass r2 ->
+    r1.Subclass a ->  -- B \ C excludes the entirety of A
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
+  | excl_irrelevant_l :
+    a.Subclass r2 ->
+    r1.Disjoint a -> -- irrelevant exclusion, A ∪ B ∪ C = empty
+    Subtract (.node r1 ex1) (.node r2 ex2) R ->
+    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
 
 inductive Kind.Subkind : Kind -> Kind -> Prop where
   | subtract : Subtract K1 K2 R -> IsEmpty R -> Subkind K1 K2
 
-theorem Kind.Subtract.from_empty (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsEmpty R := by
+theorem Kind.Subtract.is_empty_l (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsEmpty R := by
   induction hs
   case empty_l => constructor
-  case union_l ih1 ih2 =>
-    cases he with
-    | union he1 he2 => exact .union (ih1 he1) (ih2 he2)
-  case absurd_l => constructor
-  case excl_subclass_r ih => exact ih he
-  case excl_disjoint_r ih => exact ih he
-  case excl_irrelevant_r ih => exact ih he
-  case excl_r _ hsub _ ih =>
-    cases he with
-    | absurd ha => exact .union (ih (.absurd ha)) (.absurd (ha.trans_subclass hsub))
-  case subclass_l hsub =>
-    cases he with
-    | absurd ha => apply! IsEmpty.absurd $ .there _
-  case subclass_r => constructor
-  case irrelevant_r =>
-    cases he with
-    | absurd ha => exact .absurd ha
+  case union_l ha hb =>
+    cases he
+    apply! IsEmpty.union (ha _) (hb _)
   case empty_r => assumption
-  case union_r ih1 ih2 =>
-    cases he with
-    | absurd ha => exact ih2 (ih1 (.absurd ha))
+  case union_r ha hb =>
+    apply hb
+    apply! ha
+  case tree => constructor; exact .there he.is_absurd
+  case excl_absurd_r => assumption
+  case excl_irrelevant_r ih => apply! ih
+  case excl_subclass_r hs2 hs1 _ ih =>
+    constructor; apply! ih;
+    constructor; cases he
+    apply! ContainsSupOf.trans_subclass
+  case excl_subclass_l hs2 hs1 => assumption
+  case excl_irrelevant_l ih => apply! ih
+
+
+theorem Kind.Subtract.absurd_l (hs : Subtract (.node r1 ex1) K R) (hsc : ContainsSupOf ex1 r1) : IsEmpty R := by
+  apply hs.is_empty_l
+  constructor
+  assumption
+
+theorem Kind.Subtract.empty_implies_subclass
+  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+  (he : IsEmpty R)
+  : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
+  cases hs
+  case tree =>
+    cases he.is_absurd <;> aesop
+  case excl_absurd_r => left; apply he.is_absurd
+  case excl_irrelevant_r hs => apply hs.empty_implies_subclass he
+  case excl_subclass_r hs =>
+    cases he
+    apply! hs.empty_implies_subclass
+  case excl_subclass_l => left; apply he.is_absurd
+  case excl_irrelevant_l hs => apply! hs.empty_implies_subclass
 
 theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2 : IsEmpty K2) : IsEmpty K1 := by
   induction hs
   case empty_l => constructor
-  case union_l ih1 ih2 =>
-    cases he with
-    | union he1 he2 => exact .union (ih1 he1 hek2) (ih2 he2 hek2)
-  case absurd_l ha => exact .absurd ha
-  case excl_subclass_r hss hc _ ih =>
-    cases hek2 with
-    | absurd ha =>
-      cases ha
-      case here hsub => exact (hss.antisymm hsub).elim
-      case there ha => exact ih he (.absurd ha)
-  case excl_disjoint_r hss _ _ ih =>
-    cases hek2 with
-    | absurd ha =>
-      cases ha
-      case here hsub => exact (hss.antisymm hsub).elim
-      case there ha => exact ih he (.absurd ha)
-  case excl_absurd_r hs => assumption
-  case excl_irrelevant_r hd _ ih =>
-    cases hek2 with
-    | absurd ha =>
-      cases ha
-      case here hsub => exact (hd.symm.not_subclass hsub).elim
-      case there ha => exact ih he (.absurd ha)
-  case excl_r hd hsub _ ih =>
-    cases he with
-    | union heR heA =>
-      cases hek2 with
-      | absurd ha =>
-        cases ha
-        case here hsub2 => exact (hd.symm.not_subclass hsub2).elim
-        case there ha => exact ih heR (.absurd ha)
-  case subclass_l =>
-    cases hek2 with
-    | absurd ha => cases ha
-  case subclass_r =>
-    cases hek2 with
-    | absurd ha => cases ha
-  case irrelevant_r =>
-    cases hek2 with
-    | absurd ha => cases ha
+  case union_l ha hb =>
+    cases he
+    constructor
+    apply! ha
+    apply! hb
   case empty_r => assumption
-  case union_r ih1 ih2 =>
-    cases hek2 with
-    | union he2a he2b => exact ih1 (ih2 he he2b) he2a
+  case union_r ha hb =>
+    cases hek2
+    simp_all
+  case tree => cases hek2.is_absurd
+  case excl_absurd_r hs => assumption
+  case excl_irrelevant_r hd hs ih =>
+    cases hek2.is_absurd
+    case here hsk => cases hd.not_subclass hsk
+    case there hek2 => apply! ih _ (.absurd hek2)
+  case excl_subclass_r hs2 hs1 hs ih =>
+    cases he
+    cases hek2.is_absurd
+    case here hsk =>
+      cases hs2.antisymm hsk
+      rename_i h _
+      cases hs.empty_implies_subclass h
+      case inl => constructor; assumption
+      case inr hsk2 => cases hsk2.antisymm hs1; assumption
+    case there hsk => apply! ih _ (.absurd _)
+  case excl_subclass_l => assumption
+  case excl_irrelevant_l hs2 hd1 hs ih =>
+    cases hek2.is_absurd
+    case here hsa =>
+      cases hs2.antisymm hsa
+      cases hs.empty_implies_subclass he
+      case inl h1 => exact .absurd h1
+      case inr h1 => cases hd1.not_subclass h1
+    case there hsc => apply ih he (.absurd hsc)
 
 theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
   cases hs
@@ -623,57 +638,17 @@ theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K
   case union_l ih1 ih2 =>
     have ⟨hd1, hd2⟩ := hd.union_l_inv
     exact .union_l (ih1 hd1) (ih2 hd2)
-  case absurd_l => exact .empty_l
-  case excl_subclass_r ih => exact ih hd
-  case excl_disjoint_r ih => exact ih hd
-  case excl_absurd_r hs => assumption
-  case excl_irrelevant_r ih => exact ih hd
-  case excl_r _ hsub _ ih => exact .union_l (ih hd) (hd.refine_subroot_l hsub)
-  case subclass_l hsub => apply! append_excl_l (ex1:=[_])
-  case subclass_r => exact .empty_l
-  case irrelevant_r => exact hd
   case empty_r => assumption
   case union_r ih1 ih2 => exact ih2 (ih1 hd)
-
-theorem Kind.Subtract.empty_or_subroot (hs : Subtract (.node r1 ex1) (.node r2 ex2) R) (he : IsEmpty R) : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
-  cases hs
-  case absurd_l => left; assumption
-  case excl_subclass_r hss hsc hs =>
-    cases hs.empty_or_subroot he <;> aesop
-  case excl_disjoint_r hss hsc hs =>
-    cases hs.empty_or_subroot he <;> aesop
-  case excl_absurd_r hs => cases he; aesop
-  case excl_irrelevant_r hd hs =>
-    cases hs.empty_or_subroot he <;> aesop
-  case excl_r hs =>
-    cases he
-    rename_i he1 he2
-    cases hs.empty_or_subroot he1 <;> aesop
-  case subclass_l hs =>
-    cases he
-    rename_i he
-    cases he
-    case here he => cases hs.antisymm he; right; constructor
-    case there => aesop
-  case subclass_r => aesop
-  case irrelevant_r => cases he; aesop
-
--- theorem Kind.Disjoint.refine_subclass_l (hd : Disjoint (.node r2 ex2) K) (hs : Classifier.Subclass r1 r2) : ContainsSupOf ex2 r2 ∨ Disjoint (.node r1 ex1) K := by
---   cases hd
---   case empty_r => right; apply! empty_r
---   case union_r h1 h2 =>
---     cases h1.refine_subclass_l hs (ex1:=ex1); aesop
---     cases h2.refine_subclass_l hs (ex1:=ex1); aesop
---     right; apply! union_r
---   case absurd_l hsc => aesop
---   case absurd_r hsc => right; apply! absurd_r
---   case root hd => right; apply root $ hd.refines_subclass_l hs
---   case excl_l hsc => right; apply excl_l $ hsc.trans_subclass hs
---   case excl_r r2' ex2' hsc =>
---     induction hsc
---     case here a xs r2' hss =>
---       cases Classifier.subclass_or_disjoint a r1
---       case inl hs1 =>
+  case tree => apply! hd.append_excl_l (ex1 := [_])
+  case excl_absurd_r => assumption
+  case excl_irrelevant_r ih => apply! ih
+  case excl_subclass_r hs1 _ ih =>
+    apply Disjoint.union_l
+    apply! ih
+    apply! hd.refine_subroot_l
+  case excl_subclass_l => assumption
+  case excl_irrelevant_l ih => apply! ih
 
 theorem Kind.Disjoint.append_l_disj_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hda : a.Disjoint r2) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
   cases hd
@@ -703,45 +678,97 @@ theorem Kind.Disjoint.append_l_contained_inv (hd : Disjoint (.node r1 (a :: ex1)
     case here hs => apply! absurd_r $ hsc.trans_subclass _
     case there => apply! excl_r
 
+theorem Kind.Disjoint.refine_disjoint_subtract_l_disjoint_root
+  (hdr : Disjoint R K)
+  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+  (hd : r1.Disjoint r2)
+  : Disjoint (.node r1 ex1) K := by
+  cases hs
+  case tree =>
+    generalize h : node r1 (r2 :: ex1) = L at hdr
+    induction hdr <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb => simp_all; apply! union_r
+    case absurd_l hsc =>
+      cases hsc
+      case here hs => cases hd.not_subclass hs
+      case there hsc => apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root hd2 => apply! root
+    case excl_l => apply! excl_l
+    case excl_r hsc =>
+      cases hsc
+      case here hs => apply! root $ hd.refines_subclass_r _
+      case there hsc => apply! excl_r
+  case excl_absurd_r => assumption
+  case excl_irrelevant_r hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
+  case excl_subclass_r hs =>
+    have ⟨hl, _⟩ := hdr.union_l_inv
+    apply! hl.refine_disjoint_subtract_l_disjoint_root _ hd
+  case excl_subclass_l => assumption
+  case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
+
+
+
+
 theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
   induction hs generalizing K
   case empty_l => apply empty_l
   case union_l ih1 ih2 =>
     have ⟨_, _⟩ := hdr.union_l_inv
     apply! union_l (ih1 _ _) (ih2 _ _)
-  case absurd_l => apply! absurd_l'
-  case excl_subclass_r ex1 a r1 r2 ex2 _  hss hsc hs ih =>
-    generalize h : node r2 (a :: ex2) = L at hd2
-    induction hd2 generalizing K2 <;> try cases h
+  case empty_r => assumption
+  case union_r ha hb =>
+    have ⟨hl, hr⟩ := hd2.union_l_inv
+    apply ha hl _
+    apply hb hr hdr
+  case tree r1 ex1 r2 =>
+    generalize h : node r1 (r2 :: ex1) = L at hdr
+    induction hdr <;> try cases h
     case empty_r => apply! empty_r
     case union_r ha hb =>
+      have ⟨_, _⟩ := hd2.union_r_inv
       simp_all
-      have ⟨_, _⟩ := hdr.union_r_inv
-      apply! union_r (ha _) (hb _)
+      apply! union_r
     case absurd_l hsc =>
       cases hsc
-      case here hsc => cases hss.antisymm hsc
-      case there hsc =>
-        apply ih _ hdr
-        apply! absurd_l
+      case here hs =>
+        cases hd2
+        case absurd_l hsc => cases hsc
+        case absurd_r hsc => apply! absurd_r
+        case root hd =>  apply root; apply! hd.refines_subclass_l _
+        case excl_l hsc => apply excl_l; apply! hsc.trans_subclass
+        case excl_r hsc => cases hsc
+      case there hsc => apply! absurd_l
     case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr
-    case excl_l hsc => apply! ih (.excl_l _)
+    case root => apply! root
+    case excl_l => apply! excl_l
     case excl_r hsc =>
       cases hsc
-      case here hs => apply excl_r $ hsc.trans_subclass hs
-      case there hsc => apply! ih (excl_r _)
-  case excl_disjoint_r r1 ex1 r2 ex2 _ a hss hd hs ih =>
+      case here hs =>
+        cases hd2
+        case absurd_r hsc => apply! absurd_r
+        case root hd => cases hd.symm.not_subclass hs
+        case excl_l hsc => apply absurd_r; apply! hsc.trans_subclass
+        case excl_r hsc => cases hsc
+        case absurd_l hsc => cases hsc
+      case there hsc => apply! excl_r
+  case excl_subclass_r r1 ex1 r2 ex2 _ a hss hsc hs ih =>
+    have ⟨hdr1, hdr2⟩ := hdr.union_l_inv
     generalize h : node r2 (a :: ex2) = L at hd2
     induction hd2 generalizing K2 <;> try cases h
     case empty_r => apply! empty_r
     case union_r ha hb =>
       simp_all
       have ⟨_, _⟩ := hdr.union_r_inv
-      apply! union_r (ha _) (hb _)
+      have ⟨_, _⟩ := hdr1.union_r_inv
+      have ⟨_, _⟩ := hdr2.union_r_inv
+      apply! union_r (ha _ _ _) (hb _ _ _)
     case absurd_l hsc =>
       cases hsc
-      case here hsc => cases hss.antisymm hsc
+      case here hsc1 =>
+        cases hss.antisymm hsc1
+
       case there hsc =>
         apply ih _ hdr
         apply! absurd_l
@@ -750,7 +777,7 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
     case excl_l hsc => apply! ih (.excl_l _)
     case excl_r hsc =>
       cases hsc
-      case here hs => apply! root $ hd.symm.refines_subclass_r _
+      case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
       case there hsc => apply! ih (excl_r _)
   case excl_absurd_r hs => assumption
   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
@@ -763,7 +790,7 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
       apply! union_r (ha _) (hb _)
     case absurd_l hsc =>
       cases hsc
-      case here hsc => cases hd.symm.not_subclass hsc
+      case here hsc => cases hd.not_subclass hsc
       case there hsc =>
         apply ih _ hdr
         apply! absurd_l
@@ -772,70 +799,32 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
     case excl_l hsc => apply! ih (.excl_l _)
     case excl_r hsc =>
       cases hsc
-      case here hs => apply ih _ hdr; apply root; apply! hd.symm.refines_subclass_r
+      case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
       case there hsc => apply! ih (excl_r _)
-  case excl_r r1 ex1 r2 ex2 _ a hd hsc hs ih =>
-    have ⟨hdr', hd'⟩ := hdr.union_l_inv
+  case excl_subclass_l hs2 hs1 => assumption
+  case excl_irrelevant_l r1 ex1 r2 ex2 _ a hs2 hd1 hs ih =>
     generalize h : node r2 (a :: ex2) = L at hd2
     induction hd2 generalizing K2 <;> try cases h
     case empty_r => apply! empty_r
     case union_r ha hb =>
       simp_all
       have ⟨_, _⟩ := hdr.union_r_inv
-      have ⟨_, _⟩ := hdr'.union_r_inv
-      have ⟨hl, hr⟩ := hd'.union_r_inv
-      apply! union_r (ha _ _ _) (hb _ _ _)
+      apply! union_r (ha _) (hb _)
     case absurd_l hsc =>
       cases hsc
-      case here hsc => cases hd.symm.not_subclass hsc
+      case here hsc =>
+        cases hs2.antisymm hsc
+        apply! hdr.refine_disjoint_subtract_l_disjoint_root hs
       case there hsc =>
-        apply ih _ hdr'
+        apply ih _ hdr
         apply! absurd_l
     case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr'
+    case root hd1 => apply ih (.root hd1) hdr
     case excl_l hsc => apply! ih (.excl_l _)
     case excl_r hsc =>
       cases hsc
-      case here hs =>
-        cases hd'
-        case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
-        case absurd_r hsc => apply! absurd_r
-        case root hd => cases hd.symm.not_subclass hs
-        case excl_l hsc =>  apply! absurd_r $ hsc.trans_subclass _
-        case excl_r hsc => apply! excl_r
+      case here hs => apply root; apply! hd1.refines_subclass_r
       case there hsc => apply! ih (excl_r _)
-  case subclass_l r1 ex1 r2 hs =>
-    generalize h : node r2 [] = L at hd2
-    induction hd2 <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      have ⟨_, _⟩ := hdr.union_r_inv
-      simp_all
-      apply! union_r
-    case absurd_l hsc => cases hsc
-    case absurd_r => apply! absurd_r
-    case root hd => apply! hdr.append_l_disj_inv
-    case excl_l hsc => apply! hdr.append_l_contained_inv
-    case excl_r hsc => cases hsc
-  case subclass_r r1 ex1 r2 hs =>
-    generalize h : node r2 [] = L at hd2
-    induction hd2 <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      have ⟨_, _⟩ := hdr.union_r_inv
-      simp_all
-      apply! union_r
-    case absurd_l hsc => cases hsc
-    case absurd_r => apply! absurd_r
-    case root hd => apply! root $ hd.refines_subclass_l _
-    case excl_l hsc => apply! excl_l $ hsc.trans_subclass _
-    case excl_r hsc => cases hsc
-  case irrelevant_r r1 ex1 r2 hd => assumption
-  case empty_r => assumption
-  case union_r ha hb =>
-    have ⟨hl, hr⟩ := hd2.union_l_inv
-    apply ha hl _
-    apply hb hr hdr
 
 theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
   induction he
@@ -855,19 +844,24 @@ theorem Kind.Subkind.refine_disjoint_l (hs : Subkind K1 K2) (hd : Disjoint K2 K)
 
 theorem Kind.Subtract.exists' : ∃ R, Subtract (node r1 ex1) (node r2 ex2) R := by
   induction ex2
-  case nil =>
-    cases r1.subclass_or_disjoint r2
-    case inl hs => exists empty; apply subclass_r hs
-    case inr hs =>
-      cases hs
-      case inl hs => exists (node r1 (r2 :: ex1)); apply subclass_l hs
-      case inr hd => exists (node r1 ex1); apply irrelevant_r hd
+  case nil => exists node r1 (r2 :: ex1); apply tree
   case cons head tail ih =>
-    cases head.subclass_or_disjoint r2
+    cases r2.subclass_or_disjoint head
     case inl hs =>
-      cases hs.might_strict
-      case inl he => cases he; exists node r1 ex1; apply excl_absurd_r hs
-      case inr hss =>
+      exists node r1 ex1
+      apply! excl_absurd_r
+    case inr hs =>
+      cases hs
+      case inl hs =>
+        cases r1.subclass_or_disjoint head
+        case inl hs1 => exists node r1 ex1; apply! excl_subclass_l
+        case inr hs1 =>
+          cases hs1
+          case inl hs1 =>
+            have ⟨R1, h⟩ := ih
+            exists .union R1 (.node head ex1)
+            apply excl_subclass_r
+
 
 theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
   induction b generalizing a

From 449d305246af725bd31e1d6a81b2ce85b5123bf3 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 9 Dec 2025 21:35:27 +0100
Subject: [PATCH 40/71] We might need some relation between Subtract and
 Subkind to prove linking properties

---
 Capless/Classifier.lean | 318 ++++++++++++++++++++++++++++++++++++----
 1 file changed, 293 insertions(+), 25 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 85c7ed6f..6252e28c 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -160,9 +160,12 @@ theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b)
     apply ih hd
 
 theorem Classifier.subclass_or_disjoint a b:
-  Subclass a b ∨ Subclass b a ∨ Disjoint a b := by
+  Subclass a b ∨ StrictSub b a ∨ Disjoint a b := by
   induction a
-  case top => right; left; apply Subclass.of_top
+  case top =>
+    cases Subclass.of_top (a:=b).might_strict
+    case inl => simp_all; left; exact .rfl
+    case inr => aesop
   case child n k ih =>
     cases ih
     case inl ih =>
@@ -170,14 +173,17 @@ theorem Classifier.subclass_or_disjoint a b:
     case inr ih =>
       cases ih
       case inl ih =>
-        cases ih.down_r
+        cases ih.weaken.down_r
         { subst_vars; left; apply Subclass.parent_l .rfl }
         { rename_i ih1; have ⟨m, ih1⟩ := ih1;
           generalize h : (n == m) = h0;
           cases h0
           right; right;
           apply Disjoint.refines_subclass_r; apply Disjoint.base (m:=m); aesop; assumption
-          have h0 := LawfulBEq.eq_of_beq h; subst_vars; right; left; assumption
+          have h0 := LawfulBEq.eq_of_beq h; subst_vars
+          cases ih1.might_strict
+          . left; subst_vars; exact .rfl
+          . aesop
         }
       case inr ih =>
         right; right; apply Disjoint.left ih
@@ -371,7 +377,7 @@ inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   -- Exclusion case
   -- First, handle the cases where (B \ C) doesn't make sense
   | excl_absurd_r :
-    r2.Subclass a -> -- (B \ a) is just empty
+    r2.StrictSub a -> -- (B \ a) is just empty
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
   | excl_irrelevant_r :
     r2.Disjoint a -> -- (B \ a) = B
@@ -390,7 +396,7 @@ inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
                                         -- of (A \ B), so it's okay to keep anyway.
   | excl_subclass_l :
     a.Subclass r2 ->
-    r1.Subclass a ->  -- B \ C excludes the entirety of A
+    r1.StrictSub a ->  -- B \ C excludes the entirety of A
     Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
   | excl_irrelevant_l :
     a.Subclass r2 ->
@@ -708,6 +714,45 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l_disjoint_root
   case excl_subclass_l => assumption
   case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
 
+theorem Kind.Disjoint.refine_disjoint_subtract_l_subroot
+  (hdr : Disjoint R K)
+  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+  (hsub : r2.Subclass r1)
+  (hd2 : Disjoint (.node r2 ex1) K)
+  : Disjoint (.node r1 ex1) K := by
+  cases hs
+  case tree =>
+    generalize h : node r1 (r2 :: ex1) = L at hdr
+    induction hdr <;> try cases h
+    case empty_r => apply! empty_r
+    case union_r ha hb =>
+      have ⟨_, _⟩ := hd2.union_r_inv
+      simp_all
+      apply! union_r
+    case absurd_l hsc =>
+      cases hsc
+      case here hs2 => cases hsub.antisymm hs2; assumption
+      case there => apply! absurd_l
+    case absurd_r => apply! absurd_r
+    case root => apply! root
+    case excl_l => apply! excl_l
+    case excl_r hsc =>
+      cases hsc
+      case here hs2 =>
+        cases hd2
+        case absurd_l => apply excl_r; apply! ContainsSupOf.trans_subclass
+        case absurd_r => apply! absurd_r
+        case root hd => cases hd.symm.not_subclass hs2
+        case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
+        case excl_r hsc => apply! excl_r
+      case there hsc => apply! excl_r
+  case excl_absurd_r => assumption
+  case excl_irrelevant_r hs =>  apply! hdr.refine_disjoint_subtract_l_subroot
+  case excl_subclass_r hs =>
+    have ⟨hl, _⟩ := hdr.union_l_inv
+    apply! hl.refine_disjoint_subtract_l_subroot
+  case excl_subclass_l => assumption
+  case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_subroot
 
 
 
@@ -768,16 +813,22 @@ theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Sub
       cases hsc
       case here hsc1 =>
         cases hss.antisymm hsc1
-
+        apply! hdr1.refine_disjoint_subtract_l_subroot
       case there hsc =>
-        apply ih _ hdr
+        apply ih _ hdr1
         apply! absurd_l
     case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr
+    case root hd1 => apply ih (.root hd1) hdr1
     case excl_l hsc => apply! ih (.excl_l _)
     case excl_r hsc =>
       cases hsc
-      case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
+      case here hs =>
+        cases hdr2
+        case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
+        case absurd_r => apply! absurd_r
+        case root hd => cases hd.symm.not_subclass hs
+        case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
+        case excl_r => apply! excl_r
       case there hsc => apply! ih (excl_r _)
   case excl_absurd_r hs => assumption
   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
@@ -846,22 +897,30 @@ theorem Kind.Subtract.exists' : ∃ R, Subtract (node r1 ex1) (node r2 ex2) R :=
   induction ex2
   case nil => exists node r1 (r2 :: ex1); apply tree
   case cons head tail ih =>
-    cases r2.subclass_or_disjoint head
+    cases head.subclass_or_disjoint r2
     case inl hs =>
-      exists node r1 ex1
-      apply! excl_absurd_r
+      have ⟨R, h⟩ := ih
+      cases head.subclass_or_disjoint r1
+      case inl hs1 =>
+        exists .union R (.node head ex1)
+        apply! excl_subclass_r
+      case inr hs1 =>
+        cases hs1
+        case inl hs1 =>
+          exists node r1 ex1
+          apply! excl_subclass_l
+        case inr hs1 =>
+          exists R
+          apply! excl_irrelevant_l _ hs1.symm
     case inr hs =>
       cases hs
       case inl hs =>
-        cases r1.subclass_or_disjoint head
-        case inl hs1 => exists node r1 ex1; apply! excl_subclass_l
-        case inr hs1 =>
-          cases hs1
-          case inl hs1 =>
-            have ⟨R1, h⟩ := ih
-            exists .union R1 (.node head ex1)
-            apply excl_subclass_r
-
+        exists node r1 ex1
+        apply! excl_absurd_r
+      case inr hs =>
+        have ⟨R, h⟩ := ih
+        exists R
+        apply! excl_irrelevant_r hs.symm
 
 theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
   induction b generalizing a
@@ -890,19 +949,228 @@ theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
     induction a
     case empty => exists empty; apply! empty_l
     case node r1 ex1 =>
-      have ⟨r1, h1⟩ := hb1 (a := node r1 ex1)
-      have ⟨r2, h2⟩ := hb2 (a := r1)
-      exists r2; apply! union_r
+      apply exists'
     case union ha1 ha2 =>
       have ⟨r1, h1⟩ := ha1
       have ⟨r2, h2⟩ := ha2
       exists .union r1 r2
       apply! union_l
 
+theorem Kind.Subtract.is_empty_append_l
+  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+  (he : IsEmpty R)
+  (hs1 : Subtract (.node r1 (a :: ex1)) (.node r2 ex2) R1)
+  : IsEmpty R1 := by
+  induction ex2 generalizing R R1
+  case nil =>
+    cases hs1
+    cases hs
+    constructor
+    cases he.is_absurd
+    case here hs => apply! ContainsSupOf.here
+    case there hsc => exact .there $ .there hsc
+  case cons head tail ih =>
+    cases hs
+    case excl_absurd_r hs =>
+      cases hs1
+      case excl_absurd_r => constructor; cases he; apply! ContainsSupOf.there
+      case excl_irrelevant_r hd hs1 => cases hd.not_subclass hs.weaken
+      case excl_subclass_r hs1 hs2 hsa => cases hs.antisymm hs2
+      case excl_subclass_l => constructor; cases he; apply! ContainsSupOf.there
+      case excl_irrelevant_l hd hs2 hs1 => cases hs.antisymm hs2
+    case excl_irrelevant_r hd hs =>
+      cases hs1
+      case excl_absurd_r hsub => cases hd.not_subclass hsub.weaken
+      case excl_irrelevant_r hs1 => apply! ih
+      case excl_subclass_r hsub1 hsub2 hs1 => cases hd.symm.not_subclass hsub2
+      case excl_subclass_l hsub => cases hd.symm.not_subclass hsub
+      case excl_irrelevant_l hsub _ => cases hd.symm.not_subclass hsub
+    case excl_subclass_r hsub1 hsub2 hs =>
+      cases he
+      rename_i he1 he
+      cases hs1
+      case excl_absurd_r hsub =>
+        constructor
+        cases hsub.antisymm hsub2
+      case excl_irrelevant_r hd hs1 => apply! ih
+      case excl_subclass_r =>
+        constructor
+        . apply! ih
+        . constructor; cases he; apply! ContainsSupOf.there
+      case excl_subclass_l hsub _ => cases hsub.antisymm hsub1
+      case excl_irrelevant_l hd _ _ => cases hd.symm.not_subclass hsub1
+    case excl_subclass_l hsub1 hsub2 =>
+      have ⟨R, h⟩ := Subtract.exists (node r1 ex1) (node r2 tail)
+      have he1 := h.is_empty_l he
+      cases hs1
+      case excl_absurd_r => constructor; cases he; apply! ContainsSupOf.there
+      case excl_irrelevant_r hd hs => cases hd.symm.not_subclass hsub2
+      case excl_subclass_r hsub _ hs1 =>
+        cases hsub.antisymm hsub1.weaken
+        constructor
+        . apply! ih
+        . constructor; cases he; apply! ContainsSupOf.there
+      case excl_subclass_l => constructor; cases he; apply! ContainsSupOf.there
+      case excl_irrelevant_l hd _ _ => cases hd.not_subclass hsub1.weaken
+    case excl_irrelevant_l hd hsub2 hs =>
+      cases hs1
+      case excl_absurd_r hsub => cases hsub.antisymm hsub2
+      case excl_irrelevant_r hd2 hs => apply! ih
+      case excl_subclass_r hsub1 _ hs1 => cases hd.symm.not_subclass hsub1
+      case excl_subclass_l hsub1 _ => cases hd.not_subclass hsub1.weaken
+      case excl_irrelevant_l hsub2 hs1 => apply! ih
+
+theorem Kind.Subtract.unique
+  (hs1 : Subtract K1 K2 R1)
+  (hs2 : Subtract K1 K2 R2)
+  : R1 = R2 := by
+  induction hs1 generalizing R2
+  case empty_l => cases hs2; simp
+  case union_l ha hb =>
+    cases hs2
+    simp
+    apply And.intro
+    apply! ha
+    apply! hb
+  case empty_r => cases hs2; simp
+  case union_r ha hb =>
+    cases hs2
+    case union_r ga gb => cases ha ga; apply! hb
+  case tree => cases hs2; simp
+  case excl_absurd_r hss =>
+    cases hs2
+    case excl_absurd_r => simp
+    case excl_irrelevant_r hd _ => cases hd.not_subclass hss.weaken
+    case excl_subclass_r hs _ => cases hss.antisymm hs
+    case excl_subclass_l hs => cases hss.antisymm hs
+    case excl_irrelevant_l hs _ => cases hss.antisymm hs
+  case excl_irrelevant_r hd hs ih =>
+    cases hs2
+    case excl_absurd_r hss => cases hd.not_subclass hss.weaken
+    case excl_irrelevant_r hs2 => apply! ih
+    case excl_subclass_r hs _ => cases hd.symm.not_subclass hs
+    case excl_subclass_l hs => cases hd.symm.not_subclass hs
+    case excl_irrelevant_l hs _ => cases hd.symm.not_subclass hs
+  case excl_subclass_r hsa hsb hs1 ih =>
+    cases hs2
+    case excl_absurd_r hss => cases hss.antisymm hsa
+    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hsa
+    case excl_subclass_r hs _ => simp; apply! ih
+    case excl_subclass_l hss _ => cases hss.antisymm hsb
+    case excl_irrelevant_l hd _ _ => cases hd.symm.not_subclass hsb
+  case excl_subclass_l hsa hss =>
+    cases hs2
+    case excl_absurd_r hss => cases hss.antisymm hsa
+    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hsa
+    case excl_subclass_r hs _ _ => cases hss.antisymm hs
+    case excl_subclass_l hss _ => simp
+    case excl_irrelevant_l hd _ _ => cases hd.not_subclass hss.weaken
+  case excl_irrelevant_l hs hd hs1 ih =>
+    cases hs2
+    case excl_absurd_r hss => cases hss.antisymm hs
+    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hs
+    case excl_subclass_r hs _ _ => cases hd.symm.not_subclass hs
+    case excl_subclass_l hss _ => cases hd.not_subclass hss.weaken
+    case excl_irrelevant_l hd _ _ => apply! ih
+
+-- theorem Kind.Subtract.is_subkind
+--   (hs : Subtract K1 K2 R)
+--   : Subkind R K1 := by
+--   induction hs
+--   case empty_l => constructor; constructor; constructor
+--   case union_l ha hb =>
+
+
+theorem Kind.Subtract.empty_union_l
+  (hs : Subtract (.union K1 K2) K R)
+  (he : R.IsEmpty)
+  (hs1 : Subtract K1 K R1)
+  (hs2 : Subtract K2 K R2)
+  : R1.IsEmpty ∧ R2.IsEmpty := by
+  cases hs
+  case union_l ha hb =>
+    cases hs1.unique ha
+    cases hs2.unique hb
+    cases he
+    aesop
+
+
+theorem Kind.Subtract.empty_union_rl
+  (hs : Subtract K K1 R)
+  (he : R.IsEmpty)
+  (hs1 : Subtract K (.union K1 K2) R1)
+  : R1.IsEmpty := by
+  cases hs1
+  case empty_l => constructor
+  case union_l C1 R1 C2 R2 ha hb =>
+    have ⟨T1, h1⟩ := Subtract.exists C1 K1
+    have ⟨T2, h2⟩ := Subtract.exists C2 K1
+    have ⟨_, _⟩ := hs.empty_union_l he h1 h2
+    constructor
+    apply! h1.empty_union_rl
+    apply! h2.empty_union_rl
+  case union_r hsa hsb =>
+    cases hs.unique hsa
+    apply hsb.is_empty_l he
+
+theorem Kind.Subtract.empty_with_middle
+  (hs : Subtract K L R)
+  (he : R.IsEmpty)
+  (hs1 : Subtract K L1 R1)
+  (hs2 : Subtract R1 L2 R2)
+  : R2.IsEmpty := by
+  induction hs generalizing L1 R1 L2 R2
+  case empty_l => cases hs1; cases hs2; constructor
+  case union_l K1 K R1 K2 R2 h1 h2 ih1 ih2 =>
+    cases he
+    cases hs1
+    cases hs2
+    constructor
+    apply! ih1
+    apply! ih2
+  case empty_r => apply hs2.is_empty_l; apply hs1.is_empty_l he
+  case union_r ha hb =>
+
+    -- apply hb he
 
 
+theorem Kind.Subtract.empty_union_rr
+  (hs : Subtract K K2 R)
+  (he : R.IsEmpty)
+  (hs1 : Subtract K (.union K1 K2) R1)
+  : R1.IsEmpty := by
+  cases hs1
+  case empty_l => constructor
+  case union_l C1 R1 C2 R2 ha hb =>
+    have ⟨T1, h1⟩ := Subtract.exists C1 K2
+    have ⟨T2, h2⟩ := Subtract.exists C2 K2
+    have ⟨_, _⟩ := hs.empty_union_l he h1 h2
+    constructor
+    apply! h1.empty_union_rr
+    apply! h2.empty_union_rr
+  case union_r hsa hsb =>
+    -- cases hs.unique hsa
+    -- apply hsb.is_empty_l he
 
 
+theorem Kind.Subtract.refl' (hs : Subtract K K R) : IsEmpty R := by
+  cases hs
+  case empty_l => constructor
+  case union_l K1 K2 R1 R2 ha hb =>
+
+  case tree => constructor; apply ContainsSupOf.here .rfl
+  case excl_absurd_r hs => constructor; apply! ContainsSupOf.here
+  case excl_irrelevant_r r1 ex2 _ hd hs =>
+    have ⟨R, h⟩ := Subtract.exists (.node r1 ex2) (.node r1 ex2)
+    apply! is_empty_append_l h h.refl'
+  case excl_subclass_r r1 ex2 _ _ _ _ hs =>
+    have ⟨R, h⟩ := Subtract.exists (.node r1 ex2) (.node r1 ex2)
+    constructor
+    . apply! is_empty_append_l h h.refl'
+    . constructor; apply ContainsSupOf.here .rfl
+  case excl_subclass_l hsub1 hsub2 => cases hsub1.antisymm hsub2; constructor; apply ContainsSupOf.here .rfl
+  case excl_irrelevant_l hd hs _ => cases hd.symm.not_subclass hs
+
 theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3)  : Subkind K1 K2 := by
   cases hs1
   cases hs2

From f5664a056ba4d4676a4c28529e1e89e92c7fce13 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 10 Dec 2025 12:44:29 +0100
Subject: [PATCH 41/71] Make stuff TODO so we can progress

---
 Capless/Classifier.lean | 775 +---------------------------------------
 TODO.md                 |   3 +
 2 files changed, 21 insertions(+), 757 deletions(-)
 create mode 100644 TODO.md

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 6252e28c..7388b5fb 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -1113,765 +1113,26 @@ theorem Kind.Subtract.empty_union_rl
     cases hs.unique hsa
     apply hsb.is_empty_l he
 
-theorem Kind.Subtract.empty_with_middle
-  (hs : Subtract K L R)
-  (he : R.IsEmpty)
-  (hs1 : Subtract K L1 R1)
-  (hs2 : Subtract R1 L2 R2)
-  : R2.IsEmpty := by
-  induction hs generalizing L1 R1 L2 R2
-  case empty_l => cases hs1; cases hs2; constructor
-  case union_l K1 K R1 K2 R2 h1 h2 ih1 ih2 =>
-    cases he
-    cases hs1
-    cases hs2
-    constructor
-    apply! ih1
-    apply! ih2
-  case empty_r => apply hs2.is_empty_l; apply hs1.is_empty_l he
-  case union_r ha hb =>
-
-    -- apply hb he
+-- prove later
+theorem Kind.Subtract.rfl (hs : Subtract K K R) : IsEmpty R := by sorry
 
+theorem Kind.Subkind.rfl : Subkind K K := by
+  have ⟨R, h⟩ := Subtract.exists K K
+  apply subtract h h.rfl
 
-theorem Kind.Subtract.empty_union_rr
-  (hs : Subtract K K2 R)
-  (he : R.IsEmpty)
-  (hs1 : Subtract K (.union K1 K2) R1)
-  : R1.IsEmpty := by
-  cases hs1
-  case empty_l => constructor
-  case union_l C1 R1 C2 R2 ha hb =>
-    have ⟨T1, h1⟩ := Subtract.exists C1 K2
-    have ⟨T2, h2⟩ := Subtract.exists C2 K2
-    have ⟨_, _⟩ := hs.empty_union_l he h1 h2
-    constructor
-    apply! h1.empty_union_rr
-    apply! h2.empty_union_rr
-  case union_r hsa hsb =>
-    -- cases hs.unique hsa
-    -- apply hsb.is_empty_l he
-
-
-theorem Kind.Subtract.refl' (hs : Subtract K K R) : IsEmpty R := by
-  cases hs
-  case empty_l => constructor
-  case union_l K1 K2 R1 R2 ha hb =>
-
-  case tree => constructor; apply ContainsSupOf.here .rfl
-  case excl_absurd_r hs => constructor; apply! ContainsSupOf.here
-  case excl_irrelevant_r r1 ex2 _ hd hs =>
-    have ⟨R, h⟩ := Subtract.exists (.node r1 ex2) (.node r1 ex2)
-    apply! is_empty_append_l h h.refl'
-  case excl_subclass_r r1 ex2 _ _ _ _ hs =>
-    have ⟨R, h⟩ := Subtract.exists (.node r1 ex2) (.node r1 ex2)
-    constructor
-    . apply! is_empty_append_l h h.refl'
-    . constructor; apply ContainsSupOf.here .rfl
-  case excl_subclass_l hsub1 hsub2 => cases hsub1.antisymm hsub2; constructor; apply ContainsSupOf.here .rfl
-  case excl_irrelevant_l hd hs _ => cases hd.symm.not_subclass hs
+-- prove later
+theorem Kind.Subtract.implies_trans
+  (hs3 : Subtract K1 K3 R3)
+  (hs1 : Subtract K1 K2 R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract K2 K3 R2)
+  (he2 : R2.IsEmpty)
+  : R3.IsEmpty := by sorry
 
-theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3)  : Subkind K1 K2 := by
+theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3) : Subkind K1 K3 := by
   cases hs1
   cases hs2
-  rename_i
-
-
--- theorem Kind.Subkind.empty_l : Subkind .empty K := by
---   constructor
---   constructor
---   constructor
-
--- theorem Kind.Subtract.union_r_inv (hs : Subtract K (.union K1 K2) R) : ∃ R1 R2, Subtract K K1 R1 ∧  Subtract R1 K2 R2 ∧ Subkind R2 R ∧ Subkind R R2 := by
---   cases hs
---   case empty_l =>
---     exists empty, empty
---     apply And.intro .empty_l
---     apply And.intro .empty_l
---     apply And.intro .empty_l
---     exact .empty_l
---   case union_l ha hb =>
-
-
--- theorem Kind.Subtract.rfl (hs : Subtract K K R) : IsEmpty R := by
---   cases hs
---   case empty_l => constructor
---   case union_l ha hb =>
-
--- theorem Kind.Intersect.is_subkind (hi : Intersect K1 K2 R) : Subkind R K1 ∧ Subkind R K2 := by
---   induction hi
---   case empty_l => apply And.intro <;> apply Subkind.empty_l
---   case empty_r => apply
-
---   induction hs generalizing K
---   case empty_l => exact .empty_l
---   case union_l ih1 ih2 =>
---     cases he with
---     | union he1 he2 => exact .union_l (ih1 hd he1) (ih2 hd he2)
---   case absurd_l hc => exact absurd_l' hc
---   case excl_subclass_r ex1 a r1 r2 ex2 _ hss hsc hs ih =>
---     generalize h : node r2 (a :: ex2) = L at hd
---     induction hd generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc => cases hss.antisymm hsc
---       case there hsc =>
---         cases hs.empty_r_inv he (.absurd hsc)
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply root $ hd.refines_subclass_l hss
---     case excl_l hsc =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply! excl_l $ hsc.trans_subclass hss
---     case excl_r hsc1 =>
---       cases hsc1
---       case here hsc1 => apply excl_r $ hsc.trans_subclass hsc1
---       case there hsc1 => apply ih _ he; apply! excl_r
---   case excl_disjoint_r r1 ex1 r2 ex2 _ a hss hd hs ih =>
---     simp_all
---     generalize h : node r2 (a :: ex2) = L at hd
---     induction hd generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc => cases hss.antisymm hsc
---       case there hsc =>
---         cases hs.empty_r_inv he (.absurd hsc)
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply root $ hd.refines_subclass_l hss
---     case excl_l hsc =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply! excl_l $ hsc.trans_subclass hss
---     case excl_r hsc1 =>
---       cases hsc1
---       case here hsc1 => apply root $ (hd.refines_subclass_l hsc1).symm
---       case there hsc1 => apply ih _; apply! excl_r
---   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd1 hs ih =>
---     simp_all
---     generalize h : node r2 (a :: ex2) = L at hd
---     induction hd generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb => subst_vars; simp_all; apply! union_r ha hb
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc => cases hd1.symm.not_subclass hsc
---       case there hsc =>
---         cases hs.empty_r_inv he (.absurd hsc)
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply root $ hd.refines_subclass_l hss
---     case excl_l hsc =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply! excl_l $ hsc.trans_subclass hss
---     case excl_r hsc1 =>
---       cases hsc1
---       case here hsc1 => apply ih; apply root; apply hd1.symm.refines_subclass_r hsc1
---       case there hsc1 => apply ih _; apply! excl_r
---   case excl_r r1 ex1 r2 ex2 _ a hd1 hsc hs ih =>
---     cases he
---     rename_i he he1
---     cases he1
---     simp_all
---     rename_i he1
---     generalize h : node r2 (a :: ex2) = L at hd
---     induction hd generalizing K2 <;> try cases h
---     case empty_r.refl => apply! empty_r
---     case union_r.refl ha hb => subst_vars; simp_all; apply! union_r ha hb
---     case absurd_l.refl hsc =>
---       cases hsc
---       case here hsc => cases hd1.symm.not_subclass hsc
---       case there hsc =>
---         cases hs.empty_r_inv he (.absurd hsc)
---         apply! absurd_l
---     case absurd_r.refl => apply! absurd_r
---     case root.refl hd =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply root $ hd.refines_subclass_l hss
---     case excl_l.refl hsc =>
---       cases hs.empty_or_subroot he
---       case inl hsc => apply! absurd_l
---       case inr hss => apply! excl_l $ hsc.trans_subclass hss
---     case excl_r.refl hsc1 =>
---       cases hsc1
---       case here hsc1 => apply ih; apply root; apply hd1.symm.refines_subclass_r hsc1
---       case there hsc1 => apply ih _; apply! excl_r
---   case subclass_l r1 ex1 r2 hs =>
---     cases he
---     rename_i he
---     cases he
---     case here he => cases hs.antisymm he; have h := hd.append_excl_l (ex1:=ex1); simp at h; assumption
---     case there => apply! absurd_l'
---   case subclass_r r1 ex1 r2 hs =>
---     generalize h : node r2 [] = L at hd
---     induction hd <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb => simp_all; apply! union_r
---     case absurd_l hsc => cases hsc
---     case absurd_r => apply! absurd_r
---     case root hd => apply! root $ hd.refines_subclass_l _
---     case excl_l hsc => apply! excl_l $ hsc.trans_subclass _
---     case excl_r hsc => cases hsc
---   case irrelevant_r hd =>
---     cases he
---     apply! absurd_l'
---   case union_r ha hb =>
-
-    -- have ⟨hl, hr⟩ := hd.union_l_inv
-    -- simp_all
-    -- apply ha hl
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
--- theorem Kind.Disjoint.refine_subkind_l' (hd : K1.Disjoint (.node r2 ex2)) (hs : Subkind L K1) : L.Disjoint (.node r2 ex2) := by
---   induction hs with
---   | empty_l => exact .empty_l
---   | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
---   | absurd_l ha =>
---     apply absurd_l' ha
---   | excl_subclass_r hss hc hs ih =>
---     cases hd
---     case absurd_l hc =>
---       cases hc
---       case here hc => cases hss.antisymm hc
---       case there hc =>
-
-
---   | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
---   | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
---   | subclass_r hsub => exact hd.refine_subclass_node hsub
---   | @union_r K K1' R K2' hi hs' ih =>
---     have ⟨hd1, hd2⟩ := hd.union_l_inv
---     exact refine_union_r hi hs' hd1 hd2 ih
-
--- theorem Kind.Disjoint.excl_cons_l (hd : Disjoint (.node r1 (a :: ex1)) K2) : Disjoint (.node r1 ex1) K2 := by
---   cases hd with
---   | empty_r => exact .empty_r
---   | union_r hd1 hd2 => exact .union_r (excl_cons_l hd1) (excl_cons_l hd2)
---   | absurd_l ha =>
---     cases ha with
---     | here hs => exact .absurd_l (.here hs)
---     | there ha => exact .absurd_l ha
---   | absurd_r ha => exact .absurd_r ha
---   | root hd => exact .root hd
---   | excl_l ha => exact .excl_l ha
---   | excl_r ha =>
---     cases ha with
---     | here hs => exact .excl_r (.here hs)
---     | there ha => exact .excl_r ha
-
--- theorem Kind.Disjoint.refine_subclass_node (hsub : r1.Subclass r2) (hd : Disjoint (.node r2 []) K2) : Disjoint (.node r1 ex1) K2 := by
---   induction K2 with
---   | empty => exact .empty_r
---   | node r3 ex3 =>
---     cases hd with
---     | absurd_l ha => cases ha
---     | absurd_r ha => exact .absurd_r ha
---     | root hd => exact .root (hd.refines_subclass_l hsub)
---     | excl_l ha => exact .excl_l (ha.trans_subclass hsub)
---     | excl_r ha => cases ha
---   | union K2a K2b ih1 ih2 =>
---     cases hd with
---     | union_r hd1 hd2 => exact .union_r (ih1 hd1) (ih2 hd2)
-
--- -- Helper for union_r case: if K ⊆ K1' ∪ K2' via union_r, and both K1' and K2' are disjoint from K2, then K is disjoint from K2
--- -- We prove by induction on K
--- theorem Kind.Disjoint.refine_union_r
---     (hi : Intersect K K1' R) (hs : Subkind R K2') (hd1 : K1'.Disjoint K2) (hd2 : K2'.Disjoint K2)
---     (ih : ∀ K2, K2'.Disjoint K2 → R.Disjoint K2) : K.Disjoint K2 := by
---   induction K generalizing K1' R K2' K2 with
---   | empty => exact .empty_l
---   | union Ka Kb iha ihb =>
---     cases hi with
---     | union_l hia hib =>
---       have ⟨hra, hrb⟩ := hs.union_l_inv
---       have iha' := iha hia hra.1 hd1 hd2 (fun K2 hd2' => (ih K2 hd2').union_l_inv.1)
---       have ihb' := ihb hib hrb.1 hd1 hd2 (fun K2 hd2' => (ih K2 hd2').union_l_inv.2)
---       exact .union_l iha' ihb'
---   | node r ex =>
---     cases hi with
---     | empty_r =>
---       -- K1' = .empty, R = .empty
---       -- hd1 : .empty.Disjoint K2
---       -- hd2 : K2'.Disjoint K2
---       -- hs : Subkind .empty K2'
---       -- We need (.node r ex).Disjoint K2
---       -- This case is actually impossible to prove in general!
---       -- Unless we have more information about the relationship between K and K2'
---       sorry
---     | singleton_l hsub =>
---       -- K1' = .node r2 ex2, R = .node r (ex ++ ex2)
---       -- r.Subclass r2
---       cases K2 with
---       | empty => exact .empty_r
---       | node r3 ex3 =>
---         cases hd1 with
---         | absurd_l ha => exact .absurd_l (ha.trans_subclass hsub)
---         | absurd_r ha => exact .absurd_r ha
---         | root hd => exact .root (hd.refines_subclass_l hsub)
---         | excl_l ha => exact .excl_l (ha.trans_subclass hsub)
---         | excl_r ha => exact .excl_r ha
---       | union K2a K2b =>
---         have ⟨hd1a, hd1b⟩ := hd1.union_r_inv
---         have ⟨hd2a, hd2b⟩ := hd2.union_r_inv
---         exact .union_r (refine_union_r (.singleton_l hsub) hs hd1a hd2a (fun K2 hd2' => ih K2 hd2'))
---                        (refine_union_r (.singleton_l hsub) hs hd1b hd2b (fun K2 hd2' => ih K2 hd2'))
---     | singleton_r hsub =>
---       -- K1' = .node r2 ex2, R = .node r2 (ex ++ ex2)
---       -- r2.Subclass r
---       cases K2 with
---       | empty => exact .empty_r
---       | node r3 ex3 =>
---         -- The intersection took r2, but K has r with r2 ⊆ r
---         -- We need K.Disjoint K2, but K might be strictly bigger than the intersection
---         cases hd2 with
---         | absurd_l ha =>
---           -- K2' is absurd, so R (which is a subkind of K2') must be absurd too
---           -- But R = .node r2 (ex ++ ex2), so we need ContainsSupOf (ex ++ ex2) r2
---           -- which would make R absurd. If R is absurd, then from the subkind
---           -- we can derive things...
---           sorry
---         | absurd_r ha => exact .absurd_r ha
---         | root hd =>
---           -- hd : r2'.Disjoint r3 where r2' is root of K2'
---           -- We need r.Disjoint r3, given r2.Subclass r
---           sorry
---         | excl_l ha =>
---           sorry
---         | excl_r ha => exact .excl_r ha
---       | union K2a K2b =>
---         sorry
---     | singleton_disj hdisj =>
---       -- r.Disjoint r2, so intersection is empty
---       -- R = .empty
---       -- But we need K = .node r ex to be disjoint from K2
---       -- We can't conclude this from K1'.Disjoint K2 alone
---       sorry
-
--- theorem Kind.Disjoint.refine_subkind_l (hd : K1.Disjoint K2) (hs : Subkind L K1) : L.Disjoint K2 := by
---   induction hs generalizing K2 with
---   | empty_l => exact .empty_l
---   | union_l _ _ ih1 ih2 => exact .union_l (ih1 hd) (ih2 hd)
---   | absurd_l ha => exact .absurd_l ha
---   | excl_subclass_r _ _ _ ih => exact ih (hd.excl_cons_l)
---   | excl_disjoint_r _ _ _ ih => exact ih (hd.excl_cons_l)
---   | excl_irrelevant_r _ _ ih => exact ih (hd.excl_cons_l)
---   | subclass_r hsub => exact hd.refine_subclass_node hsub
---   | @union_r K K1' R K2' hi hs' ih =>
---     have ⟨hd1, hd2⟩ := hd.union_l_inv
---     exact refine_union_r hi hs' hd1 hd2 ih
-
--- theorem Kind.Disjoint.refine_subkind_r (hd : Disjoint K1 K2) (hs : Subkind L K2) : K1.Disjoint L := by apply (hd.symm.refine_subkind_l hs).symm
-
--- theorem Kind.Disjoint.refine
-
--- inductive Kind : Type where
--- -- | empty : Kind
--- | singleton : Classifier -> List Classifier -> Kind
--- -- | union : Kind -> Kind -> Kind
-
--- @[simp]
--- def Kind.classifier (c : Classifier) := singleton c []
-
--- @[simp]
--- def Kind.excl (k : Kind) c :=
---   match k with
---   | singleton r es => singleton r (c :: es)
-
-
--- inductive HasSuperclassOf : Classifier -> List Classifier -> Prop where
---   | here : b.Subclass a -> HasSuperclassOf b (a :: xs)
---   | there : HasSuperclassOf b xs -> HasSuperclassOf b (a :: xs)
-
--- theorem HasSuperclassOf.subclass (hsc : HasSuperclassOf a es) (hs : Classifier.Subclass b a) : HasSuperclassOf b es := by
---   induction hsc
---   case here hsub => apply here  $ hs.trans hsub
---   case there ih => apply! there
-
--- inductive Kind.Disjoint : Kind -> Kind -> Prop where
---   -- | empty_l : Disjoint .empty K
---   -- | empty_r : Disjoint K .empty
---   -- empty classifiers are disjoint with everything else
---   | absurd_l : HasSuperclassOf a es -> Disjoint (singleton a es) K2
---   | absurd_r : HasSuperclassOf a es -> Disjoint K1 (singleton a es)
---   -- Otherwise, the root has to be a subclass of the other's exclude list
---   | root_l : HasSuperclassOf r1 es2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
---   | root_r : HasSuperclassOf r2 es1 -> Disjoint (singleton r1 es1) (singleton r2 es2)
---   | root : Classifier.Disjoint r1 r2 -> Disjoint (singleton r1 es1) (singleton r2 es2)
---   -- union case
---   -- | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
---   -- | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
-
--- inductive Kind.Subkind : Kind -> Kind -> Prop where
---   | absurd_l : HasSuperclassOf a es ->
---     Subkind (singleton a es) K
---   -- | empty_l : Subkind .empty K
---   | subclass_no_excl :
---     r1.Subclass r2 ->
---     Subkind (singleton r1 es1) (singleton r2 [])
---   | excl_subclass :
---     Subkind (singleton r1 es1) (singleton r2 es2) ->
---     a.StrictSub r2 ->
---     HasSuperclassOf a es1 ->
---     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
---   | excl_disjoint :
---     Subkind (singleton r1 es1) (singleton r2 es2) ->
---     a.StrictSub r2 ->
---     a.Disjoint r1 ->
---     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
---   | excl_irrelevant :
---     Subkind (singleton r1 es1) (singleton r2 es2) ->
---     a.Disjoint r2 ->
---     Subkind (singleton r1 es1) (singleton r2 (a :: es2))
-
--- theorem Kind.Subkind.singleton_weaken_l (hs : Subkind (.singleton a es) K) : Subkind (.singleton a (e :: es)) K := by
---   cases hs
---   case absurd_l => apply! absurd_l $ .there _
---   case subclass_no_excl hsub => apply! subclass_no_excl
---   case excl_subclass hss hsc hs => apply! hs.singleton_weaken_l.excl_subclass _ (.there _)
---   case excl_disjoint hss hd hs => apply! hs.singleton_weaken_l.excl_disjoint
---   case excl_irrelevant hd hs => apply! hs.singleton_weaken_l.excl_irrelevant
-
-
--- theorem Kind.Subkind.rfl : Subkind K K := by
---   cases K
---   case singleton r es =>
---     induction es
---     case nil => apply subclass_no_excl .rfl
---     case cons h t ih =>
---       cases Classifier.subclass_or_disjoint r h
---       case inl hsub =>
---         apply! absurd_l $ .here _
---       case inr hsub =>
---         cases hsub
---         case inl hsub =>
---           cases hsub.might_strict
---           case inl he =>  subst_vars; apply! absurd_l $ .here _
---           case inr hsub => apply ih.singleton_weaken_l.excl_subclass hsub (.here .rfl)
---         case inr hd =>  apply ih.singleton_weaken_l.excl_irrelevant hd.symm
-
--- -- theorem Kind.Subkind.refines_is_empty
--- --   (hs : Subkind K1 K2)
--- --   (he : IsEmpty K2) : IsEmpty K1 := by
--- --   cases hs
--- --   rename_i he1 hsub
--- --   induction hsub <;> try cases he.singleton_must_excl
--- --   case absurd_l => apply! IsEmpty.absurd
--- --   case absurd_r => assumption
--- --   case empty_l => assumption
--- --   case empty_r => assumption
--- --   case excl_subclass_r hsub hsc hs ih =>
--- --     cases he
--- --     rename_i he
--- --     cases he
--- --     case here he => have h := hsub.antisymm he; contradiction
--- --     case there he => apply ih (.absurd he) he1
--- --   case excl_disjoint_r hsub hsc hs ih =>
--- --     cases he.singleton_cases
--- --     case inl he => have h := hsub.antisymm he; contradiction
--- --     case inr he => apply ih (.absurd he) he1
--- --   case excl_irrelevant_r hsub hs ih =>
--- --     cases he.singleton_cases
--- --     case inl he => have h := hsub.symm.not_subclass he; contradiction
--- --     case inr he => apply ih (.absurd he) he1
--- --   case residue hsc hs hsub ih =>
--- --     cases he.singleton_cases
--- --     case inl he => have h := hsc.antisymm he; contradiction
--- --     case inr he => cases he1; apply! ih (.absurd he)
--- --   case union_l hsa hsb iha ihb =>
--- --     cases he1
--- --     constructor
--- --     apply! iha
--- --     apply! ihb
--- --   case union_rl ha hb iha ihb =>
--- --     cases he
--- --     apply! iha _ (ihb _ he1)
--- --   case union_rr ha hb iha ihb =>
--- --     cases he
--- --     apply! iha _ (ihb _ he1)
-
--- -- theorem Kind.Disjoint.is_empty_r
--- --   (he : IsEmpty K)
--- --   : Disjoint K1 K := by
--- --   induction he
--- --   case empty => apply! empty_r
--- --   case absurd => apply! absurd_r
--- --   case union => apply! union_r
-
--- theorem Kind.Disjoint.symm (hd : Disjoint K1 K2) : Disjoint K2 K1 := by
---   induction hd
---   -- case empty_l => apply! empty_r
---   -- case empty_r => apply! empty_l
---   case absurd_l => apply! absurd_r
---   case absurd_r => apply! absurd_l
---   case root_l => apply! root_r
---   case root_r => apply! root_l
---   case root h => apply! root h.symm
---   -- case union_l => apply! union_r
---   -- case union_r => apply! union_l
-
--- theorem Kind.Subkind.absurd_r
---   (hs : Subkind (singleton r1 es1) (singleton r2 es2))
---   (hsc : HasSuperclassOf r2 es2)
---   : HasSuperclassOf r1 es1 := by
---   cases hs
---   case absurd_l => assumption
---   case subclass_no_excl => cases hsc
---   case excl_subclass hsc1 hss hs =>
---     cases hsc
---     case here hsub => cases hss.antisymm hsub
---     case there hsc => apply hs.absurd_r hsc
---   case excl_disjoint hd hss hs =>
---     cases hsc
---     case here hsub => cases hss.antisymm hsub
---     case there hsc => apply hs.absurd_r hsc
---   case excl_irrelevant hd hs =>
---     cases hsc
---     case here hsub => cases hd.symm.not_subclass hsub
---     case there hsc => apply hs.absurd_r hsc
-
--- theorem Kind.Subkind.root_is_subclass (hs : Subkind (singleton r1 es1) (singleton r2 es2)) : HasSuperclassOf r1 es1 ∨ r1.Subclass r2 := by
---   cases hs
---   case absurd_l => left; assumption
---   case subclass_no_excl => right; assumption
---   case excl_subclass hsc hss hs =>
---     cases hs.root_is_subclass <;> aesop
---   case excl_disjoint hs =>
---     cases hs.root_is_subclass <;> aesop
---   case excl_irrelevant hs =>
---     cases hs.root_is_subclass <;> aesop
-
--- theorem Kind.Subkind.refine_has_superclass
---   (hs : Subkind (singleton r1 es1) (singleton r2 es2))
---   (hsc : HasSuperclassOf a es2)
---   : HasSuperclassOf r1 es1 ∨ r1.Disjoint a ∨ HasSuperclassOf a es1 := by
---   cases hs
---   case absurd_l => aesop
---   case subclass_no_excl => cases hsc
---   case excl_subclass hsc hss hs =>
---     cases hsc
---     case here hsub => have h := hsc.subclass hsub; aesop
---     case there hsc => apply hs.refine_has_superclass hsc
---   case excl_disjoint hd hss hs =>
---     cases hsc
---     case here hsub => have h:= (hd.refines_subclass_l hsub).symm; aesop
---     case there hsc => apply hs.refine_has_superclass hsc
---   case excl_irrelevant hd hs =>
---     cases hsc
---     case here hsub =>
---       cases hs.root_is_subclass
---       case inl => aesop
---       case inr hsub2 => have h := ((hd.refines_subclass_l hsub).refines_subclass_r hsub2).symm; aesop
---     case there hsc => apply hs.refine_has_superclass hsc
-
--- theorem Kind.Disjoint.refine_by_subkind
---   (hd : Disjoint K2 L)
---   (hs : Subkind K1 K2)
---   : Disjoint K1 L := by
---   induction hs generalizing L
---   case absurd_l => apply! absurd_l
---   case subclass_no_excl hsub =>
---     cases hd
---     case absurd_l hsc => cases hsc
---     case absurd_r hsc => apply! absurd_r
---     case root_l hsc => apply! root_l $ hsc.subclass _
---     case root_r hsc =>  cases hsc
---     case root hd => apply! root $ hd.refines_subclass_l _
---   case excl_subclass hs hss hsc ih =>
---     cases hd
---     case absurd_l hsc =>
---       cases hsc
---       case here hsub => cases hss.antisymm hsub
---       case there hsc => apply absurd_l $ hs.absurd_r hsc
---     case absurd_r => apply! absurd_r
---     case root_l hsc1 =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr hsub => apply! root_l $ hsc1.subclass _
---     case root_r hsc1 =>
---       cases hsc1
---       case here hsub => apply! root_r $ hsc.subclass _
---       case there hsc1 =>
---         cases hs.refine_has_superclass hsc1
---         case inl => apply! absurd_l
---         case inr h1 =>
---           cases h1
---           case inl h1 => apply! root
---           case inr h1 => apply! root_r
---     case root hd =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr h1 => apply! root $ hd.refines_subclass_l _
---   case excl_disjoint hs hss hd1 ih =>
---     cases hd
---     case absurd_l hsc =>
---       cases hsc
---       case here hsub => cases hss.antisymm hsub
---       case there hsc => apply absurd_l $ hs.absurd_r hsc
---     case absurd_r => apply! absurd_r
---     case root_l hsc1 =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr hsub => apply! root_l $ hsc1.subclass _
---     case root_r hsc1 =>
---       cases hsc1
---       case here hsub => apply! root $ hd1.symm.refines_subclass_r _
---       case there hsc1 =>
---         cases hs.refine_has_superclass hsc1
---         case inl => apply! absurd_l
---         case inr h1 =>
---           cases h1
---           case inl h1 => apply! root
---           case inr h1 => apply! root_r
---     case root hd2 =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr => apply! root $ hd2.refines_subclass_l _
---   case excl_irrelevant hs hd ih =>
---     cases hd
---     case absurd_l hsc =>
---       cases hsc
---       case here hsub => cases hd.symm.not_subclass hsub
---       case there hsc => apply absurd_l $ hs.absurd_r hsc
---     case absurd_r => apply! absurd_r
---     case root_l hsc1 =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr hsub => apply! root_l $ hsc1.subclass _
---     case root_r hsc1 =>
---       cases hsc1
---       case here hsub =>
---         cases hs.root_is_subclass
---         case inl => apply! absurd_l
---         case inr hsub2 =>
---           apply root
---           apply Classifier.Disjoint.symm
---           apply! (hd.refines_subclass_l _).refines_subclass_r _
---       case there hsc1 =>
---         cases hs.refine_has_superclass hsc1
---         case inl => apply! absurd_l
---         case inr h1 =>
---           cases h1
---           case inl h1 => apply! root
---           case inr h1 => apply! root_r
---     case root hd2 =>
---       cases hs.root_is_subclass
---       case inl => apply! absurd_l
---       case inr => apply! root $ hd2.refines_subclass_l _
-
--- theorem Kind.Subkind.trans (ha : Subkind K1 K2) (hb : Subkind K2 K3) : Subkind K1 K3 := by
---   induction hb generalizing K1
---   case absurd_l hsc =>
---     apply absurd_l $ ha.absurd_r hsc
---   case subclass_no_excl hs =>
---     cases ha.root_is_subclass
---     case inl hsc => apply! absurd_l
---     case inr hsub => apply! subclass_no_excl $ hsub.trans _
---   case excl_subclass hk hss hsc ih =>
---     cases K1 with
---     | singleton r1 es1 =>
---       cases ha.refine_has_superclass hsc
---       case inl hsc2 => apply! absurd_l
---       case inr h =>
---         cases h
---         case inl hd => apply! excl_disjoint (ih _) _ hd.symm
---         case inr hsc2 => apply! excl_subclass (ih _) _ hsc2
---   case excl_disjoint hk hss hd ih =>
---     cases K1 with
---     | singleton r1 es1 =>
---       cases ha.root_is_subclass
---       case inl hsc => apply! absurd_l
---       case inr hsub => apply! excl_disjoint (ih _) _ $ hd.refines_subclass_r _
---   case excl_irrelevant hk hd ih =>
---     apply! excl_irrelevant (ih _) _
-
--- theorem Kind.subkind_disjoint_absurd (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : HasSuperclassOf K1.1 K1.2 := by
---   induction ha
---   case absurd_l hsc => exact hsc
---   case subclass_no_excl hsub =>
---     cases hb
---     case absurd_l hsc => exact hsc
---     case absurd_r hsc => cases hsc
---     case root_l hsc => cases hsc
---     case root_r hsc => exact hsc.subclass hsub
---     case root hd => exact absurd hsub hd.not_subclass
---   case excl_subclass hs hss hsc ih =>
---     cases hb
---     case absurd_l hsc2 => exact hsc2
---     case absurd_r hsc2 =>
---       cases hsc2
---       case here hsub => exact (hss.antisymm hsub).elim
---       case there hsc2 => exact ih (.absurd_r hsc2)
---     case root_l hsc2 =>
---       cases hsc2
---       case here hsub => exact hsc.subclass hsub
---       case there hsc2 => exact ih (.root_l hsc2)
---     case root_r hsc2 => exact ih (.root_r hsc2)
---     case root hd => exact ih (.root hd)
---   case excl_disjoint hs hss hd ih =>
---     cases hb
---     case absurd_l hsc => exact hsc
---     case absurd_r hsc =>
---       cases hsc
---       case here hsub => exact (hss.antisymm hsub).elim
---       case there hsc => exact ih (.absurd_r hsc)
---     case root_l hsc =>
---       cases hsc
---       case here hsub => exact absurd hsub hd.symm.not_subclass
---       case there hsc => exact ih (.root_l hsc)
---     case root_r hsc => exact ih (.root_r hsc)
---     case root hd2 => exact ih (.root hd2)
---   case excl_irrelevant hs hd ih =>
---     cases hb
---     case absurd_l hsc => exact hsc
---     case absurd_r hsc =>
---       cases hsc
---       case here hsub => exact absurd hsub hd.symm.not_subclass
---       case there hsc => exact ih (.absurd_r hsc)
---     case root_l hsc =>
---       cases hsc
---       case here hsub =>
---         cases hs.root_is_subclass
---         case inl hsc2 => exact hsc2
---         case inr hsub2 => exact absurd hsub2 (hd.refines_subclass_l hsub).not_subclass
---       case there hsc => exact ih (.root_l hsc)
---     case root_r hsc => exact ih (.root_r hsc)
---     case root hd2 => exact ih (.root hd2)
-
--- theorem Kind.Subkind.absurd_disjoint (ha : Subkind K1 K2) (hb : Disjoint K1 K2) : Subkind K1 K3 := by
---   cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
-
--- theorem Kind.Disjoint.absurd_subkind (hb : Disjoint K1 K2) (ha : Subkind K1 K2) : Disjoint K1 K3 := by
---   cases K1; exact .absurd_l (Kind.subkind_disjoint_absurd ha hb)
+  rename_i h1 h2 _ h3 h4
+  have ⟨R, h⟩ := Subtract.exists K1 K3
+  apply subtract h
+  apply! h.implies_trans h1
diff --git a/TODO.md b/TODO.md
new file mode 100644
index 00000000..c72e506f
--- /dev/null
+++ b/TODO.md
@@ -0,0 +1,3 @@
+- Prove `Subtract` properties
+  - [ ] `rfl`
+  - [ ] `implies_trans`

From 6a75133aebf008920ca1e3aef22d7e7f8a028e8c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 10 Dec 2025 17:27:23 +0100
Subject: [PATCH 42/71] WellScoped.subcapt green again

---
 Capless/CaptureSet.lean         | 323 +-----------------
 Capless/Classifier.lean         | 165 +++++++++-
 Capless/Store.lean              |  33 +-
 Capless/Subcapturing.lean       |  34 +-
 Capless/Subcapturing/Basic.lean | 119 ++++---
 Capless/Typing.lean             |  32 +-
 Capless/WellScoped/Basic.lean   | 563 +++++++++++++-------------------
 7 files changed, 519 insertions(+), 750 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 788dea60..091daf6b 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -15,7 +15,6 @@ This file contains the definition of capture sets.
 inductive Singleton : Nat -> Nat -> Type where
 | var : Fin n -> Singleton n k
 | cvar : Fin k -> Singleton n k
-| proj : Singleton n k -> Kind -> Singleton n k
 
 /-- Capture sets in System Capless.
 
@@ -35,21 +34,25 @@ Since the capture sets are indexed with the number of available binders, and eac
 inductive CaptureSet : Nat -> Nat -> Type where
 | empty : CaptureSet n k
 | union : CaptureSet n k -> CaptureSet n k -> CaptureSet n k
-| singleton : Singleton n k -> CaptureSet n k
+| singleton : Singleton n k -> Kind -> CaptureSet n k
 
 @[simp]
 def CaptureSet.proj (c : CaptureSet n k) (K : Kind) :=
   match c with
   | empty => empty
   | union c1 c2 => union (c1.proj K) (c2.proj K)
-  | singleton s => singleton $ s.proj K
+  | singleton s p => singleton s (p.intersect K)
+
+theorem CaptureSet.proj_top {C : CaptureSet n k} : C.proj .top = C := by
+  induction C <;> try aesop
+  apply Kind.Intersect.top_r
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
 
-notation:max "{x=" x "}" => CaptureSet.singleton (Singleton.var x)
-notation:max "{c=" c "}" => CaptureSet.singleton (Singleton.cvar c)
+notation:max "{x=" x " | " K "}" => CaptureSet.singleton (Singleton.var x) K
+notation:max "{c=" c " | " K "}" => CaptureSet.singleton (Singleton.cvar c) K
 
 @[simp]
 instance : Union (CaptureSet n k) where
@@ -120,14 +123,12 @@ def Singleton.rename (s : Singleton n k) (f : FinFun n n') : Singleton n' k :=
   match s with
   | var n => var $ f n
   | cvar k => cvar k
-  | proj s K => (s.rename f).proj K
 
 @[simp]
 def Singleton.crename (s : Singleton n k) (f : FinFun k k') : Singleton n k' :=
   match s with
   | var n => var n
   | cvar k => cvar $ f k
-  | proj s K => (s.crename f).proj K
 
 @[simp]
 theorem Singleton.rename_id {s : Singleton n k} :
@@ -159,14 +160,14 @@ def CaptureSet.rename (C : CaptureSet n k) (f : FinFun n n') : CaptureSet n' k :
   match C with
   | empty => empty
   | union C1 C2 => (C1.rename f) ∪ (C2.rename f)
-  | singleton s => singleton $ s.rename f
+  | singleton s p => singleton (s.rename f) p
 
 @[simp]
 def CaptureSet.crename (C : CaptureSet n k) (f : FinFun k k') : CaptureSet n k' :=
   match C with
   | empty => empty
   | union C1 C2 => (C1.crename f) ∪ (C2.crename f)
-  | singleton s => singleton $ s.crename f
+  | singleton s p => singleton (s.crename f) p
 
 def CaptureSet.weaken (C : CaptureSet n k) : CaptureSet (n+1) k :=
   C.rename FinFun.weaken
@@ -201,20 +202,20 @@ theorem CaptureSet.cweaken_union {C1 C2 : CaptureSet n k} :
   simp [CaptureSet.cweaken, CaptureSet.crename_union]
 
 theorem CaptureSet.rename_singleton {x : Fin n} {f : FinFun n n'} :
-  ({x=x} : CaptureSet n k).rename f = {x=f x} := by simp
+  ({x=x | K} : CaptureSet n k).rename f = {x=f x | K} := by simp
 
 theorem CaptureSet.ext_rename_singleton_zero {f : FinFun n n'} :
-  ({x=0} : CaptureSet (n+1) k).rename f.ext = {x=0} := by
+  ({x=0 | K} : CaptureSet (n+1) k).rename f.ext = {x=0 | K} := by
   simp [FinFun.ext]
 
 theorem CaptureSet.rename_csingleton {x : Fin k} {f : FinFun n n'} :
-  {c=x}.rename f = {c=x} := by simp
+  {c=x | K}.rename f = {c=x | K} := by simp
 
 theorem CaptureSet.crename_singleton {x : Fin n} {f : FinFun k k'} :
-  {x=x}.crename f = {x=x} := by simp
+  {x=x | K}.crename f = {x=x | K} := by simp
 
 theorem CaptureSet.crename_csingleton {x : Fin k} {f : FinFun k k'} :
-  ({c=x} : CaptureSet n k).crename f = {c=f x} := by simp
+  ({c=x | K} : CaptureSet n k).crename f = {c=f x | K} := by simp
 
 theorem CaptureSet.rename_empty :
   ({} : CaptureSet n k).rename f = {} := by simp
@@ -260,11 +261,11 @@ theorem CaptureSet.cweaken_crename {C : CaptureSet n k} :
   simp [cweaken, crename_crename, FinFun.comp_weaken]
 
 theorem CaptureSet.cweaken_csingleton {c : Fin k} :
-  ({c=c} : CaptureSet n k).cweaken = {c=c.succ} := by
+  ({c=c | K} : CaptureSet n k).cweaken = {c=c.succ | K} := by
   simp [singleton, cweaken, crename, FinFun.weaken]
 
 theorem CaptureSet.weaken_csingleton :
-  ({c=c} : CaptureSet n k).weaken = {c=c} := by
+  ({c=c | K} : CaptureSet n k).weaken = {c=c | K} := by
   simp [singleton, weaken]
 
 theorem CaptureSet.rename_id {C : CaptureSet n k} :
@@ -309,79 +310,6 @@ theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
 -- ## Projections
 -- -/
 
--- `n` with projections widen `C'` to given `C`
-inductive WidenVar : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Prop where
-  | var : WidenVar x (.var x) C C
-  | proj : WidenVar n s C' C -> WidenVar n (s.proj K) C' (C.proj K)
-
--- `n` with projections widen to given `C`, including a projection to `K`
-inductive WidenVarWith : Fin n -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Kind -> Prop where
-  | here : WidenVar n s C' C -> WidenVarWith n (s.proj K) C' (C.proj K) K
-  | there : WidenVarWith n s C' C K -> WidenVarWith n (s.proj K') C' (C.proj K') K
-
--- `k` with projections widen `C'` to given `C`
-inductive WidenCVar : Fin k -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Prop where
-  | var : WidenCVar c (.cvar c) C C
-  | proj : WidenCVar c s C' C -> WidenCVar c (s.proj K) C' (C.proj K)
-
--- `k` with projections widen to given `C`, including a projection to `K`
-inductive WidenCVarWith : Fin k -> Singleton n k -> CaptureSet n k -> CaptureSet n k -> Kind -> Prop where
-  | here : WidenCVar c s C' C -> WidenCVarWith c (s.proj K) C' (C.proj K) K
-  | there : WidenCVarWith c s C' C K -> WidenCVarWith c (s.proj K') C' (C.proj K') K
-
-inductive Singleton.IsVar : Singleton n k -> Fin n -> Prop where
-  | var : IsVar (.var x) x
-  | proj : IsVar s x -> IsVar (s.proj K) x
-
-theorem Singleton.IsVar.proj_inv (hv : IsVar (s.proj K) n) : IsVar s n := by cases hv; assumption
-
-theorem WidenVar.is_var (hw : WidenVar n s C' C) : s.IsVar n := by
-  induction hw
-  case var => constructor
-  case proj ih => apply ih.proj
-
-inductive Singleton.IsVarWith : Singleton n k -> Fin n -> Kind -> Prop where
-  | here : IsVar s n -> IsVarWith (s.proj K) n K
-  | there : IsVarWith s n K -> IsVarWith (s.proj K') n K
-
-theorem WidenVarWith.is_var_with (hw : WidenVarWith k s C' C K) : s.IsVarWith k K := by
-  induction hw
-  case here hw => apply Singleton.IsVarWith.here hw.is_var
-  case there ih => apply ih.there
-
-inductive Singleton.IsAbsurdVar : Singleton n k -> Fin n -> Prop where
-  | here : K1.Disjoint K2 -> s.IsVarWith x K1 -> IsAbsurdVar (.proj s K2) x
-  | there : IsAbsurdVar s x -> IsAbsurdVar (s.proj K) x
-
-inductive Singleton.IsCVar : Singleton n k -> Fin k -> Prop where
-  | var : IsCVar (.cvar n) n
-  | proj : IsCVar s n -> IsCVar (s.proj K) n
-
-theorem Singleton.IsCVar.proj_inv (hv : IsCVar (s.proj K) n) : IsCVar s n := by cases hv; assumption
-
-theorem WidenCVar.is_cvar (hw : WidenCVar n s C' C) : s.IsCVar n := by
-  induction hw
-  case var => constructor
-  case proj ih => apply ih.proj
-
-theorem CaptureSet.proj_singleton : (singleton s).proj K = (singleton $ s.proj K) := by simp
-
-theorem CaptureSet.proj_inj {C D : CaptureSet n k} (heq : C.proj K = D.proj K) : C = D := by
-  induction C generalizing D
-  case empty =>
-    simp at heq
-    unfold proj at heq; split at heq <;> simp at heq
-    rfl
-  case union ha hb =>
-    simp at heq
-    cases D <;> simp at heq
-    have ⟨_, _⟩ := heq
-    rw [ha _, hb _]
-    repeat assumption
-  case singleton =>
-    cases D <;> simp at heq
-    aesop
-
 theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K) := by
   induction hsub <;> try simp
   case empty => apply empty
@@ -389,220 +317,3 @@ theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K
   case union_l ha hb => apply! union_l
   case union_rl ha => apply! union_rl
   case union_rr hb => apply! union_rr
-
--- inductive HasSingleton : Singleton n k -> Singleton n k -> Prop where
---   | var : HasSingleton (.var n) (.var n)
---   | cvar : HasSingleton (.cvar k) (.cvar k)
---   | proj : HasSingleton s s' -> HasSingleton (.proj s K) s'
-
--- inductive HasSingletonProj : Singleton n k -> Singleton n k -> Kind -> Prop where
---   | here : HasSingleton s s' -> HasSingletonProj (.proj s K) s' K
---   | there : HasSingletonProj s s' K -> HasSingletonProj (.proj s K') s' K
-
--- theorem HasSingleton.is_not_proj (hh : HasSingleton s (.proj s' K)) : False := by
---   cases hh
---   case proj hh => apply hh.is_not_proj
-
--- theorem HasSingleton.is_target (hs1 : HasSingleton s t) (hs2 : HasSingleton t u) : t = u := by
---   induction hs1
---   case var => cases hs2; rfl
---   case cvar => cases hs2; rfl
---   case proj ih => apply! ih
-
--- theorem HasSingletonProj.erase (hs : HasSingletonProj s s' K) : HasSingleton s s' := by
---   induction hs
---   case here => apply! HasSingleton.proj
---   case there ih => apply! HasSingleton.proj
-
--- inductive ProjectedSingleton: CaptureSet n k -> (CaptureSet n k) -> Prop where
---   | var : ProjectedSingleton {x=x} {x=x}
---   | cvar : ProjectedSingleton {c=c} {c=c}
---   | proj : ProjectedSingleton s C -> ProjectedSingleton s (.proj C K)
-
--- inductive ProjectedSingletonWith : (CaptureSet n k) -> (K : Kind) -> (CaptureSet n k) -> Prop where
---   | here : ProjectedSingleton s C -> ProjectedSingletonWith s K (.proj C K)
---   | there : ProjectedSingletonWith s K C -> ProjectedSingletonWith s K (.proj C K')
-
--- def ProjectedSingletonWith.erase (hp : ProjectedSingletonWith s K C) : ProjectedSingleton s C := by
---   induction hp <;> apply! ProjectedSingleton.proj
-
--- /-- A capture set that only has projections on top of singletons. -/
--- inductive ProjectedSingletonsOnly: CaptureSet n k -> Prop where
---   | empty : ProjectedSingletonsOnly .empty
---   | singleton : ProjectedSingleton s C -> ProjectedSingletonsOnly C
---   | union : ProjectedSingletonsOnly C1 -> ProjectedSingletonsOnly C2 -> ProjectedSingletonsOnly (.union C1 C2)
-
--- @[simp]
--- def CaptureSet.push_proj (C: CaptureSet n k) (K: Kind) : CaptureSet n k :=
---   match C with
---   | .empty => .empty
---   | .singleton c => proj (.singleton c) K
---   | .csingleton c => proj (.csingleton c) K
---   | .proj C1 K1 => proj (.proj C1 K1) K
---   | .union C1 C2 => .union (C1.push_proj K) (C2.push_proj K)
-
--- @[simp]
--- def CaptureSet.canonicalize (C : CaptureSet n k) : CaptureSet n k :=
---   match C with
---   | .empty => .empty
---   | .singleton c => .singleton c
---   | .csingleton c => .csingleton c
---   | .union C1 C2 => .union (C1.canonicalize) (C2.canonicalize)
---   | .proj C1 K => C1.canonicalize.push_proj K
-
--- theorem CaptureSet.push_proj_is_superset (C : CaptureSet n k) : (C.proj K) ⊆ C.push_proj K := by
---   induction C <;> simp only [push_proj]
---   case empty => exists 0; apply Subset.proj_empty
---   case union C1 C2 ih1 ih2 =>
---     apply IsTrans.trans (r := HasSubset.Subset)
---     exists 0; apply Subset.proj_union_r
---     apply! Subset.union_monotone
---   case singleton => exists 0; apply Subset.rfl
---   case csingleton => exists 0; apply Subset.rfl
---   case proj => apply Subset.proj' Subset.rfl'
-
--- theorem CaptureSet.canonicalize_is_superset {C : CaptureSet n k} : C ⊆ C.canonicalize := by
---   induction C <;> (simp; try apply Subset.rfl')
---   case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
---   case proj C1 K ih =>
---     apply Subset.trans'
---     apply Subset.proj' ih
---     apply push_proj_is_superset
-
--- theorem CaptureSet.push_proj_is_subset {C : CaptureSet n k} : C.push_proj K ⊆ C.proj K := by
---   induction C <;> (simp; try apply Subset.rfl')
---   case empty => apply Subset.empty'
---   case union C1 C2 ih1 ih2 =>
---     apply Subset.trans' _ Subset.proj_union_l'
---     apply! Subset.union_monotone
-
--- theorem CaptureSet.canonicalize_is_subset {C : CaptureSet n k} : C.canonicalize ⊆ C := by
---   induction C <;> (simp; try apply Subset.rfl')
---   case union ih1 ih2 => apply Subset.union_monotone ih1 ih2
---   case proj C1 K ih =>
---     apply Subset.trans' C1.canonicalize.push_proj_is_subset
---     apply Subset.proj' ih
-
--- theorem CaptureSet.push_proj_singleton {C : CaptureSet n k} (hp: ProjectedSingletonsOnly C) : ProjectedSingletonsOnly (C.push_proj K) := by
---   induction hp <;> try simp_all
---   case empty => constructor
---   case singleton hp =>
---     induction hp
---     case var => apply ProjectedSingletonsOnly.singleton (.proj .var)
---     case cvar => apply ProjectedSingletonsOnly.singleton (.proj .cvar)
---     case proj =>
---       apply ProjectedSingletonsOnly.singleton
---       apply ProjectedSingleton.proj
---       apply! ProjectedSingleton.proj
---   case union C1 C2 ih1 ih2 =>
---     apply! ProjectedSingletonsOnly.union
-
--- theorem CaptureSet.canonicalize_is_projected_singletons_only {C : CaptureSet n k} : ProjectedSingletonsOnly C.canonicalize := by
---   induction C <;> try simp
---   case empty => apply ProjectedSingletonsOnly.empty
---   case singleton => apply ProjectedSingletonsOnly.singleton .var
---   case csingleton => apply ProjectedSingletonsOnly.singleton .cvar
---   case union C1 C2 ih1 ih2 => apply ProjectedSingletonsOnly.union ih1 ih2
---   case proj C K ih =>
---     apply push_proj_singleton
---     assumption
-
--- lemma CaptureSet.push_proj_depth {C : CaptureSet n k} : (C.push_proj K).depth ≤ 1 + C.depth := by
---   induction C <;> simp; omega
-
--- theorem CaptureSet.canonicalize_depth {C : CaptureSet n k} : C.canonicalize.depth ≤ C.depth := by
---   induction C <;> simp
---   case union ih1 ih2 => omega
---   case proj C K ih =>
---     apply IsTrans.trans
---     apply C.canonicalize.push_proj_depth
---     simp; exact ih
-
--- lemma CaptureSet.push_proj_singleton_eq {C : CaptureSet n k} (hp : ProjectedSingleton s C) : (C.push_proj K) = (C.proj K) := by
---   induction hp <;> simp
-
--- theorem CaptureSet.canonicalize_projected_singletons {C : CaptureSet n k} (hp : ProjectedSingletonsOnly C) : C.canonicalize = C := by
---   induction hp
---   case singleton s C hs =>
---     induction hs <;> simp
---     case proj ha ih =>
---       rw [ih]
---       apply! push_proj_singleton_eq
---   case empty => simp
---   case union ha hb iha ihb =>
---     simp; aesop
-
--- theorem CaptureSet.canonicalize_idempt {C : CaptureSet n k} : C.canonicalize.canonicalize = C.canonicalize := by
---   have h := C.canonicalize_is_projected_singletons_only
---   rw [C.canonicalize.canonicalize_projected_singletons h]
-
--- theorem CaptureSet.Subset.canonicalize {A B : CaptureSet n k} (hs : A ⊆ B) : A.canonicalize ⊆ B.canonicalize := by
---   apply trans'
---   apply A.canonicalize_is_subset
---   apply trans' hs
---   apply B.canonicalize_is_superset
-
-
--- inductive HasSingleton : CaptureSet n k -> CaptureSet n k -> Prop where
---   | var : HasSingleton {x=x} {x=x}
---   | cvar : HasSingleton {c=c} {c=c}
---   | union_l : HasSingleton s C1 -> HasSingleton s (.union C1 C2)
---   | union_r : HasSingleton s C2 -> HasSingleton s (.union C1 C2)
---   | proj : HasSingleton s C -> HasSingleton (s.proj K) (C.proj K)
-
--- theorem CaptureSet.Subset.subset_has_singleton' {C1 C2 : CaptureSet n k} (hh1 : HasSingleton s C1) (hs : Subset t C1 C2) : HasSingleton s C2 := by
---   induction hs generalizing s
---   case empty => cases hh1
---   case rfl => assumption
---   case union_l ih1 ih2 =>
---     cases hh1
---     apply! ih1
---     apply! ih2
---   case union_rl ih => apply HasSingleton.union_l; apply ih hh1
---   case union_rr ih => apply HasSingleton.union_r; apply ih hh1
---   case trans ha hb iha ihb =>
---     apply ihb $ iha hh1
---   case proj_empty => cases hh1; rename_i hh1; cases hh1
---   case proj_union_l =>
---     cases hh1
---     { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_l }
---     { rename_i hh1; cases hh1; constructor; apply! HasSingleton.union_r }
---   case proj_union_r =>
---     cases hh1
---     rename_i hh1
---     cases hh1
---     { apply HasSingleton.union_l; constructor; assumption }
---     { apply HasSingleton.union_r; constructor; assumption }
---   case proj ih =>
---     cases hh1
---     constructor
---     apply! ih
-
--- theorem CaptureSet.subset_has_singleton {C1 C2 : CaptureSet n k} (hs : C1 ⊆ C2) (hh : HasSingleton C C1) : HasSingleton C C2 := by
---   have ⟨_, h⟩ := hs
---   apply Subset.subset_has_singleton' hh h
-
--- theorem CaptureSet.projected_singleton_has_singleton (hp : ProjectedSingleton s C) : HasSingleton C C := by
---   induction hp
---   case var => constructor
---   case cvar => constructor
---   case proj hp => constructor; assumption
-
--- theorem CaptureSet.projected_singleton_unique_singleton (hp : ProjectedSingleton s C) (hh : HasSingleton C' C) : C' = C := by
---   induction hp generalizing C'
---   case var => cases hh; rfl
---   case cvar => cases hh; rfl
---   case proj hp ih =>
---     cases hh
---     rename_i hh
---     have ih1 := ih hh
---     subst_vars
---     simp
-
-
--- theorem CaptureSet.Subset.empty_projected_singleton {C : CaptureSet n k} (hs : C ⊆ .empty) (hp : ProjectedSingleton s C) : False := by
---   have ⟨n, h⟩ := hs
---   have h2 := CaptureSet.Subset.subset_has_singleton' (projected_singleton_has_singleton hp) h
---   cases h2
-
--- end Capless
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index 7388b5fb..acef732c 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -295,6 +295,13 @@ inductive Kind : Type where
   | node : Classifier -> List Classifier -> Kind -- .only[K].except[K1, ..., Kn]
   | union : Kind -> Kind -> Kind
 
+@[simp]
+def Kind.top := node .top []
+
+-- Shorthand notation for a subtree without exclusions
+@[simp]
+def Kind.classifier c := node c []
+
 def Kind.sup (a: Kind) (b: Kind) : Kind := a.union b
 
 def Kind.inf (a: Kind) (b: Kind) : Kind :=
@@ -348,7 +355,7 @@ inductive Kind.IsEmpty : Kind -> Prop where
 theorem Kind.IsEmpty.is_absurd (he : IsEmpty (.node r exs)) : ContainsSupOf exs r := by
   cases he; assumption
 
-inductive Intersect : Kind -> Kind -> Kind -> Prop where
+inductive Kind.Intersect : Kind -> Kind -> Kind -> Prop where
   | empty_l : Intersect .empty K .empty
   | empty_r : Intersect K .empty .empty
   | union_l : Intersect K1 K R1 -> Intersect K2 K R2 -> Intersect (K1.union K2) K (R1.union R2)
@@ -357,6 +364,70 @@ inductive Intersect : Kind -> Kind -> Kind -> Prop where
   | singleton_r : r2.Subclass r1 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r2 (ex1 ++ ex2))
   | singleton_disj : r1.Disjoint r2 -> Intersect (.node r1 ex1) (.node r2 ex2) .empty
 
+@[simp]
+def Kind.intersect (k : Kind) (l : Kind) : Kind :=
+  match k with
+  | .empty => .empty
+  | .union k1 k2 => .union (k1.intersect l) (k2.intersect l)
+  | .node r1 ex1 =>
+    match l with
+    | .empty => .empty
+    | .union l1 l2 => .union ((node r1 ex1).intersect l1) ((node r1 ex1).intersect l2)
+    | .node r2 ex2 =>
+      if r1.subclass r2 then .node r1 (ex1 ++ ex2)
+      else if r2.subclass r1 then .node r2 (ex1 ++ ex2)
+      else .empty
+
+theorem Kind.Intersect.lawful : Intersect K L (K.intersect L) := by
+  induction K generalizing L
+  case empty => unfold intersect; apply empty_l
+  case union ha hb =>
+    unfold intersect
+    apply union_l ha hb
+  case node r1 ex1 =>
+    induction L
+    case empty => unfold intersect; simp; apply empty_r
+    case union ha hb => unfold intersect; simp; apply union_r ha hb
+    case node r2 ex2 =>
+      unfold intersect
+      simp
+      split
+      . rename_i h
+        rw [← Classifier.subclass_is_Subclass] at h
+        apply! singleton_l
+      . split
+        . rename_i h
+          rw [← Classifier.subclass_is_Subclass] at h
+          apply! singleton_r
+        . rename_i h1 h2
+          rw [← Classifier.subclass_is_Subclass] at h1 h2
+          cases Classifier.subclass_or_disjoint r1 r2 <;> try contradiction
+          rename_i h3; cases h3
+          case inl h3 => have h4 := h3.weaken; contradiction
+          case inr h3 => apply! singleton_disj
+
+theorem Kind.Intersect.top_r {K : Kind} : K.intersect .top = K := by
+  induction K
+  case empty => simp
+  case union ha hb => simp_all
+  case node r1 ex1 =>
+    have h := Classifier.Subclass.of_top (a:=r1)
+    rw [Classifier.subclass_is_Subclass] at h
+    aesop
+
+theorem Kind.Intersect.top_l {K : Kind} : Kind.top.intersect K = K := by
+  induction K
+  case empty => simp
+  case union ha hb => aesop
+  case node r1 ex1 =>
+    have h := Classifier.Subclass.of_top (a:=r1)
+    rw [Classifier.subclass_is_Subclass] at h
+    simp
+    split
+    . rename_i h1; unfold Classifier.subclass at h1; simp_all
+    . simp
+
+
 inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   | empty_l : Subtract .empty K .empty
   | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
@@ -1094,7 +1165,6 @@ theorem Kind.Subtract.empty_union_l
     cases he
     aesop
 
-
 theorem Kind.Subtract.empty_union_rl
   (hs : Subtract K K1 R)
   (he : R.IsEmpty)
@@ -1113,6 +1183,20 @@ theorem Kind.Subtract.empty_union_rl
     cases hs.unique hsa
     apply hsb.is_empty_l he
 
+theorem Kind.Subtract.top (hs : Subtract K .top R) : IsEmpty R := by
+  cases hs
+  case empty_l => constructor
+  case union_l ha hb =>
+    apply IsEmpty.union ha.top hb.top
+  case tree =>
+    constructor
+    apply ContainsSupOf.here
+    apply Classifier.Subclass.of_top
+
+theorem Kind.Subkind.of_top : Subkind K .top := by
+  have ⟨R, h⟩ := Subtract.exists K .top
+  apply subtract h h.top
+
 -- prove later
 theorem Kind.Subtract.rfl (hs : Subtract K K R) : IsEmpty R := by sorry
 
@@ -1136,3 +1220,80 @@ theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3) : Subkind
   have ⟨R, h⟩ := Subtract.exists K1 K3
   apply subtract h
   apply! h.implies_trans h1
+
+theorem Kind.Intersect.with_subkind
+  (hs : K1.Subkind K2)
+  : (intersect L K1).Subkind (intersect L K2) := by sorry
+
+theorem Kind.Subkind.of_empty
+  (hs : Subkind K L)
+  (he : L.IsEmpty)
+  : K.IsEmpty := by
+  cases hs
+  case subtract hs he1 => apply! hs.empty_r_inv
+
+theorem Kind.Intersect.subkind_l
+  : (intersect K L).Subkind K := by sorry
+theorem Kind.Intersect.subkind_r
+  : (intersect K L).Subkind L := by sorry
+
+theorem Kind.Intersect.is_empty_l
+  (he : IsEmpty K) : IsEmpty (K.intersect L) := by
+  apply Subkind.of_empty subkind_l he
+
+theorem Kind.Intersect.is_empty_r
+  (he : IsEmpty L) : IsEmpty (intersect K L) := by
+  apply Subkind.of_empty subkind_r he
+
+theorem Kind.Subkind.union_rl : Subkind K1 (.union K1 K2) := by sorry
+theorem Kind.Subkind.union_rr : Subkind K2 (.union K1 K2) := by sorry
+
+theorem Kind.Subkind.union_l
+  (hs1 : Subkind K1 L)
+  (hs2 : Subkind K2 L)
+  : Subkind (.union K1 K2) L := by
+  cases hs1
+  cases hs2
+  constructor
+  apply! Subtract.union_l
+  apply! IsEmpty.union
+
+theorem Kind.Subkind.join
+  (hs1 : Subkind K1 L1)
+  (hs2 : Subkind K2 L2)
+  : Subkind (.union K1 K2) (.union L1 L2) := by
+  apply union_l
+  apply trans hs1 .union_rl
+  apply trans hs2 .union_rr
+
+theorem Kind.Subkind.reorder_union_4 : Subkind (.union (.union A B) (.union C D)) (.union (.union A C) (.union B D)) := by
+  apply union_l
+  . apply union_l
+    . apply trans .union_rl .union_rl
+    . apply trans .union_rl .union_rr
+  . apply union_l
+    . apply trans .union_rr .union_rl
+    . apply trans .union_rr .union_rr
+
+theorem Kind.Intersect.union_r_subkind : Subkind (.intersect K (.union L1 L2)) (.union (K.intersect L1) (K.intersect L2)) := by
+  induction K
+  case empty => simp; apply Subkind.subtract; apply Subtract.empty_l; constructor
+  case node => simp; apply Subkind.rfl
+  case union ha hb =>
+    -- simp
+    have h := Subkind.join ha hb
+    simp at h
+    simp
+    apply Subkind.trans h .reorder_union_4
+
+theorem Kind.Subkind.is_empty_l
+  (he : IsEmpty K)
+  : Subkind K L := by
+  induction he
+  case empty =>
+    apply subtract .empty_l .empty
+  case absurd exs r hsc =>
+    have ⟨R, h⟩ := Subtract.exists (.node r exs) L
+    apply! subtract h $ h.absurd_l _
+  case union h1 h2 =>
+    apply! union_l
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 697e97b9..7c6a9fe6 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -113,37 +113,30 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont (.union C1 C2)
 | singleton :
   Context.Bound Γ x (S^C) ->
-  WidenVar x s C C1 ->
-  WellScoped Γ cont C1 ->
-  WellScoped Γ cont (.singleton s)
+  WellScoped Γ cont (C.proj L) ->
+  WellScoped Γ cont {x=x|L}
 | csingleton :
   Context.CBound Γ c (CBinding.inst C) ->
-  WidenCVar c s C C1 ->
-  WellScoped Γ cont C1 ->
-  WellScoped Γ cont (.singleton s)
+  WellScoped Γ cont (C.proj L) ->
+  WellScoped Γ cont {c=c|L}
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  WidenCVar c s C C1 ->
-  WellScoped Γ cont C1 ->
-  WellScoped Γ cont (.singleton s)
+  WellScoped Γ cont (C.proj L) ->
+  WellScoped Γ cont {c=c|L}
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
-  s.IsCVar c ->
-  WellScoped Γ cont (.singleton s)
+  WellScoped Γ cont {c=c|L}
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
-  s.IsVar x ->
-  WellScoped Γ cont (.singleton s)
+  WellScoped Γ cont {x=x|L}
 | label_disj : -- label is within context but not reachable from stack
   Context.LBound Γ x c S ->
-  Kind.Disjoint K (.classifier c) ->
-  s.IsVarWith x K ->
-  WellScoped Γ cont (.singleton s)
-| label_absurd : -- label is projected to absurdity
-  Context.LBound Γ x c S ->
-  s.IsAbsurdVar x ->
-  WellScoped Γ cont (.singleton s)
+  Kind.Disjoint L (.classifier c) ->
+  WellScoped Γ cont {x=x|L}
+| absurd : -- a completely projected away reference cannot be used, so it is always well-scoped.
+  L.IsEmpty ->
+  WellScoped Γ cont (.singleton s L)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
 inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 7559aab6..118c7fce 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -12,15 +12,13 @@ namespace Capless
 
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
-  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x} K
-  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x} (.singleton c [])
-  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c} K
-  | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
-  | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ C K -> CaptureKind Γ {c=c} K
+  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x | L} (L.intersect K)
+  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x|K} (K.intersect (.node c []))
+  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c|L} (L.intersect K)
+  | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ C K -> CaptureKind Γ {c=c | L} (L.intersect K)
+  | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ C K -> CaptureKind Γ {c=c | L} (L.intersect K)
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
   | empty : CaptureKind Γ .empty K
-  | singleton_proj_kind : CaptureKind Γ (.singleton $ .proj s K) K
-  | singleton_proj : CaptureKind Γ (.singleton s) K -> CaptureKind Γ (.singleton $ s.proj K1) K
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
@@ -37,27 +35,21 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Subcapt Γ (C1 ∪ C2) C3
 | var :
   Context.Bound Γ x (CType.capt C S) ->
-  Subcapt Γ {x=x} C
+  Subcapt Γ {x=x|L} (C.proj L)
 | cinstl :
   Context.CBound Γ c (CBinding.inst C) ->
-  Subcapt Γ C {c=c}
+  Subcapt Γ (C.proj L) {c=c|L}
 | cinstr :
   Context.CBound Γ c (CBinding.inst C) ->
-  Subcapt Γ {c=c} C
+  Subcapt Γ {c=c|L} (C.proj L)
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  Subcapt Γ {c=c} C
-| singleton_proj_sub {s : Singleton n k} {K1 K2 : Kind}:
-  K1.Subkind K2 -> Subcapt Γ (.singleton $ s.proj K1) (.singleton $ s.proj K2)
-| singleton_proj_l : Subcapt Γ (.singleton $ .proj s K) (.singleton s)
-| singleton_proj : Subcapt Γ (.singleton s) C -> Subcapt Γ (.singleton $ s.proj K) (C.proj K)
-| singleton_proj_disj :
-  Kind.Disjoint K1 K2 ->
-  CaptureKind Γ (.singleton s) K1 ->
-  Subcapt Γ (.singleton $ s.proj K2) .empty
-
+  Subcapt Γ {c=c|L} (C.proj L)
+| subkind : K.Subkind L -> Subcapt Γ (.singleton s K) (.singleton s L)
+| proj_absurd : L.IsEmpty -> Subcapt Γ (.singleton s L) .empty
+| proj_split : Subcapt Γ (.singleton s (.union K1 K2)) (.union (.singleton s K1) (.singleton s K2))
+| proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2))
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
-notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 
 end Capless
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index ab20e762..f7eafc2a 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -29,18 +29,17 @@ theorem Subcapt.proj_sub {C : CaptureSet n k}
   : Subcapt Γ (C.proj K1) (C.proj K2) := by
   induction C
   case empty => simp; apply subset .rfl
-  case singleton s => apply singleton_proj_sub hsk
+  case singleton s L =>
+    apply subkind
+    apply! Kind.Intersect.with_subkind
   case union ha hb iha ihb =>
     simp
     apply join iha ihb
 
 theorem Subcapt.proj_l : Subcapt Γ (C.proj K) C := by
-  induction C
-  case empty => simp; apply rfl
-  case singleton => apply singleton_proj_l
-  case union ha hb iha ihb =>
-    simp
-    apply! join
+  have h := proj_sub (Γ:=Γ) (C:=C) (K1:=K) .of_top
+  rw [CaptureSet.proj_top] at h
+  assumption
 
 theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
   match hk with
@@ -53,13 +52,11 @@ theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2)
     have ⟨_, _⟩ := hk.union_l_inv' heq
     apply And.intro <;> apply! CaptureKind.sub
   | .empty => by cases heq
-  | .singleton_proj_kind => by cases heq
-  | .singleton_proj hk => by cases heq
 termination_by structural hk
 
 
 theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := by
-  induction hs <;> (subst_vars; simp_all)
+  induction hs <;> (subst_vars; try simp_all)
   case trans ha hb iha ihb =>
     have ⟨_, _⟩ := ihb
     apply And.intro <;> apply! trans
@@ -67,57 +64,75 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     have ⟨_, _⟩ := hsub.union_l_inv
     apply And.intro <;> apply! subset
   case cinstl Γ _ hb =>
-    have h1 : Subcapt Γ C1 (C1 ∪ C2) := Subcapt.subset $ .union_rl .rfl
-    have h2 : Subcapt Γ C2 (C1 ∪ C2) := Subcapt.subset $ .union_rr .rfl
+    unfold CaptureSet.proj at heq; split at heq <;> simp at heq
+    have ⟨_, _⟩ := heq; subst_vars; simp_all
+    rename_i Γ c L _ C1 C2
+    have h1 : Subcapt Γ (C1.proj L) ((C1 ∪ C2).proj L) := by
+      simp
+      apply Subcapt.subset $ .union_rl .rfl
+    have h2 : Subcapt Γ (C2.proj L) ((C1 ∪ C2).proj L) := by
+      simp
+      apply Subcapt.subset $ .union_rr .rfl
     apply And.intro <;> apply! trans _ (.cinstl hb)
+  case union =>
+    injections; subst_vars; apply And.intro <;> assumption
+  case proj_merge =>
+    have ⟨_, _⟩ := heq; subst_vars; simp_all
+    apply And.intro <;> apply subkind
+    apply Kind.Subkind.union_rl
+    apply Kind.Subkind.union_rr
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
 
-theorem Subcapt.proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by
-  induction C
-  case empty => simp; apply subset .empty
-  case union ha hb iha ihb =>
-    have ⟨_, _⟩ := hs.union_l_inv
-    simp
-    apply! union (iha _) (ihb _)
-  case singleton => apply! singleton_proj
+-- prove later, not sure if needed
+theorem Subcapt.proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by sorry
 
-theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
-  induction C
-  case empty => apply empty
-  case union  => apply! union
-  case singleton => apply! singleton_proj_kind
-
-theorem CaptureKind.proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj K1) K := by
-  induction C
-  case empty => simp; apply empty
-  case union ha hb =>
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply! union (ha _) (hb _)
-  case singleton => apply! singleton_proj
-
-theorem Subcapt.proj_disj
-  (hd : Kind.Disjoint K1 K2)
-  (hk : CaptureKind Γ C K1)
-  : Subcapt Γ (C.proj K2) .empty := by
+theorem Subcapt.proj_absurd_set {C : CaptureSet n k} (he : L.IsEmpty) : Subcapt Γ (C.proj L) .empty := by
   induction C
   case empty => simp; apply rfl
-  case union ha hb =>
+  case union ha hb => apply! union
+  case singleton =>
     simp
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply! union (ha _) (hb _)
-  case singleton => apply! singleton_proj_disj
-
-theorem CaptureKind.var_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by
-  induction hk <;> (subst_vars; try simp_all)
-  case var hb1 hk ih =>
-    cases Context.bound_injective hb hb1
-    assumption
-  case label hb1 => cases Context.bound_lbound_absurd hb hb1
-  case sub hsk hk ih => apply! sub
-
-theorem CaptureKind.var_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by apply! hk.var_inv' (.refl _)
+    apply trans
+    apply subkind Kind.Intersect.subkind_r
+    apply! proj_absurd
+
+-- theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
+--   induction C
+--   case empty => apply empty
+--   case union  => apply! union
+--   case singleton => apply! singleton_proj_kind
+
+-- theorem CaptureKind.proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj K1) K := by
+--   induction C
+--   case empty => simp; apply empty
+--   case union ha hb =>
+--     have ⟨_, _⟩ := hk.union_l_inv
+--     apply! union (ha _) (hb _)
+--   case singleton => apply! singleton_proj
+
+-- theorem Subcapt.proj_disj
+--   (hd : Kind.Disjoint K1 K2)
+--   (hk : CaptureKind Γ C K1)
+--   : Subcapt Γ (C.proj K2) .empty := by
+--   induction C
+--   case empty => simp; apply rfl
+--   case union ha hb =>
+--     simp
+--     have ⟨_, _⟩ := hk.union_l_inv
+--     apply! union (ha _) (hb _)
+--   case singleton => apply! singleton_proj_disj
+
+-- theorem CaptureKind.var_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by
+--   induction hk <;> (subst_vars; try simp_all)
+--   case var hb1 hk ih =>
+--     cases Context.bound_injective hb hb1
+--     assumption
+--   case label hb1 => cases Context.bound_lbound_absurd hb hb1
+--   case sub hsk hk ih => apply! sub
+
+-- theorem CaptureKind.var_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by apply! hk.var_inv' (.refl _)
 
 -- theorem CaptureKind.proj_inv' (hk : CaptureKind Γ D K) (heq : D = C.proj K1) : K1.Subkind K ∨ (∃ K2, K1.Disjoint K2 ∧ CaptureKind Γ C K2) ∨ CaptureKind Γ C K := by
 --   induction hk generalizing C K1
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 5ec5cf98..bfffadf0 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -17,13 +17,13 @@ namespace Capless
 inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -> Prop where
 | var :
   Context.Bound Γ x (S^C) ->
-  Typed Γ (Term.var x) (S^{x=x}) {x=x}
+  Typed Γ (Term.var x) (S^{x=x|.top}) {x=x|.top}
 | label :
   Context.LBound Γ x c S ->
-  Typed Γ (Term.var x) (Label[S]^{x=x}) {x=x}
+  Typed Γ (Term.var x) (Label[S]^{x=x|.top}) {x=x|.top}
 | pack :
   CaptureBound Γ C B ->
-  Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} ->
+  Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x|.top} ->
   Typed Γ (Term.pack C x) (∃[c<:B]T) {}
 | sub :
   Typed Γ t E1 C1 ->
@@ -31,7 +31,7 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   (Γ ⊢ E1 <:e E2) ->
   Typed Γ t E2 C2
 | abs {C : CaptureSet n k} :
-  Typed (Γ,x:T) t E (C.weaken ∪ {x=0}) ->
+  Typed (Γ,x:T) t E (C.weaken ∪ {x=0|.top}) ->
   Typed Γ (λ(x:T)t) ((∀(x:T)E)^C) {}
 | tabs {C : CaptureSet n k} :
   Typed (Γ,X<:S) t E C ->
@@ -40,19 +40,19 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed (Γ,c<:B) t E C.cweaken ->
   Typed Γ (λ[c<:B]t) ((∀[c<:B]E)^C) {}
 | app :
-  Typed Γ (Term.var x) (EType.type (∀(x:T)E)^C) {x=x} ->
-  Typed Γ (Term.var y) T {x=y} ->
-  Typed Γ (Term.app x y) (E.open y) ({x=x} ∪ {x=y})
+  Typed Γ (Term.var x) (EType.type (∀(x:T)E)^C) {x=x|.top} ->
+  Typed Γ (Term.var y) T {x=y|.top} ->
+  Typed Γ (Term.app x y) (E.open y) ({x=x|.top} ∪ {x=y|.top})
 | invoke :
-  Typed Γ (Term.var x) (EType.type (Label[S])^C) {x=x} ->
-  Typed Γ (Term.var y) (S^{}) {x=y} ->
-  Typed Γ (Term.invoke x y) E ({x=x} ∪ {x=y})
+  Typed Γ (Term.var x) (EType.type (Label[S])^C) {x=x|.top} ->
+  Typed Γ (Term.var y) (S^{}) {x=y|.top} ->
+  Typed Γ (Term.invoke x y) E ({x=x|.top} ∪ {x=y|.top})
 | tapp :
-  Typed Γ (Term.var x) (EType.type (∀[X<:SType.tvar X]E)^C) {x=x} ->
-  Typed Γ (Term.tapp x X) (E.topen X) {x=x}
+  Typed Γ (Term.var x) (EType.type (∀[X<:SType.tvar X]E)^C) {x=x|.top} ->
+  Typed Γ (Term.tapp x X) (E.topen X) {x=x|.top}
 | capp :
-  Typed Γ (Term.var x) (EType.type (∀[c<:CBound.upper {c=c}]E)^C) {x=x} ->
-  Typed Γ (Term.capp x c) (E.copen c) {x=x}
+  Typed Γ (Term.var x) (EType.type (∀[c<:CBound.upper {c=c|.top}]E)^C) {x=x|.top} ->
+  Typed Γ (Term.capp x c) (E.copen c) {x=x|.top}
 | letin :
   Typed Γ t (EType.type T) C ->
   Typed (Γ,x: T) u E.weaken C.weaken ->  -- which means that x ∉ C and x ∉ fv(E)
@@ -70,9 +70,9 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
 | boundary {Γ : Context n m k} {S : SType n m k} :
   c.Subclass .control ->
   Typed
-    ((Γ,c<:CBound.kind (.classifier c)),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:CBound.kind (.node c [])),x: Label[S.cweaken]^{c=0|.top})
     t
-    (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0} ∪ {x=0}) ->
+    (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ->
   Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
 
 notation:40 Γ " ⊢ " t:80 " : " E " @ " C => Typed Γ t E C
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index dfe588d4..a393ff3b 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,17 +11,94 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
-theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.proj K) := by
-  induction hsc generalizing K <;> simp
-  case empty => apply empty
-  case union iha ihb => apply union iha ihb
-  case singleton hb hw hsc ih => apply singleton hb hw.proj ih
-  case csingleton hb hw hsc ih => apply csingleton hb hw.proj ih
-  case cbound hb hw hsc ih => apply cbound hb hw.proj ih
-  case ckind hb hw => apply ckind hb hw.proj
-  case label hb hl hw => apply label hb hl hw.proj
-  case label_disj hb hd hw => apply label_disj hb hd hw.there
-  case label_absurd hb ha => apply label_absurd hb ha.there
+theorem WellScoped.subkind
+  (hsc : WellScoped Γ cont (.proj C K2))
+  (hs : K1.Subkind K2)
+  : WellScoped Γ cont (.proj C K1) := by
+  generalize h : C.proj K2 = D at hsc
+  induction hsc generalizing C K2 K1
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    simp; constructor
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+  case singleton hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply singleton hb
+    apply ih
+    apply Kind.Intersect.with_subkind hs
+    apply! refl
+  case csingleton hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply csingleton hb
+    apply ih
+    apply Kind.Intersect.with_subkind hs
+    apply! refl
+  case cbound hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cbound hb
+    apply ih
+    apply Kind.Intersect.with_subkind hs
+    apply! refl
+  case ckind hb ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! ckind
+  case label hb hl =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! label
+  case label_disj hb hd =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply label_disj hb
+    apply hd.refine_subkind_l $ Kind.Intersect.with_subkind hs
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply absurd
+    apply (Kind.Intersect.with_subkind hs).of_empty he
+
+theorem WellScoped.subkind_singleton
+  (hsc : WellScoped Γ cont (.singleton s L))
+  (hs : Kind.Subkind K L)
+  : WellScoped Γ cont (.singleton s K) := by
+  rw [← Kind.Intersect.top_l (K:=L)] at hsc
+  have h : CaptureSet.proj (.singleton s .top) L = .singleton s (.intersect .top L) := by simp
+  rw [← h] at hsc
+  have h1 := hsc.subkind hs
+  simp only [CaptureSet.proj] at h1
+  rw [Kind.Intersect.top_l] at h1
+  assumption
+
+-- theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.proj K) := by
+--   induction hsc generalizing K
+--   case empty => apply empty
+--   case union ih1 ih2 => apply union ih1 ih2
+--   case singleton hb hsc ih =>
+--     simp only [CaptureSet.proj]
+--     apply singleton hb ih
+--   case csingleton hb hsc ih =>
+--     simp only [CaptureSet.proj]
+--     apply csingleton hb ih
+--   case cbound hb hsc ih =>
+--     simp only [CaptureSet.proj]
+--     apply cbound hb ih
+--   case ckind hb =>
+--     simp only [CaptureSet.proj]
+--     apply ckind hb
+--   case label hb hl =>
+--     simp only [CaptureSet.proj]
+--     apply label hb hl
+--   case label_disj hb hd =>
+--     simp only [CaptureSet.proj]
+--     apply label_disj hb (hd.intersect_disjoint Kind.Intersect.lawful)
+
 
 theorem WellScoped.subset {C1 C2 : CaptureSet n k}
   (hsc : WellScoped Γ cont C2)
@@ -48,13 +125,12 @@ theorem WellScoped.cons
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case label hb hl hw =>
+  case label hb hl =>
     apply label hb
     constructor; assumption
-    apply hw
   case label_disj hb hd =>
     apply! label_disj
-  case label_absurd => apply! label_absurd
+  case absurd => apply! absurd
 
 theorem WellScoped.conse
   (hsc : WellScoped Γ cont C) :
@@ -66,12 +142,11 @@ theorem WellScoped.conse
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case label hb hl hw =>
+  case label hb hl =>
     apply label hb
     constructor; assumption
-    apply hw
   case label_disj => apply! label_disj
-  case label_absurd => apply! label_absurd
+  case absurd => apply! absurd
 
 theorem WellScoped.scope
   (hsc : WellScoped Γ cont C) :
@@ -83,133 +158,133 @@ theorem WellScoped.scope
   case csingleton ih => apply csingleton <;> aesop
   case cbound ih => apply cbound <;> aesop
   case ckind ih => apply ckind <;> aesop
-  case label hb hl hw =>
+  case label hb hl =>
     apply label hb
     constructor; assumption
-    apply hw
   case label_disj => apply! label_disj
-  case label_absurd => apply! label_absurd
-
-theorem WellScoped.subkind' {C D : CaptureSet n k}
-  (hsc : WellScoped Γ cont D)
-  (heq : D = C.proj K2)
-  (hs : K1.Subkind K2)
-  : WellScoped Γ cont (C.proj K1) := by
-  induction hsc generalizing C <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq; simp)
-  { apply empty }
-  { have ⟨_, _⟩ := heq; subst_vars;
-    rename_i ih1 _ ih2
-    apply union (ih1 _) (ih2 _) <;> rfl }
-  { subst_vars
-    rename_i hw
-    cases hw
-    rename_i hb _ _ _ hw hsc ih
-    apply singleton hb (.proj hw) (ih _)
-    rfl }
-  { subst_vars
-    rename_i hw
-    cases hw
-    rename_i hb _ _ _ hw hsc ih
-    apply csingleton hb (.proj hw) (ih _)
-    rfl }
-  { subst_vars
-    rename_i hw
-    cases hw
-    rename_i hb _ _ _ hw hsc ih
-    apply cbound hb (.proj hw) (ih _)
-    rfl }
-  { subst_vars
-    rename_i hw
-    apply! ckind _ hw.proj_inv.proj }
-  { subst_vars
-    rename_i hw
-    apply! label _ _ hw.proj_inv.proj }
-  { subst_vars
-    rename_i hw
-    cases hw
-    case here hw => apply! label_disj _ (hw.refine_by_subkind _) (.here _)
-    case there hw => apply! label_disj _ _ (.there _) }
-  { subst_vars
-    rename_i hb _ _ hw
-    cases hw
-    case here hd hw =>
-      apply label_absurd hb (.here _ hw)
-      apply! (hd.symm.refine_by_subkind _).symm
-    case there hw => apply! label_absurd hb (.there _) }
-
-theorem WellScoped.subkind {C: CaptureSet n k} (hsc : WellScoped Γ cont (C.proj K2)) (hs : K1.Subkind K2) : WellScoped Γ cont (C.proj K1) := by
-  apply subkind' hsc _ hs
-  rfl
-
--- theorem WellScoped.capture_kind'
---   (hsc : WellScoped Γ cont D)
---   (heq : D = C.proj K)
---   (hk : CaptureKind Γ C K)
---   : WellScoped Γ cont C := by
---   induction hsc generalizing C <;> (unfold CaptureSet.proj at heq; split at heq <;> simp at heq)
---   { apply empty }
---   { have ⟨_, _⟩ := heq; subst_vars
---     rename_i h1 ih1 h2 ih2
---     have ⟨_, _⟩ := hk.union_l_inv
---     -- apply union (ih1 _ hk) (ih2 _ hk)
---     apply! union (ih1 (.refl _) _) (ih2 (.refl _) _) }
---   { rename_i hb hw hsc ih _ _;
---     subst_vars;
---     cases hw;
---     apply singleton hb
---     assumption
---     apply ih (.refl _)
---     apply hk.widen_var hb
---     assumption }
---   { rename_i hb hw hsc ih _ _;
---     subst_vars;
---     cases hw;
---     apply csingleton hb
---     assumption
---     apply ih (.refl _)
---     apply hk.widen_cinstr hb
---     assumption }
---   { rename_i hb hw hsc ih _ _;
---     subst_vars;
---     cases hw;
---     apply cbound hb
---     assumption
---     apply ih (.refl _)
---     apply hk.widen_cbound hb
---     assumption }
---   { rename_i hb hi _ _
---     cases hi <;> cases heq
---     apply! ckind
---   }
---   { rename_i hb hl hi _ _
---     cases hi <;> cases heq
---     apply! label }
---   { rename_i hb hd hi _ _
---     cases hi <;> cases heq
---     case here.refl hi =>
---       cases hk.widen_lbound hb hi
---       case inl hsub => cases Kind.subkind_disjoint_absurd hsub hd.symm
---       case inr hi =>
---         have ⟨K1, _, hi⟩ := hi
---         apply label_disj hb _ hi
---         apply! hd.refine_by_subkind
---     case there.refl hi => apply! label_disj
---   }
-
--- theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : CaptureKind Γ C K) : WellScoped Γ cont C := by apply! hsc.capture_kind' $ .refl _
-
-theorem WellScoped.union_inv (hsc : WellScoped Γ cont (C1 ∪ C2)) : WellScoped Γ cont C1 ∧ WellScoped Γ cont C2 := by
-  cases hsc; aesop
+  case absurd => apply! absurd
+
+theorem WellScoped.absurd_set
+  (he : Kind.IsEmpty L)
+  : WellScoped Γ cont (.proj C L) := by
+  induction C
+  case empty => simp; constructor
+  case union ha hb => simp; apply! union
+  case singleton =>
+    simp
+    apply absurd
+    apply! Kind.Subkind.of_empty Kind.Intersect.subkind_r
+
+theorem WellScoped.proj_merge
+  (hsc1 : WellScoped Γ cont (.proj C K1))
+  (hsc2 : WellScoped Γ cont (.proj C K2))
+  : WellScoped Γ cont (.proj C (K1.union K2)) := by
+  generalize h : C.proj K1 = D at hsc1
+  induction hsc1 generalizing C K1 K2
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    simp; constructor
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hsc2
+    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+  case singleton hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hsc2
+    case singleton hb2 hsc2 =>
+      cases Context.bound_injective hb hb2
+      apply singleton hb
+      apply subkind _ Kind.Intersect.union_r_subkind
+      apply! ih _ (.refl _)
+    case label hb2 _ => cases Context.bound_lbound_absurd hb hb2
+    case label_disj hb2 _ => cases Context.bound_lbound_absurd hb hb2
+    case absurd p he =>
+      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply! Kind.Subkind.is_empty_l
+      apply subkind_singleton _ h
+      apply! singleton
+  case csingleton hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hsc2
+    case csingleton hb2 hsc2 =>
+      cases Context.cbound_injective hb hb2
+      apply csingleton hb
+      apply subkind _ Kind.Intersect.union_r_subkind
+      apply! ih _ (.refl _)
+    case cbound hb2 _ => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd p he =>
+      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply! Kind.Subkind.is_empty_l
+      apply subkind_singleton _ h
+      apply! csingleton
+  case cbound hb hsc ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hsc2
+    case csingleton hb2 _ => cases Context.cbound_injective hb hb2
+    case cbound hb2 hsc2 =>
+      cases Context.cbound_injective hb hb2
+      apply cbound hb
+      apply subkind _ Kind.Intersect.union_r_subkind
+      apply! ih _ (.refl _)
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd p he =>
+      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply! Kind.Subkind.is_empty_l
+      apply subkind_singleton _ h
+      apply! cbound
+  case ckind hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! ckind
+  case label hb hl =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! label
+  case label_disj hb hd =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hsc2
+    case singleton hb2 _ => cases Context.bound_lbound_absurd hb2 hb
+    case label hb hl => apply! label
+    case label_disj hb2 hd2 =>
+      cases Context.lbound_inj hb hb2
+      subst_vars
+      have h := Kind.Disjoint.union_l hd hd2
+      apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
+    case absurd he =>
+      have h := Kind.Disjoint.union_l hd (.is_empty_l he)
+      apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    rename_i p
+    have h : (p.intersect (K1.union K2)).Subkind (p.intersect K2) := by
+      apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+      apply Kind.Subkind.union_l _ .rfl
+      apply Kind.Subkind.is_empty_l he
+    apply! subkind_singleton _ h
+
+theorem WellScoped.proj_merge_singleton
+  (hs1 : WellScoped Γ cont (.singleton s K1))
+  (hs2 : WellScoped Γ cont (.singleton s K2))
+  : WellScoped Γ cont (.singleton s (K1.union K2)) := by
+  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
+  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
+  rw [← CaptureSet.proj] at hs1 hs2
+  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
+  apply! proj_merge
 
-theorem WellScoped.singleton_inv (hsc : WellScoped Γ cont {x=x}) (hb : Γ.Bound x S^C) : WellScoped Γ cont C := by
-  cases hsc
-  case singleton hb1 hs hw => cases hw; cases Context.bound_injective hb hb1; assumption
-  case csingleton hw => cases hw
-  case cbound hw => cases hw
-  case ckind hw => cases hw
-  case label hb1 _ hw => cases hw; cases Context.bound_lbound_absurd hb hb1
-  case label_disj hb1 _ hw => cases hw
-  case label_absurd hb1 _ hw => cases hw
 
 theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
   induction hsub
@@ -217,205 +292,27 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
   case subset hsub => apply! hsc.subset
   case union ha hb iha ihb =>
     apply! union (iha _) (ihb _)
-  case var hb => apply! singleton _ .var
+  case var hb => apply! singleton
   case cinstl hb =>
     cases hsc
-    case singleton hv => cases hv
-    case csingleton hb1 _ hv =>
-      cases hv
+    case csingleton hb1 _ =>
       cases Context.cbound_injective hb1 hb
       assumption
-    case cbound hb1 _ hv =>
-      cases hv
+    case cbound hb1 _ =>
       cases Context.cbound_injective hb1 hb
-    case ckind hb1 hv =>
-      cases hv
+    case ckind hb1 =>
       cases Context.cbound_injective hb1 hb
-    case label hv => cases hv
-    case label_disj hv => cases hv
-    case label_absurd hb ha => cases ha
-  case cinstr hb => apply! csingleton _ .var
-  case cbound hb => apply! cbound _ .var
-  case singleton_proj_sub hk =>
-    rw [← CaptureSet.proj_singleton] at hsc
-    apply! hsc.subkind
-  case singleton_proj_l => apply! hsc.proj
-  case singleton_proj C K hs ih =>
-    generalize h : C.proj K = D at hsc
+    case absurd he => apply! absurd_set
+  case cinstr hb => apply! csingleton
+  case cbound hb => apply! cbound
+  case subkind => apply! hsc.subkind_singleton
+  case proj_absurd he => apply! absurd
+  case proj_split =>
     cases hsc
-    case empty =>
-      unfold CaptureSet.proj at h; split at h <;> simp at h
-      rw [← CaptureSet.proj_singleton]; apply proj; apply ih .empty
-    case union iha ihb =>
-      unfold CaptureSet.proj at h; split at h <;> simp at h
-      have ⟨_, _⟩ := h; subst_vars; simp_all
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
--- theorem WellScoped.capture_kind (hsc : WellScoped Γ cont (C.proj K)) (hk : Γ ⊢ C :k K) : WellScoped Γ cont C := by
---   induction hk
---   case var hb hk ih =>
---     cases hsc
---     case proj_singleton hsc hs =>
---       cases hs
---       rename_i hs
---       cases hs
---       assumption
---     case label_disj hb1 hd hsp =>
---       cases hsp
---       case here hs =>
---         cases hs
---         cases Context.bound_lbound_absurd hb hb1
---       case there hsp => cases hsp
---   case cvar hb => apply! ckind
---   case cbound hb hk ih =>
---     cases hsc
---     case proj_singleton hsc hs =>
---       cases hs
---       rename_i hs
---       cases hs
---       assumption
---     case label_disj hsp =>
---       cases hsp
---       case here hs _ => cases hs
---       case there hsp => cases hsp
---   case cinstr hb hk ih =>
---     cases hsc
---     case proj_singleton hsc hs =>
---       cases hs
---       rename_i hs
---       cases hs
---       assumption
---     case label_disj hsp =>
---       cases hsp
---       case here hs _ => cases hs
---       case there hsp => cases hsp
---   case sub hsk hk ih =>
---     apply! ih $ hsc.subkind _
---   case empty => apply! empty
---   case singleton_proj_kind =>
---     cases hsc
---     case proj_singleton hsc hs =>
---       cases hs
---       rename_i hs
---       cases hs
---       apply! proj_singleton hsc $ .proj _
---     case label_disj hb hd hsp =>
---       cases hsp
---       case here hs =>
---         cases hs
---         apply! label_disj hb hd $ .here _
---       case there hsp =>
---         apply! label_disj
---   case singleton_proj hk ih =>
---     cases hsc
---     case proj_singleton hsc hs =>
---       cases hs
---       apply! proj_singleton hsc
---     case label_disj hb hd hsp =>
---       cases hsp
---       case here hs =>
---         cases hs
---         rename_i hs
---         have h := label_disj hb hd (.here hs) (cont:=cont)
---         have h1 := ih h
---         apply h1.proj
---       case there hsp => apply! label_disj
---   -- case singleton_proj_disj hk hd ih =>
---   --   cases hsc
---   --   case proj_singleton hsc hs =>
---   --     cases hs
---   --     apply! proj_singleton
---   --   case label_disj hb hd hsp =>
---   --     cases hsp
---   --     case here hs =>
---   case union ha hb iha ihb =>
---     simp at hsc
---     cases hsc
---     apply! union (iha _) (ihb _)
-
--- theorem WellScoped.subcapt
---   (hsc : WellScoped Γ cont C)
---   (hs : Γ ⊢ C' <:c C) :
---   WellScoped Γ cont C' := by
---   induction hs
---   case trans ih1 ih2 => exact ih1 (ih2 hsc)
---   case subset hs => exact hsc.subset hs
---   case union ih1 ih2 => exact .union (ih1 hsc) (ih2 hsc)
---   case var hb => exact .singleton hb hsc
---   case cinstl hb1 =>
---     cases hsc
---     case csingleton hb =>
---       have h := Context.cbound_injective hb1 hb; injections; subst_vars
---       assumption
---     case cbound hb => cases Context.cbound_injective hb1 hb
---     case ckind hb => cases Context.cbound_injective hb1 hb
---     case label_disj hsp => cases hsp
---   case cinstr hb => exact .csingleton hb hsc
---   case cbound hb => exact .cbound hb hsc
---   case singleton_proj_sub hs =>
---     rename_i s K1 K2
---     have h : (CaptureSet.singleton (s.proj K2)) = (CaptureSet.singleton s).proj K2 := by simp
---     rw [h] at hsc
---     exact hsc.subkind hs
---   case singleton_proj_l => exact hsc.proj
---   case proj_r C D K hs hk ih =>
---     cases hk
---     case cvar => apply! ckind
---     case var hb hk =>
-
---       sorry
---     case cbound => sorry
---     case cinstr => sorry
---     case sub => sorry
---     case empty => sorry
---     case singleton_proj_kind => sorry
---     case singleton_proj => sorry
---     -- case singleton_proj_disj => sorry
---     case union => sorry
---   case singleton_proj_disj hd hk => sorry
--- -- termination_by?
-
--- -- theorem WellScoped.subkind
-
--- -- theorem WellScoped.var_inv
--- --   (hsc : WellScoped Γ cont {x=x})
--- --   (hbx : Γ.Bound x (S^C)) :
--- --   WellScoped Γ cont C := by
--- --   cases hsc
--- --   case singleton =>
--- --     rename_i hbx'
--- --     have h := Context.bound_injective hbx hbx'
--- --     cases h
--- --     trivial
--- --   case label =>
--- --     exfalso
--- --     apply Context.bound_lbound_absurd <;> easy
-
--- -- theorem WellScoped.label_inv
--- --   (hsc : WellScoped Γ cont {x=x})
--- --   (hbl : Γ.LBound x S) :
--- --   ∃ tail, cont.HasLabel x tail := by
--- --   cases hsc
--- --   case singleton =>
--- --     exfalso
--- --     apply Context.bound_lbound_absurd <;> easy
--- --   case label => aesop
+    apply! proj_merge_singleton
+  case proj_merge =>
+    have h1 := hsc.subkind_singleton .union_rl
+    have h2 := hsc.subkind_singleton .union_rr
+    apply! union
 
 end Capless

From 9e5c632170734f5256020bb4f2c6ab066824c2a1 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 10 Dec 2025 17:48:04 +0100
Subject: [PATCH 43/71] Renaming is green again

---
 Capless/CaptureSet.lean                    | 12 +++
 Capless/Renaming/Basic.lean                | 24 +++---
 Capless/Renaming/Capture/Subcapturing.lean | 95 ++++++----------------
 Capless/Renaming/Capture/Typing.lean       |  2 +-
 Capless/Renaming/Term/Subcapturing.lean    | 70 ++++++----------
 Capless/Renaming/Term/Typing.lean          |  2 +-
 Capless/Renaming/Type/Subcapturing.lean    | 50 ++++++------
 Capless/Renaming/Type/Typing.lean          |  2 +-
 Capless/Subcapturing.lean                  |  1 +
 9 files changed, 97 insertions(+), 161 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 091daf6b..f5d36035 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -317,3 +317,15 @@ theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K
   case union_l ha hb => apply! union_l
   case union_rl ha => apply! union_rl
   case union_rr hb => apply! union_rr
+
+theorem CaptureSet.proj_rename {C : CaptureSet n k} : (C.proj K).rename f = (C.rename f).proj K := by
+  induction C
+  case empty => simp
+  case singleton => simp
+  case union ha hb => simp; aesop
+
+theorem CaptureSet.proj_crename {C : CaptureSet n k} : (C.proj K).crename f = (C.crename f).proj K := by
+  induction C
+  case empty => simp
+  case singleton => simp
+  case union ha hb => simp; aesop
diff --git a/Capless/Renaming/Basic.lean b/Capless/Renaming/Basic.lean
index bdc72f04..d12361c1 100644
--- a/Capless/Renaming/Basic.lean
+++ b/Capless/Renaming/Basic.lean
@@ -21,7 +21,7 @@ structure VarMap (Γ : Context n m k) (f : FinFun n n') (Δ : Context n' m k) wh
   map : ∀ x E, Γ.Bound x E -> Δ.Bound (f x) (E.rename f)
   tmap : ∀ X b, Γ.TBound X b -> Δ.TBound X (b.rename f)
   cmap : ∀ c b, Γ.CBound c b -> Δ.CBound c (b.rename f)
-  lmap : ∀ x S, Γ.LBound x S -> Δ.LBound (f x) (S.rename f)
+  lmap : ∀ x c S, Γ.LBound x c S -> Δ.LBound (f x) c (S.rename f)
 
 def VarMap.cext {Γ : Context n m k} {Δ : Context n' m k}
   (ρ : VarMap Γ f Δ) (b : CBinding n k) :
@@ -46,7 +46,7 @@ def VarMap.cext {Γ : Context n m k} {Δ : Context n' m k}
       simp [CBinding.cweaken_rename_comm]
       constructor
       apply ρ.cmap; assumption
-  · intros x S hb
+  · intros x c S hb
     cases hb
     simp [SType.cweaken_rename_comm]
     constructor
@@ -78,7 +78,7 @@ def VarMap.ext {Γ : Context n m k} {Δ : Context n' m k}
       rw [<- CBinding.weaken_rename]
       constructor
       apply ρ.cmap; assumption
-  · intros x S hb
+  · intros x c S hb
     cases hb
     case there_var =>
       rw [<- SType.weaken_rename]
@@ -113,7 +113,7 @@ def VarMap.text {Γ : Context n m k} {Δ : Context n' m k}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intros x S hb
+    intros x c S hb
     cases hb
     case there_tvar =>
       rw [SType.tweaken_rename]
@@ -124,7 +124,7 @@ structure CVarMap (Γ : Context n m k) (f : FinFun k k') (Δ : Context n m k') w
   map : ∀ x E, Γ.Bound x E -> Δ.Bound x (E.crename f)
   tmap : ∀ X b, Γ.TBound X b -> Δ.TBound X (b.crename f)
   cmap : ∀ c b, Γ.CBound c b -> Δ.CBound (f c) (b.crename f)
-  lmap : ∀ x S, Γ.LBound x S -> Δ.LBound x (S.crename f)
+  lmap : ∀ x c S, Γ.LBound x c S -> Δ.LBound x c (S.crename f)
 
 def CVarMap.cext {Γ : Context n m k} {Δ : Context n m k'}
   (ρ : CVarMap Γ f Δ) (b : CBinding n k) :
@@ -155,7 +155,7 @@ def CVarMap.cext {Γ : Context n m k} {Δ : Context n m k'}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_cvar hb0 =>
       rw [<- SType.cweaken_crename]
@@ -191,7 +191,7 @@ def CVarMap.ext {Γ : Context n m k} {Δ : Context n m k'}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_var =>
       rw [<- SType.weaken_crename]
@@ -226,7 +226,7 @@ def CVarMap.text {Γ : Context n m k} {Δ : Context n m k'}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_tvar hb0 =>
       rw [<- SType.tweaken_crename]
@@ -237,7 +237,7 @@ structure TVarMap (Γ : Context n m k) (f : FinFun m m') (Δ : Context n m' k) w
   map : ∀ x E, Γ.Bound x E -> Δ.Bound x (E.trename f)
   tmap : ∀ X b, Γ.TBound X b -> Δ.TBound (f X) (b.trename f)
   cmap : ∀ c b, Γ.CBound c b -> Δ.CBound c b
-  lmap : ∀ x S, Γ.LBound x S -> Δ.LBound x (S.trename f)
+  lmap : ∀ x c S, Γ.LBound x c S -> Δ.LBound x c (S.trename f)
 
 def TVarMap.ext {Γ : Context n m k} {Δ : Context n m' k}
   (ρ : TVarMap Γ f Δ) (E : CType n m k) :
@@ -267,7 +267,7 @@ def TVarMap.ext {Γ : Context n m k} {Δ : Context n m' k}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_var =>
       rw [<- SType.weaken_trename]
@@ -302,7 +302,7 @@ def TVarMap.text {Γ : Context n m k} {Δ : Context n m' k}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_tvar hb0 =>
       rw [<- SType.tweaken_trename]
@@ -336,7 +336,7 @@ def TVarMap.cext {Γ : Context n m k} {Δ : Context n m' k}
       constructor
       apply ρ.cmap; assumption
   case lmap =>
-    intro x S hb
+    intro x c S hb
     cases hb
     case there_cvar hb0 =>
       rw [<- SType.cweaken_trename]
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index 41f610d4..ae661649 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -16,85 +16,36 @@ theorem CaptureSet.Subset.crename {C1 C2 : CaptureSet n k}
   C1.crename f ⊆ C2.crename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
-  case proj_union =>
-    simp
-    apply proj_union
-  case union_proj =>
-    simp
-    apply union_proj
-
-mutual
 
 theorem CaptureKind.crename
   (h : CaptureKind Γ C K)
   (ρ : CVarMap Γ f Δ) :
-  CaptureKind Δ (C.crename f) K :=
-  match h with
-  | .label hl =>
-    have hl1 := ρ.lmap _ _ hl
-    CaptureKind.label hl1
-  | .cvar hc =>
-    CaptureKind.cvar (ρ.cmap _ _ hc)
-  | .sub hs hk => CaptureKind.sub hs (hk.crename ρ)
-  | .csub hs hk => by
-    have hk1 := hk.crename ρ
-    have hs1 := hs.crename ρ
-    apply CaptureKind.csub hs1
-    apply hk1
-  | .empty => CaptureKind.empty
-  | .proj_kind => by
-    simp
-    apply CaptureKind.proj_kind
-  | .proj hk => by
-    simp
-    apply CaptureKind.proj
-    apply hk.crename ρ
+  CaptureKind Δ (C.crename f) K := by
+  induction h
+  case var hb hk ih => apply! var (ρ.map _ _ hb) (ih _)
+  case label hb => apply! label (ρ.lmap _ _ _ hb)
+  case cvar hb => apply! cvar (ρ.cmap _ _ hb)
+  case cbound hb hk ih => apply! cbound (ρ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih => apply! cinstr (ρ.cmap _ _ hb) (ih _)
+  case sub hs hk ih => apply! sub hs (ih _)
+  case empty => apply empty
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
   (ρ : CVarMap Γ f Δ) :
-  Subcapt Δ (C1.crename f) (C2.crename f) :=
-  match h with
-  | .trans a b => by
-    apply Subcapt.trans (a.crename ρ) (b.crename ρ)
-  | .subset hsub => by
-    apply Subcapt.subset
-    apply CaptureSet.crename_monotone hsub
-  | .union a b => by
-    simp
-    apply Subcapt.union (a.crename ρ) (b.crename ρ)
-  | .var hb => by
-    have hb1 := ρ.map _ _ hb
-    simp [CType.crename] at hb1
-    apply Subcapt.var hb1
-  | .cinstl hb => by
-    have hb1 := ρ.cmap _ _ hb
-    apply Subcapt.cinstl hb1
-  | .cinstr hb => by
-    have hb1 := ρ.cmap _ _ hb
-    apply Subcapt.cinstr hb1
-  | .cbound hb => by
-    have hb1 := ρ.cmap _ _ hb
-    apply Subcapt.cbound hb1
-  | .proj hs => by
-    simp
-    apply Subcapt.proj
-    apply hs.crename ρ
-  | .proj_sub hs => by
-    simp
-    apply Subcapt.proj_sub hs
-  | .proj_l => by
-    simp
-    apply Subcapt.proj_l
-  | .proj_r hk => by
-    simp
-    apply Subcapt.proj_r
-    apply hk.crename ρ
-  | .proj_disj hd hk => by
-    simp
-    apply Subcapt.proj_disj hd
-    apply hk.crename ρ
-
-end
+  Subcapt Δ (C1.crename f) (C2.crename f) := by
+  induction h <;> try rw [CaptureSet.proj_crename]
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply! subset $ hs.crename
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply! var (ρ.map _ _ hb)
+  case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
+  case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
+  case cbound hb => apply! cbound (ρ.cmap _ _ hb)
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
+  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Renaming/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean
index c65afeab..8b7564e8 100644
--- a/Capless/Renaming/Capture/Typing.lean
+++ b/Capless/Renaming/Capture/Typing.lean
@@ -124,7 +124,7 @@ theorem Typed.crename
     apply ih2; assumption
   case boundary ih =>
     simp [Term.crename, EType.crename, CType.crename, SType.crename]
-    apply boundary
+    apply boundary; assumption
     have ih := ih ((ρ.cext _).ext _)
     simp [CBinding.crename,
           TBinding.crename,
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index b7e798db..30ee0acd 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -17,59 +17,35 @@ theorem CaptureSet.Subset.rename {C1 C2 : CaptureSet n k}
   C1.rename f ⊆ C2.rename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
   apply CaptureSet.Subset.union_rr; trivial
-  case proj_union =>
-    simp
-    apply proj_union
-  case union_proj =>
-    simp
-    apply union_proj
 
-mutual
 theorem CaptureKind.rename
   (h : Γ ⊢ C :k K)
-  (ρ : VarMap Γ f Δ) : Δ ⊢ (C.rename f) :k K :=
-  match h with
-  | .empty => .empty
-  | .label hl => .label (ρ.lmap _ _ hl)
-  | .cvar hb => .cvar (ρ.cmap _ _ hb)
-  | .csub hs hk => .csub (hs.rename ρ) (hk.rename ρ)
-  | .sub hs hk => .sub hs (hk.rename ρ)
-  | .proj_kind => by
-    simp
-    apply CaptureKind.proj_kind
-  | .proj hk => by
-    simp
-    apply CaptureKind.proj (hk.rename ρ)
+  (ρ : VarMap Γ f Δ) : Δ ⊢ (C.rename f) :k K := by
+  induction h
+  case var hb hk ih => apply! var (ρ.map _ _ hb) (ih _)
+  case label hb => apply! label (ρ.lmap _ _ _ hb)
+  case cvar hb => apply! cvar (ρ.cmap _ _ hb)
+  case cbound hb hk ih => apply! cbound (ρ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih => apply! cinstr (ρ.cmap _ _ hb) (ih _)
+  case sub hs hk ih => apply! sub hs (ih _)
+  case empty => apply empty
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
   (ρ : VarMap Γ f Δ) :
-  Subcapt Δ (C1.rename f) (C2.rename f) :=
-  match h with
-  | .trans ha hb => .trans (ha.rename ρ) (hb.rename ρ)
-  | .subset hs => by
-    apply Subcapt.subset
-    apply CaptureSet.Subset.rename hs
-  | .union ha hb => .union (ha.rename ρ) (hb.rename ρ)
-  | .var hb => .var (ρ.map _ _ hb)
-  | .cinstl hb => .cinstl (ρ.cmap _ _ hb)
-  | .cinstr hb => .cinstr (ρ.cmap _ _ hb)
-  | .cbound hb => .cbound (ρ.cmap _ _ hb)
-  | .proj h1 => by
-    simp
-    apply Subcapt.proj (h1.rename ρ)
-  | .proj_sub hs => by
-    simp
-    apply Subcapt.proj_sub hs
-  | .proj_l => by
-    simp
-    apply Subcapt.proj_l
-  | .proj_r hk => by
-    simp
-    apply Subcapt.proj_r (hk.rename ρ)
-  | .proj_disj hd hk => by
-    simp
-    apply Subcapt.proj_disj hd (hk.rename ρ)
-end
+  Subcapt Δ (C1.rename f) (C2.rename f) :=by
+  induction h <;> try rw [CaptureSet.proj_rename]
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply! subset $ hs.rename
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply! var (ρ.map _ _ hb)
+  case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
+  case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
+  case cbound hb => apply! cbound (ρ.cmap _ _ hb)
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
+  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Renaming/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean
index aea928d6..af1ba474 100644
--- a/Capless/Renaming/Term/Typing.lean
+++ b/Capless/Renaming/Term/Typing.lean
@@ -128,7 +128,7 @@ theorem Typed.rename
     apply ih2; trivial
   case boundary ih =>
     simp [Term.rename, EType.rename, CType.rename]
-    apply Typed.boundary
+    apply Typed.boundary; assumption
     have ih := ih ((ρ.cext _).ext _)
     simp [CBinding.rename, FinFun.ext, CType.rename, SType.rename] at ih
     rw
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index b9e3e019..8ee5f600 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -11,39 +11,35 @@ remain valid when type variables are renamed consistently between contexts.
 -/
 namespace Capless
 
-mutual
-
-
 theorem CaptureKind.trename
   (h : CaptureKind Γ C K)
   (ρ : TVarMap Γ f Δ) :
-  CaptureKind Δ C K :=
-  match h with
-  | .label hl => .label (ρ.lmap _ _ hl)
-  | .cvar hb => .cvar (ρ.cmap _ _ hb)
-  | .csub hs hk => .csub (hs.trename ρ) (hk.trename ρ)
-  | .sub hs hk => .sub hs (hk.trename ρ)
-  | .empty => .empty
-  | .proj_kind => .proj_kind
-  | .proj hk => .proj (hk.trename ρ)
+  CaptureKind Δ C K := by
+  induction h
+  case var hb hk ih => apply! var (ρ.map _ _ hb) (ih _)
+  case label hb => apply! label (ρ.lmap _ _ _ hb)
+  case cvar hb => apply! cvar (ρ.cmap _ _ hb)
+  case cbound hb hk ih => apply! cbound (ρ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih => apply! cinstr (ρ.cmap _ _ hb) (ih _)
+  case sub hs hk ih => apply! sub hs (ih _)
+  case empty => apply empty
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
   (ρ : TVarMap Γ f Δ) :
-  Subcapt Δ C1 C2 :=
-  match h with
-  | .trans ha hb => .trans (ha.trename ρ) (hb.trename ρ)
-  | .subset hs => .subset hs
-  | .union ha hb => .union (ha.trename ρ) (hb.trename ρ)
-  | .var hb => .var (ρ.map _ _ hb)
-  | .cinstl hb => .cinstl (ρ.cmap _ _ hb)
-  | .cinstr hb => .cinstr (ρ.cmap _ _ hb)
-  | .cbound hb => .cbound (ρ.cmap _ _ hb)
-  | .proj h1 => .proj (h1.trename ρ)
-  | .proj_sub hs => .proj_sub hs
-  | .proj_l => .proj_l
-  | .proj_r hk => .proj_r (hk.trename ρ)
-  | .proj_disj hd hk => .proj_disj hd (hk.trename ρ)
-end
+  Subcapt Δ C1 C2 := by
+  induction h
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply! subset
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply! var (ρ.map _ _ hb)
+  case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
+  case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
+  case cbound hb => apply! cbound (ρ.cmap _ _ hb)
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
+  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean
index 493d2459..ddd02e85 100644
--- a/Capless/Renaming/Type/Typing.lean
+++ b/Capless/Renaming/Type/Typing.lean
@@ -120,7 +120,7 @@ theorem Typed.trename
     apply ih2; trivial
   case boundary ih =>
     simp [Term.trename, EType.trename, CType.trename]
-    apply boundary
+    apply boundary; assumption
     have ih := ih ((ρ.cext _).ext _)
     simp [FinFun.ext, CType.trename, SType.trename] at ih
     rw [ SType.cweaken_trename
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 118c7fce..901b9ddd 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -51,5 +51,6 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2))
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
+notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 
 end Capless

From 2693bb00b6330a4104912539b52a8aedf96662ee Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 11 Dec 2025 17:43:20 +0100
Subject: [PATCH 44/71] Everything seems fine before Subst

---
 Capless/Classifier.lean                    |  24 ++
 Capless/Reduction.lean                     |   6 +-
 Capless/Renaming/Capture/Subcapturing.lean |  14 +-
 Capless/Renaming/Term/Subcapturing.lean    |  14 +-
 Capless/Renaming/Type/Subcapturing.lean    |   2 +-
 Capless/Subcapturing.lean                  |  13 +-
 Capless/Subcapturing/Basic.lean            | 317 ++++++++++++++++++++-
 Capless/Subtyping/Basic.lean               |   8 +-
 Capless/Typing/Basic.lean                  |  28 +-
 Capless/Weakening/Basic.lean               |   6 +-
 Capless/Weakening/Subtyping.lean           |   6 +-
 Capless/Weakening/Typing.lean              |   6 +-
 Capless/WellScoped/Basic.lean              |   4 -
 13 files changed, 396 insertions(+), 52 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index acef732c..ecdb74c5 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -1225,6 +1225,10 @@ theorem Kind.Intersect.with_subkind
   (hs : K1.Subkind K2)
   : (intersect L K1).Subkind (intersect L K2) := by sorry
 
+theorem Kind.Intersect.with_subkind_r
+  (hs : K1.Subkind K2)
+  : (intersect K1 L).Subkind (intersect K2 L) := by sorry
+
 theorem Kind.Subkind.of_empty
   (hs : Subkind K L)
   (he : L.IsEmpty)
@@ -1297,3 +1301,23 @@ theorem Kind.Subkind.is_empty_l
     apply! subtract h $ h.absurd_l _
   case union h1 h2 =>
     apply! union_l
+
+theorem Kind.Intersect.union_r_superkind : Subkind (.union (K.intersect L1) (K.intersect L2)) (.intersect K (.union L1 L2)) := by
+  induction K
+  case empty => simp; apply Subkind.is_empty_l; constructor; constructor; constructor;
+  case node => simp; apply Subkind.rfl
+  case union ha hb =>
+    have h := Subkind.join ha hb
+    simp
+    apply Subkind.trans .reorder_union_4 h
+
+-- theorem Kind.Subkind.intersect_l_inv
+--   (hs : Subkind (K1.intersect L) (K2.intersect L))
+--   : Subkind K1 K2 := by
+
+-- theorem Kind.Subkind.union_with_subkind_l
+--   (hs : Subkind K L)
+--   : Subkind (L.union K) L := by
+--   apply union_l .rfl hs
+
+theorem Kind.Intersect.union_l_subkind : Subkind (.intersect (.union K1 K2) L) (.union (K1.intersect L) (K2.intersect L)) := by sorry
diff --git a/Capless/Reduction.lean b/Capless/Reduction.lean
index f5099033..2c711ba8 100644
--- a/Capless/Reduction.lean
+++ b/Capless/Reduction.lean
@@ -24,8 +24,8 @@ inductive Reduce : State n m k -> State n' m' k' -> Prop where
   Reduce ⟨σ | cont | Term.capp x c⟩ ⟨σ | cont | t.copen c⟩
 | enter :
   Reduce
-    ⟨σ | cont | boundary:S in t⟩
-    ⟨(σ.label S).cval {x=0} | cont.weaken.cweaken.scope 0 | t⟩
+    ⟨σ | cont | boundary[c]:S in t⟩
+    ⟨(σ.label c S).cval {x=0|.top} | cont.weaken.cweaken.scope 0 | t⟩
 | leave_var :
   Reduce
     ⟨σ | cont.scope x | Term.var y⟩
@@ -36,7 +36,7 @@ inductive Reduce : State n m k -> State n' m' k' -> Prop where
     ⟨σ | cont.scope x | v⟩
     ⟨σ | cont | v⟩
 | invoke {σ : Store n m k} {cont : Cont n m k} :
-  σ.LBound x S ->
+  σ.LBound x c S ->
   cont.HasLabel x tail ->
   Reduce
     ⟨σ | cont | Term.invoke x y⟩
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index ae661649..b565ed52 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -22,14 +22,21 @@ theorem CaptureKind.crename
   (ρ : CVarMap Γ f Δ) :
   CaptureKind Δ (C.crename f) K := by
   induction h
-  case var hb hk ih => apply! var (ρ.map _ _ hb) (ih _)
+  case var hb hk ih =>
+    rw [CaptureSet.proj_crename] at ih
+    apply! var (ρ.map _ _ hb) (ih _)
   case label hb => apply! label (ρ.lmap _ _ _ hb)
   case cvar hb => apply! cvar (ρ.cmap _ _ hb)
-  case cbound hb hk ih => apply! cbound (ρ.cmap _ _ hb) (ih _)
-  case cinstr hb hk ih => apply! cinstr (ρ.cmap _ _ hb) (ih _)
+  case cbound hb hk ih =>
+    rw [CaptureSet.proj_crename] at ih
+    apply! cbound (ρ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih =>
+    rw [CaptureSet.proj_crename] at ih
+    apply! cinstr (ρ.cmap _ _ hb) (ih _)
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
+  case absurd he => apply! absurd
 
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
@@ -46,6 +53,5 @@ theorem Subcapt.crename
   case subkind hs => apply! subkind
   case proj_absurd => apply! proj_absurd
   case proj_split => apply! proj_split
-  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index 30ee0acd..daf8f4fa 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -22,14 +22,21 @@ theorem CaptureKind.rename
   (h : Γ ⊢ C :k K)
   (ρ : VarMap Γ f Δ) : Δ ⊢ (C.rename f) :k K := by
   induction h
-  case var hb hk ih => apply! var (ρ.map _ _ hb) (ih _)
+  case var hb hk ih =>
+    rw [CaptureSet.proj_rename] at ih
+    apply! var (ρ.map _ _ hb) (ih _)
   case label hb => apply! label (ρ.lmap _ _ _ hb)
   case cvar hb => apply! cvar (ρ.cmap _ _ hb)
-  case cbound hb hk ih => apply! cbound (ρ.cmap _ _ hb) (ih _)
-  case cinstr hb hk ih => apply! cinstr (ρ.cmap _ _ hb) (ih _)
+  case cbound hb hk ih =>
+    rw [CaptureSet.proj_rename] at ih
+    apply! cbound (ρ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih =>
+    rw [CaptureSet.proj_rename] at ih
+    apply! cinstr (ρ.cmap _ _ hb) (ih _)
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
+  case absurd => apply! absurd
 
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
@@ -46,6 +53,5 @@ theorem Subcapt.rename
   case subkind hs => apply! subkind
   case proj_absurd => apply! proj_absurd
   case proj_split => apply! proj_split
-  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 8ee5f600..79e0ecbb 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -24,6 +24,7 @@ theorem CaptureKind.trename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
+  case absurd => apply! absurd
 
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
@@ -40,6 +41,5 @@ theorem Subcapt.trename
   case subkind hs => apply! subkind
   case proj_absurd => apply! proj_absurd
   case proj_split => apply! proj_split
-  case proj_merge => apply! proj_merge
 
 end Capless
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 901b9ddd..e2ac88f0 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -12,13 +12,14 @@ namespace Capless
 
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
-  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ C K -> CaptureKind Γ {x=x | L} (L.intersect K)
+  | var : Context.Bound Γ x (S^C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {x=x | L} K
   | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x|K} (K.intersect (.node c []))
   | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c|L} (L.intersect K)
-  | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ C K -> CaptureKind Γ {c=c | L} (L.intersect K)
-  | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ C K -> CaptureKind Γ {c=c | L} (L.intersect K)
+  | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
+  | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
   | empty : CaptureKind Γ .empty K
+  | absurd : L.IsEmpty -> CaptureKind Γ (.singleton s L) K
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
@@ -48,7 +49,11 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | subkind : K.Subkind L -> Subcapt Γ (.singleton s K) (.singleton s L)
 | proj_absurd : L.IsEmpty -> Subcapt Γ (.singleton s L) .empty
 | proj_split : Subcapt Γ (.singleton s (.union K1 K2)) (.union (.singleton s K1) (.singleton s K2))
-| proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2))
+
+theorem Subcapt.proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2)) := by
+  apply union
+  . apply subkind $ .union_rl (K2:=K2)
+  . apply subkind .union_rr
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index f7eafc2a..6b0bab90 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -76,11 +76,6 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro <;> apply! trans _ (.cinstl hb)
   case union =>
     injections; subst_vars; apply And.intro <;> assumption
-  case proj_merge =>
-    have ⟨_, _⟩ := heq; subst_vars; simp_all
-    apply And.intro <;> apply subkind
-    apply Kind.Subkind.union_rl
-    apply Kind.Subkind.union_rr
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
@@ -98,6 +93,318 @@ theorem Subcapt.proj_absurd_set {C : CaptureSet n k} (he : L.IsEmpty) : Subcapt
     apply subkind Kind.Intersect.subkind_r
     apply! proj_absurd
 
+theorem CaptureKind.subset
+  (hk : CaptureKind Γ C2 K)
+  (hs : C1 ⊆ C2)
+  : CaptureKind Γ C1 K := by
+  induction hs
+  case empty => apply empty
+  case rfl => assumption
+  case union_l ha hb => apply! union (ha _) (hb _)
+  case union_rl ih =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! ih
+  case union_rr ih =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! ih
+
+theorem CaptureKind.subkind_proj
+  (hk : CaptureKind Γ (.proj C K2) K)
+  (hs : Kind.Subkind K1 K2)
+  : CaptureKind Γ (.proj C K1) K := by
+  generalize h : C.proj K2 = D at hk
+  induction hk generalizing C K2 K1
+  case var hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply var hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply sub
+    apply (Kind.Intersect.with_subkind_r (Kind.Intersect.with_subkind hs))
+    apply! label
+  case cvar hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply sub
+    apply (Kind.Intersect.with_subkind_r (Kind.Intersect.with_subkind hs))
+    apply! cvar
+  case cbound hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cbound hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case cinstr hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cinstr hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case sub hs2 hk ih =>
+    subst_vars
+    apply sub hs2
+    apply ih hs (.refl _)
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    apply empty
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply absurd
+    apply Kind.Subkind.of_empty (Kind.Intersect.with_subkind hs) he
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply union (ha hs (.refl _)) (hb hs (.refl _))
+
+
+
+
+
+
+
+theorem CaptureKind.subkind_singleton
+  (hs : CaptureKind Γ (.singleton s K2) K)
+  (hsub : K1.Subkind K2)
+  : CaptureKind Γ (.singleton s K1) K := by
+  rw [← Kind.Intersect.top_l (K:=K2)] at hs
+  rw [← Kind.Intersect.top_l (K:=K1)]
+  rw [← CaptureSet.proj] at hs
+  rw [← CaptureSet.proj]
+  apply! subkind_proj
+
+theorem CaptureKind.absurd_set {C : CaptureSet n k}
+  (he : L.IsEmpty)
+  : CaptureKind Γ (C.proj L) K := by
+  induction C
+  case empty => apply empty
+  case union ha hb => apply! union
+  case singleton => simp; apply absurd; apply Kind.Intersect.is_empty_r he
+
+theorem CaptureKind.var_lookup_inv
+  (hk : CaptureKind Γ {x=x|L} K)
+  (hb : Γ.Bound x S^C)
+  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  generalize h : {x=x|L} = D at hk
+  induction hk <;> cases h
+  case var K hb2 hk ih =>
+    cases Context.bound_injective hb hb2
+    right; assumption
+  case label hb2 => cases Context.bound_lbound_absurd hb hb2
+  case sub hs hk ih =>
+    cases ih hb (.refl _)
+    case inl => left; assumption
+    case inr h => right; apply! sub
+  case absurd => aesop
+
+theorem CaptureKind.label_lookup_inv
+  (hs : CaptureKind Γ {x=x|K1} K)
+  (hb : Γ.LBound x c S)
+  : K1.IsEmpty ∨ (K1.intersect (.classifier c)).Subkind K := by
+  generalize h : {x=x|K1} = D at hs
+  induction hs <;> cases h
+  case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
+  case label hb1 =>
+    cases Context.lbound_inj hb hb1; subst_vars
+    right; exact .rfl
+  case sub hs1 _ ih =>
+    cases ih hb (.refl _)
+    case inl => aesop
+    case inr h => right; exact .trans h hs1
+  case absurd => aesop
+
+theorem CaptureKind.cbound_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.bound (.upper C)))
+  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 => cases Context.cbound_injective hb hb2
+  case cbound hb2 hk ih =>
+    cases Context.cbound_injective hb hb2
+    right; assumption
+  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
+  case sub hs hk ih =>
+    cases ih hb (.refl _)
+    case inl => left; assumption
+    case inr h => right; apply! sub
+  case absurd => aesop
+
+theorem CaptureKind.ckind_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.bound (.kind K1)))
+  : L.IsEmpty ∨ (L.intersect K1).Subkind K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 =>
+    cases Context.cbound_injective hb hb2
+    right; exact .rfl
+  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
+  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
+  case sub hs1 _ ih =>
+    cases ih hb (.refl _)
+    case inl => aesop
+    case inr h => right; exact .trans h hs1
+  case absurd => aesop
+
+theorem CaptureKind.cinst_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.inst C))
+  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 => cases Context.cbound_injective hb hb2
+  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
+  case cinstr hb2 hk ih =>
+    cases Context.cbound_injective hb hb2
+    right; assumption
+  case sub hs hk ih =>
+    cases ih hb (.refl _)
+    case inl => left; assumption
+    case inr h => right; apply! sub
+  case absurd => aesop
+
+theorem CaptureKind.proj_merge
+  (hk1 : CaptureKind Γ (.proj C K1) L1)
+  (hk2 : CaptureKind Γ (.proj C K2) L2)
+  (hs1 : L1.Subkind L)
+  (hs2 : L2.Subkind L)
+  : CaptureKind Γ (.proj C (K1.union K2)) L := by
+  generalize h : C.proj K1 = D at hk1
+  induction hk1 generalizing C K1 K2
+  case var x _ _ _ K hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply var hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    cases hk2.var_lookup_inv hb
+    case inl h =>
+      apply sub hs1
+      apply subkind_proj hk1
+      apply! Kind.Subkind.union_l .rfl $ .is_empty_l _
+    case inr h => apply ih h (.refl _)
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hk2.label_lookup_inv hb
+    case inl h =>
+      apply sub hs1
+      apply subkind_singleton (label hb)
+      apply Kind.Intersect.union_r_subkind.trans
+      apply Kind.Subkind.union_l .rfl $ .is_empty_l h
+    case inr h =>
+      apply sub
+      exact .union_l hs1 (.trans h hs2)
+      apply sub Kind.Intersect.union_l_subkind
+      apply sub $ Kind.Intersect.with_subkind_r Kind.Intersect.union_r_subkind
+      apply label hb
+  case cvar hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hk2.ckind_lookup_inv hb
+    case inl h =>
+      -- h : (p.intersect K2).IsEmpty
+      apply sub hs1
+      apply sub $ Kind.Intersect.with_subkind_r $
+        Kind.Subkind.trans Kind.Intersect.union_r_subkind $
+        Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
+      apply cvar hb
+    case inr h =>
+      -- h : ((p.intersect K2).intersect K).Subkind L2
+      apply sub
+      exact .union_l hs1 (.trans h hs2)
+      apply sub Kind.Intersect.union_l_subkind
+      apply sub $ Kind.Intersect.with_subkind_r Kind.Intersect.union_r_subkind
+      apply cvar hb
+  case cbound hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cbound hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    cases hk2.cbound_lookup_inv hb
+    case inl h =>
+      apply sub hs1
+      apply subkind_proj hk1
+      apply Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
+    case inr h => apply ih h (.refl _)
+  case cinstr hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cinstr hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    cases hk2.cinst_lookup_inv hb
+    case inl h =>
+      apply sub hs1
+      apply subkind_proj hk1
+      apply Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
+    case inr h => apply ih h (.refl _)
+  case sub hs hk1 ih =>
+    subst_vars
+    apply ih hk2
+    exact .trans hs hs1
+    rfl
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    apply empty
+  case absurd =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply subkind_singleton
+    apply sub hs2 hk2
+    apply Kind.Subkind.trans
+    . apply Kind.Intersect.union_r_subkind
+    . apply Kind.Subkind.union_l _ .rfl
+      . apply! Kind.Subkind.is_empty_l
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨_, _⟩ := hk2.union_l_inv
+    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+
+theorem CaptureKind.proj_merge_singleton
+  (hs1 : CaptureKind Γ (.singleton s K1) K)
+  (hs2 : CaptureKind Γ (.singleton s K2) K)
+  : CaptureKind Γ (.singleton s (K1.union K2)) K := by
+  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
+  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
+  rw [← CaptureSet.proj] at hs1 hs2
+  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
+  exact proj_merge hs1 hs2 .rfl .rfl
+
+theorem CaptureKind.subcapt
+  (hk : CaptureKind Γ C2 K)
+  (hs : Subcapt Γ C1 C2)
+  : CaptureKind Γ C1 K := by
+  induction hs generalizing K
+  case trans ha hb => apply ha; apply! hb
+  case subset => apply! hk.subset
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply! var
+  case cinstl c C L hb =>
+    generalize h : {c=c|L} = D at hk
+    induction hk <;> try cases h
+    case cvar hb1 => cases Context.cbound_injective hb hb1
+    case cbound hb1 hk ih => cases Context.cbound_injective hb hb1
+    case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
+    case sub hs hk ih => apply sub hs; apply ih hb; rfl
+    case absurd he => apply! absurd_set
+  case cinstr => apply! cinstr
+  case cbound => apply! cbound
+  case subkind K1 L hs =>
+    rw [← Kind.Intersect.top_l (K:=L)] at hk
+    rw [← Kind.Intersect.top_l (K:=K1)]
+    rw [← CaptureSet.proj] at hk
+    rw [← CaptureSet.proj]
+    apply subkind_proj hk hs
+  case proj_absurd he => apply! absurd
+  case proj_split =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! proj_merge_singleton
+
 -- theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
 --   induction C
 --   case empty => apply empty
diff --git a/Capless/Subtyping/Basic.lean b/Capless/Subtyping/Basic.lean
index 464156e0..ecc30a46 100644
--- a/Capless/Subtyping/Basic.lean
+++ b/Capless/Subtyping/Basic.lean
@@ -15,9 +15,9 @@ theorem Subbound.refl {B : CBound n k} :
   Subbound Γ B B := by
   cases B <;> constructor
   case upper =>
-    apply Subcapt.refl
+    apply Subcapt.rfl
   case kind =>
-    apply Kind.subkind_refl
+    apply Kind.Subkind.rfl
 
 theorem Subbound.trans
   (h1 : Subbound Γ B1 B2)
@@ -26,7 +26,7 @@ theorem Subbound.trans
   cases h1 <;> cases h2 <;> constructor
   apply Subcapt.trans <;> easy
   rename_i hsub K hk
-  apply CaptureKind.csub hsub hk
+  apply hk.subcapt hsub
   rename_i k1 k2 h1 k3 h2
   apply Kind.Subkind.trans h1 h2
   rename_i hk K2 hs
@@ -64,7 +64,7 @@ theorem ESubtyp.ex_inv_subcapt
 theorem CSubtyp.refl :
   CSubtyp Γ T T := by
   cases T; apply capt
-  { apply Subcapt.refl }
+  { apply Subcapt.rfl }
   { apply SSubtyp.refl }
 
 theorem ESubtyp.refl :
diff --git a/Capless/Typing/Basic.lean b/Capless/Typing/Basic.lean
index 76ea311a..0db2b943 100644
--- a/Capless/Typing/Basic.lean
+++ b/Capless/Typing/Basic.lean
@@ -14,14 +14,14 @@ namespace Capless
 theorem Typing.inv_subcapt'
   (he1 : t0 = Term.var x) (he2 : E0 = EType.type (CType.capt C S))
   (h : Typed Γ t0 E0 C0) :
-  Subcapt Γ {x=x} C := by
+  Subcapt Γ {x=x|.top} C := by
   induction h <;> try (solve | cases he1 | cases he2)
   case var =>
     cases he1; cases he2
-    apply Subcapt.refl
+    apply Subcapt.rfl
   case label =>
     cases he1; cases he2
-    apply Subcapt.refl
+    apply Subcapt.rfl
   case sub hsub ih =>
     subst he1 he2
     have h := ESubtyp.type_inv_subcapt hsub
@@ -32,26 +32,26 @@ theorem Typing.inv_subcapt'
 
 theorem Typing.inv_subcapt
   (h : Typed Γ (Term.var x) (EType.type (CType.capt C S)) C0) :
-  Subcapt Γ {x=x} C :=
+  Subcapt Γ {x=x|.top} C :=
   Typing.inv_subcapt' rfl rfl h
 
 theorem Typed.bound_typing
   (hb : Context.Bound Γ x T) :
-  Typed Γ (Term.var x) (EType.type T) {x=x} := by
+  Typed Γ (Term.var x) (EType.type T) {x=x|.top} := by
   cases T
   apply Typed.sub
   apply Typed.var hb
-  apply Subcapt.refl
+  apply Subcapt.rfl
   constructor
   constructor
-  apply Subcapt.var; trivial
+  have h := Subcapt.var hb (L:=.top); rw [CaptureSet.proj_top] at h; assumption
   apply SSubtyp.refl
 
 theorem Typed.precise_capture'
   (he1 : t0 = Term.var x)
   (he2 : E0 = EType.type (CType.capt C S))
   (h : Typed Γ t0 E0 C0) :
-  Typed Γ (Term.var x) (EType.type (CType.capt {x=x} S)) {x=x} := by
+  Typed Γ (Term.var x) (EType.type (CType.capt {x=x|.top} S)) {x=x|.top} := by
   induction h <;> try (solve | cases he1 | cases he2)
   case var => cases he1; cases he2; apply Typed.var; trivial
   case label => cases he1; cases he2; apply Typed.label; trivial
@@ -64,33 +64,33 @@ theorem Typed.precise_capture'
     have ih := ih rfl rfl
     apply Typed.sub
     { exact ih }
-    { apply Subcapt.refl }
+    { apply Subcapt.rfl }
     { constructor
       constructor
-      apply Subcapt.refl
+      apply Subcapt.rfl
       trivial }
 
 theorem Typed.precise_capture
   (h : Typed Γ (Term.var x) (EType.type (CType.capt C S)) C0) :
-  Typed Γ (Term.var x) (EType.type (CType.capt {x=x} S)) {x=x} :=
+  Typed Γ (Term.var x) (EType.type (CType.capt {x=x|.top} S)) {x=x|.top} :=
   Typed.precise_capture' rfl rfl h
 
 theorem Typed.precise_cv'
   (he : t0 = Term.var x)
   (h : Typed Γ t0 E C0) :
-  Typed Γ (Term.var x) E {x=x} := by
+  Typed Γ (Term.var x) E {x=x|.top} := by
   induction h <;> try (solve | cases he)
   case var => cases he; apply Typed.var; trivial
   case label => cases he; apply Typed.label; trivial
   case sub ih =>
     apply Typed.sub
     { apply! ih }
-    { apply Subcapt.refl }
+    { apply Subcapt.rfl }
     { trivial }
 
 theorem Typed.precise_cv
   (h : Typed Γ (Term.var x) E C0) :
-  Typed Γ (Term.var x) E {x=x} :=
+  Typed Γ (Term.var x) E {x=x|.top} :=
   Typed.precise_cv' rfl h
 
 end Capless
diff --git a/Capless/Weakening/Basic.lean b/Capless/Weakening/Basic.lean
index 9e2a7124..892ba2b3 100644
--- a/Capless/Weakening/Basic.lean
+++ b/Capless/Weakening/Basic.lean
@@ -24,7 +24,7 @@ def VarMap.weaken {Γ : Context n m k} :
   constructor <;> (intros; constructor; trivial)
 
 def VarMap.lweaken {Γ : Context n m k} :
-  VarMap Γ FinFun.weaken (Γ.label S) := by
+  VarMap Γ FinFun.weaken (Γ.label c S) := by
   constructor <;> (intros; constructor; trivial)
 
 def VarMap.weaken_ext {Γ : Context n m k} :
@@ -39,7 +39,7 @@ def VarMap.lweaken_ext {Γ : Context n m k} :
   VarMap
     (Γ.var T)
     FinFun.weaken.ext
-    ((Γ.label P).var T.weaken) := by
+    ((Γ.label c P).var T.weaken) := by
   apply VarMap.ext
   apply VarMap.lweaken
 
@@ -56,7 +56,7 @@ def VarMap.lweaken_cext_ext {Γ : Context n m k} :
   VarMap
     ((Γ.cvar (CBinding.bound b)).var T)
     FinFun.weaken.ext
-    (((Γ.label P).cvar (CBinding.bound b.weaken)).var T.weaken) := by
+    (((Γ.label c P).cvar (CBinding.bound b.weaken)).var T.weaken) := by
   apply VarMap.ext
   apply VarMap.cext
   apply VarMap.lweaken
diff --git a/Capless/Weakening/Subtyping.lean b/Capless/Weakening/Subtyping.lean
index ec23dfea..4619f87a 100644
--- a/Capless/Weakening/Subtyping.lean
+++ b/Capless/Weakening/Subtyping.lean
@@ -44,7 +44,7 @@ theorem Subbound.weaken
 
 theorem SSubtyp.lweaken
   (h : SSubtyp Γ S1 S2) :
-  ∀ S, SSubtyp (Γ.label S) S1.weaken S2.weaken := by
+  ∀ S, SSubtyp (Γ.label c S) S1.weaken S2.weaken := by
   intro b
   simp [SType.weaken]
   apply SSubtyp.rename
@@ -61,7 +61,7 @@ theorem CSubtyp.weaken
 
 theorem CSubtyp.lweaken
   (h : CSubtyp Γ E1 E2) :
-  CSubtyp (Γ.label S) E1.weaken E2.weaken := by
+  CSubtyp (Γ.label c S) E1.weaken E2.weaken := by
   simp [CType.weaken]
   apply CSubtyp.rename
   { apply h }
@@ -77,7 +77,7 @@ theorem ESubtyp.weaken
 
 theorem ESubtyp.lweaken
   (h : ESubtyp Γ E1 E2) :
-  ESubtyp (Γ.label S) E1.weaken E2.weaken := by
+  ESubtyp (Γ.label c S) E1.weaken E2.weaken := by
   simp [EType.weaken]
   apply ESubtyp.rename
   { apply h }
diff --git a/Capless/Weakening/Typing.lean b/Capless/Weakening/Typing.lean
index 4700943b..18972536 100644
--- a/Capless/Weakening/Typing.lean
+++ b/Capless/Weakening/Typing.lean
@@ -38,7 +38,7 @@ theorem Typed.weaken
 
 theorem Typed.lweaken
   (h : Typed Γ t E Ct) :
-  Typed (Γ.label S) t.weaken E.weaken Ct.weaken := by
+  Typed (Γ.label c S) t.weaken E.weaken Ct.weaken := by
   simp [Term.weaken, EType.weaken]
   apply h.rename
   apply VarMap.lweaken
@@ -51,7 +51,7 @@ theorem Typed.weaken_ext {Γ : Context n m k}
 
 theorem Typed.lweaken_ext {Γ : Context n m k}
   (h : Typed (Γ.var T) t E Ct) :
-  Typed ((Γ.label P).var T.weaken) t.weaken1 E.weaken1 Ct.weaken1 := by
+  Typed ((Γ.label c P).var T.weaken) t.weaken1 E.weaken1 Ct.weaken1 := by
   simp [Term.weaken1, EType.weaken1]
   apply h.rename VarMap.lweaken_ext
 
@@ -63,7 +63,7 @@ theorem Typed.weaken_cext_ext {Γ : Context n m k}
 
 theorem Typed.lweaken_cext_ext {Γ : Context n m k}
   (h : Typed ((Γ.cvar (CBinding.bound B)).var T) t E Ct) :
-  Typed (((Γ.label P).cvar (CBinding.bound B.weaken)).var T.weaken) t.weaken1 E.weaken1 Ct.weaken1 := by
+  Typed (((Γ.label c P).cvar (CBinding.bound B.weaken)).var T.weaken) t.weaken1 E.weaken1 Ct.weaken1 := by
   simp [Term.weaken1, EType.weaken1]
   apply h.rename VarMap.lweaken_cext_ext
 
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index a393ff3b..c92986a9 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -310,9 +310,5 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
   case proj_split =>
     cases hsc
     apply! proj_merge_singleton
-  case proj_merge =>
-    have h1 := hsc.subkind_singleton .union_rl
-    have h2 := hsc.subkind_singleton .union_rr
-    apply! union
 
 end Capless

From 47a7c1e5d35b3d4aa6341b61c78490ed6d949738 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 11 Dec 2025 19:43:40 +0100
Subject: [PATCH 45/71] Progress is green again :D

---
 Capless/Classifier.lean                 |  30 ++
 Capless/Inversion/Lookup.lean           |  16 +-
 Capless/Inversion/Typing.lean           | 112 +++---
 Capless/Soundness/Progress.lean         |  25 +-
 Capless/Subcapturing.lean               |   4 +-
 Capless/Subcapturing/Basic.lean         | 431 +++++++-----------------
 Capless/Subst/Basic.lean                | 100 +++---
 Capless/Subst/Capture/Subcapturing.lean |  96 ++----
 Capless/Subst/Capture/Typing.lean       |   4 +-
 Capless/Subst/Term/Subcapturing.lean    |  98 ++----
 Capless/Subst/Term/Typing.lean          |   4 +-
 Capless/Subst/Type/Subcapturing.lean    |  64 ++--
 Capless/Subst/Type/Typing.lean          |   4 +-
 Capless/WellScoped/Basic.lean           |  54 +--
 14 files changed, 420 insertions(+), 622 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index ecdb74c5..a853235b 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -658,6 +658,16 @@ theorem Kind.Disjoint.from_empty_intersect (hi : Intersect K1 K2 R) (he : IsEmpt
       | inr ha => exact .absurd_r ha
   | singleton_disj hd => exact .root hd
 
+theorem Kind.Disjoint.top_l (hd: Disjoint .top K) : IsEmpty K := by
+  cases hd
+  case empty_r => constructor
+  case union_r ha hb => apply IsEmpty.union ha.top_l hb.top_l
+  case absurd_l hsc => cases hsc
+  case absurd_r hsc => constructor; assumption
+  case root hd => cases hd.symm.not_subclass .of_top
+  case excl_l hsc => constructor; apply hsc.trans_subclass .of_top
+  case excl_r hsc => cases hsc
+
 theorem Kind.Disjoint.symm (hd : K1.Disjoint K2) : Disjoint K2 K1 := by
   induction hd with
   | empty_l => exact .empty_r
@@ -1321,3 +1331,23 @@ theorem Kind.Intersect.union_r_superkind : Subkind (.union (K.intersect L1) (K.i
 --   apply union_l .rfl hs
 
 theorem Kind.Intersect.union_l_subkind : Subkind (.intersect (.union K1 K2) L) (.union (K1.intersect L) (K2.intersect L)) := by sorry
+
+theorem Kind.Intersect.assoc_subkind : Subkind (.intersect (.intersect K1 K2) K3) (.intersect K1 (.intersect K2 K3)) := by
+  induction K1 <;> try simp_all
+  case empty => apply Subkind.rfl
+  case union ha hb => apply Subkind.join ha hb
+  case node =>
+    induction K2
+    case empty => simp; apply Subkind.rfl
+    case union ha hb => simp; apply Subkind.join ha hb
+    case node => sorry
+
+theorem Kind.Intersect.assoc_superkind : Subkind (.intersect K1 (.intersect K2 K3)) (.intersect (.intersect K1 K2) K3) := by
+  induction K1 <;> try simp_all
+  case empty => apply Subkind.rfl
+  case union ha hb => apply Subkind.join ha hb
+  case node =>
+    induction K2
+    case empty => simp; apply Subkind.rfl
+    case union ha hb => simp; apply Subkind.join ha hb
+    case node => sorry
diff --git a/Capless/Inversion/Lookup.lean b/Capless/Inversion/Lookup.lean
index bad0bfe7..ad725ad5 100644
--- a/Capless/Inversion/Lookup.lean
+++ b/Capless/Inversion/Lookup.lean
@@ -55,13 +55,13 @@ def Store.lookup_inv_bound
     have ih := ih.cweaken (b := CBinding.inst C)
     simp [EType.cweaken, EType.crename, CType.cweaken] at *
     constructor; exact ih
-  case label S _ ih =>
+  case label c S _ ih =>
     cases hl
     have ⟨T1, hb1, heq⟩ := Context.label_bound_succ_inv hb
     subst heq
     rename_i hl
     have ⟨Cv0, ih⟩ := ih hl hb1
-    have ih := ih.lweaken (S := S)
+    have ih := ih.lweaken (S := S) (c := c)
     aesop
 
 theorem Store.bound_type
@@ -107,7 +107,7 @@ theorem Store.lookup_inv_typing
   ∃ S0 C0 Cv0,
     Typed Γ v (EType.type (S0^C0)) Cv0 ∧
     Γ.Bound x (S0^C0) ∧
-    (Γ ⊢ (S0^{x=x}) <: (S^C)) := by
+    (Γ ⊢ (S0^{x=x|.top}) <: (S^C)) := by
   have ⟨Tx, hbx⟩ := Store.bound_type hl ht
   have ⟨C0, S0, hb, hsub⟩ := Typed.var_inv hx hbx
   have ⟨Cv0, hv⟩ := Store.lookup_inv_bound hl ht hb
@@ -125,19 +125,19 @@ theorem Store.lookup_inv_typing_alt
   repeat apply Exists.intro
   apply Typed.sub
   { exact htv }
-  { apply Subcapt.refl }
-  { constructor; constructor; apply Subcapt.refl; easy }
+  { apply Subcapt.rfl }
+  { constructor; constructor; apply Subcapt.rfl; easy }
 
 theorem Store.bound_label
-  (hl : Store.LBound σ x S)
+  (hl : Store.LBound σ x c S)
   (ht : TypedStore σ Γ) :
-  Γ.LBound x S := by
+  Γ.LBound x c S := by
   induction ht <;> cases hl <;> try (solve | constructor; aesop)
   case label ih => constructor
 
 theorem Cont.has_label_tail_inv
   (htc : TypedCont Γ E1 cont E2 Ct)
-  (hb : Γ.LBound x S0)
+  (hb : Γ.LBound x c S0)
   (hh : cont.HasLabel x tail) :
   ∃ Ct1, TypedCont Γ (S0^{}) tail E2 Ct1 := by
   induction hh generalizing E1 E2 Ct <;> try (solve | cases htc; aesop)
diff --git a/Capless/Inversion/Typing.lean b/Capless/Inversion/Typing.lean
index fe06efe5..a3d3d29e 100644
--- a/Capless/Inversion/Typing.lean
+++ b/Capless/Inversion/Typing.lean
@@ -28,8 +28,8 @@ namespace Capless
 theorem Typed.app_inv'
   (he : t0 = Term.app x y)
   (h : Typed Γ t0 E Ct0) :
-  ∃ T Cf F E0, Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.forall T F))) {x=x}
-    ∧ Typed Γ (Term.var y) (EType.type T) {x=y}
+  ∃ T Cf F E0, Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.forall T F))) {x=x|.top}
+    ∧ Typed Γ (Term.var y) (EType.type T) {x=y|.top}
     ∧ E0 = F.open y
     ∧ ESubtyp Γ E0 E := by
     induction h <;> try (solve | cases he)
@@ -48,8 +48,8 @@ theorem Typed.app_inv'
 
 theorem Typed.app_inv
   (h : Typed Γ (Term.app x y) E Ct) :
-  ∃ T Cf F E0, Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.forall T F))) {x=x}
-    ∧ Typed Γ (Term.var y) (EType.type T) {x=y}
+  ∃ T Cf F E0, Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.forall T F))) {x=x|.top}
+    ∧ Typed Γ (Term.var y) (EType.type T) {x=y|.top}
     ∧ E0 = F.open y
     ∧ ESubtyp Γ E0 E :=
   Typed.app_inv' rfl h
@@ -58,7 +58,7 @@ theorem Typed.tapp_inv'
   (he : t0 = Term.tapp x X)
   (h : Typed Γ t0 E Ct) :
   ∃ Cf F E0,
-    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.tforall (SType.tvar X) F))) {x=x}
+    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.tforall (SType.tvar X) F))) {x=x|.top}
     ∧ E0 = F.topen X
     ∧ ESubtyp Γ E0 E := by
   induction h <;> try (solve | cases he)
@@ -79,7 +79,7 @@ theorem Typed.tapp_inv'
 theorem Typed.tapp_inv
   (h : Typed Γ (Term.tapp x X) E Ct) :
   ∃ Cf F E0,
-    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.tforall (SType.tvar X) F))) {x=x}
+    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.tforall (SType.tvar X) F))) {x=x|.top}
     ∧ E0 = F.topen X
     ∧ ESubtyp Γ E0 E :=
   Typed.tapp_inv' rfl h
@@ -88,7 +88,7 @@ theorem Typed.var_inv'
   (he1 : t0 = Term.var x)
   (he2 : E0 = EType.type T)
   (h : Typed Γ t0 E0 Ct0) (hb : Γ.Bound x T0) :
-  ∃ C0 S0, Γ.Bound x (S0^C0) ∧ (Γ ⊢ (S0^{x=x}) <: T) := by
+  ∃ C0 S0, Γ.Bound x (S0^C0) ∧ (Γ ⊢ (S0^{x=x|.top}) <: T) := by
   induction h <;> try (solve | cases he1 | cases he2)
   case var C0 S0 hb =>
     cases he1; cases he2
@@ -114,7 +114,7 @@ theorem Typed.var_inv'
 
 theorem Typed.var_inv
   (h : Typed Γ (Term.var x) (EType.type T) Ct) (hb : Γ.Bound x T0) :
-  ∃ C0 S0, Γ.Bound x (CType.capt C0 S0) ∧ CSubtyp Γ (CType.capt {x=x} S0) T := by
+  ∃ C0 S0, Γ.Bound x (CType.capt C0 S0) ∧ CSubtyp Γ (CType.capt {x=x|.top} S0) T := by
   apply Typed.var_inv' rfl rfl h hb
 
 theorem Typed.canonical_form_lam'
@@ -123,7 +123,7 @@ theorem Typed.canonical_form_lam'
   (he2 : E0 = EType.type (CType.capt Cf S0))
   (h : Typed Γ t0 E0 Ct0) :
   CSubtyp Γ T' T ∧
-  Typed (Γ.var T') t E (Cf.weaken ∪ {x=0}) := by
+  Typed (Γ.var T') t E (Cf.weaken ∪ {x=0|.top}) := by
   induction h <;> try (solve | cases he1 | cases he2)
   case abs =>
     cases he1; cases he2
@@ -149,13 +149,13 @@ theorem Typed.canonical_form_lam'
       assumption
       apply Subcapt.join
       { apply hsc.weaken }
-      { apply Subcapt.refl } }
+      { apply Subcapt.rfl } }
 
 theorem Typed.canonical_form_lam
   (ht : Γ.IsTight)
   (h : Typed Γ (Term.lam T t) (EType.type ((∀(x:T')E)^Cf)) Ct) :
   CSubtyp Γ T' T ∧
-  Typed (Γ.var T') t E (Cf.weaken ∪ {x=0}) := by
+  Typed (Γ.var T') t E (Cf.weaken ∪ {x=0|.top}) := by
   apply Typed.canonical_form_lam' <;> try trivial
   constructor
 
@@ -189,7 +189,7 @@ theorem Typed.canonical_form_tlam'
     { apply! SSubtyp.trans }
     { constructor
       apply? Typed.sub
-      apply ht1.tnarrow; assumption; apply Subcapt.refl
+      apply ht1.tnarrow; assumption; apply Subcapt.rfl
       apply hsc.tweaken
       apply ESubtyp.refl }
 
@@ -205,7 +205,7 @@ theorem Typed.capp_inv'
   (he : t0 = Term.capp x c)
   (h : Typed Γ t0 E Ct0) :
   ∃ Cf F E0,
-    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.cforall (CBound.upper {c=c}) F))) {x=x} ∧
+    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.cforall (CBound.upper {c=c|.top}) F))) {x=x|.top} ∧
     E0 = F.copen c ∧
     ESubtyp Γ E0 E := by
   induction h <;> try (solve | cases he)
@@ -226,7 +226,7 @@ theorem Typed.capp_inv'
 theorem Typed.capp_inv
   (h : Typed Γ (Term.capp x c) E Ct0) :
   ∃ Cf F E0,
-    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.cforall (CBound.upper {c=c}) F))) {x=x} ∧
+    Typed Γ (Term.var x) (EType.type (CType.capt Cf (SType.cforall (CBound.upper {c=c|.top}) F))) {x=x|.top} ∧
     E0 = F.copen c ∧
     ESubtyp Γ E0 E :=
   Typed.capp_inv' rfl h
@@ -411,7 +411,7 @@ theorem Typed.canonical_form_pack'
   (he2 : E0 = EType.ex B T)
   (h : Typed Γ t0 E0 Ct) :
   CaptureBound Γ C B ∧
-    Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} := by
+    Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x|.top} := by
   induction h <;> try (solve | cases he1 | cases he2)
   case pack =>
     cases he1; cases he2
@@ -425,14 +425,14 @@ theorem Typed.canonical_form_pack'
     assumption
     apply Typed.sub
     exact ih
-    apply Subcapt.refl
+    apply Subcapt.rfl
     constructor
     apply hs.cinstantiate ihb
 
 theorem Typed.canonical_form_pack
   (ht : Γ.IsTight)
   (h : Typed Γ (Term.pack C x) (EType.ex B T) Ct) :
-  CaptureBound Γ C B ∧ Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} :=
+  CaptureBound Γ C B ∧ Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x|.top} :=
   Typed.canonical_form_pack' ht rfl rfl h
 
 theorem Typed.forall_inv' {v : Term n m k}
@@ -513,72 +513,72 @@ theorem Typed.cforall_inv {v : Term n m k}
 theorem Typed.var_inv_capt'
   (he : t0 = Term.var x)
   (hx : Typed Γ t0 E Cx) :
-  Γ ⊢ ({x=x}) <:c Cx := by
+  Γ ⊢ ({x=x|.top}) <:c Cx := by
   induction hx <;> try (solve | cases he)
-  case var => cases he; apply Subcapt.refl
-  case label => cases he; apply Subcapt.refl
+  case var => cases he; apply Subcapt.rfl
+  case label => cases he; apply Subcapt.rfl
   case sub ih =>
     have ih := ih he
     apply Subcapt.trans <;> easy
 
 theorem Typed.var_inv_capt
   (hx : Typed Γ (Term.var x) E Cx) :
-  Γ ⊢ ({x=x}) <:c Cx :=
+  Γ ⊢ ({x=x|.top}) <:c Cx :=
   Typed.var_inv_capt' rfl hx
 
 theorem Typed.app_inv_capt'
   (he : t0 = Term.app x y)
   (ht : Typed Γ t0 E Ct) :
-  Γ ⊢ ({x=x}∪{x=y}) <:c Ct := by
+  Γ ⊢ ({x=x|.top}∪{x=y|.top}) <:c Ct := by
   induction ht <;> try (solve | cases he)
-  case app => cases he; apply Subcapt.refl
+  case app => cases he; apply Subcapt.rfl
   case sub ih =>
     have ih := ih he
     apply! Subcapt.trans
 
 theorem Typed.app_inv_capt
   (ht : Typed Γ (Term.app x y) E Ct) :
-  Γ ⊢ ({x=x}∪{x=y}) <:c Ct :=
+  Γ ⊢ ({x=x|.top}∪{x=y|.top}) <:c Ct :=
   Typed.app_inv_capt' rfl ht
 
 theorem Typed.tapp_inv_capt'
   (he : t0 = Term.tapp x X)
   (ht : Typed Γ t0 E Ct) :
-  Γ ⊢ ({x=x}) <:c Ct := by
+  Γ ⊢ ({x=x|.top}) <:c Ct := by
   induction ht <;> try (solve | cases he)
-  case tapp => cases he; apply Subcapt.refl
+  case tapp => cases he; apply Subcapt.rfl
   case sub ih =>
     have ih := ih he
     apply! Subcapt.trans
 
 theorem Typed.tapp_inv_capt
   (ht : Typed Γ (Term.tapp x X) E Ct) :
-  Γ ⊢ ({x=x}) <:c Ct :=
+  Γ ⊢ ({x=x|.top}) <:c Ct :=
   Typed.tapp_inv_capt' rfl ht
 
 theorem Typed.capp_inv_capt'
   (he : t0 = Term.capp x c)
   (ht : Typed Γ t0 E Ct) :
-  Γ ⊢ ({x=x}) <:c Ct := by
+  Γ ⊢ ({x=x|.top}) <:c Ct := by
   induction ht <;> try (solve | cases he)
-  case capp => cases he; apply Subcapt.refl
+  case capp => cases he; apply Subcapt.rfl
   case sub ih =>
     have ih := ih he
     apply! Subcapt.trans
 
 theorem Typed.capp_inv_capt
   (ht : Typed Γ (Term.capp x c) E Ct) :
-  Γ ⊢ ({x=x}) <:c Ct :=
+  Γ ⊢ ({x=x|.top}) <:c Ct :=
   Typed.capp_inv_capt' rfl ht
 
 theorem Typed.var_inv_cs'
   (he1 : t0 = Term.var x)
   (he2 : E0 = EType.type (S^C))
   (hx : Typed Γ t0 E0 Cx) :
-  Γ ⊢ ({x=x}) <:c C := by
+  Γ ⊢ ({x=x|.top}) <:c C := by
   induction hx <;> try (solve | cases he1 | cases he2)
-  case var => cases he1; cases he2; apply Subcapt.refl
-  case label => cases he1; cases he2; apply Subcapt.refl
+  case var => cases he1; cases he2; apply Subcapt.rfl
+  case label => cases he1; cases he2; apply Subcapt.rfl
   case sub ih =>
     subst_vars
     rename_i hsub
@@ -590,7 +590,7 @@ theorem Typed.var_inv_cs'
 
 theorem Typed.var_inv_cs
   (hx : Typed Γ (Term.var x) (EType.type (S^C)) Cx) :
-  Γ ⊢ ({x=x}) <:c C :=
+  Γ ⊢ ({x=x|.top}) <:c C :=
   Typed.var_inv_cs' rfl rfl hx
 
 theorem Typed.val_precise_cv'
@@ -614,7 +614,7 @@ theorem Typed.val_precise_cv'
     have ih := ih rfl hv
     apply Typed.sub
     { easy }
-    { apply Subcapt.refl }
+    { apply Subcapt.rfl }
     { constructor; easy }
 
 theorem Typed.val_precise_cv
@@ -627,8 +627,8 @@ theorem Typed.invoke_inv' {Γ : Context n m k}
   (he : t0 = Term.invoke x y)
   (ht : Typed Γ t0 E Ct) :
   ∃ S0 C0,
-    Typed Γ (Term.var x) (Label[S0]^C0) {x=x} ∧
-    Typed Γ (Term.var y) (EType.type (S0^{})) {x=y} := by
+    Typed Γ (Term.var x) (Label[S0]^C0) {x=x|.top} ∧
+    Typed Γ (Term.var y) (EType.type (S0^{})) {x=y|.top} := by
   induction ht <;> try (solve | cases he)
   case invoke =>
     cases he
@@ -638,15 +638,15 @@ theorem Typed.invoke_inv' {Γ : Context n m k}
 theorem Typed.invoke_inv {Γ : Context n m k}
   (ht : Typed Γ (Term.invoke x y) E Ct) :
   ∃ S0 C0,
-    Typed Γ (Term.var x) (Label[S0]^C0) {x=x} ∧
-    Typed Γ (Term.var y) (EType.type (S0^{})) {x=y} :=
+    Typed Γ (Term.var x) (Label[S0]^C0) {x=x|.top} ∧
+    Typed Γ (Term.var y) (EType.type (S0^{})) {x=y|.top} :=
   Typed.invoke_inv' rfl ht
 
 theorem Typed.label_inv'
   (he1 : t0 = Term.var x)
   (he2 : E0 = EType.type T)
-  (ht : Typed Γ t0 E0 Ct) (hb : Γ.LBound x S1) :
-  ∃ S0, Γ.LBound x S0 ∧ (Γ ⊢ (Label[S0]^{x=x}) <: T) := by
+  (ht : Typed Γ t0 E0 Ct) (hb : Γ.LBound x c S1) :
+  ∃ c0 S0, Γ.LBound x c0 S0 ∧ (Γ ⊢ (Label[S0]^{x=x|.top}) <: T) := by
   induction ht <;> try (solve | cases he1 | cases he2)
   case var hb0 =>
     cases he1; cases he2
@@ -654,40 +654,40 @@ theorem Typed.label_inv'
     apply! Context.bound_lbound_absurd
   case label hb0 =>
     cases he1; cases he2
-    apply Exists.intro; apply And.intro
+    apply Exists.intro; apply Exists.intro; apply And.intro
     { exact hb0 }
     { apply CSubtyp.refl }
   case sub hsub ih =>
     cases he1; cases he2
     cases hsub
-    have ⟨S0, hb0, hs0⟩ := ih rfl rfl hb
-    apply Exists.intro
+    have ⟨c0, S0, hb0, hs0⟩ := ih rfl rfl hb
+    apply Exists.intro; apply Exists.intro;
     apply And.intro
     { easy }
     { apply CSubtyp.trans <;> easy }
 
 theorem Typed.label_inv
-  (ht : Typed Γ (Term.var x) (EType.type T) Ct) (hb : Γ.LBound x S1) :
-  ∃ S0, Γ.LBound x S0 ∧ (Γ ⊢ (Label[S0]^{x=x}) <: T) :=
+  (ht : Typed Γ (Term.var x) (EType.type T) Ct) (hb : Γ.LBound x c S1) :
+  ∃ c0 S0, Γ.LBound x c0 S0 ∧ (Γ ⊢ (Label[S0]^{x=x|.top}) <: T) :=
   Typed.label_inv' rfl rfl ht hb
 
 theorem Typed.label_inv_sub
-  (ht : Typed Γ (Term.var x) (Label[S]^C) Ct) (hb : Γ.LBound x S1)
+  (ht : Typed Γ (Term.var x) (Label[S]^C) Ct) (hb : Γ.LBound x c S1)
   (hg : Γ.IsTight) :
-  ∃ S0, Γ.LBound x S0 ∧ (Γ ⊢ S <:s S0) := by
-  have ⟨S0, hl, hs⟩ := Typed.label_inv ht hb
+  ∃ c0 S0, Γ.LBound x c0 S0 ∧ (Γ ⊢ S <:s S0) := by
+  have ⟨c0, S0, hl, hs⟩ := Typed.label_inv ht hb
   cases hs; rename_i hs
   have h1 := SSubtyp.sub_dealias_label_inv hg (by constructor) (by constructor) hs
   aesop
 
 theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
-  (he : t0 = (boundary:S in t))
+  (he : t0 = (boundary[c]:S in t))
   (ht : Typed Γ t0 E Ct) :
   Typed
-    ((Γ,c<:(.kind Kind.control)),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:(.kind $ .classifier c)),x: Label[S.cweaken]^{c=0|.top})
     t
     (S.cweaken.weaken^{})
-    (Ct.cweaken.weaken ∪ {c=0} ∪ {x=0}) ∧
+    (Ct.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ∧
     (Γ ⊢ (S^{}) <:e E) := by
   induction ht <;> try (solve | cases he)
   case boundary =>
@@ -701,18 +701,18 @@ theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
     { apply Typed.sub
       { exact ih }
       { apply Subcapt.join; apply Subcapt.join
-        all_goals try apply Subcapt.refl
+        all_goals try apply Subcapt.rfl
         apply hsc.cweaken.weaken }
       apply ESubtyp.refl }
     { apply ESubtyp.trans <;> easy }
 
 theorem Typed.boundary_inv {Γ : Context n m k} {S : SType n m k}
-  (ht : Typed Γ (boundary:S in t) E Ct) :
+  (ht : Typed Γ (boundary[c]:S in t) E Ct) :
   Typed
-    ((Γ,c<:(.kind Kind.control)),x: Label[S.cweaken]^{c=0})
+    ((Γ,c<:(.kind $ .classifier c)),x: Label[S.cweaken]^{c=0|.top})
     t
     (S.cweaken.weaken^{})
-    (Ct.cweaken.weaken ∪ {c=0} ∪ {x=0}) ∧
+    (Ct.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ∧
     (Γ ⊢ (S^{}) <:e E) :=
   Typed.boundary_inv' rfl ht
 
diff --git a/Capless/Soundness/Progress.lean b/Capless/Soundness/Progress.lean
index 802075ba..ad27f977 100644
--- a/Capless/Soundness/Progress.lean
+++ b/Capless/Soundness/Progress.lean
@@ -15,7 +15,7 @@ This module proves that a well-typed term is either an answer (in which case the
 namespace Capless
 
 theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
-  (∃ v, Store.Bound σ x v ∧ v.IsValue) ∨ (∃ S, Store.LBound σ x S) := by
+  (∃ v, Store.Bound σ x v ∧ v.IsValue) ∨ (∃ c S, Store.LBound σ x c S) := by
   induction σ
   case empty => exact Fin.elim0 x
   case val =>
@@ -37,7 +37,8 @@ theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
         { apply Term.IsValue.weaken; trivial }
       case inr ih =>
         apply Or.inr
-        have ⟨S, ih⟩ := ih
+        have ⟨c, S, ih⟩ := ih
+        constructor
         constructor
         constructor; easy
   case tval ih =>
@@ -51,7 +52,8 @@ theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
       { apply Term.IsValue.tweaken; trivial }
     case inr ih =>
       apply Or.inr
-      have ⟨S, ih⟩ := ih
+      have ⟨c, S, ih⟩ := ih
+      constructor
       constructor
       constructor; easy
   case cval ih =>
@@ -65,7 +67,8 @@ theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
       { apply Term.IsValue.cweaken; trivial }
     case inr ih =>
       apply Or.inr
-      have ⟨S, ih⟩ := ih
+      have ⟨c, S, ih⟩ := ih
+      constructor
       constructor
       constructor; easy
   case label ih =>
@@ -74,6 +77,7 @@ theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
       apply Or.inr
       constructor
       constructor
+      constructor
     case succ x0 =>
       have ih := ih (x := x0)
       cases ih
@@ -85,7 +89,8 @@ theorem Store.lookup_exists {σ : Store n m k} {x : Fin n} :
         { apply Term.IsValue.weaken; trivial }
       case inr ih =>
         apply Or.inr
-        have ⟨S, ih⟩ := ih
+        have ⟨c, S, ih⟩ := ih
+        constructor
         constructor
         constructor; easy
 
@@ -98,10 +103,10 @@ theorem Store.val_lookup_exists {σ : Store n m k} {x : Fin n}
   cases h
   case inl h => easy
   case inr h =>
-    have ⟨S, hl⟩ := h
+    have ⟨c, S, hl⟩ := h
     have hb := Store.bound_label hl hs
-    have ⟨S0, hb0, hsub⟩ := Typed.label_inv hx hb
-    have h := Context.lbound_inj hb hb0
+    have ⟨c0, S0, hb0, hsub⟩ := Typed.label_inv hx hb
+    have ⟨_, _⟩ := Context.lbound_inj hb hb0
     subst_vars
     cases hvt
     case capt hvt =>
@@ -144,7 +149,7 @@ theorem Store.value_typing_label_absurd
 theorem Store.label_lookup_exists {σ : Store n m k} {x : Fin n}
   (hs : TypedStore σ Γ)
   (hx : Typed Γ (Term.var x) (EType.type (Label[S]^C)) Cx) :
-  ∃ S0, Store.LBound σ x S0 := by
+  ∃ c0 S0, Store.LBound σ x c0 S0 := by
   have hg := TypedStore.is_tight hs
   have h := Store.lookup_exists (σ := σ) (x := x)
   cases h
@@ -214,7 +219,7 @@ theorem progress
     case invoke hx hy _ _ σ cont Ct =>
       cases hsc; rename_i hsc _
       have hg := TypedStore.is_tight hs
-      have ⟨S0, hl⟩ := Store.label_lookup_exists hs hx
+      have ⟨c0, S0, hl⟩ := Store.label_lookup_exists hs hx
       have hl := Store.bound_label hl hs
       have ⟨_, hsl⟩ := WellScoped.label_inv hsc hl
       aesop
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index e2ac88f0..c1ae39d6 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -13,8 +13,8 @@ namespace Capless
 
 inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | var : Context.Bound Γ x (S^C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {x=x | L} K
-  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x|K} (K.intersect (.node c []))
-  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c|L} (L.intersect K)
+  | label : Context.LBound Γ x c S -> CaptureKind Γ {x=x|K} (.intersect (.node c []) K)
+  | cvar : Context.CBound Γ c (.bound (.kind K)) -> CaptureKind Γ {c=c|L} (K.intersect L)
   | cbound : Context.CBound Γ c (.bound (.upper C)) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
   | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 6b0bab90..a6ae0bbf 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -80,8 +80,6 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
 
--- prove later, not sure if needed
-theorem Subcapt.proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by sorry
 
 theorem Subcapt.proj_absurd_set {C : CaptureSet n k} (he : L.IsEmpty) : Subcapt Γ (C.proj L) .empty := by
   induction C
@@ -124,13 +122,13 @@ theorem CaptureKind.subkind_proj
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply sub
-    apply (Kind.Intersect.with_subkind_r (Kind.Intersect.with_subkind hs))
+    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
     apply! label
   case cvar hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply sub
-    apply (Kind.Intersect.with_subkind_r (Kind.Intersect.with_subkind hs))
+    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
     apply! cvar
   case cbound hb hk ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
@@ -161,12 +159,6 @@ theorem CaptureKind.subkind_proj
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply union (ha hs (.refl _)) (hb hs (.refl _))
 
-
-
-
-
-
-
 theorem CaptureKind.subkind_singleton
   (hs : CaptureKind Γ (.singleton s K2) K)
   (hsub : K1.Subkind K2)
@@ -204,7 +196,7 @@ theorem CaptureKind.var_lookup_inv
 theorem CaptureKind.label_lookup_inv
   (hs : CaptureKind Γ {x=x|K1} K)
   (hb : Γ.LBound x c S)
-  : K1.IsEmpty ∨ (K1.intersect (.classifier c)).Subkind K := by
+  : K1.IsEmpty ∨ (Kind.intersect (.classifier c) K1).Subkind K := by
   generalize h : {x=x|K1} = D at hs
   induction hs <;> cases h
   case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
@@ -237,7 +229,7 @@ theorem CaptureKind.cbound_lookup_inv
 theorem CaptureKind.ckind_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.kind K1)))
-  : L.IsEmpty ∨ (L.intersect K1).Subkind K := by
+  : L.IsEmpty ∨ (K1.intersect L).Subkind K := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 =>
@@ -299,8 +291,8 @@ theorem CaptureKind.proj_merge
     case inr h =>
       apply sub
       exact .union_l hs1 (.trans h hs2)
-      apply sub Kind.Intersect.union_l_subkind
-      apply sub $ Kind.Intersect.with_subkind_r Kind.Intersect.union_r_subkind
+      apply sub Kind.Intersect.union_r_subkind
+      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
       apply label hb
   case cvar hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
@@ -309,7 +301,7 @@ theorem CaptureKind.proj_merge
     case inl h =>
       -- h : (p.intersect K2).IsEmpty
       apply sub hs1
-      apply sub $ Kind.Intersect.with_subkind_r $
+      apply sub $ Kind.Intersect.with_subkind $
         Kind.Subkind.trans Kind.Intersect.union_r_subkind $
         Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
       apply cvar hb
@@ -317,8 +309,8 @@ theorem CaptureKind.proj_merge
       -- h : ((p.intersect K2).intersect K).Subkind L2
       apply sub
       exact .union_l hs1 (.trans h hs2)
-      apply sub Kind.Intersect.union_l_subkind
-      apply sub $ Kind.Intersect.with_subkind_r Kind.Intersect.union_r_subkind
+      apply sub Kind.Intersect.union_r_subkind
+      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
       apply cvar hb
   case cbound hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
@@ -405,289 +397,122 @@ theorem CaptureKind.subcapt
     have ⟨_, _⟩ := hk.union_l_inv
     apply! proj_merge_singleton
 
--- theorem CaptureKind.proj_kind : CaptureKind Γ (.proj C K) K := by
---   induction C
---   case empty => apply empty
---   case union  => apply! union
---   case singleton => apply! singleton_proj_kind
-
--- theorem CaptureKind.proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj K1) K := by
---   induction C
---   case empty => simp; apply empty
---   case union ha hb =>
---     have ⟨_, _⟩ := hk.union_l_inv
---     apply! union (ha _) (hb _)
---   case singleton => apply! singleton_proj
-
--- theorem Subcapt.proj_disj
---   (hd : Kind.Disjoint K1 K2)
---   (hk : CaptureKind Γ C K1)
---   : Subcapt Γ (C.proj K2) .empty := by
---   induction C
---   case empty => simp; apply rfl
---   case union ha hb =>
---     simp
---     have ⟨_, _⟩ := hk.union_l_inv
---     apply! union (ha _) (hb _)
---   case singleton => apply! singleton_proj_disj
-
--- theorem CaptureKind.var_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by
---   induction hk <;> (subst_vars; try simp_all)
---   case var hb1 hk ih =>
---     cases Context.bound_injective hb hb1
---     assumption
---   case label hb1 => cases Context.bound_lbound_absurd hb hb1
---   case sub hsk hk ih => apply! sub
-
--- theorem CaptureKind.var_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.Bound x S^C) : CaptureKind Γ C K := by apply! hk.var_inv' (.refl _)
-
--- theorem CaptureKind.proj_inv' (hk : CaptureKind Γ D K) (heq : D = C.proj K1) : K1.Subkind K ∨ (∃ K2, K1.Disjoint K2 ∧ CaptureKind Γ C K2) ∨ CaptureKind Γ C K := by
---   induction hk generalizing C K1
---   case var hb hk ih =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---   case label hb ih =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---   case cvar =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---   case cbound =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---   case cinstr =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---   case sub hsk hk ih =>
---     cases ih heq
---     case inl hsk1 => left; apply hsk1.trans hsk
---     case inr h =>
---       cases h
---       case inl hd =>
---         obtain ⟨K2, hd, hk2⟩ := hd
---         -- K1.Disjoint K2 and CaptureKind Γ C K2, we have hsk : K' -> K
---         -- We need to show K1.Subkind K or disjoint or CaptureKind C K
---         -- Use singleton_proj_disj + sub to get CaptureKind (C.proj K1) K
---         right; left; exists K2;
---       case inr hk2 => right; right; apply sub hsk hk2
---   case empty =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---     right; right; apply empty
---   case singleton_proj_kind =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---     have ⟨_, _⟩ := heq; subst_vars;
---     left; apply Kind.Subkind.rfl
---   case singleton_proj hk ih =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---     have ⟨_, _⟩ := heq; subst_vars;
---     right; right; assumption
---   case singleton_proj_disj hk hd ih =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---     have ⟨_, _⟩ := heq; subst_vars;
---     -- hk : CaptureKind Γ (.singleton s) K1', hd : K1'.Disjoint K1
---     -- Need K1.Disjoint K2 and CaptureKind Γ (.singleton s) K2, use K1' as K2
---     right; left; exact ⟨_, hd.symm, hk⟩
---   case union ha hb iha ihb =>
---     unfold CaptureSet.proj at heq; split at heq <;> simp at heq
---     have ⟨_, _⟩ := heq; subst_vars;
---     cases iha $ .refl _
---     case inl hsub => left; assumption
---     case inr h1 =>
---       cases ihb $ .refl _
---       case inl hsub => left; assumption
---       case inr h2 =>
---         cases h1
---         case inl hd1 =>
---           cases h2
---           case inl hd2 =>
---             right; left
---             obtain ⟨K2a, hda, hka⟩ := hd1
---             obtain ⟨K2b, hdb, hkb⟩ := hd2
---             -- Use absurd_disjoint: K1 disjoint K2a means K1 subkind anything
-
---           case inr hk2 =>
---             right; left
---             obtain ⟨K2, hd, hk1⟩ := hd1
---             exact ⟨K2, hd, union hk1 (hd.absurd_subkind hk2)⟩
---         case inr hk1 =>
---           cases h2
---           case inl hd2 =>
---             right; left
---             obtain ⟨K2, hd, hk2⟩ := hd2
---             exact ⟨K2, hd, union (hd.absurd_subkind hk1) hk2⟩
---           case inr hk2 => right; right; apply! union
-
--- theorem CaptureKind.proj_inv (hk : CaptureKind Γ (C.proj K1) K) : K1.Subkind K ∨ (∃ K2, K1.Disjoint K2 ∧ CaptureKind Γ C K2) ∨ CaptureKind Γ C K := by
---   apply hk.proj_inv' $ .refl _
-
--- theorem CaptureKind.proj_disj (hk : CaptureKind Γ C K1) (hd : K1.Disjoint K2) : CaptureKind Γ (C.proj K2) K3 := by
---   induction C
---   case empty => simp; apply empty
---   case union iha ihb =>
---     simp
---     have ⟨_, _⟩ := hk.union_l_inv
---     apply! union (iha _) (ihb _)
---   case singleton => apply! singleton_proj_disj
-
--- theorem CaptureKind.widen_var
---   (hk : CaptureKind Γ (.singleton s) K)
---   (hb : Γ.Bound x S^C)
---   (hw : WidenVar x s C C') : CaptureKind Γ C' K := by
---   induction hw generalizing K
---   case var => apply! hk.var_inv
---   case proj hw ih =>
---     rw [← CaptureSet.proj_singleton] at hk
---     cases hk.proj_inv
---     case inl hsk => apply sub hsk; apply proj_kind
---     case inr hs =>
---       cases hs
---       case inl hd =>
---         obtain ⟨K2, hd, hk2⟩ := hd
---         -- hd : K'.Disjoint K2, hk2 : CaptureKind Γ (.singleton s) K2
---         -- ih gives us CaptureKind Γ C K2, then proj_disj gives us CaptureKind Γ (C.proj K') K
---         exact proj_disj (ih hk2 hb) hd.symm
---       case inr hk' => apply proj; apply! ih
-
--- theorem CaptureKind.cbound_inv' (hk : CaptureKind Γ D K) (heq : D = {c=c}) (hb : Γ.CBound c (.bound (.upper C))) : CaptureKind Γ C K := by
---   induction hk <;> (subst_vars; try simp_all)
---   case cvar hb1 => cases Context.cbound_injective hb hb1
---   case cbound hb1 _ _ =>
---     cases Context.cbound_injective hb hb1
---     assumption
---   case cinstr hb1 _ _ => cases Context.cbound_injective hb hb1
---   case sub hsk _ ih => apply! sub
-
--- theorem CaptureKind.cbound_inv (hk : CaptureKind Γ {c=c} K) (hb : Γ.CBound c (.bound (.upper C))) : CaptureKind Γ C K := by apply! hk.cbound_inv' (.refl _)
-
--- theorem CaptureKind.cinstr_inv' (hk : CaptureKind Γ D K) (heq : D = {c=c}) (hb : Γ.CBound c (.inst C)) : CaptureKind Γ C K := by
---   induction hk <;> (subst_vars; try simp_all)
---   case cvar hb1 => cases Context.cbound_injective hb hb1
---   case cbound hb1 _ _ => cases Context.cbound_injective hb hb1
---   case cinstr hb1 _ _ =>
---     cases Context.cbound_injective hb hb1
---     assumption
---   case sub hsk _ ih => apply! sub
-
--- theorem CaptureKind.cinstr_inv (hk : CaptureKind Γ {c=c} K) (hb : Γ.CBound c (.inst C)) : CaptureKind Γ C K := by apply! hk.cinstr_inv' (.refl _)
-
--- theorem CaptureKind.widen_cbound
---   (hk : CaptureKind Γ (.singleton s) K)
---   (hb : Γ.CBound c (.bound (.upper C)))
---   (hw : WidenCVar c s C C') : CaptureKind Γ C' K := by
---   induction hw generalizing K
---   case var => apply! hk.cbound_inv
---   case proj hw ih =>
---     rw [← CaptureSet.proj_singleton] at hk
---     cases hk.proj_inv
---     case inl hsk => apply sub hsk; apply proj_kind
---     case inr hs =>
---       cases hs
---       case inl hd =>
---         obtain ⟨K2, hd, hk2⟩ := hd
---         exact proj_disj (ih hk2 hb) hd.symm
---       case inr hk' => apply proj; apply! ih
-
--- theorem CaptureKind.widen_cinstr
---   (hk : CaptureKind Γ (.singleton s) K)
---   (hb : Γ.CBound c (.inst C))
---   (hw : WidenCVar c s C C') : CaptureKind Γ C' K := by
---   induction hw generalizing K
---   case var => apply! hk.cinstr_inv
---   case proj hw ih =>
---     rw [← CaptureSet.proj_singleton] at hk
---     cases hk.proj_inv
---     case inl hsk => apply sub hsk; apply proj_kind
---     case inr hs =>
---       cases hs
---       case inl hd =>
---         obtain ⟨K2, hd, hk2⟩ := hd
---         exact proj_disj (ih hk2 hb) hd.symm
---       case inr hk' => apply proj; apply! ih
-
--- theorem CaptureKind.lbound_inv' (hk : CaptureKind Γ D K) (heq : D = {x=x}) (hb : Γ.LBound x c S) : Kind.Subkind (.classifier c) K := by
---   induction hk <;> (subst_vars; try simp_all)
---   case var hb1 _ _ => cases Context.bound_lbound_absurd hb1 hb
---   case label hb1 =>
---     have ⟨heq, _⟩ := Context.lbound_inj hb hb1
---     subst_vars
---     apply Kind.Subkind.rfl
---   case sub hsk _ ih => apply ih.trans hsk
-
--- theorem CaptureKind.lbound_inv (hk : CaptureKind Γ {x=x} K) (hb : Γ.LBound x c S) : Kind.Subkind (.classifier c) K := by apply! hk.lbound_inv' (.refl _)
-
--- inductive IsAbsurdLabel : Context n m k -> Singleton n k -> Fin n -> Prop where
---   | with_c : Γ.LBound x c S -> K.Disjoint (.classifier c) -> s.IsVarWith x K -> IsAbsurdLabel Γ s x
---   | with_self : Γ.LBound x c S -> K1.Disjoint K2 -> s.IsVarWith x K1 -> IsAbsurdLabel Γ (.proj s K2) x
---   | proj : IsAbsurdLabel Γ s x -> IsAbsurdLabel Γ (s.proj K) x
-
--- theorem CaptureKind.widen_lbound (hk : CaptureKind Γ (.singleton s) K) (hb : Γ.LBound x c S) (hi : s.IsVar x) : (Kind.classifier c).Subkind K ∨ IsAbsurdLabel Γ s x ∨ ∃ K1, K1.Subkind K ∧ s.IsVarWith x K1 := by
---   induction hi generalizing K
---   case var =>
---     left
---     exact hk.lbound_inv hb
---   case proj s K' hi ih =>
---     rw [← CaptureSet.proj_singleton] at hk
---     cases hk.proj_inv
---     case inl hsk =>
---       right
---       exact ⟨K', hsk, .here hi⟩
---     case inr hs =>
---       cases hs
---       case inl hd =>
---         -- K'.Disjoint K2 and CaptureKind Γ (.singleton s) K2
---         -- This is an absurd projection case - K' projects something of disjoint kind K2
---         obtain ⟨K2, hd, hk2⟩ := hd
---         -- hk2 : CaptureKind Γ (.singleton s) K2, hd : K'.Disjoint K2
---         -- Since singleton_proj_disj gives any kind K, we know the original hk : CaptureKind Γ ((singleton s).proj K') K
---         -- was constructed with an arbitrary K. We return right with K' as the witness.
---         -- K'.Subkind K follows from the fact that the disjoint projection has any kind.
---         -- We can use singleton_proj_disj hk2 hd.symm to reconstruct a CaptureKind with our target kind,
---         -- and then show K'.Subkind K via proj_kind + sub.
---         -- Actually, we can just show K' is the projection that witnesses IsVarWith
---         right
---         -- We need K'.Subkind K. Since hk came from singleton_proj_disj, the overall kind K is arbitrary.
---         -- But we don't have direct access to that. Let's use proj_kind which gives CaptureKind for K' kind.
---         -- From hk : CaptureKind Γ ((singleton s).proj K') K, by cases on construction...
---         -- Actually the simplest: use singleton_proj_disj + sub to derive K'.Subkind K is not directly available.
---         -- Let's try: we know the result has kind K and there's a projection to K', so K'.Subkind K.
---         -- Wait - we're in the case where proj_inv returned the disjoint case, not the subkind case.
---         -- So we DON'T have K'.Subkind K directly from proj_inv.
---         -- But we can construct it: from singleton_proj_disj we get CaptureKind for any kind,
---         -- and from singleton_proj_kind we get CaptureKind Γ (singleton (s.proj K')) K'.
---         -- Combining with sub we'd need K'.Subkind K which is what we want to prove...
---         -- This is circular. Let me try a different approach: return that K' is absurd.
---         -- If K' is disjoint from K2 and K2 has a real classifier, then K' must be absurd.
---         -- Actually no, that's not right either.
---         -- Let me just return K'.Subkind K using Kind.Subkind.rfl won't work since K' ≠ K in general.
---         -- The real answer: in the absurd disjoint case, the projection has ANY kind including K.
---         -- So we should be able to show K' ≤ K. But how?
---         -- From hk we know the proj has kind K. proj_kind says proj has kind K'.
---         -- So by transitivity if we had proj_kind + sub (K' to K), we'd have the proof.
---         -- But we need that sub evidence... which comes from the fact that hk has kind K.
---         -- This is exactly what we'd get if proj_inv returned K'.Subkind K in the first case!
---         -- The issue is proj_inv returns the disjoint case separately.
---         -- Let me use a workaround: we can show K' is subkind of K using the actual hk.
---         -- hk : CaptureKind Γ ((singleton s).proj K') K
---         -- singleton_proj_kind : CaptureKind Γ ((singleton s).proj K') K'
---         -- If we had K' ≠ K with CaptureKind for both, that's fine - both can hold.
---         -- But we need to PROVE K'.Subkind K...
---         -- Actually, let's use CaptureKind.sub backwards: if we have CaptureKind C K' and CaptureKind C K,
---         -- and the only way to go from K' to K is via sub, then we'd need the subkind.
---         -- But that's also not directly provable.
---         --
---         -- SOLUTION: The disjoint case in proj_inv should actually imply K'.Subkind K
---         -- because the only way to get kind K from (singleton (s.proj K')) when the inner has
---         -- disjoint kind K2 is via singleton_proj_disj which gives any K,
---         -- but then sub can lift K' to K.
---         -- The cleanest fix is to change proj_inv to include K'.Subkind K in the disjoint case.
---         -- For now, let me use Kind.Subkind.rfl and see if K' = K in our context (it should be when proj_inv returns case 2)
---         -- Actually no, we're stuck. Let me add a helper or change proj_inv's return type.
---         sorry
---       case inr hk' =>
---         cases ih hk' hb with
---         | inl hsub => left; exact hsub
---         | inr h =>
---           right
---           obtain ⟨K1, hsk1, hvw⟩ := h
---           exact ⟨K1, hsk1, .there hvw⟩
-
-
-
-
-
-end Capless
+-- Basic operations on .top
+
+theorem CaptureKind.var_top (hb : Γ.Bound x S^C) (hs : CaptureKind Γ C K) : CaptureKind Γ {x=x|.top} K := by
+  rw [← CaptureSet.proj_top (C:=C)] at hs
+  apply! var
+
+theorem CaptureKind.label_top (hb : Γ.LBound x c S) : CaptureKind Γ {x=x|.top} (.node c []) := by
+  rw [← Kind.Intersect.top_r (K:=.node c [])]
+  apply label hb
+
+theorem CaptureKind.cvar_top (hb : Γ.CBound c (.bound (.kind K))) : CaptureKind Γ {c=c|.top} K := by
+  rw [← Kind.Intersect.top_r (K:=K)]
+  apply cvar hb
+
+theorem CaptureKind.cbound_top (hb : Γ.CBound c (.bound (.upper C))) (hs : CaptureKind Γ C K) : CaptureKind Γ {c=c|.top} K := by
+  rw [← CaptureSet.proj_top (C:=C)] at hs
+  apply! cbound
+
+theorem CaptureKind.cinstr_top (hb : Γ.CBound c (.inst C)) (hs : CaptureKind Γ C K) : CaptureKind Γ {c=c|.top} K := by
+  rw [← CaptureSet.proj_top (C:=C)] at hs
+  apply! cinstr
+
+theorem Subcapt.var_top (hb : Γ.Bound x S^C) : Subcapt Γ {x=x|.top} C := by
+  have h := Subcapt.var hb (L:=.top)
+  rw [CaptureSet.proj_top] at h
+  exact h
+
+theorem Subcapt.cinstl_top (hb : Γ.CBound c (.inst C)) : Subcapt Γ C {c=c|.top} := by
+  have h := Subcapt.cinstl hb (L:=.top)
+  rw [CaptureSet.proj_top] at h
+  exact h
+
+theorem Subcapt.cinstr_top (hb : Γ.CBound c (.inst C)) : Subcapt Γ {c=c|.top} C := by
+  have h := Subcapt.cinstr hb (L:=.top)
+  rw [CaptureSet.proj_top] at h
+  exact h
+
+theorem Subcapt.cbound_top (hb : Γ.CBound c (.bound (.upper C))) : Subcapt Γ {c=c|.top} C := by
+  have h := Subcapt.cbound hb (L:=.top)
+  rw [CaptureSet.proj_top] at h
+  exact h
+
+theorem Subcapt.proj_proj_intersect : Subcapt Γ (.proj (.proj C K1) K2) (C.proj (K1.intersect K2)) := by
+  induction C
+  case empty => simp; apply rfl
+  case union ih1 ih2 =>
+    simp
+    apply! join
+  case singleton =>
+    simp
+    apply subkind Kind.Intersect.assoc_subkind
+
+theorem Subcapt.proj_intersect_proj : Subcapt Γ (C.proj (K1.intersect K2)) (.proj (.proj C K1) K2) := by
+  induction C
+  case empty => simp; apply rfl
+  case union ih1 ih2 =>
+    simp
+    apply! join
+  case singleton =>
+    simp
+    apply subkind Kind.Intersect.assoc_superkind
+
+theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
+  induction hk generalizing L
+  case var hb hk ih =>
+    apply var hb
+    apply subcapt ih .proj_intersect_proj
+  case label hb =>
+    simp
+    apply sub Kind.Intersect.assoc_superkind (label hb)
+  case cvar hb =>
+    simp
+    apply sub Kind.Intersect.assoc_superkind $ cvar hb
+  case cbound hb hk ih =>
+    apply cbound hb
+    apply subcapt ih .proj_intersect_proj
+  case cinstr hb hk ih =>
+    apply cinstr hb
+    apply subcapt ih .proj_intersect_proj
+  case sub hs hk ih =>
+    apply sub (Kind.Intersect.with_subkind_r hs) ih
+  case empty => apply empty
+  case absurd he =>
+    apply absurd
+    apply Kind.Intersect.is_empty_l he
+  case union ha hb => apply union ha hb
+
+theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
+  rw [← Kind.Intersect.top_l (K:=L)]
+  rw [← CaptureSet.proj, Kind.Intersect.top_l]
+  apply hk.apply_proj
+
+theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by
+  induction hs generalizing K
+  case trans ha hb => apply trans ha hb
+  case subset => apply! subset $ .proj _
+  case union ha hb => apply union ha hb
+  case var hb =>
+    simp
+    apply trans (var hb) .proj_intersect_proj
+  case cinstl hb =>
+    apply trans .proj_proj_intersect
+    apply cinstl hb
+  case cinstr hb =>
+    apply trans (cinstr hb) .proj_intersect_proj
+  case cbound hb =>
+    apply trans (cbound hb) .proj_intersect_proj
+  case subkind hs =>
+    apply subkind $ Kind.Intersect.with_subkind_r hs
+  case proj_absurd he =>
+    apply proj_absurd $ Kind.Intersect.is_empty_l he
+  case proj_split =>
+    simp
+    apply proj_split
+
+theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
+  rw [← Kind.Intersect.top_l (K:=K)]
+  rw [← CaptureSet.proj, Kind.Intersect.top_l]
+  apply! apply_proj
diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index 037ac237..b47c8b12 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -71,10 +71,10 @@ This handles the most complex case due to the interaction with capture sets:
 namespace Capless
 
 structure VarSubst (Γ : Context n m k) (f : FinFun n n') (Δ : Context n' m k) where
-  map : ∀ x E, Γ.Bound x E -> Typed Δ (Term.var (f x)) (EType.type (E.rename f)) {x=f x}
+  map : ∀ x E, Γ.Bound x E -> Typed Δ (Term.var (f x)) (EType.type (E.rename f)) {x=f x|.top}
   tmap : ∀ X b, Γ.TBound X b -> Δ.TBound X (b.rename f)
   cmap : ∀ c b, Γ.CBound c b -> Δ.CBound c (b.rename f)
-  lmap : ∀ l S, Γ.LBound l S -> Δ.LBound (f l) (S.rename f)
+  lmap : ∀ l c S, Γ.LBound l c S -> Δ.LBound (f l) c (S.rename f)
 
 structure TVarSubst (Γ : Context n m k) (f : FinFun m m') (Δ : Context n m' k) where
   map : ∀ x E, Γ.Bound x E -> Δ.Bound x (E.trename f)
@@ -83,7 +83,7 @@ structure TVarSubst (Γ : Context n m k) (f : FinFun m m') (Δ : Context n m' k)
   tmap_inst : ∀ X S, Γ.TBound X (TBinding.inst S) ->
     Δ.TBound (f X) (TBinding.inst (S.trename f))
   cmap : ∀ c b, Γ.CBound c b -> Δ.CBound c b
-  lmap : ∀ l S, Γ.LBound l S -> Δ.LBound l (S.trename f)
+  lmap : ∀ l c S, Γ.LBound l c S -> Δ.LBound l c (S.trename f)
 
 structure CVarSubst (Γ : Context n m k) (f : FinFun k k') (Δ : Context n m k') where
   map : ∀ x E, Γ.Bound x E -> Δ.Bound x (E.crename f)
@@ -91,8 +91,8 @@ structure CVarSubst (Γ : Context n m k) (f : FinFun k k') (Δ : Context n m k')
   cmap : ∀ c C, Γ.CBound c (CBinding.inst C) ->
     Δ.CBound (f c) (CBinding.inst (C.crename f))
   cmap_bound : ∀ c B, Γ.CBound c (CBinding.bound B) ->
-    Subbound Δ (CBound.upper {c=f c}) (B.crename f)
-  lmap : ∀ l S, Γ.LBound l S -> Δ.LBound l (S.crename f)
+    Subbound Δ (CBound.upper {c=f c|.top}) (B.crename f)
+  lmap : ∀ l c S, Γ.LBound l c S -> Δ.LBound l c (S.crename f)
 
 def VarSubst.ext {Γ : Context n m k}
   (σ : VarSubst Γ f Δ)
@@ -130,10 +130,10 @@ def VarSubst.ext {Γ : Context n m k}
       rw [<- CBinding.weaken_rename]
       constructor; trivial
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_var hb0 =>
-      have hb1 := σ.lmap _ _ hb0
+      have hb1 := σ.lmap _ _ _ hb0
       rw [<- SType.weaken_rename]
       constructor; trivial
 
@@ -168,10 +168,10 @@ def VarSubst.text {Γ : Context n m k}
       have hb1 := σ.cmap _ _ hb0
       constructor; trivial
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_tvar hb0 =>
-      have hb1 := σ.lmap _ _ hb0
+      have hb1 := σ.lmap _ _ _ hb0
       rw [SType.tweaken_rename]
       constructor; aesop
 
@@ -207,10 +207,10 @@ def VarSubst.cext {Γ : Context n m k}
       rw [CBinding.cweaken_rename_comm]
       constructor; trivial
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb
     case there_cvar hb0 =>
-      have hb1 := σ.lmap _ _ hb0
+      have hb1 := σ.lmap _ _ _ hb0
       rw [SType.cweaken_rename_comm]
       constructor; aesop
 
@@ -264,10 +264,10 @@ def TVarSubst.cext {Γ : Context n m k}
       constructor
       exact hb''
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_cvar hb0 =>
-      have hb' := σ.lmap _ _ hb0
+      have hb' := σ.lmap _ _ _ hb0
       rw [<- SType.cweaken_trename]
       constructor
       assumption
@@ -325,10 +325,10 @@ def TVarSubst.ext {Γ : Context n m k}
       constructor
       exact hb''
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_var hb0 =>
-      have hb' := σ.lmap _ _ hb0
+      have hb' := σ.lmap _ _ _ hb0
       rw [<- SType.weaken_trename]
       constructor
       assumption
@@ -416,10 +416,10 @@ def TVarSubst.text {Γ : Context n m k}
         constructor
         exact hb''
     case lmap =>
-      intros l S hb
+      intros l c S hb
       cases hb
       case there_tvar hb0 =>
-        have hb' := σ.lmap _ _ hb0
+        have hb' := σ.lmap _ _ _ hb0
         rw [<- SType.tweaken_trename]
         constructor
         assumption
@@ -463,10 +463,10 @@ def CVarSubst.ext {Γ : Context n m k}
       constructor
       trivial
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_var hb0 =>
-      have hb' := σ.lmap _ _ hb0
+      have hb' := σ.lmap _ _ _ hb0
       rw [<- SType.weaken_crename]
       constructor
       assumption
@@ -517,10 +517,10 @@ def CVarSubst.text {Γ : Context n m k}
       have h0 := σ.cmap_bound _ _ hb0
       apply Subbound.tweaken; easy
     case lmap =>
-      intros l S hb
+      intros l c S hb
       cases hb
       case there_tvar hb0 =>
-        have hb' := σ.lmap _ _ hb0
+        have hb' := σ.lmap _ _ _ hb0
         rw [<- SType.tweaken_crename]
         constructor
         assumption
@@ -576,10 +576,10 @@ def CVarSubst.cext {Γ : Context n m k}
         constructor
         trivial
   case lmap =>
-    intros l S hb
+    intros l c S hb
     cases hb
     case there_cvar hb0 =>
-      have hb' := σ.lmap _ _ hb0
+      have hb' := σ.lmap _ _ _ hb0
       rw [<- SType.cweaken_crename]
       constructor
       assumption
@@ -595,13 +595,12 @@ def CVarSubst.cext {Γ : Context n m k}
       rename_i cb
       cases cb
       case kind k =>
-        simp [CBinding.crename, CBound.crename]
-        constructor
-        apply CaptureKind.cvar
-        constructor
+        simp only [CBinding.crename, CBound.crename]
+        apply Subbound.set_kind
+        apply CaptureKind.cvar_top .here
       case upper D0 =>
         constructor
-        apply Subcapt.cbound
+        apply Subcapt.cbound_top
         rw [<- CaptureSet.cweaken_def]
         rw [<- CaptureSet.cweaken_crename]
         constructor
@@ -648,7 +647,7 @@ def VarSubst.open
       simp [CBinding.rename_id]
       trivial
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb
     case there_var hb0 =>
       simp [SType.weaken, SType.rename_rename, FinFun.open_comp_weaken]
@@ -667,7 +666,7 @@ def VarSubst.narrow
       simp [CType.rename_id]
       apply Typed.sub
       apply Typed.bound_typing; constructor
-      apply Subcapt.refl
+      apply Subcapt.rfl
       apply ESubtyp.type
       apply hs.weaken
     case there_var hb0 =>
@@ -689,7 +688,7 @@ def VarSubst.narrow
       simp [CBinding.rename_id]
       constructor; trivial
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb
     case there_var hb0 =>
       simp [SType.rename_id]
@@ -730,9 +729,9 @@ def CVarSubst.narrow
       simp [FinFun.id]
       apply Subbound.trans (B2:=B'.cweaken)
       { cases B' <;> constructor
-        apply Subcapt.cbound
-        constructor
+        apply Subcapt.cbound_top
         constructor
+        apply CaptureKind.cvar_top
         constructor }
       { apply Subbound.cweaken; easy }
     case inr h =>
@@ -742,15 +741,19 @@ def CVarSubst.narrow
       simp [FinFun.id, CBound.crename_id]
       rename_i cb0
       cases cb0 <;> constructor
-      apply Subcapt.cbound
+      apply Subcapt.cbound_top
       have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
       simp [CBinding.cweaken] at hb1'
       exact hb1'
       simp [CBound.crename] at hb
-      apply CaptureKind.cvar
+      apply CaptureKind.cvar_top
       have h1 := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
       simp [CBinding.cweaken, CBinding.crename, CBound.crename] at h1
       assumption
+  case lmap =>
+    intro x cl S hb
+    simp [SType.crename_id]
+    cases hb; constructor; easy
 
 def TVarSubst.narrow
   (hs : SSubtyp Γ S' S) :
@@ -802,7 +805,7 @@ def TVarSubst.narrow
     constructor
     trivial
   case lmap =>
-    intro l S hb
+    intro l c S hb
     simp [SType.trename_id]
     cases hb
     constructor
@@ -849,7 +852,7 @@ def TVarSubst.open :
   , cmap := fun c b hb => by
       cases hb
       trivial
-  , lmap := fun l S hb => by
+  , lmap := fun l c S hb => by
       cases hb
       simp [SType.tweaken, SType.trename_trename, FinFun.open_comp_weaken, SType.trename_id]
       assumption
@@ -857,7 +860,7 @@ def TVarSubst.open :
 
 def CVarSubst.open :
   CVarSubst
-    (Γ.cvar (CBinding.bound (CBound.upper {c=c})))
+    (Γ.cvar (CBinding.bound (CBound.upper {c=c|.top})))
     (FinFun.open c)
     Γ := by
   constructor
@@ -892,7 +895,7 @@ def CVarSubst.open :
       simp [FinFun.open]
       simp [CBound.crename]
       simp [FinFun.weaken, FinFun.open]
-      constructor; apply Subcapt.refl
+      constructor; apply Subcapt.rfl
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases b1 <;> cases he1
@@ -903,13 +906,13 @@ def CVarSubst.open :
       rename_i cb; cases cb
       case kind K =>
         apply Subbound.set_kind
-        apply CaptureKind.cvar hb1
+        apply CaptureKind.cvar_top hb1
       case upper D0 =>
         constructor
-        apply Subcapt.cbound
+        apply Subcapt.cbound_top
         easy
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb
     simp [SType.cweaken, SType.crename_crename, FinFun.open_comp_weaken]
     simp [SType.crename_id]
@@ -943,7 +946,7 @@ def CVarSubst.instantiate {Γ : Context n m k}
     constructor
     trivial
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb
     simp [SType.crename_id]
     constructor; trivial
@@ -958,16 +961,15 @@ def CVarSubst.instantiate {Γ : Context n m k}
       constructor
       rename_i C2 hsub
       apply Subcapt.trans
-      apply Subcapt.cinstr .here
+      apply Subcapt.cinstr_top .here
       simp [CaptureSet.crename_id]
       exact hsub.cweaken (b:=CBinding.inst C)
       constructor
       rename_i hk
       have h1 := CaptureKind.cweaken (b:=.inst C) hk
-      apply CaptureKind.csub (C2:=C.cweaken)
-      apply Subcapt.cinstr
+      apply CaptureKind.subcapt (C2:=C.cweaken) h1
+      apply Subcapt.cinstr_top
       apply Context.CBound.here
-      assumption
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases he2
@@ -978,12 +980,12 @@ def CVarSubst.instantiate {Γ : Context n m k}
       case kind K1 =>
         simp [CBound.crename]
         constructor
-        apply CaptureKind.cvar
+        apply CaptureKind.cvar_top
         exact hb1.there_cvar (b':=.inst C)
         -- have hb2 := hb1
       case upper D0 =>
         constructor
-        apply Subcapt.cbound
+        apply Subcapt.cbound_top
         rw [<- CaptureSet.cweaken_def]
         rw [<- CBound.cweaken_upper]
         rw [<- CBinding.cweaken_bound]
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index 1c0c3da3..5e95aea6 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -7,73 +7,49 @@ Substitution theorems for capture variable substitution in subcapturing judgment
 
 namespace Capless
 
-mutual
 theorem CaptureKind.csubst
   (h : CaptureKind Γ C K)
   (σ : CVarSubst Γ f Δ) :
-  CaptureKind Δ (C.crename f) K :=
-  match h with
-  | .label hl =>
-    have hl1 := σ.lmap _ _ hl
-    .label hl1
-  | .cvar hb => by
+  CaptureKind Δ (C.crename f) K := by
+  induction h
+  case var hb hk ih =>
+    rewrite [CaptureSet.proj_crename] at ih
+    apply! var (σ.map _ _ hb) (ih _)
+  case label hb => apply label (σ.lmap _ _ _ hb)
+  case cvar hb =>
     cases σ.cmap_bound _ _ hb
-    assumption
-  | .csub hsub hk =>
-    have hsub1 := hsub.csubst σ
-    .csub hsub1 (hk.csubst σ)
-  | .sub hs hk => .sub hs (hk.csubst σ)
-  | .empty => .empty
-  | .proj_kind => by
-    simp
-    apply CaptureKind.proj_kind
-  | .proj hk => by
-    simp
-    apply CaptureKind.proj $ hk.csubst σ
-
+    apply! apply_proj_singleton
+  case cbound hb hk ih =>
+    rewrite [CaptureSet.proj_crename] at ih
+    cases σ.cmap_bound _ _ hb
+    rename_i hb
+    apply subcapt _ hb.apply_proj_singleton
+    apply! ih
+  case cinstr hb hk ih =>
+    rewrite [CaptureSet.proj_crename] at ih
+    apply! cinstr (σ.cmap _ _ hb) (ih _)
+  case sub hs hk ih =>
+    apply! sub hs (ih _)
+  case empty => apply empty
+  case absurd he => apply! absurd
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.csubst
   (h : Subcapt Γ C1 C2)
   (σ : CVarSubst Γ f Δ) :
-  Subcapt Δ (C1.crename f) (C2.crename f) :=
-  match h with
-  | .trans ha hb => .trans (ha.csubst σ) (hb.csubst σ)
-  | .subset hsub => by
-    apply Subcapt.subset
-    apply (CaptureSet.crename_monotone hsub)
-  | .union h1 h2 => by
-    have ih1 := h1.csubst σ
-    have ih2 := h2.csubst σ
-    rw [CaptureSet.crename_union]
-    apply Subcapt.union <;> trivial
-  | .var hb =>
-    have ht := σ.map _ _ hb
-    Subcapt.var ht
-  | .cinstl hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstl hb1
-  | .cinstr hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstr hb1
-  | .cbound hb => by
-    have hb1 := σ.cmap_bound _ _ hb
-    cases hb1
-    easy
-  | .proj h1 => by
-    simp
-    apply Subcapt.proj (h1.csubst σ)
-  | .proj_sub hs => by
-    simp
-    apply Subcapt.proj_sub hs
-  | .proj_l => by
-    simp
-    apply Subcapt.proj_l
-  | .proj_r hk => by
-    simp
-    apply Subcapt.proj_r (hk.csubst σ)
-  | .proj_disj hd hk => by
-    simp
-    apply Subcapt.proj_disj hd (hk.csubst σ)
-end
+  Subcapt Δ (C1.crename f) (C2.crename f) := by
+  induction h <;> try rw [CaptureSet.proj_crename]
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply subset (CaptureSet.Subset.crename hs)
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply var (σ.map _ _ hb)
+  case cinstl hb => apply cinstl (σ.cmap _ _ hb)
+  case cinstr hb => apply cinstr (σ.cmap _ _ hb)
+  case cbound hb =>
+    cases σ.cmap_bound _ _ hb
+    apply! apply_proj_singleton
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index 1ba6b826..7fa6d68d 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -122,7 +122,7 @@ theorem Typed.csubst
     case boundary ih =>
       simp [Term.crename]
       simp [EType.crename, CType.crename]
-      apply boundary
+      apply boundary; assumption
       have ih := ih (σ.cext.ext _)
       simp [CBinding.crename, EType.crename, CType.crename, SType.crename, FinFun.ext] at ih
       rw [ <- SType.cweaken_crename
@@ -133,7 +133,7 @@ theorem Typed.csubst
       aesop
 
 theorem Typed.copen
-  (h : Typed (Γ,c<:CBound.upper {c=c}) t E Ct) :
+  (h : Typed (Γ,c<:CBound.upper {c=c|.top}) t E Ct) :
   Typed Γ (t.copen c) (E.copen c) (Ct.copen c) := by
   simp [Term.copen, EType.copen]
   apply? Typed.csubst
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index 77822a66..050bca61 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -9,76 +9,46 @@ Substitution theorems for term variable substitution in subcapturing judgments.
 
 namespace Capless
 
-mutual
 theorem CaptureKind.subst
   (h : CaptureKind Γ C K)
   (σ : VarSubst Γ f Δ) :
-  CaptureKind Δ (C.rename f) K :=
-  match h with
-  | .label hl =>
-    have hl1 := σ.lmap _ _ hl
-    .label hl1
-  | .cvar hb => by
-    have hb1 := σ.cmap _ _ hb
-    simp [CBinding.rename, CBound.rename] at hb1
-    apply CaptureKind.cvar hb1
-  | .csub hsub hk =>
-    have hsub1 := hsub.subst σ
-    .csub hsub1 (hk.subst σ)
-  | .sub hs hk => .sub hs (hk.subst σ)
-  | .empty => .empty
-  | .proj_kind => by
-    simp
-    apply CaptureKind.proj_kind
-  | .proj hk => by
-    simp
-    apply CaptureKind.proj $ hk.subst σ
-
+  CaptureKind Δ (C.rename f) K := by
+  induction h
+  case var hb hk ih =>
+    rewrite [CaptureSet.proj_rename] at ih
+    have h1 := Typing.inv_subcapt $ σ.map _ _ hb
+    apply subcapt $ ih σ
+    apply h1.apply_proj_singleton
+  case label hb => apply label (σ.lmap _ _ _ hb)
+  case cvar hb => apply cvar (σ.cmap _ _ hb)
+  case cbound hb hk ih =>
+    rewrite [CaptureSet.proj_rename] at ih
+    apply! cbound (σ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih =>
+    rewrite [CaptureSet.proj_rename] at ih
+    apply! cinstr (σ.cmap _ _ hb) (ih _)
+  case sub hs hk ih =>
+    apply! sub hs (ih _)
+  case empty => apply empty
+  case absurd he => apply! absurd
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.subst
   (h : Subcapt Γ C1 C2)
   (σ : VarSubst Γ f Δ) :
-  Subcapt Δ (C1.rename f) (C2.rename f) :=
-  match h with
-  | .trans ha hb => .trans (ha.subst σ) (hb.subst σ)
-  | .subset hsub => by
-    apply Subcapt.subset
-    apply CaptureSet.Subset.rename hsub
-  | .union h1 h2 => by
-    have ih1 := h1.subst σ
-    have ih2 := h2.subst σ
-    rw [CaptureSet.rename_union]
-    apply Subcapt.union <;> trivial
-  | .var hb => by
-    have ht := σ.map _ _ hb
-    simp [CType.rename] at ht
-    have h := Typing.inv_subcapt ht
-    trivial
-  | .cinstl hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstl hb1
-  | .cinstr hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstr hb1
-  | .cbound hb => by
-    have hb1 := σ.cmap _ _ hb
-    simp [CBinding.rename, CBound.rename] at hb1
-    apply Subcapt.cbound hb1
-  | .proj h1 => by
-    simp
-    apply Subcapt.proj (h1.subst σ)
-  | .proj_sub hs => by
-    simp
-    apply Subcapt.proj_sub hs
-  | .proj_l => by
-    simp
-    apply Subcapt.proj_l
-  | .proj_r hk => by
-    simp
-    apply Subcapt.proj_r (hk.subst σ)
-  | .proj_disj hd hk => by
-    simp
-    apply Subcapt.proj_disj hd (hk.subst σ)
-end
+  Subcapt Δ (C1.rename f) (C2.rename f) := by
+  induction h <;> try rw [CaptureSet.proj_rename]
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply subset (CaptureSet.Subset.rename hs)
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb =>
+    have h1 := Typing.inv_subcapt (σ.map _ _ hb)
+    apply h1.apply_proj_singleton
+  case cinstl hb => apply cinstl (σ.cmap _ _ hb)
+  case cinstr hb => apply cinstr (σ.cmap _ _ hb)
+  case cbound hb => apply cbound (σ.cmap _ _ hb)
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Term/Typing.lean b/Capless/Subst/Term/Typing.lean
index 3c6e18c1..9b3ab6fa 100644
--- a/Capless/Subst/Term/Typing.lean
+++ b/Capless/Subst/Term/Typing.lean
@@ -113,7 +113,7 @@ theorem Typed.subst
     rw [<- CaptureSet.cweaken_rename_comm]
     exact ih
   case label hb =>
-    have hb1 := σ.lmap _ _ hb
+    have hb1 := σ.lmap _ _ _ hb
     simp [Term.rename, EType.rename, CType.rename, SType.rename]
     apply label
     aesop
@@ -126,7 +126,7 @@ theorem Typed.subst
   case boundary ih =>
     simp [Term.rename]
     simp [EType.rename, CType.rename] at *
-    apply boundary
+    apply boundary; assumption
     have ih := ih (σ.cext.ext _)
     simp
       [ CBinding.rename
diff --git a/Capless/Subst/Type/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean
index a7912e25..a3640b4f 100644
--- a/Capless/Subst/Type/Subcapturing.lean
+++ b/Capless/Subst/Type/Subcapturing.lean
@@ -7,54 +7,38 @@ Substitution theorems for type variable substitution in subcapturing judgments.
 
 namespace Capless
 
-mutual
 
 theorem CaptureKind.tsubst
   (h : CaptureKind Γ C K)
   (σ : TVarSubst Γ f Δ) :
-  CaptureKind Δ C K :=
-  match h with
-  | .label hl =>
-    have hl1 := σ.lmap _ _ hl
-    .label hl1
-  | .cvar hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cvar hb1
-  | .csub hsub hk =>
-    have hsub1 := hsub.tsubst σ
-    .csub hsub1 (hk.tsubst σ)
-  | .sub hs hk =>
-    .sub hs (hk.tsubst σ)
-  | .empty => .empty
-  | .proj hk => .proj $ hk.tsubst σ
-  | .proj_kind => .proj_kind
+  CaptureKind Δ C K := by
+  induction h
+  case var hb hk ih =>
+    apply! var (σ.map _ _ hb) (ih _)
+  case label hb => apply label (σ.lmap _ _ _ hb)
+  case cvar hb => apply cvar (σ.cmap _ _ hb)
+  case cbound hb hk ih => apply! cbound (σ.cmap _ _ hb) (ih _)
+  case cinstr hb hk ih => apply! cinstr (σ.cmap _ _ hb) (ih _)
+  case sub hs hk ih => apply! sub hs (ih _)
+  case empty => apply empty
+  case absurd he => apply! absurd
+  case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.tsubst
   (h : Subcapt Γ C1 C2)
   (σ : TVarSubst Γ f Δ) :
-  Subcapt Δ C1 C2 :=
-  match h with
-  | .trans ha hb => .trans (ha.tsubst σ) (hb.tsubst σ)
-  | .subset hsub => .subset hsub
-  | .union h1 h2 => .union (h1.tsubst σ) (h2.tsubst σ)
-  | .var hb => by
-    have ht := σ.map _ _ hb
-    apply Subcapt.var <;> aesop
-  | .cinstl hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstl hb1
-  | .cinstr hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cinstr hb1
-  | .cbound hb =>
-    have hb1 := σ.cmap _ _ hb
-    .cbound hb1
-  | .proj hk => .proj $ hk.tsubst σ
-  | .proj_sub hs => .proj_sub hs
-  | .proj_l => .proj_l
-  | .proj_r hs => .proj_r $ hs.tsubst σ
-  | .proj_disj hd hk => .proj_disj hd $ hk.tsubst σ
+  Subcapt Δ C1 C2 := by
+  induction h
+  case trans ha hb => apply! trans (ha _) (hb _)
+  case subset hs => apply subset hs
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply var (σ.map _ _ hb)
+  case cinstl hb => apply cinstl (σ.cmap _ _ hb)
+  case cinstr hb => apply cinstr (σ.cmap _ _ hb)
+  case cbound hb => apply cbound (σ.cmap _ _ hb)
+  case subkind hs => apply! subkind
+  case proj_absurd => apply! proj_absurd
+  case proj_split => apply! proj_split
 
-end
 
 end Capless
diff --git a/Capless/Subst/Type/Typing.lean b/Capless/Subst/Type/Typing.lean
index f8d36a51..2a74d5ee 100644
--- a/Capless/Subst/Type/Typing.lean
+++ b/Capless/Subst/Type/Typing.lean
@@ -104,7 +104,7 @@ theorem Typed.tsubst
       trivial
     case label hb =>
       simp [Term.trename, EType.trename, CType.trename, SType.trename]
-      have hb1 := σ.lmap _ _ hb
+      have hb1 := σ.lmap _ _ _ hb
       apply label; assumption
     case invoke ih1 ih2 =>
       simp [Term.trename]
@@ -115,7 +115,7 @@ theorem Typed.tsubst
     case boundary ih =>
       simp [Term.trename]
       simp [EType.trename, CType.trename, SType.trename]
-      apply boundary
+      apply boundary; assumption
       have ih := ih (σ.cext.ext _)
       simp [EType.trename, CType.trename, SType.trename] at ih
       rw [ <- SType.cweaken_trename
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index c92986a9..cd3574c4 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -76,30 +76,6 @@ theorem WellScoped.subkind_singleton
   rw [Kind.Intersect.top_l] at h1
   assumption
 
--- theorem WellScoped.proj (hsc : WellScoped Γ cont C) : WellScoped Γ cont (C.proj K) := by
---   induction hsc generalizing K
---   case empty => apply empty
---   case union ih1 ih2 => apply union ih1 ih2
---   case singleton hb hsc ih =>
---     simp only [CaptureSet.proj]
---     apply singleton hb ih
---   case csingleton hb hsc ih =>
---     simp only [CaptureSet.proj]
---     apply csingleton hb ih
---   case cbound hb hsc ih =>
---     simp only [CaptureSet.proj]
---     apply cbound hb ih
---   case ckind hb =>
---     simp only [CaptureSet.proj]
---     apply ckind hb
---   case label hb hl =>
---     simp only [CaptureSet.proj]
---     apply label hb hl
---   case label_disj hb hd =>
---     simp only [CaptureSet.proj]
---     apply label_disj hb (hd.intersect_disjoint Kind.Intersect.lawful)
-
-
 theorem WellScoped.subset {C1 C2 : CaptureSet n k}
   (hsc : WellScoped Γ cont C2)
   (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
@@ -311,4 +287,34 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
     cases hsc
     apply! proj_merge_singleton
 
+theorem WellScoped.var_inv
+  (hsc : WellScoped Γ cont {x=x|.top})
+  (hbx : Γ.Bound x (S^C)) :
+  WellScoped Γ cont C := by
+  cases hsc
+  case singleton hbx' _ =>
+    have h := Context.bound_injective hbx hbx'
+    cases h
+    rw [CaptureSet.proj_top] at *
+    trivial
+  case label =>
+    exfalso
+    apply Context.bound_lbound_absurd <;> easy
+  case label_disj =>
+    exfalso
+    apply Context.bound_lbound_absurd <;> easy
+  case absurd he => cases he.is_absurd
+
+theorem WellScoped.label_inv
+  (hsc : WellScoped Γ cont {x=x|.top})
+  (hbl : Γ.LBound x c S) :
+  ∃ tail, cont.HasLabel x tail := by
+  cases hsc
+  case singleton =>
+    exfalso
+    apply Context.bound_lbound_absurd <;> easy
+  case label => aesop
+  case label_disj hd => cases hd.top_l.is_absurd
+  case absurd he => cases he.is_absurd
+
 end Capless

From f259c5852c288a1547c9533a0ce898db4bd697b9 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 11 Dec 2025 20:08:03 +0100
Subject: [PATCH 46/71] Preservation also green :D

---
 Capless/CaptureSet.lean                  |  3 ++
 Capless/Inversion/Typing.lean            |  6 ++-
 Capless/Soundness/Preservation.lean      | 36 ++++++-------
 Capless/Typing/Boundary.lean             | 67 +++++++++++++-----------
 Capless/Weakening/TypedCont/Capture.lean |  9 ++--
 Capless/Weakening/TypedCont/Term.lean    | 37 +++++++------
 Capless/Weakening/TypedCont/Type.lean    |  3 ++
 7 files changed, 92 insertions(+), 69 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index f5d36035..d3706365 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -329,3 +329,6 @@ theorem CaptureSet.proj_crename {C : CaptureSet n k} : (C.proj K).crename f = (C
   case empty => simp
   case singleton => simp
   case union ha hb => simp; aesop
+
+theorem CaptureSet.proj_weaken {C : CaptureSet n k} : (C.proj K).weaken = (C.weaken).proj K := C.proj_rename
+theorem CaptureSet.proj_cweaken {C : CaptureSet n k} : (C.proj K).cweaken = (C.cweaken).proj K := C.proj_crename
diff --git a/Capless/Inversion/Typing.lean b/Capless/Inversion/Typing.lean
index a3d3d29e..e49643f4 100644
--- a/Capless/Inversion/Typing.lean
+++ b/Capless/Inversion/Typing.lean
@@ -683,6 +683,7 @@ theorem Typed.label_inv_sub
 theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
   (he : t0 = (boundary[c]:S in t))
   (ht : Typed Γ t0 E Ct) :
+  (c.Subclass .control) ∧
   Typed
     ((Γ,c<:(.kind $ .classifier c)),x: Label[S.cweaken]^{c=0|.top})
     t
@@ -692,11 +693,13 @@ theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
   induction ht <;> try (solve | cases he)
   case boundary =>
     cases he
+    apply And.intro; assumption
     split_and
     { easy }
     { apply ESubtyp.refl }
   case sub hsc hsub ih =>
-    have ⟨ih, hsub0⟩ := ih he
+    have ⟨hs, ih, hsub0⟩ := ih he
+    apply And.intro; assumption
     split_and
     { apply Typed.sub
       { exact ih }
@@ -708,6 +711,7 @@ theorem Typed.boundary_inv' {Γ : Context n m k} {S : SType n m k}
 
 theorem Typed.boundary_inv {Γ : Context n m k} {S : SType n m k}
   (ht : Typed Γ (boundary[c]:S in t) E Ct) :
+  (c.Subclass .control) ∧
   Typed
     ((Γ,c<:(.kind $ .classifier c)),x: Label[S.cweaken]^{c=0|.top})
     t
diff --git a/Capless/Soundness/Preservation.lean b/Capless/Soundness/Preservation.lean
index abf2297f..aacbb8ee 100644
--- a/Capless/Soundness/Preservation.lean
+++ b/Capless/Soundness/Preservation.lean
@@ -40,7 +40,7 @@ inductive Preserve : Context n m k -> EType n m k -> State n' m' k' -> Prop wher
   TypedState state (Γ.cvar b) E.cweaken ->
   Preserve Γ E state
 | mk_enter :
-  TypedState state ((Γ.label S).cvar b) E.weaken.cweaken ->
+  TypedState state ((Γ.label c S).cvar b) E.weaken.cweaken ->
   Preserve Γ E state
 
 theorem value_typing_widen
@@ -50,10 +50,10 @@ theorem value_typing_widen
     cases hs
     apply Typed.sub
     easy
-    apply Subcapt.refl
+    apply Subcapt.rfl
     constructor
     constructor
-    apply Subcapt.refl
+    apply Subcapt.rfl
     easy
 
 theorem EType.weaken_cweaken_helper {S : SType n m k} :
@@ -81,7 +81,7 @@ theorem preservation
       { apply Typed.sub
         { apply Typed.open (h := hcft)
           exact hy }
-        { apply Subcapt.refl }
+        { apply Subcapt.rfl }
         { subst he1
           easy } }
       { have h1 := Typed.app_inv_capt ht
@@ -108,7 +108,7 @@ theorem preservation
       { easy }
       { apply Typed.sub
         { apply Typed.topen (h := hft) }
-        { apply Subcapt.refl }
+        { apply Subcapt.rfl }
         { subst he0
           easy } }
       { have h1 := Typed.tapp_inv_capt ht
@@ -130,7 +130,7 @@ theorem preservation
       { easy }
       { apply Typed.sub
         { apply Typed.copen hct }
-        { apply Subcapt.refl }
+        { apply Subcapt.rfl }
         { subst he1
           exact hs1 } }
       { have h1 := Typed.capp_inv_capt ht
@@ -152,7 +152,7 @@ theorem preservation
       { apply WellScoped.cons; easy }
       { constructor
         apply Typed.sub <;> try easy
-        apply Subcapt.refl
+        apply Subcapt.rfl
         apply ESubtyp.weaken; easy
         { easy }
         easy }
@@ -166,7 +166,7 @@ theorem preservation
       { exact htt }
       { apply WellScoped.conse; easy }
       { constructor
-        apply Typed.sub; exact htu; apply Subcapt.refl
+        apply Typed.sub; exact htu; apply Subcapt.rfl
         apply ESubtyp.weaken
         apply ESubtyp.cweaken; exact hsub
         { easy }
@@ -228,7 +228,7 @@ theorem preservation
       constructor
       { constructor; exact hs }
       { apply Typed.sub
-        exact ht; apply Subcapt.refl
+        exact ht; apply Subcapt.rfl
         apply ESubtyp.tweaken; exact hsub }
       { apply hsc.tweaken }
       { apply TypedCont.tweaken; exact hc }
@@ -240,18 +240,18 @@ theorem preservation
       constructor
       { constructor; exact hs }
       { apply Typed.sub
-        exact ht; apply Subcapt.refl
+        exact ht; apply Subcapt.rfl
         apply ESubtyp.cweaken; exact hsub }
       { apply hsc.cweaken }
       { apply TypedCont.cweaken; exact hc }
   case enter =>
     cases ht
     case mk hs hsc ht hc =>
-      have ⟨ht0, hsub0⟩ := Typed.boundary_inv ht
+      have ⟨hsc, ht0, hsub0⟩ := Typed.boundary_inv ht
       apply Preserve.mk_enter
       constructor
       { constructor; constructor; easy }
-      { apply Typed.boundary_body_typing ht0 }
+      { apply Typed.boundary_body_typing hsc ht0 }
       { repeat any_goals apply WellScoped.union
         { rw [CaptureSet.weaken_cweaken]
           apply WellScoped.scope
@@ -280,9 +280,9 @@ theorem preservation
       { easy }
       { apply Typed.sub
         { exact ht1 }
-        { apply Subcapt.refl }
+        { apply Subcapt.rfl }
         { constructor; easy } }
-      { have ht1 := Typed.sub ht Subcapt.refl (ESubtyp.type hsub)
+      { have ht1 := Typed.sub ht Subcapt.rfl (ESubtyp.type hsub)
         have hy := Typed.var_inv_cs ht1
         apply WellScoped.subcapt
         apply WellScoped.empty
@@ -294,14 +294,14 @@ theorem preservation
       rename_i hv _ _ _
       cases hc
       case scope hsub hbl hc0 =>
-        have ht1 := Typed.sub ht Subcapt.refl (ESubtyp.type hsub)
+        have ht1 := Typed.sub ht Subcapt.rfl (ESubtyp.type hsub)
         have ht2 := Typed.val_precise_cv ht1 hv
         apply Preserve.mk
         constructor
         { easy }
         { apply Typed.sub
           { exact ht2 }
-          { apply Subcapt.refl }
+          { apply Subcapt.rfl }
           { apply ESubtyp.refl } }
         { constructor }
         { easy }
@@ -311,7 +311,7 @@ theorem preservation
       have hg := TypedStore.is_tight hs
       have ⟨S0, C0, hx, hy⟩ := Typed.invoke_inv ht
       have h1 := Store.bound_label hl hs
-      have ⟨S0, hbx, hsub⟩ := Typed.label_inv_sub hx h1 hg
+      have ⟨c0, S0, hbx, hsub⟩ := Typed.label_inv_sub hx h1 hg
       have ⟨Ct1, hc1⟩ := Cont.has_label_tail_inv hc hbx hhl
       apply Preserve.mk
       constructor
@@ -323,6 +323,6 @@ theorem preservation
         easy }
       { apply hc1.narrow
         constructor; constructor
-        apply Subcapt.refl; easy }
+        apply Subcapt.rfl; easy }
 
 end Capless
diff --git a/Capless/Typing/Boundary.lean b/Capless/Typing/Boundary.lean
index 33bb318b..37028691 100644
--- a/Capless/Typing/Boundary.lean
+++ b/Capless/Typing/Boundary.lean
@@ -8,11 +8,12 @@ The following proves a substitution theorem specialised to the typing of boundar
 It is a prerequisite for the (ENTER) case in the preservation theorem.
 !-/
 
-def VarRename.boundary {Γ : Context n m k} {S : SType n m k} :
+def VarRename.boundary {Γ : Context n m k} {S : SType n m k}
+  (hs : Classifier.Subclass c .control) :
   VarMap
-    ((Γ,c<:CBound.kind .control),x:(Label[S.cweaken])^{c=0})
+    ((Γ,c<:CBound.kind (.classifier c)),x:(Label[S.cweaken])^{c=0|.top})
     FinFun.weaken.ext
-    (((Γ.label S),c<:CBound.kind .control),x:(Label[S.weaken.cweaken])^{c=0}) := by
+    (((Γ.label c S),c<:CBound.kind (.classifier c)),x:(Label[S.weaken.cweaken])^{c=0|.top}) := by
   constructor
   case map =>
     intro x E hb
@@ -55,7 +56,7 @@ def VarRename.boundary {Γ : Context n m k} {S : SType n m k} :
       constructor; constructor
       constructor; easy
   case lmap =>
-    intro x S hb
+    intro x c0 S hb
     cases hb; rename_i hb
     cases hb; rename_i hb
     simp [FinFun.weaken, FinFun.ext]
@@ -63,11 +64,12 @@ def VarRename.boundary {Γ : Context n m k} {S : SType n m k} :
     rw [SType.cweaken_rename_comm]
     constructor; constructor; constructor; easy
 
-def CVarRename.boundary {Γ : Context n m k} {S : SType n m k} :
+def CVarRename.boundary {Γ : Context n m k} {S : SType n m k}
+  (hs : Classifier.Subclass c .control) :
   CVarMap
-    (((Γ.label S),c<:CBound.kind .control),x:(Label[S.weaken.cweaken])^{c=0})
+    (((Γ.label c S),c<:CBound.kind (.classifier c)),x:(Label[S.weaken.cweaken])^{c=0|.top})
     FinFun.weaken.ext
-    ((((Γ.label S),c:={x=0}),c<:CBound.kind .control),x:(Label[S.weaken.cweaken.cweaken])^{c=0}) := by
+    ((((Γ.label c S),c:={x=0|.top}),c<:CBound.kind (.classifier c)),x:(Label[S.weaken.cweaken.cweaken])^{c=0|.top}) := by
   constructor
   case map =>
     intro x T hb
@@ -110,7 +112,7 @@ def CVarRename.boundary {Γ : Context n m k} {S : SType n m k} :
       repeat constructor
       easy
   case lmap =>
-    intro l S hb
+    intro l c0 S hb
     cases hb; rename_i hb
     cases hb; rename_i hb
     cases hb
@@ -139,11 +141,12 @@ theorem TBinding.cweaken_copen_id {b : TBinding n m k} :
   simp [TBinding.cweaken, TBinding.crename_crename]
   simp [FinFun.open_comp_weaken, TBinding.crename_id]
 
-def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
+def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k}
+  (hs : Classifier.Subclass c .control) :
   CVarSubst
-    ((((Γ.label S),c:={x=0}),c<:.kind .control),x:(Label[S.weaken.cweaken.cweaken])^{c=0})
+    ((((Γ.label c S),c:={x=0|.top}),c<:.kind (.classifier c)),x:(Label[S.weaken.cweaken.cweaken])^{c=0|.top})
     (FinFun.open 0)
-    (((Γ.label S),c:={x=0}),x:(Label[S.weaken.cweaken])^{c=0}) := by
+    (((Γ.label c S),c:={x=0|.top}),x:(Label[S.weaken.cweaken])^{c=0|.top}) := by
   constructor
   case map =>
     intro x T hb
@@ -197,12 +200,10 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       constructor
       subst he1
       simp [FinFun.open]
-      apply CaptureKind.csub
-      apply Subcapt.cinstr (.there_var .here)
-      simp [CaptureSet.crename, FinFun.weaken]
-      apply CaptureKind.label
+      apply CaptureKind.subcapt
+      apply CaptureKind.label_top
       apply Context.LBound.there_var (.there_cvar .here)
-
+      apply Subcapt.cinstr_top (.there_var .here)
     case inr h =>
       have ⟨b2, c2, hb2, he3, he4⟩ := h
       rename_i cb0
@@ -213,19 +214,19 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       case kind K =>
         constructor
         simp [FinFun.open]
-        apply CaptureKind.cvar
+        apply CaptureKind.cvar_top
         apply Context.CBound.there_var hb2
       case upper D0 =>
         constructor
         simp [FinFun.open]
-        apply Subcapt.cbound
+        apply Subcapt.cbound_top
         simp [CaptureSet.crename_rename_comm]
         simp [CaptureSet.crename_crename, FinFun.open_comp_weaken, CaptureSet.crename_id]
-        have hb3 := Context.CBound.there_var (E:=Label[S.weaken.cweaken]^{c=0}) hb2
+        have hb3 := Context.CBound.there_var (E:=Label[S.weaken.cweaken]^{c=0|.top}) hb2
         simp [CBinding.weaken] at hb3
         easy
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb; rename_i hb
     cases hb; rename_i hb
     cases hb; rename_i hb
@@ -240,11 +241,12 @@ def CVarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       repeat constructor
       easy
 
-def VarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
+def VarSubst.boundary {Γ : Context n m k} {S : SType n m k}
+  (hs : Classifier.Subclass c .control) :
   VarSubst
-    (((Γ.label S),c:={x=0}),x:(Label[S.weaken.cweaken])^{c=0})
+    (((Γ.label c S),c:={x=0|.top}),x:(Label[S.weaken.cweaken])^{c=0|.top})
     (FinFun.open 0)
-    ((Γ.label S),c:={x=0}) := by
+    ((Γ.label c S),c:={x=0|.top}) := by
   constructor
   case map =>
     intro x T hb
@@ -256,10 +258,10 @@ def VarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
       simp [FinFun.open_comp_weaken, SType.rename_id]
       apply Typed.sub
       { apply Typed.label; constructor; constructor }
-      { apply Subcapt.refl }
+      { apply Subcapt.rfl }
       { constructor
         constructor
-        { apply Subcapt.cinstl; constructor }
+        { apply Subcapt.cinstl_top; constructor }
         { apply SSubtyp.refl } }
     case there_var hb =>
       simp [FinFun.open]
@@ -279,7 +281,7 @@ def VarSubst.boundary {Γ : Context n m k} {S : SType n m k} :
     simp [FinFun.open_comp_weaken, CBinding.rename_id]
     easy
   case lmap =>
-    intro l S hb
+    intro l c S hb
     cases hb; rename_i hb
     simp [SType.weaken, SType.rename_rename]
     simp [FinFun.open_comp_weaken, SType.rename_id]
@@ -322,13 +324,14 @@ theorem CaptureSet.open_weaken_ext {C : CaptureSet (n+1) k} :
   simp [CaptureSet.rename_id]
 
 theorem Typed.boundary_body_typing {Γ : Context n m k} {S : SType n m k}
-  (ht : Typed ((Γ,c<:(.kind .control)),x:(Label[S.cweaken])^{c=0}) t E Ct) :
-  Typed ((Γ.label S),c:={x=0}) t E Ct := by
-  have h := ht.rename VarRename.boundary
-  have h := h.crename CVarRename.boundary
-  have h := h.csubst CVarSubst.boundary
+  (hs : Classifier.Subclass c .control)
+  (ht : Typed ((Γ,c<:(.kind (.classifier c))),x:(Label[S.cweaken])^{c=0|.top}) t E Ct) :
+  Typed ((Γ.label c S),c:={x=0|.top}) t E Ct := by
+  have h := ht.rename $ VarRename.boundary hs
+  have h := h.crename $ CVarRename.boundary hs
+  have h := h.csubst $ CVarSubst.boundary hs
   simp [Term.copen_cweaken_ext, EType.copen_cweaken_ext, CaptureSet.copen_cweaken_ext] at h
-  have h := h.subst VarSubst.boundary
+  have h := h.subst $ VarSubst.boundary hs
   simp [Term.open_weaken_ext, EType.open_weaken_ext, CaptureSet.open_weaken_ext] at h
   easy
 
diff --git a/Capless/Weakening/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean
index 98b6ce6b..74539056 100644
--- a/Capless/Weakening/TypedCont/Capture.lean
+++ b/Capless/Weakening/TypedCont/Capture.lean
@@ -80,25 +80,28 @@ theorem WellScoped.cweaken
     { have hb1 := Context.Bound.there_cvar (b := b) hb
       simp [CType.cweaken, CType.crename] at hb1
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_crename]; exact ih }
   case csingleton hb _ ih =>
     apply csingleton
     { have hb1 := Context.CBound.there_cvar (b' := b) hb
       simp [CType.cweaken, CType.crename] at hb1
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_cweaken]; exact ih }
   case cbound hb _ ih =>
     apply cbound
     { have hb1 := Context.CBound.there_cvar (b' := b) hb
       simp [CType.cweaken, CType.crename] at hb1
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_crename]; exact ih }
+  case ckind hb => apply ckind hb.there_cvar
   case label hb hs =>
     apply label
     { have hb1 := Context.LBound.there_cvar (b := b) hb
       simp [CType.cweaken, CType.crename] at hb1
       exact hb1 }
     { apply hs.cweaken }
+  case label_disj hb hd => apply! label_disj hb.there_cvar
+  case absurd => apply! absurd
 
 theorem TypedCont.cweaken
   (h : TypedCont Γ E t E' Ct) :
diff --git a/Capless/Weakening/TypedCont/Term.lean b/Capless/Weakening/TypedCont/Term.lean
index 2336c817..577f51bd 100644
--- a/Capless/Weakening/TypedCont/Term.lean
+++ b/Capless/Weakening/TypedCont/Term.lean
@@ -85,22 +85,26 @@ theorem WellScoped.weaken
       have hb1 := Context.Bound.there_var (E':=T) hb
       simp [CType.weaken, CType.rename] at hb1
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
   case csingleton hb _ ih =>
     apply csingleton
     { have hb1 := Context.CBound.there_var (E:=T) hb
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
   case cbound hb _ ih =>
     apply cbound
     { have hb1 := Context.CBound.there_var (E:=T) hb
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
+  case ckind hb => apply ckind hb.there_var
   case label hb hs =>
     apply label
     { have hb1 := Context.LBound.there_var (E:=T) hb
       exact hb1 }
     { apply hs.weaken }
+  case label_disj hb hd => apply label_disj hb.there_var hd
+  case absurd => apply! absurd
+
 
 theorem TypedCont.weaken
   (h : TypedCont Γ E t E' C0) :
@@ -166,7 +170,7 @@ theorem Cont.HasLabel.lweaken
 
 theorem WellScoped.lweaken
   (h : WellScoped Γ cont Ct) :
-  WellScoped (Γ.label S) cont.weaken Ct.weaken := by
+  WellScoped (Γ.label c S) cont.weaken Ct.weaken := by
   induction h
   case empty => simp [CaptureSet.weaken]; constructor
   case union ih1 ih2 =>
@@ -175,29 +179,32 @@ theorem WellScoped.lweaken
   case singleton hb _ ih =>
     apply singleton
     { simp [FinFun.weaken]
-      have hb1 := Context.Bound.there_label (S:=S) hb
+      have hb1 := Context.Bound.there_label (c:=c) (S:=S) hb
       simp [CaptureSet.weaken, CaptureSet.rename] at hb1
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
   case csingleton hb _ ih =>
     apply csingleton
-    { have hb1 := Context.CBound.there_label (S:=S) hb
+    { have hb1 := Context.CBound.there_label (c:=c) (S:=S) hb
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
   case cbound hb _ ih =>
     apply cbound
-    { have hb1 := Context.CBound.there_label (S:=S) hb
+    { have hb1 := Context.CBound.there_label (c:=c) (S:=S) hb
       exact hb1 }
-    { exact ih }
+    { rw [← CaptureSet.proj_rename]; exact ih }
+  case ckind hb => apply! ckind hb.there_label
   case label hb hs =>
     apply label
-    { have hb1 := Context.LBound.there_label (S':=S) hb
+    { have hb1 := Context.LBound.there_label (c':=c) (S':=S) hb
       exact hb1 }
     { apply hs.lweaken }
+  case label_disj hb hd => apply! label_disj hb.there_label
+  case absurd => apply! absurd
 
 theorem TypedCont.lweaken
   (h : TypedCont Γ E cont E' Ct) :
-  TypedCont (Γ.label S) E.weaken cont.weaken E'.weaken Ct.weaken := by
+  TypedCont (Γ.label c S) E.weaken cont.weaken E'.weaken Ct.weaken := by
   induction h
   case none =>
     simp [Cont.weaken]
@@ -211,7 +218,7 @@ theorem TypedCont.lweaken
     -- rw [heq]
     apply cons
     { rename_i ht _ _
-      have ht1 := ht.lweaken_ext (P := S)
+      have ht1 := ht.lweaken_ext (c:=c) (P := S)
       rw [EType.weaken1_weaken] at ht1
       rw [CaptureSet.weaken1_weaken] at ht1
       exact ht1 }
@@ -221,7 +228,7 @@ theorem TypedCont.lweaken
     simp [Cont.weaken, EType.weaken_ex]
     apply conse
     { rename_i ht _ _
-      have ht1 := ht.lweaken_cext_ext (P := S)
+      have ht1 := ht.lweaken_cext_ext (c:=c) (P := S)
       rw [EType.weaken1_weaken] at ht1
       rw [EType.weaken_cweaken] at ht1
       rw [CaptureSet.weaken1_weaken] at ht1
@@ -234,7 +241,7 @@ theorem TypedCont.lweaken
     apply scope
     { constructor; aesop }
     { aesop }
-    { have h1 := hs.lweaken (S:=S)
+    { have h1 := hs.lweaken (c:=c) (S:=S)
       aesop }
 
 end Capless
diff --git a/Capless/Weakening/TypedCont/Type.lean b/Capless/Weakening/TypedCont/Type.lean
index 98c57463..6b0067af 100644
--- a/Capless/Weakening/TypedCont/Type.lean
+++ b/Capless/Weakening/TypedCont/Type.lean
@@ -79,12 +79,15 @@ theorem WellScoped.tweaken
       simp [CType.tweaken, CType.trename] at hb1
       exact hb1 }
     { exact ih }
+  case ckind hb => apply ckind hb.there_tvar
   case label hb hs =>
     apply label
     { have hb1 := Context.LBound.there_tvar (b := b) hb
       simp [CType.tweaken, CType.trename] at hb1
       exact hb1 }
     { apply hs.tweaken }
+  case label_disj hb hd => apply! label_disj hb.there_tvar
+  case absurd => apply! absurd
 
 theorem TypedCont.tweaken
   (h : TypedCont Γ E t E' C0) :

From 9e2b93dd826ec329654a809ff22268660bb2c94b Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 11 Dec 2025 20:49:05 +0100
Subject: [PATCH 47/71] Some new terms and types

---
 Capless/Term.lean          | 55 ++++++++++++++++++++++++++++++++++++++
 Capless/Type/Basic.lean    | 27 +++++++++++++++++++
 Capless/Type/Core.lean     |  1 +
 Capless/Type/Renaming.lean |  3 +++
 Capless/Typing.lean        |  9 +++++++
 5 files changed, 95 insertions(+)

diff --git a/Capless/Term.lean b/Capless/Term.lean
index b1622469..61598383 100644
--- a/Capless/Term.lean
+++ b/Capless/Term.lean
@@ -63,6 +63,12 @@ inductive Term : Nat -> Nat -> Nat -> Type where
 | bindc : CaptureSet n k -> Term n m (k+1) -> Term n m k
 /-- Boundary form `boundary[c] as <c,x> in t`. -/
 | boundary : Classifier -> SType n m k -> Term (n+1) m (k+1) -> Term n m k
+/-- Intercept: `intercept[K] in t` --/
+| intercept : Kind -> Term n m k -> Term n m k
+/-- Unwraps a maybe. --/
+| unwrap : Fin n -> Term n m k
+/-- Unwraps a maybe, but with an additional handler for intercepted labels. --/
+| unwrap_handle : Fin n -> Term (n+2) (m+1) k -> Term n m k
 
 /-!
 ## Notations
@@ -76,6 +82,8 @@ notation:40 "let" "(c,x)=" t " in " u => Term.letex t u
 notation:40 "let" "X=" S " in " t => Term.bindt S t
 notation:40 "let" "c=" C " in " t => Term.bindc C t
 notation:40 "boundary[" c "]:" S " in " t => Term.boundary c S t
+notation:40 "intercept[" K "]"" in " t => Term.intercept K t
+notation:40 "handle " n " with " t => Term.unwrap_handle n t
 
 /-- Whether this term is a value? -/
 @[aesop safe constructors]
@@ -106,6 +114,9 @@ def Term.rename (t : Term n m k) (f : FinFun n n') : Term n' m k :=
   | Term.bindt S t => Term.bindt (S.rename f) (t.rename f)
   | Term.bindc c t => Term.bindc (c.rename f) (t.rename f)
   | Term.boundary c S t => Term.boundary c (S.rename f) (t.rename f.ext)
+  | Term.intercept K t => Term.intercept K (t.rename f)
+  | Term.unwrap x => Term.unwrap (f x)
+  | Term.unwrap_handle x t => Term.unwrap_handle (f x) (t.rename f.ext.ext)
 
 def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   match t with
@@ -123,6 +134,9 @@ def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   | Term.bindt S t => Term.bindt (S.trename f) (t.trename f.ext)
   | Term.bindc c t => Term.bindc c (t.trename f)
   | Term.boundary c S t => Term.boundary c (S.trename f) (t.trename f)
+  | Term.intercept K t => Term.intercept K (t.trename f)
+  | Term.unwrap x => Term.unwrap x
+  | Term.unwrap_handle x t => Term.unwrap_handle x (t.trename f.ext)
 
 def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   match t with
@@ -140,6 +154,9 @@ def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   | Term.bindt S t => Term.bindt (S.crename f) (t.crename f)
   | Term.bindc c t => Term.bindc (c.crename f) (t.crename f.ext)
   | Term.boundary c S t => Term.boundary c (S.crename f) (t.crename f.ext)
+  | Term.intercept K t => Term.intercept K (t.crename f)
+  | Term.unwrap x => Term.unwrap x
+  | Term.unwrap_handle x t => Term.unwrap_handle x (t.crename f)
 
 def Term.weaken (t : Term n m k) : Term (n+1) m k := t.rename FinFun.weaken
 
@@ -248,6 +265,12 @@ theorem Term.rename_id {t : Term n m k} :
     simp [Term.rename, CaptureSet.rename_id, ih]
   case boundary ih =>
     simp [Term.rename, SType.rename_id, ih, FinFun.id_ext]
+  case intercept ih =>
+    simp [Term.rename, ih]
+  case unwrap =>
+    simp [Term.rename, FinFun.id]
+  case unwrap_handle ih =>
+    simp [Term.rename, FinFun.id_ext, ih, FinFun.id]
 
 theorem Term.trename_id {t : Term n m k} :
   t.trename FinFun.id = t := by
@@ -285,6 +308,12 @@ theorem Term.trename_id {t : Term n m k} :
     exact ih
   case boundary ih =>
     simp [Term.trename, SType.trename_id, ih, FinFun.id_ext]
+  case intercept ih =>
+    simp [Term.trename, ih]
+  case unwrap =>
+    simp [Term.trename]
+  case unwrap_handle ih =>
+    simp [Term.trename, FinFun.id_ext, ih]
 
 theorem Term.crename_id {t : Term n m k} :
   t.crename FinFun.id = t := by
@@ -322,6 +351,12 @@ theorem Term.crename_id {t : Term n m k} :
   case boundary ih =>
     simp [Term.crename]
     simp [ih, SType.crename_id, FinFun.id_ext]
+  case intercept ih =>
+    simp [Term.crename, ih]
+  case unwrap =>
+    simp [Term.crename]
+  case unwrap_handle ih =>
+    simp [Term.crename, ih]
 
 theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''} :
   (t.rename f).rename g = t.rename (g.comp f) := by
@@ -361,6 +396,13 @@ theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''
   case boundary ih =>
     simp [rename, SType.rename_rename]
     simp [<- FinFun.ext_comp_ext, ih]
+  case intercept ih =>
+    simp [rename, ih]
+  case unwrap =>
+    simp [rename]
+  case unwrap_handle ih =>
+    simp [rename]
+    simp [<- FinFun.ext_comp_ext, ih]
 
 theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k''} :
   (t.crename f).crename g = t.crename (g.comp f) := by
@@ -400,6 +442,12 @@ theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k
   case boundary ih =>
     simp [crename, SType.crename_crename]
     simp [<- FinFun.ext_comp_ext, ih]
+  case intercept ih =>
+    simp [crename, ih]
+  case unwrap =>
+    simp [crename]
+  case unwrap_handle ih =>
+    simp [crename, ih]
 
 theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m''} :
   (t.trename f).trename g = t.trename (g.comp f) := by
@@ -439,5 +487,12 @@ theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m
   case boundary ih =>
     simp [trename, SType.trename_trename]
     simp [<- FinFun.ext_comp_ext, ih]
+  case intercept ih =>
+    simp [trename, ih]
+  case unwrap =>
+    simp [trename]
+  case unwrap_handle ih =>
+    simp [trename]
+    simp [<- FinFun.ext_comp_ext, ih]
 
 end Capless
diff --git a/Capless/Type/Basic.lean b/Capless/Type/Basic.lean
index aa3d492d..8968485a 100644
--- a/Capless/Type/Basic.lean
+++ b/Capless/Type/Basic.lean
@@ -83,6 +83,9 @@ theorem SType.crename_rename_comm (S : SType n m k) (f : FinFun n n') (g : FinFu
   | SType.label S => by
     have ih := SType.crename_rename_comm S f g
     simp [SType.rename, SType.crename, ih]
+  | SType.maybe T => by
+    have ih := SType.crename_rename_comm T f g
+    simp [SType.rename, SType.crename, ih]
 
 end
 
@@ -148,6 +151,9 @@ theorem SType.rename_rename (S : SType n m k) (f : FinFun n n') (g : FinFun n' n
   | SType.label S => by
     have ih := SType.rename_rename S f g
     simp [SType.rename, ih]
+  | SType.maybe T => by
+    have ih := SType.rename_rename T f g
+    simp [SType.rename, ih]
 
 end
 
@@ -205,6 +211,9 @@ theorem SType.trename_rename_comm (S : SType n m k) (f : FinFun n n') (g : FinFu
   | SType.label S => by
     have ih := SType.trename_rename_comm S f g
     simp [SType.trename, SType.rename, ih]
+  | SType.maybe T => by
+    have ih := SType.trename_rename_comm T f g
+    simp [SType.trename, SType.rename, ih]
 
 end
 
@@ -249,6 +258,9 @@ theorem SType.crename_crename (S : SType n m k) (f : FinFun k k') (g : FinFun k'
   | SType.label S => by
     have ih := SType.crename_crename S f g
     simp [SType.crename, ih]
+  | SType.maybe T => by
+    have ih := SType.crename_crename T f g
+    simp [SType.crename, ih]
 
 end
 
@@ -293,6 +305,9 @@ theorem SType.crename_trename_comm (S : SType n m k) (f : FinFun k k') (g : FinF
   | SType.label S => by
     have ih := SType.crename_trename_comm S f g
     simp [SType.crename, SType.trename, ih]
+  | SType.maybe T => by
+    have ih := SType.crename_trename_comm T f g
+    simp [SType.crename, SType.trename, ih]
 
 end
 
@@ -425,6 +440,9 @@ theorem SType.trename_trename (S : SType n m k) (f : FinFun m m') (g : FinFun m'
   | SType.label S => by
     have ih := SType.trename_trename S f g
     simp [SType.trename, ih]
+  | SType.maybe T => by
+    have ih := SType.trename_trename T f g
+    simp [SType.trename, ih]
 
 end
 
@@ -544,6 +562,9 @@ theorem SType.rename_id {S : SType n m k} :
   | SType.label S => by
     have ih := SType.rename_id (S := S)
     simp [SType.rename, ih]
+  | SType.maybe T => by
+    have ih := SType.rename_id (S := T)
+    simp [SType.rename, ih]
 
 end
 
@@ -588,6 +609,9 @@ theorem SType.trename_id {S : SType n m k} :
   | SType.label S => by
     have ih := SType.trename_id (S := S)
     simp [SType.trename, ih]
+  | SType.maybe T => by
+    have ih := SType.trename_id (S := T)
+    simp [SType.trename, ih]
 
 end
 
@@ -633,6 +657,9 @@ theorem SType.crename_id {S : SType n m k} :
   | SType.label S => by
     have ih := SType.crename_id (S := S)
     simp [SType.crename, ih]
+  | SType.maybe T => by
+    have ih := SType.crename_id (S := T)
+    simp [SType.crename, ih]
 
 end
 
diff --git a/Capless/Type/Core.lean b/Capless/Type/Core.lean
index d6a5080f..31fc1fa7 100644
--- a/Capless/Type/Core.lean
+++ b/Capless/Type/Core.lean
@@ -40,6 +40,7 @@ inductive SType : Nat -> Nat -> Nat -> Type where
 | cforall : CBound n k -> EType n m (k+1) -> SType n m k
 | box : CType n m k -> SType n m k
 | label : SType n m k -> SType n m k
+| maybe : SType n m k -> SType n m k
 
 end
 
diff --git a/Capless/Type/Renaming.lean b/Capless/Type/Renaming.lean
index 4de9f184..e850b75c 100644
--- a/Capless/Type/Renaming.lean
+++ b/Capless/Type/Renaming.lean
@@ -47,6 +47,7 @@ def SType.rename : SType n m k -> FinFun n n' -> SType n' m k
 | SType.cforall B E, f => SType.cforall (B.rename f) (E.rename f)
 | SType.box T, f => SType.box (T.rename f)
 | SType.label S, f => SType.label (S.rename f)
+| SType.maybe T, f => SType.maybe (T.rename f)
 
 end
 
@@ -67,6 +68,7 @@ def SType.trename : SType n m k -> FinFun m m' -> SType n m' k
 | SType.cforall B E, f => SType.cforall B (E.trename f)
 | SType.box T, f => SType.box (T.trename f)
 | SType.label S, f => SType.label (S.trename f)
+| SType.maybe T, f => SType.maybe (T.trename f)
 
 end
 
@@ -87,6 +89,7 @@ def SType.crename : SType n m k -> FinFun k k' -> SType n m k'
 | SType.cforall B E, f => SType.cforall (B.crename f) (E.crename f.ext)
 | SType.box T, f => SType.box (T.crename f)
 | SType.label S, f => SType.label (S.crename f)
+| SType.maybe T, f => SType.maybe (T.crename f)
 
 end
 
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index bfffadf0..379320c4 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -74,6 +74,15 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ->
   Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
+| intercept {Γ : Context n m k} {S : SType n m k} :
+  Typed Γ t (S^{}) C ->
+  Typed Γ (intercept[K] in t) (EType.type (SType.maybe S)^(C.proj K)) C
+| unwrap {Γ : Context n m k} {S : SType n m k} :
+  Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
+  Typed Γ (.unwrap x) (S^{}) {x=x|.top}
+-- | unwrap_handle {Γ : Context n m k} :
+  -- Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
+  -- Typed (((Γ, X<:.top),x:)) h
 
 notation:40 Γ " ⊢ " t:80 " : " E " @ " C => Typed Γ t E C
 

From bd818bce3f4a7001bb4a57e6c9d109ec50acc800 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 11 Dec 2025 20:49:20 +0100
Subject: [PATCH 48/71] Claude made these latex rules

---
 docs/classifiers.aux         |  12 ++
 docs/classifiers.fdb_latexmk |  69 +++++++++
 docs/classifiers.fls         |  99 ++++++++++++
 docs/classifiers.log         | 282 +++++++++++++++++++++++++++++++++++
 docs/classifiers.pdf         | Bin 0 -> 141236 bytes
 docs/classifiers.tex         | 282 +++++++++++++++++++++++++++++++++++
 6 files changed, 744 insertions(+)
 create mode 100644 docs/classifiers.aux
 create mode 100644 docs/classifiers.fdb_latexmk
 create mode 100644 docs/classifiers.fls
 create mode 100644 docs/classifiers.log
 create mode 100644 docs/classifiers.pdf
 create mode 100644 docs/classifiers.tex

diff --git a/docs/classifiers.aux b/docs/classifiers.aux
new file mode 100644
index 00000000..d710d72b
--- /dev/null
+++ b/docs/classifiers.aux
@@ -0,0 +1,12 @@
+\relax 
+\@writefile{toc}{\contentsline {section}{\numberline {1}Classifier Structure}{1}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {2}Kind Structure}{1}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {paragraph}{Abbreviations:}{1}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {3}Classifier Subclassing}{1}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {4}Classifier Disjointness}{1}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {5}Kind Disjointness}{2}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {6}Kind Intersection}{3}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {7}Kind Subtraction}{3}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {paragraph}{Exclusion handling:}{4}{}\protected@file@percent }
+\@writefile{toc}{\contentsline {section}{\numberline {8}Subkinding}{4}{}\protected@file@percent }
+\gdef \@abspage@last{4}
diff --git a/docs/classifiers.fdb_latexmk b/docs/classifiers.fdb_latexmk
new file mode 100644
index 00000000..25f41729
--- /dev/null
+++ b/docs/classifiers.fdb_latexmk
@@ -0,0 +1,69 @@
+# Fdb version 4
+["pdflatex"] 1765376733.25341 "classifiers.tex" "classifiers.pdf" "classifiers" 1765376733.48149 0
+  "/nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/fonts/map/pdftex/updmap/pdftex.map" 1 5467273 5b0658553574280248ba79969b1bcdf6 ""
+  "/nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/web2c/pdftex/pdflatex.fmt" 1 3353365 7bee47b976ca5b37ed73421a25124f9b ""
+  "/nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/web2c/texmf.cnf" 1 44167 47290b3f99eee2ff9220dc83b01a8fd8 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/enc/dvips/cm-super/cm-super-ts1.enc" 1 2900 1537cc8184ad1792082cd229ecc269f4 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/map/fontname/texfonts.map" 1 3524 cb3e574dea2d1052e39280babc910dc8 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/jknappen/ec/tcrm1000.tfm" 1 1536 e07581a4bb3136ece9eeb4c3ffab8233 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex7.tfm" 1 1004 54797486969f23fa377b128694d548df ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex8.tfm" 1 988 bdf658c3bfc2d96d3c8b02cfc1c94c20 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam10.tfm" 1 916 f87d7c45f9c908e672703b83b72241a3 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam5.tfm" 1 924 9904cf1d39e9767e7a3622f2a125a565 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam7.tfm" 1 928 2dc8d444221b7a635bb58038579b861a ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm10.tfm" 1 908 2921f8a10601f252058503cc6570e581 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm5.tfm" 1 940 75ac932a52f80982a9f8ea75d03a34cf ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm7.tfm" 1 940 228d6584342e91276bf566bcf9716b83 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmbx10.tfm" 1 1328 c834bbb027764024c09d3d2bf908b5f0 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmbx12.tfm" 1 1324 c910af8c371558dc20f2d7822f66fe64 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmcsc10.tfm" 1 1300 63a6111ee6274895728663cf4b4e7e81 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmex10.tfm" 1 992 662f679a0b3d2d53c1b94050fdaa3f50 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi12.tfm" 1 1524 4414a8315f39513458b80dfc63bff03a ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi6.tfm" 1 1512 f21f83efb36853c0b70002322c1ab3ad ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi8.tfm" 1 1520 eccf95517727cb11801f4f1aee3a21b4 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr12.tfm" 1 1288 655e228510b4c2a1abe905c368440826 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr17.tfm" 1 1292 296a67155bdbfc32aa9c636f21e91433 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr6.tfm" 1 1300 b62933e007d01cfd073f79b963c01526 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr8.tfm" 1 1292 21c1c5bfeaebccffdb478fd231a0997d ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr9.tfm" 1 1292 6b21b9c2c7bebb38aa2273f7ca0fb3af ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmss10.tfm" 1 1316 b636689f1933f24d1294acdf6041daaa ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmss8.tfm" 1 1296 d77f431d10d47c8ea2cc18cf45346274 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy10.tfm" 1 1124 6c73e740cf17375f03eec0ee63599741 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy6.tfm" 1 1116 933a60c408fc0a863a92debe84b2d294 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy8.tfm" 1 1120 8b7d695260f3cff42e636090a8002094 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmbx10.pfb" 1 34811 78b52f49e893bcba91bd7581cdc144c0 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmbx12.pfb" 1 32080 340ef9bf63678554ee606688e7b5339d ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmcsc10.pfb" 1 32001 6aeea3afe875097b1eb0da29acd61e28 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmmi10.pfb" 1 36299 5f9df58c2139e7edcf37c8fca4bd384d ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmmi7.pfb" 1 36281 c355509802a035cadc5f15869451dcee ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr10.pfb" 1 35752 024fb6c41858982481f6968b5fc26508 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr17.pfb" 1 32362 179c33bbf43f19adbb3825bb4e36e57a ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr7.pfb" 1 32762 224316ccc9ad3ca0423a14971cfa7fc1 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmss10.pfb" 1 24457 5cbb7bdf209d5d1ce9892a9b80a307cc ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmsy10.pfb" 1 32569 5e5ddc8df908dea60932f3c484a54c0d ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/symbols/msam10.pfb" 1 31764 459c573c03a4949a528c2cc7f557e217 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/cm-super/sfrm1000.pfb" 1 138258 6525c253f16cededa14c7fd0da7f67b2 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/iftex.sty" 1 7984 7dbb9280f03c0a315425f1b4f35d43ee ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/ifvtex.sty" 1 1057 525c2192b5febbd8c1f662c9468335bb ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amsfonts.sty" 1 5949 3f3fd50a8cc94c3d4cbf4fc66cd3df1c ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amssymb.sty" 1 13829 94730e64147574077f8ecfea9bb69af4 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsa.fd" 1 961 6518c6525a34feb5e8250ffa91731cff ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsb.fd" 1 961 d02606146ba5601b5645f987c92e6193 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsbsy.sty" 1 2222 2166a1f7827be30ddc30434e5efcee1b ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsgen.sty" 1 4173 d22509bc0c91281d991b2de7c88720dd ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsmath.sty" 1 88370 c780f23aea0ece6add91e09b44dca2cd ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsopn.sty" 1 4474 23ca1d3a79a57b405388059456d0a8df ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amstext.sty" 1 2444 71618ea5f2377e33b04fb97afdd0eac2 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/article.cls" 1 20144 63d8bacaf52e5abf4db3bc322373e1d4 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/size10.clo" 1 8448 5cf247d4bd0c7d5d711bbbdf111fae2e ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/geometry/geometry.sty" 1 41601 9cf6c5257b1bc7af01a58859749dd37a ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/graphics/keyval.sty" 1 2671 70891d50dac933918b827d326687c6e8 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/l3backend/l3backend-pdftex.def" 1 29785 9f93ab201fe5dd053afcc6c1bcf7d266 ""
+  "/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/mathpartir/mathpartir.sty" 1 14401 0712448ba80da5750b26552c69bbf0c8 ""
+  "classifiers.aux" 1765376733.44858 1058 64cd16951017d0150c99ab709b25b8d8 "pdflatex"
+  "classifiers.tex" 1765376724.8347 7034 c3e8b304751d5bb991ddba01a3e1b8b8 ""
+  (generated)
+  "classifiers.aux"
+  "classifiers.log"
+  "classifiers.pdf"
+  (rewritten before read)
diff --git a/docs/classifiers.fls b/docs/classifiers.fls
new file mode 100644
index 00000000..f38f919a
--- /dev/null
+++ b/docs/classifiers.fls
@@ -0,0 +1,99 @@
+PWD /home/nki/Projects/capless-lean/docs
+INPUT /nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/web2c/texmf.cnf
+INPUT /nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/web2c/pdftex/pdflatex.fmt
+INPUT classifiers.tex
+OUTPUT classifiers.log
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/article.cls
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/article.cls
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/size10.clo
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/size10.clo
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/base/size10.clo
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsmath.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsmath.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsopn.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amstext.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amstext.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsgen.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsgen.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsbsy.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsbsy.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsmath/amsopn.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amssymb.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amssymb.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amsfonts.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/amsfonts.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/mathpartir/mathpartir.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/mathpartir/mathpartir.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/graphics/keyval.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/graphics/keyval.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/geometry/geometry.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/geometry/geometry.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/ifvtex.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/ifvtex.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/iftex.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/generic/iftex/iftex.sty
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/l3backend/l3backend-pdftex.def
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/l3backend/l3backend-pdftex.def
+INPUT ./classifiers.aux
+INPUT ./classifiers.aux
+INPUT classifiers.aux
+OUTPUT classifiers.aux
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/map/fontname/texfonts.map
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr17.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr12.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr6.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi12.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmmi6.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmsy6.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmex10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsa.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsa.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsa.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsb.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsb.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/tex/latex/amsfonts/umsb.fd
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr12.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmbx12.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/cmextra/cmex7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msam5.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm7.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/amsfonts/symbols/msbm5.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmbx10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/jknappen/ec/tcrm1000.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmss10.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmss8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmss8.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmr9.tfm
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/tfm/public/cm/cmcsc10.tfm
+OUTPUT classifiers.pdf
+INPUT /nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/share/texmf-var/fonts/map/pdftex/updmap/pdftex.map
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/enc/dvips/cm-super/cm-super-ts1.enc
+INPUT classifiers.aux
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmbx10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmbx12.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmcsc10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmmi10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmmi7.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr17.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr7.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmss10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmsy10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/symbols/msam10.pfb
+INPUT /nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/cm-super/sfrm1000.pfb
diff --git a/docs/classifiers.log b/docs/classifiers.log
new file mode 100644
index 00000000..6a8c4c44
--- /dev/null
+++ b/docs/classifiers.log
@@ -0,0 +1,282 @@
+This is pdfTeX, Version 3.141592653-2.6-1.40.26 (TeX Live 2024/nixos.org) (preloaded format=pdflatex 1980.1.1)  10 DEC 2025 15:25
+entering extended mode
+ restricted \write18 enabled.
+ %&-line parsing enabled.
+**classifiers.tex
+(./classifiers.tex
+LaTeX2e <2024-11-01> patch level 2
+L3 programming layer <2025-01-18>
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/base/article.cls
+Document Class: article 2024/06/29 v1.4n Standard LaTeX document class
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/base/size10.clo
+File: size10.clo 2024/06/29 v1.4n Standard LaTeX file (size option)
+)
+\c@part=\count196
+\c@section=\count197
+\c@subsection=\count198
+\c@subsubsection=\count199
+\c@paragraph=\count266
+\c@subparagraph=\count267
+\c@figure=\count268
+\c@table=\count269
+\abovecaptionskip=\skip49
+\belowcaptionskip=\skip50
+\bibindent=\dimen141
+)
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsmath/amsmath.sty
+Package: amsmath 2024/11/05 v2.17t AMS math features
+\@mathmargin=\skip51
+
+For additional information on amsmath, use the `?' option.
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsmath/amstext.sty
+Package: amstext 2021/08/26 v2.01 AMS text
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsmath/amsgen.sty
+File: amsgen.sty 1999/11/30 v2.0 generic functions
+\@emptytoks=\toks17
+\ex@=\dimen142
+))
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsmath/amsbsy.sty
+Package: amsbsy 1999/11/29 v1.2d Bold Symbols
+\pmbraise@=\dimen143
+)
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsmath/amsopn.sty
+Package: amsopn 2022/04/08 v2.04 operator names
+)
+\inf@bad=\count270
+LaTeX Info: Redefining \frac on input line 233.
+\uproot@=\count271
+\leftroot@=\count272
+LaTeX Info: Redefining \overline on input line 398.
+LaTeX Info: Redefining \colon on input line 409.
+\classnum@=\count273
+\DOTSCASE@=\count274
+LaTeX Info: Redefining \ldots on input line 495.
+LaTeX Info: Redefining \dots on input line 498.
+LaTeX Info: Redefining \cdots on input line 619.
+\Mathstrutbox@=\box52
+\strutbox@=\box53
+LaTeX Info: Redefining \big on input line 721.
+LaTeX Info: Redefining \Big on input line 722.
+LaTeX Info: Redefining \bigg on input line 723.
+LaTeX Info: Redefining \Bigg on input line 724.
+\big@size=\dimen144
+LaTeX Font Info:    Redeclaring font encoding OML on input line 742.
+LaTeX Font Info:    Redeclaring font encoding OMS on input line 743.
+\macc@depth=\count275
+LaTeX Info: Redefining \bmod on input line 904.
+LaTeX Info: Redefining \pmod on input line 909.
+LaTeX Info: Redefining \smash on input line 939.
+LaTeX Info: Redefining \relbar on input line 969.
+LaTeX Info: Redefining \Relbar on input line 970.
+\c@MaxMatrixCols=\count276
+\dotsspace@=\muskip17
+\c@parentequation=\count277
+\dspbrk@lvl=\count278
+\tag@help=\toks18
+\row@=\count279
+\column@=\count280
+\maxfields@=\count281
+\andhelp@=\toks19
+\eqnshift@=\dimen145
+\alignsep@=\dimen146
+\tagshift@=\dimen147
+\tagwidth@=\dimen148
+\totwidth@=\dimen149
+\lineht@=\dimen150
+\@envbody=\toks20
+\multlinegap=\skip52
+\multlinetaggap=\skip53
+\mathdisplay@stack=\toks21
+LaTeX Info: Redefining \[ on input line 2953.
+LaTeX Info: Redefining \] on input line 2954.
+)
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsfonts/amssymb.sty
+Package: amssymb 2013/01/14 v3.01 AMS font symbols
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsfonts/amsfonts.sty
+Package: amsfonts 2013/01/14 v3.01 Basic AMSFonts support
+\symAMSa=\mathgroup4
+\symAMSb=\mathgroup5
+LaTeX Font Info:    Redeclaring math symbol \hbar on input line 98.
+LaTeX Font Info:    Overwriting math alphabet `\mathfrak' in version `bold'
+(Font)                  U/euf/m/n --> U/euf/b/n on input line 106.
+))
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/mathpartir/mathpartir.sty
+Package: mathpartir 2016/02/24 version 1.3.2 Math Paragraph for Typesetting Inf
+erence Rules
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/graphics/keyval.sty
+Package: keyval 2022/05/29 v1.15 key=value parser (DPC)
+\KV@toks@=\toks22
+)
+\mpr@andskip=\skip54
+\mpr@lista=\toks23
+\mpr@listb=\toks24
+\mpr@hlist=\box54
+\mpr@vlist=\box55
+\mpr@right=\box56
+)
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/geometry/geometry.sty
+Package: geometry 2020/01/02 v5.9 Page Geometry
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/generic/iftex/ifvtex.sty
+Package: ifvtex 2019/10/25 v1.7 ifvtex legacy package. Use iftex instead.
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/generic/iftex/iftex.sty
+Package: iftex 2024/12/12 v1.0g TeX engine tests
+))
+\Gm@cnth=\count282
+\Gm@cntv=\count283
+\c@Gm@tempcnt=\count284
+\Gm@bindingoffset=\dimen151
+\Gm@wd@mp=\dimen152
+\Gm@odd@mp=\dimen153
+\Gm@even@mp=\dimen154
+\Gm@layoutwidth=\dimen155
+\Gm@layoutheight=\dimen156
+\Gm@layouthoffset=\dimen157
+\Gm@layoutvoffset=\dimen158
+\Gm@dimlist=\toks25
+)
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/l3backend/l3backend-pdftex.def
+File: l3backend-pdftex.def 2024-05-08 L3 backend support: PDF output (pdfTeX)
+\l__color_backend_stack_int=\count285
+\l__pdf_internal_box=\box57
+) (./classifiers.aux)
+\openout1 = `classifiers.aux'.
+
+LaTeX Font Info:    Checking defaults for OML/cmm/m/it on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for OMS/cmsy/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for OT1/cmr/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for T1/cmr/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for TS1/cmr/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for OMX/cmex/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+LaTeX Font Info:    Checking defaults for U/cmr/m/n on input line 11.
+LaTeX Font Info:    ... okay on input line 11.
+
+*geometry* driver: auto-detecting
+*geometry* detected driver: pdftex
+*geometry* verbose mode - [ preamble ] result:
+* driver: pdftex
+* paper: <default>
+* layout: <same size as paper>
+* layoutoffset:(h,v)=(0.0pt,0.0pt)
+* modes: 
+* h-part:(L,W,R)=(72.26999pt, 469.75502pt, 72.26999pt)
+* v-part:(T,H,B)=(72.26999pt, 650.43001pt, 72.26999pt)
+* \paperwidth=614.295pt
+* \paperheight=794.96999pt
+* \textwidth=469.75502pt
+* \textheight=650.43001pt
+* \oddsidemargin=0.0pt
+* \evensidemargin=0.0pt
+* \topmargin=-37.0pt
+* \headheight=12.0pt
+* \headsep=25.0pt
+* \topskip=10.0pt
+* \footskip=30.0pt
+* \marginparwidth=65.0pt
+* \marginparsep=11.0pt
+* \columnsep=10.0pt
+* \skip\footins=9.0pt plus 4.0pt minus 2.0pt
+* \hoffset=0.0pt
+* \voffset=0.0pt
+* \mag=1000
+* \@twocolumnfalse
+* \@twosidefalse
+* \@mparswitchfalse
+* \@reversemarginfalse
+* (1in=72.27pt=25.4mm, 1cm=28.453pt)
+
+LaTeX Font Info:    Trying to load font information for U+msa on input line 12.
+
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsfonts/umsa.fd
+File: umsa.fd 2013/01/14 v3.01 AMS symbols A
+)
+LaTeX Font Info:    Trying to load font information for U+msb on input line 12.
+
+
+(/nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-t
+exmfdist/tex/latex/amsfonts/umsb.fd
+File: umsb.fd 2013/01/14 v3.01 AMS symbols B
+)
+
+[1
+
+{/nix/store/0p5xcind9ckmqixygzi1p2yc70hygcj0-texlive-combined-full-2024-final/s
+hare/texmf-var/fonts/map/pdftex/updmap/pdftex.map}{/nix/store/ansahnzp0dpzyg87c
+x9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/enc/dvips/cm-s
+uper/cm-super-ts1.enc}]
+
+[2]
+
+[3]
+
+[4] (./classifiers.aux)
+ ***********
+LaTeX2e <2024-11-01> patch level 2
+L3 programming layer <2025-01-18>
+ ***********
+ ) 
+Here is how much of TeX's memory you used:
+ 2526 strings out of 473201
+ 38804 string characters out of 5689025
+ 441596 words of memory out of 5000000
+ 25786 multiletter control sequences out of 15000+600000
+ 568233 words of font info for 72 fonts, out of 8000000 for 9000
+ 1141 hyphenation exceptions out of 8191
+ 57i,13n,65p,230b,229s stack positions out of 10000i,1000n,20000p,200000b,200000s
+</nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final
+-texmfdist/fonts/type1/public/amsfonts/cm/cmbx10.pfb></nix/store/ansahnzp0dpzyg
+87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/publi
+c/amsfonts/cm/cmbx12.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-c
+ombined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmcsc10.pfb></
+nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-tex
+mfdist/fonts/type1/public/amsfonts/cm/cmmi10.pfb></nix/store/ansahnzp0dpzyg87cx
+9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/am
+sfonts/cm/cmmi7.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combin
+ed-full-2024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmr10.pfb></nix/sto
+re/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/
+fonts/type1/public/amsfonts/cm/cmr17.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr
+1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/c
+m/cmr7.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2
+024-final-texmfdist/fonts/type1/public/amsfonts/cm/cmss10.pfb></nix/store/ansah
+nzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2024-final-texmfdist/fonts/ty
+pe1/public/amsfonts/cm/cmsy10.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-
+texlive-combined-full-2024-final-texmfdist/fonts/type1/public/amsfonts/symbols/
+msam10.pfb></nix/store/ansahnzp0dpzyg87cx9k935zgr1xscg1-texlive-combined-full-2
+024-final-texmfdist/fonts/type1/public/cm-super/sfrm1000.pfb>
+Output written on classifiers.pdf (4 pages, 141236 bytes).
+PDF statistics:
+ 78 PDF objects out of 1000 (max. 8388607)
+ 47 compressed objects within 1 object stream
+ 0 named destinations out of 1000 (max. 500000)
+ 1 words of extra memory for PDF output out of 10000 (max. 10000000)
+
diff --git a/docs/classifiers.pdf b/docs/classifiers.pdf
new file mode 100644
index 0000000000000000000000000000000000000000..42ad763364b5dd31817049768aeee8f51f1b28ab
GIT binary patch
literal 141236
zcma(2Q>-vN)V7OGKGU{s+qP}nwr$(CZQHhO+jFk>+k5{<>r3|EG|gzzlP1m8ao?jQ
zkrx)FVW4G!B$;0xS%+l8r^mN5w1nj5hNP1=u{Cox$7f(>V#ELcG)Ov83u|W+M|?U_
zYXfH!VG|=eV-rYTUPvcrM-u}ZNcYVebs48ER`{MPwR`cIWbpcTRnnVfS0`~=o9nEb
zAnFAar3^=rO4&ajG!XIxMB#~AI>Imzw}72CyS>Xp)8_-GHHamUbmWN{qd+vl7U^Wh
zU=43(IoqYFljh1uu1VqE+EI+Mc-g6rz7NghCridz5S0s++tp+do$ARSmp#_0Zp^(s
z?~i+pLNS4M`F(EFf0%I@ro--j*4YgI8qd&b%rkV?u4bxttDWp1qzxlf^0Nstjr~de
zN7!aOKHD|<I=B*Ke}X)7&VFk*F>QD2)Q+H~J1d_${P=2m#ArEjGZ2I|Vsf$K_{3OC
zB2Y_p=pk6u%>+vCb)!If;EOu+*rPNHH*INTct>7~z*DT-a-f?f`oywd(Pl|ahVhOP
z#dm8viV|l#5k|nKeL@7rK!Dg}o@t;cyfuz(5<PPV;Dv4=<|6NR6wW*%EWk0U(HM#n
ziBz{<7@`u_Z4eth4{T;e^Or;zOfMX7n|eK=?K<1JoXs#C)=S2mLe5RMK#3zgsoAB=
z2fKkA1V2jP{qG_#z5BoHvIL*M^v>q4x+kUF`Z@Qx>V~BJ#22`X-Cq=&8$4d`$3Wqx
z<O$pjF5se9r+28?+|@d`s$X7NL+z|0;H%;8>KclP+(Eoxdih}YvykYuu6<)N41=?1
zNNtH&;mZ|s=odB|tg&kSk8x!^Ns$xq!~Cld)*a2$_?sEO<d@CYEvY8}M4<TuQDHz`
zd6<dd7g#T-2lp9E7>e8#ehasz#Qy4e;BVZ4MS`!pqSlH4c3s@~W~*7M3o`n!<GG%J
zlF6er<8*CNVN(W6$6=J#YzfU2-*e`N4%D(?!t#_>q5jU>vKID;-l9pN0V%-Oh4FW(
z8#k{loW10dIC{Sl<p&d-bu&}s2w<2sNY{$^MA2l9ZkQU|gkb>Vho&2M7JA|Y>b9x=
ztUI+ovwj%I#6%+0B(NB5aFw&d<{@%gbg!IBFVSz&S6P(IlJ@0hNfO87HXNDgCi!|S
z`hd43*9BPGLB~?iRiKqlE#*S#Pn3)ulV}aQg2zd{{CTM32py4QtDMp50+v!PT^(g1
zP+-dw(Xr5f*22PEe&rVQn<2l;o!K6MG(cA1MwbNN&tcJFq`JDyZ#RdQtIq0!UojNb
zd!amoTgVf-;@M*W;752P1xekYJ?^^vspR8oeoz-xuXjHfk&~+>GPv@&|NO&b+Vc>j
zvBGP)BaZi8ustA)s*Qq03?r!t^!bXf&BgZu&bS(OQ%tKQUsO{f-7N~a4HkP3mc1ZB
zPxuZbUr`|WXlK~q+=m2r>j&j1o#hT?v)knwg4^=`p)7&JAft_;=Mrdb=7{nv{0jH|
zMCiT;e0`$Y$n$4sT_FA9^P;G)zO<>+Xg!2Za=5BSC?y84;kc~3Abhjx05Yh!H8y6&
z#li{qythjrKL5eNUnc1Cl7{u5Q8zX!K!6JoJMQv7xl9IB2HbYFj3~T39Jy>~4d@0T
zz?75KC=OCd^#{Naty~^lO<imKwnxi^tt+)>)oc@JJv?z{ppA8SgJlcN;R!1SKQ$ne
zKU2etfGG{rkRpUCE^iK6EQL3*lFlx4(ezKY52i`?lI)!c_`;zCI(@IK^J*!7^RklW
z)IK%F&c!2w5k~c>$Oi^a`;o>nKC3AB=ow@XNvxUZs+iF~M=7aR6#*YP<D47dO5gpP
zCBn%lAU>MTg{T3X<Q?CqL$JHuL;L!*UT&Vo(P(S_xYL!_6wNV$a&mC$VVYT!Ezi2q
z#tpW!c3w?3zx>58WS<d~<9-%2==@`-FjpO#k|TTgLas85D8$OHr5_T4Z6rGh;>MEh
z==;_bdBCRQk$sjO&Yr$`I;K!mWT)9rgk8|pH9=dVeAScuSB`>%3_@Gh8N`Ja{RiM@
z`8ft@Vr%^W<Me;g|1h4B{(pfz69dQpE$nwR{)4?J^#8z~d`9^m=<5cXQN~7&?6suU
zv(ZW3xK!0jp`v(rrjL$15s{*fe8D)og09s%P<{V^M_=vBcA2Xq9^K<URGRq{IYEqG
zR%8_F9y#W=FzeU&-r)K7IMCX-U+Y4V3lxz8laRcQk!rfSn9@TjKRQlQ)Xu5sF%h-;
zF`--!ipomCa)k@;<@bW1kAg6Ie4{190kivg!FaXn1HX{V_nj9Jzb6WJt+Yv;5`Obx
zEbRPk*RID+PJrB71K4~<A>o1&Qe9*~lq7437$C(6**ZW_E8Q8QGzm)TdIzhh(Ir{>
zuXWT^v@aW`?oh6(KT?Qdz+PVHgx~$Ej}SNs-$%yr#D)e9nticFdt4_0fauz(J>Rl@
z-loLOBJD`$-WGKq*fMtfA=B7GDE#Uo?~Q|qIc(~RLdZ%oUR7U#i3}uvYHvP>fbin?
zgt-F?x@6_2>Ef~OgBe5ox-QYZV>-#c<Q{}e=pP;vUeOp}$8WY?TIHYHCHU9Wb=?D@
zEZ_LA&TR^e+D4I9fe5|}GIj|gXlNQBv<BFzm%ZzrCgAKXz@ssZENs&--rW(gl)DR_
z-_)-gpRB`s=5KhD*#x&2W5%566Y<}4$pv3@+SEl2KMGxH8DNV$#A1iIR4M2LXNUbr
zw>+1lLdr+N7a?4_+bkQwe0={T&V1!?vj1Xogog(!cb<=~PuFH%;3J6S)hLBNKIjQ}
z^q6FDiZ;iP4W!*(up|AoK&?~!3U;l~59>;5b?X+e^WvDi8lKD!0ff{5O9`mWAWzv%
zp<I*&vbkb{WL6WC%SbaWbX-%Wp(YfhN%1%kBFlm~xN>b-l1a=i$fMJKvxh1lcw8iK
z&DcssI5apT7xXt##%xj*Ja7)k%vA`vy3kK5PlM@|Ft_Ks$AqOGbLEk_IUik#5N`j@
zy`m;ajmgxu_Lsz4PKFK%$<dfoUo!-aIEHQ1cj@{?RMdVedChJ?@3>-o3XOXHB4S5&
zcEvGlvT8-?qBfp_Tk3izqW*-L)abxD44zi5aG#KX)c%J%sYKlz6iWaGZoRtPz&4s4
z;L_gM{$?=0gt@fSiHF$43Yd{LmNr}M<N{uQ%Tmm)gZKhdLgIFN%N0mPOx3A4j*GwX
z&F{CvhlvAPHo2z1Vu-tr)_Lop3fPF0tiMtv)I;Km|0Y`~Ewyf=w`*f9(nF$ww?dmu
zq?Y7m&>_i?7vx<RydBBsKbeM?+9&qn^9*s6$SZ(~nyOK879>0S$3}C7EzzVmv6poo
zMWIoVciUo8<Ts?JLdB!sA`>!6DzHDulvT{~n6guT9IECkz>i<=UQTvWEvlM{bm5}`
z$eodNVP5=*L#UorqeL)T@RbN>1rJ_;t+ZrX%aJ<+w9Ojfzt83^Kt(LInFLPN?z2DG
z@Xw^MD%+JU*Q6-!{lz+oF8R9sZWb0^i5rEw_<U+tLOr?;p^Y@|e9yTAMYKbjvER?w
zvKxm@cgtucr4wDSTkX(dB}B^Ke%Z&Pi~r92FU7M-F<^u(*gnpQWk&@+e+xP2y?3*#
z&zNqIX6lXaGNc%nrAvzX_i0t92DfZ#fcr+&rsfC#Y$nrUh(K>Na*IpGKMs<`T=}iV
zd8&9t*8tgr3jZ_aE@-F}Xq<b7n(=$pc*tF{K+z{^bV?Qjiw2LENIB`#jhIvS%<03&
zlhd^e_9(B9lPCT3-6tB-3l&{YI`E3O@HX3UZ(bs}*$y1zKj4KZ=hOcMyZ>8`&C0<3
ze~aB4O({DpHu&EEuxnlbF9d7$ZV!(Po(bTgomo!C1vaLjfYzG52^snOHCx-f$lHFG
zLWA5x94HOLfoIl>@pyD~ay_EuC|Ja7E<o*v1{=I2NqIE<nAOhS^c1qnZ-!^Px_1h7
zbbh_#Y5Tlk`f}gixx2kxcczzmr`HWi7YL1NZ73W8YJMSLXG8s`{va2_(WNmraN?Kg
z`&HlB!->wwX(s-pI9}hgJR7#7EUS)@{V)Mew_w>Yj|gllc9DZKz0t7fiQFNOwyAH-
zOUI+I<t(2LOZdwLF?w3&h4K`mv&5QptuzcB2kv_J^YXLvhL^Q+gxWlVswCapI~CvE
z+vDlo-Jy($ariWRcs=9zx+dKOL(&WYmk0!56{EZxe$}-xf=1H&fVT%lB6ELu=X{>S
zKU8%l*LL`Hy|!^hEDsreE0d7$ua(N1Ll1x-r*%_Oq!Ze9K#vCaR;)Yn+6bX3Z3_Xr
zF;`4|+g6@mnzjE1^~JVFqr2m)_v6e67&o6--j3TD8cvt+Q{KMuJTP_iYdQqE3b`eX
zfuG$LMHV!i0`QTdQ6kD;kqjZ0JV7u|xO|FhiQ&%rZ{A$4>^m`sSZaX;jWw}@9=W{`
z4G!8hPje^i;nv7yq9mH0xQ9$&)k#xGNz{C(HHGd}*kHw9R`UupAuSnnse}+kqc36C
zK&-HgR=5w#nIZ9{BKL$t$a;Kkq;_PjSQ6sz8-icQu@!W%c0o0`o?jN?&hn5h+Xc+^
z(`II;e+-?=LK&M3gXcq+dJExMmO-uJl@@M&xl2h%?)mw4$YCcAL>h+2!Gu}ht+Wg=
znafiV`*9vsx;D}jFcc`$NZgiRr3byEYdz$cUd$27p0{^S*79+v@}3>dE4dpT!XP=g
zkS6g>QJ_M^GkiMsqS?k-OCnDSbUjnR<w?QnUqDhM1sYB1*Iu$f@M3D#u3^AjGzn4A
z748?!)EyG~Rd^ga@%;b<4c9T2542*N{qU^v?vRS}ODdnRs@^QAnndX=&JcU=MJNaK
z2sb<#mUN(pX(iO@K|3_7OTMaQ8LaZ|FkyYDg(wFXXuX%xPe2T))5uWXY54e`s?YvX
z@JkZN*sk(laIh|f206liV&!6y;PWZ2Zh@3V{UYc>6>l@C&M}Qy#Ap1@QpRT<Kg&+o
zGZ_q2TkB>b1#E-{UPcM`5%*UQ7jtq5B>hgtrT?3F5|~@W10C*qK-o^8j1ms%y`F7_
ziy%%O*V0b?<H-LJ{wPrL{TDl9Ng@r=WiOrPgdT~PkbYF#QqX+66ki9kqostPNhGqt
ziVkME)$`hq1-*!3tO%%XQZi71I0a*}V=Yl~SsiV3n;Ex-ULGyBN^Bcoe80^9Tfc(s
zG^Rq%#RSl5O3=*UGA(P2ugxfm@*1c+1s|1E+|CXAfKrm0Y5Me_vJU(!{Y#}1pY@_H
z63GMeqoq8E93`qNevK<^PXnh`IhWseMyl2;g{#!qiOxDyVuR#Nd*0)$_jld;OlQvy
z6V;!V<c5M41ZsVCd>Rsobp?@|WwLU-s*#4%$#Tl_G%Rr*JFd`>7FWr<)SK6d^)&cY
za)nG*#EDy{MNIGq&1J>&?LgRBC3zMUkW*Y}om$(z1lW8*r9~8QdKTIF?bIT>c2f=+
zo0k0L!ga79i6a8s9Z@Hx^Sm-5Jt2u1(UtSO@?<nO3i2t~RRV4mJ$rz@Epv3#*KA7j
zS1(W6=q^P$^Qsh>*KNLhm6s{y?Y_e6i+J-Y59R^&+*Q#{4!B3)RuE$WB7ZLn6WXUD
zxG2Ce@i<QuMPBFLgVJYI(cPP#v>B{>BwW`F$O$OOP#h@4VJ(A8sXt_7;VI;`y=dT~
zcP0H^W!9OU=c@>|Ry8{eGqH)k=~$l!uP`$&Tfwto>?Yy))EF7;YSD}e6LHvHInuP$
z5f-+u2#1*c8n{lsa^6B_K00^y3vEpa$NmRas^NDA{epb6*C#TECQ<B>yjzy5uJl_%
zm;0jhc_U+Twi$`p)<^ebOfig~6K=4>`96Jmf_eZ%11TXov@FI$Hm6p?vGaWq`xapF
z-&3|7$taj<8PxF8Q@W+dh0@1ELPwkP^msM6DleTn$#<i-dX1q^-P6U)!Qeftu}s^<
z{X1G!Nk+y0aznBHFT#L><Nw+Py3vyQ9~Y?i>wkoSFt}^L$dF8Fl5?U3ZW`w;#l%3v
zvaphfElEere?CyLcmm>o{lt@$W4KVpzGHpu?FQ1r*W>lQgdqZLH(!GGPn?<*wK#r~
zH0|j4XMd#aYU9SylL;>txpE+_>cgEi$B!4!x7+*YouqTI2)|~YH(?`)E=(527Ig@L
zlj9v<!c>l&oF@Pu-sN}LkY<Tg)V)euy+DJIglHcwrzWrkTPIOyu)Mh06n8bdr=9!j
z3tGKX+Fx%(5a%u?SVX$EFSqB9Jc(h?D@VNGeYNjmvW^<H_^3+b@%Fl{>1;qyOR|n6
zrJ6aS(l$A+LYD#4ZvMUT*1GZ?wWM%c5wAEIK||L4g3YRsRBdo07ImzBWZ^E|TMCbe
z-w4g8wlFKPQr+Gc_o3S8kK=lzC8T_|ccir!<`36F)g9elcZSalqVbav0*yXBmh6e3
zbHK6_63-1G$pe12eVcfWaMz(4_Z5eFj)?9NXyCTDoUr(@P>(QE{UDjr0>~QT>YrRw
z+~*<zo7c5|u;)(hSW%p{NSnJQs;Vd6UcPk_*s?EIzO%5nJ3{lDS`Ym7aotmRGJ+*?
zY8$hn_Ay7<Dn#z*v&4J-!efx6cumuCp`xYDNq1r(H=h|wpD@b_x49^ZS*3>Fh8)4P
z`M~K_hvz8aDEQGU5Nd(FHH1+&efMp8qiXo3_5E|WNwBl89D-zBr?F_x%!}?YB<tE2
z{1oK9v*WNL`9|n`m=#-LXJ;#t{t1eQ9uBXKB>B+G=4&D%mI7EQ$dhquf1DZa8s)d`
zOeRxz*AKJjgH1SldoIscbGJ^k5eZ^=&e$D>1sS+DNntDeznBS|Z>MHcts70wfXkn_
z%ouSA3l%t*_)Yel%d31dO)*-Aan;k;!*ovda6@y(<;kmMb?}?in#;?4D+Mr>xapkC
zt9{-qsv3~`0MGglQDw6%HZ}6ilc+9MVA^wK^glvTVt(`q&wI%$XQl*vUk{>$d1>Nw
zJ&Xx>f4ETbbbSw6mws&tTrpxtg%TLwG-1IO0>sm2VZjhzluvsbg32Z<IYDAtLh>kr
zF6J!MjEB4a>#7k$#;)+eYLbJ1*CFeAw+cw3YOcWiU=C}4Acyjmw>kvopgv#n7AXeH
z{L)}*NSQG}1=`8<X1bpR(3K_Y(zW0obRM*oo%5QhNrrPe3I2K5V4GXAelXJI;2(HX
zDpG>mmJ(0;^|}vUCMm*FHf^A|fnUL8(;&XZGe2xX@wwKEp{9`H+E^ZvN4pproQzV4
zsw2>45)eautkd9+A9ao9P&9rzR65}t_O!}xh+s2Tg`vE6&e`1d3WjK)n)Re!xmRV0
zVOy7GPA&nHslr_20#6k_SJF`!G8aB0vzv}_3wQdb)R+2n;vhmrJg2is*tpC#Vb8y?
z0F32-Oy>pAxnB1+w3h&Tt+`jv>>j*~6ps!Lc%fQRoZJ+fak(F#Hr+(46imHinYD1|
z;c#c8T=D8`%x^Lu!P_|Q=Xn}~1u+<J=$oCwShGA{+D55SgflgBJ+4D<JWzMslUuSr
zMA=2U(YaBUM$T)YmRq`622-01cni{P26AlCgHo0ZkZa!)mOSW=O}P42GJ}+tMyR?Q
z2W}F!%2<w0ena=T-dzYQ8*O9+Yz-FetJ`hHOZL?np?xvujEdUe*!+xwt$}m7-!6^m
z+>sUr!9Z;flc)EwREDD}Ygsc9eGkUIO_|hTL?z4m9h%a0Y6qHdscm_I(E~5`AVC}O
z|J0`JQ*uI~qO1%-)Lr0uE5ht}=-aj$`cSNT*GE^lUr%_B${N=-QII^MrtNrbW-2Qc
zOl&x&1dOA?1p+FPPZ8sDhX^Oza}P6XWLmcydH^Ycr}LIR*wJ}Q_rizf4>*76h7d-U
zQ?kMq_t26C<ErfC*;_HPN{=-+*b<~2E!Z03NN%1l@z|waHS2DD+R+R(ZXjzu9GS4{
zfIs)>k~~mnll%rHW+o14yBv7BG-=E5h|ebowdi9ugRP=Lu1krU=N&p#?=4%qE!_M5
z8NhdS6tDEtd1At2my$s=F8N>j^ROYcWj^Jg(0aV%x((X;jn+!FRwRp2jU$Jcb$UO%
z)IAdHO;V*GnmeP-cZXBjQj*mZyrKYJ%~(>d!WthvSb$@RpRC~JuUe2{@{3aJP2Mh(
z?o{+S*8#bJDnVe(6)ej1VK~G@ACPm_R#gHOX(OU0rSIj~XBmz9eErBI0|u_F5Umst
z8<z+$F@`-d=S8pi<;L07sV!AU&)gQ8T?Zh5V(jPe|4RzRH+VhyS!FZPT2-GSY<m!e
zDjFU&>YOF#6QN3RtM^LnLIgapZlX%6RI4y_D|$AoZltK~E3PU^7GX}6Kw<E2IMpqE
z0YzA1@JWhLTHRRQt`l)UEqo>U>^xDK8o@%T6Kb_9Qj72s43W{DF_Azfj(fW7J++5|
z>@F&;vx(mdfVW+Qu>U3RLM@c^$`&S?A@?&cPMM2RmF9jth|a7C)s$N~rnhbN!$zP8
zjr@?@8;O_gH@ZAfbn*nkaLw5QOM_KbT0}>T`~%vo7rSVFpN9^sA*H-4`U@$2Ua=xO
zx8eFLFOC^(zKJ-VxqB-7C?{kwN<Dc4M%w)bkDSH%!jlwiWchz52h9I(*N_39ft7{n
z{}hZE@fjHCnOXnO^gp%xe?oi)Mh5!-uf6#Hzmycy3@V?kg-R3MC1r2Ey|bee*u^r>
z&dhv^3Vtg)56|5$RKGvK(vCzeZa;H0IlZ0nSLa#Rd3n{;de^kZ+nju<S)Hh=4;7ES
zzLArX6e9$VUqe|kHvzc6zi)c9zb{x&veN402J#~nD_8{;*uD{v6Y^_700RiPqi4d%
z|E4CSQqROcF@(@R0keOMba;$*xDR0OU=RK~1rLn?G!DRXQw>mQ4M0-QG!7G@ig|qq
z+|bnE;y3eDN8~?{h|o_#K0fzY#>Kw~0n*R}!U?P#aNCMswicbrFXoTBz6g7K`=m#J
zE^PhZ&VtuBdb+#U{bg;f^}}P(iJ<zYW_M8YAsm4PxCK=G`85BP1LpAiwT*@fLe00f
zIDJVKfVR560SWT^s|6J0kc@BKtc(n8K!N~vn}V5BR08aF`e*+!s(wuQgWkWL0I+Yc
z|KZ%)-SGi!aQt0BH#dWDbpYh}TxZ(=th&bH_iJ&Wu)5i~p#scrT*3+E7h%1x;GIJ>
zJAr6+V}5IJ!sC-w00Q*7zPtI^rowZfxv{abagFhL8vhYZU$IPaYDom;Wb@D7+LHS%
zlNo^lYV_`Q!F}xwx!C{n;`sW3(%9nA()e2lO$meQifziN0uxs_waZdNnDjGd#dias
z0|Nu&%L4#7h6M1?+HCww;NKbpeJ)FUf_t!n1N5cUNArKN!paBWvYNlbi_F8CM*^`A
zbN2`O{;hbo3m%++sBdg?22=O9zRp(oMfy>JZv2Jno5eFcgP}ikFTo@8KZ@JylOwHz
zZUW-s`uraIo<nG=vZTNor=tJcdF)G3RMfZg$D^Xd^G}IN1MZ)g7z5t-;{o}0!*<Ev
z*>m|GQd`)-gogjF+FtYeRGY~4bMim912y<>0X54#m6HHK=pXz}dQjTX<IB*;pY$7_
z&hMZ4uUPUQ)xuvJAqSk;7~c!DAI7)eGd~%ZSY98EZpPKYZzpKw{+f>cubvXmyj~R*
zsB815UQQv`y$c#~jt%yoPmHUrqw6j{l?#`f)K=g5W199^oQPAi)4z(Ko$FtBO@Qib
zZ0x@xuN_*cu(h+Ho0KHKO8&a3r#%Xj9GU@DKWmJ&tKa~5@OiKkm+`uAwEeM<&RA9a
zJ3b9)eKV(jU45MZx>-;F>OlnLe$vTtX#KPwVdr$j;QDDlY>3BT^}v5YAOP2>e*$%>
zsehu~b(~W5M^;FGiQfxQT`PR}Wd1nMaN{ugZ69FAfc0Cyz`dv@Z*cFJI}d#KDcje7
z;?JG3*ZY3`Yx42`GuZz5djq(>{TIUW`~vDBdHjMo_K-gQBK@wVXnFGE*TK!@Nj-4J
z`5o}-alnsb8AmiW1GFOhn(6)3KGmuw4oA7z2|A~`%F!hytk^+3jvN63GsHBU3Z4Hu
z7G<<4hO=@JOFhsu%sAY*Yp+3g@bQWi9V_}v(nvgg)&-k<t6&RC8W~H30X7~luHHoa
z`kkx&?IeJ$x0&COYzD2x1wy|RX?N58dEA8oMxio7fbzopV)33VmqTHycHnFnB`9%f
z4nggB3RVWctu_{yW<T3acUog>V*g0$qexCnR{)YdZ0GyHuyq{SoBOI&v2f~mfnR{f
zKujFaJ&KlD`jEgWrb3|pOi3BG4W~VQ5F>%6>${T6Ra+$~gj6OA?xr$BnSoHf7%jP&
zcx#*vV87Iqtpq$jr@)N=9<-P`u2HJ25SyHKl(-4J&8wJbPJAh-N$-13e9O+hbY}V>
zBZG%@82w4NC+tHQ*}0vBIri!l)2{=OovP|D(-5jrqO0ohVPdLPLC3G+I7D4jzcypO
z?~1QEPF=xW{q6CK=t_F%l;^8#0|@vWE(-BH5}4eWJCoaqXeAPrX>nhBH&9YH)d@`C
zQo7Zq+oqWLM!Qo-?f@^Q_f<WGgr+jFwVyuX=t#KiKbNuKR=>!TPn3lVH=5=>bN#7?
z*IQs8;W+q!Sd3N(7h=hXF`aURV9dfKL-~Vmq_WQ>1K~xsTp)NQPnBR`cAR81!TZNL
zQ+o?Wb8n2#!lC;BO*YrJ;iQHDQCu`X1zY#12ne~kUrzMWxoK+wVkU>&ebMk%oofos
z$K+7uv{LMuTZsW#<|_%3^BUh$yu&wyMG00xl}#pa>?mw&k`j4|*AybbTDGwa6gL&*
zVrHe2pq!jOQ<`vXhSjF9tq0AWk`_tc>mSV%->5vxqJ1RdoP<JxHW(3i3mT9UZhH0X
zEau2a6Zp8?iIaCr!i`fXwym{cEb-$*)ddrE?HK&Dd^x{MsZ<Ze4X=<xBx969B~JU~
zMiU;TpmORnO=8a{f%kxDnz<Y0d@OP!nvx`xwz%c954}cM=8fS`acXGENg$Ap#YPr^
z0>3C{4fk<Ut|Sq?{wdpVF1bBkg&6AYHI0}tdmrXOvEc0CyXHxgnUw-0UP~PGD?^pE
z^$YkptsLH(vY(A?-^BipirIUE+!s1sILTINZsWl?Cc@l1K6Kn6eEKg5yPU%!awh(#
zSWrJs<|k%x!YZdKsB`E8%Q$M3@AR#ibyf~#co{i~qEGTi@o5i^8`%2MLbrWJrHktK
z(oI`YjI}C8Hw_h*$Faquyqv&NrDXMW@Im!(IU-hh+M6uJ*oT$=3&QtpZC(29s*H~*
zyi~zKqnX*2p<R+Q61VF7d@7p{2_tJQ%Y3*S3W>9SUDxXB$cfnTv>ra%p7DaaPoKk7
zkM_&hntw>ldKkNq2up@%9kWXF{WTcSr!iON)IzGnv@3A_J<~$!a5gQgw>j9BGN$f$
zheK_YQqY-=hMP%fQ>9g?-h-!LdKAj*hh91p7<g9P(K}FxG*t>FwCf}0qF{L~>@9ff
z$z>FhAVBP2yD8hrULuy>eFClnjfEFIFvdN3nnE%++73NEFk={q4qEqX8S9TL<U65#
zCD}HqV!g_q3BlfiMZK>J#E$@;2wF~wq}tqG_)cift!?`QxEVA7)Z>|q5{=DCi6ywn
zW#zy%DVGK>Vns}jcv3{1jsAsvM{}#0tPCf{&FA6|%;zb)A931bR?*#RDrT$W(2%$x
zhyIm*ge3vA$*?4YL@GoEsQzA$T_fNA#Ol@UPH3=Rtas`){+89gy0Q|Y{!4BQN^$UK
zk-@npCj$&axo~o!w#S)F5_D&eQw(7WT<)(IVzWwy=^t0;?BICa8mu9hYe$Zc6q&lb
zd;4xn!x*X!uFoMc3Br=g#1KGgHPa4joAzFAa~Y3>)N?+pv&W-GbD;o&)Y#)d(}by`
z9*so^D%Cn?N;@NO`}Q-#TL3PkQMyVJ#ZRDtSQf|n0v+rG>Az?w`}h(ocfijk*M=Aw
z-;nP>Sf}$}_u*Om&tFqfYjDXg*C%Ojq2BLtL73?>LiM43><c^$at2Oo`}0PIMI5c|
zk9$C<R{XQ)-$fgZ?PAKwFZc^GqPqr%JIga(3$;s9OPelN)@rIQt{#zBs4kvTdIyuI
zlZ5U;-|7;x#67?;)<L8liI;R03d9jT!x2<u%fKqnIJ~>LNww^3&@uKVT=l)ZTNLiY
zG%N#>A%3+VZ2rH<*P)$UJd_A8ewP`ut+wMG-l^2~1COZT-yqW5&g7i+liTHovZf@I
zIdPp14<iY!Fiv|@Czfy0RWLwyNRV{u_9iCM;9G%4auyLom^noOT=c!zJq7NlHd%sn
z05d>Q#*FPE7^tLz67JzWLbD@IXjZSay}LDx$eBGyli_9_G^E;hP5U9I>wMoXQ<CM?
znwP6;fnFvhcByCvAG>AHL6>CA&0W#Ca5AsM2$e2yu<KWD;a&?Qq$^a=lQc)GV(A9c
zC8u|3yKic;>A139Rl!AIdwiQ}k;Ho}zR;ugyeHK<M2E4GNX22loO9yOU05;s(2cfz
zyW)%<6|zyRLiDh&T0*o%$C%R?6D^x7p^l^cFBz-$%)cJO%beC5dU>uBOgk8FZbZi~
z+S~$6nYl?Bu?N}b>0<*{D5(`cR9>zL$&1<bd_kll#a%M=rjW5nKr0~{gRth6xXYNM
z9tY<BVS{!}el(IR*w1V2M`>l}M_5Og`5hLRPJ>OS$6ix_9o2+iL>64^nv!lmig(JD
zY%>CQ?iJRWxZd~@P2H~&hF7N9w?!LlF66ZLnQ8P<f^iKFO@aMe%rg^K%RNIu*1~Z6
zcoeCa3+lZxo-1wC7u>W6#=j@aFj<)Z*WXeqM+UBC@!;`OPWb-jFP)(<?UoEe#fVr<
zt?VG}Crl!WjyIhvYRYCOS<YfSPB?q468?c4Y33H>S^Ya2TN8j)m%S2NnKXq21-ok}
z_tKVFdW1PCX>A|egnxlPTPBY~U7^M1AX%|*$gCJx`!6calA4S-hTXZcTjg>mI91S2
z9RRggL9HX-p|_p&g^H;Csz;`)X>GxxN(mE4rlW@sp0|6#p+g%XTZi+R<*zIfd|Wjz
zDraZ(s(Z;tC*z}7LZL703!Y|WNdpymrS=8huBe5n=q00tb1_}SsWyVJMr0|&IRK5d
zwNe##wIJ@&Xr*Fp3|(a=k697{a)ICGTq89+O1^nwl1}!NFcerb(;5U*u~HDyW;nI;
z1suU1UByy2dqq$?3;W8&1vaMg!Pzv)@kDsan_oIe;YwlneAgZ_U!Vq5%gioV$@G5S
zr(g$mzmm?iWjq_1)gvtE(og8Fdf<{|dI3?y`xw?S8wd_1i%w~bsI<w{T|sOfpYI5{
z-M^W`nfAj|V`F-Nb@O-Rf@JqG;YM%h_aZNW(7Z@6l~m|o%QhwrH(#Ws8_s5bN5kFe
z+rrX*qRnQFqhAPK)8A;;hUv#)m)gAEo7_|S>X(NF{iVXo(dTw{ZwCto0`yD@5_cB?
zQkvNteWU_+fL}h2<+$gzrLM}sVPXfoF}e}d6*2|^<BMl`iNI|vU`aDv8sfP(6@%$%
zp;gH^hx07%5QV(al%Xo?eqM<&?e+7f+#}Tk)cKK7=I~aJoZ3&`*6WXD1o}rDk_L(C
zE=YO;4P8;$&H<Lq=<BSZ_+t=;;;Ozo%*Y*Y#<l1o<q8SAH{x0Pv_x76{u2FCWIb;Y
z22ZKE8ko~%P&ca-Qc&uQs@p`d!SctkywQl{8}a!kuhtMZb>rbkh-q;^i3k{uz6eHd
zjU{>U52F`Wg&9qC+};#VLdeW@sO!UH(%~DodZ|MR1xgS&Pi$F!23Qr8;;$gMHkLOg
z;7?ccu^iw-x8?Z~5*c}&T*zSfQ?EA$te{w8l;(wSu}TvrI6uo{l|FZUmrNd~2<>G7
zHd+_+Hxors>{{9YF@E7i)oZ*7RQ3v~n9E}^Sa3h#Ja+fSpF9ySWt)gX{G=KHm)?+D
zCW*N^B)s+Rr#KPh&1&iu>=q;r`|Dsr>baEt7Zytyn5*sSZTFm`;F1>l$6!*gKp{aB
zlBSRE44M>WL#C>~6wPcNnj6|?a|qICz>O6``f82`x8onN60bhj@2<T>MU2cS)gemM
z_EvNfQLLMFD#ee29p%fO3=6W=QFlORGYiZS9v`Y+49?5g$V>ZO%5HE)qZ%;}4PqKO
z1d@t_0d}LvR}r@Dx{ZBwca@f@vhSNzFQ`ZIMD{Eo@e6*e;rR=mT#F&`$%WL~KBJs4
z$&EXxJIPkmoB4-~woC>aFqt(;{{HBb^w=l9^f1C$_k1)XG=6M!qBTwnh-Ee{Pk*RR
zceil=Io@BRg2%bRdMeMqL(qHyTjR-2NDk-7s!z@#XlQestA_4zC|x5J()kERGdzVb
zaux({15cUUILKX5n(BBorkERv_h+(i$v)2K&;;k|f@wiS%|zW_y#RD8*51~x<b20+
zNh$+)9P8AROs>}yFm8t=!iJG=3qp3f-ae?<XXt)>N-Mysvvny@4rFeFo~zE;{Y)BV
z;!@fp@~QL~fYAdTTzuY2tRdmT^;foYwQ9Q)J4*Oy{$I0TgY}b7u5iaH^gg03X&-(O
z<F(l~eb4Qp7od`Cs5@L3@H&yd05|m-3%vO^PT@ba2)q3^vgQ^A8$I+n{uJ;=4DbD-
zq;Kt+n$S5pa!@&xe<}GmbG=a^u$Rv<usgx3DxhGe3aAp+CZ(%q4q3EEIjg;6=ha6o
z7VM^4fUR%t$wVbFhZ21rK>HbBqoTEtOmo%6W2lfJcCiyDUtN}b|IpxI(G{gwNs&-f
z*|KN!1GG)HhUpDDSyU+Fh4cbb`lROH=_by7W+O9t4As=E_~~;bk4z8cdv{?tuKjdz
ztPP;kLuynxm0Joj3l4nX+v%?wE0SH05^WF76lQ0}vgeS*GSAb~jj7k=qK-Ahy!zEo
zibHRK+tf<iTHyDo6wkFzEBAciqAd?Vyt##eej#^Qewh28qWK2JShFV0<z8EjF~Z@_
z!3whieR7Yap(xGHK^)i^3u_a6p;Z=9U82I>ZPFq*!^>p*YrEH_lq<fHIJdhY4nN4>
z91#yt`-}g+U%DJ4d@NQ=N}?p>^;7-D<A!Ao?MU68#J*a2YPa7Cnl0u7zb%o@n0o^v
zN_~13=nZ8l^;DK!LF{}AW3fCV2xa5*0s2KmgC!ty$V4$%A09x<K?i2HF|BZCuxcZl
z-YtGwTN#{*=`0<knPl`3iH8{AMAvF$`1*lwVMbXH+iqf4Cq!rAT)t(jGZq4j?Lb5U
zi#L*di;*`&qI-LUVUQ9y?ElhVl%@9rU1H0x!suw+C4W*>7?VS(be<*|iHVp}d)maH
zy$D4<gM}i3tvkSwl_0}x&bJ}$2*dIRr&17Wzw}o=?h=>E`x3~^8QU~3tyK~&tn37s
zju{l0`6ei{G;8KrU*&&17a|RmaLdQbp3dBS?pWylq@Q`t2;xkY*eo?`>aV_{ik6`B
zsL~n?h3EgvDZeO}-QOe_REk03vl{S908lhz{`e#M0)T97qmuf(?F2d&(j-*V?T>t&
zv*EX}rLRO|xe6&{#lAxO%hK>01@-8JRNN|9`8&P8a}B?>YGvL8I#_U~>L1=hnx<qB
zj9!0}_ESWE2*2kJy(ji3mg=+~P3f)%K;@uh&nS%9TyV%NW0Rqqq&hClGUJ>WpK?4%
ztM3Zz+*asnFfQb{^V|!`sJu*4oP$WCLAr8yA%=u=`4JiL>60DulOB)`MD3O`mg-en
z>Zcp3hboD^e0vg!F0(^3jDt0Xmq!*t6AD}@bUZ@yWx8~LigZR4c_a`bR)cb|7c_gZ
z9x%6su*k2~F`aJ|J|2y-2jO8^*id$_NXjFIh*2V?;>=gw&3i$ynC8IHkyCu`$u=@q
z2MYN`Mnz2|ZGWO5>gd?Z<tZ`Syx4u)dNOX2@|9T=v8Du!RErfSyeFo0J;`lVrV+IN
zT0V1F<Q+PuRC2I*Yb*R2%}$Hpl3=_pHT*Uh{Z<lC0c3_@=f-{6R~r8`=9E5=7#Hp*
z&Fp-B1T4`-?AiUGExqSvC||!(Ei)2NTIa!=P(9q#!GM7AkNQE?I|0R97_UtQ(-fK-
zZ5{^>9?kMpizYMXCOS8wes<cVXGTmDnsEB-8d^Pw!M&tR=mcV64DTx8HfB2?#ZbS8
zdFgTMQh_*I9C=9t5O6jPQ4W4nP5?9k5x(gR60oaSA*tKzUa+=;5~ZHQri+0Pd3iB4
z$8d|*%_@>Ud+9u6!=$!%qtp~!CzBoWcDM~o6Kf1HQ-ukF7hOIN(_(WBEQ~q@JXLwE
zsJbQ7BVd-mV5`Qk$Clj6HE(cQHLWIXx*Vcw-tPyF2cqCmh7~MiVrx*fY|n^W=zQnL
z1S5T8PMra0($YRSnmx}8r;9CvT(T6^83rD=DjWb-DUG)?8KuvU2z%E`nf{G5(wk~w
z?#l~43Se+(ZIkxG$<j=)9Fhaaf>r7QL^bdUd@Zp*`jaTb&1!0tma1+QKc2VGHvrF#
zNp-8x6hHfu7}zE}rxY!aCKN&Yr^ZrD3rhp7pFmbUw6UPn1sg*<F8qdsQ0*c#LtMzD
z?E)p;Zh<(i%-v2wQEQ&Dnu?o}%79`YEUbuCKNfvHx%I+;O+Wrlh=;72PQW8+d=#g^
z<X=sOxn~V4k{x>_k*b`<^)bbBV_2G8ZeZ1=s!&rl1i>1i*0j#0GV?*zjh}@_0jKm{
zS{m8*yr<(<d;jhjJ}pq#Gi`P6##6oOTTw3Z{qvo)Q&XH^6cT!>MW0#Oh%~@)Ith|n
ztxLtKpKkAP4M}tc+P*9q^wN{rzg(H8&iGXNc^Vs0t{y2WSGXI1TSUa6YoMs4MIsc1
zaKKJFG?~jMFhCc&DXIcFy?2x;A`Iio3Yb`I-*bOASOTfwf4{e_gj9oG;*1J;+N_N!
zF)%L8DZ?*JLmI!CSPb!NiI;~;rR~-%T;9^f(Th${0gZCX_l}7M5}lF5<i*5wOPM9D
z#w39{Cry?eQDPAhya<7-mEmVSp|(yPm@_vVSe)P`kF^m0e)f=Er6_lf*;kkisBtW~
z_vuQ@xOcqffot@1F56{^-!!Io_C<{bDWm6?ynF!pWA2YHu#fc@#!2e})12nCM4RY7
zoSe8?0DJXP`7v#iko1QHOQdp_vUoUy$G@_?uucj$bCXfil%y=yJ{c=|V=v3n@IXNb
zVpuzmJ+Mt9*t({S?0&!5WR)042xn(&T`20%*oVhS@>(MKkpR#dO(8L<kGi#mSqj%e
zxv`vrDcJJ~z;SCVY*WFKc^|WQG-4`kruVIkh?dR)8^eS?6l?x4j3FaZ*xOHAkh=_#
zo?PUtoqz?EuQ1?RPI5ow!``%1Sin$8p!4OOOtMT|gT0_ARFb#Ayw6L!>~XH1<)6W&
zfnLQG%Q3mJr<amup0=v1uz-uuLl{P_%MJzLN~Y}b0onoy59QI$jQn2M8u6I3jPPAT
zXXxaq(ug=#99xsN!M#+joMix)E=V%d7<aY8rrN(I(C=t^(Rlj7=hYzpt_)&poz)Q_
zhWs|)#6=DlA@4DI^zP6?l^$Rb;y;N7q0wnILhT?bBc}iPe(|slp1P~-8XiZ4%3`8M
z^#k9))bt~+grS5fGoPyadI~snWRKNepno*S2=l%T%N?%?YQwu)mJiXSIo;X|VVOX1
zs5?zL&R_sPhJeWM`Z~v4j6WvhA?&Xa*&3f=`BR^P=&6^Vr~iy*Q<3!*(13&0of0Ss
zG~9RS?C&2&)9u(sTJqOQfPq=#f)C~D#??0^n``>bKBFT{^nH>ZHAcH_4tl@wC&jv}
z%6s*n6udPfHJYTSmUUirDC?&L#3w%nUWjj<Dk^b+;?YQ+ft6kOKFbo1q+3<`PQJkt
z58Rs<O@WeIua2$i*kKYb=EuHdHFN6AwbT||I&&fwa1HbjrwV0EsWYyWro!v}E{~^@
z3E6y2xKAM=hyp+}MLx$?SK%Xsz!Vo4)@pIq2T|Qx=gNn~B9aDbV~~Vuh$=x@VTIFX
zWNR{;HhPn#!0>}Y=T&LW_Dn;07uGJB4}($vmr<R%3wd$ST^xs<R_UG8ACrseX{2Y^
zsWgs`v!vYqx1_$*97wIu{X6Z&8L$P|LF3-yd>|E|vc7}4tz#Jc1h-Ht6RdnS7|Nl_
z5SDsl_H(Fi*Fdu%VZ@5LVt})Qbybi@pn#}Ab7T7(_mbG@&hl(=Co5Nzho<;5D0_H+
z@!?_Fy#epdj*yZ~$|s|u(YeEr4ihb+xY~LBID3>&0=O4t!uM3oIhFxj;(BHBdNWi4
z3}};U5Y$0Z&N!z?W+=XbeYZ{)!mxaO$%|H=-zq4GK=|p<8D>}lbaWum2rB~+D&;ix
z(a)6Z9ONdzQ024?;W;}lBVm>9dRIGT(dG{8ik35i8(I5kxoX>#+USd6Es8OrZA69c
zkUT*&)Q6H?=5r*I8dUd?0u)6dzg+ONAKw6c_jcer8pR@SctP$-9~y=iSWLN9iajYr
zl)ChW+vRwTHP}F~M}R4U83dduVda@Je@LX#^@ut25Al`BRQ!}q7zZYzKnbdbMHoiz
zi4=M|S@a);9ZKN&t+WX(QpE*j3V>ts3mH{4)s}E4{^fHQ)p3lJ1JsLrY!S^r!#;2d
z?vCk7bO#bn2T)FgPfR6e^#8uei5-kSCD_!4kkyd$Fn3_;x>Gcq@h(EXLI=|zHHw)r
z)PxU;xNJ$2p>uc72GYBGly8JTNKr`t&YmhRUmxp?9SKz~wCmi~MLeP_ZVX^syzrgR
z%=s>iO7(K+s?ojH(=}fc9E|)4S8Xwc>V3?g?tpQz2d!8oX!geZI3w@|A28$E?Vqr}
zp8q)cRr~T3$C9YG@0Qge3^jo!4dE^E<E&guVF49tVsmPACCUDn3qe}Uy)Pb)uHA#Q
zrfJ@_q?EK(%@7@`ZeD1pLdEoNaNU3q;H}SEd^teg!Yp0qm{+##d~(c<zDuEw<c7T8
z^JITxhy?jd+dV*bBHS`yS~@5qbxAti*6J7>hxqJ;S0S+<Wi4G6gMZhs=h+zK%JISt
z*fL@D=l*gdxp=w}z<{~Ld!5_bg^kP+%9X!`J@jIBAqCj`rxAe8v_EUF?>gQ79=kB|
z(m=LMc&uU$1|*$~yf#KWX!r}5o7XDrKR?O?w8`(*5IW-^ISv~Ged4}7b1+-1a}pk8
zliIQq$uQ#gLZvCvSSFc{NYTRUM05D*YY6uPRNc&L|624=H85D#m|P&%5j&H>IQZSv
zJE!Ozx@mq*XTylKn$QQtVqo8gw*7=RV45!2nsr-7qW;*M9>-2f2@V?{F33S^a(p!u
zi07MdFtl=!g%>=!k5)5y-IbjrikaV+<Q`pa({W25;{b0=e{CcLOG`2*c_jr#e27RY
zX%T#zu-ESVa5i!KrMl^+h!%%7AB}oW^++JqY)E&-e~*P^gzm#mj`PUbL~pk+FPNP#
z9Le=N{lgD<?Kwn4@JaU9N`nynwF?$K;-O(VSjR0;3wJ>B7?SSdR>rFk#C}^-0?~4b
zR?43K?~Rp)v<GQS0eez~AR|fM1F^z4T4?b<gQ_18MA$p(f6QrL9Ao2k(gcZ4aA_4w
zb}0BGh2^C<4Z%A1gk_!TxjW$3kE;@VRO8|?PJ_cFX(XjQEt&`%$S(#6<gJKxqfmY5
zT1Zo3sh3EJoQjYP7TFkfrl7_Qc`#15mU}WewO|8BaB4P40m=JkLAgZFvrq(~V@9Jc
zZ75@HuT(2}ez-W?eN1OOP#gvw@6%yLjIz;z-5&nokGjBlbIc}elNp?yp|0+w;bS^S
zkI^v=YaO&{J!b=IK`TpOlTQdZNe-g_<vJ#4iN8E~XYEzD>Cm&w>Yhis-#r9C)dG)?
zqmc#8hTz|^!jp4UxhT4?cv$b}kyDZuw6+>p?MHgS?{pZFeOxUMgObQX4)N2^@}c+G
zz*tR!v8pELEb*|;dvlYUc~PQ~aJ3+Q|H9xxNuFslTfT^CldPVh+a{3A5o;JJHD`q4
zd@WnpVMT>CAN&7K-2;}?Ql}`94ztf=t=70^aMxx<=f4OxLI6yP4mdkfqU34FfqtVU
zk!$LNxwY!eYmLJQsXmO@e@Kuoyxwi>v-Qv;#X#SlP7J+6sUluVk7P>#3gGWZT-*O`
zXul;R)YsMBpn2G#Y#6U~tF4WnkL*Xn><OUO_V31z9$6l=rhA{&A$-AodIerm{p-?B
zuBESNIqyBJT7TPM5pW^n>Dw;D!lFZ#p-bQPaYo|DF>wC<8s?*#Wh6Qtq_-2;+dUb}
zofdb4m#Ta2sEN0hVWcXKl;Y19G3a%|%W8S^Udio0A7CIJl@n}kl0a8C)W)+f=rQ7`
z`S3v@;Hl=Iwqxs&0%+w#GAMD%wGiUP+9MPy=jt~Pwkzv{iK<PTxzK~}+;F~!zi*gO
z*#AMfpke`&5KBw!lCf{pSZkqw$aZq|=C}$rFg0ZY<l=LasN}R99cP|P-{f}DSj5Oj
z<CcwSfeI0FJFC+hjf?Ih<I2-Ge(6IvS1XcP;1E96ARo$<-xU8mXJI<g7}RY_LMz~K
z*EjUSouW`i@zT4=n_6#eQS8;PI|20b^!P)$Fprx&*U_a}#gS^Hz~GM-8qAto-iVtx
z;ZHG)oKXpP{}K&<ENws#gcP^-2;ct>CW|E{9hITQ<OeMZ-w|KyjJMg9M0wg5wnioT
z&|wC4XrRjM<Gjw1DMdUE1o;byfQ#7Rk7n2q6-JI?Bj=%=Qs>i{9C-pZ$8t#>;xF!j
z;IwpVa3r$V%KqJ|?|7_V;o|-5p>o4xR_gE=bDRd*Mrtk@T!jSpsw*BZgT{V8hP8+L
zgB_pj^bA4Z^4z7B%3)7NAPewY>|4A^q~%U4p}_^%Os)9I<`ET(U**98H8Rp`Q%ZlC
z7rs?T3BBAYGV=>!VzQ;n6MGMh+BQc`bo?SQ@E{&yoUb0teikmZG&)8TW8MY%`>u1E
zft8A&CKrxKgONj95n2{cIx)0?xnkM*=hCP=aeMwF%A@;WYf~3i%SfUbNE7DT+*Utg
ziKmZRdRKej&^BOH1icDAU>jyY=big9qHKF83Zxhlg>=B@9d|1wG_|#%Kylu~^l92_
zt)<BP<^KIHdL-Xt^NWKyJtso1r9Ic>6M$kKx0YD}%tJKz)*#{`CXjCMp_aQ8Bt@&V
z@xA3KK|H5L!>G)Q*pP6D5*c(HcXfRtld+cFh(Ow;DNcv?tS)UGEtPu9z@QaxgI8Hr
zalIk1vb_$?(QJ>89~_j)WXyJExx_X}5Z!(fEWn%g<)pZx-MowcQ4k>|gYP578}&NQ
z-JQ72md`OSQ!&rY(F&476>%<18tbLWitiM_Z|E@IxFjJQ7c`|Td=>RO*A?dzY`t%z
zevWZtF68~xny4qGrv>vG4tjK54itu52RO7+;(Rk^D8bA<K2gNJy<p(kh~^{S%1~}w
zJS<cW_mPu<odjNPa79!?qwq4${GdrhqLjD3l9{CWS;Ak*IV-o>%{@JDqDL*+JGX=i
zlYk)BFB`KY#A(fnmiQG8YOP;!2u*r)=&H;TND@_yY1E0EXAXjhvYkwA77I>n$eAui
zSXioQ@UXyZG(xeW@q{%!i{PA-o!%nG`?e#&XVh>oPk*i1PvS6K<Z4i~%tVItt&MPs
zO`&IL^fYgHepr7qv@lOSdlh3fv48ib`^vU0IZ|@Y%&gg9xC34WX)|H%h>1hwrsx;p
zcmPLo%6f*ZY5;qHd!{gZHY8OC>IFtUX!8260&GX>|Do)hVnqR(HM?!wwr!nl<80fu
zZQHhO+qP}n)|`2`$xP;-<ldJ`x*t2~q^q*N)ehvIlxk?u$vWF*W8+?F+H&+{E?pPj
z573QXrgk*4!xEyXJmQrGD74<gr-$RulZWnOkk)UM+Pvrj+gFfhaW9`}PH)REOYJG+
zFP&!J=ssZ|KDv~y8w&}(7X)A?5ItNTXMBr_2(1k8-bCPZOarY-7Bj4(x)wvZ!cCjd
zPTfk5MSnl(l=DWuGA@LiOF`7g@sJglols_*-3HDAC|*b0r^l2I5YGv35=F~SY;P4o
z=#cr!F2wCa&iY%;sI;&Bz%o`y5lzE2!Xle8PWs%ZwxQ<m+QGh{HN%{OR+v?Q9G^pE
zG&kycuj(@BsF2+EU^ci&IvepyxCYl<(+<Hsec$J;v#_lGn0vtwuiGz(wBeml9)~Ep
zFZLR4@Z73zU_5(P=f1U$s_LSlo6Lm8cH9oSOf?-Y)YS$g@t@bU#jwwJ&SD>KZ_99W
zpu>85K?9egnZJ6cH}p<xN!=`|q}PbnoV_UYbmmhx_w?SO3g9eJLn6C!r#kp#Qu%+e
z`9#O5Q`a@@X3`Zq7fgxM&0aEuL}7bEH-hfA8P{+w-u11qc<RwhjN7Xh=C=-=N5%ou
zDznH^!>7Uknpfy6)!LNq7_27^tIKc?uk9mhbww^TWyPxH<DC_((&ya){2tp>om5$A
zXVM0lmh@#&yiD2G|FK+5b0`%kr+!<c{G8meNF%Xa)7HTz;Cm@cddH?AT_por#vRqc
z+?wII*tDvKPtRAeDlY316*cYMXG82cbE;;(kMeQTqRgfF*MuCfFvR{`(A43AJFFk3
zE}d$y{$6QLeqE+l9Mt%0Oce_;X#e)y1qdZ-&hUFlq|<m!7M*L9;Zg?@HY!@63`#Lo
z>(Yi`@ms!3@TfMw6E_F;a*WNH=M4sPeYQL@{CiBxXPIR2Uzj3O?1Ewl-cOdwv&c^e
zn+2wlvaV)P2whIioL1`1XeCv6c4cS3RrrzW5J0O`AC`ahs~aB1GQ$aarP5ztexPfe
zx#*&O_)xHp=EUWB5|XGj%%q1D@G#bn_LcWwS7|}I0j_cl?ES46v6A2$J6?`^)37ap
z+-_iiZrLwut#v9zzqD4Z{HBQ|DDdg6s%`^5*>4x>y7P0=&AJFYjsKf)#jzW*ljPh;
z_OK-9OyAwyqQ>057y^#SXl3s^fji(;OYkUby6LsIw-t3P##V%@=06Y{QoL04QGy_O
zlA#QgW>17WZ!^#j7J6u>Zy0{Hp`O;QZEI`xQb@D+Ixvn+hzKSw1yB)mRD2(b#HjFr
zoMHkuK)F^x77MfEqv|(t62uWc5P?c3xBD8tC9ul5333)^a6E=<OoG=~2|08dqQ4wT
z8eaC7_1LfmF^17j3QmuNwW6MiEnz}iL+NdbT`5X(r{>B5;$$dC*cR&VM-=~@_zi~I
zQE}xbZEtXdk<N?A3Ke;&=&rA52peXk7DK!H?1l<_7g*jh?08H+_dIM`PbIOlBg1)d
z;#a(QoPO#4+f!Kf?bjeKQ#4*#^stkW3-@4wWg)Q@+;e6KvbT*^reHpT9$tqF>1)D$
zKl=+M6XzbIw@F_T%uinP>lI!6Qm4uL<3#K0apy`0&(XZs3!)AE!UD?PZ37W!?8DQ|
z%u&${Ma?b$gqI?-RY+q4+|2;}*L!{dj?~{8^Zq{-&hBCaSu%eGKuZBB7K$u2RjU0H
zYTIvc1X;FJUk^3g`13&v4-p^DfFK!m6Sj@yxr!Nt@xZ7Jx>#fQj3V+yTcwPM6qL_8
zR~+x4b0T|vl=i_&q6Y58#VtP^&_O?vvTy`D^put7RI~gZbtfxNW#^)(xtPl03b!hP
z^k83V=TFzDwH{?yFd*KBs;`XGGWo;NS`>9OszpKqTIO9$m4-#D&+{xJpkAZd9RX6A
z%S65zZDE3iEhF@%T`IDHy=W9sUJv)*l_$f(!-OQdADvTj?ysy7fF;c+9;At?X82hu
z6>2jsZJuiWf<N*eKpI1nQG7MMgSG0NdP++yPPXwSikVE`rBq+m%)pFv9Fe^1?Xqzj
z%v<#wTpE_QSrNqI>DJ|NQ*Rn<LZG_x0{--`<<*$nu9l#bt-}D-g`&J~u76W&v|5tG
zU5I%Ln#UIG!2|OT&bejb`G=(x6z|5BaCx3?P}Gk*nU83QHy17x;ySw}4pJO+9Vw(r
zjv^0YHo&PT34w<I>*cEwWvXE(^4yH<s7;&~QFIKci$E^p48jD?TJ{6*e7RAuo28ns
zXmVm)$nEk=NSuyuf-^xZfF4-8PRgyshIQ||FwRFZxO;eJ+;;GcGaH~1cFz8AQUtxz
zrOti40m0i|MH!8Ykj0sG-#~0CsFWRpBr}X=M{@<L@Nhv(MDayxs2A%|wNkcYQwi_+
z>;$2G?bYvz<CP^!{iUHG2*3(GRQ`thKEE_#!m+7}%vLO`VY_gI92vz|r0h%>&@M!r
zG0t%>cCaf=0A#fuHo}DgNO$Wyg%OVEbUI50V2=ynFxk0!=kp@_rILQIg~%p8YpIGz
z7@8S(ZuMR1y`i&#AFTK@=CmZIdq3T<o3D@Nxt0&U#hHzTI)yHfmt+?azT{I<-L;00
z-oJCrV;-xQCoS9998UhV6e5jn3LA;IEkZN0CKIboHw!8PFB#<zvN`v3iXaRq9xmT#
zA9Y(B7x~3)z_=_t;a~qb)UPZ<(~jJg4rc=feRvy%(ag>CiJAdAwCB?}N&X69Ii0|U
z2NZV*R+|)V46idA_j`0t16K+BvMPpd<vueU$ZE3aU%Szl#KFH3Kwl(;+&Qa!DN)56
z+CSL}z2te&zhvgNvbAgL0%!}5<bVC9c#P|HNMklGy^~ev9PMHuI=)^BR@y2d`p7R%
zenz~TX0o!L`cOf0SPTDyFR0~2@E;(4rvE45_YdOdVEjKJeg;nV{~yH9$o${*LH&dH
zm9W>a{z3exrD}GruLrXB6nKJj2m~A`5sG<g@dd*X=&q{^2Q|fQXtXyxT+FT}H{ZX_
zJDTd$<3CQmr&qTOb7mKI;+mZ50jODdHaI+4TLl2>&X_`YIsokK_~h*D^kBe&HQCr8
zU-;Z$fqWPz7N;Pn->N}0FfdM@4dZ~@IY7(Vc>t)c5PqTXeZ&+K#3U2buzSZRXzy})
z$kHeT;7@gpKxK|VN?Cb&sxV;c<fgW1+0oUTin+gEpbUX(06auQf>*vpz(u(I4BQ9^
zQ1aj%>jAjATmgOvelf^na91bax}<5t*4tZIBJFKFyu6(LF*RAT4A>HAE`FuinY04f
zS5P7De$@cIVqj(fxc$D-BjNo3bIr|;-;4Q&M%O2hLH>YpU}3lrFwWkR_Msa7`hKN1
z0Jz4ieNz84GqZZl{J?8~zPNCHp^2xr4!*{}bVlIc#F!93oSa<1`8zK1*nZ8pATVy_
zc_Zg1$0Kk6g4I6YK!i22a_<80dAJ~E?<jZR&IAH~G@t>zGVW^Mwf-=0o3g9Qs&bFr
zVz&FFx^tPhmnByv77}AzoJ8Db=4Ro-z<6-E+Sc^atpZ*gK|X)OH?#z5sQ=;(PHd-3
z!CRajz^SBsQlE?m-N#OYU4bF&ot&T{p#b`61L)Dm(XQTtb?nUS@n`Y$PRlXBy>oGM
z0$1gZ0DP{i2j==Pcxn6N>G@$#;a;77+K&1X!{FihCFB0X$st?n0}Z|uzsF%(evtXM
z`KM-}^`^c_`0)T<Z)bOZrE^hCjzNOmevyAhQ60_A%`qs>>c3eZc4aX!$?5&*Ljmyp
z0#*IM`vwQefe?`Pz}~)Hab@zhb$Qx;$CX1gxB-QKiawoWfAg>IQ^C@HH4xDHd{-Cj
zJpR&Q^nJz7$+UsC{gKn<`JHw6B|iR@JMOLg(hdIUjY8QXjN|{B@&)_y{Spx44tv!_
zl$&sN_1pk*E-lse`>`zpe4AZPwhvJIu9aJdeQSbVkjEa|9W^_x&^rZfS!i+uUjLy?
z<-hjmMTa#22essC-}v^?0Knnd+WI~8+@OmaTzuUBC>rP2+ABSNzfF0Nk4s#>r9DJN
z00Gcv$YTe4O-ynF1p(;ck-Iblefba?2B4EIOWah1+B4_i_iILmIed+Vf&y$a^3D7a
z9sr<g?~O;m_mg_ZCjr>|`;86B|L*i7N+hT3_nTKrmGVn~2!MWO`{XG~SLyo)4*>nm
z_KgK-HFxy$UmnA6a^of!pl5gPP#3fJTlS{TSJ?}y{vF+`!1|T`ZK?l9_b$9`uy+sH
zag0CiG@SbB-@0;fH}2QGrnK~1*Tx56wb$*Aht=gf^wbvQ1>jdvc8_xF*?jz0!mZ$C
zc2BNy;MfEj_}6lYoXsXj_E*x4==KNvi(bNSOTVr(^gg!OdtuV|4!@QG;|df^e`=P)
ze@O7EQb?ngs(752lTD0-43iD^uNsHfslN3MJ4cxW4JziJ$vWusq92>CVQ2S~M|9|=
z*B(!q=Cb{1NDbQ7+S{qa=23P{hLe%7Pf`ABiB+$B;nKZ1@A~JDo#SSoJYWN4uTUtV
zmdH+q7!$hwWYgLL)#=oPTOobsObt!cfQmF%Qe>QYk6URV=u!*^8s<_7bA>Gqig~sB
z*lxSh8G5q&Mp687<%4yGub0C22k&SVH^Z7zZy&FfW9Ms<LULxJVqu<9d@R$a<aG%Z
z!t`fasxW29NUFLLmQ3?Ft3l9?JJorosmN5Am>Rf*n+))Yl)akR(BXil6%3;fS3)lJ
z>!P=HR>5H8SDq7hj2eyW&DSA51!G0bI=yl}@K#`%ox7!+SA>c<M-$4Vm+ZUjBlUjH
zhOHiYq90`G=3D&TuCUz0<|%vTn+H%2ef%b32<`6&Y+U7_0&f<+MQ>+<a&9oOc{y;L
zz53#DB%ykaH?zCyTAbhcKS()U93D7-mVL@B)QbnfPwT}F5Ai6}Ec&IrE<Zrg1}3T^
zZ%RDJvXsLa-FV2Rb(D&sBUs8juq8$-6E)4V+FnT&N04+a&KkMA;uOW3<wXz?-Y7YV
zQqSED+osj`i^+=5#IN1%hcu_OE1@teUu#E`rAFX{lBalfD-KgqV*<{Pj$+)Hq~2kW
z9=M1(LPun|l{msdO(#n!h83O0mp)(3FG+;-il&TmSp#~IyroAppi87utr!|^JL;yd
zYYnC5J@2aAzM5m~Ri*G-=b2kf8Z7eqDKlrQ`1Ku%>YGL4w^z2uUSYu9B{eQU3}Q|<
zl&kPc*6q{-*6|Lls}HrCxEA%>AFSF&1&6X1I7@B?9j`UDibJ@qLPTT+wp%z%xXcbR
zx5m6=9aB$~lGO9@&4q|r9ZXMAM*baXSS;S<ohwz(?B);prQ~}KNk3nvMghd)cNy&x
z2Xp0MR`{VXLG20B0T28FJn3xuV!+*S^bj%V=>mvSuUzqRpIpQH7O$e!<bH_hxfihK
zGbiC+r<Q;^{3K{Onn3L=;-V^kT(?-B#&qkuwWJ#B2<=qDg-9!-B-!&fEa3wbBpp=r
zHT)v01B?<t^b>d)nXh(tKj(Ov5o<vg+v<>HIH8QpKav)(UhAJ{u`PFoZv<rBRmkXg
z3NU;@?tbR_kz98|sm{s_FSx4zq-H{OS`(|D4Mh5Hd;Zwhd?v_S1#u^c0a`^n@8K~`
z+#aWf0U#NS8WY2c@fofg0FZ=*$h`+q!yJk&y!dt$<$M+P7XTlQD5G34E-S~+GpIj6
zf*<d~-kiiS5l1x-OO%12%SNXiP*sClBOf@v+OLyehv})FtUSW^x#l&%lwbbmQG#E&
z0j=@7*L1Q@UVn^J%}lUq=2Zy*t?#|}D{)9Zsjluo7hQI7-T^=t1e<7KMItr9N~~8v
zS+&fZe1>x_5O`-OS!9dxXBv=j8-Wq0i#B#AcPbuj)L<a{CYBB4L>|T2E%>}U)hR9U
zUv%98j1OlkH1p7_g%Re|BGaTSeyZ+-6yKD*6v)DPT9XCilyU<)!bfuFBq^_eMdySJ
z6$yC-ddM8zL_<jF#%qprZB#yBb>tcbeldR%_@NUZBpM9R!1LW9HqVqeCct+pS2#vl
zI;$_^rSUk_l>grUtfNa5E)3?Amd~f@@3YDfyNzaZpm2%RWu2_MY0PW(|HCAQEaQRT
zAvND+9feN#Zrd25D^Zk8;!lG&NmPKC589<dzDUPtfk0U5N7X_a&MA@~l&H`di?3nb
z$Q%_*LO6qprpJ|<kI!8n5mrXZ2_5EDQJirSP-eab(IuiSrdykJPowyJlAmkep*VZ_
zesRKg4U#7w&DD~q@4)ng24&w+3$5qrxxmFNgRU`@gXDJ6=W>crVbj+YX=*EV2hjow
z5er5AUS0Gxx2e8^dGr5fK8bq3V}g259xmiSv$1u@AzBHShmQ{En)436EUeFcRcG=G
z5Ug{kY=-G<v1z)DGZ#mHtkU+Du>2_~tu`LTF1F<3cJGbL<1*ax8uiYdB(W}__Lvyw
z7B+mh^3e^L(=o-jrVG5(#({fE=_AT(XL?Z44k)x1gk1XwDsN`g+gu~<&PRx5b`(w7
z%oe17O>pRqt~Yw*?tJ3tAP1+#_J#fa+jAtmSc(GK;cy47tO6XQ@*W1oPV(pjm)tT`
zo0gJ9?7r__DymXHI^429ZojNh-<_a?1wPy^HFH^C69$?t6JY`PNdIU}D%VJsT`)`b
z+7QW<>pDPN7KU3{m(F1jC9hZ(w+)p5=foX{I5fop7BN>~rUyuKMAi|t83V}O5|Gog
z&_-Y%UhDwh`$VWE!?FHl+yuEYwpz2$i2qWp{JAzW;bsOjSpbdfl((AOQ}wwh(#z;O
zf@LE4UOzK*lNNHOVZ26X*k{ZztN@y)0bFM@>2o<<;RqXh=!&RcT1I~cY2`<*UhG;0
z_lPk1$hbhnu9&%Vvhr4bo#684F<ZH8SNq!dGA!sgQ~!66`w^e&?6u*~#NPv;-iLTb
z=Xx(KXiNC7t!0{o<x?QZ4f9~WiWWHoB0L?N)-0=kf`Jzw$gl@q&hXDCuFb)K;EGH|
zx~PBvdQ%^2iDbU;C<a?_-e%Oknb#67TK9ucOSuvpiOGqg7eiq|pH?~-?>>YwsOBVB
ze!euqyBW<H;qI68n6QPddKITjC$gyz>H4{=8DRkeo^TuQoxm}Ur)4u*=y|sKixAl!
zOp$8-Cdy{%@AiG#P6opq1cc7nh@btzSQ2Swb~@m%KF-_u7<Sz5qF}Sq+;{9|C2#c;
z(vW>Y*dvW<63wifKwmnHV(wXT-d5;+fWw|Sui6(g%+HTU&}?R=YQ0bkmKdz&lKs7g
zSW?+PDGC^72Mf21cYeYC!q&3OAEfj*u@8OCr~r*4O4T}ApklOd^{_8wm)qgoDK6%T
zuiV<;5cNjPi;~R?{Uj?1V{QmyM3c^=)t;!LrQFzrMJpFxfxR}Z^Q9O?Cs;WGUd5FG
z1~d_0>xM_~+Gi`=lz|Y@l@!iID<)TxutuGQLadjHmcf)Yf|OG{ZTZ6FUGapDdkiu!
zL@yara_ozaxde%92~J0|QsEm~<qSV^p4^^87wjVALyLCjjZitZJ-Gg$X$I1AJ4;y3
z7I2E3zJamn+12!Z%HrOOQNSTjhcRWO4E6*GzWo@Wh`iL{8eK<<Pm`;`<eMgvnq%R?
zE(_kwiNayoV>$X0C*rokP-;+WN^KUeO1|aTs)VN%2~1@oJ6fKLs8^8@KG<s|ol84*
zBbqgGXu37~9XyDRo&ldF*?-8~`d_xkT|FYyUzQcetE%r#OJzGN@X^eYnZ&5=O6(c|
zql>$UncPG?1_h<5l&7A>Xp?joN9862crqsV4^-$m3D-3g?_R#4U|!TkGMX`XLTUL@
zy1tK<!2qQ$tYRu)31z%>tJlrZ+uyz(J*bCl=o5k++JibKNWii=TADF|h+0+h#!;x4
zo>A!YH1A>q7PdOKTe5>Tpoo&yJDAma?5EnJC`X?r^X+Yg!Dp?wb9DJ~Ml1L?Tx|-`
zjP<AEZ<&WE3F6K|dFZ;7wLVYg5rT+}^NBke$SZ(cR&KB>Zb!R48p#rLpkC=b??T@y
zr3}wn;h&97byE=xUgjXkRX0>k1A=`QcAe(t1Lj9a?n-ef7%6?#>D5DzNJe`mv4&_y
z>ESAd7oJE`Ymq5=@QYW?Ak`6OyXif=q%3X2whYc9+-l)G`Cb)!3S9UdHLhb^LQQg)
zGm>bt!F1%fh<uy?03)>{;Cmgnr6}H032@y<iQ`UK{vKR&ZL<e#dQSZm`Mi21P)u%#
z)&v<3$7G0b`6ZkbOVo!4A76a1e1l3CWE-nd#Z>OS7mG)^bs+mk;qA<JyXQO1Sot3~
z|4sjJwl)^9km-SlOHs-V(aVlsxWtT|R@vV%O+^VM2|ud)cEtf8&RMBDi&(*z91%M<
z$A%IZGQo{SM|OAVe9qZK-f?<WF^`4V4iwXOgQ)?Y{5dBJ+q(>_lu$fLD+Gm^pGGFI
zeIzfp4;U8Nox7TL9<EA{HKVT(`E(%2we4vGY7KHd*+k7Ge<H5doKebYKA~y3J%*<o
zjMQYo9kCO~&B=_g&$>Y@r1&_WQv}pC)UM&upI+f^W5#taIowwDx`PW+d`m}aINDO2
zloDA>n!7BW>QIs*BIc$#r%irY=)%WqPyPk|$v)Hgn_T?m($ZrNA@?2hbKgwr$za`9
zkqFe9Y>ac~{>Zm}D8G`x+FP(bXBzrC)w9VvSP+R}R_+WhRf40J9KtzyDiN61XHHpA
zQPoMf`6H#u_7%Uy9?$N5;#_l%|LIgA!Q@J@?r$Tq<8r6mI})k~F9Xv|4&`O!%I5a2
z{w}2u)qdgQxEtAXZ#>TF)z}=yHXhKf`Ol4n)Y)X2K*ny%A4M==_m=@*4wN&?vPe!u
zTS17{!IsA)yhPn?F`=ilXE(2uyAQ1k@70?_u#<XQhq{(s;f`Z<lRa<f3c?S^fWeIr
zdvi&4A2(<N`s4I)(m)oGcA>}D_5>iln(tx6TE{5QEzbng&~F7>n%b!AD1caLRO*?|
zb5V|?`P$dwXu(CkOTfA`3mZ#ZH;$CMEOX`pRqJ8+sl|vp{Wxla4jOMKdY6J%9p7eR
z$)1@=-WQ3^XaCq*P*339ojMXWYg-6;1QHlLAVNpCrQW%?CVvhE{q#{@p2J>=AOmkf
z^F>NCpIHA{>t{X}<&2M;sNhnFwekf%h9UORX}S@E%WC{}-7E!Ahn)8EB$XC4(1JI*
zTRm;3Sf3Q~UprR_)ONT*-{w{Q+GOPWo~!}uRN$T2eV3~lx_q^uMDWnMWg0!2-P+Z-
zGUaH&0dXduYs745AlJ`{!gBgyvuDZ8zU8|#i^`bu;yC8hDLQI<urENm1@5@TO5@Ps
zL+s!@k^|ChRz9*zu06dfvH>FNIgpY=D!C*kBqnkl${yUkKDskhdrNt_clbe3rbgy8
z`ZcN)jZhqJ!_ppa7$~pA68@b|`Yp18;rWot)3GvzXFeYgzp1`401MhOPHKh7N*3UU
z<>t6N3^UI&X3304!4t`b_jeQUD}YtdUlRR($dd)W)EUe4Rr{sglK!1Cas%RYlh&8V
z#>XNe#C1}E<DPH5Vx8xA*zL&kqTG1O1f~3eZ?zaPu-g0?^klw+ILUim2bapWI_fw~
zy{KATJwH@Q<rAt@u#Nj#k~pb|;+9bnmHuziR?}-DjLbMX5^OmDYQb2cb&0z940Nch
zuKl#_HhvM?c{`2cDyG0jv%h}joC+4n%HDHg6Aq%F;J)~U2&|T?<MvdpInT4&QdDTw
z*q$7gNmTI7MD1*?&>Eg;TjZq~qX^^vVU@U(eC(uTC+Ore&#dmk#OzK_J`OkEdZK*T
zHR5gI%m^-f3GDL$S&(OoPi(q}&Cw+`%C=*R@HD1igfjupTXOjhM0bnj8qS!WVes|t
z1KEs&x7e~?g_9ipCixY}4-vbC05LPoYk)Q;0~lYE(5|ST_{y$zYIVTM;{aFudK&@L
z`r%Jd7+-!Wj^=vWHP#p=m@o)f9-7(}M!$_2$T)X7`}W6`3g8{tlL2V%Hic6&Hzve#
zaOcs>E=x?gaeL20bX;Ze;b<3B$|ERR=2|4{oY3Qa6<9-BNT~90eL{K`GF!c0q7r)K
zNyDu8p1Vnvo!t%Cjo-rqN90!%F6hAs|0n+^Av7oi;}mPD4LFD0J=H3=Fheq`2a!eu
z{5Z+JZr2ahiv=xSV;As3`5w3GfUHw|eKLK(pS~eFOqlh;F=hvQcLno5IDaH5u$A4%
zVu;0C?mmQLtx7l2UM=fyl@I4mQf|}TVMUG-+X&OEN3y3*DI*_pSA`ClFf5hLIoh{f
z)cH<F_to)p<>a!VNb`pTM)J)saxy~>Fw<&3>$z(juwqkrB;3z6z=U<-W16Apj;9`|
zwN+2#IQx9wsYCn5M~}F3WWFUIDI&}2jBeRvAE_Xrw7x@Lsh&iHCZM7Oql@wr&qFe7
z<(G(bHN@FgcH^eKsEf5TW$lGDdRM1e{@RQ~b#|wKd53W8MYGO%W4?FJrXPbz7|TnN
zzUxq4Ex-Nw(=2Latin5Z&XEp_wKd*)>JbvvGH45Wc%su{o4ZpbjTv>Pl1>|^Gu(gp
zMxlbU1$f2MKrSkId)r;TIpvIJeoAV~X-z|yGYLUuW4PtJnJ7`v@o8f0hM_9vhPP-$
zaSN`RY>$A|0m{~A%eXrpAkY*63397&l@%cfv`ZbfI>dXLDcQ{|==D}#(l5|e6l`$9
zDfmImQ8CJ%t<duiBdqzS(O@@7{ZhpWmR3*>e7O7~iK6*E4}OBOTsGhauk{kR%9l$u
z)FuXSOt>}a8QHz>0~F$pCH|Ee<f;-Wx0q#hCp6ffDYJWYgd|Tm7fPj+sNs;|ji;SN
z$UAlJXs$<6fHY!^y7k=iyLV`l!=FK?1CZQTxU2jeNHKcBt-QBOT!i~mdX^LzQQkh2
zU2^)cJzy8HIO2v3!m-jEyh9HZ1QXp@e^;=l;97kLn+Bq(R1|50I;-3k!*Kp>OlfFl
zvHI0ezX}|;q-@Dhj2$IR-!Q(>S$BAt{RI&^f!gGdB3$USgGkO|wsDb%6l+E6#<E>{
ze!RZi2c4QghqDZok)ch7M-Bhn<Rc5=G74)fvxs)9!KYqX%8PU?y!D7L(Jg35(+Qhd
zyC@<Tq)5DqP_FQlss|j?1nAgiV=}0bX32=h$b|q-hObXV+7ey3+d{GWkY|kylUDI_
z5E-aLX?e3F0NbIfL4dT+c*g48Q1AXn-c|iE&{Qob$3C@V`K3Qc#q(k?!Py$*LM^-W
zEEeA>kRz&u`(oPQyb3np{?ygd<YF6nr!_)F=F|cuIDlmtMyWz-hWh@>{8Iju&VY*5
z7nrkUwFX!PEF$1|d55Pgr8uZ8<ZG-V;(ghvJ5=y+(`ylj!GNdB%}0acCCsT|;+%(%
zQ*wcdH6Ejs->WL?g5_(kKrv3CKTR#Cw0PD063?DtT3fsoFxBwytAH5(JNSFD3SKL*
zfuK4Pydq4`KMAHG8*~3;`@Ga<tnP-nh4T(YZP_^+S{%ssod>x6S^;8SinOxb3PCq(
zGtH}Ccyl$BaF%j4>*vr&Jo|0W)>xUP!;mHJ=HaA+zKN&Ac%-`13mu8`OO!GFcG4Z&
z04g`9BmpQSUaH765>i@;jR_2)1q_A{{s!<CfsI&!==kOH;l_uJc)-T3JFNO?L2@|7
ztI&v%Y}M+$-KHehyFm&4wORx4mJtO%Q?=Q_9>X%kw<w3B5`L&P!GYDH;YC@>wA*j{
z3jm$(M@a7&soot5UgadsRbWFRMO89XiZ8AKC#ts$PNT>mU&QV1*$tZVOdXbQsnXa6
zqT9c5M-0~lY9JQT8w1VX{ytLok>w1ocZWD+91{~_A;H*?^Z6`jCiJ5pstPWFxD9@3
z`ebyAa<<_yfF{%_x($z4HH^A0xtaQtU7j7S2%`KK7%8g@8mvacB-_Rp((QK^ug&3_
zCx57G&3m1pop&q-mbSxSe90GWAlPe!1)*3(oNd%;PyP2-<C)m$+L}*4HX5VcmFCCb
zog$%zx`Rud>&yKs9!<=>rJ0?~vEf_`{u8U1X!}zH^d8Cjmh3XqqQ6=c1VOqBf}a*<
z3dCSxD&9Oh$euQoP2@@ZXf@Q)B`ZcfQfFnUwpExcf@x^;Qbu$Th>#;tDS7d};_o>E
zqHxSqf!k@299^n(TAzL!LY$HT5&Yax6{&AXtpsWM4)Qd8OcaG0Hx8?b<cO#b($%N+
z4U-QUsLuv{$w9X|xcs`=l#7nXsZPglJtHGr-<udZly(Y50L_3`Up8RDOF>;%7>6j;
zQ%OcLt8q)~MAjpMNc}$3>+5xDVn6F^n|sCH)~hQkTQy#}Spg&xnSXAYy-|x7i#U&4
zT}=2-OB3!OTv3HH&u~U>BMdx6o@1tE&Y|b#9Ht5(*xN!f5!F_{EXX4VW>oY^5obKL
z!4#%mkC0FO4<Bze4@0DYg{1{CP!)#>w45hDWFbd(z=WbeXyPSBW$6*M_NpvbdQTb~
zu6hEV8u3og!{df|sRRixY&w-l!q{G0E%>`%&kSR=u$3?8S!<udk4iJsh4|eK>@mZT
zqv?5v4s*~Zd63mhs0uK$NOev}eM;F%I2m+YeY_xGNoDr+D4JpL3iZSOT4U&>K&O5j
zhc9uPQ#WzRwu)`N*Jty0uNis$JW5KWfR0$1ObEJ$uS8N6l6q}OmHH&x*QMmvaZ-Ba
zXThTwBYwbH4o6?`8HTQ}t#z%**~4Tfg~k}S#3h^a8dUS(2qn%huFK#sAEU4xq~%Fe
zri=-Ugg|h%9S2i%z?W$LV0|04)DMQg@p+R{KfN$KbN=<T=J=fzuXf*nUnhO9v>Z5o
zpX86XRo&W|Qp&Imhxa{SJ(kCOz1#+kXq_395(aYwCErwPdSU>ts<_e7sL0ZleI>yN
ze4y2<hMl7-q-Lh)4yG3~rg&8-Nx|&(LiDShGsRt4t-h+6(S4~`Gjb8&eVu5frqza8
z)?{U=WEBv4N;5-yHZICy2QnkWf#=a5rn)iTfUfos;b1N)f27WhVDe#$ZAZPEPtYj_
zjZRq{ELdJK#K<%bb4Wm+su3MZ44U4aN>;p!^lo_F7M&mgj+5C@(>R5-A2tyO&!G#N
z^uoXE*W$1)^*$pEF;R+2Enc*r*S>ba?(1mR9G~E04QU-UP`k6#)ORuP!sX(A3GaUU
znN){sWs;$i(p02l@K?Gz#LZtPf!nblc^3eaM26B5;tp9b2^)9<PaYBoeD|;tdK-un
z?sw)W%{vIu$PSK(-5=avk1Ch06InsB=_dk5kmyZinR7_aq-5LNaR(!~d$7i(7|;aW
z&o|)tTYW_^K&YgCe&B?lXelZwp#RL%)246~48dH>C+b?5S)NL~7}N3>)3JAC1~?Kj
z#KWYJu6@-#)XV(e^w;W)7CyOrC|j~%w#U+!cFPnfQcQh$!xn$>qbU>+O6_Gv?K4ZY
zY|ULf-!csaxEfzJkSUpj3YJ;x_<77KRwr;v`4k97E0DWt)XLk^qVlr-7=_eg#Kpm*
z;-Fsmk-w%V&TBJV46YkIZV3}Vu&b#22#5u0$Y%B9xN^kz{gHKwV=)Ya;(ni9OE75A
ztqjv_qmp%$A{&IbSbpVTD#&pKi_cSX61+{{!j#5}XxuhBhG;K_eglFl^+Ax)@>x?1
zT?o^o9|DU9+a26Q-2T$Tm9-{X2faV2c5a;NfV5#EfWSZsie#2A?~^c^S`-VD!_n1v
zFTXkvLKjU_orW-f+|UW(#N>=}w|@_>*PN5-=DVr|GcxD#C9FoLi;zVXcbG`$oU^c0
z{sV-)Ry6uzyg`88C7`OYH|E&-a1V9;+$rI$>$otIi*BOt&tBO19Q)r@1?<RY%U6Qf
z!a%Rg=*|LEQAt7Imzp6Ktjts80B5W7l25L=m+jQg#253UnWCa`WzdsPGi~QlPMnIr
zp|7$?t!C44lq&S#Hnc?-#uub;vK4|p$X%3((|x89!g@cP8GY|b*B_PQRI2Edo=t^3
zEci5PR2l9`+IBjii_u0rjsCYTgMXUy5-(>q&4yPk|4fe8-Mcx#S-eIS%r2C80n}@4
zm9v%`n)N&~EQEiXJG0}c7*DUQqHYpK#hSCfu0|=LhiPJOxr&oUH!K+Z7+(yN&WT`U
zNv!zWMZ39^sLapaAU+*HcKyrzm!eN4fRO6*+-fblwD+02i3p3kp2OSinOTE`opwF{
zyzfV>2s#*LDU6?DB{NU%skvHMSHN@SBHRW*PIV<A7=tQiFfVFpg3_Y<bR7u#evACD
zp^5g-ZnjtkH)$EYz6jf%`32RKsS=!s^*7#Xof0J{wbAiYE0Q|*Y|F&2Q#?fImHh@0
zae#$VKD#~nWbi1nP>YcKqP_A2bf>5d58i_oP%Eo`&@1T!)?ydQHedi%04|>$Jdj2i
zL90NsX=vgEl;EuCGvH%t{t1P!{4g~afdt7Rwp16Pca$C;)=Xjkl+8v~;h`VPpOKKC
zi%(S?Kbp~=!m;6~?kbBy2FSw+;bkzDpI&zhws_d~&jauAC*wrq-{8J%I4@L@8)La(
zQd?*|`1w|0kuwF{g>FXW%Q|uyz-?+u?8#rs47X($Gmb0Mu!G2vla5|fJt~|ALbRn_
ztj+y`NiFygkB+jTjE6{b-r_UJkmglsg8|+SFKrH>@PM5L*;dN0p1@ud{J_D-e3C6E
z=)7MT7L>3<#@4z95JYj1N(hCTYTjVF>MCeZRNNukg?5%rnhDzOX02iAe?m@zd*#K}
zByCrgIq6D`SeuWslXTyeQ;v?$Id_~gMIml)8_SDuu`X+TNBQXRF}&fC6e^nVNfbLk
zm${DCRUKueL4LCk{;Es245nV8#N&53=;N!uRjTv^<n~cp<g7j%&@Duw@3zAlmK`~e
zdO=7D_932a0`RYd{-)348i7A$s^@EpI3=<=<EoK_J8JHl05Y`!4|HrBj@M1U*hoJ4
znCNlyuxTUvR5v13%Z`76ROD;$Dw0T4Mt3IB_-z`o#zQ7(@Bq?~<i~3U%sZ0BzR=Pn
zQAEOso<x_nV7d<YX5aWyQZu|3Dt?o^n>gqRKPkwC0WmVAxA^HZQxbIsuXkWDHI~o!
z$wIs*AaZxAY!iLsae3btlrA4kw!T+RPr9b%;s#eTI?!9$_Kzo&RwK~Ij!p3u_6NfJ
zTszG&Vk<m92Hg!Oe-oNesL6qYeAf})H@V8&!ft^rwT@f__@o@A<#^`?kQwM)q|7i7
zbYfB?c3A7oB-s{^RDyKI{7X!@7%e2>I*Qn`ns+xv66S2TH}YENj8vfcj<_uDiZ%Mh
ziNb#=W?Hz$q*j-e-9oLh2d$5k>w1I_OlCTC!@+Sx1|7Pgv7LeB>A@;g9<YhcWfHP@
zWo4J5J71@nKKe@56F=r_TAPwPfQ9-pPmFBSM;<=^oERqFhR=Nyn+-)Vj+2s3*$Xaf
zk4$e(h{OyWAnk+B)wXV%DER55nUL%3oN1_AS(&sbpWD-;zJCOYc>T=#H#w^EmaEpu
zpmaApWU@B&LfCBDPrpdeX(aRIFYE`~eZyzQo|NHz7?UK6&*bM^SS3zoRZ|ZKulc~>
zyMamq-|)5JCdNPt)(ox5o&df9^M0uT)Cs$AVzGV%bBC1$FoZXgw}y7rk=91BM~oJR
zZLFp5K?Xw)g}0mNiwJJiUw-kg1T1@Nzx2bH^GR%@fMT8~fefo~m}1<vs>Vmh68z-o
z+B+j=(maDZ#FVc0+QhLOL~W_vw12po#%?lZ$9lo$iYIh2*pHo<pixz`jBnf_mZ6yV
zowLrny^8YI){kX-#)Om5Bs_(6-*-eDqD=sqzU?}=9X(f2HEIvQ0Y{MdzVi;Tr?5p~
zm+pF3sk^X*Y_zZc=5SD{<^m$t#`n;`W($#ocYt)=hv=ZHGEAZCr{#f{Q4M2b>2Rg;
z>a_?n@w@KitY44^{vC+Ag^CLvUP$B2QZZIV_i<4XA|fP@6G9#0>lo?Wdb0s}f%SNK
zH0~11s>_6JAs5A^qNm%C+DO{eUCpykpZgcq2vI^SogFj3b_D;<bUILjH~unJDGKiI
zPXVbD3zvu-%<mPoJw>~hj1S-*j=&U&d+#>;)W92_f{x}K30P}SNaCQ{un$?0b^Im{
z|F}kYc+%f!5v|AOFHNqfN;$Ppaf}E9YvX+=*^|_r8$HpHfIlMRm?A^D)qz0@YvLO0
zWNN7*Ukc2)N1JqQ@XI$rfilpslwzlm4j(R9wT|-_xrwdNI@1aR<&2msI*8;hI(yK#
z2}!+q^}!ao-7xd595FQfWN#|-&WtKT(by{5`5@kSxAbRpeh~`9ahw{+3}KPz4i*v%
z!On#|y#Z1D4r8`L`)%^jvLPeGSv?a_CmQz%e6IE!VQTKxO`JNcal-WcJ_z2;-ioAJ
zVcx^$Zb{*eTuk$81P#VW8YUr<3`ta__9|W?FmLzFI>fb(S;fA$i7$A8M<33jT3yNd
z44<MwR&NdkB54|L8-H;--}GLbqoooH;(b=?8_z93Z*iyZ7!48J-#wB<xu7G*?I4`D
z8ViFsg3BZeMlC-fUa^4;BByyjDiAB~{5_D!!O8&g97hJn{@!t!YZwqaGZsg4#^DsL
zX%cmN+G=A_YzqwDL4pKeFBPAA*sdBpYB;+q9nY5z=UVx57y+?`MJQtZ1*cS{i1F<=
z9I~|R=xU35^t+zT6IqBgfmL;cp^%U}XI#0Y!y2zpG<I(-LzWw;Vds^-j8k9s=e8<s
z(|g-Gbbbp;%<S&jbh=NXTww8@aTHYbMiEo`&5xj0ntehXpkn7+d#-sGO%k+_+^`Yh
zT&cLi6C(qo#RQ+IV*(t=yDmIZv1nWyEbf}?@p)`6e?)U6^FfIik==OJq<bB!8-QEo
z*i1pD<QkAw!1nY?bV%3!mwqTispM?pYvN;T@~<LnM{*c)Bv~%vI<8K~&K=@UH~MZX
zf)GC8AOAPtGic@I^U^Z28ijA1H5veVOxQ{+ziT?Z(Z4yQV=$nTBhq4`s|IJSzg-hR
zljXlEf~>Jy)7%Mr(5|Xj>;7FQtO<YaXP0AfpwXfFI7ti!>%SveO-P#)>E!f%DI?qg
zN2gZQZ9iqc_(w*um!1I5bC#K108j8Np$`)H(}560$0Uay+y-6(!1};Jl94OoMWU_V
zO20xCy-5Q3$rPYJ)K#vyxdF?pq8jx749%7uOR5H?iNwTmd*7^S^jAA)Y~Ix9D_ZC$
zpC>599FqmtQkD^b%x3k{Wf~(SQOx)rY^ut<4(_H=vBfXS+`HSw0G|xcOnMKaH%FhA
zy!5e?)NfxnHVkv`TrbRfk^GaU=U(xr;ISMPsbSASZ?4oX*XO0dPJCe*Fsi&?JoR<F
zwTnR0;^ORg!o%TIS<;B?RFbhc4hWH^ku?hNif8U_y{OMutDp*H{Ym_FU9pL7?ni%d
zCp#!^dXH#P*?I;HSN->0X>*C{j5-@a#H)Kw-0;%jP@T`x`r(qZS7tFh-k=Ol-^THw
zX0NJW$D-#}w3o432|u8}06Sj|VPSWhRr#uSGFW3P!$Pw-NRKIYR}P|K)b@*Oj!wn{
zR&H{9NtI6K>Ra-{Lt{$vC|bE?@Z7r%IN*S5k*3u1ksGgYtx{pe8?u-U>x9^`9BsF;
zlan?Qnv6135sFfk!i#RFNKc%PsdlSSbp|g})2Nr!U(9<(&FsWjJxefQYqO_^XYiS+
z=Q7>h3-NFh-*-7m<~H7!klCcy%RZqBsB!zJuWzFQAf0KQYgmdzuC*p+6Iir_S}Gnd
zE`09xuZ;YH&|QF7yM5bz`<S#KKI)@23Poz%-AgREVr)GF!}O^WdE;=XXUdU?nG5L{
zrAByB*mR-$rTgmgEwHKvmn0qTN07=oBKQZZ7FcD;6!uUd<=lJ*_CY#lIq{R2A^CDA
zDUNfU3wlTY!_33W;3gK6@Rfo*V|QZ$M-2r|t)Io);WkZjmI1S`D<U|9Kf<86)6t5@
z`XEo8feb^)kj;6b&z~s)+F|pWYov7Wt_heb$_I6G@_NM`q6!U<HIlyyYXpoSvsWdo
za9z49$)U@$!dO|gWtSBYPJOSc8*yrHKYqGMY9_Bpxu$+Vi@e<!ePC2mA<Oca6HBnY
zEHk_mGeg3m3B=d6T9mLfPxc>n5&v!nV+oY;t+twq?xKd=gwgsu0q#7qSZEVSe&|K|
zmlf$Ro&s6K@Xn)mWz$DU>&X|QDt&#XcJ6sFT;1tOa#N#-d8WT?CKA;M>Lg6Qd{fua
z_K_vlt+qunY3=sNzwCxbfhuFrjFIeQ!cyjkRFoo$AY!%8zb5s?RKtTuz$1|eXdTI(
z7q@j6(rF%B;MS{*x0J!tJqZ<sa8$@3GA|V-TeLAemwO-cRC@=ox3`wH+B(i!WGPzu
zj?j@x;%qkEG{pE?JS5eJZq?~NG?CZr#^<F*3w+aBb?CR?i5$m!!0^yg5Fq|vUpA$$
z-P`L_EK{pNA%#9O9k-6bOsyKx=qm1-UB`z2KDTWv`+LZH>gjzDu~7c{W`I6%=)oAE
zlmto}!o>XUMCxYiyEMt_v0J2a+Vg-%dcdgm$iP6=zFSV~emno<KIm1lc6MoMb*NTh
z@fhmLtlJDe;-+bj)k?j0S!!n9AY+?8k}J2v1l|4!D#D*DE`ZO6V@F0=mJR!kxYFsH
z)GLIzDwPvw*)G%zNrV~%Aug>A&oUJhyY10(h30$8<CE)bb@LtXOZHeTq5xActM)1p
zD83$PJ=7P)CADJg=@iB*v~X#(LlrS>*OG)~RaATSHyJMsf|*68pws`6plSoHqL7GP
zdsXyVOD{5_Y(ut*NvPqWt;4<J@8+?2%#%;3_f*z*WrjCsxz?N^!9slXy*`#HV3{VE
zI^^lrN9bpx$5RPXW&kdFJOaX{>veK0^!itM$`JAPThxU<*NF9fgFXJvFTOUgefWO>
z`C0xW$j{00U(Wr1Hhv~{2G;*t{$DnJW)AlM0mv_(y^d594dx2nL)g{{?z*}+Gm;%G
zWk=rD3E~QSb8~|Pfw%R|<T#U_?)cMtu~T62$lLAV+}o}4N<^-pl#k9-&kPi?xgKzq
zj+y2LK;%F~MKmQ1Kt`qlMn;C_=HQ?V9mjfC3+nbjFCaz^&8?Z^+ZM(F1pDWfO+jd`
zvotH4R$yZtt8WTQ?_^K^<VfEDsE&cr{&#eKCLWx?;><uFD9#W-d~+Qrdv9Fi>S`O8
zc53R+ZTQb4WFAuq7=xpu<HC14E`brSQxgMQ6X+Obz?47REoL-qH6WGC2%13Lr*ClH
z0W-M&l{*Hewzf7VjCB^q70&cq`8hxh8iAu9(;Vd484wHLmja8x&K%fV?gqx*IAFyI
zn(VKJLOnBRI~ErZ;4PRXv|(QL;wPS|CUPF}9xtzeh$LE`9(>bxYU5Qe&KbZjA1(kh
z@T2bjPxoi609uQ$4I2wvOJhBIlXGhwD{z{I8ZaQ#K?4i{I|6Rs+{zKWn2;rT=j(R}
zT?pDri0CbxuLV0u7&Ijy%&ydztH10>4B86;IT$(gC4Yp`7xC05XXJWD*xLFUfb}2Q
zJKr<pW;+n9Ui>cZL*JX#iIth<l}CD(<~ml!??MD*Q%_M=O=xh_yri?<>>Zgq-_0pM
z0swAgbaHHDXn->SfDX(|=AU@M<!!vTQ=&)wlUJ%P-s|ftz>?cwfNol8|J&a^-fS3c
zKY+MG=DE$sT<Bk!yQwJvWN1T#J_s`tedu4;Cs*dVC*7|dpcph80PB)hI3qBI@B7!)
z)Em#l^tE-3&fn{wQ(ESUiHXWd^SPhWlU|kJ;Oi}boGB{+4>T7t0A^%za=*v#!Oz}9
z3M`E;%~Adq$@Pp4z@M<^(4E)7k64pb-&Vlo-q0YdyWRey>zz(?h`f)^b?3CT^r&6m
zwBKCKpIO>p-|YWw<@ap-ttGKHwY=oVE&I8?|Fvgms;_hTZJqS|<O<vo`!jRnO<?uA
zs*L+q3z!0&p~kWKbz6ZlcIQnJWHnv&%OwR(ZV%0#7hV85w)UmV`$*rpf&XY?tq-l#
z<k;|b7!Ekc%*^;byYU%^soBj>EPEUMUP~%e`Wg=W?H=jNaOYj}qZyD^U7tOUKR7xt
z1IXay#Nrg{+xzZn;A<Q7O34b?@x8tQAPT0*J@<*$=h?mkpvW!u#&44zh}%c;6nd^Z
z1gMAdlgR-XMdXW&?x*l%djQ4|@hy^71t419d(K-jwflsp_(FeR0K`D`BSQlqdi-xU
zVq$j)Oi$@MbH}jaTV(5Y0_L~G)mYSbv6Jbr_bis#gykKa2^howx6c)@<X-_b`BxxM
zd<i!@K^$E@A74`+Y-3$BhxzZiRVID+IvFni6{gJId+#-jU&M>=YQ3gU@E+>MU+^9&
z`!DdGQ|FI=1@s$uH+J;h*2rD%=mp+O?&yd7N0l6to13erbtCujcgN&+pMTehU=G#{
zrngJabPC%{9ed41mp173pQ@rC+&jggwqKB6ArBn-0zGs77qc`Wy`D&ss%LAIrp9!g
zlK#prx4GW!_`NcwZ72IWB}eV6FKUg#Wd9n?i*DyJ#?J}x7+kH!BY^=?F5ZwojYuEF
z0zJzwT)h{HGXmY%`u1-ZHK<8FN2!y1rk9wivwa8+8{li|?&d_ENg?5~_RD2#()uRb
zJRo;Gm;U&Jc@dKrF8rN+jdGc0AhD38nRn1OqR#@|Pv@yoKLHEl4k3^NTUrIZrTf_I
zx(MB<`B{!A5=Ou%*>|xMMyHMd6~J`rG`)}<50^L4(jS9za?sVj>7;m%GPOZWusS{X
zDkcizVtjjSmLrKXgSdrL;?I*m2O2$}pEu@C{0ue?sguOgTI~_8+U_JpEeMYGK)h}&
zYh`_6b(tyoL{`|rGY@vhgzlv2Q^6M3UvQ6c)U+5d_vN=9?J-9%p%Cn^>kuCx=e@RQ
zI@-7&@~(!19vB^6B+|>MD2LS=5w2fWNUq((E647MsEcAU7(0i!Q`^||;pSs3CxrtO
zKL_<AJ7^RP4`~yp<pmZFY(Br{jFOWGEnXEv6)$W|m8YiY7mj(1Cd;<f08z~651c*X
zrC}fYJC#y=e`ym1<bvHtHX{|%?67@PA$Ew6^OH~<Ss1_1(6OC*&m7>f>ZqU`7QdPR
zx+uUD#2}<A#g~LGxi2q1%<OXB2pQ~Q)rRfYS5Tj2UxXY^Sj_3i!f*cIFQ{E4ph4Ln
zNvL(42WBa4_epo{Q{JP*Y7{fo*8=Uj_G%q1MCYGDlQekju-`|g)#fDD8TRHCGigCD
zz+p8WNR=Ycz-7JQBv@Tr+1O}FmP8ejb%bcE@w~b?XI&T)$S!PGVx=^Tz8Pkw3OCkR
zzu&0T&v&g5XHU1tr#C2X+ZP+V@71h#PLkr7l4)^stCG8e6vTjKidkO3d^0_}i+{Bh
z`ZQJ=l?YPlQ`)o1i#qp&c=%it>)HGgS&lHCSa<c9pl3WVV>7R*BpnaxK;DIdX3DRT
z&*)9BSx#<q3D$&WLO|9)=dL=1N8(rW(pr6`cuq}6qgriJMU7<SjXklRT)`xEaT9Zq
zaZF;j)D*NgCJ&u=7w^F$zUqG<Jdj3vIlpV5VW<`>AFH||g4PQVbE1Dk7+NPPvCHcW
zV;+?1sqI9`PO-J^G0`O<D)o<t1tbj<G76ke-Ux?*Q<YnE*YJu9<+`-4UZhHA=~_9Q
z0$Tq`Q+%=5>iE!GIO<SJ-V%XH=@4ync>JTFi3VHCL^L*s-{EHE^&-FRH*I!#zj`uy
zZu-62E-O8};%O%u7(!UP3y!fW?3zqBKC5SI#jodYWdWl5zZg4*USYH_U2fa9?Qh$*
zZQHhO+qP}nwr$(H&#04|^xzKHKX_O2R8@HRv{OeiWe?h?KRltap?ku(_h}Kwmh{CQ
z5ja2vNV~0sFVK0%Ypr8@)b>l2%2R>ZFWP`%(qPcUtTjbC$uReq*TTF{1m#s(z~{uZ
zeVirkz}Takd-_&h2@@hJHR8Dj-L&L7(5u5*PU_EFE>ABg?tpymj?CG|c!SE!NN2c%
z3^m+!)np}_gdbR)GkN@S?VWW(Q!@@*B5dE2lXoEWItm1#te^@p{KXjQoF8L&%>Ir6
z(jD-+aqlosby)*l+;HkNk%;*DZt6LgD9hztHo{2uvejNY0im$cZnsLbX1g76g$E)~
zFJuygoOTiPR^g%Woc*E);W>%UXq0rXPc)Xl)-;|_5pH3ius5J_Ww2gu-oco|`|PA<
zVsIST*{;k>KWJO&v6c2v)UaI_KgfFn>VDa}<*1NdS5ThBp@gTb!p;-axXu2F){>vL
z;lHYMIBCD67M2f0f!Bq@)<WVq<MVO^uVd}Np@psUsbTm?v6h=|Uopj<$q)+XbD)ls
z1g#(h@1I>^UiI*dJ1jmqS$3reUT4ZQ7f&WhxrUQXyHJ=3(g^G>VM*wpYXQC<4YdAP
zg(O&vbb86~O+AFII%9?mAtvJHIWIWzS!X1$U&YvuR-~~43!ef#JOKq9GfS7iMk`cf
zc}!K*<XlxYUJjORD*b&HY`(Gcu_l#E6SH5<-gm;1UDaXO#j)hM5?^$(cWzI!e`=XS
za1M^*d!iysu8R>xy>b@8X<JZlXy5fVR*A>01i36*ey+|UYJVUBz9_Hy?H9Z@h(a28
zCDU(%zi#4?uwheFNu!S;Nzlv3>(+6qRW;BOt;28e>kD`HbBux|P|c`dpux}Eb3$h4
z5EN)K%Bhp{C(O=CYz^#r5my5Of$m2d48}Go<Djy_rz2=|5KqPvf_evl=x3L@k1^3c
z@^nA-yLL6~!&|-_r8``Mo$8iI%m9Lps7_1|+!>ngX4$1SK!Xp~jPH-;DX!j6-xj};
zFp+!9_~8=?BpRi)_$My#*Q98gwUt@c-4V0AFWWM(+VmcwfsPY~h}iLa+^LR1yk(X`
zo;r3<uC@M2(kR%5w@XpBX7zN$J`e7j=39j9>X5JrCP5;4mT!cc?SGwV+WaYW*qm}B
zO8O#H5k={Dnv=D+g#qDOVni+D0b>o}N~e?V97ZuVrV+pl(FHRQ%0~jX0ftL;9jM43
zxR0x-Q(q@VYx)C05*AS<_uh+wRT0syXJ$&pfp^K7vm)4+OKr|zIE@VV<{y#V$t5eP
z^81cD7@hPgK&BXYT1}}E;UXJMHSl|cdnw}uwkB`643pHbwn|z1kH{VY%gfd*FeTYL
z0u#WxlJdSXSqgGMo#rHoD5_AXuSTnB%7KqgkER5wd)79+7pG<V{P<+Qr4uD6j9`8`
zFV4xtALFT)BU4uoEMOD%AQ=~cw!=<3kWoWz1ZQQ0YXQAqm8^rDX6E0vC-xYb8!QBx
zFkyhJGVHL2Lg)G3`LGz(_BI(^79r3>DNHvPvy2x?yshZ`{sKnX%xjsC<|uqtyJBzX
z7<5HNd)q$trL}ZLJW$q9i37?%OPM^K1Le%L6>l<!I>0l6jDQ9UxyNj*j=|)^^rC!i
zjpM62_?wAP2Bl~~$quIncEXp~NjMJ6(^JduwS2$V3!@ek&Er_xX@*GK{4))ZWd~I7
z=Qt~DKBnE_hABhaIiY2QsWmiAr{Wh@b<eFib)-s!($8@yQ7T-0DVRdbdJRL_aAY|f
zAMLO!z;%4^prLS}ucE??s5!hPgw9Wd8}9YY9PebrPCV1_Sz7_=R@-}2?07Gl*RTH+
z-2>q?KKs`-A^){`>(JISFSL(H9D8YmsADt3gS3RilMIG1N{9JiWcacMK>UbBD1+bU
zfYBV3A)iYK9qdIHS1m6fg>Q+TXC=U3*g<^rg;V@=T<974$_jT^+tbM!qkc=jW0mI3
zJZC801C_V2H5hc6C!)3!B4hO;JE#zo=MB2uN6zKrFIGTQD_TU{W~UkTSn%STH&>nR
zE^8W?A}ZvMoY?H`-BCsHplE6^%1E!E53@o&tKu>Sj%er8cxHIRCBPs2$&@+!$ol}_
zRq`?Nu#Q{)Gzo`jq9^%b5vP?mR}193j7GvGI2;osqtkkK>~aWr!6p3rQ{^ta=3<{r
z40V1**a|(Ou$g<J4MyFLJsa;pWd8s&4EaqMpIReDQrqexO|Ba#_N;5pW?==fMWT^(
zeYm>kCOJ@{DrH+NRmr5Y`Q@tEgRKyh2!euf_MFWOyed8))Br|TNv%a&DTMa)>``_j
z*XQaxjZw!fcecXQ!ul`(F_yRwa)HCXeAy_PKHT?ZsN}=JJNb+bdAG!lHbPsKco3?R
zZU(XUL(vJ^kG&Hz|5wYutwsab6wn?*c2OUCn>gN`@;9RvnjC+q(bl#<XyN*eU8-?S
zsO40LV;rD<I~=uhJ2;oC_n+nitFw@$u1`Ihpf7bMl^c&2qUDA=sU>B~(rs#+u@&p=
zSb4z}v7kh{YtZjyJUcI2C;BpsB9H`gh%9pmf|52sw~@eic}6gYU<6<(s++VxS5`o`
zlFqCG!KpC{KB1g%0L#sLJm+}*n0zS=r_RiSPg9`!t}`VBz$x0jedRw^+p0;PqSOP0
zm@6d>ucX6fLi5*HLZZTf3|166u>uvic^@Dd&S!*w5Juy4@4$hryd3IVfuB+Ha@Y5V
z^~D-K`r>_+e$E*gubk{?Xf$Y;((<u-Qq$ufm2IH41@gXR-ezbv_tssjssnPB-9>8Q
zJE5nvsR>LD3W5&P5Dcf(x*ktJ_{*$U4@r}&_4wDW7o5#+%jx2$2FCU{Upn)g6?MV2
zPN}p2zpW>XlTa!0o62y8$*p5Fx98sQHxq8>27<tZRA|b+xd#*{QxRvbu17fpVdqsK
z28;n|8zItoA(OnT=u{i`uk4~?jfQaZ0(EBDc*e6_{VWSZecu~gLlWeF^?I^wq0Qrv
z8Vstgc3o^izA5;qROu5L`>c|!fpSth)pXDejMuLXmm;6?Ve(;NchrWFuhu3#lTbM8
zb8IroHqVR(xQhf37Sw;&F3S@Bn+nAiL6#ij!nU0!uzk>+@wbsvbu$;m+36{xe(MsR
z+I4>I(3two?^GB^<LBr|Z5oeWW97WfuGTX8`=rg{HlIPG(KilW%(&hA^_Hu#+S!d(
zUPxGgjY{Cotn=OvVlVL2zjTTfVb3ZPdN36p9ejQl5<5#^;;ZQu(u1FKUT=A}AhfU@
zDg;)eV%PivMhmJqR$bvQ9da@>QHn`g{|y&^d%sY%_;G5<iCSd4)ZkuUj|Rtza~7OR
zjf{j~DW%nT-qSTK6#oTDl9>JB;bx<l>RCkhthfGE+POCLI%}?$ZW81T+S^skBiXX^
z2%Ghpv;B;8?RPZ%0)QIs9S+m>Um$jC+yK`lSc=$y6n_8c(tJ58I*+s5h)0-l_hqA}
z(@&@T+l_f25rM3+4_WhdV-&{0Dv%`pSVKiVtP<<06#{wP8)hzc=#Y(~n>k@6e?+?m
zfxBmQb*REl%1EV?cu|1=#kMQf#s4&x<BbO)IOabkxv_I7OtWa<e-^k7VR@yh8Wq9!
z<xn7wi9IFlL$(j^ALz^23E>MKWt3R2`RgFHH|ySeo)Un1+RCl}E>Ev>Axak~(L(}n
zw@IR1x;J9jWC*NuX4Z7`(`#VQX|wyNt&AU1-g`Wcnm^%oUJ=b%q=$HAfP^#BF^Ded
zN>`2>)IAubA-=UVe2o$w>jKN!)b<@ML)%z%7%6jJ-vmEEe;mb3X>@2&dy=k87vibR
zphdpm7R4J^5gY)Iibw_j;IM&%6y2pm8_yZ>NL`>$v>r2+I=C9;`Bt8tnl$dWetwT%
z)Z@0m?UiFgtp*JK=Nscrw~K)(w~QFw_WEm+q>8Zw8k=%(W^iNfjmY66U?k*KtlD_e
zBWtv^8AllWB&_&BksebOIG}Rde^h_=3AEdO8o3Bh5PZoFR;}=C0U&fkBF}LfuYyFM
zz*B{;0`-BlsptOZqNWxt(AqqHPXgb2O%7mk;&HULah5sPd*%Qv^%UCdgAt3{nLCT$
zt7LCvPOqEh9Q#P9{pDm%Klk64car#6K0inw$yS56=v>=6EygGVtoqCG62}hY7c6>T
z1$V2Bq|345S<gQ>`6U6WR#JVRB?adjKkBlW8e5f23iPU@KV)Jt2*xtFJM=x-C5eJS
zBZ@1H&Qx5hbwsEofWn3^lmR_UvPDm2tx%cfK<uD=$3dn|rgitfrpV?QW6f>-Ir-}W
ziloj{($5=9WgO3pthQqklwM)**X-n@#B-Vve=L6IWKvB3jE%DPWagMH>+4ygsDSMn
z4!m^bPR>%EQO`?K1+Uiiy_o#j;0O_%<b8SUWu-e<#NJvzeY;ONA?G0i4U{WiAkO#*
z(}OjIa3u+kEmfI^=*OaEy4&G~&zfp#>86-KvB&)Ib{Uy)SvKzXeV~tUMWw-YS;$2q
zU>m&pk<wiV#id^r(=db;JI}Yo*+SUp%LGFWqUNoDfu;z7K6=-A<Lr2KpUp%y8&&mF
z{u_rlfdPm%WhqoHM?m8}C!L)J3K(`70kWj$YNc`$W5yos9b_o(E))Fpy%N-FG{Y1d
z=*AbbFPyAb%eif;Tz5C8fmmLfU;gNztN?TQpFT6yvrUot!O%0^QwV>%vAS3hij3mm
zs*z*I($)=ofvKQYWL?VOX7jFYg#qZ_26hImbZ5-Qp)12)MC=}hDRXpL39|w)Ye(%z
zj8fSL<;#({NPPFZlC6fBX5!&|Lz$Dfn0!^422CWjA=wbae^6olMUhYE9UWh=*0<wn
zShq0af6_&Il7NXBNq|TAl;J+|&LH~>7*^i3I!@`L<38g<IM_!Q#R6U!2IR-R11-B#
z;|t-CHq2hdgjH;N9jkO=f!jSf^)C0Q?`r%PnmC&-G0UuRMP~0sP6+yv*Tbl6=}Xh=
z6wjL1<Mcr;M9JJH&en$P3~dwz#Z$rs?yxCpfO=KW9>yj_R&!}Lo12tvOy{|#kFc8=
z?iph34ovQZz`58;!Lph%`SJhub%fGJAiEI>>~RGiAZG=B`6h?U(-WIxw`mG=9X95Z
z4G-_dri*0`fd=B{{pCLsY_DxpIjO}Rs)x#{+iW(VY%_MbgQag_GWbk~BHHz<m&!8C
zHFXD%XI^IN#1!Dr=5y22!VEN{Ej2o5lDcf}9{BVbHBvm;@3+hsQqpm{y$#_bbfT~)
zZ2acMTOxhB-2N62&KoW&AZ-%-ush!EhjU%VVfT>weN_Z6;ePqOSxywO$~0dHt2Oh*
zgkJhH&~KPT<E$epmZKyet9(Zl?p@p@ez>ajYz1O=Hkuc$vx>d^L}u#b15+?sW#Vs3
zCP|C_n7-Z3w#3gZw|8+&ZAcmDI3ci5TyZdYO?IzFZbai{)N`z6j{O{?8|X~M*Wh9{
zd6X0G^Q;W|G1lQxU0l4+&2ynYyik-5A{mbY`-C*oSmxT%Y#+`iMz9|$I4GlQn|Wb9
zE^B;gj%Pc3H<z2$dIkyNMtJUg@oD<fJ_?0GOzSyR37?<S&V=Rg0ysQ3MaW8PL);Tq
zBhCF*k|u&lNf2qb=^D3<yMcz(DCXJA*d8W<#e<6Ke><&A1xMgMnhwlKnFJa2)u24v
z9iQfwu86yui-IzTrV0TLw$PevO}u2&j_q1SGN{fU>IZS=l~h&V_L1xVftV6{UY?7g
z>x&U~={xNRqBN{h?uV2QS_Js4UaRyPbZGu!R5VLmxQuvEbpkT$<m><7yXdk3q{+x+
z3hdHgh>`RKw^vk~oifw+MwV{gvou{@4P2nBFPI>pp1cvDPG8zO!e0{|E``5y2W}aF
z^|$KG$kwI)BWGM!gx5kNZy)^TPRPX~I+Y#ytNa4&sBR=et<D`LEPDp*^L!u<eT9kd
zBf9^a(zL>&WghrBVXs8tnx8-lG%BD=_Yvnv2INO(@HtuNVwu*KvOZaSk^qlcnEZ<0
zZrW;$`z)PMaQcLz+@w>_H7#RPWSaIxLf0lfla{ftAIRj2k86O5|B^JiEf}vtV-TQk
zfGKu&`V)I>I}|jLM*3(5f4UssEmWR862HGHSNrlZ6K7Ziz@e`ys{WHMZ7=txA?5of
zDytp(VAxy@z$zQkvc1mgO(U96cM_zLn(1feiSyRl<y4z7vmvXb+c+rU@u+?7)qWj{
zh-;~~+xa0C>~@rV+ZHn^B-91sDInE3@L87TbNu2PsBhy)uzuFc9l~u9%D$FzTd&$N
zmJ3NgtU3`+JufFk^ts)AL}0ljatIbHWrLS5_I21gHKR8mB{1>PXGfsb2G%q5BkH)#
z>&8oz`}2U{`~h7d>@UsDcyaKgMxS({w63jZ{8|Q5h=L1L_^5(h7y0LB?DsSGoeUYB
z%cFFCED1k<>E=914D#|BXKr0ofYeGu?N~~Q5nu%~Dl3z9YbTtb|5f?^EHl(amabf_
z%2&AYHmW;!#4$ywS><=3pMOjPE;2hbDd}}OM7(_YuD(83`Vvs`=tv~s3VrCkU)vpV
zgUWvuyKku}2dbm$P0}BR;Adqw{WV>3WLx2sD9VgpZ|oDYK#|ulWTJuc(IFS#EEaw`
z?cdU8N!v2+Lw*RUSs9U$_6)EqJOpErDyLN&jGaETjDy?0)fUA-LH|(0QH&clgSRNa
zEmH~di0biB^_g@usWI_5BzuO;C@||2+)L~9&!Gqq*W;yK<<0J-BK>xwV6^BXRDvf`
zz*lI7GvrpqQ3AHOpS<0Qo+9hG?7(!qlcPpwmUtV!6i?MQueulQ3(2Q7ZGGHjC(aR5
ziG$(tohUO&PDYF>{oGI@;Qa~eLvh~(hDlGM*L#o@#7Ti9C!Rau)j^bNXhlN>@Zm}v
z?l|3wGr!NnAZ98hk!Z8){)$oTI|wJN27QDQSMI^woaq5NvO@0+NznSdimHxq2r|2o
zeJ9y5bV8|eRKRVwCql=SU#ZvSAgpKAPz64DGT0l3Tc*bOuF}k!uQ%jCRH;;6RQ1F(
zipDBINVO;Jktg1>Mra0Wu`PHYY`b!R5a#{!p(;!H!l=YzoDrTQ+yT)Q=k(F&V`xN|
z3;F#$FL&RWd;NXdje$h{Bl8zEqV>WCH8~PK8e4{Orc2yHZ?uqCj&cxBd@5TKt|&g}
zGW%QKsVP?BM|o8Ui~|>nycEZfY&&cWppz(%mq5h8+fB8=3A{^@P)VDiDXGZdwyWkT
z=C6jkEL|>A;McOS3kWceRdN9<SJ-i&|D+<;k*VyGngue@fN5pHAJ7N)#P+NMYJLEx
zia(s&n`(fBJR6EGmy!_TyVi1Q+s8djY6<~KBz`^|D!$}&D@$u}O&?&b1fQY+L2mW4
zktfHPGVPGbXX2J<XgjfU5~aQvOA}py?op$xiZZkas0GsDUUS7A6gduv^)SYigmEMg
zH_$Niq4+<eMKs)@KvFoOVv4Cva9%&()A<rpb7R^xDJpC;Ox1n@Nv_;T?SHYKc^#*+
z9`FzY6`yzX#~D^ULA56fhsIPocKNzH1$}_ds%-r4MqSg|<&tN{uWJ=?bO<#BU|SxV
z!S1{xP6x?=hyW#5z43@RRhlnz&o0x%e|Xp7LKv_N3n*I;@u784%mF_kRMm04EoBm2
za{?8+ZNs%0Dl-75@FBMf4nzt*G^TptUovmko}ChA=_33p0Bq#<T4*>@xHA;!WNL=7
zah|Dzx?l<^;&(BPK$|8DDdbo=!5{VLQX<~c`P!zA;B#XTlR|z~@#-brSwkoyhSOqI
zv)B28qEgTH1*bx0<2H3O4R!L4S6Bg;aXDF5NmQY0*6A!q`zvZB7&EqIToM>yO$l~W
zeP)qf!eq|<xVr9@+V=A)Gi$yulIQx2kV7>{ndAyJ8t{6lzFpU{NM6g&<cRl+>F{D_
z=iuF%ZkTOyrO+SG^00e@KF8QP6c{=5ctLKjO#GwAlmS%z8ehCNDlKu@q7=Jz{+hF@
zR`Z9OU#~#vrtU|5sdN8~S5d|CBFb|d<nY;3B~0(#e=4LU$xkmq74f-8ZiT*l1oc$M
z{yRWD<qz*D^N%+N<<vtpW*GSNQZ(IjMd0E4Z4agJI8D)RqYV`QIlUeeSYT-Ver^QR
z!@7hxM7eg|AIW>Vi<h>`XI#2A9;_>}^D<VAJrIjQK&N+3&?I8N{Zqep%2bb-gc<er
z3^gRVxl*I;%%i$2i^47w;Y@<`0H{ahUtR)@7HUi=6^BNnG+=c7ctPj3u(>S)W28QV
zz7!`)Zc1%_cE^8s!r@pIhZvAK%nv)egKO`W>7vx9B*_vwqeszv9fo3d7c(G-ADA#w
za(8+WW^LyEPjS{^j>&<Vxt)BC?|`4(!fVCZEWtG)a^R5Uz0w&I^P=SwQQY9Lv-MjH
zQCo-0G@jvS?(R`3VQJKYt`Kg7j!`uiS+?{CR^+h#N(Pz8yS{t&mOcg(m950GD#$EV
zG;T&k*{va(F_3gb&JkU+xl2zR&lv^Tmg6PZ(i8jd!f~;Hf$Uzxi&cS1BvHWb%O|wd
z##9yTLd(e^Y$XU*(AG;q@3=4*bgGbOlcJyoU30yE<-;}_Hnk;Gke|1DuXBENg^eOj
zB3{1uL>jeo(OuNYGM}_|>e-6??flK?JX54h;?23%udzw*lq|Tv!(@>x@?R=-)%FTc
zPCiZYTZUmW;%xt-pj^=?d2!Osm3=ZASM9d&YrRwtJOVD;mmEnUs!28Ufv?7H!3m_O
zyQD}X&A$X3@As2`iQ$z*of`~kCFAH-xx1X2F45vx!iynGv2{D=GlhIJx?evpr(7B^
zJ*T>qDwQ?|K2XpmDfp>)VDZY^@`-K14CKhlW_&_`Dq#J-sOjoRJkesySpu2PL|&Dj
z#<6vRDS{5!-5MRRaU42>$zuzAbP)p8Kq(!_F`!64V4@AFL%tFTxxTZS*2v{KfWO_2
zi1U&aCOWE(xox0#XwpoN&%>+f{}_w<*4|Kd>(nTgP;@IROkBgy#)b4Gn+x!J@+8^l
z179}d=5zc2r0dQPQ|y$B<cqftq|1`QFz^w}^}gc7Eud9REV_57r$l`oEHKXO-TpZ_
z`F}i1WGFN6p@^x>z9~jvlRx5MCN|s#O9b%#3z@z&UpC6wH)WYHhSSiTx3NA}`*M?J
z9Y+no-oH_+D%#=ynFY(dH<#!>31a#-@_y+AV8d1qh%d^cVZfggcStnXPVNpm>+Q8~
zwqn#<w%SGgL~tvnbZK+ecRxe3DGi0%haYRdLWaq?4y>tWA?6Qm+p<{|k+0S9%n3#%
zXf+riX39yzjh2&GVYs*81m6^@te9Y%5L<5Y*}n<XYU`m>(b&0e2w&?eN%D6poeXn^
zV>AB3{U^ZsguFuhHT6u3Sh+!61uU?PGWO16ASJ+V1ZF69d6{6oSCY=50%#Sg>I_Nz
zrf;{k#uW{KRxj&!rYyv-$5z!Pv|7B-dY%^TZ1B*b5DpcLc5=ib2lsGp&F?Mmt&G9o
z{U-=H`go9Vcsh3XvMMJnr`hQJxL#rftM1$qplqOMCrt8dNH~HU;6)+cgqFa}v}m_C
zj^6vVvV&GA<T2O>8Cly=1mZ&S*5}&Tl4h~yF<H@{oyryC<JTj87vYGSitsjZL&`kQ
zNh(k(K4k@RQE7!>HmPK#!*mWAf2643@X@R|kujD12{TQQc**@TYI)Z+LC#Rj6(b~Y
zC<UPM<xt^M+t=Gj4qk@KSU%`)7-+CYS^|4Rfx}r@aX#vSvu;J^z^&FJ7|m(TSBXv8
z|G>MKWp}-Fbld3mtY*<`LR<1|$jkN+)RZ9zfPN+DE0TK*a^J95LbF_xHkPLSs;mu_
z4>1~$l!3yVqV$BCAaw&2OUd~eFK5_TrE(8lx-d3nBa$DehK?ABu?mIMUodT?u<c4+
zZK9(kuL%K{A~B{I8TW0XDjSD%bRwb7RRTA#B1&@9quk}rOBQ{T(>SO`344{_Y)3U?
zSD|RTnZajlkP8w)#FlZbRx=PR7VTNv#aJbw=2Vh^rCWu(x~4zac#PRGC}Qy<xUjA>
ziDteHU&328E$UM?O<@UdOpkuS8`tC{!m;f|M`F7(eE<NdX2Ld~9o^~{yI1Q&qd$U^
z!2-+S0W5e;kUm3UMr4BKH6D6Xfn7x9zjHqasoSSaWDK&?UbqiE>w{rr*NPc4^ctK3
ztz4#Uo5~UMJYEY;Bh1AO7PQYEDl8`(YdTH%XRpZ{TP$%aBdAl$KppM%oPX#8>L)?R
z4DocGKo}eOoe*st>+9l6Nb6knHBA;zUcqUUp6W>$$X3jC#%A@>Xhy%0^u+xt(*x6<
zVs$G<Th=J&Z`3q`<lK<CNbE}$(saM7)iZa6M>*r6@2h7mSXNEs?7~P#92W+l_A4@z
z^DQC3aI?THcW=r=@cAt5hm*+}HjI&L*{l1Tc_x{d0nlh!fCnvtzO}#k-Rer7kQqws
zS*HcA^2!*uhQpXQTt^N<_t<%(i8wA;VQ}XApT+S_*4_0n(&6C?wEfdEr6l8J69-gs
z=13zCdr(i~2h>;bUM0-Kn+hf6AjHzbCBY*zk3e>uHWg1EtgK*bhCSYwFi6dnc>waL
z`%P|CK*n?3zU(e+nj-jDpgCm&p};JND@f+YkrNb2Ue_&=P$RQ5B48VCb|Ab(WFgvX
z#_dwj&`FB6NF871XzrE1?#2pl(v5c`7__g6?yG_K^ba@?Ct7ow`aP(+J0m~_K<Bw&
z_4N?wsnKp~w7vy(#)@1%2?m|x1Op)9ry6%eu1mYKXQ6j^&Wzl;6-7y}1rM3-nRcz$
zo?I(t{H`+z^JQH>%Ki+mGSJ!|?MIZ&`}2x&Zv7AsEj-U6t{1E5tXAOuYr+|N`|#}a
zCizZGgh4{1p3O5l2-|BVq0FUi;)l_icn?_R>Tq6KKRqiZHi*xT%6jow*i|is9@K}{
z8i=~9qinD9XV^s#dQbYi;5pC|rH%dQ<j~iD64Z#wP~2lculfR6{ASuNPn6G23l4XT
zJ<`<K#Sr{l)cCe-pMqUSH}BJC(`7Bx&qC;$+C(G9=bVUHQrP+Hw9X*rCqG09s6ePX
zYFwB4=|&w3tExeCY8_9u!Aj{l-Kc=7^78(aNiU}IPW|U<=S~uRPPI3`3TOh&(YsZF
zLR!B4yfj9OiC0z0!)}}1=obXUdKz!U`+S*W)QM?r#EL?X7*fe&Of<Z-2L{vH9rF)>
zoa%nvrcxX-0N9|pUZ*P}kiRY{tqy^G#tU$-O~zqX&S?$_DQd0s^*{9~AAqh?m6(mA
zx8rcVB0{sFHHx<L(bQx-;{dZ!ONTyY*=k!yene~-co%fse7uM}RjoZCOC!pgu)S!4
zGvlS70XY1>QDG0pM0Z2CG&Q%2%boUd7$#$U+?Fp87$I)jW(Oaq?;no6SvaH8ES<?r
zmJEXH0Zk(up3JAAaj41qe^yic>eJyK{m5w9hc<ptz$4mz!=ZRHW)EXN7j#`B-0*px
z5s7y;eVS2yJrPflh_p9S{sc&b?Hcs*yq2xbH}kpHr9(X6Q@Y#PQ_k(nPQ!FWvuDo5
z9BunAB-+wi5m0<Y>+Ee2SS@0tO5~uFs<&W;PC@{tYNWo)w#wB~=gKc0WbA2(s7ZDv
zye8;A)dD+F_av`KDXM&@#7th4l>1f%5=y!1d$a^-WlZ56dwL5|K`0})y;&=jEAbvg
z=8h$r+%BDjpNabSFNLiLUeN)hleJFgONU|G=1Sk=<6-BI!9KGTlP<t-mOld|p1=_r
z(kPIeH0G0}6sL0=jOsCf<tZ;(r9+f6!Z~3pqP8C)Nx&mHXE;k<Yq__}5GAsKlPQWQ
ztnN>-gMj1o(i0SgNUX0|3dfUU^2KT2S9M;pt}KMSGTN=2%bAT)vo1Je^Lh^hUX1YI
zkSEH%zLMdB=~Ikcmdj-2B=sopr?mEOmdYQm>r71ZsLtiwzNb?7N)#n8tD(j206vt}
zD*KP+mzNI>P(X^>TV<JF=!y44V1Oum>rww5P9n+o6gn2&%c|g^VLKZh3mGd3&IM>*
z=|*6H2+2pTF~2mYF9n2twZK@JRYD|6`UO12c&p&La&g}Bo5)j8*YCv*OH(iZxfLeH
zR+W)V%?D#I7?@)nyI3QjQzAh$%0A0tj>MUFFQJ{xq9q-;4AUoD(ayP7BW;eKaC1eq
zPp||w^@!^n;2Oy_T~)W7k%~pX8Imj?o3%S-rYFQ!ZwC5T?Sg&-HSL9{@qBiKdWoK2
zt~OY<G(1p}S+Xp?)agX;x7p=7mEkUdD|>Wo8XE8riB{aZdcX9uUb$;O!>F7tN;`WO
zZrv8ZZs_yw8|EsL1JBHfqr*TInT1#!WRWb10l$_Y1X<FrW@E+h-LehHHJqf#Dcne9
zy?^`=_mQS@TCnbC0T}KovGE2@I6j%o`HaLWt);h`)J-YEt+Jb|8*!q~I8nm7c8NPs
zNHqXCZ_?>d>_BcCnY<VGQrRYK_;{u`;S@lFNGgGW)h3`&fIR;#M-{Z9B=>tfwo176
zb-!RBa9DSBAI|SUR1dnGKfriUfn!+oY7#HTb~eQ6g<r*+BsbtQ8jwCt`;nsC6g2+0
zw13w}N7*d~mAzr~Ae`obXI!c(b03H`wn;x)01gd!R;&c1|2D_rAVNab7+JhE9bQKW
z&$vmJ36kz~fN?mH4Z==61`IU4P~dzCQG|}&c_&vLh99dBeptQn6+2ENR}hde&!bI*
zFPTqeS;5zu-~yrbZhwW8vrj!f5*GtjK1yN2_Q~xmj?mbXX9^kP<0l>+o}63cjxels
zOqd#EcU38Z;gp=ji5BOF(uoCjvDQ37Mb6}uY^WT=eYr+5EH#;-zGKTXN;2-Ff6!Rb
zuNh0XRAbvX^;g01WGvQ=`$=N`Gg!AgQtyl{eH;L$TV+F%*r_`l7|$9^-$}eP6zWgc
zMAlr$RGJz4h^xI}J;-oz^+2D3ZQO`lu%4uwFIOm!KgPb|_ZEW`5Xt{7aL4;62sx|A
zq`1u)8{)h(-8{S@VZIKLCPG?B<-oC;=Pf=}X*r(cXffxIVpZhP9SLxB6EOg6K7FwI
z^x1>sUP$}mIjdwc608)q*PQ@nA(tm#`ncZKu+V6DXAnM<W9Yb9F5-ba`6eFCFH$CW
zr5P$GxM4!E*s5c3&LcB+9qo%O#*7_<u3QhGq5ki?djWvfmqAx6>Gc{(z?hLPa@hZ0
zcapzYsV1SJX;}#A5F94O&Sltt77DsIovb;0WUo+wCU}idj@8Kvjk=aRP9`m9)}Jbo
z(1um1FzaPUKJKp;=v|p*ZQ;DZ#=z9&a?iTD85*V+)S@FG_nj<g6Wj|bG+lhM(B%uB
z?QKTEH07|f!#im`=$X|Gj<26>Gg#jrM+*n1wVf=bTzEQGmLRO)xmX(QkB=0P$4?1&
z4O$rY>++H^M|=j#fkL2yRfsqO3ag%*yH&uE8*^){8w|m`cR{EWdXs6ww0ukWhsC^J
z^vF&UwSuwA_VLL9LdsaHracYrqQg_nP2;If-Ox6;paYzlBEdpIt1TIZgteTS#^LmD
z!I*BM6Hc_TGzDf#C{3q1fx>$pyt6{wLA!Gfua<SvgGbRN(ZH%%R@cjoMt`WCPm5Du
zn$3}=PY>{-c&0jZ;!9>!6T;XmiOy#ur%6cMTl%19kYnka{9aQ@1$FXV_%BJEtN%Ks
z;eA^>wcPG1OR{EQu1!`C$~}q%L9ad^nH2h_Kb`v)5c;#qvk0_121I+cnttLf!8)pz
z&m}M%{s|6HEYOqoXI0#RW*!U`Z1<mr?*D=BT-8ug$!&g##$IThvv;nxvWlT3dwHKH
z>ELp%PP#<Do#w`Nz}kQc>z_H9b%N5+<lyANZAqhj-ev^5O;A4u1{7%L*H~<`73$P(
zvmZZDk+%BMzP$0Z-Qk(LZ=~3dCFwjdL&Mhh%8A^oa&v5NQX%ZhQ%<eLFe~=t%5gAy
zLT645k6>5z4z1t|m@^){W|kBygjMChB$suiUjogTFM;+pILoZ`L~vW6o;S8>hKO8Z
zYeW5CFZ!F&alx&mKYf<QbhPlVvN$2_#P2FJkI5G*4U);#nc#7cn5xs^i9(;VbP7|x
z+~~5=DSitBw)<LGx{+7sU9_hV$2q_sQgO}m=d}@8Fg^7MDA9e6qO#RPmqpZxiX|ZX
z(ukQctM`^Q=s)R)i;#WQR>_YPWgEQzDO~0<H>I;#MN{5KfBcE<wAp#o!dlhJ?<@id
zSLr~FD<0X&e_O}h-Fzhar(9nzV$*N6fj0(J0Tb$8AG4|Ai-WNKF1MH=ohxn0%?)8C
z(s0X5F~-RNED5!=@hLx5Yj;2(OC*WNmrbn9t|eKEo6FP|K!B?v+cjZ@=Vxxm@@{(z
z&?2dK2%ypr&4xVQap9%-xIRQkux1c3zLpe_a6!&SDcfRqjhn1R_Am92TU!c|svvmU
zGl^Yz6b`DXO7`}pJox<UmGzTn^s2Kt@Vfz}e1MByg44}a0O&G1ZWt{`$#8}@?s+<T
zSjstQ+nh6CuxPn&dvl5?7>V~&qy7OFhhJ|fa4VMQ1;#RuPW$K89mb?aYiOiPm-6td
z#|(ST^@GG^4GMK4Ye)`OeJ!`mx)FXQ!M@VEpSwtTS(FT#Nx^`mQWHxsJw<inP|*iT
zru&AC%k$!JH01?%<u0cxMiHUetUde&84Yy|ti)D;P&#tB#BKvO#k5WyBD3CDjG}qY
zpCB0JJ7}UpuJ1lAxfq}0;qSIYz|i{Rhqk%>g2yHZnHf%^VqB96umtyBruKf)>AFE*
z+1^^<|C!(v$T4(yo|A*06w%OW`zk%mfUDF6@BF4uy$ql!w<hkiXEG7%`fM1h$U^49
z^?@8O^w^v<#6`AHD}U$4wt-VZkC%X7tLrJE4m%kmr;x2@m%FGi&uM)oj99qpCU<XY
z-&UtHay}rQv_~&fqxp0~_F*s-GbZ_cU?nAUmU*S(6Yv&aHTJ$;TFBNhziTlg9#-8e
zP6p^o0)`XR?1$C$;SfIBaVJl{yrWGYCwKuqvdgqkOX*H^^L8RY&Dit^<K-}CAS##q
zH@r|Azq&3q{%LBmnkI?6zEKasMuegQ@rqg0L0dPQ%34xTo8-zjO`cM7#$w8q^`to8
zG^P*u-SY(X%)nOj#AuZQPq#BM0-<Vh<dg68;j#1%<Oo$t;0@81^4~=F&Uz$e(R!|`
z=16M+&PRbe)5=mC%O)U#<>o6d{I*W$+eaOUfFYKB^(ck+nI%gX%G!C4A(|onnfwFW
zvNn1(rzS|#BsLfH{hLzYL!(h_00<m;Lz23L6dn@jP$b1)GMIU=0(Q#e9n9B|tTuob
ziqIH42&@0`bkpMjrG(BTKJ#@bSMBAcSyX)+m*Lxtn8kA6=~4YC3bXvNWw|WK`qhAI
z&<1Jwky2Fwt7pJror?+fKg^w{Z5aj8VFHmE5Q>foNh(#Zx63k>0hRAvDJj&SV0(9Z
z`~!H;g}wSeKsDC?3shre_}|0~BLO=H^Z&m7A5M*dfr0h^H#pM<s+??x%o<CuL%2u-
zAr8^y?B<rH2u)Le+}O1UA)dCVvk0|FyR%3Nk%*MIDE@RnzxVd@H}}!obXGsd;xx0(
z<fQkM9g-m+m8P`0If7KUe;9pyd<ql+V7#)D(jfqV5S|7NayVdMx*9};OX#=dkPb^=
z53)R>am<I&Xb*wmVV49<d>3&^Hw%!G77Jjj3()2d(UuPZ0kRJm5d25h*)Ia%sLxi;
z!k+`3e|QKZu+K2n+0T6-uf=uz!{NsVq+YWQust{!IQI(yF3u&eFHc?1#E%=@9K^np
zXAbHLa^9&fKqx-<Cpkc68YVm_?9cD!=0;bK95@APOFi%kvkxb-3Fu4!0kI8h2>ZUn
z$PauC@=?V?hhyrWi;MD5CbTvJb^#YE1n>qXR*pK1>45*ZxPb)(zMTg*|DXBXe2`$)
zFLC9Ugd6yq1qXl){f+P9H}W?J;__RJVSRFP1QN{kHJEb?$T~k3!M`*R3w;sz0|vmg
z^;ZUji%9$SXuwv#oOt~)_g?Hm-#@UK6~KG%K<|gJdS4y`X&}U(^Y<3<oonVN{UoQx
zL?=6&U{)Mt_U`jI-#&chXPYO$Pp3AhDXOdKZEqax(%R;!3-&6FA-|Vt`Gr(i<CcE5
z2l7lWixvcO9~=_$5$XY$pcWuJECu)e4bU@}VH{ufcJK5H&%4Kfj=_J%2OB}J9QODZ
zdJG%TH3%U7J`F+d?$7y~ZSdd}OkJoZ9zZIbb{X?*@A}O&d?xSx_xC^^z8`wN=er#+
ze=pB3SNaas^ycvT{Db}{jvCC;VuG@q%HezEkxv#A6CK{4jhr6dKPe0!WFPDS5)kAL
z-}{d%4h`c|4fhYR>e~7U=soA!t>-^Nt;@8nPq_bcEwmo+mn$Q5s>hiSVAU_h7U&RM
zW9RSS*KhR;pYYF*@h|7(uk!h?M*N_p=m_6;l@Ia{pKl%V^85q+NVk(d;ms=l*0B#}
z_D_l>_`9R)62a<Rs_gHDig@7dir~iDi{3)kmX{7;FVB@i5bzSPVKtDb=K42zCeQU}
z5BdzkCDgowAiq!V-<tx#{NMX++w|nYFH2zi+G!pg!=dj<yr1^59ZZK_<zKDP?#ATE
z=iBSUJv2bSJ^MQH+3({WB42;jm#<6>A)a43Ho&o?tH5p;z^&IS=z4p<gRfpQ03QIw
z&(<?J5&(e7uSg(3{xzTYeQw1kJklW`fXlDI;G6V)pEw3U^C$SjpXeLccU|6>?g9UJ
z-<UrD|JWYS-&G&H!zcPKH1hd3{{64{df!FJ?LtqtcJ*J-064(lpZ^~Vbyb@E`wzn(
z!p9H6->6@AD**z0IO^<mb5x3XypM|flSc@13)k6aIL4>%WCtSrnRqWITBDfnpf{;3
z8<UajOVFS-TU%g;PgZF3mB)WxtcEvD7M~dMJxubR!P5Wm`RV7Kji3tmJ3Z#;rC?Z!
zJD4QnbK%H+9tzFo1mT<Y#MM@w&go!YxvI|I(XOU=RBDJy5H_pkRy7o}@`NP_>}%gO
z0ane|tD2`gdG49t+h<mLmPrzB4dNIDmFgED^4Xqj^A5Xwzufk$R$@l}k(-xKKqZJo
zb=~GX(OCGVZGGOfea^0N8}gXpEyV<7%dyTf;|SV|Zpou@+Z*$-<N%feo%va!0kTN1
zwX48X3|2X^B%ry8t?>HaR8+}0)je{=KWKyb6eyKT?eF)TRRL0F^%W=EN-OV=&l1bV
z$Ebx}f>pCihr_lKtFGRbY1#!_R>E=_IqJmlwPTKPru9}I8z3jI3>>DjIrX427!O^D
zl696V36xoAaF!2j#HYu@E&-*<XGs4RzE1||=(+BmcUz}8EiDuEQ|&3@oFa+B?$oL?
zpT);Lom(ehzBTm{RnZC04z8N)k7Tdv^vV~G4wQG_XG_<^J*`|qU*r=ap!_+{z8y3~
z6q$h)l-c)(Elam`N*zkeXcox^QQ3(T34jm#I;sESWU*Qf{L3e?Ycp_`Sp2}?sz)Ke
z0#^y;1HxG~{Cc+Vbd|%`O<h6}rN%OTsJ!GB^Ybxqc010*TpE3D)M9iVOIQ&M50VVe
zC!gh>gPEl$1v&KO7i_C+?{yQ+U%+jLyP_;o^m)vtVvRDYigGsxEa*|-`VNqNe+dmv
zgH}>9F4=^#{C|Zj*}t=ovm@UN0WdKFzl$b!R|3<W#6qH<Jd(>Tozu^=Cie@eQ%<14
zrZigeg1k??EOQD)Udf|naY>R$WsbdN;OcvfMqbg#keP3mR2?^YX`q{E$okC=TCJ?6
z<=y~a>dl)X=o+65F74Rhw^}{=fE(mE%9sTZp1E6x@ulkum#g4sjrm_6iT$=5<gGTP
zGXVQl7EalCmSVj0K{ZD*W;sVEteQ{e;mRH?T$O2Ziq?gM$yK`U;WsjRmYve!w^^hh
zcjsGea2#{fg)~QtaNS_o4gKvw1Ky{M7*$)v=Oj;RJ;Z6-UpPlj!%6TEZm?EW?qK?K
zn2u_gqzC3Tcu2skOp+^U^ye}!$8((5OU|Ffx_}(D_G_!-ZGaY(!qBmTR=T234)v8u
z*U!?VU_p9MfU7PrF29AV-W?vEputVwM02Y2JL9?P6}={Td1xp1SU$lPC@QjtA$I`o
z*>yY}$GgOUt~V_x>SwX4z1BDiq=t~G!O=b+sML6^HcRT{uKIPJKc<Nj1p^P(2^-(T
z5fjN2D()#wTnuJE4Z!L)^Kq8HL?U*|QCnU#{>hQk9OU0KX*3}mc2Yg51*X{1@poPv
z_&q}_WUlIin_CWG(TpK#;81Dwem~VZiSaN5Ia*Z<Qy-gmk4j@aHjW}7<jHini|uj1
z+=Fm-o5dv;`2=s>n^pw(u#=D?w$qp=V66Y3KJhz<f>Lehe6}Q5N0Ha51cUJ|FQu_a
zJ$cCxr}&re*U2q2S?WMo5&yLv^{mWUL+QSzrbmLECa3nLxj1TQg2ynVef9?Vcv=4p
zZN+BG5e1R}Elumx-t$8h`WVX0$F#zRYGTJ_(Mq+fNE!~@=XVz}s{k_c#4I+)S5bHN
zCMj_@JB-Fvs%l}Mva^#Tt>x9dXpfFOZCHq7^TO+To_@{o1|%3Vlw8Km`$PX!eKUQu
zc;r4s${VjLy+vVC$9g&C?P*|AD5>T{)@Kf_V9pIC46OeC20-I8y9&BX*W~Y~F!dgB
zJ@{-IxL=a9&Dou}nqK2dRyL*Zl9B7h4DCo*RV=$by5}{lxr((vd^!41AkcYhC(KX)
z*wzw~`D56Xe2nHpcAq_{z=HfRvy~Izf1reX*g&Y0%>P<4;5Z)>AfvB(UA-#}^4Knz
zYh8CGIyj5m3Bj`^qABYAv4F~!I*&R_F@mjX(t~r@;7S#nyWkI``uGaDl>*;pf}LRQ
zjY+`tMlC0mTz+tQS-d(!Z$-%8z^ACJSBLNkg9B4FKfGK785^W#4Jj6$=`>Od#?zvO
zpjRibcdQMd|3eQ+Bt}`VPY&-%J|%lfYSfoLgv6Gi85;SwymEMbn1-GoqSvqh*Wb>V
z>iDbFJ%{|CbVje&5M0@jt^yOA`%k}P$}IWC5aQW!JXc%Lcd}rzFLI!~Ooz6#<@Q@g
zuiDpfMB|f+pJ(|&Q7)o%&*N~FsRz4oZ_CRq1|rp$JrD5!X<CZ!&`1)Vf=xzeEC1CJ
zMtz>bNTOI${=0CFRt0+y6h##E23yUyo~Lp@rC)jdvhEMHJTmf>-H3Sqpfg)2>Lx<z
z<W}oLQvy<bX4d;-hH-(g_j|K_acRV;dbao4tWiui#a0R`Gs28E>&a-MlqP6qjmjn2
z865-X`DYn!e?J@jSocYYl``d*WP*ux@*0}nnqov@MPl58d?P&zelHDiq|2A0YROo{
zj_JUA7C}TJ?Y|glNYSt;@EUJaMajx3-_+AmQN8jLsATj#SNyf&H`1Ex+)6hp$ypzq
zmmqB-`xA}YUbeQ36k}_v-F`!;^+ssz=LY)uFZwq}gfP(I?t-4dmHSm#_chb2984GE
zNoxozaYihePi!N`B`Q%WSSS&eZAI(p@}bDgk9~DZl5%p!WoBY$^p{4TVm#MHyKUm{
zq>_gK;@hNYCWOqphGGQ&%iGxLcA7_0-8Nu*p6l+?Ij>OKu`e}dc!(D_Eze5R@x}P3
zr^=1M5yhht9M5L2FU-W;j?A^|BocWAr0Zi91`p#wy4_<;IcR8RYqpcb60Slps-#vu
zEEG^Z5*RLVYJ}Ra3^}5`VIrOQ?k>O%R}$BEx)+6f9peK3jcMTClKjfpl;5E{%SXRi
zEnGx~9lcQxsx^V`Da#bsS}j}6W2MKDh>F$C4Z3a=c3ZYqIuo}%zT8g#z0fD-8oZ*B
z?6Ilkr0U2R6<*ymeOQA4C`AFgVJDFIt>)M*Xp~&41vVnZh783d*YQ#FsddJjQe4?I
zq3|O}r}#IJ5B2Yk!3Ju@_!=G0x3CYMrQ?vzA|;}WFB=b5NV5^AIzY>K4@{PB94sEk
zYVn%TEQgBI66Rk1(*nNe*q#{SeV1ug5pbWL;{bXC)%<zviC*`aFm+GG9uMg{3=Q19
zrG%y*G`$e{wr;LIRs4s4RVY++_y^%4fsij$x^A|?gIe)yCdPp;B><y{I>`QT4#{UR
z%Se-I;*$wIYJ)BAxbluY5*M?d<@BYDBZWFg$7ivm+9^s0L5q1V{g1Oz>5s>fF&E@2
z6B#Z<>r(PIbaULo%|g9e5V#5WK|6-%)59X0pzNY<QyCv4o@Se6IAd)|Z(%=19JOr-
zElVCLpJjfs3JuA9+#1GIt@~2XF)@_<$TubbGF{KJRps2EVa<vzNO;sI#)-#^)?b&_
zkD%$R6rg2N-Ixm_HuZy3gCX$Nm8OC;1M^qh?@f=^t<JbUocRM$GmYNKkh1E}3rfC7
zU%uHrK!e40vIYKiR+Q0VgmU7}=r(?Pz7*);cuh4hFRZ?o5aCXhdxd$4;oW3~R-2fe
zH)lt8QVo?L?wo+#<Dh!f_}RB{gCe^x+!FKrG_PHI$Ui`JxQKp{U>4~|{6m!F!W{Ya
zR6P3Ar@}O%H0RZVi&$v_Q+V)D><wi^zk?e5Q{wDAZ(QAq7^$Ci>YHJFWt2Ns>V~h*
znN#`PU5F91#_VXGG{JNp-Z%N~qe$2RqV0nDZ`8zB?#D8pk4m77UGFE1Una79UxJj`
zwn(X989^D{Uo~WMKWcE>G|5<4zUujcn3Awx+{dkg)USj&<0<X9E_FfMXmPjXr$w(a
zMZ7^R>E0EW-e2#xA4%{-!vnOoMUXaMn51po94hL$`VS(mM~I@wALk;%PfQx)%XL6v
zHv3{d&am8YmsMq-7{}0bgskvuYu-_s{iApEnPJJXkcEG84w*@YO!U4V<p7fOrCV!3
zs$Nm~0^mCk>sx3Sz{*`j>_BYoq|-n;ChWhfgpC~z;tIRAktRxy3i=ELan2pln?(Pd
zR3zCG2}eeRC28@h)2u6lhIdGxEvfw^M|K~i^q7N{e6uZi*mqBoa!=kuSbtj{KU=TR
za)VVP5_MGI)plzGPv%a?i8kXdwEh|K9)&VZ8{~HrKEQscS3H)2)cW8xnYg<Ih_h1H
zBnnd+JIPv^7kElGf3L0eX1EFT%7$WUWrwv~QZEwgLO=(X*h#A{U(28u3PetG<1N4l
z%gk!3Kv+Q&Ek`Ha(MY&{V|JLE6`C7-?88WtC+Dfo4R^XP+m+5qY2Ie4GP!j2dD2A9
zsym*oqHWk)`bkA2(Pkw2aPU#c{CDOK%&9~pSg_m_p{X2FLfcj(I$Kv&G!hYObcrlb
zy}Jwo3`~Bt&O{vhKB0<(UPrZ{{8wwv>vL!as`a8bu#O>bFOEBo2kXJT717$EMNl**
zgA0pc_S?OvQR73&knVQwy)bTEeAz2FHG4-$TLF=be&;1eosL(2vy_4JdW?vt$ldEI
z%Iq>47TUCKx`A@g+6dZS&-4eKh?>d4q?cYWcUpQkeXsiZ(@Qy=8VVS<+O9p40o-^C
zjBK^TQljHkibBvG4~J&TF~oblk!L7rT7w?W)qUL>fRw`oYPcXQDa;B2`9%)p(H>c?
z^QGJkJXTT_tyg$NFKJ)9gev68M@0m~*M2Yz!<v*r;zg1f@?Af*;<kTd*2!d@NEf?r
z=ltnTnLhl~%-3}DAiMPOtXvy^%cLmg>3XtB5WW3HSzr{c8k%)%dubF4Ys~3(*V9)}
z53tCl#K}iryN%j=R{D7PAI8qHIn$_J(=j?p$F^<Td}5m&+jhscZQHhO+qRS4GgUKF
zQ~Uj}|G=ud)|dOL>pa$ZEa`I1fEceKe+JBkl(lT|($`YQ+jkFYbamcYEv`V@sf$Il
z{fH`ZBgpD7;mo2T9WGcEvL+eL&JVO7HF0!b9bPTp7Xv`YvU#0SO+^0^rD$@BpoUn|
zg*&Bc9!k$_9v2wXQI!j;QFO1$6%BIhtybiF_>onmO=+S9yjm%ZO>+5yW5<0I4~`B5
zWcNcy^r~$6svz35dGt>Zd@Fvddr}i(MmUShN;j@|=X>UUJD97we+57aie+fEIFafY
zVdrD;SLSV?8!SyQJ8!XolJEV}P)GeF`WTj0B{L;;Xb6z@0>)#uiE|Q3-aCDdOB!*?
zqg4SF$|`G511c}xN}@^kvnT)J8f1--<s>5T6tT*Cl6r~O)pp*KRs1#-PU7OtDoQ`#
z;DNX49}Jv&G$i|V$_RI0ExPt*Q~6W9$coUFjJrex`P=OWfc0Y3*)4CY7XyIhhV>VB
z^rzReJ3f{FLwQs=WzR!Wj*NYjiHbgbz=@?Oi^rmM0(dc3a=xf2_t)J`Kq4$pDy<Yr
z?Ubna5HMNhXzN6Uw()XNGf!!~KT~y!lgb(DI{_nR!;SeGYOTU(w1Kz!wy);w*e6$)
zaga*fSZm1jQLb25!;Lzm0(Yw*g!=#nC#r@Y^ZdBtQ9-w`K@}N_yr~}vsL^wN!%14C
zH;_Y2$UX($vt|!^Jo=d5O5T|Ac4t+yj4qmt)+NtnxuqVAapR=bfa6n1Xb&oYlYAo&
z;hIM7LBecN!^!?<5Ezs^JJx<L-L2osqDbQ@942`1PG;CErl%wyKITttv`x?PN%&#D
zTM*Pfdl{k~s^i;_c5_O6XW=cDF@9=5osmdnA#~u&<*Jes_1;LZvWEdK*L6~UR43s(
z3ymEB!ewzq7M{E(VkGXk1D>{E6UBhcD&_F`=L)v<@zE6$323*&07#%JwGN!E*Dg}2
zS{q1_sBiICGM_Q7CHPZ?&Zvxs8Na!<D{J!<YL?Erky5x5Oqx15bf_dmTaP(gWl0bs
zhGi9|MWvHpE2zva2I6ss{4~va6^MV*WuFEUw|NOE{i`EfcMaXog1!zf!Q5lEhkq!I
zM)H1?v)xG9hBh+{TA!G#`XvbgfcR2R5&l7mLIOPOPlc6e_gi5XCm7_tC2&kg-0H-~
zaAVii4>9eH&{1Gqf?kU@+BuZ{Iq$=8|0pU_XX7c-d>-wQ>xMAY2P<eMZv&dyCK@TT
z<F!MMk>d;=T?4;(P7<4%X&REHXx&0c|BmwafG_Xi^xBhaW)spTqwFe!ZFFJy3tipe
zaV{PDG*{)e8=hll(i+6usft7TP{m;Ld1jo%<*djzJ_aGm>%^3*Ye=gC0BEu{MtS}0
zqVW;^t|YNC+Ebl<NMh%;I`(c+E}W1a$lu<@%rd3P$nmpwuUnVLnDVE+`j%jYKT(76
zJ2tX{aLMlM#i}YG<WYtVym{94?#&!mrl)yYT0m)WSf`e>mc#it+O4bnOaklqy@`T9
z{fnA4KSYq6)dN1P!PlefoSaN-s<lA1qwp7ECe>@{=v}8bgBDr217*IoRwr;omNA8Z
zT&>7ylAhUQLSop_HrvRcEaAJj^P>tcEu0IL+EWlNCrex9^PFq)#pU5X-zdeosVedv
zK|Efp(U*_t6ob%Y?ig-SV~i)!-U_#e%X`bOM1S$I%pskfa{AD(PVHCF513;>c@<zT
z^zduH2131kRM&Utly;o|Mal9o9&Cxm&PO9_p(%Dq*q!$D*BoGioF1uxrZ=cBR^=%I
z8C8N;SSA7?Jq(nOP6nPVh9d@lFvNB`3X8%~3eq}A8Fg&ZH=rC7q*zC`^A{W_d@w{F
zkvB&06plE2f=WfkMs>*(Ui*(*j2+w(wRMvxEl|z|pJIe5A|p%msf}zDc;&j!XpKrk
za_BF3QI#R-k(BoRFT;B!HDQrc9lSTCjS#IMfckrUgq5WdSMub6nj@XU(>G-X5+cZJ
z#g=!?s$wncft}R$3ufB`JSZllniq~@ga%=vv_QCMQoO3@X7G_)d-p;#4OZ-X*#t88
zYU?(d<ICJTsB9LFY8c3K9N;o+f6E8&o1x=)>Wd8DnC?3T7j0eBy{A~OK?A2-Zh85-
zV#Ba&_;Uz-MlMd>S{0=g<1t;@yKIv*5-mb6ZcE5PU0kpW!?$hX=XoOb>O8|*y<=(<
zshoM8R*Kq}o;}am+{frL+v4T-7z``U420SxR@yUHF<n_nq5&v~7Hly01P3u=%6-ha
zM-ui6_;ijA<%Kgtkl0SNTk%ZrccgD_B3K}s%_gS$nsJ&UN4=MpN6Bmx!ThRZVOr17
zV<A6CgrIC825CG7X=)lAY67fuU3&F3qVK{#k$H8p7p3HaxlF$gB@!3h`UxZIqyCol
ze&AlRIW%j-f*r5ZLCKU5tY&ytcNv??!f)WKhMbkMYtm`EMS!G0E60g8pLF+DXHpSO
z0f|@YWA)08y`Nc+>*gV9(eDvrvKG1&lD2?F&W%{oO05~ch^tH)2DmDM{PL8j&GX$8
zVn`d1=uWTd=nUcZ@8p-WlR3H3kHXQa`$ehS+{Ndsd@NM|jEQ<CzRG{ww27V-YIf=J
zJMT)cC!J@uhDoKKsSeVHO^)OXvuZN3u*Z#+iGAw|>)iI_t#M&Q<dKAmI_n4CM2k2Y
zg-i>WZfdW3Mh#{UCK}GtzjtHGs2^48F;~ml<<n<D$%?e^0du9IXbjAP2iWHt1$T<b
z=N|~*l9w9WY3CPe*h7fv>ofdfNU*wYPuILhX5HH6vP;^gD4y{mx+<hd2#Q|wC#N=m
z)qE~%o8}Uu5uBjohM>j#31wzV`eob!6z<S-G_!(s0$NaUQUN6KNNcn)1=G?uDd=E&
z8!h9-{1ln5%o5z+H2t8fDbPdiQ+!%LD<G=jtIFI(_ASBrD~AJh+u8@bGoHLO-}@_*
zulv>r+^jjohs&Q7bo6<C6Q2*QG~+M*Z63?KVX3FL<n#IAs<7iiLSBnjHS3Lq1!Ryk
zieAs3d<wI-n%!=9qt^yzc9Uq26)b%0(Eg*6B(@<hgRg=rinjBQ>ognmn4Ix@ETSx3
znWeDdi0Kb&NE6vMCn=6VxOYuh>voKv!cB7^#{2Vi9o5O5q3w{5(s|dY`4b%tER(jZ
zR}RpYyH<mFm+xf53SxNVV=E(9xZl{(ABY4fEj$xeohLk~`Q}DWk-5n2b&O|HqM>_R
z)~M;#UfFtRQx?s(^Yu{N#Ti#Lho8i46uQxJaG_4W4`kB~A3W>`ZB~Ssr$I4rHQ0ve
zf7w14@c6Nd^){JK(*6l{`cm+Gc?7O7i;BU)G;#J76*d|o5+SX0PwGt4BBg@N*Rv{4
zFHn6iiDOJGu2I|@h@Tv^PI6!;v~dr?$cX>oFa2YWgY>E%#e5xaRWINPeldR!Vx+|C
z%qM)Yy`$ost){~xpamB!OU_udXg&g?9jYsz<7PY8w+PPBAj`5maP4$-VXxV3F(&nk
z51qO4qY?4wpqhzQ?o-p2n?^GT-eZl=v+`xQBxl<>AZ6z@E&x>=FUXi`K~lPzC`ZM0
zH)3TkXLyp#8W6IQbNiUSpWbRgWk-_;nJI5Q&Ae+&+qM;#qda7&j_X`CdY>UG8yi{`
zmXI=6UVX&D9H19X<WjdwRL2u)0UGWj#VjK}1CMi;?J}1^RHKGo%kn;1ObgqdkhL!z
z5=AIR2qBxDWnZDeI=1Q)&4R#l-#6iH%4o-uhL+(y2>WY%p{e5XgkRe($aLI?#OqH7
z5u-sXQmoREC?cnFZyrY!9dA$oS6JEr-Zd7_f%Y^_=CRXv{2k$SnR$c=c)An1eu_YG
z&{Xeuyz6Q+&A4j*B75pUhQh_9qopy4WDoL$(HaL@IOVHx8sgT?XnP}3?@dTl^YAH0
zG+}X*N{SPURp6XSWSEBs^6tLfi`y)XK*ccv{Z0dA+HFMn3J*P1&#KYLNOkmn;N4fZ
zE;98w8bi*CC>R)Dtxc00M;4Zokh|Pm&&)7#4?f`Ro&wzJ5&$*`R$WK5$b?V$_T}bi
z=O5T2m9xo_nS296t$Nh-$k9E#u{mX5#?7xJ{j>Q(>p+p2n=Xht{*^8=Y-0!zydE=x
zP6ABKc>Fbz{UfbEkHvq{T30>8O2%ymb3mo>$%S)uG6vk67cW3}EN+dHKh-`Gltw6n
z)1f72)8I2mA!mz)ZC!S80GrG+j$lOEDKUIXkW1$N81Ea;Yp!BcmT(u+P+$|9Og!cZ
zIlr*y__81DPbB^Q_qn=yVjlRqYe1+;pntoOy*Oorzcp7RkegWDdFX0qGPFlCsrn_R
zVD)`BdgSlz`xjJ36n!m0e+O{{Vk1m9qqpL5%La1g?A?RPenhl8>$ocStOTLIJ<srG
z2QD4oQ~Q?{s6$f1A!)nglF?@(`%cH{+R&MJJ`b0Q*>B2-uN}9h;-q^**6p3pT0gao
zk_Xms$2?W+$yb}xyOabO2W!WV_e>?xn|5lm3CL4r$FUVLdxnhZsR>Tw`W;NWLZ(Dp
zJphoZdbdvic7R@Xdh^_MC+s;rnJumBe(mc%$~DmaEcYeO61Fb`ZfUNZ%4b<crEm0L
zAX|oP>&SPN-34bLe~=90b%(rbE@xRM<voTNnp}Ur!UKRW-AA*;>C7CV6!*q_Xj%gj
zE<hoz(_M)n$Kk<VTFYk4bB-(I1)*9!Xnl<xEoYp}Dx0^<CL#Ky`wufNtsx7s;_COW
zP*Hd!`Tn3wx%lz6^x+G9pA6K>Uz9A_#$x~qUc6aRpJqnO@&%1<>2KY1Er&n)wvE5v
zLNU`3ym3cXHgexF05n7W@39NxGy(3c#Nuq<fO}ywuuiGr`8rnV$}ZshhE(i)-u1{G
z)<2_)?$Q-Hqz!#Gy;l@?9Zftfh0<8mM;BVh7ih=jS4s93%iWho=X3Smdp>S3K46Rd
zVspORYcY%sa3k>hx5(TBTYy-MqC%QtagKj6g56W*h<0Yt7{;>^D8HMy)sRl2By)^w
z$xZ6AHg~DH{UeVNS+zsJwV%~Wrw=}E8F_U)bMZTDzwJ`;tMQ*9m9x7z3nsCSrD@v3
zBN<En2Mxvmk*bX+JMyxIyQ*%cE_+VhBvV?=<#=81qrkY0wt<$BFIdC!H3-k-L}tR%
zb;kF+IcSAVME(BpqbT6r*;12_hasi~RXC9AmXh{*FTs*Ok%F>GjhcD|8A}=m;NhjM
zLD^`SER6m{+YwZbsv((TitG!Vqngoj*Jin(3~k$+DwfB#c!P1(znv)1WiZ=lIYtE%
zx}oW-jn(RKB4ei4exSB^5*)CJxl-1WJ`H^*2Va>gka@(m!@LAW4r-3rWke-uF$r{U
z$J{*C)IiyM2%8_s#z%pEF%LN<aJHBJ%Rq&k*NtHkceMtIwdbZ`Dc0qbBRvvsUi8^?
z!!Q7sBwyFHIB&>Wka>+#=%H>Y`N@l-*#b)snT3G2BTQgf$%U{(uFAD`D_PXS5l!@O
z{pLM~y@F?@WB7jgA{0(C;y!Ost05<D{UVB%A!J%PJnbbqh>>J^LlF1C@n1I#kE0Cy
z5^K1Y-vro(ddzX(Sk6}pKVH9dHl12`o#Ezj-g!Mxv}myJMrp2zb^MJrPfREYtY(yN
zUvIU7&rL?eUahZ}k5ccN!`26j3v&F<12are&i^PP_KP;LSG`k$JSoWX^eU=~yncMW
z6d!_4L_SGQhTx0pmTaDrT*Dh!i{Rj~#XuO|1U+y3NCRd#={t+@X}V>ON`|VYM@F!7
zaK6gQQm8Ev%=V77<U8pIHBXo<5X1j9sQO%T@9cd4{X{oblv#Pk;dU&)r=_3R<yMEx
zj-B{mJTr7<p;CF-L~r4W0ikP!RPC3*ghqb;dXnixwA2fGx%16Okz5L%O8Sdw5<>;G
z0pP~rpXlhP%VUm%k_#hN8$dg@Y3r9%a2F7>uw6sfkQsA_c2YLt&8aw`oZ)pT2F>?z
z!&m0G$O-ncx71Y~D<>=1XUXZ;aGDI;R{)ald{PSM-$FCV;^0WC@wLF*up*Bq<%~q4
zff0lgAq(_LjE+Ad#o~-FgdA*}X)S?@&R2UxD0~1a#Eny;hUvE!kyk37Ns$^#a$LMm
z=j)(^_o|R2{`CsBdKr90TKljRv*rTi!JMdlot)XXJ~+l3f^Hn|+y%zdNW)z9mev<8
z#C8>RwK2G3)Spf<tw}`JkaC9s$S;O;`}E08E|l*?EUJej!do=^ly`1$%%`;C4$_((
z;josU%@6~@Vs562#{|4tv7v@pM{HPBnUI#!WV>p1MZ7ETXCCp-7GO)Tj1}0nkCX%1
zLV1XoL}87HpSk;w^qTl;>TgNPAM<o}+B~@RlGRcSR`f66!gR`+MysLqC^I<NA9D;K
z^IqkmgmRu-X>c-4{xR`K?oFKINvJBq#uhLOMqiK%Z^oi@yVhc+@q54+a07^##4)$V
z4Jj*VR{qUq*mW<<9z|VQhc1boEPx1jO~tx@Ypco1yeqdra$|U0JacW@O2;%sfpG=X
z9%s=@DXUDXW|ywOmU<}b${EX~!{CR+{}cNU+U?qw=A5q4S4fJ+Pl@v8D8I^tfod&k
z10Jf=d)Ge9gI!`-FyXmoR|;n4yKJP{09+Jy85Q`5{Y-pOgcy?Jz&m(R{wYMhT!E)D
z+gIA<uI**g+nH)59N+TeCo8^DhdQ|xxWWw#Rqe@!fcR(U+Q_IymDjKQ#Y)Ckvi=eW
zIfyaI`<G(8i)&jiJ87;l7n}Gtu7*#&dkNn|#D0<H)ozEj_i?y2rMQyYu%n(1rX*^?
zIf}HEJ4vf#V4pYFJceCQ;0KAl2)h9?$$>a>%XBG@ns-hIK)UeErNmLiwsE>P@w8U~
zB|Y`k?7Bo7jDN@e<=$Pq*&DoTTLG53(CRH8qUh%71Dz^bGnObq>IEeh!u5d2K6`t}
zcf3m1ET0LIy@MIbA9H$*fT_}F-v&)Lvdeug+Ht5l>PZ`5aCb)V%EMoSLb)SueBR1?
zGBY}M>kH)N;NbfoU_6fh1mm$VF#MmIcqRfiX7>LG<FPZdF#K;8kKh-*n7Ngcu>%3U
zn3aK(v52ve?H}V`e0;wgog9n}tbe(!M>+k2@ot{!C?&$3#%AG|og@RDN)!hedJ&ih
zX9)rba6yn1=eG#92;jn5r~>{b7CL>7aGZSlo@_T=>ohF0?`(gpeQbSf%{<gGou598
zuMt${jYDz7qYpwR0#TS*l!t@(2?+8L$OFYBEdd2P1$;Xn)L{v3Z5lwe4*q~pv<mh~
zB+4O1itMo<+WDo2AOn#=0fkBUiIDmU_yHkMeA5&3%YfuUJ^x(;VtE6yfZ|xhjZp#K
z+dqJ4Xb{hjep{jT1MP<f3X6!i|CEIs<rLo1M_|Cog%(>E&Qc&3>XilZ1_Of-eg7-~
z3rXZfIwR_vxj8x-f^=~?5pG?Rbi4=Z)R*w|!&}5XKZb4s{=~w_1$PPlPK$((LDkoX
zcl<e65nm<h>a~#v8s7s86xh2ig@td0TZHrD!pW^E2cC8D|HnMBegnAy`QAVP?Sp=G
zZ0=m@1?k`JjOjyx?OlQdfAsFU0BNNnqvTdq_Jur(-T$MtGV}y$6SzT=;Ge+;GJBUP
zdT*xtfQ&hHfG}8hckVU`Z5YrCxpTND&sIV|d&YBZG@xw?{OnwU`{S<Ndft`(wh0oJ
zTE6W4G-!x(^ut`gtkeeeSzGzS8652O+d_r3c?hVW{s_s_b^g3w=1TZ6$V)5BO9KHp
zg9~&KKL0xr`?XcT7gDfivlJTSQyYN}NNW*c7ATb#<tgOk<oEMmkXReMS)iUD+}DyI
zNDyEveFTzTEDOlMgRc^<ak!>0qk`lchzAHB;QUrd5Fp>L?=O?+{FHw)!{Gz|>&@4F
z1tu@k64T)~^Ieb8{XLYeA3i-)FEs%yn4dsCfgi;=>28jSQ*UjL4$x0R`L7mHAc0=~
zt^DdUJzURkQlJq%dpnSC4QUvELt2#HJN)<z;2?j5MbO6|nWr7fANJs%^7|j6H(&O`
z%e})#?#VmuZ{NRt(+uP}JwPbtys;F(W<>H#en0Gs81LeZ>GIgAArHRdDslRW2#32a
z6ig2Re_#ECd_NgnjZ@hd#UO+KuKwgr;`i*)mvQ#(%H#g!zFcVmPXY(~R)Z~~4<$bT
z*o)pj%0XDgC1pFjVg0Vpqu~5%fG6buGk5^Fg7gys)n;I?Lc%wBB$C43g64r)fIfXs
zSpo6m<M@jd0m(B%0$Cy2xb-Z<g8Tw~HR$p3l|})7-Rqh1#R0vua}<8M%fKzg`!@br
z=0Z7#3)-EUAs~n+{M|%oZMx*psM~3Ipt$N;W=aOqdGLnTI_gs-IdKH`H5m#1q<Hkk
z7h4}BT$0>*p|PB@M%=T+73_hZhpY>6bmIcMe8=2EeySAaQ{p7eJSbzvIXrd`PZGZQ
zKIe2=aP7R6R9APgVoLgKT62{Jcr+xYRz*{Rv0gYoEvK8F&CNw-U)PuuX48Vls)WW@
zsxz(O7~%avvqp={e@d6sDL=rW@2fc9Uh&`SlOyqd+)@y<$nLZJprMZ?k%|v=3K!x~
z5zBE1tFDjWY0=wxY48!Ds_B3G6VF`7;X~WC<AzPmP-(I1&TFzoELVS$HsErm61;g5
z>*0ZDm;y_^HRo!{e{K;Sz*mOLy!l(n0AkBLq5@?zWy+&A!MAiCqOii@oSGN}qk5Ki
zvBxivBwBAL%lMWRCDfQE2e-Ok3){LFUx0p<5b>>Xq}j6HEa9>6(OkJkXaD4U>>*$j
zrQ>RZ9fB>9=?Pd{8S!2%8b1P3qbSE)9>f1{^nLKek%h%{(_zF`T_mC9F*^E6-}Iv8
zpI%q4+Np{?-eyL4vUV+>F6F#Gt8$)Orf>fDWml%blh)NRAxib(4=I0biLy1D>^Qoe
zQog4BKe)D)kFH+ggKvNLOd*}oy_B`>e_GwO)0ZGqwqHtC^1h+Xy&{vsAzq@stT5;_
zz>eO?ntvwxj$vs=A^+xPa3R{UOgVH<sUch{F@nxb^^m}M%RL`jbw`uOK|9{jyYJc%
zNfZ>P*9-VE!aw`nwx}p4(m!x0OJsZjnt$YwXSL~61<bz$V1epAg&w+v=Vb;Vlv+5I
zT9Q-PWc~B~7Xb7-)+@0Z4?Dk;l4Q2HbCKrCeIP!^FrkAUh?hR)7KY@7u1}73!=-9-
zfGzrSw-eER(|M9w*3w9i?4@Evd|xFn|IVtUox^s_e3ijwnVjcry84wC8Jyvh?hFh)
zJLxjo%O=uIuzzIRGRY4C2AkNcd&Avwn9{k{i+{dH`BokgAY?XlTHn4BVLZpGM81JL
zzuM52hN+r3Rj#aUB3^R!GoaRc#oTp0c`p8@I~t^OemGG1SIc6}*5t+LiUz3Vz)4C-
z+$?6WY#CgaK9`<x+*_NYEacya8HSbb3B9opWrwY4PCKWaj57$}wR_6Y@^<~ctfgQx
zOX26tyyoLn^@3WXeww(juH(zutKuvUat-EWcWqmM)TNbBZVUlC<|9lH>>wJu#dk<f
z)SN%mORWR#*<2$QSvB1)lEm<gUWWHJY^SXuJ$90qN?Wwvh-{-uySH%58i2Bn4vnuI
zNK;xSL{=zU8Vs}dd0ahI)m}j!7=AJlR^F2go7ERfuH#gyb|#`=0?l_uE%TU~8UG-T
zuz|i(OfRkG%(6Z_wAKO)C)5oBq@(hgCp{MG^5}+T4dJ?f6BQYk8dnP~=VBj9B$@kb
ztPY)l!zldYGcg+OROm%lpP%lme2uFS(J5tu!EcOEJs(~lF6^dsGoYI-=(PqPmV!r|
zlef)nn;fzEvU!CtNa-5-O@_Rx>PHJ9bQ`+}mVTr-Yi~yO82U=8O|iZj9>O!%4u)dX
zrg(Sae<|&H94s(P?s;R)wrp=?Enu&)w-R!`L}Hq4fH!*F^0RU(ZGwENW@r3rwT^11
zxNucjLqpWhJeIXbKvhA7(Siw*`qc<li!-aB_!PTqKo#4e7^~&gD3meGR{qj__=OVL
zl(=uW+#_#?jqHi|?z5x%$8Nn2I^wlJQ6}>4zMoA@0mf|8^8~}^w;Xpb3+AX}C_!9V
z@F;yUeUIeVT78IQ6Mf+kDqyLZCLCq|N%r4cij#sf1tm!XTmbT(BL|#{zd@4j&4~o}
z+LwMu+DkdzCJcPmy)R*<zVt*Ib{3L0f|ET49~*W2F{YigDg_AvKAp_pIXxauk3-FA
zkK4x#WznFQ)Yzq3oP1ZFk+SlKr0vY*tTkz=^BcG>s+CQYt;)`zFnUEzxkx7Rt<Zca
zhsZXo+FjDo$g}VxXDlkw5cyd(kIBbp>lW<tq5TlM{`7E`S5Llpq^V>!r%g2#nmUVj
zbJ9D_=e7womA^Mu$B?>4g_*GF6t^O`4Y9+F442%BO~}%r)G#qGb@Ss@&faj}NXwWM
znu|=2&gFH(L1r>+rfoE^?h!M*s9Gr43eSxXp{E%^2nN*f#^)SLP>xiYb$MT=eWCsp
z79k)oYEc+*r%fA}0}{+K#6eIhr3&3vN`A*l%<>i)J^<|8-#SM00V-f3S97IvFz06E
zmZoDcM5D|*)|gry+YT_u?!LpfjD@MLDapiI^Tz|VJ{u^6GiC*n+Z)x@d=Y5_>NV_+
zHp!kbFCtzUL^|<&jbPpa=rOAmoE+MLOL<ZjYiN%1n34ktT-1^+^!SwzcCEK_r-`vR
zw=j}_bI%W0gcT>xnA5VvbF3(M8PPe~Pb*6{`?HsH7qtds#lmw~1p`@KIR?^fyN6Xa
zZ#1&FHuvcqUG!2Ybm04dy4hF?2d(g-iViGgLm%}L8_fKb{^r9BT<AtWwuO}XrAY4#
z9k_$C7uAw2K9CE4xUMeF?G_RzM-8kjk;2qfSSR*9@<zeCeq>@c9zRjrk)%h~6?v49
z5QUK<phM?!8^$rGm)X)8T;B78Z-~ZLaVp?fb+hSmI*h5GYVlk3OXQB~P`=6vY0Y{Z
zj1EvHd*<vN^xl&6iFKtE2@$h3sb&rywx2CPsbT|Rb$mkKjdh{JSYj6Dwx1AriYJ-w
z7kDh;8#B2S^Xl;4j(r|snPzxvK{PI-R*d}}Gp8L5r<WU6&In}0>vHd^1H#SkzpDCq
z-=u1@U~>+jdceJ8V^Yue`)>7~Qv+jGY-Kj*Z3lC$eDp3@L<}Z2c&@~|+wC5-vD|n4
z$CVBY&)!XPf+L;4H?o}-P;s>?*=7;Wz(mQ`IQQU!0s3bF2G2a+HZQT5))4?j2*b<_
zqcP)C74qwO+hODmx$qpJ(|pwy{}|WfRIRFod^&B5&C)9{VH`ZOA|8EsqJ;Crf2}#%
z>SusL@9d$EzCr|dT#kZC4BU19W<PRASCW@7pn;BmFLQ9cf+un^xUnMk$1mWw4XRhM
zyrX%iZV)`!ohZN<pf4k9jw?NVd!vj-B3PN^Sef(&Q1?1<dgJsZP<%^_`WtVG@`es$
zS@2xd{MSK^GepXvm!sQ9ncnB%!a@Rft`b=aROc*sY@Cs`BLgV3S4DC{JLuw1iIjb{
z^;j`TjfTvBr3QZNPXlk^n8Bi|P0Un(Sz4XEsU;q4O3m0Ogg!;`)aYvB;2T`2ZHw|_
zKHX67$vC7v_%wQUg=mQ3B!nST3`92|8n2vji|;9GWn#EA_Y6IlM7eZEx0T&GH*9Kw
zAB8vmQ97xVhxx=^Gvk}@=X^;^e&sdS)Dm-SZ_{9nXHURKz2<GNe$KU6%UmuB&3aS_
zwX9%q$tigiTh;37M^nHqv=9K~^E^viw}5gvh<x$}N421h8$O!!$0gN2+w72s|LaL4
zKSp+m3v~J{<*I8Kq!3Cf`rWq6Irqr(V6ke&5k|0x;@ao=$H|#Cb0=hd*$dwm@D97R
zWH?2&$8eh83>o$3i_%la1gLl^ZWm7V<#-Qe<ejS2$|P>je5Uv&F*`7GB~6@EJrc8w
zRr@NvA>_-yl!7DY2=6^bZDvgO+|smjg=}Uk-dkf1b7@wp<6Kzi26A2HnjU*d^4fbE
z(>$*d?~z6z>gKYG=BqZA{%#(ml=v(op8zJ9m{ktJt|zvWyGsz2hd4M%NetIrS5*Av
zJ}6@PpD__42v6O8eK)h9t>RM&qB-E?&tB4shNMXp7sRj$@Fi`($W8M#Fa#P(y*Kkg
zuA(Q-RL)pO?b#--<3kVeZ@cp$OyTL{Kck((e1(-1tR$?P6>jrk+a2+-&hv$2Q_o41
zLVT~gbV+=NPgaMFPl0=W0tQ35tfry^hio5ZGEV}rWF-e3U!2<il-b&<x<2GczK3is
zO6PEeU-3)~_G^B<^WBzX-4I^{!*>j%l?_)5fcF*y;a_m9vVI3O`WR>##N4&s^i71u
zAp|xx>kBM6dlb`bJmhYQ;;NK145my3$1bdBt>$#~!262%gA&7&FwFL_gl=sd`i>*v
zD_gHxUw{f3nualoXIJ(N;*P6G>hY%q{CO+O!NUv_s}tc5K2&?V{3Vql#<O8B<EC!{
zz|zflmVVv>1<{MoQea*q{Vug?X!IcQZyKwR6BsIO3t)XR>aHNliAxBQIeFg+;zpzP
zNTE$@{wY#M2+?Xy-s}by)$RHWDWtA6dS?G*<TkGEul9myOMrT{YcUIFRIH)j?+Cc?
zDy4o+X7Z=jON_{H{X&X{w{sVpGjH1}H3zY9uHT~!TM%vM97uugb(FV0uNU^({fh2X
zMQO*gtN;npX5Gs!Ct$g%kDJWIo<eM<+J9To*BW^0yrZnxX_$H4xs_BZ;%)V()Q;8z
zQ6#ZWLu+n4%?BN2l1l_Z_=z8NzQpzi)-y)2lr%l-iDsgji04@4%aG*R*%@H-o24@w
zNar<J=zBFtNXqM5WEMHV`(e*`$MpwL(Vfb&#FK#x*LLXgDtAl8qUNX-ZEojZBc(Va
z)aDAMECyTW#4P+7br-4FU}WC<(!D|5Ir27owpF&z)V4z1>Ffp*KzQ-IRWMVy#}-Wt
ztpTCNPQ%e*aFQyos4KNY5N>TYx_Y3a3^57bz&szWaCJZh2N=s!-N_-wb}Ww@QJQw<
zy7t$eMfjhA5b?8%zPA<gf{E{!Kns6F5u=hXaSrr~_0F7D11nkASa|(Wj^wuWyNub6
zMrBSEC7wOt3&<u#J^F0v%KF#Ye+5s8cH;I9B>J8mAWOd05Z2E+zV8eh(UqZYfzoo3
z^j1dgBQdahE3i_PscroGOYOH0IPhE|^yAinqNbC#EH5RjA)|u=t&=>14x5B8ATwTd
zTW0Iugtj&eBS}YoqUJ1tf0K4nrT415O7=*nX?|<T!n|iS$&HXJvAdoOsl02$f&ZRy
zXP*<GjO{nIX8Q=Yy?ZD_U2cDz{>!_xl0>I3riVeF&NiKKVM(H+he*ytFsvg!tY_X3
zj`cx?S9Hn6Q+2k++{o-~4WqHK6&kU0Qw*rqTW7~3PN>h?_A_sZx|TvuEgiAAgl2dG
zM5xt?{Fw)MZP&zpqPda7>7(9+mXJu7YHvl!ij&^#Cd%&DV6b=+s+=qA<aG;lh<6P<
z-u}{&j?9pYy>D+CGK~Ift9ANCS)>B-<PjfW+rI#hNbPDyR5Cq|4(`eDr5-E+r<JXX
zR?@dz{Ps6>ME4Rdvd7p{;sD3jwLkaSDGt)pi2r?Hpe}pAe&q#~iIT=a4F`&TrH86!
zbqSB<E$w#>H>-dt&s$fr_PgHe*Czf>bGjLvnT#ANl9j&vb@dhMzmDpCe;m^Ja;B)1
zu|FrgU^f#!9tyS(HtJz?1iWJ8LMecl2xFIDiatwS4000l1z2q2z1TY`-&QXYCj%77
zZ1H7U7Hl6$nhi4*QLbKS>1A#wsu3z9O7-@7tp>|)&Mehc3eC}c5>ey0maYj{`#Acg
z#@)Z(`UqSv1Kp?s8u!KafmI!%O6kAR;kC0mf7R=4N-5%a+}_tlcg+kJ+vOY2i`qfl
zE#^2eCa0i(jtWnxcLId$s_wa53g0Buh-@h$vLko7?T*C@_R(j@!`nspf4>Y+M<2A^
zRv{!Tc>XnhVhz|icAL`gmzE7$^4?twFvIAmF_CMZq`Pi2>cO1VdFbZn-K4hg`6DGM
zc3deqNl%w`;b>-C2yI|(LZ~4%&jm-3YARWEQcI%!Aym`-Nl{#vTZN-8aj&}{8y$Ks
zA5eM#*GuL55DnTMx7(80QalYgi8nbFhozc>)if7zC{+}bhvfEX<PhDWIUtnSVGC#+
zrg$#X#35X-Hl34>>oaT=waP4q(SojrKC;b+xy|InL*qw8a<GPV^8V~Ka)T>18vAkR
zHq$ckA0w`FXMeQz>@Ku&;?1@2^049MX5tJO)BGz;{mj-o917<m)FC}EK18K0mOL`h
z(u|0q!ef}|SIY|>bSru6+VeAq5+(=9cM?<XV1T;`<wWJ<*x{Bk5f~=rxcIG2l4SZ+
z9?KRWUHAj=uWk&ys>73<lfw$U#>c|$_!5N?c`8)$X}uPK{lXCaZEuFNbwO$zmS_vE
z&i>-})#tTHUxnc8quHmPNxnGi4bMH_vO~F#bhM^ML0^d}%uy6C+>c=l*)|A_{`SB_
z={DHekFLm};zQVNqf^61Qzpc*3UM`;;~wQ-Ta<it$oGX&ilK>O*~Ee*LsNng>|o7^
zkDqyd*`cidP)?#L2I-C;z393b8wMV7^T1G&fy-BplLZQW5LD&uF**roRKVPvpk(+d
zh4*X-n}z+Y=#}ltMP}S~3PApC?xYt6<N5R+oIv>?Y!FpQ^0p3bp5L=8Qzi?QGtlt<
zq!haoL%l=;G$vUI!>mKZD1ueoP#R@i9w%+MrwCIuN#D~zc*Cnfe=$JJ5<NUQv{Y<F
zW%m!GWv+6#U3(3i3E#@}cUrr{oLEZ;Kl~sI^9j$DA$jYL^e8%E%{3XkA#-gup5FtA
ztxu7;V=TlXROIwG;}6H__?G=vVYU*x?-q<EODIBt$O%u*b2!&FT<sHa)6;vckQ1n4
zfwS=`IsVvj5_h4}=9V5cxwCkg?~3M+)WERyeA2l}Ij2fjDth5dLiHSv8+3YbyI*HW
z&~E)`;zE8etj+J6Ld2sXT?!nIx(iBRiW%ruR>_4<s;+A3Z)sK|LwXg*ti;dC?!vNg
z#x+mxd8-ATX-f$e?^v2!gyu`EKf7#5U9~sv%OkTfuP^bL$InQodLPGs0g1||OkQGn
z`S@%&3b4ixAik>bHx(<yI0)%mPB6~ha+h|z^Xr^oxC|8dL<b>9Q8K=Ra41A|2e&>L
zI01vNuiNcr!W!df|L3~E<A=YQU)j_?1N-6NM!zVzFm;e_P?}8*ANb&K9aH9sdnLQ>
z`-_a}IIKz+%^{lq$t)A%l8{^7OWQXV9(3N9VBL!349HFDYxcZL2yQ7ff?2ycv$Jd}
zPcBx<{Y~u^z9W9^iGsKfV|Ec78Ccd3gG=yU#x^<hbP`H_+#$X7u>lMXC)h<_N7^j>
z(&|Dvisj|^cOwg!U$MpYW;2l@{UMiWquX1iPCkBh$%$<ay$D-CnE6jdA+e69YGQO7
z@w|SI$Fk7}58r-gme_Jz&ot<JVS5S%2+F9bqHzlvUB{2ffoEMo^>`s#nZic&wWuk}
zs{X1bthY=<nGkJn&^D>vuI>dJJG%}rsg;s%lhV$fkg6Bi)MW$iTHL8&xaR9n_9N_(
zrMYG#dJHtZcyIV!nWrNwoKjtVx1;)5wGzn9$+TsD0(Xhx;8&z9ZU=a!n_TdY*xWB<
z3~C0S?W{B%Bmxw=#2C_-`3|a%yi1dg%Kb7!)NR8pgLgXY$~$4}PO@$HgjtTMo1|5D
zc2f`3h&<S`oA1i6N=fXzoe{3alw+>Wj_4`cG$s-aOpSMbmq0S@)a)P^sPfIezLgas
ztL3Gq(dzEs4Z|yrqK+}{Gdq*O91A#92E*;(X-L@Mv((-jhcgOVe284_qLGd19&%IN
z(t)JiWY{v7m9rWRol^bL2hl#vf>Aq*iK|<@gbVJ8wR}@9FMg$q$PDKg%e(1l%BUT>
zu{uD9C~413ZDb9%lb7c11cRSGA!&>*D8oM8EBQ>%%{K!4+S1VL_kH7TX4B0iGKTTV
zbF}O(Nys9Tz9rrBt_dGn5~(D5Q<B6C*4;M@i;3VXo^@#~#u4)_?P&U@nwjS2*J>U1
z_$x1l9VE8bcgyW9hT;=@U9M-$+vPVhmYn?2DHSxz;Si2sm8uEkqcF`L>y4~oSY$4=
z%xj9KXHwXMG$`J<lIB3k4eH0x<V7Ryw;!L82v5UZ6yGMX;Uz`&KKSH@+tDIz6r0lz
zoOyRyjcG&7bi4NXT+S;qCwJqL^?A>t!|vSV-OxqwIGPR4s(=J57P%dcZGJX-UV8Yh
zhb7z{ZXgH2*#K00`4C2R-<d0?0U>D%;zXA~n$mRD+`-^D1#44onAm0|`J157O0yCC
zX=RB{>2po>xzDrtM`FKh=MFNZLZnItet+D5`UThg?Tr%0KkNA@zOVI%x<TO|rj}^0
zBc02q)b2#X>cN}&W$gpJQJblu?8geykY=wN#=FdFn=&@dyY)?y%s~_FDacAmD2UuT
zocw!%RvucPM?e>QLZ5{1NXHZV#+GOSBNHY#0tlRa2i{*On4P!<@FbbIndB^)wn6Ok
zaydR@bF~o|Np`Gkr<)XwY-~K}-#CvVo#E$S`<q5(q4G&LtOYUtcw)u$=8FjT(|7ea
z6M@3SwUcj#kA5LM%T|sM;$qpKA}8}YFO`hjp61DZ<y!%)s@Vwb_b)fMd{LPb^P6YD
z>2}DKB@v#@vYAa>c=t6o?<rhj!==9>%DXJl8ou$pFL;Rmdqm30@E;;lCWikPivAO8
zvoW&&U(fdcS6IT%!o>bREG&s^0+-j;TA>Z^=vY8tY3=9`wkz=;4(LG6)b9)E0C#QK
zy++$)ZRO^P{@mf*@zq=ET2kqFNo_t(t!E=mtEUPKEz4q*n4exw^ACzkLnkP{4GY5T
zotzvVotz98kSsGfvx0lqiWDdVc5te1Y&iN#@lPd&I{l<WhUDtmpj=%8`J+<_Ok)Lv
zCaa4^r)y#YM9s`R^MkR@c@Hw^U!7bG1TN-RnMFGa?XNgFy*)5DzuEuxmHOijKASoV
zqVDF_divu88M^9+Lo4Ig3<RFr06u#BC4!vGDzG#?h;(>)r$=b^N}HK=<(`(hxw(nq
z&n6q`5`7%d_z1)fFoo$Qk3}AxL;dsXHIP97(G2uG0+SeoRA8!q{*1n@JS(jMdlnJQ
z4P9L;-Onm(n^)UPMljm%WdOLG=^lvGGxkbv_}&+D7WBIs&MzqLh=1?<`I|Vl=qhJg
z02!GZ+cUQ+q^OFscXA#JOg=u*)XBxQ7!t@@=7#}HlY6b}160R9d0F7VHISbf5`;ul
z8K~Daz<0rs$-c4C)y44Ng?$GSE#Mn$SI`((Qkj?<fz~^_2)z>X+XKX7$2`|~Q@_tI
zO|`h$wQ73&(~7Ff*6>NBbuRxc=xK4a1(^1IGdd#>zT?sYGl6j?CnvRetbk%cfevj9
z`yR#JSm8ZqbEJ~_2XA1#IxqhzwM}kF1o)Coa$oqt=*e@bp>{7%LGJI~TlRYpL118d
z7v~2t^<kM>8bx2p-#ak=Jfr*Ab{7<J3#7bxKdS>x`hI>t6#ww)7P~Yr<Nc)mtm%<C
zqq;+rs<iiD{D_lNS)Ba7HPknSV5oIq09F6SV5)vW&-wXX0NeP<9p(ErzM8%U?DjqW
z+$H^!P<OEdD)8{)Fbnd{ot(e*u^0fv@&nt3#|+sp_7QmW<G%Rg^!Af+%b)+b6a48*
zPI6{w{Z*2FEcf-32eGcM>G^4W%hyOZeFKxL|I!W7{Ij8q{J1ht<tI(6WA)vlI*j?+
z4Mo&^y!=C1P?S(u#67CKHorEwUt|6TsQw;F*3eoHNW99V`Ds-Jg1xDF(`$cOVtV`Z
zapvfXIn1G&{W$)7i9>28b1C+%#Gr;G2Rc24dK7T8z31Ksa;xjS$)_CsnjwT>U|e74
z?CAj7K6?Y2yu?BLKBXW>_mjMYpUVl2!0aV?gEs_cko*bc0Frk25!}24B5V2~$bO;d
z^+jO!8+*kcypP85C(9AMd8tTy;CE>L8U0C*`=N0AXJYvg#JTB{zO3B2c;H8JdFCf!
zWBb8*72ivh{sG^K0sDe<`1Z%q-WI>W4|Fy8UoLIX2H!sZ#N;26TgXO7`_GgY&*S5t
zfSWh<&x9?{G#Z{uT7l-DdbbpfZx{!V)XH!0orsq=z1ytY9wqOZ;He%(Z`1dGEr^9S
zFEeX5%{O}KzGXX(EkEL4*Oos%8ynwh_^TS<$=|N%t2+sezB_UqzUSlL(;M6CLuYz-
zJ7qr=3^X@9KULoFcXGWiTc!@pc3@u#+aJ=*oE>Xl|9*5xbpO64$?gl?%k<>AhOW!A
z;|HcY<mDCld&MWUm7`n9@%sV7Q!o3c&(|kLfWS2ty8qwU1FaXUA|t=yodlJKJ#gLH
z3wu;;!bBUml5f;8LHz5|b$$HN&v`^E?nZdajCuo!g}on8NUtkC<y@Obdq-6zw>=YF
zms9Mbg@{IG|4x1%BVzFpx)+AA`1hq#52us$lV6xE@F%fo(#391OksMc)Ab_Bq2`KO
z0}n23M`f+zFj3fxF3luVF=p}MhY^rwl*t$({`+830QLp(U=!E*`Pc=5*m6HgnJxKu
z-w8)}RWHCakoDbQ+ObJGYN-r42Sg7t2IC&W$SHgr@JOJ5_L8Ee&?og1;K}R@Y>vj{
zJ^u?7>j2nNv*@S<YGXLtVr6dVcXHO{jURzUzt3dW>-oMIjj*@_>E*cU0F?BJMe_{7
ze&BEBxus^UC_3f}l6=zavvu}fn)>FUxs+nMni8&%rMx|#;EveB<d3}Jy(>EWDSRPs
zA(3Mn8hlb3rvbHO_l3}eTtMas0T-(vle*a>pn9h*C(pm{Qx_OLKL(6O>uqw9Yjc)&
zw?L!>XKfpOj_>H{BpesJ;k2i6i{TM;2ZR%KC(@TJE9c}ut5y=DC}j4qP}0eJO5;PU
zs$UJXJO_@(fNO_h!~li<nII`<V_&@$BbP!yCGLFfON9}o8hzK`sW)N7tz4mc8*3o0
zM5x&jr;ou!{)V3d3uAM_(bA*VSxb}3!q3~R<jzj_8jXw#rK@ZhHSwY8U?HVamb?gs
zG7c)VzvHS6&+P!7+#<jF4_nlZJnIq|Udsp<OwQIR;Ljjs84Mcg`{D05;V$$i^g$Sp
z+lp?e1FtUg&wkB?Y9~3+;Kb-=ESa?K7TCAGTJKVYgZ(6dM0u4fzL&rg2=$qovpVbg
zxH9Ws^cN0Y_?KNWKzz}oC=wUyRP}lrdWtp6;ATVvdQ<%w%Zpng=gFbv3nm|e7bAfM
z^7;7s8*8a`U?VX_z;8o~XO{QiPU^M~cWJ6x*_iz?g*)kBRGE(!%e6MIfdKGFuBJZ9
z<)NVdMc)CrYhFj6nRJ(wafLcu3Q}pfk)68A!c4hQk`LA(f|*~zT2&co;XYkDyW#*e
zbF@lSAX5iFJYdM?DSq)NR`mzkyM5$hrVNqa8VI1atX!<`!xx26;WQSc#E*uyQK^?4
zsg;h<7%DO7=+dyJto@L_QDfO-(*<qrXPo`76;Q?d1}I~C$2N!YIM6$rbjkx1ozy#@
zSIVy=FCz&Eh$WF;*sshI>ZuW3dy3nyTJYA>=UDh?^DDtL(<}9X%M<WDy-O=<Dn-z6
zd)UxA_M~`w1X$4~!WTX_t@|!&$EK!f#N9}C*{vxMT0)}72h!#?_x6d72AqF9rBu*C
z1DmCX$`V}YYSPm0+Mare(|n&;3G)`UTsc1SSLW+Sst2#7iZe{y$QR<ZoK>~nBDZ=>
zkpz1?WwkxZ2tIOSi>9>M-lvu#9C7IlbZ@#Lf%a057!swXgX!%c(_-`3s%S@Ai9%jH
zLz^S;)GXAeVKB&wiK&v-q6LI5>!bsb=)`g72g(O|3gVReC<~+o4ZfUS)t3hmVmk6R
z!dzKku&~2h@d^9}Qn0^7hosE2^|jA1J;=HLrA0S}Cl&I;>k%hy$4DvhxLgx&j7?8Q
zgbsS_4rhzlGc$Mj&UxEBZD2Uanw@cB9Wq^x4>TtZRC)VXr(xR{<XRX_#4XRSU2Nf2
zN}{}V#f_hLq(vKV(0d><s;={(Hjqs23uochLLJ0AxM*<2qk;;+d*>G;$V|trbXPds
zGmzm4A!8l>^od<Z{3XG)TWl+A8c$dMw0gj(!Sq5*XvC#-kevB!CGiZcoli6rb}(VZ
zc0+-9nXbTD081c4$-{gC9(S$ZO91wA!{CCn@^NX(nGd4u9XF7`MSE_R0(xtv8MN>i
z=LcPGDGZ>*KWGx}Y6+a!R%R3L{j%kP4nYSyY+e0P>5ha)Zf{3y)WeCB5o5FX_)&^6
z`ks#aD+g(lHXcls8<a_;>W*%bEFxwqqDN`ZuK+t)P6ogrlj!~O4O8VCRi_viqB&n9
zjhWzvRR3VyfT$m7Ah^A!w`OgG@Xfi(K+ziGB2Nedn)_42L$i_q%V1`X<h+QUFKM{7
z`17g)huguYV!Dp?tPiBqG)WM$sv+mN!8lMtCxMKa{sX~VY`t|rdG4*HV!7Oju?qTp
z@nzMJBaz}fJOtiA`(a*Ur<Q6h2v}1t;k%4d;;5-!ARB~*sI%P~QV!qAr0><p8aZqx
zS!Teq>R2i8XuQi2>~NrqdubW{^^1IvTX6e<CYHfzE2!EE)mqZ1#kehdwf`DCRIb50
z$Hxk3fPgrE#Op}08+v9$YOVw^mnA(&D|hVpmRDq6EhZf~w*O;0)2#D2vYt2WMlF>k
zY=vG)V$h+{*t7tO*bzH;JFw9QJ)xIw1!=+U_Ysv92P77j7YwJhkpVNsC<dxjq*NMq
z@}u?UX3+zQ{|GN(-?0XW2MBimVLWz>L;Q;c=dj#Z9WK`Q+%n7ZF{%zGV0ht3q2iAW
zB&lPVBe6#YJ-mPmD%xhbf}Q~7Omd)@;6ltCh(KmS-${Zt`NAoS7Rt;j9mnc@=a<*E
zJJFl8oY$Ax;{%fT;BCNWynveMT{ILpB^}-`O!o=3a<@2e$9@?tOIi3^d5u@wc&Vq9
zPlwwM@o}R!sW~Ddw}EQHJ0Hu1<u>Jyr<e7Pp7T=lkv^6bGFQ+tF2}U5BcPhs)iUYi
z+vJD^y4&G2uq{KVP0+4vqIqyf4Xa%!yvUUHwd*OZifI}mx+79diDx3@$o5P3a+u0t
z8)zpopp*SiB~b+6Z1A{OvneV=eD`0NVK=gr__!%uy4@Mve8JDjC;@#`AtFPo<AOYF
z5DLkAQjYn`Ut7m-d+1n5h$I(clVwV11*kUY!_?^Q3s<7|Bh-T3jvo9odF_-^U>(cj
zPgbs@g2#VKfF9ojy<la~BwxZ7)&dKi{oX2MtdzStf=6V&klvLc+P)#>^g0XipQ}@J
zMllBo>nK}byhS6U^Lg|rYppXHhsKB0@jSBt(n0*2sP=&}KB}-;QLz;uGue9+7oWV?
zwpa9T5}<*t2xV@lx=_<CbsGBbn#*5KAb4ug&z;|Ow3$6U3@0Bh_$CM@(1l8-gz&yy
zi|l_Gp$qh*2DBrhp7V62tdd^s$3VD`p0}$g9|ics<5OMkDcPEvxs9{+ct*JX;re;I
zi((r`B%>qIfOPoIaA@$6Kv`yXQ0S<_eg+eNi8F}7^ol;^%1axJq2=sQPn3qrbkkH;
zn~J`#5h<QwTlbDbsUVHi0i$$Yd{V|owX|PRJW@m|<$D9cNRP_huE<h8G#Yiv18t#P
z4Dw)`=~%~<7~sbtrHbWCRL!II-W7ifJ`$OHD=*YzpLt5X7ygT}d)N|139v1iwr$(C
zoq5u>ZQHhO+qP}nw#~ZLdYx*#PJBa*7(3<)^C-Llc(ka}B@m(tZ`YcKQ}OK<!$<>B
zOB?6y^^D=kOMt%47EXyRuB|`^SyMp76Hn3DwlAID^7toxw@h1ja#?ceKHG}XHX~3u
z%D-His{`iBUjCvjZ^ijJQ(MNcfwk!ymYgy-AQ)UEi6U0MF^88SElN?RM)I1NRIR7S
z$Nrve+P!M?wS|5*EYZs(hi{9SUY85JyM6Y86ME3;Le|&2*qAnj=QoomeGqnGPW<S4
z`HWlD^>?|bYKHr0BvmEwuv5P@)1iZv+EA}nJ;p<XlaY>L5sY37iBnXXCp+|jIf2Jq
zOM4jF;8Wj`<k(0FI+VO?bMkJDmBQ2aBS#TUrfelma%Z~N%yk<iK3cFl493;;04Ntn
zv?j19GlZou7kMyW9dD&dxVFK@ff2r^X2aem<kj3C;9<P|?)1S15iwQZerg+KTn}OY
zrrnizzd49k`Pqv;pn*Vn0>A27_!MUHa9<pOS!+BE4<2)n2ni@rbrn}Of^;RYQxDMO
zW#aZqzc{e5zT0QOns@b{S|V}UFyG8Lu_02&iB^~UcFSJ!GHxd2VsNX0G^Qjg&4F^~
zA$1L^(P6A5s#klNlTIKvggtFh``-jn<y;{f)P=gWeeAF#`!n;~Ly}+N{@lq>A%u6+
zU3p$}^(d?h4p-A<&k{{^{LL4MmEe~Is`=OBSl253=O1@aTd44XIO+1|?gi7T1_zC)
zvlXW$Z-L$da*~Sgz1W^1T*h3c!r(;$M+(_O+CXBC2WpKe6vo91{#SX?EYrt{&Ao4s
zQ*_j(2>Kv&>v~CSgn8)NSnGdgk^MNX)ZErAQRF<#<9KTXqNLD#s1*lT=)lyey2DFv
z2FK6ddttOhC7E30v54^6ET>=(tPXW?N`nkUASC!Izsj|dFocxTkEuDgFcuTuB{W?|
z;k&-dLq!5irk%T6c7btKO|YL)N7^cw)I7sK*r%8_efla60TFa~5^vQaTfRAwqp9OK
z2ZCmub%zJH)>L$(h_y>l`)EWGLXP3zOP6%Id-TnS^k-v4rIIU>NhQ;Z2U0*-!Scpf
z!p4+IGAbHaaG$o)j`WH$e_{(j*oteWjdg0rafbk_UjM-!3$Il4RsVy<h!bqC8RnF0
zI)zI<{x8orui7a6`ei^RW8#R-y*R%h-uRioss0(uJG2?&gDC~PbQB3?Hrynh63B46
z*vWHbUxg5Z4q)&0Obfv_0n8N@$b>eE1=DrddleV&7XU{9l;oC@$TPAJ3HSWM@aKZa
zGW(VRd!oP)&fejgTDb)Tg6*;~C?eBm5H`4oe_A1@g*My<+=k%obtFXBjIPjhGP7!`
zr_$cCmFkVRCq+`#-~D}k$(k;Zkp-+-n+ea-%$7LjD3d#>jDX0hDWy`!enGZT+#x_6
zn}H5SpJozZ2p2Y1%4zj4I)GE6<2*c@tseBI=k-i7<B!{O1<1hB<S4pleYQ*)AN4il
zrMNLDaMnrxP{|9^?v%19Ib;TA6D=(&``&r>R@vDs-d4pi34AktL@ij^1ju$A&<aR?
zz}Q*PWGvt35eD24G?{%b(7Q;tjx&Q4kLvm!0Rs#XTR~hhG^d5e^N2(EB~b4|+Fy)|
zE3bq&dU5E1`B2qW-$DSXMTh4|c#h{cWs$pO15O{Yqlwjz;^3#m`p9frda6@n*1Ky6
zwIisbHOoz^oAkcfDkog8a-D2Vle@y=dXO9qNT`zLKt^u@z`??Qq0z*p@(5#?u;i9n
zZ|?9DCOdR^R4H)ik=5#Yy9m-h(m9^z9h^Ph6ML#J=S+BzcHQub%9qlD+&IjZZZ#gI
z^i16-K;P(=lraL6zu_ZDS-Es^$qej4rnKSMJTZ&ihuG*nd4ZXOmWo}TDf%k%+UcAF
z6A0uyZL#-lqQk{J<b4&Cw=6C7k^8IWxi%3jn+6hNy2cFB4WK)TTep8nX}gh*?AQ?B
zA3H9Pj}$g%qNrce0I|hjE*V#DY#&w^M6Ke?6nSdhv$aWXvi_4S9{I9{JcB}|DAD1B
zD_GXQK1EXp$(7AY$2Er6V#*h4oPuFr>sDw^S`9+w4g>jK8JxXLNl$suP=@0~efB>G
z&7k1Lpuv`A6dl{VaY`6IY=OmV<hhw*;mn9ctxbsluQtz9=}h!G)!aPkw#sH>%NUz+
z7vLgB>});yME|pm`hBVVwLyoYIEsjI8Iy<SjTUTM0RBCOY0|WkxjUQrwRaCx+#WrQ
zj~sv(yj4!10=H1OZcm3DVkZN+v=M9*L*Rk|J@Moln<MRQR?l-B`z4P%XD)xaYsEV&
z4tqx08C1$SkF~d0iZ8VEC12df=H0x>9>0||eRo&4y=sBDAi?=#cWgroBe)Bv;3gT)
z)dk}&m%L)rI3VRRnRrU`Vgk-NF+hPQ47pH`4J|~Ma*L5NJ$3FtbmqqekOWI`=6a>3
zJ@yl5!{ApPRQ?bily%?h<ni&lE%z|bfSIo+>ukxFog15O#Zl-|q^t^YjpV8!?u9WD
zfn>dQ$VuE_9+#DaJ>?S29Y=!zin)j;?}$ZolvVMEWlIHXYKv=r!9M5q`9=@r`YB-U
z(kQa9L6>UTUa3P*HWP=%X?_>L?VWPEnEY;e!?Yvg9x0M%@TLsz1y#J9H*6{^vOzw)
zH^3Usf4|1)NJOdhafkLuaJkU1->jKb3a%9g@r>7!@oM}WPoiJc642Qu{<}|a<^Q7+
z-DD#}E-We64vzYs|HpHT%#U346eYCR{}QxhdyrN($HSz#=3weEa-kHjWrs{J=bRoD
zqKP!dkF)@W>1UVdBKsQem#m|DB6Oj>NLCR{%;nG5q$x&LnyHJz882E$y#xKVu?-d0
z5KL&FRG!}SZ{R|+NGiWH=J#cYNjJoM5&P>sZpo*Br5^Hf>!>RioL^E~36}E1!?V)|
zhy0qUV(l9ixU|$TtP`)iK+8UAoNu`?3>-I+X^!B*(9D3Ol^a3KQgbz6Ft9!!mA0=m
zWFb~aD}8^fZo7bePiB5JBDDQF+fDIb6k6rnGCbqhz2LTQi(tY4un2QEdiZg7JBSHB
z-?{x`23yBg2K-Tj<wgueqFbEj7YMx@SkpuNFi3p3H|2fKZXZA3@QWvKe2I=J=brMX
zE?H6qv+_Dv%*QrAi)d1#PC{kuW2!ple+fS&HqNQhK_*DJGm4&^Qe<w+>JPW0t}8Xx
zp=QWM+Z+>@l`Fr7S$F^A`YVB@ow<zUW8osTVyeQ?W*WG)Dplo+#E#@#+^$@b8x+MO
zUPRq^o}nEzZ{c8-l}k;N+Ee->o0j$Y?63zrGj^*~6uaj4*6DWnDlkE-d??-#0VM0I
z(<h-gjMAcYk^o*xFkc;yu<{s;7f3ASyA571uh~_$ny~r$eecK5%AN^>XIQnxHHMiU
zYAOUp-X-opP3l@-0u~7=3>6=|7$q=;I2KZKzZ2E_3^$3Pdq_hG``Y-kBA6!lS?M0U
zjx`{*ZOp9CM6<t<_^DXqPR!$TL*M(DN6!U@8WCv>cFX=IPr=V3Y@3k|PSbaY)*+g^
z(2A9?z|%?8YX)fbFu>u!XEt(f<51HB4iHWW%38av<C9&gqyhvl(zq^woPToUcl!W&
z-MSwgTq@J|K)dv&q)u!${GFofv%NEURYZ-iQ2S%ESF4$9bi@2prB^k}hw;hCI)~{v
z^anm3z5*|ym=3q~h8dS~$Qy3nuw%97*_G}i_$e+orD?=3U}1gL(7Erm4QR+ovGL#8
zrAW$UU5%r4yCoz4Kv3(OX^e&3{&gt8`W3Es5>-wPAUoo(t3czaBuefw?`7#)`R2Q>
zw{{xoYgcc8gEvVlJtY7kT!1OL`Uyng;$imTTKoTZms8&@y3y#@Ll6qNN*^XSq#_nG
zA4WO73+mSg1vq<N#%|~p!S#WZOEV&W=QyPw^Z&C_X%cWz<20-mDi(?4sz)z#J3(x7
zb@Ws|jCL_l)Xb=YZc98C@e+3mFA#Ht5EdeQP4m6XKVPe%fr4T9fmW6BO*!qM-Q$&j
z4w6Z{8Cp1^>gx`G{|BsF8uDtZBsi>}8kgE9d9&}1b2PTxW6dk>&7tyA2a*iiCTIWM
zw^{|bsl0rx0)_G)77x*<)Hvn0pnOPUz;d%kLykbU^_SvIU??CT&_y4n-axcEE`HI?
z#D%{-3DQ$0wN|_lQoR+N0W82L^vOd<`#InqiW#u1b_u8uNZ%Q3%m6CIXrb8%+x6r*
zwtV|LP$=g;0IXfDkSR0bYK3m_JO%ed5g9@ki-F4IEv$!@Zj$<Tb%lCfKP%}k94S!U
zHXTuyF^iI$PU?Iw#*MCt9TZn#kENM8uD@FBFh5E(fIs*bEr+{^T9PLrUg_P$>*d!i
zUGa2(P&LsMx&o*Ts^31SfvupAB^u<}k!F&7yxFf{{Q5v;ASJoUnD?f@g!e6&Vb9oL
zfqInSj*W51ubpi0D0EY|r8lUMNKNR2HcY-5zxXyVG}{u{wMhEAdf#|@B-ukYQxMbv
zm5t7!&ieLte1B1Kg<8tRad2%Q>v-Z$0Us|k($Zt*-2K(Os4w*R<}sE5;Keo{`-kkS
zRIYYKo2u4`!-wysBdY}@Rq`bsAi5Xre9QF`>=>mKu~(HYgL*Z+ioCo$)WhlBIAoon
z9Xeg0*U=(vC6>Ns6I0j4VQSCX8CU9|5*c5~>3+5J1n#IeY~+i&Tk?1?K%`Xdrj2Cn
zb^r<6#zYxtTMpUsY_}=;P{#}p){EBmkwHNm!hNB4fC6^kh;WAlVO0Y2vmPSkPPMeh
za|I!yhSFB(Md1SsW#F~(++bpcSC*0ep*Vo2lEPbZ<VeI2Xc6Hb(oqz=`$ys7y3h%U
z9-3-F$<Zf%@-j+SMcm1Elnyiidid>IINF_!;_ON0H^|qKjykUQa8+@Y_?iFD{cLOm
zDWwSB1=UHY$9a`RC4h8rUueb6sJ+^*%2}?MN_aEn12OTM1YJpLH)>=5)Hf`&mA@3O
z5%0#bAR=EDKdbG5kRskh9otN%5B<aQW;$3{-G0nLYU5xiY6Io<UaH3UWR6i5I%k0X
zS>-9El|o7H7-_gG$Q2{;KO4IHY^)k(x4}t%DDLs{w$C4K#L7^lptY>aENJ4Ea#A9P
zu778Ln3BwVnl_X&a>OZSC^3vfKHee$s!=J{t-cMmF`)fnD5xRlC_ZES8LfMRF(SYC
z17dtS{Cu3-7bUyJ)O?|exu)wzWt3(YHZ5{6U4K<emrz~-fj+UZ^LNtjGV!ij&>X2c
zl4kocowBf*yl(#CFl~|$djfH7em$u;VlDSS=v9Nef;(XrMTcT*$&G!M;e*yK?e^v`
z+k7}d3ei8O5oy&Dr$LhaM*rxY-FbMI<d~SFvl7}4GEOD7)l5M-<*>Kj*Yz(Mnn5~j
z2@C;pb=im^wL7kq5%|hK1T5#U*gmC^m~7qEmM_l@{&sU=%<hVUgEpPp!_`5(ciU*W
z-QCt#-0rP?gITS$Or$VeD@0xhiFf`LRjkA0lOvB1nmV}>JMyZu?6HXCG2^pgflGsb
z@A0G_u{5hY)BB((=+N~pGm(zn|G@J*Wp*hvIhqVXlW_vqf5<>yYndhr3Pqx3#v0G}
zAv*U5H;DYoip#h%w>orT$WR&BS+&-dz+|O3En&Kd8lSp!TK11qft}F*!zdFK-Y8za
z?4u^ZHoR0=696YC?pDnMg&O$kBC#LasPT35;$PlB+y}VJeL7^4e?G^CfD`Zfk(H}M
z?kB(A#-AIqor8r<krd&ApbS;fmqye_bm^?ctWP?%vlFOC?*GUxY>OXk{GH<|q0(Tv
z^*|bb#AqJI|3JqlMK<Fr%H$IBvWIv}orreB^nny|S0qAQ8(y=_Hkn3)c5q+Cuu1pK
zw^E&x4Uwo7i3T;MTJ}}4o->_3+dCO7?YuUZ(LMK&bEFmu=n$aiC`9t&nF3(!deQ@i
zlse`#sb&17^#w9bzpZ37ECL5h-keOFjWs3lvKpBV>TaBmwUKx|-hHdY7|1bx+)2=l
zeH3Z<veN9rA~rk*uTb!nKVLGWE2W}9ec_E4xV?3@>o~~rXY?+|Go4yKxO#%s_o`RD
z*n*d&s$-hJ9#(<IalyUEU!B8s)_Y?L3^Es;;rf)$GqKfeeh9l>Zf+dLeeMrlC^UU`
zeO3NiaU+b9l&inSM_qyr+UZX}oY;rNM^AFA+&^PPuzx<%f@xsL9yBe(?m*9GR4g1W
zePDT-&K@*Yq?44fD+Z7Pn`}9#dYvNF+-}Mc%b6a7519;*qcePre0apX@QES_Ll8E7
z&wDSEN}l8H{|$?cMZDiQ;VY7?Y|fhc-{(dpHSsOAxx;p@sWW=`X>)iwvbxgeWT>p)
zjK0zRjynXh=R6~X<H?M$AI$6pKIAhnHtZYOja<|Fl5#sqg=V$<f-zy__ls>~Cvue{
zu~fj3PEnd7|F(O4wy2e?I0|UM+Bxj`+jYLZsJZ5h7nz3-5GG287YOh#%6qj@6$_SI
z92>q<lE;xoz=XxVmIr*|1<Fy}XbyrOcn4edqHBv;erLgtYaN}Vm07rhBo34)kpjV{
zR2bwMJ3U-BU0Y@<8BEs5cGc5RmolVcP`X}!;_l`lm(t(n8{}CaE&5drd6B+!N+pt;
z<U#fgP|gZ2WlG3PIF#uewnXUVVKrroUhT8eRp^JL-;~}!(XG(gkYnili$u;Pp%Ck|
z*<A4%&m$U$t=6Sm9dPBqu|TNgT-Yb-WZuf#{<tYr_^u*f-FI6|@4KK_;>3c2X?7MC
znO&m46WZ8L@{N;%$XDTT{*G`v9qX(#zU^san@y0@yyX=LAtXkBY4Uv!idM3GroZ-q
zPFQ#l-_*2R_<2r|0<PxM;cRa(6CMD$T<v7<u^$U@sc4-TtK!wum#N5ZEAH?sRnAeM
z+?5%e8BO1$I5q|1=2H<rVV*+FM45sFHGP?bfCn`-Ke^exZ(<@iAc5O;<V|u`V;!;M
zuPq0wlsul+Q<HZwS*DPwCb4)Lt3L%m%{x?snuuCXIRF{~3fr^C=Wqtq#kl6Ekhr=C
zEYJv~uAYe1EK@X89_@67LI7Kn<hKn7mp0h(%-1GgL<8+(%Lah0YMQ|JTO6d?S+td*
zo*1!-7E!&_#MTzYY@?T5=ho$-Ad`g5%GN+^C$r}J!s;9FahT}{9kv7=fdA#Pd%Dk$
zG0=VZ*YLpe*ywePUQ|ogs9DVVP6SN2D$Ltl^P00O!wIpHplZ1-n6;{$<so3c<UD(+
zRK>_-W7@QeXFa}BmNFNTO;F)g>8>QTI`s4s$kn~ON93z~KXL_k`yVh-sAU_MmpP38
z$f6X*v9`+wJ=Hfa2{Jk&PJGKtx!+p5A87Sgj(gpLFk#rIxz7Rt$bA&dJ4L`xWxZ_f
zxv<^5NBnV3{)RErDGBs_Q!NcK<DU}U;kEobXs+P4t%-_y4*burGDP!R7-aA^?M8>K
z(8D;TyV`ZsF(@!J4j*r|){%PGQzGn0i7{4Jlr!XF5a`l|zk)+E%xV&Qw9Ozaf)ms6
zc2D|-_}?z)6lSwF#VcCZ-lOo#qcj}jyfC>UPCn85VEC&Lfh~HfhL^9Sblte|(a(E#
z9i=M|e;#*;oW5S2ztF+B9#bY`6#5_&Z86T;XFLPCx_LXn<eQGa)4l*(dCdS``<3A-
zoxGH+{%(>uZfE8SKOw1R3n3d#4j9We@tA>3nrK^jT+mWrxAOyYm;;Rq6bJV$5Nqom
zTwHvtFnX-W7Ivfm4JEwqSw)302-;$X>Co`&Q13(kZ}fsph_@0+Qr$sO%6I0uoycW&
ztox2owj676jGm~RApho5lD1$jq1`jGi&pHa8-+=T%zH&*Zga8XVp}%##;Ce$>U`RE
z&$L%C5Z|QvK4=0$p^z=rS~Ra`j)J#<iYd%Qo8ZX$+~O(EQJ%n2Bzf_1i9f?G#g9n8
zrl3%-_e40@kV>HSVPu5KJAnqc<Gj|o+r_?_ds;~h^#%r-K_+zC*U#0Dx`oL*Pw&6`
zX5n0=08|uaHz2F&lB2and+5e#kF9H^gXv59xgQTRe*6nR^0@Y+<$6y)w8yVhdqNe_
znI2s!nscf@wB;wMrHHSub07;?x$E`m3^Acd_*&~~`av`g+{rBsWHUQnFN2vj-@6%L
z(w$6g>RpwQpV`G*q21xEoP>KOwW|R1X7^Z#;i4WM^C}~d*z<%3k%VVskYbkEQLG)5
zOC%F;2FX>=3sn1aPnqF*>?|=t{KCipZs~#MyTmr)&E$i~41LeW-jmzyl@_(0;kczA
z%?sN0kPQI_OGLK7bf4@mkR(%s+fQ!%AaKh<m4t>?@w4kq)?)^K-E7w_5+-_I&6caH
zcXM{|wHHh8KbK*L+nmfxDto96cZW#S(z=v23%9vV24N|Nv4oU(D><dbJU)7p@FX-^
zp^jW;N42|L$0?F8=&A!%z{5_HKZU2wOWW1E$n5ag(0REmR4_?)t5`<qm9i@W8K_{|
z4Ev!-pL?H%eUiZjOFwcZW=#pYS6CdS$zFhA6x^G6Fb6s10md8OqVdK`cQ1>pYT179
z-DAoOEHgt?g~ELrDTc$9?SAxY^`u}2fmez-4Q%!($in4}r)bIr-vnGszb(sb;0A|b
zra9h@c@E~1DNi}=ntS-N*u~LH>O-vmyrFX?z(dVE6qv=3l%A&+%^aKHyr#m;CR7Dv
z%HBHAY%`4N30#Ebi}S(+%Dsl`j7a3$>qi2m-dZwFfUMGm{Nkxz(L#mQy(kgyC_{`l
zx?FZE>do^@Xn=6rCF++%G}%!$Tdns}LxiO5KZMrH_v4JPb0RXN0=@D^(w1_q+B~k=
z2#)itl<AXo-JCL&PMENb`1qc>a_$G<>wCj5VRQkvl{6y;O3~eVAKVX?b&Jl9mQboi
zDF45U5j5V@;rABMpUC0494bf2D93Gq)aEEaEK<i0F<;kI>lo%QC*scH7qYNZ>}wX?
zjv}$VRF=`%AQ+KrGEaEV)qVoG2Aclkrm0Df;{n28lghDq@joz@)q&sW+k16Uk%ts+
zpiUqs6v7{Y&4?(d!`~^JPfEIRVSz$7p=rDS{&3JTranoXNqoS?+DIAFvalKucKLw$
zUIV(~qL5SdOlAm?g=ea`EEEVijkOgp`b{&YKugwg9NuJO7i1yRi|PBYHd85O5cVD~
zmqGkn#5IeT77S~Fs6aj{-<d0N@pOi{mbxC`J)XY}^tDbVMQFCL%1Qc|5@G;CW42>X
zR+l#bn`aLSE?0}C$v3A=ioH90<FNmtMgz6eX1Dm9@Brr`TLA$DK7I`pq{cr49U!8=
z_0(YEy~H%ixKNITK~&mzz<LH9HC=H{<3rHa$cPPayIIlO)EaNdT?$B`adA=0JOR&U
zT1SX`!iZ68DDa|*xdjt)NwqQIS}7emi%^6uQoa&IN;G~e3UsCFOF7zp*IQW4p;YTH
z|He<86J5>i2%ERI&*7;f+L)##7wS_zxhM8(m2eYT*A3$wbRt&Nb0W)J54@E_C=ovC
zT3R23h3I<xCR4h7o!qBCP_1-(hs^0AX0sw8XKjxt5k-F7FN6v}{!PTR>`7~AdS^&r
z`LyM?KW;)R=HEctiKXlf$a9l<6I4*U>CiSi00KLp9DtQMJHA5!GUl+}Q09th+;O0&
zS^6AOjqlk`cP+e;cp(1l^mfyttmY6`T{cUh^o3GVKR~4=`*8Al8(mk#fW)(n_M=!u
zH*$0M`4oa%ks`6i4|5ZoA+8BaT)Z|96A?4=Apt0K)Cdz1ejyvlyU{-8d<zIIroG~T
z7kRjfcke}=qjDEgZ;}GZ8{+mp+)HJ~L{eU4ZDuG_v)x1A^j#l}u0TJN;OTa1DfO=o
zF&V&1A*=cP1f;>HWD(%Q!wZYT+YZ_59(hTa+QuqtJ$-{g5;eU*Gc*e>${6g{(KA!4
zQiFz~CSe&Ezus57qq`F!VE(bquFn=k!6)cvR2{ecOsjzx^nUa}TTBDKcsEv&-Z8iR
zdVnJ7R)yHg>rl}-lzSOM#u4GwsuFf^^63hzji!OAm#(8xBs|QzegO-B3g3_BVOG6?
z01S(x=m8$MZj}*_q9S$_-nE~C&`N6G`c}r@_v=EwfFIcUb(he1q76SGi3|VM@Rdo-
zzdwB6+3Ec>Q11|6cq~V*Xxr^PsYfP)3;`*cRxtG$Z;|b&eC50xC@Ss@=&|p)t2HfJ
zaw3>o_wXW?uqT7YHiBD-Tf*AqXvO`I@7QB4m6T=3G()l+_wE)e7KC3d(W2O%*r)Jn
zhz9;D+azV<tV`yGZC{72q>8qx)|Etu5}sk!Hv*@*&k{cG$#K>oImy_~@!_p;lURPT
zM9&quB}Spj_Ak|;_Q74x!G^zW==}wDV!(fBs|%n!isxcK>l?_qEOC_Jo+OJ0<y|E}
z?>Vx*kpJvt%hWf+3a2o|Zq>=nd5vw;l4jE!Q7)^w%w9ru_(T{^=6y@r=nmrsn`5wt
zs0VW%CJ37C!T1k=J@XccHrI%30Y211KIw(>cGga<0Z;nKW-mt>y!)x_sPFFP@7Nr2
zL72>v6_~kX&ee^i+GXz6#{laE9Ra3-8hkFfUk?UhR<l<X{3!mp{>5d|Fr^mPIaX9k
zf&9)oB4~;$+Z#z3sG~dXwaA>oAXCa!L!UFn{;zmZ?sb-v_A;fh5}&2M>G~OQMTgjQ
zv5<{%B~*kCJs9{x5dL*1F9$jGuc|sc>ZWGi2>NkEd3AgEo)}A(a0%2wEtQE0)4(6P
zEo)48?aa%@IEB)T+B2u@4!-@;WyStIZD%E7=ct=?4Z;=?1U!|9yUgkFs7pSb>s)TO
zR{vZ5h%lsfn&$ABrtHg`p?HYMQ=4Fvq|<Z&O{b;KIE#v`Eq8^~FbO@c+5s=+C&1&f
zk{U^6Kub+t6A+-;^@;nIVgK^(hRkxAjt_A25_%v{vz$N2hRo?6U4Tt1<O(Y!Ijl)k
z37^}M7gmZu3<oP+Y<0>+xoq_65LqN5d&i^6Hiz-2&dg*&S38)`swAtBs)$kbJ~D7;
zh}MRV4&EigGwEAfbF%EDJ43>$j8DoH>YzAxDQ7I5qG2Ezcf}Zy8fS7uFz~P3kh~n!
z)l{VlnF9^ANE6>ZCnYt`Zem&*CtFXpYZ=_o_%tH&vDfYsD`#Fbw}LXKLNyn*%4CXn
z`|L1H=vOi=n=Wvih=$^1#K`~h+1RuChJis8<p7YI0_>3we)1Y(jK0{6xtD}33IGF6
zA;X+xr<W=%YgD|FN-KAYnTSx7`Lt9LGmVifQ=W|Eh#R}Rqc0nhk^q*AWIpTpw>-|_
zFGTs}P0?AOeH@tz!$6>Ia7ba0yapxUY;|4*$PS@f?B0H|{~4+?+fC9Ta$5d&&9J=j
z&`Gj!M1j~Ya<i#R%+C_=<Xyq6*+cB%bsFfT?0T}TggjQ;;{x||j+ss83#Kl9FHoF`
znBm24D3Lg?qKLN*^qoC;r0KuRQ!gg#==1#raf8H%@|A<hEm_5AwWzOzgTV@eXn33J
z7)umc*;M2=&kjRjwiJdIc#a&tg@ExQPId{1Ogc)eN-c9fclBE{@J#~MIRfg3c}!{p
zBy;RgN16{#Y^P;7nn)DpB-gP^z+IWo0FdkNO9AZC#jWv3R_o&#Cu1+C!L%WpMos+U
zcu09v;q0agOZzI=%WS+uZam?C8Jk+>lYf4=$E2l=3vFs)a^`p#NSqvp){3@$QJ~Hw
z4*6?Xo<Mz9k)HFcqW*bO)|IOuk($7*I8bpp=r4R#gmIb!-Xp@I=&1=*127uI{ZRT$
z2{PANkx^$ZfBh|Ku&O$`|Mqa!8o`=4N&5fQ5H0SYegOa+3Pw_y;|*aGVaUAdG2YJQ
zKf@R`X03l`!!x^WcCSQ<<sG&>jEm{V)N3nHa^c?eF$i-J(e}M#fJ6gRJI`zy0t!gB
zEUCmtmIt>zhaJ#!%EQp=n?LbA3WXqXhlH$(sCskt2~Ng8G%aj*lyU8HQn%T}T7W$=
z)(##j+*~QX9(fEBgP1<Kwc7b*pF6=RiT_x<5?f>ONn!34EUspHs&?;kz6q})h_7@u
z;4ZwUv5b)qLQa_;;tN}t4yoi}LCC4soQoQ^=;^Z0r7Hfs`h)|ETHxHFE(QGK;QU89
zu+Mlb!vp`U7K`&sQws>0hjI&s4e`0YveqK1%MDV}@sW0H3DXoFu4@EpVyei3luSQ9
zyT&!gABMAUN#e&WR!d=9pHR5?G>XLPXT4fGcd>=l5lZj+YCeFz9D{Q@@OSS3(~YJ1
zbYc(Bu6n!VEAbg|M{Edl%L!~XB$TBoe;-n7jO_OkEffg``{?2%d-0gGrqfPXi4@}#
zPll=#h3eTZO0{se(0-=bz8IT^q>6wYE<2}n!bp211sR^fhmOvm?HvO<!MtX_Mia(t
z%E#%$&-?b8Fh|{Q&bUSPqnu5=j1%+OS>})un4VS$8Bw6q9iO+peYBC{kXqQ7-pM+g
zFoUW|(KK(*M1a(9KqYM1_hbNon;E0_a3u-_g*`HxC2CcTVgSeBB|4)w?QGP50@_DM
z4Md|~W{@3l&mPzQJ8xjv=E`r=i2JMS{|)Bvd{mpt>w|#1+Q_{ot{GCR-a^cGwA9ja
zE`R1fgxS-;W0NA+I}TaU8~h_y;{m)rRk-hIhm;r=_XkZi?(PHPo$$1dLJ?jaJYKYq
z8=kZm;+-Ud6~;2GA`v%vYuYkOT@q0vRkx7oxFk6jY6PbsNEJ$uAEoVk9d$!LvYw)0
zR;s?n{ttcQhO~0_Shkt;E34l~4bCCbA&?n-WWjD2(W-ux;Gp|1kjQ2ZZ~@ZOrHD==
zBH&zFr{}tsy;EWHrkM@_%x7G?CiZSpqEpC9@7$QL{)hH}S*hrLVIEeok${OY&vs|f
z;=5e}q<m^Jee}^NC%!&KFH9&4_lMQ1ZG#C5Jk0-0Qcxh9UL1vo<Ov;^fvKh`H!P>}
z9EU(az#_WFi#ON0u6*0Xqer+nlvO3$!4Zk;TM^JM;?@yTak}z8L>}ClZ*##8FzMuc
zDS9KHwou4bi&Y_SmbYv8qvj_={&yoGZ)cJoni)i=?mGJg=$#^rIC&_)#~rHmqS6A-
zaPO0dy0z+PNBr7jHBt5f<wc~KBsD%<Mrvg^Tqc8Fsy9=u{PX5~*v7<q^g{P@fkRxX
zQ+eN#=_OKnZ~9I6SeEXpoobk&0@KYhoPcmh61H*E0HMp@{bv2O@Tj;E{RKi}U~@B|
zFh<z59OJNsW!phdnM0~K;&2%~6?Oe{N8}_<N^O2}d?v<XjsVp<KPgwjYJO}03!$^?
zg_m~JLCl%9y$O!HXT4pFTg)Qm4<{3!kD4YutL3r^9o=O0)+V7okT~+so*TLsWvL{s
zw1>Qd3czP)!2>)26Utz0t@zOC&<ig~<Uahean5#M@f+CZ8nMr#0C!{bgAeTtCN2)5
zmM0JEiSW6sIgxkH<rdjyh#A`Yhotn>gP|taX_nAmwct*?VHg0Q>LoZhxDfZ1B!T-G
zjcgAKrzxZ&=%v3=IwRC9iU>keKDv6ff<_oK2NEa<|6?UY4IPh7L{Eov>G$yHBET6Y
zLy{xccDA~h@ccV4NwQ)&<PF9rttnMn6bB{p^lrL9(xl#TFmwYhD)vw1@w9_uxiz`A
z7Bq{rnXn{A0P@6stCF*4m5iROF*<W^Apbsb_INCNq4Q$)ENcC{?f3xdzX8sx4Ki^W
zJ8F&b$bunf_OckVkSYvqrfaoJs5f%Ps^h<n@=~E4(-`@_((w-v^w`dotTygG)f5r9
zBQ+07W;0YC3Tz~p=x#<(F>7zn%D`|z^yr5m%N|i@Dk#g#zz99eAJB-N#HIKyAA2aH
zycGiS*=_}&fN0>|9>B;xKLQ`I&fm?Uo<^f^itS2rkDLeuux5N{%`AhT&86R)NkdnP
z451JEDSvTcNV|#-Tykq9NYcN7cUj#pZb26U+hbzr-_LOnx!2%EI!2T}Q`QVR)KYf6
zpf~6nlA!#W4&m6g9eu-@5maMd7_9gB+NFu4*j&z_B=P(3%*)9L9#1Sg`iMy2u$heR
zywaH+c>in!5BxUM%$S{f@+HW(J=O=M)eL?CeC+wl=-|CmPd4*5tW-ZCz}B?pqjE1X
zsS}uYK>Mj?$QL}i(Oe>4!1@#o-)=>1u9Chm>=C)qvF-_$ZFBFlo)cevQqR?5bsac8
zB<Xo5M2LCXGQU#+`7aL+Q1MWq(MJe6rjMr8-WP7*ZB->8#j^6$M#k~lAWlS+L|8y9
zrW*a;jVHX>w1i_Ok1$h2zQ*;3ZV5NXiAzeT`dPtu4D1p~&8Y2rXr8DTukd5-;YaaG
zDP&F5`BEESw{IXg*>SFK4el;@%?oG{>jW@u%d=To&$0Mu5ojRKPnl{doT>PTn6;zl
zXeEwmSopQ1a+y2Ha40H39Cxu6g~_*zjWzizES-{_q1^vorCs5Q-enk2H;NYRor3!Z
znEXk(24z=W)nuYi83u{=v(l;sL4KLAklpTxB0y;Wb_v8&PPg591C_j_PQ7S*snsdY
zV`OPVfZamXxxP92M{dT}x@ya}RzifQdRKHkYNHsimL9&TUEKRzODlc=r1UF__}k}~
zH)`qeU7K@Q(dDQzGjjSYP~eYAtK?#Wa;S++cF|E)_PXZf+FBjNvK!MD*lqEnUxNdE
zU8m!lgTEn?_JFfTLnZ&Hd^<ABgvz!v-{uHF<@S|sP?kPd0|?OI*Zd((mZ#)Vx^QCU
z#Kb)~I>4Lk!t5^W)08g)Uri}eh?g0SDWGF3Rlbay;P3WDq+5qFBuyKTpH`|I?=aH-
zrHWj0pYkN}Nu%n^`i~@L=P5Rx$2hA_(+4FvEuIq=ZzLzLOm|Hpc!`XW8QEJ?KizNb
z&#hhWvkXs~YDQ^fG&KZ)S@JLUM23*FF~HN=5m~S%rgnA@l+Y~}h4qXZ7u@0Kq+qkK
z(+a6nPJb(QoFFmSAM2v&AsiG5G`Kcr9cAIfYs5y_)n$W3cy}^fa^=OYSej&5J%oCZ
z>dVkI1+v_HS)q0M8a6{TYmjbbIDOt}JRHVn$CvK+XezHInz6vmubXYA+qbPfG!T8v
zbsr8&#vqIMib%9!c617h@xxp;t&vKt+UOO1-~R{fwRI48!@wm^&T0u%vr>#Vkq4@}
zL}eRBN6~)1MCpVtJl7{bO3^%imAr;1r=<6k<qhF5Swu@M&5Olg?%i)jSWe}zRJ46q
zwYDFMY9R;-Fics!lMJDXn4cKoCqEgKET2(Vm~}=qPPOAizo$~@2Uj?F_vZB=uIp$#
z6~Gxk7Y9RFQ*DHmZlNJC#C~>5upD|KFA~_kMSg8L>K$8hi%*m2P=1y8*Cap3=0*%|
z4-)Cd%3GLe6lVUnfNW5nnfpcrJIh6qnvoqsqXq5|qy?j}z{{b%R)vVxd!$Y_Jy%N*
z<=+_V<O;W$FUr=X@hz+i0G%dX$DiqtdG4}W#~kT}>I5geh8-d}kecR`h^L`p8#W{B
z0;w!Y%TPwYQoUvu?suXQpM4{%XY_K~5=J~F0)n{GblAWbJyN5b{RROk;XnqvVaXm?
zDGa${Vvnz9KkNDtNmO&q$m9>D<c2VEQM`~i!}kuk6epB-&DN^3cyndfB|{O?)(#=4
zvu5s&6qx&8<U=qn#iyhkI3w#;Gx_1kbj?ygxg%T<g$mUCzfTG7=m2rNQOogi7qS>Z
zh496<?YL1$Bn?We9eeHBdRN=-Q*@Hat{9&HXSi*yUA|Slw(8&$$U)nNUWn^H&(Unn
zyh?Z!EjY#aZT&wG5v|(D@Lo*rosy}#APMnt_~QDS=mCUYw~BMU-?W8wan)7aG=9ZP
znTAz|7hZ5aZ8(G}!)4KIK&s74#8&Kyj`vA$-{A}F*sT02M$CL1dR?n9j=qmcm?t$z
zP+#4=<Mjd#Pi1LJZ}9TT9Cd(RWwSO$eJxmCk58I`g~poQ<!*+@Fo-3XZOM~V{gJqm
zstHiQhuvPj`NKUS5$TZcYOY%KFG7%<;4APMpBHNNs^)Clb>tT<!f$`^l;naf@(zdi
zaL2cN%wo#Rll+^!{}6~h3j&M=zQW6Y4)-f%Y2d98CCIEuf}n}*P0(|)-f5+#@o`$C
z&x+0bCF5$994!iN$m{s(8`i-jAkw(TU%5Am`HLg$Ki=c%ZFtHj$fY^rkD2{|squ%}
zGrfx<6a{!9*7S2iJ#)HTBUJwt>K+Go7w*mui$#-(LLma572kdnT?t!WTas_HQUOAy
z-fm2Zx~1&4lnIJbW%RGRF)x>k&xX}44HWB*9v1hwgNa`9S-p{UjQE++$fOs?SD9pu
zdO)0{z7u#4NG^LiT+p8m7G(N`bfW^SwmxZNvV@{!*-$`@kBK4pL@JAp%F^BaHXH<7
zx`a)!;$o~SxYq#QmXt$(wyRFLJJr2OajwD1b&+}G44|-^Bi-G`i!l8Huzqjh+VX6j
zhY1`{%Bo4YLyWN<>{@5bA_)e>5@&E?FQum!V=*6;s3OTea0EYI)V^l06OH<6gj%Uf
z*g_buFZlF*wA9C=9QvHn$vgrt;iA$~RF!7&P%P5eV+$EJL>;3VVg9<^bIcg7qIK3j
zpqSz}ZW<kl5Hl&FZOk(&+`LV!vb!xM0$3%XfYQTzRMDPB0e8k?N-*XF2H-_9<MGXb
z<mHc(dBeVQacAcC-z0k3vP!BRBP9!Ew!U7G%jMP;QGYF8X_S16{Kg)5eja{C-wu+z
z+7(oG!f!I-h5{Jijg@qzbq8m}y2~RMfw^Tr_r4NI^T2Mvk?{Cl2sR6YY#x~g)%v}o
z4^ueM5G`n!FQk}@m#C$cC8MQ<{8zX`;?3McR1{ar3zYfsQo7z~$~%+Z_JzO;Ev?A5
z(=zL(ZFmpcvY2uX4|_TqjbQlC&Q6qX2tM-N?dy=`8=@!hXQ${(-@+6;$JsTYv{C7r
zEN9c^wqz0#cS3RZdU8HI_5bkw+BeCY1^O!W7#>6*r(YiIsw~dg<Y`(@2<Y>B>F!AW
z*?FCMM}nh7>WvZ3$$xcAUcDmOc=-j026LePG8Un6N@0Ku_^7Fw(eeTB-a36<V`k%O
z3~Y$?<}uV}7}vzDG-kYSwEucC#4DfkDMkRM$H0zXxBuP6;w4rb;$joL)TB^P0F~(J
zt92`sPGeN3v&f=oUt>#xr+EZ|`0E2m2QvGi_=oKqI8>7IEHzgRSazX)u~ZDuXR^Lo
z!MSNXa2Xc{(J@xv02m>}q%*c^{KoA0Vj?3f48w1@-ItaPLAf==+W>Da6NE1%?d)Ax
zW*AGAT{F|0TDv?F0}IB)taH7tYT+D(^oz-nHZ?JfcMp2JkEw3WQnW`kIf#AsF~f_v
zWW0W<I{vO50?MEy0|+|XiCl#^Kg(C|c4;LuJrsufY34RheN+rxZ|_^p{dy9yhqKN!
zdazZshtO~Hd4GC5=AP=vF{3hE4^R>1;`;jXW<Q#v=D41UK42|tRC=AJoe!aD|De>g
zz4_QN%QP6EoO3n-x1Ny>ucB*jaZ#p5>D=Vp#@Tm{x(#dXDZsZZq7c3A=YkU3Y`qYt
zYYJ7Sk7tY<VQ{=g&UJsGMg8Lg5-cG6Xf=$6ffJ780m)PwDz4t(lrzq%Nn?fVSJ)a-
z*8LDTg@1veS`Tmm-b0GxT3UN``P?zHf=`eTkrddlD;MJb5n>NvBQ-Qw(+RlO0`Dt&
zI34}>CD@X#8@XdOFr&k8(fgz8dx_33Z{Z30nc*7p*Y#{-H~cJl+JA(kOs0Pm5?_x9
zyx40NF6+L0w;`Rl=Xzj;$<{UUr%@3b^L${%%|UozOu21VMcZ~F9>JyGYFtC{BXj>{
zPS;pHw<46fu@l;J>;3wmQMTq}`Nr&D-X)#c#D_gU4Czj6wZrcEW7;15oA7O~;EHoi
zPzr#*={?PAJc=p<(;zG_`g#*N9O9bOltJu}i|hnW56f`!L{i4W^X<thNZbrZha|-D
zH`q+*6<2cvW6kD;GiEUnCPT<f!6urH>26OpLmr*4=`sLTvCEzRzIwQnL06qE*+KRf
z1KF_q#W(?WHh{QtBrrS8tBzIre^4Y${|80F$i~3<|7r~!91Q<wt$~w+mHGd>*3b$n
zkF$>UpF|=YuO9>YhCuSa8p)CX@lHF48$41VH;9|tKZ5@b8T&MVgM^F@W~aM9l{*!+
zg`U>xrZ+yTyuer~l^~UAAWOK!P$6w~&J7L_03@l)>}~)!I9oP2I64+CE}8l$+;e(n
ztQ@xS2~3y}h;M3vK}h4%N9!aOCy!XAKp}v~T2}yBTYxicKv`WtI5+@waPU7rpaNMS
z07+){dQgD~SOWME|Llcxl6<&aS$%4&v@@gMC**zrV-Wktr>Dm61UQ5yaL#}LQw0CS
zj40Oe-w%=e3|s+VD3Bm+p1-I-!THUR5kdc)ot>SWnd#jO*h^#5>2V-?@Gf=WWx-hj
za`t%8eYYV16XySbj+};q1wfXXfmy#z*8EhuTT@wr{-yyq7!bkiJZ5b|Gy?Mervm_3
zPEr3zV2DSv`olax8vj01;C<tx@2uOp>pc<uar_BW0fOb-0hmL`P<23>0apV5$Y!Ff
zsIdQ34;aG-?)m9i%+GAQQ&X^3W@bOQ_aaAT|K@b8{_Bo`zD*}Et^i!^?2YUJ*FG)d
zKba>U6Uy)qkmX%G5C;dbFP%J+bx06zye{&uJa#MSfKK7=U!YX|@Q{-`G8%2%^%eqs
zakcpDV?Dw-vSvSPRRVMXcyMrVdVY9-V+a5bfSL`zB`Z%Z|6hB@Up9WX{i72A7XWoW
zcECqKt-##A`R?qQZ2<sua<%xlwLaXxn0XFPKs5b)=zbhy(9ry!p<in-jo*ko`aQ^N
zK!$zyRXlS4qqnm=J+ZmRMt`Aeo<GRHBi{{|5!B}5l=Q#rce}iHj%DEek;xfY{gcB3
zfcw5v!28})@b_=_s7lQDIx3D|$&?^<A;51xv@f2LKa}g&wIAm17VK#Mzf;9fz9=*h
z{de)BP#hkd{xkmUzd5Nt;*&qQ{XUIfJFLIGz+#=7>tB23?}NX;_L=Je*IYkP9;?-r
z6OBKq`7>JoZ@Y51^SK-qAPs+=o4+;cGsD+za6<&@uD&q{*Hkbse;VZhI)N+xk;gKf
ztGC3B073$la_0B9Dj@xn<NbI1y(d#Zn>;<ZGc(cO10Y`dSwDPAP(UGCUpox+Ic)!o
zq@)aTtg)u}c6WCG-R!w4bHK-U;UNH5Hi+dDPSE@9T=;&Z%iz~9vAuhsbyDA~UlDHr
z*NHwvdU$`G1H0idP<^#O><9j{jGq|y+$Vqet~0V<qmLcvu8}?ha(~=sc<<9jkiV%f
z@5R0Y=A0e=_@|6Zz3I8FA-MnG4p@D+Pjv56$6s`BV12g_bZ@$?7x;HQC6G=oPToFZ
zzw>X8;s5v!9!-LHaES0$258V;*wzYI+rAn!Vi&U=Ow`Q6tp!N~;}=c)OZ%UQkne;B
zDq{PY3(f1JHr?zKTFOxB1<^_Ix}a3g<N8&2OPjY{c(R8}WNsVtr=#E>BT#Td7oX#D
z<Lb=9uHCrU-A%yOd)j)PM`zC1T5t7AkN37)J!78BPpPy}VKcX7*Q#BLeEwwF#!+)o
zY%mm=rISpvSp+5Gj{3wRhJzeWeK|cHxdW3pUWLgq=AsXrQG36~MZGgmKlUfv678g^
zj;!ERk-T)AUno2G!<4l5HxiFR&bq@vifq$X!rE@}59y*Ih-MEDDzGEmzd2pDA}HSR
z#IUuiggPF90$kxP_Fp~;in6=nEz(PcLRS}|XJa1EV9lGA@%)HA`wf44j?Xon-8SZ0
z@keA)i(q{xziETm*_G7sH~Q>E$axHq=9ea^BX4zWUY1j6PcFHd$Kp?-Y`!Pf@T-GM
zgPXbv*$D4sjp?ZYL2X5ulbc~($-501G`1KfK~6h6;(;iSC=+}NcWhqjnu=x*{?eZc
zbxAbaAX6{fK_$IXVnlZ|nG%hft_1HRBa^G~Jjy6>=Wt03zY~>*ak^7fUutjcN<2qr
z@%ZI0%YSC3f0r)(Z&qY+GFKC?Eo%m_$Bws>aOpviff|Y4O=X_jn<9HVi@mbSe3J_G
zyumyIV`_sfmNCi2{OpZ9)i-`ND;LplTt*AkSp_VAk%pa<Y~>aaBA=(^bU`C>Oq?#h
z7z%=;iyL9zdNc#ZJ6H?&w%=D7O*PYE=qqs*{1CaDQ}1R>p9wNH%LaWkcdUp(f}?j&
z<%vK^*o~4JxVdtx_;)4nV&z<SJt1vvl@*qA=lr_Q@r&UyGTqm&6GbhN$Su|iq0>es
zcA2P1z?$mMp3Lp}D}W5nH>12o&5l`otiYU_Dc2w#_BU-^s$M9#m0@-HvqlOty?|#4
zLU&Tp6x91_rq^_buwM)K{667tk;$0tn9<!sXpUO?sK22Ta{g~GfOBfin4D1INtP^z
zB!7-E?&m(@JqVXp&Dl*JZub{BAvC57Dp=?Rj&kW6Daj!xlIqIFxy%ly(Z^I!e6tu;
zX=M-MEvkXTv|dcsQhsk7m^74qE-(SHcNylp^q`$FX?og{eas0?bC}s}&*(jSI&W`P
z?)k{lu`3mcw+v7zRd`+3#64a?+=#4~*Rrgs6#t^j28ZidI3!`!lCH>N@qJV_+6br3
zHIhLX9~;ucV-WPJy&!*A04Gjmvq#ceJhCuu4yDLSajFlV47rEvNaEJp0a{__qUblG
zZL7CM3O0=cv|vVH81)`)LKjjUrqk?+47R%8G+lOu(m*@plh*5~Ywvb*<O%28;`MDz
zA&tLWK;ZC4GZGVy98r5!eB!MSW%-d`ToYggy*VY>ZVg5Bw~9zJQ%0;NZuHAZJfZ_x
z$wV#gjj_XZG>0nrE&T`xrzoYUYKWp^eG4S*l$V@&CK6bh+t>T+_@d$(EST1iQTd69
zR~>w!LvZu{F0{7B4Bv=wd1rQ4e)DPnjL<8c?k*Ir08Nd_QX|GZe64k?<Z_w#3D|eY
zwXd3q7gcnz(NN<m>PxFmP-NEbPe)`!<}5Aoea`8fPn!7#hPmF6P>nvxr+u#}J+AYt
zLt1sXY2p&7Zou0~cZH?WzRciU1_x<2aUrh|HOh*n&?DFyba;dMO4GhzeK4NQ3Lqlr
zQme@LYcEq;eWDzSWM`SXD71ce=DBYnBJIPxo8*2zs{Y`Vbp7IG!NLaPjmu3fF+Fz-
z>!;u6M;cG1=OrIoZ)lP3w$Ch9w+Hoh?)$KmX_iJXt@c~UNN7sl*Do1PoH@Ex+50A?
z(ec7ae8p}0(d#-Qa3B%K)W{w38*H@%2S+yVHkBDPpt~*=JG*u7R}-VPWoWY^46!&3
zFSR&sGL&EH@1`qV3)lS`5J%WYYq`rM9|PNjdDXLbQUHd2RMV*UN7c;axhuiuv5dWq
zXd!p`>+UXqOyn(lY1!U$=Qbo6n@GvlD()fmVxFo$@eEk!yJfzhe9f_{dmR?%|EAde
z%-ym1GXEk%b5SPh%PUBrtq^w%ocnlmbHmE2u_i8YdF-_R8-rSlzNdo-_kV>{e2sh}
zu&ruq47eaABO+Zx^s-5QtbqDFeQ@z-SilpdsM(C&2N3RkK7Y0auR46;pANq=@+M?W
z2>ja|U3{HF6#5t&NCxEh+a(f3FWG==(#hMtlR#s#M?tRZMq5FB%-aXcZR4%EUx8b>
z%U@S~+trkuJ8cGpyx-Y#sb}N&VJQxqGmF#<TObQnxZ6DLo$FXE`#Xq4C~A$_YQz65
z7N}NEGYBx{%ijDS#@-=F7^VrcZQHhO+qP}nw)<_{wr$(CZQGu2bK}n9U(7OhwW*4z
z%qP!T7}5vcy8a{_)KtD3(4zC-i5uh_9ycmcuSYs!1;q0kc~`wqwMm|@`%b;0Swq`V
zBy>F=X|_as+_f?*dEJ?wk}qw3zaG59n(;($#JjM4J(h^qAhH<Xp1-TRBX9NM-asq+
z*8zng>Pq!^k<v2RDs;XJC#FY37Q)~RA<3A^#8^p2k8!LGxv|1LV^!U+v+e6@KQ}K;
zAXBfrl<{if1;PllXxQHWmVFU<-&<-P`S|t^S3w^V8}zCOb#Hk!dZOLcn<z~10&_)L
z`Q*1f)QU0W5kTiuSkAw}r&=6FzrnAK0OPfnvE<lHfT|&ZksBjWD~#!H`LqxMHnY5i
zgI<CYc$<&LqJ8N<O0@}k_szY<_Q0xdqQsP)8W-G>>UQBR8l9x(M5uWh7(6@+5p~B?
z`nfC!7aED1!Y*KeNR=)j+iA@uvaN9`=Y;8U5uezwV{$v>Kms1<4%RcYPVNRdNSSk8
zVXpvMhnvo(EyB;-N+gR}T<qoCxtRR1HAyLdUG~%mh1-~z1%`{-ce9#=_SbL0J8SSE
z`s2~?Ph`2tw@quIlhuDcPn#|i?3;%B)d{WmZQiIcgE*$Ty))7qlsNo#>X`^f!X`jq
zIqJ!ERyGA~kcRuw)qg6Jk^$pwj04=RaQMNfyU!ImOnsHGL#bZw3JYm*=(pR*nVi`F
zWwe>zA(Z`uft|dQsbbZ=1o6?SQe}nb?e~mii#K|vB~E^xM?<6~CBn{Ag79nJ-f?)X
zx5kAo8W?2$dBHA+!lS>S$e11ljCb!WkNlgb(nwnQP`UxI%`JLk($PKtPb)58AsChV
zL%8Pl5TniVrQ027=VWpor^3nJ0$<@#?KukTZL<@7gC7D@qrwa|iJUddg9(rA5Uzlo
z!7wNa!&TFHKFUucswkcfjONQobR(8VwM%(e77ew{jSk2yR~+w_82ZVx&~5mfry`NQ
zMjh6cK_cL3Nyef%Sj$HV@jdmuicR`$Md_hAXa5e55`uM<=4IR+4L6?IV_oV=O1!(>
zu4M-wydGmO!pf3vROLM)sOVO46zC^@j6Lh)788)ekOv}e`M5M=g8`6eaf7=1iu^aO
z0twl$m8h0}somXQWLkLKrGK7l!_Di!v6M>R@?@?@#9HT!Rxkh#a!NaIt6*|9%pG#%
z>By0<IXxd)s@R8aaH$+|@=ge^Me{q4vc6T6T_I-GrPqpInH6(rzvfkQMw!^5$J0Dt
zq4Fspa5&o8VxdC{{>d^S6$yhspG-rfR2PG2tWIVuki$vzklMOM--c1K4EhjXAZYuD
zjHfk7B5!<NX|^HScCxPfWQygW!4$1u3oD3YN_96HpiA^S3MMZal1haexu>uavwuGF
zXiYjrhriSGPr+%MwmT&*vbBbLF43CF>TIO2x8qEk3JycQqmFB8{c?tJ{bz}XLy=vO
zY>l}oCrbxEGz>pj4*g+w*|gMNA9d)!3l`idM5o0RtEZA!Qfe9Ql@>qedbLS|Ofgl~
z=26^rNX8M_45MnED1U0im`wV5<AU}43hOW`G1_=1(86(&#f-WzPc#-bS%RLQD(c$*
zM+_c?kUh|zCEanT8@SWD7uVCAxe$97qSYvou$TwVYvCCeX(bW`&d!!!wxMRe5`D!U
zDqrM15?pTB^2AD(!%P2Ues%eHzFsGn%Qh2FzCpo}AcUcyzGZ<X);&Q1Q1DRwlc^=k
z?Rx^q^>qsSNZ5H0ciw&H(n$W7I}>I-;_ekuqPXQm35p<Tvk)i3ssGGol?n`l-|OLI
z<*j{Q<|my*JyTQf3>-al?qm8Mc*6ZBdQm(YC>-TYQnL^`fdg-40RKX%_oZViHvVqK
zsE<N(NSX#p8iYtijfF^euqb>5+CM{5OxZsHJ^7Toe-9Cxs$ijXS$D~+WemSN`~??L
zQ7@Gs!@xl3z9c$w)fzi0@|6p^*FMpN`(GvYer_q#t!$vl%IGoRiO%jZHV0i*<6<w=
zi&icc_gHaSO|pJ%p?r|2S?O6R`+j$R5;jU!p8|+h>dlZ|!E9Mbbl0uAkrHQmxXBB^
zj?0gxg1C<@QGXR@a$YYK+P}HOCWHid%p6P4GCim$b&vxbO9{}9I#4KD!o^LV8Y|o-
zXOG{<y;PC!Y-{vj6XQ&45xMY^tAdSiwrw}#xA|azuVQ+bUNRgL1vDd!K-anZpor7#
zP8RBAY8WR~(6q0|Yk!sKqL<r_quxE4M-;6tob&LR98ZU(KY|jVxMi$|87pA5*mv+&
z)8{zo9mv`lDL3(7v8~USO<@Ge;81Vaq;M>TW|_u~z35+~CU9Y3=IrnzCC(xbAW5O(
z0#n@$bm9QPNS?|8AuWY^eM-NhuM~G~uDa5z{E`ki$6`>2s`CnZg2r<T%0~p{mJC`)
zhtE<gQ8A)3=mK3oqB<?;DBQ3_w{>8xkV^zmL^`-3ogw2%d7v}nN>n$E=$Tsr){!Vf
zktogyG=Wr!jsmJfr=T$;oIo@w1S4Sf=HDJ97%?W9Q$XPTX>IN3PC&pH0l3$o&{HQe
zB}Lzyo_Y$H8M0j4k^_?WGn&q!vuBOC7TGwa7z}UsYsIXh!y0uz8fK1FSlIbt`oUb;
z7qQPa0}oN1RM+fLB$#W&Eds_8z2(f00KO1#R_$#B7=FKzV|(~6qr0Xok+9m6omve5
z_{1I8q-HW^JlZ?f-G(>&rOr1}>5*hHq;p$?jfwte{O!{cvM)QWF$M7((q%VGbt(|d
zX$#Aq9x7Gep@`0vM10A^);7NNXD-By#-+eb)j&W@qZ?F!!49b*_OvNx-iefaJcQS|
zt<D*=S(!oN|2{zNy%Z+}^kg`^vcS))%4VgOWsda1N~Jbc;<F0XGW53DQ?cSTZITx#
zs>?cu3KGjN^L5Ip1h6j<CK;etwI*s3m36Qy$SD?&7e4Hke$S!>{kY}Xc%Y|IX+Ep|
z8=rhL?^mX6fSngu=|Vn?zgS+4BiNWC1(J%}dG%=0R~!VP3;Yo-bBQAszpFNpzmXvv
zovC%mOeXlE2rHYz&o>uit9-DTKU9z-D~+x^g&)FJX*HvO+Mlo7oay9l1;uQ}%w_H|
zprsm;C~@{qle@!7vce>Cz16PBna^ae%t<SdJLT*=L|e!$=5<HQdL#~Fvw>8TGt|MQ
zK8?tPwu=P~PP1`cgW|O(tN<FK9@OLUv(=R#2a%0iT4sScQRLO_01Zqw)#Ww1OvM)c
z2<ijm-#qTWL7eMHrI%nqtDm#;<kr+|@*@UazdBwHZl$7O4R5YR`QiRF6K^Se8;X4j
zq=_IkNN5DaV{RPIZh6O1zu_&?iQ6oD=vS&0XF-7b3HIE0iKQ>GR=24maFV!-CDJqQ
zB`h$HjD^qld`CS(V}~dzrSRs_;vYGw@_<y=3SUBP;m|f&;h$RJ{T%1wt7Vj5BS(>9
z9LTr(72yC8&y|Wab2$`<lYX#R)e&SW{;<4(=RW%Pf`QdD>25OkqIAMHA9Fn17YtIT
zdbZkuVTfwG&8Ne;*==4K`UmSHb+UV_|H{~RGB@o}x*!uWIg9P|{b>`0>VVg}Rl$0q
zt!EI+R(K;LpLWEH1(lh`)*#Thdm|FbPK~>CBm71nQ6Nhs$qOTO(9ne{JHA)?It)af
zInc=%!YPKpKQ!qt(%U@)p7WFA^to!>DC}dIGu14sGx$~l9yUfFeQ=s9#l2OR1?N1g
zC4d=%Cak5}q*17AOnY)8F(xLnakh!!pT~R16K{Mbf;1MSaV9k8$LsTK^GlHl)VE2^
z^yl=<-R4+nGxiNWL68i&F5IRxjaXD&IgbvOxO7qb2w-X!j*kDLb9kSYX5hEBwt8(^
zUT@FRTSiLGtu9#qW?J|N9I$kif!<U-<eVY|Tr3d%9liyN)GyVNHMkT1^~mkmHTEIG
zyDk?cC2tMNam>hrHHuy}ZAa5*?zm-gJa)#^d{^KeKO*){@aso~<#EC#Gn9F3o@yt;
z&@h4GeVD0oDpmAwI659ftJq$-@e21P>ObIY)cuD$tS`os18Ypd;SZSMOOuNb6@$Q)
zF=jFcn>`kKUpAor;88{N7W2zBT;j4JF4S&&?K<_(=LFNYmVGKE1vxobr<ASxhe<m=
zy3o4*!Y!p{Pg?k9E=hnKu*kl-htY>Q5tl&Hn^bJ$q(DI+Rcityx@_Gdv{HFc9F-8J
z8XqS&3hQy;r=>k$SIU#UYGvRBiqS%97rmeH2+tC!t3(y~ABDa?1`NM2{if~I6rdu~
zpbNoCo>S`VJdyYP5RzG$0*4L{DY-lj?|}9A0XJgq2HCYznMuTw?DWY0BCK1P6oFb)
z5MpNcg59bb{QeD!J(v|oG`nH{ts<}63O-iT)hXRFv!p)3?i%)#!YF#dOl*++0#68Z
zB_@)l!bCJK`(&(BjHFk`UD1uG`?vY|D%koqXSw+*WgBGV`}z=CDs*1og1kVy2-5Vt
zz&1p9pa;|dZ#qPJ#4xQy(hYU+!HbtCy{uW6ZqBG?je;70@5g0~PcD%Ex8_?SR6*7P
zuihGPkd8qh$!RmG70mbZx1>|&b)~oY*oWlPE73BB>4XeM`#MR)9cufr#gC%$UfdXT
zdFq88OB1TXBWRr9_;DmFKXFj@g!56agnp1q(dyNX<3?1Oi{CN`=*fhD_`*Y&?edj;
z$z-*z_l8Omdl1H7CClu5sb8*+JFpB{jQ{30^VsJRWn&sTLk<|OUUc1kXfJm|=0;S!
z)veC+_Q+;O+LZy3Z!%Ge969}7C(E#51rvMfwez=9@~YZApUY}i*uQ5s%q3WzX-!-r
zmxrD*raqkQbNIYI^{o~wo>g}!?q}q;eSfG>MZ@(A=b}Z1<g^?OSs;^-<Go)$y{z_%
zw<{MD{EEGOvJhc(+FMwCJumRcu&XV%)sMVQe@@?&I$16cl*7_MwD0#(57@N&!^%K(
zyj?8Cd$@s0Ak)Qy5lvq6{B<^UyKAUEZc%AJ-nYh&ZzTMq(#L4^YN&plt#VP^CY6u~
zDQCFC&I$`7g)rF~Y?9N%ajT9f+fZ>>B#Y)~iLyQ28t}2nHkATlbn(f36)Ty?`pMSB
zmlVCaDGkhu;bYLjaPQkeHP2|aImuo5Y5^o_f&$y=MrItIjcGj6M<lR{0Tf@2KN1Bk
z(Ys2hH~2$o&>P-mcEt{Fn^6+^gWO$_*5)N#t&MY)m%fI0TGa>Vm`S`YsEvMCPDV$`
z^+yVb%+^dogqgua_df|2<P$rtSFSv0qd*B%l<&WKbg0rsFo3I=PI^oD`=hOpUd|ZQ
z|JH6fQdbTivbUl)N(rhWrVWPd-#folW(l3g`et^CPwxBlugJY@^!mq>2o&JRg#Yb;
zovZD^Y0tYp{Szlv8i@v(-~B}><z1=!!PHTpQ*)lZOM*frj}qqJH(OmjuD|(k;Jy1`
zN-f%p?Nps5xp;I?^0<LvcewL4#D%T<uwE{iTb?vCN2;fr@B#P2p|~36vV_!~l~hp8
zi@V$F;+M>rY@UJ+j*@1HJ*+^ze0n8d()~6aB*pVu#=x?m26z>=k0W8kN_xW!iILre
zyDFc&&@a)KUf`hmJ*Sgx?ze9*66i4}wddiCNOLzLg~U{abM|RuU75I<=3CTK)hvvY
z;Jb^u(0P`dHbO?Y(?L=EU2fbLv(TiRo8&D-O_x0z_muy0YLjjIC_mq_6`ivDrSr88
z^qR^z&vJKJy$_r&R2~Vm5w6n6Xckcx)kT3r*^_Hcy&CYiUvPNhhp-A8)e7&CRZCY_
zDrBQA%Sgbs(VO88XC>D2wJE&dKuK?<a$M`mTV*efeAH0qP2+V%_Ql!1GFCc^Ti{V0
z7(F&$^KToq!Qt9TesKwmW%4k~bxA2^eiE?Z+LA0YUDUIl<ZS5{owbYzBk&rfwu9+}
zb$I0;2?2jz^}=V8tjfdrh}gl>9`QDLRr-&a&4!R|k;aWlq$GSqrj;myI<X`NT!^Uq
z7&_@2?|PJ$30H|7->rijtK~DR#LCR-+1E`eOF9xP%GFuHsn6kc;Aq<5`o<X99aQjo
zq&p3BID1+PcfvURg*B+0K`G+p6$$#c`8~sTy8FO-(9FKC%lD7uNb*m$%q{fAB03x*
zk-F!(oy3@rU0qq19I`nrIA*1tyEi0<KQRqpOnTc!b*zN%OjxvPO%)(ie5%(Qye1Um
zF=4c`s{)Nz1LxW&BgxPTqKH;lwL!1t--MoNkL`c5onFZeHvj*)GFkG>nl^kprQ$43
z^at4FLXfo~KeilY3a<VE8*Mg$Iv4nd95Mkw@<4&H!Mr4OkYDRp{jXeKmu-MM_62(}
z>?U1-|2+X`Hvc>=iBp=49)K2P8-?m>tlzWMlSniALdBxlN2u7YJjh^O*lMLzKkT|$
zf=XIfkiWaJM9bj>wpR2T?I3u(h7<4wt^IJ7IU3UXH?=@&|Dy#rR6$T?e!UJ0aK8=m
zFRI@i0DIN*Dcf-5ji<^Td{abuX|08|)*NCKmN(IePaii&%r+HrF?)ztA0R%xNp(?Q
zAw{MdRK}P7Cu|2_Cs{g$wW^3hm53R}Bg;VVF>4d%E@An~R`_vf2C_e<Q$^LT@lk~}
zEb;t)jWT8EP2u%SmdV@z5R7OF>dpzy9p2s4LZ)OzuC9}SR*gAq(7>5;U*PUaC?9@^
zc-J@s51vhyb2D#)klR3~XTIQc%YL0?#5j<`Yy>&8Y^Ow`N@!dA2b20)-`aE-x%bHO
zS*Qgy`zxh@cZ?LwWxsA;xqsiy$dKoKb{kqE2{J5{HnCbilD|u8S7?$4IiNF0an!0I
zY}EPR&HGBp2`57)f2c^}MJ|xvJHj<<uP`EhlEa3-Ji`gAd#G;d3s8#H#wOFvqrJIw
z-bJ1;<2935;o7vt$a%?iA<tT+=JIONgdjseJM7~wfEWcp-KIxF;N$@K=0{LKm!Q-f
z-P6Qn?9+Q(;y)FaPceQIPhCWqM<W-#r&2ktDqvk1xhsXo7AW_8l;COJu7t`#<FjI=
z+A1WtvPStJ@;}1Uc&m^iu6%A7-w>X?e^MkiD#eD(CM4Gy1!2!l{Uhb0n?*EcTpn4n
z_cw|lxp)mvj>%xhNjz9sOG|sWMMtbej{D2@Kg_9D75*Lv_%zw{h*mEt@9`gyUwqG`
z8kiKyBnmPWr*wZbyg##n{(jAJ2Zlx(O)bnR3ujs?$E+ig8C*97-hOQM;Bk1PLOw}5
z*afWY$4`x6v}Y~q^x0>UiDFt+NAC9+D63E}kjADn3fH&_{Zf2c|HMxo+3L3H-E;d~
zC-q9Q*lhf?+gwq5%bD5eOJ=#VRXIHOo+NZz=X#u0+mDnp)WoGO_4^5UNGZEhgO+Wg
z&tk}H(dW2W9c-$E1uu9BCE;v4m0%VV9Sy2XN+1J@_yjA8kp`8KW1o=ppBUX7zfdtO
z$T<E0A+}P0_D#ry7&3h7r!q?L@l9>#@$#RkbNt{wk1OchV3)?DB+}9B+4OCpq$|K2
z>KF;rw%!EnOD&{G*p-szo{N_!B+hZK%*3+ruPRt`6K_t~ZR#!UC75-@+0e&+XVnl*
zf#!52!ZW8m^45;e%ee}99-1RI*X$=1WFbx2BMwvzgE#Ac{CPf@oeIOxbp)}@u|LS0
zrUjYfPUdZgG3!}XCic7_bpb!K0%n0q)m*H-Q8N9cu!)=u*GV2bofZTv7C@=>X-uF3
z&79QgTmVIQ!bIoxy|Dge{8oJ`YPPHQk%Y@yB)2<i0C&N!pGeS``y<1ld{H_YN1^;e
z*##D>9Fv?ZxR%w~@Ko6RiV?@e8wo>ak&xhfA}OE?_VsjAOsR>TiRkuWkf3C!XAfF|
z%=@W_kwehhW@XL^AIK<3<Yy+@5v6pFp<c4DExMqcb64_r$*!5l$B^!Dc`z9p8#Sob
zx8>-j*(1`jsR3HODJEX!Si&Y*0E`pW4BnzvN%HDo6l|0F+I$FZ5Dn)V`mRk8U9Bf`
zQa8rs<vna18^obmlA1;&LFX17$?GLk<#_ql&=_$W3y0ack}H5J_DoEk{0<REWoB%$
ze;^|_xfE{I!6hR6)38q`Uckeh8;R2UyF&^xGOl(yz*(!8;l!h})Lgmb^27~(%HXlu
zXT~%=EO=qKm7vMxMZ<xn+jR5E8cy^~QkUU8xk8gG#cI&q|BhWrcg)IUK6U{U1{zT)
znAAPLB@zG4;8AG)H?zw8xy?{`?P!N4Zc#jNY((>3_Evz0dX8E%brWE$IJ^$)?f5TF
z+^hcnB0Fd*Ulw$ha;1%xHQKw<R7M^CAyaZ#t#_6%HV5UDDn{iOzm8{~`$aP`=qQI#
z0HRMs%~Vy)zOMmGFHp5v1iT)~Ub!OT7-T+ZWTi_U!liD{1;QfO_{D*fb~5zESjtXp
z*VP&ocbczYay?oapP?^GHNel^6Zy)gt~WQV54IV9i0HJTn?t~mCd*XNg?`wCPR2~R
zdrH+jkA(@M9UVw&Hv;j^Eq9sAS0dxfkAfs=O9htwW8z(Kz#;@dY}K0W8<glhUy)}<
zgYB62Y}nYN;Tv46UAVLu#uogmMO5EKL7(^YMSdv7_wsIogvOO4@J%y0mk-F~y%bA=
znpo$T{{pYZU+gj|VYF=swZDrwQ;c8;o>glXT<swgjvIQ%Tb)_M9#PC6IDG$0`N<OO
z?ROkQ?4MK*2-j^#NOT>vXX;=sEE|05-h@pfs%hi!u2;P=$)6QrG#-}#UMuD*1<nu#
zgHShW9!TSvg{C5UQwFlNxPHae-VUz3AIv896s3cRyFf1o@>gYCA2RYu3h1$kjtW;F
zA7O+ugb%6aa`1plc5y%j=Ebz)o}f$B@N>A<k)M5>o^FATr_`bN${Dt;xzBaKfvlkF
zwWz>ZbV|u)0(TS7G$d<pq?5Pg!$IOy^o7q344BawWlA5sf_((K(LvV(jU{FrXVE0b
zOh07P%=Kc8)DooW#6i11DViKi$jXH&<~}V_<<w*E+R4C&Aguf$mwKwDU6fR5SOqS4
zUL;4DK+W9sFK{eJDtO8EMHM2{_$Q?FoL}6JMO91}IZILI%mDNf3v8c#;{z7NWuiBc
z-jRk1ZPaLjMIGGw-HW(Mv4T^S(Ad<|<J=iE^1Ft_g!7K0m*=O^SP}&)CnH5oSoQg2
zjAq^E&qn0?h`Z$$y3Y+z`zg2GYE~)NjOM|v?R91ZB0Zb*Gg$FgRJ_@~YN>4`seGI^
zm@Ep={`M}iy!kFm95I!j=u5O5z2%Vq3NrPw)22zIKZK^)lc!>;X2Q4PexQ~w7Viiz
z{Z?7o!Pz?pt-8W?(ld{y?A!hPS+w-07xju?^MvC<yL{&ZhnjI(#D8ta-5r{Lb%Ua&
z9c2NK1r+O7>|KB0z_T3xOTWePzcO#k?9Bgv=8cVkli~lX{%`vhI|CEv|8wTe4O9i$
z=8K(_k*hdClA<RD?7~hGvVsu|W*yA<*diGTfdrML1XZ!PL{OlZgd~}cR8&Cecj?S?
z@9nR9&wchSC#PvgU4PB@$L|gE&()Y&QPsQ|SqD01Fj8o^|53nISQ(Q5gN6_cEDHGj
zV+K(}{#{=S;18E$6g*ID;*Y+I3k+`L&=pI8W_Jc52I%s`3y2U&AiSAJL<|oGEHZe&
z>CZ{T_&5+tfj@+KUIC^&Ol-gx;QP{|P5@?b1vaYgv5r^)fD9sJd}1Q}8xp*d=l}x*
zCK3ossKL&Gq?ZWh5|TxD2*JT-pI-@rqTR4T?~x$BudfdS<%0O%Xgd{TB)|`%275l`
zHhAnqFgLJ&95hQ1(Sbi0GVnd{%nkydf5pr^orXUJ7~C*54<ZA{Bsl(ll+!=sfcH%S
zW?kTYTY8R5dh_5u9FYKjeOLq{un+gnz9N5eq5NMEVM7L%Md(N<k$jy%ItY1=`_|Mz
z3^o92ppe3Be{LaO-}!fsa(t8nNY_E`Z%Z7gWhGWXp@*j*-W+(C;QPVP@DBnWe|d<{
z95DZhObT;X79>b<LtlWtuO$J4eTMHE@Sxx772wcU@q=HkE&_#Fx;}A-*B2noe1zRz
z2i=%H-g~Nkf0tSZ8U-jAu&MFDKnHsQ9)MG@&zx<ZdFbCUh>x1lH~gR{A#Xt4d*Xg!
z1UiRrcz`qDmtf!q41EuXTYv0dN<adHd}g43pj-pGi2r$^8jn^S()vukPZ`4j_H`NX
zJP-)p-_G{Pxp`W%7bxcX|JwgF=_IDKw3pU}-v2AvDk=(q12_~NG4spYQ7|9^!=r#r
z@5AE#%^3d?{oVq7=V|CBLt|0AsW-iAf2t4p`P=L7+Z#au{bfu+#E8@2P~77OYz39{
zGkl{T|6!l{3;o)k|K^<h0p9=JichUAJ;kZ+w|)H83nf6z_4nO)bblH>th0+8VFrBK
zt4qJ@yRe3E6Z<6m*{+NTJ>V#ac6j}MAtCZ<g#)xVF#<t5e?e3EU(os?Pa_8gVHf!#
z^x>oAQ-Hwy(qreUGQfWq9R!aZ;UnY7XZoiuiww-q_HB^Tk-~-;G0Y19_>Fi-LWKwK
zTb{$fzXux-NWg@S9tsD%KL`cTS-|YS@sXYc5PUa1Yk!E3t^peUEchS$qXc~zF?eMD
z00Q+!`A_(Bz=nbM8wOlRvRtq7zOB9O;;C0Ty+_r;QN}*hX_-Mr9+ooF_Li}jTm;cO
z6P+=NS6=+&xa6g=g2JhqwbMIf#n_J<Wh%*L&IQfkD#?heX8|e`Pv8B^v#nfxc2IPP
z%&e*g)%O73i?}DSBe7XJntOXqDPg2D;d#AVg)6_PNdH0L?XYTmRnp3P>^>~AC=?B{
z6}jN>4_sP;RKruMra<pN7}5i{c|Tad5Z=8fZPSZnATXg;EW|KxBFJ@NLVP~y=xCSc
z#>UTrrAB`s912^&=4gq5;Z2oqZ#?WMbkyEU<oK_z2jaF_kR*-51Qi&LvY|fdJG{20
zgYIwFqR0l5FVbvWWyX|SqZ_XBPt_AqvZf|482;&V@Z8NINe30iwa#;MHgBRFzt7Xh
zRg#NNC+>}_tMKq(hUJ!bIvA7Rt_0KW2Dml4@@j#=$`09z7Hf#TfR~Qom=&%7Xc#z9
zC-*A+F_tI5uN|cbNmYJ<Gt{{<JlEIs#uttaDWS)(OX5pNV4e#a`b(S;F7ij~Km)$*
zk&)<a>ld3gucs}X;+4lPyttN=B8>m{zKS2sEruMm#7BjR#Sk-#Dm^Qc@gX3qA;&j7
zsy&2gp@`a;mT$+Ad*M{nR}1}ozW@`M)%4$dzLOWNB?e8p4XN!);~45rW@C~Q<G^q4
zWs5Sn&?@Y$^R||)P!vbc+8zmIxoW)A;Q8A9@3~|<<4R7>3e#!Du^WAexKwb_*X{6b
zq_MY~ZJ1d}C_$#rnRd+yUP)JG!c=hV#_K<dBfqB*%Ei*eI0f+DojMo#@-JW3?2N)P
zl0=#DIHr|#n`s>&U(yOTrzs#Vbg4|VGw~QX6u%Qvfl>}WI#dl>ui~lt=nFG;st4z6
z`;h2Rz*4)}+D!gl6dL%R$+9Vamy4eJagDS#vE_I|SC1pPfH4GFbAh?k$?dI&4IHs7
zPhQKm`yF&?=199r=9MR5e2J5bO^>7nxg<YXXBh*JsvFQZK-&Q}LvulRbdDDPqe;T)
z_Yy6H+OVGaPyxr^_E}7%zniGnq^x$j@iI5mGs2j80csiRPO%l+tYfAbzlMY3xyY;v
zpzl{xT7n1e8(5kk*qUqkKHuvLUBvXgEwNj+h7Oj71YN^@7Fi_lCa&3$l`L!mc!3ac
zYO-iau((}kF(vQ|c}yoleMfk-KC0Ob?z}>T*1t`Li!!Yzw18Ed_Y&NG-Gi}?7F*Ri
z?0l)^zoAFjUFOE#CCHKh%$M27R@n;0#Pa6govU9^<5zv<3c2*s&Zx5QMUZfKF;Y>H
zD58U$y}ejg^aSc)nWNM;rj#TWtL}qcT+Ezjd1PwN32PDP$Ek5(mNxeQpRl|pq>Lo!
zP?C9j^r}Xpnz7IU4nyLGrKrt&ypn_U^{mJb#Fw5<FY|0&0Q4?+#!DVPz4Gx(p9cvD
zP`N`D#V4Q99;+mYM~Cgv^B#_X{gVQ}@_2udq(}Ne;8SyK?ru!`$0EsNs&#u@fZh0V
zJwzWP90_4cWbDU{UbKs;f|exa6>2{${rJ~zE&>$F9mz_EF}=N{bZ?6D*`fYC)j1EA
zC{xRpi&*GYFSX9AF6|Yg9c_!%y;1iJQ%<t2&80?tK2Bu1)~S==SB)JOHFx=}1v2GO
zXyD`OkM-<Xs!KlDm}2vr#rad;&EsWF=bvLIxh>La4MF^NZ_Gel-1m6nG^&Re^b_N#
zc*JMTKq;V+xGt7W{cE7e&*Eb}{t9S8j}#&J@!7{XVb9$*Ky!?o|Bi-x?IeD1(Ju7l
z61J|HMkwbNR?w4-bb)=NR(Rc&e$uWkd@&|PozlFW$UffUoy<7WI<UB5$`bbl19I@2
zLt0Il*VVWj!gypgQU9{B?Gy2Z>lbi69eQP-I~DBMYXcTwts6>Qxi)ULBkZt?l=^A~
za>AbHhuCgl(n3de?kpTgPTM8Rj+aSGh5XKxjWF$^tczf4y7}y&zE(2ECsLfhOC#T{
zo^5BDK5;jLv@J8T^4YDjEwCvjCQ{n=vFN>N-G%w$D4$T7ZA%B?U`F<(03OehC#5f&
zbLt~{=wgL|?3g5Yj_tW4dl;FBccFTcvLdUJW#vaqN8a|y*e3C0EI~u3{Y2p=ZL`P%
zU`aBudd%2I)-SR@m%ejO3CPA%P(@%jm8GlQyh0LgUNrzf#~!{roy5=g+_{c7YzOXF
zV2~$nzeJS-0O45Dmk*age>D@k$xQ{|&WfiVX?krS?t0Or!8)ep1_4fSbWMb$>m|2#
z=Tns_QIqYQ)&cAq@Y?praf~?fU>9fGRGs1!E|#qaiZfB?%(XL{-Sedz?<amXqTT4I
zN?nLKGjrN}JGGdHR_h6c*Ropz0%oJjYL#N0bQijv7stBLwIFjzwq1PKwOGkS9EXA&
z1?Fk~sP5qjv@$4&v)oFjukQO|u*RhQpV3L}Ew{ad^b>TQFk-Q|ymc+qgMoVt^Tigj
z&BoNd#7Ed&?QYT;+PW%i3cq_5>6Eb$I6Ar^%yx9$gm8mNwSmfPXh2(h$a7rNaO5(Q
zdncN!IQ3(c7#itoz+B`*Z+y%k_w-N=+C1Z>Q@+N=*Zof8<hC>_#Xwuns>dF7KxP?~
zO)Kmay~ofsqrw(5W4~_`-4$op*F%5HVSvO%hjGHgK;3vf$>5|vV0XJ}?K3BB_Yo0Q
zyBgSL_PFAEmM75ra_ywi^CLoeU%}MQ4`*lezpdBq?359TdEVS{7Vq7ZHM_L&#V$7U
zwbB9_(+<vW$uR&c8yfwb_lr?G0(m=}k5g-Ry@TD7UB0ccr1s^3=KB8Umq?ec1hmbq
zG1BX%-^_b)y<_)Tzid!oeXzW%%?%EI{W-w3)k5vH?7Q=a3Kh^hzV=n5nM47~=bGpq
zR_=NKxR0RNTq*uIxA#xK0}$ADD`Vxu^!2Sc5@ngH$-pTo)*=Dw<MY7e60Lk*L|uuX
zlEwFQkNF#yJJ!U-MTWb}@<I@}T%G+NeT<#o`QN#1pAsoPYZK?KFwtW5{*_fKQ*v2f
zQ>C&KY?l{~oz!AVBGOU#K=oB({UY(@J)e!pLp4-&8+C5QT}rR50b?v_eb{pc*K>5p
z8t$(P+EPpykpg}g^GxYIAqwpgZr}LmPbY++AILe|KhbF^7CvW9dj=TDo$dsyeH&&B
zCjva%58^C68|6k8N-3MNja+|)a*vRzf1U!yTpnv;9cEv-(>)~8<9G+qRD@Qrphu?T
z0bM(i+d!uAdeldbUccyz_HoJWz08*NXO!67I=4pR^Ps`}&qqs1u!r`8REO|a9T5LH
z3izC7$By|08ksT@s2E+t`DD`%VdW$XJ5kx1UDi;9y1A6!33eU;6sih?YO#fIyBu$O
zP_geim_J0NJ^J;79;Ee7Bl9azY3bF4CnO7W8sy`T-K#iq*Sh7Tn}3JF+I27lo7LJE
zpn-x!-5;|y?vNg3566`2W5lz`4{`FQ%@qo`jkZ!0`@L;}aV`c>;ds|D-ZajVu>Cw?
zpu6WgMSv8h8ihK}vR6Tn$a#!vK??Lqr~gw;>Elmt<3DF4`AQS=G=Gz3auMSutT6nj
z3YRwIX&!Zd6kmehT}};cxHX?<6fk<gT&u=bzTXQhu@!oEUdnhxN|PP+0Gl>V$Uo*&
zEZuTk8mfhWY27Hs8aep!MaF4tUtH$YUaLvp2JdK*E%EO4kiTljxY?Twdlu<8k6iPD
zgN!rOtY%p<u}iC>m+Z~vU~RN`(AP!#9muK*n_EhMUHz=wRc(9jK8TRg(2PET+%-Uj
zsqa9fS#x`XqsxkZ>rL|HuecC}Uu#-7CKxH1@T*)-@=cI<cds#L47unGd$(-NL=UL6
zm`O`^d&jawe*XuXAg7Ic%Lce9A8p%OU<~WU3mZ;^BiwH4>F7RD0U3!Evu!9dD3WTF
z=rjX=Svgy>f|8C*sm=Oqvn0q@wwQXkxnex30E+bjrsr#zh!}a!M1xHR6&l~3km~g=
zWP-Kw<I3&KhG7m<7isKGhrzABw~bx%KDn)9oQ6u+x>{;$OJ-~*K`H-PKP_k?jJkj{
z-cSN3Wq3>Eir=gI=IZpxNvJ&0V;OFlT0zwKTe$d2;o5_V>})FGp0#)q3zL%VJzuog
zrw9&=`7{ezV$THaEC`#Z4l3#H?b{c{)<+v>3qgUph%e?P#3@c&6FS7B2-)ba2%G2O
z=a6els+iIdv)%5K(6=s9EKZ8$-V6!VJ970A3}SP!nb+0uEUv+u1H00kmu0y@aVQ}7
z5e6+#)sy<GB#|+zksmFv8*<6(Bbo`5oWDA{pX&(dDU#0FqQNT7+rGujMjRm>o?fI+
zNuvgC7U{*Um|i94zqols(LIFEH>_^ax!3hK7g)B-&B#Nf2A;uB2C9y2eEErVR?-o|
zk0WDbPaZ&WKFsd}u*NX9zU%a&8<j(kt@2bxLc34YLAHDoH|cfZc3iWrP?oAUtXc&l
z>dxHr`w)ed(PJ5>3R|j-rtm506QN4GbKCK5T;6bCTs7-SnpmV`Hnazfz4);^U+1zV
zW!mu%A%mjw6cS{$HbK{Yy?Vl=jOpCaD@a>9?$^-XE3w^UpnEM2Q`G@s(l_xFo^w&(
zc>@~(l^{-N!`kIa#^P~6bCSKg-d!tURD4!mz0ThfUOmOUbh8eB(3`*LvNsp-W&7Gp
z#6VWE$opg!0i+9jMmsocasq4gjxAx_Y6GBRO}*3y^Ya>x(7vLXFCqPJDt#&IjvrfQ
zwp**Zh#s4Nin5ydLnt;;_vhJl|Cn?FLpw9Q#wndet#Z-JAcx#J*aW#mQkr<|`eYuz
zy=mT0FV&SEQ(kl(ee)iotwp@nOfKEG*KKi<=)a?^ckJUDwLxWufm;3bI&W8BP0^3t
zJPSn_$7%m4n2hnj>1i6`|6HkF@4yA}^jemDWnueY9Af+WN5*32@!oVVT;f7NP?7!V
zYh3OrF{^RrNAF_pJAm(^gdhl_!%kFb1saL-@gXbeQjU#)sUuO}u^ih6k2eKjlrwK(
z_+|Ng1Yn@T`dLrLbw1*%b?auE*sdld20S>!41?^DUVUL11*Mm*>0b?r-(?*xlz-rK
z(E{;wVJcF)cN%8YiEAV;Zql!~5iukmZ%%1cA*N14VEk*sWd}VS6mU?YU&*ZL_Jp%7
zu2wPRQiis-d)u29ZW$mn60+aT7-U<a1Ew}kbpcNtJK_<4nW1x5a5WcRZItGoIjSIV
z6xOl@IS$|+EWS5kSaDJe);w^V<`(^Qmk-T2Hk+LoqDkAh)uqQ?xs`Mk<(lK$a}WmI
z!RuOvT{1!*KExPjvOTQ%qD)mQg4=nr%XNC#!Y%McXNwii8*$cRRd)chUNp-Z(#d55
z(Y({TjU~axa#3`|St#@E?^M8(wb8TrQm~SBGJbtj==eYe?OdR%eiRc%DrK)U$})34
z*@^H3C1E1tvlKR43)^g<-&UxpSyXSl5-#b!55_Q+4sAEYO1IQX8q@``9>=Dtn);4&
zWsel1fh#i5A3=`_4j-AhQN5nS2(nf6NqK?^y7Yeu2G@yG^GWN0GkDV;BI(=F`FDR?
z3>2jDW6NIeqQy3aUj6WQ%F~Fu*mDBWZX-2KT6i&C*pnl!0Y?{mdh>bLYY&W<&Tb)Q
z3$cNV7X{MfM{$FBmuaLhh9T>3|Lm#!gR-M00@{h?<Cq+a5wVN2b9K`>%~$zc*?ASm
zj%awUVlr)ew}2X#$q&-1P*`)<@P^;5>i&d~Sa9THAVTuo1O86)T_NF>NV;oa14<-{
zYzIubDa&_puJ)>HNmQ240y<)oksgzc)c<g<>op03M$0*c8etCkUEhY8wSvVH$DT%k
zS^Hw?3-byaG*3>Uy-1|(XxfMMGPK7YUCBCnm$atY2Wq!TC-KSqN2=IGW>LF&l38n>
zXBD!1t@D-Y=Es+<fLOw7^EmvJfdd^R57IuL2x2Ps4gorH%Ga+U+fAa4zBtPq9jg~m
zQGC$jp?I89lT<){<vzDWXR7~_WzkaL3Y#!4ja^AU#nMPyYj1Sg1)m7AvvgJMf2jIM
zLI<xUEHcj4Ns5Bs``t24YrI99nhtJi*=|vT-c_44NxHL(lFF(~bDcCA5F|AS)3D&b
z4i@iFeE7vYbFEl=;0$I=g(?^EL`~9s-~Y{MY}a5sPdG6v&0luy*=Sd?=Kp1T_-nQE
zzMx6*o9opM5EKS87D$CxEH+58APS+<eMhz%^D}#=wM_Py9}iW}{=!RF+YZj<xD$VE
z-gqg}<=SXh)nrx1z3IZ~B<Cw(UAp+3EXGLZ)=t!*U$_b-cI5*Rj?&DU@(qE;PA2M)
zlbZ82W-c@FfjIy{`q(ZigF*fH=%Gr}_BR~SBU*pGG}NfxHd^UxyQQ179)WkIZD9^n
z_$^E+G9SjX4TL3kpuat3YZprnn>1(gEUyVbgTzzvQl4G2s(Hk^tyQ%vzf#<dS4NLI
z+=>GANjS%Tyng5u?H<G!pl+f09lDz=IJkz<me7guRS9dRZ~6_%qT{GK;!({VZ(3s)
zxnn>rWrme^Cn7ARnvCOQXd%38u8q;a5pzQ3<yO1bMlHrBSfk;3wb#Mg`-v6uc;Gqu
zBvQHZ14WRB@aemG-QO!TUG{FrY3#z)z!bmOe0W*ZC;VHBl5v)Ew#5FuGbiRkVd#9q
ztM(r8ix<(GjlNOMSHRMRh1ed}q%og#W&hGG5LpAU0DM(-@@h2V4i)gf{Vws9#W*Pp
zS)%L1>Vnb_EpXmJ%d74$mA?c&dP}WGx|-tke0WwY!v5NQCJD|XZGubsfC4aeul}*(
z+PhdzU~5bVB;IIdOdgzsr=BYLQcq6xaqwopteR9UuL(M@P@C0zss&*<KZmfsCx71v
z(b|<$=@q71AQrR{sc`kDAriL>iKoGLNDGTB>p%<kft!n%*`CJgmyP*LWY{-L^K8G(
zd}?kZd%7v5j3|oey{5L?I_k;Ecy>Uq-!lBAHfR@GDWOpw@V)FWuW$$GSO?r{8+{_z
z##)GZrS~EPbB>39v$=ahoL8-Cv*Nt@y=P$|gpooyvcuA#T3^cXl~kbJ+CLOmrR3sm
z78vGF()Qstl9~CQB}PKadDOH<J8+}#L16Cp`Lixoufod`anbC1`GK}5fL}@LmP^zk
zWJb0QCSx@Y>q_8CC9#6pA*-dc78vVMn^l1OY%H$n0>n3qzz>oL2kJ=$r1blMm;@`i
zCTI<KgHi6O>Lmu&d)=v_iu3gS5l10O%Q+XRB?uLw>eh4FWtSRY?ZP>>{x??Hj&VZY
zzK9a;$jSBeye!68pUOL?Kv%OU-|%ISNm8<oG%eCalm2<3fdiC_K&!*$H-A`?p>Hca
z3X902QlC!UMDZFJ2I&}=uYchlGn)$G!J!tG*IOz64@rFrpI$uByVhg&C~*-DoU~Zf
z7=xF3EJc&(wY2CODWaSV!h83-9T6Y;V}YZb+RW^I{nZWXdxZ`<5h+J)sJF3apzF_Z
zm4%=7x_Mjr`gSsQgj(-SK~Kvxz9oRCVdr?b8)fg}jAJ)22aY1|nK8PhXIz}c+U1Jq
zFDriWYpJW0DI2rhBTlJ!8nyWsSV}c=AWK~w%c!ovlq@mrtkHFlN|Q(vycT`~g!T9*
zog>{-Xm*XC=plT?P1;<GF51x2(6&z@sQIuY$Lx+5Ncw?Tyqpm63E>I$a0;?L`R?`T
zt5aH}xHEi$%~bwN`4_i|MXKuO)?SFXo6xo-(&lY*AP(+G*)7I9X;<?jK_e4Vll)(a
zk#Ooql}!%w1nCBLEbL%<)Bck_Ho7Oa%!amrZC!Yjb!*OsYwOSY*19_3Pq0@cpU|_g
z3?nrQmz2~84(H^D4LkM+k%FH&J|<-$hxduyI8*CHZcq9HwA^7r&PyZ<`R4fGyHHR!
zC~gEQn^K)@-^#5@1D%Fcx0*8prwq+V(_^rO-M#t``5L(6mpC1;W)@=54NZc`%xT9?
zUZwp$Tw5e}`;*Yr^B}|!N^A=X9`D!lFyR3*3>ol{ZTY&XD9gVa(WdI|e<8SxN-DPV
z?j){V+RPqrd7Wr3;kDvI;XF8Q;Ihg`@p;#K9ZDe0bPElA*9b8r!Xl!ieqMXh=56=<
zV~l|c|ATMA_P=I*tZe_+tdE_Q^?&j$I9S;^{-0-k?%*uh)@!W<R>|k27_6NO+={{H
zJ<J%<OhXtwqIW{!yAg>N3);_ELJ);%=RIizK8en=-m{*6{xx^nO{>$+H@-K%cRhL5
zd)BbTHJxZ-$*9vnH1NSh9PONeL;#qmw6t~v01(F~AV8k=7?>@D5a9RvZZu-L4BMbU
z!I9s=guvjz2ybkf2#2}lK*2!CI=BGa-2irgh<1XA1PJ}WAW(mzAp@cSjRfrBr~;wL
z`5?hTy7d^Q26DL$;W4y_zuA3wfYYfo0Ct9kg0FiA0F>ekI7W~`Kq>+d+Vw|25vc^=
z0cg`mKw=)h)Syl2v_J<WgCi%mx3iE=E(ak4wj>(sfVT)Cv;xT2K>xY|YXJJRz{-Pg
z2K-w`BSs+RTSMEw59Wh3iMItE81{Gf0UAJrb#H}r3e*fZ_J3UhQVW>`W*}jHf~&v5
z199)q900bnxBn#H%%AH-5YF!m;!8-U7a&1iLIi99RuRA%1Z4FxkPiY4zytEt`oamo
z(bs)>#$iDm0W`Of{nFro#-%L*1m19eH}axLaSlTq4qO5`zAqE5)HA;rrvz(E3}Ryq
zC<Z~V)O{Nf{&SoA-RA1}_v(04Oygeupf~;#sHygEF+8~(E&&eZ=n6tL{X5>ys{d`>
z2tWkzBS4@4IR*{L0W^S@)~?kDxA5i)^ylvI&$#oxe{l=q1gyT>0{9ZD9(d!|*rg+2
zX8-_n2mSK;TY9h$8JU5t57Hn4Kr_IGK)JfRelx3o!GHh#86w03Al~o!ZU^kw&->%a
z*ruL_0&~6p&iegAb+(+GsGO>5`q_B&&;G9~1Rua22EZN=9EJ~pfQAMJ@dyp<^Oqxr
z3-Zwv?H@uVRAUHmz+c&ezod`a^+O4G%KsJ&dVi-=S?_%i1UT(~wT&?j-`xFo_{(4Q
z<39c;f85vjUB~rz7kR9Ui{tl|@kj8@?-x%zJn$qx+T);$_$HkX)TIx4?yvmP?{8BJ
zwGMT7`M#$o3Ucm;S)9)X_lHR`EQ)ss*s2spKx6wiKZWm>qn~vO5E!&#NEff~4jmAT
z4e?FC_v59xxwnT;_g46Q1GHy9*B6%@tTkBeSAz-P2LJ#P7R=KS@TPTma0c$-ymwcG
zx_;Ca4XBf?fN{tN;;@%X-;V`0_W2?Q8Um=})F;!IP)`s5{mkC^ruhr*xCb2%{mp(1
z=%6Y5dvF5o@PiBm*pBlHc&E(y3w!4t0R0N@kvDaL9}nLT`Ul=Ucl`)Y0kALhT@?ML
zlG}ICcWQJ26}G1j-`C>J-`sb9*98Id3ZQKyD?dmh8hle3q)kU%Lb1cS%2z~7*CsZM
z`5f{@oZfrlu|-u>#*6Qq%GO3jj4h*<M+J$S^ITxE(}(lQa61m6A)z!bMlkVGErIWJ
z4EN1(Q4grBJwRb229iXqhKE0Ft#FWmU4X?aJD=4JiFkdyL!nRqzH!-TNYM@K0D_Wx
zv_z&zWK`U!<sM%IV}Y59m<JR6U<|o0Mp?TV$wkbcP(;vxzDT=p%+I49ZKTXUGxy((
zc_n$mJL@^GM4*5sB_V%QDxAUc*%6n+$tzH~3mPVw@uyQx?DuBa4NYc#hqSeMOQ;JK
zTdNQ=Ys8iUf$}OU;e#59wbMQ1i*XWW0Sk?XkjWj<-41#}gI`~W*4pOYLD5cm_K--f
zvyS|<tWpzf01cEkd43nApBohR6h8I=%757w^P!-+!s6HEq?=&PeN$(-2JD!6FWC+?
z$vYt=qxZ2F<Q`mU?Uc91#z3)P0+nRS!`*tSz=R40PMVtxF8#VUt$txsNoNav`8*~H
zG64b9c6Gdff467BYd2VvBm|a!c6%uTB<O{<ekSiZD+uidqEu0}$KxeT@on57Ywpuc
zydvberBCyY6nNMjaC#ARM=Ch9)2grTdX7BiFOp!GX;;GVz??xgJP=gU<gQQpo3=U8
zj6^S$g_sc9Z=M*O5GFwWDpHIBcc#readxo`D2dBQ`^$}@Cgy5wbxW-|oTM6kG6hg>
zS70uHH(RI4+gzIaxQlcsQ=&Lcuo54lveJB|v=7DXEvwtKITKq3Ki&|KYbtoPtBYfy
z<<zpduAh8D<K=p%foyfrj}7C0cHK;qGBIQ^hdu|7a_Ty|FlMpgxYi)|vuVv%F2zMq
z+f^PC)rDdzq8Y8<25#fpAj4O}oT7Mp*{YD;b8V{jZ+#I718+2K<v5#lW|<UpSfd`n
z;wOQ(liiFN50faV|8c-t%rW9Ezh(F<M<qHSw(hVNXzV%q_k_vm6dGK!^7HjPU24th
z7?*-rbEgylrgCyFE;MMDUF8r(p=3y_<UHT?>A+obm?`_!<6doF10?d^e2r_RJKE^;
z^T7bURmVVC5J=AG9++&GXLgd&>T(7XQhu%U;MKEDI;Zv67T61(^Xps|4Y63vsd5vt
zAD}(TvS31v2TR$5J}?_}1|-7jwy}E5oY;tYUY!D@SI0HrS{7^hHGqUs2zgRKX`Ku@
z=@!X-Mz(6269+yc8<ix&5;;n#obh^3DyP~KL}@IUKwLEz-IR-cURs}bdIk{~gi)@?
z1#niM940U3f9hRi(hZB;xWFDnJWRP(p8L@b)6QGL1V+fu#b4~vw3+B@rzl;UR#I5i
z;&JQ-#M(pjG}bn<!kN5*dK9ifv7@YzbWOo;Q9&SPQOG&5OV?jpCQCb<o!xp;-GRK2
z*4mX@@SV@s(9pZ#IZ#)<*l<<OcGUggHl;t@@Ld6f#oE*Ra6;oS^4@vW0!R=svGllA
z4mM$~Uy*`N3>@0YtQdiS52?Lys?dV0<U_QV{;&K)8?|Zonz<X8K2X8;qqc&uiL3<Z
zPhbx&p++f)0a&Xr3>uvMNZP%mU=`i`T5IGXx`krqrfu-2%--PNG42z6^Cj}G*fJL?
zUm?UH7dn!XvNti2rp8pKaW!&mR;4yR!pI34+c{*ka#quYtyHu0Ad+-Fl@D$A2J~7y
zH5nk5&sYI%V){m6;!?L~U*uc;+=b-$;Fl<gcS)eFw9+?YUogAYFtw+>#J@1fT~%q)
zOjN{@|HIfh1d9@ES@hbrZQHi_u5H`4ZQFj=wr$(C-EZ<EI->uehdHUpK~+WM$+h=#
zTHqq@X++;w?CrO1_2712mU>5-#M%18n0nk}rg!!=EjJ?YkYaJo6<o-zq(_zTyx%2_
z2HoCWa+ma0nBhNUJ)ey}vjj<5Ho*4j_H~Sbl(?;z1Qdo?%4UWS;=!Y|&yh&2fXC>2
z@<H3^EraYPSJIKKj6PLtwzT(B#(zR_K}N8Gk32L5a_Ud66whLf)qooX7`T3sywvKV
z@PL@K?rH$}jL?uwQ`Hj5`0&cQ5G3_tvAgDn_J%o6Pb__pq(dk8S{qI`%cKVwZBw-C
zwUCd=GuP3%hPGb_9)llpTP+X8%ZvEgMkWYn9pCDK=%C74EOId@jCA7Ph5Kgz3T8+w
znDmINHpIiLKR6rVS)h54Tt3%cBR%riFC2!|-z4Z%SABt}GO&352+W_fi2qZNCokcH
z3)N#as@$x$utJ50F*=cR%VAVg1NK~?JOgxUUZN3?Tr7+>8KIBYl%r@}a)lZ_Xuh_o
z727T8TnYBJ$D$SB?3bvp$T@RZa1cz<YtuCorA~RpaNy3ji3!;9Qa@rhSYtbpEO4=y
zc(|Dq6@s(RNa16FeB7yR3^k|-n5s=RV0+-OPEpS^lYyTFQp=wCCRn+8X#Ka9ozQap
zK2C*~nh*D}B<UOz(m7NSxlnjQ!41Auubrotpi3IY1NS!-gAaka<`Wa=+#D{=-HS}5
zqKftDL1awpZv4|g4`o{?wg5+FF-p4CU;7P0Wy_W>Na2bvBf$)(H!Agmc{@k<mq(OX
zTy^@pWIBIIl-lS5eD{@$^w|gx&w40$v|Ryf0;_AV;+;yRopo$Z`ME;hkIE9M%%?yX
zf?#H&*>N24BbT&a#-*{&Px87VM_W6KHP>>4P1CZ#VdoV@Z>Qj)_4`m%X9M^C_(pK?
zMAgacs8(f1qT~*$`>3vT%UY>=O7E^+J@x5t0q;i<n(_n^xfNFK_8b2il}s|sab#y`
zu$Z%!0hm_-icbBOg!v2Zhl%f+mzumuCGrG_TsKeUY@j?uHjnu6X^kytqp+bhm^FC!
z-}IB7TIyc@8Te9uPw(w-{}i1)P~W&D+3X{=Wx|9tnZOSmZ;QLYFEtvn*<dHNZ;l^R
zm&vjrV=cS;e8fTM=^c|&xN)}UwsI(2b!S+@54aT)D^#V$;z7r+`0b<s+J`v&Ot<=}
zhkSVKFt|mdDz_?(U3sDa9~Cf=@*c7Wtl~dyilULaZtNv`b8hiHk;_)|b+Fv35H#be
zUlY09l>J>+4*kL(DDB+MBh}7>ZgGXGe-tF~sO4Gy^^%16ozR}oazeA4Nf%VGUdX7#
zv_jQqwU7eR)>Q%bW4;Iyo?mH|AeZvMY3Aznb7li?OX6yYj;?KsV}2iAf@S7~8AHG6
zpAsd-P=B=DhJRz%48pWzUxyw~c#GCgQF|7HMtFPcL%Z7~-<o8Q)%QQagAVf(vQ{F%
zzkeX9rB=j}K;Rs|Z)}2Y7q-OCve75BU(f&pMN9<ER$L&2tg&9zd<PYO*!7rqjVou5
zv&{ajA||C&n5}*B^j13H*Nc!@QXpvbcz-Z;(!*_Vmt&q}NTV$sPHlqPaRpnkjPh6Z
z_da{4(w3)|j`4H$?yv8$(Q+2;$~LL%OaMGKQT-gnZGZYGjhooVcV<gd_pIuc?sf00
zE{87YY?4LJn8LYaFhTyqD>_Bb?}37PM;y<#6|%OMe5GhNZiY|#Yq+&>=c$zu2On<P
zEMJe<kRiB{$X|ABK0PdBorN~Pu{x({#j<z@#WVVf2ja!UgIyeFbKW?!!K@DDX`1R|
zG-<r$(*M`IC{5EgHKOSvdyt%~u#-JWj!l=7YR)-L^BJh3-b|n=A&&(n?Z=4;F;%DX
z4r=tXnb;t?fh6}Zs_y%y3oC9{_8?gs&2(e}&jMHVPyq(@-#xy@ntCFtb1#O~>j-{=
z88CkV&Hkr1Z_L`-%MgCogAT*W#Y?mmfQ)0~JOfCe`d>1rKeBS>)Y7+}tYaI+Fu>MY
zP$c^1<wwK5mavka+>qJ;P%;IZCx!*_o<HEe)dh$-D*<?M(AbBz4uvZc!P|U{F?Qc)
z{QB-Y7k)b2-#Wf!TuuZUljaO!m;~L|YbclTvS^LnG><i183u=hH%G@5tFJUp%3K5D
zp-Vs`GJp@QFq7KbL&)QaDDwvuL4S{CERFhMj&u%*WiRLQVs&rjrzf*(r3yCgLDOtt
z4xQ(~o3T4&kx0jD?sttL4e@VI#R9sy+rM)mYHjE)_s^sh^omDX#bv!AJC29dbz?az
znMJdyqhx&xz0R(j&y+b-WktSgKa5~9=hL_lDJ6&D(j^NQ)b$D@MI+%2g++DpZp?ru
z|Cpur(LzFyzD;uavn_sgrb?zn-(>X+`L_Q{gAwTJgoEy<h3S(rV8wFa$u9NDBJocn
z#_1^VQ^{loMuZQ0B}qWLm|>8nV|Qf+Wp8!6!6+gC*(^)~E-2Yd3U&>Q=c|n+UWah5
zeSSB=vz)fJBz=t~1s*uj2*BBN%2G59N(sG)hD7RNOnq`HN?yVNjhyAei^{)?W9-X0
zEl3UFPjVRdNF=h^?xUL^WV2;+IgkNgsGRO$MW%crWy~BH?Hz8d-5hT?g%B{rLm2!V
zrJ1x_G?W+<kvLef*Q|tWB1HJBJuKs(cu4@F0P<NX51vRzJxPmMlcAX-Tk+|UY{0Jw
z8==rhxtZ(pxnM?GJbGJ%WMLNs7jB8&AJa8VkcBiswsuw7<m^_M!i&c=t@>+*RF^~1
z3>sZ|<rZkfmphgig+0`PgbV+ir$HgUF?F~jHq}ugjXH2#)(X(=Zu^aS+)0B0lkbWw
zS_JYXML`}oIKe}&PNfFlGH&9}__uh?{Vk~7smrk$3*6tUyV3gNvJNgkugmP#0joHm
zfZ(e>8|ioD*m{ZQJC%p4l5Hpt(Bs2n>@jYk=$>-ie0n2-u=a(}<kKC~?e9$E1i+6X
z%@l#I>*rj4(-~2M(~=it2xor8J$r#UE63w#IP7v2@$$HrOnf!b&Y+0dGvmA(Z>Te@
z(69z=C1fUvBe~#?!jYIzZ=bP6!$X!4FCV*lK}#7vJr<VdE86<7e{FPqUATNYefzKM
z6)7QKxs?`@>AL=CLiwj)B0l*dlOndUFhpiPS4ob11D?~0$KoEmY#(U|`M^4@FBMRf
zwT^zQ8zP7%(hd>|xjdVUlM4ieWfBxtCvv)0k{*aJoDSex4vj<;G|Q#5X%pjm*SiW9
zhK7WT)tTYZlx(qz2P*LB0+u&X+t%IC{BJ4~0XZQpw*e97U*c@MvBrFB<s54?X@T&@
zD})Ii0+CwmMsh*ql5Ffligr7IczKUHheu^Y0zMXEd$klP?UhbwO=_w~42e7r)?#u+
zWO5bVp=A`a6AKT_pNh{2plF-i=4s`x{przzKjC6r^cwJobDY$55W3)fXg$f7nAMNS
z<y_ye4dw9%lZe=QDtoS1c6obh&ZQn%J2}^Q$(BFi`FvdWrsC1Y6SkhSBwZrk#vg@&
zmw?RB?@>9=OTOeEa)m9(=>K%%orT1JVaSd#(0+9oqKZI1&RMiPR}~{jA-2QN56Uhn
zvJSAmnE=!<v5|^yt!x|kiT@N$Z<MLdPu3#v8${x<b?as^XdK++nWV0X(#+OOsO!5T
zldDek7hreZz`G0K8<<42a@FJ2OrGI6)R8iX?c0XsB%~{1z#CpylesRIx|+QpW>oE!
z&6@jHSkAXN1-|?(&HSzuDZ-|-X214nejAvv0Z>cf11RV(leV<{hddMAK066*m~q_h
zGo#@$vVcaoBFVL#%2}-J2~}m7wYvsh7b4O{8y_k8Q|WVa!Tm^#<&IrPir`?;G3Kre
zVf}s8kW<zN&SE}Tot0-2);^&Grq}Rt1L+Cnh{{N%RQ+=4{E1|0d^Q5WJLgLicjWbr
z`et=T*deLo!7jc-agJqQ{r6DzjdN5nqpsDP6O^ot{HGl?OVR|c+zXqYc=WP`#|bh9
z@-CtVv}a`+1I8D49URE@9E&&u*aBE&?0O@_d%{PqnR(O&oSF8=gY1exQB5RmUA{P1
zzUQqa0HdlCFwi317rI2MpJW4#i6+T_uaC#i_)fk(LJObEfq@T{3DG%~*^dMTHTJDI
zR+_j`MzBspA<*15*H&BWkr_&w8Xh#b@83gL(@|Sl&(9TBY&cen4Fso9ShYD%7&GLs
zKy?%bKxz_U<yyJGVmC&cv=U_FN6z&z4L{dL4JD9x307xQ1R6-4d|J)Jha`IfmJh*y
zf2Jb;fE;e0n>JG!Ip{L$*ktH01(lJfU*cfVAg?w`M=6tT<sYoG%OW-08Q#3P0Ew3{
zpnf2e?1lB2pHwNX<HgF}&=>cyU2NxA);z{QKDD|nAw$Whq=@M0W5yTX8!z}EyYnal
zHelH%;SI6sem7JCchd+XXL?*zDB$bfb`x1Cf0vu?0yInt1S`@^&qQdVWv};PA%Qbe
z$K=7Ptl(&gp=v(ql_!v2%_a{fP8@TEOF(bc_HDEeQ4^H2-o$7?+y0YkO<Yv-i}CXK
zjPD4!dIoLj>N$%OPivhEu?3Tdc_-{VU*LqyHUsiJ0O>gpwz%_MifN>Mk2RiOWqqLQ
zf;EQmZ>z@@pK!^;?Wiaa4k!9zm(_2&ofqPp8`4ORmUupg&be^-*XN!?3_2?O{`=*T
zG+%BULPp>03lU}?zD>A=CEN-hs>pt-1vo|@RqP&zKD*CW5*U^cJzEY7EdM)!ibt)A
zIWH{4MjDpEhJ}_-;<BpcRdKr<eV5KWP<k1eT-E5I@~|5DLHOT~5YiumSAJR=5pZYd
z8!q~;2q)!;SB*4QFN9N!faOTr+yD+^->YzFf)fcxqJ_Nc6h(HxT_oYv=q#&x2Mj-@
z)m5E0hsj&e_O79xS-YW2)>$@MQjGLCFghQiE(bE_!3E1kFgG(X6uVlgn{eo%8#gT+
zD*cf?zN#C@q>4J!KuS($Da9CXnkIVVgIBOxprlE_;$gz7fzDf^LVV*i!b);8?x8*G
zoD|f%?z2H={u7;QGONW&8%R0iJp6RT#4m65uUSFgH|$t5mY-Z(S;v$8bN^#?@zZaO
z%p&v;<RTj!p01A4yvib4=Ojuq>84{@#vlVg23}lmxC*c_Zc`S+diiUji}8JhXP4TN
zwTgU5hScorIsAQ+`EHAJ++3@q*KTHC%{r-Zo40vu?qX@$UoS)2F)-dlhuD<2mt%mu
zD{d!G`v-%Gu$Mf9>G(U*o<wP;(#Q6KFk-k`dSuzCaNPvCe=my=Z>1<jMT-efmBuNO
z?1ALQL^oL_y>^#wgn-Jdrc{3J!F<`@?tuzti%t2aGm6MGsN8mC`qwRd6f^u{J(M5=
zITvrcQXPvmitBvdh;K<V(&}C}Pm039PvsEBtI-l?DGc$=*OVRVtJ#9k{_7305j6XZ
z=E>t@MR?s2+z2P}Ggk15CFurow}fQ=&lDV~c%8_{prdwd6;fq@VjX%OZ#=`b>ZqhO
zb68NnJ!w{HkCEeFs@1Hq6^?J8GQFG1PZ8ai>*2Iflb&ne9O05xUQ>BjxU6PdSt^h`
z4A*FR8{G^zDyDtDJX8<_zu{e|)>gYc?g(wuzxiciO^4L8Yn|A8HfL_cC<aFX2g)-P
zY(?V#+`IS0Odh-vY&EmO5iJ1GAJIcXizUGlX9uTG7_1=6)`+)8=4!poib1$D(GBS1
z@Ji5~>D;zLGBUe&3LH*WpS+R6MNdyyXh_c0)fc~Ou?S9hsfBh>3`-f_A)ciRYBvk7
zoMwE=ndD8Tm0B-{*Kolhz5#XR+jp)MG%P3W_3P3HQimhU@}2FqGGh+PDXSsSJ&#PP
z{&xO?-WC>t*Bpu79z6+n5D{!O74--_9-qb6Gy$E|u7s;S;R!;|HtcSJT{5)SN7(Aa
zgqd06n9b{@{(}`2l&&2X6Xe3OI7%5usH&H;-)8D0?;m?o-OxIbqYY&)9VEMtXJ>V^
zLGO4pT@lKRYb%Rrb*~0^i@TDr<$Wk7NU7ZU)KQDL4#C`1n<<Er)NRQVBWC$)+$TPU
z>Oe>TYRc521u-aUl2vUZ9h7Snc^2hyDKv$LJLp(7_{?F6?xMMv9?y2Ye=W)uXrlEr
zYv6rsaX;xK7r}0u!B)uY@@9;dvmiLfE??<mXu5GCba336qiap5axV#+ZjdGg)ejI2
zt&Lb>XbSZf&5(r##vv_0irc>X52JM`r6bwx%<;gtVB!F0>s}n~{QBCEJ&B6uq?0(x
z6EOz(joi~u#*axzmMP=GQs1UNunl={FN_p4*|_n|)9(^DlH~t=4f|x#2t&9Y<|UoD
zYn8uGhS`#&ABT$qNN$rcJyx@a@=vla#-_A8hdPiRKx8VErA_iDA+I5sSlGmI0z|oc
zkUP8pZ{Osw6K)rBJ&jUI`Kg6cXWnA1JZnPhW&db5`%%@zOIAQ%st2SRgYOG<em+a@
zV5!Y*?!nXpnRoU-%#mut8hWbduhyk=-yKd8$!phzae-)P#1_Hbt3AM!mU=WkMSM~a
zQA+~y1Rk<aD{y*vPTcU{0dhBhu#C0}dbv%QiUvf3Y1>Ju!|8(Z$KYVdEqV=cC>iJP
zKKCE|4Xq9k72VQ2H@=Q1PJ<~kfp~At@wGTshqk==j0e-?bspJjE6yg7l7^$~(*xtp
zTQioPhQ3jKR3ItBWlGY|@M`|g!Dcb1l-&SYDg{N7s{dTRmDO2Px(~<x>8273fLUPy
z$JBC1!-|3r6>UVzBMTdk>)aw+K;WpF6NujcGE6MPkS~VyuIcfX>I>n{|3urDVZs5&
zZKEpoU@qoqUqzUEJMh8p(y$7o-1LXb&T~X|j0$BrzOfR8X`Wpw2q6%gb+1fBY^g5c
z#8g5+gYS~TtD&PD)5B~mnzNmF-5@}Df5i(VrXSd9Gs(B7(^6U{*C-Y9H7gDx4^%QH
z7aM&={&KV~x{S;Edm?j_16$`p;d|OJ)nKXD0N07kE3B<W9mvvbnzcwosVoa+YF}6V
zb2Sf}jm;>Ikt!l-9fj++C!UbHq=MFE=6f_)ppq=d5Q$+l7+;QnoD5iB<T2u<bM_7l
zD<azRcnn|%qypt!a!bl=y-JNy&I=i>WKfNMN<0JDv*8gEs-xlyrO?DO*0hP@HN9$b
zW`;@vK<n^BlcOL#zXffy4h14O0tZ%LtM}(}U^`e&1-teBnrZhNtF?^6W3ZD$ngD||
zjK5{l=9}6p7m+7JI<!VMI00=MNR()8ap0~Bw+wwA5-Gz>QDl}pJ4X#rLVe<VVRBXv
z(=P)p>_vbcplygYFU%@qb@7UQznH>O4hz|SP(#n_S*2e^k|i!`dXYL)L?*2>GMaFG
zT!QAQsd>3$Xp&%sCWRbo!~R)mSSfC?35KoW6$ccogRN$VxX994hJ3WMWC^`|uv!N`
zb8NTe6Nl>nXDvhTEgJoP0-Xj@;xmRyL(W-y6LP0^D4gcyI=bvIocWA2A-BSPzl+F7
z4>Q7*3psRd>IZt@GIQ5!MNXCnt@4E#2V2Az)q+}0!D^o{ro>MLvxGji`OZXp^sjG^
z&R<8f!+0OgX78SwIyE)%7hMhF&ExYwZ0w&a?JzooFK-X{kSuqsQ!0(zS$cBlwr*Pc
z#R)x`cEb_j@KqvRb@F0p(~B^(9U9ALUnxdA9k)SL(^|M!L6ZAZCfKJZo>S@0(~YZ7
z`Yjeul=>pWyv1Ltv~?bqXrK1tq>(tjz<_VXvbj)a<AAC59@1Z#0u{#J$nIn#hz_)f
z0oH*fEqBZ{0TYmnH5-Ck?GJO9{#>~J4N&>InVDGVH00#P#_5QFZvSIr9W(}aGQ96q
zjZxfyMfD|alVa5>92;yZ3Bvjif{*2Lak$e&x)F!yoiQclrK9tq`he{q>=`z~=F!#%
z)9Xp_chGK(8@^1FfqhVo*Xd<*{dE(IqTDVqOrJs^pY(o4;`(?zl#A;u*lB8<VZKyx
z5~rxzw7ykN*I0LgO0o0!<|tT@C-Tiw1v{*@yGx+??w}Zma;lU}`i~Cujfhha1erP^
z3eM7Go}U@s#mw<k$Fg9=SUDY|8&c9f&&*iD8k-f*OjeEJY<>_h7|$NETHaDi5wX$W
z<DiuA+-;y_8lJ_|pASL4aV<s>F`GKqp$Rv>_OsByelH2g+Iw(^dr9Z`w3;9eP7^z?
zML6Gvb!Kvz0hBD-z1A_>E#)4{S=JFoYehz#r6spEhD@-M`&uf6W)YN*4?Y&Ht(dib
zGHR?XJuMW%-DDZ6#d$bXVrs1(mB}~!CE?1c{{nt+{5SA}jfL|+v2G>;c2;Kg|E&IZ
z$eV+WneG1#ez=4FN!HqABchGTfAV(@b7q%tlZ0XD>thI-n%gGSQ3@p3rlrVP*aljV
zfQASs*gfMs<vs2C?Ol1T(XcvMU(H$FS?xAkVOX#@cbr)3s}_i4pa@J#ixNj6D66%a
zngrh4-#<Or-ybwEUIHd2$nUks5d)5g#(@cn{23IU0R<5uVDumWIxmL{0?KU{0_gez
z&=pkFB~--21Hgxm8`FzrKv(qVnS-?kRyYOX2@(|i_W;iH#xm%&8N7h%$5mqg;Y`#%
zY9gYcdu|+pLl8$mE#LwG7lHx2qu^?D*kAx>gB5**fk!<`^`UD-2s1@nTQ@g1x_snp
z=o3To@d-eCaN;XKE&`6RVOV3}H&M)dKxd$D$r$J`#C$XO&|ibOkaeQ106GEyB!B-J
zK?M$`Ayi9XM?iuqU}u#jfXo?!GyEA#KMs3<pDi2!dh}brg>TGnYDA0=ZVYo9SSLp?
zA>MukZhu+~ARu$9N(Vw71RMZ@rIR#b1fVd&!vI?W1`zWQ=eKPxgnWu3SO6l-pK*BG
zYamy#zV<!+G5Xl8-UWhI4M0m`a3@C~K}7p(z3=fL9f6fGpVy<GM|<1?2DkE8J!&n6
zrI8nOSZp;jTOW$I5NZk0A9;L|;74{-a3KH?cM%X!P<Oz5bb$D<X5QC2AkW;H{N0gV
zhQy${R^};8{itHV2hh#Hczli>`+RH&e|rbe_kYO8-7P8{J$)aTbqs)dz*V0@c5frG
zLHsqo)zN#WKQBNjkHq^ukh^d9&!chZpLAFlsQa(Y?^i@8D@&>~%dy5^$#;G+4UKg0
zzN{p9kUmPHG2p%9V^k0bNJxNx%!fEM#7|?K-%zE1jR8Oc|Ay$zq8@GMcLiW7KX@?e
zKjs6Aq1aInAhkE-CtKWq6zhHD(=YY&HvTtn!q4PgFXU$zm$E~Mp!b@_kK>EqH6Iz{
z;Jpl7sl68B2&H^5z7gQtPEB|Yzo-hX0kD(nyHy1gP(&^WW(lssTyCdKn@9e)uiswu
zFZh@kboAerUtw0iy^r1#SfJ3rCVl(6I&3h^;lW2ewxf6rZX!EG4yDXqS%M>&@6KAF
zB`niNtF<=}5I_NR^n7x-hw21sK!0|6M=Bcuyxw7$y_3KJgfRqw#3K4Ww3EQcOMQ=o
z$o&=|P3{3gfwph@O?-y9J^Hm{et-r(b_k#kR(C%mB8jPS%za4kZ(tOmKs<d8pmRvE
z+zY)n2z-BRN|s{(_{Wc^8$B?=Vn85~FC;i1PIbS2@3BAx5~n%nRX=0FKso(#>aSZz
zdB81&`0ZQnk6jdycfhR~0`w!%&_DImNBG)r@mtwC`Vz!j%NKdwQFlOXIt6~LuXR2x
zt}YIOOdq@mW6^#!e!KSnBq(E8W(H`cv}gwk*b9y-w8G~z?W}?I9V=*<c3aql{`#3-
zhc<Pg83iowLMscU2lsQ-HSdXkBQ)@(T8gR^<4$ul0;nq{I3Z9%c3{_$XSM=v&2n4`
zu&^;gw$taT#$XE%L2N96q?K8ePe=yWvlI&GesU(Rzc$(4Vk5@*`XCkD1trp?BEl2K
zZ8ybzEM!LihGMYz%3(-f8D^eTmKE~5MtvaRcu{U5$^L9R4YIKL*n7Misp{QQ|19z>
z-%#~OG9W#K>CT=tgdu&7OCmSqb_W$Pj6-RUr4$b>CZThLFxG6fqG-M|rmVga7Ub<V
z_sa>>-365H+80^j%IK>Sby^)KPZ%;Q-*U6>9F`7Ac*S0*!8Amxuu-4~S&XWD#b?{H
zFku0R>1;0Ke4td9zb&Z4y3{jbEz+m&dV77{r<lly0nz7aM1qL4{XS}G2+~5tJjU1T
zAH=vr`3DCkh)5szfaMHkUd|!I)!Ny4^_z$_NzOfPm&VZs>Fkp;gc4gWjQ6=0twew4
zb_csr0iiF7fLTKYhGQ*rs&|4~X}fME_sYq!Wv+y=kuoA%B)mI(Z~*%TYV#Iy@;2ip
zv%p##%`0U1Qwn(_jTRwYObk2r@3SKb$|6w?0P^@sACkWwHNzi3Sh3-myZMN-$F(|g
z?w<@YsZCoj*SFFv==+AcW5L^Q#r3YIu;#+>AZF@}Cwy1j+6gLMz4DB*orqtx<~)WT
z;t*$aKp;yPJAM}bh7NBUT&O1Xs8=@qE6uo3JxRueKMuWwZbC+?5+t4X{fGyW&@jsG
z^J+ilTafTs<jdEb^gvFPUj1ux`0l2yyC_{>mK88_(g}+-I>RreH#Pwr4w?S1dhU&#
zY6&=9q-)-u80PEvz6TQd5O5Sb@XfS9o8qM<h9e7sa#^&Y%SSmhO;%CFWmRg19DV!G
zB+0E+d0XDImxkUBJ%kd<&wlCf?>Td8Lg}8kJf^zWbi(dWY{ovc)H}hmX*9%PS(T`n
zfvkwfhy(MWhnOZ5xn-+2Hk$V|JXNN&{siR?M^_vV**HGj6=Q2_TjHm;|GtinHn!!Q
z(xov4Ngf(rDf_5wLGG`<)Q&{Z9Mw(&@2eWI&~p80O|jxs%ZH{q<H;l*Tz^t06EF%I
zjZ3|Lh(i1NOkd!-%_yE(#V!8A%Db*mae4K+D$!XS)zr7kMC-Iv&Hx)^S-&V@Wl1J*
zQoS=3e4$mDrQa3LPpR<JA`qhqMd}XU7i-O~O6IX7WuQ%4xba26PZo_`UX0ytlTW~x
zR^)K}C#8+q0G|1Aa{7BxxQK~x#zAeQOFdVIXi&<1p1b2MI6fG5--Rx1d-p7#MDj(Y
zbSbLzOl1Pb2gx|%LaXARm6z<ED=#Cdks`<(VP|&S_T+b<CK?+LFC51&N(<=NE8m6!
znm|=?!v+j$t+CkXiIh}MOADQjPa!bLf|v>ahBV@+XHvhvqjBz;<pF)b+k!r{DO_51
z%kznd9HJCA^WhFE(l>;!0a|8T=@zz+aUPjutYXvJ=iko9dw)p`?@?(_*39g}Qopv5
zOgTO<F3zu?qn1i$E?-Jk60_G$g@d>5PVppZEba$<*pnd=iyv8$K&Ry2l!=~OE`n`#
z!vHCGnxO}SvRE~QFYYHif=gS-G4F-zg_G?c>yTZ#b`rC5)_w2c@Y%@|TYsJDdNNLP
za(n2qn3~uxy|(9D<6%!5O;WiZwKeKm&g!x&li3<e5#=falpwnG;mCG-%CH<BmlTx`
z=J#ir&NX}l4DZPyMjOy%_KzouY{Zw&o!PtztI=O&(a#y+=<0T3W^Uzp!+ao^@{HU^
zQMz4REyYM+BqKJx!R<_;AkU9t_4L@yrt=p!FCYO9atdlw@M)u0YZ5?PE*4HBhp$Vw
z+A@pI#16(FvP+>Sq!4J2+Xd4Wp4t9VEgV{oXr2j^(@9HAwK0nQ8$fjvlYM{{JC!P}
z>nWM|-`{ShssoGX6aY(OKP%^%bxGf|NChgyUSsa>O7~_P11n^nuCP3e2eP$Jz@o8>
ze+F#^kYbvib}BLBw3UaIsfKGyC}r{%=nv$W25Y5>B8JYS?Q<o#>-fL>)ChCgoJwEK
zxKB))qW4dx%GC#QB`s~g^vJe)U?GZY%NMFQfE|m-n=wMY2eiWqBm%z^+O4#mMaYF~
zygQbrq$Osf@EXO#o45Dn*tU|nh%lIz3y52#8GPzAp6Oh&TnboK4<x;B17V*$+|;;A
z&76pB#d%X~C3gdi)YbRwLtiJ)Kjz`>bHRqFW^5@u9aZc@$GK$F52?fFutxXe(dDO#
zn^aPw%k-*!JNvGrPiMZsK8mt^ZY4I?n@Qb{g#~6$d2x`ST@22*re-g=r1K1cVYDVs
zooX1d9-@;%Y##)817TMjV-YK{Af@Ub?#<;&i^C3r9mWa|d)(`2>~<{C$GS*wr&n=>
z(L^yDop?V+2lJFOvA2TD5#lQpibM7YcxMM1DC5IR<tAF$b(7aXj6ZwJ9wec(o{33&
zPu-yB<q0n)RnO_;a_e;3^DB1S`Neh~1ZG;}Gva&xieV-rw&atl{SM0>nuqC1&Y`#7
z0o+0`lW$fBu&bRYdW$<Vb<WDMPMS9MPpvLflpHvQE5ujQmh21Hp{C(P2}j^dJ?%`D
z$cGI?F9C+oT*q}PTMopIcen8`v(mZCR=Q*bzp;o<>=vDSO-SDP#E9?DwKGNzh`e^3
z%ar=jcHvML-W+1RdnZkqIy#wA11+dBS9)hzMHZr;0phF77Qrn?8dv!N1Emb1ZlJXk
zv~kmg@|U(NotU5wP{jf-jz+uTgEQVK%>Keu(_ga11GOR}i+ko=L%cqJG@(muY;n3@
zm<)lqvSV;O+x2P^`zf+mle0_Y+Nav{?B4So=7ytxgwb|Gw4?gn;05n~2JbX6JP~2A
zZthbjobjdAW2U6FGlWrn3;zou!iR0WYOmp75UX9Ob}ctH>p66)FcCgjj&6{>z5~-^
zH**yHeN0_cHNAH@Tv35RI0dACMfG)#RnTY23hYZ#W82qzG^nrGF?B3SgyFxXHuPGb
zj}iad9nvkHA><aGd9w6|=+2?UpajT`8hfeYvf82*>o8+@$V%Q1e~=jy>CU^+tQS;e
zig51sbANL(0eMRZ!VzgU@^<GR)icNRBOD=G^1{uK!arQ<G%9LGGfhB7#)GKRmo!Pi
zal^NKBtd$)YE#M6y(OGH0FAA?oXs=Z(6CPtX7by>LnB2Iw_2oBB6Y#Kfu3-C@De~8
zx}k^BEmVrfUuBcaK2bJyc_3cy{_xb)eJqsaiL`E&`9zY(rT!B!;H*&C=#)aFrE%Yy
znZnX)gg#A~rC5&eB*-^^<fE0K-$FG3OgwLA!=3m|i&<z*Ol`T;QclcRyiF7#(<cJX
z=xS-V0ME0(R(%-76ydtPTxsnUAXceUE)5nlr3+1FHpsLTRlPP>6jcxI!t6;qF0y@o
zFKt;=^)~wwC*PYs85CtF3oS3Qe^AHIdhast<I`4%?|YpTk@x{}*y%4g)^i=~yR-vc
zBd|M}C5a!=c?NTIn?VOCi(g|Kt>Yd#wn~(#zB^q*!iHn%%59bb5NjDL2Z<lX#0N;!
z9zakqWyjnWF<PMlTX#|c@!j5IPmQLm1jhn@e^f%`+_17EUf?*d+#Y0qO*yuC-wd?l
z&t{gBEgzQ~GI&u^WwoLVd`lzuVodh^9<|ae+1oU^fRX*lm>o`W)J-1c7T@<zECWih
z>2rM@t7{@i(C4R-?{3V#to!=ZZ2fU#dJ-VxfO)TZ8MRTLL<qF89GenR2Ai(Pvj2X6
zDBhK#*%DV)KRL@`>f+@DGRv+xSFzJ}gq}f0<JO_!J7Qx|{*L%~*0sHRs1&hJ7sgbq
zZx=nu-s<txZ~xGFAf7j}fg-+;R8wWegcL}Er{=t|z}q1{$+o095z^m%7(0(#LHv~~
z>S?fV5{jPdqFm+N3YHYPSao&WnkeRspQ9w82VNphX#5uH_LKzXIMJzA7gC0cKTVP!
z<)v$4(RKis#P|vospZuU^%<*(i1iH0i-^#pIY1_kiP~ttB7UI;@)OhHvFSEa0X+v6
znU4Vz{nUn8YRLAee(?ixf^B7i68JpIE^`a!J)|b?^{A)QGB2Zmql&zHO`F_6u63ve
z!V-D<;lad>+c&)U+zS%Pv8d5hfM(H3<GX20w>0*rl3!O?K50n&nilWeo}r37H1{4`
zl5g@kQ8S(&CVs9Bs(aNEbhs$?-uHfNB3(4mS1{e?)nv0T+^C-X7uA~g0_qr<V2?)0
zqX?Q_ZpWwleS(G`pf!al*Ln9Ord5dOTwm~2`n3=Aq1l;;4ooSi8P^L+WF;hxIH-s?
zXnpaUN~sCiYO{3fl4=0n(LA(bp-k9}|4mP?%ds@XT&-JjVMi`bq*0Ta?AVpBbJhMO
zREqvwH0vOkA#->Z6SHv0^^7m#h2=yiH_5V^Jt-~yO~#8&EPwGllv3T?J-XVL|MFVR
zl&xVCT@29kHNOnPVIsqPRN0oM0*Q~@apkIjar5z{axl61xr=(1oCaGZH9BgiBso~r
znRbIkV~a=TP9^TdX%lyy>E!`4Eo~I4YP2*wLX=xpr4r-16=oHt83~?}4}980@_Jq3
zQL7Ot^FB?f_~3S0VLG3oq2iND*+se7k8%txsnMe|HI#4fU`tAO`g3ldO*|ny@GtKG
z7m8er1m_>a9_=)*+>f0M)SAF&phL4%P#Z8sJgaFK=|>k+!9ie`=T{C`7eaUXkF9j9
zDlqzE)z&vw1*~P6J(n9#&DtGE<Ga*Xqh&SCb^3KqJ+<Vci(YS)qBq%Jsi>cz3v+c0
zFOA7!2W*LOk;t-W(qkZKYhlTZ0#$m`({RcK$tlC?0Ze?@`sy!N5>rm$jz(JM*b*8|
zy?4`T^^A>3_6mdVAje*}Brp5k*!Fu7Fit-38EmlOgY!Qo?;*;-P?V?2GP4nC)9}rz
z7^tLtApdqd9%`gbqkTkGF=Ms9`fjn5#a2)Oqj@C?GG>r-mf%q%vtf9vA0=NxCcX=@
z)94-frK-A@<1@15*x53re_j<7BZv^(e)ikN;cu=JG&|1*?+)hVLpJogk!N4`vt(ma
z_r0a(GCs#G?PD3DXGup_D)PN_)mcv1z9vk>zVW6oz~Wrw!uW)su_1CbMns&*L07|y
z%2<KJ)%^tluo~oM-w^bP{$ZMx(jS3@ET+hhzeNVM<R${z22xH;!b@5?u*L>db9B@C
zo^jYr<Vk6wZRtoj6{FT2LdkCSnwzILa|)wS0a|$TuQ`{L5t0xAq#V6gO4qQ`RUUno
z%+P#jr@djpuL8OAr#LHd<9LP3+3`_!rcSQ%TjLJ=Mnu$8(5KcCZyXn9$>~MDazmMr
z=jbU&*#sHsGeB=&PZchRSATYD<wWW{blVPuHLcxS&lH^CCF~0{T<!s8B~0pKZ88FC
zCq>P9O95JR`Ft>liONj+gU77}%qx-M*|G2##5P&`YUP>H69P08^I$+vl==P7C~K3r
z!Fve}b&Bl_v{~=Q;AG8!g4?F1iGzDE1=Nl@=$;SmWRNfK6bm-%<+2zqn>S7+XPyA!
ze()^nH(SdAh}LM+^}IWljPTa}INOT+Nq$Z)+748r#}^!<o@QXu-08(nU5%NB$f=+M
zs}g#F0X7NQxxB?6;;VsqDNnb@PAOLiiQ=Nhr->v$=BYkt&k;Tqd}$k%-B}NOb~&Bn
z!G=Vld!N~KAX~3s(KcJND84Io#kO(H#!u>|M(KSx2ox~}L6Mo5%x03&0@u?usz~la
zC7tl2cXt>apJ~NQK5uY7PV&XTS(8km#DLh))mTsu(wcH%F_o$QX7QyEV-1jEor4e2
zW+yD^0ZRt#Fw!?1K7NBX659`CsmQttWC+tD6l^6#SI~k?<QQ3)YUeC-gInFkMf0+g
z)vf&__>UeWQ@`{mQrf=-_QZY`(O97d*`D`FE4U{zjz6S1bUFp%m(B5oC|CFDaY1MS
zV;>fvKBi?liPlS(XY)ItHAQPqj2ceY9Mg#;KeyM`4e)Q5fjR~FH_TmHD(8c{os;!*
zLjd1R*&_wAMrZ2HFb~Hlgv%#4lxs?Lz@WzebTTjSSF)<?TSbICe|Nj=&{WJ_7Gixq
zj|X)#hVk;=hL$BP@wu_~0Rt<mnl_wis>lMrG;U^*WY4|Do<UObQ|R5p2SPpAqxb%1
zoT5x`sbV8<mtBBG76<VFxfNZ-QfYaI5+$}&^pM^H1RtvL#+-hI-;FeMzP7`a7=&!|
zJ&8VVo{HZ$a&UeFmli8qD!y=**N+SpyHr0i01}EXEayqeV|+8FAm<g?CwoPIWDi#D
z;e~-ttRF;HieP8$Kb{eXy@<kR%7TpIhZS--RLiVgI$~uajPCE^`@E#T>pUOli`<`(
zyT#P3x(G;An3D{ql=fAwn1*|`4!aiv$)n_4K=~cLA#}g547qip^NYG$TBClb4`rW|
z`oe8!&N`TIQT4-{9fiICvlsql?e*JkCBYk_a+H&KwAG|lMf4^~tMsIH%iHY!XkHYa
zYLE}=ScFO0;5R2bTAF#BLCPHCS=g%QZ$(uKqhhNuE@a++pAWO9B9V*@erJi)C`5cZ
z==j#}D%7c7VCHSg9cJK$11b=kr|w=Tvk%vx9fY`#<`Qi4m<sRMFei_1&ve)1sa|d@
zkf-vo8tz%Fz%*rpuXuQyqB-;JAT<9&ExtxqCsh<7xr1q&HEu|LZELD!9?!RA(s6p*
zia%ZT_6;4w835C(#p(LnVOqLrjH*Js%ge5fQ+G+*U7B)9m>Y5&rYcXzbem!7=@Cmh
z!;l}~KADDN2BN!uHio0#@DwWLH7cF&g(cOJCt@w7OaABDUCQothxM{f$LRY<x<E^#
zdUu2SS!7FjMXDS`X!Hp2^#??!gT(uT12k%p4Be(;*~RIWQ)(6Bg3TxMm$dP6J|CVk
z=LqQ+KKCPCe4Ey8+Keg*zj3D6$+LGc+NyRXyZeNAiSnkB{O+x-Gfot{U^~j?hR%vT
z_wSBlmDeXBcam={N}`2}<38z%c2em9=cBd(T(^@s{la?5nj-FN4oj#rdU(Ylte+HC
zu@?hUfmi$Xpaib_SjXgb^`c*M!<?ejZ+cxnD!D9RGKKx{PNM=WJrk!%X`iS1qV^N*
z^<%6`uq*BGyJRz6Fvn=YD-eRb+<wTpSgcSR(%+lWG10<{XYE4++dpG7(<7uA19)Vk
zU}OGvi4sEJh|$5%gl2opm%c%>?}bSyAJE>&vWdW5h)(!PXOJ7su)DpGD_!4g33th|
zi<hHbbeE;f;Fm{CMx|NH@{f;3Bo5$SNS{JO<0Em4m-MxKxmONj5CY&Ts;EUuZH>jY
zp+yU;cT@iMwVtpyR#&)iE>?4KC~kutJh|iKvZg`MCCuz!HyWmj8ui|iCb*D|EyBZU
z-3lkNQE1jKYR9TL(>~8>2%H6|pHec`lxFzSbH}a0Fsa3_${9z+x87?CZV}xTHdnEh
z-zi?r;jBmFG1SYh&65{SOz`7!W95Z2gN-jc11@CNH<HQDa-qJgem_GZ>tt-dkFAi5
z*<$aNx~@qK$wz`VRfL4s5yLZBF(><lCN-<_#caX5$x|ehj^1U3H@U_Z?O%yW&I|iw
zoYU!Lemc%{OiC>bMG5i^MDm;=^!aWE13gVykWSS`WnMXqHmBeRrnRdk<?lmjux=TK
zN;#aGwoHaN?6T_u#D69$CT^l2?Xr=xY*PfU$Z&ZSRKUu|GA`5^EWBFo=XvT*uiyGo
zeK<IzUIf>Lejg%;cCP#>K03_3-Vz`p`{xlXwHIRIUB`ch0^yIDBgAQRXR6%L=eb51
zZFg@>+=`8~jn_*$sxq`PY~r%#nG5|D%+bAdL26%7_OfAt(hU9u*PFtmB~BL|Wu2Bi
z=^d>~WVHvdtNtmE$yQx?cJ9Nc7(#&b`$ym$=-!^Njaz*fyUY7#oyvi{(G~i*6h-$a
zLufr2`1Vp|G}Y_}77OxdNM_~rmr=Ug#$+LwY}~d{cqslx#<o;GljxI?U1?O?n0hT5
zFrN$J;&&Nv3s<NP-53i#Pm~Gz?#D7}^|8~UW;1_$REVhaGmikWhY2&U#LzI<`_yfJ
z)oKL<9G5eSdh{7h+oeb5ymu}Xak$Y2S;N+gBGP<|lON?a_tnbFnEBG_(#M!VzBrBa
z+G4qc8D_^TisXvt2MNkw>K@GV`EM1~lg}~lZIY84mp0QnoyloyVI9W|pB+Up*1UQ2
zqP*^>Q|`xx(9Bev8>=*-^Gkp2lMl<udrR*uDI>jt!27pepUWI*7GbVWGalo5Ny;jn
z5sJ1NuO(AXCt%OW2zb2>Uw5Ln@_yaYOk4GCGQyO~fLmE_X1TTVpx@q<>ma{D)_3nY
z<EwzPIK9*w6uUUhL*;JTAktcyo)lh*Wwf1?u32oJ0ED&}-7Fg{teluUG4n&_E(YKz
zx(HHFh$><PO7n+lM=H=6ett?7D(hfVa8;`E)of~Y*-{>PIWaMOmQ>V$1PvfOjyJ7W
zT`#Nbgc_YJn@sM55ARK74C^|Y6P0|goUMypo>W0~38&c>P5#j5c84lU9ZZ!juQ}pF
zSB)(GZSWnr-qu7K+IrXcwAMyry;ZgpI2;XLVWKMQj=-mxnNsRiE&{t13C+=#*vM?O
zu8FYtc&@XCIB%$&(pKwTCbr438FqsppiTBuQ*HBU|0FoBZs_KRR;C=#_KsZIDJk9{
z;jJiH0m>Qd^*II=DKHaMcbX!o3Wt*2EIvQ(BKpw(WBb%Jdz!V<qcTuiWq8)|qU5w~
zqeY)E@TY43k4;{~pMTSzyjnZ=)Y7*%aeN#nTa$yqh6As^kyOp|f{YOqQ;kRuLu<ah
zqD)_-<dnGMt1QS&6n1<ONy%Xm;JL&=&z>1ggrnSW{&>;M-EnEPv`8^=Js$B=-XieI
zOla=90Z}^h0`|sz67!9oH8Jc-bLLtABB+BA?f)z-`oC9Xgdu!wfrF~pexlnoZq)s<
z7EkpP8%?p4b+vh$6zl>qpHAq9Pd$WG!<SrJ5<yd!5bRI`99iCok{Q#;nHy=QIrxu3
z7PNhBAn*qa)V29f7?j}OMu}UGh04GmSNuEG#;PxVt&%{UwP%PoPiJ;72uWvuR$^nk
zcIX+$5Ev{RK5nc?kUjea`!Nw4u3>nR7P$T~RtBKxP?#JRuv+hrsX<XS_<kD{qhU^b
zbQP_y(MM}2Z=5z1SA9e*iT>}_+XfPzR($Hnmfl`~w++bL_a}(ctEgnO?D<=i<acS!
zG2YD{@?v>+!s3G0Bi|Sadz2b6uAWJlU9yhXa+%EIPOVj<uHOdq5s~Z#f#*We#!`P+
z@$cd5PWBuRsxxfgSZQuTn<qUJ<2hHkh$uU->kp4_TWyhd<Y>)Bp+aExl}rZ7>CJ{g
zU(xWSl9+XU;2HFZVupw32<Lehey*~#k@-eblS`Mzg|c?hym<yFRgD>6*PQLr3WgEv
zC1jiQS$~4^1|JJx7oEq2Yya$(oG*4e-1*F!_{44Dcx;R~>;nw~qNPVkp3VZ0PD$#y
zP=&21NRnR4wuT|$6xW05f5wyRWoAmFZ^VI`5RIv&N-Uj@d@XFXech(aNFgmmXYksC
z;!K|YF^nyUrD6%=ebkOfR%E$;@a{wV_!`i^4$^ox+2}D@8@OCDfp2`mi=<;QqA`l%
zs#5G})uLpy!-nAdbopb6Ot3()uKcnC)7}|h>9$OSWo<yCkZJL=!qpXDEXubcCbVJ*
zFV~SpJ{qJ&9gB!l?35<o<zrH2n5vtlFhpY_VcI(#`Kq(#oEMgl1(J*zebd`Uv4_yJ
z1k%7pR;JO_tf{d3nXr${&g=0kWTY$v?W??Llf8-kkIOlkqYTuwtT*}WG(sd3lkB=J
z@dny-icFXy#=|YkR;f<xZsvyA6=SHXB}}u`qzY*pxRzq)RGe_FNxUt1eg7uN!`mTD
zwi73tH_vms{{@%l+tK>J$Os$5e?vx?85#cri7*kca<Xy!XZ6345jGAs*8ev$;`|R8
zv07y#+$JQ10AAp94ky^=Bv3l&gJBqgnSy}@kH_i|6jBoE=tKcIw^b}A6%mYA;(KzR
z@tFPmwes1`Y|iz#>8`Wd<*xm<Z@}~iK_!I1F2@3jMMFUZngDVZjO-v106?H10|ALd
za&p8PoST{Jy&B4f&zC@f0ZjXb4`xDw64TrK(|4990D_Z$d;^1k2pldk5h*ba6ab(|
zpm0J@07MC`0O-|60H8zYj|K!Mis(c|tlgc!;04}9vv;co5JyWdAR;CvwTF(Ie+DEv
zVBK%;Pls_0;L_eRk9GwEKxl2C(Dd3XbT`JCKVRE0Fp!&@E2NK}i~wXoKT8d87hHe~
zAf|wVat;^*;F}6F2iz&(mqsQs1<By*U+}LF1i{r@o&gD}jg4c_y1;&kbr=^efCzB4
z6<8pX3&2N>;!FPTOdbGW-|Y#2NU+Ec+-uf1GXl&{6iiFAXj@z0{tiPMZy($V4Cq<a
zIYdGC91s8l&I2-ps~BPJyFNU_6sENk>{|*KMt-R|1c08}TPI&KEz(J(7-WI|48Il1
z59Ue7bftYb)4(t&lz36N-$@yeu#ipN=MC+bSDT!DF!|PNT@o$~T>Ym8*wD7h8VH<|
zQ<!Dt*NApj_;3BX@H_xyetLLx69m8on7`*b7sPK@-`XbX$K?B@w@y%R9rXaJzMBr%
z622*T_Yd)lXaH|M0LudI#qDQatY2QZs0aW;IxUtyaC2CH#BYSJP3XqAM^7$4(h2Ba
z0NqJ>5P+}u&(G-#O#=jwt@Tg*w>m^<YO8XpOw9XVx_7&>M5F=eJ!)74l(eqYs`PXS
zfg{aTfM35bMu0)zvU~hLvTe9P1kYwIt2Q6hMsd4Hd+*)&UH*Qf3&Psa=ums_;-{$s
zkonio!biW=FM7$pd1HQJ?|LpjyO<U2+}ytpk6(~)eqZ|N>5Z>>5GrnF6c4?CrE~nR
zD(FxF?VVq(YRIrXx`3i>-H*H1K?O_tx(eZdFgBNWWm3ND1*-?Y>}sgCQT|_BNQ#h>
z02mP<UdX_8B?MH2fOn|vy5tZ`muXOd148y7ADKY*F5;iSR|paZdBlk5;1GJ)2CKX2
zd2k1Qpsg<AM0ILMt6#NtKbK!t_yr2|<+S$$Gy^ZT;YKzRpBBwTNo9Ngs=Fy?U>D1}
z0(+px;9i{^15tJ=tI2N@$RjC%>nL_>D;{um^^Cu7IyaT%5q2_-*If7AEOPW&>gUCH
z_~lmFU%b`oZ=P+4Oa%`=vwU~Azwkgf_gnPcEF4Zc+NG1Qj~25%Un;$pyXkbW;Ig(E
zwyG1C$l7UgP@)+lT41PhPo^3@*arJz<IuWf$Hc$aqYOXZj3c?st|C>a1M=4V=*6n%
zR=q`8UaUvV+PBnEmZ!)1&1dYfU(-F^11HrixK*NjXIhKzY<9cUm?!FUoD0Ad{>I-Z
z*5hXL#h(};qe99uzDDs9MClH%TVlYEkR^%7mKzmKyzFLQIK&E}G^EZpc0A5j)R;m@
zk~BkkPE?5zSc`5v$`<&L<3<=C$C&3AZyLWPzmhuZdUWdRQpTf;uL5&4Q=B2^^$}SW
zq)a;lN?<TtJ|H>rE5%pN<lJj}FXXMbKJ009R6O~&^g<&b?lrU+@qZ;V@nP|ddp@E;
z4mb4NJ1s;&1<Hq`2&&*^cbE##Yl^N=Z9!SB-&tn8dSHsPVr;`cNv-uqrVFmu(!`v{
z5%cBTF<WbdCaiCU{>T>V>3;#*pbb)OL56B?4b|Nv=>^b1ehYPQQ9Xyn*`n5R8TwS#
zW8kcP6VP68fH11b>o#`Ed#hoDr8;o>@1u#&qRx4?YbB&KoLhA+5x6I$yx<{w=tmxn
zOip1GE3AX7Q5}PpQN*SxItoeyNgelbjHt*I@V@S3#eIW;F<^>E6&?s&@kF8-3=#_O
z|9yA=A;8CpiIHgJ{=;7S*5FGM$RK8n($SEU+~qzs1GklYgrnNn1G}%Ky)LN8?b~#C
zvAsodJd1%5z7qg(QGfS8?7dTvtqZrNnYL})HdflU&6T!urES}`SK791+s3Ng|M@HW
zRPWu<RdMR3JL+c6nDe`S;vMfhzA*-(p`NiOKa1m!tBP_OYP4Bj8dE&!>wQ3lQ(Z`=
zY(?ME6|bf#j%5ReMExfjU6q`3T6(no6Jo^<Oo62Y%YizSn1w4`D6NP=A8E;54H@p`
zq|ez#ld~TPTDY^FqMz!?j*i1}bE_jvIYUn>bL9+95(2g9;t|<>O7q@eRPa#CAWb5s
z+LWpT?~={+99;R=H`05DVY_)Pu95RY&3Sw5h27f}k_5xEh<esYa=5xeFs2Q=4T`t6
zbw5rd6+JX9u1IpR8#;Ek(FcUW7g6SxE(#%^XV`D}J2uXa7{L^zN#0lLkBV~q&NzcF
zW3VEio11EAkeHm+em`8>=r6sr0$;UE<IU+v4BQQth3-KTi-k3MzjRNiH*CQ`e{mgp
zjQf@DD)btK1jXU!yp*etY<tZJ(MB0O7nv{B>7(FTwO#Y~e%MEp@QX8+n4zP7u9@`;
z`moFD-(#EKKOr;KzA9|hcXbsW;lvNxrwvpEm#X_TLcWjD)nOKV`4MAiHEwV}#d!6f
zp<ezfGA%&ujj=|#;xY5D(P&#Tkvj|1V6Wr-AuQPZYpFQE`nrwe4OCE`z{i6QZPPqr
zSju7u^bc^vS;GO{*sBrLxQkMs+C&8v2F<;b9=_wq?r#I=C4Wb2N~R6^U#=V{Wo|=O
zxEH3>#h*oO!kWL|616P{ghG_9BP?mPlCX%Rc;Y5(6Ra!+w{K|rOzbAbUX??Y360?b
zvloMQG0EyS!9w@A(0pz0VF-G945vBJC~-wL$VKOIONxFL0PK-E`8dn(HpG!&mB*h+
z6_rarhdVVEmF&}YMSX(QV+mWmM)Sc6WfS-`6ba~ir~Ya_|3v;kkb7qE^muOOeq{Rj
zn`ceF{!tvrOM{1=9pn08LGs5|<Ql;yaS@q+pi%%aeJOzk4c$h|8Ih!n`@GB5Ev=G#
zsPJt}jk-ZFZ`n4o7>lh`Rq3*b$z<dWnupOo8C6vYYZ-Frnfs6i0=Pq{oXKgAtRoF(
z09}~6r}~sC6p@3W6#9q4ak}?M>v*04W=!{dAQ`!K9+aN8sJwYlz;Pz1F%-{wXrW03
zlf}7XwHGV}9s?ySKfT3Cx=b78FKMphwkTXX!iSL|E|IR|y4TH`U;|N&?NLd3qZ50a
z40uS(G+PA~Dc2~`^wFyXDeU~xICR#MfsptJy`yok<_TCmUadt63<oYYh!l?U@y_w%
zwhF!+_qROSD+c)NY~3VsGJ@QxCZ`+cyJ9R=2^`1kJqO4wpA`1ErY_8=-v%bM`x@A5
z@3hOBUAa7GGejpNhT8UnA^oiL2L#pT4I9!eBC+@>yLU)@pb~_?Vavso#S$-V&b{0$
zt7bQbFewJ(U%_J}8%{UMw{D6gbDJ0xHoVz1N#8sPz(2g6*ne)ChyU&o97MyLj(h%1
zUmT<Da6_B3uE$GV<etcNlCYFj{fDi9Nx523hp7!zBl=N<*wJ5ndtq%>MN=nZ=Ff~B
zTezO29Gk!kkl+dG{0~z-ny!Z>-L;uw6t2|XF->oqo8f2d<DWbnc%(-bla}6y=sKJ*
zLfRk2Lv%S_3(Cd!Jccd6S5RHC;xj(rDR){VWR(y26KYY^(MOMFQ5Z8h^_~?G;~%Tv
z?`0smx@Ji;|H0n&2GhIeM66BvsdV=hRYDc{UL&j5(T?t%aHe4xGMd31ODPqkKh-Z=
zdzz<hGeL~c+keT?nqsG@7mP^lwUP`s4hF9TZhD=dW+AVJj>OUY1&lAB+-_zafE(`c
z#6I);C42Yd6WPKN@Z3Q>pz|EsNF;3t%c8t`qd9<L`?<~ScxekC;8`$h?ibtb$3AAL
z{}$=-xWO<m1mVwI-PJKfb~~RKqaDA>gb$<QswfQ5OQSDOLzbCSK>(F9T3rf8A}hP2
z6|K4qy07exPI;-r<?FkXQbWF8^g2<pEZBm*%?vEKR4p@S*;Olb;U?m@Ja(Q`3s#UL
zwIMl;cRMKUv^QX*kx4Ae@Jng+Q%I`IWcRQr<Q(y4rBi-aC<k=q)V>>O(cB4Atjkm5
znT1Jbi6`<fU?8^5!8vp=nTVDE7t1@Gi>}np924G2Ia_YI&8_E&pOR5@7%64E^=GXj
zP)%s>9ji}_>HbZZn}_-Z+yfQN!CYdMZOQRxgkZ~#z3|QK8{imf5y(oDOa@;pRHwdO
zQY%6dxL1=E&Q|F#;`7p+W~^B75E2rJ%yoe(I(2suzJRu)E_mABpy-2CRZwAvKtfae
zS8Y6&51t4rDHYNlUiARixGgK>?o>c}L-DpXJc3jqXU=T4rJaEEs5Q%5H6m1X)>GgB
zzsOZMT3?O@++_NOu=BU_FZDRMiubhfTIH2H-XkSz`@^`kS+$8AaR>ZIEH~xsxJ5}H
zxLC6!w>dRl=5|$#9oPe;HcB%u&UHa1a$zV)wW6EEZZeaoxB2IFY)j<nON5MAopqD(
zh0EhxObf+R%nSo};x*cMMv2?|9)hj%vdRx*0bh=DCQRj4r1sN!61zRrp31GngRs?0
zH}Z$JBFjm#FHX&s`txe14Ohd7_Vp@aaH4z<HA%X7&$3?$18)Q$8p0J*b($AhTovfo
z(sB#<G7rUFq>XLid}a71AWB&*&Y#=J&7L{8NADl{?@3lQ!vS6T)R<j~7s{vk5oAm+
zgxQdkV9cPz^h4S8u)CcP`&-WY$~GNfpXZr9Mi3sO<)wmk{ZNFAA2m>n9@<o+0GHj|
zIt=f}RYAf3BoMPLL6I+cW6h=34z*ReWev=FZk0R$`A6q-%){ZjfmAcYB4bD(uL4mv
z)n?UfgrCN4ChixX)-5JFVx;co(k^?^;Z}%T2l!&yEgb2rfonofU$_>*Lp`sv%;*uH
z)AUpFY1msDABbK&Tzu?q#i34EUs7khQk8JVQQ3*T+SGq0Dw)$`|1z;BR2riM95QUg
zuCw3oRI&=|0E#qEi&RTb*v(u&DI%;Xl`Eo%V#8d0brd6>X>d;IOX>lu2P$%A@2#3W
zaAEqu*KjFziebI-(IZJeWL{32642tCbE;?8&0}ALwY?+2F<wHYTZza}H<agLsFH$s
zRO<%F;X|zBhgeo&<=qOgpAasVi9<8S?oTnP0A1$}4@nJ>&(^H>oKKlpkTG&LY=vB}
zb)tmRnmCQT=Y~F3HqYH~yU-mtdKU5IKMp4EXd@)CWCnXaE>8<UE2PFI(q&ktH^*#d
z0egTFE3#ljsurN&OQ2Q;PpeL}CsXMR+gD<WOI5vn%J<gOJ>^;R;PE~aalV)mdv4AF
z$4U++Du~@uOU^A<Y)B!+w5vKTde6&6)K<+$_U#}g%YN;W{d1G&@VxHz0PB$yS{J8z
zrSV2U{J1#zh8?yrowIAOozP@-&j#E_MPrBJd6OE#&#o@B*zQ+baW4J?(+*!EUwSJ-
z4wkKFmx%gLR|+$soFp)tTYNq@X>%X!!Mw?0BeX`(f#!rRNfHK4N#iSRw-c7vSl%w+
zTaSOd{ltdAqWnxkUz0*QnR8OziF3GNGB>tDAL6KI{9sLy7==>M-MQM~(WN6!^K$aW
z$mpKx_K$=$bHihboSMdnwb}Z}PA03&F7ZLoL-`MeLO&g=oy`g@Gsl;G!xcu!3w560
z0SD=e!zm`wI4=uz?|clhV<g2XqZ}s?K^3Q*2*(Q^+f;9RPnIV<vCPVC?y5IU1dNk>
zJv}~~->)2(GJk&N4-CPqOS71X-7RB2(L(V!PFB)})xi^t`NXUX$)kCV3l2Uq&$T_f
zC1;NEC+lQJ*TGoL0pVuPYGi>`|G--m(X_LX@|qe9+d|x1a@S<hzT6M_9rS#A@PUI-
z4u>{!$i%whrUJsH|8|xYi7kpD;d{}HJxXRgrIH+_ChcF(_~77;UH&o)64Wnca1huk
zh0fgq$@U?raCL_h)eVKCev8Nw0KvnJdd5?R(j5L<d9j=%>x9Q1np9p+hev_-d9y=8
zRM<n7wZfxaT1Qs-`3Y=zC`hW6byRFVWeJPy(>4%em?<M&`tHN%4wABBZ(uI~$4?>{
z7hD&tQsf}={?U$%vV#{+WY+I6Gy5?KM9gq8qsp|C++S%lr_%hWTiGSKzMbTtfFoZN
z+0`juTOncp0_WtbzQj!DmJtje=Ov=?j2k;a_e$G|O_X$3mYEaDT3uOKLrYrpUV;|p
zE#B%~pdcnpOKhJ>NYB<~b0J&;!Y`$SZ|^`lt{ZzcHTI?4f3QsvW!#Q@$c$=jleiJ&
zJCbdSi9vr4DwUmu{s_B1;x)`-a7kBZ2ZH{|a4cOmvK+i&HeHE!=c2gs>-SvU2k7c*
zvf?!CsTAM+CRrk3_;s(YR?>}y1p*NxZ}IHCpl+(=nD~UUv(8@LboItzt+`?<S^M`%
za-D1MKg2c=zOs#^2b<pDBfl=DR6cezIDaD9c$gIy2czgMkH_QTpc+{k2vh~kPE?>z
z2TD2~!zQpn;DWTa6!~X*7~usSBJrlK!(dFq6=b%{zXWv9+(s|L0j~D)D%Wa*p2=gj
zgLK=0s-r+NRtxc%Hgr}B;TG2U8kxt+>G~p7Gvl9|xhHQXka|Q{OcWisZ+*l`+u}wu
zw_wuJa0iZ~-k8q*=yrV@#q1rM4SBY})p=_GI!D}#PSA_wHWQ}sFKft+(}NMSYp7a4
z{Qb;anG+)$f;cA|i4@841kbV9n1V|A)3x)kKc8BFi~Moxb%nW5f&GBR{(j?aD8@;$
zivEzz7E;qBwV))bY;&kG`HXGu<TjWh*g0}F?RQQ*y$UUz4F9Vp=D`R?uPfHR!}BL5
zq+5k0QjMGDMi$wj!SM)#yT)UNr|?ZXv5_#NRuJ#XzDC|S{QXB;Nu?B~3_i`98gJTQ
z9o<}RRo+uRS7|G>)%H}1nbHn7EQ-p)+~EqJdbpFU<DRh~MP5iz>dG!m)3vfrv0(Wf
zFv!b-^ZTr;GY~NsB6|`|pI26YU*bNmGeH%b9eL<TT5=gtnY+l3bI!{TXsN7&hL`9g
zI&+)nhXTnB?j$Y(t5rFi!;z3{JYkmVSsyGJ(n8fu0nbu$GHTUwdDt>;Qu1v9uZa;e
z)N<Dc3}(HbJ6awjvdP-id0O1M{iwy>mPqBxPjtF}sHhpwgvR0cN<Kp0>CoSRO*eZL
z7m4>aox)1vV}BkUE7%q%ZUtl;k7R`UY)ISyUzfEG!`bWL4JDI$;t}(zyPXTnWuIoP
z3Dy5jtslhUJa_rcGW9X+5H4}6ff|nc9zNk|6~`%}vzlmD4P%P!DCYShdzHVLyqV=P
zCtxh2KHdDlIk5&o_Lc#lOKA($uVdlnFmGnZSY;;NPvt#2*xY{2K+CdJo>>y|WH)!E
zNY1W>sWtSFk+pL56)~Q(e_|W8S$EpdrjGR7vHP~R5^$_u?eRm8Hv~o7Fos7Kqcg_3
zOQ>Tspuj)e>1V>|sr|Dj%$^!dD!c-`6ns$mZVN@^p|DgK9`hy-#rR29s^a^srH=s8
zjmAp7?KOqYtyYh)1+SLq5q8eeq&2=J<1TkK403<zL8}+jp{*VTZ3t;TG?0p&dp}zu
z%lNH@@T`<pO$9TSzjjl@K5wuKBj?k^>7IE6^%@v{VIaEHgfyE=HGUp&nWd|Bvcv=2
z-V`I*=y1dbCYw?IOfHq_4tP%KfzN)+%@Y=ir{oVU23<#CNr0dFcBLch{UDzp+Zgi~
ziKAj0Yiy6bT`AW=;-lxuOcNm4b^D8`HLM(_=zZO*iw1j8lLoT9v6OuCcg!MEzOZJf
zGb4QCr!AWjTg2H{!%~U(QjJM{+uq56Pt{y<*z@phxDffE0x$FuSOr2_2j^vI@cYFn
zC=W!J`G=yD5~R31&eYel7J(c$#V42BWBAcQTY9*;=EVyxcY%F8$8r#r5w;%&Mq6X2
zM^W>~aZZ){ESDHloO>Z*Cgf+~h{S94qgQI*OG{zL#j-(Q>*tH|S@GA}6Sr+fvJt{<
z4Az<<*^CsQ9q)0<yEi!#v|fO|ez9a9Pf{*p8I*+7J7E4QKFAw=*GkTt0tSA=i2_#1
zTLWdcs-{cl!Z4MHU;ug}>$F%{qw_F8DLc5AMVhpyv>I0&G`n(dv3<BsLqbGA9=;9U
zuJnnaSr)tE<a$(to;<=*&_|OBv%$IozZN+c<q{q}4qznZc3|2-y`bk;TPl@>RV?uz
z`M@@3?e5otPjZ38zi$N?v}eaCc=tGEn%HiH6h=#SY30omx5Gk@iB}(Fv)Vq+-9}`-
zm}VE(n>ZT4q{arWYaDyV(8}+Rtv!7@Tv`_DoZ`1S=9kFDU1J(17Ht=BZ)!FK_dhD~
znvNH*w^X?g(5<j~Q>;MPg4_g!;T<rkwqS+jkPMZ~Cv{T1M1#Vja`NG#H9X-~tjo~1
zMH^4lFB^dz_rTYuv`z{2{IMvgR8Q5b*|6yQxybEYezA?NC<2a`1R3hRL=#!jzCXY`
zB-5e|o=(rE70GWU5r-AH>i`)WC2qOM*4N~>r?FeviI4-ECuu;51`oH%DZ2hxXcXQ)
z>1++{6Tp=W0GSrHPqrJI;=_P_m_DrbLe)r~r|gNW$$J62+eCuL_Vndra`BtW;oxBU
zS|oA$`Z`hAa*Ey9N9oo#?<JYEJc?!WXZfMFB{sdPK+l_$d7T}~dS&qaLsbu7q&)XB
z-_am#)=M-Z!mJ8S+oPzInAB{#Cqdjfjx>*6+gU<TNIf)*k{QRHz#a4D4iuH8s?m(0
zXBeR&+ctxp)i90JpMna3-_ND`ax|#VFCR%67!+YL=NEvd>Y0@Y`$ZeXla+JYv_+rb
zjX~qE2v$*5x|o_s?vW~TWH~|8S64VD%hImH>F<U~ZhqY6=~#H{rr}C0%KE!Tv(KsI
zY=>HZQf;*@J}F#ynoMek#4c-J4-X$V<_e!Z*g3X#N#DO0z`k3fFLkZWSMZ6DStHzg
zM2B8t#uqKuu_j@eEUSAWUEJ{kL3Lteap{xsl+714F21KmLa+_$AXswH3U$AsSrspU
z@|BzV)(9j>D^|QH-Y-EPEwwP;_sYuq=a0UNekgD;($J)4Gq#LkuUuvIv%<q8+ZLrU
zaUU{HUKrZ{fd_x1;s1v|8q+`Y(b$>(QyYzijh*SA+GwmyY%Kq?Z8U2KGZq}n1?N}-
zuGs>Z{3wJ1;f3$r`*Z~&VT{Ze6EMukvjxwxM8f2=VMvIq`NG$oq7Mk2$hz#$ozFVk
zn%f><nGMr?=NAn*{o_T^0^iFAryyb(#D$f?^h<4Wp^;EgK|{ks6K?Oy^%3QHkOEYL
z_7Ir>kU?<tL+!wR4FDMC=MymL{(>4>#f@le7zPH>_xJtrs}30@T9~j7z$g-V2o<sc
ze5AFljjC-gJ3>E)I#in-lL!HzgBM6Y!buQ7`Qc%*u?GtP5VjWa2e6;0ex5AA=P{eC
zIK~ffNTFPN2!UU;V9<7N<bXX4<{WpnG8}RIKr_`4G+&yjv}gf9C*=Z(3y(brztX>F
z{Gb5BgMpn`YSw4nGACHE0sHg6wyyX9{^%WmeA3sy(!bS&JHL}75d!-G*pa}%*9xo<
z&KkpiJ;^{@M*#ACfCuxteziE!Lbz7J6WCqm5dcKjcAE0LIsgeNK>Ydz1$Ov>6Vn6a
z#ApYC2FuWsn|tD`A&)XQ`uS)4T`w37&*L%xY3*u_bJmxDL>Bin_}4k{?Xv2+U{*El
zTR;ZE*DJaX2+k|cqa6R<TFg0qkkO3n)gSIVk0^d%{1dEGo>^AZw`+i}#Kjo~7@V+X
zV2r(*&OpQ6KY+etZ}JEH%l9>@zBP~lZ{6DH;lo6m07v;mzBwT$+t=G8cYoB!#xU6B
z3}%Qee%1cQfB=Y(^@4~+OS${<J?P6es)JzpirHOm|H$~mNdnRb3rL)S)8AtZj2mAb
z0PVHl00w0X3HzXd4H@MJG31HeGHDT4^>kw<)vf+aP?<(g@x6r6>Y&?p>gT2RLGTa(
zg=(88QL7;Bu)5sVEy~(!;#Br$lCvhBWs~!KDkv!M_6FSgAi12(+c~f&$yV_n8t=V$
za=8k?@W!bc>n;&ybZ$nkUrPv$2PIPO9uj^pgvx@<`uK^RCigGK2Js9e%sbqJZ1m&I
z?-xM)$3+MYyzNr<4hinqPRKSVB4fy6&O2jF;|}7fPBtf7q%wwh@h#6=3!z~XcHIL=
zIgST#YbB@ow=*z;k^x6h-1>MA7)7rpSNaIJqUsd)k#7jUIn;!Sn)e~z5f%37Uvxfq
zsI=$m45obXM(z{?YtDyC)4*(1fB1|E$>j6}8P0sZETowrT``k0lk>spwA4N2@28-7
zD@!VW-xf~u1bJ9csJV3?EKYWKT**%NEP?ihEi9U6Y6U?f1*aPpNx*j*vwQvUAeMZj
z$-7RA517H4f(e#1^5t~)rp=<tUgW-8oX`%dvNL6wtsonAovy*BDfVl7X12vX_zdD6
zdB7q3?(qJAJdzgs6}D~ldz5PQnF_iAm%RfM1MQlm?@CS04&ydcLxB}-Iz29dl^DAU
z=D5i=(wDQ2cCt1ORK%Vi!SP(&G!{0B_dWDfv4d9!6U`nSmE4dni%8G2nu8+%5&`Cj
z!y?Ab4Hawu-H{g~Z4j+t!-T1E{N#pBk&jj;ej&5Uoy4ku1Vnt#flBeMuFRxC3jVI=
zsaPB5(Y5jfVV4U7KMapT@3ay=OJBcP=AH{Hf=BMsuQC55Q2w$HI|eX{_Xqdu?{_>z
z9}L$9zTx6U!QTt@(Kt2z*5-<HxDkGsbtUybuw~`*Ap@76Bj(omo&aXETGEeIE=kED
z8IhR#aSWXHlktZ`%>qH6pPX3aUc1*|h?cfTP~zb4DC>Bt=BH5lzNWC9_gcORf2h`O
zF4}4cbU`q4q)C83Y>7c#=hn06E%8&@!ue=9H_+_{RoYcaqaECKx;EdYlh8O-AUP>i
zXhH31vnlv*8!iBOQw~O7u`@~i$Oc&ixN)uGQ!eK4VWp8xJ!thaiou{&{;<k*AqF6k
z7-r(3-8My)9Fx{WseUX4t6n*ZYrwP0ba2+qS&+{%=0RxRd!0YzeXk0RptHteT$GV9
zg{S@*_ZnkOk>7s6TY;ukz#LD{&IsBSSa(E2kzHin>`fS)igl|!MVCDlvX*GVD;yT+
z89p5*6R(?$LvRDSBr?d<Gz&#oJ=f<-|HMpPRFWVbi2Gd#T(t8-`=VSf%Ji~436Ssb
zc+flDRM%$;Rrh7}?aSY}CI#APPyH~B%euh%s&52g!|zNW<O&Mn8b-fxrrjCwvDNq)
zlbKxpaa1`7KVEBVtblVg+Jl?0;OfA<JHcPhHj1RxuS7hEWU(^5LRFe}j1h<*I2Q8a
zw(uIIoK#X2B!ee@SjTB<g(S{Imo(7Y?JN#)r=`P{4S`2l!NehvJ*BQx?dN`51@6$2
zoh{=+?qvL#jq#fWrs6#^z5G2Jmqc}VmvviycK6T;tApFp@c#YQVAT_fAWV4UrP-of
zu8(1*b=Go~Up1@w^~Kd`kHl;EBd^*Okts61cLpW}Z$^y%O=wBCzF8wF;rQ`T@VN?S
zIPPV<rX=ekO=;_sGhdN=aP;A_`7OjUbrklT5dfLFcK5fQl;*2bvLq-Kk3DyPop`gK
z_WdB}0^mbKkxioes+^i-d=RgSdf1mnZ~%7#rJ|?VzU*~%?2x!dMyc)lQOz}+8IT-&
zK$7wTh-?7wasK#gcl|QkA@%D^MuSVl!l%z;z>pz<?r#!@lOsd98bST6Y?}vKy%-x5
z+UWvRqQ%G$k#O9ou!i>_FN>|a-<+rV(Q4cLoW^ckSq5$M+LZX^3=W{r<LLMGfl%3S
z%DaVaTMv2<NiiV!-E&m+Ff=mc8z`Pcs>V+j0{F=+%KI`f8j5LUqFm4O1WIGUifKia
z>rm%=NegegHBWEvc-j_FutCyi<?lVB37dngt+)I)mEgzl;dtD`k6sl=u3?bjg{PEG
zp*d}>m9IwS=Jh^Bu+4D2G2pHQ#>dLfc@+i>DP=Ri6{pn+^2`Hvm_Aw;r~wZtXviN!
zB!dg&MTNMR#Rhkl@%_=EgVIY$=yjzqlv96Sjr0(=532arXttDJz8^IaPxThox#7*E
zMLiUt%bsHB`s4sx2}bsQc5O^{h;~cD@<?ElyRnx(R4TUx`waY=Qspt(6})CqxmnMs
z3v880zniI3_Ls+kbp|JTmvi=LZvJRiF!R)o<^$6_ilB)o5gy8ZE3jCi8h6wdrRzbh
zhLyuC8h_p^lI=jNAK1!VjDqZCLx2oITW@WkdAeLu0|de*EFdPuQx7uDw_Vz9;befO
zBvf(SrMmvn70hShy}Om;CFZh<4-y7SyD;K$4J-7DPixGXDSVmi%qUCaR4Pzj9#)SG
zX=h6si9MVhEQ7sSR*ReKB2oKcGS)RtHqgk{cC)$wa%XC#`ZI|;0%H&Dn0tQHCFl!8
z_m)<}s#1oIm~7FivPc)@sTN{bc#auTO5@L6mt20*1006=`1zgH-S1Cl&P>hpLm4g!
zg)gVhcT?@e9?Sj@P}k85*TunRX#+7Ypj29J>VVsI`vvQq`_}v)t0hg)vPCSg9Ph)6
zB$|lIAx37`Tg<dlMIYr+FRH0FV^sX3Ld7Wg382W4A4${Jxf+YyZRqhzx<>BHd0`yn
zL??>cr;5|ybRxABaP+{wx-^z#vhJww;V;qfTIXpcS8XrT-p5}dpaD2;Xe&d2(F_XQ
zYkV%ooja0Jwv&C!?52EYGlXL?P05ZgtmbD9+Ca)PueBR1po1okHbtxF>W#~jp*xk=
zD8ZRZlz3Je@HDZJ&%mE*q=cmWmv@FA(L5t+9dYyVZ8Tp-5uUgx4zeeQyyIPWx<6%|
zMyQ-rh<JxCBm#`Krq<4gQS<g-f>nthJlVTJHJG27qy;wIEV9;>;8Sif@)`h|t%2s}
z%sX?!O7a0@-$JG1V;lQ9Lh1uEJGR5{%k`Y@B!n+VG3^TJ?G(~z%w$HfvQIVDOC^WY
z9}#TF*kza=t^ark(R!m*+Q&Zjj?K3&zg?*WzXNPr!yw2*wT1$)T=jv3fbnu7YTZx+
z1h`tK<xt1fujW^ER8Bp7twmNZn_p7SOuMOCy9^`t9&OICj^%9Mtdt7V-8D~J3vvFL
zr1oxF+IIZDWeZ4L{UhF6;PLu>p)(z{2gWHny9Om7gt6}(Twlqfo!?Dm)!rl~ol&x6
z<d-(d*JK&3tKz%c=kO3rCccI08yND`piN%i3&}3H7c-G%m=>>-BM}K0nk4Hi4~?E@
zjL{E;fdn`)MC&UR9;?jK%?Gvnm|c;m3QjFfb2y@C4#MLtbL5x;dCHkKa!n5ZqghHH
zCKgwla`lWi89JBEkND;JoJyqAoLR>bQAD6+RrVbabRhof!5JnG&?FOBU#-j9pDL#j
zr}-C8B+Ry#Y<yfL5}e#|Jn?1Mk~zLrZM$_$$#Wh~y_dIiVY?a{cO)Y{);^RUoodk<
zF4_#aM(qvrV0$KJj;L*YBYMBVKP^se^#r`~Yv^B3ocd2E*`EQD1Oh{Q77HBK!al}(
zG(a2McZn2bu8%CdP>2Z~XMgy{S^OdpP2-fWEWsMf7`^U(jSK~qmA+A{2Yd$lJt%uA
z>zoA9GjexoHH^N{F@SaZhIhP_E+R8yY#Wi;bNvcIEUDQ1{*=v;F(ze`BvuS{(GrhJ
zPT77A^r<)PnR_Rt)C**Nxz}3H3`%1|Dut7Ae<9`s=yTAA-rlnw_4Kg%zS_dB6L@gz
znz;nze)Jr+&kK%oxZq4D#;Sa4^Ia87Mx$oSS%f@yvQ#Ol2zc8a#4!lCDddq;zODrr
zCYD~U{^AqnYpOHcWP4y3rlLPTOD#-%J+&j_XsB{OpVRK3FYc#i?GT3Hs78Muj^9Wx
zzjZ8}E^AVJQ<v&M_){&>J>om?IJhisyqWK|wUcoxTiuS8h20KqP1e!@xuxoDVa^8b
ziHI;X8Qq38r7(#x1-W$Y;pP4^7}!ak*7wH43|5Wp@ML11$6clF-oX5pbRqH##Y>cV
zzAT_$LudJ%aCALxsF_!`e5FSnv&Lk)dDoIkirkX?T;j4Xp^Lxj7r`DjR|w>Rirmkf
zW`B_Dl@KI<ZM*cLM>}eEoD>S5f*k;3q9#_`55Jv`7fUAJ8Yf9lQrtw}#LSd$Cp-*q
zFYM}!olM51-*i<dN6bPA+j+`s)#AT`ZO5MEukH)@qFw2Ot{q-8V7*Aa@}B09(RxFx
zgLSuIu0RC3Z4z}|_aOH6I>6_)daImjUJ^}kmW{TPfrLs#tP&JeTC{LxT$$3z`flN?
zO|?xJ(@>sVus{wA_2<G3Eooc;9xg2=L}USdbR8WY8~2B|t;+Qv%hj-%%>!ys^I#5Z
zjRuVq=q+4qiPa&#UrPd4O)b5|bGjx-u`NfXMVM_Sc|6g5iwoRUEG3#}t6Axn@!^vC
zcFqcS&CF_>$RM?IPe^72`@^y)PXo?0JqDS|evC!%Y}O{#o{Ja5bylJkRAo%bX>U@-
zJbY8z2F1^0S!Blgr>6%cVw}dGTYNmHB7?|k0+bls-dx<IR=&0cO(W1FN}c`VX_(`@
zQ}nA13)XB&K1k?kHDw;zA04+}(zkomCBQoNYC^V4a&d;7Y$nJ&D*I*(Ef=R%MsZ9x
zGMK+>t*=Dvt};i7v8015YcHdiye=<9VCTVHRHqe=@4-+e9C>IMXj?r*scD9Q(!#h6
zpa?wvaB#_hD&L3Cy>ZL9;h9BvBtNC+H1#}qbggyK3c5kj_g!0Y#o>&icK4UdtAfzc
zZuh_}9s*{hwS<{MZaFbff2Kx6y#XYGK98i}68W-lK=PLGK2}YGcMe`9#n=K|Qbwuz
z3cKXUxOFZD&jju83U}U7I3%qUT{XcD(S^dL+49uqKz0-+gIm1UY5fkBvfMuwpIi2p
z<Piy`KA>mH=%lNh{G=AmZbUWaER6+=JLoQ0I<?kuX1$}~q+^OIwKK^{ALwknc^kPK
zjR!d+P3@d69zF4We=UJp4Up^{1Ew-bJNzMh@gi=zlTfO@3TL)PGcJ4kKC(AIHV)A4
z_Y6!M^cdIp*+z)F#K}-`O05!o;$(eqrGnk-@cHAXB${^w{iNg#%F<?MxJwt!{)Wc`
zqF{p5ypK|7+|id_`J4gM*A$;C|E8w~r@(uad)ud1G&w&9Rf`6uDNMX^1gILt_@1Ra
zlul`l50^<FA#W(dYwxthYR67polb83xqRx*sK~>(DG;p}#B3JI5E~Zhr%!jN;xOd|
zd396qwu8Glu7`d?oePcM_t}aXLyR}O3-j5gPe$Y#t>V*$2a+yE)Uomj&y7AwL%&oX
z_^pNR0hqx7#|rMNF+CnmFHWbj3aVO+v8>?ztatTDFCKGCl;bHLxHrLLSOFNsAIi0j
z(^N+COeprsfyW+HAVMYed01;y>h;5`QjJ;0!suAtbl%q|VqSoMs2WU*PH=#=O1!RP
zc~<-xrf(Tzipu-vfql~(+%yy5i?P%f_5!2c1Cg-@^ZQ0wu|5KlgFaW*O8DB~;U(RD
zDz8(cF?oa*M_9+iSbf0*ebpJTPz=WE89HZTi6WkEY+a_KDQnLj%u`wT%d*N1zckrx
z@D&tGIrXL+`S?C$*2{Feq$ws5HuI983ziBJ5Dq(}5?90_;MdB_ilQq#5EBL#8gKXf
z;DysHk>6jO?th{5HT<sIN_Fp>xFECUEq3C}FS~!GPIlN2JJss5stdRURbrkBd{8+1
zo^)}iMrJnEb<?Xr{WP~&*vcI@J~d9PVt&Z4N@r!q`Ci_ak0Tepw${$gi#_s{v9v6@
zG*9S#*38bGoZJL*iKk7Cp2TTGWN9zOs+>~zSb@1edhF-db<96{wum!A1Tjc4WR(eX
z9U4p{kfyUDY(tZj9^Xx4YJO_qA6qP6R7HuGS1M`}Qd!t`GTP1@gKk^rTMm)II?FU-
z@dLz@Tb#of!3?*XG-~3hG@-`I77|Cb`*eSycTJ@~bIWs&*vx-F`Ds=&_U&pLiCAj#
zW)?a>WQxfY71{gIQzaKcvq7SGvoX{|M2!)vOop3X!dJIJ&-K18BTBa)jPV@kF3@N&
zmiKV+55V37q4htcpe%n&K?&Gd82=;QB!Hq9wXkwBaUh@<wK8xr5jHWhH8z3b<AZW^
zaxgKlhH_i8R*|vYV?gORR&#?-S_2+*5eGsQtiLC;U$IsxU(_XJ+!T+^MJT-N){D{e
zPqBv2y}f^NAHtj1Y)P3ER=J##?h~8RoowxNDoQKdZYkOM9^M=upJn-kH=<ICYB(l;
znrk{7dbr@zF*`55!l!ZHObn4S5nWm)vEDi#QmTb-_hs%TJG6fmyBWPw#D8l`vy0t6
z`_h-tn_|{7ZV@>``()W{waFkS!{a<|j%8O_!!y{&kp`!<;tF41mRW@LSb;kOBGgbx
z`DAd|KAg=4N3-Rd>g24>@W!S|v3j#4pZ0#<W#I#vKdxrd+3aX|*RpW2bmYu}17pH~
zSEW`>>%27o{Ih}wo8fc%y>aTD1Cwl1J+`{OYT~t#R;I;zOQ!a~YcN@)4oX_-lRaf7
zeAB0pEP3qs1xlq6Dw(NKeTc#?!Wu9kuefgmt*>t{6bcP|TwOhrLamlVoh(&ak!25v
z7saD=&>6krr*iCsn8@L^HM{xoF3>m!mei<`zJxQy4xs@o4{;{2SR*iaG-Nwp|C9}_
zlO&;z924U3i+<+YEztf%j8f#i?+bCs?<zm?OmM_K8W5h91nFO-_IYv~@Y>VAvcS{0
zqVEZq%~73Tp+abo%BgoatDJF;qs*d(Tx0tq?6!nK{`h;LM$2U@4v&Tr`;CUIt3kC{
zpQOZBGXl#(^t+1lqH+*E!t_F(MzTBz3xU{?A=(q!<!62f3Mt3ZKSXlg<`IsT!ube(
zz<49gon9&0&xPG9_Z^E$<Y1$|ZIq@>M}>RYC|@`hAmv~edD)<thzP`drwl$v_l0-s
zJY{=qa_QSg5)sqxb9au}PAB(;W_)s7ckXj_(+RR(*$*4X67*i#jo*K)9ZQsaKe~6H
zYn@J@^U7Adx=)14DN%moDQY;+YSrs{FWR^6lk)I>8k1UHMW5wuxytKDR%1VUBg$Dr
zR&9;(92@=v7nvQgL;qu<T>T%QVg3IJG$a29n*RgM|8{6RY|0J)0h+(xxF%p{{9jNS
z<-e2$q4Pf}jY^>LvCv-ae^MF}oVV*`W+4p7M*t7ZZp`k9j*0%7=gWzO&8^8kGfKXV
z8J)MW$@=Yf$D5m2*TutwwcEwkwZ-|<8=|fE>a{in9@7l3dA9uoa@(~tx3bNFw>0BT
zwRtAcE5w+btLsWG6``U7D_@IfqxmV4TK<gN6Agakz?ks%(w;{CYW(zSZ^SbV$x~nv
zEwfF?En|oyHC98uQ*IXPO+C^uUI>^(G-su#W%7?2*)G!9j!!&M*R{qFI&me&KQ|%$
zE4~F|CHh}W%hk4P^tWy$lR4J($M>^-aD)MmnhRGuQg3)2SF*AbzCM%Kr}ys{fkS2@
zW98K@{qAb5KFdC>1W69GbM@Nb)m7J1hGQ%EWR`nn4v@ZiVM_w#LNU%TfTwlvJqE^<
zwGV#k?wJ@cZa9UIIAoXy5}=e|iW6t53*)JD()kiU9&MNPipK0fEs&so(i-)o@7d+S
zKx*|s_kr$&+Qj}c>Qg`VU_SDftzubf3{}h3Fb#~$nI9+p1w8=9NoshGokq1#CKyUR
zbD9C{Ra6F_D-blG2OyfoB?Nc2z<Hvupb@}|9FE;1H6{Xgmcr>!It_ZF#sPxrXPRWt
zA<TC=9jk;O22A$pR-^h5ovZf~O9hUDu;Y%SEt&yXnw5A*7_<|5Ax3fz=0hC`|BRe-
z&@TspKZFa?qDKQm0xMTd^mZfas5K+@*anTq75R2UX2Ovja(WXZyPdEfYsRQlZD4v8
zzF40>HU3kd^u3qrDPZve9J?O>!v9mB_$eT26`sw2f93m0^$Pq_Eq<j5|4QVizT;B>
z?FxLeF~4#AXDsEDQ1L4K>K+^V2iNV-Kxe@7%jWQMsqJ^#AZ`R#c&n^p=N4A?tEt!^
z{*9V>*^rVJrWg36`((a<z=HknTEfQp@6F!-GX>cH4GVk{KPbXg$T$uwtt87PHF0Tn
zBnf$lkgxYgY~)H+UIdx!?TL<CXvgPsXYN^*mKNm4k<|=d*Oactgp21Zl+DdU9d`>W
zZXPYIRZAXT{<`HZ>J}IM=T)-p#>bnTk&I>@T`KN+A2Q5$g%&@5zKgHTudGBFC1}1?
zy|aD!7G$_PPhK3{(_zP>A5W;pi4Vh1$8A4zQr!+Rx%D?yHJ0@w9a%ah4dxX#@@y);
z%0n*m=#b)7oH@0(Pc+!B_`adwfp1>@hC-8W^<fe>JLD^Yg->`srK{e1)2H^mW^QBl
z$$<-()|dgWO0}{cTy1vpPsdN1j4zJ;sQWMXdg;0Lo3^p)`s4ZP#?R`{+S&MfR4ueY
zs(S0kOKFFkdj80b1^ZVV_@ezJV3<8tKv9k#x#^+2u>e29Zz##YYXNd0M>qf$5L&@e
ze)SD1x)C`45^mE*uw()dPYDJn&zn*8>um*M5b}`Ld4cIOtTl3qlK{en#3(cSzBuSK
z8^Mq{q%9h_8wtb!-;Y^{jU4QFh7%jI3u9@_1Ct^FaK@I|{&?$Qc7NM8?%V!#2BQXD
zXg?AgUqGFLmqYxNga&pyG5m923kVjLF3hmpF)PO56fLMQ9dsA;2yNgv*znpqTK%mn
zP->ffxJi7QT@3g19WC&^%f=ABgpUl)a%?5G>A*SDuciYN=`HD&aYHrjIcaZWA9Sy2
zI84r&WHHCySM3B_iJp|vQ~L$OO%R9hSIL4Dg}HcHit<eIQFcJPWEtGF-*k-&(DKH4
zFYiypk2$87B9$AdX@5N~IG<CJm!kQdl%-z!Eb#6~7@ste8){_s?vwF+ddNRk7kTS*
z6!hNLPmr|Kn#k%1&OdG6FBY<5Mff!X_m2kGr4T>C?Jolc{(*zPZ^9>F<NWuy^8a@@
zC`tG%;)8SM-reb1?w_^y;WC9Y(qj;%^tJM>Zhs036Ps!UUb0SdhBf67o3DUl!%f0H
zYd)(nT)~?o`pbs&KSpJn?9%~{u20|VXUKS-<R8Y%Y;WwkpYTiU3bA;fQm-#xg17(4
zpUASJFPWbe1l^yt9HjEJ1KqrsZXc>Yl>^?QxXvLTC+UQ)DZild<hztyzg~mKrsdSD
zGf}7{T36kkB6+5K?;nxDO_{!x=hEfuA<#wE4+I7&4_g6-1So{aF?0Zc21x%E3H$>#
z&hrN#g*HtPxFWcC;W%g>8SpPB3y54SC~H)VOlkn;!r_IWX#yHBZc+3!l9{+)aUP;T
z!J_D$5d9VtCc+p~6ae=OnF4K$1{@_*fbJMmxuQe;c4;8FHvO$y_%*I<_%+{ixaT!f
zc1=I9LSQI4+Z;}BISutJ3=pQhIz%sMXJ&TdDT=w4Unx>-6vWFl5Onoz1iWl0p0<uc
zi>{@9KX^N8M|^)Q#C6#U{JuUXbFn`&+RH7Dgw>GJ9maea%OK3t!^H2mPIA|yoZ{6b
z(DlrGQ5IAD#C&!Q>SBCUL~0lgit!^KKm>A=><sh|PV|rfwYIq8{9TcFc7yZsVM%T`
z*@?H&fYwV-8=$8N+WkQDQnbI5BKu7Ptd9lm$DI4k_{dI*21qxP{e46i&0GA<^blIx
zW#rx5vrX1ac|NNjs6xwA^Q7!1q{c%5D+irUM<>dxZ~LzQ-9KQ!`FA;BXXgB``0>A2
zNeFPC&*!(qZmUlKSo|?LW*5C1pKdyG%A3}cBwhy>lbLOfdTA0*j*c)_S9jH1_|n`w
z*h(25nY_H;a!|2k`Yi`kdQFoz`lA)iYdJre>$}J;?q?gb{k>N{+h2Lh;5v5_E?ZaO
zW&Xl|y?@K0E5o#T$i{Ml_SNJ~X}(ELn#W<vI?w#PlDns$GF8{9_O#S$xzX7dvA;PM
z4Px}H7>kbhSqJyRK>zmbo+Y)veA8JVz5X;KiwE|zMCk=VTJLS`LFT>p$~JK|?eW!Z
z1G`k8N1aZ?+NC+~@vDOqgY9!_C+Y6XokhB>jzC34Eo0tZDa~izCzasPYxKKD0xPci
zlObh3=)$guEOqGU6-1>8Rt7_x%m}q%sMTX!TE@^4RNKgr?>{Jj1s#EW`0dIq{6|TI
zi0Nj8@<KGVUF+IJK}Wrml|NS>&@Xwk^)bbaDBWRb%HTkGNGkoz0-<+8U3PjH4VI7V
z8?>Oa6vdYlqz4%JFwA^9dN`i<VfOd%zeXr+f9^mY3j}gN1HwO%AnQwLpCC^GFEi^O
z3z$al^NiqVg6ahH5k>@_LAlBP#2t3uZ{454MY$o$WJm1nCeSO|PbitNhuRa@zuSFE
z^0&c$D=Pds;fLIJgR3Y9Dl5(_WGBc)49h!93dE5R%7MtCAmEcnNHvP?F_if-6MLWx
z&QItQ%?Ekv<XXmYI^a&V>sU}Y9R=lWvoLWiD#FK3_0*~mHXWtN#~xmvpDU*G?Z&U}
z3&X$N_}#zVc+IyP|M~ys#{V+v&+c<U-)`JHo9Ww)L*|r7zwwy-CpXUR;r&?dxV;WO
z%iH{y8((fbdc(tSC;rQgj|_LiM(U33(BIyd%Ksf1_P;O0_>Qm`{tL*!{0$jl366*D
znjHLH+I74i`^UHUk-Vwx_%-Wk)oYzuK{1(~tKUP}MOj7st~z$EDNTp3#u>M(Yh$YO
z7dHdC@68))ahoL>R`Uz{0mQcHcW%`e18>>J7h;<Tpic(R*H6!tJdc8tPseW@OOuhn
z&z*QN(f6Ayj;t<9Mn0qT>+sI&JdC#^oUTC~Wphs;c)|KUv%N<N^+KD<pCT~p0gXSz
zRTmH4Fki3l4&Z>%Z23cGv)Lx|VB-TPw>J(Lo^o_|g&2JQl8#C6_HKnE)8^x9ZcX`K
zw_4qXF+6Rd<4<?jdaJLjUh2coh6d@kx*sYgTB~{MNzL1=_-x`FdJTmXOMcene~wV9
zzimaigK}43jl9@7L0n!xQ!tS03aUO6i@JK7pgISRLGLa>SWv&@yMMnxzP@77Oepk8
zUS5c<j;nne8K@;ECDoscw+I)!YJJR*A;mk4+5xWb0Lu{A&5r{dXBQ5~E^_6$_2OdL
zUzW1)I*e=&gO5ShqQl=_bRT8tmH#75X=CXZc?URRp9aLuj;tbJ@(8GRpXZJ#;EHE#
z*|8fu6L1w!jX*ykbdWQwTi8$DVbA@v;~m_C9T7KMBA`D&-l*9z*^1Mnam0WH@ZB{i
zZtJ;vk{v@ZwSq8RLKkIz$cEDh9E90%fPYc*onbi;?Fe(efx;^Ib>*5(#KB`J2RrXj
zADGRE<;nV{q!-9?$k9@;Ybx3}iMP%|k3~gOuyYk}n2WT|raKfcQe!=wM7T~*Q^;|3
zPbSdW+#A1GXGgxIlM{CzjRq!?H{|l9h29w(jwL93|0v{1Lp>ZdA4_0NBu`MxmKJqq
z;yfHhNi0cJ%2pI`mn1!;)X~14_;dG3kGn<YCRS6U>we|=Oz<|m#P4)7uo%_ZHLSDV
zOZDd#{`H{+upou#1-jj_)bSsfVf+V~`QO6Kdbx5%r=Ve596^}iU(9TKLel+bX6XMf
zX4V`%Po=n}e6QO6BlaC->!<%ottIoX*tg|y3GRY#(>S9T4-dzEK5<yegna3l#Ay3F
z_SMIC`D6NLVoa&V^j*pu=gf4-?@bk6OzhP(xfSVM+wk{J%jNX{$PCz2uNTTUGnIca
zQyO?FphiGaapr&__M(%$A<?sUIqY6rBI9TtKw@yO#_o>y2EXu(Fp={<_T+p&b;S?u
zh`cVfj7uB(Ei*M5Ch*lc_n$xiVkWAcdjGPZL3&R;wz$6PqV-?QT>p>ERQ*3Pqx>Jt
zDEyllqwjA8hB8I-0nmq;8KIi$b`G5cpr%ZeBwyFh(yS0_^`X4FL>{njnSpW>UjfiX
zm;(GOzrsNt;@hA4jrJY-){&=$8ol&zJno}LGV{wCWcu#OW$rbD@%Z5hLzofv1aM1$
zsw1I4KtA+L0x@{RQaa28O#G<G{W)VdBB-DPtUIT9kjtJ;7;;4bP7l->2Jr!Xr$Ug!
zQ#A4&`T{1vZ~PVd&d`(U7=fuHf^8E%F7!Z_nL%X6PL2G^Hjf0zln~B@;82kD5%??h
zJ;8L`3jj+}z<mjS!F*6CM7~yZoP#_r3!08f=40o2_$DR?8~1hNWaU_tItRPT+lIwN
zBmj@sL+r2A_kNw{^gHzp-aZ-)t#N1i)*0!Odt)>{IkG!<rtj2Oflto#^xjyNPfqlm
z2Xp`4STTn@;gu(C<9HN>Pmc20T{37|iOM^BZt!vHCMBlZ$t`0CwUf`|u;_ZzGgOY2
z@88S}{l(134m01UQO`*$#1~+pP>Ih!F!T2p#{Y{t^WR$~%~Xq)HL<BSB;xW&|5Tc7
zN-Hm3P5i4gd$??+o+SBf<pp(h)zHe0DaOo>DwAfNdXl?n`Z*qjx#Hb6wIsvKqkh*$
z34c5mS$Qq7=Cu%2@)t5TK5}D5+uu$->%3o{{Xd*K&FQ+kX~aeI$VR?i@%eePyWw7(
zqYbpXQqd(M+nc^eTwig)Z|_azO%eEY0iAy_^E-0G)xGi9Z!lxphhf;c!8YJ8i*jMi
z@026EFT~(|N;SXum(C=amarYqpXw6?-0C+OCatbVFa5cHGGBSnicy<-KOSW`9rAZd
zvNm~}Z)VwSer4$Ww^L`3dEC|(q;`3aOIN4L*{4>XrBWZ8F~ltBp=}104o-)1)PjJH
zAf{5sp)oSB&)4qV(@)c9l9&yJevm)OLtECVtX2?U!beT=ZQc~&hDTQ)npKy?1C}Zm
z0)&VBxr4cj!;z26VJE%v_^mTbf+Z+(k0i+Uk?=!h`1A}@9~^@me?s^j!q>6f`rHu+
zrv!Tfct=6LnRyGm?|Fn-agQzA=YVGlP!(9twHqPIYXi!j*BrLray#O10_W_2IF=E<
zp&wD(eL0|X&dlUMO7;5fU6i{X>_d5q#k>>9;1#l<<cF*{jquHkxR9Jv7{C+>kt~R8
zVuGG|DAZk0HX}J73kl|8uUu$Oo}3`prVf=XmwmS6%Lc`%V}W1}HtT(>Lfm(=#M?%B
z&#@qJIx4@C;zR-cIy&c-r|g4GuKf38!cmL++}_XZ#*cJz+&7-nwCRLsuWYA_`$FU#
za^CM!3_6Fr>O1#+a-S=kPMG?B^j+3L=aeMA^Az<RQzr4ronCmDU8P+6oVsP)#OvmC
z-fcKPi8xJHd7k{GGp$`CB~O7WSNqv_x81=1(wPjW^2C2&=6n4Zfvuq>6c5jTpQIq*
zWcXjJ&DOaPI?mN<LjX>DS@}s6>0p2hje$8IfMsrOs-p)EAVW=rn&DrcV;X*DSjP!P
zF4}$Xe!>ZM&GF%z^6K`DX1*5**Sr1AFQ=2qy4@VIcU8UVdaQ#Zw{3J`<g3H$gUVmx
z{fr^E*X3@GKeYS6Ny;C&x!xMHTp5!f=!H9!>Cd<KMft^j?lSC3YBqhmd&v^X9ClE$
z`;Z*Zr;QGY;_L6v_K94wUyI)j^(Z2l_Umzl{T+9R1MMCfm9abC6LZL??FMmLUyXwH
zEstBL>!f9!l(+Wv_R}rAJ>=Fzk0!<Ni<%ZsZl2rzLwmwk+B-A&R%PRl1T8IZHhf46
z1ePFLMbgQ>RC(&rpRP?2#y@sLT2u4ygitcu;qK1we0cEdbh7KWtY}h{YKE<=mEjyu
zzEu{(TG@Klt<GafGH<gU3RU4nbCjyVzt(^#0F^;jkbZ&g0JwDn?f`;p<pbtsTe?Sp
z*Mij&_5jW-03<bOVgM}kFzo=y^AZ(n8e=RlX!i$*l__fHwIou~C8IJ?P0f@V5C*Dr
zfDX_EH!Q4+-_+*nQ-fIo%=FU%{AL9Jm!0}v$Fo;^GNUR*i@XEqmP7iGy1@*ePMRxF
zt1<t}BX24lYypDrCzd>MWkWIGBUT!#HG^7#ZF+HkSGHwUb;-tOOBP-5jAmZ6GKo3>
zeHo<<<q@$ON=l$D#ZiK7kD}%lG$x5uz8y<^v}QBye{1ZlgW~9#g&!bzf&~Z=WP=4;
zVA)+@k>IWg4#8b_k%UEp1cFO~y95#v++6|$XYt^+KyY{GlJEWQt+(nvRrjr$Kj!pw
z&FQLBJvDv$ce>4%-V}kp&6X;z;IFDP${l>x9eY*y!Ip$a5VzjG$H=cu-#J1^-!-Bs
z1r}$Kl~N>mK^Vop;HrE9+`|@VT1EON4J!JlW;c(Rl$d7pG_hNK?O_h8iopOS*AiF^
zhneR~=~GKxh~zvJXa_6yS|54#JDuOkQ+1c_P@wzu{C#^;s8%%7N=!e7?Ui(LQ5ZMS
zqyaM%vDCH%aRmC_({0Wu(T!EkCMrAB!IchD4mo?Rixm5pxSKI?<@7zUj_Sj;_oK~=
zAcD0qdk-5|CUx8{3{gVrJ|@xV2-<_P1Q-1%XKp7H$gt~i*P_PVDmBj!q6PK%o4vQE
zEdo<_&HcA$TBj{FQ+M;0cUMAJV%^(!S><;D1GmJiS7LEfch4>Ef?2OxKpqL-8d35!
zX-?4Fx@GqIre|{=DI>9xdlXINNTwjrd`4yat)Jns92|Xe&@mCMav)Z$yGj2KKK&2K
z0Em~5?>{~grL6*=5hQ8a(y<}N7zwbCSqj#q!jbR6aha^P`OslR7pn01SNZdq;OnbH
z)a0tw=YYt(Vedxjs0_EWiNUU9hSNc3?e`RaN|3Xec`pa1TLk_(^~~A7oSJqC(d2cl
zeVcZAV=fYZwj*`M>!fBJbJRZBk{*maxtwMHHL;UqsGis88+JGFt_!6aHg)82^=>)}
zjIoxtvjK#?_iRz_Jj^M}&GKDxo89e#f4$}iln?qXSb0S^{nxGIU3^&1%IShP+VZ?{
z8YJ^wCQtMFC~nRgAjA*Fni<rb&v=`+!#lpD-6;y(vtsFjKJ2Sv-=5z)X;tH$JaEoa
zgn<Z73Q>H;mH3Cm_;u&l-5H8I;YiJ^@j|4D!R*JnK3|EC*so>N(JotXbEnz!U*&HK
zC;Awp+V6JRTb~c|=qzwwglS!B^a}KuJ@@}ZgF`LN$A<mpb1N<tjfvXxc-0_+6Ap#(
z&Yymt!X!0o6mcFCtI+4G{-VU0WINsG{W)XP`zj|)f}&julUkoD=?5k#9O3mtGKdDp
zEKfgBH*iK=!GNR!uVyT*oNY_IpR`P|nimjkKlxyj2+QS7wS>I5{3j1HAfmwOiIPT3
zlup=8<JCgyh6{vU^_yTTj7F1Ggdm##VU@+C9GJBMyZXmYAe}kkqu$;k&cz_m#n8S*
zc(t@i#E+1KttHxrgKZOn9<A09`Z2W%ORRNOL~=k6Vxg796xY{<rV$tleK}dWUGEM{
zrlRW0O@#%ORyXj$YHGK@t1P)G5DspKNCQ!lhi6;Lm1IlUd9K6*gU;>}S~!(Ueo7+Y
zHN|f&9I%cEgOrC*lnhT;;!poneOLPFcg0(a#?FR9iD8?bxK8or4CNYzuU>KS)MC_Z
zwqaawuKq0RZxvdkSbLZmHaO5)yb+-c=)W5M@)R|TX=l4i$t#5dXHVI!TD2Naqy;0|
zle|UNemSj2?JO4RM6~LaPzO|?MFm2j-#G(uaoZb)hp|u%t<hq8rP8YH#Dx;kL0)m)
zw(Qnl7tJp|Ykjw`>x$Z*W!lMWIu4;Loiz_nORz5J8L0SuoXfeYkYx4Uwq}k+Y;{$z
zg}MKN6XBY89cZf^1?fFVCP@3ZT<`A|d}YU*c`0_ajqRMJ%Tu9^jIV0b(c^3!&_}C`
z6YQ01p9|T4gqLe0GppL%^*FCLzfmw-=DsPvWwY=}mtp?S#hBg8NajZQ*`z$=VX6#s
z?Y&@tkt~IavDKOs|9QB)O+`o`ceuQ+B`N+E7h_R3<A}D$dQmf-tP|CqYU2jH<j<{$
z%0{G0Ce|@yCnr+4bLMHgsjoQs&AP_&rDH$=!`2e<9Ff4IfB2gG6H5X5&o?~Z-{-$_
z?$g3YoQ=VXJN}*gfk_-;zw+YRtF<(WPE$UN%Gf=?fc*_bA1P=T<l_#RUt3+TPW7Yi
zdsk+T&840Mc(EI8Po@X;UQP|Z-<z9VF?=gD{m!$py86W9tvAV_l+MmJvr~m*vt#PU
zz~>sr6X*P$<P#`+)t-viR}%*3D?8sS4Jd7V+(=2(Epl^bQ7z|?#l<LfquseB2fv23
z`OOo}r9`^UZ}tp<_3jU!vP}zZMXfs?Q&zkz6XbjeaTM)m?0ClPr5IlS<J(2}{O{r9
zz?Hc*!KvkHQMY+dASI8Jb6SwvYwtB+M$j~o$`!X$i{?62gT{id?sw9W83$=c;^NYy
zRcGHyvjfBBr<+^W@Q>f%9UKM4)#fcF+okY@qM8I3rg6)<0|$e<n(C#9ns(*K;*ZVF
zVn$5ij*`Ksk*3NqJZ2N-FibQVMx?kTJ5hr;8d1L_j>cr){MwJ0#O8ZQKxC1-RR{<h
z2+J3{G9Bl(3@rM(6hR`ma*0EAm^<KVGOc6HX|l`2?yoVx;?sFeE|{mPxl}q5k*z1Q
z&((`x!nQj?%m0%jh@Jv0JDT6<0)cF)GZpLQ1zDjoY-~nLrR-${mj(ZnbJASd6;m?`
zJdnesImL#peeqF8&|XS~app6;-sO{u?xW~pGC3zfwDhHcoC$ViFcKrMf^&SYqeGs^
zbVFlA12bg}MFlQBDOpYKoZ}HVtY*I1?WK9%U5|`;j?E`ELYq`vP6l!(2(7w#PUrS7
zScV)4I`_Lv-SJPuF5WyD3zeFGdTBNun{|gg#e<rUKgqJ{cW3)5l$(b)q?AUM=^1Lh
z;A{o5)ukl2X1J(9gH;io_(vPtqaHjq@)|F7&Qk|2TL+nXQLQ}Gi3JxW*)0$6pjIQ6
zE}D6!2&s=aPaoq)1b?eaoEmo*Ex+FyL(-$pJvo|McC#bO|G_=}Jw2@M0=IZ;evjj^
zAuOykEp>q)ZU`?oA3r+*kJLSn=LWxjaxebxp)K4=`kvYYut^K?@$x}Id>~#Bln)99
zbMk^-@bbR6*HeL8{9h`XE~W^CrNuo0XzJi<Nx-A7DWl6R`_{q1%+$&0uPvH3wyuEt
z>t8l;0kkb$T<@m_fVn{s5ERD84+R7HxcUFv*#BoDK-u=4CE(sF2#=F367I?kcd=#%
z*dt8cY+Nl(0q_3*EBLt~+`R06fkR6ti@#w6=-(j{O%H@6fJe>DPQ%TSfJYSox$l!L
zYwP0b1^`3<r)4&P4+i^>Pit4{8@Ou7k@-xNBz4UxqU#p&ziaxJNnx@^MLuB*!!>1?
zneL9!iNU|V+Ub+G9)Km7OH>oc=D<Wn=Zw$1=VB}a$?kuc%XvwSVoF=_%mbCQses<c
zZAj9XC!L{GSRwu*@-MO-<(Xp96bVH*bokZJkf?q7>Ku;nXYrJj$AUW&qBe+q8VP1W
zQ&XkR39d9^yOl-d^mK$aQZC#COLy_hK1>c>ju#XtjW{3r;H;0oC!@(mjvdmz%JoIb
zle{uSA>b2*f~}xtsKp~>J{ro5mT}?5?Ta~6W&SLQGa*heE<?f|u%&9@*v1wfVIXes
zjsyQeTL3jpMv%ite#RGwCqzBeZV%Y>e`Lw2Wk#*cl+;9i>RK+aVm@1|&;lC(KVl!N
z$sXqF4eU{_p~xg92<1>67T4alGT!Q?B;wBftIK%RJSGhEer95~@+rg;smM#sZYjSp
z^phk^f@bCC>e<TADV;^J&n7TU_B^$+*F=ahKpaOQ^YJhY^;LqVH4g|L<3KB~M`KcE
zCO_u^Mw*W^+se#ppQ87h8E+mM*~g3W3&CACFRKBStZ*3ztnL~iXh_*bGXP$8bWrS5
zz+}33U$8}P^ZJrsO~|Cu_M$X^!6CxyCroG$26&8hv`4K+9NkklzaBY9xJBW3<`?_r
zgCXdn=t^cIt_iFOH|;Bm{`IGMd7(e19l;OOVx<x)yu?M=Tfqq?O^q#S*}M-t)k@S%
zU^G>%A5UK66&+LwOHF*}Y=4iLf%;C*mb5~m2p1KkrY(w1)54*3Wqz{$BkyE=h&q9N
zE7yO`-@R;L)@~V8rrdDoeEi&u4gK4|Eum{#%$$@<ip10J+nw0Z6S<+fTybBB4b}!r
zDEUwn?TpsA9zqgdsoTM7_yyJD7u49{a&c@l=hO<RD23=7xE-AZw*6ZRrs!=QYvzI}
z;Y_9|axWhmEqmADPwdTU`om8{<?)^xinwPKV|E0QJYttjD4T!OeOXKwmu3|p4=uP}
z(nZe6=4BYjBnKde?C31zE|Dy&@2ojdIV^)*hU`ip?iWL8B{YM!fwZo$JxgQ}{NoA9
z$%i-@I>@0Sqj#)ot=Vv997JD6SB5dDkk%x<mA{KxS-3)y438Q(7G}ivmGJ;~!9FF=
zFRc~*GnJT*Fesd8JSFr)Q5GowR6E!%3TU(wA3Po!?-{0@oLU=fn8qzE`IZ<7{a&iq
z<3`v!5D8JL4QUou%V~d8n8~LNksHH*-mlP2N1;@iHSrqJ3UY4GkidL^EBduE*!?X>
zl}=r{hae_a_IkObi+$T;+FzBbHYC_&WwJ}HSlJXT^=*Nw+&Qjsxzy*hOW9nT_;_{*
z-3Ot{-rN@06F^dG)_mIjmHtT_;QpUYDk}StMbditj(}zIAkhbOTEx~0Ij^!hu$6&{
zL$9BfQQ)`%eh*u%JBQOAFTl_}qz+mHZ`J3KA72V**#M;QzUw{N#***c>}h98Zdonu
zf_nwNrr9+%%$z9JY}@f-Wuf1rfPQM_(tD-1L@3L||5EwGM*;zsJo32w!hPL*x6XB3
z1~z^SSGEysFf;xNX()N^xKsvjb~*hyf&wr;nZl{OF0DWUK5&r*$E>dUQzh#?A@}p>
zjKxn9f*ril)WIribiUaH(Q<Yx-q1$aA8%>yjtkEdgB#o2*zHK_GQQ=jYWFW(MJLvY
zRvCAI%jleCcgfM?X%f^WecN|+5ff(x+{-M+pYm$2%ME_re4TuqL%DJLWwt)9%181$
zy274qu#cujs4$&Sja@N!0i33vj5_e4D;OWXE&SjY7jL6^#Nk;v9s0xeZJhdfF+@q1
zBRFBx0$={5@>l?pM|wzr0U+U;$D{{BXU0wO4>YA~BIQpqibA65mGmRG);?(<1FGIt
z7nZzbioeS33*|x`Y4;9$=_qK@@K*!_z58_`+6kX=)hCsy4@9qMvIiCH#Y}6y#)Qma
zY1=t~7FA_AKti#>>}a_Z64Cg4KSxYLfVBjDkhC~ixCF&-@+iD2qGwO!T#|VoN-ncU
z&ni$pT1=yfoMzf9g^Pdv#eUwKDVcx1WcOl|TFwaleW*E-OU#{q2T{rt&(>NoLMW*u
zZtgZ_KVtLdTchl|w;5r_2_TD2UW%s%`WTCg1e=Xhsa%X1eO*#-crI-%lJTUog^%<{
zJmo}F?JYO+6yXj&lha)hRgNN*#$49**|LN>lV^)`TC|5Wh@bh=MTv|&kE)HhY*lja
z!HUO|zL-MY3dfB$U*{|{O36Hn*1=A*izxGNti?tL7zUX%q3A{<Qxt8Jr;%L7gfO)P
z#IQ75H@>M#HAb&1(#yUk;ac~-aKJ)NqfNqEc+ZYq^WvV?d<1;4XLzIFOswhJ^ltq^
zxM;D}&AW;`iX~%o0;1+kqW0)@BN0*0&9eMUgN)@w=zblX`K+skC$;A{v{A*B`GCs%
zRC>8RQ)hW&<$7w{ZW>SBx8BalNAC7nkGtiQQqlEVdY*m4B;OwEL-D9TFFd#h*G4at
zjk;xxdhB7JHDIx>b)S^#V%!fat`FhWhX~C2^!yh7OW{1<s~r?Wu=RH3)KaBPUUvH^
z{~cJhpz-&{`wPiiF5{ljB_Sb|4~H(8cP|AFU3_XD(6Szi9S(l@<vmV9)3@phj_vDt
z`qT1llMPMXr9Jna(0Y>LkjKp>ia~DgLHf<;4G@-XsDMvl{*<o7YkiWEt_nNFhQp$8
z_glNG<eJ~U2Qc~%e%7&ehL*hH>kn^yo0@QFNwR-5J`Z#fm^zg4*;z!tYh6A+??7`l
zGRld;8yLq64-gyh@{apj{c0pla`%)+7S*U|T^%*nqfx6m<}Uaj$BLwWo|P}lu9F>W
z#y)o&H>u!5*!*6(QLN<H-KQ=E_z9BHn$CEHyE*OV^m1`RWB-qZ!MUHP;<@H6y){2I
z-J!P5>7Q(G{8ld|>T6rj%ex9amDIl9p3Pa|EvsTt+@x*3dz~8cr+rFh*sOu7^LKSU
z-YYorSl5c_nxhdEiL<ro^T587@A6nSCndL*2g0wm8rDh%h@$bffuZKWfOI-?n?#1l
zs)Y|#HPG?=!Gb?24q^Bv69p`E*6wD#?Pp?iw97!))KWp{mVsHnSd6Z-mzin*^AI}t
zyQR9=fTvx-U5luVjp}f+-l9S3y&kNx_L^wt7mh`txYACk$T>~#d6mI*<j#aKvFbvj
zIKu+`XxQR_c{!6Kd%=I8uSQk!K}+OR+B8j-8e%PR^x%-jif~Ff_1O?>YU<4I2}`V4
zo>-P!8AnVVUp@n9xTR}zia3W_SHbU<Mm-cf^gNl?i4|P?yJFQYg0GNr_sS96kd(Hd
zg7%x~pruT3&s4vddz34ryZfu)iibF(N$di>empfy$rX!S`am(Qf0^Gueqm<ECdzo_
z?%0OKW&}x$)vG9ck1sqtK0LK$oV5lM6@j&t>{iD$KKx<&`1UbFInhhJ>RUImWzuG3
zRea^kIh8zA{&KHqt{bm#rm?b>4q|NOupGm)ORU^yh@TvrA-K35?VhQ9O!*X}b#2*F
z%GaFEn`j+?%`krvT@xJJ;qvjm9A3oAma|9BV}}cKm$G`JB_1L9<DF{<evD_W*Fdi0
zPp})JChMr3)BwpMn6BseYOX)b$K4eN=sZZjP}6lmB;siv9g5}EwtISPFp>c~K-)YA
z6`>EXT$grNkLx=!pdKV#za`{!ddzWGbLUVSP;W!mYe0O}JQ=5Ogx36Aijmw{g;lWf
zz<c{I({m|KeIsD2q|Q3NP90|#EQ90S>f>io8PEe$n@uHXVCS}zYKy>nGFaZc3K-h{
zlcu2odb2rQ#rmk6sv$2DR@{WP68AfJc8=6#@H%~TG#Nz0;9b+1H`&Z>dd}3)9D0U;
z+_u?-ih=5}0)DpW#1gV0uZ6*=mTS=Uz|gJ{#w>#rU50U_uG)!k&K<_h<m}Wx#7qB<
z5&kPc(0y%bMZlxrWMPQ}81MoFV1@)d8n&L6_jd$5IsgL@01N=#%U;9bZUBM50mkdU
z>Q-=oz~A8O??4)0AOeF5O7lxWpi(ei2?1VNSr|XBv@}GT7Xp>wmy(tcd<po!Rqkg|
zwsf*~vjOmd|8vBbZm5ATz?ACO!5j}6Gb1j(@sc;5Gp!qUt0<e>m=HJ_V&!H>5jp<I
z9UzdUU5hWn2v!cVuDL+nd4vOv9-J%r@nPe|WlfXWn`vx^JRYV5mT{c^s-C3SQl=TC
zpL|OFnPkei#j=CyRqY{++eNx+)m2hCtWlQ~8^jW3rXMG*rzx$~Pl94984DSO>!jEE
zxT45P5{qF==8KA<5}S6PUZ@qbdid<6ybu;B#y%`t)@SzODP}ozUDs!Akp*0JweB;X
zZ{Xw@{PLa0PB!|qg?sT%U4)P$SfXjmAB%NEDy_)<8jBU5W&MAzr>mQ(iyPAAeg#1g
QUI7S<fQ3ayO_t!l0Eiuw00000

literal 0
HcmV?d00001

diff --git a/docs/classifiers.tex b/docs/classifiers.tex
new file mode 100644
index 00000000..1cb65f6c
--- /dev/null
+++ b/docs/classifiers.tex
@@ -0,0 +1,282 @@
+\documentclass{article}
+\usepackage{amsmath, amssymb}
+\usepackage{mathpartir}
+\usepackage{geometry}
+\geometry{margin=1in}
+
+\title{Classifiers and Kinds: Definitions and Rules}
+\author{}
+\date{}
+
+\begin{document}
+\maketitle
+
+\section{Classifier Structure}
+
+Classifiers form a tree structure rooted at $\top$:
+
+\begin{align*}
+c &::= \top \mid c.n & \text{(classifiers)}
+\end{align*}
+
+where $c.n$ denotes the $n$-th child of classifier $c$.
+
+\section{Kind Structure}
+
+Kinds represent sets of classifiers with possible exclusions:
+
+\begin{align*}
+K &::= \emptyset \mid K \cup K \mid c \setminus [c_1, \ldots, c_n] & \text{(kinds)}
+\end{align*}
+
+The notation $c \setminus [\overline{c}]$ represents all classifiers in the subtree rooted at $c$, excluding the subtrees rooted at each $c_i$.
+
+\paragraph{Abbreviations:}
+\begin{itemize}
+    \item $\mathsf{top} \triangleq \top \setminus []$ (all classifiers)
+    \item $\mathsf{classifier}(c) \triangleq c \setminus []$ (subtree rooted at $c$)
+\end{itemize}
+
+\section{Classifier Subclassing}
+
+The subclassing relation $c_1 \leq c_2$ holds when $c_1$ is in the subtree rooted at $c_2$:
+
+\begin{mathpar}
+\inferrule*[Right=SC-Refl]
+{ }
+{c \leq c}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=SC-Parent]
+{c_1 \leq c_2}
+{c_1.n \leq c_2}
+\end{mathpar}
+
+\section{Classifier Disjointness}
+
+Two classifiers are disjoint ($c_1 \bot c_2$) when they are in different subtrees:
+
+\begin{mathpar}
+\inferrule*[Right=CD-Base]
+{n \neq m}
+{p.n \bot p.m}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=CD-Left]
+{c_1 \bot c_2}
+{c_1.n \bot c_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=CD-Right]
+{c_1 \bot c_2}
+{c_1 \bot c_2.m}
+\end{mathpar}
+
+\section{Kind Disjointness}
+
+Two kinds are disjoint ($K_1 \bot K_2$) when they have no common classifiers:
+
+\begin{mathpar}
+\inferrule*[Right=KD-EmptyL]
+{ }
+{\emptyset \bot K}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-EmptyR]
+{ }
+{K \bot \emptyset}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-UnionL]
+{K_1 \bot K \\ K_2 \bot K}
+{K_1 \cup K_2 \bot K}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-UnionR]
+{K \bot K_1 \\ K \bot K_2}
+{K \bot K_1 \cup K_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-AbsurdL]
+{r_1 \in \overline{e_1}}
+{r_1 \setminus \overline{e_1} \bot r_2 \setminus \overline{e_2}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-AbsurdR]
+{r_2 \in \overline{e_2}}
+{r_1 \setminus \overline{e_1} \bot r_2 \setminus \overline{e_2}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-Root]
+{r_1 \bot r_2}
+{r_1 \setminus \overline{e_1} \bot r_2 \setminus \overline{e_2}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-ExclL]
+{r_1 \in \overline{e_2}}
+{r_1 \setminus \overline{e_1} \bot r_2 \setminus \overline{e_2}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=KD-ExclR]
+{r_2 \in \overline{e_1}}
+{r_1 \setminus \overline{e_1} \bot r_2 \setminus \overline{e_2}}
+\end{mathpar}
+
+Here, $r \in \overline{e}$ means $\exists e_i \in \overline{e}.\ r \leq e_i$ (containment via superclass).
+
+\section{Kind Intersection}
+
+The intersection relation $K_1 \cap K_2 = R$ computes the common classifiers:
+
+\begin{mathpar}
+\inferrule*[Right=Int-EmptyL]
+{ }
+{\emptyset \cap K = \emptyset}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-EmptyR]
+{ }
+{K \cap \emptyset = \emptyset}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-UnionL]
+{K_1 \cap K = R_1 \\ K_2 \cap K = R_2}
+{(K_1 \cup K_2) \cap K = R_1 \cup R_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-UnionR]
+{K \cap K_1 = R_1 \\ K \cap K_2 = R_2}
+{K \cap (K_1 \cup K_2) = R_1 \cup R_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-SubL]
+{r_1 \leq r_2}
+{(r_1 \setminus \overline{e_1}) \cap (r_2 \setminus \overline{e_2}) = r_1 \setminus (\overline{e_1} \mathbin{+\mkern-8mu+} \overline{e_2})}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-SubR]
+{r_2 \leq r_1}
+{(r_1 \setminus \overline{e_1}) \cap (r_2 \setminus \overline{e_2}) = r_2 \setminus (\overline{e_1} \mathbin{+\mkern-8mu+} \overline{e_2})}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Int-Disj]
+{r_1 \bot r_2}
+{(r_1 \setminus \overline{e_1}) \cap (r_2 \setminus \overline{e_2}) = \emptyset}
+\end{mathpar}
+
+\section{Kind Subtraction}
+
+The subtraction relation $K_1 - K_2 = R$ computes the classifiers in $K_1$ but not in $K_2$:
+
+\begin{mathpar}
+\inferrule*[Right=Sub-EmptyL]
+{ }
+{\emptyset - K = \emptyset}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-UnionL]
+{K_1 - K = R_1 \\ K_2 - K = R_2}
+{(K_1 \cup K_2) - K = R_1 \cup R_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-EmptyR]
+{ }
+{(r_1 \setminus \overline{e_1}) - \emptyset = r_1 \setminus \overline{e_1}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-UnionR]
+{(r_1 \setminus \overline{e_1}) - K_1 = R_1 \\ R_1 - K_2 = R_2}
+{(r_1 \setminus \overline{e_1}) - (K_1 \cup K_2) = R_2}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-Tree]
+{ }
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus []) = r_1 \setminus (r_2 :: \overline{e_1})}
+\end{mathpar}
+
+\paragraph{Exclusion handling:} For $(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2}))$, using the identity $A - (B - C) = (A - B) \cup (A \cap B \cap C)$:
+
+\begin{mathpar}
+\inferrule*[Right=Sub-ExclAbsurd]
+{a < r_2}
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2})) = r_1 \setminus \overline{e_1}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-ExclIrrelR]
+{a \bot r_2 \\ (r_1 \setminus \overline{e_1}) - (r_2 \setminus \overline{e_2}) = R}
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2})) = R}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-ExclSubR]
+{a \leq r_2 \\ a \leq r_1 \\ (r_1 \setminus \overline{e_1}) - (r_2 \setminus \overline{e_2}) = R}
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2})) = R \cup (a \setminus \overline{e_1})}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-ExclSubL]
+{a \leq r_2 \\ r_1 < a}
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2})) = r_1 \setminus \overline{e_1}}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=Sub-ExclIrrelL]
+{a \leq r_2 \\ r_1 \bot a \\ (r_1 \setminus \overline{e_1}) - (r_2 \setminus \overline{e_2}) = R}
+{(r_1 \setminus \overline{e_1}) - (r_2 \setminus (a :: \overline{e_2})) = R}
+\end{mathpar}
+
+Here, $a < r$ denotes strict subclassing ($a \leq r$ and $a \neq r$).
+
+\section{Subkinding}
+
+The subkinding relation $K_1 \subset K_2$ holds when every classifier in $K_1$ is also in $K_2$:
+
+\begin{mathpar}
+\inferrule*[Right=SK-Sub]
+{K_1 - K_2 = R \\ \mathsf{isEmpty}(R)}
+{K_1 \subset K_2}
+\end{mathpar}
+
+where $\mathsf{isEmpty}(K)$ is defined inductively:
+
+\begin{mathpar}
+\inferrule*[Right=IsEmpty-Empty]
+{ }
+{\mathsf{isEmpty}(\emptyset)}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=IsEmpty-Absurd]
+{r \in \overline{e}}
+{\mathsf{isEmpty}(r \setminus \overline{e})}
+\end{mathpar}
+
+\begin{mathpar}
+\inferrule*[Right=IsEmpty-Union]
+{\mathsf{isEmpty}(K_1) \\ \mathsf{isEmpty}(K_2)}
+{\mathsf{isEmpty}(K_1 \cup K_2)}
+\end{mathpar}
+
+\end{document}

From 48d4494ddfd57525b1a5febe99833b2ad46097f3 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 15 Dec 2025 18:41:59 +0100
Subject: [PATCH 49/71] WIP

---
 Capless/Classifier.lean | 298 ++++++++++++++++++++++++++++++++++++++++
 Capless/Store.lean      |  17 +++
 Capless/Term.lean       |  68 +++++----
 Capless/Typing.lean     |  15 +-
 4 files changed, 365 insertions(+), 33 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index a853235b..c229ed76 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -34,6 +34,13 @@ theorem Classifier.StrictSub.weaken (hs : StrictSub a b) : Subclass a b := by
 
 theorem Classifier.StrictSub.size (hs : StrictSub a b) : sizeOf a > sizeOf b := by induction hs <;> (simp; try omega)
 
+theorem Classifier.StrictSub.neq (hs : StrictSub a b) : a ≠ b := by
+  apply Ne.intro
+  intro h
+  have hs := hs.size
+  rw [h] at hs
+  omega
+
 inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
   | base : n != m -> Disjoint (child n p) (child m p)
   | left : Disjoint a b -> Disjoint (child n a) b
@@ -1351,3 +1358,294 @@ theorem Kind.Intersect.assoc_superkind : Subkind (.intersect K1 (.intersect K2 K
     case empty => simp; apply Subkind.rfl
     case union ha hb => simp; apply Subkind.join ha hb
     case node => sorry
+
+@[simp]
+def Kind.contains_sup_of (exs : List Classifier) (c : Classifier) :=
+  match exs with
+  | .nil => false
+  | .cons head tail => c.subclass head || contains_sup_of tail c
+
+theorem Kind.ContainsSupOf.lawful : ContainsSupOf exs r ↔ contains_sup_of exs r := by
+  apply Iff.intro
+  . intro hsc
+    induction hsc
+    case here hs => simp; simp_all [Classifier.subclass_is_Subclass]
+    case there ih => simp_all
+  . intro hsc
+    unfold contains_sup_of at hsc
+    split at hsc
+    . aesop
+    . simp at hsc
+      cases hsc <;> rename_i hsc
+      . apply ContainsSupOf.here; simp_all [Classifier.subclass_is_Subclass]
+      . apply ContainsSupOf.there; rw [← lawful] at hsc; simp_all
+
+@[simp]
+def Kind.disjoint (K1 : Kind) (K2 : Kind) :=
+  match K1 with
+  | .empty => true
+  | .union a b => a.disjoint K2 && b.disjoint K2
+  | .node r1 ex1 =>
+    match K2 with
+    | .empty => true
+    | .union a b => (Kind.node r1 ex1).disjoint a && (Kind.node r1 ex1).disjoint b
+    | .node r2 ex2 =>
+      r1.disjoint r2
+        || contains_sup_of ex1 r1 || contains_sup_of ex2 r2
+        || contains_sup_of ex1 r2 || contains_sup_of ex2 r1
+
+theorem Kind.Disjoint.lawful : Disjoint K1 K2 ↔ K1.disjoint K2 := by
+  apply Iff.intro
+  . intro hd
+    induction hd
+    case empty_l => simp
+    case empty_r K =>
+      induction K <;> simp_all
+    case union_l => simp_all
+    case union_r K K1 K2 _ _ ha hb =>
+      induction K <;> simp_all
+      rename_i iha ihb hha hhb
+      have ⟨_, _⟩ := hha.union_l_inv
+      have ⟨_, _⟩ := hhb.union_l_inv
+      apply And.intro
+      apply! iha
+      apply! ihb
+    case absurd_l hsc => simp_all [ContainsSupOf.lawful]
+    case absurd_r hsc => simp_all [ContainsSupOf.lawful]
+    case root hd => simp_all [Classifier.disjoint_is_Disjoint]
+    case excl_l => simp_all [ContainsSupOf.lawful]
+    case excl_r => simp_all [ContainsSupOf.lawful]
+  . intro hd
+    induction K1
+    case empty => apply empty_l
+    case union ha hb =>
+      apply union_l <;> simp_all
+    case node r1 ex1 =>
+      induction K2
+      case empty => apply empty_r
+      case union ha hb =>
+        apply union_r <;> simp_all
+      case node r2 ex2 =>
+        simp at hd; rw [← Classifier.disjoint_is_Disjoint] at hd; repeat rw [← ContainsSupOf.lawful] at hd
+        cases hd <;> rename_i hd
+        . cases hd <;> rename_i hd
+          . cases hd <;> rename_i hd
+            . cases hd <;> rename_i hd
+              . apply! root
+              . apply! absurd_l
+            . apply! absurd_r
+          . apply! excl_r
+        . apply! excl_l
+
+
+-- inductive Kind.Contains : Kind -> Classifier -> Prop where
+--   | union_l : Contains K1 c -> Contains (.union K1 K2) c
+--   | union_r : Contains K2 c -> Contains (.union K1 K2) c
+--   | subclass : Classifier.Subclass c r -> Contains (.node r []) c
+--   | excl_sub :
+--     Classifier.StrictSub a c ->
+--     Contains (.node r exs) c ->
+--     Contains (.node r (a :: exs)) c
+--   | excl_irrelevant :
+--     Classifier.Disjoint a c ->
+--     Contains (.node r exs) c ->
+--     Contains (.node r (a :: exs)) c
+
+-- theorem Kind.Contains.is_subclass
+--   (hc : Contains (.node r exs) c)
+--   : c.Subclass r := by
+--   cases hc
+--   case subclass => assumption
+--   case excl_sub hc => apply hc.is_subclass
+--   case excl_irrelevant hc => apply hc.is_subclass
+
+-- theorem Kind.Contains.not_empty
+--   (hc : Contains K c)
+--   (he : IsEmpty K)
+--   : False := by
+--   induction he
+--   case empty => cases hc
+--   case absurd exs r hsc =>
+--     induction hsc
+--     case here hs =>
+--       cases hc
+--       case excl_sub hss hc =>
+--         apply hss.antisymm
+--         apply hc.is_subclass.trans hs
+--       case excl_irrelevant hd hc =>
+--         apply hd.symm.not_subclass
+--         apply hc.is_subclass.trans hs
+--     case there hsc ih =>
+--       cases hc <;> apply! ih
+--   case union ha hb =>
+--     cases hc
+--     apply! ha
+--     apply! hb
+
+-- theorem Kind.Contains.excl_irrelevant_l
+--   (hd : Classifier.Disjoint r a)
+--   (hc : Contains (.node r exs) c)
+--   : Contains (.node r (a :: exs)) c := by
+--   cases c.subclass_or_disjoint a <;> rename_i hs
+--   . cases (hd.refines_subclass_l hc.is_subclass).not_subclass hs
+--   . cases hs <;> rename_i hs
+--     . apply! excl_sub
+--     . apply! excl_irrelevant hs.symm
+
+-- theorem Kind.Contains.change_root
+--   (hc : Contains (.node r exs) c)
+--   (hs1 : c.Subclass a)
+--   : Contains (.node a exs) c := by
+--   cases hc
+--   case subclass => apply! subclass
+--   case excl_sub hss hc => apply excl_sub hss; apply! hc.change_root
+--   case excl_irrelevant hd hc => apply excl_irrelevant hd; apply! hc.change_root
+
+-- theorem Kind.Contains.excl_append
+--   (hc1 : Contains (.node r ex1) c)
+--   (hc2 : Contains (.node r ex2) c)
+--   : Contains (.node r (ex1 ++ ex2)) c := by
+--   induction ex1
+--   case nil => exact hc2
+--   case cons head tail ih =>
+--     cases hc1
+--     case excl_sub => apply! excl_sub _ (ih _)
+--     case excl_irrelevant => apply! excl_irrelevant _ (ih _)
+
+-- theorem Kind.Contains.subtract
+--   (hc : Contains K c)
+--   (hs : Subtract K L R)
+--   : Contains L c ∨ Contains R c := by
+--   induction hs
+--   case empty_l => cases hc.not_empty .empty
+--   case union_l ha hb =>
+--     cases hc <;> rename_i hc
+--     . cases ha hc
+--       . aesop
+--       . right; apply union_l; assumption
+--     . cases hb hc
+--       . aesop
+--       . right; apply union_r; assumption
+--   case empty_r => aesop
+--   case union_r ha hb =>
+--     cases ha hc <;> rename_i ha
+--     . left; apply union_l; assumption
+--     . cases hb ha <;> rename_i hb
+--       . left; apply union_r; assumption
+--       . aesop
+--   case tree r1 _ r2 =>
+--     cases c.subclass_or_disjoint r2 <;> rename_i hs
+--     . left; constructor; assumption
+--     . cases hs <;> rename_i hs
+--       . right; apply! excl_sub
+--       . right; apply excl_irrelevant hs.symm hc
+--   case excl_absurd_r hss => aesop
+--   case excl_irrelevant_r hd _ ih =>
+--     cases ih hc
+--     case inl hc => left; apply! excl_irrelevant_l
+--     case inr => aesop
+--   case excl_subclass_r a hs2 hs1 _ ih =>
+--     cases ih hc <;> rename_i ih
+--     . cases c.subclass_or_disjoint a <;> rename_i hs
+--       . right; apply union_r; apply! change_root
+--       . cases hs <;> rename_i hs
+--         . left; apply! excl_sub
+--         . left; apply! excl_irrelevant (.symm _)
+--     . right; apply! union_l
+--   case excl_subclass_l hs2 hss => aesop
+--   case excl_irrelevant_l hs2 hd1 _ ih =>
+--     cases ih hc <;> rename_i ih
+--     . left; apply excl_irrelevant _ ih; apply hd1.symm.refines_subclass_r hc.is_subclass
+--     . aesop
+
+-- theorem Kind.Contains.refine_subkind
+--   (hc : Contains K c)
+--   (hs : Subkind K L)
+--   : Contains L c := by
+--   cases hs
+--   rename_i hs he
+--   cases hc.subtract hs
+--   . assumption
+--   . rename_i hc; cases hc.not_empty he
+
+-- theorem Kind.Contains.intersect'
+--   (hc1 : Contains K1 c)
+--   (hc2: Contains K2 c)
+--   (hi : Intersect K1 K2 R)
+--   : Contains R c := by
+--   induction hi
+--   case empty_l => cases hc1.not_empty .empty
+--   case empty_r => cases hc2.not_empty .empty
+--   case union_l ha hb =>
+--     simp_all
+--     cases hc1
+--     . apply! union_l (ha _)
+--     . apply! union_r (hb _)
+--   case union_r ha hb =>
+--     simp_all
+--     cases hc2
+--     . apply! union_l (ha _)
+--     . apply! union_r (hb _)
+--   case singleton_l =>
+--     apply excl_append hc1 (hc2.change_root hc1.is_subclass)
+--   case singleton_r =>
+--     apply excl_append (hc1.change_root hc2.is_subclass) hc2
+--   case singleton_disj hd =>
+--     cases (hd.refines_subclass_l hc1.is_subclass).not_subclass hc2.is_subclass
+
+-- theorem Kind.Contains.intersect
+--   (hc1 : Contains K1 c)
+--   (hc2 : Contains K2 c)
+--   : Contains (K1.intersect K2) c := intersect' hc1 hc2 (Intersect.lawful)
+
+-- @[simp]
+-- def Kind.contains (K : Kind) (c : Classifier) : Bool :=
+--   match K with
+--   | .empty => false
+--   | .union K1 K2 => K1.contains c || K2.contains c
+--   | .node r exs =>
+--     match exs with
+--     | .nil => c.subclass r
+--     | .cons a xs =>
+--       if a.subclass c && a != c then (Kind.node r xs).contains c
+--       else if a.disjoint c then (Kind.node r xs).contains c
+--       else false
+
+-- theorem Kind.Contains.lawful : Contains K c ↔ K.contains c := by
+--   apply Iff.intro
+--   . intro hc
+--     induction hc <;> try simp_all
+--     case subclass hs => rw [← Classifier.subclass_is_Subclass]; assumption
+--     case excl_sub hss _ _ => left; apply And.intro; rw [← Classifier.subclass_is_Subclass]; apply hss.weaken; apply hss.neq
+--     case excl_irrelevant hd _ _ => right; rw [← Classifier.disjoint_is_Disjoint]; assumption
+--   . intro hc
+--     unfold contains at hc
+--     split at hc
+--     . aesop
+--     . simp at hc; cases hc
+--       . apply union_l; rw [lawful]; assumption
+--       . apply union_r; rw [lawful]; assumption
+--     . split at hc
+--       . constructor; rw [Classifier.subclass_is_Subclass]; assumption
+--       . simp at hc
+--         split at hc
+--         . rename_i h
+--           have ⟨h1, h2⟩ := h
+--           apply excl_sub
+--           rw [← Classifier.subclass_is_Subclass] at h1
+--           cases h1.might_strict <;> aesop
+--           rw [← lawful] at hc; aesop
+--         . have ⟨h1, h2⟩ := hc
+--           rw [← lawful] at h2
+--           rw [← Classifier.disjoint_is_Disjoint] at h1
+--           apply! excl_irrelevant
+
+  -- : Contains (K1.intersect K2) c := by
+  -- induction K1 generalizing K2
+  -- case empty => cases hc1.not_empty .empty
+  -- case union ha hb =>
+  --   simp
+  --   cases hc1
+  --   apply! union_l (ha _ hc2)
+  --   apply! union_r (hb _ hc2)
+  -- case node r1 ex1 =>
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 7c6a9fe6..289756a6 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -56,6 +56,10 @@ inductive Cont : Nat -> Nat -> Nat -> Type where
   (l : Fin n) ->
   Cont n m k ->
   Cont n m k
+| intercept : -- intercept frame
+  Kind ->
+  Cont n m k ->
+  Cont n m k
 
 /-- Evaluation state. -/
 structure State (n : Nat) (m : Nat) (k : Nat) where
@@ -100,6 +104,19 @@ inductive Cont.HasLabel : Cont n m k -> Fin n -> Cont n m k -> Prop where
 | there_label :
   Cont.HasLabel cont l tail ->
   Cont.HasLabel (Cont.scope l' cont) l tail
+| there_intercept :
+  Cont.HasLabel cont l tail ->
+  Cont.HasLabel (Cont.intercept K cont) l tail
+
+/-- Checks whether a label can be handled in a scope of a continuation stack. This can either be a label frame itself, or the intercept frame. -/
+inductive Cont.HasIntercept : Cont n m k -> Fin n -> Classifier -> Cont n m k -> Prop where
+| here_label :
+  Cont.HasIntercept (Cont.scope l tail) l tail
+| here_intercept :
+  Cont.HasLabel tail l tail' -> -- the tail must actually contain the label frame
+
+  Cont.HasIntercept ()
+
 
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
  -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
diff --git a/Capless/Term.lean b/Capless/Term.lean
index 61598383..fa4fef48 100644
--- a/Capless/Term.lean
+++ b/Capless/Term.lean
@@ -65,10 +65,12 @@ inductive Term : Nat -> Nat -> Nat -> Type where
 | boundary : Classifier -> SType n m k -> Term (n+1) m (k+1) -> Term n m k
 /-- Intercept: `intercept[K] in t` --/
 | intercept : Kind -> Term n m k -> Term n m k
-/-- Unwraps a maybe. --/
-| unwrap : Fin n -> Term n m k
-/-- Unwraps a maybe, but with an additional handler for intercepted labels. --/
-| unwrap_handle : Fin n -> Term (n+2) (m+1) k -> Term n m k
+/-- Unwraps a maybe --/
+| unwrap: Fin n -> Term (n+2) (m+1) k -> Term n m k
+/-- value form of maybe: a returned value -/
+| ok : Fin n -> Term n m k
+/-- value form of maybe: a invocation label, and its associated value. -/
+| invoked : Fin n -> Fin n -> Term n m k
 
 /-!
 ## Notations
@@ -83,7 +85,7 @@ notation:40 "let" "X=" S " in " t => Term.bindt S t
 notation:40 "let" "c=" C " in " t => Term.bindc C t
 notation:40 "boundary[" c "]:" S " in " t => Term.boundary c S t
 notation:40 "intercept[" K "]"" in " t => Term.intercept K t
-notation:40 "handle " n " with " t => Term.unwrap_handle n t
+notation:40 "handle " n " with " t => Term.unwrap n t
 
 /-- Whether this term is a value? -/
 @[aesop safe constructors]
@@ -92,6 +94,8 @@ inductive Term.IsValue : Term n m k -> Prop where
 | tlam : Term.IsValue (tlam S t)
 | clam : Term.IsValue (clam B t)
 | pack : Term.IsValue (pack c x)
+| ok : Term.IsValue (ok v)
+| invoked : Term.IsValue (invoked l v)
 
 /-!
 ## Renaming Operations on `Term`
@@ -115,8 +119,10 @@ def Term.rename (t : Term n m k) (f : FinFun n n') : Term n' m k :=
   | Term.bindc c t => Term.bindc (c.rename f) (t.rename f)
   | Term.boundary c S t => Term.boundary c (S.rename f) (t.rename f.ext)
   | Term.intercept K t => Term.intercept K (t.rename f)
-  | Term.unwrap x => Term.unwrap (f x)
-  | Term.unwrap_handle x t => Term.unwrap_handle (f x) (t.rename f.ext.ext)
+  | Term.unwrap x t => Term.unwrap (f x) (t.rename f.ext.ext)
+  | Term.ok v => Term.ok $ f v
+  | Term.invoked l v => Term.invoked (f l) (f v)
+
 
 def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   match t with
@@ -135,8 +141,9 @@ def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   | Term.bindc c t => Term.bindc c (t.trename f)
   | Term.boundary c S t => Term.boundary c (S.trename f) (t.trename f)
   | Term.intercept K t => Term.intercept K (t.trename f)
-  | Term.unwrap x => Term.unwrap x
-  | Term.unwrap_handle x t => Term.unwrap_handle x (t.trename f.ext)
+  | Term.unwrap x t => Term.unwrap x (t.trename f.ext)
+  | Term.ok v => Term.ok v
+  | Term.invoked l v => Term.invoked l v
 
 def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   match t with
@@ -155,8 +162,9 @@ def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   | Term.bindc c t => Term.bindc (c.crename f) (t.crename f.ext)
   | Term.boundary c S t => Term.boundary c (S.crename f) (t.crename f.ext)
   | Term.intercept K t => Term.intercept K (t.crename f)
-  | Term.unwrap x => Term.unwrap x
-  | Term.unwrap_handle x t => Term.unwrap_handle x (t.crename f)
+  | Term.unwrap x t => Term.unwrap x (t.crename f)
+  | Term.ok v => Term.ok v
+  | Term.invoked l v => Term.invoked l v
 
 def Term.weaken (t : Term n m k) : Term (n+1) m k := t.rename FinFun.weaken
 
@@ -267,10 +275,12 @@ theorem Term.rename_id {t : Term n m k} :
     simp [Term.rename, SType.rename_id, ih, FinFun.id_ext]
   case intercept ih =>
     simp [Term.rename, ih]
-  case unwrap =>
-    simp [Term.rename, FinFun.id]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [Term.rename, FinFun.id_ext, ih, FinFun.id]
+  case ok =>
+    simp [Term.rename, FinFun.id]
+  case invoked =>
+    simp [Term.rename, FinFun.id]
 
 theorem Term.trename_id {t : Term n m k} :
   t.trename FinFun.id = t := by
@@ -310,10 +320,10 @@ theorem Term.trename_id {t : Term n m k} :
     simp [Term.trename, SType.trename_id, ih, FinFun.id_ext]
   case intercept ih =>
     simp [Term.trename, ih]
-  case unwrap =>
-    simp [Term.trename]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [Term.trename, FinFun.id_ext, ih]
+  case ok => simp [Term.trename]
+  case invoked => simp [Term.trename]
 
 theorem Term.crename_id {t : Term n m k} :
   t.crename FinFun.id = t := by
@@ -353,10 +363,10 @@ theorem Term.crename_id {t : Term n m k} :
     simp [ih, SType.crename_id, FinFun.id_ext]
   case intercept ih =>
     simp [Term.crename, ih]
-  case unwrap =>
-    simp [Term.crename]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [Term.crename, ih]
+  case ok => simp [Term.crename]
+  case invoked => simp [Term.crename]
 
 theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''} :
   (t.rename f).rename g = t.rename (g.comp f) := by
@@ -398,11 +408,11 @@ theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''
     simp [<- FinFun.ext_comp_ext, ih]
   case intercept ih =>
     simp [rename, ih]
-  case unwrap =>
-    simp [rename]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [rename]
     simp [<- FinFun.ext_comp_ext, ih]
+  case ok => simp [rename]
+  case invoked => simp [rename]
 
 theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k''} :
   (t.crename f).crename g = t.crename (g.comp f) := by
@@ -444,10 +454,10 @@ theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k
     simp [<- FinFun.ext_comp_ext, ih]
   case intercept ih =>
     simp [crename, ih]
-  case unwrap =>
-    simp [crename]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [crename, ih]
+  case ok => simp [crename]
+  case invoked => simp [crename]
 
 theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m''} :
   (t.trename f).trename g = t.trename (g.comp f) := by
@@ -489,10 +499,10 @@ theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m
     simp [<- FinFun.ext_comp_ext, ih]
   case intercept ih =>
     simp [trename, ih]
-  case unwrap =>
-    simp [trename]
-  case unwrap_handle ih =>
+  case unwrap ih =>
     simp [trename]
     simp [<- FinFun.ext_comp_ext, ih]
+  case ok => simp [trename]
+  case invoked => simp [trename]
 
 end Capless
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 379320c4..6f3fb7eb 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -79,10 +79,17 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
   Typed Γ (intercept[K] in t) (EType.type (SType.maybe S)^(C.proj K)) C
 | unwrap {Γ : Context n m k} {S : SType n m k} :
   Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
-  Typed Γ (.unwrap x) (S^{}) {x=x|.top}
--- | unwrap_handle {Γ : Context n m k} :
-  -- Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
-  -- Typed (((Γ, X<:.top),x:)) h
+  Typed
+    (((Γ,X<:.top),x:(Label[.tvar 0]^{x=x|.top})),x:(SType.tvar 0)^{})
+    t
+    (S.tweaken.weaken.weaken^{}) (C.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
+  Typed Γ (.unwrap x t) (S^CaptureSet.empty) C
+| ok {Γ : Context n m k} {S : SType n m k} :
+  Typed Γ (Term.var x) (S^CaptureSet.empty) {x=x|.top} -> Typed Γ (Term.ok x) ((SType.maybe S)^CaptureSet.empty) {x=x|.top}
+| invoked {Γ : Context n m k} {S : SType n m k} :
+  Typed Γ (Term.var l) (Label[S]^C) {x=l|.top} ->
+  Typed Γ (Term.var v) (S^CaptureSet.empty) {x=v|.top} ->
+  Typed Γ (Term.invoked l v) ((SType.maybe S)^C) ({x=l|.top} ∪ {x=v|.top})
 
 notation:40 Γ " ⊢ " t:80 " : " E " @ " C => Typed Γ t E C
 

From f40efbf2cabc52c3f59577528d63ae10cfda3a9d Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 16 Dec 2025 19:53:12 +0100
Subject: [PATCH 50/71] Add HasIntercept

---
 Capless/Store.lean | 50 ++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 46 insertions(+), 4 deletions(-)

diff --git a/Capless/Store.lean b/Capless/Store.lean
index 289756a6..7c32f629 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -108,14 +108,53 @@ inductive Cont.HasLabel : Cont n m k -> Fin n -> Cont n m k -> Prop where
   Cont.HasLabel cont l tail ->
   Cont.HasLabel (Cont.intercept K cont) l tail
 
-/-- Checks whether a label can be handled in a scope of a continuation stack. This can either be a label frame itself, or the intercept frame. -/
-inductive Cont.HasIntercept : Cont n m k -> Fin n -> Classifier -> Cont n m k -> Prop where
+/-- Checks whether a label can be handled in a scope of a continuation stack. This can either be a label frame itself, or the intercept frame.
+ -  We need to actually check the classifier here to see if they match. -/
+inductive Cont.HasIntercept : Cont n m k -> Fin n -> Kind -> Cont n m k -> Prop where
 | here_label :
-  Cont.HasIntercept (Cont.scope l tail) l tail
+  Cont.HasIntercept (Cont.scope l tail) l L tail
 | here_intercept :
   Cont.HasLabel tail l tail' -> -- the tail must actually contain the label frame
+  L.disjoint K = false ->
+  Cont.HasIntercept (Cont.intercept K tail) l L tail
+| there_intercept :
+  Cont.HasIntercept tail l L tail' ->
+  L.disjoint K = true ->
+  Cont.HasIntercept (Cont.intercept K tail) l L tail'
+| there_val :
+  Cont.HasIntercept cont l L tail ->
+  Cont.HasIntercept (Cont.cons t cont) l L tail
+| there_tval :
+  Cont.HasIntercept cont l L tail ->
+  Cont.HasIntercept (Cont.conse t cont) l L tail
+| there_cval :
+  Cont.HasIntercept cont l L tail ->
+  Cont.HasIntercept (Cont.scope l' cont) l L tail
+| there_label :
+  Cont.HasIntercept cont l L tail ->
+  Cont.HasIntercept (Cont.scope l' cont) l L tail
+
+theorem Cont.HasIntercept.HasLabel (hi : HasIntercept cont l L tail) : ∃ tail', HasLabel cont l tail' := by
+  induction hi
+  case here_label l tail L => exists tail; apply HasLabel.here
+  case here_intercept _ _ tail' _ _ hl _ => exists tail'; apply HasLabel.there_intercept hl
+  case there_intercept ih =>
+    have ⟨t, h⟩ := ih
+    exists t; apply HasLabel.there_intercept h
+  case there_val ih =>
+    have ⟨t, h⟩ := ih
+    exists t; apply HasLabel.there_val h
+  case there_tval ih =>
+    have ⟨t, h⟩ := ih
+    exists t; apply HasLabel.there_tval h
+  case there_cval ih =>
+    have ⟨t, h⟩ := ih
+    exists t; apply HasLabel.there_cval h
+  case there_label ih =>
+    have ⟨t, h⟩ := ih
+    exists t; apply HasLabel.there_label h
+
 
-  Cont.HasIntercept ()
 
 
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
@@ -266,18 +305,21 @@ def Cont.weaken : Cont n m k -> Cont (n+1) m k
 | Cont.cons t cont => Cont.cons t.weaken1 cont.weaken
 | Cont.conse t cont => Cont.conse t.weaken1 cont.weaken
 | Cont.scope x cont => Cont.scope x.succ cont.weaken
+| Cont.intercept K cont => Cont.intercept K cont.weaken
 
 def Cont.tweaken : Cont n m k -> Cont n (m+1) k
 | Cont.none => Cont.none
 | Cont.cons t cont => Cont.cons t.tweaken cont.tweaken
 | Cont.conse t cont => Cont.conse t.tweaken cont.tweaken
 | Cont.scope x cont => Cont.scope x cont.tweaken
+| Cont.intercept K cont => Cont.intercept K cont.tweaken
 
 def Cont.cweaken : Cont n m k -> Cont n m (k+1)
 | Cont.none => Cont.none
 | Cont.cons t cont => Cont.cons t.cweaken cont.cweaken
 | Cont.conse t cont => Cont.conse t.cweaken1 cont.cweaken
 | Cont.scope x cont => Cont.scope x cont.cweaken
+| Cont.intercept K cont => Cont.intercept K cont.cweaken
 
 /-!
 ## Tightness

From a790d92a1cb527319fe89dde437e7322a64aeb67 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 18 Dec 2025 18:06:20 +0100
Subject: [PATCH 51/71] Progress on intercept

---
 Capless/Inversion/Lookup.lean        | 16 +++++-
 Capless/Narrowing/TypedCont.lean     | 64 ++++++++++++++++++++-
 Capless/Reduction.lean               | 21 ++++++-
 Capless/Renaming/Capture/Typing.lean |  7 +++
 Capless/Renaming/Term/Typing.lean    |  7 +++
 Capless/Renaming/Type/Typing.lean    |  8 ++-
 Capless/Soundness/Progress.lean      |  6 +-
 Capless/Store.lean                   | 85 +++++++++++++++++-----------
 Capless/Subst/Capture/Typing.lean    | 10 ++++
 Capless/Subst/Term/Typing.lean       |  8 +++
 Capless/Subst/Type/Typing.lean       |  8 +++
 Capless/Term.lean                    | 83 ++++++---------------------
 Capless/Typing.lean                  | 30 +++++-----
 13 files changed, 233 insertions(+), 120 deletions(-)

diff --git a/Capless/Inversion/Lookup.lean b/Capless/Inversion/Lookup.lean
index ad725ad5..e31e808b 100644
--- a/Capless/Inversion/Lookup.lean
+++ b/Capless/Inversion/Lookup.lean
@@ -136,15 +136,27 @@ theorem Store.bound_label
   case label ih => constructor
 
 theorem Cont.has_label_tail_inv
-  (htc : TypedCont Γ E1 cont E2 Ct)
+  (htc : TypedCont Γ E1 Cin cont E2 Ct)
   (hb : Γ.LBound x c S0)
   (hh : cont.HasLabel x tail) :
-  ∃ Ct1, TypedCont Γ (S0^{}) tail E2 Ct1 := by
+  ∃ Ct1, TypedCont Γ (S0^{}) Cin tail E2 Ct1 := by
   induction hh generalizing E1 E2 Ct <;> try (solve | cases htc; aesop)
   case here =>
     cases htc; rename_i hb0 htc0
     have he := Context.lbound_inj hb hb0
     cases he
     aesop
+  case there_val ih =>
+    cases htc
+    rename_i htc
+    apply ih (htc.cin_narrow $ Subcapt.subset (.union_rl .rfl)) hb
+  case there_tval ih =>
+    cases htc
+    rename_i htc
+    apply ih (htc.cin_narrow $ Subcapt.subset (.union_rl .rfl)) hb
+  case there_intercept ih =>
+    cases htc
+    rename_i htc
+    apply ih (htc.cin_narrow $ Subcapt.subset (.union_rl .rfl)) hb
 
 end Capless
diff --git a/Capless/Narrowing/TypedCont.lean b/Capless/Narrowing/TypedCont.lean
index a2636445..71968493 100644
--- a/Capless/Narrowing/TypedCont.lean
+++ b/Capless/Narrowing/TypedCont.lean
@@ -27,9 +27,9 @@ transitivity of subtyping and the narrowing properties of the underlying typing
 namespace Capless
 
 theorem TypedCont.narrow
-  (h : TypedCont Γ E1 cont E C0)
+  (h : TypedCont Γ E1 Cin cont E C0)
   (hsub : ESubtyp Γ E2 E1) :
-  TypedCont Γ E2 cont E C0 := by
+  TypedCont Γ E2 Cin cont E C0 := by
   cases h
   case none =>
     apply TypedCont.none
@@ -55,5 +55,65 @@ theorem TypedCont.narrow
     { assumption }
     { assumption }
     { apply CSubtyp.trans <;> aesop }
+  case intercept =>
+    cases hsub
+    rename_i hsub
+    apply TypedCont.intercept
+    assumption
+    assumption
+    assumption
+    apply! CSubtyp.trans
+
+theorem TypedCont.cin_narrow
+  (h : TypedCont Γ E1 Cin1 cont E C0)
+  (hsub : Γ ⊢ Cin2 <:c Cin1)
+  : TypedCont Γ E1 Cin2 cont E C0 := by
+  cases h
+  case none => apply! TypedCont.none
+  case cons ht hsc h =>
+    apply cons ht hsc $ h.cin_narrow _
+    apply Subcapt.join hsub .rfl
+  case conse ht hsc h =>
+    apply conse ht hsc $ h.cin_narrow _
+    apply Subcapt.join hsub .rfl
+  case scope hb hs h =>
+    apply scope hb _ hs
+    apply h.cin_narrow hsub
+  case intercept hws hsub_T0 htyped htcont =>
+    -- From the error, we can see the actual types:
+    -- K✝ : Kind (the classifier kind)
+    -- hws : WellScoped Γ cont Ct
+    -- hsub_T0 : Γ ⊢ T0 <: S^{}
+    -- htyped : Typed (((Γ,X<:⊤),x:(Label[.tvar 0]^(Cin1.proj K))),x:(SType.tvar 0)^{}) h ...
+    -- htcont : TypedCont Γ (S^{}) (Cin1 ∪ Ct) cont E' C
+    -- Order of inaccessibles: Kind, CaptureSet, CaptureSet, Term, Cont, CType, SType
+    rename_i Kd _ _ _ _ _ _  -- Get all 7 inaccessibles, Kd should be Kind
+    apply intercept
+    { -- use Typed.narrow in the middle for the label
+      -- htyped : Typed (((Γ,X<:⊤),x:(Label[.tvar 0]^(Cin1.proj Kd))),x:(SType.tvar 0)^{}) h ...
+      -- goal : Typed (((Γ,X<:⊤),x:(Label[.tvar 0]^(Cin2.proj Kd))),x:(SType.tvar 0)^{}) h ...
+      -- The difference is in the MIDDLE binding (position 1), not the outer one (position 0)
+      -- Step 1: Build the subtyping on capture sets
+      have hsub_proj : Subcapt Γ (Cin2.proj Kd) (Cin1.proj Kd) := Subcapt.apply_proj hsub
+      have hsub_proj' : Subcapt (Γ,X<:⊤) (Cin2.proj Kd) (Cin1.proj Kd) := hsub_proj.tweaken
+      -- Step 2: Build the CSubtyp for the label types
+      have hcsub : CSubtyp (Γ,X<:⊤) (Label[.tvar 0]^(Cin2.proj Kd)) (Label[.tvar 0]^(Cin1.proj Kd)) :=
+        CSubtyp.capt hsub_proj' SSubtyp.refl
+      -- Step 3: Use VarSubst.narrow extended with VarSubst.ext to narrow position 1
+      -- The VarSubst.ext needs the outer type to be the same in source and target
+      -- VarSubst.narrow gives: VarSubst ((Γ,X<:⊤),x:T1) id ((Γ,X<:⊤),x:T2)
+      -- VarSubst.ext extends with the same outer binding
+      have hnarrow := VarSubst.narrow hcsub
+      have hsubst := VarSubst.ext hnarrow ((SType.tvar 0)^{})
+      have h := Typed.subst htyped hsubst
+      -- Simplify the FinFun.id.ext to id
+      simp only [FinFun.id_ext, Term.rename_id, EType.rename_id, CaptureSet.rename_id] at h
+      exact h }
+    assumption
+    apply htcont.cin_narrow $ Subcapt.join hsub .rfl
+    assumption
+
+
+
 
 end Capless
diff --git a/Capless/Reduction.lean b/Capless/Reduction.lean
index 2c711ba8..d3dbca88 100644
--- a/Capless/Reduction.lean
+++ b/Capless/Reduction.lean
@@ -26,6 +26,10 @@ inductive Reduce : State n m k -> State n' m' k' -> Prop where
   Reduce
     ⟨σ | cont | boundary[c]:S in t⟩
     ⟨(σ.label c S).cval {x=0|.top} | cont.weaken.cweaken.scope 0 | t⟩
+| intercept :
+  Reduce
+    ⟨σ | cont | intercept[K] with h in t⟩
+    ⟨σ | cont.intercept K h | t⟩
 | leave_var :
   Reduce
     ⟨σ | cont.scope x | Term.var y⟩
@@ -35,9 +39,24 @@ inductive Reduce : State n m k -> State n' m' k' -> Prop where
   Reduce
     ⟨σ | cont.scope x | v⟩
     ⟨σ | cont | v⟩
+| leave_intercept_var :
+  Reduce
+    ⟨σ | cont.intercept K h | Term.var x⟩
+    ⟨σ | cont | Term.var x⟩
+| leave_intercept_val {v : Term n m k} :
+  v.IsValue ->
+  Reduce
+    ⟨σ | cont.intercept K h | v⟩
+    ⟨σ | cont | v⟩
+| invoke_handler {σ : Store n m k} {cont : Cont n m k} :
+  σ.LBound x c S ->
+  cont.HasIntercept x (.classifier c) (.some h) tail ->
+  Reduce
+    ⟨σ | cont | Term.invoke x y⟩
+    ⟨σ | tail | Term.bindt S ((h.open x.castSucc).open y)⟩
 | invoke {σ : Store n m k} {cont : Cont n m k} :
   σ.LBound x c S ->
-  cont.HasLabel x tail ->
+  cont.HasIntercept x (.classifier c) .none tail ->
   Reduce
     ⟨σ | cont | Term.invoke x y⟩
     ⟨σ | tail | Term.var y⟩
diff --git a/Capless/Renaming/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean
index 8b7564e8..8b95bd14 100644
--- a/Capless/Renaming/Capture/Typing.lean
+++ b/Capless/Renaming/Capture/Typing.lean
@@ -137,5 +137,12 @@ theorem Typed.crename
         <- CaptureSet.weaken_crename,
         <- CaptureSet.cweaken_crename] at ih
     exact ih
+  case intercept ih ih2 =>
+    apply intercept
+    have ih := ih $ ((ρ.text _).ext _).ext _
+    simp [TBinding.crename, EType.crename, CType.crename, SType.crename] at ih ih2
+    simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename] at ih ih2
+    apply ih
+    apply ih2 ρ
 
 end Capless
diff --git a/Capless/Renaming/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean
index af1ba474..38f0426e 100644
--- a/Capless/Renaming/Term/Typing.lean
+++ b/Capless/Renaming/Term/Typing.lean
@@ -138,5 +138,12 @@ theorem Typed.rename
       , CaptureSet.weaken_rename ]
     simp [CBound.rename, EType.rename, CType.rename] at ih
     exact ih
+  case intercept ih ih2 =>
+    apply intercept
+    have ih := ih $ ((ρ.text _).ext _).ext _
+    simp [TBinding.rename, EType.rename, CType.rename, SType.rename] at ih ih2
+    simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ih ih2
+    apply ih
+    apply ih2 ρ
 
 end Capless
diff --git a/Capless/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean
index ddd02e85..f524d6dd 100644
--- a/Capless/Renaming/Type/Typing.lean
+++ b/Capless/Renaming/Type/Typing.lean
@@ -127,5 +127,11 @@ theorem Typed.trename
        , SType.weaken_trename ]
     simp [EType.trename, CType.trename] at ih
     exact ih
-
+  case intercept ih ih2 =>
+    apply intercept
+    have ih := ih $ ((ρ.text _).ext _).ext _
+    simp [TBinding.trename, EType.trename, CType.trename, SType.trename, FinFun.ext_zero] at ih ih2
+    simp [← SType.weaken_trename, ← SType.tweaken_trename] at ih ih2
+    apply ih
+    apply ih2 ρ
 end Capless
diff --git a/Capless/Soundness/Progress.lean b/Capless/Soundness/Progress.lean
index ad27f977..1b3d1583 100644
--- a/Capless/Soundness/Progress.lean
+++ b/Capless/Soundness/Progress.lean
@@ -189,7 +189,7 @@ theorem progress
     case sub hsub ih _ _ _ =>
       apply ih <;> try easy
       apply WellScoped.subcapt; easy; easy
-      apply! TypedCont.narrow
+      apply! TypedCont.narrow (TypedCont.cin_narrow hc _) _
     case abs => cases hc <;> aesop
     case tabs => cases hc <;> aesop
     case cabs => cases hc <;> aesop
@@ -222,7 +222,9 @@ theorem progress
       have ⟨c0, S0, hl⟩ := Store.label_lookup_exists hs hx
       have hl := Store.bound_label hl hs
       have ⟨_, hsl⟩ := WellScoped.label_inv hsc hl
-      aesop
+      have ⟨handler, tail, hsi⟩ := hsl.has_intercept (L:=.classifier c0)
+      cases handler <;> aesop
     case boundary => aesop
+    case intercept => aesop
 
 end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 7c32f629..f021ecdf 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -58,6 +58,7 @@ inductive Cont : Nat -> Nat -> Nat -> Type where
   Cont n m k
 | intercept : -- intercept frame
   Kind ->
+  Term (n + 2) (m + 1) k ->
   Cont n m k ->
   Cont n m k
 
@@ -106,38 +107,38 @@ inductive Cont.HasLabel : Cont n m k -> Fin n -> Cont n m k -> Prop where
   Cont.HasLabel (Cont.scope l' cont) l tail
 | there_intercept :
   Cont.HasLabel cont l tail ->
-  Cont.HasLabel (Cont.intercept K cont) l tail
+  Cont.HasLabel (Cont.intercept K h cont) l tail
 
-/-- Checks whether a label can be handled in a scope of a continuation stack. This can either be a label frame itself, or the intercept frame.
+/-- Checks whether a label can be handled in an intercept scope of a continuation stack.
  -  We need to actually check the classifier here to see if they match. -/
-inductive Cont.HasIntercept : Cont n m k -> Fin n -> Kind -> Cont n m k -> Prop where
+inductive Cont.HasIntercept : Cont n m k -> Fin n -> Kind -> Option (Term (n + 2) (m + 1) k) -> Cont n m k -> Prop where
 | here_label :
-  Cont.HasIntercept (Cont.scope l tail) l L tail
+  Cont.HasIntercept (Cont.scope l tail) l L .none tail
 | here_intercept :
   Cont.HasLabel tail l tail' -> -- the tail must actually contain the label frame
   L.disjoint K = false ->
-  Cont.HasIntercept (Cont.intercept K tail) l L tail
+  Cont.HasIntercept (Cont.intercept K h tail) l L (.some h) tail
 | there_intercept :
-  Cont.HasIntercept tail l L tail' ->
+  Cont.HasIntercept tail l L h' tail' ->
   L.disjoint K = true ->
-  Cont.HasIntercept (Cont.intercept K tail) l L tail'
+  Cont.HasIntercept (Cont.intercept K h tail) l L h' tail'
 | there_val :
-  Cont.HasIntercept cont l L tail ->
-  Cont.HasIntercept (Cont.cons t cont) l L tail
+  Cont.HasIntercept cont l L h tail ->
+  Cont.HasIntercept (Cont.cons t cont) l L h tail
 | there_tval :
-  Cont.HasIntercept cont l L tail ->
-  Cont.HasIntercept (Cont.conse t cont) l L tail
+  Cont.HasIntercept cont l L h tail ->
+  Cont.HasIntercept (Cont.conse t cont) l L h tail
 | there_cval :
-  Cont.HasIntercept cont l L tail ->
-  Cont.HasIntercept (Cont.scope l' cont) l L tail
+  Cont.HasIntercept cont l L h tail ->
+  Cont.HasIntercept (Cont.scope l' cont) l L h tail
 | there_label :
-  Cont.HasIntercept cont l L tail ->
-  Cont.HasIntercept (Cont.scope l' cont) l L tail
+  Cont.HasIntercept cont l L h tail ->
+  Cont.HasIntercept (Cont.scope l' cont) l L h tail
 
-theorem Cont.HasIntercept.HasLabel (hi : HasIntercept cont l L tail) : ∃ tail', HasLabel cont l tail' := by
+theorem Cont.HasIntercept.has_label (hi : HasIntercept cont l L h tail) : ∃ tail', HasLabel cont l tail' := by
   induction hi
   case here_label l tail L => exists tail; apply HasLabel.here
-  case here_intercept _ _ tail' _ _ hl _ => exists tail'; apply HasLabel.there_intercept hl
+  case here_intercept _ _ tail' _ _ _ hl _ => exists tail'; apply HasLabel.there_intercept hl
   case there_intercept ih =>
     have ⟨t, h⟩ := ih
     exists t; apply HasLabel.there_intercept h
@@ -154,8 +155,19 @@ theorem Cont.HasIntercept.HasLabel (hi : HasIntercept cont l L tail) : ∃ tail'
     have ⟨t, h⟩ := ih
     exists t; apply HasLabel.there_label h
 
-
-
+theorem Cont.HasLabel.has_intercept (hl : HasLabel cont l tail) : ∃ h tail', HasIntercept cont l L h tail' := by
+  induction hl
+  case here l tail => exists .none, tail; apply! HasIntercept.here_label
+  case there_val ih => have ⟨h, tail, ih⟩ := ih; exists h, tail; apply! HasIntercept.there_val
+  case there_tval ih => have ⟨h, tail, ih⟩ := ih; exists h, tail; apply! HasIntercept.there_tval
+  case there_cval ih => have ⟨h, tail, ih⟩ := ih; exists h, tail; apply! HasIntercept.there_cval
+  case there_label ih => have ⟨h, tail, ih⟩ := ih; exists h, tail; apply! HasIntercept.there_label
+  case there_intercept cont _ _ K h0 hl ih =>
+    have ⟨h, tail, ih⟩ := ih
+    generalize hd : L.disjoint K = b0
+    cases b0
+    . exists .some h0, cont; apply HasIntercept.here_intercept hl hd;
+    . exists h, tail; apply! HasIntercept.there_intercept
 
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
  -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
@@ -194,26 +206,35 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   L.IsEmpty ->
   WellScoped Γ cont (.singleton s L)
 
-/-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` through the continuation stack results in an output of type `Eout`, and the captured variables of the entire stack is `C`. -/
-inductive TypedCont : Context n m k -> EType n m k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
+/-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` with ambiant captures `Cin`
+    through the continuation stack results in an output of type `Eout`,
+    and the captured variables of the entire stack is `C`. -/
+inductive TypedCont : Context n m k -> EType n m k -> CaptureSet n k -> Cont n m k -> EType n m k -> CaptureSet n k -> Prop where
 | none :
   ESubtyp Γ E E' ->
-  TypedCont Γ E Cont.none E' {}
+  TypedCont Γ E Cin Cont.none E' {}
 | cons {Ct : CaptureSet n k} :
   Typed (Γ,x: T) t (EType.weaken E) Ct.weaken ->
   WellScoped Γ cont Ct ->
-  TypedCont Γ E cont E' C ->
-  TypedCont Γ (EType.type T) (Cont.cons t cont) E' (C ∪ Ct)
+  TypedCont Γ E (Cin ∪ Ct) cont E' C ->
+  TypedCont Γ (EType.type T) Cin (Cont.cons t cont) E' (C ∪ Ct)
 | conse {Ct : CaptureSet n k} :
   Typed ((Γ.cvar (CBinding.bound B)).var T) t (EType.weaken (EType.cweaken E)) Ct.cweaken.weaken ->
   WellScoped Γ cont Ct ->
-  TypedCont Γ E cont E' C ->
-  TypedCont Γ (EType.ex B T) (Cont.conse t cont) E' (C ∪ Ct)
+  TypedCont Γ E (Cin ∪ Ct) cont E' C ->
+  TypedCont Γ (EType.ex B T) Cin (Cont.conse t cont) E' (C ∪ Ct)
 | scope :
   Context.LBound Γ x c S ->
-  TypedCont Γ (S^{}) cont E' C ->
+  TypedCont Γ (S^{}) Cin cont E' C ->
   (Γ ⊢ T0 <: S^{}) ->
-  TypedCont Γ (EType.type T0) (Cont.scope x cont) E' C
+  TypedCont Γ (EType.type T0) Cin (Cont.scope x cont) E' C
+| intercept {S : SType n m k} {Cin Ct: CaptureSet n k}:
+  Typed (((Γ,X<:⊤),x:(Label[.tvar 0]^(Cin.proj K))),x:(SType.tvar 0)^{}) h (S.tweaken.weaken.weaken^CaptureSet.empty) (Ct.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
+  WellScoped Γ cont Ct ->
+  TypedCont Γ (S^CaptureSet.empty) (Cin ∪ Ct) cont E' C ->
+  (Γ ⊢ T0 <: (CType.capt .empty S)) ->
+  TypedCont Γ (EType.type T0) Cin (Cont.intercept K h cont) E' (C ∪ Ct)
+
 
 /-- Typecheck an evaluation state. -/
 inductive TypedState : State n m k -> Context n m k -> EType n m k -> Prop where
@@ -221,7 +242,7 @@ inductive TypedState : State n m k -> Context n m k -> EType n m k -> Prop where
   TypedStore σ Γ ->
   Typed Γ t E Ct ->
   WellScoped Γ cont Ct ->
-  TypedCont Γ E cont E' C ->
+  TypedCont Γ E Ct cont E' C ->
   TypedState (State.mk σ cont t) Γ E'
 
 /-!
@@ -305,21 +326,21 @@ def Cont.weaken : Cont n m k -> Cont (n+1) m k
 | Cont.cons t cont => Cont.cons t.weaken1 cont.weaken
 | Cont.conse t cont => Cont.conse t.weaken1 cont.weaken
 | Cont.scope x cont => Cont.scope x.succ cont.weaken
-| Cont.intercept K cont => Cont.intercept K cont.weaken
+| Cont.intercept K h cont => Cont.intercept K h.weaken cont.weaken
 
 def Cont.tweaken : Cont n m k -> Cont n (m+1) k
 | Cont.none => Cont.none
 | Cont.cons t cont => Cont.cons t.tweaken cont.tweaken
 | Cont.conse t cont => Cont.conse t.tweaken cont.tweaken
 | Cont.scope x cont => Cont.scope x cont.tweaken
-| Cont.intercept K cont => Cont.intercept K cont.tweaken
+| Cont.intercept K h cont => Cont.intercept K h.tweaken cont.tweaken
 
 def Cont.cweaken : Cont n m k -> Cont n m (k+1)
 | Cont.none => Cont.none
 | Cont.cons t cont => Cont.cons t.cweaken cont.cweaken
 | Cont.conse t cont => Cont.conse t.cweaken1 cont.cweaken
 | Cont.scope x cont => Cont.scope x cont.cweaken
-| Cont.intercept K cont => Cont.intercept K cont.cweaken
+| Cont.intercept K h cont => Cont.intercept K h.cweaken cont.cweaken
 
 /-!
 ## Tightness
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index 7fa6d68d..a19280d0 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -131,6 +131,16 @@ theorem Typed.csubst
          , <- CaptureSet.weaken_crename
          , <- CaptureSet.cweaken_crename ] at ih
       aesop
+    case intercept ih ih2 =>
+      simp [Term.crename]
+      apply intercept
+      have ih := ih $ (σ.text.ext _).ext _
+      simp [TBinding.crename, EType.crename, CType.crename, SType.crename] at ih ih2
+      simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename] at ih ih2
+      apply ih
+      apply! ih2
+
+
 
 theorem Typed.copen
   (h : Typed (Γ,c<:CBound.upper {c=c|.top}) t E Ct) :
diff --git a/Capless/Subst/Term/Typing.lean b/Capless/Subst/Term/Typing.lean
index 9b3ab6fa..a99f5621 100644
--- a/Capless/Subst/Term/Typing.lean
+++ b/Capless/Subst/Term/Typing.lean
@@ -138,6 +138,14 @@ theorem Typed.subst
       , CaptureSet.cweaken_rename_comm
       , FinFun.ext ] at ih
     exact ih
+  case intercept ih ih2 =>
+    simp [Term.rename]
+    apply intercept
+    have ih := ih $ (σ.text.ext _).ext _
+    simp [TBinding.rename, EType.rename, CType.rename, SType.rename] at ih ih2
+    simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ih ih2
+    apply ih
+    apply! ih2
 
 theorem Typed.open
   (h : Typed (Γ,x: P) t E Ct)
diff --git a/Capless/Subst/Type/Typing.lean b/Capless/Subst/Type/Typing.lean
index 2a74d5ee..13610c42 100644
--- a/Capless/Subst/Type/Typing.lean
+++ b/Capless/Subst/Type/Typing.lean
@@ -122,6 +122,14 @@ theorem Typed.tsubst
          , <- SType.weaken_trename
          , <- SType.cweaken_trename ] at ih
       aesop
+    case intercept ih ih2 =>
+      simp [Term.trename]
+      apply intercept
+      have ih := ih $ ((σ.text _).ext _).ext _
+      simp [TBinding.trename, EType.trename, CType.trename, SType.trename] at ih ih2
+      simp [← SType.weaken_trename, ← SType.tweaken_trename] at ih ih2
+      apply ih
+      apply! ih2
 
 theorem Typed.topen
   (h : Typed (Γ,X<: (SType.tvar X)) t E Ct) :
diff --git a/Capless/Term.lean b/Capless/Term.lean
index fa4fef48..b79d8f4d 100644
--- a/Capless/Term.lean
+++ b/Capless/Term.lean
@@ -63,14 +63,8 @@ inductive Term : Nat -> Nat -> Nat -> Type where
 | bindc : CaptureSet n k -> Term n m (k+1) -> Term n m k
 /-- Boundary form `boundary[c] as <c,x> in t`. -/
 | boundary : Classifier -> SType n m k -> Term (n+1) m (k+1) -> Term n m k
-/-- Intercept: `intercept[K] in t` --/
-| intercept : Kind -> Term n m k -> Term n m k
-/-- Unwraps a maybe --/
-| unwrap: Fin n -> Term (n+2) (m+1) k -> Term n m k
-/-- value form of maybe: a returned value -/
-| ok : Fin n -> Term n m k
-/-- value form of maybe: a invocation label, and its associated value. -/
-| invoked : Fin n -> Fin n -> Term n m k
+/-- Intercept: `intercept[K] with h in t` --/
+| intercept : Kind -> Term (n + 2) (m + 1) k -> Term n m k -> Term n m k
 
 /-!
 ## Notations
@@ -84,8 +78,7 @@ notation:40 "let" "(c,x)=" t " in " u => Term.letex t u
 notation:40 "let" "X=" S " in " t => Term.bindt S t
 notation:40 "let" "c=" C " in " t => Term.bindc C t
 notation:40 "boundary[" c "]:" S " in " t => Term.boundary c S t
-notation:40 "intercept[" K "]"" in " t => Term.intercept K t
-notation:40 "handle " n " with " t => Term.unwrap n t
+notation:40 "intercept[" K "]" " with " h " in " t => Term.intercept K h t
 
 /-- Whether this term is a value? -/
 @[aesop safe constructors]
@@ -94,8 +87,6 @@ inductive Term.IsValue : Term n m k -> Prop where
 | tlam : Term.IsValue (tlam S t)
 | clam : Term.IsValue (clam B t)
 | pack : Term.IsValue (pack c x)
-| ok : Term.IsValue (ok v)
-| invoked : Term.IsValue (invoked l v)
 
 /-!
 ## Renaming Operations on `Term`
@@ -118,11 +109,7 @@ def Term.rename (t : Term n m k) (f : FinFun n n') : Term n' m k :=
   | Term.bindt S t => Term.bindt (S.rename f) (t.rename f)
   | Term.bindc c t => Term.bindc (c.rename f) (t.rename f)
   | Term.boundary c S t => Term.boundary c (S.rename f) (t.rename f.ext)
-  | Term.intercept K t => Term.intercept K (t.rename f)
-  | Term.unwrap x t => Term.unwrap (f x) (t.rename f.ext.ext)
-  | Term.ok v => Term.ok $ f v
-  | Term.invoked l v => Term.invoked (f l) (f v)
-
+  | Term.intercept K h t => Term.intercept K (h.rename f.ext.ext) (t.rename f)
 
 def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   match t with
@@ -140,10 +127,7 @@ def Term.trename (t : Term n m k) (f : FinFun m m') : Term n m' k :=
   | Term.bindt S t => Term.bindt (S.trename f) (t.trename f.ext)
   | Term.bindc c t => Term.bindc c (t.trename f)
   | Term.boundary c S t => Term.boundary c (S.trename f) (t.trename f)
-  | Term.intercept K t => Term.intercept K (t.trename f)
-  | Term.unwrap x t => Term.unwrap x (t.trename f.ext)
-  | Term.ok v => Term.ok v
-  | Term.invoked l v => Term.invoked l v
+  | Term.intercept K h t => Term.intercept K (h.trename f.ext) (t.trename f)
 
 def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   match t with
@@ -161,10 +145,7 @@ def Term.crename (t : Term n m k) (f : FinFun k k') : Term n m k' :=
   | Term.bindt S t => Term.bindt (S.crename f) (t.crename f)
   | Term.bindc c t => Term.bindc (c.crename f) (t.crename f.ext)
   | Term.boundary c S t => Term.boundary c (S.crename f) (t.crename f.ext)
-  | Term.intercept K t => Term.intercept K (t.crename f)
-  | Term.unwrap x t => Term.unwrap x (t.crename f)
-  | Term.ok v => Term.ok v
-  | Term.invoked l v => Term.invoked l v
+  | Term.intercept K h t => Term.intercept K (h.crename f) (t.crename f)
 
 def Term.weaken (t : Term n m k) : Term (n+1) m k := t.rename FinFun.weaken
 
@@ -273,14 +254,8 @@ theorem Term.rename_id {t : Term n m k} :
     simp [Term.rename, CaptureSet.rename_id, ih]
   case boundary ih =>
     simp [Term.rename, SType.rename_id, ih, FinFun.id_ext]
-  case intercept ih =>
-    simp [Term.rename, ih]
-  case unwrap ih =>
-    simp [Term.rename, FinFun.id_ext, ih, FinFun.id]
-  case ok =>
-    simp [Term.rename, FinFun.id]
-  case invoked =>
-    simp [Term.rename, FinFun.id]
+  case intercept ih ih2 =>
+    simp [Term.rename, SType.rename_id, FinFun.id_ext, ih, ih2]
 
 theorem Term.trename_id {t : Term n m k} :
   t.trename FinFun.id = t := by
@@ -318,12 +293,8 @@ theorem Term.trename_id {t : Term n m k} :
     exact ih
   case boundary ih =>
     simp [Term.trename, SType.trename_id, ih, FinFun.id_ext]
-  case intercept ih =>
-    simp [Term.trename, ih]
-  case unwrap ih =>
-    simp [Term.trename, FinFun.id_ext, ih]
-  case ok => simp [Term.trename]
-  case invoked => simp [Term.trename]
+  case intercept ih ih2 =>
+    simp [Term.trename, ih, ih2, FinFun.id_ext]
 
 theorem Term.crename_id {t : Term n m k} :
   t.crename FinFun.id = t := by
@@ -361,12 +332,8 @@ theorem Term.crename_id {t : Term n m k} :
   case boundary ih =>
     simp [Term.crename]
     simp [ih, SType.crename_id, FinFun.id_ext]
-  case intercept ih =>
-    simp [Term.crename, ih]
-  case unwrap ih =>
-    simp [Term.crename, ih]
-  case ok => simp [Term.crename]
-  case invoked => simp [Term.crename]
+  case intercept ih ih2 =>
+    simp [Term.crename, ih, ih2]
 
 theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''} :
   (t.rename f).rename g = t.rename (g.comp f) := by
@@ -406,13 +373,8 @@ theorem Term.rename_rename {t : Term n m k} {f : FinFun n n'} {g : FinFun n' n''
   case boundary ih =>
     simp [rename, SType.rename_rename]
     simp [<- FinFun.ext_comp_ext, ih]
-  case intercept ih =>
-    simp [rename, ih]
-  case unwrap ih =>
-    simp [rename]
-    simp [<- FinFun.ext_comp_ext, ih]
-  case ok => simp [rename]
-  case invoked => simp [rename]
+  case intercept ih ih2 =>
+    simp [rename, ih, ih2, ← FinFun.ext_comp_ext]
 
 theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k''} :
   (t.crename f).crename g = t.crename (g.comp f) := by
@@ -452,12 +414,8 @@ theorem Term.crename_crename {t : Term n m k} {f : FinFun k k'} {g : FinFun k' k
   case boundary ih =>
     simp [crename, SType.crename_crename]
     simp [<- FinFun.ext_comp_ext, ih]
-  case intercept ih =>
-    simp [crename, ih]
-  case unwrap ih =>
-    simp [crename, ih]
-  case ok => simp [crename]
-  case invoked => simp [crename]
+  case intercept ih ih2 =>
+    simp [crename, ih, ih2]
 
 theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m''} :
   (t.trename f).trename g = t.trename (g.comp f) := by
@@ -497,12 +455,7 @@ theorem Term.trename_trename {t : Term n m k} {f : FinFun m m'} {g : FinFun m' m
   case boundary ih =>
     simp [trename, SType.trename_trename]
     simp [<- FinFun.ext_comp_ext, ih]
-  case intercept ih =>
-    simp [trename, ih]
-  case unwrap ih =>
-    simp [trename]
-    simp [<- FinFun.ext_comp_ext, ih]
-  case ok => simp [trename]
-  case invoked => simp [trename]
+  case intercept ih ih2 =>
+    simp [trename, ih, ih2, ← FinFun.ext_comp_ext]
 
 end Capless
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 6f3fb7eb..6c020722 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -74,22 +74,22 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ->
   Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
-| intercept {Γ : Context n m k} {S : SType n m k} :
-  Typed Γ t (S^{}) C ->
-  Typed Γ (intercept[K] in t) (EType.type (SType.maybe S)^(C.proj K)) C
-| unwrap {Γ : Context n m k} {S : SType n m k} :
-  Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
+| intercept {Γ : Context n m k} {S : SType n m k} {C C1 : CaptureSet n k}:
   Typed
-    (((Γ,X<:.top),x:(Label[.tvar 0]^{x=x|.top})),x:(SType.tvar 0)^{})
-    t
-    (S.tweaken.weaken.weaken^{}) (C.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
-  Typed Γ (.unwrap x t) (S^CaptureSet.empty) C
-| ok {Γ : Context n m k} {S : SType n m k} :
-  Typed Γ (Term.var x) (S^CaptureSet.empty) {x=x|.top} -> Typed Γ (Term.ok x) ((SType.maybe S)^CaptureSet.empty) {x=x|.top}
-| invoked {Γ : Context n m k} {S : SType n m k} :
-  Typed Γ (Term.var l) (Label[S]^C) {x=l|.top} ->
-  Typed Γ (Term.var v) (S^CaptureSet.empty) {x=v|.top} ->
-  Typed Γ (Term.invoked l v) ((SType.maybe S)^C) ({x=l|.top} ∪ {x=v|.top})
+    (((Γ,X<:.top),x:(Label[.tvar 0]^(C.proj K))),x:(SType.tvar 0)^{})
+    h
+    (S.tweaken.weaken.weaken^{}) (C1.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
+  Typed Γ t (S^{}) C ->
+  Typed Γ (intercept[K] with h in t) (S^{}) (C ∪ C1)
+-- | unwrap {Γ : Context n m k} {S : SType n m k} :
+--   Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
+--   Typed Γ (.unwrap x t) (S^CaptureSet.empty) C
+-- | ok {Γ : Context n m k} {S : SType n m k} :
+--   Typed Γ (Term.var x) (S^CaptureSet.empty) {x=x|.top} -> Typed Γ (Term.ok x) ((SType.maybe S)^CaptureSet.empty) {x=x|.top}
+-- | invoked {Γ : Context n m k} {S : SType n m k} :
+--   Typed Γ (Term.var l) (Label[S]^C) {x=l|.top} ->
+--   Typed Γ (Term.var v) (S^CaptureSet.empty) {x=v|.top} ->
+--   Typed Γ (Term.invoked l v) ((SType.maybe S)^C) ({x=l|.top} ∪ {x=v|.top})
 
 notation:40 Γ " ⊢ " t:80 " : " E " @ " C => Typed Γ t E C
 

From feab24e34638196eceae073d6f0cbe562539de32 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 18 Dec 2025 21:03:54 +0100
Subject: [PATCH 52/71] Some WIP rework of subcapt

---
 Capless/Basic.lean                       |  3 ++
 Capless/Soundness/Preservation.lean      |  3 +-
 Capless/Store.lean                       |  4 +-
 Capless/Subcapturing.lean                |  4 +-
 Capless/Subcapturing/Basic.lean          | 50 +++++++++---------------
 Capless/Weakening/Basic.lean             | 40 +++++++++++++++++++
 Capless/Weakening/TypedCont/Capture.lean | 18 ++++++++-
 Capless/Weakening/TypedCont/Term.lean    | 43 ++++++++++++++++++--
 Capless/Weakening/TypedCont/Type.lean    | 14 ++++++-
 Capless/Weakening/Typing.lean            | 25 ++++++++++++
 10 files changed, 160 insertions(+), 44 deletions(-)

diff --git a/Capless/Basic.lean b/Capless/Basic.lean
index 99532273..6ed7be5f 100644
--- a/Capless/Basic.lean
+++ b/Capless/Basic.lean
@@ -98,4 +98,7 @@ theorem FinFun.comp_succ {f : FinFun n n'}: Fin.succ ∘ f = (FinFun.ext f) ∘
 theorem FinFun.ext_zero {f : FinFun n n'} : f.ext 0 = 0 := by
   simp [FinFun.ext]
 
+theorem FinFun.ext_ext_one {f : FinFun n n'} : f.ext.ext 1 = 1 := by
+  rfl
+
 end Capless
diff --git a/Capless/Soundness/Preservation.lean b/Capless/Soundness/Preservation.lean
index aacbb8ee..a2127960 100644
--- a/Capless/Soundness/Preservation.lean
+++ b/Capless/Soundness/Preservation.lean
@@ -94,7 +94,8 @@ theorem preservation
         { apply WellScoped.var_inv
           exact h2; easy }
         { easy } }
-      { easy }
+      { rw [CaptureSet.open, CaptureSet.rename]
+        easy }
   case tapply hl =>
     cases ht
     case mk hs hsc ht hc =>
diff --git a/Capless/Store.lean b/Capless/Store.lean
index f021ecdf..037cf0cd 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -326,14 +326,14 @@ def Cont.weaken : Cont n m k -> Cont (n+1) m k
 | Cont.cons t cont => Cont.cons t.weaken1 cont.weaken
 | Cont.conse t cont => Cont.conse t.weaken1 cont.weaken
 | Cont.scope x cont => Cont.scope x.succ cont.weaken
-| Cont.intercept K h cont => Cont.intercept K h.weaken cont.weaken
+| Cont.intercept K h cont => Cont.intercept K (h.rename FinFun.weaken.ext.ext) cont.weaken
 
 def Cont.tweaken : Cont n m k -> Cont n (m+1) k
 | Cont.none => Cont.none
 | Cont.cons t cont => Cont.cons t.tweaken cont.tweaken
 | Cont.conse t cont => Cont.conse t.tweaken cont.tweaken
 | Cont.scope x cont => Cont.scope x cont.tweaken
-| Cont.intercept K h cont => Cont.intercept K h.tweaken cont.tweaken
+| Cont.intercept K h cont => Cont.intercept K (h.trename FinFun.weaken.ext) cont.tweaken
 
 def Cont.cweaken : Cont n m k -> Cont n m (k+1)
 | Cont.none => Cont.none
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index c1ae39d6..a1697e49 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -19,7 +19,7 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
   | empty : CaptureKind Γ .empty K
-  | absurd : L.IsEmpty -> CaptureKind Γ (.singleton s L) K
+  | absurd : CaptureKind Γ C K -> K.IsEmpty -> CaptureKind Γ C L
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
@@ -47,7 +47,7 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
 | subkind : K.Subkind L -> Subcapt Γ (.singleton s K) (.singleton s L)
-| proj_absurd : L.IsEmpty -> Subcapt Γ (.singleton s L) .empty
+| absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
 | proj_split : Subcapt Γ (.singleton s (.union K1 K2)) (.union (.singleton s K1) (.singleton s K2))
 
 theorem Subcapt.proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2)) := by
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index a6ae0bbf..b7a07b20 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -52,8 +52,12 @@ theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2)
     have ⟨_, _⟩ := hk.union_l_inv' heq
     apply And.intro <;> apply! CaptureKind.sub
   | .empty => by cases heq
+  | .absurd hk he => by
+    have ⟨_, _⟩ := hk.union_l_inv' heq
+    apply And.intro <;> apply! absurd
 termination_by structural hk
 
+theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
 
 theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := by
   induction hs <;> (subst_vars; try simp_all)
@@ -76,20 +80,11 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro <;> apply! trans _ (.cinstl hb)
   case union =>
     injections; subst_vars; apply And.intro <;> assumption
+  case absurd he hk =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply And.intro <;> apply! absurd
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
-theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
-
-
-theorem Subcapt.proj_absurd_set {C : CaptureSet n k} (he : L.IsEmpty) : Subcapt Γ (C.proj L) .empty := by
-  induction C
-  case empty => simp; apply rfl
-  case union ha hb => apply! union
-  case singleton =>
-    simp
-    apply trans
-    apply subkind Kind.Intersect.subkind_r
-    apply! proj_absurd
 
 theorem CaptureKind.subset
   (hk : CaptureKind Γ C2 K)
@@ -149,11 +144,10 @@ theorem CaptureKind.subkind_proj
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     apply empty
-  case absurd he =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+  case absurd hk he ih =>
     apply absurd
-    apply Kind.Subkind.of_empty (Kind.Intersect.with_subkind hs) he
+    apply ih hs h
+    assumption
   case union ha hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -169,29 +163,22 @@ theorem CaptureKind.subkind_singleton
   rw [← CaptureSet.proj]
   apply! subkind_proj
 
-theorem CaptureKind.absurd_set {C : CaptureSet n k}
-  (he : L.IsEmpty)
-  : CaptureKind Γ (C.proj L) K := by
-  induction C
-  case empty => apply empty
-  case union ha hb => apply! union
-  case singleton => simp; apply absurd; apply Kind.Intersect.is_empty_r he
-
 theorem CaptureKind.var_lookup_inv
   (hk : CaptureKind Γ {x=x|L} K)
   (hb : Γ.Bound x S^C)
-  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K := by
   generalize h : {x=x|L} = D at hk
   induction hk <;> cases h
   case var K hb2 hk ih =>
     cases Context.bound_injective hb hb2
-    right; assumption
+    assumption
   case label hb2 => cases Context.bound_lbound_absurd hb hb2
   case sub hs hk ih =>
-    cases ih hb (.refl _)
-    case inl => left; assumption
-    case inr h => right; apply! sub
-  case absurd => aesop
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd ih =>
+    simp_all
+    apply! absurd
 
 theorem CaptureKind.label_lookup_inv
   (hs : CaptureKind Γ {x=x|K1} K)
@@ -392,7 +379,8 @@ theorem CaptureKind.subcapt
     rw [← CaptureSet.proj] at hk
     rw [← CaptureSet.proj]
     apply subkind_proj hk hs
-  case proj_absurd he => apply! absurd
+  case absurd he =>
+    apply absurd_set
   case proj_split =>
     have ⟨_, _⟩ := hk.union_l_inv
     apply! proj_merge_singleton
diff --git a/Capless/Weakening/Basic.lean b/Capless/Weakening/Basic.lean
index 892ba2b3..27c853bb 100644
--- a/Capless/Weakening/Basic.lean
+++ b/Capless/Weakening/Basic.lean
@@ -87,6 +87,36 @@ def CVarMap.weaken_cext_ext {Γ : Context n m k} :
   apply CVarMap.cext
   apply CVarMap.weaken
 
+def VarMap.weaken_text_ext_ext {Γ : Context n m k} :
+  VarMap
+    (((Γ.tvar b).var T1).var T2)
+    FinFun.weaken.ext.ext
+    ((((Γ.var P).tvar (b.rename FinFun.weaken)).var (T1.rename FinFun.weaken)).var (T2.rename FinFun.weaken.ext)) := by
+  apply VarMap.ext
+  apply VarMap.ext
+  apply VarMap.text
+  apply VarMap.weaken
+
+def CVarMap.weaken_text_ext_ext {Γ : Context n m k} :
+  CVarMap
+    (((Γ.tvar b).var T1).var T2)
+    FinFun.weaken
+    ((((Γ.cvar cb).tvar (b.crename FinFun.weaken)).var T1.cweaken).var T2.cweaken) := by
+  apply CVarMap.ext
+  apply CVarMap.ext
+  apply CVarMap.text
+  apply CVarMap.weaken
+
+def VarMap.lweaken_text_ext_ext {Γ : Context n m k} :
+  VarMap
+    (((Γ.tvar b).var T1).var T2)
+    FinFun.weaken.ext.ext
+    ((((Γ.label c P).tvar (b.rename FinFun.weaken)).var (T1.rename FinFun.weaken)).var (T2.rename FinFun.weaken.ext)) := by
+  apply VarMap.ext
+  apply VarMap.ext
+  apply VarMap.text
+  apply VarMap.lweaken
+
 def TVarMap.weaken {Γ : Context n m k} :
   TVarMap Γ FinFun.weaken (Γ.tvar b) := by
   constructor <;> (intros; constructor; trivial)
@@ -108,4 +138,14 @@ def TVarMap.weaken_cext_ext {Γ : Context n m k} :
   apply TVarMap.cext
   apply TVarMap.weaken
 
+def TVarMap.weaken_text_ext_ext {Γ : Context n m k} :
+  TVarMap
+    (((Γ.tvar b1).var T1).var T2)
+    FinFun.weaken.ext
+    ((((Γ.tvar b2).tvar (b1.trename FinFun.weaken)).var (T1.trename FinFun.weaken.ext)).var (T2.trename FinFun.weaken.ext)) := by
+  apply TVarMap.ext
+  apply TVarMap.ext
+  apply TVarMap.text
+  apply TVarMap.weaken
+
 end Capless
diff --git a/Capless/Weakening/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean
index 74539056..60d5d9ac 100644
--- a/Capless/Weakening/TypedCont/Capture.lean
+++ b/Capless/Weakening/TypedCont/Capture.lean
@@ -68,6 +68,7 @@ theorem Cont.HasLabel.cweaken
   case there_tval => simp [Cont.cweaken]; apply there_tval; aesop
   case there_cval => simp [Cont.cweaken]; apply there_cval; aesop
   case there_label => simp [Cont.cweaken]; apply there_label; aesop
+  case there_intercept => simp [Cont.cweaken]; apply there_intercept; aesop
 
 theorem WellScoped.cweaken
   (h : WellScoped Γ E Ct) :
@@ -104,8 +105,8 @@ theorem WellScoped.cweaken
   case absurd => apply! absurd
 
 theorem TypedCont.cweaken
-  (h : TypedCont Γ E t E' Ct) :
-  TypedCont (Γ.cvar b) E.cweaken t.cweaken E'.cweaken Ct.cweaken := by
+  (h : TypedCont Γ Cin E t E' Ct) :
+  TypedCont (Γ.cvar b) Cin.cweaken E.cweaken t.cweaken E'.cweaken Ct.cweaken := by
   induction h
   case none =>
     simp [Cont.cweaken]
@@ -140,5 +141,18 @@ theorem TypedCont.cweaken
     apply ih
     have h := hs.cweaken (b:=b)
     aesop
+  case intercept ht hsc hs h ih =>
+    simp [Cont.cweaken]
+    apply intercept
+    { have ht1 := ht.cweaken_text_ext_ext (cb := b)
+      simp [TBinding.cweaken, TBinding.crename, CType.cweaken, CType.crename,
+            ← CaptureSet.proj_cweaken, CaptureSet.proj_crename,
+            SType.weaken, SType.crename_rename_comm, SType.tweaken, ← SType.crename_trename_comm, SType.crename,
+            CaptureSet.cweaken, ← CaptureSet.weaken_crename] at ht1
+      simp [CaptureSet.cweaken, SType.tweaken, SType.weaken]
+      exact ht1 }
+    apply hsc.cweaken
+    apply ih
+    apply h.cweaken
 
 end Capless
diff --git a/Capless/Weakening/TypedCont/Term.lean b/Capless/Weakening/TypedCont/Term.lean
index 577f51bd..a095f88e 100644
--- a/Capless/Weakening/TypedCont/Term.lean
+++ b/Capless/Weakening/TypedCont/Term.lean
@@ -70,6 +70,8 @@ theorem Cont.HasLabel.weaken
   case there_label ih =>
     simp [Cont.weaken]
     apply there_label; trivial
+  case there_intercept ih =>
+    apply there_intercept; trivial
 
 theorem WellScoped.weaken
   (h : WellScoped Γ cont Ct) :
@@ -107,8 +109,8 @@ theorem WellScoped.weaken
 
 
 theorem TypedCont.weaken
-  (h : TypedCont Γ E t E' C0) :
-  TypedCont (Γ.var T) E.weaken t.weaken E'.weaken C0.weaken := by
+  (h : TypedCont Γ E Cin t E' C0) :
+  TypedCont (Γ.var T) E.weaken Cin.weaken t.weaken E'.weaken C0.weaken := by
   induction h
   case none =>
     simp [Cont.weaken]
@@ -147,6 +149,22 @@ theorem TypedCont.weaken
     { aesop }
     { have h1 := hs.weaken (T:=T)
       aesop }
+  case intercept ht hsc hs h ih =>
+    apply intercept
+    { have ht1 := ht.weaken_text_ext_ext (P:=T)
+      simp [CType.rename, TBinding.rename,
+            EType.weaken, EType.rename] at ht1
+      simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ht1
+      simp [FinFun.ext_zero, FinFun.ext_ext_one] at ht1
+      simp [CaptureSet.weaken, SType.rename] at ht1
+      simp [CaptureSet.weaken, Term.weaken]
+
+            -- SType.rename, SType.weaken, SType.tweaken,
+            -- CaptureSet.proj_rename] at ht1
+      exact ht1 }
+    apply hsc.weaken
+    apply ih
+    apply h.weaken
 
 theorem Cont.HasLabel.lweaken
   (h : Cont.HasLabel cont x tail) :
@@ -167,6 +185,7 @@ theorem Cont.HasLabel.lweaken
   case there_label ih =>
     simp [Cont.weaken]
     apply there_label; trivial
+  case there_intercept => apply! there_intercept
 
 theorem WellScoped.lweaken
   (h : WellScoped Γ cont Ct) :
@@ -203,8 +222,8 @@ theorem WellScoped.lweaken
   case absurd => apply! absurd
 
 theorem TypedCont.lweaken
-  (h : TypedCont Γ E cont E' Ct) :
-  TypedCont (Γ.label c S) E.weaken cont.weaken E'.weaken Ct.weaken := by
+  (h : TypedCont Γ Cin E cont E' Ct) :
+  TypedCont (Γ.label c S) Cin.weaken E.weaken cont.weaken E'.weaken Ct.weaken := by
   induction h
   case none =>
     simp [Cont.weaken]
@@ -243,5 +262,21 @@ theorem TypedCont.lweaken
     { aesop }
     { have h1 := hs.lweaken (c:=c) (S:=S)
       aesop }
+  case intercept ht hsc hs h ih =>
+    apply intercept
+    { have ht1 := ht.lweaken_text_ext_ext (c := c) (P:=S)
+      simp [CType.rename, TBinding.rename,
+            EType.weaken, EType.rename] at ht1
+      simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ht1
+      simp [FinFun.ext_zero, FinFun.ext_ext_one] at ht1
+      simp [CaptureSet.weaken, SType.rename] at ht1
+      simp [CaptureSet.weaken, Term.weaken]
+
+            -- SType.rename, SType.weaken, SType.tweaken,
+            -- CaptureSet.proj_rename] at ht1
+      exact ht1 }
+    apply hsc.lweaken
+    apply ih
+    apply h.lweaken
 
 end Capless
diff --git a/Capless/Weakening/TypedCont/Type.lean b/Capless/Weakening/TypedCont/Type.lean
index 6b0067af..6aadeb23 100644
--- a/Capless/Weakening/TypedCont/Type.lean
+++ b/Capless/Weakening/TypedCont/Type.lean
@@ -54,6 +54,7 @@ theorem Cont.HasLabel.tweaken
   case there_tval => simp [Cont.tweaken]; apply there_tval; aesop
   case there_cval => simp [Cont.tweaken]; apply there_cval; aesop
   case there_label => simp [Cont.tweaken]; apply there_label; aesop
+  case there_intercept => apply! there_intercept
 
 theorem WellScoped.tweaken
   (h : WellScoped Γ cont Ct) :
@@ -90,8 +91,8 @@ theorem WellScoped.tweaken
   case absurd => apply! absurd
 
 theorem TypedCont.tweaken
-  (h : TypedCont Γ E t E' C0) :
-  TypedCont (Γ.tvar S) E.tweaken t.tweaken E'.tweaken C0 := by
+  (h : TypedCont Γ E Cin t E' C0) :
+  TypedCont (Γ.tvar S) E.tweaken Cin t.tweaken E'.tweaken C0 := by
   induction h
   case none =>
     simp [Cont.tweaken]
@@ -125,5 +126,14 @@ theorem TypedCont.tweaken
     apply ih
     have h := hs.tweaken (b:=S)
     aesop
+  case intercept ht hsc h hs ih =>
+    apply intercept
+    { have ht1 := ht.tweaken_text_ext_ext (b2:=S)
+      rw [TBinding.trename, SType.trename, CType.trename, SType.trename, SType.trename, FinFun.ext_zero, CType.trename, SType.trename, FinFun.ext_zero] at ht1
+      rw [EType.trename, CType.trename, ← SType.weaken_trename, ← SType.weaken_trename, ← SType.tweaken_trename] at ht1
+      exact ht1 }
+    apply hsc.tweaken
+    apply ih
+    apply hs.tweaken
 
 end Capless
diff --git a/Capless/Weakening/Typing.lean b/Capless/Weakening/Typing.lean
index 18972536..38ff443d 100644
--- a/Capless/Weakening/Typing.lean
+++ b/Capless/Weakening/Typing.lean
@@ -21,6 +21,7 @@ The file provides comprehensive weakening operations for `Typed` judgments:
 ## Extended weakening:
 - `Typed.weaken_ext`, `Typed.lweaken_ext`: For nested variable contexts
 - `Typed.weaken_cext_ext`, `Typed.lweaken_cext_ext`: For capture-extended contexts
+- `Typed.weaken_text_ext_ext`, `Typed.lweaken_text_ext_ext`, `Typed.cweaken_text_ext_ext`, `Typed.tweaken_text_ext_ext`: For type-var then two var contexts (handler bindings)
 - `Typed.tweaken_ext`, `Typed.tweaken_cext_ext`: For type variable extensions
 - `Typed.cweaken_ext`, `Typed.cweaken_cext_ext`: For capture variable extensions
 
@@ -67,6 +68,30 @@ theorem Typed.lweaken_cext_ext {Γ : Context n m k}
   simp [Term.weaken1, EType.weaken1]
   apply h.rename VarMap.lweaken_cext_ext
 
+theorem Typed.weaken_text_ext_ext {Γ : Context n m k}
+  (h : Typed (((Γ.tvar b).var T1).var T2) t E Ct) :
+  Typed ((((Γ.var P).tvar (b.rename FinFun.weaken)).var (T1.rename FinFun.weaken)).var (T2.rename FinFun.weaken.ext))
+    (t.rename FinFun.weaken.ext.ext) (E.rename FinFun.weaken.ext.ext) (Ct.rename FinFun.weaken.ext.ext) := by
+  apply h.rename VarMap.weaken_text_ext_ext
+
+theorem Typed.lweaken_text_ext_ext {Γ : Context n m k}
+  (h : Typed (((Γ.tvar b).var T1).var T2) t E Ct) :
+  Typed ((((Γ.label c P).tvar (b.rename FinFun.weaken)).var (T1.rename FinFun.weaken)).var (T2.rename FinFun.weaken.ext))
+    (t.rename FinFun.weaken.ext.ext) (E.rename FinFun.weaken.ext.ext) (Ct.rename FinFun.weaken.ext.ext) := by
+  apply h.rename VarMap.lweaken_text_ext_ext
+
+def Typed.cweaken_text_ext_ext {Γ : Context n m k}
+  (h : Typed (((Γ.tvar b).var T1).var T2) t E Ct) :
+  Typed ((((Γ.cvar cb).tvar (b.crename FinFun.weaken)).var T1.cweaken).var T2.cweaken)
+    t.cweaken E.cweaken Ct.cweaken := by
+  apply h.crename CVarMap.weaken_text_ext_ext
+
+def Typed.tweaken_text_ext_ext {Γ : Context n m k}
+  (h : Typed (((Γ.tvar b1).var T1).var T2) t E Ct) :
+  Typed ((((Γ.tvar b2).tvar (b1.trename FinFun.weaken)).var (T1.trename FinFun.weaken.ext)).var (T2.trename FinFun.weaken.ext))
+    (t.trename FinFun.weaken.ext) (E.trename FinFun.weaken.ext) Ct := by
+  apply h.trename TVarMap.weaken_text_ext_ext
+
 def Typed.tweaken
   (h : Typed Γ t E Ct) :
   Typed (Γ.tvar b) t.tweaken E.tweaken Ct := by

From cf128462827e52b4f6704e8167b135895894c74e Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 19 Dec 2025 19:39:31 +0100
Subject: [PATCH 53/71] Subcapturing tuning

Expand absurd, make capture kind lookups always create valid sets
---
 Capless/Classifier.lean                    |   1 -
 Capless/Renaming/Capture/Subcapturing.lean |   4 +-
 Capless/Renaming/Term/Subcapturing.lean    |   4 +-
 Capless/Renaming/Type/Subcapturing.lean    |   4 +-
 Capless/Soundness/Preservation.lean        |   3 +-
 Capless/Store.lean                         |   3 -
 Capless/Subcapturing/Basic.lean            | 151 +++++++++------------
 Capless/Subst/Capture/Subcapturing.lean    |   4 +-
 Capless/Subst/Term/Subcapturing.lean       |   4 +-
 Capless/Subst/Type/Subcapturing.lean       |   4 +-
 Capless/Weakening/TypedCont/Capture.lean   |   1 -
 Capless/Weakening/TypedCont/Term.lean      |   3 -
 Capless/Weakening/TypedCont/Type.lean      |   1 -
 Capless/WellScoped/Basic.lean              |  74 +++-------
 14 files changed, 98 insertions(+), 163 deletions(-)

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index c229ed76..acbb100f 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -434,7 +434,6 @@ theorem Kind.Intersect.top_l {K : Kind} : Kind.top.intersect K = K := by
     . rename_i h1; unfold Classifier.subclass at h1; simp_all
     . simp
 
-
 inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   | empty_l : Subtract .empty K .empty
   | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index b565ed52..e0f5ad46 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -36,7 +36,7 @@ theorem CaptureKind.crename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd he => apply! absurd
+  case absurd hk he ih => apply! absurd (ih _)
 
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
@@ -51,7 +51,7 @@ theorem Subcapt.crename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.crename _)
   case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index daf8f4fa..e5f7ef57 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -36,7 +36,7 @@ theorem CaptureKind.rename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd => apply! absurd
+  case absurd hk he ih => apply! absurd (ih _)
 
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
@@ -51,7 +51,7 @@ theorem Subcapt.rename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.rename _)
   case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 79e0ecbb..85636a05 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -24,7 +24,7 @@ theorem CaptureKind.trename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd => apply! absurd
+  case absurd ih => apply! absurd (ih _)
 
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
@@ -39,7 +39,7 @@ theorem Subcapt.trename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.trename _)
   case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Soundness/Preservation.lean b/Capless/Soundness/Preservation.lean
index a2127960..9e336db1 100644
--- a/Capless/Soundness/Preservation.lean
+++ b/Capless/Soundness/Preservation.lean
@@ -94,7 +94,8 @@ theorem preservation
         { apply WellScoped.var_inv
           exact h2; easy }
         { easy } }
-      { rw [CaptureSet.open, CaptureSet.rename]
+      { simp [CaptureSet.open, CaptureSet.rename, FinFun.open]
+        simp [CaptureSet.weaken, CaptureSet.rename_rename, FinFun.open_comp_weaken, CaptureSet.rename_id]
         easy }
   case tapply hl =>
     cases ht
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 037cf0cd..08cbedb6 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -202,9 +202,6 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   Context.LBound Γ x c S ->
   Kind.Disjoint L (.classifier c) ->
   WellScoped Γ cont {x=x|L}
-| absurd : -- a completely projected away reference cannot be used, so it is always well-scoped.
-  L.IsEmpty ->
-  WellScoped Γ cont (.singleton s L)
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` with ambiant captures `Cin`
     through the continuation stack results in an output of type `Eout`,
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index b7a07b20..afbd9e94 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -183,69 +183,75 @@ theorem CaptureKind.var_lookup_inv
 theorem CaptureKind.label_lookup_inv
   (hs : CaptureKind Γ {x=x|K1} K)
   (hb : Γ.LBound x c S)
-  : K1.IsEmpty ∨ (Kind.intersect (.classifier c) K1).Subkind K := by
+  : (Kind.intersect (.classifier c) K1).Subkind K := by
   generalize h : {x=x|K1} = D at hs
   induction hs <;> cases h
   case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
   case label hb1 =>
     cases Context.lbound_inj hb hb1; subst_vars
-    right; exact .rfl
+    exact .rfl
   case sub hs1 _ ih =>
-    cases ih hb (.refl _)
-    case inl => aesop
-    case inr h => right; exact .trans h hs1
-  case absurd => aesop
+    apply Kind.Subkind.trans _ hs1
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply Kind.Subkind.is_empty_l
+    apply Kind.Subkind.empty_r_inv _ he
+    apply ih hb (.refl _)
 
 theorem CaptureKind.cbound_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.upper C)))
-  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih =>
     cases Context.cbound_injective hb hb2
-    right; assumption
+    assumption
   case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
   case sub hs hk ih =>
-    cases ih hb (.refl _)
-    case inl => left; assumption
-    case inr h => right; apply! sub
-  case absurd => aesop
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply absurd _ he
+    apply ih hb (.refl _)
 
 theorem CaptureKind.ckind_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.kind K1)))
-  : L.IsEmpty ∨ (K1.intersect L).Subkind K := by
+  : (K1.intersect L).Subkind K := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 =>
     cases Context.cbound_injective hb hb2
-    right; exact .rfl
+    exact .rfl
   case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
   case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
   case sub hs1 _ ih =>
-    cases ih hb (.refl _)
-    case inl => aesop
-    case inr h => right; exact .trans h hs1
-  case absurd => aesop
+    apply Kind.Subkind.trans _ hs1
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply Kind.Subkind.is_empty_l
+    apply Kind.Subkind.empty_r_inv _ he
+    apply ih hb (.refl _)
 
 theorem CaptureKind.cinst_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.inst C))
-  : L.IsEmpty ∨ CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
   case cinstr hb2 hk ih =>
     cases Context.cbound_injective hb hb2
-    right; assumption
+    assumption
   case sub hs hk ih =>
-    cases ih hb (.refl _)
-    case inl => left; assumption
-    case inr h => right; apply! sub
-  case absurd => aesop
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply absurd _ he
+    apply ih hb (.refl _)
 
 theorem CaptureKind.proj_merge
   (hk1 : CaptureKind Γ (.proj C K1) L1)
@@ -260,67 +266,40 @@ theorem CaptureKind.proj_merge
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply var hb
     apply subkind_proj _ Kind.Intersect.union_r_subkind
-    cases hk2.var_lookup_inv hb
-    case inl h =>
-      apply sub hs1
-      apply subkind_proj hk1
-      apply! Kind.Subkind.union_l .rfl $ .is_empty_l _
-    case inr h => apply ih h (.refl _)
+    apply ih _ (.refl _)
+    apply hk2.var_lookup_inv hb
   case label hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hk2.label_lookup_inv hb
-    case inl h =>
-      apply sub hs1
-      apply subkind_singleton (label hb)
-      apply Kind.Intersect.union_r_subkind.trans
-      apply Kind.Subkind.union_l .rfl $ .is_empty_l h
-    case inr h =>
-      apply sub
-      exact .union_l hs1 (.trans h hs2)
-      apply sub Kind.Intersect.union_r_subkind
-      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-      apply label hb
+    have h := hk2.label_lookup_inv hb
+    apply sub
+    exact .union_l hs1 (.trans h hs2)
+    apply sub Kind.Intersect.union_r_subkind
+    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+    apply label hb
   case cvar hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hk2.ckind_lookup_inv hb
-    case inl h =>
-      -- h : (p.intersect K2).IsEmpty
-      apply sub hs1
-      apply sub $ Kind.Intersect.with_subkind $
-        Kind.Subkind.trans Kind.Intersect.union_r_subkind $
-        Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
-      apply cvar hb
-    case inr h =>
-      -- h : ((p.intersect K2).intersect K).Subkind L2
-      apply sub
-      exact .union_l hs1 (.trans h hs2)
-      apply sub Kind.Intersect.union_r_subkind
-      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-      apply cvar hb
+    have h := hk2.ckind_lookup_inv hb
+    apply sub
+    exact .union_l hs1 (.trans h hs2)
+    apply sub Kind.Intersect.union_r_subkind
+    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+    apply cvar hb
   case cbound hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply cbound hb
     apply subkind_proj _ Kind.Intersect.union_r_subkind
-    cases hk2.cbound_lookup_inv hb
-    case inl h =>
-      apply sub hs1
-      apply subkind_proj hk1
-      apply Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
-    case inr h => apply ih h (.refl _)
+    have h := hk2.cbound_lookup_inv hb
+    apply ih h (.refl _)
   case cinstr hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply cinstr hb
     apply subkind_proj _ Kind.Intersect.union_r_subkind
-    cases hk2.cinst_lookup_inv hb
-    case inl h =>
-      apply sub hs1
-      apply subkind_proj hk1
-      apply Kind.Subkind.union_l .rfl $ Kind.Subkind.is_empty_l h
-    case inr h => apply ih h (.refl _)
+    have h := hk2.cinst_lookup_inv hb
+    apply ih h (.refl _)
   case sub hs hk1 ih =>
     subst_vars
     apply ih hk2
@@ -329,15 +308,10 @@ theorem CaptureKind.proj_merge
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     apply empty
-  case absurd =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply subkind_singleton
-    apply sub hs2 hk2
-    apply Kind.Subkind.trans
-    . apply Kind.Intersect.union_r_subkind
-    . apply Kind.Subkind.union_l _ .rfl
-      . apply! Kind.Subkind.is_empty_l
+  case absurd hk1 he ih =>
+    subst_vars
+    apply ih hk2 _ (.refl _)
+    apply Kind.Subkind.is_empty_l he
   case union ha hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -370,7 +344,9 @@ theorem CaptureKind.subcapt
     case cbound hb1 hk ih => cases Context.cbound_injective hb hb1
     case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
     case sub hs hk ih => apply sub hs; apply ih hb; rfl
-    case absurd he => apply! absurd_set
+    case absurd he hk ih =>
+      apply absurd _ he
+      apply ih hb (.refl _)
   case cinstr => apply! cinstr
   case cbound => apply! cbound
   case subkind K1 L hs =>
@@ -379,8 +355,8 @@ theorem CaptureKind.subcapt
     rw [← CaptureSet.proj] at hk
     rw [← CaptureSet.proj]
     apply subkind_proj hk hs
-  case absurd he =>
-    apply absurd_set
+  case absurd hk1 he =>
+    apply! absurd
   case proj_split =>
     have ⟨_, _⟩ := hk.union_l_inv
     apply! proj_merge_singleton
@@ -467,9 +443,9 @@ theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.pro
   case sub hs hk ih =>
     apply sub (Kind.Intersect.with_subkind_r hs) ih
   case empty => apply empty
-  case absurd he =>
-    apply absurd
-    apply Kind.Intersect.is_empty_l he
+  case absurd he hk ih =>
+    apply absurd ih
+    apply Kind.Intersect.is_empty_l hk
   case union ha hb => apply union ha hb
 
 theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
@@ -494,8 +470,11 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     apply trans (cbound hb) .proj_intersect_proj
   case subkind hs =>
     apply subkind $ Kind.Intersect.with_subkind_r hs
-  case proj_absurd he =>
-    apply proj_absurd $ Kind.Intersect.is_empty_l he
+  case absurd hk he =>
+    simp
+    apply absurd _ he
+    apply CaptureKind.sub _ hk.apply_proj
+    apply Kind.Intersect.subkind_l
   case proj_split =>
     simp
     apply proj_split
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index 5e95aea6..ea98f4eb 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -31,7 +31,7 @@ theorem CaptureKind.csubst
   case sub hs hk ih =>
     apply! sub hs (ih _)
   case empty => apply empty
-  case absurd he => apply! absurd
+  case absurd ih => apply! absurd (ih _)
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.csubst
@@ -49,7 +49,7 @@ theorem Subcapt.csubst
     cases σ.cmap_bound _ _ hb
     apply! apply_proj_singleton
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.csubst _)
   case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index 050bca61..fe3bd02a 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -30,7 +30,7 @@ theorem CaptureKind.subst
   case sub hs hk ih =>
     apply! sub hs (ih _)
   case empty => apply empty
-  case absurd he => apply! absurd
+  case absurd ih => apply! absurd (ih _)
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.subst
@@ -48,7 +48,7 @@ theorem Subcapt.subst
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.subst _)
   case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Type/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean
index a3640b4f..88120520 100644
--- a/Capless/Subst/Type/Subcapturing.lean
+++ b/Capless/Subst/Type/Subcapturing.lean
@@ -21,7 +21,7 @@ theorem CaptureKind.tsubst
   case cinstr hb hk ih => apply! cinstr (σ.cmap _ _ hb) (ih _)
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
-  case absurd he => apply! absurd
+  case absurd ih => apply! absurd (ih _)
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.tsubst
@@ -37,7 +37,7 @@ theorem Subcapt.tsubst
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
   case subkind hs => apply! subkind
-  case proj_absurd => apply! proj_absurd
+  case absurd hk he => apply! absurd (hk.tsubst _)
   case proj_split => apply! proj_split
 
 
diff --git a/Capless/Weakening/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean
index 60d5d9ac..368c41ef 100644
--- a/Capless/Weakening/TypedCont/Capture.lean
+++ b/Capless/Weakening/TypedCont/Capture.lean
@@ -102,7 +102,6 @@ theorem WellScoped.cweaken
       exact hb1 }
     { apply hs.cweaken }
   case label_disj hb hd => apply! label_disj hb.there_cvar
-  case absurd => apply! absurd
 
 theorem TypedCont.cweaken
   (h : TypedCont Γ Cin E t E' Ct) :
diff --git a/Capless/Weakening/TypedCont/Term.lean b/Capless/Weakening/TypedCont/Term.lean
index a095f88e..3ec85285 100644
--- a/Capless/Weakening/TypedCont/Term.lean
+++ b/Capless/Weakening/TypedCont/Term.lean
@@ -105,8 +105,6 @@ theorem WellScoped.weaken
       exact hb1 }
     { apply hs.weaken }
   case label_disj hb hd => apply label_disj hb.there_var hd
-  case absurd => apply! absurd
-
 
 theorem TypedCont.weaken
   (h : TypedCont Γ E Cin t E' C0) :
@@ -219,7 +217,6 @@ theorem WellScoped.lweaken
       exact hb1 }
     { apply hs.lweaken }
   case label_disj hb hd => apply! label_disj hb.there_label
-  case absurd => apply! absurd
 
 theorem TypedCont.lweaken
   (h : TypedCont Γ Cin E cont E' Ct) :
diff --git a/Capless/Weakening/TypedCont/Type.lean b/Capless/Weakening/TypedCont/Type.lean
index 6aadeb23..184f00b6 100644
--- a/Capless/Weakening/TypedCont/Type.lean
+++ b/Capless/Weakening/TypedCont/Type.lean
@@ -88,7 +88,6 @@ theorem WellScoped.tweaken
       exact hb1 }
     { apply hs.tweaken }
   case label_disj hb hd => apply! label_disj hb.there_tvar
-  case absurd => apply! absurd
 
 theorem TypedCont.tweaken
   (h : TypedCont Γ E Cin t E' C0) :
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index cd3574c4..190896d3 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -58,11 +58,6 @@ theorem WellScoped.subkind
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply label_disj hb
     apply hd.refine_subkind_l $ Kind.Intersect.with_subkind hs
-  case absurd he =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply absurd
-    apply (Kind.Intersect.with_subkind hs).of_empty he
 
 theorem WellScoped.subkind_singleton
   (hsc : WellScoped Γ cont (.singleton s L))
@@ -106,7 +101,6 @@ theorem WellScoped.cons
     constructor; assumption
   case label_disj hb hd =>
     apply! label_disj
-  case absurd => apply! absurd
 
 theorem WellScoped.conse
   (hsc : WellScoped Γ cont C) :
@@ -122,7 +116,6 @@ theorem WellScoped.conse
     apply label hb
     constructor; assumption
   case label_disj => apply! label_disj
-  case absurd => apply! absurd
 
 theorem WellScoped.scope
   (hsc : WellScoped Γ cont C) :
@@ -138,18 +131,7 @@ theorem WellScoped.scope
     apply label hb
     constructor; assumption
   case label_disj => apply! label_disj
-  case absurd => apply! absurd
 
-theorem WellScoped.absurd_set
-  (he : Kind.IsEmpty L)
-  : WellScoped Γ cont (.proj C L) := by
-  induction C
-  case empty => simp; constructor
-  case union ha hb => simp; apply! union
-  case singleton =>
-    simp
-    apply absurd
-    apply! Kind.Subkind.of_empty Kind.Intersect.subkind_r
 
 theorem WellScoped.proj_merge
   (hsc1 : WellScoped Γ cont (.proj C K1))
@@ -176,13 +158,6 @@ theorem WellScoped.proj_merge
       apply! ih _ (.refl _)
     case label hb2 _ => cases Context.bound_lbound_absurd hb hb2
     case label_disj hb2 _ => cases Context.bound_lbound_absurd hb hb2
-    case absurd p he =>
-      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
-        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
-        apply Kind.Subkind.union_l .rfl
-        apply! Kind.Subkind.is_empty_l
-      apply subkind_singleton _ h
-      apply! singleton
   case csingleton hb hsc ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -194,13 +169,6 @@ theorem WellScoped.proj_merge
       apply! ih _ (.refl _)
     case cbound hb2 _ => cases Context.cbound_injective hb hb2
     case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd p he =>
-      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
-        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
-        apply Kind.Subkind.union_l .rfl
-        apply! Kind.Subkind.is_empty_l
-      apply subkind_singleton _ h
-      apply! csingleton
   case cbound hb hsc ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -212,13 +180,6 @@ theorem WellScoped.proj_merge
       apply subkind _ Kind.Intersect.union_r_subkind
       apply! ih _ (.refl _)
     case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd p he =>
-      have h : (p.intersect (K1.union K2)).Subkind (p.intersect K1) := by
-        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
-        apply Kind.Subkind.union_l .rfl
-        apply! Kind.Subkind.is_empty_l
-      apply subkind_singleton _ h
-      apply! cbound
   case ckind hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -238,18 +199,6 @@ theorem WellScoped.proj_merge
       subst_vars
       have h := Kind.Disjoint.union_l hd hd2
       apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
-    case absurd he =>
-      have h := Kind.Disjoint.union_l hd (.is_empty_l he)
-      apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
-  case absurd he =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    rename_i p
-    have h : (p.intersect (K1.union K2)).Subkind (p.intersect K2) := by
-      apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
-      apply Kind.Subkind.union_l _ .rfl
-      apply Kind.Subkind.is_empty_l he
-    apply! subkind_singleton _ h
 
 theorem WellScoped.proj_merge_singleton
   (hs1 : WellScoped Γ cont (.singleton s K1))
@@ -261,6 +210,24 @@ theorem WellScoped.proj_merge_singleton
   rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
   apply! proj_merge
 
+theorem WellScoped.absurd
+  (hk : CaptureKind Γ C K)
+  (he : K.IsEmpty)
+  : WellScoped Γ cont C := by
+  induction hk
+  case var hb hk ih => apply! singleton hb (ih _)
+  case label hl =>
+    apply label_disj hl
+    apply Kind.Disjoint.symm
+    apply Kind.Disjoint.from_empty_intersect Kind.Intersect.lawful he
+  case cvar hb => apply ckind hb
+  case cbound hb hk ih => apply! cbound hb (ih _)
+  case cinstr hb hk ih => apply! csingleton hb (ih _)
+  case sub hs hk ih => apply ih; apply hs.empty_r_inv he
+  case empty => constructor
+  case absurd hk he1 ih => apply! ih
+  case union ha hb => simp_all; apply! union
+
 
 theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
   induction hsub
@@ -278,11 +245,10 @@ theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C
       cases Context.cbound_injective hb1 hb
     case ckind hb1 =>
       cases Context.cbound_injective hb1 hb
-    case absurd he => apply! absurd_set
   case cinstr hb => apply! csingleton
   case cbound hb => apply! cbound
   case subkind => apply! hsc.subkind_singleton
-  case proj_absurd he => apply! absurd
+  case absurd hk he => apply! absurd
   case proj_split =>
     cases hsc
     apply! proj_merge_singleton
@@ -303,7 +269,6 @@ theorem WellScoped.var_inv
   case label_disj =>
     exfalso
     apply Context.bound_lbound_absurd <;> easy
-  case absurd he => cases he.is_absurd
 
 theorem WellScoped.label_inv
   (hsc : WellScoped Γ cont {x=x|.top})
@@ -315,6 +280,5 @@ theorem WellScoped.label_inv
     apply Context.bound_lbound_absurd <;> easy
   case label => aesop
   case label_disj hd => cases hd.top_l.is_absurd
-  case absurd he => cases he.is_absurd
 
 end Capless

From 03d7af998e3ff718c8f8bd5c0b793607e2ea60dc Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Fri, 19 Dec 2025 21:04:04 +0100
Subject: [PATCH 54/71] WIP split WellScoped to ReachSet and WellScoped

Ideally we should have ReachSet be subsetted instead of subcaptured, but since projection exists, maybe it's better to move the subkind rules to subsetting.
---
 Capless/Store.lean            |  45 ++-
 Capless/WellScoped/Basic.lean | 595 +++++++++++++++++++---------------
 2 files changed, 371 insertions(+), 269 deletions(-)

diff --git a/Capless/Store.lean b/Capless/Store.lean
index 08cbedb6..2c15c2af 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -169,6 +169,32 @@ theorem Cont.HasLabel.has_intercept (hl : HasLabel cont l tail) : ∃ h tail', H
     . exists .some h0, cont; apply HasIntercept.here_intercept hl hd;
     . exists h, tail; apply! HasIntercept.there_intercept
 
+/-- Computes the reach set of a capture set. The reach set should only consist of capture variables and -/
+inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
+| empty : ReachSet Γ .empty .empty
+| union :
+  ReachSet Γ C1 R1 ->
+  ReachSet Γ C2 R2 ->
+  ReachSet Γ (C1 ∪ C2) (R1 ∪ R2)
+| var :
+  Context.Bound Γ x (S^C) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {x=x|L} R
+| cinstr :
+  Context.CBound Γ c (CBinding.inst C) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {c=c|L} R
+| cbound :
+  Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {c=c|L} R
+| ckind :
+  Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
+  ReachSet Γ {c=c|L} {c=c|L}
+| label :
+  Context.LBound Γ x c S ->
+  ReachSet Γ {x=x|L} {x=x|L}
+
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
  -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
  -- This is an invariant to be maintained thoroughout evaluation. -/
@@ -179,18 +205,6 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   WellScoped Γ cont C1 ->
   WellScoped Γ cont C2 ->
   WellScoped Γ cont (.union C1 C2)
-| singleton :
-  Context.Bound Γ x (S^C) ->
-  WellScoped Γ cont (C.proj L) ->
-  WellScoped Γ cont {x=x|L}
-| csingleton :
-  Context.CBound Γ c (CBinding.inst C) ->
-  WellScoped Γ cont (C.proj L) ->
-  WellScoped Γ cont {c=c|L}
-| cbound :
-  Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  WellScoped Γ cont (C.proj L) ->
-  WellScoped Γ cont {c=c|L}
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c|L}
@@ -234,13 +248,14 @@ inductive TypedCont : Context n m k -> EType n m k -> CaptureSet n k -> Cont n m
 
 
 /-- Typecheck an evaluation state. -/
-inductive TypedState : State n m k -> Context n m k -> EType n m k -> Prop where
+inductive TypedState : State n m k -> Context n m k -> EType n m k -> CaptureSet n k -> Prop where
 | mk :
   TypedStore σ Γ ->
   Typed Γ t E Ct ->
-  WellScoped Γ cont Ct ->
+  ReachSet Γ Ct Rt ->
+  WellScoped Γ cont Rt ->
   TypedCont Γ E Ct cont E' C ->
-  TypedState (State.mk σ cont t) Γ E'
+  TypedState (State.mk σ cont t) Γ E' Rt
 
 /-!
 ## Store Lookup
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 190896d3..2f397a13 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,274 +11,361 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
-theorem WellScoped.subkind
-  (hsc : WellScoped Γ cont (.proj C K2))
-  (hs : K1.Subkind K2)
-  : WellScoped Γ cont (.proj C K1) := by
-  generalize h : C.proj K2 = D at hsc
-  induction hsc generalizing C K2 K1
+theorem ReachSet.inj
+  (hr1 : ReachSet Γ C R1)
+  (hr2 : ReachSet Γ C R2)
+  : R1 = R2 := by
+  induction hr1 generalizing R2
+  case empty => cases hr2; simp
+  case union ha hb => cases hr2; simp; apply! And.intro (ha _) (hb _)
+  case var hb1 hr1 ih =>
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_injective hb1 hb2; apply! ih
+    case label hb2 => cases Context.bound_lbound_absurd hb1 hb2
+  case cinstr hb1 hr1 ih =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2
+  case cbound hb1 hr1 ih =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2
+  case ckind hb1 =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2; simp
+  case label hb1 =>
+    cases hr2
+    case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
+    case label hb2 => cases Context.lbound_inj hb1 hb2; simp
+
+theorem ReachSet.subset
+  (hs : C1 ⊆ C2)
+  (hr1 : ReachSet Γ C2 R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
+  induction hs generalizing R2
   case empty =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    simp; constructor
+    exists .empty; apply And.intro .empty .empty
+  case rfl =>
+    exists R2; apply And.intro .rfl hr1
+  case union_l ha hb =>
+    have ⟨R1, hs1, h1⟩ := ha hr1
+    have ⟨R2, hs2, h2⟩ := hb hr1
+    exists R1 ∪ R2
+    apply And.intro $ .union_l hs1 hs2
+    apply! union
+  case union_rl ih =>
+    cases hr1
+    rename_i R1 R2 h1 h2
+    have ⟨R, hs, h⟩ := ih h1
+    exists R; apply And.intro (.union_rl hs) h
+  case union_rr ih =>
+    cases hr1
+    rename_i R1 R2 h1 h2
+    have ⟨R, hs, h⟩ := ih h2
+    exists R; apply And.intro (.union_rr hs) h
+
+
+theorem ReachSet.subcapt
+  (hr2 : ReachSet Γ C2 R2)
+  (hs : Subcapt Γ C1 C2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
+  induction hs generalizing R2
+  case trans ha hb =>
+    have ⟨R2, hs2, hr⟩ := hb hr2
+    have ⟨R1, hs1, hr⟩ := ha hr
+    exists R1
+    apply! And.intro (.trans _ _)
+  case subset => apply! subset
   case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
-  case singleton hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply singleton hb
-    apply ih
-    apply Kind.Intersect.with_subkind hs
-    apply! refl
-  case csingleton hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply csingleton hb
-    apply ih
-    apply Kind.Intersect.with_subkind hs
-    apply! refl
-  case cbound hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cbound hb
-    apply ih
-    apply Kind.Intersect.with_subkind hs
-    apply! refl
-  case ckind hb ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply! ckind
-  case label hb hl =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply! label
-  case label_disj hb hd =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply label_disj hb
-    apply hd.refine_subkind_l $ Kind.Intersect.with_subkind hs
+    have ⟨Ra, hsa, hra⟩ := ha hr2
+    have ⟨Rb, hsb, hrb⟩ := hb hr2
+    exists Ra ∪ Rb
+    apply! And.intro (.union_l _ _) (.union _ _)
+  case var hb => exists R2; apply And.intro .rfl; apply! var
+  case cinstl hb =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+  case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
+  case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
+  case subkind hs =>
+    -- time to push subkinding to subsetting
 
-theorem WellScoped.subkind_singleton
-  (hsc : WellScoped Γ cont (.singleton s L))
-  (hs : Kind.Subkind K L)
-  : WellScoped Γ cont (.singleton s K) := by
-  rw [← Kind.Intersect.top_l (K:=L)] at hsc
-  have h : CaptureSet.proj (.singleton s .top) L = .singleton s (.intersect .top L) := by simp
-  rw [← h] at hsc
-  have h1 := hsc.subkind hs
-  simp only [CaptureSet.proj] at h1
-  rw [Kind.Intersect.top_l] at h1
-  assumption
 
-theorem WellScoped.subset {C1 C2 : CaptureSet n k}
-  (hsc : WellScoped Γ cont C2)
-  (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
-  induction hs
-  case empty => apply empty
-  case rfl => assumption
-  case union_l ha hb iha ihb =>
-    apply! union (iha _) (ihb _)
-  case union_rl ha iha =>
-    cases hsc
-    apply! iha
-  case union_rr ha iha =>
-    cases hsc
-    apply! iha
 
-theorem WellScoped.cons
-  (hsc : WellScoped Γ cont C) :
-  WellScoped Γ (Cont.cons u cont) C := by
-  induction hsc
-  case empty => apply empty
-  case union => apply union <;> aesop
-  case singleton ih => apply singleton <;> aesop
-  case csingleton ih => apply csingleton <;> aesop
-  case cbound ih => apply cbound <;> aesop
-  case ckind ih => apply ckind <;> aesop
-  case label hb hl =>
-    apply label hb
-    constructor; assumption
-  case label_disj hb hd =>
-    apply! label_disj
+-- theorem WellScoped.subkind
+--   (hsc : WellScoped Γ cont (.proj C K2))
+--   (hs : K1.Subkind K2)
+--   : WellScoped Γ cont (.proj C K1) := by
+--   generalize h : C.proj K2 = D at hsc
+--   induction hsc generalizing C K2 K1
+--   case empty =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     simp; constructor
+--   case union ha hb =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+--   case singleton hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply singleton hb
+--     apply ih
+--     apply Kind.Intersect.with_subkind hs
+--     apply! refl
+--   case csingleton hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply csingleton hb
+--     apply ih
+--     apply Kind.Intersect.with_subkind hs
+--     apply! refl
+--   case cbound hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply cbound hb
+--     apply ih
+--     apply Kind.Intersect.with_subkind hs
+--     apply! refl
+--   case ckind hb ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply! ckind
+--   case label hb hl =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply! label
+--   case label_disj hb hd =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply label_disj hb
+--     apply hd.refine_subkind_l $ Kind.Intersect.with_subkind hs
 
-theorem WellScoped.conse
-  (hsc : WellScoped Γ cont C) :
-  WellScoped Γ (Cont.conse u cont) C := by
-  induction hsc
-  case empty => apply empty
-  case union => apply union <;> aesop
-  case singleton ih => apply singleton <;> aesop
-  case csingleton ih => apply csingleton <;> aesop
-  case cbound ih => apply cbound <;> aesop
-  case ckind ih => apply ckind <;> aesop
-  case label hb hl =>
-    apply label hb
-    constructor; assumption
-  case label_disj => apply! label_disj
+-- theorem WellScoped.subkind_singleton
+--   (hsc : WellScoped Γ cont (.singleton s L))
+--   (hs : Kind.Subkind K L)
+--   : WellScoped Γ cont (.singleton s K) := by
+--   rw [← Kind.Intersect.top_l (K:=L)] at hsc
+--   have h : CaptureSet.proj (.singleton s .top) L = .singleton s (.intersect .top L) := by simp
+--   rw [← h] at hsc
+--   have h1 := hsc.subkind hs
+--   simp only [CaptureSet.proj] at h1
+--   rw [Kind.Intersect.top_l] at h1
+--   assumption
 
-theorem WellScoped.scope
-  (hsc : WellScoped Γ cont C) :
-  WellScoped Γ (Cont.scope x cont) C := by
-  induction hsc
-  case empty => apply empty
-  case union => apply union <;> aesop
-  case singleton ih => apply singleton <;> aesop
-  case csingleton ih => apply csingleton <;> aesop
-  case cbound ih => apply cbound <;> aesop
-  case ckind ih => apply ckind <;> aesop
-  case label hb hl =>
-    apply label hb
-    constructor; assumption
-  case label_disj => apply! label_disj
+-- theorem WellScoped.subset {C1 C2 : CaptureSet n k}
+--   (hsc : WellScoped Γ cont C2)
+--   (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
+--   induction hs
+--   case empty => apply empty
+--   case rfl => assumption
+--   case union_l ha hb iha ihb =>
+--     apply! union (iha _) (ihb _)
+--   case union_rl ha iha =>
+--     cases hsc
+--     apply! iha
+--   case union_rr ha iha =>
+--     cases hsc
+--     apply! iha
 
+-- theorem WellScoped.cons
+--   (hsc : WellScoped Γ cont C) :
+--   WellScoped Γ (Cont.cons u cont) C := by
+--   induction hsc
+--   case empty => apply empty
+--   case union => apply union <;> aesop
+--   case singleton ih => apply singleton <;> aesop
+--   case csingleton ih => apply csingleton <;> aesop
+--   case cbound ih => apply cbound <;> aesop
+--   case ckind ih => apply ckind <;> aesop
+--   case label hb hl =>
+--     apply label hb
+--     constructor; assumption
+--   case label_disj hb hd =>
+--     apply! label_disj
 
-theorem WellScoped.proj_merge
-  (hsc1 : WellScoped Γ cont (.proj C K1))
-  (hsc2 : WellScoped Γ cont (.proj C K2))
-  : WellScoped Γ cont (.proj C (K1.union K2)) := by
-  generalize h : C.proj K1 = D at hsc1
-  induction hsc1 generalizing C K1 K2
-  case empty =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    simp; constructor
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hsc2
-    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
-  case singleton hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hsc2
-    case singleton hb2 hsc2 =>
-      cases Context.bound_injective hb hb2
-      apply singleton hb
-      apply subkind _ Kind.Intersect.union_r_subkind
-      apply! ih _ (.refl _)
-    case label hb2 _ => cases Context.bound_lbound_absurd hb hb2
-    case label_disj hb2 _ => cases Context.bound_lbound_absurd hb hb2
-  case csingleton hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hsc2
-    case csingleton hb2 hsc2 =>
-      cases Context.cbound_injective hb hb2
-      apply csingleton hb
-      apply subkind _ Kind.Intersect.union_r_subkind
-      apply! ih _ (.refl _)
-    case cbound hb2 _ => cases Context.cbound_injective hb hb2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-  case cbound hb hsc ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hsc2
-    case csingleton hb2 _ => cases Context.cbound_injective hb hb2
-    case cbound hb2 hsc2 =>
-      cases Context.cbound_injective hb hb2
-      apply cbound hb
-      apply subkind _ Kind.Intersect.union_r_subkind
-      apply! ih _ (.refl _)
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-  case ckind hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply! ckind
-  case label hb hl =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply! label
-  case label_disj hb hd =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hsc2
-    case singleton hb2 _ => cases Context.bound_lbound_absurd hb2 hb
-    case label hb hl => apply! label
-    case label_disj hb2 hd2 =>
-      cases Context.lbound_inj hb hb2
-      subst_vars
-      have h := Kind.Disjoint.union_l hd hd2
-      apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
+-- theorem WellScoped.conse
+--   (hsc : WellScoped Γ cont C) :
+--   WellScoped Γ (Cont.conse u cont) C := by
+--   induction hsc
+--   case empty => apply empty
+--   case union => apply union <;> aesop
+--   case singleton ih => apply singleton <;> aesop
+--   case csingleton ih => apply csingleton <;> aesop
+--   case cbound ih => apply cbound <;> aesop
+--   case ckind ih => apply ckind <;> aesop
+--   case label hb hl =>
+--     apply label hb
+--     constructor; assumption
+--   case label_disj => apply! label_disj
 
-theorem WellScoped.proj_merge_singleton
-  (hs1 : WellScoped Γ cont (.singleton s K1))
-  (hs2 : WellScoped Γ cont (.singleton s K2))
-  : WellScoped Γ cont (.singleton s (K1.union K2)) := by
-  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
-  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
-  rw [← CaptureSet.proj] at hs1 hs2
-  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
-  apply! proj_merge
+-- theorem WellScoped.scope
+--   (hsc : WellScoped Γ cont C) :
+--   WellScoped Γ (Cont.scope x cont) C := by
+--   induction hsc
+--   case empty => apply empty
+--   case union => apply union <;> aesop
+--   case singleton ih => apply singleton <;> aesop
+--   case csingleton ih => apply csingleton <;> aesop
+--   case cbound ih => apply cbound <;> aesop
+--   case ckind ih => apply ckind <;> aesop
+--   case label hb hl =>
+--     apply label hb
+--     constructor; assumption
+--   case label_disj => apply! label_disj
 
-theorem WellScoped.absurd
-  (hk : CaptureKind Γ C K)
-  (he : K.IsEmpty)
-  : WellScoped Γ cont C := by
-  induction hk
-  case var hb hk ih => apply! singleton hb (ih _)
-  case label hl =>
-    apply label_disj hl
-    apply Kind.Disjoint.symm
-    apply Kind.Disjoint.from_empty_intersect Kind.Intersect.lawful he
-  case cvar hb => apply ckind hb
-  case cbound hb hk ih => apply! cbound hb (ih _)
-  case cinstr hb hk ih => apply! csingleton hb (ih _)
-  case sub hs hk ih => apply ih; apply hs.empty_r_inv he
-  case empty => constructor
-  case absurd hk he1 ih => apply! ih
-  case union ha hb => simp_all; apply! union
 
+-- theorem WellScoped.proj_merge
+--   (hsc1 : WellScoped Γ cont (.proj C K1))
+--   (hsc2 : WellScoped Γ cont (.proj C K2))
+--   : WellScoped Γ cont (.proj C (K1.union K2)) := by
+--   generalize h : C.proj K1 = D at hsc1
+--   induction hsc1 generalizing C K1 K2
+--   case empty =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     simp; constructor
+--   case union ha hb =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     cases hsc2
+--     apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+--   case singleton hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     cases hsc2
+--     case singleton hb2 hsc2 =>
+--       cases Context.bound_injective hb hb2
+--       apply singleton hb
+--       apply subkind _ Kind.Intersect.union_r_subkind
+--       apply! ih _ (.refl _)
+--     case label hb2 _ => cases Context.bound_lbound_absurd hb hb2
+--     case label_disj hb2 _ => cases Context.bound_lbound_absurd hb hb2
+--   case csingleton hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     cases hsc2
+--     case csingleton hb2 hsc2 =>
+--       cases Context.cbound_injective hb hb2
+--       apply csingleton hb
+--       apply subkind _ Kind.Intersect.union_r_subkind
+--       apply! ih _ (.refl _)
+--     case cbound hb2 _ => cases Context.cbound_injective hb hb2
+--     case ckind hb2 => cases Context.cbound_injective hb hb2
+--   case cbound hb hsc ih =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     cases hsc2
+--     case csingleton hb2 _ => cases Context.cbound_injective hb hb2
+--     case cbound hb2 hsc2 =>
+--       cases Context.cbound_injective hb hb2
+--       apply cbound hb
+--       apply subkind _ Kind.Intersect.union_r_subkind
+--       apply! ih _ (.refl _)
+--     case ckind hb2 => cases Context.cbound_injective hb hb2
+--   case ckind hb =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply! ckind
+--   case label hb hl =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     apply! label
+--   case label_disj hb hd =>
+--     unfold CaptureSet.proj at h; split at h <;> simp at h
+--     have ⟨_, _⟩ := h; subst_vars; simp_all
+--     cases hsc2
+--     case singleton hb2 _ => cases Context.bound_lbound_absurd hb2 hb
+--     case label hb hl => apply! label
+--     case label_disj hb2 hd2 =>
+--       cases Context.lbound_inj hb hb2
+--       subst_vars
+--       have h := Kind.Disjoint.union_l hd hd2
+--       apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
 
-theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
-  induction hsub
-  case trans ha hb iha ihb => apply! iha $ ihb _
-  case subset hsub => apply! hsc.subset
-  case union ha hb iha ihb =>
-    apply! union (iha _) (ihb _)
-  case var hb => apply! singleton
-  case cinstl hb =>
-    cases hsc
-    case csingleton hb1 _ =>
-      cases Context.cbound_injective hb1 hb
-      assumption
-    case cbound hb1 _ =>
-      cases Context.cbound_injective hb1 hb
-    case ckind hb1 =>
-      cases Context.cbound_injective hb1 hb
-  case cinstr hb => apply! csingleton
-  case cbound hb => apply! cbound
-  case subkind => apply! hsc.subkind_singleton
-  case absurd hk he => apply! absurd
-  case proj_split =>
-    cases hsc
-    apply! proj_merge_singleton
+-- theorem WellScoped.proj_merge_singleton
+--   (hs1 : WellScoped Γ cont (.singleton s K1))
+--   (hs2 : WellScoped Γ cont (.singleton s K2))
+--   : WellScoped Γ cont (.singleton s (K1.union K2)) := by
+--   rw [← Kind.Intersect.top_l (K:=K1)] at hs1
+--   rw [← Kind.Intersect.top_l (K:=K2)] at hs2
+--   rw [← CaptureSet.proj] at hs1 hs2
+--   rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
+--   apply! proj_merge
+
+-- theorem WellScoped.absurd
+--   (hk : CaptureKind Γ C K)
+--   (he : K.IsEmpty)
+--   : WellScoped Γ cont C := by
+--   induction hk
+--   case var hb hk ih => apply! singleton hb (ih _)
+--   case label hl =>
+--     apply label_disj hl
+--     apply Kind.Disjoint.symm
+--     apply Kind.Disjoint.from_empty_intersect Kind.Intersect.lawful he
+--   case cvar hb => apply ckind hb
+--   case cbound hb hk ih => apply! cbound hb (ih _)
+--   case cinstr hb hk ih => apply! csingleton hb (ih _)
+--   case sub hs hk ih => apply ih; apply hs.empty_r_inv he
+--   case empty => constructor
+--   case absurd hk he1 ih => apply! ih
+--   case union ha hb => simp_all; apply! union
+
+
+-- theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
+--   induction hsub
+--   case trans ha hb iha ihb => apply! iha $ ihb _
+--   case subset hsub => apply! hsc.subset
+--   case union ha hb iha ihb =>
+--     apply! union (iha _) (ihb _)
+--   case var hb => apply! singleton
+--   case cinstl hb =>
+--     cases hsc
+--     case csingleton hb1 _ =>
+--       cases Context.cbound_injective hb1 hb
+--       assumption
+--     case cbound hb1 _ =>
+--       cases Context.cbound_injective hb1 hb
+--     case ckind hb1 =>
+--       cases Context.cbound_injective hb1 hb
+--   case cinstr hb => apply! csingleton
+--   case cbound hb => apply! cbound
+--   case subkind => apply! hsc.subkind_singleton
+--   case absurd hk he => apply! absurd
+--   case proj_split =>
+--     cases hsc
+--     apply! proj_merge_singleton
 
-theorem WellScoped.var_inv
-  (hsc : WellScoped Γ cont {x=x|.top})
-  (hbx : Γ.Bound x (S^C)) :
-  WellScoped Γ cont C := by
-  cases hsc
-  case singleton hbx' _ =>
-    have h := Context.bound_injective hbx hbx'
-    cases h
-    rw [CaptureSet.proj_top] at *
-    trivial
-  case label =>
-    exfalso
-    apply Context.bound_lbound_absurd <;> easy
-  case label_disj =>
-    exfalso
-    apply Context.bound_lbound_absurd <;> easy
+-- theorem WellScoped.var_inv
+--   (hsc : WellScoped Γ cont {x=x|.top})
+--   (hbx : Γ.Bound x (S^C)) :
+--   WellScoped Γ cont C := by
+--   cases hsc
+--   case singleton hbx' _ =>
+--     have h := Context.bound_injective hbx hbx'
+--     cases h
+--     rw [CaptureSet.proj_top] at *
+--     trivial
+--   case label =>
+--     exfalso
+--     apply Context.bound_lbound_absurd <;> easy
+--   case label_disj =>
+--     exfalso
+--     apply Context.bound_lbound_absurd <;> easy
 
-theorem WellScoped.label_inv
-  (hsc : WellScoped Γ cont {x=x|.top})
-  (hbl : Γ.LBound x c S) :
-  ∃ tail, cont.HasLabel x tail := by
-  cases hsc
-  case singleton =>
-    exfalso
-    apply Context.bound_lbound_absurd <;> easy
-  case label => aesop
-  case label_disj hd => cases hd.top_l.is_absurd
+-- theorem WellScoped.label_inv
+--   (hsc : WellScoped Γ cont {x=x|.top})
+--   (hbl : Γ.LBound x c S) :
+--   ∃ tail, cont.HasLabel x tail := by
+--   cases hsc
+--   case singleton =>
+--     exfalso
+--     apply Context.bound_lbound_absurd <;> easy
+--   case label => aesop
+--   case label_disj hd => cases hd.top_l.is_absurd
 
 end Capless

From f899517443081c162151d089ddd2d273dca5fdd7 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 22 Dec 2025 11:27:36 +0100
Subject: [PATCH 55/71] Move subkinding rules to subsetting

---
 Capless/CaptureSet.lean               |  85 +++++--
 Capless/Subcapturing.lean             |   7 -
 Capless/Subcapturing/Basic.lean       | 330 ++------------------------
 Capless/Subcapturing/CaptureKind.lean | 299 +++++++++++++++++++++++
 4 files changed, 382 insertions(+), 339 deletions(-)
 create mode 100644 Capless/Subcapturing/CaptureKind.lean

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index d3706365..9421f49c 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -44,8 +44,10 @@ def CaptureSet.proj (c : CaptureSet n k) (K : Kind) :=
   | singleton s p => singleton s (p.intersect K)
 
 theorem CaptureSet.proj_top {C : CaptureSet n k} : C.proj .top = C := by
-  induction C <;> try aesop
-  apply Kind.Intersect.top_r
+  induction C
+  case empty => aesop
+  case union ha hb => aesop
+  case singleton => simp; apply Kind.Intersect.top_r
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
@@ -72,37 +74,58 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | union_rr :
   Subset C C2 ->
   Subset C (C1 ∪ C2)
+| singleton_subkind :
+  K.Subkind L ->
+  Subset (.singleton s K) (.singleton s L)
+| proj_merge:
+  Subset (.singleton s (.union L1 L2)) (.union (.singleton s L1) (.singleton s L2))
+| trans : Subset A B -> Subset B C -> Subset A C
 
 @[simp]
 instance : HasSubset (CaptureSet n k) where
   Subset := CaptureSet.Subset
 
 theorem CaptureSet.Subset.union_l_inv (hs : Subset (.union a1 a2) b) : Subset a1 b ∧ Subset a2 b := by
-  cases hs
+  generalize h : (CaptureSet.union a1 a2) = C at hs
+  induction hs generalizing a1 a2 <;> cases h
   case rfl =>
     apply And.intro
     apply union_rl .rfl
     apply union_rr .rfl
   case union_l => apply! And.intro
   case union_rl ha =>
-    have ⟨_, _⟩ := ha.union_l_inv
+    have ⟨_, _⟩ := ha (.refl _)
     apply And.intro <;> apply! union_rl
   case union_rr ha =>
-    have ⟨_, _⟩ := ha.union_l_inv
+    have ⟨_, _⟩ := ha (.refl _)
     apply And.intro <;> apply! union_rr
+  case trans ha iha hb ihb =>
+    have ⟨_, _⟩ := ihb (.refl _)
+    apply And.intro <;> apply! trans _ ha
+
+
+-- theorem CaptureSet.Subset.trans (hs1 : Subset a b) (hs2 : Subset b c) : Subset a c := by
+--   induction hs1
+--   case empty => constructor
+--   case rfl => assumption
+--   case union_l ha hb iha ihb =>
+--     apply! union_l (iha _) (ihb _)
+--   case union_rl ha iha =>
+--     have ⟨_, _⟩ := hs2.union_l_inv
+--     apply! iha
+--   case union_rr ha iha =>
+--     have ⟨_, _⟩ := hs2.union_l_inv
+--     apply! iha
+--   case singleton_subkind s K L hs =>
+--     generalize h : (singleton s L) = D at hs2
+--     induction hs2 <;> cases h
+--     case rfl => apply! singleton_subkind
+--     case union_rl ih => apply union_rl (ih (.refl _))
+--     case union_rr ih => apply union_rr (ih (.refl _))
+--     case singleton_subkind hs2 => apply singleton_subkind (hs.trans hs2)
+--     case proj_merge hs2 => apply proj_merge (hs.trans hs2)
+--   case proj_merge
 
-theorem CaptureSet.Subset.trans (hs1 : Subset a b) (hs2 : Subset b c) : Subset a c := by
-  induction hs1
-  case empty => constructor
-  case rfl => assumption
-  case union_l ha hb iha ihb =>
-    apply! union_l (iha _) (ihb _)
-  case union_rl ha iha =>
-    have ⟨_, _⟩ := hs2.union_l_inv
-    apply! iha
-  case union_rr ha iha =>
-    have ⟨_, _⟩ := hs2.union_l_inv
-    apply! iha
 
 
 @[simp]
@@ -114,6 +137,14 @@ theorem CaptureSet.Subset.union_monotone {C1 C2 D1 D2 : CaptureSet n k} (hc : Su
   apply! union_rl
   apply! union_rr
 
+theorem CaptureSet.Subset.subkind {C : CaptureSet n k}
+  (hk : K.Subkind L)
+  : Subset (C.proj K) (C.proj L) := by
+  induction C
+  case empty => simp; constructor
+  case union ha hb => apply! union_monotone
+  case singleton => simp; apply singleton_subkind (Kind.Intersect.with_subkind hk)
+
 /-!
 ## Renaming operations
 -/
@@ -288,6 +319,11 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
     apply! Subset.union_rl
   case union_rr ha ih =>
     apply! Subset.union_rr
+  case singleton_subkind s K L hk =>
+    cases s <;> (simp; apply! Subset.singleton_subkind)
+  case proj_merge s L1 L2 =>
+    cases s <;> (simp; apply! Subset.proj_merge)
+  case trans ha hb => apply! Subset.trans
 
 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
@@ -301,6 +337,11 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
     apply! Subset.union_rl
   case union_rr ha ih =>
     apply! Subset.union_rr
+  case singleton_subkind s K L hk =>
+    cases s <;> (apply! Subset.singleton_subkind)
+  case proj_merge s L1 L2 =>
+    cases s <;> (apply! Subset.proj_merge)
+  case trans ha hb => apply! Subset.trans
 
 theorem CaptureSet.cweaken_def {C : CaptureSet n k} :
   C.cweaken = C.crename FinFun.weaken := by
@@ -317,6 +358,10 @@ theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K
   case union_l ha hb => apply! union_l
   case union_rl ha => apply! union_rl
   case union_rr hb => apply! union_rr
+  case singleton_subkind hs =>
+    apply singleton_subkind $ Kind.Intersect.with_subkind_r hs
+  case proj_merge => apply proj_merge
+  case trans ha hb => apply! trans
 
 theorem CaptureSet.proj_rename {C : CaptureSet n k} : (C.proj K).rename f = (C.rename f).proj K := by
   induction C
@@ -332,3 +377,9 @@ theorem CaptureSet.proj_crename {C : CaptureSet n k} : (C.proj K).crename f = (C
 
 theorem CaptureSet.proj_weaken {C : CaptureSet n k} : (C.proj K).weaken = (C.weaken).proj K := C.proj_rename
 theorem CaptureSet.proj_cweaken {C : CaptureSet n k} : (C.proj K).cweaken = (C.cweaken).proj K := C.proj_crename
+
+theorem CaptureSet.Subset.proj_l : Subset (C.proj K) C := by
+  induction C
+  case empty => constructor
+  case union ha hb => simp; apply! union_monotone
+  case singleton => apply singleton_subkind; apply Kind.Intersect.subkind_l
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index a1697e49..8b85d8fe 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -46,14 +46,7 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
-| subkind : K.Subkind L -> Subcapt Γ (.singleton s K) (.singleton s L)
 | absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
-| proj_split : Subcapt Γ (.singleton s (.union K1 K2)) (.union (.singleton s K1) (.singleton s K2))
-
-theorem Subcapt.proj_merge : Subcapt Γ (.union (.singleton s K1) (.singleton s K2)) (.singleton s (.union K1 K2)) := by
-  apply union
-  . apply subkind $ .union_rl (K2:=K2)
-  . apply subkind .union_rr
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index afbd9e94..7a5cb452 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -1,4 +1,5 @@
 import Capless.Subcapturing
+import Capless.Subcapturing.CaptureKind
 import Capless.Inversion.Context
 
 /-!
@@ -24,40 +25,16 @@ theorem Subcapt.join
   { apply Subcapt.trans; exact h2
     apply Subcapt.subset; apply CaptureSet.Subset.union_rr; apply CaptureSet.Subset.rfl }
 
-theorem Subcapt.proj_sub {C : CaptureSet n k}
-  (hsk : K1.Subkind K2)
-  : Subcapt Γ (C.proj K1) (C.proj K2) := by
-  induction C
-  case empty => simp; apply subset .rfl
-  case singleton s L =>
-    apply subkind
-    apply! Kind.Intersect.with_subkind
-  case union ha hb iha ihb =>
-    simp
-    apply join iha ihb
-
-theorem Subcapt.proj_l : Subcapt Γ (C.proj K) C := by
-  have h := proj_sub (Γ:=Γ) (C:=C) (K1:=K) .of_top
-  rw [CaptureSet.proj_top] at h
-  assumption
-
-theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
-  match hk with
-  | .cvar _ => by cases heq
-  | .union ha hb => by
-    injections
-    subst_vars
-    apply! And.intro
-  | .sub hsk hk => by
-    have ⟨_, _⟩ := hk.union_l_inv' heq
-    apply And.intro <;> apply! CaptureKind.sub
-  | .empty => by cases heq
-  | .absurd hk he => by
-    have ⟨_, _⟩ := hk.union_l_inv' heq
-    apply And.intro <;> apply! absurd
-termination_by structural hk
+theorem Subcapt.subkind {C : CaptureSet n k}
+  (hs : K.Subkind L) :
+  (Subcapt Γ (C.proj K) (C.proj L)) := by
+  apply subset
+  apply CaptureSet.Subset.subkind hs
 
-theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
+theorem Subcapt.singleton_subkind
+  (hs : K.Subkind L) :
+  Subcapt Γ (.singleton s K) (.singleton s L) := by
+  apply subset $ .singleton_subkind hs
 
 theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := by
   induction hs <;> (subst_vars; try simp_all)
@@ -86,281 +63,6 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 
-theorem CaptureKind.subset
-  (hk : CaptureKind Γ C2 K)
-  (hs : C1 ⊆ C2)
-  : CaptureKind Γ C1 K := by
-  induction hs
-  case empty => apply empty
-  case rfl => assumption
-  case union_l ha hb => apply! union (ha _) (hb _)
-  case union_rl ih =>
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply! ih
-  case union_rr ih =>
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply! ih
-
-theorem CaptureKind.subkind_proj
-  (hk : CaptureKind Γ (.proj C K2) K)
-  (hs : Kind.Subkind K1 K2)
-  : CaptureKind Γ (.proj C K1) K := by
-  generalize h : C.proj K2 = D at hk
-  induction hk generalizing C K2 K1
-  case var hb hk ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply var hb
-    apply ih _ (.refl _)
-    apply Kind.Intersect.with_subkind hs
-  case label hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply sub
-    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
-    apply! label
-  case cvar hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply sub
-    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
-    apply! cvar
-  case cbound hb hk ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cbound hb
-    apply ih _ (.refl _)
-    apply Kind.Intersect.with_subkind hs
-  case cinstr hb hk ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cinstr hb
-    apply ih _ (.refl _)
-    apply Kind.Intersect.with_subkind hs
-  case sub hs2 hk ih =>
-    subst_vars
-    apply sub hs2
-    apply ih hs (.refl _)
-  case empty =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    apply empty
-  case absurd hk he ih =>
-    apply absurd
-    apply ih hs h
-    assumption
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply union (ha hs (.refl _)) (hb hs (.refl _))
-
-theorem CaptureKind.subkind_singleton
-  (hs : CaptureKind Γ (.singleton s K2) K)
-  (hsub : K1.Subkind K2)
-  : CaptureKind Γ (.singleton s K1) K := by
-  rw [← Kind.Intersect.top_l (K:=K2)] at hs
-  rw [← Kind.Intersect.top_l (K:=K1)]
-  rw [← CaptureSet.proj] at hs
-  rw [← CaptureSet.proj]
-  apply! subkind_proj
-
-theorem CaptureKind.var_lookup_inv
-  (hk : CaptureKind Γ {x=x|L} K)
-  (hb : Γ.Bound x S^C)
-  : CaptureKind Γ (C.proj L) K := by
-  generalize h : {x=x|L} = D at hk
-  induction hk <;> cases h
-  case var K hb2 hk ih =>
-    cases Context.bound_injective hb hb2
-    assumption
-  case label hb2 => cases Context.bound_lbound_absurd hb hb2
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd ih =>
-    simp_all
-    apply! absurd
-
-theorem CaptureKind.label_lookup_inv
-  (hs : CaptureKind Γ {x=x|K1} K)
-  (hb : Γ.LBound x c S)
-  : (Kind.intersect (.classifier c) K1).Subkind K := by
-  generalize h : {x=x|K1} = D at hs
-  induction hs <;> cases h
-  case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
-  case label hb1 =>
-    cases Context.lbound_inj hb hb1; subst_vars
-    exact .rfl
-  case sub hs1 _ ih =>
-    apply Kind.Subkind.trans _ hs1
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply Kind.Subkind.is_empty_l
-    apply Kind.Subkind.empty_r_inv _ he
-    apply ih hb (.refl _)
-
-theorem CaptureKind.cbound_lookup_inv
-  (hs : CaptureKind Γ {c=c|L} K)
-  (hb : Γ.CBound c (.bound (.upper C)))
-  : CaptureKind Γ (C.proj L) K := by
-  generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
-  case cvar hb2 => cases Context.cbound_injective hb hb2
-  case cbound hb2 hk ih =>
-    cases Context.cbound_injective hb hb2
-    assumption
-  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply absurd _ he
-    apply ih hb (.refl _)
-
-theorem CaptureKind.ckind_lookup_inv
-  (hs : CaptureKind Γ {c=c|L} K)
-  (hb : Γ.CBound c (.bound (.kind K1)))
-  : (K1.intersect L).Subkind K := by
-  generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
-  case cvar hb2 =>
-    cases Context.cbound_injective hb hb2
-    exact .rfl
-  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
-  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
-  case sub hs1 _ ih =>
-    apply Kind.Subkind.trans _ hs1
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply Kind.Subkind.is_empty_l
-    apply Kind.Subkind.empty_r_inv _ he
-    apply ih hb (.refl _)
-
-theorem CaptureKind.cinst_lookup_inv
-  (hs : CaptureKind Γ {c=c|L} K)
-  (hb : Γ.CBound c (.inst C))
-  : CaptureKind Γ (C.proj L) K := by
-  generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
-  case cvar hb2 => cases Context.cbound_injective hb hb2
-  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
-  case cinstr hb2 hk ih =>
-    cases Context.cbound_injective hb hb2
-    assumption
-  case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply absurd _ he
-    apply ih hb (.refl _)
-
-theorem CaptureKind.proj_merge
-  (hk1 : CaptureKind Γ (.proj C K1) L1)
-  (hk2 : CaptureKind Γ (.proj C K2) L2)
-  (hs1 : L1.Subkind L)
-  (hs2 : L2.Subkind L)
-  : CaptureKind Γ (.proj C (K1.union K2)) L := by
-  generalize h : C.proj K1 = D at hk1
-  induction hk1 generalizing C K1 K2
-  case var x _ _ _ K hb hk1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply var hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    apply ih _ (.refl _)
-    apply hk2.var_lookup_inv hb
-  case label hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have h := hk2.label_lookup_inv hb
-    apply sub
-    exact .union_l hs1 (.trans h hs2)
-    apply sub Kind.Intersect.union_r_subkind
-    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-    apply label hb
-  case cvar hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have h := hk2.ckind_lookup_inv hb
-    apply sub
-    exact .union_l hs1 (.trans h hs2)
-    apply sub Kind.Intersect.union_r_subkind
-    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-    apply cvar hb
-  case cbound hb hk1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cbound hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    have h := hk2.cbound_lookup_inv hb
-    apply ih h (.refl _)
-  case cinstr hb hk1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cinstr hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    have h := hk2.cinst_lookup_inv hb
-    apply ih h (.refl _)
-  case sub hs hk1 ih =>
-    subst_vars
-    apply ih hk2
-    exact .trans hs hs1
-    rfl
-  case empty =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    apply empty
-  case absurd hk1 he ih =>
-    subst_vars
-    apply ih hk2 _ (.refl _)
-    apply Kind.Subkind.is_empty_l he
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have ⟨_, _⟩ := hk2.union_l_inv
-    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
-
-theorem CaptureKind.proj_merge_singleton
-  (hs1 : CaptureKind Γ (.singleton s K1) K)
-  (hs2 : CaptureKind Γ (.singleton s K2) K)
-  : CaptureKind Γ (.singleton s (K1.union K2)) K := by
-  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
-  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
-  rw [← CaptureSet.proj] at hs1 hs2
-  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
-  exact proj_merge hs1 hs2 .rfl .rfl
-
-theorem CaptureKind.subcapt
-  (hk : CaptureKind Γ C2 K)
-  (hs : Subcapt Γ C1 C2)
-  : CaptureKind Γ C1 K := by
-  induction hs generalizing K
-  case trans ha hb => apply ha; apply! hb
-  case subset => apply! hk.subset
-  case union ha hb => apply! union (ha _) (hb _)
-  case var hb => apply! var
-  case cinstl c C L hb =>
-    generalize h : {c=c|L} = D at hk
-    induction hk <;> try cases h
-    case cvar hb1 => cases Context.cbound_injective hb hb1
-    case cbound hb1 hk ih => cases Context.cbound_injective hb hb1
-    case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
-    case sub hs hk ih => apply sub hs; apply ih hb; rfl
-    case absurd he hk ih =>
-      apply absurd _ he
-      apply ih hb (.refl _)
-  case cinstr => apply! cinstr
-  case cbound => apply! cbound
-  case subkind K1 L hs =>
-    rw [← Kind.Intersect.top_l (K:=L)] at hk
-    rw [← Kind.Intersect.top_l (K:=K1)]
-    rw [← CaptureSet.proj] at hk
-    rw [← CaptureSet.proj]
-    apply subkind_proj hk hs
-  case absurd hk1 he =>
-    apply! absurd
-  case proj_split =>
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply! proj_merge_singleton
-
 -- Basic operations on .top
 
 theorem CaptureKind.var_top (hb : Γ.Bound x S^C) (hs : CaptureKind Γ C K) : CaptureKind Γ {x=x|.top} K := by
@@ -411,7 +113,7 @@ theorem Subcapt.proj_proj_intersect : Subcapt Γ (.proj (.proj C K1) K2) (C.proj
     apply! join
   case singleton =>
     simp
-    apply subkind Kind.Intersect.assoc_subkind
+    apply singleton_subkind Kind.Intersect.assoc_subkind
 
 theorem Subcapt.proj_intersect_proj : Subcapt Γ (C.proj (K1.intersect K2)) (.proj (.proj C K1) K2) := by
   induction C
@@ -421,7 +123,10 @@ theorem Subcapt.proj_intersect_proj : Subcapt Γ (C.proj (K1.intersect K2)) (.pr
     apply! join
   case singleton =>
     simp
-    apply subkind Kind.Intersect.assoc_superkind
+    apply singleton_subkind Kind.Intersect.assoc_superkind
+
+-- Connections between subkinding and subcapturing
+
 
 theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
   induction hk generalizing L
@@ -468,16 +173,11 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     apply trans (cinstr hb) .proj_intersect_proj
   case cbound hb =>
     apply trans (cbound hb) .proj_intersect_proj
-  case subkind hs =>
-    apply subkind $ Kind.Intersect.with_subkind_r hs
   case absurd hk he =>
     simp
     apply absurd _ he
     apply CaptureKind.sub _ hk.apply_proj
     apply Kind.Intersect.subkind_l
-  case proj_split =>
-    simp
-    apply proj_split
 
 theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
   rw [← Kind.Intersect.top_l (K:=K)]
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
new file mode 100644
index 00000000..7dc31ef6
--- /dev/null
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -0,0 +1,299 @@
+import Capless.Subcapturing
+import Capless.Inversion.Context
+
+namespace Capless
+
+
+theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
+  match hk with
+  | .cvar _ => by cases heq
+  | .union ha hb => by
+    injections
+    subst_vars
+    apply! And.intro
+  | .sub hsk hk => by
+    have ⟨_, _⟩ := hk.union_l_inv' heq
+    apply And.intro <;> apply! CaptureKind.sub
+  | .empty => by cases heq
+  | .absurd hk he => by
+    have ⟨_, _⟩ := hk.union_l_inv' heq
+    apply And.intro <;> apply! absurd
+termination_by structural hk
+
+theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
+
+
+theorem CaptureKind.subkind_proj
+  (hk : CaptureKind Γ (.proj C K2) K)
+  (hs : Kind.Subkind K1 K2)
+  : CaptureKind Γ (.proj C K1) K := by
+  generalize h : C.proj K2 = D at hk
+  induction hk generalizing C K2 K1
+  case var hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply var hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply sub
+    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
+    apply! label
+  case cvar hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply sub
+    apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
+    apply! cvar
+  case cbound hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cbound hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case cinstr hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cinstr hb
+    apply ih _ (.refl _)
+    apply Kind.Intersect.with_subkind hs
+  case sub hs2 hk ih =>
+    subst_vars
+    apply sub hs2
+    apply ih hs (.refl _)
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    apply empty
+  case absurd hk he ih =>
+    apply absurd
+    apply ih hs h
+    assumption
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply union (ha hs (.refl _)) (hb hs (.refl _))
+
+theorem CaptureKind.subkind_singleton
+  (hs : CaptureKind Γ (.singleton s K2) K)
+  (hsub : K1.Subkind K2)
+  : CaptureKind Γ (.singleton s K1) K := by
+  rw [← Kind.Intersect.top_l (K:=K2)] at hs
+  rw [← Kind.Intersect.top_l (K:=K1)]
+  rw [← CaptureSet.proj] at hs
+  rw [← CaptureSet.proj]
+  apply! subkind_proj
+
+
+
+
+theorem CaptureKind.var_lookup_inv
+  (hk : CaptureKind Γ {x=x|L} K)
+  (hb : Γ.Bound x S^C)
+  : CaptureKind Γ (C.proj L) K := by
+  generalize h : {x=x|L} = D at hk
+  induction hk <;> cases h
+  case var K hb2 hk ih =>
+    cases Context.bound_injective hb hb2
+    assumption
+  case label hb2 => cases Context.bound_lbound_absurd hb hb2
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd ih =>
+    simp_all
+    apply! absurd
+
+theorem CaptureKind.label_lookup_inv
+  (hs : CaptureKind Γ {x=x|K1} K)
+  (hb : Γ.LBound x c S)
+  : (Kind.intersect (.classifier c) K1).Subkind K := by
+  generalize h : {x=x|K1} = D at hs
+  induction hs <;> cases h
+  case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
+  case label hb1 =>
+    cases Context.lbound_inj hb hb1; subst_vars
+    exact .rfl
+  case sub hs1 _ ih =>
+    apply Kind.Subkind.trans _ hs1
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply Kind.Subkind.is_empty_l
+    apply Kind.Subkind.empty_r_inv _ he
+    apply ih hb (.refl _)
+
+theorem CaptureKind.cbound_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.bound (.upper C)))
+  : CaptureKind Γ (C.proj L) K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 => cases Context.cbound_injective hb hb2
+  case cbound hb2 hk ih =>
+    cases Context.cbound_injective hb hb2
+    assumption
+  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply absurd _ he
+    apply ih hb (.refl _)
+
+theorem CaptureKind.ckind_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.bound (.kind K1)))
+  : (K1.intersect L).Subkind K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 =>
+    cases Context.cbound_injective hb hb2
+    exact .rfl
+  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
+  case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
+  case sub hs1 _ ih =>
+    apply Kind.Subkind.trans _ hs1
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply Kind.Subkind.is_empty_l
+    apply Kind.Subkind.empty_r_inv _ he
+    apply ih hb (.refl _)
+
+theorem CaptureKind.cinst_lookup_inv
+  (hs : CaptureKind Γ {c=c|L} K)
+  (hb : Γ.CBound c (.inst C))
+  : CaptureKind Γ (C.proj L) K := by
+  generalize h : {c=c|L} = D at hs
+  induction hs <;> cases h
+  case cvar hb2 => cases Context.cbound_injective hb hb2
+  case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
+  case cinstr hb2 hk ih =>
+    cases Context.cbound_injective hb hb2
+    assumption
+  case sub hs hk ih =>
+    apply sub hs
+    apply ih hb (.refl _)
+  case absurd he hk ih =>
+    apply absurd _ he
+    apply ih hb (.refl _)
+
+theorem CaptureKind.proj_merge
+  (hk1 : CaptureKind Γ (.proj C K1) L1)
+  (hk2 : CaptureKind Γ (.proj C K2) L2)
+  (hs1 : L1.Subkind L)
+  (hs2 : L2.Subkind L)
+  : CaptureKind Γ (.proj C (K1.union K2)) L := by
+  generalize h : C.proj K1 = D at hk1
+  induction hk1 generalizing C K1 K2
+  case var x _ _ _ K hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply var hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    apply ih _ (.refl _)
+    apply hk2.var_lookup_inv hb
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have h := hk2.label_lookup_inv hb
+    apply sub
+    exact .union_l hs1 (.trans h hs2)
+    apply sub Kind.Intersect.union_r_subkind
+    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+    apply label hb
+  case cvar hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have h := hk2.ckind_lookup_inv hb
+    apply sub
+    exact .union_l hs1 (.trans h hs2)
+    apply sub Kind.Intersect.union_r_subkind
+    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+    apply cvar hb
+  case cbound hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cbound hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    have h := hk2.cbound_lookup_inv hb
+    apply ih h (.refl _)
+  case cinstr hb hk1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply cinstr hb
+    apply subkind_proj _ Kind.Intersect.union_r_subkind
+    have h := hk2.cinst_lookup_inv hb
+    apply ih h (.refl _)
+  case sub hs hk1 ih =>
+    subst_vars
+    apply ih hk2
+    exact .trans hs hs1
+    rfl
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    apply empty
+  case absurd hk1 he ih =>
+    subst_vars
+    apply ih hk2 _ (.refl _)
+    apply Kind.Subkind.is_empty_l he
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨_, _⟩ := hk2.union_l_inv
+    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+
+theorem CaptureKind.proj_merge_singleton
+  (hs1 : CaptureKind Γ (.singleton s K1) K)
+  (hs2 : CaptureKind Γ (.singleton s K2) K)
+  : CaptureKind Γ (.singleton s (K1.union K2)) K := by
+  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
+  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
+  rw [← CaptureSet.proj] at hs1 hs2
+  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
+  exact proj_merge hs1 hs2 .rfl .rfl
+
+theorem CaptureKind.subset
+  (hk : CaptureKind Γ C2 K)
+  (hs : C1 ⊆ C2)
+  : CaptureKind Γ C1 K := by
+  induction hs
+  case empty => apply empty
+  case rfl => assumption
+  case union_l ha hb => apply! union (ha _) (hb _)
+  case union_rl ih =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! ih
+  case union_rr ih =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! ih
+  case trans ha hb => aesop
+  case singleton_subkind hs =>
+    apply! subkind_singleton
+  case proj_merge =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! proj_merge_singleton
+
+theorem CaptureKind.subcapt
+  (hk : CaptureKind Γ C2 K)
+  (hs : Subcapt Γ C1 C2)
+  : CaptureKind Γ C1 K := by
+  induction hs generalizing K
+  case trans ha hb => apply ha; apply! hb
+  case subset => apply! hk.subset
+  case union ha hb => apply! union (ha _) (hb _)
+  case var hb => apply! var
+  case cinstl c C L hb =>
+    generalize h : {c=c|L} = D at hk
+    induction hk <;> try cases h
+    case cvar hb1 => cases Context.cbound_injective hb hb1
+    case cbound hb1 hk ih => cases Context.cbound_injective hb hb1
+    case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
+    case sub hs hk ih => apply sub hs; apply ih hb; rfl
+    case absurd he hk ih =>
+      apply absurd _ he
+      apply ih hb (.refl _)
+  case cinstr => apply! cinstr
+  case cbound => apply! cbound
+  case absurd hk1 he =>
+    apply! absurd

From 70ee8772d033b87ea3e6f1c5dd86d43c590c3ffa Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 22 Dec 2025 19:59:16 +0100
Subject: [PATCH 56/71] Slowly restoring sanity

---
 Capless/CaptureSet.lean                    |  34 +++
 Capless/Classifier.lean                    |   4 +
 Capless/Inversion/Context.lean             |  47 +++
 Capless/Renaming/Capture/Subcapturing.lean |   7 +-
 Capless/Renaming/Term/Subcapturing.lean    |   7 +-
 Capless/Renaming/Type/Subcapturing.lean    |   4 +-
 Capless/Store.lean                         |   5 +-
 Capless/Subcapturing.lean                  |   4 +-
 Capless/Subcapturing/Basic.lean            |   4 +-
 Capless/Subcapturing/CaptureKind.lean      | 243 ++++++++-------
 Capless/Subst/Capture/Subcapturing.lean    |   4 +-
 Capless/Subst/Term/Subcapturing.lean       |   4 +-
 Capless/Subst/Type/Subcapturing.lean       |   5 +-
 Capless/WellScoped/Basic.lean              | 333 ++++++++++++++++++++-
 14 files changed, 566 insertions(+), 139 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 9421f49c..efdb97e7 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -77,6 +77,9 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | singleton_subkind :
   K.Subkind L ->
   Subset (.singleton s K) (.singleton s L)
+| singleton_absurd :
+  K.IsEmpty ->
+  Subset (.singleton s K) .empty
 | proj_merge:
   Subset (.singleton s (.union L1 L2)) (.union (.singleton s L1) (.singleton s L2))
 | trans : Subset A B -> Subset B C -> Subset A C
@@ -145,6 +148,14 @@ theorem CaptureSet.Subset.subkind {C : CaptureSet n k}
   case union ha hb => apply! union_monotone
   case singleton => simp; apply singleton_subkind (Kind.Intersect.with_subkind hk)
 
+theorem CaptureSet.Subset.absurd {C : CaptureSet n k} (he : K.IsEmpty) : Subset (C.proj K) .empty := by
+  induction C
+  case empty => simp; constructor
+  case union ha hb =>
+    apply trans (.union_monotone ha hb)
+    apply union_l .rfl .rfl
+  case singleton => simp; apply singleton_absurd; apply Kind.Intersect.is_empty_r he
+
 /-!
 ## Renaming operations
 -/
@@ -321,6 +332,8 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
     apply! Subset.union_rr
   case singleton_subkind s K L hk =>
     cases s <;> (simp; apply! Subset.singleton_subkind)
+  case singleton_absurd s K he =>
+    cases s <;> (simp; apply! Subset.singleton_absurd)
   case proj_merge s L1 L2 =>
     cases s <;> (simp; apply! Subset.proj_merge)
   case trans ha hb => apply! Subset.trans
@@ -339,6 +352,8 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
     apply! Subset.union_rr
   case singleton_subkind s K L hk =>
     cases s <;> (apply! Subset.singleton_subkind)
+  case singleton_absurd s K he =>
+    cases s <;> (apply! Subset.singleton_absurd)
   case proj_merge s L1 L2 =>
     cases s <;> (apply! Subset.proj_merge)
   case trans ha hb => apply! Subset.trans
@@ -360,6 +375,9 @@ theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K
   case union_rr hb => apply! union_rr
   case singleton_subkind hs =>
     apply singleton_subkind $ Kind.Intersect.with_subkind_r hs
+  case singleton_absurd he =>
+    apply trans (.singleton_subkind _) (.singleton_absurd he)
+    apply Kind.Intersect.subkind_l
   case proj_merge => apply proj_merge
   case trans ha hb => apply! trans
 
@@ -383,3 +401,19 @@ theorem CaptureSet.Subset.proj_l : Subset (C.proj K) C := by
   case empty => constructor
   case union ha hb => simp; apply! union_monotone
   case singleton => apply singleton_subkind; apply Kind.Intersect.subkind_l
+
+theorem CaptureSet.Subset.proj_proj_intersect {C : CaptureSet n k}: Subset ((C.proj K).proj L) (C.proj (K.intersect L)) := by
+  induction C
+  case empty => simp; constructor
+  case union ha hb => simp; apply! union_monotone
+  case singleton =>
+    apply singleton_subkind
+    apply Kind.Intersect.assoc_subkind
+
+theorem CaptureSet.Subset.proj_intersect_proj {C : CaptureSet n k}: Subset (C.proj (K.intersect L)) ((C.proj K).proj L) := by
+  induction C
+  case empty => simp; constructor
+  case union ha hb => simp; apply! union_monotone
+  case singleton =>
+    apply singleton_subkind
+    apply Kind.Intersect.assoc_superkind
diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index acbb100f..d3836bcf 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -434,6 +434,10 @@ theorem Kind.Intersect.top_l {K : Kind} : Kind.top.intersect K = K := by
     . rename_i h1; unfold Classifier.subclass at h1; simp_all
     . simp
 
+theorem Kind.Intersect.assoc {A B C : Kind} : (A.intersect B).intersect C = A.intersect (B.intersect C) := by
+  -- will be correct when we flatten the structure
+  sorry
+
 inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
   | empty_l : Subtract .empty K .empty
   | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
diff --git a/Capless/Inversion/Context.lean b/Capless/Inversion/Context.lean
index e2b3c3b3..9853e357 100644
--- a/Capless/Inversion/Context.lean
+++ b/Capless/Inversion/Context.lean
@@ -484,4 +484,51 @@ theorem Context.cvar_bound_cbound_inv_inst
     ∧ C = C0.cweaken := by
   apply Context.cvar_bound_cbound_inv_inst' rfl hb
 
+theorem Context.bound_exists {Γ : Context n m k} :
+  (∃ C0, Context.Bound Γ x C0) ∨ (∃ c0 S0, Context.LBound Γ x c0 S0) := by
+    induction Γ
+    case empty => exact x.elim0
+    case var C0 ih =>
+      cases x.eq_zero_or_eq_succ <;> rename_i h
+      . subst_vars; left; exists C0.weaken; apply Context.Bound.here
+      . have ⟨j, _⟩ := h; subst_vars
+        cases ih (x:=j) <;> rename_i ih
+        . have ⟨C0, ih⟩ := ih; left; exists C0.weaken; apply Context.Bound.there_var ih
+        . have ⟨c0, S0, ih⟩ := ih; right; exists c0, S0.weaken; apply Context.LBound.there_var ih
+    case tvar ih =>
+      cases ih (x:=x) <;> rename_i ih
+      . have ⟨C0, ih⟩ := ih; left; exists C0.tweaken; apply Context.Bound.there_tvar ih
+      . have ⟨c0, S0, ih⟩ := ih; right; exists c0, S0.tweaken; apply Context.LBound.there_tvar ih
+    case cvar ih =>
+      cases ih (x:=x) <;> rename_i ih
+      . have ⟨C0, ih⟩ := ih; left; exists C0.cweaken; apply Context.Bound.there_cvar ih
+      . have ⟨c0, S0, ih⟩ := ih; right; exists c0, S0.cweaken; apply Context.LBound.there_cvar ih
+    case label c S ih =>
+      cases x.eq_zero_or_eq_succ <;> rename_i h
+      . subst_vars; right; exists c, S.weaken; apply Context.LBound.here
+      . have ⟨j, _⟩ := h; subst_vars
+        cases ih (x:=j) <;> rename_i ih
+        . have ⟨C0, ih⟩ := ih; left; exists C0.weaken; apply Context.Bound.there_label ih
+        . have ⟨c0, S0, ih⟩ := ih; right; exists c0, S0.weaken; apply Context.LBound.there_label ih
+
+theorem Context.cbound_exists {Γ : Context n m k} :
+  ∃ B0, Context.CBound Γ x B0 := by
+    induction Γ
+    case empty => exact x.elim0
+    case var ih =>
+      have ⟨B0, ih⟩ := ih (x:=x)
+      exists B0.weaken; apply Context.CBound.there_var ih
+    case tvar ih =>
+      have ⟨B0, ih⟩ := ih (x:=x)
+      exists B0; apply Context.CBound.there_tvar ih
+    case cvar B ih =>
+      cases x.eq_zero_or_eq_succ <;> rename_i h
+      . subst_vars; exists B.cweaken; apply Context.CBound.here
+      . have ⟨j, _⟩ := h; subst_vars
+        have ⟨B0, ih⟩ := ih (x:=j)
+        exists B0.cweaken; apply Context.CBound.there_cvar ih
+    case label ih =>
+      have ⟨B0, ih⟩ := ih (x:=x)
+      exists B0.weaken; apply Context.CBound.there_label ih
+
 end Capless
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index e0f5ad46..efa07b64 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -15,7 +15,8 @@ theorem CaptureSet.Subset.crename {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
   C1.crename f ⊆ C2.crename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
-  apply CaptureSet.Subset.union_rr; trivial
+  apply! union_rr
+  apply! proj_merge
 
 theorem CaptureKind.crename
   (h : CaptureKind Γ C K)
@@ -36,7 +37,7 @@ theorem CaptureKind.crename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd hk he ih => apply! absurd (ih _)
+  case singleton_absurd hk he => apply! singleton_absurd
 
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
@@ -50,8 +51,6 @@ theorem Subcapt.crename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.crename _)
-  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index e5f7ef57..598ea659 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -16,7 +16,8 @@ theorem CaptureSet.Subset.rename {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
   C1.rename f ⊆ C2.rename f := by
   induction h <;> try (solve | simp | constructor <;> try trivial)
-  apply CaptureSet.Subset.union_rr; trivial
+  apply! union_rr
+  apply! proj_merge
 
 theorem CaptureKind.rename
   (h : Γ ⊢ C :k K)
@@ -36,7 +37,7 @@ theorem CaptureKind.rename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd hk he ih => apply! absurd (ih _)
+  case singleton_absurd => apply! singleton_absurd
 
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
@@ -50,8 +51,6 @@ theorem Subcapt.rename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.rename _)
-  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 85636a05..4a7215ee 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -24,7 +24,7 @@ theorem CaptureKind.trename
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
-  case absurd ih => apply! absurd (ih _)
+  case singleton_absurd => apply! singleton_absurd
 
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
@@ -38,8 +38,6 @@ theorem Subcapt.trename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.trename _)
-  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index 2c15c2af..d93ecbdc 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -190,10 +190,11 @@ inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop w
   ReachSet Γ {c=c|L} R
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
-  ReachSet Γ {c=c|L} {c=c|L}
+  ReachSet Γ {c=c|L} {c=c|K.intersect L}
 | label :
   Context.LBound Γ x c S ->
-  ReachSet Γ {x=x|L} {x=x|L}
+  ReachSet Γ {x=x|L} {x=x|(Kind.classifier c).intersect L}
+| absurd : K.IsEmpty -> ReachSet Γ (.singleton s K) {}
 
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
  -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 8b85d8fe..20d9ec94 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -19,7 +19,7 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | cinstr : Context.CBound Γ c (.inst C) -> CaptureKind Γ (C.proj L) K -> CaptureKind Γ {c=c | L} K
   | sub : Kind.Subkind K L -> CaptureKind Γ C K -> CaptureKind Γ C L
   | empty : CaptureKind Γ .empty K
-  | absurd : CaptureKind Γ C K -> K.IsEmpty -> CaptureKind Γ C L
+  | singleton_absurd : K.IsEmpty -> CaptureKind Γ (.singleton s K) L
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
@@ -46,6 +46,8 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
+-- | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
+-- ^^^ would be interesting to prove, but seems really hard to crack
 | absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 7a5cb452..f41fd6ca 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -148,8 +148,8 @@ theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.pro
   case sub hs hk ih =>
     apply sub (Kind.Intersect.with_subkind_r hs) ih
   case empty => apply empty
-  case absurd he hk ih =>
-    apply absurd ih
+  case singleton_absurd he hk =>
+    apply singleton_absurd
     apply Kind.Intersect.is_empty_l hk
   case union ha hb => apply union ha hb
 
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index 7dc31ef6..10b64410 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -4,24 +4,13 @@ import Capless.Inversion.Context
 namespace Capless
 
 
-theorem CaptureKind.union_l_inv' (hk : CaptureKind Γ C K) (heq : C = C1 ∪ C2) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K :=
-  match hk with
-  | .cvar _ => by cases heq
-  | .union ha hb => by
-    injections
-    subst_vars
-    apply! And.intro
-  | .sub hsk hk => by
-    have ⟨_, _⟩ := hk.union_l_inv' heq
-    apply And.intro <;> apply! CaptureKind.sub
-  | .empty => by cases heq
-  | .absurd hk he => by
-    have ⟨_, _⟩ := hk.union_l_inv' heq
-    apply And.intro <;> apply! absurd
-termination_by structural hk
-
-theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := hk.union_l_inv' $ .refl (a := C1 ∪ C2)
-
+theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := by
+  generalize h : C1 ∪ C2 = D at hk
+  induction hk generalizing C1 C2 <;> cases h
+  case sub hs hk ih =>
+    have ⟨_, _⟩ := ih (.refl _)
+    apply And.intro <;> apply! sub hs
+  case union => apply! And.intro
 
 theorem CaptureKind.subkind_proj
   (hk : CaptureKind Γ (.proj C K2) K)
@@ -66,10 +55,12 @@ theorem CaptureKind.subkind_proj
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     apply empty
-  case absurd hk he ih =>
-    apply absurd
-    apply ih hs h
-    assumption
+  case singleton_absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply singleton_absurd
+    apply Kind.Subkind.empty_r_inv _ he
+    apply Kind.Intersect.with_subkind hs
   case union ha hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -85,98 +76,93 @@ theorem CaptureKind.subkind_singleton
   rw [← CaptureSet.proj]
   apply! subkind_proj
 
-
-
-
 theorem CaptureKind.var_lookup_inv
   (hk : CaptureKind Γ {x=x|L} K)
   (hb : Γ.Bound x S^C)
-  : CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {x=x|L} = D at hk
   induction hk <;> cases h
   case var K hb2 hk ih =>
     cases Context.bound_injective hb hb2
-    assumption
+    left; assumption
   case label hb2 => cases Context.bound_lbound_absurd hb hb2
   case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd ih =>
-    simp_all
-    apply! absurd
+    cases ih hb (.refl _)
+    case inl h => left; apply sub hs h
+    case inr h => right; assumption
+  case singleton_absurd he =>
+    right; assumption
 
 theorem CaptureKind.label_lookup_inv
   (hs : CaptureKind Γ {x=x|K1} K)
   (hb : Γ.LBound x c S)
-  : (Kind.intersect (.classifier c) K1).Subkind K := by
+  : (Kind.intersect (.classifier c) K1).Subkind K ∨ K1.IsEmpty := by
   generalize h : {x=x|K1} = D at hs
   induction hs <;> cases h
   case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
   case label hb1 =>
     cases Context.lbound_inj hb hb1; subst_vars
-    exact .rfl
+    left; exact .rfl
   case sub hs1 _ ih =>
-    apply Kind.Subkind.trans _ hs1
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply Kind.Subkind.is_empty_l
-    apply Kind.Subkind.empty_r_inv _ he
-    apply ih hb (.refl _)
+    cases ih hb (.refl _)
+    case inl h => left; apply Kind.Subkind.trans h hs1
+    case inr h => right; assumption
+  case singleton_absurd he =>
+    right; assumption
 
 theorem CaptureKind.cbound_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.upper C)))
-  : CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih =>
     cases Context.cbound_injective hb hb2
-    assumption
+    left; assumption
   case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
   case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply absurd _ he
-    apply ih hb (.refl _)
+    cases ih hb (.refl _)
+    case inl h => left; apply sub hs h
+    case inr h => right; assumption
+  case singleton_absurd he =>
+    right; assumption
 
 theorem CaptureKind.ckind_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.kind K1)))
-  : (K1.intersect L).Subkind K := by
+  : (K1.intersect L).Subkind K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 =>
     cases Context.cbound_injective hb hb2
-    exact .rfl
+    left; exact .rfl
   case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
   case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2
   case sub hs1 _ ih =>
-    apply Kind.Subkind.trans _ hs1
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply Kind.Subkind.is_empty_l
-    apply Kind.Subkind.empty_r_inv _ he
-    apply ih hb (.refl _)
+    cases ih hb (.refl _)
+    case inl h => left; apply Kind.Subkind.trans h hs1
+    case inr h => right; assumption
+  case singleton_absurd he =>
+    right; assumption
 
 theorem CaptureKind.cinst_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.inst C))
-  : CaptureKind Γ (C.proj L) K := by
+  : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
   induction hs <;> cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
   case cinstr hb2 hk ih =>
     cases Context.cbound_injective hb hb2
-    assumption
+    left; assumption
   case sub hs hk ih =>
-    apply sub hs
-    apply ih hb (.refl _)
-  case absurd he hk ih =>
-    apply absurd _ he
-    apply ih hb (.refl _)
+    cases ih hb (.refl _)
+    case inl h => left; apply sub hs h
+    case inr h => right; assumption
+  case singleton_absurd he =>
+    right; assumption
 
 theorem CaptureKind.proj_merge
   (hk1 : CaptureKind Γ (.proj C K1) L1)
@@ -188,43 +174,85 @@ theorem CaptureKind.proj_merge
   induction hk1 generalizing C K1 K2
   case var x _ _ _ K hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply var hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    apply ih _ (.refl _)
-    apply hk2.var_lookup_inv hb
+    obtain ⟨rfl, rfl⟩ := h
+    rename_i p
+    cases hk2.var_lookup_inv hb
+    case inl h =>
+      apply var hb
+      apply subkind_proj _ Kind.Intersect.union_r_subkind
+      exact ih h hs1 rfl
+    case inr he =>
+      apply sub hs1
+      apply var hb
+      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply Kind.Subkind.is_empty_l he
+      apply subkind_proj hk1 hsub
   case label hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have h := hk2.label_lookup_inv hb
-    apply sub
-    exact .union_l hs1 (.trans h hs2)
-    apply sub Kind.Intersect.union_r_subkind
-    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-    apply label hb
+    obtain ⟨rfl, rfl⟩ := h
+    rename_i p
+    cases hk2.label_lookup_inv hb
+    case inl h =>
+      apply sub
+      exact .union_l hs1 (.trans h hs2)
+      apply sub Kind.Intersect.union_r_subkind
+      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+      apply label hb
+    case inr he =>
+      apply sub hs1
+      apply sub (Kind.Intersect.with_subkind (.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))))
+      apply label hb
   case cvar hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have h := hk2.ckind_lookup_inv hb
-    apply sub
-    exact .union_l hs1 (.trans h hs2)
-    apply sub Kind.Intersect.union_r_subkind
-    apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
-    apply cvar hb
+    obtain ⟨rfl, rfl⟩ := h
+    rename_i p
+    cases hk2.ckind_lookup_inv hb
+    case inl h =>
+      apply sub
+      exact .union_l hs1 (.trans h hs2)
+      apply sub Kind.Intersect.union_r_subkind
+      apply sub $ Kind.Intersect.with_subkind Kind.Intersect.union_r_subkind
+      apply cvar hb
+    case inr he =>
+      apply sub hs1
+      apply sub (Kind.Intersect.with_subkind (.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))))
+      apply cvar hb
   case cbound hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cbound hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    have h := hk2.cbound_lookup_inv hb
-    apply ih h (.refl _)
+    obtain ⟨rfl, rfl⟩ := h
+    rename_i p
+    cases hk2.cbound_lookup_inv hb
+    case inl h =>
+      apply cbound hb
+      apply subkind_proj _ Kind.Intersect.union_r_subkind
+      apply ih h hs1 (.refl _)
+    case inr he =>
+      apply sub hs1
+      apply cbound hb
+      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply Kind.Subkind.is_empty_l he
+      apply subkind_proj hk1 hsub
   case cinstr hb hk1 ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply cinstr hb
-    apply subkind_proj _ Kind.Intersect.union_r_subkind
-    have h := hk2.cinst_lookup_inv hb
-    apply ih h (.refl _)
+    obtain ⟨rfl, rfl⟩ := h
+    rename_i p
+    cases hk2.cinst_lookup_inv hb
+    case inl h =>
+      apply cinstr hb
+      apply subkind_proj _ Kind.Intersect.union_r_subkind
+      apply ih h hs1 (.refl _)
+    case inr he =>
+      apply sub hs1
+      apply cinstr hb
+      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+        apply Kind.Subkind.union_l .rfl
+        apply Kind.Subkind.is_empty_l he
+      apply subkind_proj hk1 hsub
   case sub hs hk1 ih =>
     subst_vars
     apply ih hk2
@@ -233,15 +261,20 @@ theorem CaptureKind.proj_merge
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     apply empty
-  case absurd hk1 he ih =>
-    subst_vars
-    apply ih hk2 _ (.refl _)
-    apply Kind.Subkind.is_empty_l he
+  case singleton_absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    obtain ⟨rfl, rfl⟩ := h
+    -- K1 side is empty, so use K2 side
+    apply sub hs2
+    apply subkind_singleton hk2
+    -- p ∩ (K1 ∪ K2) <: (p ∩ K1) ∪ (p ∩ K2) <: p ∩ K2  (since p ∩ K1 is empty)
+    apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+    apply Kind.Subkind.union_l (.is_empty_l he) .rfl
   case union ha hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    obtain ⟨rfl, rfl⟩ := h
     have ⟨_, _⟩ := hk2.union_l_inv
-    apply! union (ha _ $ .refl _) (hb _ $ .refl _)
+    apply! union (ha _ _ $ .refl _) (hb _ _ $ .refl _)
 
 theorem CaptureKind.proj_merge_singleton
   (hs1 : CaptureKind Γ (.singleton s K1) K)
@@ -270,10 +303,19 @@ theorem CaptureKind.subset
   case trans ha hb => aesop
   case singleton_subkind hs =>
     apply! subkind_singleton
+  case singleton_absurd L he => apply! singleton_absurd
   case proj_merge =>
     have ⟨_, _⟩ := hk.union_l_inv
     apply! proj_merge_singleton
 
+theorem CaptureKind.absurd {C : CaptureSet n k}
+  (he : K.IsEmpty)
+  : CaptureKind Γ (C.proj K) L := by
+  induction C
+  case empty => apply empty
+  case union ha hb => apply! union
+  case singleton => apply singleton_absurd $ Kind.Intersect.is_empty_r he
+
 theorem CaptureKind.subcapt
   (hk : CaptureKind Γ C2 K)
   (hs : Subcapt Γ C1 C2)
@@ -290,10 +332,7 @@ theorem CaptureKind.subcapt
     case cbound hb1 hk ih => cases Context.cbound_injective hb hb1
     case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
     case sub hs hk ih => apply sub hs; apply ih hb; rfl
-    case absurd he hk ih =>
-      apply absurd _ he
-      apply ih hb (.refl _)
+    case singleton_absurd he => apply! absurd
   case cinstr => apply! cinstr
   case cbound => apply! cbound
-  case absurd hk1 he =>
-    apply! absurd
+  case absurd hk1 he => apply sub _ hk1; apply Kind.Subkind.is_empty_l he
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index ea98f4eb..f58054e5 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -31,7 +31,7 @@ theorem CaptureKind.csubst
   case sub hs hk ih =>
     apply! sub hs (ih _)
   case empty => apply empty
-  case absurd ih => apply! absurd (ih _)
+  case singleton_absurd => apply! singleton_absurd
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.csubst
@@ -48,8 +48,6 @@ theorem Subcapt.csubst
   case cbound hb =>
     cases σ.cmap_bound _ _ hb
     apply! apply_proj_singleton
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.csubst _)
-  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index fe3bd02a..39d3c4e2 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -30,7 +30,7 @@ theorem CaptureKind.subst
   case sub hs hk ih =>
     apply! sub hs (ih _)
   case empty => apply empty
-  case absurd ih => apply! absurd (ih _)
+  case singleton_absurd => apply! singleton_absurd
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.subst
@@ -47,8 +47,6 @@ theorem Subcapt.subst
   case cinstl hb => apply cinstl (σ.cmap _ _ hb)
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.subst _)
-  case proj_split => apply! proj_split
 
 end Capless
diff --git a/Capless/Subst/Type/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean
index 88120520..68f4ecf2 100644
--- a/Capless/Subst/Type/Subcapturing.lean
+++ b/Capless/Subst/Type/Subcapturing.lean
@@ -21,7 +21,7 @@ theorem CaptureKind.tsubst
   case cinstr hb hk ih => apply! cinstr (σ.cmap _ _ hb) (ih _)
   case sub hs hk ih => apply! sub hs (ih _)
   case empty => apply empty
-  case absurd ih => apply! absurd (ih _)
+  case singleton_absurd => apply! singleton_absurd
   case union ha hb => apply! union (ha _) (hb _)
 
 theorem Subcapt.tsubst
@@ -36,9 +36,6 @@ theorem Subcapt.tsubst
   case cinstl hb => apply cinstl (σ.cmap _ _ hb)
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
-  case subkind hs => apply! subkind
   case absurd hk he => apply! absurd (hk.tsubst _)
-  case proj_split => apply! proj_split
-
 
 end Capless
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 2f397a13..91d3839b 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,36 +11,304 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
+theorem ReachSet.proj_empty {C : CaptureSet n k}
+  (hr : ReachSet Γ (C.proj K) R)
+  (he : K.IsEmpty)
+  : R ⊆ .empty := by
+  generalize h : C.proj K = D at hr
+  induction hr generalizing C K
+  case empty => constructor
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply CaptureSet.Subset.union_l (ha he (.refl _)) (hb he (.refl _))
+  case var hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.Intersect.is_empty_r he
+  case cinstr hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.Intersect.is_empty_r he
+  case cbound hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.Intersect.is_empty_r he
+  case ckind =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply CaptureSet.Subset.singleton_absurd
+    apply Kind.Intersect.is_empty_r $ Kind.Intersect.is_empty_r he
+  case label =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply CaptureSet.Subset.singleton_absurd
+    apply Kind.Intersect.is_empty_r $ Kind.Intersect.is_empty_r he
+  case absurd =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    constructor
+
+theorem ReachSet.proj_absurd {C : CaptureSet n k}
+  (he : K.IsEmpty)
+  : ∃ R, R ⊆ .empty ∧ ReachSet Γ (C.proj K) R := by
+  induction C
+  case empty => exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    have ⟨Ra, hsa, ha⟩ := ha
+    have ⟨Rb, hbs, hb⟩ := hb
+    exists Ra ∪ Rb
+    apply And.intro
+    apply! CaptureSet.Subset.union_l
+    apply! union
+  case singleton =>
+    exists .empty
+    apply And.intro .empty
+    apply absurd
+    apply Kind.Intersect.is_empty_r he
+
 theorem ReachSet.inj
   (hr1 : ReachSet Γ C R1)
   (hr2 : ReachSet Γ C R2)
-  : R1 = R2 := by
+  : R1 ⊆ R2 := by
   induction hr1 generalizing R2
-  case empty => cases hr2; simp
-  case union ha hb => cases hr2; simp; apply! And.intro (ha _) (hb _)
+  case empty => apply CaptureSet.Subset.empty
+  case union ha hb => cases hr2; apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
   case var hb1 hr1 ih =>
     cases hr2
     case var hb2 hr2 => cases Context.bound_injective hb1 hb2; apply! ih
     case label hb2 => cases Context.bound_lbound_absurd hb1 hb2
+    case absurd he => apply! hr1.proj_empty
   case cinstr hb1 hr1 ih =>
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
     case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
     case ckind hb2 => cases Context.cbound_injective hb1 hb2
+    case absurd he => apply! hr1.proj_empty
   case cbound hb1 hr1 ih =>
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
     case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
     case ckind hb2 => cases Context.cbound_injective hb1 hb2
+    case absurd he => apply! hr1.proj_empty
   case ckind hb1 =>
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
     case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
-    case ckind hb2 => cases Context.cbound_injective hb1 hb2; simp
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2; constructor
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.Intersect.is_empty_r _)
   case label hb1 =>
     cases hr2
     case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
-    case label hb2 => cases Context.lbound_inj hb1 hb2; simp
+    case label hb2 => cases Context.lbound_inj hb1 hb2; subst_vars; constructor
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.Intersect.is_empty_r _)
+  case absurd => constructor
+
+
+theorem ReachSet.subkind {C : CaptureSet n k}
+  (hk : K.Subkind L)
+  (hr : ReachSet Γ (C.proj L) R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (C.proj K) R1 := by
+  generalize h : C.proj L = D at hr
+  induction hr generalizing C L K
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨Ra, hsa, ha⟩ := ha hk (.refl _)
+    have ⟨Rb, hsb, hb⟩ := hb hk (.refl _)
+    exists Ra ∪ Rb
+    apply And.intro (.union_monotone hsa hsb)
+    apply! union
+  case var hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.var hb h)
+  case cinstr hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.cinstr hb h)
+  case cbound hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.cbound hb h)
+  case ckind hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply Exists.intro
+    apply And.intro _ (ckind hb)
+    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply Exists.intro
+    apply And.intro _ (label hb)
+    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    exists .empty; apply And.intro .empty
+    apply absurd $ Kind.Subkind.empty_r_inv _ he
+    apply Kind.Intersect.with_subkind hk
+
+
+theorem ReachSet.singleton_subkind
+  (hk : K.Subkind L)
+  (hr : ReachSet Γ (.singleton s L) R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (.singleton s K) R1 := by
+  rw [← Kind.Intersect.top_l (K:=L), ← CaptureSet.proj] at hr
+  rw [← Kind.Intersect.top_l (K:=K), ← CaptureSet.proj]
+  apply! subkind
+
+theorem ReachSet.proj_merge' {C : CaptureSet n k}
+  (hr1 : ReachSet Γ (C.proj L1) R1)
+  (hr2 : ReachSet Γ (C.proj L2) R2)
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (C.proj (L1.union L2)) R := by
+  generalize h : C.proj L1 = D at hr1
+  induction hr1 generalizing C L1 L2 R2
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    rename_i hr2a hr2b
+    have ⟨Ra, hsa, ha⟩ := ha hr2a (.refl _)
+    have ⟨Rb, hsb, hb⟩ := hb hr2b (.refl _)
+    exists Ra ∪ Rb
+    apply And.intro
+    . apply CaptureSet.Subset.trans $ CaptureSet.Subset.union_monotone hsa hsb
+      apply CaptureSet.Subset.union_l
+      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rl .rfl) (.union_rr $ .union_rl .rfl)
+      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rr .rfl) (.union_rr $ .union_rr .rfl)
+    . apply! union
+  case var C _ _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    case var hb2 hr2 =>
+      cases Context.bound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.var hb h)
+    case label hb2 => cases Context.bound_lbound_absurd hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.var hb h)
+  case cinstr C _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    case cinstr hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.cinstr hb h)
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cinstr hb h)
+  case cbound C _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.cbound hb h)
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cbound hb h)
+  case ckind c K _ hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind p _ hb2 =>
+      cases Context.cbound_injective hb hb2
+      exists {c=c| K.intersect (p.intersect (.union L1 L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
+        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
+        apply Kind.Intersect.union_r_subkind
+      . apply! ckind
+    case absurd he =>
+      rename_i p
+      exists {c=c| K.intersect (p.intersect (.union L1 L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
+        apply Kind.Intersect.with_subkind
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
+      . apply! ckind
+
+  case label x _ _ _ hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
+    case label p c _ hb2 =>
+      cases Context.lbound_inj hb hb2
+      subst_vars
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (.union L1 L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
+        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
+        apply Kind.Intersect.union_r_subkind
+      . apply! label
+    case absurd he =>
+      rename_i c _ _ p
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (.union L1 L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
+        apply Kind.Intersect.with_subkind
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
+      . apply! label
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    rename_i p
+    have h0 : (p.intersect (L1.union L2)).Subkind (p.intersect L2) := by
+      apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+      apply Kind.Subkind.union_l (.is_empty_l he) .rfl
+    have ⟨R, hs, h⟩ := hr2.singleton_subkind h0
+    exists R
+    apply And.intro (.union_rr hs)
+    apply h
+
+theorem ReachSet.proj_merge
+  (hr1 : ReachSet Γ (.singleton s L1) R1)
+  (hr2 : ReachSet Γ (.singleton s L2) R2)
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (.singleton s (L1.union L2)) R := by
+  rw [← Kind.Intersect.top_l (K:=L1), ← CaptureSet.proj] at hr1
+  rw [← Kind.Intersect.top_l (K:=L2), ← CaptureSet.proj] at hr2
+  rw [← Kind.Intersect.top_l (K:=(L1.union L2)), ← CaptureSet.proj]
+  apply! proj_merge'
 
 theorem ReachSet.subset
   (hs : C1 ⊆ C2)
@@ -67,8 +335,51 @@ theorem ReachSet.subset
     rename_i R1 R2 h1 h2
     have ⟨R, hs, h⟩ := ih h2
     exists R; apply And.intro (.union_rr hs) h
+  case trans ha hb =>
+    have ⟨Rb, hsb, hb⟩ := hb hr1
+    have ⟨Ra, hsa, ha⟩ := ha hb
+    exists Ra; apply! And.intro (.trans hsa hsb)
+  case singleton_subkind hs => apply! singleton_subkind
+  case singleton_absurd he => exists .empty; apply And.intro .empty (.absurd he)
+  case proj_merge =>
+    cases hr1
+    apply! proj_merge
 
 
+theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
+  (hk : CaptureKind Γ C K)
+  (he : K.IsEmpty)
+  : ∃ R, R ⊆ .empty ∧ ReachSet Γ C R := by
+  induction hk
+  case var hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs (var hb h)
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro (.singleton_absurd he)
+    apply! label
+  case cvar c K L hb =>
+    exists {c=c|K.intersect L}
+    apply And.intro (.singleton_absurd he)
+    apply! ckind
+  case cbound hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cbound
+  case cinstr hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cinstr
+  case sub hsk hk ih => apply ih (hsk.empty_r_inv he)
+  case empty => exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he2 => exists .empty; apply! And.intro .empty (.absurd he2)
+  case union ha hb =>
+    have ⟨Ra, hsa, ha⟩ := ha he
+    have ⟨Rb, hsb, hb⟩ := hb he
+    exists Ra ∪ Rb
+    apply And.intro (.union_l hsa hsb)
+    apply! union
+
 theorem ReachSet.subcapt
   (hr2 : ReachSet Γ C2 R2)
   (hs : Subcapt Γ C1 C2)
@@ -78,25 +389,25 @@ theorem ReachSet.subcapt
     have ⟨R2, hs2, hr⟩ := hb hr2
     have ⟨R1, hs1, hr⟩ := ha hr
     exists R1
-    apply! And.intro (.trans _ _)
+    apply! And.intro (.trans hs1 hs2)
   case subset => apply! subset
   case union ha hb =>
     have ⟨Ra, hsa, hra⟩ := ha hr2
     have ⟨Rb, hsb, hrb⟩ := hb hr2
     exists Ra ∪ Rb
-    apply! And.intro (.union_l _ _) (.union _ _)
+    apply And.intro (.union_l hsa hsb) (.union hra hrb)
   case var hb => exists R2; apply And.intro .rfl; apply! var
   case cinstl hb =>
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
     case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
     case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd _ he => apply! proj_absurd
   case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
   case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
-  case subkind hs =>
-    -- time to push subkinding to subsetting
-
-
+  case absurd hk he =>
+    cases hr2
+    apply capture_kind_absurd hk he
 
 -- theorem WellScoped.subkind
 --   (hsc : WellScoped Γ cont (.proj C K2))

From 5142ddf2fa03ee82ca7d158fcc66b487e86d79dd Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 22 Dec 2025 20:03:51 +0100
Subject: [PATCH 57/71] With intersect.assoc we should be able to prove proj_r

---
 Capless/CaptureSet.lean       |  7 +++++++
 Capless/Subcapturing.lean     |  4 ++--
 Capless/WellScoped/Basic.lean | 13 +++++++++++++
 3 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index efdb97e7..a8d88616 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -417,3 +417,10 @@ theorem CaptureSet.Subset.proj_intersect_proj {C : CaptureSet n k}: Subset (C.pr
   case singleton =>
     apply singleton_subkind
     apply Kind.Intersect.assoc_superkind
+
+theorem CaptureSet.Subset.proj_intersect {C : CaptureSet n k}: C.proj (K.intersect L) = (C.proj K).proj L := by
+  induction C
+  case empty => simp
+  case union ha hb => simp_all
+  case singleton =>
+    simp [Kind.Intersect.assoc]
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 20d9ec94..81868bd9 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -46,9 +46,9 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
 | cbound :
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
--- | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
+| proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
 -- ^^^ would be interesting to prove, but seems really hard to crack
-| absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
+-- | absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 91d3839b..27dd2d66 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -409,6 +409,19 @@ theorem ReachSet.subcapt
     cases hr2
     apply capture_kind_absurd hk he
 
+theorem ReachSet.is_subcapt
+  (hr : ReachSet Γ C R)
+  : Subcapt Γ C R := by
+  induction hr
+  case empty => apply Subcapt.subset .empty
+  case union ha hb => apply! Subcapt.join
+  case var hb hr ih => apply Subcapt.trans (.var hb) ih
+  case cinstr hb hr ih => apply Subcapt.trans (.cinstr hb) ih
+  case cbound hb hr ih => apply Subcapt.trans (.cbound hb) ih
+  case ckind =>
+    -- apply Subcapt.
+
+
 -- theorem WellScoped.subkind
 --   (hsc : WellScoped Γ cont (.proj C K2))
 --   (hs : K1.Subkind K2)

From c76539955b369ff4a027793073cd62b3dd44d708 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 23 Dec 2025 22:14:47 +0100
Subject: [PATCH 58/71] WIP classifiers overhaul

Make Kinds a flat list, might be able to progress
---
 Capless/Classifier.lean              | 1567 ++++++++------------------
 Capless/Classifier/Core.lean         |  320 ++++++
 Capless/Classifier/Intersection.lean |  173 +++
 Capless/Classifier/Kind.lean         |  100 ++
 Capless/Classifier/Subkind.lean      |   14 +
 Capless/Classifier/Subtract.lean     |  560 +++++++++
 6 files changed, 1637 insertions(+), 1097 deletions(-)
 create mode 100644 Capless/Classifier/Core.lean
 create mode 100644 Capless/Classifier/Intersection.lean
 create mode 100644 Capless/Classifier/Kind.lean
 create mode 100644 Capless/Classifier/Subkind.lean
 create mode 100644 Capless/Classifier/Subtract.lean

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index d3836bcf..ceb2f694 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -1,1051 +1,424 @@
-import Capless.Basic
-import Capless.Tactics
+import Capless.Classifier.Core
+import Capless.Classifier.Kind
+import Capless.Classifier.Intersection
+import Capless.Classifier.Subtract
+import Capless.Classifier.Subkind
 
 namespace Capless
 
-inductive Classifier : Type where
-  | top : Classifier
-  | child : Nat -> Classifier -> Classifier
-deriving DecidableEq
-
-def Classifier.control := child 0 .top
-
-inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
-  | rfl : Subclass a a
-  | parent_l : Subclass a b -> Subclass (child n a) b
-
-inductive Classifier.StrictSub : Classifier -> Classifier -> Prop where
-  | child : StrictSub (child n a) a
-  | parent_l : StrictSub a b -> StrictSub (child n a) b
-
-theorem Classifier.Subclass.might_strict (hs : Subclass a b) : a = b ∨ StrictSub a b := by
-  induction hs
-  case rfl => left; simp
-  case parent_l hp ih =>
-    right
-    cases ih
-    case inl => subst_vars; constructor
-    case inr => apply! StrictSub.parent_l
-
-theorem Classifier.StrictSub.weaken (hs : StrictSub a b) : Subclass a b := by
-  induction hs
-  case child => apply Subclass.parent_l .rfl
-  case parent_l hp ih => apply Subclass.parent_l ih
-
-theorem Classifier.StrictSub.size (hs : StrictSub a b) : sizeOf a > sizeOf b := by induction hs <;> (simp; try omega)
-
-theorem Classifier.StrictSub.neq (hs : StrictSub a b) : a ≠ b := by
-  apply Ne.intro
-  intro h
-  have hs := hs.size
-  rw [h] at hs
-  omega
-
-inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
-  | base : n != m -> Disjoint (child n p) (child m p)
-  | left : Disjoint a b -> Disjoint (child n a) b
-  | right : Disjoint a b -> Disjoint a (child m b)
-
-theorem Classifier.Subclass.of_top : Subclass a .top := by
-  induction a
-  case top => apply rfl
-  case child n k ih => apply parent_l ih
-
-theorem Classifier.Subclass.parent_r (hs : Subclass a (child n b)) : Subclass a b := by
-  cases hs
-  case rfl => apply parent_l rfl
-  case parent_l hp =>
-    apply parent_l hp.parent_r
-
-theorem Classifier.Subclass.trans (h1 : Subclass a b) (h2 : Subclass b c) : Subclass a c := by
-  induction h2
-  case rfl => assumption
-  case parent_l hp ih => apply ih h1.parent_r
-
-theorem Classifier.Subclass.down_r (hs : Subclass a b) : a = b ∨ ∃ n, Subclass a (child n b) := by
-  induction hs
-  case rfl => simp
-  case parent_l ih =>
-    rename_i n _
-    right
-    cases ih
-    case inl ih => subst_vars; exists n; constructor
-    case inr ih =>
-      have ⟨m, ih⟩ := ih
-      exists m
-      apply parent_l ih
-
-theorem Classifier.Subclass.size (hs : Subclass a b) : sizeOf a ≥ sizeOf b := by
-  induction hs <;> (simp; try omega)
-
-theorem Classifier.Subclass.antisymm (h1 : Subclass a b) (h2 : Subclass b a) : a = b := by
-  induction h1
-  case rfl => simp
-  case parent_l hp ih =>
-    have hp1 := hp.size
-    have h21 := h2.size
-    simp at h21
-    omega
-
-theorem Classifier.StrictSub.antisymm (hs : StrictSub a b) (hs2 : Subclass b a) : False := by
-  have h := hs.size
-  have h2 := hs2.size
-  omega
-
-theorem Classifier.StrictSub.subclass_r (hss : StrictSub a b) (hs : Subclass b c) : StrictSub a c := by
-  induction hss
-  case child n a =>
-    induction hs generalizing n
-    case rfl => apply child
-    case parent_l m k ih =>
-      apply parent_l ih
-  case parent_l n a ih =>
-    apply! parent_l $ ih _
-
-theorem Classifier.Disjoint.symm (hd : Disjoint a b) : Disjoint b a := by
-  induction hd
-  case base hne =>
-    apply base; aesop
-  case left => apply! right
-  case right => apply! left
-
-theorem Classifier.Disjoint.refines_subclass_r
-  (hd : Disjoint b a2)
-  (hs : Subclass a1 a2) : Disjoint b a1 := by
-  induction hs
-  case rfl => assumption
-  case parent_l hs ih =>
-    apply right $ ih hd
-
-theorem Classifier.Disjoint.refines_subclass_l (hd : Disjoint a2 b) (hs : Subclass a1 a2) : Disjoint a1 b := by
-  apply symm
-  apply refines_subclass_r hd.symm hs
-
-theorem Classifier.Disjoint.left_inv (hd : Disjoint (child n a) b) : Subclass b a ∨ Disjoint a b := by
-  cases hd
-  case base m _ => left; constructor; constructor;
-  case left => right; assumption
-  case right hd =>
-    cases hd.left_inv
-    case inl hd => left; constructor; assumption
-    case inr hd => right; apply! right
-
-theorem Classifier.Disjoint.not_subclass (hd : Disjoint a b) (hs : Subclass a b) : False := by
-  induction a generalizing b
-  case top =>
-    induction b
-    case top => cases hd
-    case child n p ih => cases hs
-  case child n p ih =>
-    induction b
-    case top => cases hs; cases hd; apply! ih
-    case child m q ih2 =>
-      cases hs
-      case rfl =>
-        cases hd
-        case base => aesop
-        case left hs => apply ih2 hs.symm $ .parent_l .rfl
-        case right hs => apply ih2 hs $ .parent_l .rfl
-      case parent_l hs =>
-        cases hd
-        case base => have h := hs.size; simp at h; omega
-        case left => apply! ih
-        case right hd =>
-          cases hd.left_inv
-          case inl hd =>
-            have h := hs.parent_r.antisymm hd
-            subst_vars
-            have h := hs.size; simp at h; omega
-          case inr hd =>
-            apply ih (b:=q) hd hs.parent_r
-
-theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b) : Disjoint a c := by
-  induction hs
-  case rfl => assumption
-  case parent_l hp ih =>
-    apply right
-    apply ih hd
-
-theorem Classifier.subclass_or_disjoint a b:
-  Subclass a b ∨ StrictSub b a ∨ Disjoint a b := by
-  induction a
-  case top =>
-    cases Subclass.of_top (a:=b).might_strict
-    case inl => simp_all; left; exact .rfl
-    case inr => aesop
-  case child n k ih =>
-    cases ih
-    case inl ih =>
-      left; constructor; assumption
-    case inr ih =>
-      cases ih
-      case inl ih =>
-        cases ih.weaken.down_r
-        { subst_vars; left; apply Subclass.parent_l .rfl }
-        { rename_i ih1; have ⟨m, ih1⟩ := ih1;
-          generalize h : (n == m) = h0;
-          cases h0
-          right; right;
-          apply Disjoint.refines_subclass_r; apply Disjoint.base (m:=m); aesop; assumption
-          have h0 := LawfulBEq.eq_of_beq h; subst_vars
-          cases ih1.might_strict
-          . left; subst_vars; exact .rfl
-          . aesop
-        }
-      case inr ih =>
-        right; right; apply Disjoint.left ih
-
-def Classifier.subclass (a : Classifier) (b : Classifier) :=
-  if a == b then true
-  else match a with
-    | .top => false
-    | .child n p => p.subclass b
-
-theorem Classifier.subclass_is_Subclass : Subclass a b ↔ a.subclass b := by
-  apply Iff.intro
-  . intro hs
-    induction hs
-    case rfl => unfold subclass; simp
-    case parent_l n p => unfold subclass; simp; right; assumption
-  . intro hs
-    unfold subclass at hs
-    split at hs
-    case isTrue h =>
-      have h1 := LawfulBEq.eq_of_beq h
-      subst_vars
-      constructor
-    case isFalse h =>
-      split at hs
-      . contradiction
-      . rename_i p
-        constructor
-        rw [subclass_is_Subclass (a:=p)]
-        assumption
-
-def Classifier.disjoint (a : Classifier) (b : Classifier) :=
-  match a with
-  | .top => false
-  | .child n p =>
-    match b with
-    | .top => false
-    | .child m q =>
-      if p == q then n != m
-      else disjoint (.child n p) q || disjoint p (.child m q)
-
-theorem Classifier.disjoint_is_Disjoint {a b : Classifier} : Disjoint a b ↔ a.disjoint b := by
-  apply Iff.intro
-  . intro hs
-    induction hs with
-    | base hne =>
-      unfold disjoint
-      simp [hne]
-    | @left a' b' n ha ih =>
-      unfold disjoint
-      match b' with
-      | .top => cases ha.not_subclass .of_top
-      | .child m q =>
-        simp only
-        split
-        . rename_i heq
-          have h1 := LawfulBEq.eq_of_beq heq
-          subst_vars
-          cases ha.symm.not_subclass $ .parent_l .rfl
-        . simp [ih]
-    | @right a' b' m ha ih =>
-      unfold disjoint
-      match a' with
-      | .top =>
-        have : ∀ c, ¬ Disjoint top c := fun c h => by
-          induction c with
-          | top => cases h
-          | child n p ih =>
-            cases h with
-            | right ha => exact ih ha
-        exact absurd ha (this _)
-      | .child n p =>
-        simp only
-        split
-        . rename_i heq
-          have heq' := LawfulBEq.eq_of_beq heq
-          subst heq'
-          cases ha.not_subclass $ .parent_l .rfl
-        . simp [ih]
-  . intro hs
-    unfold disjoint at hs
-    split at hs
-    . cases hs
-    . split at hs
-      . cases hs
-      . split at hs
-        . rename_i h
-          have h1 := LawfulBEq.eq_of_beq h
-          subst_vars
-          apply! Disjoint.base
-        . simp at hs
-          cases hs
-          case inl hs =>
-            apply Disjoint.right
-            rw [disjoint_is_Disjoint]
-            assumption
-          case inr hs =>
-            apply Disjoint.left
-            rw [disjoint_is_Disjoint]
-            assumption
-termination_by sizeOf a + sizeOf b
-
--- **
--- Kinds
--- **
-
-inductive Kind : Type where
-  | empty : Kind
-  | node : Classifier -> List Classifier -> Kind -- .only[K].except[K1, ..., Kn]
-  | union : Kind -> Kind -> Kind
-
-@[simp]
-def Kind.top := node .top []
-
--- Shorthand notation for a subtree without exclusions
-@[simp]
-def Kind.classifier c := node c []
-
-def Kind.sup (a: Kind) (b: Kind) : Kind := a.union b
-
-def Kind.inf (a: Kind) (b: Kind) : Kind :=
-  match a with
-  | .empty => b
-  | .union a1 a2 => union (a1.inf b) (a2.inf b)
-  | .node r1 ex1 =>
-    match b with
-    | .empty => .empty
-    | .union b1 b2 => union (inf (.node r1 ex1) b1) (inf (.node r1 ex1) b2)
-    | .node r2 ex2 =>
-      if r1.subclass r2 then .node r1 (ex1 ++ ex2)
-      else if r2.subclass r1 then .node r2 (ex1 ++ ex2)
-      else .empty
-
-inductive ContainsSupOf : List Classifier -> Classifier -> Prop where
-  | here : b.Subclass a -> ContainsSupOf (a :: xs) b
-  | there : ContainsSupOf xs b -> ContainsSupOf (a :: xs) b
-
-theorem ContainsSupOf.append_l (h : ContainsSupOf xs b) : ContainsSupOf (xs ++ ys) b := by
-  induction h with
-  | here hs => exact .here hs
-  | there _ ih => exact .there ih
-
-theorem ContainsSupOf.append_r (h : ContainsSupOf ys b) : ContainsSupOf (xs ++ ys) b := by
-  induction xs with
-  | nil => exact h
-  | cons _ _ ih => exact .there ih
-
-theorem ContainsSupOf.trans_subclass (h : ContainsSupOf xs a) (hs : b.Subclass a) : ContainsSupOf xs b := by
-  induction h with
-  | here hs' => exact .here (hs.trans hs')
-  | there _ ih => exact .there (ih hs)
-
-theorem ContainsSupOf.of_append (h : ContainsSupOf (xs ++ ys) b) : ContainsSupOf xs b ∨ ContainsSupOf ys b := by
-  induction xs with
-  | nil => exact .inr h
-  | cons a xs ih =>
-    cases h with
-    | here hs => exact .inl (.here hs)
-    | there h =>
-      cases ih h with
-      | inl h => exact .inl (.there h)
-      | inr h => exact .inr h
-
-inductive Kind.IsEmpty : Kind -> Prop where
-  | empty : IsEmpty .empty
-  | absurd : ContainsSupOf exs r -> IsEmpty (.node r exs)
-  | union : IsEmpty K1 -> IsEmpty K2 -> IsEmpty (.union K1 K2)
-
-theorem Kind.IsEmpty.is_absurd (he : IsEmpty (.node r exs)) : ContainsSupOf exs r := by
-  cases he; assumption
-
-inductive Kind.Intersect : Kind -> Kind -> Kind -> Prop where
-  | empty_l : Intersect .empty K .empty
-  | empty_r : Intersect K .empty .empty
-  | union_l : Intersect K1 K R1 -> Intersect K2 K R2 -> Intersect (K1.union K2) K (R1.union R2)
-  | union_r : Intersect K K1 R1 -> Intersect K K2 R2 -> Intersect K (K1.union K2) (R1.union R2)
-  | singleton_l : r1.Subclass r2 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r1 (ex1 ++ ex2))
-  | singleton_r : r2.Subclass r1 -> Intersect (.node r1 ex1) (.node r2 ex2) (.node r2 (ex1 ++ ex2))
-  | singleton_disj : r1.Disjoint r2 -> Intersect (.node r1 ex1) (.node r2 ex2) .empty
-
-@[simp]
-def Kind.intersect (k : Kind) (l : Kind) : Kind :=
-  match k with
-  | .empty => .empty
-  | .union k1 k2 => .union (k1.intersect l) (k2.intersect l)
-  | .node r1 ex1 =>
-    match l with
-    | .empty => .empty
-    | .union l1 l2 => .union ((node r1 ex1).intersect l1) ((node r1 ex1).intersect l2)
-    | .node r2 ex2 =>
-      if r1.subclass r2 then .node r1 (ex1 ++ ex2)
-      else if r2.subclass r1 then .node r2 (ex1 ++ ex2)
-      else .empty
-
-theorem Kind.Intersect.lawful : Intersect K L (K.intersect L) := by
-  induction K generalizing L
-  case empty => unfold intersect; apply empty_l
-  case union ha hb =>
-    unfold intersect
-    apply union_l ha hb
-  case node r1 ex1 =>
-    induction L
-    case empty => unfold intersect; simp; apply empty_r
-    case union ha hb => unfold intersect; simp; apply union_r ha hb
-    case node r2 ex2 =>
-      unfold intersect
-      simp
-      split
-      . rename_i h
-        rw [← Classifier.subclass_is_Subclass] at h
-        apply! singleton_l
-      . split
-        . rename_i h
-          rw [← Classifier.subclass_is_Subclass] at h
-          apply! singleton_r
-        . rename_i h1 h2
-          rw [← Classifier.subclass_is_Subclass] at h1 h2
-          cases Classifier.subclass_or_disjoint r1 r2 <;> try contradiction
-          rename_i h3; cases h3
-          case inl h3 => have h4 := h3.weaken; contradiction
-          case inr h3 => apply! singleton_disj
-
-theorem Kind.Intersect.top_r {K : Kind} : K.intersect .top = K := by
-  induction K
-  case empty => simp
-  case union ha hb => simp_all
-  case node r1 ex1 =>
-    have h := Classifier.Subclass.of_top (a:=r1)
-    rw [Classifier.subclass_is_Subclass] at h
-    aesop
-
-theorem Kind.Intersect.top_l {K : Kind} : Kind.top.intersect K = K := by
-  induction K
-  case empty => simp
-  case union ha hb => aesop
-  case node r1 ex1 =>
-    have h := Classifier.Subclass.of_top (a:=r1)
-    rw [Classifier.subclass_is_Subclass] at h
-    simp
-    split
-    . rename_i h1; unfold Classifier.subclass at h1; simp_all
-    . simp
-
-theorem Kind.Intersect.assoc {A B C : Kind} : (A.intersect B).intersect C = A.intersect (B.intersect C) := by
-  -- will be correct when we flatten the structure
-  sorry
-
-inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
-  | empty_l : Subtract .empty K .empty
-  | union_l : Subtract K1 K R1 -> Subtract K2 K R2 -> Subtract (.union K1 K2) K (.union R1 R2)
-  | empty_r : Subtract (.node r1 ex1) .empty (.node r1 ex1)
-  | union_r :
-    Subtract (.node r1 ex1) K1 R1 ->
-    Subtract R1 K2 R2 ->
-    Subtract (.node r1 ex1) (.union K1 K2) R2
-  -- The singleton cases
-  -- Basically we follow a few broad strokes:
-  -- - A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
-  -- - For B of the form (.node r []) (no exclusion):
-  --   - If r < A, refine A
-  --   - If r > A, empty
-  --   - If r ⊥ A, A
-  -- Base case first
-  | tree : Subtract (.node r1 ex1) (.node r2 []) (.node r1 (r2 :: ex1))
-  -- Exclusion case
-  -- First, handle the cases where (B \ C) doesn't make sense
-  | excl_absurd_r :
-    r2.StrictSub a -> -- (B \ a) is just empty
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
-  | excl_irrelevant_r :
-    r2.Disjoint a -> -- (B \ a) = B
-    Subtract (.node r1 ex1) (.node r2 ex2) R ->
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
-  -- Now, for cases where a is a subtree of r2
-  -- We use the formula A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
-  | excl_subclass_r :
-    a.Subclass r2 ->
-    a.Subclass r1 -> -- A ∩ B ∩ C = a with all the exclusions
-    Subtract (.node r1 ex1) (.node r2 ex2) R ->
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.union R (.node a ex1))
-                                        -- ^ we'd need (ex1 ++ ex2) here to be exact,
-                                        -- but if an element is in the ex2 subtree
-                                        -- and not already excluded from A, it is part
-                                        -- of (A \ B), so it's okay to keep anyway.
-  | excl_subclass_l :
-    a.Subclass r2 ->
-    r1.StrictSub a ->  -- B \ C excludes the entirety of A
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) (.node r1 ex1)
-  | excl_irrelevant_l :
-    a.Subclass r2 ->
-    r1.Disjoint a -> -- irrelevant exclusion, A ∪ B ∪ C = empty
-    Subtract (.node r1 ex1) (.node r2 ex2) R ->
-    Subtract (.node r1 ex1) (.node r2 (a :: ex2)) R
-
-inductive Kind.Subkind : Kind -> Kind -> Prop where
-  | subtract : Subtract K1 K2 R -> IsEmpty R -> Subkind K1 K2
-
-theorem Kind.Subtract.is_empty_l (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsEmpty R := by
-  induction hs
-  case empty_l => constructor
-  case union_l ha hb =>
-    cases he
-    apply! IsEmpty.union (ha _) (hb _)
-  case empty_r => assumption
-  case union_r ha hb =>
-    apply hb
-    apply! ha
-  case tree => constructor; exact .there he.is_absurd
-  case excl_absurd_r => assumption
-  case excl_irrelevant_r ih => apply! ih
-  case excl_subclass_r hs2 hs1 _ ih =>
-    constructor; apply! ih;
-    constructor; cases he
-    apply! ContainsSupOf.trans_subclass
-  case excl_subclass_l hs2 hs1 => assumption
-  case excl_irrelevant_l ih => apply! ih
-
-
-theorem Kind.Subtract.absurd_l (hs : Subtract (.node r1 ex1) K R) (hsc : ContainsSupOf ex1 r1) : IsEmpty R := by
-  apply hs.is_empty_l
-  constructor
-  assumption
-
-theorem Kind.Subtract.empty_implies_subclass
-  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
-  (he : IsEmpty R)
-  : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
-  cases hs
-  case tree =>
-    cases he.is_absurd <;> aesop
-  case excl_absurd_r => left; apply he.is_absurd
-  case excl_irrelevant_r hs => apply hs.empty_implies_subclass he
-  case excl_subclass_r hs =>
-    cases he
-    apply! hs.empty_implies_subclass
-  case excl_subclass_l => left; apply he.is_absurd
-  case excl_irrelevant_l hs => apply! hs.empty_implies_subclass
-
-theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2 : IsEmpty K2) : IsEmpty K1 := by
-  induction hs
-  case empty_l => constructor
-  case union_l ha hb =>
-    cases he
-    constructor
-    apply! ha
-    apply! hb
-  case empty_r => assumption
-  case union_r ha hb =>
-    cases hek2
-    simp_all
-  case tree => cases hek2.is_absurd
-  case excl_absurd_r hs => assumption
-  case excl_irrelevant_r hd hs ih =>
-    cases hek2.is_absurd
-    case here hsk => cases hd.not_subclass hsk
-    case there hek2 => apply! ih _ (.absurd hek2)
-  case excl_subclass_r hs2 hs1 hs ih =>
-    cases he
-    cases hek2.is_absurd
-    case here hsk =>
-      cases hs2.antisymm hsk
-      rename_i h _
-      cases hs.empty_implies_subclass h
-      case inl => constructor; assumption
-      case inr hsk2 => cases hsk2.antisymm hs1; assumption
-    case there hsk => apply! ih _ (.absurd _)
-  case excl_subclass_l => assumption
-  case excl_irrelevant_l hs2 hd1 hs ih =>
-    cases hek2.is_absurd
-    case here hsa =>
-      cases hs2.antisymm hsa
-      cases hs.empty_implies_subclass he
-      case inl h1 => exact .absurd h1
-      case inr h1 => cases hd1.not_subclass h1
-    case there hsc => apply ih he (.absurd hsc)
-
-theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
-  cases hs
-  apply! Subtract.empty_r_inv
-
-inductive Kind.Disjoint : Kind -> Kind -> Prop where
-  | empty_l: Disjoint .empty K
-  | empty_r : Disjoint K .empty
-  | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
-  | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
-  | absurd_l : ContainsSupOf ex1 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-  | absurd_r : ContainsSupOf ex2 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-  | root : r1.Disjoint r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-  | excl_l : ContainsSupOf ex2 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-  | excl_r : ContainsSupOf ex1 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-
-theorem Kind.Disjoint.union_l_inv (hd : Disjoint (K1.union K2) K) : Disjoint K1 K ∧ Disjoint K2 K := by
-  generalize hk : Kind.union K1 K2 = K' at hd
-  induction hd with
-  | empty_l => cases hk
-  | empty_r => exact ⟨.empty_r, .empty_r⟩
-  | union_l hd1 hd2 =>
-    cases hk
-    exact ⟨hd1, hd2⟩
-  | union_r hd1 hd2 ih1 ih2 =>
-    have ⟨hd1', hd2'⟩ := ih1 hk
-    have ⟨hd1'', hd2''⟩ := ih2 hk
-    exact ⟨.union_r hd1' hd1'', .union_r hd2' hd2''⟩
-  | absurd_l => cases hk
-  | absurd_r => cases hk
-  | root => cases hk
-  | excl_l => cases hk
-  | excl_r => cases hk
-
-theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (K1.union K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
-  generalize hk : Kind.union K1 K2 = K' at hd
-  induction hd with
-  | empty_l => exact ⟨.empty_l, .empty_l⟩
-  | empty_r => cases hk
-  | union_l hd1 hd2 ih1 ih2 =>
-    have ⟨hd1', hd2'⟩ := ih1 hk
-    have ⟨hd1'', hd2''⟩ := ih2 hk
-    exact ⟨.union_l hd1' hd1'', .union_l hd2' hd2''⟩
-  | union_r hd1 hd2 =>
-    cases hk
-    exact ⟨hd1, hd2⟩
-  | absurd_l => cases hk
-  | absurd_r => cases hk
-  | root => cases hk
-  | excl_l => cases hk
-  | excl_r => cases hk
-
-theorem Kind.Disjoint.implies_empty_intersect (hd : K1.Disjoint K2) (hi : Intersect K1 K2 R) : IsEmpty R := by
-  induction hi with
-  | empty_l => exact .empty
-  | empty_r => exact .empty
-  | union_l hi1 hi2 ih1 ih2 =>
-    have ⟨hd1, hd2⟩ := hd.union_l_inv
-    exact .union (ih1 hd1) (ih2 hd2)
-  | union_r hi1 hi2 ih1 ih2 =>
-    have ⟨hd1, hd2⟩ := hd.union_r_inv
-    exact .union (ih1 hd1) (ih2 hd2)
-  | singleton_l hs =>
-    cases hd with
-    | absurd_l ha => exact .absurd (.append_l ha)
-    | absurd_r ha => exact .absurd (.append_r (ha.trans_subclass hs))
-    | root hd => cases hd.not_subclass hs
-    | excl_l ha => exact .absurd (.append_r ha)
-    | excl_r ha => exact .absurd (.append_l (ha.trans_subclass hs))
-  | singleton_r hs =>
-    cases hd with
-    | absurd_l ha => exact .absurd (.append_l (ha.trans_subclass hs))
-    | absurd_r ha => exact .absurd (.append_r ha)
-    | root hd => cases hd.symm.not_subclass hs
-    | excl_l ha => exact .absurd (.append_r (ha.trans_subclass hs))
-    | excl_r ha => exact .absurd (.append_l ha)
-  | singleton_disj => exact .empty
-
-theorem Kind.Disjoint.from_empty_intersect (hi : Intersect K1 K2 R) (he : IsEmpty R) : K1.Disjoint K2 := by
-  induction hi with
-  | empty_l => exact .empty_l
-  | empty_r => exact .empty_r
-  | union_l hi1 hi2 ih1 ih2 =>
-    cases he with
-    | union he1 he2 => exact .union_l (ih1 he1) (ih2 he2)
-  | union_r hi1 hi2 ih1 ih2 =>
-    cases he with
-    | union he1 he2 => exact .union_r (ih1 he1) (ih2 he2)
-  | singleton_l hs =>
-    cases he with
-    | absurd ha =>
-      cases ha.of_append with
-      | inl ha => exact .absurd_l ha
-      | inr ha => exact .excl_l ha
-  | singleton_r hs =>
-    cases he with
-    | absurd ha =>
-      cases ha.of_append with
-      | inl ha => exact .excl_r ha
-      | inr ha => exact .absurd_r ha
-  | singleton_disj hd => exact .root hd
-
-theorem Kind.Disjoint.top_l (hd: Disjoint .top K) : IsEmpty K := by
-  cases hd
-  case empty_r => constructor
-  case union_r ha hb => apply IsEmpty.union ha.top_l hb.top_l
-  case absurd_l hsc => cases hsc
-  case absurd_r hsc => constructor; assumption
-  case root hd => cases hd.symm.not_subclass .of_top
-  case excl_l hsc => constructor; apply hsc.trans_subclass .of_top
-  case excl_r hsc => cases hsc
-
-theorem Kind.Disjoint.symm (hd : K1.Disjoint K2) : Disjoint K2 K1 := by
-  induction hd with
-  | empty_l => exact .empty_r
-  | empty_r => exact .empty_l
-  | union_l _ _ ih1 ih2 => exact .union_r ih1 ih2
-  | union_r _ _ ih1 ih2 => exact .union_l ih1 ih2
-  | absurd_l ha => exact .absurd_r ha
-  | absurd_r ha => exact .absurd_l ha
-  | root hd => exact .root hd.symm
-  | excl_l ha => exact .excl_r ha
-  | excl_r ha => exact .excl_l ha
-
-theorem Kind.Disjoint.append_excl_l (hd : Disjoint (.node r1 ex2) K) : Disjoint (.node r1 (ex1 ++ ex2)) K := by
-  cases hd
-  case empty_r => apply! empty_r
-  case union_r ha hb => apply union_r ha.append_excl_l hb.append_excl_l
-  case absurd_l ha => apply absurd_l ha.append_r
-  case absurd_r => apply! absurd_r
-  case root => apply! root
-  case excl_l => apply! excl_l
-  case excl_r ha => apply excl_r ha.append_r
-
-theorem Kind.Disjoint.refine_subroot_l (hd : Disjoint (.node r1 ex1) K) (hs : r2.Subclass r1) : Disjoint (.node r2 ex1) K := by
-  cases hd
-  case empty_r => apply! empty_r
-  case union_r ha hb => apply! union_r (ha.refine_subroot_l _) (hb.refine_subroot_l _)
-  case absurd_l ha => apply! absurd_l $ ha.trans_subclass _
-  case absurd_r => apply! absurd_r
-  case root hdr => apply root; apply! hdr.refines_subclass_l _
-  case excl_l hc => apply! excl_l $ hc.trans_subclass _
-  case excl_r => apply! excl_r
-
--- If K1 is disjoint from K', and R is the intersection of K with K1, then R is disjoint from K'
-theorem Kind.Disjoint.intersect_disjoint (hd : K1.Disjoint K') (hi : Intersect K K1 R) : R.Disjoint K' := by
-  induction hi
-  case empty_l => apply! empty_l
-  case empty_r => apply! empty_l
-  case union_l iha ihb => apply! union_l (iha _) (ihb _)
-  case union_r iha ihb =>
-    have ⟨_, _⟩ := hd.union_l_inv
-    apply! union_l (iha _) (ihb _)
-  case singleton_l hs => apply append_excl_l; apply! hd.refine_subroot_l _
-  case singleton_r hs => apply hd.append_excl_l
-  case singleton_disj hdr => apply empty_l
-
-theorem Kind.Disjoint.absurd_l' (hs : ContainsSupOf ex1 r1) : Disjoint (.node r1 ex1) K := by
-  induction K
-  case empty => apply empty_r
-  case node => apply! absurd_l
-  case union ha hb => apply! union_r
-
-theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K2 R) : Disjoint R K := by
-  induction hs
-  case empty_l => exact .empty_l
-  case union_l ih1 ih2 =>
-    have ⟨hd1, hd2⟩ := hd.union_l_inv
-    exact .union_l (ih1 hd1) (ih2 hd2)
-  case empty_r => assumption
-  case union_r ih1 ih2 => exact ih2 (ih1 hd)
-  case tree => apply! hd.append_excl_l (ex1 := [_])
-  case excl_absurd_r => assumption
-  case excl_irrelevant_r ih => apply! ih
-  case excl_subclass_r hs1 _ ih =>
-    apply Disjoint.union_l
-    apply! ih
-    apply! hd.refine_subroot_l
-  case excl_subclass_l => assumption
-  case excl_irrelevant_l ih => apply! ih
-
-theorem Kind.Disjoint.append_l_disj_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hda : a.Disjoint r2) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
-  cases hd
-  case absurd_l hsc =>
-    cases hsc
-    case here hs => apply! root $ hda.refines_subclass_l _
-    case there hsc => apply! absurd_l
-  case absurd_r => apply! absurd_r
-  case root => apply! root
-  case excl_l hsc => apply! excl_l
-  case excl_r hsc =>
-    cases hsc
-    case here hs => cases hda.symm.not_subclass hs
-    case there => apply! excl_r
-
-theorem Kind.Disjoint.append_l_contained_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hsc: ContainsSupOf ex2 a) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
-  cases hd
-  case absurd_l hsc =>
-    cases hsc
-    case here hs => apply! excl_l $ hsc.trans_subclass _
-    case there hsc => apply! absurd_l
-  case absurd_r => apply! absurd_r
-  case root => apply! root
-  case excl_l hsc => apply! excl_l
-  case excl_r hsc =>
-    cases hsc
-    case here hs => apply! absurd_r $ hsc.trans_subclass _
-    case there => apply! excl_r
-
-theorem Kind.Disjoint.refine_disjoint_subtract_l_disjoint_root
-  (hdr : Disjoint R K)
-  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
-  (hd : r1.Disjoint r2)
-  : Disjoint (.node r1 ex1) K := by
-  cases hs
-  case tree =>
-    generalize h : node r1 (r2 :: ex1) = L at hdr
-    induction hdr <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb => simp_all; apply! union_r
-    case absurd_l hsc =>
-      cases hsc
-      case here hs => cases hd.not_subclass hs
-      case there hsc => apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root hd2 => apply! root
-    case excl_l => apply! excl_l
-    case excl_r hsc =>
-      cases hsc
-      case here hs => apply! root $ hd.refines_subclass_r _
-      case there hsc => apply! excl_r
-  case excl_absurd_r => assumption
-  case excl_irrelevant_r hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
-  case excl_subclass_r hs =>
-    have ⟨hl, _⟩ := hdr.union_l_inv
-    apply! hl.refine_disjoint_subtract_l_disjoint_root _ hd
-  case excl_subclass_l => assumption
-  case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
-
-theorem Kind.Disjoint.refine_disjoint_subtract_l_subroot
-  (hdr : Disjoint R K)
-  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
-  (hsub : r2.Subclass r1)
-  (hd2 : Disjoint (.node r2 ex1) K)
-  : Disjoint (.node r1 ex1) K := by
-  cases hs
-  case tree =>
-    generalize h : node r1 (r2 :: ex1) = L at hdr
-    induction hdr <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      have ⟨_, _⟩ := hd2.union_r_inv
-      simp_all
-      apply! union_r
-    case absurd_l hsc =>
-      cases hsc
-      case here hs2 => cases hsub.antisymm hs2; assumption
-      case there => apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root => apply! root
-    case excl_l => apply! excl_l
-    case excl_r hsc =>
-      cases hsc
-      case here hs2 =>
-        cases hd2
-        case absurd_l => apply excl_r; apply! ContainsSupOf.trans_subclass
-        case absurd_r => apply! absurd_r
-        case root hd => cases hd.symm.not_subclass hs2
-        case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
-        case excl_r hsc => apply! excl_r
-      case there hsc => apply! excl_r
-  case excl_absurd_r => assumption
-  case excl_irrelevant_r hs =>  apply! hdr.refine_disjoint_subtract_l_subroot
-  case excl_subclass_r hs =>
-    have ⟨hl, _⟩ := hdr.union_l_inv
-    apply! hl.refine_disjoint_subtract_l_subroot
-  case excl_subclass_l => assumption
-  case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_subroot
-
-
-
-theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
-  induction hs generalizing K
-  case empty_l => apply empty_l
-  case union_l ih1 ih2 =>
-    have ⟨_, _⟩ := hdr.union_l_inv
-    apply! union_l (ih1 _ _) (ih2 _ _)
-  case empty_r => assumption
-  case union_r ha hb =>
-    have ⟨hl, hr⟩ := hd2.union_l_inv
-    apply ha hl _
-    apply hb hr hdr
-  case tree r1 ex1 r2 =>
-    generalize h : node r1 (r2 :: ex1) = L at hdr
-    induction hdr <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      have ⟨_, _⟩ := hd2.union_r_inv
-      simp_all
-      apply! union_r
-    case absurd_l hsc =>
-      cases hsc
-      case here hs =>
-        cases hd2
-        case absurd_l hsc => cases hsc
-        case absurd_r hsc => apply! absurd_r
-        case root hd =>  apply root; apply! hd.refines_subclass_l _
-        case excl_l hsc => apply excl_l; apply! hsc.trans_subclass
-        case excl_r hsc => cases hsc
-      case there hsc => apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root => apply! root
-    case excl_l => apply! excl_l
-    case excl_r hsc =>
-      cases hsc
-      case here hs =>
-        cases hd2
-        case absurd_r hsc => apply! absurd_r
-        case root hd => cases hd.symm.not_subclass hs
-        case excl_l hsc => apply absurd_r; apply! hsc.trans_subclass
-        case excl_r hsc => cases hsc
-        case absurd_l hsc => cases hsc
-      case there hsc => apply! excl_r
-  case excl_subclass_r r1 ex1 r2 ex2 _ a hss hsc hs ih =>
-    have ⟨hdr1, hdr2⟩ := hdr.union_l_inv
-    generalize h : node r2 (a :: ex2) = L at hd2
-    induction hd2 generalizing K2 <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      simp_all
-      have ⟨_, _⟩ := hdr.union_r_inv
-      have ⟨_, _⟩ := hdr1.union_r_inv
-      have ⟨_, _⟩ := hdr2.union_r_inv
-      apply! union_r (ha _ _ _) (hb _ _ _)
-    case absurd_l hsc =>
-      cases hsc
-      case here hsc1 =>
-        cases hss.antisymm hsc1
-        apply! hdr1.refine_disjoint_subtract_l_subroot
-      case there hsc =>
-        apply ih _ hdr1
-        apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr1
-    case excl_l hsc => apply! ih (.excl_l _)
-    case excl_r hsc =>
-      cases hsc
-      case here hs =>
-        cases hdr2
-        case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
-        case absurd_r => apply! absurd_r
-        case root hd => cases hd.symm.not_subclass hs
-        case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
-        case excl_r => apply! excl_r
-      case there hsc => apply! ih (excl_r _)
-  case excl_absurd_r hs => assumption
-  case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
-    generalize h : node r2 (a :: ex2) = L at hd2
-    induction hd2 generalizing K2 <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      simp_all
-      have ⟨_, _⟩ := hdr.union_r_inv
-      apply! union_r (ha _) (hb _)
-    case absurd_l hsc =>
-      cases hsc
-      case here hsc => cases hd.not_subclass hsc
-      case there hsc =>
-        apply ih _ hdr
-        apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr
-    case excl_l hsc => apply! ih (.excl_l _)
-    case excl_r hsc =>
-      cases hsc
-      case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
-      case there hsc => apply! ih (excl_r _)
-  case excl_subclass_l hs2 hs1 => assumption
-  case excl_irrelevant_l r1 ex1 r2 ex2 _ a hs2 hd1 hs ih =>
-    generalize h : node r2 (a :: ex2) = L at hd2
-    induction hd2 generalizing K2 <;> try cases h
-    case empty_r => apply! empty_r
-    case union_r ha hb =>
-      simp_all
-      have ⟨_, _⟩ := hdr.union_r_inv
-      apply! union_r (ha _) (hb _)
-    case absurd_l hsc =>
-      cases hsc
-      case here hsc =>
-        cases hs2.antisymm hsc
-        apply! hdr.refine_disjoint_subtract_l_disjoint_root hs
-      case there hsc =>
-        apply ih _ hdr
-        apply! absurd_l
-    case absurd_r => apply! absurd_r
-    case root hd1 => apply ih (.root hd1) hdr
-    case excl_l hsc => apply! ih (.excl_l _)
-    case excl_r hsc =>
-      cases hsc
-      case here hs => apply root; apply! hd1.refines_subclass_r
-      case there hsc => apply! ih (excl_r _)
-
-theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
-  induction he
-  case empty => apply empty_l
-  case absurd => apply! absurd_l'
-  case union ha hb => apply! union_l
+-- inductive Kind.Disjoint : Kind -> Kind -> Prop where
+--   | empty_l: Disjoint .empty K
+--   | empty_r : Disjoint K .empty
+--   | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
+--   | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
+--   | absurd_l : ContainsSupOf ex1 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+--   | absurd_r : ContainsSupOf ex2 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+--   | root : r1.Disjoint r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+--   | excl_l : ContainsSupOf ex2 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+--   | excl_r : ContainsSupOf ex1 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
+
+-- theorem Kind.Disjoint.union_l_inv (hd : Disjoint (K1.union K2) K) : Disjoint K1 K ∧ Disjoint K2 K := by
+--   generalize hk : Kind.union K1 K2 = K' at hd
+--   induction hd with
+--   | empty_l => cases hk
+--   | empty_r => exact ⟨.empty_r, .empty_r⟩
+--   | union_l hd1 hd2 =>
+--     cases hk
+--     exact ⟨hd1, hd2⟩
+--   | union_r hd1 hd2 ih1 ih2 =>
+--     have ⟨hd1', hd2'⟩ := ih1 hk
+--     have ⟨hd1'', hd2''⟩ := ih2 hk
+--     exact ⟨.union_r hd1' hd1'', .union_r hd2' hd2''⟩
+--   | absurd_l => cases hk
+--   | absurd_r => cases hk
+--   | root => cases hk
+--   | excl_l => cases hk
+--   | excl_r => cases hk
+
+-- theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (K1.union K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
+--   generalize hk : Kind.union K1 K2 = K' at hd
+--   induction hd with
+--   | empty_l => exact ⟨.empty_l, .empty_l⟩
+--   | empty_r => cases hk
+--   | union_l hd1 hd2 ih1 ih2 =>
+--     have ⟨hd1', hd2'⟩ := ih1 hk
+--     have ⟨hd1'', hd2''⟩ := ih2 hk
+--     exact ⟨.union_l hd1' hd1'', .union_l hd2' hd2''⟩
+--   | union_r hd1 hd2 =>
+--     cases hk
+--     exact ⟨hd1, hd2⟩
+--   | absurd_l => cases hk
+--   | absurd_r => cases hk
+--   | root => cases hk
+--   | excl_l => cases hk
+--   | excl_r => cases hk
+
+-- theorem Kind.Disjoint.implies_empty_intersect (hd : K1.Disjoint K2) (hi : Intersect K1 K2 R) : IsEmpty R := by
+--   induction hi with
+--   | empty_l => exact .empty
+--   | empty_r => exact .empty
+--   | union_l hi1 hi2 ih1 ih2 =>
+--     have ⟨hd1, hd2⟩ := hd.union_l_inv
+--     exact .union (ih1 hd1) (ih2 hd2)
+--   | union_r hi1 hi2 ih1 ih2 =>
+--     have ⟨hd1, hd2⟩ := hd.union_r_inv
+--     exact .union (ih1 hd1) (ih2 hd2)
+--   | singleton_l hs =>
+--     cases hd with
+--     | absurd_l ha => exact .absurd (.append_l ha)
+--     | absurd_r ha => exact .absurd (.append_r (ha.trans_subclass hs))
+--     | root hd => cases hd.not_subclass hs
+--     | excl_l ha => exact .absurd (.append_r ha)
+--     | excl_r ha => exact .absurd (.append_l (ha.trans_subclass hs))
+--   | singleton_r hs =>
+--     cases hd with
+--     | absurd_l ha => exact .absurd (.append_l (ha.trans_subclass hs))
+--     | absurd_r ha => exact .absurd (.append_r ha)
+--     | root hd => cases hd.symm.not_subclass hs
+--     | excl_l ha => exact .absurd (.append_r (ha.trans_subclass hs))
+--     | excl_r ha => exact .absurd (.append_l ha)
+--   | singleton_disj => exact .empty
+
+-- theorem Kind.Disjoint.from_empty_intersect (hi : Intersect K1 K2 R) (he : IsEmpty R) : K1.Disjoint K2 := by
+--   induction hi with
+--   | empty_l => exact .empty_l
+--   | empty_r => exact .empty_r
+--   | union_l hi1 hi2 ih1 ih2 =>
+--     cases he with
+--     | union he1 he2 => exact .union_l (ih1 he1) (ih2 he2)
+--   | union_r hi1 hi2 ih1 ih2 =>
+--     cases he with
+--     | union he1 he2 => exact .union_r (ih1 he1) (ih2 he2)
+--   | singleton_l hs =>
+--     cases he with
+--     | absurd ha =>
+--       cases ha.of_append with
+--       | inl ha => exact .absurd_l ha
+--       | inr ha => exact .excl_l ha
+--   | singleton_r hs =>
+--     cases he with
+--     | absurd ha =>
+--       cases ha.of_append with
+--       | inl ha => exact .excl_r ha
+--       | inr ha => exact .absurd_r ha
+--   | singleton_disj hd => exact .root hd
+
+-- theorem Kind.Disjoint.top_l (hd: Disjoint .top K) : IsEmpty K := by
+--   cases hd
+--   case empty_r => constructor
+--   case union_r ha hb => apply IsEmpty.union ha.top_l hb.top_l
+--   case absurd_l hsc => cases hsc
+--   case absurd_r hsc => constructor; assumption
+--   case root hd => cases hd.symm.not_subclass .of_top
+--   case excl_l hsc => constructor; apply hsc.trans_subclass .of_top
+--   case excl_r hsc => cases hsc
+
+-- theorem Kind.Disjoint.symm (hd : K1.Disjoint K2) : Disjoint K2 K1 := by
+--   induction hd with
+--   | empty_l => exact .empty_r
+--   | empty_r => exact .empty_l
+--   | union_l _ _ ih1 ih2 => exact .union_r ih1 ih2
+--   | union_r _ _ ih1 ih2 => exact .union_l ih1 ih2
+--   | absurd_l ha => exact .absurd_r ha
+--   | absurd_r ha => exact .absurd_l ha
+--   | root hd => exact .root hd.symm
+--   | excl_l ha => exact .excl_r ha
+--   | excl_r ha => exact .excl_l ha
+
+-- theorem Kind.Disjoint.append_excl_l (hd : Disjoint (.node r1 ex2) K) : Disjoint (.node r1 (ex1 ++ ex2)) K := by
+--   cases hd
+--   case empty_r => apply! empty_r
+--   case union_r ha hb => apply union_r ha.append_excl_l hb.append_excl_l
+--   case absurd_l ha => apply absurd_l ha.append_r
+--   case absurd_r => apply! absurd_r
+--   case root => apply! root
+--   case excl_l => apply! excl_l
+--   case excl_r ha => apply excl_r ha.append_r
+
+-- theorem Kind.Disjoint.refine_subroot_l (hd : Disjoint (.node r1 ex1) K) (hs : r2.Subclass r1) : Disjoint (.node r2 ex1) K := by
+--   cases hd
+--   case empty_r => apply! empty_r
+--   case union_r ha hb => apply! union_r (ha.refine_subroot_l _) (hb.refine_subroot_l _)
+--   case absurd_l ha => apply! absurd_l $ ha.trans_subclass _
+--   case absurd_r => apply! absurd_r
+--   case root hdr => apply root; apply! hdr.refines_subclass_l _
+--   case excl_l hc => apply! excl_l $ hc.trans_subclass _
+--   case excl_r => apply! excl_r
+
+-- -- If K1 is disjoint from K', and R is the intersection of K with K1, then R is disjoint from K'
+-- theorem Kind.Disjoint.intersect_disjoint (hd : K1.Disjoint K') (hi : Intersect K K1 R) : R.Disjoint K' := by
+--   induction hi
+--   case empty_l => apply! empty_l
+--   case empty_r => apply! empty_l
+--   case union_l iha ihb => apply! union_l (iha _) (ihb _)
+--   case union_r iha ihb =>
+--     have ⟨_, _⟩ := hd.union_l_inv
+--     apply! union_l (iha _) (ihb _)
+--   case singleton_l hs => apply append_excl_l; apply! hd.refine_subroot_l _
+--   case singleton_r hs => apply hd.append_excl_l
+--   case singleton_disj hdr => apply empty_l
+
+-- theorem Kind.Disjoint.absurd_l' (hs : ContainsSupOf ex1 r1) : Disjoint (.node r1 ex1) K := by
+--   induction K
+--   case empty => apply empty_r
+--   case node => apply! absurd_l
+--   case union ha hb => apply! union_r
+
+-- theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K2 R) : Disjoint R K := by
+--   induction hs
+--   case empty_l => exact .empty_l
+--   case union_l ih1 ih2 =>
+--     have ⟨hd1, hd2⟩ := hd.union_l_inv
+--     exact .union_l (ih1 hd1) (ih2 hd2)
+--   case empty_r => assumption
+--   case union_r ih1 ih2 => exact ih2 (ih1 hd)
+--   case tree => apply! hd.append_excl_l (ex1 := [_])
+--   case excl_absurd_r => assumption
+--   case excl_irrelevant_r ih => apply! ih
+--   case excl_subclass_r hs1 _ ih =>
+--     apply Disjoint.union_l
+--     apply! ih
+--     apply! hd.refine_subroot_l
+--   case excl_subclass_l => assumption
+--   case excl_irrelevant_l ih => apply! ih
+
+-- theorem Kind.Disjoint.append_l_disj_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hda : a.Disjoint r2) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
+--   cases hd
+--   case absurd_l hsc =>
+--     cases hsc
+--     case here hs => apply! root $ hda.refines_subclass_l _
+--     case there hsc => apply! absurd_l
+--   case absurd_r => apply! absurd_r
+--   case root => apply! root
+--   case excl_l hsc => apply! excl_l
+--   case excl_r hsc =>
+--     cases hsc
+--     case here hs => cases hda.symm.not_subclass hs
+--     case there => apply! excl_r
+
+-- theorem Kind.Disjoint.append_l_contained_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hsc: ContainsSupOf ex2 a) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
+--   cases hd
+--   case absurd_l hsc =>
+--     cases hsc
+--     case here hs => apply! excl_l $ hsc.trans_subclass _
+--     case there hsc => apply! absurd_l
+--   case absurd_r => apply! absurd_r
+--   case root => apply! root
+--   case excl_l hsc => apply! excl_l
+--   case excl_r hsc =>
+--     cases hsc
+--     case here hs => apply! absurd_r $ hsc.trans_subclass _
+--     case there => apply! excl_r
+
+-- theorem Kind.Disjoint.refine_disjoint_subtract_l_disjoint_root
+--   (hdr : Disjoint R K)
+--   (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+--   (hd : r1.Disjoint r2)
+--   : Disjoint (.node r1 ex1) K := by
+--   cases hs
+--   case tree =>
+--     generalize h : node r1 (r2 :: ex1) = L at hdr
+--     induction hdr <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb => simp_all; apply! union_r
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hs => cases hd.not_subclass hs
+--       case there hsc => apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd2 => apply! root
+--     case excl_l => apply! excl_l
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs => apply! root $ hd.refines_subclass_r _
+--       case there hsc => apply! excl_r
+--   case excl_absurd_r => assumption
+--   case excl_irrelevant_r hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
+--   case excl_subclass_r hs =>
+--     have ⟨hl, _⟩ := hdr.union_l_inv
+--     apply! hl.refine_disjoint_subtract_l_disjoint_root _ hd
+--   case excl_subclass_l => assumption
+--   case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
+
+-- theorem Kind.Disjoint.refine_disjoint_subtract_l_subroot
+--   (hdr : Disjoint R K)
+--   (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
+--   (hsub : r2.Subclass r1)
+--   (hd2 : Disjoint (.node r2 ex1) K)
+--   : Disjoint (.node r1 ex1) K := by
+--   cases hs
+--   case tree =>
+--     generalize h : node r1 (r2 :: ex1) = L at hdr
+--     induction hdr <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb =>
+--       have ⟨_, _⟩ := hd2.union_r_inv
+--       simp_all
+--       apply! union_r
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hs2 => cases hsub.antisymm hs2; assumption
+--       case there => apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root => apply! root
+--     case excl_l => apply! excl_l
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs2 =>
+--         cases hd2
+--         case absurd_l => apply excl_r; apply! ContainsSupOf.trans_subclass
+--         case absurd_r => apply! absurd_r
+--         case root hd => cases hd.symm.not_subclass hs2
+--         case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
+--         case excl_r hsc => apply! excl_r
+--       case there hsc => apply! excl_r
+--   case excl_absurd_r => assumption
+--   case excl_irrelevant_r hs =>  apply! hdr.refine_disjoint_subtract_l_subroot
+--   case excl_subclass_r hs =>
+--     have ⟨hl, _⟩ := hdr.union_l_inv
+--     apply! hl.refine_disjoint_subtract_l_subroot
+--   case excl_subclass_l => assumption
+--   case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_subroot
+
+
+
+-- theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
+--   induction hs generalizing K
+--   case empty_l => apply empty_l
+--   case union_l ih1 ih2 =>
+--     have ⟨_, _⟩ := hdr.union_l_inv
+--     apply! union_l (ih1 _ _) (ih2 _ _)
+--   case empty_r => assumption
+--   case union_r ha hb =>
+--     have ⟨hl, hr⟩ := hd2.union_l_inv
+--     apply ha hl _
+--     apply hb hr hdr
+--   case tree r1 ex1 r2 =>
+--     generalize h : node r1 (r2 :: ex1) = L at hdr
+--     induction hdr <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb =>
+--       have ⟨_, _⟩ := hd2.union_r_inv
+--       simp_all
+--       apply! union_r
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hs =>
+--         cases hd2
+--         case absurd_l hsc => cases hsc
+--         case absurd_r hsc => apply! absurd_r
+--         case root hd =>  apply root; apply! hd.refines_subclass_l _
+--         case excl_l hsc => apply excl_l; apply! hsc.trans_subclass
+--         case excl_r hsc => cases hsc
+--       case there hsc => apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root => apply! root
+--     case excl_l => apply! excl_l
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs =>
+--         cases hd2
+--         case absurd_r hsc => apply! absurd_r
+--         case root hd => cases hd.symm.not_subclass hs
+--         case excl_l hsc => apply absurd_r; apply! hsc.trans_subclass
+--         case excl_r hsc => cases hsc
+--         case absurd_l hsc => cases hsc
+--       case there hsc => apply! excl_r
+--   case excl_subclass_r r1 ex1 r2 ex2 _ a hss hsc hs ih =>
+--     have ⟨hdr1, hdr2⟩ := hdr.union_l_inv
+--     generalize h : node r2 (a :: ex2) = L at hd2
+--     induction hd2 generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb =>
+--       simp_all
+--       have ⟨_, _⟩ := hdr.union_r_inv
+--       have ⟨_, _⟩ := hdr1.union_r_inv
+--       have ⟨_, _⟩ := hdr2.union_r_inv
+--       apply! union_r (ha _ _ _) (hb _ _ _)
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc1 =>
+--         cases hss.antisymm hsc1
+--         apply! hdr1.refine_disjoint_subtract_l_subroot
+--       case there hsc =>
+--         apply ih _ hdr1
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd1 => apply ih (.root hd1) hdr1
+--     case excl_l hsc => apply! ih (.excl_l _)
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs =>
+--         cases hdr2
+--         case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
+--         case absurd_r => apply! absurd_r
+--         case root hd => cases hd.symm.not_subclass hs
+--         case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
+--         case excl_r => apply! excl_r
+--       case there hsc => apply! ih (excl_r _)
+--   case excl_absurd_r hs => assumption
+--   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
+--     generalize h : node r2 (a :: ex2) = L at hd2
+--     induction hd2 generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb =>
+--       simp_all
+--       have ⟨_, _⟩ := hdr.union_r_inv
+--       apply! union_r (ha _) (hb _)
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc => cases hd.not_subclass hsc
+--       case there hsc =>
+--         apply ih _ hdr
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd1 => apply ih (.root hd1) hdr
+--     case excl_l hsc => apply! ih (.excl_l _)
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
+--       case there hsc => apply! ih (excl_r _)
+--   case excl_subclass_l hs2 hs1 => assumption
+--   case excl_irrelevant_l r1 ex1 r2 ex2 _ a hs2 hd1 hs ih =>
+--     generalize h : node r2 (a :: ex2) = L at hd2
+--     induction hd2 generalizing K2 <;> try cases h
+--     case empty_r => apply! empty_r
+--     case union_r ha hb =>
+--       simp_all
+--       have ⟨_, _⟩ := hdr.union_r_inv
+--       apply! union_r (ha _) (hb _)
+--     case absurd_l hsc =>
+--       cases hsc
+--       case here hsc =>
+--         cases hs2.antisymm hsc
+--         apply! hdr.refine_disjoint_subtract_l_disjoint_root hs
+--       case there hsc =>
+--         apply ih _ hdr
+--         apply! absurd_l
+--     case absurd_r => apply! absurd_r
+--     case root hd1 => apply ih (.root hd1) hdr
+--     case excl_l hsc => apply! ih (.excl_l _)
+--     case excl_r hsc =>
+--       cases hsc
+--       case here hs => apply root; apply! hd1.refines_subclass_r
+--       case there hsc => apply! ih (excl_r _)
+
+-- theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
+--   induction he
+--   case empty => apply empty_l
+--   case absurd => apply! absurd_l'
+--   case union ha hb => apply! union_l
 
-theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
-  apply refine_disjoint_subtract_l hd hs
-  apply is_empty_l he
+-- theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
+--   apply refine_disjoint_subtract_l hd hs
+--   apply is_empty_l he
 
-theorem Kind.Disjoint.refine_subkind_l (hd : Disjoint K2 K) (hs : Subkind K1 K2) : Disjoint K1 K := by
-  cases hs
-  apply! hd.refine_subkind_l'
+-- theorem Kind.Disjoint.refine_subkind_l (hd : Disjoint K2 K) (hs : Subkind K1 K2) : Disjoint K1 K := by
+--   cases hs
+--   apply! hd.refine_subkind_l'
 
-theorem Kind.Subkind.refine_disjoint_l (hs : Subkind K1 K2) (hd : Disjoint K2 K) : Disjoint K1 K := hd.refine_subkind_l hs
+-- theorem Kind.Subkind.refine_disjoint_l (hs : Subkind K1 K2) (hd : Disjoint K2 K) : Disjoint K1 K := hd.refine_subkind_l hs
 
-theorem Kind.Subtract.exists' : ∃ R, Subtract (node r1 ex1) (node r2 ex2) R := by
-  induction ex2
-  case nil => exists node r1 (r2 :: ex1); apply tree
-  case cons head tail ih =>
-    cases head.subclass_or_disjoint r2
-    case inl hs =>
-      have ⟨R, h⟩ := ih
-      cases head.subclass_or_disjoint r1
-      case inl hs1 =>
-        exists .union R (.node head ex1)
-        apply! excl_subclass_r
-      case inr hs1 =>
-        cases hs1
-        case inl hs1 =>
-          exists node r1 ex1
-          apply! excl_subclass_l
-        case inr hs1 =>
-          exists R
-          apply! excl_irrelevant_l _ hs1.symm
-    case inr hs =>
-      cases hs
-      case inl hs =>
-        exists node r1 ex1
-        apply! excl_absurd_r
-      case inr hs =>
-        have ⟨R, h⟩ := ih
-        exists R
-        apply! excl_irrelevant_r hs.symm
-
-theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
-  induction b generalizing a
-  case empty =>
-    induction a
-    case empty => exists empty; apply! empty_l
-    case node r1 ex1 => exists node r1 ex1; apply empty_r
-    case union ha hb =>
-      have ⟨r1, h1⟩ := ha
-      have ⟨r2, h2⟩ := hb
-      exists .union r1 r2
-      apply! union_l
-  case union hb1 hb2 =>
-    induction a
-    case empty => exists empty; apply! empty_l
-    case node r1 ex1 =>
-      have ⟨r1, h1⟩ := hb1 (a := node r1 ex1)
-      have ⟨r2, h2⟩ := hb2 (a := r1)
-      exists r2; apply! union_r
-    case union ha1 ha2 =>
-      have ⟨r1, h1⟩ := ha1
-      have ⟨r2, h2⟩ := ha2
-      exists .union r1 r2
-      apply! union_l
-  case node r2 ex2 =>
-    induction a
-    case empty => exists empty; apply! empty_l
-    case node r1 ex1 =>
-      apply exists'
-    case union ha1 ha2 =>
-      have ⟨r1, h1⟩ := ha1
-      have ⟨r2, h2⟩ := ha2
-      exists .union r1 r2
-      apply! union_l
 
 theorem Kind.Subtract.is_empty_append_l
   (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
@@ -1383,62 +756,62 @@ theorem Kind.ContainsSupOf.lawful : ContainsSupOf exs r ↔ contains_sup_of exs
       . apply ContainsSupOf.here; simp_all [Classifier.subclass_is_Subclass]
       . apply ContainsSupOf.there; rw [← lawful] at hsc; simp_all
 
-@[simp]
-def Kind.disjoint (K1 : Kind) (K2 : Kind) :=
-  match K1 with
-  | .empty => true
-  | .union a b => a.disjoint K2 && b.disjoint K2
-  | .node r1 ex1 =>
-    match K2 with
-    | .empty => true
-    | .union a b => (Kind.node r1 ex1).disjoint a && (Kind.node r1 ex1).disjoint b
-    | .node r2 ex2 =>
-      r1.disjoint r2
-        || contains_sup_of ex1 r1 || contains_sup_of ex2 r2
-        || contains_sup_of ex1 r2 || contains_sup_of ex2 r1
-
-theorem Kind.Disjoint.lawful : Disjoint K1 K2 ↔ K1.disjoint K2 := by
-  apply Iff.intro
-  . intro hd
-    induction hd
-    case empty_l => simp
-    case empty_r K =>
-      induction K <;> simp_all
-    case union_l => simp_all
-    case union_r K K1 K2 _ _ ha hb =>
-      induction K <;> simp_all
-      rename_i iha ihb hha hhb
-      have ⟨_, _⟩ := hha.union_l_inv
-      have ⟨_, _⟩ := hhb.union_l_inv
-      apply And.intro
-      apply! iha
-      apply! ihb
-    case absurd_l hsc => simp_all [ContainsSupOf.lawful]
-    case absurd_r hsc => simp_all [ContainsSupOf.lawful]
-    case root hd => simp_all [Classifier.disjoint_is_Disjoint]
-    case excl_l => simp_all [ContainsSupOf.lawful]
-    case excl_r => simp_all [ContainsSupOf.lawful]
-  . intro hd
-    induction K1
-    case empty => apply empty_l
-    case union ha hb =>
-      apply union_l <;> simp_all
-    case node r1 ex1 =>
-      induction K2
-      case empty => apply empty_r
-      case union ha hb =>
-        apply union_r <;> simp_all
-      case node r2 ex2 =>
-        simp at hd; rw [← Classifier.disjoint_is_Disjoint] at hd; repeat rw [← ContainsSupOf.lawful] at hd
-        cases hd <;> rename_i hd
-        . cases hd <;> rename_i hd
-          . cases hd <;> rename_i hd
-            . cases hd <;> rename_i hd
-              . apply! root
-              . apply! absurd_l
-            . apply! absurd_r
-          . apply! excl_r
-        . apply! excl_l
+-- @[simp]
+-- def Kind.disjoint (K1 : Kind) (K2 : Kind) :=
+--   match K1 with
+--   | .empty => true
+--   | .union a b => a.disjoint K2 && b.disjoint K2
+--   | .node r1 ex1 =>
+--     match K2 with
+--     | .empty => true
+--     | .union a b => (Kind.node r1 ex1).disjoint a && (Kind.node r1 ex1).disjoint b
+--     | .node r2 ex2 =>
+--       r1.disjoint r2
+--         || contains_sup_of ex1 r1 || contains_sup_of ex2 r2
+--         || contains_sup_of ex1 r2 || contains_sup_of ex2 r1
+
+-- theorem Kind.Disjoint.lawful : Disjoint K1 K2 ↔ K1.disjoint K2 := by
+--   apply Iff.intro
+--   . intro hd
+--     induction hd
+--     case empty_l => simp
+--     case empty_r K =>
+--       induction K <;> simp_all
+--     case union_l => simp_all
+--     case union_r K K1 K2 _ _ ha hb =>
+--       induction K <;> simp_all
+--       rename_i iha ihb hha hhb
+--       have ⟨_, _⟩ := hha.union_l_inv
+--       have ⟨_, _⟩ := hhb.union_l_inv
+--       apply And.intro
+--       apply! iha
+--       apply! ihb
+--     case absurd_l hsc => simp_all [ContainsSupOf.lawful]
+--     case absurd_r hsc => simp_all [ContainsSupOf.lawful]
+--     case root hd => simp_all [Classifier.disjoint_is_Disjoint]
+--     case excl_l => simp_all [ContainsSupOf.lawful]
+--     case excl_r => simp_all [ContainsSupOf.lawful]
+--   . intro hd
+--     induction K1
+--     case empty => apply empty_l
+--     case union ha hb =>
+--       apply union_l <;> simp_all
+--     case node r1 ex1 =>
+--       induction K2
+--       case empty => apply empty_r
+--       case union ha hb =>
+--         apply union_r <;> simp_all
+--       case node r2 ex2 =>
+--         simp at hd; rw [← Classifier.disjoint_is_Disjoint] at hd; repeat rw [← ContainsSupOf.lawful] at hd
+--         cases hd <;> rename_i hd
+--         . cases hd <;> rename_i hd
+--           . cases hd <;> rename_i hd
+--             . cases hd <;> rename_i hd
+--               . apply! root
+--               . apply! absurd_l
+--             . apply! absurd_r
+--           . apply! excl_r
+--         . apply! excl_l
 
 
 -- inductive Kind.Contains : Kind -> Classifier -> Prop where
diff --git a/Capless/Classifier/Core.lean b/Capless/Classifier/Core.lean
new file mode 100644
index 00000000..102247b3
--- /dev/null
+++ b/Capless/Classifier/Core.lean
@@ -0,0 +1,320 @@
+import Capless.Basic
+import Capless.Tactics
+
+namespace Capless
+
+/-- Classifiers represent nodes in the infinite classifier tree.
+    Essentially, they are a sequence of natural numbers, representing the indicies of the children to walk
+    on the path from the root to the node. -/
+inductive Classifier : Type where
+  | top : Classifier
+  | child : Nat -> Classifier -> Classifier
+deriving DecidableEq
+
+/-- The control classifier. -/
+def Classifier.control := child 0 .top
+
+/-- Subclass: Is `a` within the subtree rooted at `b`? -/
+inductive Classifier.Subclass : Classifier -> Classifier -> Prop where
+  | rfl : Subclass a a
+  | parent_l : Subclass a b -> Subclass (child n a) b
+
+/-- Strict subclass = subclass and not equal. -/
+inductive Classifier.StrictSub : Classifier -> Classifier -> Prop where
+  | child : StrictSub (child n a) a
+  | parent_l : StrictSub a b -> StrictSub (child n a) b
+
+theorem Classifier.Subclass.might_strict (hs : Subclass a b) : a = b ∨ StrictSub a b := by
+  induction hs
+  case rfl => left; simp
+  case parent_l hp ih =>
+    right
+    cases ih
+    case inl => subst_vars; constructor
+    case inr => apply! StrictSub.parent_l
+
+theorem Classifier.StrictSub.weaken (hs : StrictSub a b) : Subclass a b := by
+  induction hs
+  case child => apply Subclass.parent_l .rfl
+  case parent_l hp ih => apply Subclass.parent_l ih
+
+theorem Classifier.StrictSub.size (hs : StrictSub a b) : sizeOf a > sizeOf b := by induction hs <;> (simp; try omega)
+
+theorem Classifier.StrictSub.neq (hs : StrictSub a b) : a ≠ b := by
+  apply Ne.intro
+  intro h
+  have hs := hs.size
+  rw [h] at hs
+  omega
+
+/-- Disjoint: the classifier nodes are not within each other's subtrees. -/
+inductive Classifier.Disjoint : Classifier -> Classifier -> Prop where
+  | base : n != m -> Disjoint (child n p) (child m p)
+  | left : Disjoint a b -> Disjoint (child n a) b
+  | right : Disjoint a b -> Disjoint a (child m b)
+
+theorem Classifier.Subclass.of_top : Subclass a .top := by
+  induction a
+  case top => apply rfl
+  case child n k ih => apply parent_l ih
+
+theorem Classifier.Subclass.parent_r (hs : Subclass a (child n b)) : Subclass a b := by
+  cases hs
+  case rfl => apply parent_l rfl
+  case parent_l hp =>
+    apply parent_l hp.parent_r
+
+theorem Classifier.Subclass.trans (h1 : Subclass a b) (h2 : Subclass b c) : Subclass a c := by
+  induction h2
+  case rfl => assumption
+  case parent_l hp ih => apply ih h1.parent_r
+
+theorem Classifier.Subclass.down_r (hs : Subclass a b) : a = b ∨ ∃ n, Subclass a (child n b) := by
+  induction hs
+  case rfl => simp
+  case parent_l ih =>
+    rename_i n _
+    right
+    cases ih
+    case inl ih => subst_vars; exists n; constructor
+    case inr ih =>
+      have ⟨m, ih⟩ := ih
+      exists m
+      apply parent_l ih
+
+theorem Classifier.Subclass.size (hs : Subclass a b) : sizeOf a ≥ sizeOf b := by
+  induction hs <;> (simp; try omega)
+
+theorem Classifier.Subclass.antisymm (h1 : Subclass a b) (h2 : Subclass b a) : a = b := by
+  induction h1
+  case rfl => simp
+  case parent_l hp ih =>
+    have hp1 := hp.size
+    have h21 := h2.size
+    simp at h21
+    omega
+
+theorem Classifier.StrictSub.antisymm (hs : StrictSub a b) (hs2 : Subclass b a) : False := by
+  have h := hs.size
+  have h2 := hs2.size
+  omega
+
+theorem Classifier.StrictSub.subclass_r (hss : StrictSub a b) (hs : Subclass b c) : StrictSub a c := by
+  induction hss
+  case child n a =>
+    induction hs generalizing n
+    case rfl => apply child
+    case parent_l m k ih =>
+      apply parent_l ih
+  case parent_l n a ih =>
+    apply! parent_l $ ih _
+
+theorem Classifier.StrictSub.subclass_l (hss : StrictSub a b) (hs : Subclass c a) : StrictSub c b := by
+  cases hs.might_strict <;> rename_i hs
+  . simp_all
+  . apply hs.subclass_r hss.weaken
+
+theorem Classifier.Disjoint.symm (hd : Disjoint a b) : Disjoint b a := by
+  induction hd
+  case base hne =>
+    apply base; aesop
+  case left => apply! right
+  case right => apply! left
+
+theorem Classifier.Disjoint.refines_subclass_r
+  (hd : Disjoint b a2)
+  (hs : Subclass a1 a2) : Disjoint b a1 := by
+  induction hs
+  case rfl => assumption
+  case parent_l hs ih =>
+    apply right $ ih hd
+
+theorem Classifier.Disjoint.refines_subclass_l (hd : Disjoint a2 b) (hs : Subclass a1 a2) : Disjoint a1 b := by
+  apply symm
+  apply refines_subclass_r hd.symm hs
+
+theorem Classifier.Disjoint.left_inv (hd : Disjoint (child n a) b) : Subclass b a ∨ Disjoint a b := by
+  cases hd
+  case base m _ => left; constructor; constructor;
+  case left => right; assumption
+  case right hd =>
+    cases hd.left_inv
+    case inl hd => left; constructor; assumption
+    case inr hd => right; apply! right
+
+theorem Classifier.Disjoint.not_subclass (hd : Disjoint a b) (hs : Subclass a b) : False := by
+  induction a generalizing b
+  case top =>
+    induction b
+    case top => cases hd
+    case child n p ih => cases hs
+  case child n p ih =>
+    induction b
+    case top => cases hs; cases hd; apply! ih
+    case child m q ih2 =>
+      cases hs
+      case rfl =>
+        cases hd
+        case base => aesop
+        case left hs => apply ih2 hs.symm $ .parent_l .rfl
+        case right hs => apply ih2 hs $ .parent_l .rfl
+      case parent_l hs =>
+        cases hd
+        case base => have h := hs.size; simp at h; omega
+        case left => apply! ih
+        case right hd =>
+          cases hd.left_inv
+          case inl hd =>
+            have h := hs.parent_r.antisymm hd
+            subst_vars
+            have h := hs.size; simp at h; omega
+          case inr hd =>
+            apply ih (b:=q) hd hs.parent_r
+
+theorem Classifier.Disjoint.to_subclass (hd : Disjoint a b) (hs : Subclass c b) : Disjoint a c := by
+  induction hs
+  case rfl => assumption
+  case parent_l hp ih =>
+    apply right
+    apply ih hd
+
+/-- Each pair of classifier nodes are either subclass of the other, or they are disjoint. -/
+theorem Classifier.subclass_or_disjoint a b:
+  Subclass a b ∨ StrictSub b a ∨ Disjoint a b := by
+  induction a
+  case top =>
+    cases Subclass.of_top (a:=b).might_strict
+    case inl => simp_all; left; exact .rfl
+    case inr => aesop
+  case child n k ih =>
+    cases ih
+    case inl ih =>
+      left; constructor; assumption
+    case inr ih =>
+      cases ih
+      case inl ih =>
+        cases ih.weaken.down_r
+        { subst_vars; left; apply Subclass.parent_l .rfl }
+        { rename_i ih1; have ⟨m, ih1⟩ := ih1;
+          generalize h : (n == m) = h0;
+          cases h0
+          right; right;
+          apply Disjoint.refines_subclass_r; apply Disjoint.base (m:=m); aesop; assumption
+          have h0 := LawfulBEq.eq_of_beq h; subst_vars
+          cases ih1.might_strict
+          . left; subst_vars; exact .rfl
+          . aesop
+        }
+      case inr ih =>
+        right; right; apply Disjoint.left ih
+
+/-- The subclass relationm, defined as a deterministic boolean function. -/
+def Classifier.subclass (a : Classifier) (b : Classifier) :=
+  if a == b then true
+  else match a with
+    | .top => false
+    | .child n p => p.subclass b
+
+theorem Classifier.subclass_is_Subclass : Subclass a b ↔ a.subclass b := by
+  apply Iff.intro
+  . intro hs
+    induction hs
+    case rfl => unfold subclass; simp
+    case parent_l n p => unfold subclass; simp; right; assumption
+  . intro hs
+    unfold subclass at hs
+    split at hs
+    case isTrue h =>
+      have h1 := LawfulBEq.eq_of_beq h
+      subst_vars
+      constructor
+    case isFalse h =>
+      split at hs
+      . contradiction
+      . rename_i p
+        constructor
+        rw [subclass_is_Subclass (a:=p)]
+        assumption
+
+/-- The disjoint relation as a deterministic boolean function. -/
+def Classifier.disjoint (a : Classifier) (b : Classifier) :=
+  match a with
+  | .top => false
+  | .child n p =>
+    match b with
+    | .top => false
+    | .child m q =>
+      if p == q then n != m
+      else disjoint (.child n p) q || disjoint p (.child m q)
+
+theorem Classifier.disjoint_is_Disjoint {a b : Classifier} : Disjoint a b ↔ a.disjoint b := by
+  apply Iff.intro
+  . intro hs
+    induction hs with
+    | base hne =>
+      unfold disjoint
+      simp [hne]
+    | @left a' b' n ha ih =>
+      unfold disjoint
+      match b' with
+      | .top => cases ha.not_subclass .of_top
+      | .child m q =>
+        simp only
+        split
+        . rename_i heq
+          have h1 := LawfulBEq.eq_of_beq heq
+          subst_vars
+          cases ha.symm.not_subclass $ .parent_l .rfl
+        . simp [ih]
+    | @right a' b' m ha ih =>
+      unfold disjoint
+      match a' with
+      | .top =>
+        have : ∀ c, ¬ Disjoint top c := fun c h => by
+          induction c with
+          | top => cases h
+          | child n p ih =>
+            cases h with
+            | right ha => exact ih ha
+        exact absurd ha (this _)
+      | .child n p =>
+        simp only
+        split
+        . rename_i heq
+          have heq' := LawfulBEq.eq_of_beq heq
+          subst heq'
+          cases ha.not_subclass $ .parent_l .rfl
+        . simp [ih]
+  . intro hs
+    unfold disjoint at hs
+    split at hs
+    . cases hs
+    . split at hs
+      . cases hs
+      . split at hs
+        . rename_i h
+          have h1 := LawfulBEq.eq_of_beq h
+          subst_vars
+          apply! Disjoint.base
+        . simp at hs
+          cases hs
+          case inl hs =>
+            apply Disjoint.right
+            rw [disjoint_is_Disjoint]
+            assumption
+          case inr hs =>
+            apply Disjoint.left
+            rw [disjoint_is_Disjoint]
+            assumption
+termination_by sizeOf a + sizeOf b
+
+
+/-- Same as `subclass_or_disjoint`, but with the functions. -/
+theorem Classifier.subclass_or_disjoint' (a b : Classifier) : a.subclass b ∨ b.subclass a ∨ a.disjoint b := by
+  cases subclass_or_disjoint a b <;> rename_i h
+  . simp_all [Classifier.subclass_is_Subclass]
+  . cases h <;> rename_i h
+    . have h0 := h.weaken; simp_all [subclass_is_Subclass]
+    . simp_all [disjoint_is_Disjoint]
+
+end Capless
diff --git a/Capless/Classifier/Intersection.lean b/Capless/Classifier/Intersection.lean
new file mode 100644
index 00000000..95d3c15d
--- /dev/null
+++ b/Capless/Classifier/Intersection.lean
@@ -0,0 +1,173 @@
+import Capless.Classifier.Core
+import Capless.Classifier.Kind
+
+namespace Capless
+
+/-- The intersection of two subtrees. -/
+inductive Subtree.Intersect : Subtree -> Subtree -> Kind -> Prop where
+  | subtree_l : r1.Subclass r2 -> Intersect (mk r1 ex1) (mk r2 ex2) [mk r1 (ex1 ++ ex2)]
+  | subtree_r : r2.Subclass r1 -> Intersect (mk r1 ex1) (mk r2 ex2) [mk r2 (ex1 ++ ex2)]
+  | disjoint : r1.Disjoint r2 -> Intersect (mk r1 ex1) (mk r2 ex2) []
+
+/-- Intersection of two kinds. -/
+inductive Kind.Intersect : Kind -> Kind -> Kind -> Prop where
+  | empty_l : Intersect [] K []
+  | empty_r : Intersect K [] []
+  | append_l : Intersect [x] K R1 -> Intersect xs K R2 -> Intersect (x::xs) K (R1 ++ R2)
+  | append_r : Intersect K [x] R1 -> Intersect K xs R2 -> Intersect K (x::xs) (R1 ++ R2)
+  | singleton : x.Intersect y R -> Intersect [x] [y] R
+
+@[simp]
+def Subtree.intersect (s : Subtree) (t : Subtree) : Kind :=
+  if s.root.subclass t.root then .node s.root (s.excls ++ t.excls)
+  else if t.root.subclass s.root then .node t.root (s.excls ++ t.excls)
+  else .empty
+
+theorem Subtree.Intersect.lawful : Intersect s t (s.intersect t) := by
+  simp
+  split
+  . rename_i h
+    simp [← Classifier.subclass_is_Subclass] at h
+    apply! subtree_l
+  . split
+    . rename_i h
+      simp [← Classifier.subclass_is_Subclass] at h
+      apply! subtree_r
+    . simp [← Classifier.subclass_is_Subclass] at *
+      cases Classifier.subclass_or_disjoint s.root t.root <;> rename_i h
+      . contradiction
+      . cases h <;> rename_i h
+        . have h0 := h.weaken; contradiction
+        . simp [← Classifier.disjoint_is_Disjoint] at h
+          apply! disjoint
+
+@[simp]
+def Kind.intersect (k : Kind) (l : Kind) : Kind :=
+  List.flatMap (fun x => List.flatMap (fun y => x.intersect y) l) k
+
+def Kind.intersect.cons_l : intersect (x :: xs) K = intersect [x] K ++ intersect xs K := by simp
+def Kind.intersect.append_l : intersect (xs1 ++ xs2) K = intersect xs1 K ++ intersect xs2 K := by simp
+def Kind.intersect.cons_r : intersect [x] (y :: ys) = intersect [x] [y] ++ intersect [x] ys := by simp
+def Kind.intersect.append_r : intersect [x] (ys1 ++ ys2) = intersect [x] ys1 ++ intersect [x] ys2 := by simp
+
+theorem Kind.Intersect.lawful' : Intersect [x] L (.intersect [x] L) := by
+  induction L
+  case nil => simp; apply empty_r
+  case cons y ys ih =>
+    simp
+    apply append_r
+    . apply singleton .lawful
+    . simp at ih; apply ih
+
+theorem Kind.Intersect.lawful : Intersect K L (K.intersect L) := by
+  induction K generalizing L
+  case nil => simp; apply empty_l
+  case cons x xs ih =>
+    apply append_l _ ih
+    have h := lawful' (x:=x) (L:=L)
+    simp_all
+
+theorem Kind.intersect.top_r {K : Kind} : K.intersect .top = K := by
+  induction K
+  case nil => simp
+  case cons x xs ih =>
+    have h := Classifier.Subclass.of_top (a:=x.root)
+    rw [Classifier.subclass_is_Subclass] at h
+    rw [cons_l, ih]
+    simp [h]
+
+theorem Kind.intersect.top_l {K : Kind} : Kind.top.intersect K = K := by
+  induction K
+  case nil => simp
+  case cons y ys ih =>
+    simp at *
+    rw [ih]
+    cases y
+    rename_i r exs
+    cases r
+    case top => simp [Classifier.subclass]
+    case child n t =>
+      simp [Classifier.subclass]
+      have h := Classifier.Subclass.of_top (a:=t)
+      rw [Classifier.subclass_is_Subclass] at h
+      simp [h]
+
+theorem Classifier.disjoint.implies_no_subclass (hd : disjoint a b) : (a.subclass b = false ∧ b.subclass a = false) := by
+  simp [← Classifier.disjoint_is_Disjoint] at hd
+  simp [← Bool.not_eq_true, ← Classifier.subclass_is_Subclass]
+  apply And.intro
+  . intro h; apply hd.not_subclass h
+  . intro h; apply hd.symm.not_subclass h
+
+theorem Classifier.StrictSub.not_superclass (hss : StrictSub a b) : (b.subclass a = false) := by
+  simp [← Bool.not_eq_true, ← Classifier.subclass_is_Subclass]
+  intro h
+  apply hss.antisymm h
+
+theorem Kind.intersect.assoc'' : (intersect [x] [y]).intersect [z] = intersect [x] (intersect [y] [z]) := by
+  cases Classifier.subclass_or_disjoint x.root y.root <;> rename_i h1
+  . have h1' := Classifier.subclass_is_Subclass.mp h1
+    cases Classifier.subclass_or_disjoint y.root z.root <;> rename_i h2
+    . have h2' := Classifier.subclass_is_Subclass.mp h2
+      have h3' := Classifier.subclass_is_Subclass.mp (h1.trans h2)
+      simp_all
+    . cases h2 <;> rename_i h2
+      . have h2' := Classifier.subclass_is_Subclass.mp h2.weaken
+        have h2'' := h2.not_superclass
+        cases Classifier.subclass_or_disjoint' x.root z.root <;> rename_i h3' <;> aesop
+      . have h2' := Classifier.disjoint_is_Disjoint.mp $ h2.refines_subclass_l h1
+        have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass h2'
+        have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass $ Classifier.disjoint_is_Disjoint.mp h2
+        simp_all
+  . cases h1 <;> rename_i h1
+    . have h1' := Classifier.subclass_is_Subclass.mp h1.weaken
+      have h1'' := h1.not_superclass
+      cases Classifier.subclass_or_disjoint y.root z.root <;> rename_i h2
+      . have h2' := Classifier.subclass_is_Subclass.mp h2
+        simp_all
+      . cases h2 <;> rename_i h2
+        . have h2' := Classifier.subclass_is_Subclass.mp h2.weaken
+          have h2'' := h2.not_superclass
+          have h3 := h2.subclass_r h1.weaken
+          have h3' := Classifier.subclass_is_Subclass.mp h3.weaken
+          have h3'' := h3.not_superclass
+          simp_all
+        . have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass $ Classifier.disjoint_is_Disjoint.mp h2
+          simp_all
+    . have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass $ Classifier.disjoint_is_Disjoint.mp h1
+      cases Classifier.subclass_or_disjoint y.root z.root <;> rename_i h2
+      . have h2' := Classifier.subclass_is_Subclass.mp h2
+        simp_all
+      . cases h2 <;> rename_i h2
+        . have h2' := Classifier.subclass_is_Subclass.mp h2.weaken
+          have h2'' := h2.not_superclass
+          have h3 := h1.refines_subclass_r h2.weaken
+          have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass $ Classifier.disjoint_is_Disjoint.mp h3
+          simp_all
+        . have ⟨_, _⟩ := Classifier.disjoint.implies_no_subclass $ Classifier.disjoint_is_Disjoint.mp h2
+          simp_all
+
+theorem Kind.intersect.assoc' {B C : Kind} : (intersect [x] B).intersect C = intersect [x] (B.intersect C) := by
+  induction B generalizing C
+  case nil => simp
+  case cons y ys ih =>
+    rw [cons_l (x:=y), cons_r, append_r, append_l, ih, List.append_left_inj]
+    induction C
+    case nil => simp
+    case cons z zs ih2 =>
+      have h : (intersect [x] [y]).intersect (z :: zs) = (intersect [x] [y]).intersect [z] ++ (intersect [x] [y]).intersect zs := by
+        generalize h0 : intersect [x] [y] = C
+        simp at h0; split at h0
+        . subst_vars; apply cons_r
+        . split at h0;
+          . subst_vars; apply cons_r
+          . subst_vars; simp
+      rw [cons_r (ys:=zs), append_r, h, assoc'', ih2]
+
+theorem Kind.intersect.assoc {A B C : Kind} : (A.intersect B).intersect C = A.intersect (B.intersect C) := by
+  induction A generalizing B C
+  case nil => simp
+  case cons a as ih =>
+    rw [cons_l (xs:=as), cons_l (xs:=as), append_l, ih, List.append_left_inj, assoc']
+
+end Capless
diff --git a/Capless/Classifier/Kind.lean b/Capless/Classifier/Kind.lean
new file mode 100644
index 00000000..fd168444
--- /dev/null
+++ b/Capless/Classifier/Kind.lean
@@ -0,0 +1,100 @@
+import Capless.Classifier.Core
+
+namespace Capless
+
+-- **
+-- Kinds
+-- **
+
+/-- A subtree of a single root and an exclusion list.
+    Notionally, it represents the subtree rooted at `root`, excluding the subtrees rooted at `excls`. -/
+structure Subtree : Type where
+  root  : Classifier
+  excls : List Classifier
+
+/-- A classifier filter : a list of filtered subtree. -/
+def Kind : Type := List Subtree
+
+@[simp]
+instance : HAppend Kind Kind Kind where
+  hAppend xs ys := List.append xs ys
+
+/-- A single node. -/
+@[simp]
+def Kind.node (c : Classifier) (excls : List Classifier) : Kind := [Subtree.mk c excls]
+
+/-- Shorthand notation for a subtree without exclusions -/
+@[simp]
+def Kind.classifier (c : Classifier) := Kind.node c []
+
+/-- The empty kind. Note that non-empty kinds can still represent an empty set of nodes. See `IsEmpty`. -/
+@[simp]
+def Kind.empty : Kind := []
+
+/-- The "top" kind. This is a Kind that includes all nodes in the classifier tree. -/
+@[simp]
+def Kind.top := node .top []
+
+/-- Helper relation: does `xs` contain a superclass of `c`? -/
+inductive ContainsSupOf : List Classifier -> Classifier -> Prop where
+  | here : b.Subclass a -> ContainsSupOf (a :: xs) b
+  | there : ContainsSupOf xs b -> ContainsSupOf (a :: xs) b
+
+theorem ContainsSupOf.append_l (h : ContainsSupOf xs b) : ContainsSupOf (xs ++ ys) b := by
+  induction h with
+  | here hs => exact .here hs
+  | there _ ih => exact .there ih
+
+theorem ContainsSupOf.append_r (h : ContainsSupOf ys b) : ContainsSupOf (xs ++ ys) b := by
+  induction xs with
+  | nil => exact h
+  | cons _ _ ih => exact .there ih
+
+theorem ContainsSupOf.trans_subclass (h : ContainsSupOf xs a) (hs : b.Subclass a) : ContainsSupOf xs b := by
+  induction h with
+  | here hs' => exact .here (hs.trans hs')
+  | there _ ih => exact .there (ih hs)
+
+theorem ContainsSupOf.of_append (h : ContainsSupOf (xs ++ ys) b) : ContainsSupOf xs b ∨ ContainsSupOf ys b := by
+  induction xs with
+  | nil => exact .inr h
+  | cons a xs ih =>
+    cases h with
+    | here hs => exact .inl (.here hs)
+    | there h =>
+      cases ih h with
+      | inl h => exact .inl (.there h)
+      | inr h => exact .inr h
+
+/-- Is a Kind empty? -/
+inductive Kind.IsEmpty : Kind -> Prop where
+  | empty : IsEmpty []
+  | absurd : ContainsSupOf exs r -> IsEmpty xs -> IsEmpty (Subtree.mk r exs :: xs)
+
+theorem Kind.IsEmpty.node (hsc : ContainsSupOf exs r) : IsEmpty [.mk r exs] := absurd hsc .empty
+
+/-- If a `node` is empty, it is absurd. -/
+theorem Kind.IsEmpty.is_absurd (he : IsEmpty (.node r exs)) : ContainsSupOf exs r := by
+  cases he; assumption
+
+theorem Kind.IsEmpty.append (he1 : IsEmpty R1) (he2 : IsEmpty R2) : IsEmpty (R1 ++ R2) := by
+  induction R1 generalizing R2
+  case nil => simp_all
+  case cons x xs ih =>
+    rw [List.cons_append]
+    cases he1
+    apply! absurd _ (ih _ _)
+
+theorem Kind.IsEmpty.append_inv (he : IsEmpty (R1 ++ R2)) : IsEmpty R1 ∧ IsEmpty R2 := by
+  induction R1 generalizing R2
+  case nil => simp_all; apply empty
+  case cons x xs ih =>
+    rw [List.cons_append] at he
+    cases he
+    rename_i he1 he2
+    have ⟨_, _⟩ := ih he2
+    apply And.intro
+    . apply! absurd
+    . aesop
+
+end Capless
diff --git a/Capless/Classifier/Subkind.lean b/Capless/Classifier/Subkind.lean
new file mode 100644
index 00000000..afc6bea3
--- /dev/null
+++ b/Capless/Classifier/Subkind.lean
@@ -0,0 +1,14 @@
+import Capless.Classifier.Subtract
+
+namespace Capless
+
+/-- `K` is a subkind of `L` if every node in `K` is present in `L`. -/
+inductive Kind.Subkind : Kind -> Kind -> Prop where
+  | subtract : Subtract K1 K2 R -> IsEmpty R -> Subkind K1 K2
+
+theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpty K1 := by
+  cases hs
+  apply! Subtract.empty_r_inv
+
+
+end Capless
diff --git a/Capless/Classifier/Subtract.lean b/Capless/Classifier/Subtract.lean
new file mode 100644
index 00000000..ef4e9fbd
--- /dev/null
+++ b/Capless/Classifier/Subtract.lean
@@ -0,0 +1,560 @@
+import Capless.Classifier.Kind
+
+namespace Capless
+
+/-- This file defines the "subtraction" operation between two kind sets. -/
+
+inductive Subtree.Subtract : Subtree -> Subtree -> Kind -> Prop where
+  -- Basically we follow a few broad strokes:
+  -- - A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
+  -- - For B of the form (.node r []) (no exclusion):
+  --   - If r < A, refine A
+  --   - If r > A, empty
+  --   - If r ⊥ A, A
+  -- Base case first
+  | tree : Subtract (.mk r1 ex1) (.mk r2 []) (.node r1 (r2 :: ex1))
+  -- Exclusion case
+  -- First, handle the cases where (B \ C) doesn't make sense
+  | excl_absurd_r :
+    r2.StrictSub a -> -- (B \ a) is just empty
+    Subtract (.mk r1 ex1) (.mk r2 (a :: ex2)) (.node r1 ex1)
+  | excl_irrelevant_r :
+    r2.Disjoint a -> -- (B \ a) = B
+    Subtract (.mk r1 ex1) (.mk r2 ex2) R ->
+    Subtract (.mk r1 ex1) (.mk r2 (a :: ex2)) R
+  -- Now, for cases where a is a subtree of r2
+  -- We use the formula A \ (B \ C) = (A \ B) ∪ (A ∩ B ∩ C)
+  | excl_subclass_r :
+    a.Subclass r2 ->
+    a.Subclass r1 -> -- A ∩ B ∩ C = a with all the exclusions
+    Subtract (.mk r1 ex1) (.mk r2 ex2) R ->
+    Subtract (.mk r1 ex1) (.mk r2 (a :: ex2)) ((.mk a ex1) :: R)
+                                        -- ^ we'd need (ex1 ++ ex2) here to be exact,
+                                        -- but if an element is in the ex2 subtree
+                                        -- and not already excluded from A, it is part
+                                        -- of (A \ B), so it's okay to keep anyway.
+  | excl_subclass_l :
+    a.Subclass r2 ->
+    r1.StrictSub a ->  -- B \ C excludes the entirety of A
+    Subtract (.mk r1 ex1) (.mk r2 (a :: ex2)) (.node r1 ex1)
+  | excl_irrelevant_l :
+    a.Subclass r2 ->
+    r1.Disjoint a -> -- irrelevant exclusion, A ∪ B ∪ C = empty
+    Subtract (.mk r1 ex1) (.mk r2 ex2) R ->
+    Subtract (.mk r1 ex1) (.mk r2 (a :: ex2)) R
+
+/-- Subtraction: `K.Subtract L` gives a Kind that contains all nodes in `K` but not in `L`. -/
+inductive Kind.Subtract : Kind -> Kind -> Kind -> Prop where
+  | empty_r : Subtract K .empty K
+  | union_r :
+    Subtract K [y] R1 ->
+    Subtract R1 (y' :: ys) R2 ->
+    Subtract K (y :: y' :: ys) R2
+  | empty_l : Subtract .empty [y] .empty
+  | union_l : x.Subtract y R1 -> Subtract xs [y] R2 -> Subtract (x::xs) [y] (R1 ++ R2)
+
+theorem Kind.Subtract.singleton (hs : x.Subtract y R) : Subtract [x] [y] R := by
+  have h := union_l hs .empty_l
+  simp at h
+  apply h
+
+theorem Kind.Subtract.is_singleton (hs : Subtract [x] [y] R) : x.Subtract y R := by
+  cases hs
+  case union_l ha hb => cases hb; simp_all
+
+theorem Subtree.Subtract.is_empty_l (hs : Subtract x y R) (hsc : Kind.IsEmpty [x]) : Kind.IsEmpty R := by
+  have hsc' := hsc.is_absurd
+  induction hs
+  case tree =>
+    apply Kind.IsEmpty.node
+    apply! ContainsSupOf.there
+  case excl_absurd_r => assumption
+  case excl_irrelevant_r ih => apply! ih
+  case excl_subclass_r hs2 hs1 hs ih =>
+    constructor
+    . apply hsc'.trans_subclass hs1
+    . apply! ih
+  case excl_subclass_l hs2 hss1 => apply! Kind.IsEmpty.node
+  case excl_irrelevant_l hd2 hd1 hs ih => apply! ih
+
+theorem Kind.Subtract.is_empty_l (hs : Subtract K1 K2 R) (he : IsEmpty K1) : IsEmpty R := by
+  induction hs
+  case empty_l => constructor
+  case union_l ha hb ih =>
+    cases he
+    apply! Kind.IsEmpty.append (ha.is_empty_l $ .node _) (ih _)
+  case empty_r => assumption
+  case union_r ha hb =>
+    apply hb
+    apply! ha
+
+theorem Kind.Subtract.empty_l' : Subtract [] K [] := by
+  induction K
+  case nil => apply empty_r
+  case cons x xs ih =>
+    cases xs
+    case nil => apply empty_l
+    case cons => apply union_r .empty_l ih
+
+theorem Kind.Subtract.absurd_l (hs : Subtract (.node r1 ex1) K R) (hsc : ContainsSupOf ex1 r1) : IsEmpty R := by
+  apply hs.is_empty_l
+  apply IsEmpty.node
+  assumption
+
+theorem Kind.Subtract.empty_l_inv (hs : Subtract [] K R) : R = [] := by
+  induction K generalizing R
+  case nil => cases hs; simp
+  case cons y ys ih =>
+    cases hs
+    case union_r ha hb => cases ha; apply! ih
+    case empty_l => simp
+
+theorem Subtree.Subtract.empty_implies_subclass
+  (hs : Subtract (.mk r1 ex1) (.mk r2 ex2) R)
+  (he : R.IsEmpty)
+  : ContainsSupOf ex1 r1 ∨ r1.Subclass r2 := by
+  cases hs
+  case tree =>
+    cases he.is_absurd <;> aesop
+  case excl_absurd_r => left; apply he.is_absurd
+  case excl_irrelevant_r hs => apply hs.empty_implies_subclass he
+  case excl_subclass_r hs =>
+    cases he
+    apply! hs.empty_implies_subclass
+  case excl_subclass_l => left; apply he.is_absurd
+  case excl_irrelevant_l hs => apply! hs.empty_implies_subclass
+
+theorem Subtree.Subtract.empty_r_inv (hs : Subtract S1 S2 R) (he : R.IsEmpty) (hsc2 : ContainsSupOf S2.excls S2.root) : ContainsSupOf S1.excls S1.root := by
+  induction hs
+  case tree => cases hsc2
+  case excl_absurd_r hss => apply he.is_absurd
+  case excl_irrelevant_r hd2 hs ih =>
+    cases hsc2
+    case here hs2 => cases hd2.not_subclass hs2
+    case there => apply! ih
+  case excl_subclass_r hs2 hs1 hs ih =>
+    cases he
+    rename_i he1 he2
+    cases hsc2
+    case here hsa =>
+      cases hs2.antisymm hsa
+      cases hs.empty_implies_subclass he2 <;> rename_i hs
+      . aesop
+      . cases hs1.antisymm hs; aesop
+    case there => apply! ih
+  case excl_subclass_l hs2 hss1 => apply he.is_absurd
+  case excl_irrelevant_l hs2 hd1 hs ih =>
+    cases hsc2
+    case here hsa =>
+      cases hs2.antisymm hsa
+      cases hs.empty_implies_subclass he <;> rename_i hs
+      . aesop
+      . cases hd1.not_subclass hs
+    case there => apply! ih
+
+theorem Kind.Subtract.empty_r_inv (hs : Subtract K1 K2 R) (he : IsEmpty R) (hek2 : IsEmpty K2) : IsEmpty K1 := by
+  induction hs
+  case empty_l => constructor
+  case union_l ha hb ih =>
+    have ⟨_, _⟩ := he.append_inv
+    apply! IsEmpty.append (.node $ ha.empty_r_inv _ hek2.is_absurd) (ih _ _)
+  case empty_r => assumption
+  case union_r ha hb =>
+    cases hek2
+    apply ha
+    . apply! hb
+    . apply! IsEmpty.node
+
+theorem Subtree.Subtract.exists' : ∃ R, Subtract (mk r1 ex1) (mk r2 ex2) R := by
+  induction ex2
+  case nil => exists .node r1 (r2 :: ex1); apply tree
+  case cons head tail ih =>
+    cases head.subclass_or_disjoint r2
+    case inl hs =>
+      have ⟨R, h⟩ := ih
+      cases head.subclass_or_disjoint r1
+      case inl hs1 =>
+        exists (.mk head ex1) :: R
+        apply! excl_subclass_r
+      case inr hs1 =>
+        cases hs1
+        case inl hs1 =>
+          exists .node r1 ex1
+          apply! excl_subclass_l
+        case inr hs1 =>
+          exists R
+          apply! excl_irrelevant_l _ hs1.symm
+    case inr hs =>
+      cases hs
+      case inl hs =>
+        exists .node r1 ex1
+        apply! excl_absurd_r
+      case inr hs =>
+        have ⟨R, h⟩ := ih
+        exists R
+        apply! excl_irrelevant_r hs.symm
+
+theorem Subtree.Subtract.exists (a b : Subtree) : ∃R, Subtract a b R := exists' (r1:=a.root) (ex1:= a.excls) (r2:=b.root) (ex2:=b.excls)
+
+theorem Kind.Subtract.exists' (a : Kind) (b : Subtree)  : ∃ R, Subtract a [b] R := by
+  induction a
+  case nil => exists .empty; apply empty_l
+  case cons x xs ih =>
+    have ⟨R1, h1⟩ := Subtree.Subtract.exists x b
+    have ⟨R2, h2⟩ := ih
+    exists R1 ++ R2
+    apply union_l h1 h2
+
+theorem Kind.Subtract.exists (a : Kind) (b: Kind) : ∃ R, Subtract a b R := by
+  induction b generalizing a
+  case nil => exists a; apply empty_r
+  case cons y ys ihb =>
+    cases ys
+    case nil => apply! exists'
+    case cons =>
+      have ⟨R1, h1⟩ := exists' a y
+      have ⟨R2, h2⟩ := ihb (a:=R1)
+      exists R2
+      apply union_r h1 h2
+
+theorem Subtree.Subtract.excl_absurd_r_inv
+  (hs : Subtract (mk r1 ex1) (mk r2 (a :: ex2)) R)
+  (hss : r2.StrictSub a)
+  : R = .node r1 ex1 := by
+  cases hs
+  case excl_absurd_r => rfl
+  case excl_irrelevant_r hd _ => cases hd.not_subclass hss.weaken
+  case excl_subclass_r h1 h2 _ => cases hss.antisymm h2
+  case excl_subclass_l h1 h2 => cases hss.antisymm h2
+  case excl_irrelevant_l h1 h2 _ => cases hss.antisymm h2
+
+theorem Subtree.Subtract.excl_irrelevant_r_inv
+  (hs : Subtract (mk r1 ex1) (mk r2 (a :: ex2)) R)
+  (hd : r2.Disjoint a)
+  : Subtract (mk r1 ex1) (mk r2 ex2) R := by
+  cases hs
+  case excl_absurd_r hss => cases hd.not_subclass hss.weaken
+  case excl_irrelevant_r => assumption
+  case excl_subclass_r hs1 hs2 hs => cases hd.symm.not_subclass hs2
+  case excl_subclass_l hs2 => cases hd.symm.not_subclass hs2
+  case excl_irrelevant_l hs2 _ => cases hd.symm.not_subclass hs2
+
+theorem Subtree.Subtract.excl_subclass_r_inv
+  (hs : Subtract (mk r1 ex1) (mk r2 (a :: ex2)) R)
+  (hs1 : a.Subclass r1)
+  (hs2 : a.Subclass r2)
+  : ∃ R', R = (mk a ex1) :: R' ∧ Subtract (mk r1 ex1) (mk r2 ex2) R' := by
+  cases hs
+  case excl_absurd_r hss => cases hss.antisymm hs2
+  case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hs2
+  case excl_subclass_r => aesop
+  case excl_subclass_l hss _ => cases hss.antisymm hs1
+  case excl_irrelevant_l hd1 _ _ => cases hd1.symm.not_subclass hs1
+
+theorem Subtree.Subtract.excl_subclass_l_inv
+  (hs : Subtract (mk r1 ex1) (mk r2 (a :: ex2)) R)
+  (hs1 : r1.StrictSub a)
+  (hs2 : a.Subclass r2)
+  : R = .node r1 ex1 := by
+  cases hs
+  case excl_absurd_r hss => cases hss.antisymm hs2
+  case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hs2
+  case excl_subclass_r => rename_i hsa _ _; cases hs1.antisymm hsa
+  case excl_subclass_l => rfl
+  case excl_irrelevant_l hd1 _ _ => cases hd1.not_subclass hs1.weaken
+
+theorem Subtree.Subtract.excl_irrelevant_l_inv
+  (hs : Subtract (mk r1 ex1) (mk r2 (a :: ex2)) R)
+  (hd1 : r1.Disjoint a)
+  (hs2 : a.Subclass r2)
+  : Subtract (mk r1 ex1) (mk r2 ex2) R := by
+  cases hs
+  case excl_absurd_r hss => cases hss.antisymm hs2
+  case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hs2
+  case excl_subclass_r => rename_i hsa _ _; cases hd1.symm.not_subclass hsa
+  case excl_subclass_l => rename_i hss _; cases hd1.not_subclass hss.weaken
+  case excl_irrelevant_l => assumption
+
+theorem Subtree.Subtract.inj
+  (hs1 : Subtract a b R1)
+  (hs2 : Subtract a b R2)
+  : R1 = R2 := by
+  induction hs1 generalizing R2
+  case tree => cases hs2; simp
+  case excl_absurd_r hss => cases hs2.excl_absurd_r_inv hss; simp
+  case excl_irrelevant_r hd2 hs1 ih =>
+    apply ih
+    apply! hs2.excl_irrelevant_r_inv
+  case excl_subclass_r hsa2 hsa1 hs1 ih =>
+    have ⟨_, _, hs2'⟩ := hs2.excl_subclass_r_inv hsa1 hsa2
+    subst_vars
+    rw [List.cons_inj_right]
+    apply! ih
+  case excl_subclass_l hsa2 hss1 => cases hs2.excl_subclass_l_inv hss1 hsa2; simp
+  case excl_irrelevant_l hsa2 hd1 hs1 ih =>
+    apply ih
+    apply! hs2.excl_irrelevant_l_inv
+
+theorem Kind.Subtract.inj
+  (hs1 : Subtract K1 K2 R1)
+  (hs2 : Subtract K1 K2 R2)
+  : R1 = R2 := by
+  induction hs1 generalizing R2
+  case empty_r => cases hs2; simp
+  case union_r ha hb =>
+    cases hs2
+    rename_i hs2a hs2b
+    cases ha hs2a
+    apply hb hs2b
+  case empty_l => cases hs2; simp
+  case union_l ha hb ih =>
+    cases hs2
+    rename_i hs2a hs2b
+    cases ha.inj hs2a
+    cases ih hs2b
+    simp
+
+theorem Subtree.Subtract.is_empty_append_l
+  (hs1 : Subtract (mk r1 ex1) (mk r2 ex2) R1)
+  (he : R1.IsEmpty)
+  (hs2 : Subtract (mk r1 (a :: ex1)) (mk r2 ex2) R2)
+  : R2.IsEmpty := by
+  induction ex2 generalizing R1 R2
+  case nil =>
+    cases hs1
+    cases hs2
+    apply Kind.IsEmpty.node
+    cases he.is_absurd
+    case here => apply! ContainsSupOf.here
+    case there => apply! ContainsSupOf.there (.there _)
+  case cons a ex2 ih =>
+    cases hs1
+    case excl_absurd_r hss =>
+      apply hs2.is_empty_l
+      apply Kind.IsEmpty.node (.there he.is_absurd)
+    case excl_irrelevant_r hd2 hs1 => apply ih hs1 he; apply! excl_irrelevant_r_inv
+    case excl_subclass_r hsa1 hsa2 hs1 =>
+      cases he
+      rename_i he1 he2
+      have ⟨R, _, _⟩ := excl_subclass_r_inv hs2 hsa1 hsa2; subst_vars
+      constructor
+      . apply! ContainsSupOf.there
+      . apply! ih
+    case excl_subclass_l =>
+      apply hs2.is_empty_l
+      apply Kind.IsEmpty.node (.there he.is_absurd)
+    case excl_irrelevant_l hs1 => apply! ih hs1 _ (hs2.excl_irrelevant_l_inv _ _)
+
+theorem Subtree.Subtract.is_empty_swap_l
+  (hs1 : Subtract (mk r1 (a :: b :: ex1)) (mk r2 ex2) R1)
+  (he : R1.IsEmpty)
+  (hs2 : Subtract (mk r1 (b :: a :: ex1)) (mk r2 ex2) R2)
+  : R2.IsEmpty := by sorry
+
+theorem Subtree.Subtract.rfl
+  (hs : Subtract a a R)
+  : R.IsEmpty := by
+  cases hs
+  case tree => apply Kind.IsEmpty.node $ .here .rfl
+  case excl_absurd_r hss =>
+    apply Kind.IsEmpty.node $ .here hss.weaken
+  case excl_irrelevant_r r1 ex2 a hd hs =>
+    have ⟨R, h⟩ := Subtract.exists (mk r1 ex2) (mk r1 ex2)
+    apply h.is_empty_append_l h.rfl hs
+  case excl_subclass_r r1 ex2 _ _ _ hsa hs =>
+    have ⟨R, h⟩ := Subtract.exists (mk r1 ex2) (mk r1 ex2)
+    apply Kind.IsEmpty.absurd (.here .rfl)
+    apply h.is_empty_append_l h.rfl hs
+  case excl_subclass_l hss hs => cases hss.antisymm hs
+  case excl_irrelevant_l hd hs _ => cases hd.symm.not_subclass hs
+
+theorem Kind.Subtract.append_l'
+  (hs1 : Subtract K1 [y] R1)
+  (hs2 : Subtract K2 [y] R2)
+  : Subtract (K1 ++ K2) [y] (R1 ++ R2) := by
+  induction K1 generalizing K2 R1 R2
+  case nil => cases hs1; simp_all
+  case cons x xs ih =>
+    cases hs1
+    rename_i hs1a hs1b
+    rw [List.cons_append]
+    rw [List.append_assoc]
+    apply union_l hs1a
+    apply ih hs1b hs2
+
+theorem Kind.Subtract.append_l
+  (hs1 : Subtract K1 L R1)
+  (hs2 : Subtract K2 L R2)
+  : Subtract (K1 ++ K2) L (R1 ++ R2) := by
+  induction L generalizing K1 K2 R1 R2
+  case nil => cases hs1; cases hs2; apply empty_r
+  case cons y ys ih =>
+    cases ys
+    case nil => apply! append_l'
+    case cons =>
+      cases hs1
+      cases hs2
+      rename_i Ra hs1a hs1b Rb hs2a hs2b
+      apply union_r
+      apply append_l' hs1a hs2a
+      apply ih hs1b hs2b
+
+theorem Kind.Subtract.append_l_inv' (hs : Subtract (K1 ++ K2) [y] R) (hs1 : Subtract K1 [y] R1) : ∃ R2, R = R1 ++ R2 ∧ Subtract K2 [y] R2 := by
+  induction K1 generalizing K2 R R1
+  case nil => cases hs1; exists R
+  case cons x xs ih =>
+    cases hs1
+    rename_i hs1a hs1b
+    rw [List.cons_append] at hs
+    cases hs
+    rename_i hsa hsb
+    have ⟨R, heq, ih⟩ := ih hsb hs1b
+    cases hs1a.inj hsa
+    exists R
+    apply And.intro <;> simp_all
+
+theorem Kind.Subtract.append_l_inv (hs : Subtract (K1 ++ K2) L R) (hs1 : Subtract K1 L R1) : ∃ R2, R = R1 ++ R2 ∧ Subtract K2 L R2 := by
+  induction L generalizing K1 K2 R R1
+  generalize h : K1 ++ K2 = C at hs
+  case nil => cases hs1; cases hs; exists K2; apply And.intro; simp_all; apply empty_r
+  case cons y ys ih =>
+    cases ys
+    case nil => apply! append_l_inv'
+    case cons =>
+      cases hs1
+      rename_i hs1a hs1b
+      generalize h : K1 ++ K2 = C at hs
+      cases hs
+      rename_i hsa hsb
+      subst_vars
+      have ⟨R1, heq1, ih1⟩ := hsa.append_l_inv' hs1a
+      subst_vars
+      have ⟨R2, heq2, ih2⟩ := ih hsb hs1b
+      exists R2
+      simp_all
+      apply! union_r
+
+theorem Kind.Subtract.cons_l_inv (hs : Subtract (K :: K1) L R) (hs1 : Subtract [K] L R1) : ∃ R2, R = R1 ++ R2 ∧ Subtract K1 L R2 := by
+  apply append_l_inv hs hs1
+theorem Kind.Subtract.cons_l_inv' (hs : Subtract (x :: K1) [y] R) (hs1 : x.Subtract y R1) : ∃ R2, R = R1 ++ R2 ∧ Subtract K1 [y] R2 := by
+  have ⟨R, h1, h2⟩ := cons_l_inv hs (.union_l hs1 .empty_l)
+  simp at h1
+  aesop
+
+theorem Subtree.Subtract.is_empty_subroot_l
+  (hs1 : Subtract a b R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (mk c a.excls) b R2)
+  (hsub : c.Subclass a.root)
+  : R2.IsEmpty := by
+  induction hs1 generalizing R2
+  case tree =>
+    cases hs2; simp_all; apply Kind.IsEmpty.node
+    cases he1.is_absurd
+    case here hsub2 => apply ContainsSupOf.here $ hsub.trans hsub2
+    case there hsc => apply ContainsSupOf.there $ hsc.trans_subclass hsub
+  case excl_absurd_r hss =>
+    cases hs2.excl_absurd_r_inv hss
+    apply! Kind.IsEmpty.node $ he1.is_absurd.trans_subclass _
+  case excl_irrelevant_r hd hs1 ih =>
+    have hs2 := hs2.excl_irrelevant_r_inv hd
+    apply! ih
+  case excl_subclass_r a hsa2 hsa1 hs1 ih =>
+    simp_all
+    cases he1
+    cases Classifier.subclass_or_disjoint a c <;> rename_i hc
+    . have ⟨R, _, hs2⟩ := hs2.excl_subclass_r_inv hc hsa2
+      subst_vars
+      constructor; aesop
+      apply! ih
+    . cases hc <;> rename_i hc
+      . cases hs2.excl_subclass_l_inv hc hsa2
+        apply! Kind.IsEmpty.node (ContainsSupOf.trans_subclass _ hc.weaken)
+      . have hs2 := hs2.excl_irrelevant_l_inv hc.symm hsa2
+        apply! ih
+  case excl_subclass_l hsa2 hss1 =>
+    cases hs2.excl_subclass_l_inv (hss1.subclass_l hsub) hsa2
+    apply! Kind.IsEmpty.node $ he1.is_absurd.trans_subclass _
+  case excl_irrelevant_l hsa2 hd1 hs1 ih =>
+    have hs2 := hs2.excl_irrelevant_l_inv (hd1.refines_subclass_l hsub) hsa2
+    apply! ih
+
+theorem Subtree.Subtract.is_empty_middle
+  (hs1 : Subtract x y R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract x z R2)
+  (hs3 : R2.Subtract [y] R3)
+  : R3.IsEmpty := by
+  induction hs2 generalizing R3
+  case tree => apply hs1.is_empty_append_l he1 hs3.is_singleton
+  case excl_absurd_r hss2 => cases hs1.inj hs3.is_singleton; simp_all
+  case excl_irrelevant_r hd2 hs2 ih => apply! ih
+  case excl_subclass_r r1 ex1 r2 ex2 _ a hsa2 hsa1 hs2 ih =>
+    have ⟨R0, h0⟩ := Subtract.exists (mk a ex1) y
+    have ⟨R', _, hs3'⟩ := hs3.cons_l_inv' h0
+    subst_vars
+    apply Kind.IsEmpty.append $ hs1.is_empty_subroot_l he1 h0 hsa1
+    apply! ih
+  case excl_subclass_l hsa2 hss1 => cases hs1.inj hs3.is_singleton; simp_all
+  case excl_irrelevant_l hsa2 hd1 hs2 ih => apply! ih
+
+theorem Kind.Subtract.is_empty_middle'
+  (hs1 : Subtract K [y] R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract K [z] R2)
+  (hs3 : Subtract R2 [y] R3)
+  : R3.IsEmpty := by
+  induction K generalizing R1 R2 R3
+  case nil => cases hs1; cases hs2; cases hs3; simp_all
+  case cons x xs ih =>
+    cases hs1
+    cases hs2
+    rename_i hs1a hs1b R2 R1 hs2a hs2b
+    have ⟨he1a, he1b⟩ := he1.append_inv
+    have ⟨Rl, hl⟩ := Kind.Subtract.exists R1 [y]
+    have ⟨R3', _, hs3'⟩ := hs3.append_l_inv hl
+    subst_vars
+    apply IsEmpty.append
+    apply! hs1a.is_empty_middle
+    apply! ih
+
+mutual
+
+theorem Kind.Subtract.is_empty_swap_l
+  (hs1 : Subtract (.node r1 (a :: b :: ex1)) K R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (.node r1 (b :: a :: ex1)) K R2)
+  : R2.IsEmpty := by sorry
+
+theorem Kind.Subtract.is_empty_append_l
+  (hs1 : Subtract (.node r1 ex1) K R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (.node r1 (a :: ex1)) K R2)
+  : R2.IsEmpty := by
+  cases hs1
+  case empty_r => cases hs2; apply IsEmpty.node (.there he1.is_absurd)
+  case union_l ha hb => cases hb; simp_all; apply ha.is_empty_append_l he1 hs2.is_singleton
+  case union_r y' ys ha hb =>
+    cases hs2
+    rename_i ha2' hb2
+    have ha2 := ha2'.is_singleton
+    cases ha.is_singleton
+    case tree r2 =>
+      cases ha2
+      have ⟨R2', hb2'⟩ := Subtract.exists (node r1 (a :: r2 :: ex1)) (y' :: ys)
+      apply hb2'.is_empty_swap_l _ hb2
+      apply hb.is_empty_append_l he1 hb2'
+
+
+
+
+theorem Kind.Subtract.is_empty_subroot_l
+  (hs1 : Subtract (.node r1 ex1) K R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (.node c ex1) K R2)
+  (hsub : c.Subclass r1)
+  : R2.IsEmpty := sorry
+
+end
+
+end Capless

From c660b6bba5418be395ed9353bdad57d091660997 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 24 Dec 2025 11:58:26 +0100
Subject: [PATCH 59/71] Refl proved

---
 Capless/Classifier/Kind.lean     |   8 +
 Capless/Classifier/Subtract.lean | 258 ++++++++++++++++++++++++++-----
 2 files changed, 224 insertions(+), 42 deletions(-)

diff --git a/Capless/Classifier/Kind.lean b/Capless/Classifier/Kind.lean
index fd168444..383216c9 100644
--- a/Capless/Classifier/Kind.lean
+++ b/Capless/Classifier/Kind.lean
@@ -50,6 +50,14 @@ theorem ContainsSupOf.append_r (h : ContainsSupOf ys b) : ContainsSupOf (xs ++ y
   | nil => exact h
   | cons _ _ ih => exact .there ih
 
+theorem ContainsSupOf.insert (h : ContainsSupOf (xs ++ ys) b) : ContainsSupOf (xs ++ zs ++ ys) b := by
+  induction xs generalizing ys with
+  | nil => apply! append_r
+  | cons x xs ih =>
+    cases h
+    case here => apply! here
+    case there => apply there; apply! ih
+
 theorem ContainsSupOf.trans_subclass (h : ContainsSupOf xs a) (hs : b.Subclass a) : ContainsSupOf xs b := by
   induction h with
   | here hs' => exact .here (hs.trans hs')
diff --git a/Capless/Classifier/Subtract.lean b/Capless/Classifier/Subtract.lean
index ef4e9fbd..7176da61 100644
--- a/Capless/Classifier/Subtract.lean
+++ b/Capless/Classifier/Subtract.lean
@@ -314,10 +314,10 @@ theorem Kind.Subtract.inj
     cases ih hs2b
     simp
 
-theorem Subtree.Subtract.is_empty_append_l
-  (hs1 : Subtract (mk r1 ex1) (mk r2 ex2) R1)
+theorem Subtree.Subtract.is_empty_insert
+  (hs1 : Subtract (mk r1 (xs ++ ys)) (mk r2 ex2) R1)
   (he : R1.IsEmpty)
-  (hs2 : Subtract (mk r1 (a :: ex1)) (mk r2 ex2) R2)
+  (hs2 : Subtract (mk r1 (xs ++ zs ++ ys)) (mk r2 ex2) R2)
   : R2.IsEmpty := by
   induction ex2 generalizing R1 R2
   case nil =>
@@ -326,31 +326,25 @@ theorem Subtree.Subtract.is_empty_append_l
     apply Kind.IsEmpty.node
     cases he.is_absurd
     case here => apply! ContainsSupOf.here
-    case there => apply! ContainsSupOf.there (.there _)
+    case there => apply! ContainsSupOf.there (.insert _)
   case cons a ex2 ih =>
     cases hs1
     case excl_absurd_r hss =>
       apply hs2.is_empty_l
-      apply Kind.IsEmpty.node (.there he.is_absurd)
+      apply Kind.IsEmpty.node (.insert he.is_absurd)
     case excl_irrelevant_r hd2 hs1 => apply ih hs1 he; apply! excl_irrelevant_r_inv
     case excl_subclass_r hsa1 hsa2 hs1 =>
       cases he
       rename_i he1 he2
       have ⟨R, _, _⟩ := excl_subclass_r_inv hs2 hsa1 hsa2; subst_vars
       constructor
-      . apply! ContainsSupOf.there
+      . apply! ContainsSupOf.insert
       . apply! ih
     case excl_subclass_l =>
       apply hs2.is_empty_l
-      apply Kind.IsEmpty.node (.there he.is_absurd)
+      apply Kind.IsEmpty.node (.insert he.is_absurd)
     case excl_irrelevant_l hs1 => apply! ih hs1 _ (hs2.excl_irrelevant_l_inv _ _)
 
-theorem Subtree.Subtract.is_empty_swap_l
-  (hs1 : Subtract (mk r1 (a :: b :: ex1)) (mk r2 ex2) R1)
-  (he : R1.IsEmpty)
-  (hs2 : Subtract (mk r1 (b :: a :: ex1)) (mk r2 ex2) R2)
-  : R2.IsEmpty := by sorry
-
 theorem Subtree.Subtract.rfl
   (hs : Subtract a a R)
   : R.IsEmpty := by
@@ -360,11 +354,11 @@ theorem Subtree.Subtract.rfl
     apply Kind.IsEmpty.node $ .here hss.weaken
   case excl_irrelevant_r r1 ex2 a hd hs =>
     have ⟨R, h⟩ := Subtract.exists (mk r1 ex2) (mk r1 ex2)
-    apply h.is_empty_append_l h.rfl hs
+    apply h.is_empty_insert (xs:=[]) (zs:=[a]) h.rfl hs
   case excl_subclass_r r1 ex2 _ _ _ hsa hs =>
     have ⟨R, h⟩ := Subtract.exists (mk r1 ex2) (mk r1 ex2)
     apply Kind.IsEmpty.absurd (.here .rfl)
-    apply h.is_empty_append_l h.rfl hs
+    apply h.is_empty_insert (xs:=[]) (zs:=[_]) h.rfl hs
   case excl_subclass_l hss hs => cases hss.antisymm hs
   case excl_irrelevant_l hd hs _ => cases hd.symm.not_subclass hs
 
@@ -441,6 +435,17 @@ theorem Kind.Subtract.cons_l_inv' (hs : Subtract (x :: K1) [y] R) (hs1 : x.Subtr
   simp at h1
   aesop
 
+theorem Kind.Subtract.cons_l_split (hs : Subtract (K :: K1) L R): ∃ R1 R2, R = R1 ++ R2 ∧ Subtract [K] L R1 ∧ Subtract K1 L R2 := by
+  have ⟨Rp, hp⟩ := Subtract.exists [K] L
+  have ⟨Rt, ht⟩ := hs.cons_l_inv hp
+  exists Rp, Rt
+  simp_all
+theorem Kind.Subtract.append_l_split (hs : Subtract (K1 ++ K2) L R): ∃ R1 R2, R = R1 ++ R2 ∧ Subtract K1 L R1 ∧ Subtract K2 L R2 := by
+  have ⟨Rp, hp⟩ := Subtract.exists K1 L
+  have ⟨Rt, ht⟩ := hs.append_l_inv hp
+  exists Rp, Rt
+  simp_all
+
 theorem Subtree.Subtract.is_empty_subroot_l
   (hs1 : Subtract a b R1)
   (he1 : R1.IsEmpty)
@@ -486,7 +491,7 @@ theorem Subtree.Subtract.is_empty_middle
   (hs3 : R2.Subtract [y] R3)
   : R3.IsEmpty := by
   induction hs2 generalizing R3
-  case tree => apply hs1.is_empty_append_l he1 hs3.is_singleton
+  case tree => apply hs1.is_empty_insert (xs:=[]) (zs:=[_]) he1 hs3.is_singleton
   case excl_absurd_r hss2 => cases hs1.inj hs3.is_singleton; simp_all
   case excl_irrelevant_r hd2 hs2 ih => apply! ih
   case excl_subclass_r r1 ex1 r2 ex2 _ a hsa2 hsa1 hs2 ih =>
@@ -518,43 +523,212 @@ theorem Kind.Subtract.is_empty_middle'
     apply! hs1a.is_empty_middle
     apply! ih
 
-mutual
-
-theorem Kind.Subtract.is_empty_swap_l
-  (hs1 : Subtract (.node r1 (a :: b :: ex1)) K R1)
-  (he1 : R1.IsEmpty)
-  (hs2 : Subtract (.node r1 (b :: a :: ex1)) K R2)
-  : R2.IsEmpty := by sorry
-
-theorem Kind.Subtract.is_empty_append_l
-  (hs1 : Subtract (.node r1 ex1) K R1)
+theorem Kind.Subtract.is_empty_transform_internal
+  (hs1 : Subtract (.node r1 (xs ++ ys)) L R1)
   (he1 : R1.IsEmpty)
-  (hs2 : Subtract (.node r1 (a :: ex1)) K R2)
+  (hs2 : Subtract (.node c (xs ++ zs ++ ys)) L R2)
+  (hsub : c.Subclass r1)
   : R2.IsEmpty := by
   cases hs1
-  case empty_r => cases hs2; apply IsEmpty.node (.there he1.is_absurd)
-  case union_l ha hb => cases hb; simp_all; apply ha.is_empty_append_l he1 hs2.is_singleton
-  case union_r y' ys ha hb =>
+  case empty_r => cases hs2; apply IsEmpty.node (.trans_subclass (.insert he1.is_absurd) hsub)
+  case union_l y   _ _ ha hb =>
+    cases hb.empty_l_inv; simp at he1
+    have ⟨R', h'⟩ := Subtree.Subtract.exists (.mk r1 (xs ++ zs ++ ys)) y
+    apply h'.is_empty_subroot_l _ hs2.is_singleton hsub
+    apply ha.is_empty_insert he1 h'
+  case union_r R1' y' ys' ha1' hb1 =>
     cases hs2
-    rename_i ha2' hb2
+    rename_i R2' ha2' hb2
+    have ha1 := ha1'.is_singleton
     have ha2 := ha2'.is_singleton
-    cases ha.is_singleton
-    case tree r2 =>
+    generalize h : (Subtree.mk r1 (xs ++ ys)) = x at ha1
+    induction ha1 generalizing R1 R2' R2 <;> (injections; subst_vars)
+    case tree =>
       cases ha2
-      have ⟨R2', hb2'⟩ := Subtract.exists (node r1 (a :: r2 :: ex1)) (y' :: ys)
-      apply hb2'.is_empty_swap_l _ hb2
-      apply hb.is_empty_append_l he1 hb2'
+      rw [← List.cons_append] at hb1 hb2
+      apply is_empty_transform_internal hb1 he1 hb2 hsub
+    case excl_absurd_r hss =>
+      cases ha2.excl_absurd_r_inv hss
+      apply hb1.is_empty_transform_internal he1 hb2 hsub
+    case excl_irrelevant_r hd2 ha1 ih =>
+      have ha2 := ha2.excl_irrelevant_r_inv hd2
+      apply ih he1 (.singleton ha1) hb1 (.singleton ha2) hb2 ha2 (.refl _)
+    case excl_subclass_r r1 r2 _ _ b hsa2 hsa1 ha1 ih =>
+      have ⟨Rp1, hp1⟩ := Subtract.exists (.node b (xs ++ ys)) (y' :: ys')
+      have ⟨Rs1, _, hh1⟩ := hb1.append_l_inv hp1
+      subst_vars
+      have ⟨hep1, hes1⟩ := he1.append_inv
+      cases Classifier.subclass_or_disjoint b c <;> rename_i hc
+      . have ⟨R, heq, ha2⟩ := ha2.excl_subclass_r_inv hc hsa2
+        simp_all only [heq]
+        have ⟨Rp2, hp2⟩ := Subtract.exists (.node b (xs ++ zs ++ ys)) (y' :: ys')
+        have ⟨Rs2, _, hh2⟩ := hb2.append_l_inv hp2
+        subst_vars
+        apply IsEmpty.append
+        . apply hp1.is_empty_transform_internal hep1 hp2 .rfl
+        . apply ih _ (.singleton ha1) hh1 (.singleton ha2) hh2 ha2
+          simp
+          assumption
+      . cases hc <;> rename_i hc
+        . cases ha2.excl_subclass_l_inv hc hsa2
+          apply hp1.is_empty_transform_internal hep1 hb2 hc.weaken
+        . have ha2 := ha2.excl_irrelevant_l_inv hc.symm hsa2
+          apply ih hes1 (.singleton ha1) hh1 (.singleton ha2) hb2 ha2 (.refl _)
+    case excl_subclass_l hsa2 hss1 =>
+      cases ha2.excl_subclass_l_inv (hss1.subclass_l hsub) hsa2
+      apply hb1.is_empty_transform_internal he1 hb2 hsub
+    case excl_irrelevant_l hsa2 hd1 ha1 ih =>
+      have ha2 := ha2.excl_irrelevant_l_inv (hd1.refines_subclass_l hsub) hsa2
+      apply ih he1 (.singleton ha1) hb1 (.singleton ha2) hb2 ha2 (.refl _)
+termination_by (L.length)
+
+theorem Kind.Subtract.is_empty_append'
+  (hs1 : Subtract (.node r1 ex1) L R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (.node r1 (a :: ex1)) L R2)
+  : R2.IsEmpty := by
+  apply hs1.is_empty_transform_internal (xs:=[]) (zs:=[_]) he1 hs2 .rfl
 
+theorem Kind.Subtract.is_empty_subroot_l'
+  (hs1 : Subtract (.node r1 ex1) L R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract (.node c ex1) L R2)
+  (hsub : c.Subclass r1)
+  : R2.IsEmpty := by
+  apply hs1.is_empty_transform_internal (xs:=[]) (zs:=[]) he1 hs2 hsub
 
 
+theorem Kind.Subtract.is_empty_cons_r'
+  (hs1 : Subtract [x] L R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract [x] (l :: L) R2)
+  : R2.IsEmpty := by
+  cases hs2
+  case union_l ha hb =>
+    cases hb.empty_l_inv
+    cases hs1
+    simp
+    apply ha.is_empty_l he1
+  case union_r R1' y' ys ha' hb =>
+    have ha := ha'.is_singleton
+    induction ha generalizing R1 R2
+    case tree => apply! hs1.is_empty_append'
+    case excl_absurd_r hss =>
+      cases hs1.inj hb; aesop
+    case excl_irrelevant_r hd ha ih =>
+      apply! ih _ (.singleton ha)
+    case excl_subclass_r r1 ex1 r2 ex2 _ a hsa2 hsa1 ha ih =>
+      have ⟨R0, h0⟩ := Subtract.exists (.node a ex1) (y' :: ys)
+      have ⟨Rs, _, hs⟩ := hb.cons_l_inv h0
+      subst_vars
+      apply IsEmpty.append
+      . apply hs1.is_empty_subroot_l' he1 h0 hsa1
+      . apply! ih _ (.singleton ha) hs1 hs
+    case excl_subclass_l hsa2 hss1 =>
+      cases hs1.inj hb; aesop
+    case excl_irrelevant_l hsa2 hd1 ha ih =>
+      apply! ih _ (.singleton ha)
+
+theorem Kind.Subtract.is_empty_cons_r
+  (hs1 : Subtract K L R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract K (l :: L) R2)
+  : R2.IsEmpty := by
+  induction K generalizing R1 R2
+  case nil => cases hs2.empty_l_inv; constructor
+  case cons x xs ih =>
+    have ⟨Rp1, hp1⟩ := Subtract.exists [x] L
+    have ⟨Rs1, _, hh1⟩ := hs1.cons_l_inv hp1
+    have ⟨Rp2, hp2⟩ := Subtract.exists [x] (l :: L)
+    have ⟨Rs2, _, hh2⟩ := hs2.cons_l_inv hp2
+    subst_vars
+    have ⟨_, _⟩ := he1.append_inv
+    apply IsEmpty.append
+    . apply! hp1.is_empty_cons_r'
+    . apply! ih
 
-theorem Kind.Subtract.is_empty_subroot_l
-  (hs1 : Subtract (.node r1 ex1) K R1)
+theorem Kind.Subtract.is_empty_cons_inj_right
+  (hs1 : Subtract K L R1)
   (he1 : R1.IsEmpty)
-  (hs2 : Subtract (.node c ex1) K R2)
-  (hsub : c.Subclass r1)
-  : R2.IsEmpty := sorry
+  (hs2 : Subtract (a :: K) (a :: L) R2)
+  : R2.IsEmpty := by
+  have ⟨Raa, haa⟩ := Subtree.Subtract.exists a a
+  have hae := haa.rfl
+  cases hs1
+  case empty_r =>
+    cases hs2
+    rename_i h1 h2
+    apply IsEmpty.append
+    . apply h1.rfl
+    . apply! h2.is_empty_l
+  case union_l ha hb =>
+    have ⟨he2, he3⟩ := he1.append_inv
+    have ⟨Rh, Rt, _, hh, ht⟩ := hs2.cons_l_split
+    subst_vars
+    apply IsEmpty.append
+    . cases hh
+      rename_i hh1 hh2
+      apply Subtract.is_empty_l hh2 hh1.is_singleton.rfl
+    . have ⟨Rt1, Rt2, _, ht1, ht2⟩ := ht.cons_l_split
+      subst_vars
+      apply IsEmpty.append
+      . apply (Subtract.singleton ha).is_empty_cons_r he2 ht1
+      . apply hb.is_empty_cons_r he3 ht2
+  case union_r y R1 y' ys ha hb =>
+    have ⟨Rp, Rt, _, hp, ht⟩ := ha.cons_l_split
+    subst_vars
+    have ⟨Rp1, Rt1, _, hp1, ht1⟩ := hb.append_l_split
+    subst_vars
+    apply IsEmpty.append
+    . apply hp1.is_empty_l hp.is_singleton.rfl
+    . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
+      apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
+
+
+theorem Kind.Subtract.rfl (hs : Subtract K K R) : R.IsEmpty := by
+  cases hs
+  case empty_r => constructor
+  case union_l ha hb =>
+    cases hb.empty_l_inv
+    simp
+    apply ha.rfl
+  case union_r y R1 y' ys ha hb =>
+    have ⟨Rp, Rt, _, hp, ht⟩ := ha.cons_l_split
+    subst_vars
+    have ⟨Rp1, Rt1, _, hp1, ht1⟩ := hb.append_l_split
+    subst_vars
+    apply IsEmpty.append
+    . apply hp1.is_empty_l hp.is_singleton.rfl
+    . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
+      apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
+
+-- theorem Subtree.Subtract.is_empty_push
+--   (hs1 : Subtract x y R1)
+--   (he1 : R1.IsEmpty)
+--   (hs2 : Subtract x c R2)
+--   (hs3 : Subtract y c R3)
+--   (hs4 : R2.Subtract R3 R4)
+--   : R4.IsEmpty := by
+--   induction hs2
+--   case tree =>
+--     cases hs3
+
+-- theorem Kind.Subtract.is_empty_push'
+--   (hs1 : Subtract [x] K R1)
+--   (he1 : R1.IsEmpty)
+--   (hs2 : x.Subtract c R2)
+--   (hs3 : K.Subtract [c] R3)
+--   (hs4 : R2.Subtract R3 R4)
+--   : R4.IsEmpty := by
+--   induction hs2
+
+-- theorem Kind.Subtract.is_empty_trans''
+--   (hs1 : x.Subtract y R1)
+--   (he1 : R1.IsEmpty)
+--   (hs2 : Subtract [y] C R2)
+--   (he2 : R2.IsEmpty)
+--   (hs3 : Subtract [x] C R3)
+--   : R3.IsEmpty := by
 
-end
 
 end Capless

From 0f4430a3a8fd16b6cd45dd62763fee692180b1ee Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 24 Dec 2025 19:29:28 +0100
Subject: [PATCH 60/71] Give up :(

---
 Capless/Classifier/Core.lean      |   5 +
 Capless/Classifier/Kind.lean      |  15 +
 Capless/Classifier/Semantics.lean | 131 +++++++++
 Capless/Classifier/Subtract.lean  | 442 ++++++++++++++++++++++++++----
 4 files changed, 538 insertions(+), 55 deletions(-)
 create mode 100644 Capless/Classifier/Semantics.lean

diff --git a/Capless/Classifier/Core.lean b/Capless/Classifier/Core.lean
index 102247b3..38f86b8d 100644
--- a/Capless/Classifier/Core.lean
+++ b/Capless/Classifier/Core.lean
@@ -236,6 +236,11 @@ theorem Classifier.subclass_is_Subclass : Subclass a b ↔ a.subclass b := by
         rw [subclass_is_Subclass (a:=p)]
         assumption
 
+instance Classifier.Subclass.decidable (a b : Classifier) : Decidable (a.Subclass b) := by
+  cases h : a.subclass b
+  . apply Decidable.isFalse; rw [Classifier.subclass_is_Subclass]; simp_all
+  . apply Decidable.isTrue; simp [Classifier.subclass_is_Subclass, h]
+
 /-- The disjoint relation as a deterministic boolean function. -/
 def Classifier.disjoint (a : Classifier) (b : Classifier) :=
   match a with
diff --git a/Capless/Classifier/Kind.lean b/Capless/Classifier/Kind.lean
index 383216c9..6cb5de78 100644
--- a/Capless/Classifier/Kind.lean
+++ b/Capless/Classifier/Kind.lean
@@ -40,6 +40,21 @@ inductive ContainsSupOf : List Classifier -> Classifier -> Prop where
   | here : b.Subclass a -> ContainsSupOf (a :: xs) b
   | there : ContainsSupOf xs b -> ContainsSupOf (a :: xs) b
 
+instance ContainsSupOf.decidable : Decidable (ContainsSupOf xs a) := by
+  cases xs
+  case nil => apply Decidable.isFalse; intro h; cases h
+  case cons x xs =>
+    cases decidable (xs:=xs) (a:=a)
+    case isTrue h => exact .isTrue (.there h)
+    case isFalse h =>
+      cases Classifier.Subclass.decidable a x
+      case isTrue h2 => exact .isTrue (.here h2)
+      case isFalse h2 =>
+        apply Decidable.isFalse
+        intro hx
+        cases hx <;> contradiction
+
+
 theorem ContainsSupOf.append_l (h : ContainsSupOf xs b) : ContainsSupOf (xs ++ ys) b := by
   induction h with
   | here hs => exact .here hs
diff --git a/Capless/Classifier/Semantics.lean b/Capless/Classifier/Semantics.lean
new file mode 100644
index 00000000..f1400b00
--- /dev/null
+++ b/Capless/Classifier/Semantics.lean
@@ -0,0 +1,131 @@
+import Capless.Classifier.Subtract
+
+namespace Capless
+
+inductive Subtree.Contains : Subtree -> Classifier -> Prop where
+  | sub : a.Subclass r -> Contains (mk r []) a
+  | incl : ¬ a.Subclass x -> Contains (mk r exs) a -> Contains (mk r (x :: exs)) a
+
+instance Subtree.Contains.decidable : Decidable (Contains (mk r exs) c) := by
+  cases exs
+  case nil =>
+    cases Classifier.Subclass.decidable c r
+    case isTrue h => apply! isTrue (.sub h)
+    case isFalse h =>
+      apply isFalse; intro h0; cases h0; simp_all
+  case cons x xs =>
+    cases decidable (r:=r) (exs:=xs) (c:=c)
+    case isFalse => apply isFalse; intro h0; cases h0; simp_all
+    case isTrue ih =>
+      cases Classifier.Subclass.decidable c x
+      case isFalse h => apply! (isTrue $ .incl h ih)
+      case isTrue h => apply isFalse; intro h0; cases h0; simp_all
+
+theorem Subtree.Contains.subclass_of_root (hc : Contains a c) : c.Subclass a.root := by
+  induction hc
+  case sub => assumption
+  case incl ih => apply! ih
+
+theorem Subtree.Contains.implies_root (hc : Contains a c) : Contains a a.root := by
+  induction hc
+  case sub => apply sub .rfl
+  case incl r exs c x hns hc ih =>
+    cases r.subclass_or_disjoint x <;> rename_i hx
+    . cases c.subclass_or_disjoint x <;> rename_i hxc; aesop
+      cases hxc <;> rename_i hxc
+      . cases (hxc.subclass_l hx).antisymm hc.subclass_of_root
+      . cases (hxc.refines_subclass_r hx).not_subclass hc.subclass_of_root
+    . cases hx <;> rename_i hx
+      . apply incl hx.antisymm ih
+      . apply incl hx.not_subclass ih
+
+inductive Kind.Contains : Kind -> Classifier -> Prop where
+  | here : t.Contains x -> Contains (t :: ts) x
+  | there : Contains ts x -> Contains (t :: ts) x
+
+instance Kind.Contains.decidable : Decidable (Contains k c) := by
+  cases k
+  case nil => apply isFalse; intro h; cases h
+  case cons x xs =>
+    cases Subtree.Contains.decidable (r:=x.root) (exs:=x.excls) (c:=c)
+    case isTrue h => apply! isTrue (.here h)
+    case isFalse hNotHere =>
+      cases decidable (k:=xs) (c:=c)
+      case isTrue h => apply! isTrue (.there h)
+      case isFalse hNotThere =>
+        apply isFalse; intro h; cases h <;> aesop
+
+-- Semantic empty
+@[simp]
+def Subtree.SEmpty (s : Subtree) : Prop := ∀ x, ¬ s.Contains x
+
+@[simp]
+def Kind.SEmpty (k : Kind) : Prop := ∀ x, ¬ k.Contains x
+
+theorem Kind.SEmpty.cons_inv (hs : SEmpty (x :: xs)) : x.SEmpty ∧ SEmpty xs := by
+  apply And.intro
+  . intro c h
+    apply hs c (.here h)
+  . intro c h
+    apply hs c (.there h)
+
+theorem Subtree.SEmpty.excl_inv (he : SEmpty (mk r (x :: xs))) : r.Subclass x ∨ SEmpty (mk r xs) := by
+  cases r.subclass_or_disjoint x; aesop
+  rename_i h; cases h <;> rename_i h
+  . right; intro _ h1; rename_i c
+    apply he r $ .incl h.antisymm h1.implies_root
+  . right; intro _ h1; rename_i c
+    apply he r $ .incl h.not_subclass h1.implies_root
+
+theorem Subtree.SEmpty.is_empty : (mk r exs).SEmpty ↔ ContainsSupOf exs r := by
+  apply Iff.intro <;> intro h
+  . induction exs
+    case nil =>
+      cases h r (.sub .rfl)
+    case cons x xs ih =>
+      cases h.excl_inv <;> rename_i h
+      . apply! ContainsSupOf.here
+      . apply! ContainsSupOf.there $ ih _
+  . intro c h0
+    induction h generalizing c
+    case here hs => cases h0.implies_root; contradiction
+    case there hsc ih => cases h0.implies_root; apply! ih
+
+theorem Kind.SEmpty.is_empty : SEmpty k ↔ IsEmpty k := by
+  apply Iff.intro <;> intro h
+  . induction k
+    case nil => constructor
+    case cons x xs ih =>
+      have ⟨h1, h2⟩ := h.cons_inv
+      constructor
+      . rw [← Subtree.SEmpty.is_empty]; exact h1
+      . aesop
+  . intro c hc
+    induction h
+    case empty => cases hc
+    case absurd hsc h ih =>
+      rw [← Subtree.SEmpty.is_empty] at hsc
+      cases hc
+      case here hc => apply hsc _ hc
+      case there => apply! ih
+
+theorem Subtree.Subtract.contains_or
+  (hs : Subtract a b R1)
+  (hca : a.Contains c)
+  : b.Contains c ∨ R1.Contains c := by
+  induction hs
+  case tree r1 ex1 r2 =>
+    cases Decidable.em (c.Subclass r2)
+    . left; apply! Contains.sub
+    . right; apply! Kind.Contains.here $ Contains.incl _ _
+  case excl_absurd_r hss => right; apply! Kind.Contains.here
+  case excl_irrelevant_r hd hs ih =>
+    cases ih hca <;> rename_i ih
+    . left; apply Contains.incl; apply (hd.refines_subclass_l ih.subclass_of_root).not_subclass; assumption
+    . aesop
+  case excl_subclass_r hsa2 hsa1 hs ih =>
+    cases ih hca
+    .
+
+
+end Capless
diff --git a/Capless/Classifier/Subtract.lean b/Capless/Classifier/Subtract.lean
index 7176da61..c56380c2 100644
--- a/Capless/Classifier/Subtract.lean
+++ b/Capless/Classifier/Subtract.lean
@@ -647,42 +647,42 @@ theorem Kind.Subtract.is_empty_cons_r
     . apply! hp1.is_empty_cons_r'
     . apply! ih
 
-theorem Kind.Subtract.is_empty_cons_inj_right
-  (hs1 : Subtract K L R1)
-  (he1 : R1.IsEmpty)
-  (hs2 : Subtract (a :: K) (a :: L) R2)
-  : R2.IsEmpty := by
-  have ⟨Raa, haa⟩ := Subtree.Subtract.exists a a
-  have hae := haa.rfl
-  cases hs1
-  case empty_r =>
-    cases hs2
-    rename_i h1 h2
-    apply IsEmpty.append
-    . apply h1.rfl
-    . apply! h2.is_empty_l
-  case union_l ha hb =>
-    have ⟨he2, he3⟩ := he1.append_inv
-    have ⟨Rh, Rt, _, hh, ht⟩ := hs2.cons_l_split
-    subst_vars
-    apply IsEmpty.append
-    . cases hh
-      rename_i hh1 hh2
-      apply Subtract.is_empty_l hh2 hh1.is_singleton.rfl
-    . have ⟨Rt1, Rt2, _, ht1, ht2⟩ := ht.cons_l_split
-      subst_vars
-      apply IsEmpty.append
-      . apply (Subtract.singleton ha).is_empty_cons_r he2 ht1
-      . apply hb.is_empty_cons_r he3 ht2
-  case union_r y R1 y' ys ha hb =>
-    have ⟨Rp, Rt, _, hp, ht⟩ := ha.cons_l_split
-    subst_vars
-    have ⟨Rp1, Rt1, _, hp1, ht1⟩ := hb.append_l_split
-    subst_vars
-    apply IsEmpty.append
-    . apply hp1.is_empty_l hp.is_singleton.rfl
-    . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
-      apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
+-- theorem Kind.Subtract.is_empty_cons_inj_right
+--   (hs1 : Subtract K L R1)
+--   (he1 : R1.IsEmpty)
+--   (hs2 : Subtract (a :: K) (a :: L) R2)
+--   : R2.IsEmpty := by
+--   have ⟨Raa, haa⟩ := Subtree.Subtract.exists a a
+--   have hae := haa.rfl
+--   cases hs1
+--   case empty_r =>
+--     cases hs2
+--     rename_i h1 h2
+--     apply IsEmpty.append
+--     . apply h1.rfl
+--     . apply! h2.is_empty_l
+--   case union_l ha hb =>
+--     have ⟨he2, he3⟩ := he1.append_inv
+--     have ⟨Rh, Rt, _, hh, ht⟩ := hs2.cons_l_split
+--     subst_vars
+--     apply IsEmpty.append
+--     . cases hh
+--       rename_i hh1 hh2
+--       apply Subtract.is_empty_l hh2 hh1.is_singleton.rfl
+--     . have ⟨Rt1, Rt2, _, ht1, ht2⟩ := ht.cons_l_split
+--       subst_vars
+--       apply IsEmpty.append
+--       . apply (Subtract.singleton ha).is_empty_cons_r he2 ht1
+--       . apply hb.is_empty_cons_r he3 ht2
+--   case union_r y R1 y' ys ha hb =>
+--     have ⟨Rp, Rt, _, hp, ht⟩ := ha.cons_l_split
+--     subst_vars
+--     have ⟨Rp1, Rt1, _, hp1, ht1⟩ := hb.append_l_split
+--     subst_vars
+--     apply IsEmpty.append
+--     . apply hp1.is_empty_l hp.is_singleton.rfl
+--     . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
+--       apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
 
 
 theorem Kind.Subtract.rfl (hs : Subtract K K R) : R.IsEmpty := by
@@ -702,33 +702,365 @@ theorem Kind.Subtract.rfl (hs : Subtract K K R) : R.IsEmpty := by
     . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
       apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
 
--- theorem Subtree.Subtract.is_empty_push
---   (hs1 : Subtract x y R1)
+theorem Kind.Subtract.cons_l
+  (hs1 : Subtract [x] L R1)
+  (hs2 : Subtract xs L R2)
+  : Subtract (x :: xs) L (R1 ++ R2) := by
+  apply append_l hs1 hs2
+
+theorem Kind.Subtract.append_r
+  (hs1 : Subtract K L1 R1)
+  (hs2 : Subtract R1 L2 R2)
+  : Subtract K (L1 ++ L2) R2 := by
+  induction L1 generalizing K L2 R1 R2
+  case nil => cases hs1; simp_all
+  case cons y ys ih =>
+    cases hs1
+    case empty_l => cases hs2.empty_l_inv; apply empty_l'
+    case union_l R2 _ R1 ha hb =>
+      cases L2
+      case nil =>
+        simp
+        generalize h : R1 ++ R2 = RR at hs2; cases hs2
+        subst_vars; apply! union_l
+      case cons z zs =>
+        have ⟨Rh, Rt, _, hh, ht⟩ := hs2.append_l_split
+        subst_vars
+        simp [List.append]
+        apply cons_l (.union_r (.singleton ha) hh) (.union_r hb ht)
+    case union_r y' ys ha1 hb1 =>
+      apply union_r ha1
+      apply! ih
+
+theorem Subtree.Subtract.is_empty_not_excluded
+  (hs : Subtract a b R)
+  (he : R.IsEmpty)
+  : ContainsSupOf a.excls a.root ∨ ¬ ContainsSupOf b.excls a.root := by
+  rw [← Decidable.imp_iff_or_not]
+  intro hsc
+  induction hs
+  case tree => cases hsc
+  case excl_absurd_r hss => exact he.is_absurd
+  case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
+    cases hsc
+    case there => apply! ih he
+    case here hsc =>
+      cases hs.empty_implies_subclass he <;> rename_i h; aesop
+      cases (hd.refines_subclass_l h).not_subclass hsc
+  case excl_subclass_r hsa2 hsa1 hs ih =>
+    cases he
+    rename_i he1 he2
+    cases hsc
+    case there => apply! ih
+    case here hsc => apply he1.trans_subclass hsc
+  case excl_subclass_l => apply he.is_absurd
+  case excl_irrelevant_l hsa2 hd1 hs ih =>
+    cases hsc
+    case there => apply! ih
+    case here hsc => cases hd1.not_subclass hsc
+
+theorem Subtree.Subtract.is_empty_cases
+  (hs : Subtract a b R)
+  (he : R.IsEmpty)
+  : ContainsSupOf a.excls a.root ∨ (a.root.Subclass b.root ∧ ¬ ContainsSupOf b.excls a.root) := by
+  cases hs.empty_implies_subclass he; aesop
+  cases hs.is_empty_not_excluded he <;> aesop
+
+theorem Subtree.Subtract.is_empty_remaining_subroot
+  (hs1 : Subtract a b R1)
+  (he1 : R1.IsEmpty)
+  (hsc : ContainsSupOf b.excls x)
+  (hsub : x.Subclass a.root)
+  : ContainsSupOf a.excls x := by
+  induction hs1
+  case tree => cases hsc
+  case excl_absurd_r hss => apply he1.is_absurd.trans_subclass hsub
+  case excl_irrelevant_r hd2 hs ih =>
+    cases hsc
+    case there => apply! ih
+    case here hsc =>
+      cases hs.empty_implies_subclass he1 <;> rename_i h
+      . apply! h.trans_subclass
+      . cases (hd2.symm.refines_subclass_l hsc).not_subclass (hsub.trans h)
+  case excl_subclass_r hsa2 hsa1 hs1 ih =>
+    simp_all
+    cases he1
+    cases hsc
+    case there => apply! ih
+    case here => apply! ContainsSupOf.trans_subclass
+  case excl_subclass_l hsa2 hss1 =>
+    apply! he1.is_absurd.trans_subclass
+  case excl_irrelevant_l hsa2 hd1 hs1 ih =>
+    simp_all
+    cases hsc
+    case there => apply! ih
+    case here hsc => cases (hd1.symm.refines_subclass_l hsc).not_subclass hsub
+
+theorem Subtree.Subtract.is_empty_remaining_superroot
+  (hs1 : Subtract a b R1)
+  (he1 : R1.IsEmpty)
+  (hsc : ContainsSupOf b.excls x)
+  (hsub : a.root.StrictSub x)
+  : ContainsSupOf a.excls a.root := by
+  induction hs1
+  case tree => cases hsc
+  case excl_absurd_r hss => apply he1.is_absurd
+  case excl_irrelevant_r hd2 hs ih =>
+    cases hsc
+    case there => apply! ih
+    case here hsc =>
+      cases hs.empty_implies_subclass he1 <;> rename_i h
+      . apply! h
+      . have hd := (hd2.refines_subclass_l h).refines_subclass_r hsc
+        cases hd.not_subclass hsub.weaken
+  case excl_subclass_r hsa2 hsa1 hs1 ih =>
+    simp_all
+    cases he1
+    cases hsc
+    case there => apply! ih
+    case here => apply! ContainsSupOf.trans_subclass _ (.trans hsub.weaken _)
+  case excl_subclass_l hsa2 hss1 =>
+    apply! he1.is_absurd
+  case excl_irrelevant_l hsa2 hd1 hs1 ih =>
+    simp_all
+    cases hsc
+    case there => apply! ih
+    case here hsc => cases hd1.not_subclass (hsub.weaken.trans hsc)
+
+theorem Subtree.Subtract.is_empty_trans
+  (hs1 : Subtract a b R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract b c R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : Subtract a c R3)
+  : R3.IsEmpty := by
+  induction hs2 generalizing a R1 R3
+  case tree =>
+    cases hs3
+    cases hs1.is_empty_cases he1 <;> rename_i hs1
+    . apply Kind.IsEmpty.node (.there hs1)
+    . have ⟨hs1, hsc1⟩ := hs1
+      cases he2.is_absurd
+      case there he2 => have he2 := he2.trans_subclass hs1; contradiction
+      case here he2 => exact .node (.here $ hs1.trans he2)
+  case excl_absurd_r hss =>
+    cases hs3.excl_absurd_r_inv hss;
+    apply hs3.is_empty_l
+    apply Kind.IsEmpty.node
+    apply hs1.empty_r_inv he1 he2.is_absurd
+  case excl_irrelevant_r hd2 hs2 ih =>
+    have hs3 := hs3.excl_irrelevant_r_inv hd2
+    apply! ih
+  case excl_subclass_r r1 ex1 r2 ex2 _ x hsa2 hsa1 hs2 ih =>
+    cases he2
+    rename_i he2a he2b
+    cases x.subclass_or_disjoint a.root <;> rename_i hx
+    . have ⟨R0, _, h0⟩ := hs3.excl_subclass_r_inv hx hsa2
+      subst_vars
+      apply Kind.IsEmpty.absurd
+      . cases hs1.is_empty_cases he1 <;> rename_i hsc1
+        . apply! hsc1.trans_subclass
+        . have ⟨hx1, hy⟩ := hsc1; simp_all
+          apply! is_empty_remaining_subroot hs1 he1
+      . apply! ih
+    . cases hx <;> rename_i hx
+      . cases hs3.excl_subclass_l_inv hx hsa2
+        apply Kind.IsEmpty.node
+        apply! is_empty_remaining_superroot hs1 he1
+      . have hs3 := hs3.excl_irrelevant_l_inv hx.symm hsa2
+        apply! ih
+  case excl_subclass_l hsa2 hss1 =>
+    apply hs3.is_empty_l
+    apply Kind.IsEmpty.node
+    apply hs1.empty_r_inv he1 he2.is_absurd
+  case excl_irrelevant_l r1 ex1 r2 ex2 _ x hsa2 hd1 hs2 ih =>
+    simp_all
+    cases x.subclass_or_disjoint a.root <;> rename_i hx
+    . have ⟨R0, _, h0⟩ := hs3.excl_subclass_r_inv hx hsa2
+      subst_vars
+      constructor
+      . have ⟨_, h⟩ := Subtract.exists (mk x a.excls) (mk r1 ex1)
+        have h0 := hs1.is_empty_subroot_l he1 h hx
+        cases h.empty_implies_subclass h0 <;> rename_i h; aesop
+        cases hd1.symm.not_subclass h
+      . apply! ih
+    . cases hx <;> rename_i hx
+      . cases hs3.excl_subclass_l_inv hx hsa2
+        apply Kind.IsEmpty.node
+        cases hs1.empty_implies_subclass he1 <;> rename_i hs1; aesop
+        cases ((hd1.refines_subclass_l hs1).refines_subclass_r hx.weaken).not_subclass .rfl
+      . have hs3 := hs3.excl_irrelevant_l_inv hx.symm hsa2
+        apply! ih
+
+theorem Kind.Subtract.is_empty_trans''
+  (hs1 : Subtract A [b] R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : b.Subtract c R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : Subtract A [c] R3)
+  : R3.IsEmpty := by
+  induction A generalizing R1 R2 R3
+  case nil => cases hs3; constructor
+  case cons x xs ih =>
+    have ⟨R1h, R1t, _, hh1, ht1⟩ := hs1.cons_l_split
+    have ⟨R3h, R3t, _, hh3, ht3⟩ := hs3.cons_l_split
+    subst_vars
+    have ⟨he1h, he1t⟩ := he1.append_inv
+    apply IsEmpty.append
+    . apply hh1.is_singleton.is_empty_trans he1h hs2 he2 hh3.is_singleton
+    . apply! ih
+
+-- (A - B) - C = 0 -> B - C = 0 -> A - C = 0
+theorem Subtree.Subtract.is_empty_cons_r_inv
+  (hs1 : Subtract a b R1)
+  (hs2 : R1.Subtract [c] R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : Subtract b c R3)
+  (he3 : R3.IsEmpty)
+  (hs4 : Subtract a c R4)
+  : R4.IsEmpty := by sorry
+
+theorem Kind.Subtract.is_empty_cons_r_inv'
+  (hs1 : Subtract A [b] R1)
+  (hs2 : R1.Subtract [c] R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : b.Subtract c R3)
+  (he3 : R3.IsEmpty)
+  (hs4 : A.Subtract [c] R4)
+  : R4.IsEmpty := by
+  induction A generalizing R1 R2 R3 R4
+  case nil => cases hs4; constructor
+  case cons a as ih =>
+    have ⟨R1h, R1t, _, hh1, ht1⟩ := hs1.cons_l_split
+    have ⟨R4h, R4t, _, hh4, ht4⟩ := hs4.cons_l_split
+    subst_vars
+    have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.append_l_split
+    subst_vars
+    have ⟨he2h, he2t⟩ := he2.append_inv
+    apply IsEmpty.append
+    . apply hh1.is_singleton.is_empty_cons_r_inv hh2 he2h hs3 he3 hh4.is_singleton
+    . apply! ih
+
+theorem Kind.Subtract.union_r_inv
+  (hs : Subtract A (b :: b' :: bs) R)
+  : ∃ R1, Subtract A [b] R1 ∧ Subtract R1 (b' :: bs) R := by
+  cases hs
+  aesop
+
+theorem Kind.Subtract.is_empty_cons_r_inv
+  (hs1 : Subtract A B R1)
+  (hs2 : R1.Subtract [c] R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : Subtract B [c] R3)
+  (he3 : R3.IsEmpty)
+  (hs4 : A.Subtract [c] R4)
+  : R4.IsEmpty := by
+  induction B generalizing A R1 R2 R3 R4
+  case nil => cases hs3; cases hs1; cases hs4.inj hs2; simp_all
+  case cons b bs ih =>
+    cases bs
+    case nil => apply! is_empty_cons_r_inv' hs1 hs2 he2 hs3.is_singleton
+    case cons b' bs =>
+    have ⟨R1', hs1a, hs1b⟩ := hs1.union_r_inv
+    have ⟨R3h, R3t, _, hh3, ht3⟩ := hs3.cons_l_split
+    subst_vars
+    have ⟨he3h, he3t⟩ := he3.append_inv
+    have ⟨R1'c, h1'c⟩ := Subtract.exists R1' [c]
+    have he1' := ih hs1b hs2 he2 ht3 he3t h1'c
+    apply is_empty_cons_r_inv' hs1a h1'c he1' hh3.is_singleton he3h hs4
+
+-- Generalize C instead of B
+-- theorem Kind.Subtract.is_empty_cons_r_inv
+--   (hs1 : Subtract A [b] R1)
+--   (hs2 : R1.Subtract C R2)
+--   (he2 : R2.IsEmpty)
+--   (hs3 : Subtract [b] C R3)
+--   (he3 : R3.IsEmpty)
+--   (hs4 : A.Subtract C R4)
+--   : R4.IsEmpty := by
+--   induction C generalizing A R1 R2 R3 R4
+--   case nil => cases hs4; cases hs2; cases hs3; apply! hs1.empty_r_inv
+--   case cons z zs ih =>
+
+--     sorry
+
+theorem Kind.Subtract.is_empty_trans'
+  (hs1 : Subtract A B R1)
+  (he1 : R1.IsEmpty)
+  (hs2 : Subtract B [c] R2)
+  (he2 : R2.IsEmpty)
+  (hs3 : Subtract A [c] R3)
+  : R3.IsEmpty := by
+  induction B generalizing A R1 R2 R3
+  case nil => cases hs1; apply! hs3.is_empty_l
+  case cons b bs ih =>
+    cases bs
+    case nil => apply hs1.is_empty_trans'' he1 hs2.is_singleton he2 hs3
+    case cons b' bs =>
+      cases hs1
+      rename_i R1' hs1a hs1b
+      have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.cons_l_split
+      simp_all
+      have ⟨he2h, he2t⟩ := he2.append_inv
+      have ⟨R1'', h1''⟩ := Subtract.exists R1' [c]
+      have he1'' := ih hs1b he1 ht2 he2t h1''
+      apply is_empty_cons_r_inv hs1a h1'' he1'' hh2 he2h hs3
+
+-- A - B = 0 -> (A - C) - (B - C) = 0
+-- theorem Subtree.Subtract.is_empty_subtract_both_sides
+--   (hs1: Subtract a b R1)
 --   (he1 : R1.IsEmpty)
---   (hs2 : Subtract x c R2)
---   (hs3 : Subtract y c R3)
+--   (hs2 : Subtract a c R2)
+--   (hs3 : Subtract b c R3)
 --   (hs4 : R2.Subtract R3 R4)
---   : R4.IsEmpty := by
---   induction hs2
---   case tree =>
---     cases hs3
+--   : R4.IsEmpty := by sorry
 
--- theorem Kind.Subtract.is_empty_push'
---   (hs1 : Subtract [x] K R1)
+-- theorem Kind.Subtract.is_empty_subtract_both_sides'
+--   (hs1 : Subtract A [b] R1)
 --   (he1 : R1.IsEmpty)
---   (hs2 : x.Subtract c R2)
---   (hs3 : K.Subtract [c] R3)
+--   (hs2 : Subtract A [c] R2)
+--   (hs3 : b.Subtract c R3)
 --   (hs4 : R2.Subtract R3 R4)
 --   : R4.IsEmpty := by
---   induction hs2
+--   induction A generalizing R1 R2 R3 R4
+--   case nil => cases hs1; cases hs2; cases hs4.empty_l_inv; constructor
+--   case cons a as ih =>
+--     have ⟨R1h, R1t, _, hh1, ht1⟩ := hs1.cons_l_split
+--     have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.cons_l_split
+--     subst_vars
+--     have ⟨R4h, R4t, _, hh4, ht4⟩ := hs4.append_l_split
+--     subst_vars
+--     have ⟨he1h, he1t⟩ := he1.append_inv
+--     apply IsEmpty.append
+--     . apply hh1.is_singleton.is_empty_subtract_both_sides he1h hh2.is_singleton hs3 hh4
+--     . apply! ih
 
--- theorem Kind.Subtract.is_empty_trans''
---   (hs1 : x.Subtract y R1)
+-- theorem Kind.Subtract.is_empty_subtract_both_sides
+--   (hs1 : Subtract A B R1)
 --   (he1 : R1.IsEmpty)
---   (hs2 : Subtract [y] C R2)
---   (he2 : R2.IsEmpty)
---   (hs3 : Subtract [x] C R3)
---   : R3.IsEmpty := by
+--   (hs2 : Subtract A [c] R2)
+--   (hs3 : Subtract B [c] R3)
+--   (hs4 : Subtract R2 R3 R4)
+--   : R4.IsEmpty := by
+--   induction B generalizing A R1 R2 R3 R4
+--   case nil => cases hs3.empty_l_inv; cases hs4; cases hs1; cases hs3; apply! hs2.is_empty_l
+--   case cons b bs ih =>
+--     cases bs
+--     case nil => apply hs1.is_empty_subtract_both_sides' he1 hs2 hs3.is_singleton hs4
+--     case cons b' bs =>
+--       have ⟨R1', hs1a, hs1b⟩ := hs1.union_r_inv
+--       have ⟨R3h, R3t, _, hh3, ht3⟩ := hs3.cons_l_split
+--       subst_vars
+
+
+-- -- theorem Kind.Subtract.is_empty_trans
+-- --   (hs1 : Subtract A B R1)
+-- --   (he1 : R1.IsEmpty)
+-- --   (hs2 : Subtract B C R2)
+-- --   (he2 : R2.IsEmpty)
+-- --   (hs3 : Subtract A C R3)
+-- --   : R3.IsEmpty := by
+
 
 
 end Capless

From 5bfb44d1b12582bf02bd74677934515b76d07f7c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Wed, 24 Dec 2025 23:59:47 +0100
Subject: [PATCH 61/71] Semantics subkinding proofs done! :D Merry Christmas

---
 Capless/Classifier.lean              | 1021 +-------------------------
 Capless/Classifier/Basic.lean        |   67 ++
 Capless/Classifier/Intersection.lean |   12 +-
 Capless/Classifier/Semantics.lean    |  324 +++++++-
 Capless/Classifier/Subkind.lean      |   59 ++
 Capless/Classifier/Subtract.lean     |  185 -----
 6 files changed, 455 insertions(+), 1213 deletions(-)
 create mode 100644 Capless/Classifier/Basic.lean

diff --git a/Capless/Classifier.lean b/Capless/Classifier.lean
index ceb2f694..73ae2e84 100644
--- a/Capless/Classifier.lean
+++ b/Capless/Classifier.lean
@@ -3,1025 +3,6 @@ import Capless.Classifier.Kind
 import Capless.Classifier.Intersection
 import Capless.Classifier.Subtract
 import Capless.Classifier.Subkind
+import Capless.Classifier.Basic
 
 namespace Capless
-
--- inductive Kind.Disjoint : Kind -> Kind -> Prop where
---   | empty_l: Disjoint .empty K
---   | empty_r : Disjoint K .empty
---   | union_l : Disjoint K1 K -> Disjoint K2 K -> Disjoint (K1.union K2) K
---   | union_r : Disjoint K K1 -> Disjoint K K2 -> Disjoint K (K1.union K2)
---   | absurd_l : ContainsSupOf ex1 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
---   | absurd_r : ContainsSupOf ex2 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
---   | root : r1.Disjoint r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
---   | excl_l : ContainsSupOf ex2 r1 -> Disjoint (.node r1 ex1) (.node r2 ex2)
---   | excl_r : ContainsSupOf ex1 r2 -> Disjoint (.node r1 ex1) (.node r2 ex2)
-
--- theorem Kind.Disjoint.union_l_inv (hd : Disjoint (K1.union K2) K) : Disjoint K1 K ∧ Disjoint K2 K := by
---   generalize hk : Kind.union K1 K2 = K' at hd
---   induction hd with
---   | empty_l => cases hk
---   | empty_r => exact ⟨.empty_r, .empty_r⟩
---   | union_l hd1 hd2 =>
---     cases hk
---     exact ⟨hd1, hd2⟩
---   | union_r hd1 hd2 ih1 ih2 =>
---     have ⟨hd1', hd2'⟩ := ih1 hk
---     have ⟨hd1'', hd2''⟩ := ih2 hk
---     exact ⟨.union_r hd1' hd1'', .union_r hd2' hd2''⟩
---   | absurd_l => cases hk
---   | absurd_r => cases hk
---   | root => cases hk
---   | excl_l => cases hk
---   | excl_r => cases hk
-
--- theorem Kind.Disjoint.union_r_inv (hd : Disjoint K (K1.union K2)) : Disjoint K K1 ∧ Disjoint K K2 := by
---   generalize hk : Kind.union K1 K2 = K' at hd
---   induction hd with
---   | empty_l => exact ⟨.empty_l, .empty_l⟩
---   | empty_r => cases hk
---   | union_l hd1 hd2 ih1 ih2 =>
---     have ⟨hd1', hd2'⟩ := ih1 hk
---     have ⟨hd1'', hd2''⟩ := ih2 hk
---     exact ⟨.union_l hd1' hd1'', .union_l hd2' hd2''⟩
---   | union_r hd1 hd2 =>
---     cases hk
---     exact ⟨hd1, hd2⟩
---   | absurd_l => cases hk
---   | absurd_r => cases hk
---   | root => cases hk
---   | excl_l => cases hk
---   | excl_r => cases hk
-
--- theorem Kind.Disjoint.implies_empty_intersect (hd : K1.Disjoint K2) (hi : Intersect K1 K2 R) : IsEmpty R := by
---   induction hi with
---   | empty_l => exact .empty
---   | empty_r => exact .empty
---   | union_l hi1 hi2 ih1 ih2 =>
---     have ⟨hd1, hd2⟩ := hd.union_l_inv
---     exact .union (ih1 hd1) (ih2 hd2)
---   | union_r hi1 hi2 ih1 ih2 =>
---     have ⟨hd1, hd2⟩ := hd.union_r_inv
---     exact .union (ih1 hd1) (ih2 hd2)
---   | singleton_l hs =>
---     cases hd with
---     | absurd_l ha => exact .absurd (.append_l ha)
---     | absurd_r ha => exact .absurd (.append_r (ha.trans_subclass hs))
---     | root hd => cases hd.not_subclass hs
---     | excl_l ha => exact .absurd (.append_r ha)
---     | excl_r ha => exact .absurd (.append_l (ha.trans_subclass hs))
---   | singleton_r hs =>
---     cases hd with
---     | absurd_l ha => exact .absurd (.append_l (ha.trans_subclass hs))
---     | absurd_r ha => exact .absurd (.append_r ha)
---     | root hd => cases hd.symm.not_subclass hs
---     | excl_l ha => exact .absurd (.append_r (ha.trans_subclass hs))
---     | excl_r ha => exact .absurd (.append_l ha)
---   | singleton_disj => exact .empty
-
--- theorem Kind.Disjoint.from_empty_intersect (hi : Intersect K1 K2 R) (he : IsEmpty R) : K1.Disjoint K2 := by
---   induction hi with
---   | empty_l => exact .empty_l
---   | empty_r => exact .empty_r
---   | union_l hi1 hi2 ih1 ih2 =>
---     cases he with
---     | union he1 he2 => exact .union_l (ih1 he1) (ih2 he2)
---   | union_r hi1 hi2 ih1 ih2 =>
---     cases he with
---     | union he1 he2 => exact .union_r (ih1 he1) (ih2 he2)
---   | singleton_l hs =>
---     cases he with
---     | absurd ha =>
---       cases ha.of_append with
---       | inl ha => exact .absurd_l ha
---       | inr ha => exact .excl_l ha
---   | singleton_r hs =>
---     cases he with
---     | absurd ha =>
---       cases ha.of_append with
---       | inl ha => exact .excl_r ha
---       | inr ha => exact .absurd_r ha
---   | singleton_disj hd => exact .root hd
-
--- theorem Kind.Disjoint.top_l (hd: Disjoint .top K) : IsEmpty K := by
---   cases hd
---   case empty_r => constructor
---   case union_r ha hb => apply IsEmpty.union ha.top_l hb.top_l
---   case absurd_l hsc => cases hsc
---   case absurd_r hsc => constructor; assumption
---   case root hd => cases hd.symm.not_subclass .of_top
---   case excl_l hsc => constructor; apply hsc.trans_subclass .of_top
---   case excl_r hsc => cases hsc
-
--- theorem Kind.Disjoint.symm (hd : K1.Disjoint K2) : Disjoint K2 K1 := by
---   induction hd with
---   | empty_l => exact .empty_r
---   | empty_r => exact .empty_l
---   | union_l _ _ ih1 ih2 => exact .union_r ih1 ih2
---   | union_r _ _ ih1 ih2 => exact .union_l ih1 ih2
---   | absurd_l ha => exact .absurd_r ha
---   | absurd_r ha => exact .absurd_l ha
---   | root hd => exact .root hd.symm
---   | excl_l ha => exact .excl_r ha
---   | excl_r ha => exact .excl_l ha
-
--- theorem Kind.Disjoint.append_excl_l (hd : Disjoint (.node r1 ex2) K) : Disjoint (.node r1 (ex1 ++ ex2)) K := by
---   cases hd
---   case empty_r => apply! empty_r
---   case union_r ha hb => apply union_r ha.append_excl_l hb.append_excl_l
---   case absurd_l ha => apply absurd_l ha.append_r
---   case absurd_r => apply! absurd_r
---   case root => apply! root
---   case excl_l => apply! excl_l
---   case excl_r ha => apply excl_r ha.append_r
-
--- theorem Kind.Disjoint.refine_subroot_l (hd : Disjoint (.node r1 ex1) K) (hs : r2.Subclass r1) : Disjoint (.node r2 ex1) K := by
---   cases hd
---   case empty_r => apply! empty_r
---   case union_r ha hb => apply! union_r (ha.refine_subroot_l _) (hb.refine_subroot_l _)
---   case absurd_l ha => apply! absurd_l $ ha.trans_subclass _
---   case absurd_r => apply! absurd_r
---   case root hdr => apply root; apply! hdr.refines_subclass_l _
---   case excl_l hc => apply! excl_l $ hc.trans_subclass _
---   case excl_r => apply! excl_r
-
--- -- If K1 is disjoint from K', and R is the intersection of K with K1, then R is disjoint from K'
--- theorem Kind.Disjoint.intersect_disjoint (hd : K1.Disjoint K') (hi : Intersect K K1 R) : R.Disjoint K' := by
---   induction hi
---   case empty_l => apply! empty_l
---   case empty_r => apply! empty_l
---   case union_l iha ihb => apply! union_l (iha _) (ihb _)
---   case union_r iha ihb =>
---     have ⟨_, _⟩ := hd.union_l_inv
---     apply! union_l (iha _) (ihb _)
---   case singleton_l hs => apply append_excl_l; apply! hd.refine_subroot_l _
---   case singleton_r hs => apply hd.append_excl_l
---   case singleton_disj hdr => apply empty_l
-
--- theorem Kind.Disjoint.absurd_l' (hs : ContainsSupOf ex1 r1) : Disjoint (.node r1 ex1) K := by
---   induction K
---   case empty => apply empty_r
---   case node => apply! absurd_l
---   case union ha hb => apply! union_r
-
--- theorem Kind.Disjoint.refine_subtract_l (hd : Disjoint K1 K) (hs : Subtract K1 K2 R) : Disjoint R K := by
---   induction hs
---   case empty_l => exact .empty_l
---   case union_l ih1 ih2 =>
---     have ⟨hd1, hd2⟩ := hd.union_l_inv
---     exact .union_l (ih1 hd1) (ih2 hd2)
---   case empty_r => assumption
---   case union_r ih1 ih2 => exact ih2 (ih1 hd)
---   case tree => apply! hd.append_excl_l (ex1 := [_])
---   case excl_absurd_r => assumption
---   case excl_irrelevant_r ih => apply! ih
---   case excl_subclass_r hs1 _ ih =>
---     apply Disjoint.union_l
---     apply! ih
---     apply! hd.refine_subroot_l
---   case excl_subclass_l => assumption
---   case excl_irrelevant_l ih => apply! ih
-
--- theorem Kind.Disjoint.append_l_disj_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hda : a.Disjoint r2) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
---   cases hd
---   case absurd_l hsc =>
---     cases hsc
---     case here hs => apply! root $ hda.refines_subclass_l _
---     case there hsc => apply! absurd_l
---   case absurd_r => apply! absurd_r
---   case root => apply! root
---   case excl_l hsc => apply! excl_l
---   case excl_r hsc =>
---     cases hsc
---     case here hs => cases hda.symm.not_subclass hs
---     case there => apply! excl_r
-
--- theorem Kind.Disjoint.append_l_contained_inv (hd : Disjoint (.node r1 (a :: ex1)) (.node r2 ex2)) (hsc: ContainsSupOf ex2 a) : Disjoint (.node r1 ex1) (.node r2 ex2) := by
---   cases hd
---   case absurd_l hsc =>
---     cases hsc
---     case here hs => apply! excl_l $ hsc.trans_subclass _
---     case there hsc => apply! absurd_l
---   case absurd_r => apply! absurd_r
---   case root => apply! root
---   case excl_l hsc => apply! excl_l
---   case excl_r hsc =>
---     cases hsc
---     case here hs => apply! absurd_r $ hsc.trans_subclass _
---     case there => apply! excl_r
-
--- theorem Kind.Disjoint.refine_disjoint_subtract_l_disjoint_root
---   (hdr : Disjoint R K)
---   (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
---   (hd : r1.Disjoint r2)
---   : Disjoint (.node r1 ex1) K := by
---   cases hs
---   case tree =>
---     generalize h : node r1 (r2 :: ex1) = L at hdr
---     induction hdr <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb => simp_all; apply! union_r
---     case absurd_l hsc =>
---       cases hsc
---       case here hs => cases hd.not_subclass hs
---       case there hsc => apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd2 => apply! root
---     case excl_l => apply! excl_l
---     case excl_r hsc =>
---       cases hsc
---       case here hs => apply! root $ hd.refines_subclass_r _
---       case there hsc => apply! excl_r
---   case excl_absurd_r => assumption
---   case excl_irrelevant_r hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
---   case excl_subclass_r hs =>
---     have ⟨hl, _⟩ := hdr.union_l_inv
---     apply! hl.refine_disjoint_subtract_l_disjoint_root _ hd
---   case excl_subclass_l => assumption
---   case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_disjoint_root
-
--- theorem Kind.Disjoint.refine_disjoint_subtract_l_subroot
---   (hdr : Disjoint R K)
---   (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
---   (hsub : r2.Subclass r1)
---   (hd2 : Disjoint (.node r2 ex1) K)
---   : Disjoint (.node r1 ex1) K := by
---   cases hs
---   case tree =>
---     generalize h : node r1 (r2 :: ex1) = L at hdr
---     induction hdr <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb =>
---       have ⟨_, _⟩ := hd2.union_r_inv
---       simp_all
---       apply! union_r
---     case absurd_l hsc =>
---       cases hsc
---       case here hs2 => cases hsub.antisymm hs2; assumption
---       case there => apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root => apply! root
---     case excl_l => apply! excl_l
---     case excl_r hsc =>
---       cases hsc
---       case here hs2 =>
---         cases hd2
---         case absurd_l => apply excl_r; apply! ContainsSupOf.trans_subclass
---         case absurd_r => apply! absurd_r
---         case root hd => cases hd.symm.not_subclass hs2
---         case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
---         case excl_r hsc => apply! excl_r
---       case there hsc => apply! excl_r
---   case excl_absurd_r => assumption
---   case excl_irrelevant_r hs =>  apply! hdr.refine_disjoint_subtract_l_subroot
---   case excl_subclass_r hs =>
---     have ⟨hl, _⟩ := hdr.union_l_inv
---     apply! hl.refine_disjoint_subtract_l_subroot
---   case excl_subclass_l => assumption
---   case excl_irrelevant_l hs => apply! hdr.refine_disjoint_subtract_l_subroot
-
-
-
--- theorem Kind.Disjoint.refine_disjoint_subtract_l (hd2 : Disjoint K2 K) (hs : Subtract K1 K2 R) (hdr : Disjoint R K) : Disjoint K1 K := by
---   induction hs generalizing K
---   case empty_l => apply empty_l
---   case union_l ih1 ih2 =>
---     have ⟨_, _⟩ := hdr.union_l_inv
---     apply! union_l (ih1 _ _) (ih2 _ _)
---   case empty_r => assumption
---   case union_r ha hb =>
---     have ⟨hl, hr⟩ := hd2.union_l_inv
---     apply ha hl _
---     apply hb hr hdr
---   case tree r1 ex1 r2 =>
---     generalize h : node r1 (r2 :: ex1) = L at hdr
---     induction hdr <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb =>
---       have ⟨_, _⟩ := hd2.union_r_inv
---       simp_all
---       apply! union_r
---     case absurd_l hsc =>
---       cases hsc
---       case here hs =>
---         cases hd2
---         case absurd_l hsc => cases hsc
---         case absurd_r hsc => apply! absurd_r
---         case root hd =>  apply root; apply! hd.refines_subclass_l _
---         case excl_l hsc => apply excl_l; apply! hsc.trans_subclass
---         case excl_r hsc => cases hsc
---       case there hsc => apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root => apply! root
---     case excl_l => apply! excl_l
---     case excl_r hsc =>
---       cases hsc
---       case here hs =>
---         cases hd2
---         case absurd_r hsc => apply! absurd_r
---         case root hd => cases hd.symm.not_subclass hs
---         case excl_l hsc => apply absurd_r; apply! hsc.trans_subclass
---         case excl_r hsc => cases hsc
---         case absurd_l hsc => cases hsc
---       case there hsc => apply! excl_r
---   case excl_subclass_r r1 ex1 r2 ex2 _ a hss hsc hs ih =>
---     have ⟨hdr1, hdr2⟩ := hdr.union_l_inv
---     generalize h : node r2 (a :: ex2) = L at hd2
---     induction hd2 generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb =>
---       simp_all
---       have ⟨_, _⟩ := hdr.union_r_inv
---       have ⟨_, _⟩ := hdr1.union_r_inv
---       have ⟨_, _⟩ := hdr2.union_r_inv
---       apply! union_r (ha _ _ _) (hb _ _ _)
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc1 =>
---         cases hss.antisymm hsc1
---         apply! hdr1.refine_disjoint_subtract_l_subroot
---       case there hsc =>
---         apply ih _ hdr1
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd1 => apply ih (.root hd1) hdr1
---     case excl_l hsc => apply! ih (.excl_l _)
---     case excl_r hsc =>
---       cases hsc
---       case here hs =>
---         cases hdr2
---         case absurd_l hsc => apply! excl_r $ hsc.trans_subclass _
---         case absurd_r => apply! absurd_r
---         case root hd => cases hd.symm.not_subclass hs
---         case excl_l hsc => apply! absurd_r $ hsc.trans_subclass _
---         case excl_r => apply! excl_r
---       case there hsc => apply! ih (excl_r _)
---   case excl_absurd_r hs => assumption
---   case excl_irrelevant_r r1 ex1 r2 ex2 _ a hd hs ih =>
---     generalize h : node r2 (a :: ex2) = L at hd2
---     induction hd2 generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb =>
---       simp_all
---       have ⟨_, _⟩ := hdr.union_r_inv
---       apply! union_r (ha _) (hb _)
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc => cases hd.not_subclass hsc
---       case there hsc =>
---         apply ih _ hdr
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd1 => apply ih (.root hd1) hdr
---     case excl_l hsc => apply! ih (.excl_l _)
---     case excl_r hsc =>
---       cases hsc
---       case here hs => apply ih _ hdr; apply root; apply! hd.refines_subclass_r
---       case there hsc => apply! ih (excl_r _)
---   case excl_subclass_l hs2 hs1 => assumption
---   case excl_irrelevant_l r1 ex1 r2 ex2 _ a hs2 hd1 hs ih =>
---     generalize h : node r2 (a :: ex2) = L at hd2
---     induction hd2 generalizing K2 <;> try cases h
---     case empty_r => apply! empty_r
---     case union_r ha hb =>
---       simp_all
---       have ⟨_, _⟩ := hdr.union_r_inv
---       apply! union_r (ha _) (hb _)
---     case absurd_l hsc =>
---       cases hsc
---       case here hsc =>
---         cases hs2.antisymm hsc
---         apply! hdr.refine_disjoint_subtract_l_disjoint_root hs
---       case there hsc =>
---         apply ih _ hdr
---         apply! absurd_l
---     case absurd_r => apply! absurd_r
---     case root hd1 => apply ih (.root hd1) hdr
---     case excl_l hsc => apply! ih (.excl_l _)
---     case excl_r hsc =>
---       cases hsc
---       case here hs => apply root; apply! hd1.refines_subclass_r
---       case there hsc => apply! ih (excl_r _)
-
--- theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
---   induction he
---   case empty => apply empty_l
---   case absurd => apply! absurd_l'
---   case union ha hb => apply! union_l
-
--- theorem Kind.Disjoint.refine_subkind_l' (hd : Disjoint K2 K) (hs : Subtract K1 K2 R) (he : IsEmpty R) : Disjoint K1 K := by
---   apply refine_disjoint_subtract_l hd hs
---   apply is_empty_l he
-
--- theorem Kind.Disjoint.refine_subkind_l (hd : Disjoint K2 K) (hs : Subkind K1 K2) : Disjoint K1 K := by
---   cases hs
---   apply! hd.refine_subkind_l'
-
--- theorem Kind.Subkind.refine_disjoint_l (hs : Subkind K1 K2) (hd : Disjoint K2 K) : Disjoint K1 K := hd.refine_subkind_l hs
-
-
-theorem Kind.Subtract.is_empty_append_l
-  (hs : Subtract (.node r1 ex1) (.node r2 ex2) R)
-  (he : IsEmpty R)
-  (hs1 : Subtract (.node r1 (a :: ex1)) (.node r2 ex2) R1)
-  : IsEmpty R1 := by
-  induction ex2 generalizing R R1
-  case nil =>
-    cases hs1
-    cases hs
-    constructor
-    cases he.is_absurd
-    case here hs => apply! ContainsSupOf.here
-    case there hsc => exact .there $ .there hsc
-  case cons head tail ih =>
-    cases hs
-    case excl_absurd_r hs =>
-      cases hs1
-      case excl_absurd_r => constructor; cases he; apply! ContainsSupOf.there
-      case excl_irrelevant_r hd hs1 => cases hd.not_subclass hs.weaken
-      case excl_subclass_r hs1 hs2 hsa => cases hs.antisymm hs2
-      case excl_subclass_l => constructor; cases he; apply! ContainsSupOf.there
-      case excl_irrelevant_l hd hs2 hs1 => cases hs.antisymm hs2
-    case excl_irrelevant_r hd hs =>
-      cases hs1
-      case excl_absurd_r hsub => cases hd.not_subclass hsub.weaken
-      case excl_irrelevant_r hs1 => apply! ih
-      case excl_subclass_r hsub1 hsub2 hs1 => cases hd.symm.not_subclass hsub2
-      case excl_subclass_l hsub => cases hd.symm.not_subclass hsub
-      case excl_irrelevant_l hsub _ => cases hd.symm.not_subclass hsub
-    case excl_subclass_r hsub1 hsub2 hs =>
-      cases he
-      rename_i he1 he
-      cases hs1
-      case excl_absurd_r hsub =>
-        constructor
-        cases hsub.antisymm hsub2
-      case excl_irrelevant_r hd hs1 => apply! ih
-      case excl_subclass_r =>
-        constructor
-        . apply! ih
-        . constructor; cases he; apply! ContainsSupOf.there
-      case excl_subclass_l hsub _ => cases hsub.antisymm hsub1
-      case excl_irrelevant_l hd _ _ => cases hd.symm.not_subclass hsub1
-    case excl_subclass_l hsub1 hsub2 =>
-      have ⟨R, h⟩ := Subtract.exists (node r1 ex1) (node r2 tail)
-      have he1 := h.is_empty_l he
-      cases hs1
-      case excl_absurd_r => constructor; cases he; apply! ContainsSupOf.there
-      case excl_irrelevant_r hd hs => cases hd.symm.not_subclass hsub2
-      case excl_subclass_r hsub _ hs1 =>
-        cases hsub.antisymm hsub1.weaken
-        constructor
-        . apply! ih
-        . constructor; cases he; apply! ContainsSupOf.there
-      case excl_subclass_l => constructor; cases he; apply! ContainsSupOf.there
-      case excl_irrelevant_l hd _ _ => cases hd.not_subclass hsub1.weaken
-    case excl_irrelevant_l hd hsub2 hs =>
-      cases hs1
-      case excl_absurd_r hsub => cases hsub.antisymm hsub2
-      case excl_irrelevant_r hd2 hs => apply! ih
-      case excl_subclass_r hsub1 _ hs1 => cases hd.symm.not_subclass hsub1
-      case excl_subclass_l hsub1 _ => cases hd.not_subclass hsub1.weaken
-      case excl_irrelevant_l hsub2 hs1 => apply! ih
-
-theorem Kind.Subtract.unique
-  (hs1 : Subtract K1 K2 R1)
-  (hs2 : Subtract K1 K2 R2)
-  : R1 = R2 := by
-  induction hs1 generalizing R2
-  case empty_l => cases hs2; simp
-  case union_l ha hb =>
-    cases hs2
-    simp
-    apply And.intro
-    apply! ha
-    apply! hb
-  case empty_r => cases hs2; simp
-  case union_r ha hb =>
-    cases hs2
-    case union_r ga gb => cases ha ga; apply! hb
-  case tree => cases hs2; simp
-  case excl_absurd_r hss =>
-    cases hs2
-    case excl_absurd_r => simp
-    case excl_irrelevant_r hd _ => cases hd.not_subclass hss.weaken
-    case excl_subclass_r hs _ => cases hss.antisymm hs
-    case excl_subclass_l hs => cases hss.antisymm hs
-    case excl_irrelevant_l hs _ => cases hss.antisymm hs
-  case excl_irrelevant_r hd hs ih =>
-    cases hs2
-    case excl_absurd_r hss => cases hd.not_subclass hss.weaken
-    case excl_irrelevant_r hs2 => apply! ih
-    case excl_subclass_r hs _ => cases hd.symm.not_subclass hs
-    case excl_subclass_l hs => cases hd.symm.not_subclass hs
-    case excl_irrelevant_l hs _ => cases hd.symm.not_subclass hs
-  case excl_subclass_r hsa hsb hs1 ih =>
-    cases hs2
-    case excl_absurd_r hss => cases hss.antisymm hsa
-    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hsa
-    case excl_subclass_r hs _ => simp; apply! ih
-    case excl_subclass_l hss _ => cases hss.antisymm hsb
-    case excl_irrelevant_l hd _ _ => cases hd.symm.not_subclass hsb
-  case excl_subclass_l hsa hss =>
-    cases hs2
-    case excl_absurd_r hss => cases hss.antisymm hsa
-    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hsa
-    case excl_subclass_r hs _ _ => cases hss.antisymm hs
-    case excl_subclass_l hss _ => simp
-    case excl_irrelevant_l hd _ _ => cases hd.not_subclass hss.weaken
-  case excl_irrelevant_l hs hd hs1 ih =>
-    cases hs2
-    case excl_absurd_r hss => cases hss.antisymm hs
-    case excl_irrelevant_r hd _ => cases hd.symm.not_subclass hs
-    case excl_subclass_r hs _ _ => cases hd.symm.not_subclass hs
-    case excl_subclass_l hss _ => cases hd.not_subclass hss.weaken
-    case excl_irrelevant_l hd _ _ => apply! ih
-
--- theorem Kind.Subtract.is_subkind
---   (hs : Subtract K1 K2 R)
---   : Subkind R K1 := by
---   induction hs
---   case empty_l => constructor; constructor; constructor
---   case union_l ha hb =>
-
-
-theorem Kind.Subtract.empty_union_l
-  (hs : Subtract (.union K1 K2) K R)
-  (he : R.IsEmpty)
-  (hs1 : Subtract K1 K R1)
-  (hs2 : Subtract K2 K R2)
-  : R1.IsEmpty ∧ R2.IsEmpty := by
-  cases hs
-  case union_l ha hb =>
-    cases hs1.unique ha
-    cases hs2.unique hb
-    cases he
-    aesop
-
-theorem Kind.Subtract.empty_union_rl
-  (hs : Subtract K K1 R)
-  (he : R.IsEmpty)
-  (hs1 : Subtract K (.union K1 K2) R1)
-  : R1.IsEmpty := by
-  cases hs1
-  case empty_l => constructor
-  case union_l C1 R1 C2 R2 ha hb =>
-    have ⟨T1, h1⟩ := Subtract.exists C1 K1
-    have ⟨T2, h2⟩ := Subtract.exists C2 K1
-    have ⟨_, _⟩ := hs.empty_union_l he h1 h2
-    constructor
-    apply! h1.empty_union_rl
-    apply! h2.empty_union_rl
-  case union_r hsa hsb =>
-    cases hs.unique hsa
-    apply hsb.is_empty_l he
-
-theorem Kind.Subtract.top (hs : Subtract K .top R) : IsEmpty R := by
-  cases hs
-  case empty_l => constructor
-  case union_l ha hb =>
-    apply IsEmpty.union ha.top hb.top
-  case tree =>
-    constructor
-    apply ContainsSupOf.here
-    apply Classifier.Subclass.of_top
-
-theorem Kind.Subkind.of_top : Subkind K .top := by
-  have ⟨R, h⟩ := Subtract.exists K .top
-  apply subtract h h.top
-
--- prove later
-theorem Kind.Subtract.rfl (hs : Subtract K K R) : IsEmpty R := by sorry
-
-theorem Kind.Subkind.rfl : Subkind K K := by
-  have ⟨R, h⟩ := Subtract.exists K K
-  apply subtract h h.rfl
-
--- prove later
-theorem Kind.Subtract.implies_trans
-  (hs3 : Subtract K1 K3 R3)
-  (hs1 : Subtract K1 K2 R1)
-  (he1 : R1.IsEmpty)
-  (hs2 : Subtract K2 K3 R2)
-  (he2 : R2.IsEmpty)
-  : R3.IsEmpty := by sorry
-
-theorem Kind.Subkind.trans (hs1 : Subkind K1 K2) (hs2 : Subkind K2 K3) : Subkind K1 K3 := by
-  cases hs1
-  cases hs2
-  rename_i h1 h2 _ h3 h4
-  have ⟨R, h⟩ := Subtract.exists K1 K3
-  apply subtract h
-  apply! h.implies_trans h1
-
-theorem Kind.Intersect.with_subkind
-  (hs : K1.Subkind K2)
-  : (intersect L K1).Subkind (intersect L K2) := by sorry
-
-theorem Kind.Intersect.with_subkind_r
-  (hs : K1.Subkind K2)
-  : (intersect K1 L).Subkind (intersect K2 L) := by sorry
-
-theorem Kind.Subkind.of_empty
-  (hs : Subkind K L)
-  (he : L.IsEmpty)
-  : K.IsEmpty := by
-  cases hs
-  case subtract hs he1 => apply! hs.empty_r_inv
-
-theorem Kind.Intersect.subkind_l
-  : (intersect K L).Subkind K := by sorry
-theorem Kind.Intersect.subkind_r
-  : (intersect K L).Subkind L := by sorry
-
-theorem Kind.Intersect.is_empty_l
-  (he : IsEmpty K) : IsEmpty (K.intersect L) := by
-  apply Subkind.of_empty subkind_l he
-
-theorem Kind.Intersect.is_empty_r
-  (he : IsEmpty L) : IsEmpty (intersect K L) := by
-  apply Subkind.of_empty subkind_r he
-
-theorem Kind.Subkind.union_rl : Subkind K1 (.union K1 K2) := by sorry
-theorem Kind.Subkind.union_rr : Subkind K2 (.union K1 K2) := by sorry
-
-theorem Kind.Subkind.union_l
-  (hs1 : Subkind K1 L)
-  (hs2 : Subkind K2 L)
-  : Subkind (.union K1 K2) L := by
-  cases hs1
-  cases hs2
-  constructor
-  apply! Subtract.union_l
-  apply! IsEmpty.union
-
-theorem Kind.Subkind.join
-  (hs1 : Subkind K1 L1)
-  (hs2 : Subkind K2 L2)
-  : Subkind (.union K1 K2) (.union L1 L2) := by
-  apply union_l
-  apply trans hs1 .union_rl
-  apply trans hs2 .union_rr
-
-theorem Kind.Subkind.reorder_union_4 : Subkind (.union (.union A B) (.union C D)) (.union (.union A C) (.union B D)) := by
-  apply union_l
-  . apply union_l
-    . apply trans .union_rl .union_rl
-    . apply trans .union_rl .union_rr
-  . apply union_l
-    . apply trans .union_rr .union_rl
-    . apply trans .union_rr .union_rr
-
-theorem Kind.Intersect.union_r_subkind : Subkind (.intersect K (.union L1 L2)) (.union (K.intersect L1) (K.intersect L2)) := by
-  induction K
-  case empty => simp; apply Subkind.subtract; apply Subtract.empty_l; constructor
-  case node => simp; apply Subkind.rfl
-  case union ha hb =>
-    -- simp
-    have h := Subkind.join ha hb
-    simp at h
-    simp
-    apply Subkind.trans h .reorder_union_4
-
-theorem Kind.Subkind.is_empty_l
-  (he : IsEmpty K)
-  : Subkind K L := by
-  induction he
-  case empty =>
-    apply subtract .empty_l .empty
-  case absurd exs r hsc =>
-    have ⟨R, h⟩ := Subtract.exists (.node r exs) L
-    apply! subtract h $ h.absurd_l _
-  case union h1 h2 =>
-    apply! union_l
-
-theorem Kind.Intersect.union_r_superkind : Subkind (.union (K.intersect L1) (K.intersect L2)) (.intersect K (.union L1 L2)) := by
-  induction K
-  case empty => simp; apply Subkind.is_empty_l; constructor; constructor; constructor;
-  case node => simp; apply Subkind.rfl
-  case union ha hb =>
-    have h := Subkind.join ha hb
-    simp
-    apply Subkind.trans .reorder_union_4 h
-
--- theorem Kind.Subkind.intersect_l_inv
---   (hs : Subkind (K1.intersect L) (K2.intersect L))
---   : Subkind K1 K2 := by
-
--- theorem Kind.Subkind.union_with_subkind_l
---   (hs : Subkind K L)
---   : Subkind (L.union K) L := by
---   apply union_l .rfl hs
-
-theorem Kind.Intersect.union_l_subkind : Subkind (.intersect (.union K1 K2) L) (.union (K1.intersect L) (K2.intersect L)) := by sorry
-
-theorem Kind.Intersect.assoc_subkind : Subkind (.intersect (.intersect K1 K2) K3) (.intersect K1 (.intersect K2 K3)) := by
-  induction K1 <;> try simp_all
-  case empty => apply Subkind.rfl
-  case union ha hb => apply Subkind.join ha hb
-  case node =>
-    induction K2
-    case empty => simp; apply Subkind.rfl
-    case union ha hb => simp; apply Subkind.join ha hb
-    case node => sorry
-
-theorem Kind.Intersect.assoc_superkind : Subkind (.intersect K1 (.intersect K2 K3)) (.intersect (.intersect K1 K2) K3) := by
-  induction K1 <;> try simp_all
-  case empty => apply Subkind.rfl
-  case union ha hb => apply Subkind.join ha hb
-  case node =>
-    induction K2
-    case empty => simp; apply Subkind.rfl
-    case union ha hb => simp; apply Subkind.join ha hb
-    case node => sorry
-
-@[simp]
-def Kind.contains_sup_of (exs : List Classifier) (c : Classifier) :=
-  match exs with
-  | .nil => false
-  | .cons head tail => c.subclass head || contains_sup_of tail c
-
-theorem Kind.ContainsSupOf.lawful : ContainsSupOf exs r ↔ contains_sup_of exs r := by
-  apply Iff.intro
-  . intro hsc
-    induction hsc
-    case here hs => simp; simp_all [Classifier.subclass_is_Subclass]
-    case there ih => simp_all
-  . intro hsc
-    unfold contains_sup_of at hsc
-    split at hsc
-    . aesop
-    . simp at hsc
-      cases hsc <;> rename_i hsc
-      . apply ContainsSupOf.here; simp_all [Classifier.subclass_is_Subclass]
-      . apply ContainsSupOf.there; rw [← lawful] at hsc; simp_all
-
--- @[simp]
--- def Kind.disjoint (K1 : Kind) (K2 : Kind) :=
---   match K1 with
---   | .empty => true
---   | .union a b => a.disjoint K2 && b.disjoint K2
---   | .node r1 ex1 =>
---     match K2 with
---     | .empty => true
---     | .union a b => (Kind.node r1 ex1).disjoint a && (Kind.node r1 ex1).disjoint b
---     | .node r2 ex2 =>
---       r1.disjoint r2
---         || contains_sup_of ex1 r1 || contains_sup_of ex2 r2
---         || contains_sup_of ex1 r2 || contains_sup_of ex2 r1
-
--- theorem Kind.Disjoint.lawful : Disjoint K1 K2 ↔ K1.disjoint K2 := by
---   apply Iff.intro
---   . intro hd
---     induction hd
---     case empty_l => simp
---     case empty_r K =>
---       induction K <;> simp_all
---     case union_l => simp_all
---     case union_r K K1 K2 _ _ ha hb =>
---       induction K <;> simp_all
---       rename_i iha ihb hha hhb
---       have ⟨_, _⟩ := hha.union_l_inv
---       have ⟨_, _⟩ := hhb.union_l_inv
---       apply And.intro
---       apply! iha
---       apply! ihb
---     case absurd_l hsc => simp_all [ContainsSupOf.lawful]
---     case absurd_r hsc => simp_all [ContainsSupOf.lawful]
---     case root hd => simp_all [Classifier.disjoint_is_Disjoint]
---     case excl_l => simp_all [ContainsSupOf.lawful]
---     case excl_r => simp_all [ContainsSupOf.lawful]
---   . intro hd
---     induction K1
---     case empty => apply empty_l
---     case union ha hb =>
---       apply union_l <;> simp_all
---     case node r1 ex1 =>
---       induction K2
---       case empty => apply empty_r
---       case union ha hb =>
---         apply union_r <;> simp_all
---       case node r2 ex2 =>
---         simp at hd; rw [← Classifier.disjoint_is_Disjoint] at hd; repeat rw [← ContainsSupOf.lawful] at hd
---         cases hd <;> rename_i hd
---         . cases hd <;> rename_i hd
---           . cases hd <;> rename_i hd
---             . cases hd <;> rename_i hd
---               . apply! root
---               . apply! absurd_l
---             . apply! absurd_r
---           . apply! excl_r
---         . apply! excl_l
-
-
--- inductive Kind.Contains : Kind -> Classifier -> Prop where
---   | union_l : Contains K1 c -> Contains (.union K1 K2) c
---   | union_r : Contains K2 c -> Contains (.union K1 K2) c
---   | subclass : Classifier.Subclass c r -> Contains (.node r []) c
---   | excl_sub :
---     Classifier.StrictSub a c ->
---     Contains (.node r exs) c ->
---     Contains (.node r (a :: exs)) c
---   | excl_irrelevant :
---     Classifier.Disjoint a c ->
---     Contains (.node r exs) c ->
---     Contains (.node r (a :: exs)) c
-
--- theorem Kind.Contains.is_subclass
---   (hc : Contains (.node r exs) c)
---   : c.Subclass r := by
---   cases hc
---   case subclass => assumption
---   case excl_sub hc => apply hc.is_subclass
---   case excl_irrelevant hc => apply hc.is_subclass
-
--- theorem Kind.Contains.not_empty
---   (hc : Contains K c)
---   (he : IsEmpty K)
---   : False := by
---   induction he
---   case empty => cases hc
---   case absurd exs r hsc =>
---     induction hsc
---     case here hs =>
---       cases hc
---       case excl_sub hss hc =>
---         apply hss.antisymm
---         apply hc.is_subclass.trans hs
---       case excl_irrelevant hd hc =>
---         apply hd.symm.not_subclass
---         apply hc.is_subclass.trans hs
---     case there hsc ih =>
---       cases hc <;> apply! ih
---   case union ha hb =>
---     cases hc
---     apply! ha
---     apply! hb
-
--- theorem Kind.Contains.excl_irrelevant_l
---   (hd : Classifier.Disjoint r a)
---   (hc : Contains (.node r exs) c)
---   : Contains (.node r (a :: exs)) c := by
---   cases c.subclass_or_disjoint a <;> rename_i hs
---   . cases (hd.refines_subclass_l hc.is_subclass).not_subclass hs
---   . cases hs <;> rename_i hs
---     . apply! excl_sub
---     . apply! excl_irrelevant hs.symm
-
--- theorem Kind.Contains.change_root
---   (hc : Contains (.node r exs) c)
---   (hs1 : c.Subclass a)
---   : Contains (.node a exs) c := by
---   cases hc
---   case subclass => apply! subclass
---   case excl_sub hss hc => apply excl_sub hss; apply! hc.change_root
---   case excl_irrelevant hd hc => apply excl_irrelevant hd; apply! hc.change_root
-
--- theorem Kind.Contains.excl_append
---   (hc1 : Contains (.node r ex1) c)
---   (hc2 : Contains (.node r ex2) c)
---   : Contains (.node r (ex1 ++ ex2)) c := by
---   induction ex1
---   case nil => exact hc2
---   case cons head tail ih =>
---     cases hc1
---     case excl_sub => apply! excl_sub _ (ih _)
---     case excl_irrelevant => apply! excl_irrelevant _ (ih _)
-
--- theorem Kind.Contains.subtract
---   (hc : Contains K c)
---   (hs : Subtract K L R)
---   : Contains L c ∨ Contains R c := by
---   induction hs
---   case empty_l => cases hc.not_empty .empty
---   case union_l ha hb =>
---     cases hc <;> rename_i hc
---     . cases ha hc
---       . aesop
---       . right; apply union_l; assumption
---     . cases hb hc
---       . aesop
---       . right; apply union_r; assumption
---   case empty_r => aesop
---   case union_r ha hb =>
---     cases ha hc <;> rename_i ha
---     . left; apply union_l; assumption
---     . cases hb ha <;> rename_i hb
---       . left; apply union_r; assumption
---       . aesop
---   case tree r1 _ r2 =>
---     cases c.subclass_or_disjoint r2 <;> rename_i hs
---     . left; constructor; assumption
---     . cases hs <;> rename_i hs
---       . right; apply! excl_sub
---       . right; apply excl_irrelevant hs.symm hc
---   case excl_absurd_r hss => aesop
---   case excl_irrelevant_r hd _ ih =>
---     cases ih hc
---     case inl hc => left; apply! excl_irrelevant_l
---     case inr => aesop
---   case excl_subclass_r a hs2 hs1 _ ih =>
---     cases ih hc <;> rename_i ih
---     . cases c.subclass_or_disjoint a <;> rename_i hs
---       . right; apply union_r; apply! change_root
---       . cases hs <;> rename_i hs
---         . left; apply! excl_sub
---         . left; apply! excl_irrelevant (.symm _)
---     . right; apply! union_l
---   case excl_subclass_l hs2 hss => aesop
---   case excl_irrelevant_l hs2 hd1 _ ih =>
---     cases ih hc <;> rename_i ih
---     . left; apply excl_irrelevant _ ih; apply hd1.symm.refines_subclass_r hc.is_subclass
---     . aesop
-
--- theorem Kind.Contains.refine_subkind
---   (hc : Contains K c)
---   (hs : Subkind K L)
---   : Contains L c := by
---   cases hs
---   rename_i hs he
---   cases hc.subtract hs
---   . assumption
---   . rename_i hc; cases hc.not_empty he
-
--- theorem Kind.Contains.intersect'
---   (hc1 : Contains K1 c)
---   (hc2: Contains K2 c)
---   (hi : Intersect K1 K2 R)
---   : Contains R c := by
---   induction hi
---   case empty_l => cases hc1.not_empty .empty
---   case empty_r => cases hc2.not_empty .empty
---   case union_l ha hb =>
---     simp_all
---     cases hc1
---     . apply! union_l (ha _)
---     . apply! union_r (hb _)
---   case union_r ha hb =>
---     simp_all
---     cases hc2
---     . apply! union_l (ha _)
---     . apply! union_r (hb _)
---   case singleton_l =>
---     apply excl_append hc1 (hc2.change_root hc1.is_subclass)
---   case singleton_r =>
---     apply excl_append (hc1.change_root hc2.is_subclass) hc2
---   case singleton_disj hd =>
---     cases (hd.refines_subclass_l hc1.is_subclass).not_subclass hc2.is_subclass
-
--- theorem Kind.Contains.intersect
---   (hc1 : Contains K1 c)
---   (hc2 : Contains K2 c)
---   : Contains (K1.intersect K2) c := intersect' hc1 hc2 (Intersect.lawful)
-
--- @[simp]
--- def Kind.contains (K : Kind) (c : Classifier) : Bool :=
---   match K with
---   | .empty => false
---   | .union K1 K2 => K1.contains c || K2.contains c
---   | .node r exs =>
---     match exs with
---     | .nil => c.subclass r
---     | .cons a xs =>
---       if a.subclass c && a != c then (Kind.node r xs).contains c
---       else if a.disjoint c then (Kind.node r xs).contains c
---       else false
-
--- theorem Kind.Contains.lawful : Contains K c ↔ K.contains c := by
---   apply Iff.intro
---   . intro hc
---     induction hc <;> try simp_all
---     case subclass hs => rw [← Classifier.subclass_is_Subclass]; assumption
---     case excl_sub hss _ _ => left; apply And.intro; rw [← Classifier.subclass_is_Subclass]; apply hss.weaken; apply hss.neq
---     case excl_irrelevant hd _ _ => right; rw [← Classifier.disjoint_is_Disjoint]; assumption
---   . intro hc
---     unfold contains at hc
---     split at hc
---     . aesop
---     . simp at hc; cases hc
---       . apply union_l; rw [lawful]; assumption
---       . apply union_r; rw [lawful]; assumption
---     . split at hc
---       . constructor; rw [Classifier.subclass_is_Subclass]; assumption
---       . simp at hc
---         split at hc
---         . rename_i h
---           have ⟨h1, h2⟩ := h
---           apply excl_sub
---           rw [← Classifier.subclass_is_Subclass] at h1
---           cases h1.might_strict <;> aesop
---           rw [← lawful] at hc; aesop
---         . have ⟨h1, h2⟩ := hc
---           rw [← lawful] at h2
---           rw [← Classifier.disjoint_is_Disjoint] at h1
---           apply! excl_irrelevant
-
-  -- : Contains (K1.intersect K2) c := by
-  -- induction K1 generalizing K2
-  -- case empty => cases hc1.not_empty .empty
-  -- case union ha hb =>
-  --   simp
-  --   cases hc1
-  --   apply! union_l (ha _ hc2)
-  --   apply! union_r (hb _ hc2)
-  -- case node r1 ex1 =>
diff --git a/Capless/Classifier/Basic.lean b/Capless/Classifier/Basic.lean
new file mode 100644
index 00000000..2ab4a574
--- /dev/null
+++ b/Capless/Classifier/Basic.lean
@@ -0,0 +1,67 @@
+import Capless.Classifier.Semantics
+import Capless.Classifier.Subkind
+import Capless.Classifier.Intersection
+
+namespace Capless
+
+theorem Kind.Intersect.with_subkind
+  (hs : K1.Subkind K2)
+  : (intersect L K1).Subkind (intersect L K2) := by
+  rw [Subkind.semantics] at *
+  have h1 := Intersect.lawful L K1
+  have h2 := Intersect.lawful L K2
+  apply! Intersect.with_ssubkind_l
+
+theorem Kind.Intersect.with_subkind_r
+  (hs : K1.Subkind K2)
+  : (intersect K1 L).Subkind (intersect K2 L) := by
+  rw [Subkind.semantics] at *
+  have h1 := Intersect.lawful K1 L
+  have h2 := Intersect.lawful K2 L
+  apply! Intersect.with_ssubkind_r
+
+theorem Kind.Intersect.subkind_l
+  : (intersect K L).Subkind K := by
+  rw [Subkind.semantics]
+  have h := Intersect.lawful K L
+  apply h.is_ssubkind_l
+
+theorem Kind.Intersect.subkind_r
+  : (intersect K L).Subkind L := by
+  rw [Subkind.semantics]
+  have h := Intersect.lawful K L
+  apply h.is_ssubkind_r
+
+theorem Kind.Subkind.reorder_union_4 : Subkind ((A ++ B) ++ (C ++ D)) ((A ++ C) ++ (B ++ D)) := by
+  apply union_l
+  . apply union_l
+    . apply trans .union_rl .union_rl
+    . apply trans .union_rl .union_rr
+  . apply union_l
+    . apply trans .union_rr .union_rl
+    . apply trans .union_rr .union_rr
+
+theorem Kind.Intersect.union_r_subkind : Subkind (.intersect K (L1 ++ L2)) ((K.intersect L1) ++ (K.intersect L2)) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have hi := Intersect.lawful K (L1 ++ L2)
+  have hi1 := Intersect.lawful K L1
+  have hi2 := Intersect.lawful K L2
+  have ⟨h1, h2⟩ := hi.contains_inv hc
+  cases h2.append_inv <;> rename_i h2
+  . apply Contains.append_r; apply hi1.contains h1 h2
+  . apply Contains.append_l; apply hi2.contains h1 h2
+
+theorem Kind.Intersect.union_r_superkind : Subkind ((K.intersect L1) ++ (K.intersect L2)) (.intersect K (L1 ++ L2)) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have hi := Intersect.lawful K (L1 ++ L2)
+  have hi1 := Intersect.lawful K L1
+  have hi2 := Intersect.lawful K L2
+  cases hc.append_inv <;> rename_i hc
+  . have ⟨hc1, hc2⟩ := hi1.contains_inv hc
+    apply contains hi hc1 (.append_r hc2)
+  . have ⟨hc1, hc2⟩ := hi2.contains_inv hc
+    apply contains hi hc1 (.append_l hc2)
+
+end Capless
diff --git a/Capless/Classifier/Intersection.lean b/Capless/Classifier/Intersection.lean
index 95d3c15d..8f80a4eb 100644
--- a/Capless/Classifier/Intersection.lean
+++ b/Capless/Classifier/Intersection.lean
@@ -45,10 +45,10 @@ theorem Subtree.Intersect.lawful : Intersect s t (s.intersect t) := by
 def Kind.intersect (k : Kind) (l : Kind) : Kind :=
   List.flatMap (fun x => List.flatMap (fun y => x.intersect y) l) k
 
-def Kind.intersect.cons_l : intersect (x :: xs) K = intersect [x] K ++ intersect xs K := by simp
-def Kind.intersect.append_l : intersect (xs1 ++ xs2) K = intersect xs1 K ++ intersect xs2 K := by simp
-def Kind.intersect.cons_r : intersect [x] (y :: ys) = intersect [x] [y] ++ intersect [x] ys := by simp
-def Kind.intersect.append_r : intersect [x] (ys1 ++ ys2) = intersect [x] ys1 ++ intersect [x] ys2 := by simp
+theorem Kind.intersect.cons_l : intersect (x :: xs) K = intersect [x] K ++ intersect xs K := by simp
+theorem Kind.intersect.append_l : intersect (xs1 ++ xs2) K = intersect xs1 K ++ intersect xs2 K := by simp
+theorem Kind.intersect.cons_r : intersect [x] (y :: ys) = intersect [x] [y] ++ intersect [x] ys := by simp
+theorem Kind.intersect.append_r : intersect [x] (ys1 ++ ys2) = intersect [x] ys1 ++ intersect [x] ys2 := by simp
 
 theorem Kind.Intersect.lawful' : Intersect [x] L (.intersect [x] L) := by
   induction L
@@ -59,11 +59,11 @@ theorem Kind.Intersect.lawful' : Intersect [x] L (.intersect [x] L) := by
     . apply singleton .lawful
     . simp at ih; apply ih
 
-theorem Kind.Intersect.lawful : Intersect K L (K.intersect L) := by
+theorem Kind.Intersect.lawful (K L : Kind) : Intersect K L (K.intersect L) := by
   induction K generalizing L
   case nil => simp; apply empty_l
   case cons x xs ih =>
-    apply append_l _ ih
+    apply append_l _ (ih _)
     have h := lawful' (x:=x) (L:=L)
     simp_all
 
diff --git a/Capless/Classifier/Semantics.lean b/Capless/Classifier/Semantics.lean
index f1400b00..dad0eb03 100644
--- a/Capless/Classifier/Semantics.lean
+++ b/Capless/Classifier/Semantics.lean
@@ -1,4 +1,5 @@
 import Capless.Classifier.Subtract
+import Capless.Classifier.Intersection
 
 namespace Capless
 
@@ -39,10 +40,50 @@ theorem Subtree.Contains.implies_root (hc : Contains a c) : Contains a a.root :=
       . apply incl hx.antisymm ih
       . apply incl hx.not_subclass ih
 
+theorem Subtree.Contains.not_subclass (hs : ¬ a.Subclass r) : ¬ Contains (mk r exs) a := by
+  intro h
+  apply hs h.subclass_of_root
+
+theorem Subtree.Contains.strictSub_root (hs : r.StrictSub a) : ¬ Contains (mk r exs) a := not_subclass hs.antisymm
+theorem Subtree.Contains.disjoint_root (hd : a.Disjoint r) : ¬ Contains (mk r exs) a := not_subclass hd.not_subclass
+
+theorem Subtree.Contains.excl_subclass (hs : c.Subclass a) : ¬ Contains (mk r (a :: exs)) c := by
+  intro h; cases h; simp_all
+
+theorem Subtree.Contains.not_cons_excl (hs : ¬ Contains (mk r exs) a) : ¬ Contains (mk r (x :: exs)) a := by
+  intro h; cases h; simp_all
+
+theorem Subtree.Contains.weaken_root (hc : Contains a c) (hs : a.root.Subclass r') : Contains (mk r' a.excls) c := by
+  induction hc
+  case sub hsub => apply sub (hsub.trans hs)
+  case incl nhs hc ih =>
+    apply incl nhs
+    apply! ih
+
+theorem Subtree.Contains.append_excl (hc1 : Contains (mk r ex1) c) (hc2 : Contains (mk r ex2) c) : Contains (mk r $ ex1 ++ ex2) c := by
+  induction ex1 generalizing ex2
+  case nil => simp_all
+  case cons x xs ih =>
+    cases hc1
+    apply! incl _ (ih _ _)
+
+theorem Subtree.Contains.append_excl_inv (hc : Contains (mk r (ex1 ++ ex2)) c) : Contains (mk r ex1) c ∧ Contains (mk r ex2) c := by
+  induction ex1 generalizing ex2
+  case nil =>
+    simp_all; apply sub hc.subclass_of_root
+  case cons x xs ih =>
+    cases hc
+    rename_i hc1 hc2
+    have ⟨ih1, ih2⟩ := ih hc2
+    apply And.intro (.incl hc1 ih1) ih2
+
 inductive Kind.Contains : Kind -> Classifier -> Prop where
   | here : t.Contains x -> Contains (t :: ts) x
   | there : Contains ts x -> Contains (t :: ts) x
 
+theorem Kind.Contains.not_cons (hc1 : ¬ t.Contains x) (hc2 : ¬ Contains ts x) : ¬ Contains (t :: ts) x := by
+  intro h; cases h <;> aesop
+
 instance Kind.Contains.decidable : Decidable (Contains k c) := by
   cases k
   case nil => apply isFalse; intro h; cases h
@@ -55,6 +96,43 @@ instance Kind.Contains.decidable : Decidable (Contains k c) := by
       case isFalse hNotThere =>
         apply isFalse; intro h; cases h <;> aesop
 
+theorem Kind.Contains.is_singleton (hc : Contains [t] x) : t.Contains x := by
+  cases hc
+  case here => aesop
+  case there hc => cases hc
+
+theorem Kind.Contains.append_l (hc : Contains as x) : Contains (bs ++ as) x := by
+  induction bs
+  case nil => simp_all
+  case cons => rw [List.cons_append]; apply! Contains.there
+
+theorem Kind.Contains.append_r (hc : Contains as x) : Contains (as ++ bs) x := by
+  induction as
+  case nil => cases hc
+  case cons b bs ih =>
+    cases hc
+    case here => apply! here
+    case there => apply there; apply! ih
+
+theorem Kind.Contains.append_inv (hc : Contains (as ++ bs) x) : Contains as x ∨ Contains bs x := by
+  induction as generalizing bs
+  case nil => simp_all
+  case cons a as ih =>
+    cases hc
+    case here => left; apply! here
+    case there hc =>
+      cases ih hc <;> rename_i ih
+      . left; apply! there
+      . aesop
+
+theorem Kind.Contains.not_append (hc1 : ¬ Contains as x) (hc2 : ¬ Contains bs x) :  ¬ Contains (as ++ bs) x := by
+  intro h; cases h.append_inv <;> aesop
+
+theorem Kind.Contains.not_append_inv (hc : ¬ Contains (as ++ bs) x) : ¬ Contains as x ∧ ¬ Contains bs x := by
+  have h : ¬ (Contains as x ∨ Contains bs x) := by
+    intro h; cases h; apply! hc (append_r _); apply! hc (append_l _)
+  simp_all
+
 -- Semantic empty
 @[simp]
 def Subtree.SEmpty (s : Subtree) : Prop := ∀ x, ¬ s.Contains x
@@ -109,6 +187,17 @@ theorem Kind.SEmpty.is_empty : SEmpty k ↔ IsEmpty k := by
       case here hc => apply hsc _ hc
       case there => apply! ih
 
+theorem Subtree.Contains.refine_root
+  (hc : Contains a c)
+  (hsub1 : x.Subclass a.root)
+  (hsub2 : c.Subclass x)
+  : Contains (mk x a.excls) c := by
+  induction hc
+  case sub => apply! sub
+  case incl r exs c a nhs hc ih =>
+    simp_all
+    apply! incl
+
 theorem Subtree.Subtract.contains_or
   (hs : Subtract a b R1)
   (hca : a.Contains c)
@@ -123,9 +212,240 @@ theorem Subtree.Subtract.contains_or
     cases ih hca <;> rename_i ih
     . left; apply Contains.incl; apply (hd.refines_subclass_l ih.subclass_of_root).not_subclass; assumption
     . aesop
+  case excl_subclass_r r1 ex1 r2 ex2 _ a hsa2 hsa1 hs ih =>
+    cases ih hca <;> rename_i ih
+    . cases Decidable.em (c.Subclass a)
+      . right; apply Kind.Contains.here
+        apply! Contains.refine_root hca hsa1
+      . left; apply! Contains.incl
+    . right; apply! Kind.Contains.there
+  case excl_subclass_l hsa2 hss1 => right; apply! Kind.Contains.here
+  case excl_irrelevant_l hsa1 hd1 hs ih =>
+    cases ih hca <;> rename_i ih
+    . left; constructor; apply (hd1.refines_subclass_l hca.subclass_of_root).not_subclass; apply ih
+    . aesop
+
+theorem Subtree.Subtract.contains_inv
+  (hs : Subtract a b R1)
+  (hca : R1.Contains c)
+  : a.Contains c ∧ ¬ b.Contains c := by
+  induction hs
+  case tree r1 ex1 r2 =>
+    cases hca.is_singleton
+    apply And.intro; assumption; apply! Contains.not_subclass
+  case excl_absurd_r hss =>
+    apply And.intro hca.is_singleton
+    intro h; cases h
+    case incl nhs h => have hss' := (hss.subclass_l h.subclass_of_root).weaken; simp_all
+  case excl_irrelevant_r hd hs ih =>
+    have ⟨ih1, ih2⟩ := ih hca
+    apply And.intro ih1
+    apply! Contains.not_cons_excl
   case excl_subclass_r hsa2 hsa1 hs ih =>
-    cases ih hca
-    .
+    cases hca
+    case here hca => apply And.intro (hca.weaken_root hsa1); apply Contains.excl_subclass hca.subclass_of_root
+    case there hca =>
+      have ⟨ih1, ih2⟩ := ih hca
+      apply And.intro ih1
+      apply! Contains.not_cons_excl
+  case excl_subclass_l hsa2 hss1 =>
+    apply And.intro hca.is_singleton
+    apply Contains.excl_subclass
+    apply hca.is_singleton.subclass_of_root.trans hss1.weaken
+  case excl_irrelevant_l hsa2 hd1 hs ih =>
+    have ⟨ih1, ih2⟩ := ih hca
+    apply And.intro ih1
+    apply! Contains.not_cons_excl
+
+theorem Kind.Subtract.contains_or'
+  (hs : Subtract A [b] R1)
+  (hc : A.Contains c)
+  : b.Contains c ∨ R1.Contains c := by
+  induction A generalizing R1
+  case nil => cases hs; cases hc
+  case cons a as ih =>
+    have ⟨Rh, Rt, _, hh, ht⟩ := hs.cons_l_split
+    simp_all
+    cases hc
+    case here hc =>
+      cases hh.is_singleton.contains_or hc; aesop
+      right; apply! Contains.append_r
+    case there hc =>
+      cases ih ht hc; aesop
+      right; apply! Contains.append_l
+
+theorem Kind.Subtract.contains_or
+  (hs : Subtract A B R1)
+  (hc : A.Contains c)
+  : B.Contains c ∨ R1.Contains c := by
+  induction B generalizing A R1
+  case nil => cases hs; simp_all
+  case cons b bs ih =>
+    cases bs
+    case nil =>
+      cases hs.contains_or' hc
+      . left; apply! Contains.here
+      . aesop
+    case cons b' bs =>
+      have ⟨R', ha, hb⟩ := hs.union_r_inv
+      cases ha.contains_or' hc <;> rename_i hca
+      . left; apply! Contains.here
+      . cases ih hb hca <;> rename_i ih
+        . left; apply! Contains.there
+        . aesop
+
+theorem Kind.Subtract.contains_inv'
+  (hs :  Subtract A [b] R1)
+  (hc : R1.Contains c)
+  : A.Contains c ∧ ¬ b.Contains c := by
+  induction A generalizing R1
+  case nil => cases hs; cases hc
+  case cons a as ih =>
+    have ⟨Rh, Rt, _, hh, ht⟩ := hs.cons_l_split
+    subst_vars
+    cases hc.append_inv <;> rename_i hc
+    . have ⟨h1, h2⟩ := hh.is_singleton.contains_inv hc
+      apply And.intro (.here h1) h2
+    . have ⟨h1, h2⟩ := ih ht hc
+      apply And.intro (.there h1) h2
+
+theorem Kind.Subtract.contains_inv
+  (hs : Subtract A B R1)
+  (hc : R1.Contains c)
+  : A.Contains c ∧ ¬ B.Contains c := by
+  induction B generalizing A R1
+  case nil => cases hs; apply And.intro hc; intro h; cases h
+  case cons b bs ih =>
+    cases bs
+    case nil => have ⟨h1, h2⟩ := hs.contains_inv' hc; apply And.intro h1; intro h; simp_all [h.is_singleton]
+    case cons b' bs =>
+      have ⟨R', ha, hb⟩ := hs.union_r_inv
+      have ⟨h1, h2⟩ := ih hb hc
+      have ⟨h3, h4⟩ := ha.contains_inv' h1
+      apply And.intro h3; apply! Contains.not_cons
+
+/-- Semantic subkinding. -/
+def Kind.SSubkind (a b : Kind) : Prop := ∀ c, a.Contains c -> b.Contains c
+
+theorem Kind.Subtract.is_empty_is_subkind
+  (hs : Subtract A B R)
+  : R.IsEmpty ↔ SSubkind A B := by
+  apply Iff.intro <;> intro h
+  . intro c hc
+    rw [← SEmpty.is_empty] at h
+    cases hs.contains_or hc <;> rename_i hc
+    . exact hc
+    . cases h c hc
+  . rw [← SEmpty.is_empty]
+    intro c hc
+    have ⟨h1, h2⟩ := hs.contains_inv hc
+    simp_all [h c h1]
+
+theorem Kind.SSubkind.rfl : SSubkind A A := by intro c h; simp_all
+
+theorem Kind.SSubkind.trans (hs1 : SSubkind A B) (hs2 : SSubkind B C) : SSubkind A C := by
+  intro c hc
+  apply hs2
+  apply hs1
+  apply hc
+
+/-- Semantics of intersection -/
+
+theorem Subtree.Intersect.contains
+  (hi : Intersect a b R)
+  (hc1 : a.Contains c)
+  (hc2 : b.Contains c)
+  : R.Contains c := by
+  induction hi
+  case subtree_l hs =>
+    apply Kind.Contains.here
+    apply hc1.append_excl (hc2.refine_root hs hc1.subclass_of_root)
+  case subtree_r hs =>
+    apply Kind.Contains.here
+    apply (hc1.refine_root hs hc2.subclass_of_root).append_excl hc2
+  case disjoint hd =>
+    cases ((hd.refines_subclass_l hc1.subclass_of_root).refines_subclass_r hc2.subclass_of_root).not_subclass .rfl
+
+theorem Subtree.Intersect.contains_inv
+  (hi : Intersect a b R)
+  (hc : R.Contains c)
+  : a.Contains c ∧ b.Contains c := by
+  induction hi
+  case subtree_l hs =>
+    have ⟨h1, h2⟩ := hc.is_singleton.append_excl_inv
+    apply And.intro h1 (h2.weaken_root hs)
+  case subtree_r hs =>
+    have ⟨h1, h2⟩ := hc.is_singleton.append_excl_inv
+    apply And.intro (h1.weaken_root hs) h2
+  case disjoint hd => cases hc
+
+theorem Kind.Intersect.contains
+  (hi : Intersect A B R)
+  (hc1 : A.Contains c)
+  (hc2 : B.Contains c)
+  : R.Contains c := by
+  induction hi
+  case empty_l => cases hc1
+  case empty_r => cases hc2
+  case append_l ha hb iha ihb =>
+    cases hc1
+    case here hc1 => apply Contains.append_r; apply! iha (.here _)
+    case there hc1 => apply Contains.append_l; apply! ihb
+  case append_r ha hb iha ihb =>
+    cases hc2
+    case here hc2 => apply Contains.append_r; apply! iha _ (.here _)
+    case there hc2 => apply Contains.append_l; apply! ihb
+  case singleton hi => apply hi.contains hc1.is_singleton hc2.is_singleton
+
+theorem Kind.Intersect.contains_inv
+  (hi : Intersect A B R)
+  (hc : R.Contains c)
+  : A.Contains c ∧ B.Contains c := by
+  induction hi
+  case empty_l => cases hc
+  case empty_r => cases hc
+  case append_l ha hb iha ihb =>
+    cases hc.append_inv <;> rename_i hc
+    . have ⟨h1, h2⟩ := iha hc
+      apply And.intro (.here h1.is_singleton) h2
+    . have ⟨h1, h2⟩ := ihb hc
+      apply And.intro (.there h1) h2
+  case append_r ha hb iha ihb =>
+    cases hc.append_inv <;> rename_i hc
+    . have ⟨h1, h2⟩ := iha hc
+      apply And.intro h1 (.here h2.is_singleton)
+    . have ⟨h1, h2⟩ := ihb hc
+      apply And.intro h1 (.there h2)
+  case singleton hi =>
+    have ⟨h1, h2⟩ := hi.contains_inv hc
+    apply And.intro <;> apply! Contains.here
+
+theorem Kind.Intersect.is_ssubkind_l
+  (hi : Intersect A B R)
+  : SSubkind R A := by
+  intro c hc; simp_all [hi.contains_inv hc]
+
+theorem Kind.Intersect.is_ssubkind_r
+  (hi : Intersect A B R)
+  : SSubkind R B := by
+  intro c hc; simp_all [hi.contains_inv hc]
+
+theorem Kind.Intersect.with_ssubkind_l
+  (hs : SSubkind A B)
+  (hi1 : Intersect L A R1)
+  (hi2 : Intersect L B R2)
+  : R1.SSubkind R2 := by
+  intro c hc
+  have ⟨h1, h2⟩ := hi1.contains_inv hc
+  apply hi2.contains h1 (hs c h2)
 
+theorem Kind.Intersect.with_ssubkind_r
+  (hs : SSubkind A B)
+  (hi1 : Intersect A L R1)
+  (hi2 : Intersect B L R2)
+  : R1.SSubkind R2 := by
+  intro c hc
+  have ⟨h1, h2⟩ := hi1.contains_inv hc
+  apply hi2.contains (hs c h1) h2
 
 end Capless
diff --git a/Capless/Classifier/Subkind.lean b/Capless/Classifier/Subkind.lean
index afc6bea3..19eaadb3 100644
--- a/Capless/Classifier/Subkind.lean
+++ b/Capless/Classifier/Subkind.lean
@@ -1,4 +1,5 @@
 import Capless.Classifier.Subtract
+import Capless.Classifier.Semantics
 
 namespace Capless
 
@@ -10,5 +11,63 @@ theorem Kind.Subkind.empty_r_inv (hs : Subkind K1 K2) (he : IsEmpty K2) : IsEmpt
   cases hs
   apply! Subtract.empty_r_inv
 
+/-- Subtract-defined subkinding agrees with semantic subkinding. -/
+theorem Kind.Subkind.semantics : Subkind A B ↔ SSubkind A B := by
+  apply Iff.intro <;> intro h
+  . cases h
+    rename_i h he
+    simp_all [← h.is_empty_is_subkind]
+  . have ⟨R, h⟩ := Subtract.exists A B
+    apply subtract h
+    simp_all [h.is_empty_is_subkind]
+
+theorem Kind.Subkind.rfl : Subkind A A := by apply semantics.mpr SSubkind.rfl
+theorem Kind.Subkind.trans (ha : Subkind A B) (hb : Subkind B C) : Subkind A C := by
+  rw [semantics] at *
+  apply! SSubkind.trans
+
+theorem Kind.Subkind.of_top : Subkind A .top := by
+  rw [semantics]
+  intro c hc
+  exact .here (.sub .of_top)
+
+theorem Kind.Subkind.of_empty
+  (hs : Subkind K L)
+  (he : L.IsEmpty)
+  : K.IsEmpty := by
+  cases hs
+  case subtract hs he1 => apply! hs.empty_r_inv
+
+theorem Kind.Subkind.union_rl : Subkind K (K ++ L) := by
+  rw [semantics]
+  intro c hc
+  apply! Contains.append_r
+theorem Kind.Subkind.union_rr : Subkind L (K ++ L) := by
+  rw [semantics]
+  intro c hc
+  apply! Contains.append_l
+
+theorem Kind.Subkind.union_l (ha : Subkind K1 L) (hb : Subkind K2 L) : Subkind (K1 ++ K2) L := by
+  rw [semantics] at *
+  intro c hc
+  cases hc.append_inv <;> rename_i hc
+  . apply ha c hc
+  . apply hb c hc
+
+theorem Kind.Subkind.join
+  (hs1 : Subkind K1 L1)
+  (hs2 : Subkind K2 L2)
+  : Subkind (K1 ++ K2) (L1 ++ L2) := by
+  apply union_l
+  apply trans hs1 .union_rl
+  apply trans hs2 .union_rr
+
+theorem Kind.Subkind.is_empty_l
+  (he : IsEmpty K)
+  : Subkind K L := by
+  rw [semantics]
+  rw [← SEmpty.is_empty] at he
+  intro c hc
+  cases he c hc
 
 end Capless
diff --git a/Capless/Classifier/Subtract.lean b/Capless/Classifier/Subtract.lean
index c56380c2..f233969a 100644
--- a/Capless/Classifier/Subtract.lean
+++ b/Capless/Classifier/Subtract.lean
@@ -647,44 +647,6 @@ theorem Kind.Subtract.is_empty_cons_r
     . apply! hp1.is_empty_cons_r'
     . apply! ih
 
--- theorem Kind.Subtract.is_empty_cons_inj_right
---   (hs1 : Subtract K L R1)
---   (he1 : R1.IsEmpty)
---   (hs2 : Subtract (a :: K) (a :: L) R2)
---   : R2.IsEmpty := by
---   have ⟨Raa, haa⟩ := Subtree.Subtract.exists a a
---   have hae := haa.rfl
---   cases hs1
---   case empty_r =>
---     cases hs2
---     rename_i h1 h2
---     apply IsEmpty.append
---     . apply h1.rfl
---     . apply! h2.is_empty_l
---   case union_l ha hb =>
---     have ⟨he2, he3⟩ := he1.append_inv
---     have ⟨Rh, Rt, _, hh, ht⟩ := hs2.cons_l_split
---     subst_vars
---     apply IsEmpty.append
---     . cases hh
---       rename_i hh1 hh2
---       apply Subtract.is_empty_l hh2 hh1.is_singleton.rfl
---     . have ⟨Rt1, Rt2, _, ht1, ht2⟩ := ht.cons_l_split
---       subst_vars
---       apply IsEmpty.append
---       . apply (Subtract.singleton ha).is_empty_cons_r he2 ht1
---       . apply hb.is_empty_cons_r he3 ht2
---   case union_r y R1 y' ys ha hb =>
---     have ⟨Rp, Rt, _, hp, ht⟩ := ha.cons_l_split
---     subst_vars
---     have ⟨Rp1, Rt1, _, hp1, ht1⟩ := hb.append_l_split
---     subst_vars
---     apply IsEmpty.append
---     . apply hp1.is_empty_l hp.is_singleton.rfl
---     . have ⟨R', h'⟩ := Subtract.exists (y' :: ys) (y' :: ys)
---       apply is_empty_cons_r h' h'.rfl (.union_r ht ht1)
-
-
 theorem Kind.Subtract.rfl (hs : Subtract K K R) : R.IsEmpty := by
   cases hs
   case empty_r => constructor
@@ -910,157 +872,10 @@ theorem Kind.Subtract.is_empty_trans''
     . apply hh1.is_singleton.is_empty_trans he1h hs2 he2 hh3.is_singleton
     . apply! ih
 
--- (A - B) - C = 0 -> B - C = 0 -> A - C = 0
-theorem Subtree.Subtract.is_empty_cons_r_inv
-  (hs1 : Subtract a b R1)
-  (hs2 : R1.Subtract [c] R2)
-  (he2 : R2.IsEmpty)
-  (hs3 : Subtract b c R3)
-  (he3 : R3.IsEmpty)
-  (hs4 : Subtract a c R4)
-  : R4.IsEmpty := by sorry
-
-theorem Kind.Subtract.is_empty_cons_r_inv'
-  (hs1 : Subtract A [b] R1)
-  (hs2 : R1.Subtract [c] R2)
-  (he2 : R2.IsEmpty)
-  (hs3 : b.Subtract c R3)
-  (he3 : R3.IsEmpty)
-  (hs4 : A.Subtract [c] R4)
-  : R4.IsEmpty := by
-  induction A generalizing R1 R2 R3 R4
-  case nil => cases hs4; constructor
-  case cons a as ih =>
-    have ⟨R1h, R1t, _, hh1, ht1⟩ := hs1.cons_l_split
-    have ⟨R4h, R4t, _, hh4, ht4⟩ := hs4.cons_l_split
-    subst_vars
-    have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.append_l_split
-    subst_vars
-    have ⟨he2h, he2t⟩ := he2.append_inv
-    apply IsEmpty.append
-    . apply hh1.is_singleton.is_empty_cons_r_inv hh2 he2h hs3 he3 hh4.is_singleton
-    . apply! ih
-
 theorem Kind.Subtract.union_r_inv
   (hs : Subtract A (b :: b' :: bs) R)
   : ∃ R1, Subtract A [b] R1 ∧ Subtract R1 (b' :: bs) R := by
   cases hs
   aesop
 
-theorem Kind.Subtract.is_empty_cons_r_inv
-  (hs1 : Subtract A B R1)
-  (hs2 : R1.Subtract [c] R2)
-  (he2 : R2.IsEmpty)
-  (hs3 : Subtract B [c] R3)
-  (he3 : R3.IsEmpty)
-  (hs4 : A.Subtract [c] R4)
-  : R4.IsEmpty := by
-  induction B generalizing A R1 R2 R3 R4
-  case nil => cases hs3; cases hs1; cases hs4.inj hs2; simp_all
-  case cons b bs ih =>
-    cases bs
-    case nil => apply! is_empty_cons_r_inv' hs1 hs2 he2 hs3.is_singleton
-    case cons b' bs =>
-    have ⟨R1', hs1a, hs1b⟩ := hs1.union_r_inv
-    have ⟨R3h, R3t, _, hh3, ht3⟩ := hs3.cons_l_split
-    subst_vars
-    have ⟨he3h, he3t⟩ := he3.append_inv
-    have ⟨R1'c, h1'c⟩ := Subtract.exists R1' [c]
-    have he1' := ih hs1b hs2 he2 ht3 he3t h1'c
-    apply is_empty_cons_r_inv' hs1a h1'c he1' hh3.is_singleton he3h hs4
-
--- Generalize C instead of B
--- theorem Kind.Subtract.is_empty_cons_r_inv
---   (hs1 : Subtract A [b] R1)
---   (hs2 : R1.Subtract C R2)
---   (he2 : R2.IsEmpty)
---   (hs3 : Subtract [b] C R3)
---   (he3 : R3.IsEmpty)
---   (hs4 : A.Subtract C R4)
---   : R4.IsEmpty := by
---   induction C generalizing A R1 R2 R3 R4
---   case nil => cases hs4; cases hs2; cases hs3; apply! hs1.empty_r_inv
---   case cons z zs ih =>
-
---     sorry
-
-theorem Kind.Subtract.is_empty_trans'
-  (hs1 : Subtract A B R1)
-  (he1 : R1.IsEmpty)
-  (hs2 : Subtract B [c] R2)
-  (he2 : R2.IsEmpty)
-  (hs3 : Subtract A [c] R3)
-  : R3.IsEmpty := by
-  induction B generalizing A R1 R2 R3
-  case nil => cases hs1; apply! hs3.is_empty_l
-  case cons b bs ih =>
-    cases bs
-    case nil => apply hs1.is_empty_trans'' he1 hs2.is_singleton he2 hs3
-    case cons b' bs =>
-      cases hs1
-      rename_i R1' hs1a hs1b
-      have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.cons_l_split
-      simp_all
-      have ⟨he2h, he2t⟩ := he2.append_inv
-      have ⟨R1'', h1''⟩ := Subtract.exists R1' [c]
-      have he1'' := ih hs1b he1 ht2 he2t h1''
-      apply is_empty_cons_r_inv hs1a h1'' he1'' hh2 he2h hs3
-
--- A - B = 0 -> (A - C) - (B - C) = 0
--- theorem Subtree.Subtract.is_empty_subtract_both_sides
---   (hs1: Subtract a b R1)
---   (he1 : R1.IsEmpty)
---   (hs2 : Subtract a c R2)
---   (hs3 : Subtract b c R3)
---   (hs4 : R2.Subtract R3 R4)
---   : R4.IsEmpty := by sorry
-
--- theorem Kind.Subtract.is_empty_subtract_both_sides'
---   (hs1 : Subtract A [b] R1)
---   (he1 : R1.IsEmpty)
---   (hs2 : Subtract A [c] R2)
---   (hs3 : b.Subtract c R3)
---   (hs4 : R2.Subtract R3 R4)
---   : R4.IsEmpty := by
---   induction A generalizing R1 R2 R3 R4
---   case nil => cases hs1; cases hs2; cases hs4.empty_l_inv; constructor
---   case cons a as ih =>
---     have ⟨R1h, R1t, _, hh1, ht1⟩ := hs1.cons_l_split
---     have ⟨R2h, R2t, _, hh2, ht2⟩ := hs2.cons_l_split
---     subst_vars
---     have ⟨R4h, R4t, _, hh4, ht4⟩ := hs4.append_l_split
---     subst_vars
---     have ⟨he1h, he1t⟩ := he1.append_inv
---     apply IsEmpty.append
---     . apply hh1.is_singleton.is_empty_subtract_both_sides he1h hh2.is_singleton hs3 hh4
---     . apply! ih
-
--- theorem Kind.Subtract.is_empty_subtract_both_sides
---   (hs1 : Subtract A B R1)
---   (he1 : R1.IsEmpty)
---   (hs2 : Subtract A [c] R2)
---   (hs3 : Subtract B [c] R3)
---   (hs4 : Subtract R2 R3 R4)
---   : R4.IsEmpty := by
---   induction B generalizing A R1 R2 R3 R4
---   case nil => cases hs3.empty_l_inv; cases hs4; cases hs1; cases hs3; apply! hs2.is_empty_l
---   case cons b bs ih =>
---     cases bs
---     case nil => apply hs1.is_empty_subtract_both_sides' he1 hs2 hs3.is_singleton hs4
---     case cons b' bs =>
---       have ⟨R1', hs1a, hs1b⟩ := hs1.union_r_inv
---       have ⟨R3h, R3t, _, hh3, ht3⟩ := hs3.cons_l_split
---       subst_vars
-
-
--- -- theorem Kind.Subtract.is_empty_trans
--- --   (hs1 : Subtract A B R1)
--- --   (he1 : R1.IsEmpty)
--- --   (hs2 : Subtract B C R2)
--- --   (he2 : R2.IsEmpty)
--- --   (hs3 : Subtract A C R3)
--- --   : R3.IsEmpty := by
-
-
-
 end Capless

From e9f4f60b2b8d3246b11c2da2a3c59f0b2f9b3f3e Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 25 Dec 2025 04:06:09 +0100
Subject: [PATCH 62/71] ReachSet is okay now

---
 Capless/CaptureSet.lean               |  32 ++---
 Capless/Classifier/Basic.lean         |  24 ++++
 Capless/Classifier/Core.lean          |   4 +
 Capless/Classifier/Disjoint.lean      |  43 +++++++
 Capless/Classifier/Kind.lean          |  12 ++
 Capless/Classifier/Semantics.lean     |  18 +++
 Capless/Subcapturing.lean             |   2 +-
 Capless/Subcapturing/Basic.lean       |  84 ++++---------
 Capless/Subcapturing/CaptureKind.lean | 170 +++++++++++++++++++++++--
 Capless/WellScoped/Basic.lean         | 174 ++++++++++++++++++++------
 10 files changed, 426 insertions(+), 137 deletions(-)
 create mode 100644 Capless/Classifier/Disjoint.lean

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index a8d88616..05c1de54 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -3,6 +3,7 @@ import Mathlib.Data.Finset.Image
 import Mathlib.Data.Finset.PImage
 import Capless.Basic
 import Capless.Classifier
+import Capless.Classifier.Intersection
 import Capless.Tactics
 namespace Capless
 
@@ -47,7 +48,7 @@ theorem CaptureSet.proj_top {C : CaptureSet n k} : C.proj .top = C := by
   induction C
   case empty => aesop
   case union ha hb => aesop
-  case singleton => simp; apply Kind.Intersect.top_r
+  case singleton => unfold proj; simp only [Kind.intersect.top_r]
 
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
@@ -81,7 +82,7 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
   K.IsEmpty ->
   Subset (.singleton s K) .empty
 | proj_merge:
-  Subset (.singleton s (.union L1 L2)) (.union (.singleton s L1) (.singleton s L2))
+  Subset (.singleton s (L1 ++ L2)) (.union (.singleton s L1) (.singleton s L2))
 | trans : Subset A B -> Subset B C -> Subset A C
 
 @[simp]
@@ -154,7 +155,7 @@ theorem CaptureSet.Subset.absurd {C : CaptureSet n k} (he : K.IsEmpty) : Subset
   case union ha hb =>
     apply trans (.union_monotone ha hb)
     apply union_l .rfl .rfl
-  case singleton => simp; apply singleton_absurd; apply Kind.Intersect.is_empty_r he
+  case singleton => unfold proj; apply singleton_absurd; apply Kind.intersect.is_empty_r he
 
 /-!
 ## Renaming operations
@@ -402,25 +403,10 @@ theorem CaptureSet.Subset.proj_l : Subset (C.proj K) C := by
   case union ha hb => simp; apply! union_monotone
   case singleton => apply singleton_subkind; apply Kind.Intersect.subkind_l
 
-theorem CaptureSet.Subset.proj_proj_intersect {C : CaptureSet n k}: Subset ((C.proj K).proj L) (C.proj (K.intersect L)) := by
-  induction C
-  case empty => simp; constructor
-  case union ha hb => simp; apply! union_monotone
-  case singleton =>
-    apply singleton_subkind
-    apply Kind.Intersect.assoc_subkind
-
-theorem CaptureSet.Subset.proj_intersect_proj {C : CaptureSet n k}: Subset (C.proj (K.intersect L)) ((C.proj K).proj L) := by
-  induction C
-  case empty => simp; constructor
-  case union ha hb => simp; apply! union_monotone
-  case singleton =>
-    apply singleton_subkind
-    apply Kind.Intersect.assoc_superkind
-
-theorem CaptureSet.Subset.proj_intersect {C : CaptureSet n k}: C.proj (K.intersect L) = (C.proj K).proj L := by
+theorem CaptureSet.proj_proj {C : CaptureSet n k}: ((C.proj K).proj L) = (C.proj (K.intersect L)) := by
   induction C
   case empty => simp
-  case union ha hb => simp_all
-  case singleton =>
-    simp [Kind.Intersect.assoc]
+  case union ha hb iha ihb =>
+    simp only [CaptureSet.proj]
+    rw [iha, ihb]
+  case singleton => simp only [CaptureSet.proj]; rw [Kind.intersect.assoc]
diff --git a/Capless/Classifier/Basic.lean b/Capless/Classifier/Basic.lean
index 2ab4a574..488650a8 100644
--- a/Capless/Classifier/Basic.lean
+++ b/Capless/Classifier/Basic.lean
@@ -1,6 +1,7 @@
 import Capless.Classifier.Semantics
 import Capless.Classifier.Subkind
 import Capless.Classifier.Intersection
+import Capless.Classifier.Disjoint
 
 namespace Capless
 
@@ -64,4 +65,27 @@ theorem Kind.Intersect.union_r_superkind : Subkind ((K.intersect L1) ++ (K.inter
   . have ⟨hc1, hc2⟩ := hi2.contains_inv hc
     apply contains hi hc1 (.append_l hc2)
 
+theorem Kind.Intersect.subkind_self : Subkind A (.intersect A A) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have hi := Intersect.lawful A A
+  apply! hi.contains
+
+theorem Kind.Intersect.is_empty_repeat (he : IsEmpty (.intersect A (.intersect B A))) : IsEmpty (.intersect B A) := by
+  rw [← SEmpty.is_empty] at *
+  intro c hc
+  apply he c
+  have hi := Intersect.lawful B A
+  have hi' := Intersect.lawful A (.intersect B A)
+  have ⟨_, _⟩ := hi.contains_inv hc
+  apply! hi'.contains
+
+theorem Kind.Intersect.subkind_symm : Subkind (.intersect A B) (.intersect B A) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have ha := Intersect.lawful A B
+  have hb := Intersect.lawful B A
+  have ⟨_, _⟩ := ha.contains_inv hc
+  apply! hb.contains
+
 end Capless
diff --git a/Capless/Classifier/Core.lean b/Capless/Classifier/Core.lean
index 38f86b8d..0ba0b009 100644
--- a/Capless/Classifier/Core.lean
+++ b/Capless/Classifier/Core.lean
@@ -313,6 +313,10 @@ theorem Classifier.disjoint_is_Disjoint {a b : Classifier} : Disjoint a b ↔ a.
             assumption
 termination_by sizeOf a + sizeOf b
 
+instance Classifier.Disjoint.decidable : Decidable (Disjoint a b) := by
+  cases h : a.disjoint b
+  case true => apply isTrue; rw [disjoint_is_Disjoint]; exact h
+  case false => apply isFalse; rw[disjoint_is_Disjoint]; simp [h]
 
 /-- Same as `subclass_or_disjoint`, but with the functions. -/
 theorem Classifier.subclass_or_disjoint' (a b : Classifier) : a.subclass b ∨ b.subclass a ∨ a.disjoint b := by
diff --git a/Capless/Classifier/Disjoint.lean b/Capless/Classifier/Disjoint.lean
new file mode 100644
index 00000000..627fbf2e
--- /dev/null
+++ b/Capless/Classifier/Disjoint.lean
@@ -0,0 +1,43 @@
+import Capless.Classifier.Kind
+import Capless.Classifier.Intersection
+import Capless.Classifier.Semantics
+
+namespace Capless
+
+/-- Two subtrees are disjoint if they do not share any common nodes. -/
+inductive Kind.Disjoint : Kind -> Kind -> Prop where
+  | intersect : Intersect K L R -> R.IsEmpty -> Disjoint K L
+
+/-- Decides whether two Kinds are disjoint. -/
+def Kind.disjoint (a b : Kind) :=  (IsEmpty.decidable (K:=a.intersect b)).decide
+
+theorem Kind.Disjoint.empty_intersect : IsEmpty (K.intersect L) ↔ Disjoint K L := by
+  apply Iff.intro <;> intro h
+  . apply intersect (Intersect.lawful _ _) h
+  . cases h
+    rename_i h1 h2
+    rw [← SEmpty.is_empty] at *
+    intro c hc
+    have hi' := Intersect.lawful K L
+    have ⟨_, _⟩ := hi'.contains_inv hc
+    apply h2 c
+    apply! h1.contains
+
+/-- Proves that `disjoint` follows derivation. -/
+theorem Kind.disjoint.lawful : Disjoint K L ↔ disjoint K L := by
+  rw [disjoint, decide_eq_true_iff]
+  exact Disjoint.empty_intersect.symm
+
+theorem Kind.disjoint.symm (hs : disjoint K L) : disjoint L K := by
+  rw [← lawful] at *
+  cases hs
+  rename_i h1 h2
+  have h := Intersect.lawful L K
+  apply Disjoint.intersect h
+  rw [← SEmpty.is_empty] at *
+  intro c hc
+  apply h2 c
+  have ⟨_, _⟩ := h.contains_inv hc
+  apply! h1.contains
+
+end Capless
diff --git a/Capless/Classifier/Kind.lean b/Capless/Classifier/Kind.lean
index 6cb5de78..7c925601 100644
--- a/Capless/Classifier/Kind.lean
+++ b/Capless/Classifier/Kind.lean
@@ -11,6 +11,7 @@ namespace Capless
 structure Subtree : Type where
   root  : Classifier
   excls : List Classifier
+deriving DecidableEq
 
 /-- A classifier filter : a list of filtered subtree. -/
 def Kind : Type := List Subtree
@@ -94,6 +95,17 @@ inductive Kind.IsEmpty : Kind -> Prop where
   | empty : IsEmpty []
   | absurd : ContainsSupOf exs r -> IsEmpty xs -> IsEmpty (Subtree.mk r exs :: xs)
 
+instance Kind.IsEmpty.decidable : Decidable (IsEmpty K) := by
+  cases K
+  case nil => apply isTrue .empty
+  case cons x xs =>
+    cases ContainsSupOf.decidable (xs:=x.excls) (a:=x.root)
+    case isFalse => apply isFalse; intro h; cases h; simp_all
+    cases decidable (K:=xs)
+    case isFalse => apply isFalse; intro h; cases h; simp_all
+    rename_i h1 h2
+    apply isTrue (.absurd h1 h2)
+
 theorem Kind.IsEmpty.node (hsc : ContainsSupOf exs r) : IsEmpty [.mk r exs] := absurd hsc .empty
 
 /-- If a `node` is empty, it is absurd. -/
diff --git a/Capless/Classifier/Semantics.lean b/Capless/Classifier/Semantics.lean
index dad0eb03..03d6b971 100644
--- a/Capless/Classifier/Semantics.lean
+++ b/Capless/Classifier/Semantics.lean
@@ -448,4 +448,22 @@ theorem Kind.Intersect.with_ssubkind_r
   have ⟨h1, h2⟩ := hi1.contains_inv hc
   apply hi2.contains (hs c h1) h2
 
+theorem Kind.intersect.is_empty_r
+  (he : IsEmpty L)
+  : IsEmpty (.intersect K L) := by
+  rw [← SEmpty.is_empty] at *
+  have h := Intersect.lawful K L
+  intro c hc
+  have ⟨h1, h2⟩ := h.contains_inv hc
+  apply he c h2
+
+theorem Kind.intersect.is_empty_l
+  (he : IsEmpty K)
+  : IsEmpty (.intersect K L) := by
+  rw [← SEmpty.is_empty] at *
+  have h := Intersect.lawful K L
+  intro c hc
+  have ⟨h1, h2⟩ := h.contains_inv hc
+  apply he c h1
+
 end Capless
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 81868bd9..3a9a3050 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -48,7 +48,7 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Subcapt Γ {c=c|L} (C.proj L)
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
 -- ^^^ would be interesting to prove, but seems really hard to crack
--- | absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
+| absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index f41fd6ca..3e89840d 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -57,6 +57,11 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro <;> apply! trans _ (.cinstl hb)
   case union =>
     injections; subst_vars; apply And.intro <;> assumption
+  case proj_r hk =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply And.intro
+    . apply! trans (.proj_r _) (.subset $ .union_rl .rfl)
+    . apply! trans (.proj_r _) (.subset $ .union_rr .rfl)
   case absurd he hk =>
     have ⟨_, _⟩ := hk.union_l_inv
     apply And.intro <;> apply! absurd
@@ -70,11 +75,11 @@ theorem CaptureKind.var_top (hb : Γ.Bound x S^C) (hs : CaptureKind Γ C K) : Ca
   apply! var
 
 theorem CaptureKind.label_top (hb : Γ.LBound x c S) : CaptureKind Γ {x=x|.top} (.node c []) := by
-  rw [← Kind.Intersect.top_r (K:=.node c [])]
+  rw [← Kind.intersect.top_r (K:=.node c [])]
   apply label hb
 
 theorem CaptureKind.cvar_top (hb : Γ.CBound c (.bound (.kind K))) : CaptureKind Γ {c=c|.top} K := by
-  rw [← Kind.Intersect.top_r (K:=K)]
+  rw [← Kind.intersect.top_r (K:=K)]
   apply cvar hb
 
 theorem CaptureKind.cbound_top (hb : Γ.CBound c (.bound (.upper C))) (hs : CaptureKind Γ C K) : CaptureKind Γ {c=c|.top} K := by
@@ -105,74 +110,31 @@ theorem Subcapt.cbound_top (hb : Γ.CBound c (.bound (.upper C))) : Subcapt Γ {
   rw [CaptureSet.proj_top] at h
   exact h
 
-theorem Subcapt.proj_proj_intersect : Subcapt Γ (.proj (.proj C K1) K2) (C.proj (K1.intersect K2)) := by
-  induction C
-  case empty => simp; apply rfl
-  case union ih1 ih2 =>
-    simp
-    apply! join
-  case singleton =>
-    simp
-    apply singleton_subkind Kind.Intersect.assoc_subkind
-
-theorem Subcapt.proj_intersect_proj : Subcapt Γ (C.proj (K1.intersect K2)) (.proj (.proj C K1) K2) := by
-  induction C
-  case empty => simp; apply rfl
-  case union ih1 ih2 =>
-    simp
-    apply! join
-  case singleton =>
-    simp
-    apply singleton_subkind Kind.Intersect.assoc_superkind
-
 -- Connections between subkinding and subcapturing
 
-
-theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
-  induction hk generalizing L
-  case var hb hk ih =>
-    apply var hb
-    apply subcapt ih .proj_intersect_proj
-  case label hb =>
-    simp
-    apply sub Kind.Intersect.assoc_superkind (label hb)
-  case cvar hb =>
-    simp
-    apply sub Kind.Intersect.assoc_superkind $ cvar hb
-  case cbound hb hk ih =>
-    apply cbound hb
-    apply subcapt ih .proj_intersect_proj
-  case cinstr hb hk ih =>
-    apply cinstr hb
-    apply subcapt ih .proj_intersect_proj
-  case sub hs hk ih =>
-    apply sub (Kind.Intersect.with_subkind_r hs) ih
-  case empty => apply empty
-  case singleton_absurd he hk =>
-    apply singleton_absurd
-    apply Kind.Intersect.is_empty_l hk
-  case union ha hb => apply union ha hb
-
-theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
-  rw [← Kind.Intersect.top_l (K:=L)]
-  rw [← CaptureSet.proj, Kind.Intersect.top_l]
-  apply hk.apply_proj
-
 theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj K) := by
   induction hs generalizing K
   case trans ha hb => apply trans ha hb
   case subset => apply! subset $ .proj _
   case union ha hb => apply union ha hb
   case var hb =>
-    simp
-    apply trans (var hb) .proj_intersect_proj
+    simp [-Kind.intersect, CaptureSet.proj_proj]
+    apply! var
   case cinstl hb =>
-    apply trans .proj_proj_intersect
-    apply cinstl hb
+    rw [CaptureSet.proj_proj, CaptureSet.proj]
+    apply! cinstl
   case cinstr hb =>
-    apply trans (cinstr hb) .proj_intersect_proj
+    simp [-Kind.intersect, CaptureSet.proj_proj]
+    apply! cinstr
   case cbound hb =>
-    apply trans (cbound hb) .proj_intersect_proj
+    simp [-Kind.intersect, CaptureSet.proj_proj]
+    apply! cbound
+  case proj_r hk =>
+    apply trans
+    . apply proj_r (.sub Kind.Intersect.subkind_l hk.apply_proj)
+    . simp only [CaptureSet.proj_proj]
+      apply subset (.subkind _)
+      apply Kind.Intersect.subkind_symm
   case absurd hk he =>
     simp
     apply absurd _ he
@@ -180,6 +142,6 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     apply Kind.Intersect.subkind_l
 
 theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
-  rw [← Kind.Intersect.top_l (K:=K)]
-  rw [← CaptureSet.proj, Kind.Intersect.top_l]
+  rw [← Kind.intersect.top_l (K:=K)]
+  rw [← CaptureSet.proj, Kind.intersect.top_l]
   apply! apply_proj
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index 10b64410..7a6243de 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -26,7 +26,7 @@ theorem CaptureKind.subkind_proj
     apply Kind.Intersect.with_subkind hs
   case label hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     apply sub
     apply (Kind.Intersect.with_subkind (Kind.Intersect.with_subkind hs))
     apply! label
@@ -70,8 +70,8 @@ theorem CaptureKind.subkind_singleton
   (hs : CaptureKind Γ (.singleton s K2) K)
   (hsub : K1.Subkind K2)
   : CaptureKind Γ (.singleton s K1) K := by
-  rw [← Kind.Intersect.top_l (K:=K2)] at hs
-  rw [← Kind.Intersect.top_l (K:=K1)]
+  rw [← Kind.intersect.top_l (K:=K2)] at hs
+  rw [← Kind.intersect.top_l (K:=K1)]
   rw [← CaptureSet.proj] at hs
   rw [← CaptureSet.proj]
   apply! subkind_proj
@@ -169,11 +169,11 @@ theorem CaptureKind.proj_merge
   (hk2 : CaptureKind Γ (.proj C K2) L2)
   (hs1 : L1.Subkind L)
   (hs2 : L2.Subkind L)
-  : CaptureKind Γ (.proj C (K1.union K2)) L := by
+  : CaptureKind Γ (.proj C (K1 ++ K2)) L := by
   generalize h : C.proj K1 = D at hk1
   induction hk1 generalizing C K1 K2
   case var x _ _ _ K hb hk1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
     obtain ⟨rfl, rfl⟩ := h
     rename_i p
     cases hk2.var_lookup_inv hb
@@ -184,7 +184,7 @@ theorem CaptureKind.proj_merge
     case inr he =>
       apply sub hs1
       apply var hb
-      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+      have hsub : Kind.Subkind (p.intersect (K1 ++ K2)) (p.intersect K1) := by
         apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
         apply Kind.Subkind.union_l .rfl
         apply Kind.Subkind.is_empty_l he
@@ -231,7 +231,7 @@ theorem CaptureKind.proj_merge
     case inr he =>
       apply sub hs1
       apply cbound hb
-      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+      have hsub : Kind.Subkind (p.intersect (K1 ++ K2)) (p.intersect K1) := by
         apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
         apply Kind.Subkind.union_l .rfl
         apply Kind.Subkind.is_empty_l he
@@ -248,7 +248,7 @@ theorem CaptureKind.proj_merge
     case inr he =>
       apply sub hs1
       apply cinstr hb
-      have hsub : Kind.Subkind (p.intersect (K1.union K2)) (p.intersect K1) := by
+      have hsub : Kind.Subkind (p.intersect (K1 ++ K2)) (p.intersect K1) := by
         apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
         apply Kind.Subkind.union_l .rfl
         apply Kind.Subkind.is_empty_l he
@@ -279,11 +279,11 @@ theorem CaptureKind.proj_merge
 theorem CaptureKind.proj_merge_singleton
   (hs1 : CaptureKind Γ (.singleton s K1) K)
   (hs2 : CaptureKind Γ (.singleton s K2) K)
-  : CaptureKind Γ (.singleton s (K1.union K2)) K := by
-  rw [← Kind.Intersect.top_l (K:=K1)] at hs1
-  rw [← Kind.Intersect.top_l (K:=K2)] at hs2
+  : CaptureKind Γ (.singleton s (K1 ++ K2)) K := by
+  rw [← Kind.intersect.top_l (K:=K1)] at hs1
+  rw [← Kind.intersect.top_l (K:=K2)] at hs2
   rw [← CaptureSet.proj] at hs1 hs2
-  rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
+  rw [← Kind.intersect.top_l (K:=K1 ++ K2), ← CaptureSet.proj]
   exact proj_merge hs1 hs2 .rfl .rfl
 
 theorem CaptureKind.subset
@@ -314,7 +314,54 @@ theorem CaptureKind.absurd {C : CaptureSet n k}
   induction C
   case empty => apply empty
   case union ha hb => apply! union
-  case singleton => apply singleton_absurd $ Kind.Intersect.is_empty_r he
+  case singleton => apply singleton_absurd $ Kind.intersect.is_empty_r he
+
+theorem CaptureKind.proj_r
+  (hk1 : CaptureKind Γ C K)
+  (hk2 : CaptureKind Γ (C.proj K) L)
+  : CaptureKind Γ C L := by
+  induction hk1 generalizing L
+  case var hb hk1 ih =>
+    apply var hb
+    rw [CaptureSet.proj_proj] at ih
+    cases hk2.var_lookup_inv hb <;> rename_i hk2
+    . apply ih hk2
+    . apply ih $ .absurd hk2
+  case label hb =>
+    apply sub _ (.label hb)
+    cases hk2.label_lookup_inv hb <;> rename_i hk2
+    . rw [← Kind.intersect.assoc] at hk2
+      apply Kind.Subkind.trans _ hk2
+      apply Kind.Intersect.subkind_self
+    . have hk2 := Kind.Intersect.is_empty_repeat hk2
+      apply Kind.Subkind.is_empty_l hk2
+  case cvar hb =>
+    apply sub _ (.cvar hb)
+    cases hk2.ckind_lookup_inv hb <;> rename_i hk2
+    . rw [← Kind.intersect.assoc] at hk2
+      apply Kind.Subkind.trans _ hk2
+      apply Kind.Intersect.subkind_self
+    . have hk2 := Kind.Intersect.is_empty_repeat hk2
+      apply Kind.Subkind.is_empty_l hk2
+  case cbound hb hk ih =>
+    apply cbound hb
+    rw [CaptureSet.proj_proj] at ih
+    cases hk2.cbound_lookup_inv hb <;> rename_i hk2
+    . apply ih hk2
+    . apply ih $ .absurd hk2
+  case cinstr hb hk ih =>
+    apply cinstr hb
+    rw [CaptureSet.proj_proj] at ih
+    cases hk2.cinst_lookup_inv hb <;> rename_i hk2
+    . apply ih hk2
+    . apply ih $ .absurd hk2
+  case sub hsk hk ih =>
+    apply ih $ hk2.subkind_proj hsk
+  case empty => apply empty
+  case singleton_absurd he => apply! singleton_absurd
+  case union ha hb iha ihb =>
+    have ⟨_, _⟩ := hk2.union_l_inv
+    apply! union (iha _) (ihb _)
 
 theorem CaptureKind.subcapt
   (hk : CaptureKind Γ C2 K)
@@ -335,4 +382,101 @@ theorem CaptureKind.subcapt
     case singleton_absurd he => apply! absurd
   case cinstr => apply! cinstr
   case cbound => apply! cbound
+  case proj_r hk1 => apply! proj_r
   case absurd hk1 he => apply sub _ hk1; apply Kind.Subkind.is_empty_l he
+
+theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
+  induction hk generalizing L
+  case var hb hk ih =>
+    simp [-Kind.intersect, CaptureSet.proj_proj] at ih
+    apply var hb ih
+  case label hb =>
+    rw [Kind.intersect.assoc]
+    apply label hb
+  case cvar hb =>
+    rw [Kind.intersect.assoc]
+    apply! cvar
+  case cbound hb hk ih =>
+    simp [-Kind.intersect, CaptureSet.proj_proj] at ih
+    apply! cbound hb ih
+  case cinstr hb hk ih =>
+    simp [-Kind.intersect, CaptureSet.proj_proj] at ih
+    apply! cinstr hb ih
+  case sub hs hk ih =>
+    apply sub (Kind.Intersect.with_subkind_r hs) ih
+  case empty => apply empty
+  case singleton_absurd he hk =>
+    apply singleton_absurd
+    apply Kind.intersect.is_empty_l hk
+  case union ha hb => apply union ha hb
+
+theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
+  rw [← Kind.intersect.top_l (K:=L)]
+  rw [← CaptureSet.proj, Kind.intersect.top_l]
+  apply hk.apply_proj
+
+private theorem Kind.elim_middle_intersect : Subkind (.intersect A (.intersect B C)) (.intersect A C) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have h1 := Intersect.lawful A (B.intersect C)
+  have h2 := Intersect.lawful A C
+  have h3 := Intersect.lawful B C
+  have ⟨_, hr⟩ := h1.contains_inv hc
+  have ⟨_, _⟩ := h3.contains_inv hr
+  apply! h2.contains
+
+private theorem Kind.elim_last_repeat : Subkind (.intersect A B) (.intersect (.intersect A B) B) := by
+  rw [Subkind.semantics]
+  intro c hc
+  have h1 := Intersect.lawful A B
+  have h2 := Intersect.lawful (.intersect A B) B
+  have ⟨_, _⟩ := h1.contains_inv hc
+  apply! h2.contains
+
+theorem CaptureKind.intersect_with_proj' {C : CaptureSet n k} (hk : CaptureKind Γ (C.proj K) L) : CaptureKind Γ (C.proj K) (L.intersect K) := by
+  generalize h : C.proj K = D at hk
+  induction hk generalizing C K
+  case var hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply var hb
+    apply sub Kind.elim_middle_intersect $ ih (.refl _)
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply sub _ $ label hb
+    simp only [← Kind.intersect.assoc]
+    apply Kind.elim_last_repeat
+  case cvar hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply sub _ $ cvar hb
+    simp only [← Kind.intersect.assoc]
+    apply Kind.elim_last_repeat
+  case cbound hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply cbound hb
+    apply sub Kind.elim_middle_intersect $ ih (.refl _)
+  case cinstr hb hk ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply cinstr hb
+    apply sub Kind.elim_middle_intersect $ ih (.refl _)
+  case sub hsk hk ih =>
+    subst_vars
+    apply sub _ (ih $ .refl _)
+    apply Kind.Intersect.with_subkind_r hsk
+  case empty => apply empty
+  case singleton_absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply! singleton_absurd
+  case union ha hb iha ihb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply union (iha $ .refl _) (ihb $ .refl _)
+
+theorem CaptureKind.intersect_with_proj {C : CaptureSet n k} (hk : CaptureKind Γ (C.proj K) L) : CaptureKind Γ (C.proj K) (K.intersect L) := by
+  apply sub _ (intersect_with_proj' hk)
+  apply Kind.Intersect.subkind_symm
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 27dd2d66..d453cdca 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -26,27 +26,27 @@ theorem ReachSet.proj_empty {C : CaptureSet n k}
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply ih _ (.refl _)
-    apply Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r he
   case cinstr hb hr ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply ih _ (.refl _)
-    apply Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r he
   case cbound hb hr ih =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply ih _ (.refl _)
-    apply Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r he
   case ckind =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply CaptureSet.Subset.singleton_absurd
-    apply Kind.Intersect.is_empty_r $ Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
   case label =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     apply CaptureSet.Subset.singleton_absurd
-    apply Kind.Intersect.is_empty_r $ Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
   case absurd =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -68,7 +68,7 @@ theorem ReachSet.proj_absurd {C : CaptureSet n k}
     exists .empty
     apply And.intro .empty
     apply absurd
-    apply Kind.Intersect.is_empty_r he
+    apply Kind.intersect.is_empty_r he
 
 theorem ReachSet.inj
   (hr1 : ReachSet Γ C R1)
@@ -99,12 +99,12 @@ theorem ReachSet.inj
     case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
     case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
     case ckind hb2 => cases Context.cbound_injective hb1 hb2; constructor
-    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.Intersect.is_empty_r _)
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
   case label hb1 =>
     cases hr2
     case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
     case label hb2 => cases Context.lbound_inj hb1 hb2; subst_vars; constructor
-    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.Intersect.is_empty_r _)
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
   case absurd => constructor
 
 
@@ -147,8 +147,8 @@ theorem ReachSet.subkind {C : CaptureSet n k}
     apply And.intro _ (ckind hb)
     apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
   case label hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     apply Exists.intro
     apply And.intro _ (label hb)
     apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
@@ -164,14 +164,14 @@ theorem ReachSet.singleton_subkind
   (hk : K.Subkind L)
   (hr : ReachSet Γ (.singleton s L) R2)
   : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (.singleton s K) R1 := by
-  rw [← Kind.Intersect.top_l (K:=L), ← CaptureSet.proj] at hr
-  rw [← Kind.Intersect.top_l (K:=K), ← CaptureSet.proj]
+  rw [← Kind.intersect.top_l (K:=L), ← CaptureSet.proj] at hr
+  rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj]
   apply! subkind
 
 theorem ReachSet.proj_merge' {C : CaptureSet n k}
   (hr1 : ReachSet Γ (C.proj L1) R1)
   (hr2 : ReachSet Γ (C.proj L2) R2)
-  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (C.proj (L1.union L2)) R := by
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (C.proj (L1 ++ L2)) R := by
   generalize h : C.proj L1 = D at hr1
   induction hr1 generalizing C L1 L2 R2
   case empty =>
@@ -192,8 +192,8 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       . apply CaptureSet.Subset.union_l (.union_rl $ .union_rr .rfl) (.union_rr $ .union_rr .rfl)
     . apply! union
   case var C _ _ _ hb hr1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     cases hr2
     case var hb2 hr2 =>
       cases Context.bound_injective hb hb2
@@ -209,8 +209,8 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       exists R
       apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.var hb h)
   case cinstr C _ _ hb hr1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     cases hr2
     case cinstr hb2 hr2 =>
       cases Context.cbound_injective hb hb2
@@ -227,8 +227,8 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       exists R
       apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cinstr hb h)
   case cbound C _ _ hb hr1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
     case cbound hb2 hr2 =>
@@ -245,14 +245,14 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       exists R
       apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cbound hb h)
   case ckind c K _ hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     cases hr2
     case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
     case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
     case ckind p _ hb2 =>
       cases Context.cbound_injective hb hb2
-      exists {c=c| K.intersect (p.intersect (.union L1 L2))}
+      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
       apply And.intro
       . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
         apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
@@ -260,7 +260,7 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       . apply! ckind
     case absurd he =>
       rename_i p
-      exists {c=c| K.intersect (p.intersect (.union L1 L2))}
+      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
       apply And.intro
       . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
         apply Kind.Intersect.with_subkind
@@ -268,14 +268,14 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       . apply! ckind
 
   case label x _ _ _ hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     cases hr2
     case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
     case label p c _ hb2 =>
       cases Context.lbound_inj hb hb2
       subst_vars
-      exists {x=x| (Kind.classifier c).intersect (p.intersect (.union L1 L2))}
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
       apply And.intro
       . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
         apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
@@ -283,17 +283,17 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       . apply! label
     case absurd he =>
       rename_i c _ _ p
-      exists {x=x| (Kind.classifier c).intersect (p.intersect (.union L1 L2))}
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
       apply And.intro
       . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
         apply Kind.Intersect.with_subkind
         apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
       . apply! label
   case absurd he =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     rename_i p
-    have h0 : (p.intersect (L1.union L2)).Subkind (p.intersect L2) := by
+    have h0 : (p.intersect (L1 ++ L2)).Subkind (p.intersect L2) := by
       apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
       apply Kind.Subkind.union_l (.is_empty_l he) .rfl
     have ⟨R, hs, h⟩ := hr2.singleton_subkind h0
@@ -304,10 +304,10 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
 theorem ReachSet.proj_merge
   (hr1 : ReachSet Γ (.singleton s L1) R1)
   (hr2 : ReachSet Γ (.singleton s L2) R2)
-  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (.singleton s (L1.union L2)) R := by
-  rw [← Kind.Intersect.top_l (K:=L1), ← CaptureSet.proj] at hr1
-  rw [← Kind.Intersect.top_l (K:=L2), ← CaptureSet.proj] at hr2
-  rw [← Kind.Intersect.top_l (K:=(L1.union L2)), ← CaptureSet.proj]
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (.singleton s (L1 ++ L2)) R := by
+  rw [← Kind.intersect.top_l (K:=L1), ← CaptureSet.proj] at hr1
+  rw [← Kind.intersect.top_l (K:=L2), ← CaptureSet.proj] at hr2
+  rw [← Kind.intersect.top_l (K:=(L1 ++ L2)), ← CaptureSet.proj]
   apply! proj_merge'
 
 theorem ReachSet.subset
@@ -345,7 +345,6 @@ theorem ReachSet.subset
     cases hr1
     apply! proj_merge
 
-
 theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
   (hk : CaptureKind Γ C K)
   (he : K.IsEmpty)
@@ -380,6 +379,91 @@ theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
     apply And.intro (.union_l hsa hsb)
     apply! union
 
+theorem ReachSet.proj_r
+  (hk : CaptureKind Γ C K)
+  (hr2 : ReachSet Γ (C.proj K) R2)
+  : ∃ R ⊆ R2, ReachSet Γ C R := by
+  induction hk generalizing R2
+  case var hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case var hb2 hr2 =>
+      cases Context.bound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! var
+    case label hb2 => cases Context.bound_lbound_absurd hb hb2
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! var
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro _ (.label hb)
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
+    case label hb2 =>
+      cases Context.lbound_inj hb hb2; subst_vars
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case absurd he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cvar c C K hb =>
+    exists {c=c|C.intersect K}
+    apply And.intro _ (.ckind hb)
+    cases hr2
+    case ckind hb2 =>
+      cases Context.cbound_injective hb hb2
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case absurd x c _ K he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cbound hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cbound
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cbound
+  case cinstr hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cinstr
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cinstr
+  case sub hsk hk ih =>
+    have ⟨R3, h3, hr3⟩ := subkind hsk hr2
+    have ⟨R, h, ih⟩ := ih hr3
+    exists R
+    apply And.intro (.trans h h3) ih
+  case empty => cases hr2; exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he =>
+    exists .empty; apply And.intro .empty (.absurd he)
+  case union ha hb iha ihb =>
+    cases hr2
+    rename_i ha2 hb2
+    have ⟨R1, h1, ih1⟩ := iha ha2
+    have ⟨R2, h2, ih2⟩ := ihb hb2
+    exists R1 ∪ R2
+    apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
+
 theorem ReachSet.subcapt
   (hr2 : ReachSet Γ C2 R2)
   (hs : Subcapt Γ C1 C2)
@@ -405,6 +489,7 @@ theorem ReachSet.subcapt
     case absurd _ he => apply! proj_absurd
   case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
   case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
+  case proj_r hk => apply! proj_r
   case absurd hk he =>
     cases hr2
     apply capture_kind_absurd hk he
@@ -418,8 +503,19 @@ theorem ReachSet.is_subcapt
   case var hb hr ih => apply Subcapt.trans (.var hb) ih
   case cinstr hb hr ih => apply Subcapt.trans (.cinstr hb) ih
   case cbound hb hr ih => apply Subcapt.trans (.cbound hb) ih
-  case ckind =>
-    -- apply Subcapt.
+  case ckind L hb =>
+    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
+    rw [← CaptureSet.proj]
+    apply Subcapt.proj_r
+    apply CaptureKind.sub Kind.Intersect.subkind_l (.cvar hb)
+  case label hb =>
+    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
+    rw [← CaptureSet.proj]
+    apply Subcapt.proj_r
+    apply CaptureKind.sub Kind.Intersect.subkind_l (.label hb)
+  case absurd =>
+    apply! Subcapt.absurd (.singleton_absurd _)
+
 
 
 -- theorem WellScoped.subkind

From dddf638b55248ed9948271f9201184be77098f06 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 25 Dec 2025 15:38:56 +0100
Subject: [PATCH 63/71] WellScoped should be set

---
 Capless/Classifier/Basic.lean    |  37 ++
 Capless/Classifier/Disjoint.lean |  34 +-
 Capless/Store.lean               |   1 +
 Capless/WellScoped/Basic.lean    | 911 ++++++-------------------------
 Capless/WellScoped/ReachSet.lean | 513 +++++++++++++++++
 5 files changed, 747 insertions(+), 749 deletions(-)
 create mode 100644 Capless/WellScoped/ReachSet.lean

diff --git a/Capless/Classifier/Basic.lean b/Capless/Classifier/Basic.lean
index 488650a8..8eca0876 100644
--- a/Capless/Classifier/Basic.lean
+++ b/Capless/Classifier/Basic.lean
@@ -88,4 +88,41 @@ theorem Kind.Intersect.subkind_symm : Subkind (.intersect A B) (.intersect B A)
   have ⟨_, _⟩ := ha.contains_inv hc
   apply! hb.contains
 
+-- Disjointness and Subkinding
+
+theorem Kind.Disjoint.refine_subkind_l
+  (hd : Disjoint K2 L)
+  (hs : K1.Subkind K2)
+  : Disjoint K1 L := by
+  rw [← Disjoint.empty_intersect, ← SEmpty.is_empty, Subkind.semantics] at *
+  intro c hc
+  apply hd c
+  have h2 := Intersect.lawful K2 L
+  have h1 := Intersect.lawful K1 L
+  have ⟨hc1, _⟩ := h1.contains_inv hc
+  have hc2 := hs c hc1
+  apply! h2.contains
+
+theorem Kind.disjoint.refine_subkind_l (hd : disjoint K2 L) (hs : K1.Subkind K2) : disjoint K1 L := by
+  rw [← disjoint.lawful] at *; apply! Disjoint.refine_subkind_l
+
+theorem Kind.Disjoint.refine_subkind_r
+  (hd : Disjoint L K2)
+  (hs : K1.Subkind K2)
+  : Disjoint L K1 := by
+  apply symm; apply! hd.symm.refine_subkind_l
+
+theorem Kind.disjoint.refine_subkind_r (hd : disjoint L K2) (hs : K1.Subkind K2) : disjoint L K1 := by
+  rw [← disjoint.lawful] at *; apply! Disjoint.refine_subkind_r
+
+theorem Kind.Disjoint.and_subkind (hd : Disjoint K L) (hs : K.Subkind L) : K.IsEmpty := by
+  rw [← Disjoint.empty_intersect, Subkind.semantics, ← SEmpty.is_empty] at *
+  intro c hc
+  apply hd c
+  have hi := Intersect.lawful K L
+  apply hi.contains hc (hs c hc)
+
+theorem Kind.Disjoint.with_self (hd : Disjoint K K) : K.IsEmpty := by
+  apply hd.and_subkind .rfl
+
 end Capless
diff --git a/Capless/Classifier/Disjoint.lean b/Capless/Classifier/Disjoint.lean
index 627fbf2e..8525522c 100644
--- a/Capless/Classifier/Disjoint.lean
+++ b/Capless/Classifier/Disjoint.lean
@@ -28,8 +28,7 @@ theorem Kind.disjoint.lawful : Disjoint K L ↔ disjoint K L := by
   rw [disjoint, decide_eq_true_iff]
   exact Disjoint.empty_intersect.symm
 
-theorem Kind.disjoint.symm (hs : disjoint K L) : disjoint L K := by
-  rw [← lawful] at *
+theorem Kind.Disjoint.symm (hs : Disjoint K L) : Disjoint L K := by
   cases hs
   rename_i h1 h2
   have h := Intersect.lawful L K
@@ -40,4 +39,35 @@ theorem Kind.disjoint.symm (hs : disjoint K L) : disjoint L K := by
   have ⟨_, _⟩ := h.contains_inv hc
   apply! h1.contains
 
+theorem Kind.disjoint.symm (hs : disjoint K L) : disjoint L K := by
+  rw [← lawful] at *
+  apply! Disjoint.symm
+
+theorem Kind.Disjoint.union_l (hd1 : Disjoint K1 L) (hd2 : Disjoint K2 L) : Disjoint (K1 ++ K2) L := by
+  rw [← empty_intersect, ← SEmpty.is_empty] at *
+  intro c hc
+  have h1 := Intersect.lawful K1 L
+  have h2 := Intersect.lawful K2 L
+  have h12 := Intersect.lawful (K1 ++ K2) L
+  have ⟨hc12, _⟩ := h12.contains_inv hc
+  cases hc12.append_inv
+  . apply hd1 c; apply! h1.contains
+  . apply hd2 c; apply! h2.contains
+
+theorem Kind.Disjoint.is_empty_l (he : IsEmpty K) : Disjoint K L := by
+  rw [← empty_intersect, ← SEmpty.is_empty] at *
+  intro c hc
+  apply he c
+  have h := Intersect.lawful K L
+  have ⟨_, _⟩ := h.contains_inv hc
+  assumption
+
+theorem Kind.Disjoint.is_empty_r (he : IsEmpty L) : Disjoint K L := by
+  rw [← empty_intersect, ← SEmpty.is_empty] at *
+  intro c hc
+  apply he c
+  have h := Intersect.lawful K L
+  have ⟨_, _⟩ := h.contains_inv hc
+  assumption
+
 end Capless
diff --git a/Capless/Store.lean b/Capless/Store.lean
index d93ecbdc..d98b6c86 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -217,6 +217,7 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
   Context.LBound Γ x c S ->
   Kind.Disjoint L (.classifier c) ->
   WellScoped Γ cont {x=x|L}
+| absurd : K.IsEmpty -> WellScoped Γ cont (.singleton s K) -- empty-projected singletons are useless, so they are always well-scoped
 
 /-- Typecheck a continuation stack. `TypedCont Γ Ein cont Eout C` means that threading a input of type `Ein` with ambiant captures `Cin`
     through the continuation stack results in an output of type `Eout`,
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index d453cdca..d203074d 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -11,781 +11,198 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
-theorem ReachSet.proj_empty {C : CaptureSet n k}
-  (hr : ReachSet Γ (C.proj K) R)
-  (he : K.IsEmpty)
-  : R ⊆ .empty := by
-  generalize h : C.proj K = D at hr
-  induction hr generalizing C K
-  case empty => constructor
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply CaptureSet.Subset.union_l (ha he (.refl _)) (hb he (.refl _))
-  case var hb hr ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply ih _ (.refl _)
-    apply Kind.intersect.is_empty_r he
-  case cinstr hb hr ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply ih _ (.refl _)
-    apply Kind.intersect.is_empty_r he
-  case cbound hb hr ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply ih _ (.refl _)
-    apply Kind.intersect.is_empty_r he
-  case ckind =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply CaptureSet.Subset.singleton_absurd
-    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
-  case label =>
-    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    apply CaptureSet.Subset.singleton_absurd
-    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
-  case absurd =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    constructor
-
-theorem ReachSet.proj_absurd {C : CaptureSet n k}
-  (he : K.IsEmpty)
-  : ∃ R, R ⊆ .empty ∧ ReachSet Γ (C.proj K) R := by
-  induction C
-  case empty => exists .empty; apply And.intro .empty .empty
-  case union ha hb =>
-    have ⟨Ra, hsa, ha⟩ := ha
-    have ⟨Rb, hbs, hb⟩ := hb
-    exists Ra ∪ Rb
-    apply And.intro
-    apply! CaptureSet.Subset.union_l
-    apply! union
-  case singleton =>
-    exists .empty
-    apply And.intro .empty
-    apply absurd
-    apply Kind.intersect.is_empty_r he
-
-theorem ReachSet.inj
-  (hr1 : ReachSet Γ C R1)
-  (hr2 : ReachSet Γ C R2)
-  : R1 ⊆ R2 := by
-  induction hr1 generalizing R2
-  case empty => apply CaptureSet.Subset.empty
-  case union ha hb => cases hr2; apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
-  case var hb1 hr1 ih =>
-    cases hr2
-    case var hb2 hr2 => cases Context.bound_injective hb1 hb2; apply! ih
-    case label hb2 => cases Context.bound_lbound_absurd hb1 hb2
-    case absurd he => apply! hr1.proj_empty
-  case cinstr hb1 hr1 ih =>
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
-    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
-    case ckind hb2 => cases Context.cbound_injective hb1 hb2
-    case absurd he => apply! hr1.proj_empty
-  case cbound hb1 hr1 ih =>
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
-    case ckind hb2 => cases Context.cbound_injective hb1 hb2
-    case absurd he => apply! hr1.proj_empty
-  case ckind hb1 =>
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
-    case ckind hb2 => cases Context.cbound_injective hb1 hb2; constructor
-    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
-  case label hb1 =>
-    cases hr2
-    case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
-    case label hb2 => cases Context.lbound_inj hb1 hb2; subst_vars; constructor
-    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
-  case absurd => constructor
-
-
-theorem ReachSet.subkind {C : CaptureSet n k}
-  (hk : K.Subkind L)
-  (hr : ReachSet Γ (C.proj L) R2)
-  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (C.proj K) R1 := by
-  generalize h : C.proj L = D at hr
-  induction hr generalizing C L K
+theorem WellScoped.subkind {C : CaptureSet n k}
+  (hsc : WellScoped Γ cont (C.proj L))
+  (hsk : K.Subkind L)
+  : WellScoped Γ cont (C.proj K) := by
+  generalize h : C.proj L = D at hsc
+  induction hsc generalizing C K L
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    exists .empty; apply And.intro .empty .empty
-  case union ha hb =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have ⟨Ra, hsa, ha⟩ := ha hk (.refl _)
-    have ⟨Rb, hsb, hb⟩ := hb hk (.refl _)
-    exists Ra ∪ Rb
-    apply And.intro (.union_monotone hsa hsb)
-    apply! union
-  case var hb hr ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all
-    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
-    exists R; apply And.intro hs (.var hb h)
-  case cinstr hb hr ih =>
+    simp; constructor
+  case union ha hb iha ihb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
-    exists R; apply And.intro hs (.cinstr hb h)
-  case cbound hb hr ih =>
+    apply! union (iha hsk (.refl _)) (ihb hsk (.refl _))
+  case ckind hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
-    exists R; apply And.intro hs (.cbound hb h)
-  case ckind hb =>
+    apply! ckind
+  case label hb hl =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    apply Exists.intro
-    apply And.intro _ (ckind hb)
-    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
-  case label hb =>
+    apply! label
+  case label_disj hb hd =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    apply Exists.intro
-    apply And.intro _ (label hb)
-    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
+    have ⟨_, _⟩ := h; subst_vars
+    apply label_disj hb (hd.refine_subkind_l _)
+    apply Kind.Intersect.with_subkind hsk
   case absurd he =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    exists .empty; apply And.intro .empty
-    apply absurd $ Kind.Subkind.empty_r_inv _ he
-    apply Kind.Intersect.with_subkind hk
-
-
-theorem ReachSet.singleton_subkind
-  (hk : K.Subkind L)
-  (hr : ReachSet Γ (.singleton s L) R2)
-  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (.singleton s K) R1 := by
-  rw [← Kind.intersect.top_l (K:=L), ← CaptureSet.proj] at hr
-  rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj]
-  apply! subkind
-
-theorem ReachSet.proj_merge' {C : CaptureSet n k}
-  (hr1 : ReachSet Γ (C.proj L1) R1)
-  (hr2 : ReachSet Γ (C.proj L2) R2)
-  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (C.proj (L1 ++ L2)) R := by
-  generalize h : C.proj L1 = D at hr1
-  induction hr1 generalizing C L1 L2 R2
+    apply absurd
+    apply Kind.Subkind.empty_r_inv _ he
+    apply Kind.Intersect.with_subkind hsk
+
+theorem WellScoped.singleton_subkind
+  (hsc : WellScoped Γ cont (.singleton s L))
+  (hs : Kind.Subkind K L)
+  : WellScoped Γ cont (.singleton s K) := by
+  rw [← Kind.intersect.top_l (K:=L)] at hsc
+  have h : CaptureSet.proj (.singleton s .top) L = .singleton s (.intersect .top L) := by simp
+  rw [← h] at hsc
+  have h1 := hsc.subkind hs
+  simp only [CaptureSet.proj] at h1
+  rw [Kind.intersect.top_l] at h1
+  exact h1
+
+theorem WellScoped.proj_merge' {C : CaptureSet n k}
+  (hsc1 : WellScoped Γ cont (C.proj K))
+  (hsc2 : WellScoped Γ cont (C.proj L))
+  : WellScoped Γ cont (C.proj (K ++ L)) := by
+  generalize h : C.proj K = D at hsc1
+  induction hsc1 generalizing C K L
   case empty =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
-    exists .empty; apply And.intro .empty .empty
+    apply empty
   case union ha hb =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
-    cases hr2
-    rename_i hr2a hr2b
-    have ⟨Ra, hsa, ha⟩ := ha hr2a (.refl _)
-    have ⟨Rb, hsb, hb⟩ := hb hr2b (.refl _)
-    exists Ra ∪ Rb
-    apply And.intro
-    . apply CaptureSet.Subset.trans $ CaptureSet.Subset.union_monotone hsa hsb
-      apply CaptureSet.Subset.union_l
-      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rl .rfl) (.union_rr $ .union_rl .rfl)
-      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rr .rfl) (.union_rr $ .union_rr .rfl)
-    . apply! union
-  case var C _ _ _ hb hr1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    cases hr2
-    case var hb2 hr2 =>
-      cases Context.bound_injective hb hb2
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs hs') (.var hb h)
-    case label hb2 => cases Context.bound_lbound_absurd hb hb2
-    case absurd he =>
-      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.var hb h)
-  case cinstr C _ _ hb hr1 ih =>
-    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    cases hr2
-    case cinstr hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs hs') (.cinstr hb h)
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd he =>
-      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cinstr hb h)
-  case cbound C _ _ hb hr1 ih =>
+    cases hsc2
+    apply! union (ha _ (.refl _)) (hb _ (.refl _))
+  case ckind hb =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs hs') (.cbound hb h)
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd he =>
-      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
-      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
-      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
-      exists R
-      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cbound hb h)
-  case ckind c K _ hb =>
+    have ⟨_, _⟩ := h; subst_vars
+    apply! ckind
+  case label hb hl =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case ckind p _ hb2 =>
-      cases Context.cbound_injective hb hb2
-      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
-      apply And.intro
-      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
-        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
-        apply Kind.Intersect.union_r_subkind
-      . apply! ckind
-    case absurd he =>
-      rename_i p
-      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
-      apply And.intro
-      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
-        apply Kind.Intersect.with_subkind
-        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
-      . apply! ckind
-
-  case label x _ _ _ hb =>
+    have ⟨_, _⟩ := h; subst_vars
+    apply! label
+  case label_disj hb hd =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    cases hr2
-    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
-    case label p c _ hb2 =>
-      cases Context.lbound_inj hb hb2
-      subst_vars
-      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
-      apply And.intro
-      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
-        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
-        apply Kind.Intersect.union_r_subkind
-      . apply! label
+    have ⟨_, _⟩ := h; subst_vars
+    cases hsc2
+    case label hb2 hl =>
+      cases Context.lbound_inj hb hb2; subst_vars
+      apply! label
+    case label_disj hb2 hd2 =>
+      cases Context.lbound_inj hb hb2; subst_vars
+      apply label_disj hb
+      apply Kind.Disjoint.refine_subkind_l (.union_l hd hd2) Kind.Intersect.union_r_subkind
     case absurd he =>
-      rename_i c _ _ p
-      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
-      apply And.intro
-      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
-        apply Kind.Intersect.with_subkind
-        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
-      . apply! label
+      apply label_disj hb
+      apply Kind.Disjoint.refine_subkind_l (.union_l hd $ Kind.Disjoint.is_empty_l he) Kind.Intersect.union_r_subkind
   case absurd he =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
-    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
-    rename_i p
-    have h0 : (p.intersect (L1 ++ L2)).Subkind (p.intersect L2) := by
-      apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
-      apply Kind.Subkind.union_l (.is_empty_l he) .rfl
-    have ⟨R, hs, h⟩ := hr2.singleton_subkind h0
-    exists R
-    apply And.intro (.union_rr hs)
-    apply h
-
-theorem ReachSet.proj_merge
-  (hr1 : ReachSet Γ (.singleton s L1) R1)
-  (hr2 : ReachSet Γ (.singleton s L2) R2)
-  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (.singleton s (L1 ++ L2)) R := by
-  rw [← Kind.intersect.top_l (K:=L1), ← CaptureSet.proj] at hr1
-  rw [← Kind.intersect.top_l (K:=L2), ← CaptureSet.proj] at hr2
-  rw [← Kind.intersect.top_l (K:=(L1 ++ L2)), ← CaptureSet.proj]
+    have ⟨_, _⟩ := h; subst_vars
+    apply singleton_subkind hsc2 (.trans Kind.Intersect.union_r_subkind _)
+    apply Kind.Subkind.union_l (.is_empty_l he) .rfl
+
+theorem WellScoped.proj_merge
+  (hsc1 : WellScoped Γ cont (.singleton s K))
+  (hsc2 : WellScoped Γ cont (.singleton s L))
+  : WellScoped Γ cont (.singleton s (K ++ L)) := by
+  rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj] at hsc1
+  rw [← Kind.intersect.top_l (K:=L), ← CaptureSet.proj] at hsc2
+  rw [← Kind.intersect.top_l (K:=K++L), ← CaptureSet.proj]
   apply! proj_merge'
 
-theorem ReachSet.subset
-  (hs : C1 ⊆ C2)
-  (hr1 : ReachSet Γ C2 R2)
-  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
-  induction hs generalizing R2
-  case empty =>
-    exists .empty; apply And.intro .empty .empty
-  case rfl =>
-    exists R2; apply And.intro .rfl hr1
-  case union_l ha hb =>
-    have ⟨R1, hs1, h1⟩ := ha hr1
-    have ⟨R2, hs2, h2⟩ := hb hr1
-    exists R1 ∪ R2
-    apply And.intro $ .union_l hs1 hs2
-    apply! union
-  case union_rl ih =>
-    cases hr1
-    rename_i R1 R2 h1 h2
-    have ⟨R, hs, h⟩ := ih h1
-    exists R; apply And.intro (.union_rl hs) h
-  case union_rr ih =>
-    cases hr1
-    rename_i R1 R2 h1 h2
-    have ⟨R, hs, h⟩ := ih h2
-    exists R; apply And.intro (.union_rr hs) h
-  case trans ha hb =>
-    have ⟨Rb, hsb, hb⟩ := hb hr1
-    have ⟨Ra, hsa, ha⟩ := ha hb
-    exists Ra; apply! And.intro (.trans hsa hsb)
-  case singleton_subkind hs => apply! singleton_subkind
-  case singleton_absurd he => exists .empty; apply And.intro .empty (.absurd he)
+theorem WellScoped.subset {C1 C2 : CaptureSet n k}
+  (hsc : WellScoped Γ cont C2)
+  (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
+  induction hs
+  case empty => apply empty
+  case rfl => assumption
+  case union_l ha hb iha ihb =>
+    apply! union (iha _) (ihb _)
+  case union_rl ha iha =>
+    cases hsc
+    apply! iha
+  case union_rr ha iha =>
+    cases hsc
+    apply! iha
+  case singleton_subkind => apply! singleton_subkind
+  case singleton_absurd => apply! absurd
   case proj_merge =>
-    cases hr1
+    cases hsc
     apply! proj_merge
-
-theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
-  (hk : CaptureKind Γ C K)
-  (he : K.IsEmpty)
-  : ∃ R, R ⊆ .empty ∧ ReachSet Γ C R := by
-  induction hk
-  case var hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs (var hb h)
-  case label x c _ K hb =>
-    exists {x=x|(Kind.classifier c).intersect K}
-    apply And.intro (.singleton_absurd he)
-    apply! label
-  case cvar c K L hb =>
-    exists {c=c|K.intersect L}
-    apply And.intro (.singleton_absurd he)
-    apply! ckind
-  case cbound hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs
-    apply! cbound
-  case cinstr hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs
-    apply! cinstr
-  case sub hsk hk ih => apply ih (hsk.empty_r_inv he)
-  case empty => exists .empty; apply And.intro .empty .empty
-  case singleton_absurd he2 => exists .empty; apply! And.intro .empty (.absurd he2)
-  case union ha hb =>
-    have ⟨Ra, hsa, ha⟩ := ha he
-    have ⟨Rb, hsb, hb⟩ := hb he
-    exists Ra ∪ Rb
-    apply And.intro (.union_l hsa hsb)
-    apply! union
-
-theorem ReachSet.proj_r
-  (hk : CaptureKind Γ C K)
-  (hr2 : ReachSet Γ (C.proj K) R2)
-  : ∃ R ⊆ R2, ReachSet Γ C R := by
-  induction hk generalizing R2
-  case var hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case var hb2 hr2 =>
-      cases Context.bound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! var
-    case label hb2 => cases Context.bound_lbound_absurd hb hb2
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! var
-  case label x c _ K hb =>
-    exists {x=x|(Kind.classifier c).intersect K}
-    apply And.intro _ (.label hb)
-    cases hr2
-    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
-    case label hb2 =>
-      cases Context.lbound_inj hb hb2; subst_vars
-      rw [← Kind.intersect.assoc]
-      exact .singleton_subkind Kind.Intersect.subkind_self
-    case absurd he =>
-      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
-  case cvar c C K hb =>
-    exists {c=c|C.intersect K}
-    apply And.intro _ (.ckind hb)
-    cases hr2
-    case ckind hb2 =>
-      cases Context.cbound_injective hb hb2
-      rw [← Kind.intersect.assoc]
-      exact .singleton_subkind Kind.Intersect.subkind_self
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case absurd x c _ K he =>
-      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
-  case cbound hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! cbound
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! cbound
-  case cinstr hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cinstr hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! cinstr
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! cinstr
-  case sub hsk hk ih =>
-    have ⟨R3, h3, hr3⟩ := subkind hsk hr2
-    have ⟨R, h, ih⟩ := ih hr3
-    exists R
-    apply And.intro (.trans h h3) ih
-  case empty => cases hr2; exists .empty; apply And.intro .empty .empty
-  case singleton_absurd he =>
-    exists .empty; apply And.intro .empty (.absurd he)
-  case union ha hb iha ihb =>
-    cases hr2
-    rename_i ha2 hb2
-    have ⟨R1, h1, ih1⟩ := iha ha2
-    have ⟨R2, h2, ih2⟩ := ihb hb2
-    exists R1 ∪ R2
-    apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
-
-theorem ReachSet.subcapt
-  (hr2 : ReachSet Γ C2 R2)
-  (hs : Subcapt Γ C1 C2)
-  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
-  induction hs generalizing R2
   case trans ha hb =>
-    have ⟨R2, hs2, hr⟩ := hb hr2
-    have ⟨R1, hs1, hr⟩ := ha hr
-    exists R1
-    apply! And.intro (.trans hs1 hs2)
-  case subset => apply! subset
-  case union ha hb =>
-    have ⟨Ra, hsa, hra⟩ := ha hr2
-    have ⟨Rb, hsb, hrb⟩ := hb hr2
-    exists Ra ∪ Rb
-    apply And.intro (.union_l hsa hsb) (.union hra hrb)
-  case var hb => exists R2; apply And.intro .rfl; apply! var
-  case cinstl hb =>
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd _ he => apply! proj_absurd
-  case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
-  case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
-  case proj_r hk => apply! proj_r
-  case absurd hk he =>
-    cases hr2
-    apply capture_kind_absurd hk he
-
-theorem ReachSet.is_subcapt
-  (hr : ReachSet Γ C R)
-  : Subcapt Γ C R := by
-  induction hr
-  case empty => apply Subcapt.subset .empty
-  case union ha hb => apply! Subcapt.join
-  case var hb hr ih => apply Subcapt.trans (.var hb) ih
-  case cinstr hb hr ih => apply Subcapt.trans (.cinstr hb) ih
-  case cbound hb hr ih => apply Subcapt.trans (.cbound hb) ih
-  case ckind L hb =>
-    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
-    rw [← CaptureSet.proj]
-    apply Subcapt.proj_r
-    apply CaptureKind.sub Kind.Intersect.subkind_l (.cvar hb)
+    apply ha; apply! hb
+
+theorem WellScoped.cons
+  (hsc : WellScoped Γ cont C) :
+  WellScoped Γ (Cont.cons u cont) C := by
+  induction hsc
+  case empty => apply empty
+  case union => apply union <;> aesop
+  case ckind ih => apply ckind <;> aesop
+  case label hb hl =>
+    apply label hb
+    constructor; assumption
+  case label_disj hb hd =>
+    apply! label_disj
+  case absurd => apply! absurd
+
+theorem WellScoped.conse
+  (hsc : WellScoped Γ cont C) :
+  WellScoped Γ (Cont.conse u cont) C := by
+  induction hsc
+  case empty => apply empty
+  case union => apply union <;> aesop
+  case ckind ih => apply ckind <;> aesop
+  case label hb hl =>
+    apply label hb
+    constructor; assumption
+  case label_disj => apply! label_disj
+  case absurd => apply! absurd
+
+theorem WellScoped.scope
+  (hsc : WellScoped Γ cont C) :
+  WellScoped Γ (Cont.scope x cont) C := by
+  induction hsc
+  case empty => apply empty
+  case union => apply union <;> aesop
+  case ckind ih => apply ckind <;> aesop
+  case label hb hl =>
+    apply label hb
+    constructor; assumption
+  case label_disj => apply! label_disj
+  case absurd => apply! absurd
+
+-- Inversions
+
+theorem ReachSet.var_inv
+  (hr : ReachSet Γ {x=x|.top} R)
+  (hbx : Γ.Bound x (S^C))
+  : ∃ R' ⊆ R, ReachSet Γ C R' := by
+  cases hr
+  case var hb hr =>
+    cases Context.bound_injective hb hbx
+    rw [CaptureSet.proj_top] at hr
+    exists R; apply And.intro .rfl hr
+  case label hb => cases Context.bound_lbound_absurd hbx hb
+  case absurd he => contrapose he; decide
+
+theorem ReachSet.label_inv
+  (hr : ReachSet Γ {x=x|.top} R)
+  (hsc : WellScoped Γ cont R)
+  (hbx : Γ.LBound x c S)
+  : ∃ tail, cont.HasLabel x tail := by
+  cases hr
+  case var hb hr => cases Context.bound_lbound_absurd hb hbx
   case label hb =>
-    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
-    rw [← CaptureSet.proj]
-    apply Subcapt.proj_r
-    apply CaptureKind.sub Kind.Intersect.subkind_l (.label hb)
-  case absurd =>
-    apply! Subcapt.absurd (.singleton_absurd _)
-
-
-
--- theorem WellScoped.subkind
---   (hsc : WellScoped Γ cont (.proj C K2))
---   (hs : K1.Subkind K2)
---   : WellScoped Γ cont (.proj C K1) := by
---   generalize h : C.proj K2 = D at hsc
---   induction hsc generalizing C K2 K1
---   case empty =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     simp; constructor
---   case union ha hb =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply! union (ha _ $ .refl _) (hb _ $ .refl _)
---   case singleton hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply singleton hb
---     apply ih
---     apply Kind.Intersect.with_subkind hs
---     apply! refl
---   case csingleton hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply csingleton hb
---     apply ih
---     apply Kind.Intersect.with_subkind hs
---     apply! refl
---   case cbound hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply cbound hb
---     apply ih
---     apply Kind.Intersect.with_subkind hs
---     apply! refl
---   case ckind hb ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply! ckind
---   case label hb hl =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply! label
---   case label_disj hb hd =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply label_disj hb
---     apply hd.refine_subkind_l $ Kind.Intersect.with_subkind hs
-
--- theorem WellScoped.subkind_singleton
---   (hsc : WellScoped Γ cont (.singleton s L))
---   (hs : Kind.Subkind K L)
---   : WellScoped Γ cont (.singleton s K) := by
---   rw [← Kind.Intersect.top_l (K:=L)] at hsc
---   have h : CaptureSet.proj (.singleton s .top) L = .singleton s (.intersect .top L) := by simp
---   rw [← h] at hsc
---   have h1 := hsc.subkind hs
---   simp only [CaptureSet.proj] at h1
---   rw [Kind.Intersect.top_l] at h1
---   assumption
-
--- theorem WellScoped.subset {C1 C2 : CaptureSet n k}
---   (hsc : WellScoped Γ cont C2)
---   (hs : C1.Subset C2) : WellScoped Γ cont C1 := by
---   induction hs
---   case empty => apply empty
---   case rfl => assumption
---   case union_l ha hb iha ihb =>
---     apply! union (iha _) (ihb _)
---   case union_rl ha iha =>
---     cases hsc
---     apply! iha
---   case union_rr ha iha =>
---     cases hsc
---     apply! iha
-
--- theorem WellScoped.cons
---   (hsc : WellScoped Γ cont C) :
---   WellScoped Γ (Cont.cons u cont) C := by
---   induction hsc
---   case empty => apply empty
---   case union => apply union <;> aesop
---   case singleton ih => apply singleton <;> aesop
---   case csingleton ih => apply csingleton <;> aesop
---   case cbound ih => apply cbound <;> aesop
---   case ckind ih => apply ckind <;> aesop
---   case label hb hl =>
---     apply label hb
---     constructor; assumption
---   case label_disj hb hd =>
---     apply! label_disj
-
--- theorem WellScoped.conse
---   (hsc : WellScoped Γ cont C) :
---   WellScoped Γ (Cont.conse u cont) C := by
---   induction hsc
---   case empty => apply empty
---   case union => apply union <;> aesop
---   case singleton ih => apply singleton <;> aesop
---   case csingleton ih => apply csingleton <;> aesop
---   case cbound ih => apply cbound <;> aesop
---   case ckind ih => apply ckind <;> aesop
---   case label hb hl =>
---     apply label hb
---     constructor; assumption
---   case label_disj => apply! label_disj
-
--- theorem WellScoped.scope
---   (hsc : WellScoped Γ cont C) :
---   WellScoped Γ (Cont.scope x cont) C := by
---   induction hsc
---   case empty => apply empty
---   case union => apply union <;> aesop
---   case singleton ih => apply singleton <;> aesop
---   case csingleton ih => apply csingleton <;> aesop
---   case cbound ih => apply cbound <;> aesop
---   case ckind ih => apply ckind <;> aesop
---   case label hb hl =>
---     apply label hb
---     constructor; assumption
---   case label_disj => apply! label_disj
-
-
--- theorem WellScoped.proj_merge
---   (hsc1 : WellScoped Γ cont (.proj C K1))
---   (hsc2 : WellScoped Γ cont (.proj C K2))
---   : WellScoped Γ cont (.proj C (K1.union K2)) := by
---   generalize h : C.proj K1 = D at hsc1
---   induction hsc1 generalizing C K1 K2
---   case empty =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     simp; constructor
---   case union ha hb =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     cases hsc2
---     apply! union (ha _ $ .refl _) (hb _ $ .refl _)
---   case singleton hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     cases hsc2
---     case singleton hb2 hsc2 =>
---       cases Context.bound_injective hb hb2
---       apply singleton hb
---       apply subkind _ Kind.Intersect.union_r_subkind
---       apply! ih _ (.refl _)
---     case label hb2 _ => cases Context.bound_lbound_absurd hb hb2
---     case label_disj hb2 _ => cases Context.bound_lbound_absurd hb hb2
---   case csingleton hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     cases hsc2
---     case csingleton hb2 hsc2 =>
---       cases Context.cbound_injective hb hb2
---       apply csingleton hb
---       apply subkind _ Kind.Intersect.union_r_subkind
---       apply! ih _ (.refl _)
---     case cbound hb2 _ => cases Context.cbound_injective hb hb2
---     case ckind hb2 => cases Context.cbound_injective hb hb2
---   case cbound hb hsc ih =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     cases hsc2
---     case csingleton hb2 _ => cases Context.cbound_injective hb hb2
---     case cbound hb2 hsc2 =>
---       cases Context.cbound_injective hb hb2
---       apply cbound hb
---       apply subkind _ Kind.Intersect.union_r_subkind
---       apply! ih _ (.refl _)
---     case ckind hb2 => cases Context.cbound_injective hb hb2
---   case ckind hb =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply! ckind
---   case label hb hl =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     apply! label
---   case label_disj hb hd =>
---     unfold CaptureSet.proj at h; split at h <;> simp at h
---     have ⟨_, _⟩ := h; subst_vars; simp_all
---     cases hsc2
---     case singleton hb2 _ => cases Context.bound_lbound_absurd hb2 hb
---     case label hb hl => apply! label
---     case label_disj hb2 hd2 =>
---       cases Context.lbound_inj hb hb2
---       subst_vars
---       have h := Kind.Disjoint.union_l hd hd2
---       apply subkind_singleton (label_disj hb h) Kind.Intersect.union_r_subkind
-
--- theorem WellScoped.proj_merge_singleton
---   (hs1 : WellScoped Γ cont (.singleton s K1))
---   (hs2 : WellScoped Γ cont (.singleton s K2))
---   : WellScoped Γ cont (.singleton s (K1.union K2)) := by
---   rw [← Kind.Intersect.top_l (K:=K1)] at hs1
---   rw [← Kind.Intersect.top_l (K:=K2)] at hs2
---   rw [← CaptureSet.proj] at hs1 hs2
---   rw [← Kind.Intersect.top_l (K:=K1.union K2), ← CaptureSet.proj]
---   apply! proj_merge
-
--- theorem WellScoped.absurd
---   (hk : CaptureKind Γ C K)
---   (he : K.IsEmpty)
---   : WellScoped Γ cont C := by
---   induction hk
---   case var hb hk ih => apply! singleton hb (ih _)
---   case label hl =>
---     apply label_disj hl
---     apply Kind.Disjoint.symm
---     apply Kind.Disjoint.from_empty_intersect Kind.Intersect.lawful he
---   case cvar hb => apply ckind hb
---   case cbound hb hk ih => apply! cbound hb (ih _)
---   case cinstr hb hk ih => apply! csingleton hb (ih _)
---   case sub hs hk ih => apply ih; apply hs.empty_r_inv he
---   case empty => constructor
---   case absurd hk he1 ih => apply! ih
---   case union ha hb => simp_all; apply! union
-
-
--- theorem WellScoped.subcapt (hsc : WellScoped Γ cont C2) (hsub : Subcapt Γ C1 C2) : WellScoped Γ cont C1 := by
---   induction hsub
---   case trans ha hb iha ihb => apply! iha $ ihb _
---   case subset hsub => apply! hsc.subset
---   case union ha hb iha ihb =>
---     apply! union (iha _) (ihb _)
---   case var hb => apply! singleton
---   case cinstl hb =>
---     cases hsc
---     case csingleton hb1 _ =>
---       cases Context.cbound_injective hb1 hb
---       assumption
---     case cbound hb1 _ =>
---       cases Context.cbound_injective hb1 hb
---     case ckind hb1 =>
---       cases Context.cbound_injective hb1 hb
---   case cinstr hb => apply! csingleton
---   case cbound hb => apply! cbound
---   case subkind => apply! hsc.subkind_singleton
---   case absurd hk he => apply! absurd
---   case proj_split =>
---     cases hsc
---     apply! proj_merge_singleton
-
--- theorem WellScoped.var_inv
---   (hsc : WellScoped Γ cont {x=x|.top})
---   (hbx : Γ.Bound x (S^C)) :
---   WellScoped Γ cont C := by
---   cases hsc
---   case singleton hbx' _ =>
---     have h := Context.bound_injective hbx hbx'
---     cases h
---     rw [CaptureSet.proj_top] at *
---     trivial
---   case label =>
---     exfalso
---     apply Context.bound_lbound_absurd <;> easy
---   case label_disj =>
---     exfalso
---     apply Context.bound_lbound_absurd <;> easy
-
--- theorem WellScoped.label_inv
---   (hsc : WellScoped Γ cont {x=x|.top})
---   (hbl : Γ.LBound x c S) :
---   ∃ tail, cont.HasLabel x tail := by
---   cases hsc
---   case singleton =>
---     exfalso
---     apply Context.bound_lbound_absurd <;> easy
---   case label => aesop
---   case label_disj hd => cases hd.top_l.is_absurd
+    cases Context.lbound_inj hb hbx; subst_vars
+    cases hsc
+    case label tail hb hl =>
+      cases Context.lbound_inj hb hbx; subst_vars
+      exists tail
+    case label_disj hb he =>
+      cases Context.lbound_inj hb hbx; subst_vars
+      rw [Kind.intersect.top_r] at he
+      cases he.with_self.is_absurd
+    case absurd he =>
+      rw [Kind.intersect.top_r] at he
+      cases he.is_absurd
+  case absurd he => cases he.is_absurd
 
 end Capless
diff --git a/Capless/WellScoped/ReachSet.lean b/Capless/WellScoped/ReachSet.lean
new file mode 100644
index 00000000..c2a022e9
--- /dev/null
+++ b/Capless/WellScoped/ReachSet.lean
@@ -0,0 +1,513 @@
+import Capless.Store
+import Capless.Subcapturing
+import Capless.Subcapturing.Basic
+import Capless.Inversion.Context
+
+namespace Capless
+
+theorem ReachSet.proj_empty {C : CaptureSet n k}
+  (hr : ReachSet Γ (C.proj K) R)
+  (he : K.IsEmpty)
+  : R ⊆ .empty := by
+  generalize h : C.proj K = D at hr
+  induction hr generalizing C K
+  case empty => constructor
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply CaptureSet.Subset.union_l (ha he (.refl _)) (hb he (.refl _))
+  case var hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.intersect.is_empty_r he
+  case cinstr hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.intersect.is_empty_r he
+  case cbound hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply ih _ (.refl _)
+    apply Kind.intersect.is_empty_r he
+  case ckind =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply CaptureSet.Subset.singleton_absurd
+    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
+  case label =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply CaptureSet.Subset.singleton_absurd
+    apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
+  case absurd =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    constructor
+
+theorem ReachSet.proj_absurd {C : CaptureSet n k}
+  (he : K.IsEmpty)
+  : ∃ R, R ⊆ .empty ∧ ReachSet Γ (C.proj K) R := by
+  induction C
+  case empty => exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    have ⟨Ra, hsa, ha⟩ := ha
+    have ⟨Rb, hbs, hb⟩ := hb
+    exists Ra ∪ Rb
+    apply And.intro
+    apply! CaptureSet.Subset.union_l
+    apply! union
+  case singleton =>
+    exists .empty
+    apply And.intro .empty
+    apply absurd
+    apply Kind.intersect.is_empty_r he
+
+theorem ReachSet.inj
+  (hr1 : ReachSet Γ C R1)
+  (hr2 : ReachSet Γ C R2)
+  : R1 ⊆ R2 := by
+  induction hr1 generalizing R2
+  case empty => apply CaptureSet.Subset.empty
+  case union ha hb => cases hr2; apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
+  case var hb1 hr1 ih =>
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_injective hb1 hb2; apply! ih
+    case label hb2 => cases Context.bound_lbound_absurd hb1 hb2
+    case absurd he => apply! hr1.proj_empty
+  case cinstr hb1 hr1 ih =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2
+    case absurd he => apply! hr1.proj_empty
+  case cbound hb1 hr1 ih =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2; apply! ih
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2
+    case absurd he => apply! hr1.proj_empty
+  case ckind hb1 =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb1 hb2
+    case ckind hb2 => cases Context.cbound_injective hb1 hb2; constructor
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
+  case label hb1 =>
+    cases hr2
+    case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
+    case label hb2 => cases Context.lbound_inj hb1 hb2; subst_vars; constructor
+    case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
+  case absurd => constructor
+
+
+theorem ReachSet.subkind {C : CaptureSet n k}
+  (hk : K.Subkind L)
+  (hr : ReachSet Γ (C.proj L) R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (C.proj K) R1 := by
+  generalize h : C.proj L = D at hr
+  induction hr generalizing C L K
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨Ra, hsa, ha⟩ := ha hk (.refl _)
+    have ⟨Rb, hsb, hb⟩ := hb hk (.refl _)
+    exists Ra ∪ Rb
+    apply And.intro (.union_monotone hsa hsb)
+    apply! union
+  case var hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.var hb h)
+  case cinstr hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.cinstr hb h)
+  case cbound hb hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    have ⟨R, hs, h⟩ := ih (Kind.Intersect.with_subkind hk) (.refl _)
+    exists R; apply And.intro hs (.cbound hb h)
+  case ckind hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply Exists.intro
+    apply And.intro _ (ckind hb)
+    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
+  case label hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    apply Exists.intro
+    apply And.intro _ (label hb)
+    apply CaptureSet.Subset.singleton_subkind $ Kind.Intersect.with_subkind $ Kind.Intersect.with_subkind hk
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    exists .empty; apply And.intro .empty
+    apply absurd $ Kind.Subkind.empty_r_inv _ he
+    apply Kind.Intersect.with_subkind hk
+
+
+theorem ReachSet.singleton_subkind
+  (hk : K.Subkind L)
+  (hr : ReachSet Γ (.singleton s L) R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (.singleton s K) R1 := by
+  rw [← Kind.intersect.top_l (K:=L), ← CaptureSet.proj] at hr
+  rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj]
+  apply! subkind
+
+theorem ReachSet.proj_merge' {C : CaptureSet n k}
+  (hr1 : ReachSet Γ (C.proj L1) R1)
+  (hr2 : ReachSet Γ (C.proj L2) R2)
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (C.proj (L1 ++ L2)) R := by
+  generalize h : C.proj L1 = D at hr1
+  induction hr1 generalizing C L1 L2 R2
+  case empty =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    exists .empty; apply And.intro .empty .empty
+  case union ha hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    cases hr2
+    rename_i hr2a hr2b
+    have ⟨Ra, hsa, ha⟩ := ha hr2a (.refl _)
+    have ⟨Rb, hsb, hb⟩ := hb hr2b (.refl _)
+    exists Ra ∪ Rb
+    apply And.intro
+    . apply CaptureSet.Subset.trans $ CaptureSet.Subset.union_monotone hsa hsb
+      apply CaptureSet.Subset.union_l
+      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rl .rfl) (.union_rr $ .union_rl .rfl)
+      . apply CaptureSet.Subset.union_l (.union_rl $ .union_rr .rfl) (.union_rr $ .union_rr .rfl)
+    . apply! union
+  case var C _ _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case var hb2 hr2 =>
+      cases Context.bound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.var hb h)
+    case label hb2 => cases Context.bound_lbound_absurd hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.var hb h)
+  case cinstr C _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case cinstr hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.cinstr hb h)
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cinstr hb h)
+  case cbound C _ _ hb hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs hs') (.cbound hb h)
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd he =>
+      have ⟨R2, hs2, hr2⟩ := proj_absurd (Γ:=Γ) (C:=C) he
+      have ⟨R', hs', h'⟩ := ih hr2 (.refl _)
+      have ⟨R, hs, h⟩ := h'.subkind Kind.Intersect.union_r_subkind
+      exists R
+      apply And.intro (.trans hs (.trans hs' (.union_monotone .rfl hs2))) (.cbound hb h)
+  case ckind c K _ hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind p _ hb2 =>
+      cases Context.cbound_injective hb hb2
+      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
+        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
+        apply Kind.Intersect.union_r_subkind
+      . apply! ckind
+    case absurd he =>
+      rename_i p
+      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
+        apply Kind.Intersect.with_subkind
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
+      . apply! ckind
+
+  case label x _ _ _ hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
+    case label p c _ hb2 =>
+      cases Context.lbound_inj hb hb2
+      subst_vars
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
+        apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
+        apply Kind.Intersect.union_r_subkind
+      . apply! label
+    case absurd he =>
+      rename_i c _ _ p
+      exists {x=x| (Kind.classifier c).intersect (p.intersect (L1 ++ L2))}
+      apply And.intro
+      . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
+        apply Kind.Intersect.with_subkind
+        apply Kind.Subkind.trans Kind.Intersect.union_r_subkind (.union_l .rfl (.is_empty_l he))
+      . apply! label
+  case absurd he =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    rename_i p
+    have h0 : (p.intersect (L1 ++ L2)).Subkind (p.intersect L2) := by
+      apply Kind.Subkind.trans Kind.Intersect.union_r_subkind
+      apply Kind.Subkind.union_l (.is_empty_l he) .rfl
+    have ⟨R, hs, h⟩ := hr2.singleton_subkind h0
+    exists R
+    apply And.intro (.union_rr hs)
+    apply h
+
+theorem ReachSet.proj_merge
+  (hr1 : ReachSet Γ (.singleton s L1) R1)
+  (hr2 : ReachSet Γ (.singleton s L2) R2)
+  : ∃ R, R ⊆ (R1 ∪ R2) ∧ ReachSet Γ (.singleton s (L1 ++ L2)) R := by
+  rw [← Kind.intersect.top_l (K:=L1), ← CaptureSet.proj] at hr1
+  rw [← Kind.intersect.top_l (K:=L2), ← CaptureSet.proj] at hr2
+  rw [← Kind.intersect.top_l (K:=(L1 ++ L2)), ← CaptureSet.proj]
+  apply! proj_merge'
+
+theorem ReachSet.subset
+  (hs : C1 ⊆ C2)
+  (hr1 : ReachSet Γ C2 R2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
+  induction hs generalizing R2
+  case empty =>
+    exists .empty; apply And.intro .empty .empty
+  case rfl =>
+    exists R2; apply And.intro .rfl hr1
+  case union_l ha hb =>
+    have ⟨R1, hs1, h1⟩ := ha hr1
+    have ⟨R2, hs2, h2⟩ := hb hr1
+    exists R1 ∪ R2
+    apply And.intro $ .union_l hs1 hs2
+    apply! union
+  case union_rl ih =>
+    cases hr1
+    rename_i R1 R2 h1 h2
+    have ⟨R, hs, h⟩ := ih h1
+    exists R; apply And.intro (.union_rl hs) h
+  case union_rr ih =>
+    cases hr1
+    rename_i R1 R2 h1 h2
+    have ⟨R, hs, h⟩ := ih h2
+    exists R; apply And.intro (.union_rr hs) h
+  case trans ha hb =>
+    have ⟨Rb, hsb, hb⟩ := hb hr1
+    have ⟨Ra, hsa, ha⟩ := ha hb
+    exists Ra; apply! And.intro (.trans hsa hsb)
+  case singleton_subkind hs => apply! singleton_subkind
+  case singleton_absurd he => exists .empty; apply And.intro .empty (.absurd he)
+  case proj_merge =>
+    cases hr1
+    apply! proj_merge
+
+theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
+  (hk : CaptureKind Γ C K)
+  (he : K.IsEmpty)
+  : ∃ R, R ⊆ .empty ∧ ReachSet Γ C R := by
+  induction hk
+  case var hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs (var hb h)
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro (.singleton_absurd he)
+    apply! label
+  case cvar c K L hb =>
+    exists {c=c|K.intersect L}
+    apply And.intro (.singleton_absurd he)
+    apply! ckind
+  case cbound hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cbound
+  case cinstr hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cinstr
+  case sub hsk hk ih => apply ih (hsk.empty_r_inv he)
+  case empty => exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he2 => exists .empty; apply! And.intro .empty (.absurd he2)
+  case union ha hb =>
+    have ⟨Ra, hsa, ha⟩ := ha he
+    have ⟨Rb, hsb, hb⟩ := hb he
+    exists Ra ∪ Rb
+    apply And.intro (.union_l hsa hsb)
+    apply! union
+
+theorem ReachSet.proj_r
+  (hk : CaptureKind Γ C K)
+  (hr2 : ReachSet Γ (C.proj K) R2)
+  : ∃ R ⊆ R2, ReachSet Γ C R := by
+  induction hk generalizing R2
+  case var hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case var hb2 hr2 =>
+      cases Context.bound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! var
+    case label hb2 => cases Context.bound_lbound_absurd hb hb2
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! var
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro _ (.label hb)
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
+    case label hb2 =>
+      cases Context.lbound_inj hb hb2; subst_vars
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case absurd he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cvar c C K hb =>
+    exists {c=c|C.intersect K}
+    apply And.intro _ (.ckind hb)
+    cases hr2
+    case ckind hb2 =>
+      cases Context.cbound_injective hb hb2
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case absurd x c _ K he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cbound hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cbound
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cbound
+  case cinstr hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cinstr
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cinstr
+  case sub hsk hk ih =>
+    have ⟨R3, h3, hr3⟩ := subkind hsk hr2
+    have ⟨R, h, ih⟩ := ih hr3
+    exists R
+    apply And.intro (.trans h h3) ih
+  case empty => cases hr2; exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he =>
+    exists .empty; apply And.intro .empty (.absurd he)
+  case union ha hb iha ihb =>
+    cases hr2
+    rename_i ha2 hb2
+    have ⟨R1, h1, ih1⟩ := iha ha2
+    have ⟨R2, h2, ih2⟩ := ihb hb2
+    exists R1 ∪ R2
+    apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
+
+theorem ReachSet.subcapt
+  (hr2 : ReachSet Γ C2 R2)
+  (hs : Subcapt Γ C1 C2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
+  induction hs generalizing R2
+  case trans ha hb =>
+    have ⟨R2, hs2, hr⟩ := hb hr2
+    have ⟨R1, hs1, hr⟩ := ha hr
+    exists R1
+    apply! And.intro (.trans hs1 hs2)
+  case subset => apply! subset
+  case union ha hb =>
+    have ⟨Ra, hsa, hra⟩ := ha hr2
+    have ⟨Rb, hsb, hrb⟩ := hb hr2
+    exists Ra ∪ Rb
+    apply And.intro (.union_l hsa hsb) (.union hra hrb)
+  case var hb => exists R2; apply And.intro .rfl; apply! var
+  case cinstl hb =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd _ he => apply! proj_absurd
+  case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
+  case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
+  case proj_r hk => apply! proj_r
+  case absurd hk he =>
+    cases hr2
+    apply capture_kind_absurd hk he
+
+theorem ReachSet.is_subcapt
+  (hr : ReachSet Γ C R)
+  : Subcapt Γ C R := by
+  induction hr
+  case empty => apply Subcapt.subset .empty
+  case union ha hb => apply! Subcapt.join
+  case var hb hr ih => apply Subcapt.trans (.var hb) ih
+  case cinstr hb hr ih => apply Subcapt.trans (.cinstr hb) ih
+  case cbound hb hr ih => apply Subcapt.trans (.cbound hb) ih
+  case ckind L hb =>
+    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
+    rw [← CaptureSet.proj]
+    apply Subcapt.proj_r
+    apply CaptureKind.sub Kind.Intersect.subkind_l (.cvar hb)
+  case label hb =>
+    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
+    rw [← CaptureSet.proj]
+    apply Subcapt.proj_r
+    apply CaptureKind.sub Kind.Intersect.subkind_l (.label hb)
+  case absurd =>
+    apply! Subcapt.absurd (.singleton_absurd _)
+
+end Capless

From b594eb182cf7daafb3d64891fb500831e396560e Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 25 Dec 2025 16:09:22 +0100
Subject: [PATCH 64/71] Progress is green again

---
 Capless/Renaming/Capture/Subcapturing.lean |  2 +-
 Capless/Renaming/Term/Subcapturing.lean    |  2 +-
 Capless/Renaming/Type/Subcapturing.lean    |  2 +-
 Capless/Soundness/Progress.lean            | 18 +++++++++++-------
 Capless/Subcapturing.lean                  |  6 ++++--
 Capless/Subcapturing/Basic.lean            | 11 +++--------
 Capless/Subcapturing/CaptureKind.lean      |  1 -
 Capless/Subst/Capture/Subcapturing.lean    |  2 +-
 Capless/Subst/Term/Subcapturing.lean       |  2 +-
 Capless/Subst/Type/Subcapturing.lean       |  2 +-
 Capless/WellScoped/Basic.lean              |  1 +
 Capless/WellScoped/ReachSet.lean           |  3 ---
 12 files changed, 25 insertions(+), 27 deletions(-)

diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index efa07b64..bfed76cb 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -51,6 +51,6 @@ theorem Subcapt.crename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case absurd hk he => apply! absurd (hk.crename _)
+  case proj_r hk => apply! proj_r (hk.crename _)
 
 end Capless
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index 598ea659..60e74572 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -51,6 +51,6 @@ theorem Subcapt.rename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case absurd hk he => apply! absurd (hk.rename _)
+  case proj_r hk => apply! proj_r (hk.rename _)
 
 end Capless
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 4a7215ee..0826ff84 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -38,6 +38,6 @@ theorem Subcapt.trename
   case cinstl hb => apply! cinstl (ρ.cmap _ _ hb)
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
-  case absurd hk he => apply! absurd (hk.trename _)
+  case proj_r hk => apply! proj_r (hk.trename _)
 
 end Capless
diff --git a/Capless/Soundness/Progress.lean b/Capless/Soundness/Progress.lean
index 1b3d1583..54578e2a 100644
--- a/Capless/Soundness/Progress.lean
+++ b/Capless/Soundness/Progress.lean
@@ -175,10 +175,10 @@ inductive Progress : State n m k -> Prop where
 set_option maxHeartbeats 314159265358
 
 theorem progress
-  (ht : TypedState state Γ E) :
+  (ht : TypedState state Γ E Rt) :
   Progress state := by
   cases ht
-  case mk hs ht hsc hc =>
+  case mk hs ht hc hr hsc =>
     induction ht
     case var =>
       cases hc <;> aesop
@@ -186,10 +186,13 @@ theorem progress
       cases hc <;> aesop
     case pack =>
       cases hc <;> aesop
-    case sub hsub ih _ _ _ =>
-      apply ih <;> try easy
-      apply WellScoped.subcapt; easy; easy
-      apply! TypedCont.narrow (TypedCont.cin_narrow hc _) _
+    case sub hsubcapt hsub ih _ _ _ =>
+      have ⟨R', _, h⟩ := hr.subcapt hsubcapt
+      apply ih
+      . easy
+      . apply! TypedCont.narrow (TypedCont.cin_narrow hc _) _
+      . apply h
+      . apply! WellScoped.subset
     case abs => cases hc <;> aesop
     case tabs => cases hc <;> aesop
     case cabs => cases hc <;> aesop
@@ -217,11 +220,12 @@ theorem progress
     case bindt => aesop
     case bindc => aesop
     case invoke hx hy _ _ σ cont Ct =>
+      cases hr; rename_i hr _
       cases hsc; rename_i hsc _
       have hg := TypedStore.is_tight hs
       have ⟨c0, S0, hl⟩ := Store.label_lookup_exists hs hx
       have hl := Store.bound_label hl hs
-      have ⟨_, hsl⟩ := WellScoped.label_inv hsc hl
+      have ⟨_, hsl⟩ := hr.label_inv hsc hl
       have ⟨handler, tail, hsi⟩ := hsl.has_intercept (L:=.classifier c0)
       cases handler <;> aesop
     case boundary => aesop
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 3a9a3050..2e0c72ff 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -47,8 +47,10 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
--- ^^^ would be interesting to prove, but seems really hard to crack
-| absurd : CaptureKind Γ C K -> K.IsEmpty -> Subcapt Γ C .empty
+
+-- We don't need absurd here because...
+theorem Subcapt.absurd (hk : CaptureKind Γ C K) (he : K.IsEmpty) : Subcapt Γ C .empty := by
+  apply trans (.proj_r hk) (.subset $ .absurd he)
 
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 3e89840d..f09feed6 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -62,9 +62,6 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro
     . apply! trans (.proj_r _) (.subset $ .union_rl .rfl)
     . apply! trans (.proj_r _) (.subset $ .union_rr .rfl)
-  case absurd he hk =>
-    have ⟨_, _⟩ := hk.union_l_inv
-    apply And.intro <;> apply! absurd
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 
@@ -135,13 +132,11 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     . simp only [CaptureSet.proj_proj]
       apply subset (.subkind _)
       apply Kind.Intersect.subkind_symm
-  case absurd hk he =>
-    simp
-    apply absurd _ he
-    apply CaptureKind.sub _ hk.apply_proj
-    apply Kind.Intersect.subkind_l
 
 theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
   rw [← Kind.intersect.top_l (K:=K)]
   rw [← CaptureSet.proj, Kind.intersect.top_l]
   apply! apply_proj
+
+theorem Subcapt.apply_proj_r (hs : Subcapt Γ C D) (hk : CaptureKind Γ C K) : Subcapt Γ C (D.proj K) := by
+  apply trans (.proj_r hk) hs.apply_proj
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index 7a6243de..72bf3eaf 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -383,7 +383,6 @@ theorem CaptureKind.subcapt
   case cinstr => apply! cinstr
   case cbound => apply! cbound
   case proj_r hk1 => apply! proj_r
-  case absurd hk1 he => apply sub _ hk1; apply Kind.Subkind.is_empty_l he
 
 theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
   induction hk generalizing L
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index f58054e5..ac1a84c2 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -48,6 +48,6 @@ theorem Subcapt.csubst
   case cbound hb =>
     cases σ.cmap_bound _ _ hb
     apply! apply_proj_singleton
-  case absurd hk he => apply! absurd (hk.csubst _)
+  case proj_r hk => apply! proj_r (hk.csubst _)
 
 end Capless
diff --git a/Capless/Subst/Term/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean
index 39d3c4e2..811a26bc 100644
--- a/Capless/Subst/Term/Subcapturing.lean
+++ b/Capless/Subst/Term/Subcapturing.lean
@@ -47,6 +47,6 @@ theorem Subcapt.subst
   case cinstl hb => apply cinstl (σ.cmap _ _ hb)
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
-  case absurd hk he => apply! absurd (hk.subst _)
+  case proj_r hk => apply! proj_r (hk.subst _)
 
 end Capless
diff --git a/Capless/Subst/Type/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean
index 68f4ecf2..5bd77177 100644
--- a/Capless/Subst/Type/Subcapturing.lean
+++ b/Capless/Subst/Type/Subcapturing.lean
@@ -36,6 +36,6 @@ theorem Subcapt.tsubst
   case cinstl hb => apply cinstl (σ.cmap _ _ hb)
   case cinstr hb => apply cinstr (σ.cmap _ _ hb)
   case cbound hb => apply cbound (σ.cmap _ _ hb)
-  case absurd hk he => apply! absurd (hk.tsubst _)
+  case proj_r hk => apply! proj_r (hk.tsubst _)
 
 end Capless
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index d203074d..3b7d238a 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -2,6 +2,7 @@ import Capless.Store
 import Capless.Subcapturing
 import Capless.Subcapturing.Basic
 import Capless.Inversion.Context
+import Capless.WellScoped.ReachSet
 
 /-!
 # Basic Properties of Well-Scopedness
diff --git a/Capless/WellScoped/ReachSet.lean b/Capless/WellScoped/ReachSet.lean
index c2a022e9..4bfe9a5f 100644
--- a/Capless/WellScoped/ReachSet.lean
+++ b/Capless/WellScoped/ReachSet.lean
@@ -484,9 +484,6 @@ theorem ReachSet.subcapt
   case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
   case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
   case proj_r hk => apply! proj_r
-  case absurd hk he =>
-    cases hr2
-    apply capture_kind_absurd hk he
 
 theorem ReachSet.is_subcapt
   (hr : ReachSet Γ C R)

From 1748280c9de66a1901efabd34089c899dd5976b3 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 25 Dec 2025 20:13:08 +0100
Subject: [PATCH 65/71] Some in progress failures, ReachSet is confusing me a
 little bit

What exactly happens to the reach set as evaluation continues?
Seems like it should be obvious that a term like

```
[c^] -> t
```

What would it be like to run substitution and recompute the reach set?
---
 Capless/ReachSet.lean                    |  33 +++++
 Capless/Renaming/Capture/Subtyping.lean  |   8 ++
 Capless/Renaming/Capture/Typing.lean     |  35 ++++++
 Capless/Renaming/Term/Subtyping.lean     |   8 ++
 Capless/Renaming/Term/Typing.lean        |  35 ++++++
 Capless/Renaming/Type/Subtyping.lean     |   8 ++
 Capless/Renaming/Type/Typing.lean        |  32 +++++
 Capless/Soundness/Preservation.lean      |  61 +++++----
 Capless/Store.lean                       |  28 +----
 Capless/Subst/Basic.lean                 |  43 ++++---
 Capless/Subst/Capture/Typing.lean        |  56 +++++++++
 Capless/Subst/Type/Typing.lean           |  30 +++++
 Capless/Subtyping.lean                   |  13 ++
 Capless/Typing.lean                      |   7 +-
 Capless/Weakening/Subtyping.lean         |  12 ++
 Capless/Weakening/TypedCont/Capture.lean |  58 +++++----
 Capless/Weakening/TypedCont/Term.lean    | 151 +++++++++++++++--------
 Capless/Weakening/TypedCont/Type.lean    |  58 +++++----
 18 files changed, 498 insertions(+), 178 deletions(-)
 create mode 100644 Capless/ReachSet.lean

diff --git a/Capless/ReachSet.lean b/Capless/ReachSet.lean
new file mode 100644
index 00000000..c8b5d5d1
--- /dev/null
+++ b/Capless/ReachSet.lean
@@ -0,0 +1,33 @@
+import Capless.CaptureSet
+import Capless.Context
+
+namespace Capless
+
+/-- Computes the reach set of a capture set. The reach set should only consist of capture variables and -/
+inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
+| empty : ReachSet Γ .empty .empty
+| union :
+  ReachSet Γ C1 R1 ->
+  ReachSet Γ C2 R2 ->
+  ReachSet Γ (C1 ∪ C2) (R1 ∪ R2)
+| var :
+  Context.Bound Γ x (S^C) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {x=x|L} R
+| cinstr :
+  Context.CBound Γ c (CBinding.inst C) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {c=c|L} R
+| cbound :
+  Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
+  ReachSet Γ (C.proj L) R ->
+  ReachSet Γ {c=c|L} R
+| ckind :
+  Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
+  ReachSet Γ {c=c|L} {c=c|K.intersect L}
+| label :
+  Context.LBound Γ x c S ->
+  ReachSet Γ {x=x|L} {x=x|(Kind.classifier c).intersect L}
+| absurd : K.IsEmpty -> ReachSet Γ (.singleton s K) {}
+
+end Capless
diff --git a/Capless/Renaming/Capture/Subtyping.lean b/Capless/Renaming/Capture/Subtyping.lean
index ef8cf3b0..fe07caff 100644
--- a/Capless/Renaming/Capture/Subtyping.lean
+++ b/Capless/Renaming/Capture/Subtyping.lean
@@ -32,6 +32,14 @@ theorem Subbound.crename
     apply CaptureKind.crename _ ρ
     trivial
 
+theorem TightSubbound.crename
+  (h : TightSubbound Γ c B)
+  (ρ : CVarMap Γ f Δ)
+  : TightSubbound Δ (f c) (B.crename f) := by
+  cases h
+  case upper hs =>  apply upper; apply! hs.crename
+  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
+
 def SSubtyp.crename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Renaming/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean
index 8b95bd14..534f5ef1 100644
--- a/Capless/Renaming/Capture/Typing.lean
+++ b/Capless/Renaming/Capture/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Capture.Subtyping
 import Capless.Renaming.Capture.CaptureBound
+import Capless.Renaming.Capture.Subcapturing
 
 /-!
 # Capture Variable Renaming for Typing
@@ -13,6 +14,38 @@ capture variables with a valid renaming map, we have `Δ ⊢ t.crename f : E.cre
 
 namespace Capless
 
+theorem ReachSet.crename
+  {Γ : Context n m k} {Δ : Context n m k'}
+  (h : ReachSet Γ C R)
+  (ρ : CVarMap Γ f Δ) :
+  ReachSet Δ (C.crename f) (R.crename f) := by
+  induction h generalizing k'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    simp [CType.crename] at hb1
+    apply var hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply cinstr hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply cbound hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem Typed.crename
   {Γ : Context n m k} {Δ : Context n m k'}
   (h : Typed Γ t E Ct)
@@ -144,5 +177,7 @@ theorem Typed.crename
     simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename] at ih ih2
     apply ih
     apply ih2 ρ
+    apply! ReachSet.crename
+    apply! CaptureSet.Subset.crename
 
 end Capless
diff --git a/Capless/Renaming/Term/Subtyping.lean b/Capless/Renaming/Term/Subtyping.lean
index ba460bd7..96cc3c93 100644
--- a/Capless/Renaming/Term/Subtyping.lean
+++ b/Capless/Renaming/Term/Subtyping.lean
@@ -27,6 +27,14 @@ theorem Subbound.rename
     constructor
     apply CaptureKind.rename <;> easy
 
+theorem TightSubbound.rename
+  (h : TightSubbound Γ c B)
+  (ρ : VarMap Γ f Δ)
+  : TightSubbound Δ c (B.rename f) := by
+  cases h
+  case upper hs =>  apply upper; apply! hs.rename
+  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
+
 def SSubtyp.rename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Renaming/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean
index 38f0426e..a9e1cdb4 100644
--- a/Capless/Renaming/Term/Typing.lean
+++ b/Capless/Renaming/Term/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Term.Subtyping
 import Capless.Renaming.Term.CaptureBound
+import Capless.Renaming.Term.Subcapturing
 
 /-!
 # Term Variable Renaming for Typing
@@ -12,6 +13,38 @@ term variables with a valid renaming map, we have `Δ ⊢ t.rename f : E.rename
 -/
 namespace Capless
 
+theorem ReachSet.rename
+  {Γ : Context n m k} {Δ : Context n' m k}
+  (h : ReachSet Γ C R)
+  (ρ : VarMap Γ f Δ) :
+  ReachSet Δ (C.rename f) (R.rename f) := by
+  induction h generalizing n'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    simp [CType.rename] at hb1
+    apply var hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply cinstr hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply cbound hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem Typed.rename
   {Γ : Context n m k} {Δ : Context n' m k}
   (h : Typed Γ t E Ct)
@@ -145,5 +178,7 @@ theorem Typed.rename
     simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ih ih2
     apply ih
     apply ih2 ρ
+    apply! ReachSet.rename
+    apply! CaptureSet.Subset.rename
 
 end Capless
diff --git a/Capless/Renaming/Type/Subtyping.lean b/Capless/Renaming/Type/Subtyping.lean
index f1513c2a..555a9bcd 100644
--- a/Capless/Renaming/Type/Subtyping.lean
+++ b/Capless/Renaming/Type/Subtyping.lean
@@ -26,6 +26,14 @@ theorem Subbound.trename
     constructor
     apply CaptureKind.trename <;> easy
 
+theorem TightSubbound.trename
+  (h : TightSubbound Γ c B)
+  (ρ : TVarMap Γ f Δ)
+  : TightSubbound Δ c B := by
+  cases h
+  case upper hs =>  apply upper; apply! hs.trename
+  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
+
 def SSubtyp.trename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean
index f524d6dd..c1da5d1a 100644
--- a/Capless/Renaming/Type/Typing.lean
+++ b/Capless/Renaming/Type/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Typing
 import Capless.Renaming.Basic
 import Capless.Renaming.Type.Subtyping
 import Capless.Renaming.Type.CaptureBound
+import Capless.Renaming.Type.Subcapturing
 
 /-!
 # Type Variable Renaming for Typing
@@ -12,6 +13,34 @@ type variables with a valid renaming map, we have `Δ ⊢ t.trename f : E.trenam
 -/
 namespace Capless
 
+theorem ReachSet.trename
+  {Γ : Context n m k} {Δ : Context n m' k}
+  (h : ReachSet Γ C R)
+  (ρ : TVarMap Γ f Δ) :
+  ReachSet Δ C R := by
+  induction h generalizing m'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    apply var hb1
+    exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    apply cinstr hb1
+    exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    apply cbound hb1
+    exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem Typed.trename
   {Γ : Context n m k} {Δ : Context n m' k}
   (h : Typed Γ t E Ct)
@@ -134,4 +163,7 @@ theorem Typed.trename
     simp [← SType.weaken_trename, ← SType.tweaken_trename] at ih ih2
     apply ih
     apply ih2 ρ
+    apply! ReachSet.trename
+    assumption
+
 end Capless
diff --git a/Capless/Soundness/Preservation.lean b/Capless/Soundness/Preservation.lean
index 9e336db1..adff47d4 100644
--- a/Capless/Soundness/Preservation.lean
+++ b/Capless/Soundness/Preservation.lean
@@ -26,22 +26,27 @@ This module proves that the reduction of a well-typed term preserves its type. T
 
 namespace Capless
 
-inductive Preserve : Context n m k -> EType n m k -> State n' m' k' -> Prop where
+inductive Preserve : Context n m k -> EType n m k -> CaptureSet n k -> State n' m' k' -> Prop where
 | mk :
-  TypedState state Γ E ->
-  Preserve Γ E state
+  TypedState state Γ E R' ->
+  R' ⊆ R ->
+  Preserve Γ E R state
 | mk_weaken :
-  TypedState state (Γ.var P) E.weaken ->
-  Preserve Γ E state
+  TypedState state (Γ.var P) E.weaken R' ->
+  R' ⊆ (R.weaken ∪ {x=0|.top}) ->
+  Preserve Γ E R state
 | mk_tweaken :
-  TypedState state (Γ.tvar b) E.tweaken ->
-  Preserve Γ E state
+  TypedState state (Γ.tvar b) E.tweaken R' ->
+  R' ⊆ R ->
+  Preserve Γ E R state
 | mk_cweaken :
-  TypedState state (Γ.cvar b) E.cweaken ->
-  Preserve Γ E state
+  TypedState state (Γ.cvar b) E.cweaken R' ->
+  R' ⊆ (R.cweaken ∪ {c=0|.top}) ->
+  Preserve Γ E R state
 | mk_enter :
-  TypedState state ((Γ.label c S).cvar b) E.weaken.cweaken ->
-  Preserve Γ E state
+  TypedState state ((Γ.label c S).cvar b) E.weaken.cweaken R' ->
+  R' ⊆ (R.weaken.cweaken ∪ {x=0|.top} ∪ {c=0|.top}) ->
+  Preserve Γ E R state
 
 theorem value_typing_widen
   (hv : Typed Γ v (EType.type (S^C)) Cv)
@@ -64,17 +69,31 @@ theorem EType.weaken_cweaken_helper {S : SType n m k} :
 
 theorem preservation
   (hr : Reduce state state')
-  (ht : TypedState state Γ E) :
-  Preserve Γ E state' := by
+  (ht : TypedState state Γ E R) :
+  Preserve Γ E R state' := by
   cases hr
-  case apply hl =>
+  case apply y _ hl =>
     cases ht
-    case mk hs hsc ht hc =>
+    case mk hs ht hc hr hsc =>
       have hg := TypedStore.is_tight hs
       have ⟨T0, Cf, F0, E0, hx, hy, he1, hs1⟩:= Typed.app_inv ht
       have ⟨Sv, Cv, Cv0, hv, hbx, hvs⟩ := Store.lookup_inv_typing hl hs hx
       have hv' := value_typing_widen hv hvs
       have ⟨hcfs, hcft⟩ := Typed.canonical_form_lam hg hv'
+      have ⟨R', hsub', hr'⟩ : ∃ R' ⊆ R, ReachSet Γ ((Cv.weaken ∪ {x=0|.top}).open y) R' := by {
+        have ht1 := Typed.app_inv_capt ht
+        have ⟨R1, hss1, h1⟩ := hr.subcapt ht1
+        simp [CaptureSet.open]
+        simp [FinFun.open, CaptureSet.weaken, CaptureSet.rename_rename]
+        simp [FinFun.open_comp_weaken, CaptureSet.rename_id]
+        cases h1; rename_i R2 R3 h2 h3
+        have ⟨hss1l, hss1r⟩ := CaptureSet.Subset.union_l_inv hss1
+        have ⟨RCv, hscv, hcv⟩ := h2.var_inv hbx
+        exists RCv ∪ R3
+        apply And.intro
+        . apply CaptureSet.Subset.union_l (.trans hscv hss1l) hss1r
+        . apply hcv.union h3
+      }
       constructor
       constructor
       { easy }
@@ -84,16 +103,8 @@ theorem preservation
         { apply Subcapt.rfl }
         { subst he1
           easy } }
-      { have h1 := Typed.app_inv_capt ht
-        have h2 := WellScoped.subcapt hsc h1
-        simp [CaptureSet.open]
-        simp [FinFun.open, CaptureSet.weaken, CaptureSet.rename_rename]
-        simp [FinFun.open_comp_weaken, CaptureSet.rename_id]
-        cases h2; rename_i h2 h3
-        apply WellScoped.union
-        { apply WellScoped.var_inv
-          exact h2; easy }
-        { easy } }
+      { exact hr' }
+      { apply! hsc.subset }
       { simp [CaptureSet.open, CaptureSet.rename, FinFun.open]
         simp [CaptureSet.weaken, CaptureSet.rename_rename, FinFun.open_comp_weaken, CaptureSet.rename_id]
         easy }
diff --git a/Capless/Store.lean b/Capless/Store.lean
index d98b6c86..a4768133 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -3,6 +3,7 @@ import Capless.Type
 import Capless.CaptureSet
 import Capless.Context
 import Capless.Typing
+import Capless.ReachSet
 
 /-!
 # Evaluation States
@@ -169,33 +170,6 @@ theorem Cont.HasLabel.has_intercept (hl : HasLabel cont l tail) : ∃ h tail', H
     . exists .some h0, cont; apply HasIntercept.here_intercept hl hd;
     . exists h, tail; apply! HasIntercept.there_intercept
 
-/-- Computes the reach set of a capture set. The reach set should only consist of capture variables and -/
-inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
-| empty : ReachSet Γ .empty .empty
-| union :
-  ReachSet Γ C1 R1 ->
-  ReachSet Γ C2 R2 ->
-  ReachSet Γ (C1 ∪ C2) (R1 ∪ R2)
-| var :
-  Context.Bound Γ x (S^C) ->
-  ReachSet Γ (C.proj L) R ->
-  ReachSet Γ {x=x|L} R
-| cinstr :
-  Context.CBound Γ c (CBinding.inst C) ->
-  ReachSet Γ (C.proj L) R ->
-  ReachSet Γ {c=c|L} R
-| cbound :
-  Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
-  ReachSet Γ (C.proj L) R ->
-  ReachSet Γ {c=c|L} R
-| ckind :
-  Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
-  ReachSet Γ {c=c|L} {c=c|K.intersect L}
-| label :
-  Context.LBound Γ x c S ->
-  ReachSet Γ {x=x|L} {x=x|(Kind.classifier c).intersect L}
-| absurd : K.IsEmpty -> ReachSet Γ (.singleton s K) {}
-
 /-- Checks whether a capture set is well-scoped under a context and a continuation stack.
  -- A capture set is well-scoped if any label transitively reachable from it is in the scope of the continuation stack (via `Cont.HasLabel`).
  -- This is an invariant to be maintained thoroughout evaluation. -/
diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index b47c8b12..bd8747f7 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -91,7 +91,7 @@ structure CVarSubst (Γ : Context n m k) (f : FinFun k k') (Δ : Context n m k')
   cmap : ∀ c C, Γ.CBound c (CBinding.inst C) ->
     Δ.CBound (f c) (CBinding.inst (C.crename f))
   cmap_bound : ∀ c B, Γ.CBound c (CBinding.bound B) ->
-    Subbound Δ (CBound.upper {c=f c|.top}) (B.crename f)
+    TightSubbound Δ (f c) (B.crename f)
   lmap : ∀ l c S, Γ.LBound l c S -> Δ.LBound l c (S.crename f)
 
 def VarSubst.ext {Γ : Context n m k}
@@ -476,9 +476,7 @@ def CVarSubst.ext {Γ : Context n m k}
     cases b0 <;> cases he0
     have h := σ.cmap_bound _ _ hb'
     rw [<- CBound.crename_rename_comm]
-    rw [<- CaptureSet.weaken_csingleton]
-    rw [<- CBound.weaken_upper]
-    apply Subbound.weaken; easy
+    apply TightSubbound.weaken; easy
 
 def CVarSubst.text {Γ : Context n m k}
   (σ : CVarSubst Γ f Δ) :
@@ -515,7 +513,7 @@ def CVarSubst.text {Γ : Context n m k}
       cases hb
       rename_i hb0
       have h0 := σ.cmap_bound _ _ hb0
-      apply Subbound.tweaken; easy
+      apply TightSubbound.tweaken; easy
     case lmap =>
       intros l c S hb
       cases hb
@@ -596,8 +594,7 @@ def CVarSubst.cext {Γ : Context n m k}
       cases cb
       case kind k =>
         simp only [CBinding.crename, CBound.crename]
-        apply Subbound.set_kind
-        apply CaptureKind.cvar_top .here
+        apply TightSubbound.kind .here .rfl
       case upper D0 =>
         constructor
         apply Subcapt.cbound_top
@@ -723,17 +720,31 @@ def CVarSubst.narrow
     have h := Context.cvar_cbound_inv hb
     cases h
     case inl h =>
-      have ⟨he1, he2⟩ := h
-      cases he1; cases he2
+      have ⟨he1, he2⟩ := h; simp_all
       simp [CBound.crename_id]
       simp [FinFun.id]
-      apply Subbound.trans (B2:=B'.cweaken)
-      { cases B' <;> constructor
-        apply Subcapt.cbound_top
-        constructor
-        apply CaptureKind.cvar_top
-        constructor }
-      { apply Subbound.cweaken; easy }
+      cases hs
+      case set hs =>
+        cases he2
+        apply TightSubbound.upper (.trans (.cbound .here) _)
+        rw [← CaptureSet.proj_crename, CaptureSet.proj_top]
+        apply hs.cweaken
+      case kind hsk =>
+        cases he2
+        apply TightSubbound.kind .here hsk
+      case set_kind hk =>
+        cases he2
+
+
+
+
+      -- apply Subbound.trans (B2:=B'.cweaken)
+      -- { cases B' <;> constructor
+      --   apply Subcapt.cbound_top
+      --   constructor
+      --   apply CaptureKind.cvar_top
+      --   constructor }
+      -- { apply Subbound.cweaken; easy }
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases b1 <;> cases he1
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index a19280d0..e71582d2 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -2,6 +2,7 @@ import Capless.Subst.Basic
 import Capless.Subst.Capture.Subtyping
 import Capless.Subst.Capture.CaptureBound
 import Capless.Typing
+import Capless.WellScoped.Basic
 
 /-
 Substitution theorems for capture variable substitution in typing judgments.
@@ -9,6 +10,61 @@ Substitution theorems for capture variable substitution in typing judgments.
 
 namespace Capless
 
+theorem ReachSet.csubst
+  {Γ : Context n m k} {Δ : Context n m k'}
+  (h : ReachSet Γ C R)
+  (σ : CVarSubst Γ f Δ) :
+  ∃ R' ⊆ R.crename f, ReachSet Δ (C.crename f) R' := by
+  induction h generalizing k'
+  case empty => exists .empty; apply And.intro .empty .empty
+  case union ih1 ih2 =>
+    have ⟨R1, hs1, h1⟩ := ih1 σ
+    have ⟨R2, hs2, h2⟩ := ih2 σ
+    exists R1 ∪ R2
+    simp
+    apply And.intro $ CaptureSet.Subset.union_monotone hs1 hs2
+    apply! union
+  case var hb hr ih =>
+    have hb1 := σ.map _ _ hb
+    simp [CType.crename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply var hb1
+    rw [← CaptureSet.proj_crename]; exact h
+  case cinstr hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply cinstr hb1
+    rw [← CaptureSet.proj_crename]; exact h
+  case cbound L _ hb hr ih =>
+    have hb1 := σ.cmap_bound _ _ hb
+    cases hb1; rename_i hb1
+    have ⟨R1, hs1, h1⟩ := ih σ
+    have hb1' := hb1.apply_proj (K:=L)
+    rw [CaptureSet.proj, Kind.intersect.top_l, ← CaptureSet.proj_crename] at hb1'
+    have ⟨R2, hs2, h2⟩ := h1.subcapt hb1'
+    exists R2
+    apply And.intro $ hs2.trans hs1
+    exact h2
+  case ckind c K L hb =>
+    have hb1 := σ.cmap_bound _ _ hb
+    cases hb1; rename_i hb1
+    have hb1' := hb1.apply_proj (K:=K) (L:=L)
+    rw [CaptureSet.proj, Kind.intersect.top_l] at hb1'
+    exists {c=f c|(K.intersect L).intersect L}
+    apply And.intro
+    . apply CaptureSet.Subset.singleton_subkind Kind.Intersect.subkind_l
+    . apply! ckind hb1'
+
+  case label hb =>
+    have hb1 := σ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem Typed.csubst
   {Γ : Context n m k} {Δ : Context n m k'}
   (h : Typed Γ t E Ct)
diff --git a/Capless/Subst/Type/Typing.lean b/Capless/Subst/Type/Typing.lean
index 13610c42..241c03a8 100644
--- a/Capless/Subst/Type/Typing.lean
+++ b/Capless/Subst/Type/Typing.lean
@@ -9,6 +9,35 @@ Substitution theorems for type variable substitution in typing judgments.
 
 namespace Capless
 
+
+theorem ReachSet.tsubst
+  {Γ : Context n m k} {Δ : Context n m' k}
+  (h : ReachSet Γ C R)
+  (σ : TVarSubst Γ f Δ) :
+  ReachSet Δ C R := by
+  induction h generalizing m'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 σ) (ih2 σ)
+  case var hb hr ih =>
+    have hb1 := σ.map _ _ hb
+    apply var hb1
+    exact ih σ
+  case cinstr hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    apply cinstr hb1
+    exact ih σ
+  case cbound hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    apply cbound hb1
+    exact ih σ
+  case ckind hb =>
+    have hb1 := σ.cmap _ _ hb
+    apply ckind hb1
+  case label hb =>
+    have hb1 := σ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem Typed.tsubst
   {Γ : Context n m k} {Δ : Context n m' k}
   (h : Typed Γ t E Ct)
@@ -130,6 +159,7 @@ theorem Typed.tsubst
       simp [← SType.weaken_trename, ← SType.tweaken_trename] at ih ih2
       apply ih
       apply! ih2
+      apply! ReachSet.tsubst
 
 theorem Typed.topen
   (h : Typed (Γ,X<: (SType.tvar X)) t E Ct) :
diff --git a/Capless/Subtyping.lean b/Capless/Subtyping.lean
index 148d9f79..3a62c8aa 100644
--- a/Capless/Subtyping.lean
+++ b/Capless/Subtyping.lean
@@ -20,6 +20,19 @@ inductive Subbound : Context n m k -> CBound n k -> CBound n k -> Prop where
   Kind.Subkind k1 k2 -> Subbound Γ (CBound.kind k1) (CBound.kind k2)
 | set_kind :
   CaptureKind Γ C K -> Subbound Γ (CBound.upper C) (CBound.kind K)
+
+/-- Stronger version of subbounds: it keeps track of the binding in the case of a kind-bounded csv. -/
+inductive TightSubbound : Context n m k -> Fin k -> CBound n k -> Prop where
+  | set : Subcapt Γ {c=c|.top} C -> TightSubbound Γ c (.upper C)
+  | kind  :
+    Γ.CBound c (CBinding.bound (.kind K)) ->
+    K.Subkind L ->
+    TightSubbound Γ c (.kind L)
+  | set_kind :
+    Γ.CBound c (CBinding.bound (.upper C)) ->
+    CaptureKind Γ C K ->
+    TightSubbound Γ c (CBound.kind K)
+
 mutual
 
 inductive ESubtyp : Context n m k -> EType n m k -> EType n m k -> Prop where
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 6c020722..3baa991b 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -3,6 +3,7 @@ import Capless.Subtyping
 import Capless.Type
 import Capless.Term
 import Capless.CaptureBound
+import Capless.ReachSet
 
 /-!
 # Typing Rules of Capless
@@ -74,12 +75,14 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ->
   Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
-| intercept {Γ : Context n m k} {S : SType n m k} {C C1 : CaptureSet n k}:
+| intercept {Γ : Context n m k} {S : SType n m k} {C C1 Cr : CaptureSet n k}:
   Typed
-    (((Γ,X<:.top),x:(Label[.tvar 0]^(C.proj K))),x:(SType.tvar 0)^{})
+    (((Γ,X<:.top),x:(Label[.tvar 0]^(Cr.proj K))),x:(SType.tvar 0)^{})
     h
     (S.tweaken.weaken.weaken^{}) (C1.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
   Typed Γ t (S^{}) C ->
+  ReachSet Γ C Cr' ->
+  Cr' ⊆ Cr ->
   Typed Γ (intercept[K] with h in t) (S^{}) (C ∪ C1)
 -- | unwrap {Γ : Context n m k} {S : SType n m k} :
 --   Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->
diff --git a/Capless/Weakening/Subtyping.lean b/Capless/Weakening/Subtyping.lean
index 4619f87a..ab7ffb47 100644
--- a/Capless/Weakening/Subtyping.lean
+++ b/Capless/Weakening/Subtyping.lean
@@ -42,6 +42,10 @@ theorem Subbound.weaken
   { apply h }
   { apply VarMap.weaken }
 
+theorem TightSubbound.weaken
+  (h : TightSubbound Γ c B)
+  : TightSubbound (Γ.var b) c B.weaken := h.rename VarMap.weaken
+
 theorem SSubtyp.lweaken
   (h : SSubtyp Γ S1 S2) :
   ∀ S, SSubtyp (Γ.label c S) S1.weaken S2.weaken := by
@@ -110,6 +114,10 @@ theorem Subbound.tweaken
   apply? Subbound.trename
   apply TVarMap.weaken
 
+theorem TightSubbound.tweaken
+  (h : TightSubbound Γ c B)
+  : TightSubbound (Γ.tvar b) c B := h.trename TVarMap.weaken
+
 theorem ESubtyp.cweaken
   (h : ESubtyp Γ E1 E2) :
   ESubtyp (Γ.cvar b) E1.cweaken E2.cweaken := by
@@ -138,4 +146,8 @@ theorem Subbound.cweaken
   apply? Subbound.crename
   apply CVarMap.weaken
 
+theorem TightSubbound.cweaken
+  (h : TightSubbound Γ c B)
+  : TightSubbound (Γ.cvar b) (FinFun.weaken c) B.cweaken := h.crename CVarMap.weaken
+
 end Capless
diff --git a/Capless/Weakening/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean
index 368c41ef..da835021 100644
--- a/Capless/Weakening/TypedCont/Capture.lean
+++ b/Capless/Weakening/TypedCont/Capture.lean
@@ -70,38 +70,42 @@ theorem Cont.HasLabel.cweaken
   case there_label => simp [Cont.cweaken]; apply there_label; aesop
   case there_intercept => simp [Cont.cweaken]; apply there_intercept; aesop
 
+theorem ReachSet.cweaken
+  (hr : ReachSet Γ C R)
+  : ReachSet (Γ.cvar b) C.cweaken R.cweaken := by
+  induction hr
+  case empty => constructor
+  case union ha hb => apply! union
+  case var hb hr ih =>
+    have hb1 := hb.there_cvar (b:=b)
+    apply var hb1
+    rw [← CaptureSet.proj_crename]; exact ih
+  case cinstr hb hr ih =>
+    have hb1 := hb.there_cvar (b':=b)
+    apply cinstr hb1
+    rw [← CaptureSet.proj_crename]; exact ih
+  case cbound hb hr ih =>
+    have hb1 := hb.there_cvar (b':=b)
+    apply cbound hb1
+    rw [← CaptureSet.proj_crename]; exact ih
+  case ckind hb =>
+    have hb1 := hb.there_cvar (b':=b)
+    apply ckind hb1
+  case label hb =>
+    have hb1 := hb.there_cvar (b:=b)
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem WellScoped.cweaken
   (h : WellScoped Γ E Ct) :
   WellScoped (Γ.cvar b) E.cweaken Ct.cweaken := by
   induction h
-  case empty => constructor
-  case union ih1 ih2 => apply union <;> aesop
-  case singleton hb _ ih =>
-    apply singleton
-    { have hb1 := Context.Bound.there_cvar (b := b) hb
-      simp [CType.cweaken, CType.crename] at hb1
-      exact hb1 }
-    { rw [← CaptureSet.proj_crename]; exact ih }
-  case csingleton hb _ ih =>
-    apply csingleton
-    { have hb1 := Context.CBound.there_cvar (b' := b) hb
-      simp [CType.cweaken, CType.crename] at hb1
-      exact hb1 }
-    { rw [← CaptureSet.proj_cweaken]; exact ih }
-  case cbound hb _ ih =>
-    apply cbound
-    { have hb1 := Context.CBound.there_cvar (b' := b) hb
-      simp [CType.cweaken, CType.crename] at hb1
-      exact hb1 }
-    { rw [← CaptureSet.proj_crename]; exact ih }
-  case ckind hb => apply ckind hb.there_cvar
-  case label hb hs =>
-    apply label
-    { have hb1 := Context.LBound.there_cvar (b := b) hb
-      simp [CType.cweaken, CType.crename] at hb1
-      exact hb1 }
-    { apply hs.cweaken }
+  case empty => apply! empty
+  case union ha hb => apply! union
+  case ckind hb => apply! ckind hb.there_cvar
+  case label hb hl => apply label hb.there_cvar hl.cweaken
   case label_disj hb hd => apply! label_disj hb.there_cvar
+  case absurd => apply! absurd
 
 theorem TypedCont.cweaken
   (h : TypedCont Γ Cin E t E' Ct) :
diff --git a/Capless/Weakening/TypedCont/Term.lean b/Capless/Weakening/TypedCont/Term.lean
index 3ec85285..064a0af2 100644
--- a/Capless/Weakening/TypedCont/Term.lean
+++ b/Capless/Weakening/TypedCont/Term.lean
@@ -73,38 +73,77 @@ theorem Cont.HasLabel.weaken
   case there_intercept ih =>
     apply there_intercept; trivial
 
+-- theorem WellScoped.weaken
+--   (h : WellScoped Γ cont Ct) :
+--   WellScoped (Γ.var T) cont.weaken Ct.weaken := by
+--   induction h
+--   case empty => simp [CaptureSet.weaken]; constructor
+--   case union ih1 ih2 =>
+--     simp [CaptureSet.weaken] at *
+--     apply union <;> aesop
+--   case singleton hb _ ih =>
+--     apply singleton
+--     { simp [FinFun.weaken]
+--       have hb1 := Context.Bound.there_var (E':=T) hb
+--       simp [CType.weaken, CType.rename] at hb1
+--       exact hb1 }
+--     { rw [← CaptureSet.proj_rename]; exact ih }
+--   case csingleton hb _ ih =>
+--     apply csingleton
+--     { have hb1 := Context.CBound.there_var (E:=T) hb
+--       exact hb1 }
+--     { rw [← CaptureSet.proj_rename]; exact ih }
+--   case cbound hb _ ih =>
+--     apply cbound
+--     { have hb1 := Context.CBound.there_var (E:=T) hb
+--       exact hb1 }
+--     { rw [← CaptureSet.proj_rename]; exact ih }
+--   case ckind hb => apply ckind hb.there_var
+--   case label hb hs =>
+--     apply label
+--     { have hb1 := Context.LBound.there_var (E:=T) hb
+--       exact hb1 }
+--     { apply hs.weaken }
+--   case label_disj hb hd => apply label_disj hb.there_var hd
+
+theorem ReachSet.weaken
+  (hr : ReachSet Γ C R)
+  : ReachSet (Γ.var T) C.weaken R.weaken := by
+  induction hr
+  case empty => constructor
+  case union ha hb => apply! union
+  case var hb hr ih =>
+    have hb1 := hb.there_var (E':=T)
+    simp [CType.weaken, CType.rename] at hb1
+    apply var hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case cinstr hb hr ih =>
+    have hb1 := hb.there_var (E:=T)
+    apply cinstr hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case cbound hb hr ih =>
+    have hb1 := hb.there_var (E:=T)
+    apply cbound hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case ckind hb =>
+    have hb1 := hb.there_var (E:=T)
+    apply ckind hb1
+  case label hb =>
+    have hb1 := hb.there_var (E:=T)
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem WellScoped.weaken
   (h : WellScoped Γ cont Ct) :
   WellScoped (Γ.var T) cont.weaken Ct.weaken := by
   induction h
-  case empty => simp [CaptureSet.weaken]; constructor
-  case union ih1 ih2 =>
-    simp [CaptureSet.weaken] at *
-    apply union <;> aesop
-  case singleton hb _ ih =>
-    apply singleton
-    { simp [FinFun.weaken]
-      have hb1 := Context.Bound.there_var (E':=T) hb
-      simp [CType.weaken, CType.rename] at hb1
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
-  case csingleton hb _ ih =>
-    apply csingleton
-    { have hb1 := Context.CBound.there_var (E:=T) hb
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
-  case cbound hb _ ih =>
-    apply cbound
-    { have hb1 := Context.CBound.there_var (E:=T) hb
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
-  case ckind hb => apply ckind hb.there_var
-  case label hb hs =>
-    apply label
-    { have hb1 := Context.LBound.there_var (E:=T) hb
-      exact hb1 }
-    { apply hs.weaken }
-  case label_disj hb hd => apply label_disj hb.there_var hd
+  case empty => apply! empty
+  case union ha hb => apply! union
+  case ckind hb => apply! ckind hb.there_var
+  case label hb hl => apply label hb.there_var hl.weaken
+  case label_disj hb hd => apply! label_disj hb.there_var
+  case absurd => apply! absurd
+
 
 theorem TypedCont.weaken
   (h : TypedCont Γ E Cin t E' C0) :
@@ -185,38 +224,42 @@ theorem Cont.HasLabel.lweaken
     apply there_label; trivial
   case there_intercept => apply! there_intercept
 
+theorem ReachSet.lweaken
+  (hr : ReachSet Γ C R)
+  : ReachSet (Γ.label c S) C.weaken R.weaken := by
+  induction hr
+  case empty => constructor
+  case union ha hb => apply! union
+  case var hb hr ih =>
+    have hb1 := hb.there_label (c:=c) (S:=S)
+    apply var hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case cinstr hb hr ih =>
+    have hb1 := hb.there_label (c:=c) (S:=S)
+    apply cinstr hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case cbound hb hr ih =>
+    have hb1 := hb.there_label (c:=c) (S:=S)
+    apply cbound hb1
+    rw [← CaptureSet.proj_rename]; exact ih
+  case ckind hb =>
+    have hb1 := hb.there_label (c:=c) (S:=S)
+    apply ckind hb1
+  case label hb =>
+    have hb1 := hb.there_label (c':=c) (S':=S)
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem WellScoped.lweaken
   (h : WellScoped Γ cont Ct) :
   WellScoped (Γ.label c S) cont.weaken Ct.weaken := by
   induction h
-  case empty => simp [CaptureSet.weaken]; constructor
-  case union ih1 ih2 =>
-    simp [CaptureSet.weaken] at *
-    apply union <;> aesop
-  case singleton hb _ ih =>
-    apply singleton
-    { simp [FinFun.weaken]
-      have hb1 := Context.Bound.there_label (c:=c) (S:=S) hb
-      simp [CaptureSet.weaken, CaptureSet.rename] at hb1
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
-  case csingleton hb _ ih =>
-    apply csingleton
-    { have hb1 := Context.CBound.there_label (c:=c) (S:=S) hb
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
-  case cbound hb _ ih =>
-    apply cbound
-    { have hb1 := Context.CBound.there_label (c:=c) (S:=S) hb
-      exact hb1 }
-    { rw [← CaptureSet.proj_rename]; exact ih }
+  case empty => apply! empty
+  case union ha hb => apply! union
   case ckind hb => apply! ckind hb.there_label
-  case label hb hs =>
-    apply label
-    { have hb1 := Context.LBound.there_label (c':=c) (S':=S) hb
-      exact hb1 }
-    { apply hs.lweaken }
+  case label hb hl => apply label hb.there_label hl.lweaken
   case label_disj hb hd => apply! label_disj hb.there_label
+  case absurd => apply! absurd
 
 theorem TypedCont.lweaken
   (h : TypedCont Γ Cin E cont E' Ct) :
diff --git a/Capless/Weakening/TypedCont/Type.lean b/Capless/Weakening/TypedCont/Type.lean
index 184f00b6..ae3258a8 100644
--- a/Capless/Weakening/TypedCont/Type.lean
+++ b/Capless/Weakening/TypedCont/Type.lean
@@ -56,38 +56,42 @@ theorem Cont.HasLabel.tweaken
   case there_label => simp [Cont.tweaken]; apply there_label; aesop
   case there_intercept => apply! there_intercept
 
+theorem ReachSet.tweaken
+  (hr : ReachSet Γ C R)
+  : ReachSet (Γ.tvar b) C R := by
+  induction hr
+  case empty => constructor
+  case union ha hb => apply! union
+  case var hb hr ih =>
+    have hb1 := hb.there_tvar (b:=b)
+    apply var hb1
+    exact ih
+  case cinstr hb hr ih =>
+    have hb1 := hb.there_tvar (b':=b)
+    apply cinstr hb1
+    exact ih
+  case cbound hb hr ih =>
+    have hb1 := hb.there_tvar (b':=b)
+    apply cbound hb1
+    exact ih
+  case ckind hb =>
+    have hb1 := hb.there_tvar (b':=b)
+    apply ckind hb1
+  case label hb =>
+    have hb1 := hb.there_tvar (b:=b)
+    apply label hb1
+  case absurd he => apply! absurd
+
 theorem WellScoped.tweaken
   (h : WellScoped Γ cont Ct) :
   WellScoped (Γ.tvar b) cont.tweaken Ct := by
   induction h
-  case empty => constructor
-  case union ih1 ih2 => apply union <;> aesop
-  case singleton hb _ ih =>
-    apply singleton
-    { have hb1 := Context.Bound.there_tvar (b := b) hb
-      simp [CType.tweaken, CType.trename] at hb1
-      exact hb1 }
-    { exact ih }
-  case csingleton hb _ ih =>
-    apply csingleton
-    { have hb1 := Context.CBound.there_tvar (b' := b) hb
-      simp [CType.tweaken, CType.trename] at hb1
-      exact hb1 }
-    { exact ih }
-  case cbound hb _ ih =>
-    apply cbound
-    { have hb1 := Context.CBound.there_tvar (b' := b) hb
-      simp [CType.tweaken, CType.trename] at hb1
-      exact hb1 }
-    { exact ih }
-  case ckind hb => apply ckind hb.there_tvar
-  case label hb hs =>
-    apply label
-    { have hb1 := Context.LBound.there_tvar (b := b) hb
-      simp [CType.tweaken, CType.trename] at hb1
-      exact hb1 }
-    { apply hs.tweaken }
+  case empty => apply! empty
+  case union ha hb => apply! union
+  case ckind hb => apply! ckind hb.there_tvar
+  case label hb hl => apply label hb.there_tvar hl.tweaken
   case label_disj hb hd => apply! label_disj hb.there_tvar
+  case absurd => apply! absurd
 
 theorem TypedCont.tweaken
   (h : TypedCont Γ E Cin t E' C0) :

From 6373e89f88521ee1846390a0ce616b40adcb313c Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Thu, 15 Jan 2026 13:20:27 +0100
Subject: [PATCH 66/71] Some cleanup of TightSubbound and allow Progress

TightSubbound is an attempt to keep track of instantiated capture variables during substitution,
in order to try to forumulate the structure of ReachSet during substitution.
It should have a set_kind case to allow the morphisms to be created (the sorrys)
---
 .claude/settings.local.json             |  7 +++
 Capless/Subst/Basic.lean                | 43 +++++++++--------
 Capless/Subst/Capture/Subcapturing.lean |  3 +-
 Capless/Subst/Capture/Typing.lean       | 28 ++++++------
 Capless/Subst/Term/Typing.lean          | 61 ++++++++++++++++++++++++-
 Capless/Subst/Type/Typing.lean          |  3 +-
 Capless/Subtyping.lean                  | 12 ++---
 7 files changed, 115 insertions(+), 42 deletions(-)
 create mode 100644 .claude/settings.local.json

diff --git a/.claude/settings.local.json b/.claude/settings.local.json
new file mode 100644
index 00000000..8fee127d
--- /dev/null
+++ b/.claude/settings.local.json
@@ -0,0 +1,7 @@
+{
+  "permissions": {
+    "allow": [
+      "Bash(lake build:*)"
+    ]
+  }
+}
diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index bd8747f7..aa145b0c 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -733,7 +733,7 @@ def CVarSubst.narrow
         cases he2
         apply TightSubbound.kind .here hsk
       case set_kind hk =>
-        cases he2
+        cases he2 <;> sorry
 
 
 
@@ -751,16 +751,16 @@ def CVarSubst.narrow
       cases he2
       simp [FinFun.id, CBound.crename_id]
       rename_i cb0
-      cases cb0 <;> constructor
-      apply Subcapt.cbound_top
-      have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
-      simp [CBinding.cweaken] at hb1'
-      exact hb1'
-      simp [CBound.crename] at hb
-      apply CaptureKind.cvar_top
-      have h1 := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
-      simp [CBinding.cweaken, CBinding.crename, CBound.crename] at h1
-      assumption
+      cases cb0 <;> constructor <;> sorry
+      -- apply Subcapt.cbound_top
+      -- have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
+      -- simp [CBinding.cweaken] at hb1'
+      -- exact hb1'
+      -- simp [CBound.crename] at hb
+      -- apply CaptureKind.cvar_top
+      -- have h1 := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
+      -- simp [CBinding.cweaken, CBinding.crename, CBound.crename] at h1
+      -- assumption
   case lmap =>
     intro x cl S hb
     simp [SType.crename_id]
@@ -916,8 +916,9 @@ def CVarSubst.open :
       simp [FinFun.open_comp_weaken, CBound.crename_id]
       rename_i cb; cases cb
       case kind K =>
-        apply Subbound.set_kind
-        apply CaptureKind.cvar_top hb1
+        sorry
+        -- apply Subbound.set_kind
+        -- apply CaptureKind.cvar_top hb1
       case upper D0 =>
         constructor
         apply Subcapt.cbound_top
@@ -978,9 +979,12 @@ def CVarSubst.instantiate {Γ : Context n m k}
       constructor
       rename_i hk
       have h1 := CaptureKind.cweaken (b:=.inst C) hk
-      apply CaptureKind.subcapt (C2:=C.cweaken) h1
-      apply Subcapt.cinstr_top
-      apply Context.CBound.here
+      sorry
+      sorry
+      sorry
+      -- apply CaptureKind.subcapt (C2:=C.cweaken) h1
+      -- apply Subcapt.cinstr_top
+      -- apply Context.CBound.here
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases he2
@@ -990,9 +994,10 @@ def CVarSubst.instantiate {Γ : Context n m k}
       cases cb
       case kind K1 =>
         simp [CBound.crename]
-        constructor
-        apply CaptureKind.cvar_top
-        exact hb1.there_cvar (b':=.inst C)
+        sorry
+        -- constructor
+        -- apply CaptureKind.cvar_top
+        -- exact hb1.there_cvar (b':=.inst C)
         -- have hb2 := hb1
       case upper D0 =>
         constructor
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index ac1a84c2..80dd97a8 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -18,7 +18,8 @@ theorem CaptureKind.csubst
   case label hb => apply label (σ.lmap _ _ _ hb)
   case cvar hb =>
     cases σ.cmap_bound _ _ hb
-    apply! apply_proj_singleton
+    rename_i hb1 hs1
+    apply sub (Kind.Intersect.with_subkind_r hs1) (cvar hb1)
   case cbound hb hk ih =>
     rewrite [CaptureSet.proj_crename] at ih
     cases σ.cmap_bound _ _ hb
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index e71582d2..ba17de0f 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -52,18 +52,20 @@ theorem ReachSet.csubst
     exact h2
   case ckind c K L hb =>
     have hb1 := σ.cmap_bound _ _ hb
-    cases hb1; rename_i hb1
-    have hb1' := hb1.apply_proj (K:=K) (L:=L)
-    rw [CaptureSet.proj, Kind.intersect.top_l] at hb1'
-    exists {c=f c|(K.intersect L).intersect L}
+    cases hb1; rename_i K' hb1 hs1
+    exists {c=f c|(K'.intersect L)}
     apply And.intro
-    . apply CaptureSet.Subset.singleton_subkind Kind.Intersect.subkind_l
-    . apply! ckind hb1'
-
-  case label hb =>
+    . simp only [CaptureSet.crename]; apply CaptureSet.Subset.singleton_subkind; apply Kind.Intersect.with_subkind_r hs1
+    . apply! ckind
+  case label c S L hb =>
     have hb1 := σ.lmap _ _ _ hb
-    apply label hb1
-  case absurd he => apply! absurd
+    rename_i x
+    exists {x=x|((Kind.classifier c).intersect L)}
+    apply And.intro
+    . apply CaptureSet.Subset.rfl
+    . apply label hb1
+  case absurd he =>
+    exists ∅; apply And.intro; apply CaptureSet.Subset.empty; apply! absurd
 
 theorem Typed.csubst
   {Γ : Context n m k} {Δ : Context n m k'}
@@ -187,9 +189,10 @@ theorem Typed.csubst
          , <- CaptureSet.weaken_crename
          , <- CaptureSet.cweaken_crename ] at ih
       aesop
-    case intercept ih ih2 =>
+    case intercept hr hs ih ih2 =>
       simp [Term.crename]
-      apply intercept
+      have ⟨R1, hrs1, hr1⟩ := hr.csubst σ
+      apply intercept _ _ hr1 (CaptureSet.Subset.trans hrs1 hs.crename)
       have ih := ih $ (σ.text.ext _).ext _
       simp [TBinding.crename, EType.crename, CType.crename, SType.crename] at ih ih2
       simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename] at ih ih2
@@ -197,7 +200,6 @@ theorem Typed.csubst
       apply! ih2
 
 
-
 theorem Typed.copen
   (h : Typed (Γ,c<:CBound.upper {c=c|.top}) t E Ct) :
   Typed Γ (t.copen c) (E.copen c) (Ct.copen c) := by
diff --git a/Capless/Subst/Term/Typing.lean b/Capless/Subst/Term/Typing.lean
index a99f5621..7e0deaf4 100644
--- a/Capless/Subst/Term/Typing.lean
+++ b/Capless/Subst/Term/Typing.lean
@@ -3,6 +3,7 @@ import Capless.Subst.Basic
 import Capless.Subst.Term.Subtyping
 import Capless.Renaming.Term.Typing
 import Capless.Renaming.Term.CaptureBound
+import Capless.WellScoped.ReachSet
 
 /-
 Substitution theorems for term variable substitution in typing judgments.
@@ -10,6 +11,61 @@ Substitution theorems for term variable substitution in typing judgments.
 
 namespace Capless
 
+theorem ReachSet.subst
+  {Γ : Context n m k} {Δ : Context n' m k}
+  (h : ReachSet Γ C R)
+  (σ : VarSubst Γ f Δ) :
+  ∃ R' ⊆ R.rename f, ReachSet Δ (C.rename f) R' := by
+  induction h generalizing n'
+  case empty => exists .empty; apply And.intro .empty .empty
+  case union ih1 ih2 =>
+    have ⟨R1, hs1, h1⟩ := ih1 σ
+    have ⟨R2, hs2, h2⟩ := ih2 σ
+    exists R1 ∪ R2
+    simp
+    apply And.intro $ CaptureSet.Subset.union_monotone hs1 hs2
+    apply! union
+  case var L _ hb hr ih =>
+    have hb1 := σ.map _ _ hb
+    have hs1 := Typing.inv_subcapt hb1
+    have hs2 := hs1.apply_proj (K:=L)
+    rw [CaptureSet.proj, Kind.intersect.top_l, ← CaptureSet.proj_rename] at hs2
+    have ⟨R, hs, h⟩ := ih σ
+    have ⟨R', hs', hr'⟩ := h.subcapt hs2
+    exists R'
+    apply And.intro (hs'.trans hs) hr'
+  case cinstr hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply cinstr hb1
+    rw [← CaptureSet.proj_rename]; exact h
+  case cbound hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply cbound hb1
+    rw [← CaptureSet.proj_rename]; exact h
+  case ckind hb =>
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply Exists.intro
+    apply And.intro .rfl
+    simp only [CaptureSet.rename]
+    apply! ReachSet.ckind
+  case label hb =>
+    have hb1 := σ.lmap _ _ _ hb
+    apply Exists.intro
+    apply And.intro
+    . apply CaptureSet.Subset.rfl
+    . apply label hb1
+  case absurd he =>
+    exists ∅; apply And.intro; apply CaptureSet.Subset.empty; apply! absurd
+
 theorem Typed.subst
   {Γ : Context n m k} {Δ : Context n' m k}
   (h : Typed Γ t E Ct)
@@ -138,9 +194,10 @@ theorem Typed.subst
       , CaptureSet.cweaken_rename_comm
       , FinFun.ext ] at ih
     exact ih
-  case intercept ih ih2 =>
+  case intercept hr hs ih ih2 =>
     simp [Term.rename]
-    apply intercept
+    have ⟨R1, hs1, hr1⟩ := hr.subst σ
+    apply intercept _ _ hr1 (hs1.trans hs.rename)
     have ih := ih $ (σ.text.ext _).ext _
     simp [TBinding.rename, EType.rename, CType.rename, SType.rename] at ih ih2
     simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ih ih2
diff --git a/Capless/Subst/Type/Typing.lean b/Capless/Subst/Type/Typing.lean
index 241c03a8..820160da 100644
--- a/Capless/Subst/Type/Typing.lean
+++ b/Capless/Subst/Type/Typing.lean
@@ -151,7 +151,7 @@ theorem Typed.tsubst
          , <- SType.weaken_trename
          , <- SType.cweaken_trename ] at ih
       aesop
-    case intercept ih ih2 =>
+    case intercept hr hs ih ih2 =>
       simp [Term.trename]
       apply intercept
       have ih := ih $ ((σ.text _).ext _).ext _
@@ -160,6 +160,7 @@ theorem Typed.tsubst
       apply ih
       apply! ih2
       apply! ReachSet.tsubst
+      apply hs
 
 theorem Typed.topen
   (h : Typed (Γ,X<: (SType.tvar X)) t E Ct) :
diff --git a/Capless/Subtyping.lean b/Capless/Subtyping.lean
index 3a62c8aa..17bb9d9c 100644
--- a/Capless/Subtyping.lean
+++ b/Capless/Subtyping.lean
@@ -23,15 +23,15 @@ inductive Subbound : Context n m k -> CBound n k -> CBound n k -> Prop where
 
 /-- Stronger version of subbounds: it keeps track of the binding in the case of a kind-bounded csv. -/
 inductive TightSubbound : Context n m k -> Fin k -> CBound n k -> Prop where
-  | set : Subcapt Γ {c=c|.top} C -> TightSubbound Γ c (.upper C)
-  | kind  :
+  | upper : Subcapt Γ {c=c|.top} C -> TightSubbound Γ c (.upper C)
+  | kind :
     Γ.CBound c (CBinding.bound (.kind K)) ->
     K.Subkind L ->
     TightSubbound Γ c (.kind L)
-  | set_kind :
-    Γ.CBound c (CBinding.bound (.upper C)) ->
-    CaptureKind Γ C K ->
-    TightSubbound Γ c (CBound.kind K)
+  -- | set_kind :
+  --   Γ.CBound c (CBinding.bound (.upper C)) ->
+  --   CaptureKind Γ C K ->
+  --   TightSubbound Γ c (CBound.kind K)
 
 mutual
 

From fb1edaea166a93497af77cf167161c214787e2f4 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 19 Jan 2026 13:44:52 +0100
Subject: [PATCH 67/71] Undo TightSubbound

---
 Capless/Renaming/Capture/Subtyping.lean |  8 ---
 Capless/Renaming/Term/Subtyping.lean    |  8 ---
 Capless/Renaming/Type/Subtyping.lean    |  8 ---
 Capless/Subst/Basic.lean                | 70 +++++++++----------------
 Capless/Subst/Capture/Subcapturing.lean |  4 +-
 Capless/Subst/Capture/Typing.lean       |  7 +--
 Capless/Subtyping.lean                  | 12 -----
 Capless/Weakening/Subtyping.lean        | 12 -----
 8 files changed, 28 insertions(+), 101 deletions(-)

diff --git a/Capless/Renaming/Capture/Subtyping.lean b/Capless/Renaming/Capture/Subtyping.lean
index fe07caff..ef8cf3b0 100644
--- a/Capless/Renaming/Capture/Subtyping.lean
+++ b/Capless/Renaming/Capture/Subtyping.lean
@@ -32,14 +32,6 @@ theorem Subbound.crename
     apply CaptureKind.crename _ ρ
     trivial
 
-theorem TightSubbound.crename
-  (h : TightSubbound Γ c B)
-  (ρ : CVarMap Γ f Δ)
-  : TightSubbound Δ (f c) (B.crename f) := by
-  cases h
-  case upper hs =>  apply upper; apply! hs.crename
-  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
-
 def SSubtyp.crename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Renaming/Term/Subtyping.lean b/Capless/Renaming/Term/Subtyping.lean
index 96cc3c93..ba460bd7 100644
--- a/Capless/Renaming/Term/Subtyping.lean
+++ b/Capless/Renaming/Term/Subtyping.lean
@@ -27,14 +27,6 @@ theorem Subbound.rename
     constructor
     apply CaptureKind.rename <;> easy
 
-theorem TightSubbound.rename
-  (h : TightSubbound Γ c B)
-  (ρ : VarMap Γ f Δ)
-  : TightSubbound Δ c (B.rename f) := by
-  cases h
-  case upper hs =>  apply upper; apply! hs.rename
-  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
-
 def SSubtyp.rename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Renaming/Type/Subtyping.lean b/Capless/Renaming/Type/Subtyping.lean
index 555a9bcd..f1513c2a 100644
--- a/Capless/Renaming/Type/Subtyping.lean
+++ b/Capless/Renaming/Type/Subtyping.lean
@@ -26,14 +26,6 @@ theorem Subbound.trename
     constructor
     apply CaptureKind.trename <;> easy
 
-theorem TightSubbound.trename
-  (h : TightSubbound Γ c B)
-  (ρ : TVarMap Γ f Δ)
-  : TightSubbound Δ c B := by
-  cases h
-  case upper hs =>  apply upper; apply! hs.trename
-  case kind hb hk => apply! kind (ρ.cmap _ _ hb)
-
 def SSubtyp.trename_motive1
   (Γ : Context n m k)
   (E1 : EType n m k)
diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean
index aa145b0c..80456337 100644
--- a/Capless/Subst/Basic.lean
+++ b/Capless/Subst/Basic.lean
@@ -91,7 +91,7 @@ structure CVarSubst (Γ : Context n m k) (f : FinFun k k') (Δ : Context n m k')
   cmap : ∀ c C, Γ.CBound c (CBinding.inst C) ->
     Δ.CBound (f c) (CBinding.inst (C.crename f))
   cmap_bound : ∀ c B, Γ.CBound c (CBinding.bound B) ->
-    TightSubbound Δ (f c) (B.crename f)
+    Subbound Δ (.upper {c=f c|.top}) (B.crename f)
   lmap : ∀ l c S, Γ.LBound l c S -> Δ.LBound l c (S.crename f)
 
 def VarSubst.ext {Γ : Context n m k}
@@ -476,7 +476,7 @@ def CVarSubst.ext {Γ : Context n m k}
     cases b0 <;> cases he0
     have h := σ.cmap_bound _ _ hb'
     rw [<- CBound.crename_rename_comm]
-    apply TightSubbound.weaken; easy
+    apply h.weaken
 
 def CVarSubst.text {Γ : Context n m k}
   (σ : CVarSubst Γ f Δ) :
@@ -513,7 +513,7 @@ def CVarSubst.text {Γ : Context n m k}
       cases hb
       rename_i hb0
       have h0 := σ.cmap_bound _ _ hb0
-      apply TightSubbound.tweaken; easy
+      apply h0.tweaken
     case lmap =>
       intros l c S hb
       cases hb
@@ -594,7 +594,8 @@ def CVarSubst.cext {Γ : Context n m k}
       cases cb
       case kind k =>
         simp only [CBinding.crename, CBound.crename]
-        apply TightSubbound.kind .here .rfl
+        apply Subbound.set_kind
+        apply CaptureKind.cvar_top .here
       case upper D0 =>
         constructor
         apply Subcapt.cbound_top
@@ -726,41 +727,29 @@ def CVarSubst.narrow
       cases hs
       case set hs =>
         cases he2
-        apply TightSubbound.upper (.trans (.cbound .here) _)
-        rw [← CaptureSet.proj_crename, CaptureSet.proj_top]
-        apply hs.cweaken
+        constructor
+        apply Subcapt.trans (.cbound_top .here) hs.cweaken
       case kind hsk =>
         cases he2
-        apply TightSubbound.kind .here hsk
+        constructor
+        apply CaptureKind.sub hsk (.cvar_top .here)
       case set_kind hk =>
-        cases he2 <;> sorry
-
-
-
-
-      -- apply Subbound.trans (B2:=B'.cweaken)
-      -- { cases B' <;> constructor
-      --   apply Subcapt.cbound_top
-      --   constructor
-      --   apply CaptureKind.cvar_top
-      --   constructor }
-      -- { apply Subbound.cweaken; easy }
+        cases he2
+        constructor
+        apply CaptureKind.cbound_top .here hk.cweaken
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases b1 <;> cases he1
       cases he2
       simp [FinFun.id, CBound.crename_id]
       rename_i cb0
-      cases cb0 <;> constructor <;> sorry
-      -- apply Subcapt.cbound_top
-      -- have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
-      -- simp [CBinding.cweaken] at hb1'
-      -- exact hb1'
-      -- simp [CBound.crename] at hb
-      -- apply CaptureKind.cvar_top
-      -- have h1 := Context.CBound.there_cvar (b':=CBinding.bound B') hb1
-      -- simp [CBinding.cweaken, CBinding.crename, CBound.crename] at h1
-      -- assumption
+      cases cb0
+      case upper =>
+        constructor
+        apply Subcapt.cbound_top hb1.there_cvar
+      case kind =>
+        constructor
+        apply CaptureKind.cvar_top hb1.there_cvar
   case lmap =>
     intro x cl S hb
     simp [SType.crename_id]
@@ -916,9 +905,8 @@ def CVarSubst.open :
       simp [FinFun.open_comp_weaken, CBound.crename_id]
       rename_i cb; cases cb
       case kind K =>
-        sorry
-        -- apply Subbound.set_kind
-        -- apply CaptureKind.cvar_top hb1
+        constructor
+        apply! CaptureKind.cvar_top
       case upper D0 =>
         constructor
         apply Subcapt.cbound_top
@@ -978,13 +966,7 @@ def CVarSubst.instantiate {Γ : Context n m k}
       exact hsub.cweaken (b:=CBinding.inst C)
       constructor
       rename_i hk
-      have h1 := CaptureKind.cweaken (b:=.inst C) hk
-      sorry
-      sorry
-      sorry
-      -- apply CaptureKind.subcapt (C2:=C.cweaken) h1
-      -- apply Subcapt.cinstr_top
-      -- apply Context.CBound.here
+      apply CaptureKind.cinstr_top .here hk.cweaken
     case inr h =>
       have ⟨b1, c1, hb1, he1, he2⟩ := h
       cases he2
@@ -993,12 +975,8 @@ def CVarSubst.instantiate {Γ : Context n m k}
       simp [FinFun.id, CBound.crename_id]
       cases cb
       case kind K1 =>
-        simp [CBound.crename]
-        sorry
-        -- constructor
-        -- apply CaptureKind.cvar_top
-        -- exact hb1.there_cvar (b':=.inst C)
-        -- have hb2 := hb1
+        constructor
+        apply CaptureKind.cvar_top hb1.there_cvar
       case upper D0 =>
         constructor
         apply Subcapt.cbound_top
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index 80dd97a8..f81a1ad2 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -18,8 +18,8 @@ theorem CaptureKind.csubst
   case label hb => apply label (σ.lmap _ _ _ hb)
   case cvar hb =>
     cases σ.cmap_bound _ _ hb
-    rename_i hb1 hs1
-    apply sub (Kind.Intersect.with_subkind_r hs1) (cvar hb1)
+    case set_kind hsk1 =>
+      apply hsk1.apply_proj_singleton
   case cbound hb hk ih =>
     rewrite [CaptureSet.proj_crename] at ih
     cases σ.cmap_bound _ _ hb
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index ba17de0f..f5f46c1f 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -52,11 +52,8 @@ theorem ReachSet.csubst
     exact h2
   case ckind c K L hb =>
     have hb1 := σ.cmap_bound _ _ hb
-    cases hb1; rename_i K' hb1 hs1
-    exists {c=f c|(K'.intersect L)}
-    apply And.intro
-    . simp only [CaptureSet.crename]; apply CaptureSet.Subset.singleton_subkind; apply Kind.Intersect.with_subkind_r hs1
-    . apply! ckind
+    cases hb1
+    sorry
   case label c S L hb =>
     have hb1 := σ.lmap _ _ _ hb
     rename_i x
diff --git a/Capless/Subtyping.lean b/Capless/Subtyping.lean
index 17bb9d9c..b7dc3e06 100644
--- a/Capless/Subtyping.lean
+++ b/Capless/Subtyping.lean
@@ -21,18 +21,6 @@ inductive Subbound : Context n m k -> CBound n k -> CBound n k -> Prop where
 | set_kind :
   CaptureKind Γ C K -> Subbound Γ (CBound.upper C) (CBound.kind K)
 
-/-- Stronger version of subbounds: it keeps track of the binding in the case of a kind-bounded csv. -/
-inductive TightSubbound : Context n m k -> Fin k -> CBound n k -> Prop where
-  | upper : Subcapt Γ {c=c|.top} C -> TightSubbound Γ c (.upper C)
-  | kind :
-    Γ.CBound c (CBinding.bound (.kind K)) ->
-    K.Subkind L ->
-    TightSubbound Γ c (.kind L)
-  -- | set_kind :
-  --   Γ.CBound c (CBinding.bound (.upper C)) ->
-  --   CaptureKind Γ C K ->
-  --   TightSubbound Γ c (CBound.kind K)
-
 mutual
 
 inductive ESubtyp : Context n m k -> EType n m k -> EType n m k -> Prop where
diff --git a/Capless/Weakening/Subtyping.lean b/Capless/Weakening/Subtyping.lean
index ab7ffb47..4619f87a 100644
--- a/Capless/Weakening/Subtyping.lean
+++ b/Capless/Weakening/Subtyping.lean
@@ -42,10 +42,6 @@ theorem Subbound.weaken
   { apply h }
   { apply VarMap.weaken }
 
-theorem TightSubbound.weaken
-  (h : TightSubbound Γ c B)
-  : TightSubbound (Γ.var b) c B.weaken := h.rename VarMap.weaken
-
 theorem SSubtyp.lweaken
   (h : SSubtyp Γ S1 S2) :
   ∀ S, SSubtyp (Γ.label c S) S1.weaken S2.weaken := by
@@ -114,10 +110,6 @@ theorem Subbound.tweaken
   apply? Subbound.trename
   apply TVarMap.weaken
 
-theorem TightSubbound.tweaken
-  (h : TightSubbound Γ c B)
-  : TightSubbound (Γ.tvar b) c B := h.trename TVarMap.weaken
-
 theorem ESubtyp.cweaken
   (h : ESubtyp Γ E1 E2) :
   ESubtyp (Γ.cvar b) E1.cweaken E2.cweaken := by
@@ -146,8 +138,4 @@ theorem Subbound.cweaken
   apply? Subbound.crename
   apply CVarMap.weaken
 
-theorem TightSubbound.cweaken
-  (h : TightSubbound Γ c B)
-  : TightSubbound (Γ.cvar b) (FinFun.weaken c) B.cweaken := h.crename CVarMap.weaken
-
 end Capless

From 98b27c2654e2660232ff1572a66ecaf58734c021 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Mon, 26 Jan 2026 21:28:34 +0100
Subject: [PATCH 68/71] Add reachsets p1

---
 Capless/CaptureSet.lean               |  47 ++++++++
 Capless/ReachSet.lean                 |  27 ++++-
 Capless/Subcapturing.lean             |   5 +
 Capless/Subcapturing/Basic.lean       |  14 +++
 Capless/Subcapturing/CaptureKind.lean | 147 ++++++++++++++++++++++++--
 5 files changed, 233 insertions(+), 7 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 05c1de54..918030de 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -16,6 +16,8 @@ This file contains the definition of capture sets.
 inductive Singleton : Nat -> Nat -> Type where
 | var : Fin n -> Singleton n k
 | cvar : Fin k -> Singleton n k
+| reach : Fin n -> Singleton n k
+| creach : Fin k -> Singleton n k
 
 /-- Capture sets in System Capless.
 
@@ -50,6 +52,21 @@ theorem CaptureSet.proj_top {C : CaptureSet n k} : C.proj .top = C := by
   case union ha hb => aesop
   case singleton => unfold proj; simp only [Kind.intersect.top_r]
 
+@[simp]
+def Singleton.with_reach (s: Singleton n k) :=
+  match s with
+  | var n => reach n
+  | cvar k => creach k
+  | reach n => reach n
+  | creach k => creach k
+
+@[simp]
+def CaptureSet.with_reach (c: CaptureSet n k) :=
+  match c with
+  | empty => empty
+  | union a b => union a.with_reach b.with_reach
+  | singleton s k => singleton s.with_reach k
+
 @[simp]
 instance : EmptyCollection (CaptureSet n k) where
   emptyCollection := CaptureSet.empty
@@ -166,12 +183,16 @@ def Singleton.rename (s : Singleton n k) (f : FinFun n n') : Singleton n' k :=
   match s with
   | var n => var $ f n
   | cvar k => cvar k
+  | reach n => reach $ f n
+  | creach k => creach $ k
 
 @[simp]
 def Singleton.crename (s : Singleton n k) (f : FinFun k k') : Singleton n k' :=
   match s with
   | var n => var n
   | cvar k => cvar $ f k
+  | reach n => reach n
+  | creach k => creach $ f k
 
 @[simp]
 theorem Singleton.rename_id {s : Singleton n k} :
@@ -410,3 +431,29 @@ theorem CaptureSet.proj_proj {C : CaptureSet n k}: ((C.proj K).proj L) = (C.proj
     simp only [CaptureSet.proj]
     rw [iha, ihb]
   case singleton => simp only [CaptureSet.proj]; rw [Kind.intersect.assoc]
+
+-- Reach
+
+theorem CaptureSet.reach_reach {C : CaptureSet n k}: C.with_reach.with_reach = C.with_reach := by
+  induction C <;> aesop
+
+theorem CaptureSet.reach_proj {C : CaptureSet n k} : C.with_reach.proj K = (C.proj K).with_reach := by
+  induction C <;> aesop
+
+theorem CaptureSet.proj_reach_inv {C D : CaptureSet n k} (h1 : C.proj K = D.with_reach)
+  : ∃ C' : CaptureSet n k, C'.proj K = D ∧ C = C'.with_reach := by
+  induction C generalizing D
+  case empty =>
+    exists empty
+    simp at h1; unfold with_reach at h1; split at h1 <;> simp_all
+  case union ha hb =>
+    simp at h1; unfold with_reach at h1; split at h1 <;> try simp_all
+    have ⟨Ra, ha1, ha2⟩ := ha (.refl _)
+    have ⟨Rb, hb1, hb2⟩ := hb (.refl _)
+    exists (Ra ∪ Rb)
+    apply And.intro <;> simp_all
+  case singleton s L =>
+    unfold with_reach at h1; split at h1 <;> simp [-Kind.intersect, -Singleton.with_reach] at h1
+    have ⟨_, _⟩ := h1; subst_vars
+    rename_i s
+    exists .singleton s L
diff --git a/Capless/ReachSet.lean b/Capless/ReachSet.lean
index c8b5d5d1..7ed571c2 100644
--- a/Capless/ReachSet.lean
+++ b/Capless/ReachSet.lean
@@ -24,10 +24,35 @@ inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop w
   ReachSet Γ {c=c|L} R
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
-  ReachSet Γ {c=c|L} {c=c|K.intersect L}
+  ReachSet Γ {c=c|L} (.singleton (.creach c) (K.intersect L))
 | label :
   Context.LBound Γ x c S ->
   ReachSet Γ {x=x|L} {x=x|(Kind.classifier c).intersect L}
 | absurd : K.IsEmpty -> ReachSet Γ (.singleton s K) {}
 
+theorem ReachSet.apply_proj (hr : ReachSet Γ C R) : ReachSet Γ (C.proj K) (R.proj K) := by
+  induction hr
+  case empty => apply empty
+  case union ha hb => apply! union
+  case var ih =>
+    rw [CaptureSet.proj_proj] at ih
+    apply! var
+  case cinstr ih =>
+    rw [CaptureSet.proj_proj] at ih
+    apply! cinstr
+  case cbound ih =>
+    rw [CaptureSet.proj_proj] at ih
+    apply! cbound
+  case ckind hb =>
+    simp only [CaptureSet.proj]
+    rw [Kind.intersect.assoc]
+    apply ckind hb
+  case label hb =>
+    simp only [CaptureSet.proj]
+    rw [Kind.intersect.assoc]
+    apply label hb
+  case absurd =>
+    apply absurd
+    apply! Kind.intersect.is_empty_l
+
 end Capless
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 2e0c72ff..6ff7a968 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -1,5 +1,6 @@
 import Capless.Context
 import Capless.CaptureSet
+import Capless.ReachSet
 
 /-!
 
@@ -21,6 +22,7 @@ inductive CaptureKind : Context n m k -> CaptureSet n k -> Kind -> Prop where
   | empty : CaptureKind Γ .empty K
   | singleton_absurd : K.IsEmpty -> CaptureKind Γ (.singleton s K) L
   | union : CaptureKind Γ C1 K -> CaptureKind Γ C2 K -> CaptureKind Γ (C1 ∪ C2) K
+  | reach : CaptureKind Γ C K -> CaptureKind Γ C.with_reach K
 
 inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop where
 | trans :
@@ -47,6 +49,9 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
+| reach : Subcapt Γ C C.with_reach
+| reachset :
+  ReachSet Γ C R -> Subcapt Γ R C.with_reach
 
 -- We don't need absurd here because...
 theorem Subcapt.absurd (hk : CaptureKind Γ C K) (he : K.IsEmpty) : Subcapt Γ C .empty := by
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index f09feed6..968fac3e 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -62,6 +62,14 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro
     . apply! trans (.proj_r _) (.subset $ .union_rl .rfl)
     . apply! trans (.proj_r _) (.subset $ .union_rr .rfl)
+  case reach =>
+    apply And.intro
+    . apply trans reach (.subset $ .union_rl .rfl)
+    . apply trans reach (.subset $ .union_rr .rfl)
+  case reachset hr =>
+    apply And.intro <;> apply trans (.subset _) (reachset hr)
+    . exact .union_rl .rfl
+    . exact .union_rr .rfl
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 
@@ -132,6 +140,12 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     . simp only [CaptureSet.proj_proj]
       apply subset (.subkind _)
       apply Kind.Intersect.subkind_symm
+  case reach =>
+    rw [CaptureSet.reach_proj]
+    apply! reach
+  case reachset hr =>
+    rw [CaptureSet.reach_proj]
+    apply reachset hr.apply_proj
 
 theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
   rw [← Kind.intersect.top_l (K:=K)]
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index 72bf3eaf..747a1791 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -6,11 +6,15 @@ namespace Capless
 
 theorem CaptureKind.union_l_inv (hk : CaptureKind Γ (C1 ∪ C2) K) : CaptureKind Γ C1 K ∧ CaptureKind Γ C2 K := by
   generalize h : C1 ∪ C2 = D at hk
-  induction hk generalizing C1 C2 <;> cases h
+  induction hk generalizing C1 C2 <;> try cases h
   case sub hs hk ih =>
     have ⟨_, _⟩ := ih (.refl _)
     apply And.intro <;> apply! sub hs
   case union => apply! And.intro
+  case reach ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all
+    have ⟨_, _⟩ := ih
+    apply And.intro <;> apply! reach
 
 theorem CaptureKind.subkind_proj
   (hk : CaptureKind Γ (.proj C K2) K)
@@ -65,6 +69,12 @@ theorem CaptureKind.subkind_proj
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply union (ha hs (.refl _)) (hb hs (.refl _))
+  case reach ih =>
+    have ⟨C0, ha, hb⟩ := CaptureSet.proj_reach_inv h
+    have ih := ih hs ha
+    rw [hb, CaptureSet.reach_proj]
+    apply! reach
+
 
 theorem CaptureKind.subkind_singleton
   (hs : CaptureKind Γ (.singleton s K2) K)
@@ -81,7 +91,7 @@ theorem CaptureKind.var_lookup_inv
   (hb : Γ.Bound x S^C)
   : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {x=x|L} = D at hk
-  induction hk <;> cases h
+  induction hk <;> try cases h
   case var K hb2 hk ih =>
     cases Context.bound_injective hb hb2
     left; assumption
@@ -92,13 +102,15 @@ theorem CaptureKind.var_lookup_inv
     case inr h => right; assumption
   case singleton_absurd he =>
     right; assumption
+  case reach =>
+    unfold CaptureSet.with_reach at h; aesop
 
 theorem CaptureKind.label_lookup_inv
   (hs : CaptureKind Γ {x=x|K1} K)
   (hb : Γ.LBound x c S)
   : (Kind.intersect (.classifier c) K1).Subkind K ∨ K1.IsEmpty := by
   generalize h : {x=x|K1} = D at hs
-  induction hs <;> cases h
+  induction hs <;> try cases h
   case var hb1 hk ih => cases Context.bound_lbound_absurd hb1 hb
   case label hb1 =>
     cases Context.lbound_inj hb hb1; subst_vars
@@ -109,13 +121,15 @@ theorem CaptureKind.label_lookup_inv
     case inr h => right; assumption
   case singleton_absurd he =>
     right; assumption
+  case reach =>
+    unfold CaptureSet.with_reach at h; aesop
 
 theorem CaptureKind.cbound_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.upper C)))
   : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
+  induction hs <;> try cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih =>
     cases Context.cbound_injective hb hb2
@@ -127,13 +141,15 @@ theorem CaptureKind.cbound_lookup_inv
     case inr h => right; assumption
   case singleton_absurd he =>
     right; assumption
+  case reach =>
+    unfold CaptureSet.with_reach at h; aesop
 
 theorem CaptureKind.ckind_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.bound (.kind K1)))
   : (K1.intersect L).Subkind K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
+  induction hs <;> try cases h
   case cvar hb2 =>
     cases Context.cbound_injective hb hb2
     left; exact .rfl
@@ -145,13 +161,15 @@ theorem CaptureKind.ckind_lookup_inv
     case inr h => right; assumption
   case singleton_absurd he =>
     right; assumption
+  case reach =>
+    unfold CaptureSet.with_reach at h; aesop
 
 theorem CaptureKind.cinst_lookup_inv
   (hs : CaptureKind Γ {c=c|L} K)
   (hb : Γ.CBound c (.inst C))
   : CaptureKind Γ (C.proj L) K ∨ L.IsEmpty := by
   generalize h : {c=c|L} = D at hs
-  induction hs <;> cases h
+  induction hs <;> try cases h
   case cvar hb2 => cases Context.cbound_injective hb hb2
   case cbound hb2 hk ih => cases Context.cbound_injective hb hb2
   case cinstr hb2 hk ih =>
@@ -163,6 +181,63 @@ theorem CaptureKind.cinst_lookup_inv
     case inr h => right; assumption
   case singleton_absurd he =>
     right; assumption
+  case reach =>
+    unfold CaptureSet.with_reach at h; aesop
+
+@[simp]
+private def CaptureSet.drop_reach (s : CaptureSet n k) :=
+  match s with
+  | empty => empty
+  | union a b => union a.drop_reach b.drop_reach
+  | singleton s K =>
+    let s' : Singleton n k :=
+      match s with
+      | .var n => .var n
+      | .cvar k => .cvar k
+      | .reach n => .var n
+      | .creach k => .cvar k
+    singleton s' K
+
+@[simp]
+private theorem CaptureSet.reach_drop_reach {C : CaptureSet n k} : C.with_reach.drop_reach = C.drop_reach := by
+  induction C <;> aesop
+
+private theorem CaptureKind.drop_reach
+  (hk : CaptureKind Γ C K)
+  : CaptureKind Γ C.drop_reach K := by
+  induction hk
+  case var => apply! var
+  case label => apply! label
+  case cvar => apply! cvar
+  case cbound => apply! cbound
+  case cinstr => apply! cinstr
+  case sub => apply! sub
+  case empty => apply empty
+  case singleton_absurd => apply! singleton_absurd
+  case union => apply! union
+  case reach => aesop
+
+private theorem CaptureKind.drop_reach_inv
+  (hk : CaptureKind Γ C.drop_reach K)
+  : CaptureKind Γ C K := by
+  induction C
+  case empty => apply empty
+  case union ha hb =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply union <;> aesop
+  case singleton s K =>
+    simp at hk
+    cases s <;> (simp at hk; try assumption)
+    . apply reach hk
+    . apply reach hk
+
+
+theorem CaptureKind.with_reach_inv
+  (hk : CaptureKind Γ C.with_reach K)
+  : CaptureKind Γ C K := by
+  have hk1 := hk.drop_reach
+  rw [CaptureSet.reach_drop_reach] at hk1
+  apply hk1.drop_reach_inv
 
 theorem CaptureKind.proj_merge
   (hk1 : CaptureKind Γ (.proj C K1) L1)
@@ -275,6 +350,13 @@ theorem CaptureKind.proj_merge
     obtain ⟨rfl, rfl⟩ := h
     have ⟨_, _⟩ := hk2.union_l_inv
     apply! union (ha _ _ $ .refl _) (hb _ _ $ .refl _)
+  case reach hsk ih =>
+    have ⟨C0, ha, hb⟩ := CaptureSet.proj_reach_inv h
+    subst_vars
+    rw [CaptureSet.reach_proj]; apply reach
+    apply ih _ hs1 (.refl _)
+    rw [CaptureSet.reach_proj] at hk2
+    apply hk2.with_reach_inv
 
 theorem CaptureKind.proj_merge_singleton
   (hs1 : CaptureKind Γ (.singleton s K1) K)
@@ -362,6 +444,48 @@ theorem CaptureKind.proj_r
   case union ha hb iha ihb =>
     have ⟨_, _⟩ := hk2.union_l_inv
     apply! union (iha _) (ihb _)
+  case reach ih =>
+    rw [CaptureSet.reach_proj] at hk2
+    apply reach
+    apply ih hk2.with_reach_inv
+
+theorem CaptureKind.reachset
+  (hk : CaptureKind Γ C K)
+  (hr : ReachSet Γ C R)
+  : CaptureKind Γ R K := by
+  induction hr
+  case empty => apply empty
+  case union ha hb =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! union (ha _) (hb _)
+  case var hb hr ih =>
+    apply ih
+    cases hk.var_lookup_inv hb
+    . aesop
+    . apply! absurd
+  case cinstr hb hr ih =>
+    apply ih
+    cases hk.cinst_lookup_inv hb
+    . aesop
+    . apply! absurd
+  case cbound hb hr ih =>
+    apply ih
+    cases hk.cbound_lookup_inv hb
+    . aesop
+    . apply! absurd
+  case ckind hb =>
+    cases hk.ckind_lookup_inv hb
+    . apply sub _ (reach (cvar hb))
+      apply! Kind.Subkind.trans Kind.Intersect.subkind_r
+    . apply singleton_absurd
+      apply! Kind.intersect.is_empty_r
+  case label hb =>
+    cases hk.label_lookup_inv hb
+    . apply sub _ (label hb)
+      apply! Kind.Subkind.trans Kind.Intersect.subkind_r
+    . apply singleton_absurd
+      apply! Kind.intersect.is_empty_r
+  case absurd he => apply empty
 
 theorem CaptureKind.subcapt
   (hk : CaptureKind Γ C2 K)
@@ -380,9 +504,12 @@ theorem CaptureKind.subcapt
     case cinstr hb1 hk ih => cases Context.cbound_injective hb hb1; assumption
     case sub hs hk ih => apply sub hs; apply ih hb; rfl
     case singleton_absurd he => apply! absurd
+    case reach => unfold CaptureSet.with_reach at h; aesop
   case cinstr => apply! cinstr
   case cbound => apply! cbound
   case proj_r hk1 => apply! proj_r
+  case reach => apply! with_reach_inv
+  case reachset hr => apply hk.with_reach_inv.reachset hr
 
 theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
   induction hk generalizing L
@@ -408,6 +535,9 @@ theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.pro
     apply singleton_absurd
     apply Kind.intersect.is_empty_l hk
   case union ha hb => apply union ha hb
+  case reach ih =>
+    rw [CaptureSet.reach_proj]
+    apply reach ih
 
 theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
   rw [← Kind.intersect.top_l (K:=L)]
@@ -475,6 +605,11 @@ theorem CaptureKind.intersect_with_proj' {C : CaptureSet n k} (hk : CaptureKind
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
     have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     apply union (iha $ .refl _) (ihb $ .refl _)
+  case reach ih =>
+    have ⟨C0, ha, hb⟩ := CaptureSet.proj_reach_inv h
+    have ih := ih ha
+    apply! reach
+
 
 theorem CaptureKind.intersect_with_proj {C : CaptureSet n k} (hk : CaptureKind Γ (C.proj K) L) : CaptureKind Γ (C.proj K) (K.intersect L) := by
   apply sub _ (intersect_with_proj' hk)

From 7adf20e085412c0a035a9143f436ce6570837905 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 27 Jan 2026 10:33:40 +0100
Subject: [PATCH 69/71] Make all preliminaries pass

---
 Capless/CaptureSet.lean               |  39 +++++
 Capless/ReachSet.lean                 |  12 ++
 Capless/Store.lean                    |   3 +
 Capless/Subcapturing.lean             |   7 +-
 Capless/Subcapturing/Basic.lean       |  25 +--
 Capless/Subcapturing/CaptureKind.lean |  42 ++++-
 Capless/Subcapturing/Reach.lean       |   0
 Capless/WellScoped/Basic.lean         |  17 ++
 Capless/WellScoped/ReachSet.lean      | 232 +++++++++++++++++++++++---
 9 files changed, 337 insertions(+), 40 deletions(-)
 create mode 100644 Capless/Subcapturing/Reach.lean

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 918030de..51fa1a8d 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -73,6 +73,8 @@ instance : EmptyCollection (CaptureSet n k) where
 
 notation:max "{x=" x " | " K "}" => CaptureSet.singleton (Singleton.var x) K
 notation:max "{c=" c " | " K "}" => CaptureSet.singleton (Singleton.cvar c) K
+notation:max "{x^=" x " | " K "}" => CaptureSet.singleton (Singleton.reach x) K
+notation:max "{c^=" c " | " K "}" => CaptureSet.singleton (Singleton.creach c) K
 
 @[simp]
 instance : Union (CaptureSet n k) where
@@ -98,6 +100,10 @@ inductive CaptureSet.Subset : CaptureSet n k → CaptureSet n k → Prop where
 | singleton_absurd :
   K.IsEmpty ->
   Subset (.singleton s K) .empty
+| var_reach :
+  Subset (.singleton (.var x) K) (.singleton (.reach x) K)
+| cvar_creach :
+  Subset (.singleton (.cvar c) K) (.singleton (.creach c) K)
 | proj_merge:
   Subset (.singleton s (L1 ++ L2)) (.union (.singleton s L1) (.singleton s L2))
 | trans : Subset A B -> Subset B C -> Subset A C
@@ -356,6 +362,10 @@ theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'}
     cases s <;> (simp; apply! Subset.singleton_subkind)
   case singleton_absurd s K he =>
     cases s <;> (simp; apply! Subset.singleton_absurd)
+  case var_reach x K =>
+    apply! Subset.var_reach
+  case cvar_creach c K =>
+    apply! Subset.cvar_creach
   case proj_merge s L1 L2 =>
     cases s <;> (simp; apply! Subset.proj_merge)
   case trans ha hb => apply! Subset.trans
@@ -376,6 +386,10 @@ theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k}
     cases s <;> (apply! Subset.singleton_subkind)
   case singleton_absurd s K he =>
     cases s <;> (apply! Subset.singleton_absurd)
+  case var_reach x K =>
+    apply! Subset.var_reach
+  case cvar_creach c K =>
+    apply! Subset.cvar_creach
   case proj_merge s L1 L2 =>
     cases s <;> (apply! Subset.proj_merge)
   case trans ha hb => apply! Subset.trans
@@ -400,6 +414,8 @@ theorem CaptureSet.Subset.proj (hsub : Subset C D) : Subset (C.proj K) (D.proj K
   case singleton_absurd he =>
     apply trans (.singleton_subkind _) (.singleton_absurd he)
     apply Kind.Intersect.subkind_l
+  case var_reach => apply! var_reach
+  case cvar_creach => apply! cvar_creach
   case proj_merge => apply proj_merge
   case trans ha hb => apply! trans
 
@@ -457,3 +473,26 @@ theorem CaptureSet.proj_reach_inv {C D : CaptureSet n k} (h1 : C.proj K = D.with
     have ⟨_, _⟩ := h1; subst_vars
     rename_i s
     exists .singleton s L
+
+theorem CaptureSet.Subset.reach : Subset C C.with_reach := by
+  induction C
+  case empty => apply empty
+  case union => apply! union_monotone
+  case singleton s K =>
+    cases s <;> (simp; try apply rfl)
+    . apply var_reach
+    . apply cvar_creach
+
+theorem CaptureSet.Subset.with_reach (hs : Subset C D) : Subset C.with_reach D.with_reach := by
+  induction hs
+  case empty => apply empty
+  case rfl => apply rfl
+  case union_l => apply! union_l
+  case union_rl => apply! union_rl
+  case union_rr => apply! union_rr
+  case singleton_subkind => apply! singleton_subkind
+  case singleton_absurd => apply! singleton_absurd
+  case var_reach => apply rfl
+  case cvar_creach => apply rfl
+  case proj_merge => apply! proj_merge
+  case trans => apply! trans
diff --git a/Capless/ReachSet.lean b/Capless/ReachSet.lean
index 7ed571c2..c2201700 100644
--- a/Capless/ReachSet.lean
+++ b/Capless/ReachSet.lean
@@ -28,6 +28,12 @@ inductive ReachSet : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop w
 | label :
   Context.LBound Γ x c S ->
   ReachSet Γ {x=x|L} {x=x|(Kind.classifier c).intersect L}
+| var_reach :
+  ReachSet Γ {x=x|K} R ->
+  ReachSet Γ {x^=x|K} R
+| cvar_creach :
+  ReachSet Γ {c=c|K} R ->
+  ReachSet Γ {c^=c|K} R
 | absurd : K.IsEmpty -> ReachSet Γ (.singleton s K) {}
 
 theorem ReachSet.apply_proj (hr : ReachSet Γ C R) : ReachSet Γ (C.proj K) (R.proj K) := by
@@ -51,6 +57,12 @@ theorem ReachSet.apply_proj (hr : ReachSet Γ C R) : ReachSet Γ (C.proj K) (R.p
     simp only [CaptureSet.proj]
     rw [Kind.intersect.assoc]
     apply label hb
+  case var_reach ih =>
+    simp only [CaptureSet.proj]
+    apply var_reach ih
+  case cvar_creach ih =>
+    simp only [CaptureSet.proj]
+    apply cvar_creach ih
   case absurd =>
     apply absurd
     apply! Kind.intersect.is_empty_l
diff --git a/Capless/Store.lean b/Capless/Store.lean
index a4768133..315b8a1d 100644
--- a/Capless/Store.lean
+++ b/Capless/Store.lean
@@ -183,6 +183,9 @@ inductive WellScoped : Context n m k -> Cont n m k -> CaptureSet n k -> Prop whe
 | ckind :
   Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
   WellScoped Γ cont {c=c|L}
+| creach :
+  Context.CBound Γ c (CBinding.bound (CBound.kind K)) ->
+  WellScoped Γ cont {c^=c|L}
 | label :
   Context.LBound Γ x c S ->
   Cont.HasLabel cont x tail ->
diff --git a/Capless/Subcapturing.lean b/Capless/Subcapturing.lean
index 6ff7a968..5f61e3f6 100644
--- a/Capless/Subcapturing.lean
+++ b/Capless/Subcapturing.lean
@@ -49,14 +49,17 @@ inductive Subcapt : Context n m k -> CaptureSet n k -> CaptureSet n k -> Prop wh
   Context.CBound Γ c (CBinding.bound (CBound.upper C)) ->
   Subcapt Γ {c=c|L} (C.proj L)
 | proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K)
-| reach : Subcapt Γ C C.with_reach
-| reachset :
+| reachsetl :
   ReachSet Γ C R -> Subcapt Γ R C.with_reach
+| reachsetr :
+  ReachSet Γ C R -> Subcapt Γ C.with_reach R
 
 -- We don't need absurd here because...
 theorem Subcapt.absurd (hk : CaptureKind Γ C K) (he : K.IsEmpty) : Subcapt Γ C .empty := by
   apply trans (.proj_r hk) (.subset $ .absurd he)
 
+theorem Subcapt.reach : Subcapt Γ C C.with_reach := by apply subset .reach
+
 notation:50 Γ " ⊢ " C1 " <:c " C2 => Subcapt Γ C1 C2
 notation:50 Γ " ⊢ " C " :k " K => CaptureKind Γ C K
 
diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean
index 968fac3e..d3114c48 100644
--- a/Capless/Subcapturing/Basic.lean
+++ b/Capless/Subcapturing/Basic.lean
@@ -62,14 +62,19 @@ theorem Subcapt.union_l_inv' (hs : Subcapt Γ C D) (heq : C = (C1 ∪ C2)) : Sub
     apply And.intro
     . apply! trans (.proj_r _) (.subset $ .union_rl .rfl)
     . apply! trans (.proj_r _) (.subset $ .union_rr .rfl)
-  case reach =>
-    apply And.intro
-    . apply trans reach (.subset $ .union_rl .rfl)
-    . apply trans reach (.subset $ .union_rr .rfl)
-  case reachset hr =>
-    apply And.intro <;> apply trans (.subset _) (reachset hr)
+  case reachsetl hr =>
+    apply And.intro <;> apply trans (.subset _) (reachsetl hr)
     . exact .union_rl .rfl
     . exact .union_rr .rfl
+  case reachsetr hr =>
+    unfold CaptureSet.with_reach at heq; split at heq <;> simp_all
+    have ⟨h1, h2⟩ := heq; subst_vars
+    cases hr
+    apply And.intro
+    . apply trans _ (.subset $ .union_rl .rfl)
+      apply! reachsetr
+    . apply trans _ (.subset $ .union_rr .rfl)
+      apply! reachsetr
 
 theorem Subcapt.union_l_inv (hs : Subcapt Γ (C1 ∪ C2) D) : Subcapt Γ C1 D ∧ Subcapt Γ C2 D := hs.union_l_inv' $ .refl (a := C1 ∪ C2)
 
@@ -140,12 +145,12 @@ theorem Subcapt.apply_proj (hs : Subcapt Γ C D) : Subcapt Γ (C.proj K) (D.proj
     . simp only [CaptureSet.proj_proj]
       apply subset (.subkind _)
       apply Kind.Intersect.subkind_symm
-  case reach =>
+  case reachsetl hr =>
     rw [CaptureSet.reach_proj]
-    apply! reach
-  case reachset hr =>
+    apply reachsetl hr.apply_proj
+  case reachsetr hr =>
     rw [CaptureSet.reach_proj]
-    apply reachset hr.apply_proj
+    apply reachsetr hr.apply_proj
 
 theorem Subcapt.apply_proj_singleton (hs : Subcapt Γ (.singleton s .top) C) : Subcapt Γ (.singleton s K) (C.proj K) := by
   rw [← Kind.intersect.top_l (K:=K)]
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index 747a1791..e03d9159 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -386,6 +386,8 @@ theorem CaptureKind.subset
   case singleton_subkind hs =>
     apply! subkind_singleton
   case singleton_absurd L he => apply! singleton_absurd
+  case var_reach => apply hk.with_reach_inv
+  case cvar_creach => apply hk.with_reach_inv
   case proj_merge =>
     have ⟨_, _⟩ := hk.union_l_inv
     apply! proj_merge_singleton
@@ -485,8 +487,43 @@ theorem CaptureKind.reachset
       apply! Kind.Subkind.trans Kind.Intersect.subkind_r
     . apply singleton_absurd
       apply! Kind.intersect.is_empty_r
+  case var_reach hr ih =>
+    apply ih hk.with_reach_inv
+  case cvar_creach hr ih =>
+    apply ih hk.with_reach_inv
   case absurd he => apply empty
 
+theorem CaptureKind.reachset_inv
+  (hk : CaptureKind Γ R K)
+  (hr : ReachSet Γ C R)
+  : CaptureKind Γ C K := by
+  induction hr
+  case empty => apply empty
+  case union ha hb =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! union (ha _) (hb _)
+  case var hb hr ih => apply! var hb $ ih _
+  case cinstr hb hr ih => apply! cinstr hb $ ih _
+  case cbound hb hr ih => apply! cbound hb $ ih _
+  case ckind hb =>
+    have hk1 := hk.drop_reach; simp only [CaptureSet.drop_reach] at hk1
+    cases hk1.ckind_lookup_inv hb <;> rename_i h
+    . apply sub (.trans _ h) (cvar hb)
+      rw [← Kind.intersect.assoc]
+      apply Kind.Intersect.with_subkind_r
+      apply Kind.Intersect.subkind_self
+    . apply sub (.is_empty_l h) (cvar hb)
+  case label hb =>
+    cases hk.label_lookup_inv hb <;> rename_i h
+    . apply sub (.trans _ h) (label hb)
+      rw [← Kind.intersect.assoc]
+      apply Kind.Intersect.with_subkind_r
+      apply Kind.Intersect.subkind_self
+    . apply sub (.is_empty_l h) (label hb)
+  case var_reach ih => apply reach (ih hk)
+  case cvar_creach ih => apply reach (ih hk)
+  case absurd => apply! singleton_absurd
+
 theorem CaptureKind.subcapt
   (hk : CaptureKind Γ C2 K)
   (hs : Subcapt Γ C1 C2)
@@ -508,8 +545,9 @@ theorem CaptureKind.subcapt
   case cinstr => apply! cinstr
   case cbound => apply! cbound
   case proj_r hk1 => apply! proj_r
-  case reach => apply! with_reach_inv
-  case reachset hr => apply hk.with_reach_inv.reachset hr
+  case reachsetl hr => apply hk.with_reach_inv.reachset hr
+  case reachsetr hr =>
+    apply reach $ hk.reachset_inv hr
 
 theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.proj L) (K.intersect L) := by
   induction hk generalizing L
diff --git a/Capless/Subcapturing/Reach.lean b/Capless/Subcapturing/Reach.lean
new file mode 100644
index 00000000..e69de29b
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 3b7d238a..28374be4 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -29,6 +29,10 @@ theorem WellScoped.subkind {C : CaptureSet n k}
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     apply! ckind
+  case creach hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all
+    apply! creach
   case label hb hl =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
@@ -75,6 +79,10 @@ theorem WellScoped.proj_merge' {C : CaptureSet n k}
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
     have ⟨_, _⟩ := h; subst_vars
     apply! ckind
+  case creach hb =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars
+    apply! creach
   case label hb hl =>
     unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
     have ⟨_, _⟩ := h; subst_vars
@@ -129,6 +137,12 @@ theorem WellScoped.subset {C1 C2 : CaptureSet n k}
     apply! proj_merge
   case trans ha hb =>
     apply ha; apply! hb
+  case var_reach =>
+    cases hsc; apply! absurd
+  case cvar_creach =>
+    cases hsc
+    case creach => apply! ckind
+    case absurd => apply! absurd
 
 theorem WellScoped.cons
   (hsc : WellScoped Γ cont C) :
@@ -137,6 +151,7 @@ theorem WellScoped.cons
   case empty => apply empty
   case union => apply union <;> aesop
   case ckind ih => apply ckind <;> aesop
+  case creach ih => apply creach <;> aesop
   case label hb hl =>
     apply label hb
     constructor; assumption
@@ -151,6 +166,7 @@ theorem WellScoped.conse
   case empty => apply empty
   case union => apply union <;> aesop
   case ckind ih => apply ckind <;> aesop
+  case creach ih => apply creach <;> aesop
   case label hb hl =>
     apply label hb
     constructor; assumption
@@ -164,6 +180,7 @@ theorem WellScoped.scope
   case empty => apply empty
   case union => apply union <;> aesop
   case ckind ih => apply ckind <;> aesop
+  case creach ih => apply creach <;> aesop
   case label hb hl =>
     apply label hb
     constructor; assumption
diff --git a/Capless/WellScoped/ReachSet.lean b/Capless/WellScoped/ReachSet.lean
index 4bfe9a5f..a615491e 100644
--- a/Capless/WellScoped/ReachSet.lean
+++ b/Capless/WellScoped/ReachSet.lean
@@ -41,11 +41,33 @@ theorem ReachSet.proj_empty {C : CaptureSet n k}
     have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
     apply CaptureSet.Subset.singleton_absurd
     apply Kind.intersect.is_empty_r $ Kind.intersect.is_empty_r he
+  case var_reach hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    case h_3 =>
+      have ⟨h1, h2⟩ := h
+      cases h1; subst h2
+      rename_i x _ _ p
+      apply ih (C := {x=x|p}) (K := K) he (.refl _)
+  case cvar_creach hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    case h_3 =>
+      have ⟨h1, h2⟩ := h
+      cases h1; subst h2
+      rename_i c _ _ p
+      apply ih (C := {c=c|p}) (K := K) he (.refl _)
   case absurd =>
     unfold CaptureSet.proj at h; split at h <;> simp at h
     have ⟨_, _⟩ := h; subst_vars; simp_all
     constructor
 
+theorem ReachSet.singleton_proj_empty
+  (hr : ReachSet Γ (.singleton s K) R)
+  (he : K.IsEmpty)
+  : R ⊆ ∅ := by
+  rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj] at hr
+  apply proj_empty hr he
+
+
 theorem ReachSet.proj_absurd {C : CaptureSet n k}
   (he : K.IsEmpty)
   : ∃ R, R ⊆ .empty ∧ ReachSet Γ (C.proj K) R := by
@@ -70,7 +92,9 @@ theorem ReachSet.inj
   : R1 ⊆ R2 := by
   induction hr1 generalizing R2
   case empty => apply CaptureSet.Subset.empty
-  case union ha hb => cases hr2; apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
+  case union ha hb =>
+    cases hr2
+    case union => apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
   case var hb1 hr1 ih =>
     cases hr2
     case var hb2 hr2 => cases Context.bound_injective hb1 hb2; apply! ih
@@ -99,12 +123,42 @@ theorem ReachSet.inj
     case var hb2 hr2 =>  cases Context.bound_lbound_absurd hb2 hb1
     case label hb2 => cases Context.lbound_inj hb1 hb2; subst_vars; constructor
     case absurd he => apply! CaptureSet.Subset.singleton_absurd (Kind.intersect.is_empty_r _)
+  case var_reach hr1 ih =>
+    cases hr2
+    case var_reach => apply! ih
+    case absurd he => apply! hr1.singleton_proj_empty
+  case cvar_creach ih =>
+    cases hr2
+    case cvar_creach => apply! ih
+    case absurd he => apply! singleton_proj_empty
   case absurd => constructor
 
+private theorem drop_repeat_intersect_left : Kind.Subkind (K.intersect L) (Kind.intersect K (K.intersect L)) := by
+  rw [← Kind.intersect.assoc]
+  apply Kind.Intersect.with_subkind_r
+  apply Kind.Intersect.subkind_self
+
+theorem ReachSet.idempotent
+  (hr : ReachSet Γ C R) :
+  ∃ R', R' ⊆ R ∧ R ⊆ R' ∧ ReachSet Γ R R' := by
+  induction hr <;> try assumption
+  case empty => apply Exists.intro; apply And.intro .empty (.intro .empty .empty)
+  case union ha hb =>
+    have ⟨R1, h1, h1', hr1⟩ := ha
+    have ⟨R2, h2, h2', hr2⟩ := hb
+    exists R1 ∪ R2
+    apply And.intro (.union_monotone h1 h2) (.intro (.union_monotone h1' h2') (.union hr1 hr2))
+  case ckind hb =>
+    apply Exists.intro
+    apply And.intro (.singleton_subkind Kind.Intersect.subkind_r) (.intro (.singleton_subkind drop_repeat_intersect_left) (cvar_creach $ ckind hb))
+  case label hb =>
+    apply Exists.intro
+    apply And.intro (.singleton_subkind Kind.Intersect.subkind_r) (.intro (.singleton_subkind drop_repeat_intersect_left) (label hb))
+  case absurd => apply Exists.intro; apply And.intro .empty (.intro .empty .empty)
 
 theorem ReachSet.subkind {C : CaptureSet n k}
-  (hk : K.Subkind L)
   (hr : ReachSet Γ (C.proj L) R2)
+  (hk : K.Subkind L)
   : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (C.proj K) R1 := by
   generalize h : C.proj L = D at hr
   induction hr generalizing C L K
@@ -152,11 +206,26 @@ theorem ReachSet.subkind {C : CaptureSet n k}
     exists .empty; apply And.intro .empty
     apply absurd $ Kind.Subkind.empty_r_inv _ he
     apply Kind.Intersect.with_subkind hk
+  case var_reach hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars
+    rename_i x _ _ p
+    have ⟨R1, hs1, hr1⟩ := ih (C:={x=x|p}) hk (.refl _)
+    exists R1
+    apply And.intro hs1 hr1.var_reach
+  case cvar_creach hr ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars
+    rename_i c _ _ p
+    have ⟨R1, hs1, hr1⟩ := ih (C:={c=c|p}) hk (.refl _)
+    exists R1
+    apply And.intro hs1 hr1.cvar_creach
+
 
 
 theorem ReachSet.singleton_subkind
-  (hk : K.Subkind L)
   (hr : ReachSet Γ (.singleton s L) R2)
+  (hk : K.Subkind L)
   : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ (.singleton s K) R1 := by
   rw [← Kind.intersect.top_l (K:=L), ← CaptureSet.proj] at hr
   rw [← Kind.intersect.top_l (K:=K), ← CaptureSet.proj]
@@ -246,7 +315,7 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
     case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
     case ckind p _ hb2 =>
       cases Context.cbound_injective hb hb2
-      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
+      exists .singleton (.creach c) (K.intersect (p.intersect (L1 ++ L2)))
       apply And.intro
       . apply CaptureSet.Subset.trans (.singleton_subkind _) .proj_merge
         apply Kind.Subkind.trans (Kind.Intersect.with_subkind _) Kind.Intersect.union_r_subkind
@@ -254,7 +323,7 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
       . apply! ckind
     case absurd he =>
       rename_i p
-      exists {c=c| K.intersect (p.intersect (L1 ++ L2))}
+      exists .singleton (.creach c) (K.intersect (p.intersect (L1 ++ L2)))
       apply And.intro
       . apply CaptureSet.Subset.union_rl (.singleton_subkind _)
         apply Kind.Intersect.with_subkind
@@ -294,6 +363,34 @@ theorem ReachSet.proj_merge' {C : CaptureSet n k}
     exists R
     apply And.intro (.union_rr hs)
     apply h
+  case var_reach hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case var_reach hr2 =>
+      rename_i x _ _ p
+      have ⟨R0, hs0, hr0⟩ := ih (C:={x=x|p}) hr2 (.refl _)
+      exists R0
+      apply And.intro hs0 hr0.var_reach
+    case absurd he =>
+      rename_i x _ _ p
+      have ⟨R0, hs0, hr0⟩ := ih (C:={x=x|p}) (absurd he) (.refl _)
+      exists R0
+      apply And.intro hs0 hr0.var_reach
+  case cvar_creach hr1 ih =>
+    unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h
+    have ⟨_, _⟩ := h; subst_vars; simp_all [-Kind.intersect]
+    cases hr2
+    case cvar_creach hr2 =>
+      rename_i c _ _ p
+      have ⟨R0, hs0, hr0⟩ := ih (C:={c=c|p}) hr2 (.refl _)
+      exists R0
+      apply And.intro hs0 hr0.cvar_creach
+    case absurd he =>
+      rename_i c _ _ p
+      have ⟨R0, hs0, hr0⟩ := ih (C:={c=c|p}) (absurd he) (.refl _)
+      exists R0
+      apply And.intro hs0 hr0.cvar_creach
 
 theorem ReachSet.proj_merge
   (hr1 : ReachSet Γ (.singleton s L1) R1)
@@ -335,10 +432,91 @@ theorem ReachSet.subset
     exists Ra; apply! And.intro (.trans hsa hsb)
   case singleton_subkind hs => apply! singleton_subkind
   case singleton_absurd he => exists .empty; apply And.intro .empty (.absurd he)
+  case var_reach =>
+    cases hr1
+    case var_reach => exists R2; apply! And.intro .rfl
+    case absurd he =>
+      exists .empty; apply And.intro .empty (.absurd he)
+  case cvar_creach =>
+    cases hr1
+    case cvar_creach => exists R2; apply! And.intro .rfl
+    case absurd he =>
+      exists .empty; apply And.intro .empty (.absurd he)
   case proj_merge =>
     cases hr1
     apply! proj_merge
 
+theorem ReachSet.with_reach
+  (hr : ReachSet Γ C R)
+  : ReachSet Γ C.with_reach R := by
+  induction hr
+  case empty => apply empty
+  case union ha hb =>
+    unfold CaptureSet.with_reach
+    apply! union
+  case var hb hr ih =>
+    unfold CaptureSet.with_reach
+    apply var_reach (var hb hr)
+  case cinstr hb hr ih =>
+    unfold CaptureSet.with_reach
+    apply cvar_creach (cinstr hb hr)
+  case cbound hb hr ih =>
+    unfold CaptureSet.with_reach
+    apply cvar_creach (cbound hb hr)
+  case ckind hb =>
+    unfold CaptureSet.with_reach
+    apply cvar_creach (ckind hb)
+  case label hb =>
+    unfold CaptureSet.with_reach
+    apply var_reach (label hb)
+  case var_reach hr ih =>
+    unfold CaptureSet.with_reach
+    apply var_reach hr
+  case cvar_creach hr ih =>
+    unfold CaptureSet.with_reach
+    apply cvar_creach hr
+  case absurd he =>
+    unfold CaptureSet.with_reach
+    apply absurd he
+
+theorem ReachSet.with_reach_inv
+  (hr : ReachSet Γ C.with_reach R)
+  : ReachSet Γ C R := by
+  generalize h : C.with_reach = D at hr
+  induction hr generalizing C
+  case empty =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    apply empty
+  case union ha hb =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    apply union (ha _) (hb _) <;> aesop
+  case var hb hr ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp at h1
+  case cinstr hb hr ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp at h1
+  case cbound hb hr ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp at h1
+  case ckind hb =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp at h1
+  case label =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp at h1
+  case var_reach hr ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp_all
+    apply var_reach hr
+  case cvar_creach hr ih =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> simp_all
+    apply cvar_creach hr
+  case absurd he =>
+    unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
+    have ⟨h1, h2⟩ := h; split at h1 <;> (subst_vars; simp_all; apply! absurd)
+
 theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
   (hk : CaptureKind Γ C K)
   (he : K.IsEmpty)
@@ -352,7 +530,7 @@ theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
     apply And.intro (.singleton_absurd he)
     apply! label
   case cvar c K L hb =>
-    exists {c=c|K.intersect L}
+    exists .singleton (.creach c) (K.intersect L)
     apply And.intro (.singleton_absurd he)
     apply! ckind
   case cbound hb hk ih =>
@@ -372,6 +550,10 @@ theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
     exists Ra ∪ Rb
     apply And.intro (.union_l hsa hsb)
     apply! union
+  case reach hk ih =>
+    have ⟨R0, hs0, hr0⟩ := ih he
+    exists R0
+    apply And.intro hs0 hr0.with_reach
 
 theorem ReachSet.proj_r
   (hk : CaptureKind Γ C K)
@@ -403,7 +585,7 @@ theorem ReachSet.proj_r
     case absurd he =>
       exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
   case cvar c C K hb =>
-    exists {c=c|C.intersect K}
+    exists .singleton (.creach c) (C.intersect K)
     apply And.intro _ (.ckind hb)
     cases hr2
     case ckind hb2 =>
@@ -443,7 +625,7 @@ theorem ReachSet.proj_r
       exists R; apply And.intro h1
       apply! cinstr
   case sub hsk hk ih =>
-    have ⟨R3, h3, hr3⟩ := subkind hsk hr2
+    have ⟨R3, h3, hr3⟩ := hr2.subkind hsk
     have ⟨R, h, ih⟩ := ih hr3
     exists R
     apply And.intro (.trans h h3) ih
@@ -457,6 +639,11 @@ theorem ReachSet.proj_r
     have ⟨R2, h2, ih2⟩ := ihb hb2
     exists R1 ∪ R2
     apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
+  case reach hr ih =>
+    rw [CaptureSet.reach_proj] at hr2
+    have ⟨R, h, ih⟩ := ih hr2.with_reach_inv
+    exists R
+    apply And.intro h ih.with_reach
 
 theorem ReachSet.subcapt
   (hr2 : ReachSet Γ C2 R2)
@@ -484,27 +671,20 @@ theorem ReachSet.subcapt
   case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
   case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
   case proj_r hk => apply! proj_r
+  case reachsetl hr =>
+    have ⟨R1, h1, _, hr1⟩ := hr.idempotent
+    exists R1
+    apply And.intro (.trans h1 (hr.inj hr2.with_reach_inv)) hr1
+  case reachsetr hr =>
+    have ⟨R1, _, h1, hr1⟩ := hr.idempotent
+    have h2 := hr1.inj hr2
+    apply Exists.intro
+    apply And.intro (h1.trans h2) hr.with_reach
+
 
 theorem ReachSet.is_subcapt
   (hr : ReachSet Γ C R)
   : Subcapt Γ C R := by
-  induction hr
-  case empty => apply Subcapt.subset .empty
-  case union ha hb => apply! Subcapt.join
-  case var hb hr ih => apply Subcapt.trans (.var hb) ih
-  case cinstr hb hr ih => apply Subcapt.trans (.cinstr hb) ih
-  case cbound hb hr ih => apply Subcapt.trans (.cbound hb) ih
-  case ckind L hb =>
-    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
-    rw [← CaptureSet.proj]
-    apply Subcapt.proj_r
-    apply CaptureKind.sub Kind.Intersect.subkind_l (.cvar hb)
-  case label hb =>
-    apply Subcapt.trans _ (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
-    rw [← CaptureSet.proj]
-    apply Subcapt.proj_r
-    apply CaptureKind.sub Kind.Intersect.subkind_l (.label hb)
-  case absurd =>
-    apply! Subcapt.absurd (.singleton_absurd _)
+    apply Subcapt.trans .reach (.reachsetr hr)
 
 end Capless

From eb20261d34b08c41f013cf647e3dc8c439ece5a1 Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 27 Jan 2026 10:53:38 +0100
Subject: [PATCH 70/71] Update typing to use reachset, update renaming

---
 Capless/CaptureSet.lean                    |  6 +++
 Capless/Renaming/Capture/Subcapturing.lean | 44 ++++++++++++++++++++++
 Capless/Renaming/Capture/Typing.lean       | 36 +-----------------
 Capless/Renaming/Term/Subcapturing.lean    | 43 +++++++++++++++++++++
 Capless/Renaming/Term/Typing.lean          | 36 +-----------------
 Capless/Renaming/Type/Subcapturing.lean    | 33 ++++++++++++++++
 Capless/Renaming/Type/Typing.lean          | 30 ---------------
 Capless/Typing.lean                        |  6 +--
 8 files changed, 130 insertions(+), 104 deletions(-)

diff --git a/Capless/CaptureSet.lean b/Capless/CaptureSet.lean
index 51fa1a8d..bde11255 100644
--- a/Capless/CaptureSet.lean
+++ b/Capless/CaptureSet.lean
@@ -456,6 +456,12 @@ theorem CaptureSet.reach_reach {C : CaptureSet n k}: C.with_reach.with_reach = C
 theorem CaptureSet.reach_proj {C : CaptureSet n k} : C.with_reach.proj K = (C.proj K).with_reach := by
   induction C <;> aesop
 
+theorem CaptureSet.reach_rename {C : CaptureSet n k} : C.with_reach.rename f = (C.rename f).with_reach := by
+  induction C <;> aesop
+
+theorem CaptureSet.reach_crename {C : CaptureSet n k} : C.with_reach.crename f = (C.crename f).with_reach := by
+  induction C <;> aesop
+
 theorem CaptureSet.proj_reach_inv {C D : CaptureSet n k} (h1 : C.proj K = D.with_reach)
   : ∃ C' : CaptureSet n k, C'.proj K = D ∧ C = C'.with_reach := by
   induction C generalizing D
diff --git a/Capless/Renaming/Capture/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean
index bfed76cb..03471123 100644
--- a/Capless/Renaming/Capture/Subcapturing.lean
+++ b/Capless/Renaming/Capture/Subcapturing.lean
@@ -11,6 +11,41 @@ after renaming capture variables with a valid renaming map, we have `Δ ⊢ C1.c
 -/
 namespace Capless
 
+theorem ReachSet.crename
+  {Γ : Context n m k} {Δ : Context n m k'}
+  (h : ReachSet Γ C R)
+  (ρ : CVarMap Γ f Δ) :
+  ReachSet Δ (C.crename f) (R.crename f) := by
+  induction h generalizing k'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    simp [CType.crename] at hb1
+    apply var hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply cinstr hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply cbound hb1
+    rw [← CaptureSet.proj_crename]; exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+  case var_reach ih => apply! var_reach $ ih _
+  case cvar_creach ih => apply! cvar_creach $ ih _
+
+
 theorem CaptureSet.Subset.crename {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
   C1.crename f ⊆ C2.crename f := by
@@ -38,6 +73,9 @@ theorem CaptureKind.crename
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
   case singleton_absurd hk he => apply! singleton_absurd
+  case reach ih =>
+    rw [CaptureSet.reach_crename]
+    apply! reach (ih _)
 
 theorem Subcapt.crename
   (h : Subcapt Γ C1 C2)
@@ -52,5 +90,11 @@ theorem Subcapt.crename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case proj_r hk => apply! proj_r (hk.crename _)
+  case reachsetl hr =>
+    rw [CaptureSet.reach_crename]
+    apply! reachsetl $ hr.crename _
+  case reachsetr hr =>
+    rw [CaptureSet.reach_crename]
+    apply! reachsetr $ hr.crename _
 
 end Capless
diff --git a/Capless/Renaming/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean
index 534f5ef1..6ed74ea4 100644
--- a/Capless/Renaming/Capture/Typing.lean
+++ b/Capless/Renaming/Capture/Typing.lean
@@ -14,38 +14,6 @@ capture variables with a valid renaming map, we have `Δ ⊢ t.crename f : E.cre
 
 namespace Capless
 
-theorem ReachSet.crename
-  {Γ : Context n m k} {Δ : Context n m k'}
-  (h : ReachSet Γ C R)
-  (ρ : CVarMap Γ f Δ) :
-  ReachSet Δ (C.crename f) (R.crename f) := by
-  induction h generalizing k'
-  case empty => constructor
-  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
-  case var hb hr ih =>
-    have hb1 := ρ.map _ _ hb
-    simp [CType.crename] at hb1
-    apply var hb1
-    rw [← CaptureSet.proj_crename]; exact ih ρ
-  case cinstr hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.crename] at hb1
-    apply cinstr hb1
-    rw [← CaptureSet.proj_crename]; exact ih ρ
-  case cbound hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.crename] at hb1
-    apply cbound hb1
-    rw [← CaptureSet.proj_crename]; exact ih ρ
-  case ckind hb =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.crename] at hb1
-    apply ckind hb1
-  case label hb =>
-    have hb1 := ρ.lmap _ _ _ hb
-    apply label hb1
-  case absurd he => apply! absurd
-
 theorem Typed.crename
   {Γ : Context n m k} {Δ : Context n m k'}
   (h : Typed Γ t E Ct)
@@ -174,10 +142,8 @@ theorem Typed.crename
     apply intercept
     have ih := ih $ ((ρ.text _).ext _).ext _
     simp [TBinding.crename, EType.crename, CType.crename, SType.crename] at ih ih2
-    simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename] at ih ih2
+    simp [← SType.weaken_crename, ← SType.tweaken_crename, ← CaptureSet.weaken_crename, CaptureSet.proj_crename, CaptureSet.reach_crename] at ih ih2
     apply ih
     apply ih2 ρ
-    apply! ReachSet.crename
-    apply! CaptureSet.Subset.crename
 
 end Capless
diff --git a/Capless/Renaming/Term/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean
index 60e74572..eba3143f 100644
--- a/Capless/Renaming/Term/Subcapturing.lean
+++ b/Capless/Renaming/Term/Subcapturing.lean
@@ -12,6 +12,40 @@ after renaming term variables with a valid renaming map, we have `Δ ⊢ C1.rena
 
 namespace Capless
 
+theorem ReachSet.rename
+  {Γ : Context n m k} {Δ : Context n' m k}
+  (h : ReachSet Γ C R)
+  (ρ : VarMap Γ f Δ) :
+  ReachSet Δ (C.rename f) (R.rename f) := by
+  induction h generalizing n'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    simp [CType.rename] at hb1
+    apply var hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply cinstr hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply cbound hb1
+    rw [← CaptureSet.proj_rename]; exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    simp [CBinding.rename] at hb1
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+  case var_reach ih => apply! var_reach $ ih _
+  case cvar_creach ih => apply! cvar_creach $ ih _
+
 theorem CaptureSet.Subset.rename {C1 C2 : CaptureSet n k}
   (h : C1 ⊆ C2) :
   C1.rename f ⊆ C2.rename f := by
@@ -38,6 +72,9 @@ theorem CaptureKind.rename
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
   case singleton_absurd => apply! singleton_absurd
+  case reach ih =>
+  rw [CaptureSet.reach_rename]
+  apply! reach $ ih _
 
 theorem Subcapt.rename
   (h : Subcapt Γ C1 C2)
@@ -52,5 +89,11 @@ theorem Subcapt.rename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case proj_r hk => apply! proj_r (hk.rename _)
+  case reachsetl hr =>
+    rw [CaptureSet.reach_rename]
+    apply! reachsetl $ hr.rename _
+  case reachsetr hr =>
+    rw [CaptureSet.reach_rename]
+    apply! reachsetr $ hr.rename _
 
 end Capless
diff --git a/Capless/Renaming/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean
index a9e1cdb4..a9a53b8f 100644
--- a/Capless/Renaming/Term/Typing.lean
+++ b/Capless/Renaming/Term/Typing.lean
@@ -13,38 +13,6 @@ term variables with a valid renaming map, we have `Δ ⊢ t.rename f : E.rename
 -/
 namespace Capless
 
-theorem ReachSet.rename
-  {Γ : Context n m k} {Δ : Context n' m k}
-  (h : ReachSet Γ C R)
-  (ρ : VarMap Γ f Δ) :
-  ReachSet Δ (C.rename f) (R.rename f) := by
-  induction h generalizing n'
-  case empty => constructor
-  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
-  case var hb hr ih =>
-    have hb1 := ρ.map _ _ hb
-    simp [CType.rename] at hb1
-    apply var hb1
-    rw [← CaptureSet.proj_rename]; exact ih ρ
-  case cinstr hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cinstr hb1
-    rw [← CaptureSet.proj_rename]; exact ih ρ
-  case cbound hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply cbound hb1
-    rw [← CaptureSet.proj_rename]; exact ih ρ
-  case ckind hb =>
-    have hb1 := ρ.cmap _ _ hb
-    simp [CBinding.rename] at hb1
-    apply ckind hb1
-  case label hb =>
-    have hb1 := ρ.lmap _ _ _ hb
-    apply label hb1
-  case absurd he => apply! absurd
-
 theorem Typed.rename
   {Γ : Context n m k} {Δ : Context n' m k}
   (h : Typed Γ t E Ct)
@@ -175,10 +143,8 @@ theorem Typed.rename
     apply intercept
     have ih := ih $ ((ρ.text _).ext _).ext _
     simp [TBinding.rename, EType.rename, CType.rename, SType.rename] at ih ih2
-    simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename] at ih ih2
+    simp [← SType.weaken_rename, SType.tweaken_rename, ← CaptureSet.weaken_rename, CaptureSet.proj_rename, CaptureSet.reach_rename] at ih ih2
     apply ih
     apply ih2 ρ
-    apply! ReachSet.rename
-    apply! CaptureSet.Subset.rename
 
 end Capless
diff --git a/Capless/Renaming/Type/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean
index 0826ff84..df322f04 100644
--- a/Capless/Renaming/Type/Subcapturing.lean
+++ b/Capless/Renaming/Type/Subcapturing.lean
@@ -11,6 +11,36 @@ remain valid when type variables are renamed consistently between contexts.
 -/
 namespace Capless
 
+theorem ReachSet.trename
+  {Γ : Context n m k} {Δ : Context n m' k}
+  (h : ReachSet Γ C R)
+  (ρ : TVarMap Γ f Δ) :
+  ReachSet Δ C R := by
+  induction h generalizing m'
+  case empty => constructor
+  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
+  case var hb hr ih =>
+    have hb1 := ρ.map _ _ hb
+    apply var hb1
+    exact ih ρ
+  case cinstr hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    apply cinstr hb1
+    exact ih ρ
+  case cbound hb hr ih =>
+    have hb1 := ρ.cmap _ _ hb
+    apply cbound hb1
+    exact ih ρ
+  case ckind hb =>
+    have hb1 := ρ.cmap _ _ hb
+    apply ckind hb1
+  case label hb =>
+    have hb1 := ρ.lmap _ _ _ hb
+    apply label hb1
+  case absurd he => apply! absurd
+  case var_reach ih => apply! var_reach $ ih _
+  case cvar_creach ih => apply! cvar_creach $ ih _
+
 theorem CaptureKind.trename
   (h : CaptureKind Γ C K)
   (ρ : TVarMap Γ f Δ) :
@@ -25,6 +55,7 @@ theorem CaptureKind.trename
   case empty => apply empty
   case union ha hb => apply! union (ha _) (hb _)
   case singleton_absurd => apply! singleton_absurd
+  case reach ih => apply! reach $ ih _
 
 theorem Subcapt.trename
   (h : Subcapt Γ C1 C2)
@@ -39,5 +70,7 @@ theorem Subcapt.trename
   case cinstr hb => apply! cinstr (ρ.cmap _ _ hb)
   case cbound hb => apply! cbound (ρ.cmap _ _ hb)
   case proj_r hk => apply! proj_r (hk.trename _)
+  case reachsetl hr => apply! reachsetl $ hr.trename _
+  case reachsetr hr => apply! reachsetr $ hr.trename _
 
 end Capless
diff --git a/Capless/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean
index c1da5d1a..2147fb0f 100644
--- a/Capless/Renaming/Type/Typing.lean
+++ b/Capless/Renaming/Type/Typing.lean
@@ -13,34 +13,6 @@ type variables with a valid renaming map, we have `Δ ⊢ t.trename f : E.trenam
 -/
 namespace Capless
 
-theorem ReachSet.trename
-  {Γ : Context n m k} {Δ : Context n m' k}
-  (h : ReachSet Γ C R)
-  (ρ : TVarMap Γ f Δ) :
-  ReachSet Δ C R := by
-  induction h generalizing m'
-  case empty => constructor
-  case union ih1 ih2 => apply union (ih1 ρ) (ih2 ρ)
-  case var hb hr ih =>
-    have hb1 := ρ.map _ _ hb
-    apply var hb1
-    exact ih ρ
-  case cinstr hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    apply cinstr hb1
-    exact ih ρ
-  case cbound hb hr ih =>
-    have hb1 := ρ.cmap _ _ hb
-    apply cbound hb1
-    exact ih ρ
-  case ckind hb =>
-    have hb1 := ρ.cmap _ _ hb
-    apply ckind hb1
-  case label hb =>
-    have hb1 := ρ.lmap _ _ _ hb
-    apply label hb1
-  case absurd he => apply! absurd
-
 theorem Typed.trename
   {Γ : Context n m k} {Δ : Context n m' k}
   (h : Typed Γ t E Ct)
@@ -163,7 +135,5 @@ theorem Typed.trename
     simp [← SType.weaken_trename, ← SType.tweaken_trename] at ih ih2
     apply ih
     apply ih2 ρ
-    apply! ReachSet.trename
-    assumption
 
 end Capless
diff --git a/Capless/Typing.lean b/Capless/Typing.lean
index 3baa991b..afee4d67 100644
--- a/Capless/Typing.lean
+++ b/Capless/Typing.lean
@@ -75,14 +75,12 @@ inductive Typed : Context n m k -> Term n m k -> EType n m k -> CaptureSet n k -
     t
     (S.cweaken.weaken^{}) (C.cweaken.weaken ∪ {c=0|.top} ∪ {x=0|.top}) ->
   Typed Γ (boundary[c]: S in t) (S^CaptureSet.empty) C
-| intercept {Γ : Context n m k} {S : SType n m k} {C C1 Cr : CaptureSet n k}:
+| intercept {Γ : Context n m k} {S : SType n m k} {C C1 : CaptureSet n k}:
   Typed
-    (((Γ,X<:.top),x:(Label[.tvar 0]^(Cr.proj K))),x:(SType.tvar 0)^{})
+    (((Γ,X<:.top),x:(Label[.tvar 0]^(C.with_reach.proj K))),x:(SType.tvar 0)^{})
     h
     (S.tweaken.weaken.weaken^{}) (C1.weaken.weaken ∪ {x=0|.top} ∪ {x=1|.top}) ->
   Typed Γ t (S^{}) C ->
-  ReachSet Γ C Cr' ->
-  Cr' ⊆ Cr ->
   Typed Γ (intercept[K] with h in t) (S^{}) (C ∪ C1)
 -- | unwrap {Γ : Context n m k} {S : SType n m k} :
 --   Typed Γ (Term.var x) (EType.type (.maybe S)^C) {x=x|.top} ->

From 263ad128b60b236acac769590db93506109a95da Mon Sep 17 00:00:00 2001
From: Natsu Kagami <nki@nkagami.me>
Date: Tue, 27 Jan 2026 13:28:36 +0100
Subject: [PATCH 71/71] Snapshot before dropping `reach` case

---
 Capless/Classifier/Basic.lean           |   9 ++
 Capless/Subcapturing/CaptureKind.lean   |   7 +-
 Capless/Subst/Capture/Subcapturing.lean | 179 ++++++++++++++++++++++++
 Capless/Subst/Capture/Typing.lean       |  54 -------
 Capless/WellScoped/Basic.lean           | 171 ++++++++++++++++++++++
 Capless/WellScoped/ReachSet.lean        | 172 -----------------------
 6 files changed, 365 insertions(+), 227 deletions(-)

diff --git a/Capless/Classifier/Basic.lean b/Capless/Classifier/Basic.lean
index 8eca0876..ab0af7ee 100644
--- a/Capless/Classifier/Basic.lean
+++ b/Capless/Classifier/Basic.lean
@@ -33,6 +33,15 @@ theorem Kind.Intersect.subkind_r
   have h := Intersect.lawful K L
   apply h.is_ssubkind_r
 
+theorem Kind.Subkind.of_intersect
+  (hs1 : Subkind A B1)
+  (hs2 : Subkind A B2)
+  : Subkind A (B1.intersect B2) := by
+  rw [semantics] at *
+  intro c ha
+  have h := Intersect.lawful B1 B2
+  apply h.contains (hs1 c ha) (hs2 c ha)
+
 theorem Kind.Subkind.reorder_union_4 : Subkind ((A ++ B) ++ (C ++ D)) ((A ++ C) ++ (B ++ D)) := by
   apply union_l
   . apply union_l
diff --git a/Capless/Subcapturing/CaptureKind.lean b/Capless/Subcapturing/CaptureKind.lean
index e03d9159..1d195e2d 100644
--- a/Capless/Subcapturing/CaptureKind.lean
+++ b/Capless/Subcapturing/CaptureKind.lean
@@ -1,5 +1,6 @@
 import Capless.Subcapturing
 import Capless.Inversion.Context
+import Capless.WellScoped.ReachSet
 
 namespace Capless
 
@@ -580,7 +581,11 @@ theorem CaptureKind.apply_proj (hk : CaptureKind Γ C K) : CaptureKind Γ (C.pro
 theorem CaptureKind.apply_proj_singleton (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (K.intersect L) := by
   rw [← Kind.intersect.top_l (K:=L)]
   rw [← CaptureSet.proj, Kind.intersect.top_l]
-  apply hk.apply_proj
+  apply! apply_proj
+
+theorem CaptureKind.apply_proj_singleton' (hk : CaptureKind Γ (.singleton s .top) K) : CaptureKind Γ (.singleton s L) (L.intersect K) := by
+  apply sub _ hk.apply_proj_singleton
+  apply Kind.Intersect.subkind_symm
 
 private theorem Kind.elim_middle_intersect : Subkind (.intersect A (.intersect B C)) (.intersect A C) := by
   rw [Subkind.semantics]
diff --git a/Capless/Subst/Capture/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean
index f81a1ad2..45e05268 100644
--- a/Capless/Subst/Capture/Subcapturing.lean
+++ b/Capless/Subst/Capture/Subcapturing.lean
@@ -1,5 +1,6 @@
 import Capless.Subcapturing
 import Capless.Subst.Basic
+import Capless.WellScoped.Basic
 
 /-
 Substitution theorems for capture variable substitution in subcapturing judgments.
@@ -7,6 +8,176 @@ Substitution theorems for capture variable substitution in subcapturing judgment
 
 namespace Capless
 
+private theorem ReachSet.of_capture_kind
+  (hr : ReachSet Γ C R)
+  (hk : CaptureKind Γ C K)
+  : R ⊆ R.proj K := by
+  induction hr
+  case empty => apply CaptureSet.Subset.empty
+  case union ha hb =>
+    have ⟨_, _⟩ := hk.union_l_inv
+    apply! CaptureSet.Subset.union_monotone (ha _) (hb _)
+  case var hb hr ih =>
+    cases hk.var_lookup_inv hb <;> rename_i hk
+    . apply! ih
+    . apply ih (.absurd hk)
+  case cinstr hb hr ih =>
+    cases hk.cinst_lookup_inv hb <;> rename_i hk
+    . apply! ih
+    . apply ih (.absurd hk)
+  case cbound hb hr ih =>
+    cases hk.cbound_lookup_inv hb <;> rename_i hk
+    . apply! ih
+    . apply ih (.absurd hk)
+  case ckind hb =>
+    cases hk.ckind_lookup_inv hb
+    . apply! CaptureSet.Subset.singleton_subkind (.of_intersect .rfl _)
+    . apply CaptureSet.Subset.trans (.singleton_absurd _) .empty
+      apply! Kind.intersect.is_empty_r
+  case label hb =>
+    cases hk.label_lookup_inv hb
+    . apply! CaptureSet.Subset.singleton_subkind (.of_intersect .rfl _)
+    . apply CaptureSet.Subset.trans (.singleton_absurd _) .empty
+      apply! Kind.intersect.is_empty_r
+  case var_reach ih => apply ih hk.with_reach_inv
+  case cvar_creach ih => apply ih hk.with_reach_inv
+  case absurd => exact .empty
+
+
+private theorem drop_repeat_intersect_right : Kind.Subkind (.intersect L K) (Kind.intersect K (L.intersect K)) := by
+  rw [Kind.Subkind.semantics]
+  intro c ha
+  have h1 := Kind.Intersect.lawful L K
+  have h2 := Kind.Intersect.lawful K (L.intersect K)
+  have ⟨_, _⟩ := h1.contains_inv ha
+  apply! h2.contains
+
+private theorem ReachSet.from_capture_kind
+  (hk : CaptureKind Γ C K)
+  : ∃ R, (Subcapt Γ R ((C.proj K).with_reach)) ∧ ReachSet Γ C R := by
+  induction hk
+  case var hb hk ih =>
+    have ⟨R, h, ih⟩ := ih
+    exists R
+    apply And.intro _ (var hb ih)
+    apply Subcapt.trans (.subset $ ih.of_capture_kind hk)
+    rw [← CaptureSet.reach_proj]
+    apply Subcapt.apply_proj
+    apply Subcapt.reachsetl (var hb ih)
+  case label hb =>
+    apply Exists.intro
+    apply And.intro _ (.label hb)
+    apply Subcapt.subset (.trans .var_reach (.singleton_subkind drop_repeat_intersect_right))
+  case cvar hb =>
+    apply Exists.intro
+    apply And.intro _ (.ckind hb)
+    rw [← CaptureSet.reach_proj]
+    apply Subcapt.subset (.singleton_subkind drop_repeat_intersect_right)
+  case cbound hb hk ih =>
+    have ⟨R, h, ih⟩ := ih
+    exists R
+    apply And.intro _ (cbound hb ih)
+    apply Subcapt.trans (.subset $ ih.of_capture_kind hk)
+    rw [← CaptureSet.reach_proj]
+    apply Subcapt.apply_proj
+    apply Subcapt.reachsetl (cbound hb ih)
+  case cinstr hb hk ih =>
+    have ⟨R, h, ih⟩ := ih
+    exists R
+    apply And.intro _ (cinstr hb ih)
+    apply Subcapt.trans (.subset $ ih.of_capture_kind hk)
+    rw [← CaptureSet.reach_proj]
+    apply Subcapt.apply_proj
+    apply Subcapt.reachsetl (cinstr hb ih)
+  case sub ih =>
+    have ⟨R, h, ih⟩ := ih
+    exists R
+    apply And.intro _ ih
+    apply Subcapt.trans h
+    simp [← CaptureSet.reach_proj]
+    apply! Subcapt.subkind
+  case empty => exists ∅; apply And.intro (.subset .empty) .empty
+  case singleton_absurd he =>
+    exists .empty; apply And.intro (.subset .empty) (.absurd he)
+  case union ha hb =>
+    have ⟨Ra, ha, iha⟩ := ha
+    have ⟨Rb, hb, ihb⟩ := hb
+    exists Ra ∪ Rb
+    apply And.intro (.join ha hb) (.union iha ihb)
+  case reach ih =>
+    have ⟨R, h, ih⟩ := ih
+    exists R
+    apply And.intro _ ih.with_reach
+    rw [CaptureSet.reach_proj, CaptureSet.reach_reach]
+    apply h
+
+theorem ReachSet.csubst
+  {Γ : Context n m k} {Δ : Context n m k'}
+  (h : ReachSet Γ C R)
+  (σ : CVarSubst Γ f Δ) :
+  ∃ R', (Δ ⊢ R' <:c (R.crename f)) ∧ ReachSet Δ (C.crename f) R' := by
+  induction h generalizing k'
+  case empty => exists .empty; apply And.intro (.subset .empty) .empty
+  case union ih1 ih2 =>
+    have ⟨R1, hs1, h1⟩ := ih1 σ
+    have ⟨R2, hs2, h2⟩ := ih2 σ
+    exists R1 ∪ R2
+    simp
+    apply And.intro $ .join hs1 hs2
+    apply! union
+  case var hb hr ih =>
+    have hb1 := σ.map _ _ hb
+    simp [CType.crename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply var hb1
+    rw [← CaptureSet.proj_crename]; exact h
+  case cinstr hb hr ih =>
+    have hb1 := σ.cmap _ _ hb
+    simp [CBinding.crename] at hb1
+    have ⟨R, hs, h⟩ := ih σ
+    exists R
+    apply And.intro hs
+    apply cinstr hb1
+    rw [← CaptureSet.proj_crename]; exact h
+  case cbound L _ hb hr ih =>
+    have hb1 := σ.cmap_bound _ _ hb
+    cases hb1; rename_i hb1
+    have ⟨R1, hs1, h1⟩ := ih σ
+    have hb1' := hb1.apply_proj (K:=L)
+    rw [CaptureSet.proj, Kind.intersect.top_l, ← CaptureSet.proj_crename] at hb1'
+    have ⟨R2, hs2, h2⟩ := h1.subcapt hb1'
+    exists R2
+    apply And.intro $ .trans (.subset hs2) hs1
+    exact h2
+  case ckind c K L hb =>
+    have hb1 := σ.cmap_bound _ _ hb
+    cases hb1; rename_i hb1
+    have hb1 := hb1.apply_proj_singleton' (L:=L)
+    have ⟨R, h, ih⟩ := ReachSet.from_capture_kind $ hb1.sub Kind.Intersect.subkind_r
+    exists R
+    apply And.intro _ ih
+    rw [← CaptureSet.reach_proj, CaptureSet.with_reach, Singleton.with_reach, CaptureSet.proj] at h
+    apply Subcapt.trans h (.subset $ .singleton_subkind Kind.Intersect.subkind_symm)
+  case label c S L hb =>
+    have hb1 := σ.lmap _ _ _ hb
+    rename_i x
+    exists {x=x|((Kind.classifier c).intersect L)}
+    apply And.intro
+    . apply Subcapt.subset CaptureSet.Subset.rfl
+    . apply label hb1
+  case absurd he =>
+    exists ∅; apply And.intro; apply Subcapt.subset CaptureSet.Subset.empty; apply! absurd
+  case var_reach ih =>
+    have ⟨R, h, ih⟩ := ih σ
+    apply Exists.intro
+    apply And.intro h ih.var_reach
+  case cvar_creach ih =>
+    have ⟨R, h, ih⟩ := ih σ
+    apply Exists.intro
+    apply And.intro h ih.cvar_creach
+
 theorem CaptureKind.csubst
   (h : CaptureKind Γ C K)
   (σ : CVarSubst Γ f Δ) :
@@ -34,6 +205,9 @@ theorem CaptureKind.csubst
   case empty => apply empty
   case singleton_absurd => apply! singleton_absurd
   case union ha hb => apply! union (ha _) (hb _)
+  case reach ih =>
+    rw [CaptureSet.reach_crename]
+    apply! reach $ ih _
 
 theorem Subcapt.csubst
   (h : Subcapt Γ C1 C2)
@@ -50,5 +224,10 @@ theorem Subcapt.csubst
     cases σ.cmap_bound _ _ hb
     apply! apply_proj_singleton
   case proj_r hk => apply! proj_r (hk.csubst _)
+  case reachsetl hr =>
+    rw [CaptureSet.reach_crename]
+    have ⟨R, h, hr⟩ := hr.csubst σ
+
+
 
 end Capless
diff --git a/Capless/Subst/Capture/Typing.lean b/Capless/Subst/Capture/Typing.lean
index f5f46c1f..067e0151 100644
--- a/Capless/Subst/Capture/Typing.lean
+++ b/Capless/Subst/Capture/Typing.lean
@@ -10,60 +10,6 @@ Substitution theorems for capture variable substitution in typing judgments.
 
 namespace Capless
 
-theorem ReachSet.csubst
-  {Γ : Context n m k} {Δ : Context n m k'}
-  (h : ReachSet Γ C R)
-  (σ : CVarSubst Γ f Δ) :
-  ∃ R' ⊆ R.crename f, ReachSet Δ (C.crename f) R' := by
-  induction h generalizing k'
-  case empty => exists .empty; apply And.intro .empty .empty
-  case union ih1 ih2 =>
-    have ⟨R1, hs1, h1⟩ := ih1 σ
-    have ⟨R2, hs2, h2⟩ := ih2 σ
-    exists R1 ∪ R2
-    simp
-    apply And.intro $ CaptureSet.Subset.union_monotone hs1 hs2
-    apply! union
-  case var hb hr ih =>
-    have hb1 := σ.map _ _ hb
-    simp [CType.crename] at hb1
-    have ⟨R, hs, h⟩ := ih σ
-    exists R
-    apply And.intro hs
-    apply var hb1
-    rw [← CaptureSet.proj_crename]; exact h
-  case cinstr hb hr ih =>
-    have hb1 := σ.cmap _ _ hb
-    simp [CBinding.crename] at hb1
-    have ⟨R, hs, h⟩ := ih σ
-    exists R
-    apply And.intro hs
-    apply cinstr hb1
-    rw [← CaptureSet.proj_crename]; exact h
-  case cbound L _ hb hr ih =>
-    have hb1 := σ.cmap_bound _ _ hb
-    cases hb1; rename_i hb1
-    have ⟨R1, hs1, h1⟩ := ih σ
-    have hb1' := hb1.apply_proj (K:=L)
-    rw [CaptureSet.proj, Kind.intersect.top_l, ← CaptureSet.proj_crename] at hb1'
-    have ⟨R2, hs2, h2⟩ := h1.subcapt hb1'
-    exists R2
-    apply And.intro $ hs2.trans hs1
-    exact h2
-  case ckind c K L hb =>
-    have hb1 := σ.cmap_bound _ _ hb
-    cases hb1
-    sorry
-  case label c S L hb =>
-    have hb1 := σ.lmap _ _ _ hb
-    rename_i x
-    exists {x=x|((Kind.classifier c).intersect L)}
-    apply And.intro
-    . apply CaptureSet.Subset.rfl
-    . apply label hb1
-  case absurd he =>
-    exists ∅; apply And.intro; apply CaptureSet.Subset.empty; apply! absurd
-
 theorem Typed.csubst
   {Γ : Context n m k} {Δ : Context n m k'}
   (h : Typed Γ t E Ct)
diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean
index 28374be4..1826dd77 100644
--- a/Capless/WellScoped/Basic.lean
+++ b/Capless/WellScoped/Basic.lean
@@ -12,6 +12,177 @@ This file contains basic properties of the well-scopedness relation.
 
 namespace Capless
 
+theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
+  (hk : CaptureKind Γ C K)
+  (he : K.IsEmpty)
+  : ∃ R, R ⊆ .empty ∧ ReachSet Γ C R := by
+  induction hk
+  case var hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs (var hb h)
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro (.singleton_absurd he)
+    apply! label
+  case cvar c K L hb =>
+    exists .singleton (.creach c) (K.intersect L)
+    apply And.intro (.singleton_absurd he)
+    apply! ckind
+  case cbound hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cbound
+  case cinstr hb hk ih =>
+    have ⟨R, hs, h⟩ := ih he
+    exists R; apply And.intro hs
+    apply! cinstr
+  case sub hsk hk ih => apply ih (hsk.empty_r_inv he)
+  case empty => exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he2 => exists .empty; apply! And.intro .empty (.absurd he2)
+  case union ha hb =>
+    have ⟨Ra, hsa, ha⟩ := ha he
+    have ⟨Rb, hsb, hb⟩ := hb he
+    exists Ra ∪ Rb
+    apply And.intro (.union_l hsa hsb)
+    apply! union
+  case reach hk ih =>
+    have ⟨R0, hs0, hr0⟩ := ih he
+    exists R0
+    apply And.intro hs0 hr0.with_reach
+
+theorem ReachSet.proj_r
+  (hk : CaptureKind Γ C K)
+  (hr2 : ReachSet Γ (C.proj K) R2)
+  : ∃ R ⊆ R2, ReachSet Γ C R := by
+  induction hk generalizing R2
+  case var hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case var hb2 hr2 =>
+      cases Context.bound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! var
+    case label hb2 => cases Context.bound_lbound_absurd hb hb2
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! var
+  case label x c _ K hb =>
+    exists {x=x|(Kind.classifier c).intersect K}
+    apply And.intro _ (.label hb)
+    cases hr2
+    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
+    case label hb2 =>
+      cases Context.lbound_inj hb hb2; subst_vars
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case absurd he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cvar c C K hb =>
+    exists .singleton (.creach c) (C.intersect K)
+    apply And.intro _ (.ckind hb)
+    cases hr2
+    case ckind hb2 =>
+      cases Context.cbound_injective hb hb2
+      rw [← Kind.intersect.assoc]
+      exact .singleton_subkind Kind.Intersect.subkind_self
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case absurd x c _ K he =>
+      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
+  case cbound hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cbound
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cbound
+  case cinstr hb hk ih =>
+    rw [CaptureSet.proj_proj] at ih
+    cases hr2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case cinstr hb2 hr2 =>
+      cases Context.cbound_injective hb hb2
+      have ⟨R, h1, h2⟩ := ih hr2
+      exists R; apply And.intro h1
+      apply! cinstr
+    case absurd K he =>
+      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
+      exists R; apply And.intro h1
+      apply! cinstr
+  case sub hsk hk ih =>
+    have ⟨R3, h3, hr3⟩ := hr2.subkind hsk
+    have ⟨R, h, ih⟩ := ih hr3
+    exists R
+    apply And.intro (.trans h h3) ih
+  case empty => cases hr2; exists .empty; apply And.intro .empty .empty
+  case singleton_absurd he =>
+    exists .empty; apply And.intro .empty (.absurd he)
+  case union ha hb iha ihb =>
+    cases hr2
+    rename_i ha2 hb2
+    have ⟨R1, h1, ih1⟩ := iha ha2
+    have ⟨R2, h2, ih2⟩ := ihb hb2
+    exists R1 ∪ R2
+    apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
+  case reach hr ih =>
+    rw [CaptureSet.reach_proj] at hr2
+    have ⟨R, h, ih⟩ := ih hr2.with_reach_inv
+    exists R
+    apply And.intro h ih.with_reach
+
+theorem ReachSet.subcapt
+  (hr2 : ReachSet Γ C2 R2)
+  (hs : Subcapt Γ C1 C2)
+  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
+  induction hs generalizing R2
+  case trans ha hb =>
+    have ⟨R2, hs2, hr⟩ := hb hr2
+    have ⟨R1, hs1, hr⟩ := ha hr
+    exists R1
+    apply! And.intro (.trans hs1 hs2)
+  case subset => apply! subset
+  case union ha hb =>
+    have ⟨Ra, hsa, hra⟩ := ha hr2
+    have ⟨Rb, hsb, hrb⟩ := hb hr2
+    exists Ra ∪ Rb
+    apply And.intro (.union_l hsa hsb) (.union hra hrb)
+  case var hb => exists R2; apply And.intro .rfl; apply! var
+  case cinstl hb =>
+    cases hr2
+    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
+    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
+    case ckind hb2 => cases Context.cbound_injective hb hb2
+    case absurd _ he => apply! proj_absurd
+  case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
+  case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
+  case proj_r hk => apply! proj_r
+  case reachsetl hr =>
+    have ⟨R1, h1, _, hr1⟩ := hr.idempotent
+    exists R1
+    apply And.intro (.trans h1 (hr.inj hr2.with_reach_inv)) hr1
+  case reachsetr hr =>
+    have ⟨R1, _, h1, hr1⟩ := hr.idempotent
+    have h2 := hr1.inj hr2
+    apply Exists.intro
+    apply And.intro (h1.trans h2) hr.with_reach
+
+
+theorem ReachSet.is_subcapt
+  (hr : ReachSet Γ C R)
+  : Subcapt Γ C R := by
+    apply Subcapt.trans .reach (.reachsetr hr)
+
+
 theorem WellScoped.subkind {C : CaptureSet n k}
   (hsc : WellScoped Γ cont (C.proj L))
   (hsk : K.Subkind L)
diff --git a/Capless/WellScoped/ReachSet.lean b/Capless/WellScoped/ReachSet.lean
index a615491e..ec09f406 100644
--- a/Capless/WellScoped/ReachSet.lean
+++ b/Capless/WellScoped/ReachSet.lean
@@ -1,6 +1,4 @@
 import Capless.Store
-import Capless.Subcapturing
-import Capless.Subcapturing.Basic
 import Capless.Inversion.Context
 
 namespace Capless
@@ -517,174 +515,4 @@ theorem ReachSet.with_reach_inv
     unfold CaptureSet.with_reach at h; split at h <;> simp_all [-Kind.intersect]
     have ⟨h1, h2⟩ := h; split at h1 <;> (subst_vars; simp_all; apply! absurd)
 
-theorem ReachSet.capture_kind_absurd {Γ: Context n m k}
-  (hk : CaptureKind Γ C K)
-  (he : K.IsEmpty)
-  : ∃ R, R ⊆ .empty ∧ ReachSet Γ C R := by
-  induction hk
-  case var hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs (var hb h)
-  case label x c _ K hb =>
-    exists {x=x|(Kind.classifier c).intersect K}
-    apply And.intro (.singleton_absurd he)
-    apply! label
-  case cvar c K L hb =>
-    exists .singleton (.creach c) (K.intersect L)
-    apply And.intro (.singleton_absurd he)
-    apply! ckind
-  case cbound hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs
-    apply! cbound
-  case cinstr hb hk ih =>
-    have ⟨R, hs, h⟩ := ih he
-    exists R; apply And.intro hs
-    apply! cinstr
-  case sub hsk hk ih => apply ih (hsk.empty_r_inv he)
-  case empty => exists .empty; apply And.intro .empty .empty
-  case singleton_absurd he2 => exists .empty; apply! And.intro .empty (.absurd he2)
-  case union ha hb =>
-    have ⟨Ra, hsa, ha⟩ := ha he
-    have ⟨Rb, hsb, hb⟩ := hb he
-    exists Ra ∪ Rb
-    apply And.intro (.union_l hsa hsb)
-    apply! union
-  case reach hk ih =>
-    have ⟨R0, hs0, hr0⟩ := ih he
-    exists R0
-    apply And.intro hs0 hr0.with_reach
-
-theorem ReachSet.proj_r
-  (hk : CaptureKind Γ C K)
-  (hr2 : ReachSet Γ (C.proj K) R2)
-  : ∃ R ⊆ R2, ReachSet Γ C R := by
-  induction hk generalizing R2
-  case var hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case var hb2 hr2 =>
-      cases Context.bound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! var
-    case label hb2 => cases Context.bound_lbound_absurd hb hb2
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! var
-  case label x c _ K hb =>
-    exists {x=x|(Kind.classifier c).intersect K}
-    apply And.intro _ (.label hb)
-    cases hr2
-    case var hb2 hr2 => cases Context.bound_lbound_absurd hb2 hb
-    case label hb2 =>
-      cases Context.lbound_inj hb hb2; subst_vars
-      rw [← Kind.intersect.assoc]
-      exact .singleton_subkind Kind.Intersect.subkind_self
-    case absurd he =>
-      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
-  case cvar c C K hb =>
-    exists .singleton (.creach c) (C.intersect K)
-    apply And.intro _ (.ckind hb)
-    cases hr2
-    case ckind hb2 =>
-      cases Context.cbound_injective hb hb2
-      rw [← Kind.intersect.assoc]
-      exact .singleton_subkind Kind.Intersect.subkind_self
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case absurd x c _ K he =>
-      exact .singleton_absurd $ Kind.Intersect.is_empty_repeat he
-  case cbound hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! cbound
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! cbound
-  case cinstr hb hk ih =>
-    rw [CaptureSet.proj_proj] at ih
-    cases hr2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case cinstr hb2 hr2 =>
-      cases Context.cbound_injective hb hb2
-      have ⟨R, h1, h2⟩ := ih hr2
-      exists R; apply And.intro h1
-      apply! cinstr
-    case absurd K he =>
-      have ⟨R, h1, h2⟩ := capture_kind_absurd hk.intersect_with_proj he
-      exists R; apply And.intro h1
-      apply! cinstr
-  case sub hsk hk ih =>
-    have ⟨R3, h3, hr3⟩ := hr2.subkind hsk
-    have ⟨R, h, ih⟩ := ih hr3
-    exists R
-    apply And.intro (.trans h h3) ih
-  case empty => cases hr2; exists .empty; apply And.intro .empty .empty
-  case singleton_absurd he =>
-    exists .empty; apply And.intro .empty (.absurd he)
-  case union ha hb iha ihb =>
-    cases hr2
-    rename_i ha2 hb2
-    have ⟨R1, h1, ih1⟩ := iha ha2
-    have ⟨R2, h2, ih2⟩ := ihb hb2
-    exists R1 ∪ R2
-    apply And.intro (.union_monotone h1 h2) (.union ih1 ih2)
-  case reach hr ih =>
-    rw [CaptureSet.reach_proj] at hr2
-    have ⟨R, h, ih⟩ := ih hr2.with_reach_inv
-    exists R
-    apply And.intro h ih.with_reach
-
-theorem ReachSet.subcapt
-  (hr2 : ReachSet Γ C2 R2)
-  (hs : Subcapt Γ C1 C2)
-  : ∃ R1, R1 ⊆ R2 ∧ ReachSet Γ C1 R1 := by
-  induction hs generalizing R2
-  case trans ha hb =>
-    have ⟨R2, hs2, hr⟩ := hb hr2
-    have ⟨R1, hs1, hr⟩ := ha hr
-    exists R1
-    apply! And.intro (.trans hs1 hs2)
-  case subset => apply! subset
-  case union ha hb =>
-    have ⟨Ra, hsa, hra⟩ := ha hr2
-    have ⟨Rb, hsb, hrb⟩ := hb hr2
-    exists Ra ∪ Rb
-    apply And.intro (.union_l hsa hsb) (.union hra hrb)
-  case var hb => exists R2; apply And.intro .rfl; apply! var
-  case cinstl hb =>
-    cases hr2
-    case cinstr hb2 hr2 => cases Context.cbound_injective hb hb2; exists R2; apply! And.intro .rfl
-    case cbound hb2 hr2 => cases Context.cbound_injective hb hb2
-    case ckind hb2 => cases Context.cbound_injective hb hb2
-    case absurd _ he => apply! proj_absurd
-  case cinstr hb => exists R2; apply And.intro .rfl; apply! cinstr
-  case cbound hb => exists R2; apply And.intro .rfl; apply! cbound
-  case proj_r hk => apply! proj_r
-  case reachsetl hr =>
-    have ⟨R1, h1, _, hr1⟩ := hr.idempotent
-    exists R1
-    apply And.intro (.trans h1 (hr.inj hr2.with_reach_inv)) hr1
-  case reachsetr hr =>
-    have ⟨R1, _, h1, hr1⟩ := hr.idempotent
-    have h2 := hr1.inj hr2
-    apply Exists.intro
-    apply And.intro (h1.trans h2) hr.with_reach
-
-
-theorem ReachSet.is_subcapt
-  (hr : ReachSet Γ C R)
-  : Subcapt Γ C R := by
-    apply Subcapt.trans .reach (.reachsetr hr)
-
 end Capless