├── BasicPrelude.lagda ├── CS410.bib ├── CS410.lagda ├── CS410.pdf ├── EmacsCheatSheet.lagda ├── Ex1.agda ├── Ex1Prelude.agda ├── Ex2.lagda ├── Ex3.agda ├── Ex4.agda ├── Ex5 ├── ANSIEscapes.hs ├── AgdaSetup.agda ├── Edit.agda ├── HaskellSetup.hs └── Makefile ├── FunctorKit.agda ├── Hello.agda ├── Introduction.lagda ├── Lec10.agda ├── Lec11.agda ├── Lec2.agda ├── Lec3.agda ├── Lec4.agda ├── Lec5.lagda ├── Lec6.agda ├── Lec7.agda ├── Lec8.agda ├── Lec9.agda ├── Logic.lagda ├── Makefile ├── MaybeLec6.lagda ├── README.md ├── Razor.lagda └── replace.sed /BasicPrelude.lagda: -------------------------------------------------------------------------------- 1 | \chapter{A Basic Prelude} 2 | 3 | Let us build some basic types and equipment for general use. We might need to 4 | rethink some of this stuff later, but it's better to keep things simple until 5 | life forces complexity upon us. In the course of establishing this setup, we'll 6 | surely encounter language features in need of explanation. 7 | 8 | Concretely, we shall implement 9 | 10 | %format BasicPrelude = "\M{BasicPrelude}" 11 | \begin{code} 12 | module BasicPrelude where 13 | \end{code} 14 | 15 | the source code for this chapter of the notes is indeed that very module. 16 | We'll be able to import this module into others that we define later. 17 | The first exercise will put it to good use. 18 | 19 | 20 | \section{Natural Numbers} 21 | 22 | We have already had a quick preview of the datatype of natural numbers. 23 | Let us have it in our prelude. 24 | 25 | %format Set = "\D{Set}" 26 | %format Nat = "\D{Nat}" 27 | %format zero = "\C{zero}" 28 | %format suc = "\C{suc}" 29 | \begin{code} 30 | data Nat : Set where 31 | zero : Nat 32 | suc : Nat -> Nat 33 | 34 | {-# BUILTIN NATURAL Nat #-} 35 | {-# BUILTIN ZERO zero #-} 36 | {-# BUILTIN SUC suc #-} 37 | \end{code} 38 | 39 | The funny comment-like BUILTIN things are not comments, but 40 | \emph{pragmas}---not quite official parts of the language. Agda's 41 | implementers expected that we might need to define numbers, so these 42 | pragmas just tell Agda what we've chosen to call the bits and 43 | pieces. The payoff is that we are now allowed write numbers in 44 | \emph{decimal}, leaving Agda to do all that |suc|cing. 45 | 46 | If we define addition, 47 | %format + = "\F{+}" 48 | %format _+_ = "\us{" + "}" 49 | \begin{code} 50 | _+_ : Nat -> Nat -> Nat 51 | zero + n = n 52 | suc m + n = suc (m + n) 53 | 54 | infixr 5 _+_ 55 | \end{code} 56 | then we can try evaluating expressions (using [C-c C-n]) such as 57 | \begin{spec} 58 | 1 + 2 + 3 + 4 59 | \end{spec} 60 | Note that the |infixr 5| declaration assigns a precedence level of 5 to |+| 61 | (with higher binding more tightly) and ensures that multiple additions group 62 | to the right. The above means 63 | \begin{spec} 64 | 1 + (2 + (3 + 4)) 65 | \end{spec} 66 | 67 | 68 | \section{Impossible, Trivial, and Different} 69 | 70 | In this section, we build three finite types, capturing important basic 71 | concepts. 72 | 73 | %format Zero = "\D{Zero}" 74 | %format magic = "\F{magic}" 75 | \subsection{|Zero|} 76 | The |Zero| type has nothing after its |where| but silence. There is no way 77 | to make a \emph{value} of type |Zero|. In Haskell, you could just write an 78 | infinite recursion or take the head of an empty list, but Agda won't 79 | countenance such dodges. 80 | \begin{code} 81 | data Zero : Set where 82 | \end{code} 83 | 84 | The |Zero| type represents the idea of \emph{impossibility}, which is a very useful 85 | idea, because if it's impossible to get into a situation, you don't need to worry 86 | about how to get out of it. The following definition bottles that intuition. 87 | \begin{code} 88 | magic : {X : Set} -> 89 | Zero -> X 90 | magic () 91 | \end{code} 92 | There's plenty to explain here. The |{X : Set} ->| means 93 | `for all |Set|s, |X|'. So, the whole type says `for all |Set|s |X|, there is a 94 | function from |Zero| to |X|'. To define a function, we must explain which 95 | value of the output type to return for each value of the input type. But that 96 | ought to be very easy, because there are no values of the input type! It's 97 | a bit like saying `if you believe \emph{that}, you'll believe anything'. 98 | 99 | The braces have a secondary meaning: they tell Agda that we don't want 100 | to write |X| explicitly when we use |magic|. Rather, we want Agda to 101 | infer which |X| is relevant from the context in which |magic| is being 102 | used, just the same way that Haskell silently infers the types at 103 | which polymorphic functions are used. So, the first visible argument 104 | of |magic| has type |Zero|. If we're refining a 105 | goal by |magic ?|, then it's clear that |X| should be the goal type, and 106 | then we are left finding something of type |Zero| to fill in for the |?|. 107 | 108 | But how do way say what |magic| does? We don't. Instead, we say that 109 | it doesn't. The definition of |magic| is not given by an equation, 110 | but rather by \emph{refutation}. In Agda, if we can point out that an 111 | input to a function is impossible, we do not have to write an |=| sign 112 | and an output. The way we point it out is to write the 113 | \emph{absurd pattern} |()| in the place of the impossible thing. We're 114 | effectively saying `BUSTED!'. 115 | 116 | Note, by the way, that Agda's notation thus makes |()| mean the 117 | opposite of what it means in Haskell, where it's the empty tuple, 118 | easily constructed but not very informative. That's also a useful 119 | thing to have around. 120 | 121 | %format One = "\D{One}" 122 | %format <> = "\C{\left<\right>}" 123 | \subsection{|One|} 124 | 125 | \textbf{tl;dr} There is a type called |One|. It has one element, written |<>|. 126 | 127 | I could define a |data|type with one constructor. Instead, let me show 128 | you another feature of Agda---|record|s. Where a |data|type is given 129 | by a \emph{choice} of constructors, a |record| type is given by a 130 | \emph{collection} of fields. To build a record value, one must supply 131 | a value for each field. I define |One| to be the record type with 132 | \emph{no fields}, so it is very easy to give a value for each field: there's 133 | only one way to do it. 134 | \begin{code} 135 | record One : Set where 136 | \end{code} 137 | 138 | Values of |record| types are officially written 139 | |record {field1 = value1;...;fieldn = valuen}|, so the only value in |One| is 140 | \begin{spec} 141 | record {} 142 | \end{spec} 143 | which is a bit of a mouthful for something so trivial. Fortunately, Agda lets 144 | us give a neater notation. We may optionally equip a record type with a 145 | \emph{constructor}---the function which makes a record, taking the values of the 146 | fields as arguments. As part of the record declaration, I write 147 | \begin{code} 148 | constructor <> 149 | \end{code} 150 | which means, because there are no arguments, that 151 | \begin{spec} 152 | <> : One 153 | \end{spec} 154 | We are allowed to use either the official |record| notation or the constructor 155 | shorthand when we write patterns. Note that pattern matching an element of |One| 156 | does not tell us anything we didn't already know. Think: 157 | 158 | \begin{tabular}{cccc} 159 | |Zero| & impossible to make & useful to possess & not representable with bits \\ 160 | |One| & trivial to make & useless to possess & representable with no bits \\ 161 | \end{tabular} 162 | 163 | On reflection, it is perhaps perverse to introduce record types with such a 164 | degenerate example. We'll have some proper records with fields in, shortly. 165 | 166 | But first, let us complete our trinity of finite types by getting our hands 167 | on a bit, at last. 168 | 169 | %format Two = "\D{Two}" 170 | %format tt = "\C{t\!t}" 171 | %format ff = "\C{f\!f}" 172 | \section{|Two|} 173 | 174 | The type |Two| represents a choice between exactly two things. As it is a 175 | choice, let's define it as a |data|type. As the two constructors have the 176 | same type, I can save space and declare them on the same line. 177 | \begin{code} 178 | data Two : Set where 179 | tt ff : Two 180 | \end{code} 181 | In Haskell, this type is called Bool and has values True and False. I call 182 | the type |Two| to remind you how big it is, and I use ancient abbreviations 183 | for the constructors. 184 | 185 | Agda's cunning mixfix syntax lets you rebuild familiar notations. 186 | %format if = "\F{if}" 187 | %format then = "\F{then}" 188 | %format else = "\F{else}" 189 | %format if_then_else_ = if _ then _ else _ 190 | \begin{code} 191 | if_then_else_ : {X : Set} -> Two -> X -> X -> X 192 | if tt then t else f = t 193 | if ff then t else f = f 194 | \end{code} 195 | Again, we expect Agda to figure out the type of the conditional expression 196 | from the context, so we use braces to indicate that it should be hidden. 197 | 198 | (Here are some dangling questions. Is it good that the types of the 199 | two branches are just the same as the type of the overall expression? 200 | Do we not know more, once we have checked the condition? How could we 201 | know that we know more?) 202 | 203 | We can use conditionals to define conjunction of two Booleans: 204 | 205 | \begin{code} 206 | _/\_ : Two -> Two -> Two 207 | b1 /\ b2 = if b1 then b2 else ff 208 | \end{code} 209 | % 210 | Now that we have a way to represent Boolean values and conditional expressions, 211 | we might like to have some conditions. E.g., let us be able to compare numbers. 212 | %format <= = "\F{\le}" 213 | %format _<=_ = "\us{" <= "}" 214 | \begin{code} 215 | _<=_ : Nat -> Nat -> Two 216 | zero <= y = tt 217 | suc x <= zero = ff 218 | suc x <= suc y = x <= y 219 | \end{code} 220 | 221 | %format List = "\D{List}" 222 | %format :> = "\C{:\!>}" 223 | %format _:>_ = "\us{" :> "}" 224 | \section{|List|s} 225 | 226 | We can declare a |data|type which does the job of Haskell's workhorse 227 | |[a]|. The definition of |List| is parametrized by some |X|, the set 228 | in to which the list's elements belong. I write the parameters for the 229 | datatype to the left of the |:| in the declaration. 230 | \nudge{A typesetting gremlin prevents me from colouring |[]| red.} 231 | \begin{code} 232 | data List (X : Set) : Set where 233 | [] : List X 234 | _:>_ : X -> List X -> List X 235 | 236 | infixr 5 _:>_ 237 | \end{code} 238 | I give a `nil' constructor, |[]|, and a right associative infix `cons' constructor, 239 | |:>|, which is arrowhead-shaped to remind you that you access list elements 240 | from left to right. We can write lists like 241 | \begin{spec} 242 | 1 :> 2 :> 3 :> 4 :> 5 :> [] 243 | \end{spec} 244 | but Agda does not supply any fancy syntax like Haskell's |[1,2,3,4,5]|. 245 | 246 | How many values are there in the set |List Zero|? 247 | 248 | Does the set |List One| remind you of any other set that you know? 249 | 250 | \begin{code} 251 | infixr 5 _++_ 252 | 253 | _++_ : {A : Set} -> List A -> List A -> List A 254 | [] ++ ys = ys 255 | (x :> xs) ++ ys = x :> (xs ++ ys) 256 | \end{code} 257 | 258 | 259 | \section{Interlude: Insertion} 260 | 261 | %format insertionSort = "\F{insertionSort}" 262 | %format insertList = "\F{insertList}" 263 | 264 | We've got quite a bit of kit now. Let's take a break from grinding out 265 | library components and write a program or two. In particular, as we have 266 | numbers and lists and comparison, we could write insertion sort. Let's 267 | see if we can remember how it goes. Split into cases, and the empty case 268 | is clear. 269 | \begin{spec} 270 | insertionSort : List Nat -> List Nat 271 | insertionSort [] = [] 272 | insertionSort (x :> xs) = ? 273 | \end{spec} 274 | What happens next? If we can insert |x| into the right place after sorting 275 | |xs|, we'll be home. Agda is a declare-before-use language, but a declaration 276 | does not have to be right next to the corresponding definition. We can make 277 | progress like this. 278 | \begin{code} 279 | insertionSort : List Nat -> List Nat 280 | 281 | insertList : Nat -> List Nat -> List Nat 282 | 283 | insertionSort [] = [] 284 | insertionSort (x :> xs) = insertList x (insertionSort xs) 285 | \end{code} 286 | \begin{spec} 287 | insertList y xs = ? 288 | \end{spec} 289 | Now, how do we insert? Again, we need to split the list into its cases. 290 | the |[]| case is easy. (It's also easy to get wrong.) 291 | \begin{spec} 292 | insertList y [] = y :> [] 293 | insertList y (x :> xs) = ? 294 | \end{spec} 295 | To proceed in the `cons` case, we need to know whether or not |y| should 296 | come before |x|. We could go with 297 | \[ 298 | |if y <= x then ? else ?| 299 | \] 300 | but let me take the chance to show you another feature. Instead of moving 301 | to the right and giving an expression, Agda lets us bring the extra information 302 | we need to the \emph{left}, where we can pattern match on it. 303 | \begin{spec} 304 | insertList y [] = y :> [] 305 | insertList y (x :> xs) with y <= x 306 | insertList y (x :> xs) | b = ? 307 | \end{spec} 308 | The |with| construct adds an extra column to the left-hand side, tabulating 309 | cases for the result of the given expression. Now, if we split on |b|, we get 310 | \begin{spec} 311 | insertList y [] = y :> [] 312 | insertList y (x :> xs) with y <= x 313 | insertList y (x :> xs) | tt = ? 314 | insertList y (x :> xs) | ff = ? 315 | \end{spec} 316 | and for each line of this extended table, it is clear what the output must be. 317 | \begin{code} 318 | insertList y [] = y :> [] 319 | insertList y (x :> xs) with y <= x 320 | insertList y (x :> xs) | tt = y :> x :> xs 321 | insertList y (x :> xs) | ff = x :> insertList y xs 322 | \end{code} 323 | If the patterns to the left of the bar stay just the same as on the |with|-line, 324 | we're allowed to abbreviate them, as folllows. 325 | \begin{spec} 326 | insertList y [] = y :> [] 327 | insertList y (x :> xs) with y <= x 328 | ... | tt = y :> x :> xs 329 | ... | ff = x :> insertList y xs 330 | \end{spec} 331 | Which of these strikes you as a better document is a matter of taste. 332 | 333 | \subsection{Programs as Decision Trees} 334 | 335 | It's good to think of a function definition as the description of a 336 | \emph{decision tree}. We start by considering a bunch of inputs and we need 337 | a strategy 338 | to deliver an output. We can 339 | \begin{itemize} 340 | \item give an output built from the stuff we've got, with the |= output| strategy; 341 | \item split one of our things into constructor cases, in each case considering 342 | the structures inside (and if there are no cases, we document that with an 343 | absurd pattern); 344 | \item get more stuff to consider by asking the value of some |extra| expressed 345 | in terms 346 | of the stuff we already have---that's what the right-hand side, |with extra|, 347 | achieves. 348 | \end{itemize} 349 | 350 | You can read a program as a dialogue between the machine, saying `what 351 | am I supposed to do with this stuff?' on the left, and the programmer, 352 | explaining how to proceed on the right by one of the above strategies. 353 | The case-splitting nodes aren't documented by an explicit 354 | right-hand-side in the final program, but you see them in passing 355 | while you work, and you can see that they result in multiple left-hand 356 | sides for distinguished cases. Agda figures out how to compute your 357 | functions by reconstructing the full decision tree from the 358 | constructors in your patterns. 359 | 360 | 361 | \section{Unit Testing with Dependent Types} 362 | 363 | %format == = "\D{==}" 364 | %format _==_ = "\us{" == "}" 365 | %format refl = "\C{refl}" 366 | 367 | I'm only in chapter two and I can't resist the temptation. I want to be able 368 | to write unit tests in my code---example expressions which should have the 369 | values given, e.g. 370 | \[ 371 | |insertionSort (5 :> 2 :> 4 :> 3 :> 1 :> []) == (1 :> 2 :> 3 :> 4 :> 5 :> [])| 372 | \] 373 | 374 | The good news is that Agda can run old programs \emph{during} typechecking of 375 | new programs. We can make the typechecker run our unit tests for us, making use 376 | of the following\nudge{Yes, it is scary.} piece of kit. 377 | 378 | \begin{spec} 379 | infix 4 _==_ 380 | 381 | data _==_ {X : Set}(x : X) : X -> Set where 382 | refl : x == x 383 | \end{spec} 384 | 385 | \begin{code} 386 | 387 | postulate 388 | Level : Set 389 | lzero : Level 390 | lsuc : Level -> Level 391 | lmax : Level -> Level -> Level 392 | 393 | {-# BUILTIN LEVEL Level #-} 394 | {-# BUILTIN LEVELZERO lzero #-} 395 | {-# BUILTIN LEVELSUC lsuc #-} 396 | {-# BUILTIN LEVELMAX lmax #-} 397 | 398 | data _==_ {l}{X : Set l}(x : X) : X -> Set l where 399 | refl : x == x 400 | infix 4 _==_ 401 | {-# BUILTIN EQUALITY _==_ #-} 402 | {-# BUILTIN REFL refl #-} 403 | \end{code} 404 | 405 | This |data|type has two parameters: the |X| in braces is a |Set|, and the 406 | braces, as ever, mean that it should be hidden; the |x| is an element of |X|, 407 | and its \emph{round} brackets mean that it should be \emph{visible}, in this 408 | case as the thing to the left of the |==| sign. However, right of the |:|, 409 | we have |X -> Set|, not just |Set|, because this is an \emph{indexed} collection 410 | of sets. For each |y : X|, we get a set |x == y| whose elements represent 411 | \emph{evidence} that |x| and |y| are equal. The constructor tells us the only 412 | way to generate the evidence. The return type of a constructor may choose any 413 | value for the index, and it delivers values only for that index. Here, by 414 | choosing |x| for the index in the type of |refl|, we ensure that for equality 415 | evidence to exist, the two sides of the equation must have the very same value. 416 | 417 | The upshot of all this is that we can write a unit test like this: 418 | %format iTest = "\F{iTest}" 419 | \begin{code} 420 | iTest : insertionSort (5 :> 2 :> 4 :> 3 :> 1 :> []) == (1 :> 2 :> 3 :> 4 :> 5 :> []) 421 | iTest = refl 422 | \end{code} 423 | The typechecker must make sure it is valid to use the |refl| constructor, 424 | so it evaluates both sides of the equation to ensure that they are the same. 425 | 426 | Try messing up the program to see what happens! 427 | 428 | Even better, try deleting the program and rebuilding it interactively. While 429 | your program is under construction and the test might possibly work out fine in 430 | the end, the |refl| evidence in the unit test will have a yellow background, 431 | indicating that it is \yellowBG{suspicious}\nudge{sus-pish-ous}. But you will not 432 | be allowed to do anything interactively which makes the test actually fail, and if 433 | you override the interactive system and load a silly program, the refl will 434 | have the brown background of \brownBG{steaming unpleasantness}. 435 | 436 | We won't be fooling around with fancy types in programming for a while yet, 437 | but unit testing is a good engineering practice, so let us take advantage 438 | of Agda's capacity to support it. 439 | 440 | 441 | \section{More Prelude: Sums and Products} 442 | 443 | %format /+/ = "\D{/\!\!+\!\!/}" 444 | %format _/+/_ = "\us{" /+/ "}" 445 | %format inl = "\C{inl}" 446 | %format inr = "\C{inr}" 447 | We often build datatypes which offer some sort of choice. Sometimes we just 448 | want to give a choice between two types which are already established. The 449 | type which offers `an |S| or a |T|' is called the \emph{sum} of |S| and 450 | |T|.\nudge{Haskell calls this construction |Either|.} We define it as a datatype 451 | with |S| and |T| as parameters, allowing 452 | constructors, for `left injection' and `right injection', respectively. 453 | \begin{code} 454 | infixr 1 _/+/_ 455 | 456 | data _/+/_ (S T : Set) : Set where 457 | inl : S -> S /+/ T 458 | inr : T -> S /+/ T 459 | \end{code} 460 | 461 | To see why it really is a kind of sum, try finding all the \emph{values} in each of 462 | \[ 463 | |Zero /+/ Zero|\quad |Zero /+/ One|\quad |One /+/ One|\quad 464 | |One /+/ Two|\quad |Two /+/ Two| 465 | \] 466 | 467 | When we offer a choice, we need to able to cope with either possibility. 468 | The following gadget captures the idea of `computing by cases'. 469 | 470 | %format = "\F{\left}" 471 | %format __ = "\us{" "}" 472 | \begin{code} 473 | __ : {S T X : Set} -> 474 | (S -> X) -> (T -> X) -> 475 | S /+/ T -> X 476 | (f g) (inl s) = f s 477 | (f g) (inr t) = g t 478 | \end{code} 479 | It might look a bit weird that it's an \emph{infix} operator with \emph{three} 480 | arguments, but it's used in a higher-order way. To make a function, 481 | |f g| which takes |S /+/ T| to some |X|, you need to have a function for each 482 | case, so |f| in |S -> X| and |g| in |T -> X|. 483 | 484 | %format /*/ = "\D{/\!\!\times\!\!/}" 485 | %format _/*/_ = "\us{" /*/ "}" 486 | %format , = "\C{,}" 487 | %format outl = "\F{outl}" 488 | %format outr = "\F{outr}" 489 | Meanwhile, another recurrent theme in type design is that we ask for a \emph{pair} 490 | of things, drawn from existing types.\nudge{Haskell uses the notation |(s,t)| for 491 | both the types and values.} This is, somehow, the classic example of a |record|. 492 | \begin{code} 493 | infixr 2 _/*/_ 494 | 495 | record _/*/_ (S T : Set) : Set where 496 | constructor _,_ 497 | field 498 | outl : S 499 | outr : T 500 | open _/*/_ public 501 | infixr 4 _,_ 502 | \end{code} 503 | I have a little explaining to do, here. The |field| keyword introduces the 504 | declarations of the record's fields, which must be indented below it. 505 | We have two fields, so it makes sense to have an infix |constructor|, which is 506 | just a comma---unlike Haskell, parentheses are needed only to resolve ambiguity. 507 | The |open| declaration makes |outl| and |outr| available as the `left projection' 508 | and `right projection' functions, respectively. You can check that 509 | \[ 510 | |outl : {S T : Set} -> S /*/ T -> S| \qquad 511 | |outr : {S T : Set} -> S /*/ T -> T| 512 | \] 513 | The |public| means that |outl| and |outr| stay in scope whenever any other module 514 | imports this one. 515 | 516 | To see why |S /*/ T| is called the \emph{product} of |S| and |T|, try finding 517 | all the values in the following types. 518 | \[ 519 | |Zero /*/ Zero|\quad |Zero /*/ One| \quad |One /*/ One|\quad 520 | |One /*/ Two|\quad |Two /*/ Two| 521 | \] 522 | 523 | It is sometimes useful to be able to convert a function which takes a 524 | pair into a function which takes its arguments one at a time. This 525 | conversion is called `currying' after the logician, Haskell Curry, 526 | even though Moses Scho\"nfinkel invented it slightly earlier. 527 | %format curry = "\F{curry}" 528 | \begin{code} 529 | curry : {S T X : Set} -> 530 | (S /*/ T -> X) -> 531 | S -> T -> X 532 | curry f s t = f (s , t) 533 | \end{code} 534 | Its inverse is, arguably, even more useful, as it tells you how to build a 535 | function from pairs by considering each component separately. 536 | %format uncurry = "\F{uncurry}" 537 | \begin{code} 538 | uncurry : {S T X : Set} -> 539 | (S -> T -> X) -> 540 | S /*/ T -> X 541 | uncurry f (s , t) = f s t 542 | \end{code} 543 | 544 | 545 | \section{Interlude: Exponentiation} 546 | 547 | How many functions are there in a type |S -> T|? It depends on when we consider 548 | two functions to be the same. Mathematically, such a function is considered just 549 | to be the choice of a |T| value corresponding to each |S| value. There might be 550 | lots of different ways to \emph{implement} that function, but if two programs 551 | of type |S -> T| agree on outputs whenever we feed them the same inputs, we say 552 | they are two implementations of the same function. 553 | 554 | So it's easy to count functions, at least if the sets involved are 555 | finite. If there are |t| different elements of |T| and |s| different 556 | elements of |S|, then we need to choose one of the |t| for each one of 557 | the |s|, so that's $t^s$ different possibilities. Just as |S /+/ T| really 558 | behaves like a sum and |S /*/ T| really behaves like a product, we 559 | find that |S -> T| really behaves like the exponential $|T|^{|S|}$. 560 | 561 | The fact that |curry| and |uncurry| are mutually inverse (or \emph{isomorphic}) 562 | just tells us something we learned in school 563 | \[ 564 | |X|^{(|S /*/ T|)} \cong (|X|^{|T|})^{|S|} 565 | \] 566 | 567 | You might also remember that 568 | \[ 569 | |X|^{(|S /+/ T|)} \cong |X|^{|S|} |/*/| |X|^{|T|} 570 | \] 571 | and it's not hard to see why that makes sense in terms of counting functions. 572 | (Think about what || does.) 573 | 574 | Many of the algebraic laws you learned for numeric operations at school 575 | make perfect sense for \emph{type} operations and account for structures 576 | fundamental to computation. That's (to some extent) how the Mathematically 577 | Structured Programming Group came by its name. Keep your eyes peeled for more! 578 | 579 | 580 | \section{More Prelude: Basic Functional Plumbing} 581 | 582 | %format id = "\F{id}" 583 | %format o = "\F{\circ}" 584 | %format _o_ = "\us{" o "}" 585 | 586 | Functions are a bit like machines with an input pipe and an output pipe. Their 587 | types tell us whether it's safe to plumb them together. Any functional plumber 588 | needs some basic tools. 589 | 590 | Firstly, here's a bit of pipe with no machine in the middle---the \emph{identity} 591 | function. What comes out is what went in! 592 | \begin{code} 593 | id : {X : Set} -> X -> X 594 | id x = x 595 | \end{code} 596 | 597 | Secondly, we need to be able to plumb the output from one machine to the input 598 | of another. Here's function \emph{composition}. 599 | \begin{code} 600 | _o_ : {A B C : Set} -> (B -> C) -> (A -> B) -> (A -> C) 601 | (f o g) a = f (g a) 602 | 603 | infixr 2 _o_ 604 | \end{code} 605 | 606 | What laws do you think |id| and |o| should obey? If you plumb an extra bit of pipe 607 | onto a machine, does it change what the machine does? If you plumb a sequence of 608 | machines together, the order of the machines can clearly matter, but does the 609 | order in which you did the plumbing jobs affect the behaviour of the end product? 610 | 611 | -------------------------------------------------------------------------------- /CS410.bib: -------------------------------------------------------------------------------- 1 | @inproceedings{DBLP:conf/afp/Norell08, 2 | author = {Ulf Norell}, 3 | title = {Dependently Typed Programming in Agda}, 4 | booktitle = {Advanced Functional Programming}, 5 | year = {2008}, 6 | pages = {230-266}, 7 | ee = {http://dx.doi.org/10.1007/978-3-642-04652-0_5}, 8 | crossref = {DBLP:conf/afp/2008}, 9 | bibsource = {DBLP, http://dblp.uni-trier.de} 10 | } 11 | 12 | @proceedings{DBLP:conf/afp/2008, 13 | editor = {Pieter W. M. Koopman and 14 | Rinus Plasmeijer and 15 | S. Doaitse Swierstra}, 16 | title = {Advanced Functional Programming, 6th International School, 17 | AFP 2008, Heijen, The Netherlands, May 2008, Revised Lectures}, 18 | booktitle = {Advanced Functional Programming}, 19 | publisher = {Springer}, 20 | series = {LNCS}, 21 | volume = {5832}, 22 | year = {2009}, 23 | ee = {http://dx.doi.org/10.1007/978-3-642-04652-0}, 24 | bibsource = {DBLP, http://dblp.uni-trier.de} 25 | } -------------------------------------------------------------------------------- /CS410.lagda: -------------------------------------------------------------------------------- 1 | \documentclass{book} 2 | \usepackage{a4} 3 | \usepackage{palatino} 4 | \usepackage{natbib} 5 | \usepackage{amsfonts} 6 | \usepackage{stmaryrd} 7 | \usepackage{upgreek} 8 | \usepackage{url} 9 | 10 | 11 | \DeclareMathAlphabet{\mathkw}{OT1}{cmss}{bx}{n} 12 | 13 | \usepackage{color} 14 | \newcommand{\redFG}[1]{\textcolor[rgb]{0.6,0,0}{#1}} 15 | \newcommand{\greenFG}[1]{\textcolor[rgb]{0,0.4,0}{#1}} 16 | \newcommand{\blueFG}[1]{\textcolor[rgb]{0,0,0.8}{#1}} 17 | \newcommand{\orangeFG}[1]{\textcolor[rgb]{0.8,0.4,0}{#1}} 18 | \newcommand{\purpleFG}[1]{\textcolor[rgb]{0.4,0,0.4}{#1}} 19 | \newcommand{\yellowFG}[1]{\textcolor{yellow}{#1}} 20 | \newcommand{\brownFG}[1]{\textcolor[rgb]{0.5,0.2,0.2}{#1}} 21 | \newcommand{\blackFG}[1]{\textcolor[rgb]{0,0,0}{#1}} 22 | \newcommand{\whiteFG}[1]{\textcolor[rgb]{1,1,1}{#1}} 23 | \newcommand{\yellowBG}[1]{\colorbox[rgb]{1,1,0.2}{#1}} 24 | \newcommand{\brownBG}[1]{\colorbox[rgb]{1.0,0.7,0.4}{#1}} 25 | 26 | \newcommand{\ColourStuff}{ 27 | \newcommand{\red}{\redFG} 28 | \newcommand{\green}{\greenFG} 29 | \newcommand{\blue}{\blueFG} 30 | \newcommand{\orange}{\orangeFG} 31 | \newcommand{\purple}{\purpleFG} 32 | \newcommand{\yellow}{\yellowFG} 33 | \newcommand{\brown}{\brownFG} 34 | \newcommand{\black}{\blackFG} 35 | \newcommand{\white}{\whiteFG} 36 | } 37 | 38 | \newcommand{\MonochromeStuff}{ 39 | \newcommand{\red}{\blackFG} 40 | \newcommand{\green}{\blackFG} 41 | \newcommand{\blue}{\blackFG} 42 | \newcommand{\orange}{\blackFG} 43 | \newcommand{\purple}{\blackFG} 44 | \newcommand{\yellow}{\blackFG} 45 | \newcommand{\brown}{\blackFG} 46 | \newcommand{\black}{\blackFG} 47 | \newcommand{\white}{\blackFG} 48 | } 49 | 50 | \ColourStuff 51 | 52 | 53 | \newcommand{\M}[1]{\mathsf{#1}} 54 | \newcommand{\D}[1]{\blue{\mathsf{#1}}} 55 | \newcommand{\C}[1]{\red{\mathsf{#1}}} 56 | \newcommand{\F}[1]{\green{\mathsf{#1}}} 57 | \newcommand{\V}[1]{\purple{\mathit{#1}}} 58 | \newcommand{\T}[1]{\raisebox{0.02in}{\tiny\green{\textsc{#1}}}} 59 | 60 | \newcommand{\us}[1]{\_\!#1\!\_} 61 | 62 | %include lhs2TeX.fmt 63 | %include lhs2TeX.sty 64 | %include polycode.fmt 65 | 66 | %subst keyword a = "\mathkw{" a "}" 67 | %subst conid a = "\V{" a "}" 68 | %subst varid a = "\V{" a "}" 69 | 70 | %format -> = "\blue{\rightarrow}" 71 | 72 | \newcommand{\nudge}[1]{\marginpar{\footnotesize #1}} 73 | \newtheorem{exe}{Exercise}[chapter] 74 | 75 | %format rewrite = "\mathkw{rewrite}" 76 | %format constructor = "\mathkw{constructor}" 77 | 78 | %format ? = "\orange{?}" 79 | 80 | \parskip 0.1in 81 | \parindent 0in 82 | 83 | \begin{document} 84 | 85 | \title{CS410\\ 86 | Advanced Functional Programming} 87 | \author{Conor McBride \\ 88 | Mathematically Structured Programming Group \\ 89 | Department of Computer and Information Sciences \\ 90 | University of Strathclyde} 91 | \maketitle 92 | 93 | 94 | 95 | %include Introduction.lagda 96 | 97 | %include BasicPrelude.lagda 98 | 99 | %include Logic.lagda 100 | 101 | %include Razor.lagda 102 | 103 | 104 | \appendix 105 | %include EmacsCheatSheet.lagda 106 | 107 | \bibliographystyle{plainnat} 108 | \bibliography{CS410.bib} 109 | 110 | 111 | \end{document} -------------------------------------------------------------------------------- /CS410.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pigworker/CS410-13/911aaf6eaccdc1b2770358dad3d6690c0a4a468f/CS410.pdf -------------------------------------------------------------------------------- /EmacsCheatSheet.lagda: -------------------------------------------------------------------------------- 1 | \chapter{Agda Mode Cheat Sheet} 2 | 3 | I use standard emacs keystroke descriptions. E.g., `C-c' means control-c. 4 | I delimit keystrokes with square brackets, but don't type the brackets or the 5 | spaces between the individual key descriptions. 6 | 7 | 8 | \section{Managing the buffer} 9 | 10 | \subsection*{[C-c C-l] load buffer} 11 | 12 | This keystroke tells Agda to resynchronize with the buffer contents, typechecking 13 | everything. It will also make sure everything is displayed in the correct colour. 14 | 15 | \subsection*{[C-c C-x C-d] deactivate goals} 16 | 17 | This keystroke deactivates Agda's goal machinery. 18 | 19 | \subsection*{[C-c C-x C-r] restart Agda} 20 | 21 | This keystroke restarts Agda. 22 | 23 | \section{Working in a goal} 24 | 25 | The following apply only when the cursor is sitting inside the braces of a goal. 26 | 27 | \subsection*{[C-c C-,] what's going on?} 28 | 29 | If you select a goal and type this keystroke, the information buffer 30 | will tell you the type of the goal and the types of everything in the 31 | context. Some things in the context are not in scope, because you 32 | haven't bound them with a name anywhere. These show up with names 33 | Agda chooses, beginning with a dot: you cannot refer to these things, 34 | but they do exist. 35 | 36 | \subsection*{[C-c C-.] more on what's going on?} 37 | 38 | This is a variant of the above which in addition also shows you the type 39 | of the expression currently typed into the hole. This is useful for 40 | trying different constructions out before giving/refining them! 41 | 42 | \subsection*{[C-c C-spc] give expression} 43 | 44 | If you think you know which expression belongs in a goal, type the expression 45 | between its braces, then use this keystroke. The expression can include |?| 46 | symbols, which become subgoals. 47 | 48 | \subsection*{[C-c C-c] case split} 49 | 50 | If your goal is immediately to the right of |=|, then you're still building your 51 | program's decision tree, so you can ask for a case analysis. Type the name of 52 | a variable in the goal, then make this keystroke. Agda will try to split that 53 | variable into its possible constructor patterns. Amusingly, if you type several 54 | variables names and ask for a case analysis, you will get all the possible 55 | combinations from splitting each of the variables. 56 | 57 | \subsection*{[C-c C-r] refine} 58 | 59 | If there's only one constructor which fits in the hole, Agda deploys 60 | it. If there's a choice, Agda tells you the options. 61 | 62 | \subsection*{[C-c C-a] ask Agsy (a.k.a. I feel lucky)} 63 | 64 | If you make this keystroke, Agda will use a search mechanism called 65 | `Agsy' to try and guess something with the right type. Agsy may not 66 | succeed. Even if it does, the guess may not be the right answer. 67 | Sometimes, however, there's obviously only one sensible thing to do, 68 | and then Agsy is your bezzy mate! It can be an incentive to make your 69 | types precise! 70 | 71 | 72 | \section{Checking and Testing things} 73 | 74 | \subsection*{[C-c C-d] deduce type of expression} 75 | 76 | If you type this keystroke, you will be prompted for an expression. If 77 | the expression you supply makes sense, you will be told its type. 78 | 79 | If you are working in a goal and have typed an expression already, Agda will 80 | assume that you want the type of that expression. 81 | 82 | \subsection*{[C-c C-n] normalize expression} 83 | 84 | If you type this keystroke, you will be prompted for an expression. If 85 | the expression you supply makes sense, you will be told its value. 86 | 87 | If you are working in a goal and have typed an expression already, Agda will 88 | assume that you want to normalize (i.e. compute as far as possible) 89 | that expression. The normal form might not be a value, because there 90 | might be some variables in your expression, getting in the way of 91 | computation. When there are no free variables present, the normal form 92 | is sure to be a value. 93 | 94 | \section{Moving around} 95 | 96 | \subsection*{[C-c C-f]/[C-c C-b] move to next/previous goal} 97 | 98 | A quick way to get to where the action is to use these two keystrokes, 99 | which takes you to the next and previous goal respectively. 100 | 101 | \subsection*{[M-.] go to definition} 102 | 103 | If you find yourself wondering what the definition of some identifier 104 | is, then you can put the cursor at it and use this keystroke -- it will 105 | make Agda take you there. 106 | -------------------------------------------------------------------------------- /Ex1.agda: -------------------------------------------------------------------------------- 1 | module Ex1 where 2 | 3 | open import Ex1Prelude 4 | 5 | {----------------------------------------------------------------------------} 6 | {- Name: -} 7 | {----------------------------------------------------------------------------} 8 | 9 | {----------------------------------------------------------------------------} 10 | {- DEADLINE: Week 3 Thursday 10 October 23:59 (submission method to follow) -} 11 | {----------------------------------------------------------------------------} 12 | 13 | {----------------------------------------------------------------------------- 14 | TOP TIP: if you have annoyingly many open goals, comment out big chunks of the 15 | file with a multi-line comment a bit like this one. 16 | -----------------------------------------------------------------------------} 17 | 18 | 19 | {----------------------------------------------------------------------------} 20 | {- 1.1: Tree Sort -} 21 | {----------------------------------------------------------------------------} 22 | 23 | -- 1.1.1 implement concatenation for lists 24 | 25 | _++_ : {X : Set} -> List X -> List X -> List X 26 | xs ++ ys = {!!} 27 | 28 | infixr 3 _++_ 29 | 30 | -- a datatype of node-labelled binary trees is given as follows 31 | 32 | data Tree (X : Set) : Set where 33 | leaf : Tree X 34 | _<[_]>_ : Tree X -> X -> Tree X -> Tree X 35 | 36 | -- 1.1.2 implement the insertion of a number into a tree, ensuring that 37 | -- the numbers in the tree are in increasing order from left to right; 38 | -- make sure to retain duplicates 39 | 40 | insertTree : Nat -> Tree Nat -> Tree Nat 41 | insertTree x t = {!!} 42 | 43 | -- 1.1.3 implement the function which takes the elements of a list and 44 | -- builds an ordered tree from them, using insertTree 45 | 46 | makeTree : List Nat -> Tree Nat 47 | makeTree xs = {!!} 48 | 49 | -- 1.1.4 implement the function which flattens a tree to a list, 50 | -- using concatenation 51 | 52 | flatten : {X : Set} -> Tree X -> List X 53 | flatten t = {!!} 54 | 55 | -- 1.1.5 using the above components, implement a sorting algorithm which 56 | -- works by building a tree and then flattening it 57 | 58 | treeSort : List Nat -> List Nat 59 | treeSort = {!!} 60 | 61 | -- 1.1.6 give a collection of unit tests which cover every program line 62 | -- from 1.1.1 to 1.1.5 63 | 64 | -- 1.1.7 implement a fast version of flatten, taking an accumulating parameter, 65 | -- never using ++. and ensuring that the law 66 | -- 67 | -- fastFlatten t xs == flatten t ++ xs 68 | -- 69 | -- is true; for an extra style point, ensure that the accumulating parameter 70 | -- is never given a name in your program 71 | 72 | fastFlatten : {X : Set} -> Tree X -> List X -> List X 73 | fastFlatten t = {!!} 74 | 75 | -- 1.1.8 use fastFlatten to build a fast version of tree sort 76 | 77 | fastTreeSort : List Nat -> List Nat 78 | fastTreeSort xs = {!!} 79 | 80 | -- 1.1.9 again, give unit tests which cover every line of code 81 | 82 | 83 | {----------------------------------------------------------------------------} 84 | {- 1.2: Shooting Propositional Logic Fish In A Barrel -} 85 | {----------------------------------------------------------------------------} 86 | 87 | -- 1.2.1 implement the following operations; try to use only 88 | -- [C-c C-c] and [C-c C-a] 89 | 90 | orCommute : {A B : Set} -> A /+/ B -> B /+/ A 91 | orCommute x = {!!} 92 | 93 | orAbsorbL : {A : Set} -> Zero /+/ A -> A 94 | orAbsorbL x = {!!} 95 | 96 | orAbsorbR : {A : Set} -> A /+/ Zero -> A 97 | orAbsorbR x = {!!} 98 | 99 | orAssocR : {A B C : Set} -> (A /+/ B) /+/ C -> A /+/ (B /+/ C) 100 | orAssocR x = {!!} 101 | 102 | orAssocL : {A B C : Set} -> A /+/ (B /+/ C) -> (A /+/ B) /+/ C 103 | orAssocL x = {!!} 104 | 105 | -- 1.2.2 implement the following operations; try to use only 106 | -- [C-c C-c] and [C-c C-a] 107 | 108 | andCommute : {A B : Set} -> A /*/ B -> B /*/ A 109 | andCommute x = {!!} 110 | 111 | andAbsorbL : {A : Set} -> A -> One /*/ A 112 | andAbsorbL x = {!!} 113 | 114 | andAbsorbR : {A : Set} -> A -> A /*/ One 115 | andAbsorbR x = {!!} 116 | 117 | andAssocR : {A B C : Set} -> (A /*/ B) /*/ C -> A /*/ (B /*/ C) 118 | andAssocR x = {!!} 119 | 120 | andAssocL : {A B C : Set} -> A /*/ (B /*/ C) -> (A /*/ B) /*/ C 121 | andAssocL x = {!!} 122 | 123 | -- how many times is [C-c C-c] really needed? 124 | 125 | -- 1.2.3 implement the following operations; try to use only 126 | -- [C-c C-c] and [C-c C-a] 127 | 128 | distribute : {A B C : Set} -> A /*/ (B /+/ C) -> (A /*/ B) /+/ (A /*/ C) 129 | distribute x = {!!} 130 | 131 | factor : {A B C : Set} -> (A /*/ B) /+/ (A /*/ C) -> A /*/ (B /+/ C) 132 | factor x = {!!} 133 | 134 | 135 | -- 1.2.4 try to implement the following operations; try to use only 136 | -- [C-c C-c] and [C-c C-a]; at least one of them will prove to be 137 | -- impossible, in which case you should comment it out and explain 138 | -- why it's impossible 139 | 140 | Not : Set -> Set 141 | Not X = X -> Zero 142 | 143 | deMorgan1 : {A B : Set} -> (Not A /+/ Not B) -> Not (A /*/ B) 144 | deMorgan1 x y = {!!} 145 | 146 | deMorgan2 : {A B : Set} -> Not (A /*/ B) -> (Not A /+/ Not B) 147 | deMorgan2 x = {!!} 148 | 149 | deMorgan3 : {A B : Set} -> (Not A /*/ Not B) -> Not (A /+/ B) 150 | deMorgan3 x y = {!!} 151 | 152 | deMorgan4 : {A B : Set} -> Not (A /+/ B) -> (Not A /*/ Not B) 153 | deMorgan4 x = {!!} 154 | 155 | 156 | -- 1.2.5 try to implement the following operations; try to use only 157 | -- [C-c C-c] and [C-c C-a]; at least one of them will prove to be 158 | -- impossible, in which case you should comment it out and explain 159 | -- why it's impossible 160 | 161 | dnegI : {X : Set} -> X -> Not (Not X) 162 | dnegI = {!!} 163 | 164 | dnegE : {X : Set} -> Not (Not X) -> X 165 | dnegE = {!!} 166 | 167 | neg321 : {X : Set} -> Not (Not (Not X)) -> Not X 168 | neg321 = {!!} 169 | 170 | hamlet : {B : Set} -> B /+/ Not B 171 | hamlet = {!!} 172 | 173 | nnHamlet : {B : Set} -> Not (Not (B /+/ Not B)) 174 | nnHamlet = {!!} -------------------------------------------------------------------------------- /Ex1Prelude.agda: -------------------------------------------------------------------------------- 1 | module Ex1Prelude where 2 | 3 | data Nat : Set where 4 | zero : Nat 5 | suc : Nat -> Nat 6 | 7 | {-# BUILTIN NATURAL Nat #-} 8 | {-# BUILTIN ZERO zero #-} 9 | {-# BUILTIN SUC suc #-} 10 | 11 | _+_ : Nat -> Nat -> Nat 12 | zero + n = n 13 | suc m + n = suc (m + n) 14 | 15 | infixr 5 _+_ 16 | 17 | data Zero : Set where 18 | 19 | magic : {X : Set} -> 20 | Zero -> X 21 | magic () 22 | 23 | record One : Set where 24 | constructor <> 25 | 26 | data Two : Set where 27 | tt ff : Two 28 | 29 | if_then_else_ : {X : Set} -> Two -> X -> X -> X 30 | if tt then t else f = t 31 | if ff then t else f = f 32 | 33 | _/\_ : Two -> Two -> Two 34 | b1 /\ b2 = if b1 then b2 else ff 35 | 36 | _<=_ : Nat -> Nat -> Two 37 | zero <= y = tt 38 | suc x <= zero = ff 39 | suc x <= suc y = x <= y 40 | 41 | data List (X : Set) : Set where 42 | [] : List X 43 | _:>_ : X -> List X -> List X 44 | 45 | infixr 5 _:>_ 46 | 47 | postulate 48 | Level : Set 49 | lzero : Level 50 | lsuc : Level -> Level 51 | lmax : Level -> Level -> Level 52 | 53 | {-# BUILTIN LEVEL Level #-} 54 | {-# BUILTIN LEVELZERO lzero #-} 55 | {-# BUILTIN LEVELSUC lsuc #-} 56 | {-# BUILTIN LEVELMAX lmax #-} 57 | 58 | data _==_ {l}{X : Set l}(x : X) : X -> Set l where 59 | refl : x == x 60 | infix 4 _==_ 61 | {-# BUILTIN EQUALITY _==_ #-} 62 | {-# BUILTIN REFL refl #-} 63 | 64 | infixr 1 _/+/_ 65 | 66 | data _/+/_ (S T : Set) : Set where 67 | inl : S -> S /+/ T 68 | inr : T -> S /+/ T 69 | 70 | __ : {S T X : Set} -> 71 | (S -> X) -> (T -> X) -> 72 | S /+/ T -> X 73 | (f g) (inl s) = f s 74 | (f g) (inr t) = g t 75 | 76 | infixr 2 _/*/_ 77 | 78 | record _/*/_ (S T : Set) : Set where 79 | constructor _,_ 80 | field 81 | outl : S 82 | outr : T 83 | open _/*/_ public 84 | infixr 4 _,_ 85 | 86 | curry : {S T X : Set} -> 87 | (S /*/ T -> X) -> 88 | S -> T -> X 89 | curry f s t = f (s , t) 90 | 91 | uncurry : {S T X : Set} -> 92 | (S -> T -> X) -> 93 | S /*/ T -> X 94 | uncurry f (s , t) = f s t 95 | 96 | id : {X : Set} -> X -> X 97 | id x = x 98 | 99 | _o_ : {A B C : Set} -> (B -> C) -> (A -> B) -> (A -> C) 100 | (f o g) a = f (g a) 101 | 102 | infixr 2 _o_ 103 | -------------------------------------------------------------------------------- /Ex2.lagda: -------------------------------------------------------------------------------- 1 | % This is a literate Agda file -- it's both source code and 2 | % documentation at the same time (you can generate a pdf from it using 3 | % latex). Agda only checks stuff inside code blocks: 4 | % 5 | % \begin{code} 6 | % ... 7 | % \end{code} 8 | % 9 | % Put your name in the \author field below for identification purposes! 10 | 11 | \documentclass{article} 12 | \usepackage[conor]{agda} 13 | 14 | \title{Exercise 2 for CS410: \\ Extending Hutton's razor with effects} 15 | \author{Put your name here} 16 | 17 | \begin{document} 18 | \maketitle 19 | 20 | We have seen how Hutton's razor can be extended with booleans and 21 | conditionals, next we shall investigate other extensions. In particular 22 | we shall focus on effectful computations, the main goal of this exercise 23 | is to notice a particular pattern that occurs every time we add an 24 | effect. 25 | 26 | \AgdaHide{ 27 | \begin{code} 28 | module Ex2 where 29 | 30 | open import BasicPrelude 31 | \end{code} 32 | } 33 | 34 | % ---------------------------------------------------------------------- 35 | \section{The ability to fail} 36 | 37 | \newcommand{\C}[1]{\AgdaInductiveConstructor{#1}} 38 | \newcommand{\D}[1]{\AgdaDatatype{#1}} 39 | 40 | This extension adds the ability to fail (an operation called 41 | \C{fail}) and a way to recover from it (an operation called 42 | \C{try\_default\_}). 43 | 44 | The intended meaning of \C{fail} is that it allows the program to bail 45 | out not giving a value (a natural number). We will model failure by 46 | using the \D{Maybe} type (previously called \D{Dodgy}). 47 | 48 | The intended meaning of \C{try\_default\_} is to try compute a value 49 | from its first argument, if it succeeds doing so return that value 50 | otherwise default to evaluating the second argument. 51 | 52 | See and try to understand the tests below, before starting to fill in 53 | the holes. 54 | 55 | \begin{code} 56 | -- We called this type Dodgy earlier. 57 | data Maybe (A : Set) : Set where 58 | just : A -> Maybe A 59 | nothing : Maybe A 60 | 61 | try : {A B : Set} -> Maybe A -> (A -> Maybe B) -> Maybe B 62 | try (just x) k = k x 63 | try nothing k = nothing 64 | \end{code} 65 | 66 | \begin{code} 67 | module Fail where 68 | 69 | data Expr : Set where 70 | val : Nat -> Expr 71 | plus : Expr -> Expr -> Expr 72 | fail : Expr 73 | try_default_ : Expr -> Expr -> Expr 74 | 75 | eval : Expr -> Maybe Nat 76 | eval (val x) = just x 77 | eval (plus e1 e2) = try (eval e1) \ v1 -> 78 | try (eval e2) \ v2 -> 79 | just (v1 + v2) 80 | eval fail = {!!} 81 | eval (try e1 default e2) = {!!} 82 | 83 | testExpr = plus (val 1) fail 84 | 85 | test : eval testExpr == nothing 86 | test = {!!} 87 | 88 | test2 : eval (plus (val 1) (try testExpr default val 2)) == just 3 89 | test2 = {!!} 90 | \end{code} 91 | 92 | % ---------------------------------------------------------------------- 93 | \section{The ability to throw an error} 94 | 95 | This is a slight variation of the above extension, where we can supply 96 | an error message in addition to bailing out (using the \C{throw} 97 | operation). 98 | 99 | Consequently error recovery becomes more interesting, as it can inspect 100 | the error message (\C{try\_catch\_}) operation). 101 | 102 | To model this kind of behaviour we will use the sum type (\D{Error}). 103 | 104 | Again, see and understand the tests before continuing. 105 | 106 | \begin{code} 107 | module Error where 108 | 109 | data ErrorMsg : Set where 110 | someLameError : ErrorMsg 111 | someOtherError : ErrorMsg 112 | 113 | data Expr : Set where 114 | val : Nat -> Expr 115 | plus : Expr -> Expr -> Expr 116 | throw : ErrorMsg -> Expr 117 | try_catch_ : Expr -> (ErrorMsg -> Expr) -> Expr 118 | 119 | Error : Set -> Set 120 | Error A = ErrorMsg /+/ A 121 | 122 | try' : {A B : Set} -> Error A -> (A -> Error B) -> Error B 123 | try' (inl err) k = {!!} 124 | try' (inr a) k = {!!} 125 | 126 | eval : Expr -> Error Nat 127 | eval (val x) = inr x 128 | eval (plus e1 e2) = try' (eval e1) \ v1 -> 129 | try' (eval e2) \ v2 -> 130 | inr (v1 + v2) 131 | eval (throw err) = {!!} 132 | eval (try e catch k) = {!!} 133 | 134 | test : eval (try throw someLameError catch 135 | (\ { someLameError -> val 1 136 | ; someOtherError -> val 2 137 | })) == inr 1 138 | test = {!!} 139 | 140 | test2 : eval (try throw someOtherError catch 141 | (\ { someLameError -> val 1 142 | ; someOtherError -> val 2 143 | })) == inr 2 144 | test2 = {!!} 145 | 146 | open Error using (Error) 147 | \end{code} 148 | 149 | % ---------------------------------------------------------------------- 150 | \section{The ability to store computations} 151 | 152 | \newcommand{\F}[1]{\AgdaFunction{#1}} 153 | 154 | This extension adds the ability to \C{store} and \C{load} the value of 155 | an expression (not unlike the memory function on a calculator). 156 | 157 | The intended meaning of \C{store} is to evaluate its argument, \F{put} 158 | its value in the ``memory'' and then return it. \C{load} is supposed to 159 | get the value from the memory. 160 | 161 | We model this ``memory'' as a function from its current state to a value 162 | and its new state (see \F{State}). 163 | 164 | Again, see and understand the tests! 165 | 166 | \begin{code} 167 | module State where 168 | 169 | data Expr : Set where 170 | val : Nat -> Expr 171 | plus : Expr -> Expr -> Expr 172 | load : Expr 173 | store : Expr -> Expr 174 | 175 | State : Set -> Set -> Set 176 | State S A = S -> A /*/ S 177 | 178 | done : {A S : Set} -> A -> State S A 179 | done x = {!!} 180 | 181 | get : {S : Set} -> State S S 182 | get = \ s -> s , s 183 | 184 | put : {S : Set} -> S -> State S One 185 | put s = \ _ -> <> , s 186 | 187 | _bind_ : {S A B : Set} -> State S A -> (A -> State S B) -> State S B 188 | m bind k = {!!} 189 | 190 | eval : Expr -> State Nat Nat 191 | eval (val n) = done n 192 | eval (plus e1 e2) = eval e1 bind \ v1 -> 193 | eval e2 bind \ v2 -> 194 | done (v1 + v2) 195 | eval load = {!!} 196 | eval (store e) = {!!} 197 | 198 | test : eval (store (val 2)) 0 == 2 , 2 199 | test = {!!} 200 | 201 | test2 : eval (plus (store (val 2)) load) 0 == 4 , 2 202 | test2 = {!!} 203 | 204 | test3 : eval (plus load (store (val 2))) 0 == 2 , 2 205 | test3 = {!!} 206 | 207 | test4 : eval (plus load load) 3 == 6 , 3 208 | test4 = {!!} 209 | 210 | open State using (State) 211 | \end{code} 212 | 213 | % ---------------------------------------------------------------------- 214 | \section{The ability to read from an environment} 215 | 216 | Next we shall extend our language with \C{var}iables. The intended 217 | meaning of variables is to return the value that they have been assigned 218 | in some environment (see \F{Env}). We use \F{ask} to retrieve the 219 | environment. 220 | 221 | An expression is parametrised by a set which says how many variables it 222 | has, in the tests we use expressions with two variables. The environment 223 | is modelled as a function which assigns a value to each variable. 224 | 225 | To model this we will use a variant of the ``memory''-cell above which 226 | is read-only (see \F{Reader}). 227 | 228 | \begin{code} 229 | module Reader where 230 | 231 | data Expr (V : Set) : Set where 232 | val : Nat -> Expr V 233 | plus : Expr V -> Expr V -> Expr V 234 | var : V -> Expr V 235 | 236 | -- Show how to substitue variables. 237 | subst : {V W : Set} -> Expr V -> (V -> Expr W) -> Expr W 238 | subst (val n) r = {!!} 239 | subst (plus e1 e2) r = {!!} 240 | subst (var x) r = {!!} 241 | 242 | Reader : Set -> Set -> Set 243 | Reader R A = R -> A 244 | 245 | end : {A R : Set} -> A -> Reader R A 246 | end x = {!!} 247 | 248 | ask : {R : Set} -> Reader R R 249 | ask = \ r -> r 250 | 251 | _andThen_ : {R A B : Set} -> 252 | Reader R A -> (A -> Reader R B) -> Reader R B 253 | m andThen k = {!!} 254 | 255 | Env : Set -> Set 256 | Env V = V -> Nat 257 | 258 | eval : {V : Set} -> Expr V -> Reader (Env V) Nat 259 | eval (val n) = end n 260 | eval (plus e1 e2) = eval e1 andThen \ v1 -> 261 | eval e2 andThen \ v2 -> 262 | end (v1 + v2) 263 | eval (var x) = {!!} 264 | 265 | test : eval (var tt) (\b -> if b then 1 else 2) == 1 266 | test = {!!} 267 | 268 | test2 : eval (var ff) (\b -> if b then 1 else 2) == 2 269 | test2 = {!!} 270 | 271 | test3 : eval (var <>) (\ _ -> 0) == 0 272 | test3 = {!!} 273 | 274 | test4 : eval {One} (subst (var <>) (\ _ -> val 3)) (\ _ -> 0) == 3 275 | test4 = {!!} 276 | 277 | open Reader using (Reader) 278 | \end{code} 279 | 280 | % ---------------------------------------------------------------------- 281 | \section{The ability to do input and output} 282 | 283 | This time we want to extend our language with the ability to \C{input} 284 | and \C{output} values of expressions, we also want to be able to 285 | sequence computations (the \C{>>} operator, pronounced ``then''). 286 | 287 | The intended meaning is hopefully obvious. The way we model this 288 | extensions is as a function from the input to a dodgy value and some 289 | output. The reason for using a dodgy value is because it could be the 290 | case that the program asks for input but the user doesn't provide any, 291 | in which case we fail to provide a value (see \F{IO}). 292 | 293 | Unlike previously, we do not evaluate straight from expressions into the 294 | model, but instead we \F{build} up a strategy tree (see \D{IOTree}) 295 | \emph{representing} the computation and then \F{runIO} it to get the 296 | intended meaning. 297 | 298 | Going via a strategy tree is sometimes called doing a ``deep''-embedding 299 | (as opposed to ``shallow''-embedding, which is what we been doing 300 | earlier.) We shall discuss the advantages and disadvantages of both 301 | approaches in class and touch on it in the exercises as well. 302 | 303 | \begin{code} 304 | module IO where 305 | 306 | infixl 1 _>>_ 307 | 308 | data Expr : Set where 309 | val : Nat -> Expr 310 | plus : Expr -> Expr -> Expr 311 | input : Expr 312 | output : Expr -> Expr 313 | _>>_ : Expr -> Expr -> Expr 314 | 315 | data IOTree (A : Set) : Set where 316 | pure : A -> IOTree A 317 | input : One -> (Nat -> IOTree A) -> IOTree A 318 | output : Nat -> (One -> IOTree A) -> IOTree A 319 | 320 | _graft_ : {A B : Set} -> IOTree A -> (A -> IOTree B) -> IOTree B 321 | pure x graft k = {!!} 322 | input _ c graft k = {!!} 323 | output n c graft k = {!!} 324 | 325 | build : Expr -> IOTree Nat 326 | build (val n) = pure n 327 | build (plus e1 e2) = build e1 graft \ v1 -> 328 | build e2 graft \ v2 -> 329 | pure (v1 + v2) 330 | build input = {!!} 331 | build (output e) = {!!} 332 | build (e1 >> e2) = {!!} 333 | 334 | Input = List Nat 335 | Output = List Nat 336 | 337 | IO : Set -> Set 338 | IO A = Input -> Maybe A /*/ Output 339 | 340 | runIO : {A : Set} -> IOTree A -> IO A 341 | runIO (pure x) is = {!!} 342 | runIO (input _ k) [] = {!!} 343 | runIO (input _ k) (i :> is) = {!!} 344 | runIO (output n k) is = {!!} 345 | 346 | eval : Expr -> IO Nat 347 | eval e = runIO (build e) 348 | 349 | test : eval (plus input input) (2 :> 3 :> []) == just 5 , [] 350 | test = {!!} 351 | 352 | test2 : eval (output (plus input input) >> val 1) (2 :> 3 :> []) == 353 | just 1 , 5 :> [] 354 | test2 = {!!} 355 | 356 | test3 : eval (output (output (output (val 5)))) [] == 357 | just 5 , 5 :> 5 :> 5 :> [] 358 | test3 = {!!} 359 | 360 | test4 : eval (output (val 1) >> output (val 2) >> input >> input) 361 | (0 :> 3 :> []) == just 3 , 1 :> 2 :> [] 362 | test4 = {!!} 363 | 364 | open IO using (IOTree) 365 | \end{code} 366 | 367 | % ---------------------------------------------------------------------- 368 | \section{The ability to log computations} 369 | 370 | In the final extension we want to add the ability to log the value of 371 | expressions using the \C{log\_>>\_} operator. 372 | 373 | The intended meaning of this operator is to evaluate the first argument, 374 | log its value and then return the value of its second argument. 375 | 376 | Because this is the last extension we shall expect you to figure out how 377 | to model this extension yourself (see \F{Writer}). \F{tell} should put 378 | its argument in the log, and should come handy when giving the 379 | \C{log\_>>\_} operator meaning. 380 | 381 | \begin{code} 382 | module Writer where 383 | 384 | data Expr : Set where 385 | val : Nat -> Expr 386 | plus : Expr -> Expr -> Expr 387 | log_>>_ : Expr -> Expr -> Expr 388 | 389 | Writer : Set -> Set -> Set 390 | Writer W A = {!!} 391 | 392 | finish : {A W : Set} -> A -> Writer W A 393 | finish x = {!!} 394 | 395 | tell : {W : Set} -> List W -> Writer W One 396 | tell ws = {!!} 397 | 398 | _combine_ : {W A B : Set} -> 399 | Writer W A -> (A -> Writer W B) -> Writer W B 400 | m combine k = {!!} 401 | 402 | eval : Expr -> Writer Nat Nat 403 | eval (val n) = finish n 404 | eval (plus e1 e2) = eval e1 combine \ v1 -> 405 | eval e2 combine \ v2 -> 406 | finish (v1 + v2) 407 | eval (log e1 >> e2) = {!!} 408 | 409 | -- This should return 0 and the log should contain 1 and 2, finish the 410 | -- test once you implemented eval. 411 | test : eval (log val 1 >> log val 2 >> val 0) == {!!} 412 | test = {!!} 413 | 414 | -- This should return 5 and the log should contain 2 and 3. 415 | test2 : eval (plus (log val 2 >> val 2) (log val 3 >> val 3)) == {!!} 416 | test2 = {!!} 417 | 418 | open Writer using (Writer) 419 | \end{code} 420 | 421 | % ---------------------------------------------------------------------- 422 | \section{Exercises} 423 | 424 | Hopefully you have by now got some idea of how to model different 425 | effects in object languages (extensions of Hutton's razor) using 426 | constructs from the meta-language (Agda). 427 | 428 | This process is called giving a denotational semantics, and it was 429 | developed in the late 60s by Christopher Strachey and Dana Scott. 430 | 431 | 432 | \paragraph{Exercise 1 (Moggi's insight)} 433 | 434 | In the early 90s Eugenio Moggi, while working on giving denotational 435 | semantics for effectful languages (just like we just have), noticed that 436 | so called \emph{monads}\footnote{A construction from an abstract field 437 | of mathematics called category theory.} could be used in every effectful 438 | extension he cared about. 439 | 440 | This is what a monad looks like: 441 | 442 | \begin{code} 443 | record Monad (M : Set -> Set) : Set1 where 444 | field 445 | return : {A : Set} -> A -> M A 446 | _>>=_ : {A B : Set} -> M A -> (A -> M B) -> M B 447 | \end{code} 448 | % 449 | And here is an instance of a monad: 450 | 451 | \begin{code} 452 | FailMonad : Monad Maybe 453 | FailMonad = record { return = just; _>>=_ = try } 454 | where 455 | open Fail 456 | \end{code} 457 | 458 | \begin{enumerate} 459 | 460 | \item[(a)] Your task is to identify the rest of the monads. 461 | 462 | \end{enumerate} 463 | 464 | \begin{code} 465 | ErrorMonad : Monad {!!} 466 | ErrorMonad = record { return = {!!}; _>>=_ = {!!} } 467 | where 468 | open Error 469 | 470 | StateMonad : {S : Set} -> Monad {!!} 471 | StateMonad = record { return = {!!}; _>>=_ = {!!} } 472 | where 473 | open State 474 | 475 | ReaderMonad : {R : Set} -> Monad {!!} 476 | ReaderMonad = record { return = {!!}; _>>=_ = {!!} } 477 | where 478 | open Reader 479 | 480 | ExprMonad : Monad Reader.Expr 481 | ExprMonad = record { return = {!!}; _>>=_ = {!!} } 482 | where 483 | open Reader 484 | 485 | IOTreeMonad : Monad {!!} 486 | IOTreeMonad = record { return = pure; _>>=_ = _graft_ } 487 | where 488 | open IO 489 | 490 | WriterMonad : {W : Set} -> Monad {!!} 491 | WriterMonad = record { return = {!!}; _>>=_ = {!!} } 492 | where 493 | open Writer 494 | \end{code} 495 | 496 | \paragraph{Exercise 2 (The virtue of continuations)} 497 | 498 | \begin{enumerate} 499 | 500 | \item[(a)] Rewrite the $\AgdaModule{State}$ module ``deep''-style. 501 | 502 | \end{enumerate} 503 | 504 | \begin{code} 505 | module DeepState where 506 | 507 | data Expr : Set where 508 | val : Nat -> Expr 509 | plus : Expr -> Expr -> Expr 510 | load : Expr 511 | store : Expr -> Expr 512 | 513 | data Store (A : Set) : Set where 514 | return : A -> Store A 515 | load : One -> (Nat -> Store A) -> Store A 516 | store : Nat -> (One -> Store A) -> Store A 517 | 518 | _graft_ : {A B : Set} -> 519 | Store A -> (A -> Store B) -> Store B 520 | return x graft k = {!!} 521 | load _ c graft k = load _ (\ n -> c n graft k) 522 | store n c graft k = {!!} 523 | 524 | build : Expr -> Store Nat 525 | build (val n) = {!!} 526 | build (plus e1 e2) = {!!} 527 | build load = {!!} 528 | build (store e) = {!!} 529 | 530 | runState : {A : Set} -> Store A -> State Nat A 531 | runState (return x) = {!!} 532 | runState (load _ k) = {!!} 533 | runState (store n k) = {!!} 534 | 535 | eval : Expr -> State Nat Nat 536 | eval e = runState (build e) 537 | 538 | test : eval (store (val 2)) 0 == 2 , 2 539 | test = {!!} 540 | 541 | test2 : eval (plus (store (val 2)) load) 0 == 4 , 2 542 | test2 = {!!} 543 | 544 | test3 : eval (plus load (store (val 2))) 0 == 2 , 2 545 | test3 = {!!} 546 | 547 | test4 : eval (plus load load) 3 == 6 , 3 548 | test4 = {!!} 549 | \end{code} 550 | 551 | \begin{enumerate} 552 | 553 | \item[(b)] Can you think of any reason why one would want to do it 554 | ``deep''-style rather than ``shallow''-style? 555 | 556 | \item[(c)] This exercise is not part of the homework, we will do it in 557 | class: Try rewriting the $\AgdaModule{IO}$ module ``shallow''-style. 558 | 559 | \item[(d)] This exercise is not part of the homework, we will do it in 560 | class: Can you figure out why it turns out to be trickier doing it 561 | that way? 562 | 563 | \end{enumerate} 564 | 565 | \paragraph{Exercise 3 (Wadler's insight)} 566 | 567 | A couple of years after Moggi's insight, Philip Wadler realised that the 568 | monads we use as denotations for different effectful extensions are also 569 | interesting from a programming point of view in the meta-language. 570 | 571 | For example here is a program that uses the \F{State} monad. 572 | 573 | \begin{code} 574 | prog : State Nat Two 575 | prog = get >>= \ n -> 576 | put (suc n) >>= \ _ -> 577 | return tt 578 | where 579 | open State 580 | open Monad StateMonad 581 | 582 | test : prog 0 == tt , 1 583 | test = {!!} 584 | \end{code} 585 | 586 | \begin{enumerate} 587 | 588 | \item[(a)] Write a stateful program which doubles the state and 589 | returns whether or not the result is less than 7. Write appropriate 590 | tests. 591 | 592 | \end{enumerate} 593 | 594 | \begin{code} 595 | double>7 : State Nat Two 596 | double>7 = {!!} 597 | where 598 | open State 599 | open Monad StateMonad 600 | \end{code} 601 | 602 | \begin{enumerate} 603 | 604 | \item[(b)] Write a program that uses \F{Writer} to reverse a list, 605 | together with appropriate tests. 606 | 607 | \end{enumerate} 608 | 609 | \begin{code} 610 | logRev : List Nat -> Writer Nat One 611 | logRev [] = {!!} 612 | where 613 | open Writer 614 | open Monad WriterMonad 615 | logRev (x :> xs) = {!!} 616 | where 617 | open Writer 618 | open Monad WriterMonad 619 | \end{code} 620 | 621 | \end{document} -------------------------------------------------------------------------------- /Ex3.agda: -------------------------------------------------------------------------------- 1 | module Ex3 where 2 | 3 | {- Identify yourself 4 | 5 | Name: 6 | 7 | -} 8 | 9 | {- This exercise is about ordered data structures, involving two variations 10 | on the search trees. -} 11 | 12 | open import BasicPrelude 13 | 14 | {- To keep the development clean, I suggest that we use the module system. 15 | Agda modules can have parameters, so we can parametrize the whole development 16 | by... -} 17 | 18 | module OTreeSort 19 | {X : Set} -- a set of elements 20 | {Le : X -> X -> Set} -- an order relation on them 21 | (owoto : (x y : X) -> Le x y /+/ Le y x) -- a function which orders 22 | where 23 | 24 | {- Part A: Tree Sort -} 25 | 26 | {- So that we can represent bounds cleanly, let's extend X with a bottom element 27 | and a top element. Everything should be between bottom and top. -} 28 | 29 | data BT : Set where 30 | bot : BT 31 | # : X -> BT 32 | top : BT 33 | 34 | {- Define the ordering relation on BT. -} 35 | 36 | BTLE : BT -> BT -> Set 37 | BTLE a b = {!!} 38 | 39 | {- Let's define binary search trees with elements between bounds. -} 40 | 41 | data OTree (l u : BT) : Set where 42 | leaf : {{_ : BTLE l u}} -> OTree l u 43 | node : (x : X) -> OTree l (# x) -> OTree (# x) u -> OTree l u 44 | 45 | {- The "leaf" constructor takes as an implicit argument the proof that the 46 | lower bound is below the upper bound. The doubled braces tell Agda to 47 | infer its value by searching the context for something of the right type. 48 | We should it ensure that there's something to find! 49 | The "node" constructor just uses the node value to bound the subtrees. 50 | If you think about binary trees, you'll notice that there is a leaf 51 | left of the leftmost node, between each node, and right of the rightmost 52 | node, so that we have a sequence of less-or-equal evidence from the 53 | lower bound, through each element, to the upper bound. -} 54 | 55 | {- Now let's define what it means to be an element of a bounded interval. -} 56 | 57 | record Interval (l u : BT) : Set where 58 | constructor [_] 59 | field 60 | val : X 61 | {{below}} : BTLE l (# val) -- again, the doubled braces mean these 62 | {{above}} : BTLE (# val) u -- fields are to be found in the context 63 | 64 | {- Now your turn. Define the function which takes an interval and a tree 65 | with common bounds, then delivers the result of inserting the element 66 | from the interval into the tree. -} 67 | 68 | insertOTree : {l u : BT} -> Interval l u -> OTree l u -> OTree l u 69 | insertOTree ilu tlu = {!!} 70 | 71 | {- Show how to build a tree from the elements of a list. -} 72 | 73 | makeOTree : List X -> OTree bot top 74 | makeOTree xs = {!!} 75 | 76 | {- Now that we have trees, let's flatten them to ordered lists. Unlike 77 | in lectures, but as for trees and intervals, let's have both lower and 78 | upper bounds. I've left out the ordering evidence. You put it in, 79 | using doubled braces. Ensure that, as with trees, there is always a 80 | sequence of less-or-equal evidence from the lower bound, through each 81 | element, to the upper bound. -} 82 | 83 | data OList (l u : BT) : Set where 84 | [] : OList l u -- what evidence is needed? 85 | _:>_ : (x : X)(xs : OList (# x) u) -> -- what evidence is needed? 86 | OList l u 87 | 88 | {- Now implement the flattening function. You may have to think about what 89 | other functions you need in order to do so. In particular, you may find 90 | that concatenation for "OList" is tricky to define, but you may also find 91 | that concatenation isn't exactly what you need to define. -} 92 | 93 | 94 | flattenOTree : {l u : BT} -> OTree l u -> OList l u 95 | flattenOTree t = {!!} 96 | 97 | treeSort : List X -> OList bot top 98 | treeSort = flattenOTree o makeOTree 99 | 100 | {- See the bottom of the file for testing kit. -} 101 | 102 | {- Part B 2-3-Tree Sort -} 103 | 104 | {- A 2-3-Tree is a variant on a binary tree with two important differences. 105 | (1) it's *balanced*, so that the root is the same distance above all the 106 | trees; we call that distance the "height", and we index the type 107 | by height in order to ensure balancing 108 | (2) as well as the usual 2-nodes, with one value in the node and 2 subtrees, 109 | we have 3-nodes, with two values in the node and 3 subtrees, where 110 | the middle subtree's elements should be *between* the two node values 111 | 112 | As before, I've left it to you to put the ordering evidence somewhere sensible. 113 | -} 114 | 115 | data T23 (l u : BT) : Nat -> Set where -- this needs ordering evidence 116 | leaf : T23 l u zero 117 | node2 : {n : Nat}(x : X) -> T23 l (# x) n -> T23 (# x) u n -> 118 | T23 l u (suc n) 119 | node3 : {n : Nat}(x y : X) -> 120 | T23 l (# x) n -> T23 (# x) (# y) n -> T23 (# y) u n -> 121 | T23 l u (suc n) 122 | 123 | {- When you insert into a 2-3-Tree, if you're lucky the height will stay the 124 | same. But you will not always be lucky. Sometimes the new element will make 125 | the tree just too big, and you will have the stuff to make a 2-node that is 126 | one level higher than the tree you started with. The following type 127 | expresses these possibilities. -} 128 | 129 | data Insertion23 (l u : BT)(n : Nat) : Set where 130 | itFits : T23 l u n -> Insertion23 l u n 131 | tooTall : (x : X) -> T23 l (# x) n -> T23 (# x) u n -> 132 | Insertion23 l u n 133 | 134 | {- Implement insertion. You will need to use "with" for each recursive 135 | call, then inspect what happened and decide what to do. If the insertion 136 | fitted ok, you can just plug the new subtree back where it came from. 137 | If the result was "tooTall", you may be able to make something which 138 | fits by *rebalancing* the tree, which is the point of the thing. By keeping 139 | the tree balanced, we ensure a logarithmic access time for every element. -} 140 | 141 | insert23 : {l u : BT}{n : Nat} -> Interval l u -> T23 l u n -> Insertion23 l u n 142 | insert23 ilu tlu = {!!} 143 | 144 | {- The following is a wrapper type for any old 2-3-Tree, of any height, with 145 | bot and top as bounds. It's as much as we can pin down about a tree that 146 | we build from the elements of an arbitrary list. -} 147 | 148 | record SomeT23 : Set where 149 | constructor [_] 150 | field 151 | {height} : Nat 152 | tree : T23 bot top height 153 | open SomeT23 154 | 155 | insertSomeT23 : X -> SomeT23 -> SomeT23 156 | insertSomeT23 x s = {!!} 157 | 158 | makeSomeT23 : List X -> SomeT23 159 | makeSomeT23 xs = {!!} 160 | 161 | flattenT23 : {l u : BT}{n : Nat} -> 162 | T23 l u n -> 163 | OList l u 164 | flattenT23 t = {!!} 165 | 166 | {- NOTE: while an implementation of "flatten23" which uses some variation on 167 | concatenation will be adequate, a small bonus will be available for a 168 | solution which introduces an accumulating parameter and runs in linear 169 | time. The same technique as in Ex1 can be made to work, but it takes a 170 | little thought to manage the ordering properly. -} 171 | 172 | sort23 : List X -> OList bot top 173 | sort23 xs = flattenT23 (tree (makeSomeT23 xs)) 174 | 175 | {- Here endeth the parametrized module -} 176 | 177 | {- Now we can build one instance for the parameters -} 178 | 179 | Le : Nat -> Nat -> Set 180 | Le zero y = One 181 | Le (suc x) zero = Zero 182 | Le (suc x) (suc y) = Le x y 183 | 184 | owoto : (x y : Nat) -> Le x y /+/ Le y x 185 | owoto zero zero = inl <> 186 | owoto zero (suc y) = inl <> 187 | owoto (suc x) zero = inr <> 188 | owoto (suc x) (suc y) = owoto x y 189 | 190 | open OTreeSort owoto -- this gives us the Nat instance of all your sorting stuff 191 | 192 | 193 | {- Here are some tests for your code! -} 194 | 195 | myList : List Nat 196 | myList = 20 :> 1 :> 18 :> 4 :> 13 :> 6 :> 10 :> 15 :> 2 :> 17 :> 197 | 3 :> 19 :> 7 :> 16 :> 8 :> 11 :> 14 :> 9 :> 12 :> 5 :> [] 198 | 199 | try : OList bot top 200 | try = 1 :> 3 :> 2 :> [] 201 | 202 | 203 | myList' : OList bot top 204 | myList' = 1 :> 2 :> 3 :> 4 :> 5 :> 6 :> 7 :> 8 :> 9 :> 10 :> 205 | 11 :> 12 :> 13 :> 14 :> 15 :> 16 :> 17 :> 18 :> 19 :> 20 :> [] 206 | 207 | myTest1 : treeSort myList == myList' 208 | myTest1 = refl 209 | 210 | myTest2 : sort23 myList == myList' 211 | myTest2 = refl 212 | -------------------------------------------------------------------------------- /Ex4.agda: -------------------------------------------------------------------------------- 1 | module Ex4 where 2 | 3 | open import BasicPrelude 4 | open import FunctorKit 5 | 6 | {- IDENTIFY YOURSELF 7 | Name: 8 | -} 9 | 10 | {- This exercise is about structure editing. The key concept is that 11 | of a *focused* functor. -} 12 | 13 | focus : Kit -> Kit 14 | focus f = delOne f *K idK 15 | 16 | {- delOne f means "an f with a hole instead of one element"; focus f 17 | means "an f with a hole, together with the element in the hole it 18 | amounts to "an f with a cursor position" -} 19 | 20 | {- Meanwhile, a "zipper" is a cursor in a DATA type, consisting of the 21 | active subtree, together with its context, being the list of layers 22 | from the active position (the "hole") to the root of the data. Each 23 | layer's structure is computed with delOne. -} 24 | 25 | Zipper : Kit -> Set 26 | Zipper f = DATA f /*/ List (Fun (delOne f) (DATA f)) 27 | 28 | {- The plan is to build tools for acting on a focus f, then use them 29 | to act on a Zipper f -} 30 | 31 | 32 | {- 1 Implement the (not very complicated at all) function which gets 33 | the element in focus from a focus. -} 34 | 35 | here : {X : Set}(f : Kit) -> Fun (focus f) X -> X 36 | here f xfx = {!!} 37 | 38 | 39 | {- 2 Implement the function which rebuilds an f from a (focus f) by 40 | plugging the element back in its hole. -} 41 | 42 | up : {X : Set}(f : Kit) -> Fun (focus f) X -> Fun f X 43 | up f xfx = {!!} 44 | 45 | {- 3 Use "up" to implement the function that navigates in a Zipper f 46 | all the way to the root, giving back a whole DATA f -} 47 | 48 | toRoot : {f : Kit} -> Zipper f -> DATA f 49 | toRoot {f} zf = {!!} 50 | 51 | 52 | {- Wandering about in a Zipper can sometimes go wrong if you try to 53 | step in a direction where there's nowhere to go. So let's have 54 | Maybe, and its kit for failure management. -} 55 | 56 | Maybe : Set -> Set 57 | Maybe X = One /+/ X 58 | 59 | fail : {X : Set} -> Maybe X 60 | fail = inl <> 61 | 62 | _/_ : {X : Set} -> Maybe X -> Maybe X -> Maybe X 63 | inl <> / y = y 64 | x / y = x 65 | 66 | ret : {X : Set} -> X -> Maybe X 67 | ret = inr 68 | 69 | bind : {X Y : Set} -> Maybe X -> (X -> Maybe Y) -> Maybe Y 70 | bind (inl <>) k = fail 71 | bind (inr x) k = k x 72 | 73 | {- The following is quite useful for acting on the context of a focus, 74 | keeping the element as it is. -} 75 | 76 | ap1 : {A B C : Set} -> (A -> B) -> A /*/ C -> B /*/ C 77 | ap1 f (a , c) = f a , c 78 | 79 | 80 | {- 3 Implement the function which tries to go out *one* layer and 81 | fails if it is at the root already. -} 82 | 83 | zipUp : {f : Kit} -> Zipper f -> Maybe (Zipper f) 84 | zipUp {f} zf = {!!} 85 | 86 | 87 | {- 4 Implement the function which takes an unfocused f and tries to focus it 88 | on the leftmost element position. This should fail if there are no element 89 | positions. -} 90 | 91 | leftmost : {X : Set}(f : Kit) -> Fun f X -> Maybe (Fun (focus f) X) 92 | leftmost f xf = {!!} 93 | 94 | 95 | {- 5 Implement the function which takes a focused f and tries to move the focus 96 | one position further right. This should fail if there are no element 97 | positions to the right of the current one. -} 98 | 99 | stepRight : {X : Set}(f : Kit) -> Fun (focus f) X -> Maybe (Fun (focus f) X) 100 | stepRight f xfx = {!!} 101 | 102 | 103 | {- 6 Use your solutions to parts 4 and 5 to implement zipper navigation operations 104 | zipDownLeft, to visit the leftmost subtree, and zipRight, to visit the subtree to 105 | the right of the current position at the same level. -} 106 | 107 | zipDownLeft zipRight : {f : Kit} -> Zipper f -> Maybe (Zipper f) 108 | 109 | zipDownLeft {f} z = {!!} 110 | 111 | zipRight {f} z = {!!} 112 | 113 | 114 | {- 7 Implement the mirror image of parts 4..6. -} 115 | 116 | rightmost : {X : Set}(f : Kit) -> Fun f X -> Maybe (Fun (focus f) X) 117 | rightmost f xf = {!!} 118 | 119 | stepLeft : {X : Set}(f : Kit) -> Fun (focus f) X -> Maybe (Fun (focus f) X) 120 | stepLeft f xfx = {!!} 121 | 122 | zipDownRight zipLeft : {f : Kit} -> Zipper f -> Maybe (Zipper f) 123 | 124 | zipDownRight {f} z = {!!} 125 | 126 | zipLeft {f} z = {!!} 127 | 128 | 129 | {- Here's a toy to help you experiment. -} 130 | 131 | Returns : {X : Set} -> Maybe X -> Set 132 | Returns (inl <>) = Zero 133 | Returns (inr x) = One 134 | 135 | returned : {X : Set}(mx : Maybe X){_ : Returns mx} -> X 136 | returned (inl <>) {()} 137 | returned (inr x) = x 138 | 139 | data Journey {f : Kit}(z : Zipper f) : Set where 140 | stop : Journey z 141 | _>=>_ : (move : Zipper f -> Maybe (Zipper f)) -> 142 | {r : Returns (move z)} -> 143 | Journey (returned (move z) {r}) -> Journey z 144 | infixr 3 _>=>_ 145 | 146 | {- 8 Construct a journey in the following tree structure which 147 | (a) uses all of your navigation operations 148 | (b) visits all of the numbered nodes 149 | (c) visits at least one leaf 150 | (d) finishes back at the root. -} 151 | 152 | myJourney : Journey {treeK natK} 153 | (node' (node' (node' leaf' (toNatK 0) leaf') 154 | (toNatK 1) 155 | (node' leaf' (toNatK 2) leaf')) 156 | (toNatK 3) 157 | (node' ((node' leaf' (toNatK 4) leaf')) 158 | (toNatK 5) 159 | ((node' leaf' (toNatK 6) leaf'))) , 160 | []) 161 | myJourney = {!!} 162 | 163 | 164 | {- 9 Implement the operation which collects *all* the ways to go 165 | "down" by decorating each element with its context, thus putting 166 | each into focus. You will need to use the map operator with 167 | FunFunctor (see FunctorKit.agda) in various places. -} 168 | 169 | down : {X : Set}(f : Kit) -> Fun f X -> Fun f (Fun (focus f) X) 170 | down f xf = {!!} 171 | 172 | 173 | {- 10 Implement the operation which takes *focused* data and decorates 174 | each element with *its own* focus, thus showing you every focus you 175 | can move to (with "staying put" being the focus in focus). I've 176 | done "staying put". Your job is to explain which "moves" are 177 | possible. -} 178 | 179 | around : {X : Set}(f : Kit) -> Fun (focus f) X -> Fun (focus f) (Fun (focus f) X) 180 | 181 | moves : {X : Set}(f : Kit) -> Fun (focus f) X -> Fun (delOne f) (Fun (focus f) X) 182 | moves f xfx = {!!} 183 | 184 | around f xfx = moves f xfx , xfx 185 | -------------------------------------------------------------------------------- /Ex5/ANSIEscapes.hs: -------------------------------------------------------------------------------- 1 | module ANSIEscapes 2 | (upLine, 3 | downLine, 4 | up, 5 | down, 6 | forward, 7 | backward, 8 | killLine, 9 | restoreCursor, 10 | saveCursor, 11 | clearScreen, 12 | yellow, 13 | brown, 14 | red, 15 | blue, 16 | purple, 17 | green, 18 | orange, 19 | white, 20 | yellowOnGrey, 21 | brownOnGrey, 22 | redOnGrey, 23 | blueOnGrey, 24 | purpleOnGrey, 25 | greenOnGrey, 26 | whiteOnGrey, 27 | onBlack, 28 | onGrey, 29 | onGreyEsc, 30 | onWhiteEsc, 31 | resetCursor, 32 | initTermSize) where 33 | 34 | data Dir = UpDir | DownDir | RightDir | LeftDir 35 | 36 | instance Show Dir where 37 | show UpDir = "A" 38 | show DownDir = "B" 39 | show RightDir = "C" 40 | show LeftDir = "D" 41 | 42 | upLine = putStr "\ESC[1A" 43 | downLine = putStr "\ESC[1B" 44 | 45 | up = moveCursor UpDir 46 | down = moveCursor DownDir 47 | backward = moveCursor LeftDir 48 | forward = moveCursor RightDir 49 | 50 | moveCursor :: Dir -> Int -> IO () 51 | moveCursor dir 0 = return () 52 | moveCursor dir n = putStr $ "\ESC[" ++ show n ++ show dir 53 | 54 | killLine = escape "K" 55 | restoreCursor = escape "u" 56 | saveCursor = escape "s" 57 | clearScreen = escape "2J" 58 | initTermSize = (escape "[=3h") 59 | 60 | resetCursor = escape "0;0H" 61 | 62 | escape e = putStr $ "\ESC[" ++ e 63 | 64 | yellow str = "\ESC[1;33m" ++ str ++ "\ESC[0m" 65 | brown str = "\ESC[0;33m" ++ str ++ "\ESC[0m" 66 | blue str = "\ESC[1;34m" ++ str ++ "\ESC[0m" 67 | red str = "\ESC[1;31m" ++ str ++ "\ESC[0m" 68 | green str = "\ESC[1;32m" ++ str ++ "\ESC[0m" 69 | purple str = "\ESC[1;35m" ++ str ++ "\ESC[0m" 70 | white str = "\ESC[37m" ++ str ++ "\ESC[0m" 71 | 72 | 73 | 74 | --Be careful, these assume someone else will reset the background colour 75 | yellowOnGrey str = "\ESC[1;33m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 76 | brownOnGrey str = "\ESC[0;33m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 77 | blueOnGrey str = "\ESC[1;34m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 78 | redOnGrey str = "\ESC[1;31m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 79 | greenOnGrey str = "\ESC[1;32m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 80 | purpleOnGrey str = "\ESC[1;35m\ESC[47m" ++ str ++ "\ESC[0m\ESC[47m" 81 | whiteOnGrey str = "\ESC[37m" ++ str ++ "\ESC[0m" 82 | 83 | onBlack str = "\ESC[40m" ++ str ++ "\ESC[0m" 84 | onGrey str = onGreyEsc ++ str ++ onWhiteEsc 85 | onGreyEsc = "\ESC[47m" 86 | onWhiteEsc = "\ESC[0m" 87 | orange str = str -------------------------------------------------------------------------------- /Ex5/AgdaSetup.agda: -------------------------------------------------------------------------------- 1 | module AgdaSetup where 2 | 3 | {- This file contains all the basic types you need for the editor. You should 4 | read and understand the Agda in this file, but not bother too much about 5 | the funny compiler directives. -} 6 | 7 | data Nat : Set where 8 | zero : Nat 9 | suc : Nat -> Nat 10 | 11 | {-# BUILTIN NATURAL Nat #-} 12 | {-# BUILTIN ZERO zero #-} 13 | {-# BUILTIN SUC suc #-} 14 | {-# COMPILED_DATA Nat HaskellSetup.Nat HaskellSetup.Zero HaskellSetup.Suc #-} 15 | 16 | _+_ : Nat -> Nat -> Nat 17 | zero + n = n 18 | suc m + n = suc (m + n) 19 | 20 | infixr 5 _+_ 21 | 22 | data Zero : Set where 23 | magic : {X : Set} -> 24 | Zero -> X 25 | magic () 26 | 27 | {- In order to compile them, I have to define One and /*/ as data types 28 | rather than records. -} 29 | 30 | data One : Set where 31 | <> : One 32 | {-# COMPILED_DATA One () () #-} 33 | 34 | data _/*/_ (S T : Set) : Set where 35 | _,_ : S -> T -> S /*/ T 36 | {-# COMPILED_DATA _/*/_ (,) (,) #-} 37 | 38 | data Two : Set where 39 | tt ff : Two 40 | {-# BUILTIN BOOL Two #-} 41 | {-# BUILTIN TRUE tt #-} 42 | {-# BUILTIN FALSE ff #-} 43 | {-# COMPILED_DATA Two Bool True False #-} 44 | 45 | _<=_ : Nat -> Nat -> Two 46 | zero <= y = tt 47 | suc x <= zero = ff 48 | suc x <= suc y = x <= y 49 | 50 | if_then_else_ : {X : Set} -> Two -> X -> X -> X 51 | if tt then t else f = t 52 | if ff then t else f = f 53 | 54 | data List (X : Set) : Set where 55 | [] : List X 56 | _:>_ : X -> List X -> List X 57 | infixr 5 _:>_ 58 | 59 | _++_ : {A : Set} -> List A -> List A -> List A 60 | [] ++ ys = ys 61 | (x :> xs) ++ ys = x :> (xs ++ ys) 62 | 63 | {-# COMPILED_DATA List [] [] (:) #-} 64 | {-# BUILTIN LIST List #-} 65 | {-# BUILTIN NIL [] #-} 66 | {-# BUILTIN CONS _:>_ #-} 67 | 68 | {- Here are backward lists, which are useful when the closest element is 69 | conceptually at the right end. They aren't really crucial as you could use 70 | ordinary lists but think of the data as being reversed, but I prefer to 71 | keep my thinking straight and use data which look like what I have in mind. -} 72 | 73 | data Bwd (X : Set) : Set where 74 | [] : Bwd X 75 | _<:_ : Bwd X -> X -> Bwd X 76 | infixl 5 _<:_ 77 | 78 | {- You will need access to characters, imported from Haskell. You can write 79 | character literals like 'c'. You also get strings, with String literals like 80 | "fred" -} 81 | 82 | postulate -- this means that we just suppose the following things exist... 83 | Char : Set 84 | String : Set 85 | {-# BUILTIN CHAR Char #-} 86 | {-# COMPILED_TYPE Char Char #-} -- ...and by the time we reach Haskell... 87 | {-# BUILTIN STRING String #-} 88 | {-# COMPILED_TYPE String String #-} -- ...they *do* exist! 89 | 90 | primitive -- these are baked in; they even work! 91 | primCharEquality : Char -> Char -> Two 92 | primStringAppend : String -> String -> String 93 | primStringToList : String -> List Char 94 | primStringFromList : List Char -> String 95 | 96 | postulate -- Haskell has a monad for doing IO, which we use at the top level 97 | IO : Set -> Set 98 | return : {A : Set} -> A -> IO A 99 | _>>=_ : {A B : Set} -> IO A -> (A -> IO B) -> IO B 100 | infixl 1 _>>=_ 101 | {-# BUILTIN IO IO #-} 102 | {-# COMPILED_TYPE IO IO #-} 103 | {-# COMPILED return (\ _ -> return) #-} 104 | {-# COMPILED _>>=_ (\ _ _ -> (>>=)) #-} 105 | 106 | {- Here's the characterization of keys I give you -} 107 | data Direction : Set where up down left right : Direction 108 | data Modifier : Set where normal shift control : Modifier 109 | data Key : Set where 110 | char : Char -> Key 111 | arrow : Modifier -> Direction -> Key 112 | enter : Key 113 | backspace : Key 114 | delete : Key 115 | escape : Key 116 | 117 | {- This type classifies the difference between two editor states. -} 118 | data Change : Set where 119 | allQuiet : Change -- the buffer should be exactly the same 120 | cursorMove : Change -- the cursor has moved but the text is the same 121 | lineEdit : Change -- only the text on the current line has changed 122 | bigChange : Change -- goodness knows! 123 | 124 | {- This type collects the things you're allowed to do with the text window. -} 125 | data Action : Set where 126 | goRowCol : Nat -> Nat -> Action -- send the cursor somewhere 127 | sendText : List Char -> Action -- send some text 128 | 129 | {- I wire all of that stuff up to its Haskell counterpart. -} 130 | {-# IMPORT HaskellSetup #-} 131 | {-# COMPILED_DATA Direction 132 | HaskellSetup.Direction 133 | HaskellSetup.DU HaskellSetup.DD HaskellSetup.DL HaskellSetup.DR #-} 134 | {-# COMPILED_DATA Modifier 135 | HaskellSetup.Modifier 136 | HaskellSetup.Normal HaskellSetup.Shift HaskellSetup.Control #-} 137 | {-# COMPILED_DATA Key 138 | HaskellSetup.Key 139 | HaskellSetup.Char HaskellSetup.Arrow HaskellSetup.Enter 140 | HaskellSetup.Backspace HaskellSetup.Delete HaskellSetup.Escape #-} 141 | {-# COMPILED_DATA Change 142 | HaskellSetup.Change 143 | HaskellSetup.AllQuiet HaskellSetup.CursorMove HaskellSetup.LineEdit 144 | HaskellSetup.BigChange #-} 145 | {-# COMPILED_DATA Action 146 | HaskellSetup.Action 147 | HaskellSetup.GoRowCol HaskellSetup.SendText #-} 148 | 149 | {- This is the bit of code I wrote to animate your code. -} 150 | postulate 151 | mainLoop : {B : Set} -> -- buffer type 152 | -- INITIALIZER 153 | (List (List Char) -> B) -> -- make a buffer from some lines of text 154 | -- KEYSTROKE HANDLER 155 | (Key -> B -> -- keystroke and buffer in 156 | Change /*/ B) -> -- change report and buffer out 157 | -- RENDERER 158 | ((Nat /*/ Nat) -> -- height and width of screen 159 | (Nat /*/ Nat) -> -- top line number, left column number 160 | (Change /*/ B) -> -- change report and buffer to render 161 | (List Action /*/ -- how to update the display 162 | (Nat /*/ Nat))) -> -- new top line number, left column number 163 | -- PUT 'EM TOGETHER AND YOU'VE GOT AN EDITOR! 164 | IO One 165 | {-# COMPILED mainLoop (\ _ -> HaskellSetup.mainLoop) #-} 166 | 167 | {- You can use this to put noisy debug messages in Agda code. So 168 | trace "fred" tt 169 | evaluates to tt, but prints "fred" in the process. -} 170 | postulate 171 | trace : {A : Set} -> String -> A -> A 172 | {-# IMPORT Debug.Trace #-} 173 | {-# COMPILED trace (\ _ -> Debug.Trace.trace) #-} 174 | 175 | {- You can use this to print an error message when you don't know what else to do. 176 | It's very useful for filling in unfinished holes to persuade the compiler to 177 | compile your code even though it isn't finished: you get an error if you try 178 | to run a missing bit. -} 179 | postulate 180 | error : {A : Set} -> String -> A 181 | {-# COMPILED error (\ _ -> error) #-} 182 | 183 | {- Don't mind this bit... -} 184 | postulate 185 | Level : Set 186 | lze : Level 187 | lsu : Level -> Level 188 | lmx : Level -> Level -> Level 189 | {-# BUILTIN LEVEL Level #-} 190 | {-# BUILTIN LEVELZERO lze #-} 191 | {-# BUILTIN LEVELSUC lsu #-} 192 | {-# BUILTIN LEVELMAX lmx #-} 193 | 194 | {- Equality -} 195 | {- x == y is a type whenever x and y are values in the same type -} 196 | {- 197 | data _==_ {X : Set}(x : X) : X -> Set where 198 | refl : x == x -- and x == y has a constructor only when y actually is x! 199 | infixl 1 _==_ 200 | -- {-# BUILTIN EQUALITY _==_ #-} 201 | -- {-# BUILTIN REFL refl #-} 202 | {-# COMPILED_DATA _==_ HaskellSetup.EQ HaskellSetup.Refl #-} 203 | 204 | within_turn_into_because_ : 205 | {X Y : Set}(f : X -> Y)(x x' : X) -> 206 | x == x' -> f x == f x' 207 | within f turn x into .x because refl = refl 208 | -- the dot tells Agda that *only* x can go there 209 | 210 | symmetry : {X : Set}{x x' : X} -> x == x' -> x' == x 211 | symmetry refl = refl 212 | 213 | transitivity : {X : Set}{x0 x1 x2 : X} -> x0 == x1 -> x1 == x2 -> x0 == x2 214 | transitivity refl refl = refl 215 | -} 216 | 217 | postulate 218 | _==_ : {X : Set} -> X -> X -> Set -- the evidence that two X-values are equal 219 | refl : {X : Set}{x : X} -> x == x 220 | symmetry : {X : Set}{x x' : X} -> x == x' -> x' == x 221 | transitivity : {X : Set}{x0 x1 x2 : X} -> x0 == x1 -> x1 == x2 -> x0 == x2 222 | within_turn_into_because_ : 223 | {X Y : Set}(f : X -> Y)(x x' : X) -> 224 | x == x' -> f x == f x' 225 | infix 1 _==_ 226 | 227 | {-# COMPILED_TYPE _==_ HaskellSetup.EQ #-} 228 | 229 | {- Here's an example. -} 230 | 231 | additionAssociative : (x y z : Nat) -> (x + y) + z == x + (y + z) 232 | additionAssociative zero y z = refl 233 | additionAssociative (suc x) y z 234 | = within suc turn ((x + y) + z) into (x + (y + z)) 235 | because additionAssociative x y z 236 | -------------------------------------------------------------------------------- /Ex5/Edit.agda: -------------------------------------------------------------------------------- 1 | module Edit where 2 | 3 | {- This is the file where you should work. -} 4 | 5 | open import AgdaSetup 6 | 7 | {- The key editor data structure is the cursor. A Cursor M X represents 8 | being somewhere in the middle of a sequence of X values, holding an M. -} 9 | 10 | record Cursor (M X : Set) : Set where 11 | constructor _<[_]>_ 12 | field 13 | beforeMe : Bwd X 14 | atMe : M 15 | afterMe : List X 16 | infix 4 _<[_]>_ 17 | 18 | {- An editor buffer is a nested cursor: we're in the middle of a bunch of 19 | *lines*, holding a cursor for the current line, which puts us in the 20 | middle of a bunch of characters, holding the element of One. -} 21 | Buffer : Set 22 | Buffer = Cursor (Cursor One Char) (List Char) 23 | 24 | {- This operator, called "chips", shuffles the elements from a backward list 25 | on to the start of a forward list, keeping them in the same order. -} 26 | _<>>_ : {X : Set} -> Bwd X -> List X -> List X 27 | [] <>> xs = xs 28 | (xz <: x) <>> xs = xz <>> (x :> xs) 29 | 30 | {- The "fish" operator goes the other way. -} 31 | _<><_ : {X : Set} -> Bwd X -> List X -> Bwd X 32 | xz <>< [] = xz 33 | xz <>< (x :> xs) = (xz <: x) <>< xs 34 | 35 | {- You can turn a buffer into a list of lines, preserving its text. -} 36 | bufText : Buffer -> List (List Char) 37 | bufText 38 | (sz <[ 39 | cz <[ <> ]> cs 40 | ]> ss) 41 | = sz <>> ((cz <>> cs) :> ss) 42 | 43 | {- Here's an example of a proof of a fact about fish and chips. -} 44 | firstFishFact : {X : Set} -> (xz : Bwd X)(xs : List X) -> 45 | (xz <>< xs) <>> [] == xz <>> xs 46 | firstFishFact xz [] = refl 47 | firstFishFact xz (x :> xs) = firstFishFact (xz <: x) xs 48 | 49 | {- You will need more such facts. -} 50 | 51 | {- EXERCISE 5.1 -} 52 | {- When we start the editor with the command 53 | ./Edit foo.txt 54 | the contents of foo.txt will be turned into a list of lines. 55 | Your (not so tricky) mission is to turn the file contents into a buffer which 56 | contains the same text. 57 | (2 marks) 58 | -} 59 | initBuf : List (List Char) -> Buffer 60 | initBuf ss = 61 | [] <[ 62 | [] <[ <> ]> [] 63 | ]> [] 64 | {- As you can see, the current version will run, but it always gives the empty 65 | buffer, which is not what we want unless the input is empty. -} 66 | 67 | {- Next comes the heart of the editor. You get a keystroke and the current buffer, 68 | and you have to say what is the new buffer. You also have to say what is the 69 | extent of the change. 70 | 71 | The tricky part is this: you have to be honest enough about your change 72 | report, so that we don't underestimate the amount of updating the screen needs. 73 | -} 74 | 75 | Honest : Buffer -> Change /*/ Buffer -> Set 76 | Honest b (allQuiet , b') = b == b' 77 | Honest b (cursorMove , b') = bufText b == bufText b' 78 | Honest (sz <[ _ ]> ss) (lineEdit , (sz' <[ _ ]> ss')) = (sz == sz') /*/ (ss == ss') 79 | Honest _ (bigChange , _) = One 80 | 81 | record UpdateFrom (b : Buffer) : Set where -- b is the starting buffer 82 | constructor _///_ 83 | field 84 | update : Change /*/ Buffer -- change and new buffer 85 | honest : Honest b update 86 | open UpdateFrom 87 | infix 2 _///_ 88 | 89 | {- EXERCISE 5.2 -} 90 | {- Implement the appropriate behaviour for as many keystrokes as you can. 91 | I have done a couple for you, but I don't promise to have done them 92 | correctly. -} 93 | keystroke : Key -> (b : Buffer) -> UpdateFrom b 94 | keystroke (char c) 95 | (sz <[ 96 | cz <[ <> ]> cs 97 | ]> ss) 98 | = lineEdit , 99 | (sz <[ 100 | cz <[ <> ]> c :> cs 101 | ]> ss) 102 | /// refl , refl -- see? same above and below 103 | keystroke (arrow normal right) 104 | (sz <: s <[ 105 | [] <[ <> ]> cs 106 | ]> ss) 107 | = cursorMove , 108 | (sz <[ ([] <>< s) <[ <> ]> [] ]> cs :> ss) 109 | /// within (\ x -> sz <>> (x :> cs :> ss)) turn s into ([] <>< s) <>> [] 110 | because symmetry (firstFishFact [] s) 111 | keystroke k b = allQuiet , b /// refl 112 | {- Please expect to need to invent extra functions, e.g., to measure where you 113 | are, so that up and down arrow work properly. -} 114 | {- Remember also that you can always overestimate the change by saying bigChange, 115 | which needs only a trivial proof. But you may find that the display will flicker 116 | badly if you do. -} 117 | {- (char c) 2 marks 118 | enter 3 marks 119 | backspace delete 4 marks for the pair 120 | left right 5 marks for the pair (with cursorMove change) 121 | up down 6 marks for the pair (with cursorMove change) 122 | -} 123 | 124 | 125 | {- EXERCISE 5.3 -} 126 | {- You will need to improve substantially on my implementation of the next component, 127 | whose purpose is to update the window. Mine displays only one line! -} 128 | render : 129 | Nat /*/ Nat -> -- height and width of window -- CORRECTION! width and height 130 | Nat /*/ Nat -> -- first visible row, first visible column 131 | Change /*/ Buffer -> -- what just happened 132 | List Action /*/ -- how to update screen 133 | (Nat /*/ Nat) -- new first visible row, first visible column 134 | render _ tl (allQuiet , _) = ([] , tl) 135 | render _ tl (_ , (_ <[ cz <[ <> ]> cs ]> _)) 136 | = (goRowCol 0 0 :> sendText (cz <>> cs) :> []) , tl 137 | {- The editor window gives you a resizable rectangular viewport onto the editor buffer. 138 | You get told 139 | the current size of the viewport 140 | which row and col of the buffer are at the top left of the viewport 141 | (so you can handle documents which are taller or wider than the window) 142 | the most recent change report and buffer 143 | 144 | You need to figure out whether you need to move the viewport 145 | (by finding out if the cursor is still within the viewport) 146 | and if so, where to. 147 | 148 | You need to figure out what to redisplay. If the change report says 149 | lineEdit and the viewport has not moved, you need only repaint the 150 | current line. If the viewport has moved or the change report says 151 | bigChange, you need to repaint the whole buffer. 152 | 153 | You will need to be able to grab a rectangular region of text from the 154 | buffer, but you do know how big and where from. 155 | 156 | Remember to put the cursor in the right place, relative to where in 157 | the buffer the viewport is supposed to be. The goRowCol action takes 158 | *viewport* coordinates, not *buffer* coordinates! You will need to 159 | invent subtraction! 160 | -} 161 | {- Your code does not need to worry about resizing the window. My code does 162 | that. On detecting a size change, my code just calls your code with a 163 | bigChange report and the same buffer, so if you are doing a proper repaint, 164 | the right thing will happen. -} 165 | {- 4 marks for ensuring that a buffer smaller than the viewport displays 166 | correctly, with the cursor in the right place, if nobody changes 167 | the viewport size 168 | 3 marks for ensuring that the cursor remains within the viewport even if 169 | the viewport needs to move 170 | 3 marks for ensuring that lineEdit changes need only affect one line of 171 | the display (provided the cursor stays in the viewport) 172 | -} 173 | 174 | {- For the last 8 marks, you have a chance to be even more creative. You have 175 | spare detectable keys that you could invent meanings for. You also have the 176 | freedom to change the definition of Buffer, as my code does not care what 177 | a Buffer is: it only needs to know how to initialize, update and render, 178 | and these are defined by you. 179 | 180 | Additional structural cursor moves (beginning and end of line, etc) will not 181 | score much. Going left or right word-by-word would score more: you can 182 | match against a pattern such as ' '. 183 | 184 | Selection and cut/copy/paste are worth the big bucks. For these, you need to 185 | modify the Buffer structure to remember the clipboard contents (if any), 186 | and to manage the extent of any selected region. 187 | 188 | If you feel the need to vary the foreground or background colour of the displayed 189 | text (e.g. to show a selection), please let me know. 190 | -} 191 | 192 | 193 | {- Your code then hooks into mine to produce a top level executable! -} 194 | main : IO One 195 | main = mainLoop initBuf (\ k b -> update (keystroke k b)) render 196 | 197 | {- To build the editor, just do 198 | make 199 | in a shell window (with Ex5 the current directory). 200 | To run the editor, once compiled, do 201 | ./Edit 202 | in the shell window, which should become the editor window. 203 | To quit the editor, do 204 | ctrl-C 205 | like an old-fashioned soul. 206 | -} 207 | 208 | {- There is no one right way to do this exercise, and there is some scope for 209 | extension. It's important that you get in touch if you need help, either in 210 | achieving the basic deliverable, or in finding ways to explore beyond it. 211 | -} 212 | -------------------------------------------------------------------------------- /Ex5/HaskellSetup.hs: -------------------------------------------------------------------------------- 1 | module HaskellSetup where 2 | 3 | {- This is the low-level stuff that hooks into the ncurses library, together 4 | with the Haskell versions of the Agda types. You should not need to bother 5 | reading or modifying this file. -} 6 | 7 | import Debug.Trace 8 | import Foreign 9 | import Foreign.C (CInt(..)) 10 | import ANSIEscapes 11 | import System.IO 12 | import System.Environment 13 | import Control.Applicative 14 | import Control.Concurrent 15 | 16 | foreign import ccall 17 | initscr :: IO () 18 | 19 | foreign import ccall "endwin" 20 | endwin :: IO CInt 21 | 22 | foreign import ccall "refresh" 23 | refresh :: IO CInt 24 | 25 | foreign import ccall "&LINES" 26 | linesPtr :: Ptr CInt 27 | 28 | foreign import ccall "&COLS" 29 | colsPtr :: Ptr CInt 30 | 31 | scrSize :: IO (Int, Int) 32 | scrSize = do 33 | lnes <- peek linesPtr 34 | cols <- peek colsPtr 35 | return (fromIntegral cols, fromIntegral lnes) 36 | 37 | data Direction = DU | DD | DL | DR deriving Show 38 | data Modifier = Normal | Shift | Control deriving Show 39 | data Key = Char Char | Arrow Modifier Direction | Enter | Backspace | Delete | Escape deriving Show 40 | 41 | data Nat = Zero | Suc Nat 42 | toNat :: Int -> Nat 43 | toNat 0 = Zero 44 | toNat n = Suc (toNat (n - 1)) 45 | fromNat :: Nat -> Int 46 | fromNat Zero = 0 47 | fromNat (Suc n) = 1 + fromNat n 48 | 49 | data EQ a b c = Refl 50 | 51 | data Change = AllQuiet | CursorMove | LineEdit | BigChange 52 | 53 | data Action = GoRowCol Nat Nat | SendText [Char] 54 | 55 | act :: Action -> IO () 56 | act (GoRowCol y x) = do 57 | resetCursor 58 | forward (fromNat x) 59 | down (fromNat y) 60 | act (SendText s) = putStr s 61 | 62 | getEscapeKey :: [(String, Key)] -> IO (Maybe Key) 63 | getEscapeKey [] = return Nothing 64 | getEscapeKey sks = case lookup "" sks of 65 | Just k -> return (Just k) 66 | _ -> do 67 | c <- getChar 68 | getEscapeKey [(cs, k) | (d : cs, k) <- sks, d == c] 69 | 70 | directions :: [(Char, Direction)] 71 | directions = [('A', DU), ('B', DD), 72 | ('C', DR), ('D', DL)] 73 | 74 | escapeKeys :: [(String, Key)] 75 | escapeKeys = 76 | [([c], Arrow Normal d) | (c, d) <- directions] ++ 77 | [("1;2" ++ [c], Arrow Shift d) | (c, d) <- directions] ++ 78 | [("1;5" ++ [c], Arrow Control d) | (c, d) <- directions] ++ 79 | [("3~", Delete)] 80 | 81 | keyReady :: IO (Maybe Key) 82 | keyReady = do 83 | b <- hReady stdin 84 | if not b then return Nothing else do 85 | c <- getChar 86 | case c of 87 | '\n' -> return $ Just Enter 88 | '\r' -> return $ Just Enter 89 | '\b' -> return $ Just Backspace 90 | '\DEL' -> return $ Just Backspace 91 | _ | c >= ' ' -> return $ Just (Char c) 92 | '\ESC' -> do 93 | b <- hReady stdin 94 | if not b then return $ Just Escape else do 95 | c <- getChar 96 | case c of 97 | '[' -> getEscapeKey escapeKeys 98 | _ -> return $ Just Escape 99 | _ -> return $ Nothing 100 | 101 | pni :: (Int, Int) -> (Nat, Nat) 102 | pni (y, x) = (toNat y, toNat x) 103 | 104 | mainLoop :: 105 | ([[Char]] -> b) -> 106 | (Key -> b -> (Change, b)) -> 107 | ((Nat, Nat) -> (Nat, Nat) -> (Change, b) -> ([Action], (Nat, Nat))) -> 108 | IO () 109 | mainLoop initBuf keystroke render = do 110 | hSetBuffering stdout NoBuffering 111 | hSetBuffering stdin NoBuffering 112 | xs <- getArgs 113 | buf <- case xs of 114 | [] -> return (initBuf []) 115 | (x : _) -> (initBuf . lines) <$> readFile x 116 | initscr 117 | innerLoop (0, 0) (Zero, Zero) (BigChange, buf) 118 | endwin 119 | return () 120 | where 121 | innerLoop oldSize topLeft (c, b) = do 122 | refresh 123 | size <- scrSize 124 | (acts, topLeft) <- return $ 125 | if size /= oldSize 126 | then render (pni size) topLeft (BigChange, b) 127 | else render (pni size) topLeft (c, b) 128 | mapM_ act acts 129 | mc <- keyReady 130 | case mc of 131 | Nothing -> threadDelay 100 >> innerLoop size topLeft (AllQuiet, b) 132 | Just k -> innerLoop size topLeft (keystroke k b) 133 | -------------------------------------------------------------------------------- /Ex5/Makefile: -------------------------------------------------------------------------------- 1 | default: Edit 2 | 3 | Edit: Edit.agda ANSIEscapes.hs HaskellSetup.hs AgdaSetup.agda 4 | agda --compile --ghc-flag "-lncurses" Edit.agda 5 | -------------------------------------------------------------------------------- /FunctorKit.agda: -------------------------------------------------------------------------------- 1 | module FunctorKit where 2 | 3 | open import BasicPrelude 4 | 5 | record Functor (F : Set{-type of elements-} -> Set{-type of structures-}) 6 | : Set1 where 7 | field 8 | 9 | map : {S T : Set} -> (S -> T) {- operation on elements-} 10 | -> F S -> F T {- operation on structures -} 11 | 12 | mapI : {X : Set}(xs : F X) -> map id xs == xs 13 | mapC : {R S T : Set}(f : S -> T)(g : R -> S)(xs : F R) -> 14 | map f (map g xs) == map (f o g) xs 15 | 16 | open Functor public 17 | 18 | ListFunctor : Functor List 19 | ListFunctor = record { map = mapList; mapI = mapIList; mapC = mapCList } where 20 | 21 | mapList : {S T : Set} -> (S -> T) -> List S -> List T 22 | mapList f [] = [] 23 | mapList f (x :> xs) = f x :> mapList f xs 24 | 25 | mapIList : {X : Set} (xs : List X) -> mapList id xs == xs 26 | mapIList [] = refl 27 | mapIList (x :> xs) rewrite mapIList xs = refl 28 | 29 | mapCList : {R S T : Set} (f : S -> T) (g : R -> S) (xs : List R) -> 30 | mapList f (mapList g xs) == mapList (f o g) xs 31 | mapCList f g [] = refl 32 | mapCList f g (x :> xs) rewrite mapCList f g xs = refl 33 | 34 | Label : Set -> (Set -> Set) -- no elements 35 | Label A X = A 36 | 37 | LabelFunctor : (A : Set) -> Functor (Label A) 38 | LabelFunctor A = record 39 | { map = \ _ a -> a; mapI = \ _ -> refl; mapC = \ _ _ _ -> refl } 40 | 41 | Id : Set -> Set -- one element 42 | Id X = X 43 | 44 | IdFunctor : Functor Id 45 | IdFunctor = record { 46 | map = id; 47 | mapI = \ _ -> refl; 48 | mapC = \ _ _ _ -> refl } 49 | 50 | PairFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 51 | Functor \ X -> F X /*/ G X 52 | PairFunctor {F}{G} FunF FunG = record { map = mapP ; mapI = mapPI ; mapC = mapPC } 53 | where 54 | mapP : {S T : Set} -> (S -> T) -> (F S /*/ G S) -> (F T /*/ G T) 55 | mapP f (xF , xG) = map FunF f xF , map FunG f xG 56 | mapPI : forall {X : Set}(xs : F X /*/ G X) -> mapP id xs == xs 57 | mapPI (xF , xG) rewrite mapI FunF xF | mapI FunG xG = refl 58 | mapPC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /*/ G R) -> 59 | mapP f (mapP g xs) == mapP (f o g) xs 60 | mapPC f g (xF , xG) rewrite mapC FunF f g xF | mapC FunG f g xG = refl 61 | 62 | SumFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 63 | Functor \ X -> F X /+/ G X 64 | SumFunctor {F}{G} FunF FunG = record { map = mapS ; mapI = mapSI; mapC = mapSC } 65 | where 66 | mapS : {S T : Set} -> (S -> T) -> (F S /+/ G S) -> (F T /+/ G T) 67 | mapS f (inl xF) = inl (map FunF f xF) 68 | mapS f (inr xG) = inr (map FunG f xG) 69 | mapSI : {X : Set} (xs : F X /+/ G X) -> mapS id xs == xs 70 | mapSI (inl xF) rewrite mapI FunF xF = refl 71 | mapSI (inr xG) rewrite mapI FunG xG = refl 72 | mapSC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /+/ G R) -> 73 | mapS f (mapS g xs) == mapS (f o g) xs 74 | mapSC f g (inl xF) rewrite mapC FunF f g xF = refl 75 | mapSC f g (inr xG) rewrite mapC FunG f g xG = refl 76 | 77 | data Kit : Set1 where 78 | zeroK oneK : Kit 79 | idK : Kit 80 | dataK : Kit -> Kit 81 | _*K_ : Kit -> Kit -> Kit 82 | _+K_ : Kit -> Kit -> Kit 83 | 84 | infixr 4 _+K_ 85 | infixr 5 _*K_ 86 | 87 | Fun : Kit -> Set -> Set 88 | 89 | data DATA (f : Kit) : Set where 90 | [_] : Fun f (DATA f) -> DATA f 91 | 92 | Fun zeroK X = Zero 93 | Fun oneK X = One 94 | Fun idK X = Id X 95 | Fun (dataK f) X = DATA f 96 | Fun (f *K g) X = Fun f X /*/ Fun g X 97 | Fun (f +K g) X = Fun f X /+/ Fun g X 98 | 99 | FunFunctor : (f : Kit) -> Functor (Fun f) 100 | FunFunctor zeroK = LabelFunctor Zero 101 | FunFunctor oneK = LabelFunctor One 102 | FunFunctor (dataK f) = LabelFunctor (DATA f) 103 | FunFunctor idK = IdFunctor 104 | FunFunctor (f *K g) = PairFunctor (FunFunctor f) (FunFunctor g) 105 | FunFunctor (f +K g) = SumFunctor (FunFunctor f) (FunFunctor g) 106 | 107 | twoK : Kit 108 | twoK = oneK +K oneK 109 | 110 | pattern true = [ inl <> ] 111 | pattern false = [ inr <> ] 112 | 113 | natK : Kit 114 | natK = oneK +K idK 115 | 116 | pattern ze = [ inl <> ] 117 | pattern su n = [ inr n ] 118 | 119 | toNatK : Nat -> DATA natK 120 | toNatK zero = ze 121 | toNatK (suc n) = su (toNatK n) 122 | 123 | listK : Kit -> Kit 124 | listK f = oneK +K (dataK f *K idK) 125 | 126 | pattern nil = [ inl <> ] 127 | pattern cons x xs = [ inr (x , xs) ] 128 | 129 | treeK : Kit -> Kit 130 | treeK f = oneK +K (idK *K dataK f *K idK) 131 | 132 | leaf' : {f : Kit} -> DATA (treeK f) 133 | pattern leaf = [ inl <> ] 134 | leaf' = leaf 135 | pattern node l x r = [ inr (l , x , r) ] 136 | node' : {f : Kit} -> DATA (treeK f) -> DATA f -> DATA (treeK f) -> DATA (treeK f) 137 | node' l x r = node l x r 138 | 139 | leK : DATA natK -> DATA natK -> DATA twoK 140 | leK ze n = true 141 | leK (su m) ze = false 142 | leK (su m) (su n) = leK m n 143 | 144 | 145 | {- 146 | 147 | noLabels : (f : Kit) -> DATA f -> Zero 148 | 149 | noLabels' : (r f : Kit) -> Fun f (DATA r) -> Zero 150 | noLabels' r idK x = noLabels r x 151 | noLabels' r (f *K g) (xf , xg) = noLabels' r f xf 152 | noLabels' r (f +K g) (inl x) = noLabels' r f x 153 | noLabels' r (f +K g) (inr x) = noLabels' r g x 154 | 155 | noLabels f [ x ] = noLabels' f f x 156 | -} 157 | 158 | {- 159 | mysteryf : Kit 160 | mysteryf = (labelK One) +K idK 161 | 162 | MYSTERY : Set 163 | MYSTERY = DATA mysteryf 164 | 165 | {- -- ask Agsy to try making some elements of the MYSTERY type 166 | mystery : MYSTERY 167 | mystery = {!-l!} -- do [C-c C-a] with -l in the braces 168 | -} 169 | 170 | -- Aha! It's a copy of the natural numbers! 171 | 172 | zeroM : MYSTERY 173 | zeroM = [ inl <> ] 174 | 175 | sucM : MYSTERY -> MYSTERY 176 | sucM n = [ inr n ] 177 | 178 | -- Now how about this... 179 | 180 | treef : Set -> Kit 181 | treef X = labelK One +K idK *K labelK X *K idK 182 | 183 | pattern leaf = [ inl <> ] 184 | pattern node l x r = [ inr (l , x , r) ] 185 | 186 | flatten : {X : Set} -> DATA (treef X) -> List X 187 | flatten leaf = [] 188 | flatten (node l x r) = flatten l ++ x :> flatten r 189 | 190 | insert : Nat -> DATA (treef Nat) -> DATA (treef Nat) 191 | insert n leaf = node leaf n leaf 192 | insert n (node l x r) with n <= x 193 | insert n (node l x r) | tt = node (insert n l) x r 194 | insert n (node l x r) | ff = node l x (insert n r) 195 | 196 | StuffINeed : Kit -> Set 197 | StuffINeed (labelK A) = A -> A -> Two 198 | StuffINeed idK = One 199 | StuffINeed (f *K g) = StuffINeed f /*/ StuffINeed g 200 | StuffINeed (f +K g) = StuffINeed f /*/ StuffINeed g 201 | -} 202 | 203 | kitEq : {f : Kit} -> DATA f -> DATA f -> DATA twoK 204 | 205 | nodeEq : (r f : Kit) -> Fun f (DATA r) -> Fun f (DATA r) -> DATA twoK 206 | nodeEq r zeroK () y 207 | nodeEq r oneK <> <> = true 208 | nodeEq r idK x y = kitEq x y -- here's where r is used 209 | nodeEq r (dataK f) x y = kitEq x y 210 | nodeEq r (f *K g) (xf , xg) (yf , yg) with nodeEq r f xf yf | nodeEq r g xg yg 211 | nodeEq r (f *K g) (xf , xg) (yf , yg) | true | true = true 212 | nodeEq r (f *K g) (xf , xg) (yf , yg) | qf | qg = false 213 | nodeEq r (f +K g) (inl x) (inl y) = nodeEq r f x y 214 | nodeEq r (f +K g) (inl x) (inr y) = false 215 | nodeEq r (f +K g) (inr x) (inl y) = false 216 | nodeEq r (f +K g) (inr x) (inr y) = nodeEq r g x y 217 | 218 | kitEq {f} [ x ] [ y ] = nodeEq f f x y 219 | 220 | delOne : Kit -> Kit 221 | delOne zeroK = zeroK 222 | delOne oneK = zeroK 223 | delOne idK = oneK 224 | delOne (dataK f) = zeroK 225 | delOne (f *K g) = delOne f *K g +K f *K delOne g 226 | delOne (f +K g) = delOne f +K delOne g 227 | 228 | 229 | {- 230 | nodeEq r sr (labelK A) s a a' = s a a' 231 | nodeEq r sr idK s x y = kitEq sr x y 232 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) 233 | with nodeEq r sr f sf xf yf | nodeEq r sr g sg xg yg 234 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | tt | tt = tt 235 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | qf | qg = ff 236 | nodeEq r sr (f +K g) s (inl xf) (inl yf) = nodeEq r sr f (outl s) xf yf 237 | nodeEq r sr (f +K g) s (inl xf) (inr yg) = ff 238 | nodeEq r sr (f +K g) s (inr xg) (inl yf) = ff 239 | nodeEq r sr (f +K g) s (inr xg) (inr yg) = nodeEq r sr g (outr s) xg yg 240 | 241 | kitEq {f} s [ x ] [ y ] = nodeEq f s f s x y 242 | 243 | myGo : Two 244 | myGo = kitEq ((\ _ _ -> tt) , _) (sucM (sucM (sucM zeroM))) (sucM (sucM (sucM zeroM))) 245 | -} -------------------------------------------------------------------------------- /Hello.agda: -------------------------------------------------------------------------------- 1 | module Hello where 2 | 3 | -- Oh, you made it! Well done! This line is a comment. 4 | 5 | -- In the beginning, Agda knows nothing, but we can teach it about numbers. 6 | 7 | data Nat : Set where 8 | zero : Nat 9 | suc : Nat -> Nat 10 | 11 | -- Now we can say how to add numbers. 12 | 13 | _+_ : Nat -> Nat -> Nat 14 | zero + n = n 15 | suc m + n = suc (m + n) 16 | 17 | -- Now we can try adding some numbers. 18 | 19 | four : Nat 20 | four = (suc (suc zero)) + (suc (suc zero)) 21 | 22 | -- To make it go, select "Evaluate term to normal form" from the 23 | -- Agda menu, then type "four", without the quotes, and press return. 24 | 25 | -- Hopefully, you should get a response 26 | -- suc (suc (suc (suc zero))) 27 | 28 | -------------------------------------------------------------------------------- /Introduction.lagda: -------------------------------------------------------------------------------- 1 | \chapter{Introduction} 2 | 3 | 4 | \section{Language and Tools} 5 | 6 | For the most part, we'll be using the experimental language, 7 | Agda~\cite{DBLP:conf/afp/Norell08}, which is a bit like Haskell 8 | (and implemented in Haskell), but has a more expressive type system 9 | and a rather fabulous environment for typed programming. Much of what 10 | we learn here can be ported back to Haskell with a bit of bodging and 11 | fudging (and perhaps some stylish twists), but it's the programming 12 | environment that makes it worth exploring the ideas in this class via 13 | Agda. 14 | 15 | The bad news, for some of you at any rate, is that the Agda programming 16 | environment is tightly coupled to the Emacs editor. If you don't like 17 | Emacs, tough luck. You may have a job getting all this stuff to work on 18 | whatever machines you use outside the department, but the toolchain all 19 | works fine on departmental machines. 20 | 21 | Teaching materials, exercise files, lecture scripts, and so on, will 22 | all pile up in the repository 23 | \url{https://github.com/pigworker/CS410-13}, so you'll need to get 24 | with the git programme. We'll fix it so you each have your own place 25 | to put your official branch of the repo where I can get at it. All 26 | work and feedback will be mediated via your git repository. 27 | 28 | 29 | \section{Lectures, Lab, Tutorials} 30 | 31 | \textbf{Monday:~} Lecture and Lab, 2--5pm LT1301 32 | 33 | \textbf{Tuesday:~} Tutorial, 4--5pm, LT718 (this will usually be 34 | conducted by one of my graduate students) 35 | 36 | \textbf{Friday:~} Lecture, 11am--12pm, GH811 37 | 38 | \textbf{Scheduled interruptions of service:~} Monday 30 September, 39 | University closed; Week 4 (14--18 October), I'm at a working group 40 | meeting; perhaps Friday 8 November, when I might be examining a PhD. 41 | We can't do anything about the University closing, but I'll try to 42 | find fun people for you to hang out with on the other dates. 43 | 44 | 45 | \section{Twitter @@CS410afp} 46 | 47 | This class has a twitter feed. Largely, this is so that I can post 48 | pictures of the whiteboard. I don't use it for essential 49 | communications about class business, so you need neither join twitter 50 | nor follow this user. You can access all the relevant stuff just by 51 | surfing into \url{http://twitter.com/CS410afp}. This user, unlike my 52 | personal account, will follow back all class members who follow it, 53 | unless you ask it not to. 54 | 55 | 56 | \section{Hoop Jumping} 57 | 58 | CS410 Advanced Functional Programming is a level 4 class worth 20 59 | credits. It is assessed \emph{entirely} by coursework. Departmental 60 | policy requires class convenors to avoid deadline collisions by 61 | polite negotiation, so I've agreed the following dates for handins, 62 | as visible on the 4th year noticeboard. 63 | \begin{itemize} 64 | \item Thursday week 3 65 | \item Friday week 6 66 | \item Thursday week 9 67 | \item Tuesday week 12 68 | \item Wednesday week 15 69 | \item final assignment, issued as soon as possible after fourth year project 70 | deadline, to be submitted as late as I consider practicable 71 | before the exam board 72 | \end{itemize} 73 | In order to ensure sufficient evidence of independent learning, 74 | I reserve the right to conduct done-in-one-lab assignments on Mondays 75 | not in a deadline week, and to conduct oral examinations by 76 | appointment. 77 | 78 | 79 | 80 | \section{Getting Agda Going on Departmental Machines} 81 | 82 | Step 1. Use Linux. Get yourself a shell. (It's going to be that sort 83 | of a deal, all the way along. Welcome back to the 1970s.) 84 | 85 | Step 2 for \emph{bash} users. Ensure that your \texttt{PATH} environment variable includes 86 | the directory where Haskell's \texttt{cabal} build manager puts 87 | executables. Under normal circumstances, this is readily achieved by 88 | ensuring that your \texttt{.profile} file contains the line: 89 | \[ 90 | \mbox{\texttt{export PATH=\$HOME/.cabal/bin:\$PATH}} 91 | \] 92 | After you've edited \texttt{.profile}, grab a fresh shell window before 93 | continuing. 94 | 95 | Step 2 for \emph{tcsh} users. Ensure that your \texttt{path} environment variable includes 96 | the directory where Haskell's \texttt{cabal} build manager puts 97 | executables. Under normal circumstances, this is readily achieved by 98 | ensuring that your \texttt{.cshrc} file contains the line: 99 | \[ 100 | \mbox{\texttt{set path = (\$home/.cabal/bin \$path)}} 101 | \] 102 | After you've edited \texttt{.cshrc}, grab a fresh shell window before 103 | continuing. 104 | 105 | Step 3. Ensure that you are in sync with the Haskell package database 106 | by issuing the command: 107 | \[ 108 | \mbox{\texttt{cabal update}} 109 | \] 110 | Some people found that this bombs out with a missing library. Asking 111 | \texttt{which cabal} revealed that they had a spurious \texttt{\~{}/.cabal/bin/cabal} 112 | file which took precedence over the regular \texttt{/usr/bin/cabal}. Simply delete 113 | \texttt{\~{}/.cabal/bin/cabal} to fix this problem. 114 | 115 | Step 4. Install Agda by issuing the command: 116 | \[ 117 | \mbox{\texttt{cabal install agda}} 118 | \] 119 | Yes, that's a lower case 'a' in 'agda'. In some situations, it may not manage the full 120 | installation in one go, delivering an error message about which package or version it has 121 | failed to install. We've found that it's sometimes necessary to do 122 | \texttt{cabal install happy} separately, and to do \texttt{cabal install alex-3.0}, 123 | requesting a specific older version, as required by another package. 124 | 125 | Step 5. Wait. 126 | 127 | Step 6. Wait some more. 128 | 129 | Step 7. Assuming all of that worked just fine, set up the Emacs interactive environment with the command: 130 | \[ 131 | \mbox{\texttt{agda-mode setup; agda-mode compile}} 132 | \] 133 | 134 | Step 8. Get this repository. Navigate to where in your file system you want 135 | to keep it and do 136 | \[ 137 | \mbox{\texttt{git clone https://github.com/pigworker/CS410-13.git}} 138 | \] 139 | 140 | Step 9. Navigate into the repo. 141 | \[ 142 | \mbox{\texttt{cd CS410-13}} 143 | \] 144 | 145 | Step 10. Start an emacs session involving an Agda file, e.g., by the command: 146 | \[ 147 | \mbox{\texttt{emacs Hello.agda \&}} 148 | \] 149 | The file should appear highlighted, and the mode line should say that the buffer is in 150 | Agda mode. In at least one case, this has proven problematic. To check what is going 151 | on, load the configuration file \texttt{\~{}/.emacs} and find the LISP command which 152 | refers to \texttt{agda-mode locate}. Try executing that command: select it with the 153 | mouse, then type ESC x, which should get you a prompt at which you can type 154 | \texttt{eval-region}, which will execute the selected command. If you get a message 155 | about not being able to find \texttt{agda-mode}, then edit the LISP command to give 156 | \texttt{agda-mode} the full path returned by asking \texttt{which agda-mode} in a shell. 157 | And if you get a bad response to \texttt{which agda-mode}, go back to step 2. 158 | 159 | Step 11. When you're done, please confirm by posting a message on the class discussion 160 | forum. 161 | 162 | 163 | \section{Making These Notes} 164 | 165 | The sources for these notes are included in the repo along with 166 | everything else. They're built using the excellent \texttt{lhs2TeX} 167 | tool, developed by Andres L\"oh and Ralf Hinze. This, also, can be 168 | summoned via the Haskell package manager. 169 | \[ 170 | \mbox{\texttt{cabal install lhs2tex}} 171 | \] 172 | With that done, the default action of \texttt{make} is to build 173 | these notes as \texttt{CS410.pdf}. 174 | 175 | 176 | \section{What's in \texttt{Hello.agda}?} 177 | 178 | It starts with a \texttt{module} declaration, which should and does 179 | match the filename. 180 | 181 | \begin{verbatim} 182 | module Hello where 183 | \end{verbatim} 184 | 185 | Then, as in Haskell, we have comments-to-end-of-line, as signalled by 186 | \texttt{ --~} with a space. 187 | 188 | \begin{verbatim} 189 | -- Oh, you made it! Well done! This line is a comment. 190 | 191 | -- In the beginning, Agda knows nothing, but we can teach it about numbers. 192 | \end{verbatim} 193 | 194 | Indeed, this module has not \texttt{import}ed any others, and unlike in 195 | Haskell, there is no implicit `Prelude', so at this stage, the only thing 196 | we have is the notion of a \texttt{Set}. The following \texttt{data} 197 | declaration creates three new things---a new \texttt{Set}, populated 198 | with just the values generated by its constructors. 199 | 200 | \begin{verbatim} 201 | data Nat : Set where 202 | zero : Nat 203 | suc : Nat -> Nat 204 | \end{verbatim} 205 | 206 | We see some key differences with Haskell. Firstly, \emph{one} colon 207 | means `has type', rather than `list cons'. Secondly, rather than 208 | writing `templates' for data, we just state directly the types of the 209 | constructors. Thirdly, there's a lot of space: Agda has very simple 210 | rules for splitting text into tokens, so space is often necessary, 211 | e.g., around \texttt{:} or \texttt{ ->}. It is my habit to use even 212 | more space than is necessary for disambiguation, because I like to 213 | keep things in alignment. 214 | 215 | Speaking of alignment, we do have the similarity with Haskell that 216 | indentation after \texttt{where} indicates subordination, showing that 217 | the declarations of the \texttt{zero} and \texttt{suc} value 218 | constructors belong to the declaration of the \texttt{Nat} type 219 | constructor. 220 | 221 | Another difference is that I have chosen to begin the names of 222 | \texttt{zero} and \texttt{suc} in \emph{lower} case. Agda enforces no 223 | typographical convention to distinguish constructors from other things, 224 | so we can choose whatever names we like. It is conventional in Agda to 225 | name data-like things in lower case and type-like things in upper case. 226 | Crucially, \texttt{zero}, \texttt{suc}, \texttt{Nat} and \texttt{Set} 227 | all live in the \emph{same} namespace. The distinction between different 228 | kinds of things is achieved by referring back to their declaration, which 229 | is the basis for the colour scheme in the emacs interface. 230 | 231 | The declaration of \texttt{Nat} tells us exactly which values the new set 232 | has. When we declare a function, we create new \emph{expressions} in a 233 | type, but \emph{no new values}. Rather, we explain which value should 234 | be returned for every possible combination of inputs. 235 | 236 | \begin{verbatim} 237 | -- Now we can say how to add numbers. 238 | 239 | _+_ : Nat -> Nat -> Nat 240 | zero + n = n 241 | suc m + n = suc (m + n) 242 | \end{verbatim} 243 | 244 | What's in a name? When a name includes \emph{underscores}, they stand 245 | for places you can put arguments in an application. The unspaced 246 | \texttt{\_+\_} is the name of the function, and can be used as an 247 | ordinary identifier in prefix notation, e.g. \texttt{\_+\_ m n} for 248 | \texttt{m + n}. When we use \texttt{+} as an infix operator (with 249 | arguments in the places suggested by the underscores), the spaces 250 | around it are necessary. If we wrote \texttt{m+n} by accident, we would 251 | find that it is treated as a whole other symbol. 252 | 253 | Meanwhile, because there are no values in \texttt{Nat} other than 254 | those built by \texttt{zero} and \texttt{suc}, we can be sure that 255 | the definition of \texttt{+} covers all the possibilities for the 256 | inputs. Moreover, or rather, lessunder, the recursive call in the 257 | \texttt{suc} case has as its first argument a smaller number than 258 | in the pattern on the left hand side, so the recursive call is 259 | strictly simpler. Assuming (rightly, in Agda), that \emph{values} 260 | are not recursive structures, we must eventually reach \texttt{zero}, 261 | so that every addition of values is bound to yield a value. 262 | 263 | \begin{verbatim} 264 | -- Now we can try adding some numbers. 265 | 266 | four : Nat 267 | four = (suc (suc zero)) + (suc (suc zero)) 268 | 269 | -- To make it go, select "Evaluate term to normal form" from the 270 | -- Agda menu, then type "four", without the quotes, and press return. 271 | 272 | -- Hopefully, you should get a response 273 | -- suc (suc (suc (suc zero))) 274 | \end{verbatim} 275 | 276 | Evaluation shows us that although we have enriched our expression 277 | language with things like $2+2$, the values in \texttt{Nat} are exactly 278 | what we said they were: there are no new numbers, no error cases, no 279 | `undefined's, no recursive black holes, just the values we declared. 280 | 281 | That is to say, Agda is a language of \emph{total} programs. You can 282 | approach it on the basis that things mean what they say, and---unusually 283 | for programming languages---you will usually be right. 284 | 285 | 286 | \section{Where are we going?} 287 | 288 | Agda is a language honest, expressive and precise. We shall use it to 289 | explore and model fundamental concepts in computation, working from 290 | concrete examples to the general structures that show up time and time 291 | again. We'll look at examples like parsers, interpreters, editors, and 292 | servers. We'll implement algorithms like arithmetic, sorting, search 293 | and unification. We'll see structures like monoids, functors, algebras 294 | and monads. The purpose is not just to teach a new language for 295 | instructing computers to do things, but to equip you with a deeper 296 | perception of structure and the articulacy to exploit that structure. 297 | 298 | Agda is a dependently typed language, meaning that types can mention 299 | values and thus describe their intended properties directly. If we are 300 | to be honest and ensure that we mean what we say, we had better be 301 | able to say more precisely what we do mean. This is not intended to be 302 | a course in dependently typed programming, although precision is 303 | habit-forming, so a certain amount of the serious business is 304 | inevitable. We'll also be in a position to state and prove that the 305 | programs we write are in various ways sensible. What would it take to 306 | convince you that the \texttt{+} operator we constructed above really 307 | does addition? 308 | 309 | I'm using Agda rather than Haskell for four reasons, two selfish, two 310 | less so. 311 | \begin{itemize} 312 | \item I am curious to see what happens. 313 | \item Using Agda brings my teaching a lot closer to my research and 314 | obliges me to generate introductory material which will help 315 | make this area more accessible. (The benefit for you is that I have 316 | lots of motivation to write thorough notes.) 317 | \item Agda's honesty will help us see things as they really are: we cannot 318 | push trouble under the rug without saying what sort of rug it is. 319 | Other languages are much more casual about run time failure or other 320 | forms of external interaction. 321 | \item Agda's editing environment gives strong and useful feedback during 322 | the programming process, encouraging a type-centred method of development, 323 | hopefully providing the cues to build good mental models of data and 324 | computation. We do write programs with computers: we don't just type 325 | them in. 326 | \end{itemize} 327 | -------------------------------------------------------------------------------- /Lec10.agda: -------------------------------------------------------------------------------- 1 | module Lec10 where 2 | 3 | open import BasicPrelude 4 | 5 | record Functor (F : Set{-type of elements-} -> Set{-type of structures-}) 6 | : Set1 where 7 | field 8 | 9 | map : {S T : Set} -> (S -> T) {- operation on elements-} 10 | -> F S -> F T {- operation on structures -} 11 | 12 | mapI : {X : Set}(xs : F X) -> map id xs == xs 13 | mapC : {R S T : Set}(f : S -> T)(g : R -> S)(xs : F R) -> 14 | map f (map g xs) == map (f o g) xs 15 | 16 | open Functor public 17 | 18 | ListFunctor : Functor List 19 | ListFunctor = record { map = mapList; mapI = mapIList; mapC = mapCList } where 20 | 21 | mapList : {S T : Set} -> (S -> T) -> List S -> List T 22 | mapList f [] = [] 23 | mapList f (x :> xs) = f x :> mapList f xs 24 | 25 | mapIList : {X : Set} (xs : List X) -> mapList id xs == xs 26 | mapIList [] = refl 27 | mapIList (x :> xs) rewrite mapIList xs = refl 28 | 29 | mapCList : {R S T : Set} (f : S -> T) (g : R -> S) (xs : List R) -> 30 | mapList f (mapList g xs) == mapList (f o g) xs 31 | mapCList f g [] = refl 32 | mapCList f g (x :> xs) rewrite mapCList f g xs = refl 33 | 34 | Label : Set -> (Set -> Set) -- no elements 35 | Label A X = A 36 | 37 | LabelFunctor : (A : Set) -> Functor (Label A) 38 | LabelFunctor A = record 39 | { map = \ _ a -> a; mapI = \ _ -> refl; mapC = \ _ _ _ -> refl } 40 | 41 | Id : Set -> Set -- one element 42 | Id X = X 43 | 44 | IdFunctor : Functor Id 45 | IdFunctor = record { 46 | map = id; 47 | mapI = \ _ -> refl; 48 | mapC = \ _ _ _ -> refl } 49 | 50 | PairFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 51 | Functor \ X -> F X /*/ G X 52 | PairFunctor {F}{G} FunF FunG = record { map = mapP ; mapI = mapPI ; mapC = mapPC } 53 | where 54 | mapP : {S T : Set} -> (S -> T) -> (F S /*/ G S) -> (F T /*/ G T) 55 | mapP f (xF , xG) = map FunF f xF , map FunG f xG 56 | mapPI : forall {X : Set}(xs : F X /*/ G X) -> mapP id xs == xs 57 | mapPI (xF , xG) rewrite mapI FunF xF | mapI FunG xG = refl 58 | mapPC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /*/ G R) -> 59 | mapP f (mapP g xs) == mapP (f o g) xs 60 | mapPC f g (xF , xG) rewrite mapC FunF f g xF | mapC FunG f g xG = refl 61 | 62 | SumFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 63 | Functor \ X -> F X /+/ G X 64 | SumFunctor {F}{G} FunF FunG = record { map = mapS ; mapI = mapSI; mapC = mapSC } 65 | where 66 | mapS : {S T : Set} -> (S -> T) -> (F S /+/ G S) -> (F T /+/ G T) 67 | mapS f (inl xF) = inl (map FunF f xF) 68 | mapS f (inr xG) = inr (map FunG f xG) 69 | mapSI : {X : Set} (xs : F X /+/ G X) -> mapS id xs == xs 70 | mapSI (inl xF) rewrite mapI FunF xF = refl 71 | mapSI (inr xG) rewrite mapI FunG xG = refl 72 | mapSC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /+/ G R) -> 73 | mapS f (mapS g xs) == mapS (f o g) xs 74 | mapSC f g (inl xF) rewrite mapC FunF f g xF = refl 75 | mapSC f g (inr xG) rewrite mapC FunG f g xG = refl 76 | 77 | data Kit : Set1 where 78 | labelK : Set -> Kit 79 | idK : Kit 80 | _*K_ : Kit -> Kit -> Kit 81 | _+K_ : Kit -> Kit -> Kit 82 | 83 | infixr 4 _+K_ 84 | infixr 5 _*K_ 85 | 86 | Fun : Kit -> Set -> Set 87 | Fun (labelK A) X = Label A X 88 | Fun idK X = Id X 89 | Fun (f *K g) X = Fun f X /*/ Fun g X 90 | Fun (f +K g) X = Fun f X /+/ Fun g X 91 | 92 | FunFunctor : (f : Kit) -> Functor (Fun f) 93 | FunFunctor (labelK A) = LabelFunctor A 94 | FunFunctor idK = IdFunctor 95 | FunFunctor (f *K g) = PairFunctor (FunFunctor f) (FunFunctor g) 96 | FunFunctor (f +K g) = SumFunctor (FunFunctor f) (FunFunctor g) 97 | 98 | data DATA (f : Kit) : Set where 99 | [_] : Fun f (DATA f) -> DATA f 100 | 101 | mysteryf : Kit 102 | mysteryf = (labelK One) +K idK 103 | 104 | MYSTERY : Set 105 | MYSTERY = DATA mysteryf 106 | 107 | {- -- ask Agsy to try making some elements of the MYSTERY type 108 | mystery : MYSTERY 109 | mystery = {!-l!} -- do [C-c C-a] with -l in the braces 110 | -} 111 | 112 | -- Aha! It's a copy of the natural numbers! 113 | 114 | zeroM : MYSTERY 115 | zeroM = [ inl <> ] 116 | 117 | sucM : MYSTERY -> MYSTERY 118 | sucM n = [ inr n ] 119 | 120 | -- Now how about this... 121 | 122 | treef : Set -> Kit 123 | treef X = labelK One +K idK *K labelK X *K idK 124 | 125 | pattern leaf = [ inl <> ] 126 | pattern node l x r = [ inr (l , x , r) ] 127 | 128 | flatten : {X : Set} -> DATA (treef X) -> List X 129 | flatten leaf = [] 130 | flatten (node l x r) = flatten l ++ x :> flatten r 131 | 132 | insert : Nat -> DATA (treef Nat) -> DATA (treef Nat) 133 | insert n leaf = node leaf n leaf 134 | insert n (node l x r) with n <= x 135 | insert n (node l x r) | tt = node (insert n l) x r 136 | insert n (node l x r) | ff = node l x (insert n r) 137 | 138 | StuffINeed : Kit -> Set 139 | StuffINeed (labelK A) = A -> A -> Two 140 | StuffINeed idK = One 141 | StuffINeed (f *K g) = StuffINeed f /*/ StuffINeed g 142 | StuffINeed (f +K g) = StuffINeed f /*/ StuffINeed g 143 | 144 | kitEq : {f : Kit} -> StuffINeed f -> DATA f -> DATA f -> Two 145 | 146 | nodeEq : (r : Kit) -> StuffINeed r -> (f : Kit) -> StuffINeed f -> 147 | Fun f (DATA r) -> Fun f (DATA r) -> Two 148 | nodeEq r sr (labelK A) s a a' = s a a' 149 | nodeEq r sr idK s x y = kitEq sr x y 150 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) 151 | with nodeEq r sr f sf xf yf | nodeEq r sr g sg xg yg 152 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | tt | tt = tt 153 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | qf | qg = ff 154 | nodeEq r sr (f +K g) s (inl xf) (inl yf) = nodeEq r sr f (outl s) xf yf 155 | nodeEq r sr (f +K g) s (inl xf) (inr yg) = ff 156 | nodeEq r sr (f +K g) s (inr xg) (inl yf) = ff 157 | nodeEq r sr (f +K g) s (inr xg) (inr yg) = nodeEq r sr g (outr s) xg yg 158 | 159 | kitEq {f} s [ x ] [ y ] = nodeEq f s f s x y 160 | 161 | myGo : Two 162 | myGo = kitEq ((\ _ _ -> tt) , _) (sucM (sucM (sucM zeroM))) (sucM (sucM (sucM zeroM))) -------------------------------------------------------------------------------- /Lec11.agda: -------------------------------------------------------------------------------- 1 | module Lec11 where 2 | 3 | open import BasicPrelude 4 | 5 | record Functor (F : Set{-type of elements-} -> Set{-type of structures-}) 6 | : Set1 where 7 | field 8 | 9 | map : {S T : Set} -> (S -> T) {- operation on elements-} 10 | -> F S -> F T {- operation on structures -} 11 | 12 | mapI : {X : Set}(xs : F X) -> map id xs == xs 13 | mapC : {R S T : Set}(f : S -> T)(g : R -> S)(xs : F R) -> 14 | map f (map g xs) == map (f o g) xs 15 | 16 | open Functor public 17 | 18 | ListFunctor : Functor List 19 | ListFunctor = record { map = mapList; mapI = mapIList; mapC = mapCList } where 20 | 21 | mapList : {S T : Set} -> (S -> T) -> List S -> List T 22 | mapList f [] = [] 23 | mapList f (x :> xs) = f x :> mapList f xs 24 | 25 | mapIList : {X : Set} (xs : List X) -> mapList id xs == xs 26 | mapIList [] = refl 27 | mapIList (x :> xs) rewrite mapIList xs = refl 28 | 29 | mapCList : {R S T : Set} (f : S -> T) (g : R -> S) (xs : List R) -> 30 | mapList f (mapList g xs) == mapList (f o g) xs 31 | mapCList f g [] = refl 32 | mapCList f g (x :> xs) rewrite mapCList f g xs = refl 33 | 34 | Label : Set -> (Set -> Set) -- no elements 35 | Label A X = A 36 | 37 | LabelFunctor : (A : Set) -> Functor (Label A) 38 | LabelFunctor A = record 39 | { map = \ _ a -> a; mapI = \ _ -> refl; mapC = \ _ _ _ -> refl } 40 | 41 | Id : Set -> Set -- one element 42 | Id X = X 43 | 44 | IdFunctor : Functor Id 45 | IdFunctor = record { 46 | map = id; 47 | mapI = \ _ -> refl; 48 | mapC = \ _ _ _ -> refl } 49 | 50 | PairFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 51 | Functor \ X -> F X /*/ G X 52 | PairFunctor {F}{G} FunF FunG = record { map = mapP ; mapI = mapPI ; mapC = mapPC } 53 | where 54 | mapP : {S T : Set} -> (S -> T) -> (F S /*/ G S) -> (F T /*/ G T) 55 | mapP f (xF , xG) = map FunF f xF , map FunG f xG 56 | mapPI : forall {X : Set}(xs : F X /*/ G X) -> mapP id xs == xs 57 | mapPI (xF , xG) rewrite mapI FunF xF | mapI FunG xG = refl 58 | mapPC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /*/ G R) -> 59 | mapP f (mapP g xs) == mapP (f o g) xs 60 | mapPC f g (xF , xG) rewrite mapC FunF f g xF | mapC FunG f g xG = refl 61 | 62 | SumFunctor : {F G : Set -> Set} -> Functor F -> Functor G -> 63 | Functor \ X -> F X /+/ G X 64 | SumFunctor {F}{G} FunF FunG = record { map = mapS ; mapI = mapSI; mapC = mapSC } 65 | where 66 | mapS : {S T : Set} -> (S -> T) -> (F S /+/ G S) -> (F T /+/ G T) 67 | mapS f (inl xF) = inl (map FunF f xF) 68 | mapS f (inr xG) = inr (map FunG f xG) 69 | mapSI : {X : Set} (xs : F X /+/ G X) -> mapS id xs == xs 70 | mapSI (inl xF) rewrite mapI FunF xF = refl 71 | mapSI (inr xG) rewrite mapI FunG xG = refl 72 | mapSC : {R S T : Set} (f : S -> T) (g : R -> S) (xs : F R /+/ G R) -> 73 | mapS f (mapS g xs) == mapS (f o g) xs 74 | mapSC f g (inl xF) rewrite mapC FunF f g xF = refl 75 | mapSC f g (inr xG) rewrite mapC FunG f g xG = refl 76 | 77 | data Kit : Set1 where 78 | zeroK oneK : Kit 79 | idK : Kit 80 | dataK : Kit -> Kit 81 | _*K_ : Kit -> Kit -> Kit 82 | _+K_ : Kit -> Kit -> Kit 83 | 84 | infixr 4 _+K_ 85 | infixr 5 _*K_ 86 | 87 | Fun : Kit -> Set -> Set 88 | 89 | data DATA (f : Kit) : Set where 90 | [_] : Fun f (DATA f) -> DATA f 91 | 92 | Fun zeroK X = Zero 93 | Fun oneK X = One 94 | Fun idK X = Id X 95 | Fun (dataK f) X = DATA f 96 | Fun (f *K g) X = Fun f X /*/ Fun g X 97 | Fun (f +K g) X = Fun f X /+/ Fun g X 98 | 99 | FunFunctor : (f : Kit) -> Functor (Fun f) 100 | FunFunctor zeroK = LabelFunctor Zero 101 | FunFunctor oneK = LabelFunctor One 102 | FunFunctor (dataK f) = LabelFunctor (DATA f) 103 | FunFunctor idK = IdFunctor 104 | FunFunctor (f *K g) = PairFunctor (FunFunctor f) (FunFunctor g) 105 | FunFunctor (f +K g) = SumFunctor (FunFunctor f) (FunFunctor g) 106 | 107 | twoK : Kit 108 | twoK = oneK +K oneK 109 | 110 | pattern true = [ inl <> ] 111 | pattern false = [ inr <> ] 112 | 113 | natK : Kit 114 | natK = oneK +K idK 115 | 116 | pattern ze = [ inl <> ] 117 | pattern su n = [ inr n ] 118 | 119 | listK : Kit -> Kit 120 | listK f = oneK +K (dataK f *K idK) 121 | 122 | pattern nil = [ inl <> ] 123 | pattern cons x xs = [ inr (x , xs) ] 124 | 125 | treeK : Kit -> Kit 126 | treeK f = oneK +K (idK *K dataK f *K idK) 127 | 128 | pattern leaf = [ inl <> ] 129 | pattern node l x r = [ inr (l , x , r) ] 130 | 131 | leK : DATA natK -> DATA natK -> DATA twoK 132 | leK ze n = true 133 | leK (su m) ze = false 134 | leK (su m) (su n) = leK m n 135 | 136 | 137 | {- 138 | 139 | noLabels : (f : Kit) -> DATA f -> Zero 140 | 141 | noLabels' : (r f : Kit) -> Fun f (DATA r) -> Zero 142 | noLabels' r idK x = noLabels r x 143 | noLabels' r (f *K g) (xf , xg) = noLabels' r f xf 144 | noLabels' r (f +K g) (inl x) = noLabels' r f x 145 | noLabels' r (f +K g) (inr x) = noLabels' r g x 146 | 147 | noLabels f [ x ] = noLabels' f f x 148 | -} 149 | 150 | {- 151 | mysteryf : Kit 152 | mysteryf = (labelK One) +K idK 153 | 154 | MYSTERY : Set 155 | MYSTERY = DATA mysteryf 156 | 157 | {- -- ask Agsy to try making some elements of the MYSTERY type 158 | mystery : MYSTERY 159 | mystery = {!-l!} -- do [C-c C-a] with -l in the braces 160 | -} 161 | 162 | -- Aha! It's a copy of the natural numbers! 163 | 164 | zeroM : MYSTERY 165 | zeroM = [ inl <> ] 166 | 167 | sucM : MYSTERY -> MYSTERY 168 | sucM n = [ inr n ] 169 | 170 | -- Now how about this... 171 | 172 | treef : Set -> Kit 173 | treef X = labelK One +K idK *K labelK X *K idK 174 | 175 | pattern leaf = [ inl <> ] 176 | pattern node l x r = [ inr (l , x , r) ] 177 | 178 | flatten : {X : Set} -> DATA (treef X) -> List X 179 | flatten leaf = [] 180 | flatten (node l x r) = flatten l ++ x :> flatten r 181 | 182 | insert : Nat -> DATA (treef Nat) -> DATA (treef Nat) 183 | insert n leaf = node leaf n leaf 184 | insert n (node l x r) with n <= x 185 | insert n (node l x r) | tt = node (insert n l) x r 186 | insert n (node l x r) | ff = node l x (insert n r) 187 | 188 | StuffINeed : Kit -> Set 189 | StuffINeed (labelK A) = A -> A -> Two 190 | StuffINeed idK = One 191 | StuffINeed (f *K g) = StuffINeed f /*/ StuffINeed g 192 | StuffINeed (f +K g) = StuffINeed f /*/ StuffINeed g 193 | -} 194 | 195 | kitEq : {f : Kit} -> DATA f -> DATA f -> DATA twoK 196 | 197 | nodeEq : (r f : Kit) -> Fun f (DATA r) -> Fun f (DATA r) -> DATA twoK 198 | nodeEq r zeroK () y 199 | nodeEq r oneK <> <> = true 200 | nodeEq r idK x y = kitEq x y -- here's where r is used 201 | nodeEq r (dataK f) x y = kitEq x y 202 | nodeEq r (f *K g) (xf , xg) (yf , yg) with nodeEq r f xf yf | nodeEq r g xg yg 203 | nodeEq r (f *K g) (xf , xg) (yf , yg) | true | true = true 204 | nodeEq r (f *K g) (xf , xg) (yf , yg) | qf | qg = false 205 | nodeEq r (f +K g) (inl x) (inl y) = nodeEq r f x y 206 | nodeEq r (f +K g) (inl x) (inr y) = false 207 | nodeEq r (f +K g) (inr x) (inl y) = false 208 | nodeEq r (f +K g) (inr x) (inr y) = nodeEq r g x y 209 | 210 | kitEq {f} [ x ] [ y ] = nodeEq f f x y 211 | 212 | delOne : Kit -> Kit 213 | delOne zeroK = zeroK 214 | delOne oneK = zeroK 215 | delOne idK = oneK 216 | delOne (dataK f) = zeroK 217 | delOne (f *K g) = delOne f *K g +K f *K delOne g 218 | delOne (f +K g) = delOne f +K delOne g 219 | 220 | 221 | {- 222 | nodeEq r sr (labelK A) s a a' = s a a' 223 | nodeEq r sr idK s x y = kitEq sr x y 224 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) 225 | with nodeEq r sr f sf xf yf | nodeEq r sr g sg xg yg 226 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | tt | tt = tt 227 | nodeEq r sr (f *K g) (sf , sg) (xf , xg) (yf , yg) | qf | qg = ff 228 | nodeEq r sr (f +K g) s (inl xf) (inl yf) = nodeEq r sr f (outl s) xf yf 229 | nodeEq r sr (f +K g) s (inl xf) (inr yg) = ff 230 | nodeEq r sr (f +K g) s (inr xg) (inl yf) = ff 231 | nodeEq r sr (f +K g) s (inr xg) (inr yg) = nodeEq r sr g (outr s) xg yg 232 | 233 | kitEq {f} s [ x ] [ y ] = nodeEq f s f s x y 234 | 235 | myGo : Two 236 | myGo = kitEq ((\ _ _ -> tt) , _) (sucM (sucM (sucM zeroM))) (sucM (sucM (sucM zeroM))) 237 | -} -------------------------------------------------------------------------------- /Lec2.agda: -------------------------------------------------------------------------------- 1 | module Lec2 where 2 | 3 | -- Oh, you made it! Well done! This line is a comment. 4 | 5 | -- In the beginning, Agda knows nothing, but we can teach it about numbers. 6 | 7 | data Nat : Set where 8 | zero : Nat 9 | suc : Nat -> Nat 10 | 11 | {-# BUILTIN NATURAL Nat #-} 12 | {-# BUILTIN ZERO zero #-} 13 | {-# BUILTIN SUC suc #-} 14 | 15 | -- Now we can say how to add numbers. 16 | 17 | _+_ : Nat -> Nat -> Nat 18 | zero + n = n 19 | suc m + n = suc (m + n) 20 | 21 | -- Now we can try adding some numbers. 22 | 23 | four : Nat 24 | four = (suc (suc zero)) + (suc (suc zero)) 25 | 26 | -- To make it go, select "Evaluate term to normal form" from the 27 | -- Agda menu, then type "four", without the quotes, and press return. 28 | 29 | -- Hopefully, you should get a response 30 | -- suc (suc (suc (suc zero))) 31 | 32 | data Zero : Set where 33 | 34 | magic : {X : Set} -> Zero -> X 35 | magic () 36 | 37 | record One : Set where 38 | constructor <> 39 | 40 | it : One 41 | it = _ 42 | 43 | data Two : Set where 44 | tt ff : Two 45 | 46 | _<=_ : Nat -> Nat -> Two 47 | zero <= y = tt 48 | suc x <= zero = ff 49 | suc x <= suc y = x <= y 50 | 51 | data List (X : Set) : Set where 52 | [] : List X 53 | _:>_ : X -> List X -> List X 54 | 55 | infixr 3 _:>_ 56 | 57 | data _==_ {X : Set}(x : X) : X -> Set where 58 | refl : x == x 59 | 60 | insertionSort : List Nat -> List Nat 61 | 62 | insertList : Nat -> List Nat -> List Nat 63 | 64 | insertionSort [] = [] 65 | insertionSort (x :> xs) = insertList x (insertionSort xs) 66 | 67 | insertList y [] = y :> [] 68 | insertList y (x :> xs) with y <= x 69 | insertList y (x :> xs) | tt = y :> x :> xs 70 | insertList y (x :> xs) | ff = x :> insertList y xs 71 | 72 | test : insertionSort (5 :> 3 :> 1 :> 4 :> 2 :> []) == 73 | (1 :> 2 :> 3 :> 4 :> 5 :> []) 74 | test = refl 75 | -------------------------------------------------------------------------------- /Lec3.agda: -------------------------------------------------------------------------------- 1 | module Lec3 where 2 | 3 | open import Lec2 4 | 5 | id : {X : Set} -> X -> X 6 | id x = x 7 | 8 | _o_ : {A B C : Set} -> (B -> C) -> (A -> B) -> (A -> C) 9 | (f o g) a = f (g a) 10 | 11 | one : {Y : Set} -> Y -> List Y 12 | one y = y :> [] 13 | 14 | _++_ : {Y : Set} -> List Y -> List Y -> List Y; {- off to the right, ha ha -} [] ++ ys = ys;(y :> ys) ++ xs = y :> (ys ++ xs) 15 | 16 | slowRev : {Y : Set} -> List Y -> List Y 17 | slowRev [] = [] 18 | slowRev (y :> ys) = slowRev ys ++ one y 19 | 20 | test' : List Nat 21 | test' = slowRev (1 :> 2 :> 3 :> 4 :> []) 22 | 23 | -- consider representing lists by functions which 24 | -- prefix them 25 | 26 | Hughes : Set -> Set 27 | Hughes Y = List Y -> List Y 28 | 29 | hughes2List : {Y : Set} -> Hughes Y -> List Y 30 | hughes2List f = f [] 31 | 32 | h[] : {Y : Set} -> Hughes Y 33 | h[] = id 34 | 35 | hone : {Y : Set} -> Y -> Hughes Y 36 | hone = _:>_ 37 | 38 | _h++_ : {Y : Set} -> Hughes Y -> Hughes Y -> Hughes Y 39 | _h++_ = _o_ 40 | 41 | fastRevH : {Y : Set} -> List Y -> Hughes Y 42 | fastRevH [] = h[] 43 | fastRevH (y :> ys) = fastRevH ys h++ hone y 44 | 45 | htest' : Hughes Nat 46 | htest' = fastRevH (1 :> 2 :> 3 :> []) 47 | 48 | fastRevH' : {Y : Set} -> List Y -> List Y -> List Y 49 | fastRevH' [] ys = ys 50 | fastRevH' (x :> xs) ys = fastRevH' xs (x :> ys) 51 | 52 | fastRev : {Y : Set} -> List Y -> List Y 53 | fastRev = hughes2List o fastRevH 54 | 55 | 56 | 57 | data _/+/_ (S T : Set) : Set where 58 | inl : S -> S /+/ T 59 | inr : T -> S /+/ T 60 | 61 | __ : {S T R : Set} -> 62 | (S -> R) -> 63 | (T -> R) -> 64 | (S /+/ T -> R) 65 | (f g) (inl x) = f x 66 | (f g) (inr x) = g x 67 | 68 | record _/*/_ (S T : Set) : Set where 69 | constructor _,_ 70 | field 71 | outl : S 72 | outr : T 73 | open _/*/_ public 74 | infixr 4 _,_ 75 | 76 | uncurry : {S T R : Set} -> 77 | (S -> T -> R) -> 78 | (S /*/ T -> R) 79 | uncurry f (s , t) = f s t 80 | 81 | fact : {A B C : Set} -> A /+/ (B /*/ C) -> (A /+/ B) /*/ (A /+/ C) 82 | fact (inl x) = (inl x) , (inl x) 83 | fact (inr x) = inr (outl x) , inr (outr x) 84 | 85 | exmid : {X : Set} -> X /+/ (X -> Zero) 86 | exmid = {!!} 87 | 88 | -------------------------------------------------------------------------------- /Lec4.agda: -------------------------------------------------------------------------------- 1 | module Lec4 where 2 | 3 | open import BasicPrelude 4 | 5 | Val : Set 6 | Val = Nat /+/ Two 7 | 8 | data Expr : Set where 9 | val : Val -> Expr 10 | plus : Expr -> Expr -> Expr 11 | le : Expr -> Expr -> Expr 12 | ifThenElse : Expr -> Expr -> Expr -> Expr 13 | 14 | Dodgy : Set -> Set 15 | Dodgy V = One /+/ V 16 | 17 | nat : Val -> Dodgy Nat 18 | nat (inl x) = inr x 19 | nat _ = inl <> 20 | 21 | two : Val -> Dodgy Two 22 | two (inl x) = inl <> 23 | two (inr x) = inr x 24 | 25 | try : {A B : Set} -> Dodgy A -> (A -> Dodgy B) -> Dodgy B 26 | try (inl <>) f = inl <> 27 | try (inr a) f = f a 28 | 29 | win : {A : Set} -> A -> Dodgy A 30 | win = inr 31 | 32 | eval : Expr -> Dodgy Val 33 | eval (val x) = inr x 34 | eval (plus e1 e2) = 35 | try (eval e1) \ v1 -> 36 | try (nat v1) \ n1 -> 37 | try (eval e2) \ v2 -> 38 | try (nat v2) \ n2 -> 39 | win (inl (n1 + n2)) 40 | eval (le e e₁) = {!!} 41 | eval (ifThenElse ec et ef) with eval ec 42 | eval (ifThenElse ec et ef) | inr (inr tt) = eval et 43 | eval (ifThenElse ec et ef) | inr (inr ff) = eval ef 44 | eval (ifThenElse ec et ef) | _ = inl <> 45 | -------------------------------------------------------------------------------- /Lec5.lagda: -------------------------------------------------------------------------------- 1 | \section{An evaluator for well-typed programs (done by reflecting 2 | boolean predicates)} 3 | 4 | In the previous lecture we saw how adding booleans and conditionals to 5 | Hutton's razor caused run-time errors, because things like adding a 6 | boolean to a natural number doesn't really make sense. 7 | 8 | In this lecture we will show a way to avoid these run-time errors. 9 | 10 | The way we will do it, this time around, is to introduce types, a 11 | typechecker (that takes an expression and a type and returns a boolean 12 | value indicating whether the expression was of that type or not), and 13 | then give an evaluator that given an expression, a type and a proof that 14 | expression is of that type indeed returns something of that type -- 15 | i.e. well-typed programs cannot ``go wrong'' (as Robin Milner once 16 | put it)! 17 | 18 | \begin{code} 19 | module Lec5 where 20 | 21 | open import BasicPrelude 22 | 23 | Val : Set 24 | Val = Nat /+/ Two 25 | 26 | data Expr : Set where 27 | val : Val -> Expr 28 | plus : Expr -> Expr -> Expr 29 | le : Expr -> Expr -> Expr 30 | ifThenElse : Expr -> Expr -> Expr -> Expr 31 | 32 | data Type : Set where 33 | NAT TWO : Type 34 | 35 | check : Expr -> Type -> Two 36 | check (val (inl _)) NAT = tt 37 | check (val (inr _)) NAT = ff 38 | check (val (inl _)) TWO = ff 39 | check (val (inr _)) TWO = tt 40 | check (plus e1 e2) NAT = check e1 NAT /\ check e2 NAT 41 | check (plus e1 e2) TWO = ff 42 | check (le e1 e2) NAT = ff 43 | check (le e1 e2) TWO = check e1 NAT /\ check e2 NAT 44 | check (ifThenElse ec et ef) T = if check ec TWO 45 | then check et T /\ check ef T 46 | else ff 47 | 48 | Truth : Two -> Set 49 | Truth tt = One 50 | Truth ff = Zero 51 | 52 | invertAnd : (b1 b2 : Two) -> Truth (b1 /\ b2) -> Truth b1 /*/ Truth b2 53 | invertAnd tt b2 p2 = <> , p2 54 | invertAnd ff b2 pz = magic pz 55 | 56 | invertIf : (b t f : Two) -> Truth (if b then t else f) -> 57 | Truth b /*/ Truth t /+/ Truth f 58 | invertIf tt t f pt = inl (<> , pt) 59 | invertIf ff t f pf = inr pf 60 | 61 | evalType : Type -> Set 62 | evalType NAT = Nat 63 | evalType TWO = Two 64 | 65 | eval : (e : Expr) (T : Type) -> Truth (check e T) -> evalType T 66 | eval (val (inl x)) NAT p = x 67 | eval (val (inl x)) TWO p = magic p 68 | eval (val (inr x)) NAT p = magic p 69 | eval (val (inr x)) TWO p = x 70 | eval (plus e1 e2) NAT p = 71 | let (p1 , p2) = invertAnd (check e1 NAT) (check e2 NAT) p 72 | in eval e1 NAT p1 + eval e2 NAT p2 73 | eval (plus e1 e2) TWO p = magic p 74 | eval (le e1 e2) NAT p = magic p 75 | eval (le e1 e2) TWO p = 76 | let (p1 , p2) = invertAnd (check e1 NAT) (check e2 NAT) p 77 | in eval e1 NAT p1 <= eval e2 NAT p2 78 | eval (ifThenElse ec et ef) T p with invertIf (check ec TWO) _ _ p 79 | ... | inr pef = magic pef 80 | ... | inl (pec , pet) = let (p1 , p2) = invertAnd _ _ pet in 81 | if eval ec TWO pec 82 | then eval et T p1 83 | else eval ef T p2 84 | \end{code} 85 | 86 | \subsection{Some tests} 87 | 88 | \begin{code} 89 | -- 2 + 3 90 | testExpr1 = plus (val (inl 2)) (val (inl 3)) 91 | 92 | -- \ b -> if b then 2 + 3 else 0 93 | testExpr2 : Expr -> Expr 94 | testExpr2 b = ifThenElse b 95 | testExpr1 96 | (val (inl 0)) 97 | 98 | test1 : eval testExpr1 NAT _ == 5 99 | test1 = refl 100 | 101 | test2 : eval (testExpr2 (val (inr tt))) NAT _ == 5 102 | test2 = refl 103 | 104 | test3 : eval (testExpr2 (le (val (inl 2)) (val (inl 1)))) NAT _ == 0 105 | test3 = refl 106 | \end{code} 107 | 108 | \paragraph{Exercise} Write some more tests (try to cover cases not 109 | covered by above tests). 110 | 111 | While we managed to do what we set out to do, i.e. write an evaluator 112 | which takes well-typed expressions and does not ``go wrong'', it is still a 113 | bit messy -- we need to manually discharge the cases where the 114 | typechecker returns false and we also need to invert the proofs in some 115 | of the cases. 116 | 117 | This begs the question: can we do better? -------------------------------------------------------------------------------- /Lec6.agda: -------------------------------------------------------------------------------- 1 | module Lec6 where 2 | 3 | open import BasicPrelude 4 | 5 | Val : Set 6 | Val = Nat /+/ Two 7 | 8 | data Type : Set where 9 | NAT TWO : Type 10 | 11 | EvalType : Type -> Set 12 | EvalType NAT = Nat 13 | EvalType TWO = Two 14 | 15 | data Expr : Type -> Set where 16 | val : {T : Type} -> EvalType T -> Expr T 17 | plus : Expr NAT -> Expr NAT -> Expr NAT 18 | le : Expr NAT -> Expr NAT -> Expr TWO 19 | ifThenElse : {T : Type} -> Expr TWO -> Expr T -> Expr T -> Expr T 20 | 21 | {- 22 | test : Expr NAT 23 | test = ifThenElse (ifThenElse {!!} {!!} {!plus ? ?!}) {!!} {!!} 24 | -} 25 | 26 | eval : {T : Type} -> Expr T -> EvalType T 27 | eval (val x) = x 28 | eval (plus e1 e2) = eval e1 + eval e2 29 | eval (le e1 e2) = eval e1 <= eval e2 30 | eval (ifThenElse ec et ef) with eval ec 31 | eval (ifThenElse ec et ef) | tt = eval et 32 | eval (ifThenElse ec et ef) | ff = eval ef 33 | 34 | 35 | data Raw : Set where 36 | val : Val -> Raw 37 | plus : Raw -> Raw -> Raw 38 | le : Raw -> Raw -> Raw 39 | ifThenElse : Raw -> Raw -> Raw -> Raw 40 | 41 | Maybe : Set -> Set 42 | Maybe V = One /+/ V 43 | 44 | win : {A : Set} -> A -> Maybe A 45 | win = inr 46 | 47 | oops : {A : Set} -> Maybe A 48 | oops = inl <> 49 | 50 | try : {A B : Set} -> Maybe A -> (A -> Maybe B) -> Maybe B 51 | try (inl <>) f = oops 52 | try (inr a) f = f a 53 | 54 | -- here's check, using "with" to look at intermediate results 55 | 56 | check : (T : Type) -> Raw -> Maybe (Expr T) 57 | check NAT (val (inl x)) = win (val x) 58 | check TWO (val (inl x)) = oops 59 | check NAT (val (inr x)) = oops 60 | check TWO (val (inr x)) = win (val x) 61 | check NAT (plus e1 e2) with check NAT e1 | check NAT e2 62 | check NAT (plus e1 e2) | inr e1' | inr e2' = win (plus e1' e2') 63 | check NAT (plus e1 e2) | _ | _ = oops 64 | check TWO (plus e1 e2) = oops 65 | check NAT (le e1 e2) = oops 66 | check TWO (le e1 e2) with check NAT e1 | check NAT e2 67 | check TWO (le e1 e2) | inr e1' | inr e2' = win (le e1' e2') 68 | check TWO (le e1 e2) | _ | _ = oops 69 | check T (ifThenElse ec et ef) with check TWO ec | check T et | check T ef 70 | check T (ifThenElse ec et ef) | inr ec' | inr et' | inr ef' 71 | = inr (ifThenElse ec' et' ef') 72 | check T (ifThenElse ec et ef) | _ | _ | _ = oops 73 | 74 | -- here's the same thing, but in try...win style 75 | 76 | check' : (T : Type) -> Raw -> Maybe (Expr T) 77 | check' NAT (val (inl x)) = win (val x) 78 | check' TWO (val (inl x)) = oops 79 | check' NAT (val (inr x)) = oops 80 | check' TWO (val (inr x)) = win (val x) 81 | check' NAT (plus e1 e2) = 82 | try (check' NAT e1) \ e1' -> 83 | try (check' NAT e2) \ e2' -> 84 | win (plus e1' e2') 85 | check' TWO (plus e1 e2) = oops 86 | check' NAT (le e1 e2) = oops 87 | check' TWO (le e1 e2) = 88 | try (check' NAT e1) \ e1' -> 89 | try (check' NAT e2) \ e2' -> 90 | win (le e1' e2') 91 | check' T (ifThenElse ec et ef) = 92 | try (check' TWO ec) \ ec' -> 93 | try (check' T et) \ et' -> 94 | try (check' T ef) \ ef' -> 95 | win (ifThenElse ec' et' ef') 96 | 97 | -- now here's the fancy version with the tighter spec 98 | 99 | forget : {T : Type} -> Expr T -> Raw 100 | forget (val {NAT} x) = val (inl x) 101 | forget (val {TWO} x) = val (inr x) 102 | forget (plus e1 e2) = plus (forget e1) (forget e2) 103 | forget (le e1 e2) = le (forget e1) (forget e2) 104 | forget (ifThenElse ec et ef) = ifThenElse (forget ec) (forget et) (forget ef) 105 | 106 | -- This is subtly different from what I did in the lecture. 107 | -- In the val case, I have two hidden copies of the type (which are sure to 108 | -- be the same): 1, the hidden argument to "forget", and 2, the hidden argument 109 | -- to val. In the lecture, I wrote 110 | 111 | -- forget : {T : Type} -> Expr T -> Raw 112 | -- forget {NAT} (val x) = val (inl x) 113 | -- forget {TWO} (val x) = val (inr x) 114 | -- forget (plus e1 e2) = plus (forget e1) (forget e2) 115 | -- forget (le e1 e2) = le (forget e1) (forget e2) 116 | -- forget (ifThenElse ec et ef) = ifThenElse (forget ec) (forget et) (forget ef) 117 | 118 | -- which made "forget" pattern match first on the type, then on the expression, 119 | -- with the unfortunate consequence that the "ifThenElse" case does not reduce 120 | -- unless its type matches specifically NAT or specifically TWO: a general T 121 | -- wouldn't do, which ruined the next bit. I fixed it by reordering 122 | 123 | -- forget : {T : Type} -> Expr T -> Raw 124 | -- forget (plus e1 e2) = plus (forget e1) (forget e2) 125 | -- forget (le e1 e2) = le (forget e1) (forget e2) 126 | -- forget (ifThenElse ec et ef) = ifThenElse (forget ec) (forget et) (forget ef) 127 | -- forget {NAT} (val x) = val (inl x) 128 | -- forget {TWO} (val x) = val (inr x) 129 | 130 | -- which means we only look at the type after "ifThenElse" has been dealt with. 131 | -- But it nicer never to look at "forget"'s type argument *at all*, instead looking 132 | -- at "val"'s type argument, because it's only in the val case that we care. 133 | 134 | data Checking (T : Type) : Raw -> Set where 135 | yes : (e : Expr T) -> Checking T (forget e) 136 | no : {r : Raw} -> Checking T r 137 | 138 | -- the idea is that we can only say yes if we can give the typed 139 | -- version *of the raw original*, rather than any old thing with a type 140 | 141 | checking : (T : Type) -> (r : Raw) -> Checking T r 142 | checking NAT (val (inl x)) = yes (val x) 143 | checking TWO (val (inl x)) = no 144 | checking NAT (val (inr x)) = no 145 | checking TWO (val (inr x)) = yes (val _) 146 | checking NAT (plus e1 e2) with checking NAT e1 | checking NAT e2 147 | checking NAT (plus .(forget e1) .(forget e2)) | yes e1 | yes e2 148 | = yes (plus e1 e2) 149 | checking NAT (plus e1 e2) | _ | _ = no 150 | checking TWO (plus e1 e2) = no 151 | checking NAT (le e1 e2) = no 152 | checking TWO (le e1 e2) with checking NAT e1 | checking NAT e2 153 | checking TWO (le .(forget e1) .(forget e2)) | yes e1 | yes e2 = yes (le e1 e2) 154 | checking TWO (le e1 e2) | _ | _ = no 155 | checking T (ifThenElse ec et ef) with checking TWO ec | checking T et | checking T ef 156 | checking T (ifThenElse .(forget ec) .(forget et) .(forget ef)) | yes ec | yes et | yes ef = yes (ifThenElse ec et ef) 157 | checking T (ifThenElse ec et ef) | _ | _ | _ = no 158 | 159 | -- Crucially, in each case... 160 | -- matching on the output of checking both 161 | -- gives us a typed term 162 | -- tells us that the original is given by "forget"ting that typed term 163 | -- when we say "yes", there is only one possible typed term to give! 164 | 165 | -- Note that when we say "yes" in the "ifThenElse" case, we know only that the 166 | -- type is some "T", not which "T". Correspondingly, if "forget" pattern matches on 167 | -- its hidden type argument, that will just be "T", so computation will get stuck. 168 | 169 | -- When expressions show up in types, the way they compute is what determines 170 | -- what things the machine sees as the same. It's sometimes important to think about 171 | -- where pattern matching gets stuck and ask if it's getting stuck needlessly. 172 | 173 | -- Moral: a precise spec sucks you towards the correct program, but sometimes 174 | -- you have to debug the spec (in which case it just sucks). 175 | -------------------------------------------------------------------------------- /Lec7.agda: -------------------------------------------------------------------------------- 1 | module Lec7 where 2 | 3 | open import BasicPrelude 4 | 5 | Val : Set 6 | Val = Nat 7 | 8 | data Expr : Set where 9 | val : Val -> Expr 10 | plus : Expr -> Expr -> Expr 11 | 12 | eval : Expr -> Val 13 | eval (val x) = x 14 | eval (plus e1 e2) = eval e1 + eval e2 15 | 16 | data Vec (X : Set) : Nat -> Set where 17 | [] : Vec X zero 18 | _:>_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n) 19 | 20 | head : {X : Set}{n : Nat} -> Vec X (suc n) -> X 21 | head (x :> xs) = x 22 | 23 | data Code : Nat -> Nat -> Set where 24 | PUSH : {n : Nat} -> Val -> Code n (suc n) 25 | ADD : {n : Nat} -> Code (suc (suc n)) (suc n) 26 | _>>_ : {l m n : Nat} -> Code l m -> Code m n -> Code l n 27 | 28 | infixr 4 _>>_ 29 | 30 | compile : {n : Nat} -> Expr -> Code n (suc n) 31 | compile (val x) = PUSH x 32 | compile (plus e1 e2) = compile e1 >> compile e2 >> ADD 33 | 34 | execute : {m n : Nat} -> Code m n -> Vec Val m -> Vec Val n 35 | execute (PUSH x) vs = x :> vs 36 | execute ADD (y :> (x :> vs)) = (x + y) :> vs 37 | execute (c1 >> c2) vs = execute c2 (execute c1 vs) 38 | 39 | correct : (e : Expr){n : Nat}(xs : Vec Val n) -> 40 | execute (compile e) xs == (eval e :> xs) 41 | correct (val x) xs = refl 42 | correct (plus e1 e2) xs 43 | rewrite correct e1 xs | correct e2 (eval e1 :> xs) = refl -------------------------------------------------------------------------------- /Lec8.agda: -------------------------------------------------------------------------------- 1 | module Lec8 where 2 | 3 | open import BasicPrelude 4 | 5 | Val : Set 6 | Val = Nat /+/ Two 7 | 8 | data Type : Set where 9 | NAT TWO : Type 10 | 11 | EvalType : Type -> Set 12 | EvalType NAT = Nat 13 | EvalType TWO = Two 14 | 15 | data Expr : Type -> Set where 16 | val : {T : Type} -> EvalType T -> Expr T 17 | plus : Expr NAT -> Expr NAT -> Expr NAT 18 | le : Expr NAT -> Expr NAT -> Expr TWO 19 | ifThenElse : {T : Type} -> Expr TWO -> Expr T -> Expr T -> Expr T 20 | 21 | eval : {T : Type} -> Expr T -> EvalType T 22 | eval (val x) = x 23 | eval (plus e1 e2) = eval e1 + eval e2 24 | eval (le e1 e2) = eval e1 <= eval e2 25 | eval (ifThenElse ec et ef) with eval ec 26 | eval (ifThenElse ec et ef) | tt = eval et 27 | eval (ifThenElse ec et ef) | ff = eval ef 28 | 29 | 30 | data Stk : List Type -> Set where 31 | [] : Stk [] 32 | _:>_ : {T : Type}{Ts : List Type} 33 | -> EvalType T -> Stk Ts -> Stk (T :> Ts) 34 | 35 | data Code : List Type -> List Type -> Set where 36 | PUSH : {T : Type}{Ts : List Type} -> EvalType T -> 37 | Code Ts (T :> Ts) 38 | ADD : {Ts : List Type} -> Code (NAT :> NAT :> Ts) (NAT :> Ts) 39 | LE : {Ts : List Type} -> Code (NAT :> NAT :> Ts) (TWO :> Ts) 40 | _>>_ : {Rs Ss Ts : List Type} -> Code Rs Ss -> Code Ss Ts -> Code Rs Ts 41 | BRANCH : {Ss Ts : List Type} -> Code Ss Ts -> Code Ss Ts -> 42 | Code (TWO :> Ss) Ts 43 | 44 | infixr 4 _>>_ 45 | 46 | execute : {Ss Ts : List Type} -> Code Ss Ts -> Stk Ss -> Stk Ts 47 | execute (PUSH x) vs = x :> vs 48 | execute ADD (y :> (x :> vs)) = (x + y) :> vs 49 | execute LE (y :> (x :> vs)) = (x <= y) :> vs 50 | execute (c >> c') vs = execute c' (execute c vs) 51 | execute (BRANCH c c') (tt :> vs) = execute c vs 52 | execute (BRANCH c c') (ff :> vs) = execute c' vs 53 | 54 | compile : {T : Type}{Ts : List Type} -> Expr T -> Code Ts (T :> Ts) 55 | compile (val x) = PUSH x 56 | compile (plus e1 e2) = compile e1 >> compile e2 >> ADD 57 | compile (le e1 e2) = compile e1 >> compile e2 >> LE 58 | compile (ifThenElse ec et ef) 59 | = compile ec >> BRANCH (compile et) (compile ef) 60 | 61 | test : Expr NAT 62 | test = ifThenElse (le (val 5) (val 4)) (val 2) (plus (val 7) (val 9)) 63 | 64 | 65 | correct : {T : Type}(e : Expr T){Ts : List Type} 66 | (xs : Stk Ts) -> 67 | execute (compile e) xs == (eval e :> xs) 68 | correct (val x) xs = refl 69 | correct (plus e1 e2) xs 70 | rewrite correct e1 xs | correct e2 (eval e1 :> xs)= refl 71 | correct (le e1 e2) xs 72 | rewrite correct e1 xs | correct e2 (eval e1 :> xs)= refl 73 | correct (ifThenElse ec et ef) xs 74 | rewrite correct ec xs with eval ec 75 | correct (ifThenElse ec et ef) xs | tt = correct et xs 76 | correct (ifThenElse ec et ef) xs | ff = correct ef xs 77 | -------------------------------------------------------------------------------- /Lec9.agda: -------------------------------------------------------------------------------- 1 | module Lec9 where 2 | 3 | open import BasicPrelude 4 | 5 | Le : Nat -> Nat -> Set 6 | Le zero y = One 7 | Le (suc x) zero = Zero 8 | Le (suc x) (suc y) = Le x y 9 | 10 | owoto : (x y : Nat) -> Le x y /+/ Le y x 11 | owoto zero zero = inl <> 12 | owoto zero (suc y) = inl <> 13 | owoto (suc x) zero = inr <> 14 | owoto (suc x) (suc y) = owoto x y 15 | 16 | data LB (X : Set) : Set where 17 | bot : LB X 18 | # : X -> LB X 19 | 20 | BLE : {X : Set}(LE : X -> X -> Set) -> LB X -> LB X -> Set 21 | BLE LE bot y = One 22 | BLE LE (# x) bot = Zero 23 | BLE LE (# x) (# y) = LE x y 24 | 25 | data OList {X : Set}(LE : X -> X -> Set)(l : LB X) : Set where 26 | [] : OList LE l 27 | _:>_ : (x : X){{p : BLE LE l (# x)}}(xs : OList LE (# x)) -> OList LE l 28 | 29 | myList : OList Le bot 30 | myList = 3 :> (6 :> (9 :> [])) 31 | 32 | insert : {l : LB Nat}(y : Nat){{p : BLE Le l (# y)}} -> OList Le l -> OList Le l 33 | insert y [] = y :> [] 34 | insert y (x :> xs) with owoto y x 35 | insert y (x :> xs) | inl u = y :> (x :> xs) 36 | insert y (x :> xs) | inr _ = x :> insert y xs 37 | -------------------------------------------------------------------------------- /Logic.lagda: -------------------------------------------------------------------------------- 1 | \chapter{Logic via Types} 2 | 3 | The inescapable honesty of Agda makes it possible for us to 4 | treat values as \emph{evidence} for something. We gain a 5 | logical interpretation of types. 6 | 7 | %format Logic = "\M{Logic}" 8 | \begin{code} 9 | module Logic where 10 | 11 | open import BasicPrelude 12 | \end{code} 13 | 14 | One way of looking at logical formulae is to consider what constitutes 15 | evidence that they hold. We can look at the connectives systematically. 16 | 17 | What constitutes `evidence for A or B'? Either `evidence for A' 18 | or `evidence for B'. If we have a type, |A|, representing `evidence for A' 19 | and another, |B| representing `evidence for B', then |A /+/ B| represents 20 | `evidence for A or B'. 21 | 22 | What constitutes `evidence for A and B'? We need both `evidence for A' 23 | and `evidence for B'. If we have a type, |A|, representing `evidence for A' 24 | and another, |B| representing `evidence for B', then |A /*/ B| represents 25 | `evidence for A and B'. 26 | 27 | What constitutes `evidence that A implies B'? We need to be sure that, 28 | given `evidence for A', we can produce `evidence for B'. If we have a 29 | type, |A|, representing `evidence for A' and another, |B| representing 30 | `evidence for B', then |A -> B| represents `evidence for A and B'. 31 | 32 | There will be more to say here, after exercise 1 is completed, but the basic 33 | message is: 34 | \begin{center} 35 | propositions are types; types are propositions\\ 36 | proofs are programs; programs are proofs 37 | \end{center} 38 | 39 | Types like |Nat| are rather boring propositions. Types like |2 + 2 == 4| are 40 | slightly more interesting. 41 | 42 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | default : CS410.pdf 2 | 3 | CS410.tex : CS410.lagda Introduction.lagda BasicPrelude.lagda EmacsCheatSheet.lagda Logic.lagda Razor.lagda 4 | lhs2TeX --agda CS410.lagda > CS410.tex 5 | 6 | CS410.aux : CS410.tex 7 | latex CS410 8 | 9 | CS410.blg : CS410.aux CS410.bib 10 | bibtex CS410 11 | 12 | CS410.dvi : CS410.tex CS410.blg 13 | latex CS410 14 | latex CS410 15 | 16 | CS410.pdf : CS410.tex CS410.blg 17 | pdflatex CS410 18 | 19 | 20 | # Ex2 21 | 22 | EX2=Ex2 23 | REPLACE=replace 24 | 25 | ex2: $(EX2).pdf 26 | 27 | $(EX2).pdf: latex/$(EX2).tex 28 | cd latex/ && \ 29 | latexmk -pdf -use-make $(EX2).tex && \ 30 | mv $(EX2).pdf .. 31 | 32 | latex/%.tex: %.lagda 33 | agda --allow-unsolved-metas -i . --latex $< 34 | sed -f $(REPLACE).sed $@ > $@.sedded 35 | mv $@.sedded $@ -------------------------------------------------------------------------------- /MaybeLec6.lagda: -------------------------------------------------------------------------------- 1 | \section{An evaluator for well-typed (by construction) programs} 2 | 3 | This time we shall revisit the well-typed evaluator, but instead of 4 | using a predicate that ensures that the expression is well-typed we 5 | shall index our expressions by their type -- making them well-typed 6 | by construction. 7 | 8 | \begin{code} 9 | module MaybeLec6 where 10 | 11 | open import BasicPrelude 12 | open import Lec5 using (Expr; val; plus; le; ifThenElse; Type; NAT; TWO) 13 | 14 | TyVal : Type -> Set 15 | TyVal NAT = Nat 16 | TyVal TWO = Two 17 | 18 | data TyExpr : Type -> Set where 19 | val : (T : Type) -> TyVal T -> TyExpr T 20 | plus : TyExpr NAT -> TyExpr NAT -> TyExpr NAT 21 | le : TyExpr NAT -> TyExpr NAT -> TyExpr TWO 22 | ifThenElse : {T : Type} -> TyExpr TWO -> TyExpr T -> TyExpr T -> TyExpr T 23 | 24 | evalType : Type -> Set 25 | evalType NAT = Nat 26 | evalType TWO = Two 27 | 28 | eval : {T : Type} -> TyExpr T -> evalType T 29 | eval (val NAT n) = n 30 | eval (val TWO b) = b 31 | eval (plus e1 e2) = eval e1 + eval e2 32 | eval (le e1 e2) = eval e1 <= eval e2 33 | eval (ifThenElse ec et ef) = if eval ec then eval et else eval ef 34 | \end{code} 35 | 36 | Much nicer, is it not? 37 | 38 | \paragraph{Exercise (not easy, but worth contemplating)} Why do we not 39 | have to discharge ``bad'' cases manually or have to invert things like 40 | last time? 41 | 42 | \subsection{Some evaluator tests} 43 | 44 | \begin{code} 45 | testExpr1 : TyExpr NAT 46 | testExpr1 = plus (val NAT 2) (val NAT 3) 47 | 48 | testExpr2 : TyExpr TWO -> TyExpr NAT 49 | testExpr2 b = ifThenElse b 50 | testExpr1 51 | (val NAT 0) 52 | 53 | test1 : eval testExpr1 == 5 54 | test1 = refl 55 | 56 | test2 : eval (testExpr2 (val TWO tt)) == 5 57 | test2 = refl 58 | 59 | test3 : eval (testExpr2 (le (val NAT 2) (val NAT 1))) == 0 60 | test3 = refl 61 | \end{code} 62 | 63 | How do we parse a string (a source file of a program) into a well-typed 64 | expression though? 65 | 66 | \begin{verbatim} 67 | parse : String -> TyExpr ? 68 | \end{verbatim} 69 | 70 | How do we know the type? In this case we could infer it because our 71 | language is so simple, but in general this is not possible (e.g. for 72 | parts of Haskell and Agda). 73 | 74 | Even if we could infer it, it is not a parser's job. A parser should 75 | just parse concrete syntax (a string from a source file) into an 76 | abstract syntax (a ``plain'' datatype), e.g.: 77 | 78 | \begin{verbatim} 79 | parse : String -> Expr 80 | \end{verbatim} 81 | 82 | It is then the job of a typechecker to figure out if this is a 83 | well-typed expression or not. 84 | 85 | \begin{code} 86 | data Maybe (A : Set) : Set where 87 | just : A -> Maybe A 88 | nothing : Maybe A 89 | 90 | try : {A B : Set} -> Maybe A -> (A -> Maybe B) -> Maybe B 91 | try nothing k = nothing 92 | try (just x) k = k x 93 | 94 | check : (e : Expr) (T : Type) -> Maybe (TyExpr T) 95 | check (val (inl n)) NAT = just (val NAT n) 96 | check (val (inl _)) TWO = nothing 97 | check (val (inr _)) NAT = nothing 98 | check (val (inr b)) TWO = just (val TWO b) 99 | check (plus e1 e2) NAT = try (check e1 NAT) \ wt1 -> 100 | try (check e2 NAT) \ wt2 -> 101 | just (plus wt1 wt2) 102 | check (plus e1 e2) TWO = nothing 103 | check (le e1 e2) NAT = nothing 104 | check (le e1 e2) TWO = try (check e1 NAT) \ wt1 -> 105 | try (check e2 NAT) \ wt2 -> 106 | just (le wt1 wt2) 107 | check (ifThenElse ec et ef) T = try (check ec TWO) \ wtc -> 108 | try (check et T) \ wtt -> 109 | try (check ef T) \ wtf -> 110 | just (ifThenElse wtc wtt wtf) 111 | \end{code} 112 | 113 | \subsection{Some typechecker tests} 114 | 115 | Untyped expressions are sometimes called ``raw'', so let us use Agda's 116 | module system to rename our previous examples accordingly: 117 | 118 | \begin{code} 119 | open import Lec5 using () renaming 120 | (testExpr1 to testRawExpr1; testExpr2 to testRawExpr2) 121 | \end{code} 122 | 123 | And then make sure that if we typecheck our raw expressions at the 124 | appropriate type, we indeed get the well-typed expressions. 125 | 126 | \begin{code} 127 | testCheck1 : check testRawExpr1 NAT == just testExpr1 128 | testCheck1 = refl 129 | 130 | IsJust : {A : Set} -> Maybe A -> Set 131 | IsJust nothing = Zero 132 | IsJust (just x) = One 133 | 134 | extract : {A : Set} -> (m : Maybe A) -> IsJust m -> A 135 | extract nothing p = magic p 136 | extract (just x) p = x 137 | 138 | testCheck2 : (b : Expr) (p : IsJust (check b TWO)) -> 139 | check (testRawExpr2 b) NAT == 140 | just (testExpr2 (extract (check b TWO) p)) 141 | testCheck2 b p with check b TWO 142 | testCheck2 b () | nothing 143 | testCheck2 b p | just _ = refl 144 | \end{code} 145 | 146 | \paragrahp{Exercise} Write more tests, make sure to include a couple 147 | where typechecking nothings. 148 | 149 | \paragraph{Exercise (hard)} The last test is more advanced then previous 150 | ones, try figuring out what is going on. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | CS410-13 2 | ======== 3 | 4 | being the notes and materials for CS410 in the 2013/14 academic session 5 | -------------------------------------------------------------------------------- /Razor.lagda: -------------------------------------------------------------------------------- 1 | \chapter{Hutton's Razor} 2 | 3 | This chapter is inspired by Professor Graham Hutton, author of 4 | \emph{Programming in Haskell}. We investigate various topics 5 | in the semantics (static and dynamic) of programming languages 6 | by considering minimal extensions to a very simple programming 7 | language---the expressions built from addition and natural numbers. 8 | The idea is that adding up numbers is indicative of `ordinary 9 | computation' in general, and we need add only the extra features 10 | required to expose whatever departure from the ordinary we care 11 | about. Why use complicated examples when simple ones will do? 12 | Graham champions simplicity, and thus gives very clear explanations 13 | of important things. His friends call the adding-up-numbers language 14 | \emph{Hutton's Razor} in his honour. 15 | 16 | %format Razor = "\M{Razor}" 17 | \begin{code} 18 | module Razor where 19 | 20 | open import BasicPrelude 21 | \end{code} 22 | 23 | Without further ado, let us have a datatype of expressions. 24 | 25 | %format Expr = "\D{Expr}" 26 | %format val = "\C{val}" 27 | %format plus = "\C{plus}" 28 | \begin{code} 29 | data Expr : Set where 30 | val : Nat -> Expr 31 | plus : Expr -> Expr -> Expr 32 | \end{code} 33 | 34 | Evaluating expressions is quite easy. Let us do it. The essence of it 35 | is to replace the type |Expr| of syntactic things with a type of 36 | semantic values, in this case, |Nat| itself. To do that, we need to 37 | replace the constructors, which make syntactic things, with semantic 38 | counterparts. In effect, |val| becomes |id| and |plus| becomes |+|. 39 | 40 | %format Val = "\F{Val}" 41 | %format eval = "\F{eval}" 42 | \begin{code} 43 | Val : Set 44 | Val = Nat 45 | 46 | eval : Expr -> Val 47 | eval (val n) = n 48 | eval (plus e1 e2) = eval e1 + eval e2 49 | \end{code} -------------------------------------------------------------------------------- /replace.sed: -------------------------------------------------------------------------------- 1 | # Lambda and right arrow. 2 | s/\\textbackslash/\$\\lambda\$/g 3 | s/->/\$\\to\$/g 4 | 5 | # Equality. 6 | s/==/\$\\equiv\$/g 7 | 8 | # Append. 9 | s/++/\$+\\!+\$/g 10 | 11 | # Comments. 12 | s/AgdaComment{\-\-/AgdaComment\{\-\-\-/g 13 | 14 | # Bind and then. 15 | s/>>=/\$\\mathbin\{>\\!\\!\\!>\\mkern-6.7mu=\}\$/g 16 | s/>>/\$\\mathbin\{>\\!\\!\\!>}\$/g 17 | 18 | # Unit. 19 | s/<>/\$\\langle\\rangle\$/g 20 | --------------------------------------------------------------------------------