├── README.md ├── file.mat ├── lambda-calculus ├── Makefile ├── README.md ├── cek-lambda.ml ├── cek.ml ├── cekaml.md ├── cekaml.ml ├── cekamltop.ml ├── lambda.ml ├── lexer.mll ├── parser.mly └── untyped-caml.ml ├── matrices-06-03.rb ├── matrices-06-04.rb ├── module-systems ├── README.md ├── modules.ml └── trees.ml ├── ocaml ├── .#dfapractice.ml ├── README.md ├── all_wrong.ml ├── binaryTrees.ml ├── conditionals.ml ├── dfapractice.ml ├── dfas.ml ├── ex2.ml ├── higherorder.ml ├── let.ml ├── list-intro.ml ├── pattern-matching.ml ├── polymorphic-types.ml ├── small.ml ├── type-annotation.ml ├── types.ml ├── typeslec.ml └── typeslec2.ml └── prolog ├── 01-basics.pl ├── 02-math.pl ├── 03-lists.pl ├── 04-hanoi.pl ├── 05-sort.pl ├── 06-backtrack.pl ├── README.md ├── cek.pl ├── cuts.pl ├── examples.pl ├── hanoi-text.c ├── hanoi.c ├── jedi.pl ├── p7.pl └── sort.pl /README.md: -------------------------------------------------------------------------------- 1 | Examples from CMSC 330, Summer 2015 2 | =================================== 3 | 4 | CMSC 330 is a junior level class on learning, understanding, and building programming languages. This repository provides much of the lecture material from the class, along with helpful examples and boilerplate code to get students started. There are also interspersed practice questions, which may show up on exams or projects throughout the course. 5 | 6 | - [`ocaml`](ocaml) -- A tutorial style introduction to the OCaml programming language, giving callouts to various concepts useful for functional programming in general (e.g., map and fold). 7 | - [`lambda-calculus`](lambda-calculus) -- Lectures on the lambda calculus and programming language semantics, including implementations of a core ML subset in big step and small step style. 8 | - [`prolog`](prolog) -- Handout material for the Prolog programming langauge 9 | - [`module-systems`](module-systems) -- A short tutorial on the OCaml module system 10 | -------------------------------------------------------------------------------- /file.mat: -------------------------------------------------------------------------------- 1 | store { b } { [ [ 1 0 ] [ 0 1 ] ] } 2 | store { a } { [ [ 1 0 ] [ 0 1 ] ] } 3 | multiply { a } { b } { c } 4 | print { c } 5 | add { c } { c } { c } 6 | print { c } 7 | -------------------------------------------------------------------------------- /lambda-calculus/Makefile: -------------------------------------------------------------------------------- 1 | main: 2 | ocamlbuild -use-menhir cekamltop.native 3 | -------------------------------------------------------------------------------- /lambda-calculus/README.md: -------------------------------------------------------------------------------- 1 | # Lectures on the lambda calculus and semantics 2 | 3 | - [`lambda.ml`](lambda.ml) -- The lambda calculus 4 | - [`lambdaprac.ml`](lambdaprac.ml) -- Buffer from class 5 | 6 | - [`untyped-caml.ml`](untyped-caml.ml) -- Big step interpreter for the 7 | untyped lambda calculus, using substitution. 8 | 9 | - [`cek.ml`](cek.ml) -- Lecture on the CEK machine (see other course 10 | notes on website) 11 | 12 | - Parser example (not covered completely in class, but linked for 13 | illustration here): 14 | - [`cekamltop.ml`](cekamltop.ml) -- Toplevel for CEKaml, put your P3 solution in `cekaml.ml` 15 | - [`parser.mly`](parser.mly) -- Parser 16 | - [`lexer.mll`](lexer.mll) -- Lexer 17 | - [`Makefile`](Makefile) -- Makefile 18 | -------------------------------------------------------------------------------- /lambda-calculus/cek-lambda.ml: -------------------------------------------------------------------------------- 1 | (* 2 | CMSC 330, Summer 2015 3 | 4 | Lectures on small step semantics and the CEK machine. 5 | *) 6 | 7 | module L = List 8 | module S = String 9 | 10 | type var = string (* Variable names *) 11 | type name = string (* Constructor names *) 12 | 13 | (* In this week's lectures, we're going to explore another way to 14 | define meaning to programming langauges. 15 | 16 | Just to give ourselves a refresher, let's recall the way we've 17 | defined semantics so far... 18 | 19 | *) 20 | 21 | (* -------------------------------------------------------------------------- *) 22 | (* Review: lambda calculus, big step semantics *) 23 | (* -------------------------------------------------------------------------- *) 24 | 25 | module Lambda = struct 26 | 27 | (* We start with the lambda calculus. The lambda calculus defines 28 | three basic forms for terms: 29 | 30 | t ::= 31 | | x 32 | | \x. t 33 | | t1 t2 34 | 35 | *) 36 | type term = 37 | | Var of var (* Variables *) 38 | | Lam of string * term (* Lambda abstractions *) 39 | | App of term * term (* Applications *) 40 | 41 | (* And a utility function for helping us print terms. *) 42 | let rec string_of_term = function 43 | | Var x -> x 44 | | Lam (x,t) -> "(\\" ^ x ^ ". " ^ (string_of_term t) ^ ")" 45 | | App (t1,t2) -> "(" ^ (string_of_term t1) ^ " " ^ (string_of_term t2) ^ ")" 46 | 47 | (* We remember that there were a few different ways we could 48 | transform lambda terms. For example, we had alpha-conversion (or 49 | alpha-renaming), which allows us to rename variables. We had to 50 | be careful to make sure that when we performed alpha renaming, we 51 | didn't cause variable capture (if we did, we would change the 52 | meaning of the term). 53 | 54 | For example, in the following expression: 55 | 56 | \x. x ((\x. x y) x) -- alpha-convert x to z --> \z. z ((\x. x y) z) 57 | 58 | Remember that we didn't convert that second x, because it was 59 | rebound. 60 | 61 | Then remember that we had beta-reduction (β-reduction) to "call" 62 | functions, by substituting their arguments. 63 | 64 | (\x. x x) (\y. y) -- beta-reduces to --> (\y. y) (\y. y) 65 | -- beta-reduces to --> (\y. y) 66 | 67 | We had lots of things to say about the lambda calculus, which you 68 | can read in the `lambda.ml` file. 69 | 70 | *) 71 | 72 | (* The lambda calculus is turing complete, meaning it can encode any 73 | computation we might want to do: all using lambdas, applications, 74 | and variables. 75 | 76 | But we typically want some extra things added to the lambda 77 | calculus, we we define extended terms. These include things like 78 | numbers, booleans, if/then/else expressions, etc... 79 | 80 | To define these we extend the term representation: 81 | 82 | *) 83 | type eterm = 84 | | EVar of var 85 | | ELam of string * eterm 86 | | EApp of term * eterm 87 | | ENum of int (* Numbers *) 88 | | EBool of bool (* Booleans *) 89 | | EIfThenEls of eterm * eterm * eterm (* if/then/else *) 90 | (* etc... *) 91 | 92 | end 93 | 94 | (* 95 | 96 | After we talkeda about the lambda calculus, we talked about big-step 97 | semantics. The lambda calculus just gives us a bunch of *rules* 98 | that we can use to transform lambda terms. But it doesn't tell us 99 | *how* to use these rules. E.g., consider the term: 100 | 101 | ((\x. x x) (\y. y)) (\y. y) 102 | 103 | What should we do with this term? One sensible idea is that we 104 | should beta-reduce it as far as we possibly can: 105 | 106 | ((\x. x x) (\y. y)) (\y. y) 107 | --> ((\y. y) (\y. y)) (\y. y) 108 | --> (\y. y) (\y. y) 109 | --> (\y. y) 110 | 111 | Now we're done, there are no more reductions we can make. This is 112 | similar to the way you play many board games: you continue making 113 | moves from the start until you run out of possible moves, at which 114 | point the game is done. However, just like a board game, the 115 | lambda calculus only gives us moves we can make, it doesn't tell us 116 | how to make those moves. For example: 117 | 118 | ((\x. x) (\y. y)) ((\x. x) (\y. y)) 119 | ^---------------^ ^---------------^ 120 | e1 e2 121 | 122 | Should we evaluate e1 first? Or e2 first? Church-Rosser tells us 123 | that the choice doesn't matter. But if we wanted to write a 124 | computer program to reduce lambda terms, we would have to make a 125 | choice. 126 | 127 | We can define **values**, as a syntactic subset of lambda terms: 128 | 129 | v ::= 130 | | x 131 | | \x. t 132 | 133 | As an example, the following are values: 134 | 135 | - y 136 | - \x. x 137 | - \x. (\y. x) 138 | - \x. (\y. x) x 139 | 140 | Note that in the last example, there was an application under the 141 | lambda. This is okay, all that matters is that the top level part 142 | is a lambda. 143 | 144 | You can view values in programming languages as the places where 145 | computation "stops." For example, if I have the term: 146 | 147 | \x. (\y. x) x 148 | 149 | I don't know how to reduce it until I know the value for x. I 150 | could beta-reduce `(\y. x) x` to `x`, but usually we have the 151 | following rule: 152 | 153 | Rule: No reduction is allowed under binders (lambdas) 154 | *) 155 | 156 | (* -------------------------------------------------------------------------- *) 157 | (* Small step semantics and the CEK machine *) 158 | (* -------------------------------------------------------------------------- *) 159 | 160 | (* 161 | 162 | In the previous section, we evaluated the computation all in "one 163 | big step." What do I mean by this? Well, let's think about how we 164 | evaluate this term: 165 | 166 | ((\f.\x. f (x+1)) (\x. x*2)) 3 167 | ^---------------^ ^-------^^ 168 | | e1 e2 | 169 | ------------ e3 ------------ 170 | 171 | To evaluate the term, we: 172 | 1st) evaluate e1 applied to e2, resulting in a value v': 173 | (\x. (\x. x*2) (x+1)) 174 | 2nd) evaluate the argument to a value: 175 | 3 is already a value, so nothing to do there. 176 | 3rd) Apply v' to 3: 177 | (\x. x*2) (3+1) 178 | 4th) Evaluate the result: 179 | (\x. x*2) (3+1) --> (\x. x*2) 4 --> 4*2 --> 8 180 | 181 | To evaluate the program, we do it all in one fell swoop. 182 | 183 | It might not be obvious, but there is an alternative, and the way 184 | we'll get intuition for it is to think about how our processors work. 185 | A processor operates using a clock, a signal that pulses very 186 | quickly. On each pulse (edge), the processor does the following: 187 | 188 | - Fetches the current instruction 189 | - Decodes the instruction 190 | - Executes the instruction 191 | 192 | What are instructions? To learn more about it, you can study 193 | assembly programming, but there are a few basic forms: 194 | 195 | - Move instructions: transfer data between registers (temporary variables) 196 | - Load / Store instructions: move data to memory (RAM) 197 | - Control instructions: jump to another part of the program, 198 | - Possibly conditionally (for if/then/else) 199 | - Arithmetic instructions: to (e.g.,) add/multiply/etc... 200 | 201 | Modern processors get much more complex than this, but the basic 202 | building blocks include these instructions on each clock tick. To 203 | build large programs, we structure them as sequences of 204 | instructions. On each tick, a small amount of work is performed, 205 | doing the rest of the work later. For example, we might write 206 | something like this (in a made up assembly language): 207 | 208 | move 0 r0 # Load 0 into register 0 209 | move 1 r1 210 | move 2 r2 211 | add r0 r1 r1 # Add r0 and r1, leaving result in r1 212 | mul r2 r1 r3 # Multiply r2 by r3, leaving result in r3 213 | 214 | This notion of computation proceeds in steps, where the state of 215 | the machine evolves on each step. We will define a semantics for 216 | the lambda calculus that also proceeds in steps. 217 | 218 | Our machine will have three pieces: 219 | 220 | -------------------------------| 221 | v | 222 | < C , E , K > | 223 | | ^-------------------------------| | 224 | - The control: the currently executing instruction | | 225 | | | 226 | - The environment: that stores the local variables--| | 227 | | 228 | - The continuation: that tells us where to go next ----| 229 | 230 | You can think of the continuation as the stack. When we want to 231 | call a procedure in assembly language, we need to save the 232 | registers on the stack. We also need to save a pointer to the next 233 | instruction, so the computer knows where to jump to after it 234 | finishes executing that procedure. We'll define precisely what 235 | these continuations look like in a few minutes, but for now, think 236 | of them as representing the stack. 237 | 238 | The machine state is going to evolve in steps, just like a game. 239 | We start in an initial state that looks like this: 240 | 241 | Σ = < e , [] , Done > 242 | 243 | and our machine is going to perform multiple steps to get to an end 244 | state: 245 | 246 | Σ --> Σ' --> ... --> Σf 247 | 248 | Where Σf represents some "final" configuration for the machine, 249 | where it's computed its result and that's ready to return to the 250 | user. 251 | 252 | This is just like a game board: you set up the initial state 253 | (similarly to how you place the pieces on their assigned places in 254 | the beginning of chess or checkers), then you make moves, until you 255 | get to the end. In our case, there is going to be one **unique** 256 | next state: the step function is going to be deterministic. Our 257 | goal is to cook up a series of steps so that stepping through the 258 | machine is going to mirror big step evaluation of terms (that we 259 | covered in the last section). 260 | 261 | Let's jump back to explain what the initial configuration means: 262 | 263 | - e, the program we want to evaluate. This means we want the 264 | machine to process the entire program. 265 | 266 | - [] is the empty map. We haven't assigned to any variables yet, 267 | so the environment should be empty. 268 | 269 | - Done is the empty continuation. When we finish executing the 270 | whole program we should just return the result. 271 | 272 | *) 273 | 274 | (* 275 | 276 | A note from the instructor: 277 | 278 | Try not to get stuck too much on this analogy to processors. It's 279 | really just to illustrate how these machines are working by proxy 280 | of something that you may have seen before. The real reason we're 281 | doing small step semantics is that -- in studying the machinery 282 | required to build them -- we'll get experience understanding how 283 | programming languages work. And once we have that machinery, we'll 284 | be able to easily add on a bunch of features like exceptions, 285 | concurrency, etc... that are hard to add on to big step semantics. 286 | 287 | *) 288 | 289 | (* -------------------------------------------------------------------------- *) 290 | (* A note on environments and motivating closures *) 291 | (* -------------------------------------------------------------------------- *) 292 | 293 | (* 294 | 295 | Our usual mechanism for performing computation has been to perform 296 | substitution. E.g., to evaluate: 297 | 298 | (\x. x (\y. y)) (\z. z) 299 | 300 | We substitute `x` with `(\z. z)` in the first expression: 301 | 302 | x (\y. y) { x |-> (\z. z) } 303 | = (\z. z) (\y. y) 304 | 305 | But this substitution operation doesn't really mesh with our small 306 | step philosophy. Why? Because these lambda terms could be 307 | arbitrarily large! To substitute them, we have to walk over the 308 | whole lambda term, replacing all occurences of `x` with the 309 | necessary form, becing careful to avoid capture and substitute 310 | appropriately, etc.. In other words, if we have the following 311 | expression: 312 | 313 | (\x. e1) e2 314 | 315 | Performing the substitution { x |-> e2 } won't be a constant time 316 | operation. It will be linear time, at least (because we might have 317 | to alpha rename to perform capture avoiding substitution, it might 318 | actually be quadratic in some cases). But this is very different 319 | than the processors I described above. Those processors perform 320 | one step in constant time on each clock cycle. How can we recover 321 | this performance in our machine? 322 | 323 | The answer is that we use an environment that tells us how to look 324 | up variables. For example, let's consider how the following term 325 | will be reduced: 326 | 327 | (\f. f f) (\y. y) 328 | 329 | In the big step semantics, we'd substitute `f` with `(\y. y)`. But 330 | I just said we don't want to do that here, because we'd be walking 331 | down the term `(\f. f f)`. Let's assume that instead, it were 332 | cartoonishly large, like: 333 | 334 | (\f. (((f f) (f f)) ((f f) (f f))) ((f f) (f f))) 335 | 336 | There, we'd be copying f all over the place, performing 12 337 | substitutions in one step. Instead, we're going to keep an 338 | **environment** that tells us the value for `f`. You can think of 339 | the environment like the local variables: they tell us the values 340 | of variables at the current point in time. 341 | 342 | So instead of calling `(\f. f f) (\y. y)` by substituting, we'll 343 | instead update the environment to contain { f |-> (\y. y) }, and 344 | then we'll execute `f`. But now, we have to execute: 345 | 346 | f f 347 | 348 | But how we know what the value is for `f`? The answer is that we 349 | have to look it up in the environment. So, to compute 350 | 351 | f f 352 | 353 | We first: 354 | 1) Compute the function, by looking up f in the environment: 355 | [ f |-> (\y. y) ] ( f ) = (\y. y) 356 | 2) Compute the argument, by looking up f in the environment: 357 | [ f |-> (\y. y) ] ( f ) = (\y. y) 358 | 359 | 3) Call `(\y. y)` with `(\y. y)`. How do we do this? We extend 360 | the environment so it also contains { y |-> (\y. y) }. Then we 361 | see: 362 | 363 | y with environment [ y |-> (\y. y), f |-> (\y. y) ] 364 | 365 | 4) Evaluate `y` by looking it up inside the environment, 366 | resulting in.. 367 | 368 | (\y. y) 369 | 370 | So, we have modified beta-reduction so that instead of 371 | substituting, we simply extend the environment. 372 | 373 | Now, let's see what happens when we do the following example: 374 | 375 | (\f. f 1) ((\x. (\y. x)) 2) 376 | ^ ^ ^ ^ 377 | | e1 | | e2 ^ 378 | 379 | To evalute this expression, we have to do the following: 380 | 1) Evaluate e1 to a value, but it already is. 381 | 2) Evaluate e2 to a value, 382 | 2') Evaluate the function to a value v1, but it already is 383 | 2'') Evaluate 2 to a value, but it already is 384 | 2''') Add {x |-> 2} to the environment and evaluate v1 385 | The result is `(\y. x)` 386 | Note that we **don't** get `(\y. 2)`! Remember, we **aren't** 387 | substituting. We only look up a variable from the environment 388 | when we evaluate that variable. 389 | >>>> This line will be important later on 390 | 391 | 3) To evaluate the result of e2 applied to e1, we update our 392 | environment from the empty environment to [ f |-> (\y. x) ], then 393 | we evaluate `f 1`. Question: why isn't our environment this: 394 | [ f |-> (\y. x) , x |-> 2 ] 395 | 396 | The reason is that after evaluating something, we throw away its 397 | environment. Think about it like this, if you had the following 398 | function in C: 399 | int a() { int x = 0; return x; } 400 | int b() { int x = 1; int y = a(); return x} 401 | 402 | You would expect the result to be 1. You **wouldn't** expect the 403 | result to be 0. The x being modified in `b` is a local variable, 404 | that belongs to `b`, **not** to `a`. It's a similar idea here. 405 | 406 | So now, we evaluate: 407 | f 1 with environment [ f -> (\y. x) ] 408 | 409 | And what do we do? We first lookup f to get `(\y. x)`, and then we 410 | call it by assigning [ y -> 1 ] and evaluating `x`, so now we 411 | evaluate: 412 | 413 | x [ f -> (\y. x), y -> 1 ] 414 | 415 | **But wait**! How do we know what x is!? We can't. What should x 416 | be? The answer, if we think about it carefully, is that x should 417 | be the environment where we evaluated e2 to a value. In other 418 | words, we should have remembered what `x` was when we evaluated the 419 | value where the above line (starting with `>>>>`). 420 | 421 | We can solve this conundrum by pairing a lambda expression with an 422 | environment, creating a closure. This is a pair: 423 | 424 | (\x. t), E 425 | 426 | Of a lambda term, and the environment that resolves the free 427 | variables. 428 | *) 429 | 430 | 431 | (* -------------------------------------------------------------------------- *) 432 | (* Implementing the CEK machine *) 433 | (* -------------------------------------------------------------------------- *) 434 | 435 | module CekMachine = struct 436 | (* Open the Lambda module so we can use the syntax. *) 437 | open Lambda 438 | (* 439 | Let's start to define the CEK machine. To begin with, the 440 | control is just going to be program terms: 441 | *) 442 | type control = term 443 | 444 | (* Now that we have the C, let's define environments and 445 | continuations. Environments are going to map variables to 446 | values. But it turns out that in our machine, we can't just have 447 | values, we have to actually have **closures**. So instead of 448 | mapping variables to values, the environment is going to map 449 | variables to a `machine_value`. A machine value is kind of the 450 | internal representation of a value. For now, the only values in 451 | our languages are going to be closures. 452 | 453 | Let's ask ourself, why aren't they going to be values? In other 454 | words, why can't the environment map variables to variables? 455 | 456 | { x |-> y } <<< Why **can't** this happen? 457 | 458 | The answer is that variables are just going to be looked up in 459 | the environment. So, whenever we have to look up a variable x, 460 | or y, we'll use the current environment to look that up. 461 | 462 | So, we define machine values and environments: 463 | *) 464 | type machine_value = 465 | | Clo of term * environment 466 | and environment = 467 | (var * machine_value) list 468 | 469 | (* 470 | Next, we're going to define continuations. 471 | 472 | Our computation in the small step machine is going to look as 473 | follows: to handle an application, 474 | 475 | t1 t2 476 | 477 | How do we evaluate an application? 478 | 1) Evaluate t1 to a value, (\x. t') 479 | 2) Evaluate t2 to a value, v2 480 | 3) Evaluate the application of `(\x. t')` to v2 481 | 482 | A continuation tells us where to go **next**. There are three 483 | possible cases for continuations when we're evaluating an 484 | expression: 485 | 486 | - Done. There's nothing left to do, we're done with the 487 | computation. 488 | 489 | - Evaluate the argument. This is when we're "focused in" on 490 | evaluating t1, and we have yet to evaluate t2. 491 | 492 | - Call the function (\x. t). This is when we want to evaluate 493 | `t1 t2`, and we've evaluated `t1` to `(\x. t)`, and we're 494 | "focused in" in `t2`. After we finish evaluating `t2`, we 495 | need to actually call `t1`. How are we going to do that? 496 | We're going to make `x` point at the value we get from 497 | working on evaluating `t2`. Then we're going to "focus in" 498 | on `t`. 499 | 500 | You see, the control serves as the "focus" of the machine. It's 501 | what the machine is currently looking at to perform its work. 502 | When we think about it, the machine makes its move in three main 503 | ways: 504 | 505 | - Changing the focus (control) 506 | - Changing the environment 507 | - Changing what to do next (the continuation) 508 | 509 | All that being said, the continuation is going to look like this: 510 | *) 511 | 512 | type continuation = 513 | (* Nothing left to do after this *) 514 | | Done 515 | (* Currently evaluating an e1 (in `e1 e2`), next evaluate `e2` *) 516 | | EvalArg of term * environment * continuation 517 | (* We've evaluated e1 to (\x. t) and are working on e2, next call *) 518 | | Call of term * environment * continuation 519 | 520 | (* Note that we've carefully laid out the continuation to include 521 | the environment. This is very nuanced, we have to be careful 522 | about what environment is used in various places so we don't make 523 | a mistake. *) 524 | 525 | (* Now we can defin the machine state *) 526 | type machine = 527 | control * environment * continuation 528 | 529 | (* Here are a few utility functions to update the environment and 530 | (e.g.,) print states and such... *) 531 | 532 | let add var value environment = (var,value)::environment 533 | let rec lookup var = function 534 | | [] -> failwith ("variable " ^ var ^ " undefined") 535 | | (k,(v:machine_value))::tl -> if (k = var) then v else lookup var tl 536 | 537 | (* Pretty printing... *) 538 | let rec string_of_environment env = 539 | (L.fold_left (fun acc (k,v) -> acc ^ k ^ " |-> " ^ (string_of_machine_value v)) 540 | "[ " env) ^ " ]" 541 | and string_of_machine_value = function 542 | | Clo (t,environment) -> "{ " ^ (string_of_term t) ^ " w/ environment " 543 | ^ string_of_environment environment ^ " }" 544 | let rec string_of_continuation = function 545 | | Done -> "[]" 546 | | EvalArg(t,e,k) -> "Arg[" ^ string_of_term t ^ "," ^ string_of_environment e 547 | ^ "," ^ (string_of_continuation k) ^ "]" 548 | | Call(t,e,k) -> "Call[" ^ string_of_term t ^ "," ^ string_of_environment e 549 | ^ "," ^ (string_of_continuation k) ^ "]" 550 | 551 | let string_of_machine (c,e,k) = "< " ^ string_of_term c ^ ", " 552 | ^ string_of_environment e ^ ", " 553 | ^ string_of_continuation k ^ " >" 554 | 555 | 556 | (* ------------------------------------------------------------------------ *) 557 | (* Defining the step function *) 558 | (* ------------------------------------------------------------------------ *) 559 | 560 | (* The machine is going to evolve in steps, where each step looks at 561 | the control (and continuation) and decides what to do. The step 562 | function has the following type: 563 | 564 | step : state -> state 565 | 566 | It proceeds in cases: 567 | *) 568 | let step state = match state with 569 | 570 | (* The first case is simple enough. Let's say that the control is 571 | `x`, meaning the machine is "focused in" on figuring out what 572 | the variable `x` is. How do we look up what `x` is? Well, we 573 | use the current *environment to tell us what it means. 574 | 575 | The environment holds closures, so we match the result of 576 | looking up the variable with the `Clo` constructor to get the 577 | lambda expression. Remember that closures come packaged with 578 | an environment. Say that the environment contains a closure 579 | for some variable `f`, `((\x. t), e')`. That means `f` points 580 | at a function, but that function's variables need to be looked 581 | up in the environment `e`. So now what do we do with the 582 | machine's focus? Where do we put it? Well, we need to focus 583 | in on t. And we also need to change the environment. What do 584 | we change the environment to? We need to change it to `e'`, 585 | the environment given to us by the closure. 586 | *) 587 | | (Var x, e, k) -> 588 | (match (lookup x e) with 589 | | Clo (lambda,e') -> (lambda,e',k)) 590 | 591 | (* 592 | Let's think about what would happen if we *didn't* swap that 593 | environment. Well, that would correspond to the case where we 594 | had this happen: 595 | 596 | (\f. f (\x. x)) ((\x. (\y. x)) (\z. z)) 597 | 598 | When we try to apply that, we evaluate the argument, and we get 599 | a closure: 600 | 601 | (\y. x) , [x |-> ((\z. z),[])] 602 | t1 t2 ^^ 603 | e2 604 | ^-------------------^ 605 | e1 606 | 607 | Which means that we have the function t1, which needs to be 608 | executed in the environment e1. The environment `e1` 609 | subsequently says that `x` is mapped to a closure whose term is 610 | `(\z.z)`, and when executing *that* expression, the environment 611 | should be the empty environment. 612 | 613 | When we start to execute `(\f. f (\x. x))` in the above line, 614 | we need to use the environment `e1` for `f`, because if we 615 | **didn't**, the machine would have no idea what `x` referred 616 | to. 617 | 618 | Alright, that handles the case for variables! 619 | *) 620 | (* Next, let's think, how do we evaluate an application? Let's 621 | say our machine state is something like this: 622 | 623 | < t1 t2, E, K > 624 | 625 | Where should our focus go first? Well, the first thing we need 626 | to do is to execute e1. So let's do that: 627 | 628 | < t1, E, K > <<<< WRONG 629 | 630 | But that's not quite right. Because if we did that, after we 631 | finished executing e1, the machine would jump back to executing 632 | the continuation K. So where do we need to do after we finish 633 | executing t1? 634 | 635 | < t1 , E , EvalArg(t2,E,K) > 636 | 637 | We actually need to evaluate the argument t2. And when we 638 | evaluate t2, we need to do so using the **current** 639 | environment. We'll find out that otherwise, we don't know what 640 | environment to use. The reason we need to save the current 641 | environment is similar to the reason we need to save local 642 | variables before calling a function: if we continued to use 643 | that function's variables upon its return, we would get the 644 | wrong results. 645 | 646 | All that being said, the definition of the `App` case is 647 | actually pretty simple! *) 648 | | (App (t1,t2), e, k) -> 649 | (t1, e, EvalArg(t2,e,k)) 650 | (* There are two cases left. 651 | 652 | What happens when I'm evaluating an application `e1 e2`, and 653 | I've *finished* evaluating `e1` to a value `(\x. t)`. Then 654 | my continuation will be EvalArg(t2,e,k). Now what do I do? 655 | Well, I need to focus in on executing `t2`, and I need to use 656 | environment `e`, because I said I would get into trouble 657 | otherwise. 658 | 659 | Then I need to use something for my continuation. What is 660 | that? Well, after I finish evaluating the argument, I need 661 | to actually *call* the function, how do I represent that? 662 | With the `Call` constructor. I call `(\x. t)` with the 663 | result. And after that, I execute the continuation `k`. 664 | 665 | Written in code... 666 | *) 667 | | (Lam (x,t), e, EvalArg(t',e',k)) -> 668 | (t',e',Call(Lam(x,t),e,k)) 669 | (* And now the last case. How do I actually **call** the 670 | function? Well, if I've evaluated `t1` to (\x. t'), and I've 671 | evaluated its argument to a lambda (remember, the only values 672 | are lambdas), then I'm here: 673 | 674 | t1 t2 675 | || || 676 | (\x. t) (\y. t') 677 | ^ 678 | 679 | Now to call t1, I need to focus in on `t`, when I'm focused 680 | in on `t`, I need to **remember** that `x` is `(\y. t')`. 681 | But what if `(\y. t')` has variables it needs to look up? 682 | Well, those should come from the current environment, so I 683 | **actually** need to assign `x` to a closure. 684 | 685 | This is how I write that in code: 686 | *) 687 | | (Lam (x,t), e, Call(Lam(x',t'),e',k)) -> 688 | let extended_env = add x' (Clo(Lam (x,t),e)) e' in 689 | (t',extended_env,k) 690 | (* 691 | 692 | Think carefully about the place that I've put various terms 693 | and environments here. Ask yourself, why do I extend e' 694 | rather than e? (Answer: because I need to execute the lambda 695 | within the environment e'.) 696 | 697 | After I'm done with all of that, I go back and execute the 698 | continuation `k`. *) 699 | 700 | (* There's actually one case left: if none of those cases holds, I 701 | might be done, in which case I'm just going to hand back the 702 | state: *) 703 | | (_,_,Done) -> state 704 | (* And then I'm going to define a wildcard case to flag an error 705 | in any other configuration. We'll talk more about this next 706 | time *) 707 | | _ -> failwith "no step defined." 708 | 709 | 710 | (* Before I can start executing terms, I need to define how I start 711 | to play the game. What's the initial configuration? I talked 712 | about this earlier, but the starting configuration is simply the 713 | configuration where we take the term we want to evaluate as the 714 | focus, then start with the empty environment, and the `Done` 715 | continuation. *) 716 | let inject t = (t,[],Done) 717 | 718 | (* Here's an example term.. *) 719 | let example = App(Lam("x",Var "x"),Lam("y",Var "y")) 720 | 721 | end 722 | 723 | open CekMachine 724 | 725 | (* Homework (not graded): figure out and get an intuition for how the 726 | CEK machine is working. One way to start is to define a bunch of 727 | example terms and do this with them: 728 | 729 | step (inject example) 730 | step (step (inject example)) 731 | step (step (step (inject example))) 732 | .... 733 | 734 | until you get done. 735 | 736 | Figure out why various rules do various things, ask me questions 737 | when you get stuck. 738 | 739 | *) 740 | 741 | -------------------------------------------------------------------------------- /lambda-calculus/cek.ml: -------------------------------------------------------------------------------- 1 | module L = List 2 | 3 | module CekMachine = struct 4 | type var = string 5 | 6 | type term = 7 | | Var of var (* Variables *) 8 | | Lam of string * term (* Lambda abstractions *) 9 | | App of term * term (* Applications *) 10 | 11 | let rec string_of_term = function 12 | | Var x -> x 13 | | Lam (x,t) -> "(\\" ^ x ^ ". " ^ (string_of_term t) ^ ")" 14 | | App (t1,t2) -> "(" ^ (string_of_term t1) ^ " " ^ (string_of_term t2) ^ ")" 15 | 16 | type control = term 17 | type machine_value = 18 | | Clo of term * environment 19 | and environment = 20 | (var * machine_value) list 21 | and continuation = 22 | | Done 23 | | EvalArg of term * environment * continuation 24 | | Call of term * environment * continuation 25 | 26 | let add var value environment = (var,value)::environment 27 | let rec lookup var = function 28 | | [] -> failwith ("variable " ^ var ^ " undefined") 29 | | (k,(v:machine_value))::tl -> if (k = var) then v else lookup var tl 30 | 31 | type machine = 32 | control * environment * continuation 33 | 34 | (* Pretty printing... *) 35 | let rec string_of_environment env = 36 | (L.fold_left (fun acc (k,v) -> acc ^ k ^ " |-> " ^ (string_of_machine_value v)) 37 | "[ " env) ^ " ]" 38 | and string_of_machine_value = function 39 | | Clo (t,environment) -> "{ " ^ (string_of_term t) ^ " w/ environment " 40 | ^ string_of_environment environment ^ " }" 41 | let rec string_of_continuation = function 42 | | Done -> "[]" 43 | | EvalArg(t,e,k) -> "Arg[" ^ string_of_term t ^ "," ^ string_of_environment e 44 | ^ "," ^ (string_of_continuation k) ^ "]" 45 | | Call(t,e,k) -> "Call[" ^ string_of_term t ^ "," ^ string_of_environment e 46 | ^ "," ^ (string_of_continuation k) ^ "]" 47 | 48 | let string_of_machine (c,e,k) = "< " ^ string_of_term c ^ ", " 49 | ^ string_of_environment e ^ ", " 50 | ^ string_of_continuation k ^ " >" 51 | 52 | 53 | let step state = match state with 54 | (* How do we evaluate a variable? *) 55 | | (Var x, e, k) -> 56 | (match (lookup x e) with 57 | | Clo (lambda,e') -> (lambda,e',k)) 58 | (* How do we evaluate an application? *) 59 | | (App (t1,t2), e, k) -> 60 | (t1, e, EvalArg(t2,e,k)) 61 | (* What do we do when we have a lambda and need to evaluate the argument? *) 62 | | (Lam (x,t), e, EvalArg(t',e',k)) -> 63 | (t',e',Call(Lam(x,t),e,k)) 64 | (* What do we do when we need to call the function we just computed? *) 65 | | (Lam (x,t), e, Call(Lam(x',t'),e',k)) -> 66 | let extended_env = add x' (Clo(Lam (x,t),e)) e' in 67 | (t',extended_env,k) 68 | (* What do we do when there are no steps left? *) 69 | | (_,_,Done) -> state 70 | (* Fail on all other cases. *) 71 | | _ -> failwith "no step defined..." 72 | 73 | let inject t = (t,[],Done) 74 | 75 | end 76 | 77 | 78 | open CekMachine 79 | let example = App(Lam("x",Var "x"),Lam("y",Var "y")) 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /lambda-calculus/cekaml.md: -------------------------------------------------------------------------------- 1 | # CMSC 330 - Project 3 2 | 3 | # Errata 4 | 5 | - 07/07/15 -- Small typos in call rule 6 | - 07/07/15 -- **important** error in "fix" rule, fixed now 7 | - 07/08/15 -- Fixed EBArg if case 8 | 9 | In this project, we will extend the CEK machine to handle a core 10 | subset of OCaml. In the lambda calculus, the terms were: 11 | 12 | t ::= 13 | | x Variables 14 | | \x. t Lambda abstractions 15 | | t1 t2 Applications 16 | 17 | In our language, TypelessCaml, we'll enhance this to include many 18 | other features as well: 19 | 20 | t ::= 21 | | x Variables 22 | | \x. t Lambda abstractions 23 | | t1 t2 Applications 24 | | n Integral literals 25 | | b Boolean literals 26 | | let x = t1 in t2 Let binding 27 | | op t1 ... tn Builtin operations 28 | | if t1 then t2 else t3 If/Then/Else 29 | | fix f in ... Recursion 30 | | Ctr (t1, ..., tn) Constructors 31 | | match t with | C1(x1,..,xn) -> t1 | C2(x1,..,xn) -> t1 | ... 32 | ^^ Match patterns 33 | 34 | # Components 35 | 36 | The **control** will be just a term 37 | 38 | The **machine values** (which I'll call mvalues) will be: 39 | - Closures of lambda terms and their associated environments `[ \x. t, E ]` 40 | - Integers 41 | - Booleans 42 | - Variants of constructor names and argument lists (also values) `Ctr(v1,...,vn)` 43 | 44 | The **environment** will map variables to machine values, and will be 45 | a list of (variable, mvalue) pairs. 46 | 47 | The **continuation** will have several possibilities: 48 | 49 | - `Done`: Do nothing after this 50 | 51 | - `EArg(t, E, K)`: Evaluate a function's argument, in the context of 52 | environment E 53 | 54 | - `ECall(\x. t, E, K)`: Call the function `\x. t` with environment E and 55 | do K afterwards 56 | 57 | - `DecideTF(t1,t2,E,K)`: Next decide whether the current thing is true 58 | or false. If it's true, start executing t1, if it's false start 59 | executing t2, do it in the environment of E with continuation K. 60 | 61 | - `EVariant(name,evaluated_args,next_args,E,K)`: In the expression 62 | 63 | Ctr (t1,....,tn) 64 | 65 | We are evaluating some tk (where 0 < k <= n), and have already 66 | evaluated `t1...t(k-1)`, whose results are sitting in `evaluated_args`. 67 | Next is `t(k+1)...tn`, sitting in `next_args`, evaluate each of those in 68 | the context of E, and then do K. After that, take the resulting 69 | mvalues and form a variant from them. 70 | 71 | - `EBArg(bi,evaluated_args,next_args,E,K)`: In the expression 72 | 73 | + t1 t2 ... tn 74 | 75 | Currently evaluating tk (where 0 < k <= n), and have already 76 | evaluated `t1...t(k-1)`, whose results are sitting in `evaluated_args`. 77 | Next is `t(k+1)...tn`, sitting in `next_args`, evaluate each of those 78 | in the context of E, and then do K. `bi` represents the specific operator, 79 | in this case it's plus. 80 | 81 | 82 | We'll explain these again later when we show the machine rules. 83 | 84 | # Injection 85 | 86 | How does the machine begin? If we want to execute term e, the inject 87 | function creates a machine state with e, the empty environment, and 88 | the `Done` continuation: 89 | 90 | inject(e) = < e, [] , Done> 91 | 92 | # Step function 93 | 94 | The rules for each of the cases in the step function follow. When 95 | reading these rules, be careful to note which expressions move into 96 | and out of the control, where the environments appear and move, and 97 | how the continuations evolve: 98 | 99 | ## Evaluating a variable 100 | 101 | ### When it refers to a closure 102 | 103 | Then we need to swap the current environment to the environment the 104 | closure provids for us: 105 | 106 | if E(x) = [ (\x. t ) , E' ], then 107 | < x , E , K > --> < (\x. t ), E', K > 108 | 109 | ### When it refers to a literal / variant 110 | 111 | Then we simply put that thing at the current control sring: 112 | 113 | if E(x) = {n|b|v(mv1,...,mvn)} 114 | < x , E , K > --> < {n|b|v(mv1,...,mvn)} , E , K > 115 | 116 | ## Evaluating an application 117 | 118 | We step to evauate `t1` and evaluate `t2` later: 119 | 120 | < t1 t2 , E , K > --> < t1 , E , EArg(t2,E,K) > 121 | 122 | ## Evaluating an argument 123 | 124 | < (\x. t) , E , EArg(t',E',K) > --> ( t', E', Call((\x. t) , E, K)) 125 | 126 | ## Calling a function 127 | 128 | ### Calling with a function as an argument 129 | 130 | If we are calling with a lambda term, we need to make a closure and 131 | then *step into* the body: 132 | 133 | < (\x. t) , E , Call((\y. t'),E',K) > --> < t', { y |-> [ (\x. t), E ] } :: E', K > 134 | 135 | Carefully note how the environments get swapped around. 136 | 137 | ### Calling w/ something else as an argument 138 | 139 | Then no closure is necessary 140 | 141 | < v , E , Call((\y. t'),E',K) > --> < t', { y |-> v } :: E', K > 142 | 143 | ## Evaluating a let binding 144 | 145 | Involves the same machinery as an application: 146 | 147 | --> 148 | 149 | If this is confusing to you, remember that we could write: 150 | 151 | let x = t1 in t2 === (\x. t2) t1 152 | 153 | And if we did that we would have: 154 | 155 | <(\x. t2) t1, E, K> --> <(\x. t2), E, EArg(t1,E,K)> 156 | --> 157 | 158 | Since the reduction is always going to take that form (since 159 | `(\x. t2)` doesn't need to be evaluated any further), we just take a 160 | shortcut and rewrite it to the second one. 161 | 162 | ## Evaluating an if 163 | 164 | ### Evaluating the guard 165 | 166 | To evaluate 167 | 168 | if t1 then t2 else t3 169 | 170 | We need to evaluate `t1`, then remember to go back and evaluate either 171 | `t2` or `t3`, which we indicate with a `DecideTF` continuation: 172 | 173 | --> 174 | 175 | ### Deciding and evaluating the guard 176 | 177 | After finishing evaluating the guard, we actually execute the branch 178 | 179 | --> 180 | 181 | or... 182 | 183 | --> 184 | 185 | Note that if the guard evaluated to anything *else*, we'd have a type 186 | error, and we wouldn't define a next step. You don't have to worry 187 | about this in the project, since I defined that the programs would 188 | always be well formed. 189 | 190 | ## Evaluating a built in 191 | 192 | To evaluate a built in, we need to evaluate each of its arguments in 193 | sequence, and then perform the operation. We start by seeing a 194 | builtin expression and focusing on the first thing: 195 | 196 | --> 197 | 198 | `EBarg` represents that the next thing we have to do is evaluate t2. 199 | The place where the empty list is, is the set of things we've 200 | evaluated so far. To go to the next one, we have another rule: 201 | 202 | 203 | --> --> 209 | 210 | The notation `[|op l|]` means take the list of arguments to the 211 | operator and apply it. For example, if `l` is `1,2,3`, and `op` is 212 | `+`, the result `v` should be `6`. 213 | 214 | # Recursion with `fix` 215 | 216 | Recursion works by "unrolling" the recursive definition. In other 217 | words, if we define a recursive function f in OCaml: 218 | 219 | let rec f = fun x -> if x = 0 then 1 else x*(f (x-1)) 220 | 221 | The way OCaml handles `f n` is to evaluate the body of `f`. When 222 | evaluating that body, f will be assigned to itself. 223 | 224 | So for example, `f 1` is computed like so: 225 | 226 | f 1 227 | = 228 | (fun x -> if (x = 0) then 1 else x * (f (x-1))) 1 229 | = 230 | if (1 = 0) then 1 else 1 * (f (1-1)) 231 | = 232 | 1 * (f (1-1)) 233 | = 234 | 1 * ((fun x -> if (x = 0) then 1 else x * (f (x-1))) 0) 235 | = 236 | 1 * (if (0 = 0) then 1 else 0 * (f (0-1))) 237 | = 238 | 1 * 1 239 | 240 | Convince yourself why this works. Once you are convinced, the 241 | implementation of `let rec` is actually quite simple. We call `let 242 | rec` `fix` because it creates fixed points of functions. 243 | 244 | In our syntax, `let rec f x = t` will be represented as 245 | 246 | fix f in (\x. t) 247 | 248 | Its implementation is simple: 249 | 250 | --> [fix f in (\x. t),E]}::E, K > 251 | 252 | **Important errata**: In a previous version of this document, the "fix f in" in the conclusion of the above rule was left out. This will cause errors for your implementation. 253 | 254 | ## End of the rules 255 | 256 | And that should be all the rules you need! 257 | 258 | Implementing matches and variants is just a little more complicated, 259 | and will be extra credit for this project. The reason relates to a 260 | technicality when you have variants containing closures. I'll write 261 | up the guide and let people attempt extra credit. 262 | 263 | # Running the computation 264 | 265 | To actually *run* the computation, we take the reflexive transitive 266 | closure of the step function. This means, we evaluate the step 267 | function to produce a sequence of states until we can't step any 268 | longer. We'll detect the final state using the `final_state` function. 269 | And at that point we'll have our answer: 270 | 271 | inject (e) --> .... -> (c, E, Done) 272 | where final_state (c, E, Done) = true 273 | and the answer is c 274 | 275 | 276 | 277 | 278 | 279 | 280 | -------------------------------------------------------------------------------- /lambda-calculus/cekaml.ml: -------------------------------------------------------------------------------- 1 | (* -------------------------------------------------------------------------- *) 2 | (* CMSC 330 -- Project 3 -- Small Step Interpreter for CEKaml *) 3 | (* -------------------------------------------------------------------------- *) 4 | 5 | module L = List 6 | module S = String 7 | 8 | (* -------------------------------------------------------------------------- *) 9 | (* CEKaml abstract syntax *) 10 | (* -------------------------------------------------------------------------- *) 11 | 12 | module Syntax = struct 13 | type var = string (* Variable names *) 14 | type name = string (* Constructor names *) 15 | 16 | (* Built in operators. *) 17 | type builtin = 18 | | Plus 19 | | Times 20 | | And 21 | | Not 22 | | Or 23 | 24 | (* The term representation *) 25 | type term = 26 | | Var of var (* Variables *) 27 | | Let of var * term * term (* Let binding let x = ... in *) 28 | | Lam of var * term (* (\x. e) *) 29 | | App of term * term (* e1 e2 *) 30 | | NumLit of int (* literal integers *) 31 | | BoolLit of bool (* literal booleans *) 32 | | Builtin of builtin * term list (* built in operators e1 + e2 *) 33 | | Ifthenels of term * term * term (* if e1 then e2 else e3 *) 34 | | Fix of var * term (* fixpoints: let rec var = ... *) 35 | | Variant of name * term list (* constructors: C(e1,...,en) *) 36 | (* Match patterns. 37 | match t with 38 | | C1(v11,...,v1k) -> b1 39 | | ... -> ... 40 | | Cn(vn1,...,vnk) -> bn 41 | represented as 42 | Match(t,[("C1",["v11",...,"v1k"],b1); 43 | ... 44 | ("C1",["v11",...,"v1k"],b1)]) 45 | *) 46 | | Match of term * ((name * var list * term) list) 47 | and 48 | (* A match pattern is a: 49 | - Constructor name 50 | - Variable list 51 | - Term 52 | 53 | When matched, the term will be executed with the variables 54 | substituted into the environment. *) 55 | match_pattern = (name * var list * term) 56 | 57 | let rec string_of_builtin = function 58 | | Plus -> "+" 59 | | Times -> "*" 60 | | And -> "&&" 61 | | Not -> "!" 62 | | Or -> "||" 63 | 64 | (* Turn a term into a string. *) 65 | let string_of_term t = 66 | let rec string_of_vlist vlist = 67 | List.fold_left 68 | (fun acc hd -> if acc = "" then hd else (hd ^ "," ^ acc)) "" (L.rev (vlist)) 69 | in 70 | let rec h t = match t with 71 | | Var x -> x 72 | | Let (x,t1,t2) -> "let " ^ x ^ " = " ^ (h t1) ^ " in\n" ^ (h t2) 73 | | Lam (x,t') -> "fun " ^ x ^ " -> (" ^ (h t') ^ ")" 74 | | App (t1,t2) -> "(" ^ (h t1) ^ " " ^ (h t2) ^ ")" 75 | | NumLit i -> string_of_int i 76 | | BoolLit b -> string_of_bool b 77 | | Builtin (s,tlist) -> "(" ^ (string_of_builtin s) ^ " " ^ 78 | (L.fold_left (fun acc hd -> "(" ^ (h hd) ^ ") " ^ acc) "" (L.rev tlist)) 79 | | Ifthenels (t1,t2,t3) -> "if " ^ (h t1) ^ " then " ^ (h t2) ^ " else " ^ (h t3) 80 | | Fix (f,t') -> "(fix " ^ f ^ " in " ^ (h t') ^ ")" 81 | | Variant (n,tl) -> n ^ "( " ^ 82 | (L.fold_left (fun acc hd -> "(" ^ (h hd) ^ "), " ^ acc) "" (L.rev tl)) 83 | | Match (t, mptl) -> "match " ^ (h t) ^ " with \n" ^ 84 | (L.fold_left 85 | (fun acc (n,vl,t) -> "| " ^ n ^ "(" ^ (string_of_vlist vl) ^ ") -> " ^ (h t)) 86 | "" 87 | (L.rev mptl)) 88 | in 89 | h t 90 | end 91 | 92 | open Syntax 93 | 94 | (* -------------------------------------------------------------------------- *) 95 | (* CEK-Style Small Step Interpreter *) 96 | (* -------------------------------------------------------------------------- *) 97 | 98 | module Interpreter = struct 99 | (* 100 | Do NOT modify these types / definitions, but read them to make 101 | sure you understand what they mean. 102 | *) 103 | 104 | (* The control string (current instruction) is simply a term *) 105 | type control = term 106 | 107 | (* 108 | 109 | Machine representation of Denotable values. This is the domain D 110 | from the lecture notes. 111 | *) 112 | type closure = term * environment (* A closure: internal representation of a 113 | function, with an environtment we will 114 | use to execute it. *) 115 | and mvalue = 116 | | Closure of closure 117 | | Int of int 118 | | Boolean of bool 119 | | MVariant of name * mvalue list (* A variant is a constructor name and a 120 | list of values *) 121 | 122 | (* Environments map variables to machine values. *) 123 | and environment = (var * mvalue) list 124 | (* 125 | What to do next. There are a few possibilities: 126 | 127 | - Done: no work to do next. 128 | 129 | - EArg(t2,E,K): currently evaluating a function (t1) of the 130 | application t1 t2. **Next** evaluate t2, in environment E, and 131 | then do K. 132 | 133 | - Call(t1,E,K): currently evaluating an argument (t2) of the 134 | application t1 t2. **Next** call the function by putting the 135 | control at the term inside of t (where t1 = (\x. t)), and 136 | setting the environment to E. After we do this, do K. 137 | 138 | - DecideTF(t1,t2,E,K): currently evaluating a guard (e1) of an if 139 | statement `if e1 then e2 else e3`. Next decide whether the 140 | guard is true or false, and if so execute t1 (or t2) in the 141 | environment E, doing K after that. 142 | 143 | - EvalPrimArg(evaluated_args,next_args,E,K): In the expression 144 | + t1 t2 ... tn 145 | 146 | Currently evaluating tk (where 0 < k <= n), and have already 147 | evaluated t1...t(k-1), whose results are sitting in 148 | evaluated_args. Next is t(k+1)...tn, sitting in next_args, 149 | evaluate each of those in the context of E, and then do K. 150 | 151 | *) 152 | and continuation = 153 | | Done 154 | | EArg of term * environment * continuation 155 | | Call of term * environment * continuation 156 | | DecideTF of term * term * environment * continuation 157 | | EBArg of builtin * mvalue list * term list * continuation 158 | 159 | type state = control * environment * continuation 160 | 161 | (* ------------------------------------------------------------------------ *) 162 | (* Environment *) 163 | (* ------------------------------------------------------------------------ *) 164 | let empty_environment = [] 165 | let update_environment var value environment = (var,value)::environment 166 | let lookup var environment = failwith "undefined" 167 | 168 | (* ------------------------------------------------------------------------ *) 169 | (* Pretty printing *) 170 | (* ------------------------------------------------------------------------ *) 171 | let rec string_of_environment env = 172 | (L.fold_left (fun acc (k,v) -> acc ^ k ^ " |-> " ^ (string_of_machine_value v)) 173 | "[ " env) ^ " ]" 174 | and string_of_machine_value = function 175 | | Closure (t,environment) -> "{ " ^ (string_of_term t) ^ " w/ environment " 176 | ^ string_of_environment environment ^ " }" 177 | | Int i -> string_of_int i 178 | | Boolean b -> string_of_bool b 179 | | MVariant (n,vs) -> n ^ "(" ^ 180 | (List.fold_left 181 | (fun acc hd -> 182 | if (acc = "") then (string_of_machine_value hd) 183 | else ((string_of_machine_value hd) ^ "," ^ acc)) 184 | "" (L.rev (vs))) 185 | 186 | let rec string_of_continuation = function 187 | | Done -> "Done" 188 | | EArg (t,e,c) -> "EArg(" ^ (string_of_term t) ^ "," ^ (string_of_environment e) ^ (string_of_continuation c) 189 | | Call (t,e,c) -> "Call(" ^ (string_of_term t) ^ "," ^ (string_of_environment e) ^ (string_of_continuation c) 190 | | DecideTF (t1,t2,e,c) -> "DecideTF(" ^ (string_of_term t1) ^ "," ^ 191 | (string_of_term t2) ^ (string_of_environment e) 192 | ^ (string_of_continuation c) 193 | | EBArg (bi,mvl,tl,k) -> "EBArg(" ^ (string_of_builtin bi) ^ "(" ^ 194 | (List.fold_left 195 | (fun acc hd -> 196 | if (acc = "") then (string_of_machine_value hd) 197 | else ((string_of_machine_value hd) ^ "," ^ acc)) 198 | "" (L.rev (mvl))) 199 | ^ "),("^ 200 | (List.fold_left 201 | (fun acc hd -> 202 | if (acc = "") then (string_of_term hd) 203 | else ((string_of_term hd) ^ "," ^ acc)) 204 | "" (L.rev (tl))) 205 | ^ 206 | ")," ^ (string_of_continuation k) ^ ")" 207 | 208 | let string_of_machine (c,e,k) = "< " ^ string_of_term c ^ ", " 209 | ^ string_of_environment e ^ ", " 210 | ^ string_of_continuation k ^ " >" 211 | 212 | (* ------------------------------------------------------------------------ *) 213 | (* Utility functions *) 214 | (* ------------------------------------------------------------------------ *) 215 | 216 | (* 217 | YOUR code begins here. 218 | *) 219 | 220 | (* Create an initial state *) 221 | let inject state = failwith "undefined" 222 | 223 | (* Determine if a state is final *) 224 | let final_state s = failwith "undefined" 225 | 226 | (* {step s} takes a state and steps it to a new state. 227 | 228 | NOTE: This is the main function to be implemented for this 229 | project. 230 | 231 | *) 232 | let step (s : state) : state = failwith "undefined" 233 | 234 | (* `compute e` takes `e` and repeatedly applies `step` until a final 235 | state is reached. You *must* implement this function in a tail 236 | recursive way. *) 237 | let compute (e : term) = failwith "undefined" 238 | end 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | -------------------------------------------------------------------------------- /lambda-calculus/cekamltop.ml: -------------------------------------------------------------------------------- 1 | (* CMSC 330 -- Summer 2015 2 | Toplevel for CEKaml 3 | *) 4 | 5 | open Cekamlsol 6 | open Lexing 7 | 8 | let pp = Printf.printf 9 | let pe = Printf.fprintf stderr 10 | let ps = print_string 11 | let psn x = print_string x; print_newline () 12 | 13 | let main _ = 14 | psn "CEKaml v 0.1 toplevel"; 15 | let rec loop environment = 16 | ps ">> "; 17 | let input = Lexing.from_string (read_line ()) in 18 | try 19 | let parsed_term = Parser.prog Lexer.main input in 20 | try 21 | let (c,e',_) = 22 | Interpreter.compute_plus_environment (parsed_term,environment,Done) in 23 | loop e' 24 | with 25 | | _ -> psn "Error reducing term!\n"; loop environment 26 | with 27 | | Lexer.SyntaxError msg -> pe "%s%!\n" msg; loop environment 28 | | Parser.Error -> pe "%s\n" "Parsing error..."; loop environment 29 | in 30 | loop [];; 31 | 32 | main (); 33 | -------------------------------------------------------------------------------- /lambda-calculus/lambda.ml: -------------------------------------------------------------------------------- 1 | (* 2 | CMSC 330, Summer 2015 3 | 4 | Lectures on the Lambda calculus. 5 | *) 6 | 7 | module L = List 8 | 9 | (* -------------------------------------------------------------------------- *) 10 | (* Introduction and defining lambda terms *) 11 | (* -------------------------------------------------------------------------- *) 12 | 13 | (* Like turing machines, the lambda calculus is a primitive model of 14 | computation. That is to say, any function that is computable 15 | (whose result can be computed via a mechanical means) can be 16 | computed with the lambda calculus. 17 | 18 | We start our exploration in programming languages with the lambda 19 | calculus because, unlike turing machines, the lambda calculus takes 20 | functions as the main abstraction. We will see that this lends to 21 | a nice formalization of functional langauges, but for now we'll 22 | have to trust that that's what we're building towards. 23 | 24 | First we define the so called terms (programs) of the lambda 25 | calculus. We assume there is an infinite set of variables V from 26 | which we can draw variables. 27 | 28 | t ::= 29 | | x <-- If x is a variable, then x is a term 30 | | (\x. t) <-- If x is a variable, and t is a term, then \x. is a term 31 | | (e1 e2) <-- If e1 and e2 are both terms, then (e1 e2) is a term 32 | 33 | Conceptually, the lambda calculus term (\x. t) can be thought of 34 | as the OCaml term (fun x -> t). 35 | 36 | (e1 e2) is the *application* of e1 to e2. 37 | *) 38 | 39 | (* Let's define an OCaml datatype for lambda terms. First, we will 40 | simply say that variables are strings: *) 41 | 42 | type var = string 43 | 44 | (* Next we will inductively define lambda terms using OCaml. *) 45 | type term = 46 | | Var of var (* If x is a variable, then Var x is a term *) 47 | | Lam of var * term (* If x is a variable and t a term, Lam (x,t) is a term *) 48 | | App of term * term (* If t1 and t2 terms, App (t1,t2) is a term *) 49 | 50 | (* Note that we don't explicitly parse lambda terms. Instead, we work 51 | with their OCaml representation. For many purposes, working with 52 | the concrete syntax of lambda terms will just get in the way: 53 | there's no need to talk about parsing when we talk about how to 54 | perform computations. 55 | 56 | When we work with the OCaml representation of a term, such as 57 | *) 58 | 59 | let ex_0 : term = Lam("x",Lam("y",Var "x")) 60 | 61 | (* -------------------------------------------------------------------------- *) 62 | (* Printing lambda terms *) 63 | (* -------------------------------------------------------------------------- *) 64 | 65 | (* 66 | Rather than the concrete term: 67 | 68 | (\x. (\y. x)) 69 | 70 | We say that we are working with the **abstract syntax** of the 71 | programming langauge. Working with the abstract syntax of the 72 | programming language is great, because it means that most of the 73 | theory we want to define can really just be OCaml functions on 74 | datatypes. 75 | 76 | Because they are just OCaml datatypes, let's define a function to 77 | render lambda terms as strings. 78 | *) 79 | 80 | (* Let's define a function which will traverse a term and turn it into 81 | a string representation. *) 82 | let rec string_of_term = function 83 | | Var x -> x 84 | | Lam (x,t) -> "(\\" ^ x ^ ". " ^ (string_of_term t) ^ ")" 85 | | App (t1,t2) -> "(" ^ (string_of_term t1) ^ " " ^ (string_of_term t2) ^ ")" 86 | 87 | let pterm = fun x -> print_endline (string_of_term x) 88 | 89 | (* And a few examples... *) 90 | let x = "x" 91 | let vx = Var x 92 | let y = "y" 93 | let vy = Var y 94 | let ex_1 = Lam(x,App(vx,vx)) (* Note that we have to wrap "x" in a 95 | Var constructor here. *) 96 | let ex_2 = App(ex_1,ex_1) 97 | 98 | (* Now we can see our function in action: 99 | 100 | # pterm ex_2;; 101 | ((\x. (x x)) (\x. (x x))) 102 | *) 103 | 104 | (* -------------------------------------------------------------------------- *) 105 | (* Reducing lambda terms *) 106 | (* -------------------------------------------------------------------------- *) 107 | 108 | (* 109 | How do we compute with the lambda calculus? Well, we have a set of 110 | rules that we can use to rewrite terms into other terms. If you 111 | think of computation in the lambda calculus as a game: we have 112 | various moves we can play. 113 | 114 | To start things off, I'm going to list what I see as the main 115 | source of "computation" in the lambda calculs, β reduction: 116 | 117 | `(\x. e1) e2` β-reduces to `e1 { x |-> e2 }` 118 | 119 | In other words, the result of applying (\x. e1) to e2 is e1, where 120 | we replace all the x's with e2. 121 | 122 | β reduction tells us how to apply functions. It's just what we'd 123 | think it is: substitute the argument of the function into the body. 124 | It's just like what you did in elementary algebra: 125 | 126 | f(x) = x*x + 2, plug in 3 for x, get 3*3 + 2 out. 127 | 128 | Let's define β reduction as an OCaml function: 129 | 130 | let beta_reduce = function 131 | | App(Lam(x,e1),e2) -> substitute x e2 e1 132 | | _ -> failwith "can't beta reduce" 133 | 134 | First, we need to know how to substitute values in the lambda 135 | calculus. This seems like it should be simple, let's look at a few 136 | examples: 137 | 138 | (\x. x x) (\y. y) 139 | 140 | To beta reduce this term, we need to replace x with `(\y. y)` in 141 | the term `x x`. So, we do the obvious thing: the first and second 142 | x's get replaced with `(\y. y)`: 143 | 144 | (\x. x x) (\y. y) --> x x { x |-> (\y. y) } = (\y. y) (\y. y) 145 | 146 | In other words, to replace x with some term t, all we do is take 147 | all occurences of the variable x, and replace them with t. We 148 | could code that up like this: 149 | *) 150 | let rec broken_substitute x t e = match e with 151 | | Var y -> if (x = y) then t else e (* If we have `y` and are trying to find `x`, 152 | don't replace it. Leave it alone. *) 153 | | Lam(y,e1) -> Lam(y,broken_substitute x t e1) 154 | | App(e1,e2) -> App((broken_substitute x t e1),(broken_substitute x t e2)) 155 | 156 | (* First, let's ask ourselves, why didn't we change the thing under 157 | the lambda? E.g., why didn't we say: 158 | 159 | Lam(broken_substitute x t y,broken_substitute x t e1) 160 | 161 | The answer is this: the thing that the lambda is binding is a 162 | string, not a term. In the lambda calculus, it would be 163 | nonsensical to say this: 164 | 165 | (\x. (\x. x)) (\y.y) --> ((\y.y). (\y.y)) 166 | 167 | Because that's not a well formed term. The thing before the dot 168 | has to be a variable name, **not** a term. 169 | *) 170 | 171 | (* -------------------------------------------------------------------------- *) 172 | (* Bound / free variables / Capture avoiding substitution *) 173 | (* -------------------------------------------------------------------------- *) 174 | 175 | (* 176 | Our current technique is broken, let's see why: 177 | 178 | (\x. x (\x.x)) (\y.y) 179 | ^------------^ ^----^ 180 | e1 e2 181 | 182 | Let's say I want to beta reduce the top level expression. In other 183 | words, I want to apply `e1` to `e2`. Let's see what happens if we 184 | just use our technique: 185 | 186 | (\x. x (\x. x)) (\y.y) 187 | beta reduces to --> x (\x. x) { x |-> (\y.y) } 188 | and we use broken_substitute to get... (\y.y) (\x.(\y.y)) 189 | 190 | But this is **bad**. Why? Because we shouldn't have replaced the 191 | second x. We should have left it alone. It was rebound by the 192 | inner `(\x.x)`. 193 | 194 | Let's think about this by analogy to the OCaml term: 195 | 196 | (fun x -> (fun x -> x)) 12 197 | 198 | When I want to compute that, what do I do? Well I plug in 12 for 199 | x. But then I see a fun binding x in the inner term. This 200 | rebinds x, meaning I should leave it alone. 201 | 202 | In general, this is called variable *capture*. This is closely 203 | related to the concept of *free* variables. Free variables are 204 | variables that aren't bound by a lambda. In the following 205 | expressions... 206 | 207 | (\x. y) <-- y is a free variable (we sometimes say "y is free") 208 | (\x. \y. z) <-- z is free 209 | (\x. \y. x y) <-- Nothing is free (x and y are both bound) 210 | (\x. (\y. y) y) <-- The **last** y is free 211 | 212 | It's worth talking about the last example. Let's think about it by 213 | analogy to OCaml code: 214 | 215 | (fun x -> 216 | ((fun y -> y) y)) 217 | ^ 218 | | 219 | This is the free one 220 | 221 | If you try to run that code, what happens? OCaml will complain at 222 | you. It will say, I don't know what the value of y is for that 223 | variable. 224 | 225 | If you ever get confused, remember that you can turn these lambda 226 | expressions into OCaml terms and then think about in OCaml. 227 | 228 | Now, let's define the free variables for a term: I'm going to treat 229 | lists as sets, so I need some helper functions: 230 | *) 231 | 232 | (* uniq makes a list uniq. *) 233 | let uniq = L.fold_left (fun acc hd -> if (not (L.mem hd acc)) then hd::acc else acc) [] 234 | 235 | (* Takes the union of two lists. *) 236 | let union l1 l2 = uniq (l1@l2) 237 | 238 | (* l1 \ l2 ... [1;2;3] \ [2;3] = [1] *) 239 | let difference l1 l2 = L.fold_left 240 | (fun acc hd -> if (L.mem hd l2) then acc else hd::acc) [] l1 241 | 242 | (* Removes an element from a list. *) 243 | let remove l1 x = L.fold_left (fun acc hd -> if (hd = x) then acc else hd::acc) [] l1 244 | 245 | let rec free_variables t = match t with 246 | | Var x -> [x] 247 | | Lam (x,t) -> remove (free_variables t) x 248 | | App (t1,t2) -> union (free_variables t1) (free_variables t2) 249 | 250 | (* Let's try it on some example terms... *) 251 | let ex_3 = App(vx,vy) 252 | 253 | (* 254 | # free_variables vx;; 255 | - : var list = ["x"] 256 | # free_variables ex_1;; 257 | - : var list = [] 258 | # free_variables ex_2;; 259 | - : var list = [] 260 | # free_variables ex_3;; 261 | - : var list = ["y"; "x"] 262 | *) 263 | 264 | (* We can calculate the bound varibles as the variables, minus the 265 | free variables. *) 266 | let bound_variables t = 267 | let rec variables = function 268 | | Var x -> [x] 269 | | Lam (x,y) -> x :: (variables y) 270 | | App (t1,t2) -> uniq ((variables t1)@(variables t2)) 271 | in 272 | difference (variables t) (free_variables t) 273 | 274 | (* Now, this has been a bit of a diversion. The reason we're messing 275 | around with this free and bound variable stuff is to fix our broken 276 | definition of substitute. And we need that so we can define beta 277 | reduction. 278 | 279 | What's a simple fix to avoid capturing variables? Well, when we 280 | substitute x for t inside an expression (\x. e), we first check to 281 | see if x is *free* inside of (\x. e). This will happen when we 282 | have (e.g.,) `(\x. (\x. x) x)`. In this case, we need to convert 283 | the x to a new variable that isn't the set of variables. 284 | *) 285 | 286 | (* -------------------------------------------------------------------------- *) 287 | (* Alpha conversion *) 288 | (* -------------------------------------------------------------------------- *) 289 | 290 | (* Renaming variables inside expressions is called alpha conversion. 291 | 292 | For example, consider the expression: 293 | 294 | (\x. x x) (\y. y y) 295 | ^-------^ 296 | e1 297 | 298 | Inside e1, we can rename x to z, and we get an equivalent term: 299 | 300 | (\x. x x) (\y. y y) alpha converts to (\z. z z) (\y. y y) 301 | 302 | This will work, except for in one case: when the thing we're trying 303 | to alpha convert is *free* inside the expression. For example, 304 | consider the following expression: 305 | 306 | e = (\x. y) 307 | 308 | y is free inside of `e`. So if we apply another term to it, it 309 | should simply beta reduce to y: 310 | 311 | (\x. y) z --> y 312 | 313 | But if we change x to `y`, that doesn't happen: 314 | 315 | (\y. y) z -> z 316 | 317 | This is bad, so we don't allow alpha conversion when a variable is 318 | free. 319 | 320 | We also have to take some care with how we alpha convert. E.g., in 321 | converting the following expression: 322 | 323 | (\x. (\x. x) x) 324 | 325 | We can alpha convert to 326 | 327 | (\y. (\x. x) y) 328 | 329 | But *not* 330 | 331 | (\y. (\x. y) y) 332 | *) 333 | 334 | let rec improved_substitute x t e = match e with 335 | | Var y -> if (x = y) then t else e 336 | | Lam(y,t') -> 337 | if (x = y) then e 338 | else 339 | if (not (L.mem y (free_variables t))) then 340 | Lam(y,(improved_substitute x t t')) 341 | else 342 | failwith ("error: " ^ y ^ "would be captured by substitution") 343 | | App(t1,t2) -> App((improved_substitute x t t1), (improved_substitute x t t2)) 344 | let substitute = improved_substitute 345 | 346 | (* This still isn't quite perfect. In the second case, where we 347 | currently raise an exception, we could instead rename the variable 348 | `y` inside t' to a fresh variable. Doing this relies on a 349 | subroutine, `fresh`, which generates a variable not in `t`. *) 350 | 351 | (* Exercise (2/3 stars) 352 | 353 | Implement `fresh`, which traverses a lambda term and generates a 354 | variable not in the set of variables. One possible implementation 355 | might simply form variables of the form f, and then search 356 | for it systematically. This is not particularly efficient, 357 | however. 358 | 359 | *) 360 | 361 | (* Exercise: using fresh, extend improved_substitute to account for 362 | the final case, substituting with a fresh variable and renaming 363 | appropriately. *) 364 | 365 | (* -------------------------------------------------------------------------- *) 366 | (* Defining beta reduction *) 367 | (* -------------------------------------------------------------------------- *) 368 | 369 | (* Now implementing beta reduction is simple: *) 370 | 371 | let beta = function 372 | | App(Lam(x,e1),e2) -> substitute x e2 e1 373 | | _ -> failwith "can't beta reduce" 374 | 375 | (* Note that beta reduction can be applied in various places within a 376 | lambda term. 377 | 378 | E.g., consider the following lambda term: 379 | 380 | ( (\x. x) (\x. x) ) ( (\y. y) (\y. y) ) 381 | ^-----------------^ ^-----------------^ 382 | e1 e2 383 | 384 | We can beta reduce e1, *or* e2. To allow us to implement this 385 | choice, we will annotate lambda terms with indices. 386 | 387 | As an example, pti produces the following for the aforementioned term: 388 | 389 | # pterm (App(App(x,x),App(x,x)));; 390 | (((\x. x) (\x. x)) ((\x. x) (\x. x))) 391 | # pti (App(App(x,x),App(x,x)));; 392 | 0(1(2(\x. x) 3(\x. x)) 4(5(\x. x) 6(\x. x))) 393 | 394 | Now, we can choose to either beta reduce at index 1, or at index 4. 395 | None of the other indices are places where beta reduction could 396 | apply (they're just lambdas). 397 | *) 398 | let print_term_indices t = 399 | let rec h i t = 400 | match t with 401 | | Var x -> (x,i) 402 | | Lam (x,t) -> 403 | let (a,i') = h (i+1) t in 404 | ((string_of_int i)^ "(\\" ^ x ^ ". " ^ a ^ ")",i') 405 | | App (t1,t2) -> 406 | let (a,i') = h (i+1) t1 in 407 | let (b,i'') = h (i') t2 in 408 | ((string_of_int i) ^ "(" ^ a ^ " " ^ b ^ ")",i'') 409 | in 410 | fst (h 0 t) 411 | 412 | let pti = fun x -> print_endline (print_term_indices x) 413 | 414 | (* Now, given a *) 415 | 416 | let pp = Printf.printf 417 | 418 | let beta_at_index t index = 419 | let rec h i t = 420 | match t with 421 | | Var x -> (t,i) 422 | | Lam (x,t) -> 423 | let (a,i') = h (i+1) t in 424 | (Lam (x,a),i') 425 | | App (t1,t2) -> 426 | if (i = index) then 427 | (beta t,i+1) 428 | else 429 | (let (a,i') = h (i+1) t1 in 430 | let (b,i'') = h (i') t2 in 431 | (App(a,b),i'')) 432 | in 433 | fst (h 0 t) 434 | 435 | let bai = beta_at_index 436 | 437 | (* -------------------------------------------------------------------------- *) 438 | (* The Church-Rosser Theorem *) 439 | (* -------------------------------------------------------------------------- *) 440 | 441 | (* The lambda calculus is like a game. Beta-reduction gives us a set 442 | of moves we can make. But just like chess, we can't actually play 443 | the game unless we sit at the board and make decisions about what 444 | moves to make. 445 | 446 | Our choices in the lambda calculus are places where we might make 447 | various lambda reductions. 448 | 449 | # pterm (beta_at_index (App(App(x,x),App(x,x))) 1);; 450 | ((\x. x) ((\x. x) (\x. x))) 451 | 452 | Note that we also could have reduced at index 4: 453 | 454 | # pterm (beta_at_index (App(App(x,x),App(x,x))) 4);; 455 | (((\x. x) (\x. x)) (\x. x)) 456 | 457 | We might worry: are we making the *right* choices? When there are 458 | multiple places that we can perform a beta reduction, how do we 459 | know which to choose? The Church-Rosser theorem tells us that it 460 | doesn't matter. No matter which choices we make, if we end up with 461 | a result, we could have ended up there making a different series of 462 | choices. 463 | 464 | **Theorem: Church-Rosser** 465 | 466 | From Wikipedia... 467 | 468 | > If there are two distinct reductions or sequences of reductions 469 | > that can be applied to the same term, then there exists a term 470 | > that is reachable from both results, by applying (possibly empty) 471 | > sequences of additional reductions. 472 | 473 | This is sometimes stated as the diamond property. Let's see why: 474 | 475 | 1((\x. x) (\x. x)) 4((\x. x) (\x. x)) 476 | / \ 477 | Reduce 1 first Reduce 4 first 478 | / \ 479 | ((\x. x) ((\x. x) (\x. x))) (((\x. x) (\x. x)) (\x. x)) 480 | | | 481 | (\x. x) (\x. x) (\x. x) (\x. x) 482 | \ / 483 | (\x. x) 484 | 485 | See how the reductions form a diamond? The idea is that it doesn't 486 | matter which one you choose. 487 | *) 488 | 489 | (* -------------------------------------------------------------------------- *) 490 | (* Nonterminating programs *) 491 | (* -------------------------------------------------------------------------- *) 492 | 493 | (* It's possible to write nonterminating programs in the lambda 494 | calculus too. Consider the following term `omega`: *) 495 | let omeg = Lam("x",App(Var "x",Var "x")) 496 | let omega = App(omeg,omeg) 497 | 498 | (* Omega never terminates. It loops forever. 499 | 500 | Exercise: beta reduce omega. Convince yourself it will never 501 | terminate. 502 | 503 | Exercise: Think about this, what does the Church-Rosser theorem say 504 | about the omega term? 505 | *) 506 | 507 | let s = "s" 508 | let vs = Var "s" 509 | let z = "z" 510 | let vz = Var "z" 511 | let w = "w" 512 | let vw = Var w 513 | 514 | let zero = Lam(s,Lam(z,vz)) 515 | let one = Lam(s,Lam(z,App(vs,vz))) 516 | let two = Lam(s,Lam(z,App(vs,App(vs,vz)))) 517 | 518 | let s = Lam(w,Lam(y,Lam(x,(App(vy,(App(App(vw,vy),vx))))))) 519 | -------------------------------------------------------------------------------- /lambda-calculus/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Lexing 3 | open Parser 4 | 5 | exception SyntaxError of string 6 | 7 | let next_line lexbuf = 8 | let pos = lexbuf.lex_curr_p in 9 | lexbuf.lex_curr_p <- 10 | { pos with pos_bol = lexbuf.lex_curr_pos; 11 | pos_lnum = pos.pos_lnum + 1 12 | } 13 | } 14 | 15 | let int = '-'? ['0'-'9'] ['0'-'9']* 16 | 17 | (* part 2 *) 18 | let digit = ['0'-'9'] 19 | let frac = '.' digit* 20 | let exp = ['e' 'E'] ['-' '+']? digit+ 21 | let float = digit* frac? exp? 22 | 23 | (* part 3 *) 24 | let white = [' ' '\t']+ 25 | let newline = '\r' | '\n' | "\r\n" 26 | let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* 27 | 28 | (* part 4 *) 29 | rule main = 30 | parse 31 | | "fun" { FUN } 32 | | "->" { TO } 33 | | "=" { EQUALS } 34 | | "+" { PLUS } 35 | | "let" { LET } 36 | | "in" { IN } 37 | | "if" { IF } 38 | | "then" { THEN } 39 | | "else" { ELSE } 40 | | white { main lexbuf } 41 | | newline { next_line lexbuf; main lexbuf } 42 | | int { INT (int_of_string (Lexing.lexeme lexbuf)) } 43 | | "true" { TRUE } 44 | | "false" { FALSE } 45 | | '(' { LPAREN } 46 | | ')' { RPAREN } 47 | | id { ID (Lexing.lexeme lexbuf) } 48 | | _ { raise (SyntaxError ("Unexpected char: " ^ Lexing.lexeme lexbuf)) } 49 | | eof { EOF } 50 | 51 | -------------------------------------------------------------------------------- /lambda-calculus/parser.mly: -------------------------------------------------------------------------------- 1 | %start prog 2 | 3 | %token ID 4 | %token INT 5 | %token EOF EOL DEF LPAREN RPAREN 6 | %token PLUS MINUS TIMES DIVIDE 7 | %token EQUALS 8 | %token TRUE FALSE 9 | %token IF THEN ELSE 10 | %token LET IN 11 | %token LARGER SMALLER EQLARGER EQSMALLER EQUAL NOTEQUAL 12 | %token NOT AND OR 13 | %token FUN TO 14 | %left OR 15 | %left AND 16 | %nonassoc NOT 17 | %nonassoc LARGER SMALLER EQLARGER EQSMALLER EQUAL NOTEQUAL 18 | %left PLUS MINUS 19 | %left TIMES DIVIDE 20 | %nonassoc LPAREN 21 | %nonassoc ATTRIB 22 | %% 23 | 24 | prog: 25 | | t = term EOF { t } 26 | ; 27 | 28 | term: 29 | | id = ID { Cekamlsol.Syntax.Var id } 30 | | FUN id = ID TO t = term { Cekamlsol.Syntax.Lam(id,t) } 31 | | LPAREN t = term RPAREN { t } 32 | | t1 = term t2 = term { Cekamlsol.Syntax.App(t1,t2) } 33 | | int = INT { Cekamlsol.Syntax.NumLit int } 34 | | TRUE { Cekamlsol.Syntax.BoolLit true } 35 | | FALSE { Cekamlsol.Syntax.BoolLit true } 36 | | t1 = term PLUS t2 = term { Cekamlsol.Syntax.Builtin(Plus,[t1;t2]) } 37 | | t1 = term MINUS t2 = term { Cekamlsol.Syntax.Builtin(Minus,[t1;t2]) } 38 | | LET id = ID EQUALS t1 = term IN t2 = term { Cekamlsol.Syntax.Let(id,t1,t2) } 39 | | IF t1 = term THEN t2 = term ELSE t3 = term { Cekamlsol.Syntax.Ifthenels(t1,t2,t3) } 40 | ; 41 | -------------------------------------------------------------------------------- /lambda-calculus/untyped-caml.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Core TyplessCaml 3 | 4 | This is an interpreter for a core call by value language modeled 5 | after OCaml, in a big step substitution style. 6 | 7 | Kristopher Micinski 8 | *) 9 | module L = List 10 | module S = String 11 | 12 | type var = string (* Variable names *) 13 | type name = string (* Constructor names *) 14 | 15 | (* The term representation *) 16 | type term = 17 | | Var of var (* Variables *) 18 | | Let of var * term * term (* Let binding let x = ... in *) 19 | | Lam of var * term (* (\x. e) *) 20 | | App of term * term (* e1 e2 *) 21 | | Num of int (* literal integers *) 22 | | Bool of bool (* literal booleans *) 23 | | Builtin of string * term list (* built in operators e1 + e2 *) 24 | | Ifthenels of term * term * term (* if e1 then e2 else e3 *) 25 | | Fix of var * term (* fixpoints: let rec var = ... *) 26 | | Variant of name * term list (* constructors: C(e1,...,en) *) 27 | (* Match patterns. 28 | match t with 29 | | C1(v11,...,v1k) -> b1 30 | | ... -> ... 31 | | Cn(vn1,...,vnk) -> bn 32 | represented as 33 | Match(t,[("C1",["v11",...,"v1k"],b1); 34 | ... 35 | ("C1",["v11",...,"v1k"],b1)]) 36 | *) 37 | | Match of term * ((name * var list * term) list) 38 | 39 | (* Term substitution, avoiding capture. Note that this is sort of 40 | broken right now: substitution *should* alpha convert to avoid name 41 | capture. 42 | XXX: fix this, KMM 06/24/15 43 | 44 | For students: don't worry about this, just assume substitution 45 | works. You don't need to care about how it's implemented for now. 46 | *) 47 | module Substitution = struct 48 | (* uniq makes a list uniq. *) 49 | let uniq = L.fold_left (fun acc hd -> if (not (L.mem hd acc)) then hd::acc else acc) [] 50 | 51 | (* Takes the union of two lists. *) 52 | let union l1 l2 = uniq (l1@l2) 53 | 54 | (* l1 \ l2 ... [1;2;3] \ [2;3] = [1] *) 55 | let difference l1 l2 = L.fold_left 56 | (fun acc hd -> if (L.mem hd l2) then acc else hd::acc) [] l1 57 | 58 | (* Removes an element from a list. *) 59 | let remove l1 x = L.fold_left (fun acc hd -> if (hd = x) then acc else hd::acc) [] l1 60 | 61 | let rec free_variables t = match t with 62 | | Var x -> [x] 63 | | Lam (x,t) -> remove (free_variables t) x 64 | | App (t1,t2) -> union (free_variables t1) (free_variables t2) 65 | | Builtin (_,tl) -> L.flatten (L.map free_variables tl) 66 | | Fix (f,t) -> remove (free_variables t) f 67 | | Variant (n,t) -> L.flatten (L.map free_variables t) 68 | | Ifthenels (e1,e2,e3) -> L.flatten (L.map free_variables [e1;e2;e3]) 69 | | Match (t,nvltl) -> 70 | difference 71 | (L.flatten (L.map (fun (_,vl,t) -> (difference (free_variables t) vl)) nvltl)) 72 | (free_variables t) 73 | | _ -> [] 74 | 75 | let fresh t = 76 | let rec vars t = match t with 77 | | Var x -> [x] 78 | | Let (x,t1,t2) -> x::(vars t1)@(vars t2) 79 | | Lam (x,t) -> x::(vars t) 80 | | App (t1,t2) -> (vars t1)@(vars t2) 81 | | Builtin (_,tl) -> L.flatten (L.map vars tl) 82 | | Fix (f,t) -> f::(vars t) 83 | | Ifthenels (e1,e2,e3) -> L.flatten (L.map vars [e1;e2;e3]) 84 | | Variant (n,tl) -> L.flatten (L.map vars tl) 85 | | _ -> failwith "bad" 86 | in 87 | let nums = L.fold_left (fun acc hd -> 88 | try 89 | (int_of_string (S.sub hd 1 (S.length hd-1)))::acc 90 | with _ -> acc 91 | ) [] (vars t) 92 | in 93 | "f" ^ (string_of_int (L.fold_left max 0 nums)) 94 | 95 | let rec improved_substitute x t e = 96 | match e with 97 | | Var y -> if (x = y) then t else e 98 | | Lam(y,t') -> 99 | if (x=y) then 100 | e 101 | else 102 | if (not (L.mem y (free_variables e))) then 103 | Lam(y,improved_substitute x t t') 104 | else 105 | failwith "can't replace." 106 | | App(t1,t2) -> App((improved_substitute x t t1), (improved_substitute x t t2)) 107 | | Let(y,t1,t2) -> 108 | if (x=y) then 109 | e 110 | else if (not (L.mem y ((free_variables e)))) then 111 | Let(y,improved_substitute x t t1, improved_substitute x t t2) 112 | else 113 | failwith "can't replace." 114 | | Builtin (n,tl) -> Builtin(n,L.map (improved_substitute x t) tl) 115 | | Fix(f,t') -> 116 | if (x=f) then 117 | e 118 | else 119 | if (not (L.mem f (free_variables e))) then 120 | Fix(f,improved_substitute x t t') 121 | else 122 | failwith "can't replace." 123 | | Variant (n,tl) -> Variant (n,L.map (improved_substitute x t) tl) 124 | | Match (t',cvltl) -> 125 | Match((improved_substitute x t t), 126 | (L.map (fun (ctr,vl,t'') -> 127 | (if (L.mem x vl) then (ctr,vl,t'') 128 | else (ctr,vl,improved_substitute x t t''))) cvltl)) 129 | | Ifthenels (e1,e2,e3) -> Ifthenels ((improved_substitute x t e1), 130 | (improved_substitute x t e2), 131 | (improved_substitute x t e3)) 132 | | _ -> e 133 | 134 | let substitute = improved_substitute 135 | end 136 | 137 | open Substitution 138 | 139 | (* Helper function in pattern matching. *) 140 | let rec zip lst1 lst2 = match lst1,lst2 with 141 | | [],[] -> [] 142 | | [],_ -> failwith "unequal lengths" 143 | | _, []-> failwith "unequal lengths" 144 | | (x::xs),(y::ys) -> (x,y) :: (zip xs ys) 145 | 146 | (* -------------------------------------------------------------------------- *) 147 | (* Main evaluation relation *) 148 | (* -------------------------------------------------------------------------- *) 149 | 150 | (* 151 | The following function implements the big step evauation reation: 152 | 153 | e ⇓ v 154 | *) 155 | let rec eval term = match term with 156 | (* 157 | For values, I don't have to do any work to evaluate them. In math: 158 | 159 | ---------- :: Value 160 | v ⇓ v 161 | *) 162 | | Var x -> term 163 | | Lam (x,t1) -> term 164 | | App (t1, t2) -> 165 | let (Lam (x,v1)) = eval t1 in 166 | let v2 = eval t2 in 167 | eval (substitute x v2 v1) 168 | | Num _ -> term 169 | | Bool _ -> term 170 | (* `let x = e1 in e2` is literally just syntactic sugar for 171 | (\x. e2) e1 172 | So we evaluate it that way. 173 | *) 174 | | Let (x,e1,e2) -> 175 | eval (App(Lam(x,e2),e1)) 176 | (* To evaluate builtin operators, evaluate their parameters, and 177 | then apply operations in the metalangauge (OCaml) to perform 178 | things such as addition. 179 | n 180 | e₁ ⇓ v₁ ... en ⇓ vn 〚 op 〛(v1, ..., vn) 181 | -------------------------------------------- 182 | op (e₁,...,en) ⇓ 183 | *) 184 | | Builtin (s,tl) -> 185 | let values = L.map eval tl in 186 | let arith op i l = 187 | let rec h = function 188 | | [] -> i 189 | | (Num hd)::tl -> op hd (h tl) in 190 | Num (h l) in 191 | let boolop op i l = 192 | let rec h = function 193 | | [] -> i 194 | | (Bool hd)::tl -> op hd (h tl) in 195 | Bool (h l) in 196 | (match s with 197 | (* Here is the definition of the various builtin operators. This 198 | corresponds to (in math) the 〚 op 〛syntax. That's just math 199 | that means an operator that works on `Num n1 + Num n2`. 200 | Normally, I couldn't have + work on terms, so I make a helper 201 | function that allows + to work inside of terms. 202 | 203 | As an example `Num 2 〚 + 〛Num 3` evaluates to `Num 5`. 204 | *) 205 | | "-" -> arith (-) 0 (values) 206 | | "+" -> arith (+) 0 (values) 207 | | "*" -> arith (fun x y -> x*y) 1 values 208 | | "/" -> arith (/) 1 (L.rev values) 209 | | "&&" -> boolop (&&) true values 210 | | "||" -> boolop (||) false values 211 | | "=" -> let ([Num a;Num b]) = values in 212 | if (a = b) then Bool true 213 | else Bool false 214 | | _ -> failwith "undefined primitive") 215 | (* 216 | To evaluate fixpoints we "unroll the loop" one time. 217 | 218 | e.g., `fix f (\x -> f (x-1))` 219 | gets reduced to... 220 | `(\x -> ((fix f (\x -> f (x-1))) (x-1)))` 221 | 222 | e { f ↦ (fix f e1) } ⇓ v 223 | --------------------------- :: Fix 224 | fix f e ⇓ v 225 | 226 | *) 227 | | Fix (x,e) -> substitute x term e 228 | (* To evaluate a variant, we simply evaluate its consituent components: 229 | 230 | e₁ ⇓ v₁ ... en ⇓ vn 231 | ----------------------------- :: Variant 232 | C (e₁,...,en) ⇓ C (v₁,...,vn) 233 | *) 234 | | Variant (n,el) -> Variant (n,L.map eval el) 235 | (* There are two cases for if/then/else: when the guard is true, and 236 | when it's false. 237 | 238 | e₁ ⇓ true e₂ ⇓ v 239 | -------------------------- :: IfTrue 240 | if e₁ then e₂ else e₃ ⇓ v 241 | 242 | e₁ ⇓ false e₃ ⇓ v 243 | -------------------------- :: IfFalse 244 | if e₁ then e₂ else e₃ ⇓ v 245 | *) 246 | | Ifthenels (e1,e2,e3) -> 247 | (match (eval e1) with 248 | | Bool true -> 249 | eval e2 250 | | Bool false -> 251 | eval e3 252 | | _ -> failwith "tried to compare against a non boolean") 253 | (* 254 | To evaluate 255 | match e with 256 | | C1(v11,...,v1k) -> b1 257 | | ... -> ... 258 | | Cn(vn1,...,vnk) -> bn 259 | 260 | We first evaluate e to v, then figure out which constructor to 261 | execute, then interpret it after substituting. 262 | 263 | e ⇓ Cm(v1,...,vj) 0 < m <= n bm { vm1 ↦ v1, ..., vmk ↦ vj } ⇓ v 264 | --------------------------------------------------------------------- :: Match 265 | match e with | C1(..)->.. | ... | Cn(...)->.. ⇓ v 266 | 267 | It's not a **complicated** rule, just large. 268 | *) 269 | | Match(t,pl) -> 270 | let Variant (name,vals) = eval t in 271 | (* Find the case that matches. *) 272 | let [(_,varlist,matchbody)] = L.filter (fun (n,_,_) -> n = name) pl in 273 | (* Substitute each of the values from the match variable list with 274 | the concrete values inside the variant *) 275 | let rec subst_helper acc = function 276 | | [] -> acc 277 | | ((vname,value)::tl) -> subst_helper (substitute vname value acc) tl 278 | in 279 | eval (subst_helper matchbody (zip varlist vals)) 280 | 281 | (* Example programs. *) 282 | let l = Lam("x",Lam("y",Builtin("*", [Var "x"; Var "y"]))) 283 | let l1 = App(l,Num 2) 284 | let l2 = App(l1,Num 3) 285 | 286 | let rec fac_ocaml = 287 | fun x -> 288 | if (x = 0) then 1 289 | else x * fac_ocaml (x-1) 290 | 291 | let rec sum_ocaml = 292 | fun l -> 293 | match l with 294 | | hd::tl -> hd + (sum_ocaml tl) 295 | | [] -> 0 296 | 297 | (* A function to cmpute the factorial *) 298 | let fac = 299 | Fix("fac", 300 | (Lam("x", 301 | Ifthenels(Builtin("=", [Var "x"; Num 0]), 302 | (Num 1), 303 | (Builtin("*", [Var "x"; 304 | (App(Var "fac", 305 | (Builtin("-", [Var "x"; Num 1]))))])))))) 306 | 307 | let example_list = 308 | Variant("Cons",([Num 1;Variant("Cons",([Num 3;Variant("Nil",[])]))])) 309 | 310 | (* A function which sums a list. *) 311 | let sum = 312 | Fix("sum", 313 | Lam("l", 314 | Match(Var "l", 315 | [("Cons", ["hd";"tl"], (Builtin("+",[Var "hd";App(Var "sum", Var "tl")]))); 316 | ("Nil", [], (Num 0))]))) 317 | 318 | 319 | 320 | -------------------------------------------------------------------------------- /matrices-06-03.rb: -------------------------------------------------------------------------------- 1 | # Ruby Matrix interpreter for CMSC 330 2 | # Run this with 3 | # ruby matrices-06-03.rb ./file.mat 4 | # 5 | # @author Kris Micinski 6 | 7 | # A representation for matrices that performs various operations on 8 | # them, using a Ruby array of arrays as the internal representation. 9 | class Matrix 10 | # Define an accessor for the internal (array of arrays) 11 | # representation 12 | attr_accessor :mat 13 | 14 | # @param mat [Array[Array[Fixnum]]] The array based representation 15 | # of matrices: 16 | # 17 | # [ [ 1, 2], 18 | # [ 0, 1] ] 19 | # 20 | def initialize(mat) 21 | @mat = mat 22 | end 23 | 24 | def rows 25 | @mat.length 26 | end 27 | 28 | def columns 29 | @mat[0].length 30 | end 31 | 32 | # Add {self} to matrix {m} 33 | # @param m Matrix 34 | def add(m) 35 | m1 = @mat 36 | m2 = m.mat 37 | sum = Array.new(self.rows,Array.new()) 38 | 39 | (0...(self.rows)).each do |i| 40 | (0...(self.columns)).each do |j| 41 | sum[i][j] = m1[i][j] + m2[i][j] 42 | end 43 | end 44 | Matrix.new(sum) 45 | end 46 | 47 | # Multiply {self} and matrix {b} 48 | # @param m Matrix 49 | def product(b) 50 | n = self.rows 51 | m = self.columns 52 | p = b.columns 53 | prod = Array.new(n,[]) 54 | n.times do |i| 55 | p.times do |j| 56 | sum = 0 57 | (0...m).each { |k| sum = sum + @mat[i][k] * b.mat[k][j] } 58 | prod[i][j] = sum 59 | end 60 | end 61 | Matrix.new(prod) 62 | end 63 | end 64 | 65 | ## 66 | ## Statements 67 | ## 68 | 69 | # All statements have a method, {executeStatement}, that accept an 70 | # interpreter as its argument. The {executeStatement} method then 71 | # performs the necessary work to execute the statement. 72 | 73 | class StoreStatement 74 | 75 | # Construct a "store { a } { }" statement 76 | # @param targetVar [String] The variable being stored into 77 | # @param matrix [Matrix] The matrix being stored 78 | def initialize(targetVar,matrix) 79 | @target = targetVar 80 | @matrix = matrix 81 | end 82 | 83 | # Execute a store statement by taking the interpreter's environment, 84 | # and updating it to have add the key,value pair 85 | # {(@target => @matrix)}. 86 | def executeStatement(interpreter) 87 | end 88 | end 89 | 90 | class AddStatement 91 | # Construct an "add { a } { b } { c }" operation that adds matrices 92 | # a and b, and leaves the result in C. 93 | # @param operand1 [String] operand 1 variable name 94 | # @param operand2 [String] operand 2 variable name 95 | # @param resultVar [String] variable to store result 96 | def initialize(operand1,operand2,resultVar) 97 | @operand1 = operand1 98 | @operand2 = operand2 99 | @resultVar = resultVar 100 | end 101 | 102 | # Execute a statement by taking the interpreter's environment, 103 | # looking up operand 1, looking up operand 2, and leaving the result 104 | # in C. 105 | def executeStatement(interpreter) 106 | end 107 | end 108 | 109 | class MultiplyStatement 110 | # Construct a "multiply { a } { b } { c }" operation that adds matrices 111 | # a and b, and leaves the result in C. 112 | def initialize(operand1,operand2,resultVar) 113 | @operand1 = operand1 114 | @operand2 = operand2 115 | @resultVar = resultVar 116 | end 117 | 118 | # Similar to add... 119 | def executeStatement(interpreter) 120 | end 121 | end 122 | 123 | class PrintStatement 124 | # Construct a "print { a }" statement 125 | def initialize(varName) 126 | @varName = varName 127 | end 128 | 129 | # Turn a matrix object into a string 130 | # @param matrix The matrix to convert 131 | def matrixToString(matrix) 132 | end 133 | 134 | def executeStatement(interpreter) 135 | end 136 | end 137 | 138 | ## 139 | ## Parsing 140 | ## 141 | class Parser 142 | # The filename being parsed 143 | attr :filename 144 | # The array of `{Print,Add,...}Statement` objects 145 | attr_reader :statements 146 | # The lines of the files 147 | attr_reader :lines 148 | 149 | def initialize(filename) 150 | @filename = filename 151 | @statements = [] 152 | end 153 | 154 | # Take a string like " [ [ 1 0 ] [ 0 1 ] ] " and turn it into a 155 | # {Matrix} object. 156 | def parseMatrix(str) 157 | matrix = [] 158 | str.scan(/\[((\s*\d\s*)+)\]/).each do |capture| 159 | columns = [] 160 | capture[0].split.each { |column| columns << column.to_i } 161 | matrix << columns 162 | end 163 | Matrix.new(matrix) 164 | end 165 | 166 | def parseStatement(statement) 167 | case statement 168 | when /store\s+{\s*([a-z]+)\s*}\s*{([^}]*)}/ 169 | var = $1 170 | matrix = $2 171 | StoreStatement.new(var,parseMatrix(matrix)) 172 | when /add\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 173 | a = $1 174 | b = $2 175 | to = $3 176 | AddStatement.new(a,b,to) 177 | when /negate\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 178 | a = $1 179 | to = $2 180 | NegateStatement.new(a,to) 181 | when /multiply\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 182 | a = $1 183 | b = $2 184 | to = $3 185 | MultiplyStatement.new(a,b,to) 186 | when /print\s+{\s*([a-z]+)\s*}/ 187 | PrintStatement.new($1) 188 | else 189 | nil 190 | end 191 | end 192 | 193 | def parseStatements 194 | i = 0 195 | @lines = File.readlines(@filename) 196 | @lines.each do |line| 197 | i = i+1 198 | statement = parseStatement(line) 199 | if statement then 200 | statements << statement 201 | else 202 | puts "Ignoring line #{i}: `#{line.strip}`" 203 | end 204 | end 205 | self 206 | end 207 | end 208 | 209 | ## 210 | ## Interpreter 211 | ## 212 | 213 | class Interpreter 214 | attr_accessor :environment 215 | 216 | # Construct an interpreter object 217 | def initialize(parser) 218 | @parser = parser 219 | @environment = {} 220 | end 221 | 222 | def run 223 | # First, parse all of the statements 224 | @parser.parseStatements 225 | line = 0 226 | # Next, execute each in turn 227 | @parser.statements.each do |statement| 228 | line = line+1 229 | # Attempt to execute the statement 230 | begin 231 | statement.executeStatement(self) 232 | # For debugging 233 | # puts "#{@parser.lines[line-1]}" 234 | # @environment.each { |k,v| puts "#{k.inspect} #{v.inspect}"} 235 | rescue 236 | # If failed, tell user which line caused the problem 237 | puts "Error in #{@parser.filename} on line #{line}:", 238 | "#{@parser.lines[line-1]}" 239 | end 240 | end 241 | end 242 | end 243 | 244 | ## 245 | ## Main method 246 | ## 247 | def main 248 | if (ARGV.length < 1) then 249 | puts "ruby matrices.rb filename" 250 | return 251 | end 252 | filename = ARGV[0] 253 | parser = Parser.new(filename) 254 | Interpreter.new(parser).run 255 | end 256 | 257 | ## 258 | main() 259 | 260 | 261 | -------------------------------------------------------------------------------- /matrices-06-04.rb: -------------------------------------------------------------------------------- 1 | # Ruby Matrix interpreter for CMSC 330 2 | # Run this with 3 | # ruby matrices-06-04.rb ./file.mat 4 | # 5 | # @author Kris Micinski 6 | 7 | # A representation for matrices that performs various operations on 8 | # them, using a Ruby array of arrays as the internal representation. 9 | class Matrix 10 | # Define an accessor for the internal (array of arrays) 11 | # representation 12 | attr_accessor :mat 13 | 14 | # @param mat [Array[Array[Fixnum]]] The array based representation 15 | # of matrices: 16 | # 17 | # [ [ 1, 2], 18 | # [ 0, 1] ] 19 | # 20 | def initialize(mat) 21 | @mat = mat 22 | end 23 | 24 | def rows 25 | @mat.length 26 | end 27 | 28 | def columns 29 | @mat[0].length 30 | end 31 | 32 | # Add {self} to matrix {m} 33 | # @param m Matrix 34 | def add(m) 35 | m1 = @mat 36 | m2 = m.mat 37 | sum = Array.new(self.rows,Array.new()) 38 | 39 | (0...(self.rows)).each do |i| 40 | (0...(self.columns)).each do |j| 41 | sum[i][j] = m1[i][j] + m2[i][j] 42 | end 43 | end 44 | Matrix.new(sum) 45 | end 46 | 47 | # Multiply {self} and matrix {b} 48 | # @param m Matrix 49 | def product(b) 50 | n = self.rows 51 | m = self.columns 52 | p = b.columns 53 | prod = Array.new(n,[]) 54 | n.times do |i| 55 | p.times do |j| 56 | sum = 0 57 | (0...m).each { |k| sum = sum + @mat[i][k] * b.mat[k][j] } 58 | prod[i][j] = sum 59 | end 60 | end 61 | Matrix.new(prod) 62 | end 63 | end 64 | 65 | ## 66 | ## Statements 67 | ## 68 | 69 | # All statements have a method, {executeStatement}, that accept an 70 | # interpreter as its argument. The {executeStatement} method then 71 | # performs the necessary work to execute the statement. 72 | 73 | class StoreStatement 74 | 75 | # Construct a "store { a } { }" statement 76 | # @param targetVar [String] The variable being stored into 77 | # @param matrix [Matrix] The matrix being stored 78 | def initialize(targetVar,matrix) 79 | @target = targetVar 80 | @matrix = matrix 81 | end 82 | 83 | # Execute a store statement by taking the interpreter's environment, 84 | # and updating it to have add the key,value pair 85 | # {(@target => @matrix)}. 86 | def executeStatement(interpreter) 87 | interpreter.environment[@target] = @matrix 88 | end 89 | end 90 | 91 | class AddStatement 92 | # Construct an "add { a } { b } { c }" operation that adds matrices 93 | # a and b, and leaves the result in C. 94 | # @param operand1 [String] operand 1 variable name 95 | # @param operand2 [String] operand 2 variable name 96 | # @param resultVar [String] variable to store result 97 | def initialize(operand1,operand2,resultVar) 98 | @operand1 = operand1 99 | @operand2 = operand2 100 | @resultVar = resultVar 101 | end 102 | 103 | # Execute a statement by taking the interpreter's environment, 104 | # looking up operand 1, looking up operand 2, and leaving the result 105 | # in C. 106 | def executeStatement(interpreter) 107 | env = interpreter.environment 108 | env[@resultVar] = env[@operand1].add(env[@operand2]) 109 | end 110 | end 111 | 112 | class MultiplyStatement 113 | # Construct a "multiply { a } { b } { c }" operation that adds matrices 114 | # a and b, and leaves the result in C. 115 | def initialize(operand1,operand2,resultVar) 116 | @operand1 = operand1 117 | @operand2 = operand2 118 | @resultVar = resultVar 119 | end 120 | 121 | # Similar to add... 122 | def executeStatement(interpreter) 123 | env = interpreter.environment 124 | env[@resultVar] = env[@operand1].product(env[@operand2]) 125 | end 126 | end 127 | 128 | class PrintStatement 129 | # Construct a "print { a }" statement 130 | def initialize(varName) 131 | @varName = varName 132 | end 133 | 134 | # Turn a matrix object into a string 135 | # @param matrix The matrix to convert 136 | def matrixToString(matrix) 137 | string = "" 138 | matrix.rows.times do |i| 139 | string = string + "| " 140 | matrix.columns.times { |j| string = string + matrix.mat[i][j].to_s + " " } 141 | string = string + "|\n" 142 | end 143 | string 144 | end 145 | 146 | def executeStatement(interpreter) 147 | matrix = interpreter.environment[@varName] 148 | puts "#{@varName}:", matrixToString(matrix) 149 | end 150 | end 151 | 152 | ## 153 | ## Parsing 154 | ## 155 | class Parser 156 | # The filename being parsed 157 | attr :filename 158 | # The array of `{Print,Add,...}Statement` objects 159 | attr_reader :statements 160 | # The lines of the files 161 | attr_reader :lines 162 | 163 | def initialize(filename) 164 | @filename = filename 165 | @statements = [] 166 | end 167 | 168 | # Take a string like " [ [ 1 0 ] [ 0 1 ] ] " and turn it into a 169 | # {Matrix} object. 170 | def parseMatrix(str) 171 | matrix = [] 172 | str.scan(/\[((\s*\d\s*)+)\]/).each do |capture| 173 | columns = [] 174 | capture[0].split.each { |column| columns << column.to_i } 175 | matrix << columns 176 | end 177 | Matrix.new(matrix) 178 | end 179 | 180 | def parseStatement(statement) 181 | case statement 182 | when /store\s+{\s*([a-z]+)\s*}\s*{([^}]*)}/ 183 | var = $1 184 | matrix = $2 185 | StoreStatement.new(var,parseMatrix(matrix)) 186 | when /add\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 187 | a = $1 188 | b = $2 189 | to = $3 190 | AddStatement.new(a,b,to) 191 | when /negate\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 192 | a = $1 193 | to = $2 194 | NegateStatement.new(a,to) 195 | when /multiply\s+{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}\s*{\s*([a-z]+)\s*}/ 196 | a = $1 197 | b = $2 198 | to = $3 199 | MultiplyStatement.new(a,b,to) 200 | when /print\s+{\s*([a-z]+)\s*}/ 201 | PrintStatement.new($1) 202 | else 203 | nil 204 | end 205 | end 206 | 207 | def parseStatements 208 | i = 0 209 | @lines = File.readlines(@filename) 210 | @lines.each do |line| 211 | i = i+1 212 | statement = parseStatement(line) 213 | if statement then 214 | statements << statement 215 | else 216 | puts "Ignoring line #{i}: `#{line.strip}`" 217 | end 218 | end 219 | self 220 | end 221 | end 222 | 223 | ## 224 | ## Interpreter 225 | ## 226 | 227 | class Interpreter 228 | attr_accessor :environment 229 | 230 | # Construct an interpreter object 231 | def initialize(parser) 232 | @parser = parser 233 | @environment = {} 234 | end 235 | 236 | def run 237 | # First, parse all of the statements 238 | @parser.parseStatements 239 | line = 0 240 | # Next, execute each in turn 241 | @parser.statements.each do |statement| 242 | line = line+1 243 | # Attempt to execute the statement 244 | begin 245 | statement.executeStatement(self) 246 | # For debugging 247 | # puts "#{@parser.lines[line-1]}" 248 | # @environment.each { |k,v| puts "#{k.inspect} #{v.inspect}"} 249 | rescue 250 | # If failed, tell user which line caused the problem 251 | puts "Error in #{@parser.filename} on line #{line}:", 252 | "#{@parser.lines[line-1]}" 253 | end 254 | end 255 | end 256 | end 257 | 258 | ## 259 | ## Main method 260 | ## 261 | def main 262 | if (ARGV.length < 1) then 263 | puts "ruby matrices.rb filename" 264 | return 265 | end 266 | filename = ARGV[0] 267 | parser = Parser.new(filename) 268 | Interpreter.new(parser).run 269 | end 270 | 271 | ## 272 | main() 273 | 274 | 275 | -------------------------------------------------------------------------------- /module-systems/README.md: -------------------------------------------------------------------------------- 1 | # Kris Micinski's OCaml Module System notes 2 | 3 | - [`trees.ml`](trees.ml) -- Explaining the module system by example 4 | - [`modules.ml`](modules.ml) -- Buffer from class 5 | -------------------------------------------------------------------------------- /module-systems/modules.ml: -------------------------------------------------------------------------------- 1 | let x = 23 2 | 3 | module ListMap = struct 4 | type ('a, 'b) list_map = ('a * 'b) list 5 | 6 | let empty_map = [] 7 | 8 | let add key value list = (key,value)::list 9 | 10 | let rec lookup key = function 11 | | [] -> failwith "no key" 12 | | (hd,v)::tl -> if hd = key then v else lookup key tl 13 | end 14 | 15 | module TreeMap = struct 16 | type ('a, 'b) tree_map = 17 | | Empty 18 | | Node of 'a * 'b * ('a, 'b) tree_map * ('a, 'b) tree_map 19 | 20 | let empty_map = Empty 21 | 22 | let rec add key value tm = match tm with 23 | | Empty -> Node (key,value,Empty,Empty) 24 | | Node (k,v,t1,t2) -> 25 | (if k = key then 26 | Node(k,value,t1,t2) 27 | else 28 | (if key < k then 29 | Node(k,v,add key value t1, t2) 30 | else 31 | Node(k,v,t1,add key value t2))) 32 | 33 | let rec lookup key tm = match tm with 34 | | Empty -> failwith "no key" 35 | | Node (k,v,t1,t2) -> 36 | (if k = key then 37 | v 38 | else 39 | (if key < k then 40 | lookup key t1 41 | else 42 | lookup key t2)) 43 | end 44 | 45 | module type ASSOC_MAP = sig 46 | type ('a, 'b) t 47 | val empty_map : ('a, 'b) t 48 | val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t 49 | val lookup : 'a -> ('a, 'b) t -> 'b 50 | end 51 | 52 | module ListMap : ASSOC_MAP = struct 53 | type ('a, 'b) t = ('a * 'b) list 54 | 55 | let empty_map = [] 56 | 57 | let add key value list = (key,value)::list 58 | 59 | let rec lookup key = function 60 | | [] -> failwith "no key" 61 | | (hd,v)::tl -> if hd = key then v else lookup key tl 62 | end 63 | 64 | module type ORDERED = sig 65 | type t 66 | val compare : t -> t -> int 67 | end 68 | 69 | module IntOrder : ORDERED = struct 70 | type t = int 71 | let compare x y = y - x 72 | end 73 | 74 | module PairOrder : ORDERED = struct 75 | type t = int * int 76 | let compare (x1,y1) (x2,y2) = 77 | if (x1 > x2) then y1 - y2 78 | else y2 - y1 79 | end 80 | 81 | module type ASSOC_MAP = sig 82 | type key 83 | type 'a t 84 | val empty_map : 'a t 85 | val add : key -> 'a -> 'a t -> 'a t 86 | val lookup : key -> 'a t -> 'a 87 | end 88 | 89 | module TreeMap (Key : ORDERED) : ASSOC_MAP with type key = Key.t = struct 90 | type key = Key.t 91 | 92 | type 'a t = 93 | | Empty 94 | | Node of key * 'a * 'a t * 'a t 95 | 96 | let empty_map = Empty 97 | 98 | let rec add key value tm = match tm with 99 | | Empty -> Node (key,value,Empty,Empty) 100 | | Node (k,v,t1,t2) -> 101 | (if (Key.compare k key = 0) then 102 | Node(k,value,t1,t2) 103 | else 104 | (if (Key.compare key k < 0) then 105 | Node(k,v,add key value t1, t2) 106 | else 107 | Node(k,v,t1,add key value t2))) 108 | 109 | let rec lookup key tm = match tm with 110 | | Empty -> failwith "no key" 111 | | Node (k,v,t1,t2) -> 112 | (if (Key.compare k key = 0) then 113 | v 114 | else 115 | (if (Key.compare key k < 0) then 116 | lookup key t1 117 | else 118 | lookup key t2)) 119 | end 120 | 121 | 122 | 123 | -------------------------------------------------------------------------------- /module-systems/trees.ml: -------------------------------------------------------------------------------- 1 | (* 2 | CMSC 330 -- Summer 2015 3 | Lectures on the OCaml module system 4 | *) 5 | 6 | (* So far, we've been writing OCaml code that is comprised of single 7 | files. But large projects are typically comprised of many 8 | components that need to be designed, implemented, and validated 9 | independently. 10 | 11 | In object oriented languages, we typically structure code using 12 | classes and interfaces. Each language is slightly different, but 13 | the overarching concept is modularity: classes offer a way to group 14 | code into logical components. 15 | 16 | As we design larger and larger software, we begin to realize that 17 | modularity and encapsulation are a key aspect of designing robust 18 | code. In a large system, we will naturally find that code needs to 19 | change to accommodate new features. If our system is not organized 20 | in a way that allows this to happen, the code quality can easily 21 | diminish over time. 22 | 23 | In OCaml (and its predecessor, Standard ML) we group code using 24 | modules. 25 | 26 | *) 27 | 28 | (* -------------------------------------------------------------------------- *) 29 | (* Module basics *) 30 | (* -------------------------------------------------------------------------- *) 31 | 32 | (* Let's think back to our implementation of association maps. We 33 | could have implemented them using association lists: *) 34 | type ('a, 'b) assoc_map_list = ('a * 'b) list 35 | let empty_map = [] 36 | let add_entry key value l = (key,value)::l 37 | let rec lookup key = function 38 | | [] -> failwith "no matching key" 39 | | (hd,v)::tl -> if key = hd then v else lookup key tl 40 | 41 | (* When a programmer wants to use this code, they need to copy and 42 | paste it into their file. We should be anxious about code smell 43 | whenever we are copy and pasting, there is almost always a better 44 | way. It pollutes the codebase: the implementation of association 45 | lists is in the same place as the code that uses it (confusing the 46 | reader). But it also leads to potential error. When multiple 47 | pieces of code use association lists, what do they do. 48 | 49 | In the toplevel, you might think the answer is that they could 50 | write `#use` and the file name. This is a solution very similar to 51 | `#include` in C, but doesn't work for compiled software and doesn't 52 | have the advantages of real modules we'll soon see. 53 | *) 54 | 55 | (* So as an alternative, let's group the association list in a 56 | module. 57 | 58 | modules have the syntax: 59 | *) 60 | module LMap = struct 61 | (* The things between the `struct` and the `end` are the module's 62 | components. This is similar to the beginning and ending curly 63 | braces for Java classes. *) 64 | 65 | (* Inside modules we can write code as usual: *) 66 | type ('a, 'b) assoc_map_list = ('a * 'b) list 67 | let empty_map = [] 68 | let add_entry key value l = (key,value)::l 69 | let rec lookup key = function 70 | | [] -> failwith "no matching key" 71 | | (hd,v)::tl -> if key = hd then v else lookup key tl 72 | end 73 | 74 | (* 75 | Now, if we type this into OCaml, OCaml will tell us: 76 | 77 | module Tree : 78 | sig 79 | type ('a, 'b) assoc_map_list = ('a * 'b) list 80 | val empty_map : 'a list 81 | val add_entry : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list 82 | val lookup : 'a -> ('a * 'b) list -> 'b 83 | end 84 | 85 | Typing in the module gave us a *signature*. The signature 86 | (beteween the `sig` and `end`) is the specification for the module: 87 | it includes the types of the components, along with their names, 88 | but not the implementation. Think of the signature as the module's 89 | interface. 90 | 91 | When the programmer uses the `Tree` module, they will program 92 | against its signature. Just like OCaml terms have types, OCaml 93 | modules have signatures. And just as types are checked, signatures 94 | are checked too. We can force a module to have a certain signature 95 | by using a notation we'll talk about later. If we leave it off, 96 | OCaml will infer the signature for us, just like with terms. 97 | 98 | *) 99 | 100 | (* To use things from the `Tree` module, we prefix functions inside 101 | the module with the module's name: *) 102 | 103 | let a = LMap.add_entry "h" 1 LMap.empty_map 104 | 105 | (* This can sometimes be frustratingly verbose, and so we sometimes 106 | alias the module with a simpler name: *) 107 | 108 | module M = LMap 109 | 110 | let a' = M.add_entry "h" 1 M.empty_map 111 | 112 | (* -------------------------------------------------------------------------- *) 113 | (* Signatures and Specifications *) 114 | (* -------------------------------------------------------------------------- *) 115 | 116 | (* In the above module, we implemented association maps as lists. But 117 | as we've seen, we also could have choosen to implement association 118 | maps as trees. So let's make another module that implements 119 | assocation maps as trees: 120 | *) 121 | module TMap = struct 122 | type ('a, 'b) assoc_tree = 123 | | Empty 124 | | Leaf of 'a * 'b * ('a, 'b) assoc_tree * ('a, 'b) assoc_tree 125 | 126 | let empty_map = Empty 127 | let rec add_entry key value t = match t with 128 | | Empty -> Leaf (key,value,Empty,Empty) 129 | | Leaf (k,v,t1,t2) -> 130 | if key = k then t 131 | else 132 | (if key < k then 133 | Leaf (key,v,add_entry key value t1, t2) 134 | else 135 | Leaf (key,v,t1,add_entry key value t2)) 136 | 137 | let rec lookup key = function 138 | | Empty -> failwith "no matching key" 139 | | Leaf (k,v,t1,t2) -> 140 | if k = key then v else (lookup key (if key < k then t1 else t2)) 141 | end 142 | 143 | (* Now we have two implementations of association maps. 144 | 145 | Let's say we have some code that uses an `LMap`. We might like to 146 | be able to switch easily between an `LMap` and a `TMap`: they're 147 | both doing the same thing: the programmer isn't using anything 148 | specific about their implementation. 149 | 150 | But what if the programmer *does* use something about their 151 | implementation. Let's think about the following use of LMap: 152 | 153 | *) 154 | let x = LMap.lookup "hello" [("hello","world")] 155 | 156 | (* val x : string = "world" 157 | 158 | But now, this won't work for TMaps: 159 | 160 | # let x = TMap.lookup "hello" [("hello","world")] 161 | Error: This variant expression is expected to have type 162 | (string, 'a) TMap.assoc_tree 163 | The constructor :: does not belong to type TMap.assoc_tree 164 | 165 | What went wrong here? TMap lookup relies on being passed a tree. 166 | To fix this, we need *encapsulation*. The implementation of maps 167 | should be able to do whatever it wants for the type. It should be 168 | internal to `TMap` or `LMap`, but the programmer shouldn't be able 169 | to rely on it. A similar concept arises in object oriented 170 | programming: you shouldn't rely on objects' private member 171 | variables. We make variables private because they hold details 172 | that would break the abstraction boundary between the 173 | implementation and the interface. 174 | 175 | To fix this problem, we're going to make an interface common to all 176 | assocation maps. Earlier we said that OCaml would infer a module 177 | specfication if we didn't manually write one. But sometimes this 178 | is bad, because we want to force a more abstract implementation of 179 | the module. OCaml can't know a priori what we want the interface 180 | to be: that's our choice as the designer. So let's design a 181 | signature for what we think assocation maps should look like: 182 | *) 183 | 184 | (* Note that modules use `module M = struct ... end` and signatures 185 | use `module type M = sig ... end` 186 | *) 187 | 188 | module type ASSOC_MAP = sig 189 | 190 | (* Here we're saying that the module must have *some* type named t 191 | (with two parameters). But we aren't saying what it is. It could 192 | be anything, it could be assocation list, it could be a tree, 193 | whatever. All we require is that it's named `t`. 194 | 195 | Because we haven't specified what the type is, the programmer is 196 | **not allowed** to know. We'll come back to this later. 197 | *) 198 | type ('a, 'b) t 199 | 200 | (* Here, we're going to stipulate that there is a value named 201 | `empty_map`, which has that type. *) 202 | val empty_map : ('a, 'b) t 203 | 204 | (* And so on for the other components... *) 205 | val add_entry : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t 206 | val lookup : 'a -> ('a,'b) t -> 'b 207 | end 208 | 209 | (* Now we have a specification, let's start writing modules that have 210 | that type. To force a module to adhere to a specification, we use the syntax 211 | 212 | module Name : NAME = struct ... end 213 | 214 | Where `Name` is the module's name, and `NAME` is the name of some 215 | signature we have already defined. We can also specify the 216 | signature right there by writing `sig ... end` instead of `NAME` 217 | (just like we can write `23` instead of `x`). But we usually 218 | define them separately for readibility. 219 | 220 | Let's try this with our list module: 221 | *) 222 | module LMap2 : ASSOC_MAP = struct 223 | type ('a, 'b) t = ('a * 'b) list 224 | let empty_map = [] 225 | let add_entry key value l = (key,value)::l 226 | let rec lookup key = function 227 | | [] -> failwith "no matching key" 228 | | (hd,v)::tl -> if key = hd then v else lookup key tl 229 | end 230 | 231 | (* Note that we had to change the type `assoc_map_list` to `t`. 232 | Otherwise OCaml would complain to us with the following error: 233 | 234 | File "trees.ml", line 222, characters 27-282: 235 | Error: Signature mismatch: 236 | ... 237 | The type `t' is required but not provided 238 | File "trees.ml", line 198, characters 7-17: Expected declaration 239 | 240 | This error happens because the module implementation `LMap2` does 241 | not meet its specification. And OCaml explicitly tells us why it 242 | doesn't, just like with a type error. 243 | *) 244 | 245 | (* Let's try our bad code again: 246 | 247 | let x = LMap2.lookup "hello" [("hello","world")] 248 | 249 | OCaml yells at us: 250 | 251 | Error: This expression has type 'a list 252 | but an expression was expected of type (string, 'b) LMap2.t 253 | 254 | Why? Inside LMap2, it's obvious the implementation uses a list, so 255 | this should typecheck. But the answer is that we've **hidden** the 256 | definition of the type `t` outside of the module. When we're 257 | outside of `LMap2`'s implemetation, the programmer is only allowed 258 | to know that there is a type `t`. To use that type `t`, they have 259 | to use the functions provided in the module to interact with it. 260 | 261 | This is encapsulation in action. Instead, we're forced to write the code like this: 262 | 263 | *) 264 | 265 | let x = LMap2.add_entry "hello" "world" LMap2.empty_map 266 | let y = LMap2.lookup "hello" x 267 | 268 | (* This is great, because now we can define TMap2 the same way. It 269 | * almost* works, but the type is named the wrong thing. We really 270 | want a module that is the same as TMap, but has a type `t` that is 271 | equal to `assoc_tree` for TMap: *) 272 | module TMap2 : ASSOC_MAP = struct 273 | 274 | (* You might think that we have to repeat the entire definition of 275 | the module here. But we actually don't. We can use the `include` 276 | keyword, which takes the components of the module `TMap`, and 277 | includes them in this module. *) 278 | include TMap 279 | 280 | (* And now we just define a type `t` that is equal to `assoc_tree`. *) 281 | type ('a, 'b) t = ('a, 'b) assoc_tree 282 | end 283 | 284 | (* Now we can use the module just like LMap2. *) 285 | let x = TMap2.add_entry "hello" "world" TMap2.empty_map 286 | let y = TMap2.lookup "hello" x 287 | 288 | (* Now we can swap from tree maps to list maps at will. 289 | 290 | The typical way this is done is something like: 291 | *) 292 | module M = LMap2 293 | 294 | (* code that uses M .... *) 295 | 296 | (* Now, if we later decide we want a different module, we can simply 297 | change `LMap2` to `TMap2`. 298 | *) 299 | 300 | (* -------------------------------------------------------------------------- *) 301 | (* Parameterized Modules and Functors *) 302 | (* -------------------------------------------------------------------------- *) 303 | 304 | (* In our implementation of TMap2, we used the `<` operator to 305 | implement comparison. This is alright, because the `<` operator is 306 | defined for all types. But the `<` operator really only makes 307 | sense for things like integers. A better design would be for the 308 | programmer give us an implementation of `<` that they wanted us to 309 | use to compare keys. 310 | 311 | But how could we do that. One way is that we could have the 312 | programmer write a separate map implementation for each tree map: 313 | 314 | module IntKeyTreeMap : ASSOC_MAP = ... 315 | module StringKeyTreeMap : ASSOC_MAP = ... 316 | 317 | etc... 318 | 319 | But a better implementation would be to define tree based 320 | association maps agnostic of the comparison operation. To do this 321 | we can use a *functor*, which is a module that accepts a module as 322 | a parameter: 323 | 324 | *) 325 | 326 | module type ORDERED_KEY = sig 327 | type t 328 | 329 | (* `compare a b` will return: 330 | - 0, when `a` and `b` are equal 331 | - <0, when `a` is greater than `b` 332 | - >0, when `a` is less than `b` 333 | 334 | E.g., for ints it could be `b-a` 335 | *) 336 | val compare : t -> t -> int 337 | end 338 | 339 | module TreeMap (Key : ORDERED_KEY) = struct 340 | (* Notice how the previous ('a, 'b) becomes simply 'a. *) 341 | type 'a t = 342 | | Empty 343 | | Leaf of Key.t * 'a * 'a t * 'a t 344 | 345 | let empty_map = Empty 346 | let rec add_entry key value t = match t with 347 | | Empty -> Leaf (key,value,Empty,Empty) 348 | | Leaf (k,v,t1,t2) -> 349 | if (Key.compare key k = 0) then t 350 | else 351 | (if (Key.compare key k < 0) then 352 | Leaf (key,v,add_entry key value t1, t2) 353 | else 354 | Leaf (key,v,t1,add_entry key value t2)) 355 | 356 | let rec lookup key = function 357 | | Empty -> failwith "no matching key" 358 | | Leaf (k,v,t1,t2) -> 359 | if (Key.compare k key = 0) then v else 360 | (lookup key (if (Key.compare key k < 0) then t1 else t2)) 361 | end 362 | 363 | (* Now, note that we can't simply use TreeMap.empty_map: 364 | 365 | # TreeMap.empty_map;; 366 | Error: The module TreeMap is a functor, not a structure 367 | 368 | To actually use TreeMap, we need to create a concrete instance of 369 | it. Let's create one that uses integer pairs (x,y) as the keys: 370 | *) 371 | module M = TreeMap(struct 372 | type t = int * int 373 | let compare (x1,y1) (x2,y2) = 374 | if x1 >= x2 then y1 - y2 375 | else - (y2 - y1) 376 | end) 377 | 378 | (* And then, TreeMap(IntPairKey) *) 379 | 380 | let m = M.add_entry (3,5) "hello" M.empty_map 381 | let x = M.lookup (3,5) m 382 | 383 | (* Now, I can create a custom comparator to be used for individual map 384 | instances. *) 385 | 386 | (* -------------------------------------------------------------------------- *) 387 | (* Using the `with type` notation *) 388 | (* -------------------------------------------------------------------------- *) 389 | 390 | (* In the last module I wrote, I made a little mistake: I didn't force 391 | it to implement the `ASSOC_MAP` signature. Let's do that: 392 | 393 | module TreeMap2 (Key : ORDERED_KEY) : ASSOC_MAP = TreeMap 394 | 395 | Error: Signature mismatch: 396 | Modules do not match: 397 | functor (Key : ORDERED_KEY) -> 398 | sig 399 | type 'a t = 400 | 'a TreeMap(Key).t = 401 | Empty 402 | | Leaf of Key.t * 'a * 'a t * 'a t 403 | val empty_map : 'a t 404 | val add_entry : Key.t -> 'a -> 'a t -> 'a t 405 | val lookup : Key.t -> 'a t -> 'a 406 | end 407 | is not included in 408 | ASSOC_MAP 409 | 410 | The reason is this: the ASSOC_MAP signature has two type parameters 411 | for the map, but TreeMap only has one. To fix this problem, we'll 412 | change the ASSOC_MAP signature a little bit to include the key as a 413 | type within the structure: 414 | *) 415 | module type ASSOC_MAP = sig 416 | type key 417 | type 'value t 418 | val empty_map : 'value t 419 | val add_entry : key -> 'value -> 'value t -> 'value t 420 | val lookup : key -> 'value t -> 'value 421 | end 422 | 423 | (* Now we should be able to do it by including the previous 424 | implementation of `TreeMap` *) 425 | module TreeMap2 (Key : ORDERED_KEY) : ASSOC_MAP = struct 426 | (* In this module, we have now named a key type, and specified it 427 | must be the type `t` from `Key` *) 428 | type key = Key.t 429 | 430 | (* And now we just want to include the previous implementation *) 431 | include TreeMap(Key) 432 | end 433 | 434 | (* And an example key datatype. *) 435 | module IntPairKey : ORDERED_KEY = struct 436 | type t = int * int 437 | let compare (x1,y1) (x2,y2) = 438 | if x1 >= x2 then y1 - y2 439 | else - (y2 - y1) 440 | end 441 | 442 | (* Let's make an example tree map with our ordered key, and then add 443 | things to it: *) 444 | module TM = TreeMap2(IntPairKey) 445 | 446 | (* If we try to do.. 447 | 448 | # TM.add_entry (1,2) "hello" TM.empty_map;; 449 | Error: This expression has type 'a * 'b 450 | but an expression was expected of type 451 | TM.key = TreeMap2(IntPairKey).key 452 | 453 | We get an error immediately! Why? We know that the type of the 454 | key defined in IntPairKey was an int pair. Here, OCaml is hiding 455 | something from us: it's hiding the association that the type of 456 | `key` in `TreeMap2(S : ORDERED_KEY)` (for a given structure `S`) is 457 | equal to the type `S.t`. 458 | 459 | To get past this, we need to employ a little bit of a hack. We 460 | need to use an annotation, usually known as a `with type` 461 | annotation. These annotations allow us to assert type equalities 462 | to OCaml's type checker, and give the extra hint that allows us to 463 | get us to our goal. To do this, we restructure `TreeMap2` like so: 464 | *) 465 | 466 | module TreeMap3 (Key : ORDERED_KEY) : (ASSOC_MAP with type key = Key.t) = struct 467 | (* In this module, we have now named a key type, and specified it 468 | must be the type `t` from `Key` *) 469 | type key = Key.t 470 | 471 | (* And now we just want to include the previous implementation *) 472 | include TreeMap(Key) 473 | end 474 | 475 | (* Notice that the only thing that changes here is the signature we 476 | put on the `TreeMap3` functor. We're telling OCaml, "this module 477 | has signature ASSOC_MAP, but let the type checker know that the 478 | type of key inside ASSOC_MAP is equal to (the same type as) the 479 | type `Key.t` from the `Key` module on which the functor is 480 | parameterized." 481 | 482 | Now we can do like so... 483 | *) 484 | module TM = TreeMap3(IntPairKey) 485 | 486 | (* And now we get... 487 | 488 | # TM.add_entry (1,2) "hello" TM.empty_map;; 489 | Error: This expression has type 'a * 'b 490 | but an expression was expected of type TM.key = IntPairKey.t 491 | 492 | So we're still not quite done. Unfortunately, now OCaml is telling 493 | us that it doesn't know the type of `IntPairKey.t`. This is to be 494 | expected: we've "hidden" that type by using the module. The 495 | easiest way to fix this is to add another `with type` annotation to 496 | the `IntPairKey` module: 497 | 498 | *) 499 | module IntPairKey : (ORDERED_KEY with type t = int * int) = struct 500 | type t = int * int 501 | let compare (x1,y1) (x2,y2) = 502 | if x1 >= x2 then y1 - y2 503 | else - (y2 - y1) 504 | end 505 | 506 | module TM = TreeMap3(IntPairKey);; 507 | 508 | (* And now... *) 509 | TM.add_entry (1,2) "hello" TM.empty_map 510 | 511 | (* - : string TM.t = *) 512 | -------------------------------------------------------------------------------- /ocaml/.#dfapractice.ml: -------------------------------------------------------------------------------- 1 | micinski@Kristophers-MacBook-Pro-2.local.91910 -------------------------------------------------------------------------------- /ocaml/README.md: -------------------------------------------------------------------------------- 1 | Kristopher Micinski's Lectures on OCaml / Functional Programming 2 | ================================================================ 3 | 4 | This directory contains a set of lectures on introductory functional 5 | programming with OCaml. This material is presented in 6 | [CMSC 330, summer 2015](http://www.cs.umd.edu/class/summer2015/cmsc330/). 7 | 8 | - June 15th: Basics 9 | - [`small.ml`](small.ml) -- Small example 10 | - [`let.ml`](let.ml) -- Using `let` 11 | - 12 | 13 | - June 16th: Binary trees and DFAs 14 | - [`binaryTrees.ml`](binaryTrees.ml) 15 | - [`dfas.ml`](dfas.ml) 16 | 17 | - June 17th: Higher order functional programming and reduction 18 | - [`higherorder.ml`](higherorder.ml) 19 | 20 | - June 18th: Understanding OCaml's type system and type inference 21 | - [`types.ml`](types.ml) 22 | - Buffers from class: [`typeslec.ml`](typeslec.ml) [`typeslec2.ml`](typeslec2.ml) 23 | -------------------------------------------------------------------------------- /ocaml/all_wrong.ml: -------------------------------------------------------------------------------- 1 | print_int "This function expected an int";; 2 | 3 | 1 + true;; 4 | 5 | 1 + 0.5;; 6 | 7 | [1; 2; "lists must be homogeneous"];; 8 | 9 | [1, 2, 3];; (* probably not what you expect; 10 | this list has _one_ element *) 11 | 12 | [1;2] :: 3 (* expects a list on the right of :: *) 13 | 14 | 15 | let hd ls = match ls with (h::_) -> h;; 16 | hd [];; 17 | -------------------------------------------------------------------------------- /ocaml/binaryTrees.ml: -------------------------------------------------------------------------------- 1 | (* ------------------------------------------------------ *) 2 | (* List examples *) 3 | (* ------------------------------------------------------ *) 4 | 5 | (* An example type for integer lists. 6 | Note that these are *separate* from the standard OCaml type 7 | for lists, which are 'a lists. *) 8 | type lst = 9 | | Nil 10 | | Cons of int * lst 11 | 12 | (* You build a value of type `lst` by using it's constructors. You 13 | build it in a "russian nesting doll" fashion: start with a base 14 | constructor (a constructor that doesn't talk about `lst` 15 | recursively) and apply constructors to construct larger values. 16 | *) 17 | 18 | let a = Cons (23, Cons(13, Nil)) 19 | 20 | let add_another = Cons (1, a) 21 | 22 | (* Calculate the length of an `lst`. 23 | * 24 | * Note that (a : lst) means the parameter will be of type `lst`, and 25 | * `: int` means the result will be int 26 | *) 27 | let rec length (a : lst) : int = match a with (* I use `match` to consider the possible 28 | cases for `a` *) 29 | | Nil -> 0 (* empty list is length zero *) 30 | | Cons (_, tl) -> 1 + length tl (* Note I used a wildcard `_` because I didn't care 31 | what the element's value was. *) 32 | 33 | (* Concatenate two lists. Note that if I leave off the type 34 | annotations, OCaml will infer them. 35 | *) 36 | 37 | let rec concat a b : lst = 38 | match a with 39 | | Nil -> b 40 | | Cons (hd,tl) -> Cons (hd, concat tl b) 41 | 42 | let a_twice = concat a a 43 | 44 | (* Instructor's note: Don't be confused by `lst`. It's *not* the same 45 | * thing as the standard library type `list`. It's just a type that 46 | * behaves the same way. In particular, I can't use `List.length` on 47 | * elements of type `lst`. If this confuses you, please ask for 48 | * clarification. It's just like if I defined a class `MyList` in Ruby, 49 | * and defined some methods on it. I couldn't use the standard array 50 | * methods on `MyList`, only methods I explicitly defined. 51 | *) 52 | 53 | (* ------------------------------------------------------ *) 54 | (* Binary tree examples *) 55 | (* ------------------------------------------------------ *) 56 | 57 | (* A binary tree is a leaf, or a node that contains two subtrees. *) 58 | type tree = 59 | | Leaf of int 60 | | Node of int * tree * tree 61 | 62 | (* An example tree *) 63 | let example_tree : tree = 64 | Node (23,(Leaf 13),(Leaf 42)) 65 | 66 | let rec height t = match t with 67 | | Leaf _ -> 1 (* A leaf has height 1 *) 68 | | Node (_,t1,t2) -> 1 + max (height t1) (height t2) (* I use the built in `max` *) 69 | 70 | (* A tree is balanced when its children are balanced and have equal height *) 71 | let rec balanced t = match t with 72 | | Leaf _ -> true 73 | | Node (_,t1,t2) -> (balanced t1) && (balanced t2) && (height t1 = height t2) 74 | 75 | (* Binary search *) 76 | let rec includes t i = match t with 77 | | Leaf x -> x = i 78 | | Node (x,t1,t2) -> 79 | if (x = i) then 80 | true 81 | else (if (x > i) then 82 | includes t2 i 83 | else 84 | includes t1 i) 85 | 86 | (* Turn a tree into a list of elements. *) 87 | let rec elements (t : tree) : int list = 88 | match t with 89 | | Leaf i -> [i] (* Note that [i] = i :: [] *) 90 | | Node(i,t1,t2) -> [i] @ (elements t1) @ (elements t2) 91 | 92 | let elems_of_example = elements example_tree 93 | 94 | (* ------------------------------------------------------ *) 95 | (* Practice problems *) 96 | (* ------------------------------------------------------ *) 97 | 98 | (* Calculate the min element of a sorted tree. Hint: Go down the left 99 | spine of the tree. When you get to a point where you have nowhere 100 | else to go (a leaf), you've got the min element. *) 101 | let rec min (t : tree) = failwith "undefined" (* Note that you can use `failwith` 102 | to generate a runtime exception *) 103 | 104 | let rec max (t : tree) = failwith "undefined" 105 | 106 | (* Insert i into sorted binary tree t. 107 | * As an example, to insert 12 into the following binary tree: 108 | * 109 | * 23 110 | * / \ 111 | * 14 25 112 | * 113 | * I would get: 114 | * 23 115 | * / \ 116 | * 12 25 117 | * \ 118 | * 14 119 | *) 120 | let rec insert (t : tree) (i : int) : tree = 121 | failwith "undefined" 122 | 123 | (* Insert each element of l into t *) 124 | let rec insert_many (t : tree) (i : int list) : tree = 125 | failwith "undefined" 126 | 127 | 128 | 129 | -------------------------------------------------------------------------------- /ocaml/conditionals.ml: -------------------------------------------------------------------------------- 1 | (* Conditionals *) 2 | 3 | let print_grade score = 4 | if score >= 90 then 5 | print_string "You got an A\n" 6 | else if score >= 80 then 7 | print_string "You got an B\n" 8 | else if score >= 70 then 9 | print_string "You got an C\n" 10 | else 11 | print_string "Let's all practice OCaml\n";; 12 | 13 | print_grade 100;; 14 | 15 | 16 | let is_the_answer y = 17 | let answer = 42 in 18 | y = answer;; (* how do you grok this? *) 19 | 20 | is_the_answer 17;; 21 | is_the_answer 42;; 22 | 23 | 24 | (* Comparing other types *) 25 | 26 | let eq (x,y) = x = y;; (* = is polymorphic, too *) 27 | 28 | eq(3, 3);; 29 | 30 | let x = "hi";; 31 | let y = x;; 32 | eq(x,y);; 33 | 34 | eq("hi", "hi");; 35 | 36 | 37 | 38 | (* == *) 39 | 40 | let eqeq(x,y) = x == y;; 41 | 42 | (* What is an _experiment_ we could run to figure out = vs. == ? *) 43 | 44 | eqeq(3, 3);; 45 | 46 | let x = "hi";; 47 | let y = x;; 48 | eqeq(x, y);; 49 | 50 | eqeq("hi", "hi");; 51 | -------------------------------------------------------------------------------- /ocaml/dfapractice.ml: -------------------------------------------------------------------------------- 1 | type state = int 2 | 3 | type symbol = char 4 | 5 | type transition = state * symbol * state 6 | 7 | (* 8 | * Set of states, 9 | * Alphabet, 10 | * Initial state, 11 | * Transition list, 12 | * Accepting states 13 | *) 14 | type dfa = state list * symbol list * state * transition list * state list 15 | 16 | let d : dfa = ([0],['1'],0,[(0,'1',0)],[]) 17 | 18 | let states (d:dfa) = match d with 19 | | (s,_,_,_,_) -> s 20 | 21 | (* What happens if I leave off dfa annotation? Mess up an element *) 22 | let transitions ((_,_,_,t,_):dfa) = t 23 | 24 | (* 25 | let states ((s,_,_,_,_):dfa) = s 26 | *) 27 | 28 | (* Using the record notation. 29 | https://realworldocaml.org/v1/en/html/records.html 30 | *) 31 | type dfa = 32 | { 33 | states : state list; 34 | sigma : symbol list; 35 | start : state; 36 | transitions : transition list; 37 | accepting : state list; 38 | } 39 | 40 | (* Dereference with .field, e.g., dfa.states *) 41 | let states dfa = dfa.states 42 | 43 | let addTransition (t:transition) dfa = { dfa with transitions = t::dfa.transitions } 44 | 45 | (* Helper function. *) 46 | let explode s = 47 | let rec expl i l = 48 | if i < 0 then l else 49 | expl (i - 1) (s.[i] :: l) in 50 | expl (String.length s - 1) [];; 51 | 52 | let rec contains e l = 53 | match l with 54 | | [] -> false 55 | | hd::tl -> if hd = e then true else contains e tl 56 | 57 | let checkAccepts str dfa = 58 | let symbols = explode str in 59 | let next_state state symbol = 60 | let rec find_state l = 61 | match l with 62 | | (s1,sym,s2)::tl -> 63 | if (s1 = state && sym = symbol) then s2 64 | else find_state tl 65 | | [] -> failwith "no transition defined" 66 | in 67 | find_state dfa.transitions 68 | a 69 | 70 | 71 | 72 | 73 | 74 | let checkAccepts str dfa = 75 | let symbols = explode str in 76 | (* If I'm at state {state}, where do I go on {symbol}? *) 77 | let next_state state symbol = 78 | let rec find_state l = 79 | match l with 80 | | (s1,sym,s2)::tl -> 81 | if (s1 = state && symbol = sym) then s2 82 | else 83 | find_state tl 84 | | _ -> failwith "no next state" 85 | in 86 | find_state dfa.transitions 87 | in 88 | (* Start the search at current_state, consuming symbol list *) 89 | let rec search_from current_state symbol_list = 90 | match symbol_list with 91 | | [] -> current_state 92 | | sym::tl -> search_from (next_state current_state sym) tl 93 | in 94 | let end_state = search_from dfa.start symbols in 95 | if (contains end_state dfa.accepting) 96 | then 97 | true 98 | else 99 | false 100 | 101 | let d : dfa = 102 | { states = [0;1]; 103 | sigma = ['0';'1']; 104 | start = 0; 105 | transitions = 106 | [(0,'0',0); 107 | (0,'1',1); 108 | (1,'0',0); 109 | (1,'1',1)]; 110 | accepting = [1] 111 | } 112 | 113 | 114 | -------------------------------------------------------------------------------- /ocaml/dfas.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * DFAs in OCaml 3 | *) 4 | 5 | (* Let's make a module for representing deterministic finite automata 6 | in OCaml. We're going to see that the mathematical definition of a 7 | DFA, given by Wikipedia, is going to lead to a very simple 8 | implementation of DFAs in our setting. 9 | 10 | First, let's think back to what DFAs were, when we introduced them 11 | formally. Wikipedia says: 12 | 13 | A deterministic finite automaton M is a 5-tuple, (Q, Σ, δ, q0, 14 | F), consisting of 15 | - a finite set of states (Q) 16 | - a finite set of input symbols called the alphabet (Σ) 17 | - a transition function (δ : Q × Σ → Q) 18 | - a start state (q0 ∈ Q) 19 | - a set of accepting states (F ⊆ Q) 20 | 21 | Now, let's translate this into OCaml! 22 | *) 23 | 24 | (* We're going to say states are just numbers. This means that our 25 | set q is going to just be a set of integers. We're just going to 26 | represent this as a list of integers. For example, in [this 27 | machine](https://en.wikipedia.org/wiki/Deterministic_finite_automaton#/media/File:DFA_example_multiplies_of_3.svg), 28 | the set of states is just going to be represented (by us) using the 29 | list [0;1;2] 30 | *) 31 | 32 | (* The following line creates a type *alias*. It tells the ocaml 33 | compiler to, whenever it sees `state`, treat that type as int. Why 34 | not just use `int` everywhere? Well, what happens later if we want 35 | to refactor our code? We might want to change the definition of 36 | this type to (e.g.) string. 37 | *) 38 | type state = int 39 | 40 | (* For our symbols, we're going to just use ocaml's built in char type *) 41 | type symbol = char 42 | 43 | (* To represent a transition function, we're actually going to represent a 44 | table. The table is going to tell us where to go on a given input 45 | state q, and a given symbol s. 46 | 47 | ----------------|--------------|---------------- 48 | | Current state | input symbol | Next state | 49 | |---------------|--------------|---------------| 50 | | 0 | '1' | 1 | 51 | | 0 | '0' | 0 | 52 | | 1 | '1' | 1 | 53 | | 1 | '0' | 0 | 54 | |---------------|--------------|---------------| 55 | 56 | We're going to represent this as a list of *tuples* in OCaml, which 57 | generalize pairs. Remember that a pair type is something of the 58 | form `'a * 'b` where 'a and 'b are any type (we call them type 59 | variables). A triple is created simliarly: 'a * 'b * 'c 60 | *) 61 | 62 | type transition = int * symbol * int 63 | 64 | (* Now we can literally translate the wikipedia definition of what a 65 | state machine is: 66 | *) 67 | type dfa_attempt = state list * symbol list * state * transition list * state list 68 | 69 | (* Here's an example dfa *) 70 | let d : dfa_attempt = 71 | ([0;1], (* State list *) 72 | ['0';'1'], (* Alphabet *) 73 | 0, (* Start state *) 74 | [(0,'0',0); (* transition 1 *) 75 | (0,'1',1); (* transition 2 *) 76 | (1,'0',0); (* transition 3 *) 77 | (1,'1',1)], (* transition 4 *) 78 | [1]) (* Accepting states *) 79 | 80 | (* This is all fine and well, but to access the set of states, we have 81 | to break apart the dfa. It will help to write some accessor functions. *) 82 | let states (s:dfa_attempt) = match s with 83 | | (s,_,_,_,_) -> s (* We use wildcards here, because we don't care about the 84 | other components. *) 85 | 86 | let transitions ((_,_,_,t,_):dfa_attempt) = t 87 | 88 | (* Instead, there's another tool I can use. I can use the record 89 | notation. Records are similar to C structs: they allow me to group 90 | common information, and then name the fields with sensible labels 91 | so that I can use them in my programs later. 92 | 93 | https://realworldocaml.org/v1/en/html/records.html 94 | 95 | Let's define our DFA type using the record notation. 96 | *) 97 | 98 | type dfa = 99 | { 100 | states : state list; 101 | sigma : symbol list; 102 | start : state; 103 | transitions : transition list; 104 | accepting : state list; 105 | } 106 | 107 | (* Here's an example DFA *) 108 | 109 | let d : dfa = 110 | { states = [0;1]; 111 | sigma = ['0';'1']; 112 | start = 0; 113 | transitions = 114 | [(0,'0',0); 115 | (0,'1',1); 116 | (1,'0',0); 117 | (1,'1',1)]; 118 | accepting = [1] 119 | } 120 | 121 | (* To dereference a record, I use the .field notation *) 122 | let states (dfa : dfa) = dfa.states 123 | 124 | (* This is a function that takes in a DFA as input, and adds a transition. *) 125 | let addTransition t dfa = { dfa with transitions = t::dfa.transitions } 126 | 127 | (* Now we're going to define a function that lets us *run* a DFA on an input 128 | string. This is going to be our trickiest example yet, so make 129 | sure you think through it to see what each piece is doing. 130 | *) 131 | 132 | (* We're going to define two helper functions. *) 133 | 134 | (* `explode` takes a string `s`, and turns it into its individual 135 | characters. This way we can run the DFA on the string "101" 136 | without explicitly writing ['1';'0';'1'] 137 | *) 138 | 139 | let explode s = 140 | (* Note that we define expl as a *helper* function. Helper functions are very 141 | useful in functional programming, because they help us build larger 142 | programs from programs that operate on smaller items. Not ethat 143 | the definition of `expl` is only visible *inside* of `explode`. 144 | It's a local function (local to explode), so you can't call it 145 | outside. *) 146 | let rec expl i l = 147 | if i < 0 then l else 148 | expl (i - 1) (s.[i] :: l) in (* s.[i] returns the ith element of s as a char *) 149 | expl (String.length s - 1) [];; (* String.length s returns the length of s *) 150 | 151 | (* Let's reflect on how `explode "110"` is working. First, explode 152 | will call `expl 2 []`. Let's calculate that using the equation for 153 | it! 154 | 155 | expl 2 [] = 156 | if (2 < 0) then [] else 157 | expl 1 ("110".[2] :: []) 158 | = (because if test false) 159 | expl 1 ("110".[2] :: []) 160 | = (definition of "110".[2] and ::) 161 | expl 1 (['0']) 162 | = 163 | if (1 < 0) then ['0'] else 164 | expl 0 ("110".[1] :: ['0']) 165 | = (because if test false, and defn of .[1] and ::) 166 | expl 0 (['1','0']) 167 | = 168 | if (0 < 0) then ['1','0'] else 169 | expl -1 ("110".[0] :: ['1','0']) 170 | = 171 | expl -1 (['0','1','0']) (because if test false, and defn of .[0] and ::) 172 | = 173 | if (0 < 0) then ['1','1','0'] else 174 | expl -1 ("110".[-1] :: ['1','1','0']) 175 | = (because if test true) 176 | ['1','1','0'] 177 | 178 | This is how evaluation is happening in OCaml. You unwind function 179 | definitions until you get to a case where the recursion stops, or 180 | "bottoms out." 181 | 182 | This function is actually *tail* recursive. Which is something we'll talk 183 | about next lecture. 184 | *) 185 | 186 | (* Here's another helper function, that checks whether a list contains an element *) 187 | let rec contains e l = 188 | match l with 189 | | [] -> false 190 | | hd::tl -> if hd = e then true else contains e tl 191 | 192 | (* 193 | Now, on to checking DFA acceptance. 194 | 195 | First, let's think about how we might run a DFA on paper, or in 196 | Ruby. If I did it, I might keep a (mutable) variable that keeps 197 | track of what state I'm currently at, and then updates the state 198 | depending on that. 199 | 200 | Instead of doing that, I'm just going to write a function that tells me 201 | what state to go to *next* on an input. I'm going to call this function 202 | `transition state input`. In the formal definition of DFAs it's 203 | simply called δ. But in our implementation of DFAs, it's a 204 | `transition list`. We need to write a helper function that takes that 205 | transition list and turns it into a transition function. 206 | 207 | Let's say my input string is "110". 208 | 209 | How do I run the DFA? Well, I: 210 | - Start at the beginning state, dfa.start 211 | - Call `transition dfa.start 1` and move to some state q2 212 | - Call `transition q2 1` and move to some state q3 213 | - Call `transition q3 0` and move to some state q4 214 | 215 | And how do I know if the DFA is accepting for that state or not? 216 | Well, I simply check to see if that state is contained in the set 217 | of accepting states. 218 | 219 | Now, the procedure I wrote above doesn't necessarily look obviously 220 | recursive. But what happens when I write it like this: 221 | 222 | (transition 223 | (transition 224 | (transition dfa.start '1') 225 | '1') 226 | '0') 227 | 228 | *) 229 | 230 | let checkAccepts str dfa = 231 | (* Get the list of symbols. *) 232 | let symbols = explode str in 233 | 234 | (* If I'm at state {state}, where do I go on {symbol}? *) 235 | let transition state symbol = 236 | let rec find_state l = 237 | match l with 238 | | (s1,sym,s2)::tl -> 239 | if (s1 = state && symbol = sym) then 240 | (* I've found the place in the table where I've got what I'm 241 | looking for. 242 | 243 | E.g., in 244 | ----------------|--------------|---------------- 245 | | Current state | input symbol | Next state | 246 | |---------------|--------------|---------------| 247 | | 0 | '1' | *1* | <-- here 248 | | 0 | '0' | 0 | 249 | | 1 | '1' | 1 | 250 | | 1 | '0' | 0 | 251 | |---------------|--------------|---------------| 252 | 253 | If I called `transition 0 '1'`, I would be at the place 254 | marked `here`, and would return 1. In OCaml this is 255 | represented as a list of triples, so I return the third 256 | element 257 | *) 258 | s2 259 | else 260 | (* Otherwise I continue my search. This is the case where, 261 | in the above example, I look for `transition 1 '0'`, but 262 | I'm at "here." I know I haven't found the place in the 263 | lookup table yet, so I keep going *) 264 | find_state tl 265 | | _ -> failwith "no next state" 266 | in 267 | find_state dfa.transitions 268 | in 269 | 270 | (* Now I'm going to define `run_dfa`, which is going to do the 271 | following: 272 | 273 | (transition 274 | (transition 275 | (transition dfa.start '1') ( **line 3** ) 276 | '1') 277 | '0') 278 | 279 | But it's going to work with any string, which is the list in 280 | `symbols`. Now, I'm going to do a trick: I'm going to recurse on 281 | the *reversed* list. To do this I'm going to define a helper. 282 | 283 | *) 284 | let final_state = 285 | let rec h symbol_list = 286 | match symbol_list with 287 | (* Case where list contains only one element *) 288 | | [hd] -> (transition dfa.start hd) (* Corresponds to line 3 above *) 289 | | hd::tl -> (transition (h tl) hd) 290 | | _ -> failwith "empty list of symbols" (* assume at least one symbol *) 291 | in 292 | h (List.rev symbols) (* I use the List library here. *) 293 | in 294 | 295 | (* Now I simply check to see if the final state is contained in the 296 | set of accepting states. *) 297 | if (contains final_state dfa.accepting) then 298 | true 299 | else 300 | false 301 | 302 | (* Now, let's reflect very carefully on how I did this. First, I 303 | wrote out the recursion I wanted to happen. Then I thought about 304 | how I could write a function that preserves that structure. Occasionally, 305 | I'll find that I can't obviously do it. For example, consider how 306 | the recursion would have worked if I had **not** reversed the 307 | list. I would have gotten the wrong result! 308 | 309 | This is a common pattern in functional programming: write an example 310 | equation you'd like to write, and then figure out how to get it to 311 | work. It's really very similar in mechanics to the algebra you 312 | likely did in high school. You sit down with the equations, and 313 | you figure out how to write a program that solves them. 314 | 315 | The part you need to practice at, and the part you get *better* at, 316 | is writing programs that are small and obviously correct. 317 | As an example, here's another way I could have written the last few 318 | lines of that function. I could have defined a function: 319 | 320 | let rec search_from current_state symbol_list = 321 | match symbol_list with 322 | | [] -> current_state 323 | | sym::tl -> search_from (transition current_state sym) tl 324 | in 325 | let end_state = search_from dfa.start symbols in 326 | if (contains end_state dfa.accepting) 327 | then 328 | true 329 | else 330 | false 331 | 332 | Now I don't have to reverse the list, I accumulate the current 333 | state into the function. 334 | 335 | Note that this is very similar to if I had written a function in Ruby that 336 | did something like: 337 | 338 | current_state = init 339 | for i in str { |x| ... update current_state } 340 | 341 | I've transformed what was (in Ruby) a program variable, and I've 342 | taken that to pass it along through the program. This technique is 343 | sometimes called "threading the state through" the program. And in 344 | fact, any program where I use some notion of state, I can 345 | systematically rewrite to thread the state through functions. 346 | 347 | Here's another example: 348 | *) 349 | 350 | (* In ruby: 351 | x = 0 352 | [1,2,3].each { |y| x += y } 353 | 354 | But in OCaml: 355 | *) 356 | 357 | let sum lst = 358 | let rec helper currentSum lst = match lst with 359 | | [] -> currentSum 360 | | hd::tl -> helper (currentSum + hd) tl 361 | in 362 | helper 0 lst 363 | 364 | -------------------------------------------------------------------------------- /ocaml/ex2.ml: -------------------------------------------------------------------------------- 1 | let calcPercent (grade,max) = 2 | ((float_of_int grade) /. (float_of_int max)) *. 100.0 3 | 4 | let calcPercent' grade max = 5 | ((float_of_int grade) /. (float_of_int max)) *. 100.0 6 | 7 | let transform (f : ('a*'b) -> 'c) : 'a -> 'b -> 'c = 8 | let h a b = 9 | f (a,b) 10 | in 11 | h 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /ocaml/higherorder.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Higher order functions, parameter passing, and tail recursion. 3 | * 4 | * CMSC 330, June 17, 2015 5 | *) 6 | 7 | (*--------------------------------------------------------*) 8 | (* Introduction *) 9 | (*--------------------------------------------------------*) 10 | 11 | (* Today we're going to talk about higher order functions. Higher order functions 12 | * are functions that take other functions as their input. First, let's show an 13 | * example of a function that is *not* higher order. 14 | *) 15 | 16 | let plusone x = x + 1 17 | 18 | (* This function has type: 19 | * sum : int -> int 20 | * 21 | * This function takes an int and produces another int. 22 | *) 23 | 24 | (* 25 | * Note that this is simply a notational convenience for the syntax: 26 | *) 27 | 28 | let plusone' = fun x -> x + 1 29 | 30 | (* The `fun x ->` creates an anonymous function, whose body is `x + 1`. To 31 | * call* a function in OCaml, we take it and put it next to its argument 32 | * (juxtaposition): 33 | *) 34 | 35 | let x = (fun x -> x + 1) 23 (* Could have also written `plusone' 23` *) 36 | 37 | (* These anonymous functions are sometimes called **lambdas**. *) 38 | 39 | (*--------------------------------------------------------*) 40 | (* Infinite loops *) 41 | (*--------------------------------------------------------*) 42 | 43 | (* When OCaml evaluates `(fun x -> x + 1) 23`, it takes the argument 44 | (in this case, 23), evaluates it, and then substitutes the argument 45 | into the body of the function. 46 | 47 | The process of taking the (evaluated) argument and *slamming it 48 | into* the body of the function is called **reduction**. Evaluation 49 | in functional languages happens primarily by means of reduction. 50 | 51 | Try doing it yourself: 52 | 53 | (fun x -> x + 1) (23 + 42) 54 | = 55 | (fun x -> x + 1) (65) (evaluating argument) 56 | = 57 | (65 + 1) (reduction) 58 | = 59 | 66 60 | 61 | (fun x -> x + 1) ((fun x -> x) 13) 62 | = 63 | (fun x -> x + 1) (13) (evaluating argument via reduction) 64 | = 65 | 14 (reduction) 66 | 67 | Now, here's a slightly trickier one. 68 | 69 | Let's say I define the following function: 70 | *) 71 | 72 | let rec loop = fun x -> loop x 73 | 74 | (* What happens when I do the following: 75 | 76 | loop 23 77 | = 78 | (fun x -> loop x) 23 79 | = 80 | loop 23 (reduction) 81 | = 82 | (fun x -> loop x) 23 83 | = 84 | ... 85 | = 86 | loop 23 87 | = 88 | ... 89 | 90 | Infinite loop. 91 | 92 | Now let's say I do *this*. 93 | *) 94 | 95 | let x = (fun y -> 23) (loop 23) 96 | 97 | (*--------------------------------------------------------*) 98 | (* A lecture on values *) 99 | (*--------------------------------------------------------*) 100 | 101 | (* 102 | I get.. 103 | 104 | (fun y -> 23) (loop 23) 105 | = 106 | (fun y -> 23) ((fun x -> loop x) 23) 107 | = 108 | (fun y -> 23) (loop 23) (reducing argument) 109 | = 110 | ... 111 | 112 | Another infinite loop! 113 | 114 | Why do I get this behavior? Because whenever I want to reduce 115 | (call) functions in OCaml, I first evaluate their arguments. This is why 116 | we call OCaml a *call by value* language. 117 | 118 | OCaml terms of the following form are called function applications. 119 | 120 | e1 e2 121 | 122 | (e.g., in the last example e1 = (fun y -> 23) and e2 = (loop 23)) We 123 | know we have to *apply* e1 to e2. Notice that it's e1 to e2, **not** 124 | e2 to e1. E.g., if we had `f x`, we would say that `f` is applied 125 | to `x`. The function is always the thing being applied. 126 | 127 | In the following expression: 128 | 129 | (fun x -> x + 1) ((fun x -> x) 13) 130 | ^ ^ 131 | ---------------------------- 132 | \ / 133 | top level application 134 | 135 | OCaml first evaluates the argument of (fun x -> x + 1), which is ((fun x 136 | -> x) 13). Why doesn't OCaml evaluate ((fun x -> x) 13) to 13 first? 137 | Because function application happens from *outside in*. 138 | 139 | In OCaml, values are terms of the following form: 140 | - (fun x -> ...) (functions) 141 | - x (variables) 142 | - 23 (usual primitive values) 143 | - Ctr (v1,...,vn) (constructors and their arguments) 144 | 145 | In other words, values are the *basic things* in the language. 146 | They are the places where computation ends. When I evaluate the 147 | following expression: 148 | 149 | ((fun y -> y) (fun x -> x + 1)) ((fun x -> x) 23) 150 | | e1 | e2 | 151 | |-------------------------------|-----------------| 152 | 153 | I must do the following steps: 154 | - Evaluate e1 to a value, of the form `fun x -> ...`, calling that v1 155 | - Evaluate e2 to a value, v2 156 | - Take v2 and substitute it into v1 for x, 157 | - Evaluate the result 158 | 159 | So we do: 160 | - Evaluate e1: 161 | - Evaluate e1's argument to a value, which it already is (fun x -> x + 1) 162 | - Apply e1's argument to (fun y -> y) 163 | - Get (fun x -> x + 1), which is v1 164 | - Evaluate e1's argument: 165 | - Take (fun x -> x) and apply it to 23 via reduction 166 | - Get v2 = 23 167 | - Take v1 and apply it to v2 via reduction: `(fun x -> x + 1) 23` 168 | - 23 + 1 169 | - Evaluate that: 24 170 | 171 | Note, that applications, `e1 e2`, are explicitly **not** values. If 172 | you see an application `e1 e2`, you *have* to evaluate the 173 | application before you're allowed to end the computation. 174 | 175 | If it's confusing to you, remember that 23 + 1 is just syntax for 176 | something like `plus 23 1`, where `plus` is a built in plus operator 177 | for integers that has type `int -> int -> int`. 178 | *) 179 | 180 | (* 181 | Now, what happens when we write the following expression: 182 | *) 183 | 184 | let x = (fun x -> "hello") loop 185 | 186 | (* The application evaluates to "hello". But why can this be!? 187 | `loop` is an infinite loop! The reason is that `loop` = `fun x -> 188 | loop x`. So when we evaluate: 189 | 190 | (fun x -> "hello") loop 191 | = (evaluate argument) 192 | (fun x -> "hello") (fun x -> loop x) 193 | = (reduction) 194 | "hello" 195 | 196 | See! Even though loop will create an infinite loop if *called*. 197 | It's never *called*, so the infinite loop never executes. 198 | 199 | It's kind of like if I a procedure in C named `loopforever`, and 200 | pass a *pointer* `loopforever` to a procedure. If I only pass the 201 | pointer to `loopforever`, then I never actually *call* it unless I 202 | do so explicitly. 203 | 204 | So to recap: 205 | 206 | - Values are things where computation ends. The values I want to 207 | *end up with*. 208 | - `fun x -> ...` is a value. 209 | - Applications are **not** values. You have to compute them to a value. 210 | *) 211 | 212 | (*--------------------------------------------------------*) 213 | (* Mapping *) 214 | (*--------------------------------------------------------*) 215 | 216 | (* Very frequently I'll have a list of values, and I'll want to do 217 | something to them. 218 | 219 | For example, let's say I want to convert a list of integers to a 220 | floating point value. 221 | 222 | I could write the following function: 223 | *) 224 | 225 | let rec convert_to_floats : int list -> float list = fun l -> 226 | match l with 227 | | [] -> [] 228 | | hd::tl -> (float_of_int hd) :: (convert_to_floats tl) 229 | 230 | (* Note I could have also written... 231 | 232 | let rec convert_to_floats (l : int list) : float list = 233 | ... 234 | 235 | The latter is just an abbreviation for the former. Note that the -> 236 | goes away and the type annotation goes before the : 237 | *) 238 | 239 | (* This is all fine and well, but it's actually a more general case of 240 | a pattern we see a lot in functional programming called *mapping* over a 241 | list. 242 | 243 | If we have a list 244 | 245 | +--------|--------|--------|--------+ 246 | | x1 | x2 | x3 | x4 | 247 | +--------|--------|--------|--------+ 248 | 249 | I could imagine taking an f, and applying it pointwise to each 250 | element of that list: 251 | 252 | +--------|--------|--------|--------+ 253 | | x1 | x2 | x3 | x4 | 254 | +--------|--------|--------|--------+ 255 | | | | | 256 | v v v v 257 | f f f f 258 | | | | | 259 | v v v v 260 | +--------|--------|--------|--------+ 261 | | f(x1) | f(x2) | f(x3) | f(x4) | 262 | +--------|--------|--------|--------+ 263 | 264 | I'm going to write a function, called `map`, that does this: 265 | 266 | 267 | *) 268 | 269 | let rec map (f : 'a -> 'b) (l : 'a list) : 'b list = 270 | match l with 271 | | [] -> [] 272 | | hd::tl -> (f hd) :: (map f tl) 273 | 274 | (* 275 | Let's see what happens when I apply `map float_of_int [1;2]` 276 | 277 | map float_of_int [1;2] 278 | = 279 | (float_of_int 1) :: (map float_of_int [2]) 280 | = 281 | (1.0) :: (map float_of_int [2]) 282 | = 283 | (1.0) :: (float_of_int 2 :: (map float_of_int [])) 284 | = 285 | (1.0) :: (2.0 :: (map float_of_int [])) 286 | = 287 | (1.0) :: (2.0 :: []) 288 | = 289 | [1.0; 2.0] 290 | 291 | We see that for any list `l`, we have `map f [x1;...xn]` = 292 | [f x1; f x2; ...; f xn] 293 | *) 294 | 295 | (*--------------------------------------------------------*) 296 | (* Folding *) 297 | (*--------------------------------------------------------*) 298 | 299 | (* 300 | Let's think about the following list 301 | 302 | +--------|--------|--------+ 303 | | x1 | x2 | x3 | 304 | +--------|--------|--------+ 305 | 306 | Let's say that I wanted to sum each element in the list. I could 307 | write a function like this: 308 | *) 309 | 310 | let rec sum_list (l : 'a list) = 311 | match l with 312 | | [] -> 0 313 | | hd :: tl -> hd + (sum_list tl) 314 | 315 | (* Let's think about another way that I could write `sum_list`, using 316 | an explicit accumulator. Remember, we talked about the fact that 317 | we could thread state through recursive calls. That is to say, we 318 | could pass an accumulator to `sum_list` (or rather, a helper 319 | function) explicitly: 320 | *) 321 | 322 | let sum_list' (l : 'a list) = 323 | let rec h acc l = match l with 324 | | [] -> acc 325 | | hd::tl -> h (acc + hd) tl 326 | in 327 | h 0 l 328 | 329 | (*--------------------------------------------------------*) 330 | (* A diversion: tail recursion *) 331 | (*--------------------------------------------------------*) 332 | 333 | (* The function we just defined, `h`, exhibits a specific type of 334 | recursion, named tail recursion. 335 | 336 | When the last thing a function does is call another function, we 337 | call that call a *tail call*. For example, the call `f x` is a 338 | tail call here: 339 | *) 340 | let rec f x = 341 | if (x = 0) then 1 342 | else 343 | f (x-1) 344 | 345 | (* 346 | By contrast, this function is *not* tail recursive: 347 | *) 348 | let fib x = 349 | if (x = 0 || x = 1) then 1 350 | else 351 | (f (x-1)) + (f (x-2)) 352 | 353 | (* 354 | Why isn't it tail recursive? Well, ask yourself this question: is 355 | calling `f` the *last* thing that happens for `fib 2`? It's not. 356 | First, we call `f (x-1)`, then `f (x-2)`, then we have to *use* 357 | those results to compute with them (in this case, to add them). 358 | 359 | Tail recursive functions are awesome because we can optimize them 360 | to not use the stack. For example, think about what `fib 2` does: 361 | 362 | fib 2 = 363 | f 1 + f 0 364 | ^-^ ^-^ 365 | | | 366 | ------- 367 | create stack frames and execute 368 | 369 | Now let's think about what happens when we call: 370 | 371 | fib 3 372 | = 373 | f 2 + f 1 374 | = 375 | (f 1 + f 0) + (1) 376 | = 377 | (2) + (1) 378 | 379 | If you think back to your class 216 on low level programming, 380 | you'll know that creating a stack frame potentially wastes space. 381 | It turns out there's a nice way to optimize tail calls that 382 | basically just turns them into loops. Here's another way we could 383 | write the Fibonacci function: 384 | *) 385 | 386 | let tailrecfib x = 387 | let rec h a b num = 388 | if (num) = x then a 389 | else h b (a+b) (num+1) 390 | in 391 | h 1 1 1 392 | 393 | (* Now, it's not obvious that this computes the Fibonacci sequence. I 394 | have to admit, I personally had to think hard about this for a 395 | minute or two. To see why it does, let's think about how I would 396 | compute the Fibonacci sequence by hand. 397 | 398 | 1 1 2 399 | \|\| 400 | 2 3 5 401 | \|\| 402 | 5 8 13 403 | \|\| 404 | 13 21 34 405 | 406 | What did I do when I thought about this? I wrote the first two 407 | elements of the sequence. Then I summed them to get the third (2). 408 | Then I use the previous two to get the fourth, and so on. 409 | 410 | This is **exactly** what our function does. 411 | 412 | (assume x = 5) 413 | h 1 1 1 414 | = \/| 415 | h 1 2 2 416 | = \/| 417 | h 2 3 3 418 | = \/| 419 | h 3 5 4 420 | = \/| 421 | h 5 8 5 422 | 423 | See how, in the evaluation of `h`, the second argument switches to 424 | become the first, and the new second argument is computed with the 425 | sum of the first two. The last argument is just to know when to 426 | stop. It's a counter to keep track of how many calls we've made so 427 | far. 428 | 429 | Note that everything here is just threading the state through `h`, 430 | like we've seen previously, just more complex. 431 | 432 | You see, this is because Fibonacci is not a function only of the 433 | last number in the sequence. Because if it were, we could easily 434 | make a tail recursive function out of it. Instead, the Fibonacci 435 | function is a function of the last **two** elements in the 436 | sequence. 437 | 438 | Now, why is `h` a tail call? because `h` never needs to do any 439 | work after calling `h`. 440 | 441 | Tail calls have a special property: they never need to return. 442 | 443 | let rec h a b num = 444 | if (num) = x then a 445 | else h b (a+b) (num+1) 446 | 447 | See, because the function `h` never does anything *with* the result 448 | of its tail call, why create a stack frame at all? In fact, tail 449 | calls are optimized to `goto`s. In other words, that code will be 450 | turned into something like this (in C) when it's compiled: 451 | 452 | int h(int a, int b, int num) { 453 | int a' = a; 454 | int b' = b; 455 | int num' = num; 456 | while (num <> x) { 457 | a = b 458 | b = a+b 459 | num = num+1 460 | } 461 | } 462 | 463 | The fact that `h` is a tail call allows us to do this, because tail 464 | calls are never *used*. 465 | 466 | BIG NOTE: 467 | 468 | Writing functions in a tail recursive way is a small optimization. 469 | Compilers (including ocamlc) for functional languages have gotten 470 | very good at optimizing your code. It's sometimes useful to know 471 | when it might be helpful to use a tail call rather than a non-tail 472 | call, but don't sweat it too much. Premature optimization is the 473 | root of all evil, and whatnot. 474 | *) 475 | 476 | (*--------------------------------------------------------*) 477 | (* Back to fold *) 478 | (*--------------------------------------------------------*) 479 | 480 | (* Now, back to sum_list', which we know is tail recursive: 481 | 482 | let sum_list' (l : 'a list) = 483 | let h acc l = match l with 484 | | [] -> acc 485 | | hd::tl -> h (acc + hd) tl 486 | in 487 | h 0 l 488 | 489 | It turns out that sum_list' is invoking a generic pattern over 490 | lists. It's *folding* the plus operator over the list. We might 491 | also say that it's accumulating the plus operator over the list. 492 | 493 | What do I mean by this. Well, consider that we have the list: 494 | 495 | [13; 52; 12] 496 | 497 | What happens when I write 498 | 499 | (plus 13 (plus 52 (plus 12 0) ) ) 500 | 501 | (Note I used the function `plus x y = x+y` rather than the infix 502 | operator just to bring the point home.) 503 | 504 | What if we had a function that did: 505 | 506 | (f (f (f 0 x1) x2) x3) 507 | 508 | For a generic function `f`? Then we could slide in anything we 509 | wanted! We could slide in `f = fun x y -> x+y`, or we could slide 510 | in `f = fun x y -> x*y`. 511 | 512 | But it would be kind of stupid to use 0 when we had `f = fun x y -> 513 | x*y`. It would just turn everything to zero: 514 | 515 | ( ( (0 * x1) * x2) * x3) 516 | 517 | Instead, we need to use 1. Notice that 0 is the identity for +, and 518 | 1 is the identity for *. 519 | 520 | So, now we're going to generalize what our function does: 521 | 522 | (f (.. (f (f i x1) x2) .. xn) 523 | ^ ^ 524 | --------- 525 | n fs here , where n = length(x) 526 | 527 | Our function is going to be called fold. It's going to accept a 528 | list, a function that accepts two arguments (the *current* value, 529 | and the *next* value), and an initial value: 530 | 531 | *) 532 | 533 | let fold (update : 'a -> 'b -> 'a) (init : 'a) (lst : 'b list) : 'a = 534 | let rec h acc l = 535 | match l with 536 | | [] -> acc 537 | | hd::tl -> h (update acc hd) tl 538 | in 539 | h init lst 540 | 541 | (* 542 | Now, let's write some example uses of fold 543 | *) 544 | 545 | let sum_list = fun l -> fold (fun x y -> x+y) 0 546 | 547 | let mul_list = fun l -> fold (fun x y -> x*y) 0 548 | 549 | (* Take a list of integers, and concatenate all of them into a big 550 | string *) 551 | let concat_ints_to_string : int list -> string = fun l -> 552 | fold (fun x y -> (string_of_int y ^ "|" ^ x)) "" l 553 | 554 | (*--------------------------------------------------------*) 555 | (* Practice *) 556 | (*--------------------------------------------------------*) 557 | 558 | (* Use fold to define a function that filters out all negative 559 | integers from a list 560 | 561 | filter [0; -2; 5] = [0;5] 562 | *) 563 | 564 | let filter l = fold (fun acc next -> failwith "undefined") [] l 565 | 566 | (* Note that you could *also* just write 567 | 568 | If you don't understand why this works, ASK! 569 | *) 570 | let filter = fold (fun acc next -> failwith "undefined") [] 571 | 572 | (* Now (using fold) define a function filter, that accepts an 573 | arbitrary predicate f (a function from 'a -> bool), and removes 574 | from a list `l` every element e, for which (f e = false) 575 | *) 576 | let filter f l = failwith "undefined" 577 | 578 | (* 579 | Our version of `fold` works like this: 580 | (f (f (f i x1) x2) x3) 581 | 582 | Define a function `fold_right` that does this: 583 | (f x1 (f x1 (f x3 i) ) ) 584 | 585 | Note that it will not be tail recursive. 586 | *) 587 | 588 | (* Make the following functions tail recursive *) 589 | 590 | let rec raise_x_to_the_n x n = 591 | if (n = 0) then 592 | 1 593 | else 594 | x * (raise_x_to_the_n x (n-1)) 595 | 596 | let rec multiply_each_element_by_two l = 597 | match l with 598 | | [] -> [] 599 | | hd::tl -> (2 * hd) :: (multiply_each_element_by_two tl) 600 | 601 | 602 | 603 | -------------------------------------------------------------------------------- /ocaml/let.ml: -------------------------------------------------------------------------------- 1 | (* 'let' constructs *) 2 | let x = 47;; 3 | 4 | 5 | (* Often used for _local_ variables *) 6 | let pi = 3.14 in (* { *) 7 | pi *. 3.0 *. 3.0;; (* float pi = 3.14; *) 8 | (* pi * 3.0 * 3.0; *) 9 | (* } *) 10 | print_float pi;; (* printf("%f", pi); *) 11 | 12 | 13 | let x = 47;; (* overrides earlier definition *) 14 | let x = 13 in x + 5;; (* overrides earlier one; uses it first *) 15 | x;; 16 | 17 | 18 | (* "let x = expression1 in expression2" -- what gets run when? *) 19 | let x = print_string "ran e1\n" in print_string "ran e2\n";; 20 | 21 | 22 | (* More examples *) 23 | y;; 24 | 25 | let y = 1 in y + 1;; 26 | 27 | let y = y in y + 1;; 28 | 29 | let y = 4 in let y = y + 1 in y;; (* how do you parse this? *) 30 | -------------------------------------------------------------------------------- /ocaml/list-intro.ml: -------------------------------------------------------------------------------- 1 | (* A first taste of lists in OCaml *) 2 | 3 | 4 | [1;2;3];; (* primitive data type *) 5 | 6 | [ [1;2]; [3;4] ] (* nested lists *) 7 | 8 | [];; (* empty list *) 9 | 10 | (* What are the types of the above lists? *) 11 | 12 | 13 | 14 | (* Constructing lists *) 15 | 16 | 3 :: [];; 17 | 2 :: (3 :: []);; 18 | 1::2::3::[];; 19 | 20 | let x = [1;2;3];; 21 | let y = 4 :: x;; 22 | 23 | let y = x :: 4;; (* does not work; "A :: B" means that 24 | B should be a list containing 25 | whatever type A is *) 26 | 27 | (* construct a 'z' such that the following works: *) 28 | let y = x :: z;; 29 | 30 | 31 | (* More list type practice *) 32 | 33 | [[[]; []; [1.3;2.4]]];; 34 | -------------------------------------------------------------------------------- /ocaml/pattern-matching.ml: -------------------------------------------------------------------------------- 1 | (* Pattern matching: 2 | 3 | match e with 4 | p1 -> e1 5 | | p2 -> e2 6 | | p3 -> e3 7 | *) 8 | 9 | match 1+2 with 10 | 3 -> true 11 | | i -> false;; 12 | 13 | 14 | let is_odd x = 15 | match x mod 2 with 16 | 0 -> false 17 | | 1 -> true 18 | | _ -> raise (Invalid_argument "is_odd");; (* why do we need this? *) 19 | 20 | (* Now let's work with lists *) 21 | let x = [1;2];; 22 | match x with 23 | [] -> print_string "x is an empty list\n" 24 | | _ -> print_string "x is anything but an empty list\n";; 25 | 26 | 27 | (* A function with pattern matching; this will get familiar *) 28 | let is_empty ls = 29 | match ls with 30 | [] -> true 31 | | (h::t) -> false;; 32 | 33 | is_empty [];; 34 | is_empty [1;2];; 35 | is_empty [1];; 36 | is_empty [ [] ];; 37 | 38 | 39 | (* The matching patterns can be really powerful! *) 40 | let is_vowel = function 41 | ('a' | 'e' | 'i' | 'o' | 'u') -> true 42 | | _ -> false;; 43 | 44 | let is_upper = function 45 | 'A' .. 'Z' -> true 46 | | _ -> false;; 47 | 48 | 49 | 50 | (* The matching patterns are BINDING *) 51 | let hd ls = 52 | match ls with 53 | (h::t) -> h;; 54 | 55 | hd [1;2;3];; 56 | hd [1];; 57 | hd(hd [ [4;3]; [2;1] ]);; 58 | (* hd [];; *) 59 | 60 | 61 | (* Practice: Implement tl *) 62 | (* Practice: construct a list ls such that hd(tl(hd ls)) returns 330 *) 63 | 64 | 65 | (* Coding with wildcards *) 66 | 67 | let is_empty ls = 68 | match ls with 69 | [] -> true 70 | | (_::_) -> false 71 | 72 | 73 | let hd ls = 74 | match ls with 75 | (h::_) -> h 76 | 77 | (* More examples *) 78 | let f ls = 79 | match ls with (h1::(h2::_)) -> h1 + h2;; 80 | 81 | f [2;4;8];; 82 | 83 | 84 | let g ls = 85 | match ls with [h1; h2] -> h1 + h2;; 86 | g [1;2];; 87 | (* g [1;2;3];; *) 88 | 89 | 90 | (* Abbreviated pattern matching 91 | * "let f p = e" 92 | * is the same as 93 | * "let f x = match x with p -> e" 94 | *) 95 | 96 | let hd (h::_) = h 97 | let f(x::y::_) = x + y 98 | let g [x; y] = x + y 99 | 100 | 101 | (* You probably won't do things quite like the following, but... *) 102 | let addFirsts ((x::_) :: (y::_) :: _) = x + y;; 103 | 104 | addFirsts [ [1;2;3]; [4;5]; [7;8;9] ];; 105 | (* Will the following work? *) 106 | (* addFirsts [ [1;2;3]; [4;5]; [7;8;9]; [10;11;12] ];; *) 107 | -------------------------------------------------------------------------------- /ocaml/polymorphic-types.ml: -------------------------------------------------------------------------------- 1 | (* Polymorphic types *) 2 | 3 | let hd (h::_) = h;; 4 | 5 | (* We know hd works on any kind of list, i.e., it's polymorphic: *) 6 | hd [1; 2; 3] 7 | hd ["now"; "they're"; "strings"] 8 | hd [("and", 1); ("now", 2); ("tuples", 3)] 9 | 10 | (* So what is hd's type? *) 11 | 12 | 13 | 14 | (* Some polymorphic functions *) 15 | let tl (_::t) = t 16 | 17 | let swap (x,y) = (y,x) 18 | 19 | let tls(_::xs, _::ys) = (xs, ys) 20 | 21 | let eq(x,y) = x = y (* how do you parse this? *) 22 | -------------------------------------------------------------------------------- /ocaml/small.ml: -------------------------------------------------------------------------------- 1 | (* A small OCaml program (* with nested comments *) *) 2 | let x = 37;; 3 | let y = x + 5;; 4 | print_int y;; 5 | print_string 6 | "\n" 7 | -------------------------------------------------------------------------------- /ocaml/type-annotation.ml: -------------------------------------------------------------------------------- 1 | (* Type annotations *) 2 | 3 | let (x : int) = 3 (* "x has type int" *) 4 | let z = (x : int) + 5 5 | 6 | 7 | 8 | (* _Very_ useful for debugging *) 9 | 10 | let area_of_int (x:int) : float = 11 | (float_of_int x) *. 3.14 *. 3.14;; 12 | 13 | area_of_int(3);; 14 | 15 | 16 | -------------------------------------------------------------------------------- /ocaml/types.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Exploring the OCaml type system. 3 | * 4 | * CMSC 330, June 18, 2015 5 | *) 6 | 7 | (*--------------------------------------------------------*) 8 | (* Introduction *) 9 | (*--------------------------------------------------------*) 10 | 11 | (* In the past few lectures you've seen me use types for OCaml 12 | functions, and might be slightly mystified by what they are. Today 13 | we're going to explain and attempt to justify some of OCaml's type 14 | rules, and explain how to make things like polymorphic datatypes. 15 | 16 | Let's start out by giving an example rule OCaml enforces: 17 | *) 18 | 19 | let hd l : int = match l with 20 | | [] -> 0 21 | | hd::tl -> hd 22 | 23 | (* This is the familiar head function, for integer lists. It's type 24 | is `int list -> int`, meaning it takes a list (containing 25 | integers), to an integer. 26 | 27 | A type is like a (legal) contract between your program and you. It 28 | says, if your program compiles without giving any type errors, it's 29 | not *ever* going to throw a type exception at runtime. 30 | 31 | Why is this good? Well, let's think about what would happen if we 32 | had erroneously defined `hd` this way: 33 | 34 | let hd l : int = match l with 35 | | [] -> [] 36 | | hd::tl -> hd 37 | 38 | Let's think about what would happen if we then tried to do this: 39 | 40 | print_int [1;2;3] 41 | (ocaml prints `1`) 42 | 43 | but then... 44 | 45 | print_int [] 46 | 47 | If OCaml didn't enforce type rules, the program would crash. 48 | Because print_int only knows how to print integers. It doesn't 49 | know how to print ints. 50 | 51 | Consider the following Ruby code: 52 | 53 | def print_int(i) 54 | puts (i+0) 55 | end 56 | def head(l) 57 | if (l.length == 0) then [] else l[0] end 58 | end 59 | 60 | and then... 61 | 62 | 2.0.0-p0 :008 > print_int(head([1,2,3])) 63 | 1 64 | => nil 65 | 2.0.0-p0 :009 > print_int(head([])) 66 | TypeError: no implicit conversion of Fixnum into Array 67 | from (irb):2:in `+' 68 | from (irb):2:in `print_int' 69 | from (irb):9 70 | from /Users/micinski/.rvm/rubies/ruby-2.0.0-p0/bin/irb:16:in `
' 71 | 72 | So, OCaml let's us avoid these kinds of type errors! 73 | 74 | See what happens yourself when you try to define the previous 75 | function using OCaml: 76 | 77 | # let hd l : int = match l with 78 | | [] -> [] 79 | | hd::tl -> hd 80 | ;; 81 | Error: This expression has type 'a list 82 | but an expression was expected of type int 83 | *) 84 | 85 | (*--------------------------------------------------------*) 86 | (* Defining type safety *) 87 | (*--------------------------------------------------------*) 88 | 89 | (* A type system for a programming language is **sound** if well-typed 90 | programs do not generate type errors at runtime. 91 | 92 | OCaml's type system is sound. If a program compiles, you can be 93 | **sure** it will never blow up at runtime because of a type error. 94 | Note that it may still crash because of (e.g.,) an exception (e.g., 95 | a match that isn't total). 96 | 97 | Programming languages where programs do not generate type errors 98 | are typically called type safe programming languages. 99 | *) 100 | 101 | (* Let's look at some of OCaml's type rules. We've seen one just 102 | now: 103 | 104 | - Rule: all cases for a match must return the same type. 105 | 106 | Let's look at some more basic rules: 107 | 108 | - Integer literals have type `int`. 109 | - Float literals have type `float. 110 | - etc.. for all basic types `bool`, `string`, etc... 111 | *) 112 | 113 | let xint : int = 23 114 | let xfloat : float = 23.0 115 | let xstring : string = "23pointzero" 116 | 117 | (* Let's look at the rule for matching, more formally 118 | 119 | In the expression e = 120 | match x with 121 | | pat1 -> e1 122 | | ... -> ... 123 | | patn -> en 124 | 125 | if e1 has type 'a 126 | and ... has type ... 127 | and en has type 'a 128 | 129 | then the expression e has type 'a. 130 | 131 | This is an *inductive* rule. It allows us to build bigger 132 | expressions out of smaller assumptions (assumptions about 133 | constituent types of en). 134 | *) 135 | 136 | (*--------------------------------------------------------*) 137 | (* Type variables *) 138 | (*--------------------------------------------------------*) 139 | 140 | (* 141 | See that 'a? It's called a type variable. We typically pronounce 142 | it alpha (but write it 'a so we can type in ASCII). The idea is 143 | that we could put any type there for 'a. But when we use the 144 | *same* type variable 'a in our type equation, we implicitly mean 145 | that all the `'a`'s are *equal*. This means a concrete instance of 146 | that rule would be: 147 | 148 | if e1 has type int 149 | and ... has type ... 150 | and en has type int 151 | 152 | then e has type int. 153 | 154 | Type variables are similar to quantifiers from logic. Remember 155 | back in our logic class when we had the formula: 156 | 157 | forall x. x + 1 - 1 = x 158 | 159 | If we wanted to *use* that fact, we had to provide a concrete value 160 | for `x`. So, that formula really stood for a bunch of statements: 161 | 162 | 0 + 1 - 1 = 0 (x = 0) 163 | ... 164 | n + 1 - 1 = n (x = n) 165 | ... 166 | 167 | It's the same thing here. 168 | 169 | *) 170 | 171 | (*--------------------------------------------------------*) 172 | (* More type rules *) 173 | (*--------------------------------------------------------*) 174 | 175 | 176 | (* Let's look at the rule for functions: 177 | 178 | if function f has type 'a -> 'b, and x has type 'a, then `f x` has 179 | type 'b. Sometimes we will write typing judgements in this style: 180 | 181 | f : 'a -> 'b 182 | x : 'a 183 | ------------- 184 | f x : 'b 185 | 186 | This is called an **inference rule**. The way you read it is as 187 | follows: if everything *above* the line is true. Then the thing 188 | *below* the line is true. 189 | 190 | You can view an inference rule like a recipe. If I want to make an 191 | element of type 'b, I need something, f, of type `'a -> 'b`, and 192 | something, x, of type `'a`, and then if I apply f to x, I get an `f 193 | x` of type `'b` when I put them together. 194 | 195 | Here's an example: 196 | *) 197 | 198 | let f : int -> int = fun x -> x+1 199 | let x : int = 23 200 | let y : int = f x 201 | 202 | (* The rule for constructors is similar to functions. In OCaml, you 203 | can think of constructors like functions. If I have a datatype: 204 | *) 205 | 206 | type hex = 207 | | Hex of int * int * int (* e.g., Hex (255,0,0) *) 208 | | Name of string (* e.g., Name "red" *) 209 | 210 | (* Then you can think of Hex as a function that has the following 211 | type: 212 | 213 | Hex : int * int * int -> color 214 | Name : string -> color 215 | 216 | Constructors in OCaml aren't functions, for a silly technical 217 | reason, but that's the right way to think of them. However, you 218 | can *make* them functions by doing this: 219 | 220 | 221 | *) 222 | 223 | let hex (i1,i2,i3) = Hex (i1,i2,i3) 224 | 225 | (* When I *destruct* (match on) an element datatype, I am allowed to 226 | assume the elements have their constituent types. 227 | 228 | In other words, of 229 | type t = 230 | | Ctr1 of 'a1 * ... * 'n1 231 | | ... 232 | | Ctrk of 'ak * ... * 'nk 233 | 234 | if x : t, and I have expression:n 235 | 236 | match x with 237 | | Ctr1 (x11, ..., xn1) -> e1 238 | | ... 239 | | Ctrk (x1k, ..., xnk) -> en 240 | 241 | In e1, I know that x11 : 'a1, xn1 : 'n1, 242 | ... 243 | In ek, I know that x1k : 'ak, xnk : 'nk. 244 | 245 | An example... 246 | *) 247 | 248 | let convert_to_string (h:hex) = 249 | match h with 250 | | Hex (i1,i2,i3) -> "" (* Here I am allowed to know i1 : int *) 251 | | Name s -> s (* Here I am allowed to know s : string *) 252 | 253 | (* Let's look at the rule for `let x = e1 in e2`. 254 | 255 | It says: 256 | - Figure out what x's type is by checking e1, 257 | - Call that type you figured out 'a 258 | - Inside of e2, *assume* that e1 has type 'a, now figure out e2's type 259 | - Calling that type 'b 260 | - The result of `let x = e1 in e2` is 'b. 261 | 262 | Here's an example: 263 | *) 264 | 265 | let compute = 266 | let x = ((fun x -> x) 23) in 267 | x + 2 268 | 269 | (* How do we do this? 270 | 271 | - Calculate what x's type will be. 272 | 273 | - (fun x -> x) is `'a -> 'a`. When applied to `int`, `(fun x -> 274 | x) 23 : int` 275 | 276 | - Look at the code x + 2. How do we typecheck it? 277 | - *We need to know the type of x* 278 | - But we **just figured out** that it's int. 279 | 280 | - So take `x + 2`, which is `+ : int -> int -> int` applied to `x 281 | : int`, which results in `int -> int`, which is then applied to 282 | `2 : int`, which gives us back an int. 283 | 284 | We write this rule like this: 285 | 286 | e1 : 'a 287 | x : 'a |- e2 : 'b <<< Notice this line 288 | ----------------- 289 | let x = e1 in e2 290 | 291 | Notice the highlighted line. The notation `x : 'a |- e2 : 'b` 292 | means this: 293 | 294 | If we assume x : 'a *in* e2, then e2 has type 'b. 295 | 296 | We'll come back to this in the section on type systems, but it's 297 | helpful to see it now. 298 | *) 299 | 300 | (*--------------------------------------------------------*) 301 | (* Do we really need `let`? *) 302 | (*--------------------------------------------------------*) 303 | 304 | (* Having `let` allows us to write programs that give names to things: 305 | *) 306 | 307 | let dist (x1,y1) (x2,y2) = 308 | let e1 = x1 -. x2 in 309 | let e2 = y1 -. y2 in 310 | let e1squared = e1 *. e1 in 311 | let e2squared = e2 *. e2 in 312 | sqrt (e1squared +. e2squared) 313 | 314 | (* But let's think about it, couldn't we have just written it like 315 | this? 316 | *) 317 | 318 | let dist (x1,y1) (x2,y2) = 319 | (fun e1 -> 320 | (fun e2 -> 321 | (fun e1squared -> 322 | (fun e2squared -> sqrt (e1squared +. e2squared)) 323 | (e2 *. e2)) 324 | (e1 *. e1)) 325 | (y1 -. y2)) 326 | (x1 -. x2) 327 | 328 | (* It turns out we *can*. `let` is just lambda in another form! *) 329 | 330 | (*--------------------------------------------------------*) 331 | (* Polymorphism *) 332 | (*--------------------------------------------------------*) 333 | 334 | (* 335 | Let's go back to the way we defined binary trees: 336 | *) 337 | 338 | type inttree = 339 | | IntLeaf of int 340 | | IntNode of int * inttree * inttree 341 | 342 | (* This works for trees that contain integers. But what if we want to 343 | have a tree that stores floatint point numbers. 344 | 345 | We really want a tree that takes an arbitrary type 'a, and "plugs 346 | it into" the holes where `int` is in `inttree`. In OCaml, we can 347 | create such a type by prefixing it's name with a type variable, and 348 | then use that type variable. 349 | *) 350 | 351 | type 'a tree = 352 | | Leaf of 'a 353 | | Node of 'a * 'a tree * 'a tree 354 | 355 | (* This is a parameteric type. We've defined a type of trees that is 356 | parameteric in 'a. 357 | 358 | In other words, concrete instances of 'a tree are things like: 359 | 360 | int tree = 361 | | Leaf of int 362 | | Node of int * int tree * int tree 363 | 364 | float tree = 365 | | Leaf of float 366 | | Node of float * float tree * float tree 367 | 368 | Think of `tree` sort of like a function, that works on *types*. If 369 | we give `tree` an `int`, it's going to make us a `tree int` type by 370 | filling in the holes in that type declaration. 371 | *) 372 | 373 | (* Here's another example type illustrating how to use multiple type 374 | variables, you have to put them in parenthesis and separate them 375 | with commas. *) 376 | type ('a, 'b) pair = 377 | | Pair of 'a * 'b 378 | 379 | (* Write a function that pulls out the first element of the pair. *) 380 | let first (a: ('a,'b) pair) : 'a = 381 | match a with 382 | | Pair (a,b) -> a 383 | 384 | (* It's worth pointing out that, just as `2 * 3` is an infix form for 385 | something like `mul 2 3`, `int * int` is syntactic sugar for 386 | something like `(int, int) pair`. Except now the syntactic sugar 387 | is working on *types*, rather than terms. 388 | *) 389 | 390 | (* Now, let's think about how we would write a function search 391 | (implementing binary search), for an arbitrary tree of type `'a 392 | tree`. Our original implementation went like this: 393 | *) 394 | 395 | let rec search_inttree (a : inttree) (x : int) : bool = 396 | match a with 397 | | IntLeaf y -> x = y 398 | | IntNode (y,t1,t2) -> 399 | if (x = y) then true 400 | else 401 | if (x < y) then search_inttree t1 x 402 | else search_inttree t2 x 403 | 404 | (* But I *can't* do that here. Why not? Well, think about the type 405 | of `<`. It has type `int -> int -> bool`. But when I have an `'a 406 | tree`, I need to have something that goes from `'a -> 'a -> bool`. 407 | 408 | The function `<` is *too strict* to work on an arbitrary `<`. 409 | 410 | Instead, I'm going to write a function search, that accepts a 411 | parameter `compare` that will give me: 412 | - compare x y < 0 when x lessthan y (for the type 'a) 413 | - compare x y = 0 when x equalto y (for the type 'a) 414 | - compare x y > 0 when y lessthan x (for the type 'a) 415 | *) 416 | 417 | let rec search (t : 'a tree) (compare : 'a -> 'a -> int) (x : 'a) = 418 | match t with 419 | | Leaf y -> (compare x y) = 0 420 | | Node (y,t1,t2) -> 421 | if ((compare x y) = 0) then true 422 | else 423 | if ((compare x y) = -1) then search t1 compare x 424 | else search t2 compare x 425 | 426 | (* Now, what happens when we make an `int tree`. How do we define 427 | search to line up with our previous definition? 428 | *) 429 | 430 | let search_int_tree (t : int tree) (x : int) = search t (fun x y -> x - y) x 431 | 432 | (*--------------------------------------------------------*) 433 | (* Forcing types *) 434 | (*--------------------------------------------------------*) 435 | 436 | (* Let's say that I want to come up with a function that has the type 437 | `'a * 'a -> 'a`. I might try this 438 | *) 439 | 440 | let f (a,b) = a 441 | 442 | (* But OCaml will tell me that f has type `'a * 'b -> 'a`, rather than 443 | what I want: 'a * 'a -> 'a. 444 | 445 | I can explicitly *force* them to be the same by adding a type 446 | annotation. 447 | 448 | *) 449 | 450 | let f ((a : 'a),(b : 'a)) : 'a = a 451 | 452 | (* a and b are *forced* to have the same type by OCaml's type 453 | inference engine, because I have syntactically identified the two 454 | 'a's. *) 455 | 456 | (*--------------------------------------------------------*) 457 | (* Type inference *) 458 | (*--------------------------------------------------------*) 459 | 460 | (* Now, let's talk a little bit on type inference to demystify what's 461 | going on. 462 | 463 | We're not going to be super formal: we'll get into that later. 464 | We're just going to give a high level intuition about what type 465 | inference is, and why it works. 466 | 467 | Let's think back to the function we talked about yesterday, do_twice: 468 | *) 469 | 470 | let do_twice f = fun x -> f ( f ( x ) ) 471 | 472 | (* If I go type that in at OCaml, it will give me this: 473 | 474 | (1) val do_twice : ('a -> 'a) -> 'a -> 'a = 475 | 476 | Why did it give me that? How did it compute it? 477 | 478 | First of all, let's start with this question. `do_twice` could 479 | also have this type: 480 | 481 | (2) val do_twice : (int -> int) -> int -> int = 482 | 483 | But that type would be a more specific version of (1). In general 484 | we have the following rule: 485 | 486 | OCaml will always infer the *most general possible* type for a 487 | function, unless otherwise constrained. 488 | 489 | This is why our previous example, `f`, had type `'a * 'b -> 'a`. 490 | It would be *possible* for it to have type `'a * 'a -> 'a`, but 491 | that wouldn't be the most *general* type it could be assigned. 492 | Having a most general type is important for reasons we'll discuss 493 | later (it will allow more programs to type check). 494 | 495 | But it's still unclear, what mechanism does OCaml use to decide 496 | what type something should be? 497 | 498 | Well, it uses a few rules: 499 | 500 | - If we see a literal like `1`, we know it's type is (e.g.,) `int` 501 | 502 | - If we're in an environment where someone has *told* us that `x 503 | : 'a`, we assume x has type 'a. An example of this would be 504 | let binding. (Doing type inference for let binding is 505 | difficult if we don't know 'a a priori, we'll discuss that 506 | later, but won't worry about it for now.) 507 | 508 | - If we see a variable used as a function, we know it has to have 509 | a function type. E.g., if we think f's type is 'a, but we see 510 | it used in code as `f 1`, we know it can't be just `'a`, but 511 | has to be `'a -> 'b`. 512 | 513 | And use the type constraints we talked about (at the beginning of 514 | this lecture) to guide us in going to a solution. 515 | 516 | When the OCaml type inference engine sets out to ascertain a type 517 | for a piece of code, it does based on a mechanism that makes an 518 | initial guess, and then *refines* that guess. 519 | 520 | Remember that we talked about this mechanism? It was similar to 521 | the way we computed DFAs from NFAs. We start with an initial 522 | guess, and then we go through a process of refining that guess 523 | until we end up with an answer. 524 | 525 | We'll formalize this idea later in the semester, but let's show an 526 | example of how it works on dotwice: 527 | 528 | let do_twice f = fun x -> f ( f ( x ) ) 529 | 530 | OCaml looks at this piece of code and it says the following: 531 | 532 | - I need to figure out types for x, and for f. 533 | 534 | - Let's start by assuming they're f : 'a and x : 'b. 535 | 536 | - Now, look, can f be of type 'a? No! Because it's a function, so 537 | it has to be of a functional type, let's call it `'a -> 'c`. 538 | 539 | - Now, we know that f has to accept x's type as input, so we know 540 | that f *actually* has to have type `'a -> 'c`. 541 | 542 | - Now, is this our final type? Well almost, but see, we feed f's 543 | result back into itself. So let's think about f as a box: 544 | 545 | +-------+ 546 | 'a --->| |---> 'c 547 | | f | 548 | | | 549 | +-------+ 550 | 551 | But now we're tying the output of `f` back into its input: 552 | 553 | +-------+ 554 | 'a --->| |---> 'c 555 | | | f | | 556 | | | | | 557 | ^ +-------+ | 558 | ---------------------< 559 | 560 | But now, what do we know, 'c *has* to be equal to 'a! 561 | 562 | So now, assembling the equations, we know that we end up with 563 | the type `('a -> 'a) -> 'a -> 'a`. 564 | *) 565 | -------------------------------------------------------------------------------- /ocaml/typeslec.ml: -------------------------------------------------------------------------------- 1 | let fold (update : 'a -> 'b -> 'a) initial l = 2 | let rec h acc l = match l with 3 | | [] -> acc 4 | | hd::tl -> h (update acc hd) tl 5 | in 6 | h initial l 7 | 8 | let l = [13; 12; 16] 9 | let initial = 0 10 | let update x y = x + y 11 | 12 | let sum_all_the_values = fold update initial;; 13 | 14 | let invert x = -x;; 15 | 16 | let filter (f : 'a -> bool) (l : 'a list) = 17 | let l' = 18 | fold (fun acc next_element -> 19 | if (f next_element) then 20 | next_element :: acc 21 | else 22 | acc) 23 | [] 24 | l 25 | in 26 | List.rev l' 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /ocaml/typeslec2.ml: -------------------------------------------------------------------------------- 1 | 2 | let hd l = match l with 3 | | [] -> 0 4 | | hd::tl -> hd 5 | 6 | type int_tree = 7 | | Leaf of int 8 | | Node of int * int_tree * int_tree 9 | 10 | let x = Node(12,Leaf(11),Leaf(13)) 11 | 12 | let rec find_max (t: int_tree) : int = match t with 13 | | Leaf (i) -> i 14 | | Node (x,t1,t2) -> find_max t2 15 | 16 | let rec search t x : bool = match t with 17 | | Leaf i -> (i = x) 18 | | Node (i,t1,t2) -> 19 | if (i = x) then true 20 | else 21 | (if (x > i) then 22 | (search t2 x) 23 | else 24 | (search t1 x)) 25 | 26 | type 'a tree = 27 | | Leaf of 'a 28 | | Node of 'a * 'a tree * 'a tree 29 | 30 | type int_tree = int tree 31 | 32 | type ('a, 'b) pair = 33 | | Pair of 'a * 'b 34 | 35 | 36 | -------------------------------------------------------------------------------- /prolog/01-basics.pl: -------------------------------------------------------------------------------- 1 | %-------------------------------------------------------- 2 | % some family facts 3 | 4 | woman(alice). 5 | man(bob). 6 | man(charlie). 7 | man(dennis). 8 | 9 | father(bob, charlie). 10 | father(dennis, bob). 11 | mother(alice, charlie). 12 | 13 | % some family rules 14 | 15 | son(X, Y) :- father(Y, X), man(X). 16 | son(X, Y) :- mother(Y, X), man(X). 17 | 18 | %-------------------------------------------------------- 19 | 20 | blonde(X) :- 21 | father(Father, X), 22 | blonde(Father), % father is blond 23 | mother(Mother, X), 24 | blonde(Mother). % mother is blond 25 | 26 | blonde(alice). 27 | 28 | %-------------------------------------------------------- 29 | % some Prolog clauses (facts) 30 | 31 | bigger(horse, duck). 32 | bigger(duck, gnat). 33 | 34 | % some Prolog clauses (rules) 35 | 36 | is_bigger(X,Y) :- bigger(X,Y). 37 | is_bigger(X,Y) :- bigger(X,Z), is_bigger(Z,Y). 38 | 39 | %-------------------------------------------------------- 40 | % Goal execution example 41 | 42 | mortal(X) :- man(X). 43 | mortal(X) :- woman(X). 44 | 45 | man(socrates). 46 | -------------------------------------------------------------------------------- /prolog/02-math.pl: -------------------------------------------------------------------------------- 1 | %-------------------------------------------------- 2 | plus(X,Y,Z) :- Z is X+Y. 3 | 4 | %-------------------------------------------------- 5 | factorial(0,1). 6 | 7 | factorial(N,F) :- 8 | N > 0, 9 | N1 is N-1, 10 | factorial(N1,F1), 11 | F is N*F1. 12 | 13 | %-------------------------------------------------- 14 | tail_factorial(0,F,F). 15 | tail_factorial(N,A,F) :- 16 | N > 0, 17 | A1 is N*A, 18 | N1 is N-1, 19 | tail_factorial(N1,A1,F). 20 | 21 | %-------------------------------------------------- 22 | factorial2(0,1). 23 | factorial2(N,F) :- 24 | N1 is N-1, 25 | factorial2(N1,F1), 26 | F is N*F1. 27 | 28 | %-------------------------------------------------- 29 | tail_factorial2(0,F,F). 30 | tail_factorial2(N,A,F) :- 31 | A1 is N*A, 32 | N1 is N-1, 33 | tail_factorial2(N1,A1,F). 34 | 35 | %-------------------------------------------------- 36 | reverse_factorial(0,1). 37 | reverse_factorial(N,F) :- 38 | reverse_factorial(N1,F1), 39 | N is N1+1, 40 | F is N*F1. 41 | 42 | %-------------------------------------------------- 43 | fib(0,0). 44 | fib(1,1). 45 | fib(N, F) :- 46 | N >= 2, 47 | N1 is N-1, 48 | N2 is N-2, 49 | fib(N1, F1), 50 | fib(N2, F2), 51 | F is F1+F2. 52 | 53 | %-------------------------------------------------- 54 | fib2(0,0). 55 | fib2(1,1). 56 | fib2(N, F) :- 57 | N >= 2, 58 | fib_helper(N,0,1,F). 59 | 60 | fib_helper(1,_,F,F). 61 | fib_helper(N,F1,F2,F) :- 62 | F3 is F1+F2, 63 | N1 is N-1, 64 | fib_helper(N1,F2,F3,F). 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /prolog/03-lists.pl: -------------------------------------------------------------------------------- 1 | %------------------------------------------------- 2 | % my_len/2 - find length of a list 3 | 4 | my_len([],0). 5 | my_len([_|T],F) :- 6 | my_len(T,F1), 7 | F is F1+1. 8 | 9 | %------------------------------------------------- 10 | % my_concat/3 - concatenate two lists 11 | 12 | my_concat([], L2, L2). 13 | my_concat([Elmt | L1], L2, [Elmt | C]) :- 14 | my_concat(L1, L2, C). 15 | 16 | %------------------------------------------------- 17 | % my_last/2 - find last element of a list 18 | 19 | my_last([X], X). 20 | my_last([_|T],X) :- my_last(T,X). 21 | 22 | %------------------------------------------------- 23 | % my_nth/3 - find nth element of a list 24 | 25 | my_nth(1, [H|_], H). 26 | my_nth(N, [_|T], F) :- 27 | N1 is N-1, 28 | my_nth(N1, T, F). 29 | 30 | %------------------------------------------------- 31 | % my_rev/3 - find reverse of a list 32 | 33 | my_rev(X,F) :- rev_helper(X,[],F). 34 | 35 | rev_helper([],A,A). 36 | rev_helper([H|T],A,F) :- 37 | rev_helper(T,[H|A],F). 38 | 39 | %------------------------------------------------- 40 | % palindrome/1 - find whether list is a palindrome 41 | 42 | palindrome(L) :- reverse(L, L). 43 | 44 | %------------------------------------------------- 45 | % my_takeout/3 - take out one occurrence of element E from list 46 | % starts with 1st occurence of E in list 47 | % backtracking removes 2nd occurence of E, then 3rd, etc. 48 | 49 | my_takeout(E, [E|T], T). 50 | my_takeout(E, [H|T], [H|T2]) :- 51 | my_takeout(E, T, T2). 52 | 53 | %------------------------------------------------- 54 | % my_takeout2/3 - take out one occurrence of element E from list 55 | % starts with last occurence of E in list 56 | % backtracking removes next to last occurence of E, etc. 57 | 58 | my_takeout2(E, [H|T], [H|T2]) :- 59 | my_takeout2(E, T, T2). 60 | my_takeout2(E, [E|T], T). 61 | 62 | %------------------------------------------------- 63 | % my_takeout_first/3 - take out only first occurrence of element from list 64 | 65 | my_takeout_first(E, [E|T], T). 66 | my_takeout_first(E, [H|T], [H|T2]) :- 67 | E \= H, 68 | my_takeout_first(E, T, T2). 69 | 70 | % alternative implemention using cut 71 | 72 | my_takeout_first2(E, [E|T], T) :- !. 73 | my_takeout_first2(E, [H|T], [H|T2]) :- 74 | my_takeout_first2(E, T, T2). 75 | 76 | %------------------------------------------------- 77 | % my_takeout_all/3 - take out all occurrences of element from list 78 | 79 | my_takeout_all(_, [], []). 80 | my_takeout_all(E, [E|T], T2) :- 81 | my_takeout_all(E, T, T2). 82 | my_takeout_all(E, [H|T], [H|T2]) :- 83 | E \= H, 84 | my_takeout_all(E, T, T2). 85 | 86 | %------------------------------------------------- 87 | % my_permutation/2 - find permutation of a list 88 | 89 | my_permutation([], []). 90 | my_permutation(L, [H|T]) :- 91 | my_takeout(H, L, R), 92 | my_permutation(R, T). 93 | 94 | -------------------------------------------------------------------------------- /prolog/04-hanoi.pl: -------------------------------------------------------------------------------- 1 | %-------------------------------------------------------- 2 | % hello - read name from stdin, write hello name to stdout 3 | 4 | hello :- 5 | read(X), 6 | write('Hello'), 7 | tab(1), % one space 8 | write(X). 9 | 10 | %-------------------------------------------------------- 11 | % move/4 - solve Towers of Hanoi problem 12 | % move(size,from,dest,other) 13 | 14 | move(1,X,Y,_) :- 15 | write('Move top disk from '), 16 | write(X), 17 | write(' to '), 18 | write(Y), 19 | nl. 20 | 21 | move(N,X,Y,Z) :- 22 | N>1, 23 | M is N-1, 24 | move(M,X,Z,Y), 25 | move(1,X,Y,_), 26 | move(M,Z,Y,X). 27 | -------------------------------------------------------------------------------- /prolog/05-sort.pl: -------------------------------------------------------------------------------- 1 | 2 | %------------------------------------------------- 3 | % my_takeout/3 - take out element from a list 4 | 5 | my_takeout(E, [E|T], T). 6 | my_takeout(E, [H|T], [H|T2]) :- 7 | my_takeout(E, T, T2). 8 | 9 | %------------------------------------------------- 10 | % my_permutation/2 - find permutation of a list 11 | 12 | my_permutation([], []). 13 | my_permutation(L, [H|T]) :- 14 | my_takeout(H, L, R), my_permutation(R, T). 15 | 16 | %------------------------------------------------- 17 | % is_sorted/1 - whether list is sorted 18 | 19 | is_sorted([]). 20 | is_sorted([_]). 21 | is_sorted([X1,X2|T]) :- X1 =< X2, is_sorted([X2|T]). 22 | 23 | %------------------------------------------------- 24 | % my_sort/2 - find all permutations, return those that are sorted 25 | 26 | my_sort(Xs,Ys) :- 27 | permutation(Xs,Ys), 28 | is_sorted(Ys). 29 | 30 | %------------------------------------------------- 31 | %%% Insertion sort 32 | 33 | insert(X,[],[X]). 34 | insert(X,[Y|Ys],[Y|Zs]) :- X > Y, insert(X,Ys,Zs). 35 | insert(X,[Y|Ys],[X,Y|Ys]) :- Y >= X. 36 | 37 | insertionsort([X|Xs],Ys) :- insertionsort(Xs,Zs), insert(X,Zs,Ys). 38 | insertionsort([],[]). 39 | 40 | %------------------------------------------------- 41 | %%% Quicksort 42 | 43 | append([X|Xs],Ys,[X|Zs]) :- append(Xs,Ys,Zs). 44 | append([],Ys,Ys). 45 | 46 | partition([X|Xs],Y,[X|Ls],Bs) :- 47 | Y >= X, partition(Xs,Y,Ls,Bs). 48 | partition([X|Xs],Y,Ls,[X|Bs]) :- 49 | X > Y, partition(Xs,Y,Ls,Bs). 50 | partition([],Y,[],[]). 51 | 52 | quicksort([X|Xs],Ys) :- 53 | partition(Xs,X,Littles,Bigs), 54 | quicksort(Littles,Ls), 55 | quicksort(Bigs,Bs), 56 | append(Ls,[X|Bs],Ys). 57 | quicksort([],[]). 58 | 59 | merge([X|Xs],[Y|Ys],[X|Zs]) :- X < Y, merge(Xs, [Y|Ys], Zs). 60 | merge([X|Xs],[Y|Ys],[X,Y|Zs]) :- X = Y, merge(Xs, Ys, Zs). 61 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- X > Y, merge([X|Xs], Ys, Zs). 62 | merge(Xs,[],Xs). 63 | merge([],Ys,Ys). 64 | 65 | -------------------------------------------------------------------------------- /prolog/06-backtrack.pl: -------------------------------------------------------------------------------- 1 | %-------------------------------------------------------- 2 | % backtracking, cut, not 3 | 4 | jedi(luke). 5 | jedi(yoda). 6 | sith(vader). 7 | sith(maul). 8 | 9 | % backtracking finds all pairs 10 | fight1(X,Y) :- jedi(X), sith(Y). 11 | 12 | % cut ! commits all choices for goals encountered before ! 13 | fight2(X,Y) :- jedi(X), !, sith(Y). 14 | fight3(X,Y) :- jedi(X), sith(Y), !. 15 | 16 | % can use ! to implement not 17 | not(X) :- call(X), !, fail. 18 | not(_). 19 | 20 | % not means "not currently provable" 21 | true_jedi1(X) :- jedi(X), not(sith(X)). 22 | true_jedi2(X) :- not(sith(X)), jedi(X). 23 | 24 | % X \= Y is the same as not(X=Y) 25 | help1(X,Y) :- jedi(X), jedi(Y). 26 | help2(X,Y) :- jedi(X), jedi(Y), X \= Y. 27 | help3(X,Y) :- jedi(X), X \= Y, jedi(Y). 28 | help4(X,Y) :- X \= Y, jedi(X), jedi(Y). -------------------------------------------------------------------------------- /prolog/README.md: -------------------------------------------------------------------------------- 1 | # Prolog examples and notes 2 | 3 | ## Simple examples 4 | - [`01-basics.pl`](01-basics.pl) -- An introduction to syntax and examples 5 | - [`02-math.pl`](02-math.pl) -- Mathematical builtins and `is` construct 6 | - [`03-lists.pl`](03-lists.pl) -- Manipulating lists 7 | - [`04-hanoi.pl`](04-hanoi.pl) -- Towers of Hanoi 8 | - [`05-sort.pl`](05-sort.pl) -- Sorting lists 9 | - [`06-backtrack.pl`](06-backtrack.pl) -- Illustrating backtracking 10 | 11 | ## Using the cut 12 | - [`cuts.pl`](cuts.pl) -- Explaining cuts 13 | - [`jedi.pl`](jedi.pl) -- Cuts and jedis 14 | 15 | ## Larger examples 16 | - [`cek.pl`](cel.pl) -- An implementation of the CEK machine in Prolog 17 | -------------------------------------------------------------------------------- /prolog/cek.pl: -------------------------------------------------------------------------------- 1 | %% 2 | %% The CEK machine in Prolog 3 | %% 4 | 5 | %% 6 | %% Environments -- hold closures, which are of the form [T,E]. 7 | %% 8 | 9 | % Environments are association lists 10 | empty_env([]). 11 | 12 | % Adding to environment is concatenation 13 | add(K,V,E,[[K,V]|E]). 14 | 15 | % Looking up environment is matching 16 | lookup(K,[[K,V]|_],V). 17 | lookup(K,[[K1,V]|T],V1) :- K1 \= K, lookup(K,T,V1). 18 | 19 | %% 20 | %% Terms 21 | %% 22 | 23 | %% Terms 24 | %% terms are... 25 | %% lam(x,T) -- \x. t 26 | %% app(T1,T2) -- t1 t2 27 | %% var(x) -- x 28 | 29 | %% 30 | %% Step relation 31 | %% 32 | 33 | %% Application 34 | step([app(T1,T2),E,K],[T1,E,earg(T2,E,K)]). 35 | 36 | %% Lookup variable and dereference closure in environment 37 | step([var(X),E,K],[L,E1,K]) :- lookup(X,E,[L,E1]). 38 | 39 | %% Finish evaluating a function, start evaluating an argument 40 | step([lam(X,T1),E1,earg(T2,E2,K)],[T2,E2,ecall(lam(X,T1),E1,K)]). 41 | 42 | %% Finish evaluating an argument, call function 43 | step([lam(X,T1),E1,ecall(lam(X2,T2),E2,K)],[T2,E3,K]) :- 44 | add(X2,[lam(X,T1),E1],E2,E3). 45 | 46 | %% Computing 47 | 48 | %% Initial term is machine M 49 | initial(T,[T,[],done]). 50 | 51 | %% A state is final when... 52 | final([lam(_,_),_,done]). 53 | 54 | %% Compute... 55 | 56 | %% Tail recursive... 57 | results_in(M1,M1) :- final(M1),!. 58 | results_in(M1,M3) :- step(M1,M2),results_in(M2,M3). 59 | 60 | compute(T1,T2) :- initial(T1,S1),results_in(S1,S2),S2 = [T2,_,_]. 61 | 62 | %% (\f. (f (\x. x))) (\g. g (\y. y)) 63 | 64 | %% compute(app(lam(f,app(var(f),lam(x,var(x)))),lam(g,app(var(g),lam(y,y)))),X). 65 | %% results in ... 66 | %% (\y. y) 67 | 68 | %% compute(app(app(lam(x,lam(y,var(x))),(lam(x,var(x)))),lam(y,var(y))),X). 69 | %% results in ... 70 | %% X = lam(x, var(x)) . 71 | -------------------------------------------------------------------------------- /prolog/cuts.pl: -------------------------------------------------------------------------------- 1 | /* Merge two sorted lists X,Y into one sorted list Z */ 2 | merge([X|Xs], [Y|Ys], [X|Zs]) :- 3 | X < Y, 4 | merge(Xs, [Y|Ys], Zs). 5 | 6 | merge([X|Xs], [Y|Ys], [X,Y|Zs]) :- 7 | X =:= Y, 8 | merge(Xs,Ys,Zs). 9 | 10 | merge([X|Xs], [Y|Ys], [Y|Zs]) :- 11 | X > Y, 12 | merge([X|Xs],Ys,Zs). 13 | 14 | merge(Xs, [], Xs) :- !. 15 | merge([], Ys, Ys) :- !. 16 | 17 | 18 | /* Merge two sorted lists X,Y into one sorted list Z -- with cut*/ 19 | /* 20 | merge([X|Xs], [Y|Ys], [X|Zs]) :- 21 | X < Y, !, 22 | merge(Xs, [Y|Ys], Zs). 23 | 24 | merge([X|Xs], [Y|Ys], [X,Y|Zs]) :- 25 | X =:= Y, !, 26 | merge(Xs,Ys,Zs). 27 | 28 | merge([X|Xs], [Y|Ys], [Y|Zs]) :- 29 | X > Y, !, 30 | merge([X|Xs],Ys,Zs). 31 | 32 | merge(Xs, [], Xs) :- !. 33 | merge([], Ys, Ys) :- !. 34 | 35 | */ 36 | 37 | /* Eliminating redundancy */ 38 | 39 | my_sort(Xs, Ys) :- 40 | append(As, [X,Y|Bs], Xs), 41 | X > Y, 42 | append(As, [Y,X|Bs], Xs1), 43 | my_sort(Xs1, Ys). 44 | 45 | my_sort(Xs, Xs) :- 46 | ordered(Xs). 47 | 48 | ordered([_]). 49 | ordered([X,Y|Ys]) :- 50 | X =< Y, 51 | ordered([Y|Ys]). 52 | 53 | /* sort without the redundancy */ 54 | 55 | nr_sort(Xs, Ys) :- 56 | append(As, [X,Y|Bs], Xs), 57 | X > Y, 58 | !, 59 | append(As, [Y,X|Bs], Xs1), 60 | nr_sort(Xs1, Ys). 61 | 62 | nr_sort(Xs, Xs) :- 63 | ordered(Xs), 64 | !. 65 | 66 | /* red cuts */ 67 | 68 | if_then_else(P,Q,_) :- P, !, Q. 69 | if_then_else(_,_,R) :- R. 70 | 71 | /* Alternatively, you could have: 72 | if_then_else(P,Q,R) :- not(P), R. 73 | as the second rule, but this is computationally Expensive */ 74 | 75 | 76 | /* Implementing not */ 77 | my_not(X) :- X, !, fail. 78 | my_not(_). 79 | 80 | 81 | 82 | /* Using not */ 83 | 84 | my_flatten([],[]). 85 | my_flatten(X,[X]) :- \+ is_list(X). 86 | my_flatten([X|Xs],Zs) :- 87 | my_flatten(X,Y), 88 | my_flatten(Xs,Ys), 89 | append(Y,Ys,Zs). 90 | 91 | completely_flatten(L,F) :- 92 | my_flatten(L,L), 93 | F = L. 94 | completely_flatten(L,F) :- 95 | my_flatten(L, X), !, 96 | completely_flatten(X,F). 97 | 98 | has_factor(N,L) :- 99 | N mod L =:= 0. 100 | has_factor(N,L) :- 101 | L * L < N, 102 | L2 is L + 2, 103 | has_factor(N, L2). 104 | 105 | is_prime(2). 106 | is_prime(3). 107 | is_prime(P) :- 108 | integer(P), 109 | 2 =< P, % note the direction! 110 | P mod 2 =\= 0, 111 | \+ has_factor(P, 3). 112 | 113 | 114 | /* Why you should be careful when using not */ 115 | 116 | unmarried_student(X) :- 117 | not(married(X)), 118 | student(X). 119 | 120 | student(bill). 121 | student(steve). 122 | married(joe). 123 | 124 | % What will unmarried_student(X) return? 125 | 126 | 127 | /* Tail recursion */ 128 | 129 | ntr_reverse([ ],[ ]). 130 | ntr_reverse([X|L],Rev) :- ntr_reverse(L,RL), append(RL,[X],Rev). 131 | 132 | tr_reverse([ ],[ ]). 133 | tr_reverse(L,RL) :- tr_reverse(L,[ ],RL). 134 | 135 | tr_reverse([ ],RL,RL). 136 | tr_reverse([X|L],PRL,RL) :- tr_reverse(L,[X|PRL],RL). 137 | 138 | /* 139 | * Sledgehammer approach to ensuring no backtracking: 140 | * A :- B1,...,Bn,Bn1. 141 | * A :- B1,...,Bn,!,Bn1. 142 | */ 143 | 144 | -------------------------------------------------------------------------------- /prolog/examples.pl: -------------------------------------------------------------------------------- 1 | %% Increment, X is the argument, Y is return value 2 | increment(X,Y) :- 3 | Y is X+1. 4 | 5 | addN(X,0,X). 6 | addN(X,N,Y) :- 7 | X1 is X+1, 8 | N1 is N-1, 9 | addN(X1,N1,Y). 10 | 11 | father(andrew,sam). 12 | 13 | concat([],L2,L2). 14 | concat([E|L1],L2,[E|C]) :- 15 | concat(L1,L2,C). 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /prolog/hanoi-text.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void move(int n, int from, int to, int via) 4 | { 5 | if (n > 0) { 6 | move(n - 1, from, via, to); 7 | printf("Move disk from pole %d to pole %d\n", from, to); 8 | move(n - 1, via, to, from); 9 | } 10 | } 11 | int main() 12 | { 13 | move(4, 1,2,3); 14 | return 0; 15 | } 16 | -------------------------------------------------------------------------------- /prolog/hanoi.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | typedef struct { int *x, n; } tower; 6 | tower *new_tower(int cap) 7 | { 8 | tower *t = calloc(1, sizeof(tower) + sizeof(int) * cap); 9 | t->x = (int*)(t + 1); 10 | return t; 11 | } 12 | 13 | tower *t[3]; 14 | int height; 15 | 16 | void text(int y, int i, int d, const char *s) 17 | { 18 | printf("\033[%d;%dH", height - y + 1, (height + 1) * (2 * i + 1) - d); 19 | while (d--) printf("%s", s); 20 | } 21 | 22 | void add_disk(int i, int d) 23 | { 24 | t[i]->x[t[i]->n++] = d; 25 | text(t[i]->n, i, d, "=="); 26 | 27 | //usleep(100000); 28 | usleep(700000); 29 | fflush(stdout); 30 | } 31 | 32 | int remove_disk(int i) 33 | { 34 | int d = t[i]->x[--t[i]->n]; 35 | text(t[i]->n + 1, i, d, " "); 36 | return d; 37 | } 38 | 39 | void move(int n, int from, int to, int via) 40 | { 41 | if (!n) return; 42 | 43 | move(n - 1, from, via, to); 44 | add_disk(to, remove_disk(from)); 45 | move(n - 1, via, to, from); 46 | } 47 | 48 | int main(int c, char *v[]) 49 | { 50 | puts("\033[H\033[J"); 51 | 52 | if (c <= 1 || (height = atoi(v[1])) <= 0) 53 | height = 8; 54 | for (c = 0; c < 3; c++) t[c] = new_tower(height); 55 | for (c = height; c; c--) add_disk(0, c); 56 | 57 | move(height, 0, 1, 2); 58 | 59 | text(1, 0, 1, "\n"); 60 | return 0; 61 | } 62 | -------------------------------------------------------------------------------- /prolog/jedi.pl: -------------------------------------------------------------------------------- 1 | jedi(luke). 2 | jedi(yoda). 3 | sith(vader). 4 | sith(maul). 5 | fight(X,Y) :- jedi(X), sith(Y). -------------------------------------------------------------------------------- /prolog/p7.pl: -------------------------------------------------------------------------------- 1 | /* 2 | * Backtracking: If a goal fails, prolog goes back to its last choice 3 | * and looks for an alternative. In example below, we backtrack after 4 | * has_money(mary) fails. 5 | */ 6 | 7 | travel(X) :- on_vacation(X), has_money(X). 8 | 9 | on_vacation(mary). 10 | on_vacation(peter). 11 | has_money(peter). 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /prolog/sort.pl: -------------------------------------------------------------------------------- 1 | %% Sorting by specification; inefficient! 2 | % Exponential running time. Try: mysort([3,2,1,2,7,6,9,10,4,7],X). 3 | 4 | 5 | 6 | % sort(SortedFormOfList, List). 7 | 8 | is_sorted([]). 9 | is_sorted([_]). 10 | is_sorted([X1,X2|T]) :- X1 =< X2, is_sorted([X2|T]). 11 | 12 | remove(X,[X|L],L). 13 | remove(X,[H|L],[H|M]) :- remove(X,L,M). 14 | 15 | permutation([], []). 16 | permutation(L, [X|Xs]) :- remove(X, L, Rest), permutation(Rest, Xs). 17 | 18 | mysort(Xs,Ys) :- 19 | permutation(Xs,Ys), 20 | is_sorted(Ys). 21 | 22 | %%% Insertion sort 23 | 24 | insert(X,[],[X]). 25 | insert(X,[Y|Ys],[Y|Zs]) :- X > Y, insert(X,Ys,Zs). 26 | insert(X,[Y|Ys],[X,Y|Ys]) :- Y >= X. 27 | 28 | insertionsort([X|Xs],Ys) :- insertionsort(Xs,Zs), insert(X,Zs,Ys). 29 | insertionsort([],[]). 30 | 31 | %%% Quicksort 32 | 33 | append([X|Xs],Ys,[X|Zs]) :- append(Xs,Ys,Zs). 34 | append([],Ys,Ys). 35 | 36 | partition([X|Xs],Y,[X|Ls],Bs) :- 37 | Y >= X, partition(Xs,Y,Ls,Bs). 38 | partition([X|Xs],Y,Ls,[X|Bs]) :- 39 | X > Y, partition(Xs,Y,Ls,Bs). 40 | partition([],Y,[],[]). 41 | 42 | quicksort([X|Xs],Ys) :- 43 | partition(Xs,X,Littles,Bigs), 44 | quicksort(Littles,Ls), 45 | quicksort(Bigs,Bs), 46 | append(Ls,[X|Bs],Ys). 47 | quicksort([],[]). 48 | 49 | merge([X|Xs],[Y|Ys],[X|Zs]) :- X < Y, merge(Xs, [Y|Ys], Zs). 50 | merge([X|Xs],[Y|Ys],[X,Y|Zs]) :- X = Y, merge(Xs, Ys, Zs). 51 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- X > Y, merge([X|Xs], Ys, Zs). 52 | merge(Xs,[],Xs). 53 | merge([],Ys,Ys). 54 | 55 | /* 56 | merge([X|Xs],[Y|Ys],[X|Zs]) :- X < Y, !, merge(Xs, [Y|Ys], Zs). 57 | merge([X|Xs],[Y|Ys],[X,Y|Zs]) :- X = Y, !, merge(Xs, Ys, Zs). 58 | merge([X|Xs],[Y|Ys],[Y|Zs]) :- X > Y, !, merge([X|Xs], Ys, Zs). 59 | merge(Xs,[],Xs) :- !. 60 | merge([],Ys,Ys) :- !. 61 | */ 62 | --------------------------------------------------------------------------------