├── .gitignore ├── LICENSE ├── Label.agda ├── NOTICE ├── README.md ├── Subtyping.agda └── subtyping.agda-lib /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | -------------------------------------------------------------------------------- /Label.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Label where 3 | 4 | open import Cubical.Core.Everything 5 | open import Cubical.Foundations.Prelude using (isProp; transport) 6 | 7 | open import Cubical.Data.Nat using (ℕ; zero; suc; isSetℕ) 8 | open import Cubical.Data.Nat.Order using (_<_; _≤_; ≤-refl; <-weaken; ≤<-trans; m≤n-isProp; <-asym) 9 | open import Cubical.Data.Maybe using (Maybe; nothing; just) 10 | open import Cubical.Data.Empty using () renaming (rec to ⊥-elim) 11 | 12 | Label : Set 13 | Label = ℕ 14 | 15 | data Record (A : Set) : Label -> Set where 16 | nil : forall {l} -> Record A l 17 | cons : forall {l} -> Record A l -> (l' : Label) -> A -> .(l < l') -> Record A l' 18 | 19 | data _∈_ {A : Set} (l₁ : Label) {l : Label} : Record A l -> Set where 20 | here : forall {l'} {r : Record A l'} {x lt} -> l₁ ≡ l -> l₁ ∈ cons r l x lt 21 | there : forall {l'} {r : Record A l'} {x lt} -> l₁ ∈ r -> l₁ ∈ cons r l x lt 22 | 23 | find : forall {A} {l} -> (l₁ : Label) -> (r : Record A l) -> l₁ ∈ r -> A 24 | find l₁ (cons _ _ x _) (here e) = x 25 | find l₁ (cons r _ _ _) (there l₁∈r) = find l₁ r l₁∈r 26 | 27 | ∈-implies-≤ : forall {A} {l l'} {r : Record A l'} -> l ∈ r -> l ≤ l' 28 | ∈-implies-≤ {l = l} (here e) = transport (λ i -> l ≤ e i) ≤-refl 29 | ∈-implies-≤ (there {lt = lt} l∈r) = <-weaken (≤<-trans (∈-implies-≤ l∈r) lt) 30 | 31 | l∈r-isProp : forall {A} l {l'} (r : Record A l') -> isProp (l ∈ r) 32 | l∈r-isProp l {l'} (cons _ _ _ _) (here {lt = a} e1) (here {lt = b} e2) = λ i -> here {lt = m≤n-isProp a b i} (isSetℕ l l' e1 e2 i) 33 | l∈r-isProp l (cons {l = l₁} r _ _ _) (here {lt = k} e) (there y) = ⊥-elim (<-asym k (transport (λ i -> e i ≤ l₁) (∈-implies-≤ y))) 34 | l∈r-isProp l (cons {l = l₁} r _ _ _) (there {lt = k} x) (here e) = ⊥-elim (<-asym k (transport (λ i -> e i ≤ l₁) (∈-implies-≤ x))) 35 | l∈r-isProp l (cons r _ _ _) (there {lt = k1} x) (there {lt = k2} y) = let a = l∈r-isProp l r x y in λ i → there {lt = m≤n-isProp k1 k2 i} (a i) 36 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2022 El Pin Al 2 | 3 | Licensed under the Apache License, Version 2.0. 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # subtyping-agda 2 | 3 | This project provides a soundness proof for a lambda calculus with an extrinsic concept, subtyping. 4 | The calculus is equipped with call-by-name structural operational semantics. 5 | The proof is formalized in Cubical Agda. 6 | 7 | Features: 8 | 9 | - The `Top` type 10 | - Record types 11 | -------------------------------------------------------------------------------- /Subtyping.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Subtyping where 3 | 4 | open import Cubical.Core.Everything hiding (Type) 5 | open import Cubical.Foundations.Prelude using (refl; sym; symP; cong; _∙_; transport; subst; transportRefl; transport-filler; toPathP; fromPathP; congP) 6 | open import Cubical.Foundations.Transport using (transport⁻Transport) 7 | 8 | open import Cubical.Data.Nat using (ℕ; zero; suc; _+_; +-comm; snotz; znots; +-suc; +-zero; injSuc; isSetℕ) 9 | open import Cubical.Data.Nat.Order using (_≟_; lt; eq; gt; ≤-k+; ≤-+k; ≤-trans; pred-≤-pred; _≤_; _<_; ¬m+n Term n 20 | abs : Term (suc n) -> Term n 21 | _·_ : Term n -> Term n -> Term n 22 | rec : forall {l} -> Record (Term n) l -> Term n 23 | _#_ : Term n -> Label -> Term n 24 | 25 | shift : forall {m : ℕ} (n : ℕ) (i : Fin (suc m)) (e : Term m) -> Term (m + n) 26 | shiftRecord : forall {m : ℕ} (n : ℕ) (i : Fin (suc m)) {l : Label} (r : Record (Term m) l) -> Record (Term (m + n)) l 27 | 28 | shift {m} n i (var j) 29 | with toℕ i ≟ toℕ j 30 | ... | lt _ = var (toℕ j + n , ≤-+k (snd j)) 31 | ... | eq _ = var (toℕ j + n , ≤-+k (snd j)) 32 | ... | gt _ = var (toℕ j , ≤-trans (snd j) (n , +-comm n m)) 33 | shift n i (abs e) = abs (shift n (fsuc i) e) 34 | shift n i (e · e₁) = shift n i e · shift n i e₁ 35 | shift n i (rec r) = rec (shiftRecord n i r) 36 | shift n i (e # l) = shift n i e # l 37 | 38 | shiftRecord n i nil = nil 39 | shiftRecord n i (cons r l' x x₁) = cons (shiftRecord n i r) l' (shift n i x) x₁ 40 | 41 | subst′ : forall {m n : ℕ} 42 | -> (e' : Term m) 43 | -> (i : Fin (suc n)) 44 | -> (e1 : Term (suc (n + m))) 45 | -> Term (n + m) 46 | substRecord : forall {m n : ℕ} 47 | -> (e' : Term m) 48 | -> (i : Fin (suc n)) 49 | -> forall {l : Label} 50 | -> (r1 : Record (Term (suc (n + m))) l) 51 | -> Record (Term (n + m)) l 52 | 53 | subst′ {m} {n} e' i (var j) with toℕ j ≟ toℕ i 54 | ... | lt j Term n -> Set where 70 | beta/=> : forall {e1 : Term (suc n)} {e2 : Term n} -> abs e1 · e2 ▷ subst′ e2 fzero e1 71 | cong/app : forall {e1 e1' e2 : Term n} -> e1 ▷ e1' -> e1 · e2 ▷ e1' · e2 72 | 73 | beta/rec : forall {l'} {r : Record (Term n) l'} {l} {l∈r : l ∈ r} -> rec r # l ▷ find l r l∈r 74 | cong/# : forall {e e' : Term n} {l} -> e ▷ e' -> e # l ▷ e' # l 75 | 76 | data Base : Set where 77 | Unit : Base 78 | Int : Base 79 | 80 | infixr 8 _=>_ 81 | 82 | data Type : Set where 83 | base : Base -> Type 84 | Top : Type 85 | _=>_ : Type -> Type -> Type 86 | rec : forall {l} -> Record Type l -> Type 87 | 88 | data Context : ℕ -> Set where 89 | [] : Context 0 90 | _∷_ : forall {n} -> Type -> Context n -> Context (suc n) 91 | 92 | data _[_]=_ : forall {n} -> Context n -> Fin n -> Type -> Set where 93 | here : forall {n} A (G : Context n) -> (A ∷ G) [ 0 , suc-≤-suc zero-≤ ]= A 94 | there : forall {n} {A} B {G : Context n} {i} -> G [ i ]= A -> (B ∷ G) [ fsuc i ]= A 95 | 96 | lookup : forall {n} -> Context n -> Fin n -> Type 97 | lookup [] (fst₁ , snd₁) = Empty.rec (¬-<-zero snd₁) 98 | lookup (A ∷ G) (zero , snd₁) = A 99 | lookup (A ∷ G) (suc fst₁ , snd₁) = lookup G (fst₁ , pred-≤-pred snd₁) 100 | 101 | lookup-[]= : forall {n} (G : Context n) i -> G [ i ]= lookup G i 102 | lookup-[]= [] (fst₁ , snd₁) = Empty.rec (¬-<-zero snd₁) 103 | lookup-[]= (A ∷ G) (zero , snd₁) = subst (λ f -> (A ∷ G) [ f ]= A) (Fin-fst-≡ refl) (here A G) 104 | lookup-[]= (A ∷ G) (suc fst₁ , snd₁) = subst (λ f -> (A ∷ G) [ f ]= lookup G (fst₁ , pred-≤-pred snd₁)) (Fin-fst-≡ refl) (there A (lookup-[]= G (fst₁ , pred-≤-pred snd₁))) 105 | 106 | _++_ : forall {m n} -> Context m -> Context n -> Context (m + n) 107 | [] ++ G2 = G2 108 | (A ∷ G1) ++ G2 = A ∷ (G1 ++ G2) 109 | 110 | ++-[]= : forall {m n} {G : Context m} (G' : Context n) {j : Fin m} {A} 111 | -> G [ j ]= A 112 | -> (G' ++ G) [ n + toℕ j , <-k+ (snd j) ]= A 113 | ++-[]= [] l = subst (λ f → _ [ f ]= _) (Fin-fst-≡ refl) l 114 | ++-[]= {G = G} (C ∷ G') {A = A} l = subst (λ f → ((C ∷ G') ++ G) [ f ]= A) (Fin-fst-≡ refl) (there C (++-[]= G' l)) 115 | 116 | inserts : forall {m n} -> Fin (suc m) -> Context n -> Context m -> Context (m + n) 117 | inserts {m} {n} (zero , snd₁) G' G = subst Context (+-comm n m) (G' ++ G) 118 | inserts (suc fst₁ , snd₁) G' [] = Empty.rec (¬-<-zero (pred-≤-pred snd₁)) 119 | inserts (suc fst₁ , snd₁) G' (A ∷ G) = A ∷ inserts (fst₁ , pred-≤-pred snd₁) G' G 120 | 121 | inserts-[]=-unaffected : forall {m n} (G : Context m) (G' : Context n) {j : Fin m} (i : Fin (suc m)) {A} 122 | -> toℕ j < toℕ i 123 | -> G [ j ]= A 124 | -> inserts i G' G [ toℕ j , ≤-trans (snd j) (n , +-comm n m) ]= A 125 | inserts-[]=-unaffected (A ∷ G) G' (zero , snd₁) j PathP (λ i -> Fin (+-comm n m i)) (n + toℕ j , <-k+ (snd j)) (toℕ j + n , ≤-+k (snd j)) 131 | helper1 m n j = ΣPathP (+-comm n (toℕ j) , toPathP (m≤n-isProp _ _)) 132 | 133 | helper2 : forall m n (G : Context m) (G' : Context n) -> PathP (λ i → Context (+-comm n m i)) (G' ++ G) (subst Context (+-comm n m) (G' ++ G)) 134 | helper2 m n G G' = toPathP refl 135 | 136 | inserts-[]=-shifted : forall {m n} (G : Context m) (G' : Context n) {j : Fin m} (i : Fin (suc m)) {A} 137 | -> toℕ i ≤ toℕ j 138 | -> G [ j ]= A 139 | -> inserts i G' G [ toℕ j + n , ≤-+k (snd j) ]= A 140 | inserts-[]=-shifted {m} {n} G G' {j} (zero , snd₁) {A} i≤j l = transport (λ i -> helper2 m n G G' i [ helper1 m n j i ]= A) (++-[]= G' l) 141 | inserts-[]=-shifted (B ∷ G) G' (suc fst₁ , snd₁) i≤j (here .B .G) = Empty.rec (¬-<-zero i≤j) 142 | inserts-[]=-shifted (B ∷ G) G' {j = suc fst₂ , snd₂} (suc fst₁ , snd₁) {A = A} i≤j (there .B l) = 143 | subst (λ f → inserts (suc fst₁ , snd₁) G' (B ∷ G) [ f ]= A) (Fin-fst-≡ refl) (there B (inserts-[]=-shifted G G' (fst₁ , pred-≤-pred snd₁) (pred-≤-pred i≤j) l)) 144 | 145 | _+++_+++_ : forall {m n} -> Context m -> Type -> Context n -> Context (suc (m + n)) 146 | [] +++ A +++ G2 = A ∷ G2 147 | (B ∷ G1) +++ A +++ G2 = B ∷ (G1 +++ A +++ G2) 148 | 149 | ++++++-[]=-unaffected : forall {m n} (G1 : Context m) (G2 : Context n) {A B} {j : Fin (suc (n + m))} 150 | -> (j (G2 +++ A +++ G1) [ j ]= B 152 | -> (G2 ++ G1) [ toℕ j , <≤-trans j (C ∷ (G2 ++ G1)) [ f ]= C) (Fin-fst-≡ refl) (here C (G2 ++ G1)) 155 | ++++++-[]=-unaffected G1 (C ∷ G2) {B = B} j (C ∷ (G2 ++ G1)) [ f ]= B) (Fin-fst-≡ refl) (there C a) 159 | 160 | -- Note that `j` stands for `suc fst₁`. 161 | ++++++-[]=-shifted : forall {m n} (G1 : Context m) (G2 : Context n) {A B} {fst₁ : ℕ} {snd₁ : suc (fst₁) < suc (n + m)} 162 | -> (n (G2 +++ A +++ G1) [ suc fst₁ , snd₁ ]= B 164 | -> (G2 ++ G1) [ fst₁ , pred-≤-pred snd₁ ]= B 165 | ++++++-[]=-shifted G1 [] n toℕ j ≡ n 174 | -> (G2 +++ A +++ G1) [ j ]= B 175 | -> A ≡ B 176 | ++++++-[]=-hit G1 [] j≡n (here _ .G1) = refl 177 | ++++++-[]=-hit G1 [] j≡n (there _ l) = Empty.rec (snotz j≡n) 178 | ++++++-[]=-hit G1 (C ∷ G2) j≡n (here .C .(G2 +++ _ +++ G1)) = Empty.rec (znots j≡n) 179 | ++++++-[]=-hit G1 (C ∷ G2) j≡n (there .C l) = ++++++-[]=-hit G1 G2 (injSuc j≡n) l 180 | 181 | infix 2 _<:_ 182 | infix 2 _<::_ 183 | 184 | data _<:_ : Type -> Type -> Set 185 | data _<::_ {l1 l2 : Label} : Record Type l1 -> Record Type l2 -> Set 186 | 187 | data _<:_ where 188 | S-Refl : forall {A} -> A <: A 189 | S-Arr : forall {A1 B1 A2 B2} -> A2 <: A1 -> B1 <: B2 -> A1 => B1 <: A2 => B2 190 | S-Top : forall {A} -> A <: Top 191 | S-Record : forall {l1 l2} {r1 : Record Type l1} {r2 : Record Type l2} -> r1 <:: r2 -> rec r1 <: rec r2 192 | 193 | data _<::_ {l1} {l2} where 194 | S-nil : l2 ≤ l1 -> nil <:: nil 195 | 196 | S-cons1 : forall {l1'} {r1 : Record Type l1'} {r2 : Record Type l2} {A} {l1' r1 <:: r2 198 | -> cons r1 l1 A l1' r1 <:: r2 202 | -> A <: B 203 | -> l1 ≡ l2 204 | -> cons r1 l1 A l1' r1 <:: r2 -> l2 ≤ l1 207 | <::-implies-≥ (S-nil x) = x 208 | <::-implies-≥ (S-cons1 {l1' r1 <:: r2 213 | -> forall {l} 214 | -> l ∈ r2 215 | -> l ∈ r1 216 | helper/<::-∈ (S-cons1 {l1' (l1≡l2 ∙ sym e) i ∈ cons r1 _ A l1' Type -> Set 224 | data _⊢_:::_ {n : ℕ} (G : Context n) {l} : Record (Term n) l -> Record Type l -> Set 225 | 226 | data _⊢_::_ {n} G where 227 | axiom : forall {i : Fin n} {A} 228 | -> G [ i ]= A 229 | -> G ⊢ var i :: A 230 | 231 | =>I : forall {A B : Type} {e : Term (suc n)} 232 | -> A ∷ G ⊢ e :: B 233 | -> G ⊢ abs e :: A => B 234 | 235 | =>E : forall {A B : Type} {e1 e2 : Term n} 236 | -> G ⊢ e1 :: A => B 237 | -> G ⊢ e2 :: A 238 | -> G ⊢ e1 · e2 :: B 239 | 240 | recI : forall {l} {r : Record (Term n) l} {rt : Record Type l} 241 | -> G ⊢ r ::: rt 242 | -> G ⊢ rec r :: rec rt 243 | 244 | recE : forall {l'} {r : Record Type l'} {e : Term n} {l : Label} 245 | -> G ⊢ e :: rec r 246 | -> (l∈r : l ∈ r) 247 | -> G ⊢ e # l :: find l r l∈r 248 | 249 | sub : forall {A B : Type} {e} 250 | -> G ⊢ e :: A 251 | -> A <: B 252 | -> G ⊢ e :: B 253 | 254 | data _⊢_:::_ {n} G {l} where 255 | rec/nil : G ⊢ nil ::: nil 256 | 257 | rec/cons : forall {l'} {r : Record (Term n) l'} {rt : Record Type l'} {e A} .{l' G ⊢ r ::: rt 259 | -> G ⊢ e :: A 260 | -> G ⊢ cons r l e l' G ⊢ r ::: rt 264 | -> forall {l₁} 265 | -> l₁ ∈ r 266 | -> l₁ ∈ rt 267 | helper/∈ (rec/cons D x) (_∈_.here {lt = y} e) = _∈_.here {lt = y} e 268 | helper/∈ (rec/cons D x) (_∈_.there {lt = y} l₁∈r) = _∈_.there {lt = y} (helper/∈ D l₁∈r) 269 | 270 | helper/∈′ : forall {n} {G : Context n} {l} {r : Record (Term n) l} {rt : Record Type l} 271 | -> G ⊢ r ::: rt 272 | -> forall {l₁} 273 | -> l₁ ∈ rt 274 | -> l₁ ∈ r 275 | helper/∈′ (rec/cons D x) (_∈_.here {lt = y} e) = _∈_.here {lt = y} e 276 | helper/∈′ (rec/cons D x) (_∈_.there {lt = y} l₁∈r) = _∈_.there {lt = y} (helper/∈′ D l₁∈r) 277 | 278 | weakening : forall {m n} (i : Fin (suc m)) {G : Context m} (G' : Context n) {e : Term m} {A} 279 | -> G ⊢ e :: A 280 | -> inserts i G' G ⊢ shift n i e :: A 281 | weakeningRecord : forall {m n} (i : Fin (suc m)) {G : Context m} (G' : Context n) {l} {r : Record (Term m) l} {rt} 282 | -> G ⊢ r ::: rt 283 | -> inserts i G' G ⊢ shiftRecord n i r ::: rt 284 | 285 | weakening {m = m} {n = n} i {G = G} G' {e = var j} (axiom l) 286 | with toℕ i ≟ toℕ j 287 | ... | lt i B} (=>I D) = 291 | =>I (subst (λ f -> (A ∷ inserts f G' G) ⊢ shift n (fsuc i) e :: B) (Fin-fst-≡ {j = i} refl) (weakening (fsuc i) G' D)) 292 | weakening i G' (=>E D D₁) = =>E (weakening i G' D) (weakening i G' D₁) 293 | weakening i G' (sub D s) = sub (weakening i G' D) s 294 | weakening i G' (recI D) = recI (weakeningRecord i G' D) 295 | weakening i G' (recE D l∈r) = recE (weakening i G' D) l∈r 296 | 297 | weakeningRecord i G' rec/nil = rec/nil 298 | weakeningRecord i G' (rec/cons x x₁) = rec/cons (weakeningRecord i G' x) (weakening i G' x₁) 299 | 300 | helper3 : forall {n} -> (suc n , ≤-refl) ≡ (suc n , suc-≤-suc ≤-refl) 301 | helper3 = Fin-fst-≡ refl 302 | 303 | helper4 : forall m n (j : Fin (suc (n + m))) j (toℕ j , <≤-trans j PathP (λ i -> Context (+-comm n m (~ i))) (subst Context (+-comm n m) (G2 ++ G1)) (G2 ++ G1) 309 | helper5 m n G1 G2 = symP {A = λ i -> Context (+-comm n m i)} (toPathP refl) 310 | 311 | helper6 : forall m n (e : Term (m + n)) 312 | -> PathP (λ i -> Term (+-comm m n i)) e (transport (λ i -> Term (+-comm m n i)) e) 313 | helper6 m n e = toPathP refl 314 | 315 | helper' : forall m n -> +-comm m n ≡ sym (+-comm n m) 316 | helper' m n = isSetℕ (m + n) (n + m) (+-comm m n) (sym (+-comm n m)) 317 | 318 | helper7 : forall m n (e : Term (m + n)) 319 | -> PathP (λ i -> Term (+-comm n m (~ i))) e (transport (λ i -> Term (+-comm m n i)) e) 320 | helper7 m n e = subst (λ m+n≡n+m → PathP (λ i → Term (m+n≡n+m i)) e (transport (λ i -> Term (+-comm m n i)) e)) (helper' m n) (helper6 m n e) 321 | 322 | substitution : forall {m n} (G1 : Context m) (G2 : Context n) (e1 : Term (suc (n + m))) {e2 : Term m} {A B} 323 | -> G1 ⊢ e2 :: A 324 | -> G2 +++ A +++ G1 ⊢ e1 :: B 325 | -> G2 ++ G1 ⊢ subst′ e2 (n , ≤-refl) e1 :: B 326 | substitutionRecord : forall {m n} (G1 : Context m) (G2 : Context n) {l} (r : Record (Term (suc (n + m))) l) {e2 : Term m} {A} {rt} 327 | -> G1 ⊢ e2 :: A 328 | -> G2 +++ A +++ G1 ⊢ r ::: rt 329 | -> G2 ++ G1 ⊢ substRecord e2 (n , ≤-refl) r ::: rt 330 | 331 | substitution G1 G2 e1 D' (sub D s) = sub (substitution G1 G2 e1 D' D) s 332 | substitution {m} {n} G1 G2 (var j) {e2 = e2} {B = B} D' (axiom l) with toℕ j ≟ toℕ (n , ≤-refl) 333 | ... | lt j (G2 ++ G1) [ helper4 m n j jI {A} {B} D) = =>I (transport (λ i → (A ∷ (G2 ++ G1)) ⊢ subst′ e2 (helper3 i) e1 :: B) (substitution G1 (A ∷ G2) e1 D' D)) 339 | substitution G1 G2 (e · e') D' (=>E D D₁) = =>E (substitution G1 G2 e D' D) (substitution G1 G2 e' D' D₁) 340 | substitution G1 G2 (rec r) D' (recI D) = recI (substitutionRecord G1 G2 r D' D) 341 | substitution G1 G2 (e # l) D' (recE D l∈r) = recE (substitution G1 G2 e D' D) l∈r 342 | 343 | substitutionRecord G1 G2 nil D' rec/nil = rec/nil 344 | substitutionRecord G1 G2 (cons r l e _) D' (rec/cons D x) = rec/cons (substitutionRecord G1 G2 r D' D) (substitution G1 G2 e D' x) 345 | 346 | S-Trans : forall {A B C} 347 | -> A <: B 348 | -> B <: C 349 | -> A <: C 350 | S-TransRecord : forall {l1 l2 l3} {r1 : Record Type l1} {r2 : Record Type l2} {r3 : Record Type l3} 351 | -> r1 <:: r2 352 | -> r2 <:: r3 353 | -> r1 <:: r3 354 | 355 | S-Trans S-Refl s2 = s2 356 | S-Trans (S-Arr s1 s3) S-Refl = S-Arr s1 s3 357 | S-Trans (S-Arr s1 s3) (S-Arr s2 s4) = S-Arr (S-Trans s2 s1) (S-Trans s3 s4) 358 | S-Trans (S-Arr s1 s3) S-Top = S-Top 359 | S-Trans S-Top S-Refl = S-Top 360 | S-Trans S-Top S-Top = S-Top 361 | S-Trans (S-Record s1) S-Refl = S-Record s1 362 | S-Trans (S-Record s1) S-Top = S-Top 363 | S-Trans (S-Record s1) (S-Record s2) = S-Record (S-TransRecord s1 s2) 364 | 365 | S-TransRecord (S-nil x) (S-nil y) = S-nil (≤-trans y x) 366 | S-TransRecord (S-cons1 {l1' A1 => B1 <: A2 => B2 372 | -> (A2 <: A1) × (B1 <: B2) 373 | inversion/S-Arr S-Refl = S-Refl , S-Refl 374 | inversion/S-Arr (S-Arr s s₁) = s , s₁ 375 | 376 | helper/inversion/S-Record : forall {l1 l2} {r1 : Record Type l1} {r2 : Record Type l2} 377 | -> (s : r1 <:: r2) 378 | -> forall {l} 379 | -> (l∈r2 : l ∈ r2) 380 | -> find l r1 (helper/<::-∈ s l∈r2) <: find l r2 l∈r2 381 | helper/inversion/S-Record (S-cons1 s) l∈r2 = helper/inversion/S-Record s l∈r2 382 | helper/inversion/S-Record {l1} {r1 = cons r1 l1 A k} (S-cons2 {B = B} {l1' find l (cons r1 l1 A k) z <: B) (l∈r-isProp l (cons r1 l1 A k) (_∈_.here {lt = l1' rec r1 <: rec r2 388 | -> forall {l} (l∈r2 : l ∈ r2) -> Σ[ l∈r1 ∈ (l ∈ r1) ] (find l r1 l∈r1 <: find l r2 l∈r2) 389 | inversion/S-Record S-Refl l∈r2 = l∈r2 , S-Refl 390 | inversion/S-Record (S-Record s) l∈r2 = helper/<::-∈ s l∈r2 , helper/inversion/S-Record s l∈r2 391 | 392 | inversion/=>I : forall {n} {G : Context n} {e : Term (suc n)} {A} 393 | -> G ⊢ abs e :: A 394 | -> Σ[ B ∈ Type ] Σ[ C ∈ Type ] ((B ∷ G ⊢ e :: C) × (B => C <: A)) 395 | inversion/=>I (=>I D) = _ , _ , D , S-Refl 396 | inversion/=>I (sub D s) 397 | with inversion/=>I D 398 | ... | B , C , D' , s' = B , C , D' , S-Trans s' s 399 | 400 | helper/inversion/recI : forall {n} {G : Context n} {l} {r : Record (Term n) l} {rt : Record Type l} 401 | -> (D : G ⊢ r ::: rt) 402 | -> forall {l₁} 403 | -> (l₁∈r : l₁ ∈ r) 404 | -> G ⊢ find l₁ r l₁∈r :: find l₁ rt (helper/∈ D l₁∈r) 405 | helper/inversion/recI (rec/cons D x) (_∈_.here e) = x 406 | helper/inversion/recI (rec/cons D x) (_∈_.there l₁∈r) = helper/inversion/recI D l₁∈r 407 | 408 | inversion/recI : forall {n} {G : Context n} {l} {r : Record (Term n) l} {A} 409 | -> G ⊢ rec r :: A 410 | -> Σ[ rt ∈ Record Type l ] Σ[ f ∈ (forall {l₁} -> l₁ ∈ r -> l₁ ∈ rt) ] Σ[ g ∈ (forall {l₁} -> l₁ ∈ rt -> l₁ ∈ r) ] ((forall {l₁} (l₁∈r : l₁ ∈ r) -> (G ⊢ find l₁ r l₁∈r :: find l₁ rt (f l₁∈r))) × (rec rt <: A)) 411 | inversion/recI (recI D) = _ , helper/∈ D , helper/∈′ D , (helper/inversion/recI D) , S-Refl 412 | inversion/recI (sub D s) 413 | with inversion/recI D 414 | ... | rt , f , g , x , s' = rt , f , g , x , S-Trans s' s 415 | 416 | preservation : forall {n} {G : Context n} (e : Term n) {e' : Term n} {A} 417 | -> G ⊢ e :: A 418 | -> e ▷ e' 419 | -> G ⊢ e' :: A 420 | preservation e (sub D s) st = sub (preservation e D st) s 421 | preservation (_ · _) (=>E D D₁) (cong/app s) = =>E (preservation _ D s) D₁ 422 | preservation {G = G} (abs e1 · e2) (=>E D D₁) beta/=> 423 | with inversion/=>I D 424 | ... | _ , _ , D , s with inversion/S-Arr s 425 | ... | sdom , scod = substitution G [] e1 (sub D₁ sdom) (sub D scod) 426 | preservation (e # l) (recE D l∈r) (cong/# s) = recE (preservation e D s) l∈r 427 | preservation {G = G} (rec r # l) (recE D l∈r) (beta/rec {l∈r = l∈r′}) 428 | with inversion/recI D 429 | ... | rt , f , _ , x , s with inversion/S-Record s 430 | ... | sr = let a = x l∈r′ in let l∈rt , b = sr l∈r in sub (subst (λ z -> G ⊢ find l r l∈r′ :: find l rt z) (l∈r-isProp l rt (f l∈r′) (l∈rt)) a) b 431 | 432 | -- Path. 433 | data P {n : ℕ} : Term n -> Set where 434 | var : forall {i : Fin n} -> P (var i) 435 | app : forall {e1 e2 : Term n} -> P e1 -> P (e1 · e2) 436 | proj : forall {e} {l} -> P e -> P (e # l) 437 | 438 | data Whnf {n : ℕ} : Term n -> Set where 439 | `_ : forall {p : Term n} -> P p -> Whnf p 440 | abs : forall {e : Term (suc n)} -> Whnf (abs e) 441 | rec : forall {l} {r : Record (Term n) l} -> Whnf (rec r) 442 | 443 | =>Whnf : forall {n} {G : Context n} {e : Term n} {A B : Type} 444 | -> G ⊢ e :: A => B 445 | -> Whnf e 446 | -> P e ⊎ (Σ[ e' ∈ Term (suc n) ] e ≡ abs e') 447 | =>Whnf {e = var x} D (` x₁) = inl x₁ 448 | =>Whnf {e = abs e} D abs = inr (e , refl) 449 | =>Whnf {e = e · e₁} D (` x) = inl x 450 | =>Whnf {e = rec x} D w 451 | with inversion/recI D 452 | ... | () 453 | =>Whnf {e = e # x} D (` x₁) = inl x₁ 454 | 455 | recWhnf : forall {n} {G : Context n} {e : Term n} {l} {rt : Record Type l} 456 | -> G ⊢ e :: rec rt 457 | -> Whnf e 458 | -> P e ⊎ (Σ[ l' ∈ Label ] Σ[ r ∈ Record (Term n) l' ] e ≡ rec r) 459 | recWhnf {e = var x} D (` x₁) = inl x₁ 460 | recWhnf {e = abs e} D w 461 | with inversion/=>I D 462 | ... | () 463 | recWhnf {e = e · e₁} D (` x) = inl x 464 | recWhnf {e = rec x} D rec = inr (_ , x , refl) 465 | recWhnf {e = e # x} D (` x₁) = inl x₁ 466 | 467 | helper/progress : forall {n} {G : Context n} {l1 l2} {r : Record _ l1} {rt : Record _ l2} 468 | -> G ⊢ rec r :: rec rt 469 | -> forall {l} 470 | -> l ∈ rt 471 | -> l ∈ r 472 | helper/progress D l∈rt 473 | with inversion/recI D 474 | ... | rt0 , f , g , x , s with inversion/S-Record s l∈rt 475 | ... | l∈rt0 , s' = g l∈rt0 476 | 477 | progress : forall {n} {G : Context n} {e : Term n} {A} 478 | -> G ⊢ e :: A 479 | -> (Σ[ e' ∈ Term n ] e ▷ e') ⊎ Whnf e 480 | progress (axiom x) = inr (` var) 481 | progress (=>I D) = inr abs 482 | progress {n} {e = e1 · e2} (=>E D D₁) with progress D 483 | ... | inl (e1' , s) = inl ((e1' · e2) , cong/app s) 484 | ... | inr w with =>Whnf D w 485 | ... | inl p = inr (` app p) 486 | ... | inr (e1 , x) = inl (transport (Σ-cong-snd λ x₁ i → (x (~ i) · e2) ▷ x₁) (subst′ e2 fzero e1 , beta/=>)) 487 | progress (sub D _) = progress D 488 | progress (recI D) = inr rec 489 | progress {G = G} {e = e # l} (recE D l∈r) with progress D 490 | ... | inl (e' , s) = inl ((e' # l) , cong/# s) 491 | ... | inr w with recWhnf D w 492 | ... | inl p = inr (` proj p) 493 | ... | inr (l' , r , x) = inl (transport (Σ-cong-snd λ x₁ i → x (~ i) # l ▷ x₁) (find l r (helper/progress (subst (λ x₁ → G ⊢ x₁ :: _) x D) l∈r) , beta/rec)) 494 | -------------------------------------------------------------------------------- /subtyping.agda-lib: -------------------------------------------------------------------------------- 1 | name: subtyping 2 | depend: cubical-0.4 3 | include: . 4 | --------------------------------------------------------------------------------