├── .emacs ├── .gitignore ├── CITATION.cff ├── README.md ├── Session1-solution.agda ├── Session1.agda ├── Session2-solution.agda ├── Session2.agda ├── Session3-solution-bool.agda ├── Session3-solution.agda └── Session3.agda /.emacs: -------------------------------------------------------------------------------- 1 | 2 | ;; cua-mode allows you to use windows shortcuts such as Ctrl-c, Ctrl-v, Ctrl-x, and Ctrl-z 3 | (cua-mode t) 4 | 5 | ;; show-paren-mode is useful to find matching parenthesis 6 | (show-paren-mode) 7 | 8 | ;; the default monospace font on Ubuntu doesn't display unicode characters correctly, 9 | ;; this one is much better. 10 | (set-face-attribute 'default t :font "DejaVu Sans Mono Book") 11 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.aux 2 | *.pdf 3 | *.synctex.gz 4 | *.log 5 | *.toc 6 | *.bbl 7 | *.bst 8 | *.xyc 9 | *.out 10 | *~ 11 | *.blg 12 | *.agdai 13 | -------------------------------------------------------------------------------- /CITATION.cff: -------------------------------------------------------------------------------- 1 | # This CITATION.cff file was generated with cffinit. 2 | # Visit https://bit.ly/cffinit to generate yours today! 3 | 4 | cff-version: 1.2.0 5 | title: agda-sessions 6 | message: >- 7 | If you use this software, please cite it using the 8 | metadata from this file. 9 | type: software 10 | authors: 11 | - given-names: Jesper 12 | family-names: Cockx 13 | orcid: 'https://orcid.org/0000-0003-3862-4073' 14 | - given-names: Andreas 15 | family-names: Nuyts 16 | orcid: 'https://orcid.org/0000-0002-1571-5063' 17 | - given-names: Thomas 18 | family-names: Van Strydonck 19 | orcid: 'https://orcid.org/0000-0002-5262-1381' 20 | repository-code: 'https://github.com/anuyts/agda-sessions' 21 | abstract: Learn the Agda basics in three 2-hour sessions. 22 | keywords: 23 | - Agda 24 | - tutorial 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Agda-sessions 2 | Learn the Agda basics in three 2-hour sessions. 3 | 4 | This Agda tutorial was constructed by Jesper Cockx and is presently maintained by Andreas Nuyts as part of a CS master course titled "Formal Systems and their Applications" at KU Leuven, Belgium. We decided to make it public after receiving comments that there aren't so many quick Agda tutorials out there. 5 | 6 | All agda code should currently be tuned for Agda 2.6.1 and the Agda standard library v1.3 (versions available via Ubuntu jammy package manager). 7 | 8 | It is assumed you use emacs with agda-mode as your IDE. Users may wish to put the .emacs file in their homefolder. 9 | -------------------------------------------------------------------------------- /Session1-solution.agda: -------------------------------------------------------------------------------- 1 | {- 2 | 3 | |--------------------------------------------------| 4 | | Formal systems and their applications: exercises | 5 | | Session 1: Agda basics | 6 | |--------------------------------------------------| 7 | 8 | Part 1: Booleans and natural numbers 9 | ==================================== 10 | 11 | -} 12 | 13 | data Bool : Set where 14 | true : Bool 15 | false : Bool 16 | 17 | ¬ : Bool → Bool 18 | ¬ true = false 19 | ¬ false = true 20 | 21 | _∧_ : Bool → Bool → Bool 22 | true ∧ y = y 23 | false ∧ y = false 24 | 25 | _∨_ : Bool → Bool → Bool 26 | true ∨ y = true 27 | false ∨ y = y 28 | 29 | if_then_else_ : {A : Set} → Bool → A → A → A 30 | (if true then x else y) = x 31 | (if false then x else y) = y 32 | 33 | ¬-alt : Bool → Bool 34 | ¬-alt x = if x then false else true 35 | 36 | weird : Bool → (Bool → Bool → Bool) 37 | weird x = if x then _∧_ else _∨_ 38 | 39 | data Nat : Set where 40 | zero : Nat 41 | suc : Nat → Nat 42 | 43 | {-# BUILTIN NATURAL Nat #-} 44 | 45 | _+_ : Nat → Nat → Nat 46 | zero + n = n 47 | suc m + n = suc (m + n) 48 | 49 | is-zero : Nat → Bool 50 | is-zero zero = true 51 | is-zero (suc n) = false 52 | 53 | _-_ : Nat → Nat → Nat -- Return zero instead of negative numbers 54 | m - zero = m 55 | zero - suc n = zero 56 | suc m - suc n = m - n 57 | 58 | minimum : Nat → Nat → Nat 59 | minimum zero n = zero 60 | minimum (suc m) zero = zero 61 | minimum (suc m) (suc n) = suc (minimum m n) 62 | 63 | maximum : Nat → Nat → Nat 64 | maximum zero n = n 65 | maximum (suc m) zero = suc m 66 | maximum (suc m) (suc n) = suc (maximum m n) 67 | 68 | _*_ : Nat → Nat → Nat 69 | zero * n = zero 70 | suc m * n = n + (m * n) 71 | 72 | {- 73 | Part 2: Proving basic properties 74 | ================================ 75 | -} 76 | 77 | data ⊤ : Set where 78 | tt : ⊤ 79 | 80 | data ⊥ : Set where 81 | -- no constructors 82 | 83 | data _×_ (A B : Set) : Set where 84 | _,_ : A → B → A × B 85 | 86 | fst : {A B : Set} → A × B → A 87 | fst (a , b) = a 88 | 89 | snd : {A B : Set} → A × B → B 90 | snd (a , b) = b 91 | 92 | data _⊎_ (A B : Set) : Set where 93 | left : A → A ⊎ B 94 | right : B → A ⊎ B 95 | 96 | ×-comm : {A B : Set} → A × B → B × A 97 | ×-comm (a , b) = b , a 98 | 99 | distr : {A B C : Set} → A × (B ⊎ C) → (A × B) ⊎ (A × C) 100 | distr (a , left b) = left (a , b) 101 | distr (a , right c) = right (a , c) 102 | 103 | app : {A B : Set} → (A → B) × A → B 104 | app (f , a) = f a 105 | 106 | 107 | {- 108 | Part 3: Record types 109 | ==================== 110 | -} 111 | record _×'_ (A B : Set) : Set where 112 | constructor _,'_ 113 | field 114 | fst' : A 115 | snd' : B 116 | open _×'_ 117 | 118 | ×'-comm : {A B : Set} → A ×' B → B ×' A 119 | fst' (×'-comm p) = snd' p 120 | snd' (×'-comm p) = fst' p 121 | 122 | ×'-comm' : {A B : Set} → A ×' B → B ×' A 123 | ×'-comm' (x ,' y) = y ,' x 124 | 125 | {- 126 | Part 4: The identity type 127 | ========================= 128 | -} 129 | 130 | data _≡_ {A : Set} : A → A → Set where 131 | refl : {x : A} → x ≡ x 132 | 133 | refl-example : 3 ≡ 3 134 | refl-example = refl 135 | 136 | --refl-counterexample : 3 ≡ 4 137 | --refl-counterexample = {!cannot be done!} 138 | 139 | refl-example' : 2 + 3 ≡ 5 140 | refl-example' = refl 141 | 142 | ¬¬true : ¬ (¬ true) ≡ true 143 | ¬¬true = refl 144 | 145 | 3+5-5 : (3 + 5) - 5 ≡ 3 146 | 3+5-5 = refl 147 | 148 | -- Write more tests here 149 | test-min-max : minimum (maximum 1 2) (maximum 3 4) ≡ 2 150 | test-min-max = refl 151 | -- 152 | 153 | ¬¬-elim : (b : Bool) → ¬ (¬ b) ≡ b 154 | ¬¬-elim true = refl 155 | ¬¬-elim false = refl 156 | 157 | ∧-same : (b : Bool) → b ∧ b ≡ b 158 | ∧-same true = refl 159 | ∧-same false = refl 160 | 161 | if-same : {A : Set} → (b : Bool) → (x : A) → (if b then x else x) ≡ x 162 | if-same true x = refl 163 | if-same false x = refl 164 | 165 | 166 | {- 167 | Part 5: refl patterns and absurd patterns 168 | ========================================= 169 | -} 170 | 171 | sym : {A : Set} {x y : A} → x ≡ y → y ≡ x 172 | sym {A}{x}{.x} refl = refl 173 | 174 | trans : {A : Set} {x y z : A} → x ≡ y → y ≡ z → x ≡ z 175 | trans {A}{x}{.x}{.x} refl refl = refl 176 | 177 | cong : {A B : Set} (f : A → B) {x y : A} → x ≡ y → f x ≡ f y 178 | cong f {x} {.x} refl = refl 179 | 180 | true-not-false : true ≡ false → ⊥ 181 | true-not-false () 182 | 183 | ⊥-elim : {A : Set} → ⊥ → A 184 | ⊥-elim () 185 | 186 | not-zero-and-one : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 187 | not-zero-and-one zero eq0 () 188 | not-zero-and-one (suc n) () eq1 189 | 190 | not-zero-and-one' : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 191 | not-zero-and-one' .0 refl () 192 | 193 | not-zero-and-one'' : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 194 | not-zero-and-one'' .1 () refl 195 | 196 | ∨-first : (b : Bool) → b ∨ false ≡ true → b ≡ true 197 | ∨-first true eq = refl 198 | ∨-first false () 199 | 200 | easy-match : {x : Nat} → suc x ≡ 3 → x ≡ 2 201 | easy-match {.2} refl = refl 202 | 203 | -- The main point here is that it's hard; depending on your definition of _*_ and _+_, it may be VERY hard. 204 | -- Don't worry about not being able to complete this one, that just proves the point. 205 | harder-match : {x : Nat} → x * 4 ≡ 12 → x ≡ 3 206 | harder-match {zero} () 207 | harder-match {suc zero} () 208 | harder-match {suc (suc zero)} () 209 | harder-match {suc (suc (suc zero))} p = refl 210 | harder-match {suc (suc (suc (suc x)))} () 211 | -- New versions of Agda may allow omission of all clauses but the `refl` one, 212 | -- so that the solution is not that hard after all. 213 | 214 | uip : {A : Set} {x y : A} {p q : x ≡ y} → p ≡ q 215 | uip {A} {x} {.x} {refl} {refl} = refl 216 | 217 | 218 | 219 | {- 220 | Part 6: More properties of natural numbers 221 | ========================================== 222 | -} 223 | plus0-left : (n : Nat) → 0 + n ≡ n 224 | plus0-left n = refl 225 | 226 | plus0-right : (n : Nat) → n + 0 ≡ n 227 | plus0-right zero = refl 228 | plus0-right (suc n) = cong suc (plus0-right n) 229 | 230 | plus0-right-example : 3 + 0 ≡ 3 231 | plus0-right-example = plus0-right 3 232 | --Can you figure out how Agda computes the following term? (Use C-c C-n to view the computation result.) 233 | {- plus0-right 3 234 | = cong suc (plus0-right 2) 235 | = cong suc (cong suc (plus0-right 1)) 236 | = cong suc (cong suc (cong suc (plus0-right 0))) 237 | = cong suc (cong suc (cong suc refl)) 238 | = cong suc (cong suc refl) 239 | = cong suc refl 240 | = refl 241 | -} 242 | 243 | plus-assoc : (k l m : Nat) → k + (l + m) ≡ (k + l) + m 244 | plus-assoc zero l m = refl 245 | plus-assoc (suc k) l m = cong suc (plus-assoc k l m) 246 | 247 | --auxiliary function 248 | plus-suc-right : (m n : Nat) → suc (m + n) ≡ m + suc n 249 | plus-suc-right zero n = refl 250 | plus-suc-right (suc m) n = cong suc (plus-suc-right m n) 251 | 252 | plus-comm : (m n : Nat) → m + n ≡ n + m 253 | plus-comm zero n = sym (plus0-right n) 254 | plus-comm (suc m) n = trans (cong suc (plus-comm m n)) (plus-suc-right n m) 255 | 256 | 257 | 258 | {- 259 | Part 7: Lambda-abstractions and functions 260 | ========================================= 261 | -} 262 | split-assumption : {A B C : Set} → (A ⊎ B → C) → (A → C) × (B → C) 263 | split-assumption f = (λ a → f (left a)) , (λ b → f (right b)) 264 | 265 | split-assumption' : {A B C : Set} → (A ⊎ B → C) → (A → C) ×' (B → C) 266 | fst' (split-assumption' f) a = f (left a) 267 | snd' (split-assumption' f) b = f (right b) 268 | 269 | {- 270 | State and prove: 271 | If A implies (B and C), then A implies B and A implies C 272 | -} 273 | split-conclusion : {A B C : Set} → (A → B × C) → (A → B) × (A → C) 274 | split-conclusion f = (λ a → fst (f a)) , (λ a → snd (f a)) 275 | 276 | lemma : {A B : Set} → (A → B) → (A ⊎ ⊥ → B) × (⊥ → A) 277 | lemma f = (λ where 278 | (left a) → f a 279 | (right ()) 280 | ) , λ () 281 | lemma' : {A B : Set} → (A → B) → (A ⊎ ⊥ → B) × (⊥ → A) 282 | lemma' f = (λ { (left a) → f a 283 | ; (right ()) 284 | } 285 | ) , (λ ()) 286 | 287 | const : {A B : Set} → A → B → A 288 | const a b = a 289 | ambiguous-function : Bool → ⊥ → Nat 290 | ambiguous-function bool bot = 291 | const {B = Bool} 5 (if bool then ⊥-elim bot else ⊥-elim bot) 292 | 293 | if-zero : Nat → {A : Set} → A → A → A 294 | if-zero = λ {zero {A} a b → a ; 295 | (suc n) {A} a b → b} 296 | 297 | refl₁ : {A : Set} → {a : A} → a ≡ a 298 | refl₁ = refl 299 | 300 | refl₂ : {A : Set} {a : A} → a ≡ a 301 | refl₂ = refl 302 | 303 | refl₃ : (A : Set) → (a : A) → a ≡ a 304 | refl₃ A a = refl 305 | 306 | refl₄ : (A : Set) (a : A) → a ≡ a 307 | refl₄ A a = refl 308 | 309 | refl₅ : ∀ {A} (a : A) → a ≡ a 310 | refl₅ a = refl 311 | 312 | refl₆ : ∀ A {a : A} → a ≡ a 313 | refl₆ A = refl 314 | 315 | refl₇ : ∀ A a → a ≡ a 316 | refl₇ A a = refl {A = A} -- If we explicitly pass the argument A, Agda figures that `a : A`. 317 | 318 | 319 | 320 | {- 321 | Part 8: Decidable equality 322 | ========================= 323 | -} 324 | data Dec (A : Set) : Set where 325 | yes : A → Dec A 326 | no : (A → ⊥) → Dec A 327 | 328 | equalBool? : (x y : Bool) → Dec (x ≡ y) 329 | equalBool? true true = yes refl 330 | equalBool? true false = no (λ ()) 331 | equalBool? false true = no (λ ()) 332 | equalBool? false false = yes refl 333 | 334 | -- Auxiliary function for an alternative solution to `equalNat?` 335 | suc-injective : {m n : Nat} → suc m ≡ suc n → m ≡ n 336 | suc-injective {m} {.m} refl = refl 337 | 338 | equalNat? : (m n : Nat) → Dec (m ≡ n) 339 | equalNat? zero zero = yes refl 340 | equalNat? zero (suc n) = no (λ ()) 341 | equalNat? (suc m) zero = no (λ ()) 342 | -- 343 | equalNat? (suc m) (suc n) with equalNat? m n 344 | equalNat? (suc m) (suc n) | yes eq = yes (cong suc eq) 345 | equalNat? (suc m) (suc n) | no neq = no (λ suc-m=suc-n → neq (cong (λ k → k - 1) suc-m=suc-n)) 346 | -- this last clause can be done in several ways, here are two alternatives: 347 | --equalNat? (suc m) (suc n) | no neq = no (λ{ refl → neq refl}) -- May not work in all versions of Agda. 348 | --equalNat? (suc m) (suc n) | no neq = no (λ suc-m=suc-n → neq (suc-injective suc-m=suc-n)) 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | -- Declaring precedence rules for operators (ignore this for now) 357 | infixl 6 _∧_ 358 | infixl 5 _∨_ 359 | infix 4 if_then_else_ 360 | infixl 10 _+_ 361 | infixl 12 _*_ 362 | infix 2 _≡_ 363 | -------------------------------------------------------------------------------- /Session1.agda: -------------------------------------------------------------------------------- 1 | {- 2 | 3 | |--------------------------------------------------| 4 | | Formal systems and their applications: exercises | 5 | | Session 1: Agda basics | 6 | |--------------------------------------------------| 7 | 8 | Welcome to the exercise session on the Agda language! These exercise sessions are 9 | meant to make you familiar with Agda and the agda-mode for emacs. 10 | 11 | Agda is both a programming language and a proof assistant: you can use it to write 12 | programs and then prove properties of these programs, and Agda will check these 13 | proofs for you. Note that Agda is *not* an automatic prover, so you have to write 14 | proofs yourself (though Agda can sometimes help you with that). 15 | 16 | These exercises contain instructions and explanations that will help you to solve 17 | them. These instructions are written in comments, either between {- -} or after -- 18 | and are ignored by Agda. 19 | 20 | The full documentation of Agda can be found at agda.readthedocs.io 21 | 22 | 23 | Part 1: Booleans and natural numbers 24 | ==================================== 25 | 26 | By default, Agda is a very barebones language with only few builtin types, 27 | so we have to define types like numbers and booleans ourselves. Let's start by 28 | defining the type of booleans. This is done by a 'data' declaration: 29 | -} 30 | 31 | data Bool : Set where 32 | true : Bool 33 | false : Bool 34 | 35 | {- 36 | The first line of this definition declares a new type called Bool. The two subsequent 37 | lines declare two terms of this type: true and false, both of type Bool. These are 38 | called the constructors of the datatype. To check this definition, select "load" in the 39 | Agda menu (or press Ctrl+c followed by Ctrl+l; hence the menu item shows C-c C-l). 40 | This 'loads' the file. 41 | If everything goes right, the code will be colored and you get a list of unsolved goals 42 | like "?0 : Bool". It's a good idea to (re)load the file often so you know everything is 43 | still fine. 44 | WARNING: Error messages will generally appear below this list of goals, so scroll down! 45 | 46 | Next, let's define our first function: negation. Since Agda supports unicode syntax, 47 | we can use the mathematical symbol '¬' for negation. In emacs, you can enter this 48 | symbol by simply writing \lnot. Here are some other unicode symbols we will use: 49 | 50 | Type this... to write this... 51 | \to → 52 | \lnot ¬ 53 | \or or \vee ∨ 54 | \and or \wedge ∧ 55 | \_1, \_2, ... ₁, ₂, ₃, ... 56 | \equiv or \== ≡ 57 | 58 | When you're in the middle of entering a unicode character (i.e. you've typed a backslash 59 | and a couple of characters) pres tab to see your options. 60 | The unicode input mode should be enabled by default in emacs, but you can enable 61 | or disable the unicode input mode by pressing Ctrl-\. 62 | If you see a unicode character and want to know how to type it, put the text cursor 63 | on it and select "Information about the character at point" in the "Agda" menu. 64 | 65 | The possibility to use any unicode character in an identifier, requires that all 66 | identifiers be separated by whitespace. E.g. since `¬x` is a single valid identifier, 67 | negation of x should be written `¬ x`. 68 | This is even true for characters such as `=` and `:` and `,`. 69 | 70 | Here is an incomplete definition of negation: 71 | -} 72 | 73 | ¬ : Bool → Bool 74 | ¬ x = {!!} 75 | 76 | {- 77 | Take a look at the first line, this is the type declaration. It says 78 | that ¬ is a function taking one argument of type Bool and returning a Bool. 79 | 80 | The second line is the definition, but it is incomplete: it contains a hole. 81 | Holes are parts of your Agda program that you haven't written yet. They are 82 | useful because they allow you to typecheck some part of the program before 83 | it's finished, and Agda can even give you the type of each hole. For example, 84 | after loading the file, Agda will tell you `?0 : Bool`, meaning that the 85 | hole we have here, should be replaced with some value of type `Bool`. 86 | 87 | To add a hole 88 | yourself, you can write ? or {!utter nonsense!} anywhere in your code and reload 89 | the file (press C-c C-l). The {!...!} approach is useful if you temporarily want to 90 | replace some meaningful or erroneous code with a hole. 91 | 92 | To complete the definition of ¬, place your cursor inside the hole and press 93 | C-c C-c to perform a case split. Agda will ask you on which variable to do a 94 | case split, type x and press enter. This will generate two cases: `¬ true = ?` 95 | and `¬ false = ?`. To give the result in each of these cases, again place your 96 | cursor inside the first hole, write the desired expression and press C-c C-space 97 | to confirm. 98 | 99 | Here is a list of some useful commands for interacting with Agda: 100 | 101 | C-c C-l Load file 102 | Note: if you've changed code outside a hole since the last load, 103 | then the Agda interaction commands may be using outdated information. 104 | Reload often! 105 | 106 | C-c C-d Deduce (infer) type of term 107 | C-c C-n Normalize (evaluate) term 108 | C-c C-, (inside hole) Information about hole (context and type of the hole) 109 | ^^ THIS ONE IS EXTREMELY USEFUL! Use it often! 110 | C-c C-. (inside hole) Same as C-c C-d and C-c C-, combined. 111 | C-c C-c (inside hole) Case split 112 | C-c C-space (inside hole) Give solution 113 | C-c C-r (inside hole) Refine, using the goal's type and textual content 114 | C-u C-u <...> Do <...> but produce normalized (maximally computed) output 115 | 116 | C-g Cancel whatever you're doing 117 | 118 | More commands can be found in the Agda menu of Emacs, and even more at 119 | https://agda.readthedocs.io/en/v2.6.0.1/tools/emacs-mode.html 120 | 121 | Now try to define 'and' and 'or' on booleans yourself by using case splitting. 122 | These functions have type Bool → Bool → Bool. The arrow (→) is right associative, 123 | so this should be read as Bool → (Bool → Bool), i.e. they are functions that take 124 | one boolean and return another function that takes another boolean and returns a boolean. 125 | 126 | The underscores in the names of a function mean that it uses mixfix syntax. 127 | They indicate the positions where the arguments should go, i.e. `a ∧ b` desugars to `_∧_ a b`. 128 | 129 | Try to use as few cases as possible (i.e. two cases). 130 | -} 131 | 132 | _∧_ : Bool → Bool → Bool 133 | x ∧ y = {!!} 134 | 135 | _∨_ : Bool → Bool → Bool 136 | x ∨ y = {!!} 137 | 138 | {- 139 | Here is a polymorphic definition of the if-then-else function. 140 | The accolad notation {A : Set} means that A is an implicit (i.e. hidden) 141 | argument, so Agda tries to fill it in for you when you call the function. 142 | -} 143 | if_then_else_ : {A : Set} → Bool → A → A → A 144 | (if true then x else y) = x 145 | (if false then x else y) = y 146 | 147 | 148 | {- We can give an alternative definition of negation in terms of if_then_else_: -} 149 | ¬-alt : Bool → Bool 150 | ¬-alt x = if x then false else true 151 | 152 | {- 153 | The type A can be any type, in particular also a function type 154 | such as Bool → Bool → Bool. This is called a higher-order function because 155 | it is a function that returns a function itself. 156 | -} 157 | weird : Bool → (Bool → Bool → Bool) 158 | weird x = if x then _∧_ else _∨_ 159 | 160 | {- 161 | To understand the definition of weird, you can ask Agda to evaluate 162 | it for specific arguments. To do so, press C-c C-n, type in a term 163 | (for example `weird false true false`) and press enter. 164 | 165 | Next up, we will define (unary) natural numbers. A natural number is 166 | either zero or the successor of another natural number: 167 | -} 168 | data Nat : Set where 169 | zero : Nat 170 | suc : Nat → Nat 171 | 172 | {- 173 | The following pragma allows you to write regular numbers 0,1,2,... instead of zero, 174 | suc zero, suc (suc zero), ...: 175 | -} 176 | {-# BUILTIN NATURAL Nat #-} 177 | 178 | {- Here is an example of a function on natural numbers: addition. -} 179 | _+_ : Nat → Nat → Nat 180 | zero + n = n 181 | suc m + n = suc (m + n) 182 | {- 183 | The sum `3 + 2` will now compute as follows: 184 | 3 + 2 = suc (2 + 2) = suc (suc (1 + 2)) = suc (suc (suc (0 + 2))) = suc (suc (suc 2)) 185 | -} 186 | 187 | {- Now try to define the following functions yourself: -} 188 | is-zero : Nat → Bool 189 | is-zero n = {!!} 190 | 191 | _-_ : Nat → Nat → Nat -- Return zero instead of negative numbers 192 | m - n = {!!} 193 | 194 | minimum : Nat → Nat → Nat 195 | minimum m n = {!!} 196 | 197 | maximum : Nat → Nat → Nat 198 | maximum m n = {!!} 199 | 200 | _*_ : Nat → Nat → Nat 201 | m * n = {!!} 202 | 203 | {- 204 | If Agda marks (part of) your definition in salmon-orange after you reload the file, 205 | this means that Agda cannot see that your function is terminating. This is also the 206 | case if you give an obviously non-terminating definition such as 207 | 208 | f : Nat → Nat 209 | f x = f x 210 | 211 | Agda is a total language, so it will reject any not-obviously terminating function. 212 | To make sure that Agda can see your function is terminating, write it in a way 213 | that the arguments always become smaller in each recursive call. 214 | -} 215 | 216 | {- 217 | Part 2: Proving basic properties 218 | ================================ 219 | 220 | Now as we said before, Agda is not just a programming language but also a proof 221 | assistant. This means we can use Agda to formulate theorems and prove them, 222 | and Agda will check that the proofs are correct. 223 | 224 | Under the Curry-Howard correspondence, types correspond to propositions and 225 | terms of a type correspond to proofs of the corresponding proposition. So in Agda, 226 | we state a proposition by giving a type, and we prove it by writing a program 227 | of that type. 228 | Therefore, in order to be able to use Agda as a proof assistant, it is paramount 229 | to understand the Curry-Howard correspondence. 230 | 231 | As an example, the type "A → B" in Agda corresponds to the proposition "A implies B". 232 | Here are some other types corresponding to propositional logic. 233 | -} 234 | 235 | -- Trivial (top) type (unicode: \top). This corresponds to the proposition True. 236 | data ⊤ : Set where 237 | tt : ⊤ 238 | 239 | -- Empty (bottom) type (unicode: \bot). This corresponds to the proposition False. 240 | data ⊥ : Set where 241 | -- no constructors 242 | 243 | -- Product type (unicode: \times or \x). 244 | -- This is the type of pairs of an `x : A` and a `y : B`. 245 | -- This corresponds to the proposition "A and B". 246 | -- The first line of this definition says that, for all `A : Set` and `B : Set`, we have 247 | -- `A × B : Set`. These type parameters A and B are in scope in the constructors' types. 248 | data _×_ (A B : Set) : Set where 249 | _,_ : A → B → A × B 250 | 251 | fst : {A B : Set} → A × B → A 252 | fst (x , y) = x 253 | 254 | snd : {A B : Set} → A × B → B 255 | snd p = {!!} 256 | 257 | -- Coproduct type (unicode: \uplus). 258 | -- Elements are either `left x` with `x : A` or `right y` with `y : B`. 259 | -- This corresponds to the proposition "A or B". 260 | data _⊎_ (A B : Set) : Set where 261 | left : A → A ⊎ B 262 | right : B → A ⊎ B 263 | 264 | {- Prove the following propositions by giving a term of the given type: -} 265 | 266 | -- "If A and B, then B and A" 267 | -- hint: Agda is smart. After case splitting, try refining the goal using C-c C-r. 268 | ×-comm : {A B : Set} → A × B → B × A 269 | ×-comm p = {!!} 270 | 271 | -- "If A and (B or C), then (A and B) or (A and C)" 272 | -- Hint: use C-c C-, to see the type of variables in scope 273 | distr : {A B C : Set} → A × (B ⊎ C) → (A × B) ⊎ (A × C) 274 | distr p = {!!} 275 | 276 | -- Modus ponens: "If (A implies B) and A, then B" 277 | app : {A B : Set} → (A → B) × A → B 278 | app p = {!!} 279 | 280 | 281 | {- 282 | Part 3: Record types 283 | ==================== 284 | So far, we have defined types by giving their constructors, i.e. by specifying how we 285 | can create elements of the type. We then used values of these types by case splitting 286 | (pattern matching) over how they were constructed. 287 | 288 | We can also do the converse, and define a type by specifying how we can use its elements, 289 | i.e. by specifying a list of fields that all elements must have. Then we can use values 290 | of that type by using their fields, and we can create values by specifying the value of 291 | each field. This provides an alternative way of defining the product type. 292 | 293 | Types defined this way are called codata or record types. One way to create elements is 294 | by using the constructor, whose arguments are simply the fields of the record. In this 295 | sense, a record type can be regarded as an ordinary data type with exactly one constructor. 296 | 297 | We can redefine the product type as a record type with two fields: 298 | -} 299 | record _×'_ (A B : Set) : Set where 300 | constructor _,'_ 301 | field 302 | fst' : A 303 | snd' : B 304 | {- 305 | By default, we have to refer to the fields as _×'_.fst' and _×'_.snd'. By 'opening' 306 | the module _×'_, we can simply write fst' and snd' 307 | -} 308 | open _×'_ 309 | 310 | {- 311 | We can now create elements of the record type by co-pattern-matching, i.e. case splitting 312 | over the field of the result that the function's caller will be interested in. Put the 313 | cursor in the hole below, press C-c C-c and 'split on the result' by pressing enter 314 | without providing a variable to pattern match over. 315 | -} 316 | ×'-comm : {A B : Set} → A ×' B → B ×' A 317 | ×'-comm p = {!!} 318 | {- 319 | However, we can still treat _×'_ as a data type and prove commutativity of _×'_ in exactly 320 | the same way we proved it for _×_, i.e. by pattern matching over p: 321 | -} 322 | ×'-comm' : {A B : Set} → A ×' B → B ×' A 323 | ×'-comm' p = {!!} 324 | 325 | {- 326 | Part 4: The identity type 327 | ========================= 328 | 329 | With only propositional logic, we won't be able to prove very interesting theorems. 330 | This is where Agda's dependent types come in. They allow us to write any (functional) 331 | property that we can think of as a type in Agda. In this exercise session, we give 332 | only one example (albeit a very important one): 333 | 334 | Something we often want to prove is that two things are equal, for example we want to 335 | prove that ¬ (¬ true) is equal to true. For this purpose, we introduce the type 336 | _≡_ (unicode input: \equiv or \==): 337 | -} 338 | 339 | data _≡_ {A : Set} : A → A → Set where 340 | refl : {x : A} → x ≡ x 341 | 342 | {- 343 | This type is called identity type or (propositional) equality type. 344 | 345 | This is the first example we encounter of a dependent type: a type that depends 346 | on values. In particular, we have the type 'x ≡ y' that depends on the values of 347 | x and y. 348 | 349 | The terms of type `x ≡ y` can be interpreted as proofs that x equals y. 350 | Thus, the type `x ≡ y` expresses that x and y are *provably* equal. 351 | This is called *propositional* equality. 352 | 353 | The only constructor of this type is refl (short for reflexivity). Note that `refl` 354 | only allows us to construct a term of type `x ≡ x` for some x, so we can only use 355 | the constructor `refl` to prove `x ≡ y` if `x` and `y` are in fact the same: 356 | -} 357 | 358 | refl-example : 3 ≡ 3 359 | refl-example = {!!} 360 | 361 | refl-counterexample : 3 ≡ 4 362 | refl-counterexample = {!!} 363 | 364 | {- 365 | By "the same", here, we mean *definitionally/judgementally* equal, which means 366 | that Agda can recognize equality of `x` and `y` simply by unfolding all definitions. 367 | For example, the following works by definition of `_+_`: 368 | -} 369 | 370 | refl-example' : 2 + 3 ≡ 5 371 | refl-example' = {!!} 372 | 373 | {- 374 | In short: `refl` allows to prove that an equation holds definitionally if 375 | it holds propositionally. 376 | 377 | We will later see how we can derive the 378 | other properties of equality (such as symmetry and transitivity). 379 | -} 380 | 381 | {- (Side note for the curious) 382 | Observe how the type *parameter* {A : Set} is before the colon, whereas the *indices* `A → A →` are behind it. 383 | So the first line says: for every {A : Set} (passed implicitly), we get a dependent type `_≡_ : A → A → Set`. 384 | The difference between putting variables before or after the colon is the following: 385 | * Type parameters are fixed (and in scope) throughout the definition: every constructor creates instances of the 386 | equality type for the same value of A. 387 | * Type indices are not fixed throughout the definition. Our choice of constructor, and even the choice of 388 | arguments we pass to the constructor, determines the indices in the type of the constructed object. 389 | -} 390 | 391 | {- 392 | One very useful application of the identity type is to write tests that are 393 | automatically checked by Agda. For example, we can write a test that 394 | ¬ (¬ true) is equal to true: 395 | -} 396 | 397 | ¬¬true : ¬ (¬ true) ≡ true 398 | ¬¬true = {!refl!} 399 | 400 | {- 401 | If you implemented the function ¬ correctly, you should be able to fill in 402 | refl in the hole (using C-c C-space). To see what happens when you try to 403 | prove a false statement, you can go back to the definition of ¬ and change 404 | "¬ false = true" into "¬ false = false" and reload the file (using C-c C-l). 405 | 406 | Hint: If you put the cursor in a hole and press C-u C-u C-c C-, then you get 407 | normalized (C-u C-u <...>) information about the hole (C-c C-,), including 408 | its normalized type. Above, this should be `true ≡ true`. Below, this 409 | should be `3 ≡ 3`: 410 | -} 411 | 412 | 3+5-5 : (3 + 5) - 5 ≡ 3 413 | 3+5-5 = {!!} 414 | 415 | {- 416 | If you want, you can try to come up with some additional tests about the functions 417 | you defined earlier and implement them by using refl. 418 | -} 419 | 420 | -- Write more tests here 421 | 422 | {- 423 | You can also prove more general facts by adding arguments to a theorem, for example: 424 | -} 425 | ¬¬-elim : (b : Bool) → ¬ (¬ b) ≡ b 426 | {- 427 | To prove this lemma, you cannot use refl straight away because Agda will not compute 428 | `¬ (¬ b)` when `b` is a variable. Indeed, we have only provided definitions for 429 | `¬ true` and `¬` false, so you first have to do a case split on b (using C-c C-c). 430 | -} 431 | ¬¬-elim b = {!!} 432 | 433 | {- Also try to prove the following lemmas: -} 434 | 435 | ∧-same : (b : Bool) → b ∧ b ≡ b 436 | ∧-same b = {!!} 437 | 438 | if-same : {A : Set} → (b : Bool) → (x : A) → (if b then x else x) ≡ x 439 | if-same b x = {!!} 440 | 441 | 442 | {- 443 | Part 5: refl patterns and absurd patterns 444 | ========================================= 445 | Here are some useful general properties of equality: symmetry, transitivity, 446 | and congruence. To prove them, we have to match on a value of type x ≡ y, i.e. 447 | a proof that x equals y. Since the only constructor of the identity type is 448 | refl, there is always only one case. However, pattern matching on refl is not 449 | useless: by pattern matching on a proof of x ≡ y, we learn something about 450 | x and y, namely that they are the same. 451 | In the definitions of `sym` and `trans` below, we make hidden arguments explicit. 452 | Note that the third argument of sym is not {y}, but {.x}. The dot (.) here 453 | indicates that the argument MUST be x for the pattern `refl` to make sense. 454 | Agda fills out these dotted arguments automatically when you use C-c C-c. 455 | -} 456 | 457 | sym : {A : Set} {x y : A} → x ≡ y → y ≡ x 458 | sym {A}{x}{.x} refl = refl 459 | 460 | trans : {A : Set} {x y z : A} → x ≡ y → y ≡ z → x ≡ z 461 | trans {A}{x}{.x}{.x} refl refl = refl 462 | 463 | {- Now try to prove congruence yourself: -} 464 | 465 | cong : {A B : Set} (f : A → B) {x y : A} → x ≡ y → f x ≡ f y 466 | cong f {x}{y} p = {!!} 467 | 468 | {- 469 | If you have a proof of an absurd equality (for example true ≡ false), 470 | you can write () in place to skip the proof. This is called an absurd pattern. 471 | Agda allows you to skip this case because it is impossible to ever construct 472 | a closed term of type 'true ≡ false' anyway. 473 | -} 474 | true-not-false : true ≡ false → ⊥ 475 | true-not-false () 476 | 477 | {- 478 | Absurd patterns also work for the empty type. Prove that a contradiction implies anything. 479 | You can do this by pattern matching on `contradiction` (C-c C-c). 480 | -} 481 | ⊥-elim : {A : Set} → ⊥ → A 482 | ⊥-elim contradiction = {!!} 483 | 484 | {- 485 | Now use absurd patterns to prove that a natural number cannot be both zero and one. 486 | You may have to do a non-absurd case split on one of the arguments first. Try three 487 | different approaches: 488 | -} 489 | not-zero-and-one : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 490 | not-zero-and-one n eq0 eq1 = {!!} 491 | 492 | not-zero-and-one' : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 493 | not-zero-and-one' n eq0 eq1 = {!!} 494 | 495 | not-zero-and-one'' : (n : Nat) → n ≡ 0 → n ≡ 1 → ⊥ 496 | not-zero-and-one'' n eq0 eq1 = {!!} 497 | 498 | --Note: Recent versions of Agda allow omitting certain absurd cases altogether. 499 | 500 | {- 501 | Here's another exercise: if 'b ∨ false' is equal to true, then b must be equal to true. 502 | Hint: if you start by trying to pattern match on `eq`, you get a very interesting error 503 | message. 504 | -} 505 | ∨-first : (b : Bool) → b ∨ false ≡ true → b ≡ true 506 | ∨-first b eq = {!!} 507 | 508 | {- 509 | Pattern matching over an equality proof p : a ≡ b is only possible if a and b are: 510 | 1. obviously different (then you get an absurd pattern), 511 | 2. easy to equate. For example, if p : suc x ≡ 3, then pattern matching over p will replace x with 2. 512 | However, if p : x * 4 ≡ 12, then Agda is not smart enough to perform the division 513 | and conclude that x can be replaced with 3. It will tell you so when you try to match over p. 514 | -} 515 | 516 | easy-match : {x : Nat} → suc x ≡ 3 → x ≡ 2 517 | easy-match {x} p = {!!} 518 | 519 | harder-match : {x : Nat} → x * 4 ≡ 12 → x ≡ 3 520 | harder-match {x} p = {!!} 521 | 522 | {- 523 | Finally, it is worth noting that equality proofs contain no information other than their 524 | existence. Indeed, all proofs of the same equality are equal. This fact is called uniqueness 525 | of identity proofs (UIP) and is by default provable in Agda: 526 | -} 527 | uip : {A : Set} {x y : A} {p q : x ≡ y} → p ≡ q 528 | uip {A}{x}{y}{p}{q} = {!!} 529 | {- 530 | TRIVIA: 531 | Homotopy Type Theory (HoTT), an active domain of research, investigates the virtues of 532 | not having UIP and instead viewing equality proofs as data. This is beyond the scope 533 | of the Formal Systems course. 534 | The --without-K option in Agda disables the above proof of UIP. See the section titled 535 | 'Without K' in the Agda documentation for more information. 536 | To activate --without-K in this file, add the following line at the top of this file: 537 | {-# OPTIONS --without-K #-} 538 | -} 539 | 540 | 541 | 542 | {- 543 | Part 6: More properties of natural numbers 544 | ========================================== 545 | 546 | As people, we know that 0 + n = n and n = n + 0. 547 | The first equality is easy to prove ... 548 | -} 549 | plus0-left : (n : Nat) → 0 + n ≡ n 550 | plus0-left n = {!!} 551 | 552 | {- ... but the second one is a bit harder. 553 | 554 | This is because Agda cannot compute `n + 0` when n is a variable, 555 | since it doesn't know which case of the definition of _+_ it should apply. 556 | In general, in order to prove something about a function defined by pattern-matching, 557 | it is a good idea to pattern-match in a similar way in the proof. 558 | -} 559 | plus0-right : (n : Nat) → n + 0 ≡ n 560 | plus0-right n = {!!} 561 | {- 562 | hint 1: you can make a recursive call `plus0-right n` to get a proof of `n + 0 ≡ n` 563 | Under the Curry-Howard correspondence, a recursive function corresponds to 564 | a proof by induction. 565 | hint 2: you may need to invoke the `cong` lemma from above to finish the proof. 566 | -} 567 | 568 | --Can you figure out how Agda computes the following term? (Use C-c C-n to view the computation result.) 569 | plus0-right-example : 3 + 0 ≡ 3 570 | plus0-right-example = plus0-right 3 571 | 572 | {- 573 | Prove that addition on natural numbers is associative. Try to use as few cases 574 | as possible. (It's possible to use only 2!) 575 | -} 576 | plus-assoc : (k l m : Nat) → k + (l + m) ≡ (k + l) + m 577 | plus-assoc k l m = {!!} 578 | 579 | {- 580 | Now prove that addition is commutative. This proof is harder than the ones before, 581 | so you may have to introduce a helper function to finish it. 582 | -} 583 | plus-comm : (m n : Nat) → m + n ≡ n + m 584 | plus-comm m n = {!!} 585 | 586 | 587 | 588 | {- 589 | Part 7: Lambda-abstractions and functions 590 | ========================================= 591 | So far, we have been defining named functions: each function is first declared 592 | by giving its name and type, and then defined by giving one or more equations. 593 | However, we can also define nameless functions inline. The syntax is 594 | 595 | λ args → body 596 | 597 | or 598 | 599 | \ args → body 600 | 601 | You can input λ as \lambda or \Gl (Greek l), and \ as \\. 602 | 603 | Prove the following lemma: 604 | If (A or B) implies C, then A implies C and B implies C 605 | -} 606 | split-assumption : {A B C : Set} → (A ⊎ B → C) → (A → C) × (B → C) 607 | split-assumption f = {!!} 608 | 609 | --note that we do not need lambda-abstractions when we use _×'_: 610 | split-assumption' : {A B C : Set} → (A ⊎ B → C) → (A → C) ×' (B → C) 611 | fst' (split-assumption' f) a = {!!} 612 | snd' (split-assumption' f) b = {!!} 613 | 614 | {- 615 | State and prove (using _×_): 616 | If A implies (B and C), then A implies B and A implies C 617 | -} 618 | 619 | {- 620 | We can also define inline pattern matching functions. The syntax is: 621 | 622 | λ { args-case1 → body-case1 623 | ; absurd-args-case2 624 | ; args-case3 → body-case3 625 | ... 626 | ; args-caseN → body-caseN 627 | } 628 | 629 | or 630 | 631 | λ where 632 | args-case1 → body-case1 633 | absurd-args-case2 634 | args-case3 → body-case3 635 | ... 636 | args-caseN → body-caseN 637 | 638 | Since the different arguments are separated just by spaces, a single argument 639 | consisting of a pattern should be placed in parentheses, e.g. `(left x)`. 640 | 641 | If the first argument's type is already empty, we can simply write `λ ()`. 642 | -} 643 | lemma : {A B : Set} → (A → B) → (A ⊎ ⊥ → B) × (⊥ → A) 644 | lemma f = {!!} 645 | 646 | 647 | {- 648 | As we have seen before, functions can take implicit arguments. 649 | Agda then inserts the only possible argument that leads to a well-typed term. 650 | However, sometimes there is more than one possibility. Agda notifies you with a 651 | yellow highlight and a warning in the output. 652 | 653 | Consider the following: 654 | -} 655 | const : {A B : Set} → A → B → A 656 | const a b = a 657 | ambiguous-function : Bool → ⊥ → Nat 658 | ambiguous-function bool bot = 659 | {!const 5 (if bool then ⊥-elim bot else ⊥-elim bot)!} 660 | {- 661 | Put the cursor in the hole above and press C-c C-space to replace it with it's contents. Reload. 662 | Figure out why Agda cannot possibly figure out the type of the if-expression. (Could you infer it?) 663 | 664 | We can solve this by making one of the arguments of `const`, `⊥-elim` or `if_then_else_` 665 | explicit: 666 | * We can write `⊥-elim {Bool} bot` in either the `then` or the `else` clause. 667 | The accolads notify that you are passing an implicit argument. 668 | * We can make the implicit argument of `if_then_else_` explicit. Since there is no mixfix syntax for this, 669 | we have to write 670 | `if_then_else_ {Bool} bool (⊥-elim bot) (⊥-elim bot)` 671 | * We can make the second implicit argument of `const` explicit. This can be done by writing: 672 | `const {_} {Bool}` (an underscore asks Agda to fill in the only possible well-typed value), 673 | `const {B = Bool}` (the B points to the argument called B in the type of `const`) 674 | 675 | Fix the above definition so that there are no more yellow highlights. 676 | -} 677 | 678 | {- 679 | Lambda-expressions, like named functions, can take implicit arguments: 680 | -} 681 | if-zero : Nat → {A : Set} → A → A → A 682 | if-zero = λ {zero {A} a b → a ; 683 | (suc n) {A} a b → b} 684 | 685 | {- 686 | Furthermore, it's good to know that there are a few abberviations for function types. 687 | Most importantly: 688 | 689 | 1. If we introduce multiple NAMED variables at once, we may omit arrows between them. 690 | The arrow after the last named variable introduction, must stay. 691 | -} 692 | -- both arguments explicit, with arrow 693 | refl₁ : (A : Set) → (a : A) → a ≡ a 694 | refl₁ A a = refl 695 | -- both arguments explicit, omit arrow in between (last arrow must stay) 696 | refl₂ : (A : Set) (a : A) → a ≡ a 697 | refl₂ A a = refl 698 | -- one argument explicit, with arrow 699 | refl₃ : {A : Set} → (a : A) → a ≡ a 700 | refl₃ a = refl 701 | -- one argument explicit, omit arrow in between (last arrow must stay) 702 | refl₄ : {A : Set} (a : A) → a ≡ a 703 | refl₄ a = refl 704 | {- 705 | 2. We can omit the type signatures of named variables, provided that we put a 706 | ∀ (\forall) symbol in front of them. 707 | Agda will then infer the variable's type, if possible. 708 | -} 709 | -- Implicit A without type signature, explicit a 710 | refl₅ : ∀ {A} (a : A) → a ≡ a 711 | refl₅ a = refl 712 | -- Explicit A without type signature, implicit a 713 | refl₆ : ∀ A {a : A} → a ≡ a 714 | refl₆ A = refl 715 | -- Explicit A and a, both without type signature. 716 | -- Uncomment and see what's wrong. Fix it somehow. 717 | --refl₇ : ∀ A a → a ≡ a 718 | --refl₇ A a = refl 719 | 720 | 721 | {- 722 | Part 8: Decidable equality 723 | ========================= 724 | 725 | A type is decidable if we can either give a concrete element of that type 726 | (`yes`) or prove that there is definitely no such element (`no`). 727 | -} 728 | data Dec (A : Set) : Set where 729 | yes : A → Dec A 730 | no : (A → ⊥) → Dec A 731 | {- 732 | Note that we could equivalently define `Dec A = A ⊎ (A → ⊥)`, but with 733 | the above definition we get to choose specialized constructor names instead 734 | of reusing `left` and `right`. 735 | -} 736 | 737 | {- 738 | A decision procedure for a property P is a function that returns a decision 739 | of `Dec (P x)` for every argument x. For example, we can decide whether two 740 | booleans are equal: 741 | -} 742 | equalBool? : (x y : Bool) → Dec (x ≡ y) 743 | equalBool? x y = {!!} 744 | 745 | {- 746 | Decidable equality for natural numbers is a little trickier because we need 747 | a new piece of syntax called `with`. The `with` construct allows you to analyse 748 | the value of a recursive call, which you need to complete the proof that equality 749 | on natural numbers is decidable. 750 | -} 751 | equalNat? : (m n : Nat) → Dec (m ≡ n) 752 | equalNat? zero zero = {!!} 753 | equalNat? zero (suc n) = {!!} 754 | equalNat? (suc m) zero = {!!} 755 | -- 756 | equalNat? (suc m) (suc n) with equalNat? m n 757 | equalNat? (suc m) (suc n) | yes eq = {!!} 758 | equalNat? (suc m) (suc n) | no neq = {!!} 759 | 760 | 761 | 762 | 763 | 764 | 765 | 766 | 767 | -- Declaring precedence rules for operators (ignore this for now) 768 | infixl 6 _∧_ 769 | infixl 5 _∨_ 770 | infix 4 if_then_else_ 771 | infixl 10 _+_ 772 | infixl 12 _*_ 773 | infix 2 _≡_ 774 | -------------------------------------------------------------------------------- /Session2-solution.agda: -------------------------------------------------------------------------------- 1 | {- 2 | 3 | |--------------------------------------------------| 4 | | Formal systems and their applications: exercises | 5 | | Session 2: Lists and vectors | 6 | |--------------------------------------------------| 7 | 8 | -} 9 | 10 | -- Part 0: A note on the Agda standard library 11 | --============================================ 12 | 13 | {- 14 | open import Session1-solution 15 | -} 16 | 17 | open import Data.Nat renaming (ℕ to Nat ; _≟_ to equalNat? ; _∸_ to _-_) hiding (pred ; _≤_ ; compare {- ; NonZero -}) 18 | open import Relation.Binary.PropositionalEquality 19 | open import Data.Bool renaming (not to ¬) hiding (_≤_) 20 | open import Data.Unit hiding (_≤_) 21 | open import Data.Sum hiding (map) renaming (inj₁ to left ; inj₂ to right) 22 | open import Relation.Nullary hiding (¬_) 23 | is-zero : Nat → Bool 24 | is-zero zero = true 25 | is-zero (suc n) = false 26 | 27 | 28 | -- Part 1: Lists 29 | --============== 30 | 31 | data List (A : Set) : Set where 32 | [] : List A 33 | _::_ : (x : A) → (xs : List A) → List A 34 | 35 | infixr 15 _::_ 36 | 37 | example-list : List Nat 38 | example-list = 1 :: 2 :: 3 :: [] 39 | 40 | 41 | length : {A : Set} → List A → Nat 42 | length [] = zero 43 | length (x :: xs) = suc (length xs) 44 | 45 | length-test₁ : length {A = Nat} [] ≡ 0 46 | length-test₁ = refl 47 | 48 | length-test₂ : length example-list ≡ 3 49 | length-test₂ = refl 50 | 51 | -- First, try to explain why we cannot define a head function of type 52 | -- `{A : Set} → List A → A`. 53 | 54 | -- ANSWER: it is not clear what would be the head of the empty list `[]`. 55 | 56 | data Maybe (A : Set) : Set where 57 | just : (x : A) → Maybe A 58 | nothing : Maybe A 59 | 60 | head : {A : Set} → List A → Maybe A 61 | head [] = nothing -- as found by C-c C-a 62 | head (x :: xs) = just x -- C-c C-a finds `head xs`. 63 | 64 | tail : {A : Set} → List A → Maybe (List A) 65 | tail [] = nothing -- as found by C-c C-a 66 | tail (x :: xs) = just xs -- C-c C-a finds `tail xs` 67 | 68 | _++_ : {A : Set} → List A → List A → List A 69 | [] ++ ys = ys 70 | (x :: xs) ++ ys = x :: (xs ++ ys) 71 | 72 | ++-test₁ : example-list ++ [] ≡ example-list 73 | ++-test₁ = refl 74 | 75 | ++-test₂ : (1 :: []) ++ (2 :: 3 :: []) ≡ example-list 76 | ++-test₂ = refl 77 | 78 | ++-length : {A : Set} (xs ys : List A) → length (xs ++ ys) ≡ length xs + length ys 79 | ++-length [] ys = refl 80 | ++-length (x :: xs) ys = cong suc (++-length xs ys) 81 | 82 | map : {A B : Set} → (A → B) → List A → List B 83 | map f [] = [] 84 | map f (x :: xs) = f x :: map f xs 85 | 86 | map-test : map suc example-list ≡ 2 :: 3 :: 4 :: [] 87 | map-test = refl 88 | 89 | double-all : List Nat → List Nat 90 | double-all xs = map (λ x → x + x) xs 91 | 92 | double-all-test : double-all example-list ≡ 2 :: 4 :: 6 :: [] 93 | double-all-test = refl 94 | 95 | map-length : {A B : Set} (f : A → B) (xs : List A) → length (map f xs) ≡ length xs 96 | map-length f [] = refl 97 | map-length f (x :: xs) = cong suc (map-length f xs) 98 | 99 | lookup : {A : Set} → List A → Nat → Maybe A 100 | lookup [] n = nothing 101 | lookup (x :: xs) zero = just x 102 | lookup (x :: xs) (suc n) = lookup xs n 103 | 104 | lookup-test₁ : lookup example-list 1 ≡ just 2 105 | lookup-test₁ = refl 106 | 107 | lookup-test₂ : lookup example-list 5 ≡ nothing 108 | lookup-test₂ = refl 109 | 110 | 111 | 112 | -- Part 2: Vectors 113 | --================ 114 | 115 | data Vec (A : Set) : Nat → Set where 116 | []v : Vec A 0 117 | _::v_ : {n : Nat} → A → Vec A n → Vec A (suc n) 118 | 119 | infixr 15 _::v_ 120 | 121 | example-vec : Vec Nat 3 122 | example-vec = 1 ::v 2 ::v 3 ::v []v 123 | 124 | head-v : {A : Set} {n : Nat} → Vec A (suc n) → A 125 | head-v {A} {n} (x ::v xs) = x 126 | 127 | tail-v : {A : Set} {n : Nat} → Vec A (suc n) → Vec A n 128 | tail-v {A} {n} (x ::v xs) = xs 129 | 130 | -- Create a vector of length n containing only the number 0: 131 | zero-vec : (n : Nat) → Vec Nat n 132 | zero-vec zero = []v 133 | zero-vec (suc n) = 0 ::v (zero-vec n) 134 | 135 | _++v_ : {A : Set} {m n : Nat} → Vec A m → Vec A n → Vec A (m + n) 136 | []v ++v ys = ys 137 | (x ::v xs) ++v ys = x ::v (xs ++v ys) 138 | 139 | map-v : {A B : Set} {n : Nat} → (A → B) → Vec A n → Vec B n 140 | map-v {A} {B} {.0} f []v = []v 141 | map-v {A} {B} {.(suc _)} f (x ::v xs) = (f x) ::v (map-v f xs) 142 | 143 | _·_ : {n : Nat} → Vec Nat n → Vec Nat n → Nat 144 | []v · []v = zero 145 | (x ::v xs) · (y ::v ys) = (x * y) + (xs · ys) 146 | 147 | ·-test : example-vec · map-v suc example-vec ≡ 20 148 | ·-test = refl 149 | 150 | data Fin : Nat → Set where 151 | zero-f : {n : Nat} → Fin (suc n) 152 | suc-f : {n : Nat} → Fin n → Fin (suc n) 153 | 154 | zero-Fin3 : Fin 3 155 | zero-Fin3 = zero-f 156 | 157 | one-Fin3 : Fin 3 158 | one-Fin3 = suc-f zero-f 159 | 160 | two-Fin3 : Fin 3 161 | two-Fin3 = suc-f (suc-f zero-f) 162 | 163 | lookup-v : {A : Set} {n : Nat} → Fin n → Vec A n → A 164 | lookup-v {A} {.(suc _)} zero-f (x ::v xs) = x 165 | lookup-v {A} {.(suc _)} (suc-f i) (x ::v xs) = lookup-v i xs 166 | 167 | put-v : {A : Set} {n : Nat} → Fin n → A → Vec A n → Vec A n 168 | put-v zero-f a (x ::v xs) = a ::v xs 169 | put-v (suc-f i) a (x ::v xs) = x ::v put-v i a xs 170 | 171 | put-v-test : put-v one-Fin3 7 example-vec ≡ 1 ::v 7 ::v 3 ::v []v 172 | put-v-test = refl 173 | 174 | 175 | 176 | 177 | -- Part 3: The Sigma type 178 | --======================= 179 | 180 | data Σ (A : Set) (B : A → Set) : Set where 181 | _,_ : (x : A) → (y : B x) → Σ A B 182 | 183 | syntax Σ A (λ x → B) = Σ[ x ∈ A ] B 184 | 185 | IsEven : Nat → Set 186 | IsEven n = Σ[ m ∈ Nat ] (2 * m ≡ n) 187 | 4-is-even : IsEven 4 188 | 4-is-even = 2 , refl 189 | 190 | _×_ : Set → Set → Set 191 | A × B = Σ[ _ ∈ A ] B 192 | 193 | proj₁ : {A : Set} {B : A → Set} → (p : Σ[ x ∈ A ] (B x)) → A 194 | proj₁ (x , y) = x 195 | 196 | proj₂ : {A : Set} {B : A → Set} → (p : Σ[ x ∈ A ] (B x)) → B (proj₁ p) 197 | proj₂ (x , y) = y 198 | 199 | NonZero : Set 200 | NonZero = Σ[ n ∈ Nat ] (is-zero n ≡ false) 201 | 202 | pred : NonZero → Nat 203 | pred (zero , ()) 204 | pred (suc n , eq) = n 205 | 206 | 207 | 208 | -- Part 4: The Pi type 209 | --======================= 210 | Π : (A : Set) → (B : A → Set) → Set 211 | Π A B = (x : A) → B x 212 | syntax Π A (λ x → B-of-x) = Π[ x ∈ A ] B-of-x 213 | 214 | n-n≡0 : (n : Nat) → (n - n) ≡ 0 215 | n-n≡0 zero = refl 216 | n-n≡0 (suc n) = n-n≡0 n 217 | 218 | 219 | 220 | -- Part 5: A verified sorting algorithm 221 | --===================================== 222 | 223 | data _≤_ : Nat → Nat → Set where 224 | lz : {n : Nat} → zero ≤ n 225 | ls : {m n : Nat} → m ≤ n → suc m ≤ suc n 226 | infix 2 _≤_ 227 | 228 | refl≤ : {n : Nat} → n ≤ n 229 | refl≤ {zero} = lz 230 | refl≤ {suc n} = ls refl≤ 231 | 232 | trans≤ : {l m n : Nat} → l ≤ m → m ≤ n → l ≤ n 233 | trans≤ {.0} {m} {n} lz m≤n = lz 234 | trans≤ {.(suc _)} {.(suc _)} {.(suc _)} (ls l≤m) (ls m≤n) = ls (trans≤ l≤m m≤n) 235 | 236 | _≤all_ : Nat → List Nat → Set 237 | n ≤all [] = ⊤ 238 | n ≤all (x :: xs) = (n ≤ x) × (n ≤all xs) 239 | 240 | trans-≤all : {m n : Nat} → {xs : List Nat} → (m ≤ n) → (n ≤all xs) → (m ≤all xs) 241 | trans-≤all {m} {n} {[]} m≤n n≤[] = tt 242 | trans-≤all {m} {n} {x :: xs} m≤n (n≤x , n≤xs) = trans≤ m≤n n≤x , (trans-≤all m≤n n≤xs) 243 | 244 | IsSorted : List Nat → Set 245 | IsSorted [] = ⊤ 246 | IsSorted (x :: xs) = (x ≤all xs) × IsSorted xs 247 | 248 | SortedList : Set 249 | SortedList = Σ[ xs ∈ List Nat ] (IsSorted xs) 250 | 251 | compare : (m n : Nat) → (m ≤ n) ⊎ (n ≤ m) 252 | compare zero n = left lz 253 | compare (suc m) zero = right lz 254 | compare (suc m) (suc n) with compare m n 255 | compare (suc m) (suc n) | left m≤n = left (ls m≤n) 256 | compare (suc m) (suc n) | right n≤m = right (ls n≤m) 257 | 258 | insert : (n : Nat) → (xs : List Nat) → IsSorted xs → List Nat 259 | insert n [] xs-sorted = n :: [] 260 | insert n (x :: xs) x::xs-sorted with compare n x 261 | insert n (x :: xs) x::xs-sorted | left n≤x = n :: x :: xs 262 | insert n (x :: xs) (x≤xs , xs-sorted) | right x≤n = x :: insert n xs xs-sorted 263 | 264 | insert-≤all : {m : Nat} → (n : Nat) → m ≤ n 265 | → (xs : List Nat) → (xs-sorted : IsSorted xs) → m ≤all xs → m ≤all insert n xs xs-sorted 266 | insert-≤all {m} n m≤n [] []-sorted m≤[] = m≤n , tt 267 | insert-≤all {m} n m≤n (x :: xs) (x≤xs , xs-sorted) m≤x::xs with compare n x 268 | insert-≤all {m} n m≤n (x :: xs) (x≤xs , xs-sorted) m≤x::xs | left n≤x = m≤n , m≤x::xs 269 | insert-≤all {m} n m≤n (x :: xs) (x≤xs , xs-sorted) (m≤x , m≤xs) | right x≤n = 270 | m≤x , insert-≤all n m≤n xs xs-sorted m≤xs 271 | 272 | insert-is-sorted : (n : Nat) → (xs : List Nat) → (xs-sorted : IsSorted xs) → IsSorted (insert n xs xs-sorted) 273 | insert-is-sorted n [] []-sorted = tt , tt 274 | insert-is-sorted n (x :: xs) (x≤xs , xs-sorted) with compare n x 275 | insert-is-sorted n (x :: xs) (x≤xs , xs-sorted) | left n≤x = (n≤x , (trans-≤all n≤x x≤xs)) , (x≤xs , xs-sorted) 276 | insert-is-sorted n (x :: xs) (x≤xs , xs-sorted) | right x≤n = 277 | insert-≤all n x≤n xs xs-sorted x≤xs , insert-is-sorted n xs xs-sorted 278 | 279 | insert-sorted : Nat → SortedList → SortedList 280 | insert-sorted n (xs , xs-sorted) = insert n xs xs-sorted , insert-is-sorted n xs xs-sorted 281 | 282 | sort : List Nat → SortedList 283 | sort [] = [] , tt 284 | sort (x :: xs) = insert-sorted x (sort xs) 285 | 286 | test-list : List Nat 287 | test-list = 3 :: 1 :: 2 :: 76 :: 34 :: 15 :: 155 :: 11 :: 1 :: [] 288 | 289 | test-sort : proj₁ (sort test-list) ≡ 1 :: 1 :: 2 :: 3 :: 11 :: 15 :: 34 :: 76 :: 155 :: [] 290 | test-sort = refl 291 | 292 | 293 | 294 | 295 | 296 | example : {x y : Nat} → x + y ≡ x * x → IsEven (x * x) → IsEven (x + y) 297 | example {x} {y} p x*x-is-even with x * x 298 | example {x} {y} refl x*x-is-even | .(x + y) = x*x-is-even 299 | 300 | postulate 301 | even-square : {x : Nat} → IsEven x → IsEven (x * x) 302 | 303 | example2 : {x y : Nat} → x + y ≡ x * x → IsEven x → IsEven (x + y) 304 | example2 {x} {y} p x-is-even with x * x | even-square x-is-even 305 | example2 {x} {y} refl x-is-even | .(x + y) | x*x-is-even = x*x-is-even 306 | -------------------------------------------------------------------------------- /Session2.agda: -------------------------------------------------------------------------------- 1 | {- 2 | 3 | |--------------------------------------------------| 4 | | Formal systems and their applications: exercises | 5 | | Session 2: Lists and vectors | 6 | |--------------------------------------------------| 7 | 8 | -} 9 | 10 | 11 | 12 | -- Part 0: A note on the Agda standard library 13 | --============================================ 14 | 15 | {- 16 | -- You can either import the solution of the previous exercise session: 17 | open import Session1 hiding (_×_) 18 | -} 19 | 20 | {- Xor you can import the necessary materials from the Agda standard library (is-zero needs to be reimplemented). 21 | 22 | An import with a `renaming` clause renames objects as mentioned. 23 | An import with a `hiding` clause hides the mentioned objects. 24 | An import with a `using` clause hides all objects that are not mentioned. 25 | 26 | In emacs, you can jump to a file or to the definition of an object, by clicking it with the middle mouse button. 27 | 28 | Some files contain public imports. E.g. Data.Nat contains a public import of Data.Nat.Base, 29 | so that if you import Data.Nat, then all contents of Data.Nat.Base will also be available. 30 | 31 | For the project, we will use the Agda standard library. 32 | -} 33 | --Natural numbers and related tools. 34 | open import Data.Nat renaming (ℕ to Nat ; _≟_ to equalNat? ; _∸_ to _-_) hiding (pred ; _≤_ ; compare {- ; NonZero -}) 35 | --Propositional equality 36 | -- Write `open ≡-Reasoning` to get access to some tools for proving equality. 37 | open import Relation.Binary.PropositionalEquality 38 | --Booleans. 39 | open import Data.Bool renaming (not to ¬) hiding (_≤_) 40 | --The unit type (⊤). 41 | open import Data.Unit hiding (_≤_) 42 | --The disjoint union type _⊎_ . 43 | open import Data.Sum hiding (map) renaming (inj₁ to left ; inj₂ to right) 44 | --Among other things: decidability (Dec). 45 | open import Relation.Nullary hiding (¬_) 46 | is-zero : Nat → Bool 47 | is-zero zero = true 48 | is-zero (suc n) = false 49 | 50 | 51 | -- Part 1: Lists 52 | --============== 53 | 54 | -- As in Haskell, we can give an inductive definition of lists in Agda: 55 | -- [] is the empty list 56 | -- x :: xs is a list with head x and tail xs 57 | data List (A : Set) : Set where 58 | [] : List A 59 | _::_ : (x : A) → (xs : List A) → List A 60 | -- (The advantage of naming the constructor's arguments, is that Agda will use these names 61 | -- as default names when pattern matching using C-c C-c.) 62 | 63 | -- The infix statement determines the operator's priority and allows us to write fewer parentheses 64 | infixr 15 _::_ 65 | 66 | example-list : List Nat 67 | example-list = 1 :: 2 :: 3 :: [] 68 | 69 | -- Write a function that calculates the length of a given list: 70 | length : {A : Set} → List A → Nat 71 | length xs = {!!} 72 | 73 | -- Here are some tests for the 'length' function. If your implementation is correct, 74 | -- you should be able to fill in 'refl': 75 | length-test₁ : length {A = Nat} [] ≡ 0 76 | length-test₁ = {!!} 77 | 78 | length-test₂ : length example-list ≡ 3 79 | length-test₂ = {!!} 80 | 81 | -- Basic operations on lists include taking the head and the tail of the list. 82 | -- First, try to explain why we cannot define a head function of type 83 | -- `{A : Set} → List A → A`. 84 | 85 | -- An element of `Maybe A` is either `just x` or `nothing` 86 | -- `nothing` is often used to signal some kind of error. 87 | data Maybe (A : Set) : Set where 88 | just : (x : A) → Maybe A 89 | nothing : Maybe A 90 | 91 | -- Get the head and tail of a list, returning nothing if the list is empty 92 | -- Good to know: pressing C-c C-a when in a hole, makes Agda look for SOME term 93 | -- of the correct type. Try it here to get an idea of how helpful/dangerous it is. 94 | -- You are always allowed to use this feature, and always recommended to be skeptical 95 | -- about its output. 96 | head : {A : Set} → List A → Maybe A 97 | head xs = {!!} 98 | 99 | tail : {A : Set} → List A → Maybe (List A) 100 | tail xs = {!!} 101 | 102 | -- Write a function to append two lists together: 103 | _++_ : {A : Set} → List A → List A → List A 104 | xs ++ ys = {!!} 105 | 106 | ++-test₁ : example-list ++ [] ≡ example-list 107 | ++-test₁ = {!!} 108 | 109 | ++-test₂ : (1 :: []) ++ (2 :: 3 :: []) ≡ example-list 110 | ++-test₂ = {!!} 111 | 112 | -- Prove that the length of the concatenation of two lists is the sum of the 113 | -- lengths of the two lists. 114 | -- Hint: This is easy if your definitions of _+_ and _++_ look very similar. If you're importing 115 | -- session 1 rather than the standard library and are having difficulties, 116 | -- then you may want to reconsider how you can define _+_ more similarly to _++_. 117 | ++-length : {A : Set} (xs ys : List A) → length (xs ++ ys) ≡ length xs + length ys 118 | ++-length xs ys = {!!} 119 | 120 | -- map should apply a function to every element in a list 121 | map : {A B : Set} → (A → B) → List A → List B 122 | map f xs = {!!} 123 | 124 | map-test : map suc example-list ≡ 2 :: 3 :: 4 :: [] 125 | map-test = {!!} 126 | 127 | double-all : List Nat → List Nat 128 | double-all xs = map (λ x → x + x) xs 129 | 130 | double-all-test : double-all example-list ≡ 2 :: 4 :: 6 :: [] 131 | double-all-test = {!!} 132 | 133 | -- prove that mapping a function over a list preserves its length 134 | map-length : {A B : Set} (f : A → B) (xs : List A) → length (map f xs) ≡ length xs 135 | map-length f xs = {!!} 136 | 137 | 138 | -- Next, let's implement a lookup operator: given a list and a number n, 139 | -- select the n'th element from this list. 140 | lookup : {A : Set} → List A → Nat → Maybe A 141 | lookup xs n = {!!} 142 | 143 | lookup-test₁ : lookup example-list 1 ≡ just 2 144 | lookup-test₁ = {!!} 145 | 146 | lookup-test₂ : lookup example-list 5 ≡ nothing 147 | lookup-test₂ = {!!} 148 | 149 | 150 | 151 | -- Part 2: Vectors 152 | --================ 153 | 154 | -- In a dependently typed language like Agda, there is a different way to define lists 155 | -- that gives better guarantees about the length of the list: 156 | 157 | data Vec (A : Set) : Nat → Set where 158 | []v : Vec A 0 159 | _::v_ : {n : Nat} → A → Vec A n → Vec A (suc n) 160 | 161 | infixr 15 _::v_ 162 | 163 | {- 164 | The first line declares `Vec A` as a function mapping natural numbers to "sets" (types). 165 | Namely, the number `n` will be mapped to the type `Vec A n` of vectors over `A` of 166 | length `n`. There is a subtle distinction between *parameters* such as `A` (declared 167 | before the colon) and *indices* such as `n` (declared after it): 168 | the constructors can determine the indices, 169 | but not the parameters of their output. Try replacing the first line with 170 | `data Vec (A : Set) (n : Nat) : Set where` and observe the error. 171 | 172 | The other lines declare the constructors. Note how they interact with the index n. 173 | -} 174 | 175 | example-vec : Vec Nat 3 176 | example-vec = 1 ::v 2 ::v 3 ::v []v 177 | -- example-vec = 1 ::v 2 ::v []v 178 | -- ^ this example wouldn't typecheck, as the length is 2, but the type is 'Vec Nat 3' 179 | 180 | -- If we use vectors, we don't need Maybe in the return type of head and tail. 181 | -- Instead, we only allow these functions to be called on a vector of length at 182 | -- least one (i.e. a vector of type 'Vec A (suc n)' for some n : Nat). 183 | head-v : {A : Set} {n : Nat} → Vec A (suc n) → A 184 | head-v {A} {n} xs = {!!} 185 | 186 | tail-v : {A : Set} {n : Nat} → Vec A (suc n) → Vec A n 187 | tail-v {A} {n} xs = {!!} 188 | 189 | -- Create a vector of length n containing only the number 0: 190 | zero-vec : (n : Nat) → Vec Nat n 191 | zero-vec n = {!!} 192 | 193 | -- Other functions on lists, such as _++_ and map, can also be written for vectors but 194 | -- now the types describe their effect on the length of the vector. 195 | -- Thanks to the more informative types, C-c C-r (refine) will be more helpful in empty 196 | -- goals, and C-c C-a (program/proof search) will get it right more often. 197 | 198 | _++v_ : {A : Set} {m n : Nat} → Vec A m → Vec A n → Vec A (m + n) 199 | xs ++v ys = {!!} 200 | 201 | map-v : {A B : Set} {n : Nat} → (A → B) → Vec A n → Vec B n 202 | map-v {A}{B}{n} f xs = {!!} 203 | 204 | -- It is also possible to enforce that two input vectors have the same length. 205 | -- For example, we can calculate the dot product (as in physics) of two vectors (unicode \cdot): 206 | _·_ : {n : Nat} → Vec Nat n → Vec Nat n → Nat 207 | xs · ys = {!!} 208 | 209 | ·-test : example-vec · map-v suc example-vec ≡ 20 210 | ·-test = {!!} 211 | 212 | -- In order to implement a lookup function on vectors, we first need to 213 | -- introduce the Fin type: this is the type of natural numbers up to a given 214 | -- boundary, i.e. Fin n contains the numbers 0,1,2,...,n-1 215 | -- These types are called Fin n because all finite types with n elements are 216 | -- isomorphic to Fin n. 217 | data Fin : Nat → Set where 218 | zero-f : {n : Nat} → Fin (suc n) 219 | suc-f : {n : Nat} → Fin n → Fin (suc n) 220 | 221 | -- Fin 3 contains the elements `zero`, `suc zero`, and `suc (suc zero)`: 222 | zero-Fin3 : Fin 3 223 | zero-Fin3 = zero-f 224 | 225 | one-Fin3 : Fin 3 226 | one-Fin3 = suc-f zero-f 227 | 228 | two-Fin3 : Fin 3 229 | two-Fin3 = suc-f (suc-f zero-f) 230 | 231 | -- ... but not `suc-f (suc-f (suc-f zero-f))`: 232 | -- three-Fin3 : Fin 3 233 | -- three-Fin3 = suc-f (suc-f (suc-f zero-f)) 234 | 235 | -- (try to uncomment the above definition to see what goes wrong). 236 | 237 | -- Now that we have the Fin type, we can write a version of lookup on vectors 238 | -- that doesn't have Maybe in its return type. Try to do this now: 239 | lookup-v : {A : Set} {n : Nat} → Fin n → Vec A n → A 240 | lookup-v {A}{n} i xs = {!!} 241 | -- Notice that the type of this function guarantees that the index i will never 242 | -- be out of the bounds of the vector xs. 243 | 244 | -- Also write a function that sets the i-th value in a vector to a given value: 245 | put-v : {A : Set} {n : Nat} → Fin n → A → Vec A n → Vec A n 246 | put-v i a xs = {!!} 247 | 248 | put-v-test : put-v one-Fin3 7 example-vec ≡ 1 ::v 7 ::v 3 ::v []v 249 | put-v-test = {!!} 250 | 251 | 252 | 253 | 254 | -- Part 3: The Sigma type 255 | --======================= 256 | 257 | -- Another very important type for dependently typed programming (and proving) is 258 | -- the Σ-type (unicode input: \Sigma or \GS for Greek S), aka dependent pair type. 259 | -- You can think of it as a type of pairs 260 | -- (x , y) where the type of y can depend on the value of x. 261 | data Σ (A : Set) (B : A → Set) : Set where 262 | _,_ : (x : A) → (y : B x) → Σ A B 263 | 264 | -- This syntax declaration allows us to write Σ[ x ∈ A ] (B x) instead of Σ A (λ x → B x): 265 | syntax Σ A (λ x → B-of-x) = Σ[ x ∈ A ] B-of-x 266 | 267 | {- 268 | Under the Curry-Howard correspondence, `Σ[ x ∈ A ] (B x)` means "there is some `x : A` 269 | such that B x is true". For example: 270 | -} 271 | IsEven : Nat → Set 272 | IsEven n = Σ[ m ∈ Nat ] (2 * m ≡ n) 273 | 4-is-even : IsEven 4 274 | 4-is-even = {!!} 275 | 276 | -- The Σ-type is also a generalization of the product type, which encodes the logical operator 'and': 277 | _×_ : Set → Set → Set 278 | A × B = Σ[ _ ∈ A ] B 279 | 280 | -- The projection functions project out the components of a Σ type. 281 | -- Note that the return type of proj₂ depends on the result of the 282 | -- first projection proj₁. 283 | proj₁ : {A : Set} {B : A → Set} → (p : Σ[ x ∈ A ] (B x)) → A 284 | proj₁ (x , y) = x 285 | 286 | proj₂ : {A : Set} {B : A → Set} → (p : Σ[ x ∈ A ] (B x)) → B (proj₁ p) 287 | proj₂ (x , y) = y 288 | 289 | 290 | -- Σ is often used to define subtypes. For example, using Σ and the function 291 | -- is-zero, we can define a type of nonzero natural numbers: 292 | NonZero : Set 293 | NonZero = Σ[ n ∈ Nat ] (is-zero n ≡ false) 294 | 295 | -- Now we can write a function that calculates the predecessor of a nonzero 296 | -- natural number, without resorting to using a Maybe type: 297 | pred : NonZero → Nat 298 | pred n = {!!} 299 | 300 | 301 | 302 | -- Part 4: The Pi type 303 | --======================= 304 | -- The Π-type or dependent function type is in theoretical papers and some other languages often 305 | -- denoted with a Π, but not in Agda. Of course, we can define the symbol Π ourselves. 306 | -- The Π-type is a type of functions `f` for which the type of `f x` depends on the value of `x`. 307 | -- We've been using such dependent functions all along: 308 | Π : (A : Set) → (B : A → Set) → Set 309 | Π A B = (x : A) → B x 310 | syntax Π A (λ x → B-of-x) = Π[ x ∈ A ] B-of-x 311 | -- Of course, neither the symbol Π nor the syntax for it is very useful, as Agda provides primitive 312 | -- syntax for dependent function types. So they are here just to demonstrate the parallel with the Σ-type. 313 | 314 | {- 315 | Under the Curry-Howard correspondence, `Π[ x ∈ A ] (B x)` or `(x : A) → B x` means 316 | "for all `x : A`, `B x` is true." For example: 317 | For all natural numbers n, n minus n equals 0: 318 | -} 319 | n-n≡0 : (n : Nat) → (n - n) ≡ 0 320 | n-n≡0 n = {!!} 321 | 322 | 323 | 324 | -- Part 5: A verified sorting algorithm 325 | --===================================== 326 | -- As a bigger example, we will define a type of sorted lists of natural numbers. 327 | 328 | -- First, we define inequality of natural numbers (input \le or \≤ or on some keyboards alt+<): 329 | data _≤_ : Nat → Nat → Set where 330 | lz : {n : Nat} → zero ≤ n 331 | ls : {m n : Nat} → m ≤ n → suc m ≤ suc n 332 | infix 2 _≤_ 333 | 334 | -- Show that inequality is reflexive and transitive: 335 | refl≤ : {n : Nat} → n ≤ n 336 | refl≤ {n} = {!!} 337 | 338 | trans≤ : {l m n : Nat} → l ≤ m → m ≤ n → l ≤ n 339 | trans≤ {l}{m}{n} l≤m m≤n = {!!} 340 | 341 | -- Now define what it means that n is less than or equal to 342 | -- all elements of the list xs. 343 | -- Use the Curry-Howard correspondence (see previous session) to 344 | -- encode propositions as types. 345 | _≤all_ : Nat → List Nat → Set 346 | n ≤all xs = {!!} 347 | 348 | -- Prove mixed transitivity: 349 | trans-≤all : {m n : Nat} → {xs : List Nat} → (m ≤ n) → (n ≤all xs) → (m ≤all xs) 350 | trans-≤all {m}{n}{xs} m≤n n≤xs = {!!} 351 | 352 | -- We use ≤all to define what it means for a list to be sorted: 353 | IsSorted : List Nat → Set 354 | IsSorted [] = ⊤ 355 | IsSorted (x :: xs) = (x ≤all xs) × IsSorted xs 356 | {- This is a bit overkill: in the list `x :: y :: z :: []`, 357 | we are requiring that x ≤ y, x ≤ z and y ≤ z. Of course, x ≤ z follows from the 358 | other inequalities by transitivity. However, reasoning about sortedness becomes a 359 | LOT easier if we include these superfluous inequalities. 360 | -} 361 | 362 | -- We need to be able to decide which of two numbers is greater. 363 | -- This could be done by implementing a term of type (m n : Nat) → Dec (m ≤ n), 364 | -- but the following will be more practical: 365 | -- Hint: you will likely need a with-clause. 366 | compare : (m n : Nat) → (m ≤ n) ⊎ (n ≤ m) 367 | compare m n = {!!} 368 | 369 | -- Define a function that inserts a number into a sorted list. 370 | -- Hint: You will likely need a with-clause. 371 | 372 | insert : (n : Nat) → (xs : List Nat) → IsSorted xs → List Nat 373 | insert n xs xs-sorted = {!!} 374 | 375 | -- Show that if `m ≤ n` and `m` ≤ all elements of `xs`, then `m` ≤ all elements of 376 | -- `insert n xs`. 377 | insert-≤all : {m : Nat} → (n : Nat) → m ≤ n 378 | → (xs : List Nat) → (xs-sorted : IsSorted xs) → m ≤all xs → m ≤all insert n xs xs-sorted 379 | insert-≤all {m} n m≤n xs xs-sorted m≤xs = {!!} 380 | {- Note: The proposition that you need to prove, contains a call to `insert`. 381 | It is then often a good idea to start with the same pattern matches and with-abstractions 382 | that you used in the definition of `insert`, so that the call properly reduces 383 | in each of the cases. 384 | When displaying the type, Agda will even append the content of the with-clause 385 | of `insert`, i.e. 386 | `m ≤all (insert n (x :: xs) (x≤xs , xs-sorted))` 387 | will become 388 | `m ≤all (insert n (x :: xs) (x≤xs , xs-sorted) | compare n x)` 389 | or similar (depending on your exact definition of `insert`). 390 | -} 391 | 392 | -- Show that `insert` preserves sortedness: 393 | insert-is-sorted : (n : Nat) → (xs : List Nat) → (xs-sorted : IsSorted xs) → IsSorted (insert n xs xs-sorted) 394 | insert-is-sorted n xs xs-sorted = {!!} 395 | 396 | -- In analogy to the NonZero type, we define a type of sorted lists: 397 | SortedList : Set 398 | SortedList = Σ[ xs ∈ List Nat ] (IsSorted xs) 399 | 400 | -- We can then wrap up the previous results: 401 | insert-sorted : Nat → SortedList → SortedList 402 | insert-sorted n xss = {!!} 403 | {- Note: In the previous results (`insert`, `insert-is-sorted`), we could have directly uncurried 404 | the arguments `xs` and `xs-sorted` to a single `SortedList`. 405 | However, then we have functions defined by recursion, not on an argument, but on a component of an argument. 406 | These will not pass the termination checker in some versions of Agda. 407 | -} 408 | 409 | -- Implement a `sort` function: 410 | sort : List Nat → SortedList 411 | sort xs = {!!} 412 | 413 | test-list : List Nat 414 | test-list = 3 :: 1 :: 2 :: 76 :: 34 :: 15 :: 155 :: 11 :: 1 :: [] 415 | 416 | -- If your implementation is correct, you should be able to fill in refl here: 417 | test-sort : proj₁ (sort test-list) ≡ 1 :: 1 :: 2 :: 3 :: 11 :: 15 :: 34 :: 76 :: 155 :: [] 418 | test-sort = {!!} 419 | 420 | 421 | 422 | 423 | -- Part 6: Using equality proofs 424 | --============================== 425 | {- 426 | A frequently asked question is: how can one use an equality proof. 427 | 428 | The answer is: by pattern matching. Pattern matching over an equality proof p : a ≡ b is only possible if a and b 429 | 430 | * are obviously unequal (then you get an absurd pattern), 431 | * easy to equate. 432 | 433 | If the equation is not easily solved, then you can turn one of its sides into a variable by with-abstracting over it. 434 | Of course an equation in which one side is a variable, is easily solved. 435 | You can find a good example in the Agda docs: 436 | https://agda.readthedocs.io/en/v2.5.3/language/with-abstraction.html#simultaneous-abstraction 437 | 438 | We will consider an example here as well. Suppose we know: 439 | x + y = x * x 440 | Then clearly, if `x * x` is even, then so is `x + y`. Let's prove this: 441 | -} 442 | example : {x y : Nat} → x + y ≡ x * x → IsEven (x * x) → IsEven (x + y) 443 | example {x} {y} p x*x-is-even = {!!} 444 | {- 445 | If you try to pattern-match on p, you get an error, because the equation is too difficult for Agda to solve. 446 | For this reason, we first turn one side into a variable: 447 | example {x} {y} p x*x-is-even with x * x 448 | example {x} {y} p x*x-is-even | x*x = ? 449 | Now, in the hole, the expression `x * x` is replaced with the variable `x*x` in the types of all variables in scope, 450 | as well as in the required type of the hole. 451 | If we subsequently pattern-match on p, then p becomes refl and --- as this is required for refl to be well-typed --- 452 | the variable `x*x` is replaced with the expression `x + y`. 453 | Thus, at this point, the type of `x*x-is-even` has become `IsEven (x + y)`, and the variable can simply be used on the right. 454 | -} 455 | 456 | {- 457 | This technique is a bit subtle however. Suppose we know that the square of an even number is even: 458 | -} 459 | postulate 460 | even-square : {x : Nat} → IsEven x → IsEven (x * x) 461 | {- 462 | Let's try to prove the same, but from the knowledge that x is even. 463 | -} 464 | example2 : {x y : Nat} → x + y ≡ x * x → IsEven x → IsEven (x + y) 465 | example2 {x} {y} p x-is-even with x * x 466 | example2 {x} {y} p x-is-even | x*x = {!!} 467 | {- 468 | If we proceed as before: 469 | 1. match over p 470 | 2. fill out `even-square x-is-even` on the right 471 | then we get an error: the type of `even-square x-is-even` has NOT become `IsEven (x + y)` but is still `IsEven (x * x)`. 472 | The problem is that we came up with this expression AFTER with-abstracting over `x * x`. 473 | The solution is to with-abstract over both simultaneously: 474 | example2 {x} {y} p x-is-even with x * x | even-square x-is-even 475 | example2 {x} {y} p x-is-even | x*x | x*x-is-even = {!!} 476 | Now the type of `x*x-is-even` is `IsEven x*x` and pattern-matching over `p` will turn that into `IsEven (x + y)`. 477 | -} 478 | -------------------------------------------------------------------------------- /Session3-solution-bool.agda: -------------------------------------------------------------------------------- 1 | 2 | {- 3 | 4 | |---------------------------------------------------| 5 | | Formal systems and their applications: exercises | 6 | | Session 3: Formalization of programming languages | 7 | |---------------------------------------------------| 8 | 9 | -} 10 | 11 | open import Data.Nat renaming (ℕ to Nat ; _≟_ to equalNat?) hiding (pred ; _≤_ ; compare) 12 | open import Data.Empty 13 | open import Relation.Binary.PropositionalEquality 14 | open import Data.Product 15 | open import Data.Sum hiding (map) renaming (inj₁ to left ; inj₂ to right) 16 | 17 | 18 | -- Part 1: Untyped boolean terms 19 | --============================== 20 | data Term : Set where 21 | tmTrue : Term 22 | tmFalse : Term 23 | tmIf : (t1 t2 t3 : Term) → Term 24 | 25 | size : Term → Nat 26 | size tmTrue = 1 27 | size tmFalse = 1 28 | size (tmIf t t1 t2) = 1 + size t + size t1 + size t2 29 | 30 | data IsValue : Term → Set where 31 | valTrue : IsValue tmTrue 32 | valFalse : IsValue tmFalse 33 | 34 | data _↝_ : Term → Term → Set where 35 | e-IfTrue : {t2 t3 : Term} → (tmIf tmTrue t2 t3 ↝ t2) 36 | e-IfFalse : {t2 t3 : Term} → (tmIf tmFalse t2 t3 ↝ t3) 37 | e-If : {t1 t1' t2 t3 : Term} → t1 ↝ t1' → tmIf t1 t2 t3 ↝ tmIf t1' t2 t3 38 | 39 | IsNormal : Term → Set 40 | IsNormal t = {t' : Term} → (t ↝ t') → ⊥ 41 | values-normal : {t : Term} → IsValue t → IsNormal t 42 | values-normal {.tmTrue} valTrue () 43 | values-normal {.tmFalse} valFalse () 44 | 45 | data _↝*_ : Term → Term → Set where 46 | done : {x : Term} → (x ↝* x) 47 | step_,_ : {x x1 y : Term} → (x ↝ x1) → (x1 ↝* y) → (x ↝* y) 48 | infixr 0 step_,_ 49 | 50 | s = tmIf tmTrue tmFalse tmFalse 51 | t = tmIf s tmTrue tmTrue 52 | test-eval1 : tmIf t tmFalse tmFalse ↝* tmFalse 53 | test-eval1 = step e-If (e-If e-IfTrue) , 54 | step e-If e-IfFalse , 55 | step e-IfTrue , 56 | done 57 | -------------------------------------------------------------------------------- /Session3-solution.agda: -------------------------------------------------------------------------------- 1 | 2 | {- 3 | 4 | |---------------------------------------------------| 5 | | Formal systems and their applications: exercises | 6 | | Session 3: Formalization of programming languages | 7 | |---------------------------------------------------| 8 | 9 | -} 10 | 11 | open import Data.Nat renaming (ℕ to Nat ; _≟_ to equalNat?) hiding (pred ; _≤_ ; compare) 12 | open import Data.Empty 13 | open import Relation.Binary.PropositionalEquality 14 | open import Data.Product 15 | open import Data.Sum hiding (map) renaming (inj₁ to left ; inj₂ to right) 16 | 17 | 18 | -- Part 1: Untyped boolean terms 19 | --============================== 20 | data Term : Set where 21 | tmTrue : Term 22 | tmFalse : Term 23 | tmIf : (t1 t2 t3 : Term) → Term 24 | tmZero : Term 25 | tmSucc : Term → Term 26 | tmPred : Term → Term 27 | tmIsZero : Term → Term 28 | 29 | size : Term → Nat 30 | size tmTrue = 1 31 | size tmFalse = 1 32 | size (tmIf t t1 t2) = 1 + size t + size t1 + size t2 33 | size tmZero = 1 34 | size (tmSucc t) = suc (size t) 35 | size (tmPred t) = suc (size t) 36 | size (tmIsZero t) = suc (size t) 37 | 38 | data IsNumValue : Term → Set where 39 | nvZero : IsNumValue tmZero 40 | nvSucc : {t : Term} → IsNumValue t → IsNumValue (tmSucc t) 41 | 42 | data IsValue : Term → Set where 43 | valTrue : IsValue tmTrue 44 | valFalse : IsValue tmFalse 45 | valNum : {t : Term} → IsNumValue t → IsValue t 46 | 47 | data _↝_ : Term → Term → Set where 48 | e-IfTrue : {t2 t3 : Term} → ((tmIf tmTrue t2 t3) ↝ t2) 49 | e-IfFalse : {t2 t3 : Term} → ((tmIf tmFalse t2 t3) ↝ t3) 50 | e-If : {t1 t1' t2 t3 : Term} → t1 ↝ t1' → (tmIf t1 t2 t3 ↝ tmIf t1' t2 t3) 51 | e-Succ : {t1 t1' : Term} → t1 ↝ t1' → tmSucc t1 ↝ tmSucc t1' 52 | e-PredZero : tmPred tmZero ↝ tmZero 53 | e-PredSucc : {t : Term} → IsNumValue t → tmPred (tmSucc t) ↝ t 54 | e-Pred : {t t' : Term} → t ↝ t' → tmPred t ↝ tmPred t' 55 | e-IsZeroZero : tmIsZero tmZero ↝ tmTrue 56 | e-IsZeroSucc : {t : Term} → IsNumValue t → tmIsZero (tmSucc t) ↝ tmFalse 57 | e-IsZero : {t t' : Term} → t ↝ t' → tmIsZero t ↝ tmIsZero t' 58 | 59 | IsNormal : Term → Set 60 | IsNormal t = {t' : Term} → (t ↝ t') → ⊥ 61 | 62 | values-normal : {t : Term} → IsValue t → IsNormal t 63 | values-normal {.tmTrue} valTrue {t'} () 64 | values-normal {.tmFalse} valFalse {t'} () 65 | values-normal {.tmZero} (valNum nvZero) {t'} () 66 | values-normal {.(tmSucc _)} (valNum (nvSucc x)) {.(tmSucc _)} (e-Succ et) = values-normal (valNum x) et 67 | 68 | data _↝*_ : Term → Term → Set where 69 | done : {t : Term} → (t ↝* t) 70 | step_,_ : {t t' t'' : Term} → (t ↝ t') → (t' ↝* t'') → (t ↝* t'') 71 | infixr 0 step_,_ 72 | 73 | s = tmIf tmTrue tmFalse tmFalse 74 | t = tmIf s tmTrue tmTrue 75 | test-eval1 : tmIf t tmFalse tmFalse ↝* tmFalse 76 | test-eval1 = step e-If (e-If e-IfTrue) , 77 | step e-If e-IfFalse , 78 | step e-IfTrue , 79 | done 80 | 81 | 82 | -- Part 2: Untyped arithmetic terms 83 | --================================= 84 | 85 | -- Exercise: as a test, state and prove that 86 | -- if false then 0 else (pred (suc (pred 0))) ↝* 0 87 | 88 | test-eval2 : tmIf tmFalse tmZero (tmPred (tmSucc (tmPred tmZero))) ↝* tmZero 89 | test-eval2 = step e-IfFalse , 90 | step e-Pred (e-Succ e-PredZero) , 91 | step e-PredSucc nvZero , 92 | done 93 | 94 | 95 | 96 | -- Part 3: Typed arithmetic terms 97 | --=============================== 98 | data Type : Set where 99 | tyBool : Type 100 | tyNat : Type 101 | 102 | -- As with the evaluation rules, we encode the typing rules as a data type 103 | -- We use the unicode symbol ∈ (input ∈) instead of a colon because the colon 104 | -- is already reserved by Agda. 105 | data _∈_ : Term → Type → Set where 106 | d-True : tmTrue ∈ tyBool 107 | d-False : tmFalse ∈ tyBool 108 | d-If : {tyT : Type} → {t1 t2 t3 : Term} → (d1 : t1 ∈ tyBool) → (d2 : t2 ∈ tyT) → (d3 : t3 ∈ tyT) 109 | → tmIf t1 t2 t3 ∈ tyT 110 | d-Zero : tmZero ∈ tyNat 111 | d-Succ : {t : Term} → t ∈ tyNat → tmSucc t ∈ tyNat 112 | d-Pred : {t : Term} → t ∈ tyNat → tmPred t ∈ tyNat 113 | d-IsZero : {t : Term} → t ∈ tyNat → tmIsZero t ∈ tyBool 114 | 115 | test-typing : tmIf (tmIsZero tmZero) tmZero (tmPred tmZero) ∈ tyNat 116 | test-typing = d-If (d-IsZero d-Zero) d-Zero (d-Pred d-Zero) 117 | 118 | -- Inversion lemmas (see TAPL p. 94): 119 | inversion-true : {tyR : Type} → tmTrue ∈ tyR → tyR ≡ tyBool 120 | inversion-true {tyBool} d-True = refl 121 | 122 | inversion-if : ∀ {tyR t1 t2 t3} → tmIf t1 t2 t3 ∈ tyR → (t1 ∈ tyBool) × ((t2 ∈ tyR) × (t3 ∈ tyR)) 123 | inversion-if (d-If d1 d2 d3) = d1 , (d2 , d3) 124 | 125 | inversion-isZero : ∀ {tyR t} → tmIsZero t ∈ tyR → (tyR ≡ tyBool) × (t ∈ tyNat) 126 | inversion-isZero (d-IsZero d) = refl , d 127 | 128 | -- Uniqueness of types (see TAPL p. 94): 129 | uniqueness-of-types : {t : Term} {tyT1 tyT2 : Type} → t ∈ tyT1 → t ∈ tyT2 → tyT1 ≡ tyT2 130 | uniqueness-of-types {.tmTrue} {.tyBool} {.tyBool} d-True d-True = refl 131 | uniqueness-of-types {.tmFalse} {.tyBool} {.tyBool} d-False d-False = refl 132 | uniqueness-of-types {.(tmIf _ _ _)} {tyT1} {tyT2} (d-If d1 d3 d4) (d-If d2 d5 d6) = uniqueness-of-types d4 d6 133 | uniqueness-of-types {.tmZero} {.tyNat} {.tyNat} d-Zero d-Zero = refl 134 | uniqueness-of-types {.(tmSucc _)} {.tyNat} {.tyNat} (d-Succ d1) (d-Succ d2) = refl 135 | uniqueness-of-types {.(tmPred _)} {.tyNat} {.tyNat} (d-Pred d1) (d-Pred d2) = refl 136 | uniqueness-of-types {.(tmIsZero _)} {.tyBool} {.tyBool} (d-IsZero d1) (d-IsZero d2) = refl 137 | 138 | -- Part 4: Safety = progress + preservation (see TAPL p. 96-97) 139 | --============================================================= 140 | 141 | -- First, prove the canonical forms lemma (lemma 8.3.1): 142 | canonical-forms-bool : {t : Term} → (IsValue t) → (t ∈ tyBool) → (t ≡ tmTrue) ⊎ (t ≡ tmFalse) 143 | canonical-forms-bool {.tmTrue} valTrue dt = left refl 144 | canonical-forms-bool {.tmFalse} valFalse dt = right refl 145 | canonical-forms-bool {.tmZero} (valNum nvZero) () 146 | canonical-forms-bool {.(tmSucc _)} (valNum (nvSucc x)) () 147 | 148 | canonical-forms-nat : {t : Term} → IsValue t → t ∈ tyNat → IsNumValue t 149 | canonical-forms-nat {.tmTrue} valTrue () 150 | canonical-forms-nat {.tmFalse} valFalse () 151 | canonical-forms-nat {t} (valNum nvt) dt = nvt 152 | 153 | preservation : {t t' : Term} {tyT : Type} → (t ↝ t') → (t ∈ tyT) → (t' ∈ tyT) 154 | preservation {.tmTrue} {t'} {.tyBool} () d-True 155 | preservation {.tmFalse} {t'} {.tyBool} () d-False 156 | preservation {.(tmIf tmTrue _ _)} {_} {tyT} e-IfTrue (d-If d1 d2 d3) = d2 157 | preservation {.(tmIf tmFalse _ _)} {_} {tyT} e-IfFalse (d-If d1 d2 d3) = d3 158 | preservation {.(tmIf _ _ _)} {.(tmIf _ _ _)}{tyT} (e-If e1) (d-If d1 d2 d3) = 159 | d-If (preservation e1 d1) d2 d3 160 | preservation {.tmZero} {t'} {.tyNat} () d-Zero 161 | preservation {.(tmSucc _)} {.(tmSucc _)} {.tyNat} (e-Succ e1) (d-Succ d1) = d-Succ (preservation e1 d1) 162 | preservation {.(tmPred tmZero)} {.tmZero} {.tyNat} e-PredZero (d-Pred d1) = d1 163 | preservation {.(tmPred (tmSucc t'))} {t'} {.tyNat} (e-PredSucc x) (d-Pred (d-Succ d1)) = d1 164 | preservation {.(tmPred _)} {.(tmPred _)} {.tyNat} (e-Pred e1) (d-Pred d1) = d-Pred (preservation e1 d1) 165 | preservation {.(tmIsZero tmZero)} {.tmTrue} {.tyBool} e-IsZeroZero (d-IsZero d1) = d-True 166 | preservation {.(tmIsZero (tmSucc _))}{.tmFalse} {.tyBool} (e-IsZeroSucc x)(d-IsZero d1) = d-False 167 | preservation {.(tmIsZero _)} {.(tmIsZero _)}{.tyBool} (e-IsZero e1) (d-IsZero d1) = d-IsZero (preservation e1 d1) 168 | 169 | progress : {t : Term} {tyT : Type} → t ∈ tyT → (IsValue t) ⊎ (Σ[ t' ∈ Term ] (t ↝ t')) 170 | progress d-True = left valTrue 171 | progress d-False = left valFalse 172 | progress (d-If d1 d2 d3) with progress d1 173 | progress (d-If d1 d2 d3) | left val1 with canonical-forms-bool val1 d1 174 | progress (d-If d1 d2 d3) | left val1 | (left refl) = right (_ , e-IfTrue) 175 | progress (d-If d1 d2 d3) | left val1 | (right refl) = right (_ , e-IfFalse) 176 | progress (d-If d1 d2 d3) | right (t1' , e1) = right (tmIf t1' _ _ , e-If e1) 177 | progress d-Zero = left (valNum nvZero) 178 | progress (d-Succ d1) with progress d1 179 | progress (d-Succ d1) | left val1 = left (valNum (nvSucc (canonical-forms-nat val1 d1))) 180 | progress (d-Succ d1) | right (t1' , e1) = right (tmSucc t1' , e-Succ e1) 181 | progress (d-Pred d1) with progress d1 182 | progress (d-Pred d1) | left val1 with canonical-forms-nat val1 d1 183 | progress (d-Pred d1) | left val1 | nvZero = right (tmZero , e-PredZero) 184 | progress (d-Pred d1) | left val1 | (nvSucc u) = right (_ , e-PredSucc u) 185 | progress (d-Pred d1) | right (t1' , e1) = right (tmPred t1' , e-Pred e1) 186 | progress (d-IsZero d1) with progress d1 187 | progress (d-IsZero d1) | left val1 with canonical-forms-nat val1 d1 188 | progress (d-IsZero d1) | left val1 | nvZero = right (tmTrue , e-IsZeroZero) 189 | progress (d-IsZero d1) | left val1 | (nvSucc u) = right (tmFalse , e-IsZeroSucc u) 190 | progress (d-IsZero d1) | right (t1' , e1) = right (tmIsZero t1' , e-IsZero e1) 191 | {- 192 | -- With more implicit arguments: 193 | progress {.tmTrue} {.tyBool} d-True = left valTrue 194 | progress {.tmFalse} {.tyBool} d-False = left valFalse 195 | progress {(tmIf t1 t2 t3)} {tyT} (d-If d1 d2 d3) with progress {t1} {tyBool} d1 196 | progress {(tmIf t1 t2 t3)} {tyT} (d-If d1 d2 d3) | left v1 with canonical-forms-bool {t1} v1 d1 197 | progress {tmIf .tmTrue t2 t3} {tyT} (d-If d1 d2 d3) | left v1 | left refl = right (t2 , e-IfTrue) 198 | progress {tmIf .tmFalse t2 t3} {tyT} (d-If d1 d2 d3) | left v1 | right refl = right (t3 , e-IfFalse) 199 | progress {(tmIf t1 t2 t3)} {tyT} (d-If d1 d2 d3) | right (t1' , e1) = right (tmIf t1' t2 t3 , e-If e1) 200 | progress {.tmZero} {.tyNat} d-Zero = left (valNum nvZero) 201 | progress {(tmSucc t1)} {.tyNat} (d-Succ d1) with progress {t1} {tyNat} d1 202 | progress {tmSucc t1} {.tyNat} (d-Succ d1) | left (valNum nv1) = left (valNum (nvSucc nv1)) 203 | progress {tmSucc t1} {.tyNat} (d-Succ d1) | right (t1' , e1) = right (tmSucc t1' , e-Succ e1) 204 | progress {(tmPred t1)} {.tyNat} (d-Pred d1) with progress {t1} {tyNat} d1 205 | progress {tmPred .tmZero} {.tyNat} (d-Pred d1) | left (valNum nvZero) = right (tmZero , e-PredZero) 206 | progress {tmPred (tmSucc t)} {.tyNat} (d-Pred d1) | left (valNum (nvSucc nvt)) = right (t , e-PredSucc nvt) 207 | progress {tmPred t1} {.tyNat} (d-Pred d1) | right (t1' , e1) = right (tmPred t1' , e-Pred e1) 208 | progress {(tmIsZero t1)} {.tyBool} (d-IsZero d1) with progress {t1} {tyNat} d1 209 | progress {tmIsZero .tmZero} {.tyBool} (d-IsZero d1) | left (valNum nvZero) = right (tmTrue , e-IsZeroZero) 210 | progress {tmIsZero (tmSucc t)} {.tyBool} (d-IsZero d1) | left (valNum (nvSucc nvt)) = right (tmFalse , e-IsZeroSucc nvt) 211 | progress {tmIsZero t1} {.tyBool} (d-IsZero d1) | right (t1' , e1) = right (tmIsZero t1' , e-IsZero e1) 212 | -} 213 | 214 | ------------------------------------------------------- 215 | -- Challenge: Prove normalization of this calculus. 216 | 217 | preservation* : {t t' : Term} {tyT : Type} → (t ↝* t') → (t ∈ tyT) → (t' ∈ tyT) 218 | preservation* done dt = dt 219 | preservation* (step et , et*) dt = preservation* et* (preservation et dt) 220 | 221 | map* : {f : Term → Term} 222 | → (f↝ : {t t' : Term} → t ↝ t' → f t ↝ f t') 223 | → {t t' : Term} → t ↝* t' → f t ↝* f t' 224 | map* f↝ done = done 225 | map* f↝ (step et , et*) = step f↝ et , map* f↝ et* 226 | 227 | step*_,_ : ∀ {t t' t''} → t ↝* t' → t' ↝* t'' → t ↝* t'' 228 | step* done , et* = et* 229 | step* step et , et*' , et* = step et , step* et*' , et* 230 | infixr 0 step*_,_ 231 | 232 | normalization : ∀ {t tyT} → t ∈ tyT → Σ[ t' ∈ Term ] ((t ↝* t') × IsValue t') 233 | normalization d-True = tmTrue , done , valTrue 234 | normalization d-False = tmFalse , done , valFalse 235 | normalization (d-If dt1 dt2 dt3) with normalization dt1 236 | normalization (d-If dt1 dt2 dt3) | t1' , e1* , v1' with canonical-forms-bool v1' (preservation* e1* dt1) 237 | normalization (d-If dt1 dt2 dt3) | .tmTrue , e1* , v1' | left refl with normalization dt2 238 | normalization (d-If dt1 dt2 dt3) | .tmTrue , e1* , v1' | left refl | t2' , e2* , v2' = 239 | t2' , (step* map* e-If e1* , step e-IfTrue , e2*) , v2' 240 | normalization (d-If dt1 dt2 dt3) | .tmFalse , e1* , v1' | right refl with normalization dt3 241 | normalization (d-If dt1 dt2 dt3) | .tmFalse , e1* , v1' | right refl | t3' , e3* , v3' = 242 | t3' , (step* map* e-If e1* , step e-IfFalse , e3*) , v3' 243 | normalization d-Zero = tmZero , done , valNum nvZero 244 | normalization (d-Succ dt) with normalization dt 245 | normalization (d-Succ dt) | t' , e* , v' with canonical-forms-nat v' (preservation* e* dt) 246 | normalization (d-Succ dt) | t' , e* , v' | nv' = tmSucc t' , map* e-Succ e* , valNum (nvSucc nv') 247 | normalization (d-Pred dt) with normalization dt 248 | normalization (d-Pred dt) | t' , e* , v' with canonical-forms-nat v' (preservation* e* dt) 249 | normalization (d-Pred dt) | .tmZero , e* , v' | nvZero = 250 | tmZero , (step* map* e-Pred e* , step e-PredZero , done) , valNum (nvZero) 251 | normalization (d-Pred dt) | (tmSucc t2) , e* , v' | nvSucc nv2 = 252 | t2 , (step* map* e-Pred e* , step e-PredSucc nv2 , done) , valNum nv2 253 | normalization (d-IsZero dt) with normalization dt 254 | normalization (d-IsZero dt) | t' , e* , v' with canonical-forms-nat v' (preservation* e* dt) 255 | normalization (d-IsZero dt) | .tmZero , e* , v' | nvZero = 256 | tmTrue , (step* map* e-IsZero e* , step e-IsZeroZero , done) , valTrue 257 | normalization (d-IsZero dt) | (tmSucc t2) , e* , v' | nvSucc nv2 = 258 | tmFalse , (step* map* e-IsZero e* , step e-IsZeroSucc nv2 , done) , valFalse 259 | -------------------------------------------------------------------------------- /Session3.agda: -------------------------------------------------------------------------------- 1 | 2 | {- 3 | 4 | |---------------------------------------------------| 5 | | Formal systems and their applications: exercises | 6 | | Session 3: Formalization of programming languages | 7 | |---------------------------------------------------| 8 | 9 | In this exercise session, the goal will be to see how Agda can be used to formalize 10 | syntax, evaluation rules, and typing rules of programming languages. In this session, 11 | you will do this for a very simple calculus, typed arithmetic expressions from 12 | chapter 8 of "Types and Programming Languages". In the project for this course, you 13 | will have to do the same for a more complicated language. 14 | So you can see this exercise session as a kind of warm-up for the project. 15 | 16 | -} 17 | 18 | open import Data.Nat renaming (ℕ to Nat ; _≟_ to equalNat?) hiding (pred ; _≤_ ; compare) 19 | open import Data.Empty 20 | open import Relation.Binary.PropositionalEquality 21 | open import Data.Product 22 | open import Data.Sum hiding (map) renaming (inj₁ to left ; inj₂ to right) 23 | 24 | 25 | -- Part 1: Untyped boolean terms 26 | --============================== 27 | -- First, we will define the basic syntax of a very simple untyped language of boolean 28 | -- expressions (see TAPL p. 34): 29 | data Term : Set where 30 | tmTrue : Term 31 | tmFalse : Term 32 | tmIf : (t1 t2 t3 : Term) → Term 33 | 34 | -- As a Warm-up exercise, define a function to calculate the size of a term 35 | -- (see TAPL p. 29): 36 | size : Term → Nat 37 | size t = {!!} 38 | 39 | -- In contrast to the TAPL book, in Agda we usually don't define a separate syntactic 40 | -- class of values. Instead, we define a predicate "IsValue t" on terms that expresses 41 | -- that the term t is a value. 42 | data IsValue : Term → Set where 43 | valTrue : IsValue tmTrue 44 | valFalse : IsValue tmFalse 45 | 46 | -- To give the operational semantics of our language, we define the one-step evaluation 47 | -- relation ↝ (unicode input: \r~) as an indexed datatype in Agda. 48 | data _↝_ : Term → Term → Set where 49 | e-IfTrue : {t2 t3 : Term} → (tmIf tmTrue t2 t3 ↝ t2) 50 | -- Add more constructors here, one for each evaluation rule 51 | 52 | -- A term is normal if it doesn't evaluate any further 53 | IsNormal : Term → Set 54 | IsNormal t = {t' : Term} → (t ↝ t') → ⊥ 55 | 56 | -- Prove that all values are normal (Theorem 3.5.7 of TAPL): 57 | values-normal : {t : Term} → IsValue t → IsNormal t 58 | values-normal {t} vt {t'} et = {!!} 59 | 60 | 61 | -- _↝*_ is the multi-step evaluation relation: 62 | -- x ↝* y means that x ↝ x1 ↝ x2 ↝ ... ↝ y 63 | data _↝*_ : Term → Term → Set where 64 | done : {t : Term} → (t ↝* t) 65 | step_,_ : {t t' t'' : Term} → (t ↝ t') → (t' ↝* t'') → (t ↝* t'') 66 | infixr 0 step_,_ 67 | 68 | -- Exercise: as a test, state and prove that 69 | -- if t then false else false ↝* false 70 | -- where 71 | -- s = if true then false else false 72 | -- t = if s then true else true 73 | -- Note: proving should be possible using C-c C-a. 74 | 75 | test-eval1 : {!!} ↝* {!!} 76 | test-eval1 = {!!} 77 | 78 | 79 | -- Part 2: Untyped arithmetic terms 80 | --================================= 81 | 82 | -- As an exercise, add new syntactic forms and evaluation rules for natural numbers 83 | -- to the definitions above (see TAPL p. 41). Also add extra cases to the other 84 | -- functions so that everything typechecks again. You will need to define a new 85 | -- datatype IsNumValue : Term → Set that describes when a term is a numeric value. 86 | -- (When making changes, it is best to comment out all that follows, to make Agda 87 | -- stop complaining. That way, you can make your document consistent again 88 | -- definition by definition.) 89 | 90 | -- Exercise: as a test, state and prove that 91 | -- if false then 0 else (pred (suc (pred 0))) ↝* 0 92 | 93 | test-eval2 : {!!} ↝* {!!} 94 | test-eval2 = {!!} 95 | 96 | 97 | 98 | -- Part 3: Typed arithmetic terms 99 | --=============================== 100 | 101 | -- Now we will define a type system for this simple language of booleans and 102 | -- natural numbers. It has two types: Bool and Nat. 103 | data Type : Set where 104 | tyBool : Type 105 | tyNat : Type 106 | 107 | -- As with the evaluation rules, we encode the typing rules as a data type 108 | -- We use the unicode symbol ∈ (input \in) instead of a colon because the colon 109 | -- is already reserved by Agda. 110 | -- We use the prefix d- for elements of this type, which are called [d]erivations. 111 | data _∈_ : Term → Type → Set where 112 | d-True : tmTrue ∈ tyBool 113 | -- insert more constructors here (one for each typing rule on TAPL p. 93) 114 | 115 | -- As a test, prove that the term `if (iszero 0) then 0 else (pred 0)` 116 | -- has type Nat. 117 | test-typing : {!!} ∈ tyNat 118 | test-typing = {!!} 119 | 120 | -- Inversion lemmas (see TAPL p. 94): 121 | inversion-true : {tyR : Type} → tmTrue ∈ tyR → tyR ≡ tyBool 122 | inversion-true {tyR} d = {!!} 123 | 124 | -- Exercise: state and prove at least two more inversion lemmas 125 | 126 | 127 | -- Uniqueness of types (see TAPL p. 94): 128 | uniqueness-of-types : {t : Term} {tyT1 tyT2 : Type} → t ∈ tyT1 → t ∈ tyT2 → tyT1 ≡ tyT2 129 | uniqueness-of-types {t} {tyT1} {tyT2} d1 d2 = {!!} 130 | 131 | -- Part 4: Safety = progress + preservation (see TAPL p. 96-97) 132 | --============================================================= 133 | 134 | -- First, prove the canonical forms lemma (lemma 8.3.1): 135 | canonical-forms-bool : {t : Term} → (IsValue t) → (t ∈ tyBool) → (t ≡ tmTrue) ⊎ (t ≡ tmFalse) 136 | canonical-forms-bool {t} vt dt = {!!} 137 | 138 | -- Also state and prove the canonical forms lemma for the Nat type: 139 | -- (i.e. prove that any value of type Nat is a numeric value) 140 | canonical-forms-nat : {!!} 141 | canonical-forms-nat = {!!} 142 | 143 | -- Now you are ready to prove progress and preservation of this language. 144 | -- Note: keeping the implicit arguments will make it more clear what you are doing, but will also clutter your proof. 145 | preservation : {t t' : Term} {tyT : Type} → (t ↝ t') → (t ∈ tyT) → (t' ∈ tyT) 146 | preservation {t} {t'} {tyT} e1 d1 = {!!} 147 | 148 | -- Hint: you can use the `with` syntax to pattern match on the value of a 149 | -- function call. For an example of how to use `with`, you can look at 150 | -- the solution of the first exercise session. 151 | 152 | -- Hint: you can write _ as an expression; Agda will then infer its value. 153 | -- This is only possible when only one value would type-check (e.g. the first 154 | -- component of a dependent pair). 155 | 156 | -- Hint: if you remove the dot (.) from a forced pattern, then you can name its arguments. 157 | -- e.g. you can turn `{.tmIf _ _ _}` into `{tmIf t1 t2 t3}` 158 | 159 | progress : {t : Term} {tyT : Type} → t ∈ tyT → (IsValue t) ⊎ (Σ[ t' ∈ Term ] (t ↝ t')) 160 | progress d1 = {!!} 161 | 162 | ------------------------------------------------------- 163 | -- Challenge: Prove normalization of this calculus. 164 | 165 | -- The following lemmas are straightforward 166 | -- to prove in terms of their counterparts that operate on ↝ instead of ↝*, 167 | -- and may come in handy. 168 | 169 | preservation* : {t t' : Term} {tyT : Type} → (t ↝* t') → (t ∈ tyT) → (t' ∈ tyT) 170 | preservation* et* dt = {!!} 171 | 172 | -- The following function can be applied to rules like e-If, e-Pred, ... 173 | map* : {f : Term → Term} 174 | → (f↝ : {t t' : Term} → t ↝ t' → f t ↝ f t') 175 | → {t t' : Term} → t ↝* t' → f t ↝* f t' 176 | map* f↝ et* = {!!} 177 | 178 | step*_,_ : ∀ {t t' t''} → t ↝* t' → t' ↝* t'' → t ↝* t'' 179 | step* et* , et*' = {!!} 180 | infixr 0 step*_,_ 181 | 182 | --now prove normalization 183 | 184 | normalization : ∀ {t tyT} → t ∈ tyT → Σ[ t' ∈ Term ] ((t ↝* t') × IsValue t') 185 | normalization dt = {!!} 186 | --------------------------------------------------------------------------------