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/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/CaptureBound.lean b/Capless/CaptureBound.lean new file mode 100644 index 00000000..e5973e2b --- /dev/null +++ b/Capless/CaptureBound.lean @@ -0,0 +1,9 @@ +import Capless.CaptureSet +import Capless.Type +import Capless.Subcapturing + +namespace Capless + +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/CaptureSet.lean b/Capless/CaptureSet.lean index 5c521057..bde11255 100644 --- a/Capless/CaptureSet.lean +++ b/Capless/CaptureSet.lean @@ -2,6 +2,8 @@ import Mathlib.Data.Finset.Basic 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 @@ -11,6 +13,12 @@ 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 +| reach : Fin n -> Singleton n k +| creach : Fin k -> Singleton n k + /-- Capture sets in System Capless. The type of capture sets is parameterized by: @@ -29,15 +37,44 @@ 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 : 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 p => singleton s (p.intersect K) + +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 => 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 -notation:max "{x=" x "}" => CaptureSet.singleton x -notation:max "{c=" c "}" => CaptureSet.csingleton c +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 @@ -57,30 +94,150 @@ 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) +| 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 @[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 + 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 (.refl _) + apply And.intro <;> apply! union_rl + case union_rr ha => + 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 + + + +@[simp] +instance : IsTrans (CaptureSet n k) (HasSubset.Subset) where + trans a b c := CaptureSet.Subset.trans + +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 + +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) + +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 => unfold proj; apply singleton_absurd; apply Kind.intersect.is_empty_r he + /-! ## 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 + | 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} : + 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 => {x=f x} - | csingleton c => {c=c} + | 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 x => {x=x} - | csingleton c => {c=f c} + | singleton s p => singleton (s.crename f) p def CaptureSet.weaken (C : CaptureSet n k) : CaptureSet (n+1) k := C.rename FinFun.weaken @@ -115,20 +272,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 @@ -136,6 +293,7 @@ theorem CaptureSet.rename_empty : theorem CaptureSet.crename_empty : ({} : CaptureSet n k).crename f = {} := by simp + 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 @@ -172,16 +330,13 @@ 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 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 | 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 - simp [csingleton, weaken] + ({c=c | K} : CaptureSet n k).weaken = {c=c | K} := by + simp [singleton, weaken] theorem CaptureSet.rename_id {C : CaptureSet n k} : C.rename FinFun.id = C := by @@ -194,21 +349,156 @@ theorem CaptureSet.crename_id {C : CaptureSet n k} : theorem CaptureSet.crename_monotone {C1 C2 : CaptureSet n k} {f : FinFun k k'} (h : C1 ⊆ C2) : C1.crename f ⊆ C2.crename f := by - induction h <;> try (solve | constructor | simp; constructor <;> trivial) - case union_rr => - simp + induction h <;> simp + case empty => constructor + case rfl => constructor + case union_l ha hb iha ihb => + apply! Subset.union_l + case union_rl ha ih => + 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 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 theorem CaptureSet.cweaken_monotone {C1 C2 : CaptureSet n k} (h : C1 ⊆ C2) : C1.cweaken ⊆ C2.cweaken := by - induction h <;> try (solve | constructor | simp; constructor <;> trivial) - case union_rr => - simp + induction h <;> simp + case empty => constructor + case rfl => constructor + case union_l ha hb iha ihb => + apply! Subset.union_l + case union_rl ha ih => + 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 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 theorem CaptureSet.cweaken_def {C : CaptureSet n k} : C.cweaken = C.crename FinFun.weaken := by induction C <;> aesop -end Capless +-- /-! +-- ## Projections +-- -/ + +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 + 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 var_reach => apply! var_reach + case cvar_creach => apply! cvar_creach + 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 + 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 + +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 + +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 iha ihb => + 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.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 + 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 + +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/Classifier.lean b/Capless/Classifier.lean new file mode 100644 index 00000000..73ae2e84 --- /dev/null +++ b/Capless/Classifier.lean @@ -0,0 +1,8 @@ +import Capless.Classifier.Core +import Capless.Classifier.Kind +import Capless.Classifier.Intersection +import Capless.Classifier.Subtract +import Capless.Classifier.Subkind +import Capless.Classifier.Basic + +namespace Capless diff --git a/Capless/Classifier/Basic.lean b/Capless/Classifier/Basic.lean new file mode 100644 index 00000000..ab0af7ee --- /dev/null +++ b/Capless/Classifier/Basic.lean @@ -0,0 +1,137 @@ +import Capless.Classifier.Semantics +import Capless.Classifier.Subkind +import Capless.Classifier.Intersection +import Capless.Classifier.Disjoint + +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.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 + . 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) + +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 + +-- 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/Core.lean b/Capless/Classifier/Core.lean new file mode 100644 index 00000000..0ba0b009 --- /dev/null +++ b/Capless/Classifier/Core.lean @@ -0,0 +1,329 @@ +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 + +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 + | .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 + +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 + 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/Disjoint.lean b/Capless/Classifier/Disjoint.lean new file mode 100644 index 00000000..8525522c --- /dev/null +++ b/Capless/Classifier/Disjoint.lean @@ -0,0 +1,73 @@ +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 + 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 + +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/Classifier/Intersection.lean b/Capless/Classifier/Intersection.lean new file mode 100644 index 00000000..8f80a4eb --- /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 + +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 + 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 (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 _) + 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..7c925601 --- /dev/null +++ b/Capless/Classifier/Kind.lean @@ -0,0 +1,135 @@ +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 +deriving DecidableEq + +/-- 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 + +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 + | 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.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') + | 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) + +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. -/ +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/Semantics.lean b/Capless/Classifier/Semantics.lean new file mode 100644 index 00000000..03d6b971 --- /dev/null +++ b/Capless/Classifier/Semantics.lean @@ -0,0 +1,469 @@ +import Capless.Classifier.Subtract +import Capless.Classifier.Intersection + +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 + +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 + 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 + +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 + +@[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.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) + : 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 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 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 + +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/Classifier/Subkind.lean b/Capless/Classifier/Subkind.lean new file mode 100644 index 00000000..19eaadb3 --- /dev/null +++ b/Capless/Classifier/Subkind.lean @@ -0,0 +1,73 @@ +import Capless.Classifier.Subtract +import Capless.Classifier.Semantics + +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 + +/-- 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 new file mode 100644 index 00000000..f233969a --- /dev/null +++ b/Capless/Classifier/Subtract.lean @@ -0,0 +1,881 @@ +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_insert + (hs1 : Subtract (mk r1 (xs ++ ys)) (mk r2 ex2) R1) + (he : R1.IsEmpty) + (hs2 : Subtract (mk r1 (xs ++ zs ++ ys)) (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 (.insert _) + case cons a ex2 ih => + cases hs1 + case excl_absurd_r hss => + apply hs2.is_empty_l + 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.insert + . apply! ih + case excl_subclass_l => + apply hs2.is_empty_l + apply Kind.IsEmpty.node (.insert he.is_absurd) + case excl_irrelevant_l hs1 => apply! ih hs1 _ (hs2.excl_irrelevant_l_inv _ _) + +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_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_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 + +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 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) + (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_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 => + 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 + +theorem Kind.Subtract.is_empty_transform_internal + (hs1 : Subtract (.node r1 (xs ++ ys)) L R1) + (he1 : R1.IsEmpty) + (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 (.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 R2' ha2' hb2 + have ha1 := ha1'.is_singleton + have ha2 := ha2'.is_singleton + generalize h : (Subtree.mk r1 (xs ++ ys)) = x at ha1 + induction ha1 generalizing R1 R2' R2 <;> (injections; subst_vars) + case tree => + cases ha2 + 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.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 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 + +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 + +end Capless diff --git a/Capless/Context.lean b/Capless/Context.lean index ce28b6d5..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) @@ -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) /-! @@ -127,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 @@ -142,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 @@ -157,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..9853e357 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 @@ -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/Inversion/Lookup.lean b/Capless/Inversion/Lookup.lean index bad0bfe7..e31e808b 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,26 +125,38 @@ 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) + (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/Inversion/Typing.lean b/Capless/Inversion/Typing.lean index 40526430..e49643f4 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 @@ -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|.top} := 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 + apply Subcapt.rfl 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|.top} := Typed.canonical_form_pack' ht rfl rfl h theorem Typed.forall_inv' {v : Term n m k} @@ -510,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 @@ -587,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' @@ -611,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 @@ -624,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 @@ -635,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 @@ -651,65 +654,69 @@ 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) : + (c.Subclass .control) ∧ Typed - ((Γ,c<:*),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 => 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 } { 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) : + (c.Subclass .control) ∧ Typed - ((Γ,c<:*),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/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/ReachSet.lean b/Capless/ReachSet.lean new file mode 100644 index 00000000..c2201700 --- /dev/null +++ b/Capless/ReachSet.lean @@ -0,0 +1,70 @@ +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} (.singleton (.creach c) (K.intersect L)) +| 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 + 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 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 + +end Capless diff --git a/Capless/Reduction.lean b/Capless/Reduction.lean index f5099033..d3dbca88 100644 --- a/Capless/Reduction.lean +++ b/Capless/Reduction.lean @@ -24,8 +24,12 @@ 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⟩ +| 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 S -> - cont.HasLabel x tail -> + σ.LBound x c S -> + cont.HasIntercept x (.classifier c) .none tail -> Reduce ⟨σ | cont | Term.invoke x y⟩ ⟨σ | tail | Term.var y⟩ 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/CaptureBound.lean b/Capless/Renaming/Capture/CaptureBound.lean new file mode 100644 index 00000000..40c88cab --- /dev/null +++ b/Capless/Renaming/Capture/CaptureBound.lean @@ -0,0 +1,26 @@ +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 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/Subcapturing.lean b/Capless/Renaming/Capture/Subcapturing.lean index 25dd2ecc..03471123 100644 --- a/Capless/Renaming/Capture/Subcapturing.lean +++ b/Capless/Renaming/Capture/Subcapturing.lean @@ -11,47 +11,90 @@ 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 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) + (ρ : CVarMap Γ f Δ) : + CaptureKind Δ (C.crename f) K := by + induction h + 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 => + 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 singleton_absurd hk he => apply! singleton_absurd + case reach ih => + rw [CaptureSet.reach_crename] + apply! reach (ih _) 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 - have hb1 := ρ.map _ _ hb - simp [EType.crename, CType.crename] at hb1 - assumption - case cinstl hb => - simp [CaptureSet.crename_csingleton] - have hb1 := ρ.cmap _ _ hb - simp [CBinding.rename] at hb1 - apply cinstl - assumption - case cinstr hb => - simp [CaptureSet.crename_csingleton] - have hb1 := ρ.cmap _ _ hb - simp [CBinding.rename] at hb1 - apply cinstr - assumption - case cbound hb => - simp [CaptureSet.crename_csingleton] - have hb1 := ρ.cmap _ _ hb - simp [CBinding.rename] at hb1 - apply cbound - assumption + 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 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/Subtyping.lean b/Capless/Renaming/Capture/Subtyping.lean index b0e86d16..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 @@ -21,9 +22,15 @@ 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 + 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/Capture/Typing.lean b/Capless/Renaming/Capture/Typing.lean index 043bc487..6ed74ea4 100644 --- a/Capless/Renaming/Capture/Typing.lean +++ b/Capless/Renaming/Capture/Typing.lean @@ -1,6 +1,8 @@ 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 @@ -27,6 +29,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 @@ -121,7 +125,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, @@ -134,5 +138,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, CaptureSet.reach_crename] at ih ih2 + apply ih + apply ih2 ρ end Capless diff --git a/Capless/Renaming/Term/CaptureBound.lean b/Capless/Renaming/Term/CaptureBound.lean new file mode 100644 index 00000000..4f5af7e7 --- /dev/null +++ b/Capless/Renaming/Term/CaptureBound.lean @@ -0,0 +1,25 @@ +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 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/Subcapturing.lean b/Capless/Renaming/Term/Subcapturing.lean index 950dc793..eba3143f 100644 --- a/Capless/Renaming/Term/Subcapturing.lean +++ b/Capless/Renaming/Term/Subcapturing.lean @@ -12,47 +12,88 @@ 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 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) + (ρ : VarMap Γ f Δ) : Δ ⊢ (C.rename f) :k K := by + induction h + 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 => + 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 singleton_absurd => apply! singleton_absurd + case reach ih => + rw [CaptureSet.reach_rename] + apply! reach $ ih _ 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) :=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 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/Subtyping.lean b/Capless/Renaming/Term/Subtyping.lean index 4e946418..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 @@ -20,7 +21,11 @@ theorem Subbound.rename simp [CBound.rename] constructor apply Subcapt.rename <;> easy - case star => simp [CBound.rename]; constructor + 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/Term/Typing.lean b/Capless/Renaming/Term/Typing.lean index 219997a5..a9a53b8f 100644 --- a/Capless/Renaming/Term/Typing.lean +++ b/Capless/Renaming/Term/Typing.lean @@ -1,6 +1,8 @@ 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 @@ -26,6 +28,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 @@ -126,7 +129,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 @@ -136,5 +139,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, CaptureSet.reach_rename] at ih ih2 + apply ih + apply ih2 ρ end Capless diff --git a/Capless/Renaming/Type/CaptureBound.lean b/Capless/Renaming/Type/CaptureBound.lean new file mode 100644 index 00000000..2acd7ddb --- /dev/null +++ b/Capless/Renaming/Type/CaptureBound.lean @@ -0,0 +1,25 @@ +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 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/Subcapturing.lean b/Capless/Renaming/Type/Subcapturing.lean index 602cc6ec..df322f04 100644 --- a/Capless/Renaming/Type/Subcapturing.lean +++ b/Capless/Renaming/Type/Subcapturing.lean @@ -11,33 +11,66 @@ remain valid when type variables are renamed consistently between contexts. -/ namespace Capless -theorem Subcapt.trename - (h : Subcapt Γ C1 C2) +theorem ReachSet.trename + {Γ : Context n m k} {Δ : Context n m' k} + (h : ReachSet Γ C R) (ρ : 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 + 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 - simp [EType.trename, CType.trename] at hb1 - exact hb1 - case cinstl hb => - apply cinstl + apply var hb1 + exact ih ρ + case cinstr hb hr ih => have hb1 := ρ.cmap _ _ hb - exact hb1 - case cinstr hb => - apply cinstr + apply cinstr hb1 + exact ih ρ + case cbound hb hr ih => have hb1 := ρ.cmap _ _ hb - exact hb1 - case cbound hb => - apply cbound + apply cbound hb1 + exact ih ρ + case ckind hb => have hb1 := ρ.cmap _ _ hb - exact 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 CaptureKind.trename + (h : CaptureKind Γ C K) + (ρ : TVarMap Γ f Δ) : + 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 _) + case singleton_absurd => apply! singleton_absurd + case reach ih => apply! reach $ ih _ + +theorem Subcapt.trename + (h : Subcapt Γ C1 C2) + (ρ : TVarMap Γ f Δ) : + 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 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/Subtyping.lean b/Capless/Renaming/Type/Subtyping.lean index b2d89e2e..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 @@ -20,7 +21,10 @@ theorem Subbound.trename case set => apply Subbound.set apply Subcapt.trename <;> trivial - case star => apply Subbound.star + 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/Renaming/Type/Typing.lean b/Capless/Renaming/Type/Typing.lean index 7b0bfae9..2147fb0f 100644 --- a/Capless/Renaming/Type/Typing.lean +++ b/Capless/Renaming/Type/Typing.lean @@ -1,6 +1,8 @@ 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 @@ -27,6 +29,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 @@ -117,12 +121,19 @@ 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 , 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/Preservation.lean b/Capless/Soundness/Preservation.lean index 3865b948..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 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) @@ -50,10 +55,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} : @@ -64,37 +69,45 @@ 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 } { 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 - 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 } } - { 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 } case tapply hl => cases ht case mk hs hsc ht hc => @@ -108,7 +121,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 +143,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,21 +165,21 @@ theorem preservation { apply WellScoped.cons; easy } { constructor apply Typed.sub <;> try easy - apply Subcapt.refl + apply Subcapt.rfl apply ESubtyp.weaken; easy { easy } easy } 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 } { 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 } @@ -193,9 +206,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 @@ -228,7 +241,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 +253,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 +293,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 +307,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 +324,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 +336,6 @@ theorem preservation easy } { apply hc1.narrow constructor; constructor - apply Subcapt.refl; easy } + apply Subcapt.rfl; easy } end Capless diff --git a/Capless/Soundness/Progress.lean b/Capless/Soundness/Progress.lean index 802075ba..54578e2a 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 @@ -170,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 @@ -181,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 + 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 @@ -212,12 +220,15 @@ 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 ⟨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 + have ⟨_, hsl⟩ := hr.label_inv hsc hl + 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 9a33dc39..315b8a1d 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 @@ -37,6 +38,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 @@ -55,6 +57,11 @@ inductive Cont : Nat -> Nat -> Nat -> Type where (l : Fin n) -> Cont n m k -> Cont n m k +| intercept : -- intercept frame + Kind -> + Term (n + 2) (m + 1) k -> + Cont n m k -> + Cont n m k /-- Evaluation state. -/ structure State (n : Nat) (m : Nat) (k : Nat) where @@ -80,7 +87,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. -/ @@ -99,61 +106,135 @@ 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 h 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 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 -> Option (Term (n + 2) (m + 1) k) -> Cont n m k -> Prop where +| here_label : + 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 h tail) l L (.some h) tail +| there_intercept : + Cont.HasIntercept tail l L h' tail' -> + L.disjoint K = true -> + Cont.HasIntercept (Cont.intercept K h tail) l L h' tail' +| there_val : + Cont.HasIntercept cont l L h tail -> + Cont.HasIntercept (Cont.cons t cont) l L h tail +| there_tval : + Cont.HasIntercept cont l L h tail -> + Cont.HasIntercept (Cont.conse t cont) l L h tail +| there_cval : + Cont.HasIntercept cont l L h tail -> + Cont.HasIntercept (Cont.scope l' cont) l L h tail +| there_label : + Cont.HasIntercept cont l L h tail -> + Cont.HasIntercept (Cont.scope l' cont) l L h tail + +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 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 + +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`). + -- 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 {} | union : WellScoped Γ cont C1 -> WellScoped Γ cont C2 -> - WellScoped Γ cont (C1 ∪ C2) -| singleton : - Context.Bound Γ x (S^C) -> - WellScoped Γ cont C -> - WellScoped Γ cont {x=x} -| csingleton : - Context.CBound Γ c (CBinding.inst C) -> - WellScoped Γ cont C -> - WellScoped Γ cont {c=c} -| cbound : - Context.CBound Γ c (CBinding.bound (CBound.upper C)) -> - WellScoped Γ cont C -> - WellScoped Γ cont {c=c} + WellScoped Γ cont (.union C1 C2) +| 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 S -> + Context.LBound Γ x c S -> Cont.HasLabel cont x tail -> - WellScoped Γ cont {x=x} + WellScoped Γ cont {x=x|L} +| label_disj : -- label is within context but not reachable from stack + 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` 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 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 Γ E (Cin ∪ Ct) cont E' C -> + TypedCont Γ (EType.ex B T) Cin (Cont.conse t cont) E' (C ∪ Ct) | scope : - Context.LBound Γ x S -> - TypedCont Γ (S^{}) cont E' C -> + Context.LBound Γ x c S -> + 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 +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 -> - TypedCont Γ E cont E' C -> - TypedState (State.mk σ cont t) Γ E' + ReachSet Γ Ct Rt -> + WellScoped Γ cont Rt -> + TypedCont Γ E Ct cont E' C -> + TypedState (State.mk σ cont t) Γ E' Rt /-! ## Store Lookup @@ -175,7 +256,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 : @@ -191,7 +272,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 : @@ -207,23 +288,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 @@ -236,18 +317,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 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.trename FinFun.weaken.ext) 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 h cont => Cont.intercept K h.cweaken cont.cweaken /-! ## Tightness @@ -268,7 +352,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 204cf811..5f61e3f6 100644 --- a/Capless/Subcapturing.lean +++ b/Capless/Subcapturing.lean @@ -1,5 +1,6 @@ import Capless.Context import Capless.CaptureSet +import Capless.ReachSet /-! @@ -10,6 +11,19 @@ import Capless.CaptureSet 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} (.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 + | 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 : Subcapt Γ C1 C2 -> @@ -24,17 +38,29 @@ 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 + Subcapt Γ {c=c|L} (C.proj L) +| proj_r : CaptureKind Γ C K -> Subcapt Γ C (C.proj K) +| 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 end Capless diff --git a/Capless/Subcapturing/Basic.lean b/Capless/Subcapturing/Basic.lean index 0960cc00..d3114c48 100644 --- a/Capless/Subcapturing/Basic.lean +++ b/Capless/Subcapturing/Basic.lean @@ -1,4 +1,6 @@ import Capless.Subcapturing +import Capless.Subcapturing.CaptureKind +import Capless.Inversion.Context /-! # Basic Properties of Subcapturing @@ -8,10 +10,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,8 +21,141 @@ 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 } -end Capless +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 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) + 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 => + 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_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 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) + +-- 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 + +-- Connections between subkinding and subcapturing + +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 [-Kind.intersect, CaptureSet.proj_proj] + apply! var + case cinstl hb => + rw [CaptureSet.proj_proj, CaptureSet.proj] + apply! cinstl + case cinstr hb => + simp [-Kind.intersect, CaptureSet.proj_proj] + apply! cinstr + case cbound hb => + 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 reachsetl hr => + rw [CaptureSet.reach_proj] + apply reachsetl hr.apply_proj + case reachsetr hr => + rw [CaptureSet.reach_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)] + 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 new file mode 100644 index 00000000..1d195e2d --- /dev/null +++ b/Capless/Subcapturing/CaptureKind.lean @@ -0,0 +1,659 @@ +import Capless.Subcapturing +import Capless.Inversion.Context +import Capless.WellScoped.ReachSet + +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 <;> 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) + (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 [-Kind.intersect] + 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 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 + 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) + (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 ∨ L.IsEmpty := by + generalize h : {x=x|L} = D at hk + induction hk <;> try cases h + case var K hb2 hk ih => + cases Context.bound_injective hb hb2 + left; assumption + case label hb2 => cases Context.bound_lbound_absurd hb hb2 + case sub hs hk ih => + cases ih hb (.refl _) + case inl h => left; apply sub hs h + 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 <;> 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 + left; exact .rfl + case sub hs1 _ ih => + 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 + 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 <;> try cases h + case cvar hb2 => cases Context.cbound_injective hb hb2 + case cbound hb2 hk ih => + cases Context.cbound_injective hb hb2 + left; assumption + case cinstr hb2 hk ih => cases Context.cbound_injective hb hb2 + case sub hs hk ih => + cases ih hb (.refl _) + case inl h => left; apply sub hs h + 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 <;> try cases h + case cvar hb2 => + cases Context.cbound_injective hb hb2 + 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 => + 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 + 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 <;> 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 => + cases Context.cbound_injective hb hb2 + left; assumption + case sub hs hk ih => + cases ih hb (.refl _) + case inl h => left; apply sub hs h + 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) + (hk2 : CaptureKind Γ (.proj C K2) L2) + (hs1 : L1.Subkind L) + (hs2 : L2.Subkind L) + : 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 [-Kind.intersect] at h + 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 ++ 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 + 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 + 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 + 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 ++ 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 + 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 ++ 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 + exact .trans hs hs1 + rfl + case empty => + unfold CaptureSet.proj at h; split at h <;> simp at h + apply empty + 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 + 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) + (hs2 : CaptureKind Γ (.singleton s K2) K) + : 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 ++ 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 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 + +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.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 _) + 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 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) + : 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 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 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 + 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 + 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)] + rw [← CaptureSet.proj, Kind.intersect.top_l] + 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] + 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 _) + 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) + apply Kind.Intersect.subkind_symm diff --git a/Capless/Subcapturing/Reach.lean b/Capless/Subcapturing/Reach.lean new file mode 100644 index 00000000..e69de29b diff --git a/Capless/Subst/Basic.lean b/Capless/Subst/Basic.lean index b7edf098..80456337 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 @@ -69,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) @@ -81,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) @@ -89,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 Δ (.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 Δ) @@ -128,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 @@ -166,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 @@ -205,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 @@ -262,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 @@ -323,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 @@ -355,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' @@ -414,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 @@ -461,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 @@ -474,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 h.weaken def CVarSubst.text {Γ : Context n m k} (σ : CVarSubst Γ f Δ) : @@ -513,12 +513,12 @@ def CVarSubst.text {Γ : Context n m k} cases hb rename_i hb0 have h0 := σ.cmap_bound _ _ hb0 - apply Subbound.tweaken; easy + apply h0.tweaken 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 @@ -574,10 +574,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 @@ -592,12 +592,13 @@ def CVarSubst.cext {Γ : Context n m k} simp [FinFun.ext_zero] rename_i cb cases cb - case star => - simp [CBinding.crename, CBound.crename] - constructor + case kind k => + 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 @@ -644,7 +645,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] @@ -663,7 +664,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 => @@ -685,7 +686,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] @@ -720,26 +721,39 @@ 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 - constructor } - { apply Subbound.cweaken; easy } + cases hs + case set hs => + cases he2 + constructor + apply Subcapt.trans (.cbound_top .here) hs.cweaken + case kind hsk => + cases he2 + constructor + apply CaptureKind.sub hsk (.cvar_top .here) + case set_kind hk => + 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 - apply Subcapt.cbound - have hb1' := Context.CBound.there_cvar (b':=CBinding.bound B') hb1 - simp [CBinding.cweaken] at hb1' - exact hb1' + 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] + cases hb; constructor; easy def TVarSubst.narrow (hs : SSubtyp Γ S' S) : @@ -791,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 @@ -838,15 +852,15 @@ 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, FinFun.open] + simp [SType.tweaken, SType.trename_trename, FinFun.open_comp_weaken, SType.trename_id] assumption } def CVarSubst.open : CVarSubst - (Γ.cvar (CBinding.bound (CBound.upper {c=c}))) + (Γ.cvar (CBinding.bound (CBound.upper {c=c|.top}))) (FinFun.open c) Γ := by constructor @@ -879,9 +893,9 @@ 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 + constructor; apply Subcapt.rfl case inr h => have ⟨b1, c1, hb1, he1, he2⟩ := h cases b1 <;> cases he1 @@ -890,21 +904,24 @@ 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 => + constructor + apply! CaptureKind.cvar_top 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] 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 @@ -929,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 @@ -940,8 +957,16 @@ 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_top .here + simp [CaptureSet.crename_id] + exact hsub.cweaken (b:=CBinding.inst C) + constructor + rename_i hk + apply CaptureKind.cinstr_top .here hk.cweaken case inr h => have ⟨b1, c1, hb1, he1, he2⟩ := h cases he2 @@ -949,13 +974,14 @@ def CVarSubst.instantiate {Γ : Context n m k} : rename_i cb simp [FinFun.id, CBound.crename_id] cases cb - case star => constructor + case kind K1 => + constructor + apply CaptureKind.cvar_top hb1.there_cvar case upper D0 => constructor - apply Subcapt.cbound + apply Subcapt.cbound_top rw [<- CaptureSet.cweaken_def] 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..493da89f --- /dev/null +++ b/Capless/Subst/Capture/CaptureBound.lean @@ -0,0 +1,19 @@ +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 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/Subcapturing.lean b/Capless/Subst/Capture/Subcapturing.lean index a6d054be..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,35 +8,226 @@ 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 Δ) : + 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 + case set_kind hsk1 => + apply hsk1.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 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) (σ : CVarSubst Γ f Δ) : Subcapt Δ (C1.crename f) (C2.crename f) := by - induction h - case trans => apply trans <;> aesop - case subset hsub => - apply subset - apply (CaptureSet.crename_monotone hsub) - case union h1 h2 => - have ih1 := h1 σ - have ih2 := h2 σ - rw [CaptureSet.crename_union] - apply union <;> trivial - case var hb => - have ht := σ.map _ _ hb - simp [EType.crename, CType.crename] at ht - apply var <;> aesop - case cinstl hb => - have hb1 := σ.cmap _ _ hb - apply cinstl - trivial - case cinstr hb => - have hb1 := σ.cmap _ _ hb - apply cinstr - trivial + 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 => - have hb1 := σ.cmap_bound _ _ hb - cases hb1 - easy + 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/Subtyping.lean b/Capless/Subst/Capture/Subtyping.lean index 28bd5a4d..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 CBound.star)) 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..067e0151 100644 --- a/Capless/Subst/Capture/Typing.lean +++ b/Capless/Subst/Capture/Typing.lean @@ -1,6 +1,8 @@ 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. @@ -19,9 +21,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 @@ -55,7 +57,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] @@ -120,8 +122,8 @@ theorem Typed.csubst apply ih2; assumption case boundary ih => simp [Term.crename] - simp [EType.crename, CType.crename, SType.crename] - apply boundary + simp [EType.crename, CType.crename] + 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 @@ -130,16 +132,27 @@ theorem Typed.csubst , <- CaptureSet.weaken_crename , <- CaptureSet.cweaken_crename ] at ih aesop + case intercept hr hs ih ih2 => + simp [Term.crename] + 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 + apply ih + apply! ih2 + 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 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 +160,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 +170,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..724ac6bd --- /dev/null +++ b/Capless/Subst/Term/CaptureBound.lean @@ -0,0 +1,19 @@ +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 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/Subcapturing.lean b/Capless/Subst/Term/Subcapturing.lean index be51941e..811a26bc 100644 --- a/Capless/Subst/Term/Subcapturing.lean +++ b/Capless/Subst/Term/Subcapturing.lean @@ -9,40 +9,44 @@ Substitution theorems for term variable substitution in subcapturing 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 => + 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 singleton_absurd => apply! singleton_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) := 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 + 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 ht := σ.map _ _ hb - simp [EType.rename, 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 => - have hb1 := σ.cmap _ _ hb - simp [CaptureSet.rename_csingleton] - apply cinstr - simp [CBinding.rename] at hb1 - trivial - case cbound hb => - have hb1 := σ.cmap _ _ hb - simp [CaptureSet.rename_csingleton] - apply cbound - simp [CBinding.rename] at hb1 - easy + 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 proj_r hk => apply! proj_r (hk.subst _) end Capless diff --git a/Capless/Subst/Term/Subtyping.lean b/Capless/Subst/Term/Subtyping.lean index f07b4004..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 star => 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..7e0deaf4 100644 --- a/Capless/Subst/Term/Typing.lean +++ b/Capless/Subst/Term/Typing.lean @@ -2,6 +2,8 @@ import Capless.Typing 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. @@ -9,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) @@ -21,9 +78,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 @@ -58,7 +115,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] @@ -112,7 +169,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 @@ -124,12 +181,11 @@ theorem Typed.subst apply ih2; assumption case boundary ih => simp [Term.rename] - simp [EType.rename, CType.rename, SType.rename] at * - apply boundary + simp [EType.rename, CType.rename] at * + apply boundary; assumption have ih := ih (σ.cext.ext _) simp [ CBinding.rename - , EType.rename , CType.rename , SType.rename , <- SType.weaken_rename @@ -138,6 +194,15 @@ theorem Typed.subst , CaptureSet.cweaken_rename_comm , FinFun.ext ] at ih exact ih + case intercept hr hs ih ih2 => + simp [Term.rename] + 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 + apply ih + apply! ih2 theorem Typed.open (h : Typed (Γ,x: P) t E Ct) diff --git a/Capless/Subst/Type/CaptureBound.lean b/Capless/Subst/Type/CaptureBound.lean new file mode 100644 index 00000000..e68dca7c --- /dev/null +++ b/Capless/Subst/Type/CaptureBound.lean @@ -0,0 +1,19 @@ +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 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/Subcapturing.lean b/Capless/Subst/Type/Subcapturing.lean index 218c9dbe..5bd77177 100644 --- a/Capless/Subst/Type/Subcapturing.lean +++ b/Capless/Subst/Type/Subcapturing.lean @@ -7,28 +7,35 @@ Substitution theorems for type variable substitution in subcapturing judgments. namespace Capless + +theorem CaptureKind.tsubst + (h : CaptureKind Γ C K) + (σ : TVarSubst Γ f Δ) : + 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 singleton_absurd => apply! singleton_absurd + case union ha hb => apply! union (ha _) (hb _) + 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 => - have ht := σ.map _ _ hb - simp [EType.trename, CType.trename] at ht - apply var <;> aesop - case cinstl hb => - have hb1 := σ.cmap _ _ hb - apply cinstl; easy - case cinstr hb => - have hb1 := σ.cmap _ _ hb - apply cinstr; easy - case cbound hb => - have hb1 := σ.cmap _ _ hb - apply cbound; easy + 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 proj_r hk => apply! proj_r (hk.tsubst _) 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..820160da 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 /- @@ -8,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) @@ -19,9 +49,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 @@ -103,7 +133,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] @@ -114,13 +144,23 @@ 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 , <- SType.weaken_trename , <- SType.cweaken_trename ] at ih aesop + case intercept hr hs 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 + 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 f2b45a64..b7dc3e06 100644 --- a/Capless/Subtyping.lean +++ b/Capless/Subtyping.lean @@ -1,6 +1,8 @@ import Capless.Context import Capless.Subcapturing import Capless.Type +import Capless.Classifier +import Capless.CaptureBound /-! # Subtyping Rules of Capless @@ -14,15 +16,17 @@ 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) +| 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 | 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) diff --git a/Capless/Subtyping/Basic.lean b/Capless/Subtyping/Basic.lean index a18289ca..ecc30a46 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 @@ -14,7 +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.rfl theorem Subbound.trans (h1 : Subbound Γ B1 B2) @@ -22,6 +25,13 @@ theorem Subbound.trans Subbound Γ B1 B3 := by cases h1 <;> cases h2 <;> constructor apply Subcapt.trans <;> easy + rename_i hsub K hk + apply hk.subcapt hsub + 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)) @@ -42,8 +52,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 @@ -54,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/Term.lean b/Capless/Term.lean index 33bd8453..b79d8f4d 100644 --- a/Capless/Term.lean +++ b/Capless/Term.lean @@ -61,8 +61,10 @@ 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 in t`. -/ -| boundary : SType n m k -> Term (n+1) m (k+1) -> Term n m k +/-- Boundary form `boundary[c] as in t`. -/ +| boundary : Classifier -> SType n m k -> Term (n+1) m (k+1) -> 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 @@ -75,7 +77,8 @@ 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 +notation:40 "intercept[" K "]" " with " h " in " t => Term.intercept K h t /-- Whether this term is a value? -/ @[aesop safe constructors] @@ -105,7 +108,8 @@ 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) + | 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 @@ -122,7 +126,8 @@ 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) + | 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 @@ -139,7 +144,8 @@ 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) + | 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 @@ -248,6 +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 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 @@ -285,6 +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 ih2 => + simp [Term.trename, ih, ih2, FinFun.id_ext] theorem Term.crename_id {t : Term n m k} : t.crename FinFun.id = t := by @@ -322,6 +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 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 @@ -361,6 +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 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 @@ -400,6 +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 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 @@ -439,5 +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 ih2 => + simp [trename, ih, ih2, ← FinFun.ext_comp_ext] end Capless diff --git a/Capless/Type/Basic.lean b/Capless/Type/Basic.lean index aa96764d..8968485a 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] @@ -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 @@ -111,9 +114,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] @@ -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 @@ -169,7 +175,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 @@ -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 @@ -213,9 +222,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] @@ -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 @@ -257,7 +269,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 @@ -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 @@ -389,7 +404,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 @@ -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 @@ -492,14 +510,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 +525,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] @@ -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 @@ -552,7 +573,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 @@ -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 @@ -596,9 +620,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] @@ -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 fd908379..31fc1fa7 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. -/ @@ -39,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 @@ -51,7 +53,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..e850b75c 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 @@ -44,13 +47,14 @@ 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 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 @@ -64,13 +68,14 @@ 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 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' @@ -84,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 3378d1b7..afee4d67 100644 --- a/Capless/Typing.lean +++ b/Capless/Typing.lean @@ -2,6 +2,8 @@ import Capless.Context import Capless.Subtyping import Capless.Type import Capless.Term +import Capless.CaptureBound +import Capless.ReachSet /-! # Typing Rules of Capless @@ -16,20 +18,21 @@ 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 S -> - Typed Γ (Term.var x) (Label[S]^{x=x}) {x=x} + Context.LBound Γ x c S -> + Typed Γ (Term.var x) (Label[S]^{x=x|.top}) {x=x|.top} | pack : - Typed (Γ.cvar (CBinding.inst C)) (Term.var x) (EType.type T) {x=x} -> - Typed Γ (Term.pack C x) (∃c.T) {} + CaptureBound Γ C B -> + 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 -> (Γ ⊢ C1 <:c C2) -> (Γ ⊢ 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 -> @@ -38,26 +41,26 @@ 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) 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 -> @@ -66,11 +69,28 @@ 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.star),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}) -> - Typed Γ (boundary: S in t) (S^CaptureSet.empty) C + (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}: + Typed + (((Γ,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 -> + 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 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/Typing/Boundary.lean b/Capless/Typing/Boundary.lean index b1e58900..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<:*),x:(Label[S.cweaken])^{c=0}) + ((Γ,c<:CBound.kind (.classifier c)),x:(Label[S.cweaken])^{c=0|.top}) FinFun.weaken.ext - (((Γ.label S),c<:*),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<:*),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<:*),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<:*),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 @@ -193,8 +196,14 @@ 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.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 @@ -202,18 +211,22 @@ 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_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 @@ -228,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 @@ -244,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] @@ -267,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] @@ -310,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<:*),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/Basic.lean b/Capless/Weakening/Basic.lean index 9e2a7124..27c853bb 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 @@ -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/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 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/TypedCont/Capture.lean b/Capless/Weakening/TypedCont/Capture.lean index 545e8a31..da835021 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 @@ -68,41 +68,48 @@ 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 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 } - { 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 } - 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 } - 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 Γ 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] @@ -137,5 +144,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 498b77ed..064a0af2 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 @@ -70,41 +70,84 @@ 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) : +-- 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 } - { exact ih } - case csingleton hb _ ih => - apply csingleton - { have hb1 := Context.CBound.there_var (E:=T) hb - exact hb1 } - { exact ih } - case cbound hb _ ih => - apply cbound - { have hb1 := Context.CBound.there_var (E:=T) hb - exact hb1 } - { exact ih } - case label hb hs => - apply label - { have hb1 := Context.LBound.there_var (E:=T) hb - exact hb1 } - { apply hs.weaken } + 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 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] @@ -143,6 +186,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) : @@ -163,41 +222,48 @@ theorem Cont.HasLabel.lweaken case there_label ih => simp [Cont.weaken] 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 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 => - simp [CaptureSet.weaken] at * - apply union <;> aesop - case singleton hb _ ih => - apply singleton - { simp [FinFun.weaken] - have hb1 := Context.Bound.there_label (S:=S) hb - simp [CaptureSet.weaken, CaptureSet.rename] at hb1 - exact hb1 } - { exact ih } - case csingleton hb _ ih => - apply csingleton - { have hb1 := Context.CBound.there_label (S:=S) hb - exact hb1 } - { exact ih } - case cbound hb _ ih => - apply cbound - { have hb1 := Context.CBound.there_label (S:=S) hb - exact hb1 } - { exact ih } - case label hb hs => - apply label - { have hb1 := Context.LBound.there_label (S':=S) hb - exact hb1 } - { apply hs.lweaken } + case empty => apply! empty + case union ha hb => apply! union + case ckind hb => apply! ckind hb.there_label + 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 Γ E cont E' Ct) : - TypedCont (Γ.label 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] @@ -211,7 +277,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 +287,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 +300,23 @@ theorem TypedCont.lweaken apply scope { constructor; aesop } { aesop } - { have h1 := hs.lweaken (S:=S) + { 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 23682dd9..ae3258a8 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) : @@ -54,41 +54,48 @@ 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 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 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 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] @@ -122,5 +129,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 4700943b..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 @@ -38,7 +39,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 +52,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,10 +64,34 @@ 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 +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 diff --git a/Capless/WellScoped/Basic.lean b/Capless/WellScoped/Basic.lean index 0e991b16..1826dd77 100644 --- a/Capless/WellScoped/Basic.lean +++ b/Capless/WellScoped/Basic.lean @@ -1,6 +1,8 @@ import Capless.Store import Capless.Subcapturing +import Capless.Subcapturing.Basic import Capless.Inversion.Context +import Capless.WellScoped.ReachSet /-! # Basic Properties of Well-Scopedness @@ -10,107 +12,386 @@ 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 +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) + : 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 + 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 + 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 + 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 + apply! label + case label_disj hb hd => + unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h + 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 + 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 + apply empty + 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 ckind hb => + 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 + apply! label + case label_disj hb hd => + unfold CaptureSet.proj at h; split at h <;> simp [-Kind.intersect] at h + 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 => + 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 + 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 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 => easy - case union_l => apply WellScoped.union <;> aesop - case union_rl => + 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 - aesop - case union_rr => + apply! iha + case singleton_subkind => apply! singleton_subkind + case singleton_absurd => apply! absurd + case proj_merge => cases hsc - aesop + 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) : WellScoped Γ (Cont.cons u cont) C := by induction hsc case empty => apply empty - case union ih1 ih2 => apply union <;> aesop - case singleton ih => apply singleton <;> aesop - case csingleton ih => apply csingleton <;> aesop - case cbound ih => apply cbound <;> aesop - case label => - apply label - easy - constructor; easy + 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 + 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 ih1 ih2 => apply union <;> aesop - case singleton ih => apply singleton <;> aesop - case csingleton ih => apply csingleton <;> aesop - case cbound ih => apply cbound <;> aesop - case label => - apply label - easy - constructor; easy + 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 + 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 ih1 ih2 => apply union <;> aesop - case singleton ih => apply singleton <;> aesop - case csingleton ih => apply csingleton <;> aesop - case cbound ih => apply cbound <;> aesop - case label => - apply label - easy - constructor; easy - -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 => + case ckind ih => apply ckind <;> aesop + case creach ih => apply creach <;> 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 => + cases Context.lbound_inj hb hbx; subst_vars 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 - -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 + 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..ec09f406 --- /dev/null +++ b/Capless/WellScoped/ReachSet.lean @@ -0,0 +1,518 @@ +import Capless.Store +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 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 + 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 + 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 + 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 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} + (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 + 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 + 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 + (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] + 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 .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 + apply Kind.Intersect.union_r_subkind + . apply! ckind + case absurd he => + rename_i p + 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 + 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 + 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) + (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 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) + +end Capless 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` 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: +* layout: +* 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 + +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 00000000..42ad7633 Binary files /dev/null and b/docs/classifiers.pdf differ 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} diff --git a/lake-manifest.json b/lake-manifest.json index 1dcc6aaa..26313734 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": "77b45269e0888a839059d6678a32631c8066da21", "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": "658f43ce96423382c226ad17db8041f7e99ddf31", "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..82412506 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -6,18 +6,19 @@ 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 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