├── .gitignore ├── .idea ├── .gitignore ├── modules.xml └── tutorial-code.iml ├── LICENSE ├── PartI ├── PartI.iml ├── arend.yaml └── src │ ├── Basics.ard │ ├── Case.ard │ ├── Equality.ard │ ├── EqualityProofs.ard │ ├── Exercises │ ├── BasicsEx.ard │ ├── CaseEx.ard │ ├── EqualityEx.ard │ ├── EqualityProofsEx.ard │ ├── IndexedEx.ard │ ├── ProofsEx.ard │ ├── RecordsEx.ard │ └── UniversesEx.ard │ ├── Indexed.ard │ ├── Proofs.ard │ ├── Records.ard │ ├── Universes.ard │ ├── index.ard │ └── sort.ard ├── PartII ├── PartII.iml ├── arend.yaml └── src │ ├── Exercises │ ├── HomUniversesEx.ard │ ├── PropsSetsEx.ard │ ├── SetsEx.ard │ └── SpacesEx.ard │ ├── HomUniverses.ard │ ├── PropsSets.ard │ ├── Sets.ard │ ├── Spaces.ard │ └── index.ard └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .idea/workspace.xml 2 | .idea/misc.xml 3 | .idea/vcs.xml 4 | .bin 5 | -------------------------------------------------------------------------------- /.idea/.gitignore: -------------------------------------------------------------------------------- 1 | # Default ignored files 2 | /workspace.xml -------------------------------------------------------------------------------- /.idea/modules.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /.idea/tutorial-code.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /PartI/PartI.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /PartI/arend.yaml: -------------------------------------------------------------------------------- 1 | sourcesDir: src 2 | binariesDir: .bin 3 | -------------------------------------------------------------------------------- /PartI/src/Basics.ard: -------------------------------------------------------------------------------- 1 | \open Nat 2 | 3 | ------------------------------------------------- 4 | -- Functions 5 | ------------------------------------------------- 6 | 7 | \func f => 0 8 | {- Haskell: 9 | f = 0 10 | -} 11 | 12 | \func f' : Nat => 0 13 | {- Haskell: 14 | f :: Nat 15 | f = 0 16 | -} 17 | 18 | \func id (x : Nat) => x -- identity function on natural numbers 19 | 20 | \func id' (x : Nat) : Nat => x -- the same, but with explicit result type 21 | {- Haskell: 22 | id :: Nat -> Nat 23 | id x = x 24 | -} 25 | 26 | \func foo (x _ : Nat) (_ : Int) => x -- simply returning the first argument 27 | {- Haskell: 28 | foo :: Nat -> Nat -> Int -> Nat 29 | foo x y z = x 30 | -} 31 | 32 | -- \func id'' x => x -- this definition is not correct! 33 | {- Haskell: 34 | id'' x = x 35 | -} 36 | 37 | -- types of parameters cannot be infered as before 38 | \func foo' => \lam (x _ : Nat) (_ : Int) => x 39 | -- but types of parameters can be omitted if the result type is specified explicitly 40 | \func foo'' : Nat -> Nat -> Int -> Nat => \lam x _ _ => x 41 | {- Haskell: 42 | foo'' :: Nat -> Nat -> Int -> Nat 43 | foo'' = \x y z -> x 44 | -} 45 | 46 | ------------------------------------------------- 47 | -- Infix operators 48 | ------------------------------------------------- 49 | 50 | \func \infixl 6 $$ (x y : Nat) => x 51 | \func test => 3 $$ 7 -- test returns 3 52 | {- Haskell: 53 | infixl 6 $$ 54 | ($$) x y = x 55 | test = 3 $$ 7 56 | -} 57 | 58 | \func ff (x y : Nat) => x 59 | \func ff_test => 0 `ff` 1 60 | {- Haskell: 61 | ff x y = x 62 | ff_test = 3 `ff` 7 63 | -} 64 | 65 | \func \infix 6 %% (x y : Nat) => x 66 | \func %%-test => %% 3 7 -- no need to surround %% with ( ) 67 | {- Haskell: 68 | infix 5 %% 69 | (%%) x y = x 70 | pp_test = (%%) 3 7 71 | -} 72 | 73 | ------------------------------------------------- 74 | -- Data definitions 75 | ------------------------------------------------- 76 | 77 | \data Empty 78 | {- Haskell: 79 | data Empty 80 | -} 81 | 82 | \data Unit | unit 83 | {- Haskell: 84 | data Unit = Unit 85 | -} 86 | 87 | \data Bool | false | true 88 | {- Haskell: 89 | data Bool = False | True 90 | -} 91 | 92 | \func not (x : Bool) : Bool \with -- keyword \with can be omitted 93 | | true => false 94 | | false => true 95 | {- Haskell: 96 | not :: Bool -> Bool 97 | not True = False 98 | not False = True 99 | -} 100 | 101 | \func if (x : Bool) (t e : Nat) : Nat \elim x 102 | | true => t 103 | | false => e 104 | {- Haskell: 105 | if :: Bool -> Nat -> Nat -> Nat 106 | if True t e = t 107 | if False t e = e 108 | -} 109 | 110 | {- 111 | \data K | k (K -> K) 112 | \func I => k (\lam x => x) 113 | \func Kc => k (\lam x => k (\lam _ => x)) 114 | \func app (f a : K) : K \elim f 115 | | k f' => f' a 116 | \func omega => k (\lam x => app x x) 117 | -} 118 | 119 | -- The definition of Nat 120 | -- \data Nat | zero | suc Nat 121 | 122 | -- the following functions are equivalent 123 | \func three => suc (suc (suc zero)) 124 | \func three' => 3 125 | 126 | -- there is no limit on the size of numbers 127 | \func bigNumber => 1000000000000000000000000 128 | 129 | \func \infixl 6 + (x y : Nat) : Nat \elim y 130 | | 0 => x 131 | | suc y => suc (x + y) 132 | {- Haskell: 133 | (+) :: Nat -> Nat -> Nat 134 | x + Zero = x 135 | x + Suc y = Suc (x + y) 136 | -} 137 | 138 | -- If n is a variable, then n + 2 evaluates to suc (suc n), 139 | -- but 2 + n does not as it is already in the normal form. 140 | -- This behaviour depends on the definition of +, namely, 141 | -- the argument chosen for pattern matching. 142 | 143 | \func \infixl 7 * (x y : Nat) : Nat \elim y 144 | | 0 => 0 145 | | suc y => x * y + x 146 | {- Haskell: 147 | (*) :: Nat -> Nat -> Nat 148 | x * Zero = 0 149 | x * Suc y = x * y + x 150 | -} 151 | 152 | \data BinNat 153 | | zero' 154 | | sh+1 BinNat -- x*2+1 155 | | sh+2 BinNat -- x*2+2 156 | 157 | ------------------------------------------------- 158 | -- Termination, div 159 | ------------------------------------------------- 160 | 161 | -- \func theorem : 0 = 1 => theorem 162 | 163 | \func \infixl 6 - (x y : Nat) : Nat 164 | | 0, _ => 0 165 | | suc x, 0 => suc x 166 | | suc x, suc y => x - y 167 | 168 | \func \infix 4 < (x y : Nat) : Bool 169 | | 0, 0 => false 170 | | 0, suc y => true 171 | | suc x, 0 => false 172 | | suc x, suc y => x < y 173 | 174 | -- An obvious but not correct definition: 175 | -- \func div (x y : Nat) : Nat => if (x < y) 0 (suc (div (x - y) y)) 176 | 177 | \func div (x y : Nat) => div' x x y 178 | \where 179 | \func div' (s x y : Nat) : Nat \elim s 180 | | 0 => 0 181 | | suc s => if (x < y) 0 (suc (div' s (x - y) y)) 182 | 183 | ------------------------------------------------- 184 | -- Polymorphism 185 | ------------------------------------------------- 186 | 187 | \func id'' (A : \Type) (a : A) => a 188 | {- Haskell: 189 | id'' :: a -> a 190 | id'' x = x 191 | -} 192 | 193 | -- the syntax A -> B is used for types of functions, 194 | -- the codomain of which does not depend on the argument 195 | -- for example, (id Nat) has type Nat -> Nat 196 | -- Pi-types generalize them, allowing codomain to depend on the argument 197 | \func idType : \Pi (A : \Type) (a : A) -> A => id'' 198 | {- Haskell: 199 | idType :: a -> a 200 | idType = id'' 201 | -} 202 | 203 | ------------------------------------------------- 204 | -- Implicit arguments 205 | ------------------------------------------------- 206 | 207 | \func idTest => id'' _ 0 208 | 209 | \func id''' {A : \Type} (a : A) => a 210 | 211 | \func idTest' => id''' 0 212 | \func idTest'' => id''' {Nat} 0 -- implicit arguments can be specifyed explicitly 213 | 214 | ------------------------------------------------- 215 | -- List, append 216 | ------------------------------------------------- 217 | 218 | \data List (A : \Type) | nil | cons A (List A) 219 | {- Haskell: 220 | data List a = Nil | Cons a (List a) 221 | -} 222 | 223 | -- Constructors have implicit parameters for each of the parameters of data type 224 | \func emptyList => nil {Nat} 225 | 226 | -- Operator 'append' 227 | \func \infixl 6 ++ {A : \Type} (xs ys : List A) : List A \elim xs 228 | | nil => ys 229 | | cons x xs => cons x (xs ++ ys) 230 | {- Haskell: 231 | (++) :: List a -> List A -> List a 232 | Nil ++ ys = ys 233 | cons x xs ++ ys = cons x (xs ++ ys) 234 | -} 235 | 236 | ------------------------------------------------- 237 | -- Namespaces and modules 238 | ------------------------------------------------- 239 | 240 | \func f'' => g \where \func g => 0 241 | 242 | \func gTest => f''.g 243 | 244 | \func letExample => \let 245 | | x => 1 246 | | y => x + x 247 | \in x + y * y 248 | 249 | \module M1 \where { 250 | \func f => 82 251 | \func g => 77 252 | \func h => 25 253 | } 254 | 255 | -- definitions f, g and h are unavailable in the current namespace 256 | -- they should be accessed with the prefix M1. 257 | \func moduleTest => (M1.f,M1.g,M1.h) 258 | 259 | \module M2 \where { 260 | \open M1 261 | \func t => f 262 | \func t' => g 263 | \func t'' => h 264 | } 265 | 266 | \module M3 \where { 267 | \open M1(f,g) 268 | \func t => f 269 | \func t' => g 270 | \func t'' => M1.h -- h is not opened and must be accessed with prefix 271 | } 272 | 273 | \module M4 \where { 274 | \func functionModule => 34 275 | \where { 276 | \func f1 => 42 277 | \func f2 => 61 278 | \func f3 => 29 279 | } 280 | \func t => functionModule.f1 281 | \func t' => functionModule.f2 282 | \func t'' => (f1, f3) 283 | \where \open functionModule(f1,f3) 284 | -- this \open affects everything in \where-block for t''as well as t'' 285 | } 286 | 287 | \module M5 \where { 288 | \open M2 \hiding (t') -- open all definitions except for t' 289 | \open M3 (t \as M3_t) -- open just t and rename it to M3_t 290 | \open M4 \using (t \as M4_t) -- open all definition and rename t to M4_t 291 | \func t'' => (M3_t, M4_t, t', t, functionModule, functionModule.f1, functionModule.f2, functionModule.f3) 292 | \func t''' => (t'', M2.t'', M4.t'') 293 | -- t'' in the current module clashes with t'' from M2 and M4, 294 | -- the latter definitions should be accessed with prefix 295 | } 296 | -------------------------------------------------------------------------------- /PartI/src/Case.ard: -------------------------------------------------------------------------------- 1 | 2 | ------------------------------------------------- 3 | -- Filter via \case and via helper 4 | ------------------------------------------------- 5 | 6 | \data Bool | false | true 7 | 8 | \data List (A : \Type) | nil | cons A (List A) 9 | 10 | \func filter {A : \Type} (p : A -> Bool) (xs : List A) : List A \elim xs 11 | | nil => nil 12 | | cons x xs => \case p x \with { 13 | | true => cons x (filter p xs) 14 | | false => filter p xs 15 | } 16 | 17 | \func filter' {A : \Type} (p : A -> Bool) (xs : List A) : List A \elim xs 18 | | nil => nil 19 | | cons x xs => helper (p x) x (filter p xs) 20 | \where 21 | \func helper {A : \Type} (b : Bool) (x : A) (r : List A) : List A \elim b 22 | | true => cons x r 23 | | false => r 24 | 25 | ------------------------------------------------- 26 | -- Remark in \elim vs \case 27 | ------------------------------------------------- 28 | 29 | \func f (x : Nat) : Nat => \case x \with { zero => 0 | suc n => n } 30 | \func f' (x : Nat) : Nat | zero => 0 | suc n => n 31 | 32 | ------------------------------------------------- 33 | -- \case in dependently typed languages 34 | ------------------------------------------------- 35 | 36 | \func not (b : Bool) : Bool 37 | | true => false 38 | | false => true 39 | 40 | \func foo {A : \Type} (p : A -> Bool) (a : A) : p a = not (not (p a)) => 41 | \case p a \as b \return b = not (not b) \with { 42 | | true => idp 43 | | false => idp 44 | } 45 | 46 | \func foo' {A : \Type} (p : A -> Bool) (a : A) : p a = not (not (p a)) => 47 | helper (p a) 48 | \where 49 | \func helper (b : Bool) : b = not (not b) \elim b 50 | | true => idp 51 | | false => idp 52 | 53 | ------------------------------------------------- 54 | -- \case with several arguments 55 | ------------------------------------------------- 56 | 57 | \data Ordering | LT | EQ | GT 58 | 59 | \func \infix 4 < (x y : Nat) : Bool 60 | | 0, 0 => false 61 | | 0, suc y => true 62 | | suc x, 0 => false 63 | | suc x, suc y => x < y 64 | 65 | \func compare (x y : Nat) : Ordering => 66 | \case x < y, y < x \with { 67 | | true, true => EQ -- this will never be matched 68 | | true, false => LT 69 | | false, true => GT 70 | | false, false => EQ } 71 | 72 | ------------------------------------------------- 73 | -- Proof of a fact about filter via \case 74 | ------------------------------------------------- 75 | 76 | \data Empty 77 | 78 | \func absurd {A : \Type} (e : Empty) : A 79 | 80 | \data Unit | unit 81 | 82 | \func \infix 4 <= (x y : Nat) : \Type 83 | | 0, _ => Unit 84 | | suc _, 0 => Empty 85 | | suc x, suc y => x <= y 86 | 87 | \func length {A : \Type} (xs : List A) : Nat 88 | | nil => 0 89 | | cons _ xs => suc (length xs) 90 | 91 | -- auxiliary helper lemma 92 | \func <=-helper {x y : Nat} (p : x <= y) : x <= suc y \elim x, y 93 | | 0, _ => unit 94 | | suc x, 0 => absurd p 95 | | suc x, suc y => <=-helper p 96 | 97 | \func filter-lem {A : \Type} (p : A -> Bool) (xs : List A) : length (filter p xs) <= length xs \elim xs 98 | | nil => unit 99 | | cons x xs => \case p x \as b \return length (\case b \with { | true => cons x (filter p xs) | false => filter p xs }) <= suc (length xs) \with { 100 | | true => filter-lem p xs 101 | | false => <=-helper (filter-lem p xs) 102 | } 103 | 104 | ------------------------------------------------- 105 | -- Matching on idp in \case 106 | ------------------------------------------------- 107 | 108 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) : B a' 109 | => coe (\lam i => B (p @ i)) b right 110 | 111 | \func baz {A : \Type} (B : Bool -> \Type) (p : A -> Bool) (a : A) (pt : B true) (pf : B false) : B (p a) => 112 | -- Not only the return type can be specified explicitly, but also 113 | -- the type of expressions we do matching on. 114 | -- And we can use variables bounded in \as. 115 | \case p a \as b, idp : b = p a \with { 116 | | true, q => transport B q pt -- here q : true = p a 117 | | false, q => transport B q pf -- here q : false = p a 118 | } 119 | 120 | \func baz' {A : \Type} (B : Bool -> \Type) (p : A -> Bool) (a : A) (pt : B true) (pf : B false) : B (p a) => 121 | helper B p a pt pf 122 | (p a) idp 123 | \where 124 | \func helper {A : \Type} (B : Bool -> \Type) (p : A -> Bool) (a : A) (pt : B true) (pf : B false) 125 | (b : Bool) (q : b = p a) : B (p a) \elim b 126 | | true => transport B q pt -- here q : true = p a 127 | | false => transport B q pf -- here q : false = p a 128 | 129 | ------------------------------------------------- 130 | -- One more example of \case 131 | ------------------------------------------------- 132 | 133 | -- symmetry 134 | \func inv {A : \Type} {a a' : A} (p : a = a') : a' = a 135 | => transport (\lam x => x = a) p idp 136 | 137 | \func bar {A : \Type} (p q : A -> Bool) (a : A) (s : q a = not (p a)) 138 | : not (q a) = p a => 139 | \case p a \as x, q a \as y, s : y = not x \return not y = x \with { 140 | | true, true, s' => inv s' 141 | | true, false, _ => idp 142 | | false, true, _ => idp 143 | | false, false, s' => inv s' 144 | } 145 | 146 | -- helper version 147 | \func bar' {A : \Type} (p q : A -> Bool) (a : A) (s : q a = not (p a)) 148 | : not (q a) = p a => helper (p a) (q a) s 149 | \where 150 | \func helper (x y : Bool) (s : y = not x) : not y = x \elim x, y 151 | | true, true => inv s 152 | | true, false => idp 153 | | false, true => idp 154 | | false, false => inv s 155 | 156 | ------------------------------------------------- 157 | -- Views 158 | ------------------------------------------------- 159 | 160 | \func \infixl 6 + (x y : Nat) : Nat \elim y 161 | | 0 => x 162 | | suc y => suc (x + y) 163 | 164 | \func \infixl 7 * (x y : Nat) : Nat \elim y 165 | | 0 => 0 166 | | suc y => x * y + x 167 | 168 | \data Parity (n : Nat) 169 | | even (k : Nat) (p : n = 2 * k) 170 | | odd (k : Nat) (p : n = 2 * k + 1) 171 | 172 | -- congruence 173 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 174 | => transport (\lam x => f a = f x) p idp 175 | 176 | \func parity (n : Nat) : Parity n 177 | | 0 => even 0 idp 178 | | suc n => \case parity n \with { 179 | | even k p => odd k (pmap suc p) 180 | | odd k p => even (suc k) (pmap suc p) } 181 | 182 | \func div2 (n : Nat) : Nat => \case parity n \with { 183 | | even k _ => k 184 | | odd k _ => k 185 | } 186 | 187 | ------------------------------------------------- 188 | -- Decidable predicates 189 | ------------------------------------------------- 190 | 191 | \data Decide (A : \Type) 192 | | yes A 193 | | no (A -> Empty) 194 | 195 | \func DecPred {A : \Type} (P : A -> \Type) => \Pi (a : A) -> Decide (P a) 196 | 197 | \func suc/=0 {n : Nat} (p : suc n = 0) : Empty => transport (\lam n => \case n \with { | 0 => Empty | suc _ => Unit }) p unit 198 | 199 | -- the predicate \lam n => n = 0 is decidable 200 | \func decide0 : DecPred (\lam (n : Nat) => n = 0) => \lam n => 201 | \case n \as x \return Decide (x = 0) \with { 202 | | 0 => yes idp 203 | | suc _ => no suc/=0 204 | } 205 | 206 | ------------------------------------------------- 207 | -- Decidable equality 208 | ------------------------------------------------- 209 | 210 | \func DecEq (A : \Type) => \Pi (a a' : A) -> Decide (a = a') 211 | 212 | \class Eq (A : \Type) { 213 | | decideEq : DecEq A 214 | -- Functions declared inside a class have instance of 215 | -- the class as their first implicit parameter. 216 | \func \infix 4 == (a a' : A) : Bool => \case decideEq a a' \with { 217 | | yes _ => true 218 | | no _ => false 219 | } 220 | } \where { 221 | -- Function == is equivalent to =='. 222 | \func \infix 4 ==' {e : Eq} (a a' : e.A) : Bool => \case e.decideEq a a' \with { 223 | | yes _ => true 224 | | no _ => false 225 | } 226 | } 227 | 228 | \func pred (n : Nat) : Nat 229 | | 0 => 0 230 | | suc n => n 231 | 232 | \instance NatEq : Eq Nat 233 | | decideEq => decideEq 234 | \where 235 | \func decideEq (x y : Nat) : Decide (x = y) 236 | | 0, 0 => yes idp 237 | | 0, suc y => no (\lam p => suc/=0 (inv p)) 238 | | suc x, 0 => no suc/=0 239 | | suc x, suc y => \case decideEq x y \with { 240 | | yes p => yes (pmap suc p) 241 | | no c => no (\lam p => c (pmap pred p)) 242 | } 243 | 244 | \func test1 : (0 Eq.== 0) = true => idp 245 | \func test2 : (0 Eq.== 1) = false => idp 246 | 247 | ------------------------------------------------- 248 | -- Decidable predicates and functions 249 | ------------------------------------------------- 250 | 251 | \func T (b : Bool) : \Type 252 | | true => Unit 253 | | false => Empty 254 | 255 | \func FromBoolToDec {A : \Type} (p : A -> Bool) : \Sigma (P : A -> \Type) (DecPred P) 256 | => (\lam a => T (p a), \lam a => \case p a \as b \return Decide (T b) \with { 257 | | true => yes unit 258 | | false => no (\lam x => x) 259 | }) 260 | 261 | \func FromDecToBool {A : \Type} (P : \Sigma (P : A -> \Type) (DecPred P)) : A -> Bool 262 | => \lam a => \case P.2 a \with { 263 | | yes _ => true 264 | | no _ => false 265 | } 266 | 267 | -------------------------------------------------------------------------------- /PartI/src/Equality.ard: -------------------------------------------------------------------------------- 1 | ------------------------------------------------- 2 | -- Symmetry, transitivity, Leibnitz principle 3 | ------------------------------------------------- 4 | 5 | \func Leibniz {A : \Type} {a a' : A} 6 | (f : \Pi (P : A -> \Type) -> \Sigma (P a -> P a') (P a' -> P a)) : a = a' 7 | => (f (\lam x => a = x)).1 idp 8 | 9 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) : B a' 10 | => coe (\lam i => B (p @ i)) b right 11 | 12 | -- symmetry 13 | \func inv {A : \Type} {a a' : A} (p : a = a') : a' = a 14 | => transport (\lam x => x = a) p idp 15 | 16 | -- transitivity 17 | \func trans {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 18 | => transport (\lam x => a = x) q p 19 | 20 | -- congruence 21 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 22 | => transport (\lam x => f a = f x) p idp 23 | 24 | ------------------------------------------------- 25 | -- Definition of = 26 | ------------------------------------------------- 27 | 28 | \func idp {A : \Type} {a : A} : a = a => path (\lam _ => a) 29 | 30 | \func pmap' {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 31 | => path (\lam i => f (p @ i)) 32 | 33 | \func pmap-idp {A : \Type} {a a' : A} (p : a = a') : pmap' {A} (\lam x => x) p = p 34 | => idp 35 | 36 | ------------------------------------------------- 37 | -- Function extensionality 38 | ------------------------------------------------- 39 | 40 | \func funExt {A : \Type} (B : A -> \Type) {f g : \Pi (a : A) -> B a} 41 | (p : \Pi (a : A) -> f a = g a) : f = g 42 | => path (\lam i => \lam a => p a @ i) 43 | 44 | \data \fixr 2 Either (A B : \Type) 45 | | inl A 46 | | inr B 47 | 48 | \data Empty 49 | 50 | \func lem : \Pi (X : \Type) -> Either X (X -> Empty) => {?} 51 | \func ugly_num : Nat => \case lem Nat \with { | Left => 0 | Right => 1 } 52 | 53 | ------------------------------------------------- 54 | -- Eliminators 55 | ------------------------------------------------- 56 | 57 | -- Dependent eliminator for Nat (induction). 58 | \func Nat-elim (P : Nat -> \Type) 59 | (z : P zero) 60 | (s : \Pi (n : Nat) -> P n -> P (suc n)) 61 | (x : Nat) : P x \elim x 62 | | zero => z 63 | | suc n => s n (Nat-elim P z s n) 64 | 65 | -- Non-dependent eliminator for Nat (recursion). 66 | \func Nat-rec (P : \Type) 67 | (z : P) 68 | (s : Nat -> P -> P) 69 | (x : Nat) : P \elim x 70 | | zero => z 71 | | suc n => s n (Nat-rec P z s n) 72 | 73 | \data Bool | false | true 74 | 75 | -- Dependent eliminator for Bool (recursor for Bool is just 'if'). 76 | \func Bool-elim (P : Bool -> \Type) 77 | (t : P true) 78 | (f : P false) 79 | (x : Bool) : P x \elim x 80 | | true => t 81 | | false => f 82 | 83 | {- 84 | \func coe (P : I -> \Type) 85 | (a : P left) 86 | (i : I) : P i \elim i 87 | | left => a 88 | -} 89 | 90 | ------------------------------------------------- 91 | -- left = right 92 | ------------------------------------------------- 93 | 94 | \func left=i (i : I) : left = i 95 | -- | left => idp 96 | => coe (\lam i => left = i) idp i 97 | 98 | -- In particular left = right. 99 | \func left=right : left = right => left=i right 100 | 101 | ------------------------------------------------- 102 | -- Proofs of non-equalities 103 | ------------------------------------------------- 104 | 105 | \data Unit | unit 106 | 107 | \func T (b : Bool) : \Type 108 | | true => Unit 109 | | false => Empty 110 | 111 | \func true/=false (p : true = false) : Empty => transport T p unit 112 | 113 | -- This function does not typecheck! 114 | {- 115 | \func TI (b : I) 116 | | left => \Sigma 117 | | right => Empty 118 | -} 119 | -------------------------------------------------------------------------------- /PartI/src/EqualityProofs.ard: -------------------------------------------------------------------------------- 1 | 2 | ------------------------------------------------- 3 | -- Commutativity of + 4 | ------------------------------------------------- 5 | 6 | -- transport B idp b ==> b 7 | 8 | -- recall the definition of transport: 9 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 10 | => coe (\lam i => B (p @ i)) b right 11 | 12 | -- indeed, coe (\lam i => B (idp @ i)) b right ==> 13 | -- ==> coe (\lam i => B a) b right ==> b 14 | 15 | \func \infixr 5 *> {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 16 | => transport (\lam x => a = x) q p 17 | 18 | -- symmetry 19 | \func inv {A : \Type} {a a' : A} (p : a = a') : a' = a 20 | => transport (\lam x => x = a) p idp 21 | 22 | -- congruence 23 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 24 | => transport (\lam x => f a = f x) p idp 25 | 26 | \func \infixl 6 + (x y : Nat) : Nat \elim y 27 | | 0 => x 28 | | suc y => suc (x + y) 29 | 30 | \func +-comm (n m : Nat) : n + m = m + n 31 | | 0, 0 => idp 32 | | suc n, 0 => pmap suc (+-comm n 0) 33 | | 0, suc m => pmap suc (+-comm 0 m) 34 | | suc n, suc m => pmap suc (+-comm (suc n) m *> pmap suc (inv (+-comm n m)) *> +-comm n (suc m)) 35 | 36 | ------------------------------------------------- 37 | -- Equational reasoning, proof of +-comm rewritten 38 | ------------------------------------------------- 39 | 40 | \func \fix 2 qed {A : \Type} (a : A) : a = a => idp 41 | 42 | \func \infixr 1 >== {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') => p *> q 43 | 44 | \func \infix 2 ==< {A : \Type} (a : A) {a' : A} (p : a = a') => p 45 | 46 | \func +-comm' (n m : Nat) : n + m = m + n 47 | | 0, 0 => idp 48 | | suc n, 0 => pmap suc (+-comm' n 0) 49 | | 0, suc m => pmap suc (+-comm' 0 m) 50 | | suc n, suc m => pmap suc ( 51 | suc n + m ==< +-comm' (suc n) m >== 52 | suc (m + n) ==< pmap suc (inv (+-comm' n m)) >== 53 | suc (n + m) ==< +-comm' n (suc m) >== 54 | suc m + n `qed 55 | ) 56 | 57 | -- recall that: 58 | -- x `f == f x -- postfix notation 59 | -- x `f` y == f x y -- infix notation 60 | 61 | 62 | ------------------------------------------------- 63 | -- J operator 64 | ------------------------------------------------- 65 | 66 | \func J 67 | {A : \Type} {a : A} 68 | (B : \Pi (a' : A) -> a = a' -> \Type) 69 | (b : B a idp) 70 | {a' : A} (p : a = a') 71 | : B a' p 72 | -- the details of the definition are not important for now 73 | => coe (\lam i => B (p @ i) (psqueeze p i)) b right 74 | \where 75 | \func psqueeze {A : \Type} {a a' : A} (p : a = a') (i : I) : a = p @ i => path (\lam j => p @ I.squeeze i j) 76 | 77 | \func K {A : \Type} {a : A} (B : a = a -> \Type) 78 | (b : B idp) 79 | (p : a = a) : B p => {?} 80 | 81 | \func transport' {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) : B a' \elim p 82 | | idp => b 83 | 84 | ------------------------------------------------- 85 | -- Associativity of append for vectors 86 | ------------------------------------------------- 87 | 88 | \data Vec (A : \Type) (n : Nat) \elim n 89 | | zero => vnil 90 | | suc n => vcons A (Vec A n) 91 | 92 | \func \infixl 4 v++ {A : \Type} {n m : Nat} (xs : Vec A n) (ys : Vec A m) : Vec A (m + n) \elim n, xs 93 | | 0, vnil => ys 94 | | suc n, vcons x xs => vcons x (xs v++ ys) 95 | 96 | \func +-assoc (x y z : Nat) : (x + y) + z = x + (y + z) \elim z 97 | | 0 => idp 98 | | suc z => pmap suc (+-assoc x y z) 99 | 100 | \func v++-assoc {A : \Type} {n m k : Nat} (xs : Vec A n) (ys : Vec A m) (zs : Vec A k) 101 | : (xs v++ ys) v++ zs = transport (Vec A) (+-assoc k m n) (xs v++ (ys v++ zs)) \elim n, xs 102 | | 0, vnil => idp 103 | | suc n, vcons x xs => 104 | pmap (vcons x) (v++-assoc xs ys zs) *> 105 | inv (transport-vcons-comm (+-assoc k m n) x (xs v++ (ys v++ zs))) 106 | \where 107 | -- transport commutes with all constructors 108 | -- here is the proof that it commutes with vcons 109 | \func transport-vcons-comm {A : \Type} {n m : Nat} (p : n = m) (x : A) (xs : Vec A n) 110 | : transport (Vec A) (pmap suc p) (vcons x xs) = vcons x (transport (Vec A) p xs) 111 | | idp, _, _ => idp 112 | {- This function can be defined with J as follows: 113 | => J (\lam m' p' => transport (Vec A) (pmap suc p') (vcons x xs) = vcons x (transport (Vec A) p' xs)) 114 | idp 115 | p 116 | -} 117 | 118 | ------------------------------------------------- 119 | -- Predicates 120 | ------------------------------------------------- 121 | 122 | -- Definition of <= via equality. 123 | \func LessOrEq''' (n m : Nat) => \Sigma (k : Nat) (k + n = m) 124 | 125 | \data Empty 126 | 127 | \data Unit | unit 128 | 129 | -- Recursive definition of <=. 130 | \func lessOrEq (n m : Nat) : \Type 131 | | 0, _ => Unit 132 | | suc _, 0 => Empty 133 | | suc n, suc m => lessOrEq n m 134 | 135 | -- First inductive definition of <=. 136 | \data LessOrEq (n m : Nat) \with 137 | | 0, m => z<=n 138 | | suc n, suc m => s<=s (LessOrEq n m) 139 | 140 | \func test11 : LessOrEq 0 100 => z<=n 141 | \func test12 : LessOrEq 3 67 => s<=s (s<=s (s<=s z<=n)) 142 | -- Of course, there is no proof of 1 <= 0. 143 | -- \func test10 : LessOrEq 1 0 => .... 144 | 145 | -- Second inductive definition of <=. 146 | -- This is a modification of the first inductive definition, 147 | -- where we avoid constructor patterns. 148 | \data LessOrEq' (n m : Nat) 149 | | z<=n' (n = 0) 150 | | s<=s' {n' m' : Nat} (n = suc n') (m = suc m') (LessOrEq' n' m') 151 | 152 | -- Third inductive definition of <=. 153 | \data LessOrEq'' (n m : Nat) \elim m 154 | | suc m => <=-step (LessOrEq'' n m) 155 | | m => <=-refl (n = m) 156 | 157 | 158 | 159 | 160 | -------------------------------------------------------------------------------- /PartI/src/Exercises/BasicsEx.ard: -------------------------------------------------------------------------------- 1 | -- 1. Define priorities of the functions f1, f2, f3, f4, f5 and f6 so that the function 'test' typechecks. 2 | 3 | \func f1 (x y : Nat) => x 4 | \func f2 : Nat => 0 5 | \func f3 (f : Nat -> Nat) (z : Nat) : Int => 0 6 | \func f4 : Nat => 0 7 | \func f5 => f1 8 | \func f6 => f4 9 | 10 | \func test => f1 f2 f3 f4 f5 f6 11 | 12 | -- 2. Define in Arend the function 'if', which takes a boolean value b and two elements of an arbitrary type A 13 | -- and return the first element when b equals to true and the second one otherwise. 14 | 15 | \data Bool | true | false 16 | 17 | -- 3. Define || via 'if'. 18 | 19 | \func \infixr 2 || (x y : Bool) : Bool => {?} 20 | 21 | -- 4. Define the power and the factorial functions for natural numbers. 22 | 23 | \func \infixr 8 ^ (x y : Nat) => {?} 24 | 25 | \func fac (x : Nat) => {?} 26 | 27 | -- 5. Define mod and gcd. 28 | 29 | \func mod (x y : Nat) => {?} 30 | 31 | \func gcd (x y : Nat) => {?} 32 | 33 | -- 6. Define the map function. 34 | 35 | \data List (A : \Type) | nil | \infixr 5 :: A (List A) 36 | 37 | \func map {A B : \Type} (f : A -> B) (xs : List A) : List B => {?} 38 | 39 | -- 7. Define the transpose function. 40 | -- It takes a list of lists considered as a matrix and returns a list of lists which represents the transposed matrix. 41 | -- Example: 42 | -- transpose ((1 :: 2 :: 3 :: nil) :: (4 :: 5 :: 6 :: nil)) == ((1 :: 4 :: nil) :: (2 :: 5 :: nil) :: (3 :: 6 :: nil)) 43 | -------------------------------------------------------------------------------- /PartI/src/Exercises/CaseEx.ard: -------------------------------------------------------------------------------- 1 | \import Case 2 | 3 | -- 1. Implement any sorting algorithm using \case for pattern matching on the result of comparison of elements 4 | -- of a list. 5 | 6 | -- 2. Define 'filter' via 'if' not using \case. 7 | -- Prove the lemma 'filter-lem' for this version of 'filter'. 8 | 9 | \func filter' {A : \Type} (p : A -> Bool) (xs : List A) : List A => {?} 10 | 11 | \func filter-lem {A : \Type} (p : A -> Bool) (xs : List A) : length (filter' p xs) <= length xs => {?} 12 | 13 | -- 3. Prove that, for every function f : Bool -> Bool and every x : Bool, it is true that f (f (f x)) = f x. 14 | 15 | \func Bool-lem (f : Bool -> Bool) (x : Bool) : f (f (f x)) = f x => {?} 16 | 17 | -- 4. Define the view, which represents a natural number as a pair of the quotient and the remainder of 18 | -- division by a positive 'm'. Implement the division function. 19 | 20 | \data ModView (m n : Nat) 21 | | quot-rem (q r : Nat) (t : T (r < m)) (p : n = q * m + r) 22 | 23 | \func mod-view (m n : Nat) (t : T (0 < m)) : ModView m n => {?} 24 | 25 | \func div (n m : Nat) (t : T (0 < m)) : Nat => {?} 26 | 27 | -- 5. Prove that the predicate 'isEven' is decidable. 28 | 29 | \func isEven (n : Nat) => \Sigma (k : Nat) (n = 2 * k) 30 | 31 | \func isEven-dec : DecPred isEven => {?} 32 | 33 | -- 6. Prove that if equality of elements of a type 'A' is decidable, then equality of elements if 'List A' is also decidable. 34 | 35 | \instance ListEq {A : \Type} (dec : Eq A) : Eq (List A) 36 | | decideEq => {?} 37 | 38 | -- 7. Prove that if equality of elements of a type 'A' is decidable, then every list of elements of 'A' is either empty, 39 | -- consists of repetitions of one element or there exist two different elements in 'A'. 40 | 41 | \func repeat {A : \Type} (n : Nat) (a : A) : List A \elim n 42 | | 0 => nil 43 | | suc n => cons a (repeat n a) 44 | 45 | \data Result (A : \Type) (xs : List A) 46 | | empty (xs = nil) 47 | | repeated (n : Nat) (a : A) (p : xs = repeat n a) 48 | | A-is-not-trivial (a a' : A) (p : a = a' -> Empty) 49 | 50 | \func lemma {A : \Type} (xs : List A) {dec : DecEq A} : Result A xs => {?} 51 | 52 | -- 8. Prove that the functions 'FromBoolToDec' and 'FromDecToBool' are inverse to each other. 53 | 54 | \func bdb {A : \Type} (p : A -> Bool) : FromDecToBool (FromBoolToDec p) = p => {?} 55 | 56 | -- We cannot prove that 'FromBoolToDec (FromDecToBool P) = P', but we can prove a weaker statement: 57 | -- these predicates are logically equivalent. 58 | 59 | -- Equivalence of predicates 60 | \func \infix 4 <-> {A : \Type} (P Q : A -> \Type) => \Pi (x : A) -> \Sigma (P x -> Q x) (Q x -> P x) 61 | 62 | \func dbd {A : \Type} (P : \Sigma (P : A -> \Type) (DecPred P)) : (FromBoolToDec (FromDecToBool P)).1 <-> P.1 => {?} 63 | -------------------------------------------------------------------------------- /PartI/src/Exercises/EqualityEx.ard: -------------------------------------------------------------------------------- 1 | \import Equality 2 | 3 | -- 1. Define congruence for functions with two arguments via transport. 4 | -- It is allowed to use any functions defined via transport. 5 | 6 | \func pmap2 {A B C : \Type} (f : A -> B -> C) {a a' : A} (p : a = a') {b b' : B} (q : b = b') : f a b = f a' b' => {?} 7 | 8 | -- 2. Prove that 'transport' can be defined via 'pmap' and 'repl' and vice versa. 9 | -- The function 'repl' says that if two types are equal then there exists a function between them. 10 | 11 | -- Define 'repl' via 'transport'. 12 | \func repl {A B : \Type} (p : A = B) (a : A) : B => {?} 13 | 14 | -- Define 'transport' via 'repl' and 'pmap'. 15 | \func transport' {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) : B a' => {?} 16 | 17 | -- 3. Prove that left = right without using 'transport' or 'coe'. 18 | 19 | \func left=right : left = right => {?} 20 | 21 | -- 4. Prove that a = a' and b = b' implies (a,b) = (a',b') without using 'transport'. 22 | 23 | \func pairEq {A B : \Type} {a a' : A} {b b' : B} (p : a = a') (q : b = b') : (a,b) = (a',b') => {?} 24 | 25 | -- 5. Prove that p = p' implies p.1 = p'.1 without using 'transport'. 26 | 27 | \func projEq {A : \Type} (B : A -> \Type) {p p' : \Sigma (x : A) (B x)} (t : p = p') : p.1 = p'.1 => {?} 28 | 29 | -- 6. Prove that (\lam x => not (not x)) = (\lam x => x). 30 | 31 | \func not (b : Bool) : Bool 32 | | true => false 33 | | false => true 34 | 35 | \func notNotId : (\lam x => not (not x)) = (\lam x => x) => {?} 36 | 37 | -- 7. Define factorial via Nat-rec (i.e., without recursion and pattern matching). 38 | 39 | -- 8. Prove associativity of Nat.+ via Nat-elim (i.e., without recursion and pattern matching). 40 | 41 | -- 9. Define recursor and eliminator for D. 42 | 43 | \data D 44 | | con1 Nat 45 | | con2 D D 46 | | con3 (Nat -> D) 47 | 48 | -- 10. Define recursor and eliminator for List. 49 | 50 | \data List (A : \Type) | nil | cons A (List A) 51 | 52 | -- 11. We defined transport via coe. 53 | -- Define a special case of coe via transport. 54 | -- Is it possible to define transport via coe0? 55 | 56 | \func coe0 (A : I -> \Type) (a : A left) : A right => {?} 57 | 58 | -- 12. Define a function B right -> B left. 59 | 60 | \func Itr' {B : I -> \Type} (b : B right) : B left => {?} 61 | 62 | -- 13. Prove that 0 does not equal to suc x. 63 | 64 | \func zero/=suc (x : Nat) (p : 0 = suc x) : Empty => {?} 65 | 66 | -- 14. Prove that fac does not equal to suc. 67 | 68 | \open Nat(*) 69 | 70 | \func fac (n : Nat) : Nat 71 | | 0 => 1 72 | | suc n => suc n * fac n 73 | 74 | \func fac/=suc (p : fac = suc) : Empty => {?} 75 | -------------------------------------------------------------------------------- /PartI/src/Exercises/EqualityProofsEx.ard: -------------------------------------------------------------------------------- 1 | \import EqualityProofs 2 | 3 | -- 1. The operator 'J' has a different form, which we denote 'Jalt'. Prove that 'J' and 'Jalt' are equivalent, i.e. 4 | -- define 'J' in terms of 'Jalt' and vice versa. 5 | 6 | -- Define 'Jalt' via 'J'. You can use only 'J', 'idp' and everything definable in terms of these constructs. 7 | 8 | \func Jalt {A : \Type} (B : \Pi (a a' : A) -> a = a' -> \Type) 9 | (b : \Pi (a : A) -> B a a idp) 10 | {a a' : A} (p : a = a') : B a a' p => {?} 11 | 12 | -- Define 'J' via 'Jalt'. You can use only 'Jalt', 'idp' and everything definable in terms of these constructs (but not pattern matching on 'idp'). 13 | -- See the end of this file for a hint. 14 | 15 | \func transport' {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) : B a' => {?} 16 | 17 | \func sigma-contr {A : \Type} {a : A} (p : \Sigma (x : A) (a = x)) : (a,idp) = {\Sigma (x : A) (a = x)} p => {?} 18 | 19 | \func J' {A : \Type} {a : A} (B : \Pi (a' : A) -> a = a' -> \Type) 20 | (b : B a idp) 21 | {a' : A} (p : a = a') : B a' p => {?} 22 | 23 | -- 2. Prove that 'vnil' is an identity for 'v++'. 24 | 25 | \func vnil-rightId {A : \Type} {n : Nat} (xs : Vec A n) : transport (Vec A) (+-comm 0 n) (xs v++ vnil) = xs => {?} 26 | 27 | -- 3. Prove that all definitions of <= given in the module are equivalent. 28 | 29 | -- 4. Define the membership predicate 'In' for lists. 30 | 31 | \data List (A : \Type) | nil | cons A (List A) 32 | 33 | \data In {A : \Type} (a : A) (xs : List A) 34 | 35 | -- 5. Define reflexive and transitive closure of a relation. 36 | -- That is 'ReflTransClosure R' -- is the minimal reflexive and transitive relation containing R. 37 | 38 | \data ReflTransClosure {A : \Type} (R : A -> A -> \Type) (x y : A) 39 | 40 | -- 6. Prove that if 'R' is already reflexive and transitive then 'ReflTransClosure R' is equivalent to 'R'. 41 | 42 | \func \infix 4 <-> {A : \Type} (P Q : A -> A -> \Type) => \Pi (x y : A) -> \Sigma (P x y -> Q x y) (Q x y -> P x y) 43 | 44 | \func ReflTransClosure-lem {A : \Type} (R : A -> A -> \Type) (refl : \Pi (x : A) -> R x x) (trans : \Pi (x y z : A) -> R x y -> R y z -> R x z) : R <-> ReflTransClosure R => {?} 45 | 46 | -- 7. Define the predicate xs <= ys for lists, which says "the list xs is a sublist of ys". 47 | 48 | -- 8. Prove that 'filter xs <= xs' for any list xs. 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -- Hint for the exercise 1: 62 | -- 1. Define 'transport' via 'Jalt'. 63 | -- 2. Prove that the type \Sigma (x : A) (a = x) is one-element type, that is for all p : \Sigma (x : A) (a = x) holds (x,idp) = p. 64 | -- 3. Use this to define 'J'. 65 | -------------------------------------------------------------------------------- /PartI/src/Exercises/IndexedEx.ard: -------------------------------------------------------------------------------- 1 | \import Indexed 2 | 3 | -- 1. Implement the function 'lookup', which takes a list and a natural number n and returns the n-th element in the list. 4 | -- Note that it is impossible to define such a function without restrictions on n sice n can be greater than the size of the list. 5 | -- Therefore the function should also take a proof that n is in the right range: T (n < length xs). 6 | 7 | \func lookup => {?} 8 | 9 | -- 2. Implement function replicate for 'vec' and 'Vec' (this function creates the list of a given length filled with a 10 | -- given element). 11 | 12 | -- 3. Implement function 'map' for 'vec' and 'Vec'. 13 | 14 | -- 4. Implement function 'zipWith' for 'vec' and 'Vec'. 15 | -- The function must take lists of equal lengths. 16 | 17 | -- 5. Functions Fin n -> A correspond to lists of length n with elements in A. 18 | -- Implement the function that converts an element of Fin n -> A to element of Vec A n. 19 | 20 | \func funToVec {A : \Type} {n : Nat} (f : Fin n -> A) : Vec A n => {?} 21 | 22 | -- 6. Define the type of matrices and a number of functions for them: 23 | 24 | \func Mat (A : \Type) (n m : Nat) : \Type => {?} 25 | 26 | -- diagonal matrix with elements e on the diagonal and z at all other positions. 27 | 28 | \func diag {A : \Type} (z e : A) (n : Nat) : Mat A n n => {?} 29 | 30 | -- transposition 31 | 32 | \func transpose {A : \Type} {n m : Nat} (M : Mat A n m) : Mat A m n => {?} 33 | 34 | -- addition 35 | 36 | \func matAdd {A : \Type} (add : A -> A -> A) (n m : Nat) (M N : Mat A n m) : Mat A n m => {?} 37 | 38 | -- multiplication 39 | 40 | -- z is neutral under addition. 41 | \func matMul {A : \Type} (z : A) (add mul : A -> A -> A) (n m k : Nat) (M : Mat A n m) (N : Mat A m k) : Mat A n k => {?} 42 | 43 | -- 7. Define the type CTree A n of (complete and full) binary trees of height precisely n, which store elements in internal nodes, but not in leaves. 44 | -- The height of a leaf is 0. 45 | 46 | \data CTree (A : \Type) (n : Nat) 47 | 48 | -- 8. Define the type Tree A n of binary trees of height at most n, which store elements in internal nodes, but not in leaves. 49 | -- The height of a leaf is 0. 50 | 51 | \data Tree (A : \Type) (n : Nat) 52 | 53 | -- Define the function that computes the height of a tree. 54 | 55 | \func height {A : \Type} (n : Nat) (t : Tree A n) : Fin (suc n) => {?} 56 | -------------------------------------------------------------------------------- /PartI/src/Exercises/ProofsEx.ard: -------------------------------------------------------------------------------- 1 | \import Proofs 2 | \open Nat(+,*) 3 | 4 | -- 1. Prove that (P -> Q -> R) -> (P -> Q) -> P -> S 5 | 6 | \func t1 {P Q R : \Type} (r : P -> Q -> R) (q : P -> Q) (p : P) : R => {?} 7 | 8 | -- 2. Prove that ((P -> Q -> R) -> P) -> (P -> R) -> R 9 | 10 | \func t2 {P Q R : \Type} (p : (P -> Q -> R) -> P) (r : P -> R) : R => {?} 11 | 12 | -- 3. Prove that (P && Q -> R) -> P -> Q -> R 13 | 14 | \func t3 {P Q R : \Type} (f : \Sigma P Q -> R) (p : P) (q : Q) : R => {?} 15 | 16 | -- 4. Formulate and prove t5 : (P -> Q -> R) -> P && Q -> R 17 | 18 | -- 5. Prove that (P -> R) -> (Q -> R) -> P || Q -> R 19 | 20 | \func t4 {P Q R : \Type} (f : P -> R) (g : Q -> R) (h : P || Q) : R => {?} 21 | 22 | -- 6. Formulate and prove t6 : (P || Q -> P && Q) -> (P -> Q) && (Q -> P) 23 | 24 | -- 7. Russell's paradox shows that there is no set of all sets. If such a set exists, then we can form the set `B` of sets which are not members of themselves. 25 | -- Then `B` belongs to itself if and only if it is not. 26 | -- This implies a contradiction. 27 | -- Cantor's theorem states that there is no set `X` with a surjection from `X` onto the set of subsets of `X`. 28 | -- Its proof also constructs a proposition which is true if and only if it is false. 29 | -- Prove that more generally the existence of any such proposition implies a contradiction. 30 | 31 | \func t7 {P : \Type} (f : P -> Not P) (g : Not P -> P) : Empty => {?} 32 | 33 | -- 8. Prove that if, for every x : Nat, P x is true, then there exists x : Nat such that P x is true. 34 | 35 | \func t8 (P : Nat -> \Type) (h : \Pi (x : Nat) -> P x) : \Sigma (x : Nat) (P x) => {?} 36 | 37 | -- 9. Prove that if there is no x : Nat such that P x holds, then P 3 is false. 38 | 39 | \func t9 (P : Nat -> \Type) (h : Not (\Sigma (x : Nat) (P x))) : Not (P 3) => {?} 40 | 41 | -- 10. Formulate and prove the following proposition: 42 | -- t10 : If, for every x : Nat, P x implies Q x, then the existence of an element x : Nat for which P x is true implies the existence of an element x : Nat for which Q x is true. 43 | 44 | -- 11. Formulate and prove the following proposition: 45 | -- t11 : If, for every x : Nat, either P x is false or Q x is false, then P 3 implies that Q 3 is false. 46 | 47 | -- 12. Prove associativity of `and` and `or`. 48 | 49 | \func \infixl 6 and (a b : Bool) : Bool \elim a, b 50 | | true, true => true 51 | | true, false => false 52 | | false, _ => false 53 | 54 | \func \infixl 4 or (a b : Bool) : Bool \elim a, b 55 | | true, _ => true 56 | | _, true => true 57 | | false, false => false 58 | 59 | \func and-assoc (x y z : Bool) : (x and y) and z = x and (y and z) => {?} 60 | 61 | \func or-assoc (x y z : Bool) : (x or y) or z = x or (y or z) => {?} 62 | 63 | -- 13. Prove that 2 * 2 equals to 4. 64 | 65 | -- 14. Prove associativity of ++. 66 | 67 | \data List (A : \Type) | nil | cons A (List A) 68 | 69 | \func \infixl 6 ++ {A : \Type} (xs ys : List A) : List A \elim xs 70 | | nil => ys 71 | | cons x xs => cons x (xs ++ ys) 72 | 73 | \func ++-assoc {A : \Type} (xs ys zs : List A) : (xs ++ ys) ++ zs = xs ++ (ys ++ zs) => {?} -------------------------------------------------------------------------------- /PartI/src/Exercises/RecordsEx.ard: -------------------------------------------------------------------------------- 1 | \import Records 2 | 3 | -- 1. Define the function 'swap' in several ways. 4 | 5 | -- Using \cowith and field access. 6 | \func swap {A B : \Type} (p : Pair A B) : Pair B A => {?} 7 | 8 | -- Using \new and pattern matching. 9 | \func swap' {A B : \Type} (p : Pair A B) : Pair B A => {?} 10 | 11 | -- Using \new and field access. 12 | \func swap'' {A B : \Type} (p : Pair A B) : Pair B A => {?} 13 | 14 | -- 2. Prove that 'swap (swap p) = p'. 15 | 16 | \func swap-involutive {A B : \Type} (p : Pair A B) : swap (swap p) = p => {?} 17 | 18 | -- 3. Prove that the type 'PosNat 0' is empty, but the type 'PosNat 1' is not. 19 | 20 | \data Empty 21 | 22 | \func zero-isNotPos (p : PosNat 0) : Empty => {?} 23 | 24 | \func one-isPos : PosNat 1 => {?} 25 | 26 | -- 4. Define the \record consisting of pairs of coprime natural numbers. 27 | -- Define the type of natural numbers that are coprime with 60. 28 | 29 | -- 5. Define the class of monads, which extends the class of functors. Define \instance of this class for 'Maybe'. 30 | 31 | \data Maybe (A : \Type) | nothing | just A 32 | 33 | -- 6. Define instances for the class of monads for 'State' and 'State''. 34 | 35 | \record State (S A : \Type) 36 | | state : S -> \Sigma S A 37 | 38 | \data State' (S A : \Type) 39 | | state' (S -> \Sigma S A) 40 | -------------------------------------------------------------------------------- /PartI/src/Exercises/UniversesEx.ard: -------------------------------------------------------------------------------- 1 | \import Universes 2 | 3 | -- 1. Calculate levels in each of the the invocations of 'id''' below. 4 | -- Specify explicitly result types for all idTest*. 5 | 6 | \func id'' {A : \Type} (a : A) => a 7 | 8 | \func idTest1 => id'' (id'' id) 9 | \func idTest2 => id'' Maybe 10 | \func idTest3 => id'' Functor 11 | \func idTest4 => id'' (Functor Maybe) 12 | \func idTest5 (f : \Pi {A B : \Set} -> (A -> B) -> Maybe A -> Maybe B) => id'' (Functor Maybe f) 13 | 14 | -- 2. Define 'div' via 'Nat-ind'. 15 | 16 | \func div (n k : Nat) (p : T (0 < k)) : Nat => {?} 17 | 18 | -- 3. Prove the following induction principle for lists: 19 | 20 | \func length {A : \Type} (xs : List A) : Nat 21 | | nil => 0 22 | | cons _ xs => suc (length xs) 23 | 24 | \func List-ind 25 | {A : \Type} 26 | (E : List A -> \Type) 27 | (r : \Pi (xs : List A) -> (\Pi (ys : List A) -> T (length ys < length xs) -> E ys) -> E xs) 28 | (xs : List A) : E xs => {?} 29 | 30 | -- 4. Implement function 'filter' and prove that it is correct, that is that the following holds: 31 | -- * 'filter p xs' is a sublist of 'xs' 32 | -- * All elements of 'filter p xs' satisfy the predicate 'p' 33 | -- * Any sublist of 'xs' with this property is a sublist of 'filter p xs' 34 | -------------------------------------------------------------------------------- /PartI/src/Indexed.ard: -------------------------------------------------------------------------------- 1 | ------------------------------------------------- 2 | -- Insertion sort and reverse 3 | ------------------------------------------------- 4 | 5 | \data Bool | false | true 6 | 7 | \data List (A : \Type) | nil | cons A (List A) 8 | 9 | \func if {A : \Type} (b : Bool) (t e : A) : A \elim b 10 | | true => t 11 | | false => e 12 | 13 | \func sort {A : \Type} (less : A -> A -> Bool) (xs : List A) : List A \elim xs 14 | | nil => nil 15 | | cons x xs => insert less x (sort less xs) 16 | \where 17 | \func insert {A : \Type} (less : A -> A -> Bool) (x : A) (xs : List A) : List A \elim xs 18 | | nil => cons x nil 19 | | cons x' xs => if (less x x') (cons x (cons x' xs)) (cons x' (insert less x xs)) 20 | 21 | \data Empty 22 | 23 | \data Unit | unit 24 | 25 | \func T (b : Bool) : \Type 26 | | true => Unit 27 | | false => Empty 28 | 29 | \func \infixl 6 && (a b : Bool) : Bool \elim a, b 30 | | true, true => true 31 | | true, false => false 32 | | false, _ => false 33 | 34 | \func isLinOrder {A : \Type} (lessOrEq : A -> A -> Bool) : \Type => {?} 35 | \func isSorted {A : \Type} (lessOrEq : A -> A -> Bool) (xs : List A) : \Type => {?} 36 | -- isPerm says that xs' is permutation of xs 37 | \func isPerm {A : \Type} (xs xs' : List A) : \Type => {?} 38 | \func sort-isCorrect {A : \Type} (lessOrEq : A -> A -> Bool) (p : isLinOrder lessOrEq) (xs : List A) 39 | : \Sigma (isSorted lessOrEq (sort lessOrEq xs)) (isPerm xs (sort lessOrEq xs)) => {?} 40 | 41 | \func reverse {A : \Type} (xs : List A) : List A => rev nil xs 42 | \where 43 | \func rev {A : \Type} (acc xs : List A) : List A \elim xs 44 | | nil => acc 45 | | cons x xs => rev (cons x acc) xs 46 | 47 | -- reverse (cons x xs) => rev nil (cons x xs) => rev (cons x nil) xs 48 | -- reverse (reverse (cons x xs)) => reverse (rev (cons x nil) xs) => rev nil (rev (cons x nil) xs) 49 | 50 | ------------------------------------------------- 51 | -- Examples of proofs: +-assoc and reverse-isInvolution 52 | ------------------------------------------------- 53 | 54 | \func reverse-isInvolutive {A : \Type} (xs : List A) : reverse (reverse xs) = xs => rev-isInv nil xs 55 | \where 56 | \func rev-isInv {A : \Type} (acc xs : List A) : reverse (reverse.rev acc xs) = reverse.rev xs acc \elim xs 57 | | nil => idp 58 | | cons x xs => rev-isInv (cons x acc) xs 59 | 60 | \func \infixl 6 + (x y : Nat) : Nat \elim y 61 | | 0 => x 62 | | suc y => suc (x + y) 63 | 64 | -- congruence, we'll give a definition later 65 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 66 | => {?} 67 | 68 | \func +-assoc (x y z : Nat) : (x + y) + z = x + (y + z) \elim z 69 | | 0 => idp 70 | | suc z => pmap suc (+-assoc x y z) 71 | -- we can apply pmap because of the reductions: 72 | -- (x + y) + suc z => suc ((x + y) + z) 73 | -- x + (y + suc z) => x + suc (y + z) => suc (x + (y + z)) 74 | 75 | ------------------------------------------------- 76 | -- Vectors of fixed length 77 | ------------------------------------------------- 78 | 79 | \func vec (A : \Type) (n : Nat) : \Type \elim n 80 | | 0 => \Sigma 81 | | suc n => \Sigma A (vec A n) 82 | 83 | \func head {A : \Type} (n : Nat) (xs : vec A (suc n)) => xs.1 84 | 85 | \func tail {A : \Type} (n : Nat) (xs : vec A (suc n)) => xs.2 86 | 87 | \data Vec (A : \Type) (n : Nat) \elim n 88 | | 0 => fnil 89 | | suc n => fcons A (Vec A n) 90 | 91 | \func Head {A : \Type} {n : Nat} (xs : Vec A (suc n)) : A \elim xs 92 | | fcons x _ => x 93 | 94 | \func Tail {A : \Type} {n : Nat} (xs : Vec A (suc n)) : Vec A n \elim xs 95 | | fcons _ xs => xs 96 | 97 | \data Maybe (A : \Type) | nothing | just A 98 | 99 | \func first {A : \Type} {n : Nat} (xs : Vec A n) : Maybe A \elim n, xs 100 | | 0, fnil => nothing 101 | | suc n, fcons x xs => just x 102 | 103 | \func append {A : \Type} {n m : Nat} (xs : Vec A n) (ys : Vec A m) : Vec A (m + n) \elim n, xs 104 | | 0, fnil => ys 105 | | suc _ , fcons x xs => fcons x (append xs ys) 106 | 107 | \func length {A : \Type} {n : Nat} (xs : Vec A n) => n 108 | 109 | ------------------------------------------------- 110 | -- Finite sets, lookup 111 | ------------------------------------------------- 112 | 113 | \func \infix 4 < (x y : Nat) : Bool 114 | | 0, 0 => false 115 | | 0, suc y => true 116 | | suc x, 0 => false 117 | | suc x, suc y => x < y 118 | 119 | \func fin (n : Nat) => \Sigma (x : Nat) (T (x < n)) 120 | 121 | \func Fin' (n : Nat) : \Set0 122 | | 0 => Empty 123 | | suc n => Maybe (Fin' n) 124 | 125 | \data Fin (n : Nat) \with 126 | | suc n => { fzero | fsuc (Fin n) } 127 | 128 | -- Fin 0 -- empty type 129 | \func absurd {A : \Type} (x : Fin 0) : A 130 | 131 | \func fin0 : Fin 3 => fzero 132 | \func fin1 : Fin 3 => fsuc fzero 133 | \func fin2 : Fin 3 => fsuc (fsuc fzero) 134 | -- The following does not typecheck 135 | -- \func fin3 : Fin 3 => fsuc (fsuc (fsuc fzero)) 136 | 137 | \data \fixr 2 Either (A B : \Type) 138 | | inl A 139 | | inr B 140 | 141 | \func atMost3 (x : Fin 3) : Either (x = fin0) (Either (x = fin1) (x = fin2)) \elim x 142 | | fzero => inl idp 143 | | fsuc fzero => inr (inl idp) 144 | | fsuc (fsuc fzero) => inr (inr idp) 145 | | fsuc (fsuc (fsuc ())) 146 | 147 | \func toNat {n : Nat} (x : Fin n) : Nat 148 | | {suc _}, fzero => 0 149 | | {suc _}, fsuc x => suc (toNat x) 150 | 151 | \func lookup {A : \Type} {n : Nat} (xs : Vec A n) (i : Fin n) : A \elim n, xs, i 152 | | suc _, fcons x _, fzero => x 153 | | suc _, fcons _ xs, fsuc i => lookup xs i 154 | -------------------------------------------------------------------------------- /PartI/src/Proofs.ard: -------------------------------------------------------------------------------- 1 | ------------------------------------------------- 2 | -- Curry-Howard correspondence 3 | ------------------------------------------------- 4 | 5 | \data Empty 6 | 7 | \data Unit | unit 8 | 9 | \func absurd {A : \Type} (e : Empty) : A 10 | -- There are no patterns since Empty does not have constructors. 11 | 12 | -- This can be expressed more explicitly by means of the absurd patterns. 13 | -- This pattern indicates that the data type of the corresponding variable does not have constructors. 14 | -- If such a pattern is used, the right hand side of the clause can (and should) be omitted. 15 | \func absurd' {A : \Type} (e : Empty) : A \elim e 16 | | () -- absurd pattern 17 | 18 | \func Unit-isTrue : Unit => unit 19 | 20 | \func \infixr 3 && (P Q : \Type) => \Sigma P Q 21 | 22 | -- This function proves that P -> Q -> (P & Q) 23 | \func &&-intro {P Q : \Type} (p : P) (q : Q) : \Sigma P Q => (p, q) 24 | 25 | -- This function proves that (P & Q) -> P 26 | \func &&-elim1 {P Q : \Type} (t : \Sigma P Q) : P => t.1 27 | 28 | -- This function proves that (P & Q) -> Q 29 | \func &&-elim2 {P Q : \Type} (t : \Sigma P Q) : Q => t.2 30 | 31 | \data \infixr 2 || (P Q : \Type) 32 | | inl P 33 | | inr Q 34 | 35 | -- This function proves that P -> (P || Q) 36 | \func ||-intro1 {P Q : \Type} (p : P) : P || Q => inl p 37 | 38 | -- This function proves that Q -> (P || Q) 39 | \func ||-intro2 {P Q : \Type} (q : Q) : P || Q => inr q 40 | 41 | -- This function proves that (P -> R) -> (Q -> R) -> (P || Q) -> R 42 | \func ||-elim {P Q R : \Type} (l : P -> R) (r : Q -> R) (x : P || Q) : R \elim x 43 | | inl p => l p 44 | | inr q => r q 45 | 46 | \func Not (A : \Type) => A -> Empty 47 | 48 | ------------------------------------------------- 49 | -- Examples of propositions and proofs 50 | ------------------------------------------------- 51 | 52 | \data Bool | true | false 53 | 54 | \func T (b : Bool) : \Type 55 | | true => Unit 56 | | false => Empty 57 | 58 | \func \infix 4 == (x y : Bool) : Bool 59 | | true, true => true 60 | | false, false => true 61 | | _ , _ => false 62 | 63 | \func not (x : Bool) : Bool 64 | | true => false 65 | | false => true 66 | 67 | \func not-isInvolution (x : Bool) : T (not (not x) == x) 68 | | true => unit -- if x is true, then T (not (not true) == true) evaluates to Unit 69 | | false => unit -- if x is false, then T (not (not false) == false) again evaluates to Unit 70 | 71 | -- proof of reflexivity of == is analogous 72 | \func ==-refl (x : Bool) : T (x == x) 73 | | true => unit 74 | | false => unit 75 | 76 | -- This code doe not typecheck! 77 | -- \func not-isInvolution' (x : Bool) : T (not (not x) == x) => unit 78 | 79 | \func not-isIdempotent (x : Bool) : T (not (not x) == not x) 80 | | true => {?} -- goal expression, an element of Empty is expected 81 | | false => {?} -- goal expression, an element of Empty is expected 82 | 83 | -- we can prove negation of not-isIdempoten 84 | \func not-isIdempotent' (x : Bool) : T (not (not x) == not x) -> Empty 85 | | true => \lam x => x -- a proof of Empty -> Empty 86 | | false => \lam x => x -- again a proof of Empty -> Empty 87 | 88 | -- Sigma-types are used to express existential quantification 89 | \func lemma (x : Bool) : \Sigma (y : Bool) (T (x == y)) => (x, ==-refl x) 90 | 91 | \func higherOrderFunc (f : \Pi (x : Bool) -> T (x == x)) : T (true == true) => f true 92 | 93 | ------------------------------------------------- 94 | -- Identity type 95 | ------------------------------------------------- 96 | 97 | \func not-isInvolution'' (x : Bool) : not (not x) = x 98 | | true => idp 99 | | false => idp 100 | 101 | \func not-isIdempotent'' (x : Bool) : not (not x) = not x 102 | | true => {?} -- goal expression, non-existing proof of true = false is expected 103 | | false => {?} -- goal expression, non-existing proof of false = true is expected 104 | -------------------------------------------------------------------------------- /PartI/src/Records.ard: -------------------------------------------------------------------------------- 1 | ------------------------------------------------- 2 | -- Records: \new, \cowith, projections, pattern matching 3 | ------------------------------------------------- 4 | 5 | \data NatPair | natPair Nat Nat 6 | 7 | \func natFst (p : NatPair) : Nat 8 | | natPair x _ => x 9 | 10 | \func natSnd (p : NatPair) : Nat 11 | | natPair _ y => y 12 | 13 | \record NatPair' 14 | | fst : Nat 15 | | snd : Nat 16 | 17 | -- fst : \Pi {x : NatPair'} -> Nat 18 | \func foo (p : NatPair') => fst {p} 19 | 20 | \func foo' (p : NatPair') => NatPair'.fst {p} 21 | 22 | \func bar (p : NatPair') => p.snd 23 | 24 | -- (f x).snd -- This is not allowed. It can be replaced with one of the following variants: 25 | -- \let e : NatPair' => f x \in e.snd 26 | -- snd {f x} 27 | 28 | -- This code will not typecheck since the type of p is not specified explicitly 29 | -- \func baz {p p' : NatPair'} (q : p = p') => pmap (\lam p => p.fst) q 30 | 31 | \func zeroPair => \new NatPair' { 32 | | fst => 0 33 | | snd => 0 34 | } 35 | 36 | \func etaNatPair' (p : NatPair') : p = \new NatPair' { | fst => p.fst | snd => p.snd } 37 | => idp 38 | 39 | \func \infixl 6 + (x y : Nat) : Nat \elim y 40 | | 0 => x 41 | | suc y => suc (x + y) 42 | 43 | \func sum (p : NatPair') => fst {p} + p.snd 44 | 45 | \func sum' (p : NatPair') : Nat 46 | | (a, b) => a + b 47 | 48 | -- This function is equivalent to zeroPair defined above. 49 | -- \cowith is followed with a set of clauses, each starting 50 | -- with | and specifying a field and its value 51 | \func zeroPair' : NatPair' \cowith 52 | | fst => 0 53 | | snd => 0 54 | 55 | ------------------------------------------------- 56 | -- Partial implementation 57 | ------------------------------------------------- 58 | 59 | \func PartialEx : \Type => NatPair' { | fst => 0 } 60 | 61 | \func ppp : NatPair' { | fst => 0 } => \new NatPair' { | snd => 1 } 62 | 63 | 64 | \func partial (p : NatPair' { | fst => 0 | snd => 1 }) : PartialEx => p 65 | 66 | \func PartialEx' => NatPair' { | fst => 3 | snd => 7 } 67 | 68 | \func new => \new PartialEx' 69 | 70 | ------------------------------------------------- 71 | -- Parameters visibility of fields 72 | ------------------------------------------------- 73 | 74 | \record Pair (A B : \Type) 75 | | fst' : A 76 | | snd' : B 77 | 78 | \func pairExample : Pair Nat (Nat -> Nat) 79 | => \new Pair { | fst' => 1 | snd' (x : Nat) => x } 80 | 81 | \func pairExample' 82 | => \new Pair { | A => Nat | B => Nat -> Nat | fst' => 1 | snd' (x : Nat) => x } 83 | 84 | \func pairExample'' 85 | => \new Pair Nat (Nat -> Nat) 1 (\lam (x : Nat) => x) 86 | 87 | \record NatPair'' (fst'' snd'' : Nat) 88 | 89 | \func natPair''ex => \new NatPair'' { 90 | | fst'' => 0 91 | | snd'' => 0 92 | } 93 | 94 | \record Pair'' 95 | | A : \Type 96 | | B : \Type 97 | | fst'' : A 98 | | snd'' : B 99 | 100 | ------------------------------------------------- 101 | -- Dependent records, a type of positive natural numbers 102 | ------------------------------------------------- 103 | 104 | \data Bool | true | false 105 | 106 | -- compare this definition of T with the one in module Basics 107 | \data T (b : Bool) \with 108 | | true => tt 109 | 110 | \func isPos (n : Nat) : Bool 111 | | 0 => false 112 | | suc _ => true 113 | 114 | \record PosNat (n : Nat) (p : T (isPos n)) 115 | 116 | ------------------------------------------------- 117 | -- Monoid 118 | ------------------------------------------------- 119 | 120 | \class Monoid (A : \Type) 121 | | ide : A 122 | | \infixl 7 * : A -> A -> A 123 | | *-assoc (x y z : A) : (x * y) * z = x * (y * z) 124 | -- | *-assoc : \Pi (x y z : A) -> (x * y) * z = x * (y * z) 125 | | ide-left (x : A) : ide * x = x 126 | | ide-right (x : A) : x * ide = x 127 | 128 | \func baz (m : Monoid Nat 0 (Nat.+)) => m.*-assoc 129 | 130 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 131 | => coe (\lam i => B (p @ i)) b right 132 | 133 | \func \infixr 5 *> {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 134 | => transport (\lam x => a = x) q p 135 | 136 | \class CommMonoid \extends Monoid 137 | | *-comm (x y : A) : x * y = y * x 138 | | ide-right x => *-comm x ide *> ide-left x 139 | -- ide-right follows from id-left for commutative monoids 140 | 141 | ------------------------------------------------- 142 | -- Classes, instances 143 | ------------------------------------------------- 144 | 145 | \instance +-NatMonoid : Monoid Nat 146 | | ide => 0 147 | | * => Nat.+ 148 | | *-assoc => {?} 149 | | ide-left => {?} 150 | | ide-right => {?} 151 | 152 | \instance *-NatMonoid : Monoid Nat 153 | | ide => 1 154 | | * => Nat.* 155 | | *-assoc => {?} 156 | | ide-left => {?} 157 | | ide-right => {?} 158 | 159 | -- alternative definition of the latter: 160 | \instance *-NatMonoid' : Monoid Nat 1 (Nat.*) {?} {?} {?} 161 | 162 | -- ok, +-NatMonoid is inferred since it was declared the first 163 | -- id-left x here is equivalent to id-left {+-NatMonoid} x 164 | \func +-test (x : Nat) : 0 Nat.+ x = x => ide-left x 165 | -- error, because +-NatMonoid is inferred, not *-NatMoniod 166 | -- \func *-test (x : Nat) : 1 Nat.* x = x => id-left x 167 | 168 | \func instEx => +-NatMonoid.ide-left 169 | 170 | \func instExF (M : Monoid) => M.ide 171 | 172 | \func instEx' => instExF +-NatMonoid 173 | 174 | \class Eq (A : \Type) 175 | | \infix 3 == (x y : A) : Bool 176 | 177 | -- function refl from Haskell can be defined in two ways 178 | -- refl :: Eq a => a -> Bool 179 | -- refl x = x == x 180 | \func refl {A : \Type} {e : Eq A} (a : A) => a == a 181 | 182 | \func refl' {E : Eq} (a : E) => a == a 183 | 184 | -- \func xxxx => refl 1 185 | 186 | ------------------------------------------------- 187 | -- Coercions 188 | ------------------------------------------------- 189 | 190 | \func CF-coerce (M : Monoid) (x : M) => x 191 | 192 | \data XXX | con 193 | 194 | \data YYY | con' XXX Nat | con'' 195 | \where { 196 | -- We can define coercions TO this type. 197 | -- The return type of the function must be YYY. 198 | \use \coerce fromXXX (x : XXX) => con' x 0 199 | 200 | -- We can also define coercions FROM this type. 201 | -- The type of the last parameter of the function must 202 | -- be YYY. 203 | \use \coerce toXXX (y : YYY) => con 204 | } 205 | 206 | \func fff (y : YYY) => y 207 | 208 | -- Elements of type XXX are implicitly converted to type YYY by function fromXXX. 209 | \func ggg => fff con 210 | 211 | -- Implicit convertion from Nat to Int is done in this way: 212 | \func hhh : Int => 0 213 | 214 | ------------------------------------------------- 215 | -- Extensions, diamond problem 216 | ------------------------------------------------- 217 | 218 | \record Base (A : \Type) 219 | 220 | \record Base' (A : \Type) 221 | 222 | \record X \extends Base 223 | | a : A 224 | 225 | \record Y \extends Base' 226 | | b : A 227 | 228 | \record Z \extends X, Y 229 | 230 | \func zzz => \new Z { 231 | | A => {?} 232 | | a => {?} 233 | | Base'.A => {?} 234 | | b => {?} 235 | } 236 | 237 | \func zzzz (z : Z) => Base'.A {z} 238 | 239 | \record X' \extends Base 240 | | aa : A 241 | 242 | \record Y' \extends Base 243 | | bb : A 244 | 245 | -- Z' has three fields: aa, bb, A 246 | \record Z' \extends X', Y' 247 | 248 | \class CommMonoid' \extends Monoid { 249 | | comm (x y : A) : x * y = y * x 250 | | ide-right x => comm x ide *> ide-left x 251 | } 252 | 253 | \class AbGroup \extends CommMonoid' { 254 | | inverse : A -> A 255 | | inv-left (x : A) : inverse x * x = ide 256 | | inv-right (x : A) : x * inverse x = ide 257 | } 258 | 259 | -- We omit distributivity 260 | \class Ring \extends AbGroup 261 | | mulMonoid : Monoid A 262 | 263 | -- This is not a correct way to define the class Ring: 264 | -- the structures of addition and multiplication coincide. 265 | -- \class Ring \extends AbGroup, Monoid' 266 | 267 | -- This class does not extend Monoid 268 | \class AbGroup' (A : \Type) { 269 | -- Here all the fields of Monoid, CommMonoid and AbGroup 270 | -- should be repeated 271 | } 272 | 273 | \class Ring' \extends AbGroup', Monoid 274 | | Monoid.A => AbGroup'.A -- make sure that classifying fields coincide 275 | 276 | ------------------------------------------------- 277 | -- Classes without classifying fields 278 | ------------------------------------------------- 279 | 280 | -- Implementations are omitted 281 | 282 | \func isInj {A B : \Type} (f : A -> B) : \Type => {?} 283 | 284 | \func isSur {A B : \Type} (f : A -> B) : \Type => {?} 285 | 286 | \func isBij {A B : \Type} (f : A -> B) : \Type => {?} 287 | 288 | \func IsInj+isSur=>isBij {A B : \Type} (f : A -> B) (p : isInj f) (q : isInj f) : isBij f => {?} 289 | 290 | \func IsBij=>isInj {A B : \Type} (f : A -> B) (p : isBij f) : isInj f => {?} 291 | 292 | \func IsBij=>isSur {A B : \Type} (f : A -> B) (p : isBij f) : isSur f => {?} 293 | 294 | \class Map \noclassifying {A B : \Type} (f : A -> B) { 295 | \func isInj : \Type => {?} 296 | 297 | \func isSur : \Type => {?} 298 | 299 | \func isBij : \Type => {?} 300 | 301 | \func isInj+isSur=>isBij (p : isInj) (q : isInj) : isBij => {?} 302 | 303 | \func isBij=>isInj (p : isBij) : isInj => {?} 304 | 305 | \func isBij=>isSur (p : isBij) : isSur => {?} 306 | } 307 | 308 | \func isInj+isSur<=>isBij (m : Map) : \Sigma (isBij -> \Sigma isInj isSur) (\Sigma isInj isSur -> isBij) 309 | => ((\lam p => (isBij=>isInj p, isBij=>isInj p)), (\lam p => isInj+isSur=>isBij p.1 p.2)) 310 | \where \open Map 311 | 312 | \func id-isInj {A : \Type} : Map.isInj {\new Map (\lam (a : A) => a)} => {?} 313 | 314 | \class Endo \extends Map { 315 | | B => A 316 | 317 | \func isIdem => \Pi (x : A) -> f (f x) = f x 318 | 319 | \func isInv => \Pi (x : A) -> f (f x) = x 320 | 321 | \func isIdem+isInv=>id (p : isIdem) (q : isInv) : f = (\lam x => x) => {?} 322 | } 323 | 324 | ------------------------------------------------- 325 | -- Functor 326 | ------------------------------------------------- 327 | 328 | \class Functor (F : \Type -> \Type) 329 | | fmap {A B : \Type} (f : A -> B) : F A -> F B 330 | | fmap-id {A : \Type} (y : F A) : fmap (\lam (x : A) => x) y = y 331 | | fmap-comp {A B C : \Type} (f : A -> B) (g : B -> C) (y : F A) 332 | : fmap (\lam x => g (f x)) y = fmap g (fmap f y) 333 | -------------------------------------------------------------------------------- /PartI/src/Universes.ard: -------------------------------------------------------------------------------- 1 | 2 | ------------------------------------------------- 3 | -- Hierarchies of universes, polymorphism 4 | ------------------------------------------------- 5 | 6 | \func tt : \Type2 => \Type0 -> \Type1 7 | 8 | \func id (A : \Type) (a : A) => a 9 | 10 | \func id' (A : \Type \lp) (a : A) => a 11 | 12 | \func type : \Type => \Type 13 | 14 | \func type' : \Type (\suc \lp) => \Type \lp 15 | 16 | \func test0 : \Type (\max (\suc (\suc \lp)) 4) => \Type (\max \lp 3) -> \Type (\suc \lp) 17 | 18 | \func test1 => id Nat 0 19 | \func test2 => id \Type0 Nat 20 | \func test3 => id (\Type0 -> \Type1) (\lam X => X) 21 | \func test4 => id _ id 22 | \func test4' => id (\Pi (A : \Type) -> A -> A) id 23 | 24 | \func test5 => id (\suc \lp) (\Type \lp) Nat 25 | 26 | \func test5' => id (\levels (\suc \lp) _) (\Type \lp) Nat 27 | \func test6 => id (\levels 2 _) \Type1 \Type0 28 | 29 | \data Magma (A : \Type) 30 | | con (A -> A -> A) 31 | 32 | \data MagmaEx (A : \Type) (B : \Type5) 33 | | conEx (A -> A -> A) 34 | 35 | \func test7 : \Type \lp => MagmaEx \lp Nat \Type4 36 | 37 | \class Magma' (A : \Type) 38 | | \infixl 6 ** : A -> A -> A 39 | 40 | \func test8 : \Type (\suc \lp) => Magma' \lp 41 | 42 | \func test9 : \Type \lp => Magma' \lp Nat 43 | 44 | \class Functor (F : \Set -> \Set) 45 | | fmap {A B : \Set} : (A -> B) -> F A -> F B 46 | 47 | \data Maybe (A : \Type) | nothing | just A 48 | 49 | \func test10 : \Type (\suc \lp) => Functor \lp Maybe 50 | 51 | ------------------------------------------------- 52 | -- Induction principles 53 | ------------------------------------------------- 54 | \data Empty 55 | 56 | \data Unit | unit 57 | 58 | \data Bool | false | true 59 | 60 | \func T (b : Bool) : \Type 61 | | true => Unit 62 | | false => Empty 63 | 64 | \func \infix 4 < (x y : Nat) : Bool 65 | | 0, 0 => false 66 | | 0, suc y => true 67 | | suc x, 0 => false 68 | | suc x, suc y => x < y 69 | 70 | \func Nat-ind (E : Nat -> \Type) 71 | (r : \Pi (n : Nat) -> (\Pi (k : Nat) -> T (k < n) -> E k) -> E n) 72 | (n : Nat) : E n => {?} -- prove this as an exercise 73 | 74 | ------------------------------------------------- 75 | -- Induction-recusrion 76 | ------------------------------------------------- 77 | 78 | \func isEven (n : Nat) : Bool 79 | | 0 => true 80 | | suc n => isOdd n 81 | 82 | \func isOdd (n : Nat) : Bool 83 | | 0 => false 84 | | suc n => isEven n 85 | 86 | \data IsEven (n : Nat) : \Type \with 87 | | 0 => zero-isEven 88 | | suc n => suc-isEven (IsOdd n) 89 | 90 | \data IsOdd (n : Nat) : \Type \with 91 | | suc n => suc-isOdd (IsEven n) 92 | 93 | ------------------------------------------------- 94 | -- Universes via induction-recusrion 95 | ------------------------------------------------- 96 | 97 | \data Type 98 | | nat 99 | | list Type 100 | | arr Type Type 101 | 102 | \data List (A : \Type) | nil | cons A (List A) 103 | 104 | \func El (t : Type) : \Set0 \elim t -- \Set0 is almost the same as \Type0, we will discuss the difference later 105 | | nat => Nat 106 | | list t => List (El t) 107 | | arr t1 t2 => El t1 -> El t2 108 | 109 | \func idc (t : Type) (x : El t) : El t => x 110 | 111 | \data Type' : \Set0 112 | | nat' 113 | | list' Type' 114 | | pi' (a : Type') (El' a -> Type') 115 | 116 | \func El' (t : Type') : \Set0 \elim t 117 | | nat' => Nat 118 | | list' t => List (El' t) 119 | | pi' t1 t2 => \Pi (a : El' t1) -> El' (t2 a) 120 | 121 | ------------------------------------------------- 122 | -- Completeness of specifications 123 | ------------------------------------------------- 124 | 125 | \func \infixl 6 + (x y : Nat) : Nat \elim y 126 | | 0 => x 127 | | suc y => suc (x + y) 128 | 129 | \func \infixl 7 * (x y : Nat) : Nat \elim y 130 | | 0 => 0 131 | | suc y => x * y + x 132 | 133 | -- P1 is correct specification for 'fac', but incomplete. 134 | \func P1 (f : Nat -> Nat) => f 3 = 6 135 | -- P2 is complete, but not correct. 136 | \func P2 (f : Nat -> Nat) => Empty 137 | -- P3 -- correct and complete specification for 'fac'. 138 | \func P3 (f : Nat -> Nat) => \Sigma (f 0 = 1) (\Pi (n : Nat) -> f (suc n) = suc n * f n) 139 | 140 | \func isSorted {A : \Type} (x : List A) : \Type => {?} 141 | \func isPerm {A : \Type} (x y : List A) : \Type => {?} 142 | 143 | \func P {A : \Type} (f : List A -> List A) => \Pi (xs : List A) -> \Sigma (isSorted (f xs)) (isPerm (f xs) xs) 144 | -- where 'isSorted xs' is true iff 'xs' is sorted and 145 | -- 'isPerm xs ys' is true iff 'xs' is a permutation of 'ys'. 146 | -------------------------------------------------------------------------------- /PartI/src/index.ard: -------------------------------------------------------------------------------- 1 | -- This file indicates the reading order of the other Arend modules 2 | 3 | -- Basic functional programming 4 | \import Basics () 5 | 6 | -- Basic theorem proving 7 | \import Proofs () 8 | 9 | -- Indexed data families 10 | \import Indexed () 11 | 12 | -- The path type 13 | \import Equality () 14 | 15 | -- Proofs of paths 16 | \import EqualityProofs () 17 | 18 | -- Classes and records 19 | \import Records () 20 | 21 | -- Case expressions 22 | \import Case () 23 | 24 | -- The universe type 25 | \import Universes () 26 | 27 | -- The insertion sort implementation 28 | \import sort () 29 | -------------------------------------------------------------------------------- /PartI/src/sort.ard: -------------------------------------------------------------------------------- 1 | \data List (A : \Type) | nil | cons A (List A) 2 | 3 | \data Either (A B : \Type) | inl A | inr B 4 | 5 | \class Preorder (E : \Type) 6 | | \infix 4 <= : E -> E -> \Type 7 | | <=-refl {x : E} : x <= x 8 | | <=-trans {x y z : E} : x <= y -> y <= z -> x <= z 9 | 10 | \class TotalPreorder \extends Preorder 11 | | totality (x y : E) : Either (x <= y) (y <= x) 12 | 13 | \func sort {A : TotalPreorder} (xs : List A) : List A 14 | | nil => nil 15 | | cons a xs => insert a (sort xs) 16 | \where 17 | \func insert {A : TotalPreorder} (a : A) (xs : List A) : List A \elim xs 18 | | nil => cons a nil 19 | | cons x xs => \case totality x a \with { 20 | | inl _ => cons x (insert a xs) 21 | | inr _ => cons a (cons x xs) 22 | } 23 | 24 | \data Perm {A : \Type} (xs ys : List A) \elim xs, ys 25 | | nil, nil => perm-nil 26 | | cons x xs, cons y ys => perm-cons (x = y) (Perm xs ys) 27 | | xs, ys => perm-trans {zs : List A} (Perm xs zs) (Perm zs ys) 28 | | cons x (cons x' xs), cons y (cons y' ys) => perm-perm (x = y') (x' = y) (xs = ys) 29 | 30 | \func perm-refl {A : \Type} {xs : List A} : Perm xs xs \elim xs 31 | | nil => perm-nil 32 | | cons a l => perm-cons idp perm-refl 33 | 34 | \func sort-perm {A : TotalPreorder} (xs : List A) : Perm xs (sort xs) \elim xs 35 | | nil => perm-nil 36 | | cons a l => perm-trans (perm-cons idp (sort-perm l)) (insert-perm a (sort l)) 37 | \where 38 | \func insert-perm {A : TotalPreorder} (a : A) (xs : List A) : Perm (cons a xs) (sort.insert a xs) \elim xs 39 | | nil => perm-cons idp perm-nil 40 | | cons b l => \case totality b a \as r \return 41 | Perm (cons a (cons b l)) (\case r \with { 42 | | inl _ => cons b (sort.insert a l) 43 | | inr _ => cons a (cons b l) 44 | }) \with { 45 | | inl b<=a => perm-trans (perm-perm idp idp idp) (perm-cons idp (insert-perm a l)) 46 | | inr a<=b => perm-refl 47 | } 48 | 49 | \func head {A : \Type} (def : A) (xs : List A) : A \elim xs 50 | | nil => def 51 | | cons a _ => a 52 | 53 | \data IsSorted {A : Preorder} (xs : List A) \elim xs 54 | | nil => nil-sorted 55 | | cons x xs => cons-sorted (x <= head x xs) (IsSorted xs) 56 | 57 | \func sort-sorted {A : TotalPreorder} (xs : List A) : IsSorted (sort xs) \elim xs 58 | | nil => nil-sorted 59 | | cons a l => insert-sorted a (sort-sorted l) 60 | \where { 61 | \func insert-lem {A : TotalPreorder} (a x : A) (l : List A) (a<=x : a <= x) (a<=l : a <= head a l) : a <= head a (sort.insert x l) \elim l 62 | | nil => a<=x 63 | | cons b l => \case totality b x \as r \return 64 | a <= head a (\case r \with { 65 | | inl _ => cons b (sort.insert x l) 66 | | inr _ => cons x (cons b l) 67 | }) \with { 68 | | inl _ => a<=l 69 | | inr _ => a<=x 70 | } 71 | 72 | \func insert-sorted {A : TotalPreorder} (x : A) {xs : List A} (xs-sorted : IsSorted xs) : IsSorted (sort.insert x xs) \elim xs 73 | | nil => cons-sorted <=-refl nil-sorted 74 | | cons a l => \case totality a x \as r \return 75 | IsSorted (\case r \with { 76 | | inl _ => cons a (sort.insert x l) 77 | | inr _ => cons x (cons a l) 78 | }) \with { 79 | | inl a<=x => \case xs-sorted \with { 80 | | cons-sorted a<=l l-sorted => cons-sorted (insert-lem a x l a<=x a<=l) (insert-sorted x l-sorted) 81 | } 82 | | inr x<=a => cons-sorted x<=a xs-sorted 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /PartII/PartII.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /PartII/arend.yaml: -------------------------------------------------------------------------------- 1 | sourcesDir: src 2 | binariesDir: .bin 3 | -------------------------------------------------------------------------------- /PartII/src/Exercises/HomUniversesEx.ard: -------------------------------------------------------------------------------- 1 | \data Bool | false | true 2 | 3 | \data Empty 4 | 5 | \data List (A : \Type) | nil | cons A (List A) 6 | 7 | \func T (b : Bool) : \Type 8 | | true => \Sigma 9 | | false => Empty 10 | 11 | \func isProp (A : \Type) => \Pi (x y : A) -> x = y 12 | 13 | \func isSet (A : \Type) => \Pi (a a' : A) -> isProp (a = a') 14 | 15 | \truncated \data \fixr 2 Or (A B : \Type) : \Prop 16 | | inl A 17 | | inr B 18 | 19 | \truncated \data Trunc (A : \Type) : \Prop 20 | | trunc A 21 | 22 | \func hasLevel (A : \Type) (suc-l : Nat) : \Type \elim suc-l 23 | | 0 => isProp A 24 | | suc suc-l => \Pi (x y : A) -> (x = y) `hasLevel` suc-l 25 | 26 | -- 1. The type 'Dec A' below is by default placed in '\Set0'. Place it in '\Prop' be means of '\use \level'. 27 | 28 | \data Dec (A : \Prop) 29 | | yes A 30 | | no (A -> Empty) 31 | 32 | -- \func testDec : \Prop -> \Prop => Dec 33 | 34 | -- 2. Prove that if 'A : \Prop', then 'Trunc A' is equivalent to 'A'. 35 | 36 | \func \infix 1 <-> (A B : \Type) => \Sigma (A -> B) (B -> A) 37 | 38 | \func trunc-prop {A : \Prop} : Trunc A <-> A => {?} 39 | 40 | -- 3. Prove the following de Morgan's law: 41 | 42 | \func deMorgan (A B C : \Prop) : (\Sigma A (B `Or` C)) <-> ((\Sigma A B) `Or` (\Sigma A C)) => {?} 43 | 44 | -- 4. Define eliminator for 'Or' via 'Or-rec' not using pattern matching on 'Or'. 45 | 46 | \func Or-elim {A B : \Prop} (C : Or A B -> \Prop) 47 | (f : \Pi (x : A) -> C (inl x)) (g : \Pi (y : B) -> C (inr y)) 48 | (p : A `Or` B) : C p => {?} 49 | 50 | -- 5. A type 'С' is called cogenerator if for every sets 'A' and 'B' and all functions 'f,g : A -> B' 51 | -- whenever h `o` f = h `o` g holds for all 'h : B -> C', then 'f = g'. 52 | -- Prove that '\Prop' is cogenerator. 53 | 54 | \func \fixr 9 o {A B C : \Type} (g : B -> C) (f : A -> B) => \lam a => g (f a) 55 | 56 | \func isCogenerator (C : \Type) => \Pi {A B : \Set} (f g : A -> B) (p : \Pi (h : B -> C) -> h `o` f = h `o` g) -> f = g 57 | 58 | \func PropIsCogenerator : isCogenerator \Prop => {?} 59 | 60 | -- 6. Prove that '\Prop' is a set. 61 | 62 | \func prop-isSet : isSet \Prop => {?} 63 | 64 | -- 7. Prove that (Bool = Bool) = Bool. 65 | 66 | \func BoolAut : (Bool = Bool) = Bool => {?} 67 | 68 | -- 8. Prove that (n+m)-element set is a disjoint union of n- and m-element sets. 69 | 70 | -- 9. We say that a type 'X' is injective if for any function 'f : A -> X' and any injection 'i : A -> B' 71 | -- there exists a function 'l : B -> X' such that l `o` i = f. 72 | -- Prove that '\Prop' is injective. 73 | 74 | \func isInj {A B : \Type} (f : A -> B) => \Pi (x y : A) -> f x = f y -> x = y 75 | 76 | \func isInjective (X : \Type) => \Pi {A B : \Type} (f : A -> X) (i : A -> B) (p : isInj i) -> \Sigma (l : B -> X) (l `o` i = f) 77 | 78 | \func Prop-isInjective : isInjective \Prop => {?} 79 | -------------------------------------------------------------------------------- /PartII/src/Exercises/PropsSetsEx.ard: -------------------------------------------------------------------------------- 1 | \data Bool | false | true 2 | 3 | \data Empty 4 | 5 | \data List (A : \Type) | nil | cons A (List A) 6 | 7 | \func T (b : Bool) : \Type 8 | | true => \Sigma 9 | | false => Empty 10 | 11 | \func isInj {A B : \Type} (f : A -> B) => 12 | \Pi (x y : A) -> f x = f y -> x = y 13 | 14 | \func isProp (A : \Type) => \Pi (x y : A) -> x = y 15 | 16 | \func isSet (A : \Type) => \Pi (a a' : A) -> isProp (a = a') 17 | 18 | \data \fixr 2 Either (A B : \Type) 19 | | inl A 20 | | inr B 21 | 22 | \data Decide (A : \Type) 23 | | yes A 24 | | no (A -> Empty) 25 | 26 | \func hasLevel (A : \Type) (suc-l : Nat) : \Type \elim suc-l 27 | | 0 => isProp A 28 | | suc suc-l => \Pi (x y : A) -> (x = y) `hasLevel` suc-l 29 | 30 | -- 1. Let f : A -> B and g : B -> C be some functions. 31 | -- Prove that if 'f' and 'g' are injective, then g `o` f is also injective. 32 | -- Prove that if g `o` f is injective, then 'f' is also injective. 33 | 34 | -- Composition of functions 35 | \func \fixr 9 o {A B C : \Type} (g : B -> C) (f : A -> B) => \lam a => g (f a) 36 | 37 | \func o-inj {A B C : \Type} (f : A -> B) (g : B -> C) (p : isInj f) (q : isInj g) : isInj (g `o` f) => {?} 38 | 39 | \func o-inj' {A B C : \Type} (f : A -> B) (g : B -> C) (p : isInj (g `o` f)) : isInj f => {?} 40 | 41 | -- 2. Define the predicate "divisible by 3 or by 5" in such a way that it is a proposition. 42 | -- Prove that 'MultipleOf3Or5' embeds in ℕ. 43 | 44 | \func isMultipleOf3Or5 (n : Nat) : \Type => {?} 45 | 46 | \func isMultipleOf3Or5-isProp (n : Nat) : isProp (isMultipleOf3Or5 n) => {?} 47 | 48 | \func MultipleOf3Or5 => \Sigma (n : Nat) (isMultipleOf3Or5 n) 49 | 50 | \func Mul-inc (m : MultipleOf3Or5) => m.1 51 | 52 | \func Mul-inc-isInj : isInj Mul-inc => {?} 53 | 54 | -- 3. We say that a type 'A' is trivial if there exists an element in 'A' such that it is equal to 55 | -- any other element in 'A'. 56 | -- Prove that 'A' is trivial iff 'A' is proposition and 'A' is inhabited. 57 | 58 | \func isTriv (A : \Type) => \Sigma (a : A) (\Pi (a' : A) -> a = a') 59 | 60 | \func \infix 1 <-> (A B : \Type) => \Sigma (A -> B) (B -> A) 61 | 62 | \func isTriv-lem (A : \Type) : isTriv A <-> (\Sigma (isProp A) A) => {?} 63 | 64 | -- 4. Prove that 'Either' is not a proposition in general. 65 | 66 | \func Either-isProp (p : \Pi {A B : \Type} (pA : isProp A) (pB : isProp B) -> isProp (Either A B)) : Empty => {?} 67 | 68 | -- 5. Prove that '\Sigma' preserves propositions. 69 | 70 | \func Sigma-isProp {A : \Type} (pA : isProp A) (B : A -> \Type) 71 | (pB : \Pi (x : A) -> isProp (B x)) 72 | : isProp (\Sigma (x : A) (B x)) 73 | => {?} 74 | 75 | -- 6. Prove that <= and <=' are predicates. 76 | 77 | \data <= (n m : Nat) : \Set0 \with 78 | | 0, m => z<=n 79 | | suc n, suc m => s<=s (<= n m) 80 | 81 | \data <=' (n m : Nat) : \Set0 \elim m 82 | | suc m => <=-step (<=' n m) 83 | | m => <=-refl (n = m) 84 | 85 | \func <=-isProp {n m : Nat} : isProp (<= n m) => {?} 86 | 87 | -- In the proof of <='-isProp it is allowed to use the fact that Nat is set 88 | -- without a proof. We will return to the proof of this fact later. 89 | \func Nat-isSet : isSet Nat => {?} 90 | 91 | \func <='-isProp {n m : Nat} : isProp (<=' n m) => {?} 92 | 93 | -- 7. Prove that 'ReflClosure LessOrEq' is not a predicate, but 'ReflClosure (\lam x y => T (x < y))' is a predicate. 94 | 95 | \func \infix 4 < (n m : Nat) : Bool 96 | | _, 0 => false 97 | | 0, suc _ => true 98 | | suc n, suc m => n < m 99 | 100 | \data ReflClosure (R : Nat -> Nat -> \Type) (x y : Nat) 101 | | refl (x = y) 102 | | inc (R x y) 103 | 104 | \func ReflClosure_<-isProp (n m : Nat) : isProp (ReflClosure (\lam x y => T (x < y)) n m) => {?} 105 | 106 | \func ReflClosure_<=-isNotProp (p : \Pi (n m : Nat) -> isProp (ReflClosure <= n m)) : Empty => {?} 107 | 108 | -- 8. Prove that if 'A' embeds in 'B' and 'B' is a proposition, then 'A' is proposition. 109 | 110 | \func sub-isProp {A B : \Type} (f : A -> B) (p : isInj f) (q : isProp B) : isProp A => {?} 111 | 112 | -- 9. Prove that a type with decidable equality is a set. Note that this implies 'isSet Nat' since 113 | -- we have already proved that 'Nat' has decidable equality. 114 | 115 | \func Dec-isSet {A : \Type} (dec : \Pi (x y : A) -> Decide (x = y)) : isSet A 116 | => {?} 117 | 118 | -- 10. Prove that if 'A' and 'B' are sets, then A `Either` B is also a set. 119 | 120 | \func or-isSet {A B : \Type} (p : isSet A) (q : isSet B) : isSet (Either A B) => {?} 121 | 122 | -- 11. Prove that if 'B x' is a set, then '\Pi (x : A) -> B x' is a set. 123 | 124 | \func pi-isSet {A : \Type} (B : A -> \Type) (p : \Pi (x : A) -> isSet (B x)) : isSet (\Pi (x : A) -> B x) => {?} 125 | 126 | -- 12. Prove that if 'A' is a set, then 'List A' is a set. 127 | 128 | \func List-isSet {A : \Type} (pA : isSet A) : isSet (List A) 129 | => {?} 130 | 131 | -- 13. Prove that n-types are closed under \Pi-types. 132 | -- Hint: Proof by induction. For the induction step 'suc n' one should prove that if 'f,g : \Pi (x : A) -> B x', 133 | -- then 'f = g' is equivalent to '\Pi (x : A) -> f x = g x'. 134 | 135 | \func levelPi {A : \Type} (B : A -> \Type) (n : Nat) (p : \Pi (x : A) -> B x `hasLevel` n) : (\Pi (x : A) -> B x) `hasLevel` n => {?} 136 | -------------------------------------------------------------------------------- /PartII/src/Exercises/SetsEx.ard: -------------------------------------------------------------------------------- 1 | \func isInj {A B : \Type} (f : A -> B) => \Pi (x y : A) -> f x = f y -> x = y 2 | 3 | \truncated \data Trunc (A : \Type) : \Prop 4 | | trunc A 5 | 6 | \func isSur {A B : \Type} (f : A -> B) : \Prop => 7 | \Pi (b : B) -> Trunc (\Sigma (a : A) (f a = b)) 8 | 9 | \data Empty 10 | 11 | -- 1. Prove that the predecessor function 'pred' on 'Nat' is surjective. 12 | 13 | \func pred (n : Nat) : Nat 14 | | 0 => 0 15 | | suc n => n 16 | 17 | \func pred-is-sur : isSur pred => {?} 18 | 19 | -- 2. Prove that 'suc' is not surjective. 20 | 21 | \func suc-is-not-sur (p : isSur suc) : Empty => {?} 22 | 23 | -- 3. Let 'f : A -> B' and 'g : B -> C' be some functions. 24 | -- Prove that if 'f' and 'g' are surjective, then g `o` f is also surjective. 25 | -- Prove that if g `o` f is surjective, then 'g' is also surjective. 26 | 27 | \func \fixr 9 o {A B C : \Type} (g : B -> C) (f : A -> B) => \lam a => g (f a) 28 | 29 | \func o-sur {A B C : \Type} (f : A -> B) (g : B -> C) (p : isSur f) (q : isSur g) : isSur (g `o` f) => {?} 30 | 31 | \func o-sur' {A B C : \Type} (f : A -> B) (g : B -> C) (p : isSur (g `o` f)) : isSur g => {?} 32 | 33 | -- 4. Prove the Cantor's theorem. It says that for any set 'A' the cardinality of the set of all 34 | -- subsets of 'A' is strictly greater than the cardinality of 'A'. 35 | 36 | -- The set of subsets can be defined as follows: 37 | \func Subs (A : \Set) => A -> \Prop 38 | 39 | -- Cantor's theorem consists of two parts: 40 | -- "there exists an injection from 'A' to 'Subs A'" and "there is no surjection from 'A' to 'Subs A'". 41 | \func cantor1 (A : \Set) : \Sigma (f : A -> Subs A) (isInj f) 42 | => {?} 43 | 44 | \func cantor2 (A : \Set) (f : A -> Subs A) (p : isSur f) : Empty 45 | => {?} 46 | 47 | -- 5. Define the function 'negPred : Int -> Int' such that 'negPred x = x' if 'x > 0' and 'negPred x = x - 1' if 'x <= 0'. 48 | 49 | \func negPred (x : Int) : Int => {?} 50 | 51 | -- 6. Define addition and multiplication for 'Int'. 52 | 53 | \func \infixl 6 + (x y : Int) : Int => {?} 54 | 55 | \func \infixl 7 * (x y : Int) : Int => {?} 56 | 57 | -- 7. Define the datatype 'BinNat' for the binary natural numbers. 58 | -- It should have three constructors: for 0, for even numbers 2*n and for odd numbers 2*n+1. 59 | -- This type contains several different representations of zero. 60 | -- Use datatypes with conditions to identify different representations of zero. 61 | 62 | \data BinNat 63 | 64 | -- 8. Define mutually inverse functions 'Nat -> BinNat' and 'BinNat -> Nat' and prove that they are mutually inverse. 65 | 66 | \func NatToBinNat (n : Nat) : BinNat => {?} 67 | 68 | \func BinNatToNat (b : BinNat) : Nat => {?} 69 | 70 | \func nbn (n : Nat) : BinNatToNat (NatToBinNat n) = n => {?} 71 | 72 | \func bnb (b : BinNat) : NatToBinNat (BinNatToNat b) = b => {?} 73 | 74 | -- 9. Define the set of finite subsets of a set 'A', that is of finite lists of elements of 'A' defined up to permutations 75 | -- and repetitions of elements. 76 | 77 | \data Set (A : \Set) : \Set -------------------------------------------------------------------------------- /PartII/src/Exercises/SpacesEx.ard: -------------------------------------------------------------------------------- 1 | \import Spaces 2 | 3 | -- 1. Prove that 'CircleToSphere1' and 'Sphere1ToCircle' are mutually inverse. 4 | 5 | \func Circ-S1-Circ (x : Circle) : x = Sphere1ToCircle (CircleToSphere1 x) 6 | => {?} 7 | 8 | \func S1-Circ-S1 (x : Sphere 1) : x = CircleToSphere1 (Sphere1ToCircle x) 9 | => {?} 10 | 11 | -- 2. Prove that Torus is equivalent to the direct product \Sigma Circle Circle of circles. 12 | 13 | \func TorusToS1xS1 (x : Torus) : \Sigma Circle Circle 14 | => {?} 15 | 16 | \func S1xS1ToTorus (x : \Sigma Circle Circle) : Torus 17 | => {?} 18 | 19 | \func Torus-S1xS1-Torus (x : Torus) : x = S1xS1ToTorus (TorusToS1xS1 x) 20 | => {?} 21 | 22 | \func S1xS1-Torus-S1xS1 (x : \Sigma Circle Circle) : x = TorusToS1xS1 (S1xS1ToTorus x) 23 | => {?} 24 | 25 | -- 3. Let X : \1-Type be connected. Prove that the groups pi1-1 X x and pi1-1 X y are isomorphic for all x y : X. 26 | 27 | \truncated \data TruncP (A : \Type) : \Prop 28 | | trunc A 29 | 30 | \func Equiv (A B : \Type) => \Sigma (f : A -> B) 31 | (g : B -> A) 32 | (\Pi (x : A) -> g (f x) = x) 33 | (\Pi (y : B) -> f (g y) = y) 34 | 35 | \func equality=>equivalence {A B : \Type} (p : A = B) : Equiv A B => 36 | transport (Equiv A) p (\lam x => x, \lam x => x, \lam x => idp, \lam x => idp) 37 | 38 | \func isConnected (X : \Type) => \Pi (x y : X) -> TruncP (x = y) 39 | 40 | \func pi1-1 (X : \1-Type) (x : X) => x = x 41 | 42 | \func pi1-1-equiv (X : \1-Type) (p : isConnected X) (x y : X) : Equiv (x = x) (y = y) 43 | => {?} 44 | 45 | \func pi1-1-homo (X : \1-Type) (p : isConnected X) (x y : X) (q r : x = x) : (pi1-1-func X p x y) (q *> r) = (pi1-1-func X p x y) q *> (pi1-1-func X p x y) r 46 | => {?} 47 | \where { 48 | \func pi1-1-func (X : \1-Type) (p : isConnected X) (x y : X) : (x = x) -> (y = y) 49 | => (pi1-1-equiv X p x y).1 50 | } 51 | -------------------------------------------------------------------------------- /PartII/src/HomUniverses.ard: -------------------------------------------------------------------------------- 1 | \data Bool | false | true 2 | 3 | \data Empty 4 | 5 | \data Unit | unit 6 | 7 | \data \fixr 2 Either (A B : \Type) 8 | | inl' A 9 | | inr' B 10 | 11 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 12 | => coe (\lam i => B (p @ i)) b right 13 | 14 | \func inv {A : \Type} {a a' : A} (p : a = a') : a' = a 15 | => transport (\lam x => x = a) p idp 16 | 17 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 18 | => transport (\lam x => f a = f x) p idp 19 | 20 | ------------------------------------------------- 21 | -- The universe \Prop 22 | ------------------------------------------------- 23 | 24 | \func isProp (A : \Type) => \Pi (x y : A) -> x = y 25 | 26 | \data PropInType-to-Prop (A : \Type) (p : isProp A) 27 | | inc A 28 | \where { 29 | -- Here we prove that 'PropInType-to-Prop' satisfies 'isProp'. 30 | -- This results in 'PropInType-to-Prop A p : \Prop' for all 'A' and 'p'. 31 | -- Without '\use \level' 'PropInType-to-Prop A p' would not be in '\Prop' 32 | -- unless 'A' is in '\Prop'. 33 | \use \level dataIsProp {A : \Type} {p : isProp A} 34 | (d1 d2 : PropInType-to-Prop A p) : d1 = d2 \elim d1, d2 35 | | inc a1, inc a2 => pmap inc (p a1 a2) 36 | } 37 | 38 | ------------------------------------------------- 39 | -- The universe \Set 40 | ------------------------------------------------- 41 | 42 | \func isSet (A : \Type) => \Pi (x y : A) -> isProp (x = y) 43 | 44 | \func Set-to-SetInType (A : \Set \lp) : \Sigma (X : \Type \lp) (isSet X) => 45 | (A, \lam (x y : A) => Path.inProp {x = y}) 46 | 47 | ------------------------------------------------- 48 | -- Universes \n-Type 49 | ------------------------------------------------- 50 | 51 | \func bak => \Type 30 66 52 | \func bak' => \66-Type 30 53 | \func bak'' => \66-Type 54 | 55 | -- The predicate saying "A has level suc-l - 1" 56 | \func hasLevel (A : \Type) (suc-l : Nat) : \Type \elim suc-l 57 | | 0 => isProp A 58 | | suc suc-l => \Pi (x y : A) -> (x = y) `hasLevel` suc-l 59 | 60 | ------------------------------------------------- 61 | -- Truncated data, propositional truncation 62 | ------------------------------------------------- 63 | 64 | -- Proposition 'Trunc A' says "A is nonempty". 65 | \truncated \data Trunc (A : \Type) : \Prop 66 | | trunc A 67 | 68 | -- Example: 'Trunc Nat'. 69 | \func truncNat : trunc 0 = trunc 1 => Path.inProp (trunc 0) (trunc 1) 70 | 71 | -- We can prove the negation of "Empty is nonempty". 72 | \func Trunc-Empty (t : Trunc Empty) : Empty \elim t 73 | | trunc a => a 74 | 75 | {- 76 | -- This does not typecheck! 77 | \func ex1 (t : Trunc Nat) : Nat 78 | | trunc n => n 79 | -} 80 | 81 | -- But we can define 'ex2' since 0 = 0 is in \Prop. 82 | \func ex2 (t : Trunc Nat) : 0 = 0 83 | | trunc n => idp 84 | 85 | \func Trunc-elim {A : \Type} {B : \Prop} (f : A -> B) (a : Trunc A) : B \elim a 86 | | trunc a => f a 87 | -- The eliminator computes on constructor: 88 | -- Trunc-elim f (trunc a) ===> f a 89 | 90 | \func Nat-church => \Pi (X : \Type) -> (X -> X) -> X -> X 91 | 92 | \func zero-church : Nat-church => \lam X f x => x 93 | \func one-church : Nat-church => \lam X f x => f x 94 | -- ... 95 | 96 | \func Trunc' (A : \Type) : \Prop => \Pi (X : \Prop) -> (A -> X) -> X 97 | 98 | \func trunc' {A : \Type} (a : A) : Trunc' A => \lam X f => f a 99 | 100 | \func Trunc'-elim {A : \Type} {B : \Prop} (f : A -> B) (a : Trunc' A) : B 101 | => a B f 102 | 103 | \data T (b : Bool) \with 104 | | true => tt 105 | 106 | \func T-test (b : Bool) : \Prop => T b 107 | 108 | \func T' (b : Bool) : \Type 109 | | true => \Sigma 110 | | false => Empty 111 | 112 | \func T'-test (b : Bool) : \Prop => T' b 113 | 114 | \truncated \data \fixr 2 Or (A B : \Type) : \Prop 115 | | inl A 116 | | inr B 117 | 118 | \func \fixr 2 Or' (A B : \Type) : \Prop => Trunc (Either A B) 119 | 120 | \func Or-rec {A B C : \Prop} (f : A -> C) (g : B -> C) (p : A `Or` B) : C \elim p 121 | | Or.inl a => f a 122 | | Or.inr b => g b 123 | 124 | \func exists (A : \Type) (B : A -> \Prop) => Trunc (\Sigma (x : A) (B x)) 125 | 126 | \func image {A B : \Type} (f : A -> B) => \Sigma (b : B) (Trunc (\Sigma (a : A) (f a = b))) 127 | -- image {Nat} {\Sigma} (\lam _ => ()) == \Sigma 128 | 129 | \func image' {A B : \Type} (f : A -> B) => \Sigma (b : B) (\Sigma (a : A) (f a = b)) 130 | -- image' {Nat} {\Sigma} (\lam _ => ()) == Nat 131 | 132 | ------------------------------------------------- 133 | -- Equality of types, iso 134 | ------------------------------------------------- 135 | 136 | \func Equiv (A B : \Type) => \Sigma (f : A -> B) 137 | (g : B -> A) 138 | (\Pi (x : A) -> g (f x) = x) 139 | (\Pi (y : B) -> f (g y) = y) 140 | 141 | \func equality=>equivalence (A B : \Type) (p : A = B) : Equiv A B => 142 | transport (Equiv A) p (\lam x => x, \lam x => x, \lam x => idp, \lam x => idp) 143 | 144 | \func equivalence=>equality (A B : \Type) (e : Equiv A B) : A = B => 145 | path (iso e.1 e.2 e.3 e.4) 146 | 147 | \func test (A B : \Type) (e : Equiv A B) 148 | : transport (\lam X => X) (equivalence=>equality A B e) = e.1 149 | => idp 150 | 151 | ------------------------------------------------- 152 | -- An example of application of univalence 153 | ------------------------------------------------- 154 | 155 | \data Dec (E : \Type) 156 | | yes E 157 | | no (E -> Empty) 158 | 159 | \func DecEq (A : \Type) => \Pi (x y : A) -> Dec (x = y) 160 | 161 | \func pred (n : Nat) : Nat 162 | | 0 => 0 163 | | suc n => n 164 | 165 | \func suc/=0 {n : Nat} (p : suc n = 0) : Empty => transport (\lam n => \case n \with { | 0 => Empty | suc _ => Unit }) p unit 166 | 167 | -- We proved this earlier. 168 | \func NatDecEq (x y : Nat) : Dec (x = y) 169 | | 0, 0 => yes idp 170 | | 0, suc y => no (\lam p => suc/=0 (inv p)) 171 | | suc x, 0 => no suc/=0 172 | | suc x, suc y => \case NatDecEq x y \with { 173 | | yes p => yes (pmap suc p) 174 | | no c => no (\lam p => c (pmap pred p)) 175 | } 176 | 177 | \func isCountable (X : \Type) => Equiv Nat X 178 | 179 | \func countableDecEq (X : \Type) (p : isCountable X) : DecEq X => 180 | transport DecEq (equivalence=>equality Nat X p) NatDecEq 181 | 182 | ------------------------------------------------- 183 | -- Implications of univalence for \Prop and \Set 184 | ------------------------------------------------- 185 | 186 | \func propExt {A B : \Prop} (f : A -> B) (g : B -> A) : A = B => 187 | equivalence=>equality A B (f, g, \lam x => Path.inProp _ _, \lam y => Path.inProp _ _) 188 | 189 | \func absurd {A : \Type} (e : Empty) : A 190 | 191 | \func not (x : Bool) : Bool 192 | | true => false 193 | | false => true 194 | 195 | \func not-not (b : Bool) : not (not b) = b 196 | | true => idp 197 | | false => idp 198 | 199 | \func true/=false (p : true = false) : Empty => absurd (transport T' p ()) 200 | 201 | \func Set-isNotSet (p : isSet \Set) : Empty => 202 | \let 203 | -- We first prove equality between 'idp' and 204 | -- the equality, corresponding to 'not'. 205 | | idp=not => 206 | p Bool Bool 207 | idp -- : Bool = Bool 208 | (equivalence=>equality Bool Bool (not, not, not-not, not-not)) -- : Bool = Bool 209 | -- Now we can prove the equality between the two bijections 210 | -- corresponding to 'idp' and 'not', that is that 'id' 211 | -- equals 'not'. 212 | | id=not : (\lam x => x) = not => pmap (transport (\lam X => X)) idp=not 213 | -- The contradiction follows easily. 214 | \in true/=false (pmap (\lam f => f true) id=not) 215 | 216 | -------------------------------------------------------------------------------- /PartII/src/PropsSets.ard: -------------------------------------------------------------------------------- 1 | \data Bool | false | true 2 | 3 | \data Empty 4 | 5 | \data Unit | unit 6 | 7 | \func T (b : Bool) : \Type 8 | | true => \Sigma 9 | | false => Empty 10 | 11 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 12 | => coe (\lam i => B (p @ i)) b right 13 | 14 | \func sym {A : \Type} {a a' : A} (p : a = a') : a' = a 15 | => transport (\lam x => x = a) p idp 16 | 17 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 18 | => transport (\lam x => f a = f x) p idp 19 | 20 | \func \infixr 5 *> {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 21 | => transport (\lam x => a = x) q p 22 | 23 | \data \fixr 2 Either (A B : \Type) 24 | | inl A 25 | | inr B 26 | 27 | ------------------------------------------------- 28 | -- Subsets, injective functions 29 | ------------------------------------------------- 30 | 31 | \func isEven (n : Nat) : Bool 32 | | 0 => true 33 | | 1 => false 34 | | suc (suc n) => isEven n 35 | 36 | \func Even => \Sigma (n : Nat) (T (isEven n)) 37 | 38 | \func Even-inc (e : Even) => e.1 39 | 40 | \func isInj {A B : \Type} (f : A -> B) => 41 | \Pi (x y : A) -> f x = f y -> x = y 42 | 43 | \func prodEq {A B : \Type} (t1 t2 : \Sigma A B) (p : t1.1 = t2.1) (q : t1.2 = t2.2) 44 | : t1 = t2 45 | => path (\lam i => (p @ i, q @ i)) 46 | 47 | \func sigmaEq {A : \Type} (B : A -> \Type) (t1 t2 : \Sigma (x : A) (B x)) 48 | (p : t1.1 = t2.1) (q : transport B p t1.2 = t2.2) 49 | : t1 = t2 \elim t1, t2, p, q 50 | | (x,y), (x',y'), idp, idp => idp 51 | 52 | \func T-lem {b : Bool} {x y : T b} : x = y 53 | | {true} => idp 54 | 55 | \func Even-inc-isInj : isInj Even-inc => 56 | \lam p p' t => sigmaEq (\lam n => T (isEven n)) p p' t T-lem 57 | 58 | \func mod3 (n : Nat) : Nat 59 | | 0 => 0 60 | | 1 => 1 61 | | 2 => 2 62 | | suc (suc (suc n)) => mod3 n 63 | 64 | \func mod5 (n : Nat) : Nat 65 | | 0 => 0 66 | | 1 => 1 67 | | 2 => 2 68 | | 3 => 3 69 | | 4 => 4 70 | | suc (suc (suc (suc (suc n)))) => mod5 n 71 | 72 | \func MultipleOf3Or5 => \Sigma (n : Nat) ((mod3 n = 0) `Either` (mod5 n = 0)) 73 | 74 | \func Mul-inc (m : MultipleOf3Or5) => m.1 75 | 76 | -- \func Mul-inc-isInj (p : isInj Mul-inc) : Empty => {?} 77 | 78 | ------------------------------------------------- 79 | -- Mere propositions 80 | ------------------------------------------------- 81 | 82 | \func isProp (A : \Type) => \Pi (x y : A) -> x = y 83 | 84 | \func BoolIsNotProp (p : isProp Bool) : Empty 85 | => transport T (p true false) () 86 | 87 | \func Empty-isProp : isProp Empty => \lam x y => \case x \with {} 88 | 89 | \func Unit-isProp : isProp (\Sigma) => \lam x y => idp 90 | 91 | \func Sigma-isProp {A B : \Type} (pA : isProp A) (pB : isProp B) 92 | : isProp (\Sigma A B) => \lam p q => prodEq p q (pA p.1 q.1) (pB p.2 q.2) 93 | 94 | -- \func Either-isProp {A B : \Type} (pA : isProp A) (pB : isProp B) 95 | -- : isProp (Either A B) 96 | -- => {?} 97 | 98 | \func funExt {A : \Type} (B : A -> \Type) (f g : \Pi (x : A) -> B x) 99 | (p : \Pi (x : A) -> f x = g x) : f = g => 100 | path (\lam i x => p x @ i) 101 | 102 | \func Impl-isProp {A B : \Type} {- (pA : isProp A) -} (pB : isProp B) : isProp (A -> B) 103 | => \lam f g => funExt (\lam _ => B) f g (\lam x => pB (f x) (g x)) -- path (\lam i x => pB (f x) (g x) @ i) 104 | 105 | 106 | \func forall-isProp {A : \Type} (B : A -> \Type) (pB : \Pi (x : A) -> isProp (B x)) 107 | : isProp (\Pi (x : A) -> B x) 108 | => \lam f g => path (\lam i x => pB x (f x) (g x) @ i) 109 | 110 | {- 111 | \func exists-isProp {A : \Type} (B : A -> \Type) 112 | (pB : \Pi (x : A) -> isProp (B x)) 113 | : isProp (\Sigma (x : A) (B x)) 114 | => {?} 115 | -} 116 | 117 | -- \func equality-isProp {A : \Type} (a a' : A) : isProp (a = a') => {?} 118 | 119 | \data \infix 4 <=' (n m : Nat) \with 120 | | 0, _ => zero<=_ 121 | | suc n, suc m => suc<=suc (n <=' m) 122 | 123 | \data \infix 4 <='' (n m : Nat) \elim m 124 | | m => <=-refl (n = m) 125 | | 1 => zero<=one (n = 0) 126 | | suc m => <=-step (n <='' m) 127 | 128 | ------------------------------------------------- 129 | -- Sets 130 | ------------------------------------------------- 131 | 132 | \func isSet (A : \Type) => \Pi (a a' : A) -> isProp (a = a') 133 | 134 | \func equality-isProp {A : \Type} (p : isSet A) (a a' : A) : isProp (a = a') => p a a' 135 | 136 | \func hasLevel (A : \Type) (suc-l : Nat) : \Type \elim suc-l 137 | | 0 => isProp A 138 | | suc suc-l => \Pi (x y : A) -> (x = y) `hasLevel` suc-l 139 | 140 | \func Empty-isSet : isSet Empty => \lam x y _ _ => \case x \with {} 141 | 142 | \func retract-isProp {A B : \Type} (pB : isProp B) (f : A -> B) (g : B -> A) 143 | (h : \Pi (x : A) -> g (f x) = x) 144 | : isProp A 145 | => \lam x y => sym (h x) *> pmap g (pB (f x) (f y)) *> h y 146 | 147 | \func Unit'-isProp (x y : Unit) : x = y 148 | | unit, unit => idp 149 | 150 | \func Unit-isSet : isSet Unit => \lam x y => retract-isProp {x = y} Unit'-isProp 151 | (\lam _ => unit) (\lam _ => Unit'-isProp x y) 152 | (\lam p => \case \elim x, \elim y, \elim p \with { | unit, _, idp => idp }) 153 | 154 | \func Sigma'-isProp {A : \Type} (B : A -> \Type) 155 | (pA : isProp A) (pB : \Pi (x : A) -> isProp (B x)) 156 | : isProp (\Sigma (x : A) (B x)) => \lam p q => sigmaEq B p q (pA _ _) (pB _ _ _) 157 | 158 | 159 | \func retract'-isProp {A B : \Type} (pB : isProp B) (g : B -> A) 160 | (H : \Pi (x : A) -> \Sigma (y : B) (g y = x)) 161 | : isProp A 162 | => \lam x y => sym (H x).2 *> pmap g (pB (H x).1 (H y).1) *> (H y).2 163 | 164 | \func Sigma-isSet {A : \Type} (B : A -> \Type) 165 | (pA : isSet A) (pB : \Pi (x : A) -> isSet (B x)) 166 | : isSet (\Sigma (x : A) (B x)) 167 | => \lam t t' => retract'-isProp 168 | {t = t'} 169 | {\Sigma (p : t.1 = t'.1) (transport B p t.2 = t'.2)} 170 | (Sigma'-isProp (\lam p => transport B p t.2 = t'.2) (pA _ _) (\lam _ => pB _ _ _)) 171 | (\lam s => sigmaEq B t t' s.1 s.2) 172 | (\lam p => \case \elim t', \elim p \with { | _, idp => ((idp,idp),idp) }) 173 | 174 | ------------------------------------------------- 175 | -- Groupoid structure on types 176 | ------------------------------------------------- 177 | 178 | \func isGpd (A : \Type) => \Pi (x y : A) -> isSet (x = y) 179 | 180 | -- 'idp' is left and right identity 181 | \func idp-right {A : \Type} {x y : A} (p : x = y) : p *> idp = p => idp 182 | 183 | \func idp-left {A : \Type} {x y : A} (p : x = y) : idp *> p = p \elim p 184 | | idp => idp 185 | 186 | -- * is associative 187 | \func *-assoc {A : \Type} {x y z w : A} (p : x = y) (q : y = z) (r : z = w) 188 | : (p *> q) *> r = p *> (q *> r) \elim r 189 | | idp => idp 190 | 191 | -- 'sym' is inverse 192 | \func sym-left {A : \Type} {x y : A} (p : x = y) : sym p *> p = idp 193 | \elim p 194 | | idp => idp 195 | 196 | \func sym-right {A : \Type} {x y : A} (p : x = y) : p *> sym p = idp 197 | \elim p 198 | | idp => idp 199 | 200 | \func cancelLeft {A : \Type} {x y z : A} 201 | (p : x = y) (q r : y = z) (s : p *> q = p *> r) : q = r 202 | \elim p, r 203 | | idp, idp => sym (idp-left q) *> s -------------------------------------------------------------------------------- /PartII/src/Sets.ard: -------------------------------------------------------------------------------- 1 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 2 | => coe (\lam i => B (p @ i)) b right 3 | 4 | \func sym {A : \Type} {a a' : A} (p : a = a') : a' = a 5 | => transport (\lam x => x = a) p idp 6 | 7 | \func pmap {A B : \Type} (f : A -> B) {a a' : A} (p : a = a') : f a = f a' 8 | => transport (\lam x => f a = f x) p idp 9 | 10 | \func \infixr 5 *> {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 11 | => transport (\lam x => a = x) q p 12 | 13 | \func sigmaEq {A : \Type} (B : A -> \Type) (t1 t2 : \Sigma (x : A) (B x)) 14 | (p : t1.1 = t2.1) (q : transport B p t1.2 = t2.2) 15 | : t1 = t2 \elim t1, t2, p, q 16 | | (x,y), (x',y'), idp, idp => idp 17 | 18 | ------------------------------------------------- 19 | -- Surjections, injections, bijections 20 | ------------------------------------------------- 21 | 22 | \func isProp (A : \Type) => \Pi (x y : A) -> x = y 23 | 24 | \func isInj {A B : \Set} (f : A -> B) => \Pi (x y : A) -> f x = f y -> x = y 25 | 26 | \truncated \data Trunc (A : \Type) : \Prop 27 | | in A 28 | \where { 29 | \func map {A B : \Type} (f : A -> B) (x : Trunc A) : Trunc B \elim x 30 | | in a => in (f a) 31 | 32 | \lemma extract {A : \Type} (x : Trunc A) (p : isProp A) : \level A p \elim x 33 | | in a => a 34 | } 35 | 36 | -- Note that \Sigma (a : A) (f a = b) is not 37 | -- necessarily a proposition and should be truncated. 38 | \func isSur {A B : \Set} (f : A -> B) : \Prop => 39 | \Pi (b : B) -> Trunc (\Sigma (a : A) (f a = b)) 40 | -- \Pi (b : B) -> \Sigma (a : A) (f a = b) 41 | 42 | \func isBij {A B : \Set} (f : A -> B) => \Sigma (g : B -> A) (\Pi (x : A) -> g (f x) = x) (\Pi (y : B) -> f (g y) = y) 43 | 44 | \func isBij->isInj {A B : \Set} (f : A -> B) (p : isBij f) : isInj f => \lam x y q => sym (p.2 x) *> pmap p.1 q *> p.2 y 45 | 46 | \func isBij->isSur {A B : \Set} (f : A -> B) (p : isBij f) : isSur f => \lam b => in (p.1 b, p.3 b) 47 | 48 | \func sigmaEq' {A : \Type} (B : A -> \Prop) (t1 t2 : \Sigma (x : A) (B x)) (p : t1.1 = t2.1) 49 | => sigmaEq B t1 t2 p (Path.inProp _ _) 50 | 51 | \func isInj+isSur->isBij {A B : \Set} (f : A -> B) (ip : isInj f) (sp : isSur f) : isBij f 52 | => \let t (b : B) => Trunc.extract (sp b) (\lam t1 t2 => sigmaEq' (\lam a => f a = b) t1 t2 (ip t1.1 t2.1 (t1.2 *> sym t2.2))) 53 | \in (\lam b => (t b).1, \lam a => ip _ _ (t (f a)).2, \lam b => (t b).2) 54 | 55 | ------------------------------------------------- 56 | -- A definition of Int, datatypes with condition 57 | ------------------------------------------------- 58 | 59 | \data Int 60 | | pos Nat 61 | | neg (n : Nat) \elim n { 62 | | 0 => pos 0 63 | } 64 | 65 | {- 66 | -- This does not typecheck! 67 | \func intEx (z : Int) : Nat 68 | | pos n => 3 69 | | neg n => 7 70 | -} 71 | 72 | \func intEx' (z : Int) : Nat 73 | | pos n => 3 74 | | neg (suc n) => 7 75 | 76 | \func negative (x : Int) : Int 77 | | pos n => neg n 78 | | neg n => pos n 79 | 80 | \func abs (x : Int) : Nat 81 | | pos n => n 82 | | neg n => n 83 | 84 | ------------------------------------------------- 85 | -- Quotient sets 86 | ------------------------------------------------- 87 | 88 | \truncated \data Quotient (A : \Type) (R : A -> A -> \Type) : \Set 89 | | inR A 90 | | eq (a a' : A) (r : R a a') (i : I) \elim i { 91 | | left => inR a 92 | | right => inR a' 93 | } 94 | 95 | \func quotientEq {A : \Type} {R : A -> A -> \Type} (a a' : A) (r : R a a') 96 | : inR a = {Quotient A R} inR a' 97 | => path (eq a a' r) 98 | 99 | \func inR-sur {A : \Set} {R : A -> A -> \Prop} : isSur (inR {A} {R}) => 100 | \lam [a] => \case \elim [a] \with { 101 | | inR a => in (a, idp) 102 | } 103 | 104 | \func quotientEx {A : \Type} {R : A -> A -> \Type} {B : \Set} 105 | (f : A -> B) (p : \Pi (a a' : A) -> R a a' -> f a = f a') 106 | (x : Quotient A R) : B \elim x 107 | | inR a => f a 108 | | eq a a' r i => p a a' r @ i -------------------------------------------------------------------------------- /PartII/src/Spaces.ard: -------------------------------------------------------------------------------- 1 | \data Empty 2 | 3 | \func transport {A : \Type} (B : A -> \Type) {a a' : A} (p : a = a') (b : B a) 4 | => coe (\lam i => B (p @ i)) b right 5 | 6 | \func inv {A : \Type} {a a' : A} (p : a = a') : a' = a 7 | => transport (\lam x => x = a) p idp 8 | 9 | \func \infixr 5 *> {A : \Type} {a a' a'' : A} (p : a = a') (q : a' = a'') : a = a'' 10 | => transport (\lam x => a = x) q p 11 | 12 | ------------------------------------------------- 13 | -- Spaces: sphere, torus 14 | ------------------------------------------------- 15 | 16 | \data Circle 17 | | base 18 | | loop I \with { 19 | | left => base 20 | | right => base 21 | } 22 | 23 | \data Susp (A : \Type) 24 | | south 25 | | north 26 | | merid A (i : I) \elim i { 27 | | left => north 28 | | right => south 29 | } 30 | 31 | \func Sphere (n : Nat) : \Type \lp \oo 32 | | 0 => Susp Empty 33 | | suc n => Susp (Sphere n) 34 | 35 | \func CircleToSphere1 (x : Circle) : Sphere 1 36 | | base => north 37 | | loop i => (path (merid north) *> inv (path (merid south))) @ i 38 | 39 | \func Sphere1ToCircle (x : Sphere 1) : Circle 40 | | south => base 41 | | north => base 42 | | merid north i => loop i 43 | | merid south i => base 44 | | merid (merid () _) _ 45 | 46 | \data Torus 47 | | point 48 | | line1 I \with { left => point | right => point } 49 | | line2 I \with { left => point | right => point } 50 | | face I I \with { 51 | | left, i => line2 i 52 | | right, i => line2 i 53 | | i, left => line1 i 54 | | i, right => line1 i 55 | } 56 | 57 | ------------------------------------------------- 58 | -- Higher induction principles 59 | ------------------------------------------------- 60 | 61 | \func circRec {B : \Type} {b : B} (l : b = b) (x : Circle) : B \elim x 62 | | base => b 63 | | loop i => l @ i 64 | 65 | \func concat {A : I -> \Type} {a : A left} {a' a'' : A right} (p : Path A a a') (q : a' = a'') : Path A a a'' \elim q 66 | | idp => p 67 | 68 | \func circInd (B : Circle -> \Type) (b : B base) (l : transport B (path loop) b = b) (x : Circle) : B x \elim x 69 | | base => b 70 | | loop i => (concat {\lam i => B (loop i)} (path (\lam i => coe (\lam j => B (loop j)) b i)) l) @ i 71 | -------------------------------------------------------------------------------- /PartII/src/index.ard: -------------------------------------------------------------------------------- 1 | -- This file indicates the reading order of the other Arend modules 2 | 3 | -- Propositions and sets in HoTT 4 | \import PropsSets () 5 | 6 | -- Universes stratified by homotopy level, truncations and univalence 7 | \import HomUniverses () 8 | 9 | -- Basic set theory 10 | \import Sets () 11 | 12 | -- Basic homotopy theory 13 | \import Spaces () 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Arend Tutorial 2 | 3 | Source code & exercises in Arend's tutorial. 4 | 5 | ### Part I 6 | 7 | See [index.ard](Part1/src/index.ard) and the [online tutorial][tut1]. 8 | 9 | [tut1]: https://arend-lang.github.io/documentation/tutorial/PartI 10 | --------------------------------------------------------------------------------