1 [[!toc]]
5 ##Original Calculator##
7 In a real programming application, one would usually start with a string that needs to be parsed and interpreted, such as:
9         let x = 1 in let y = x + 2 in x * y
11 The parsing phase converts this to an "abstract syntax tree" (AST), which in this case might be:
13         Let ('x', Constant 1,
14                  Let ('y', Addition (Variable 'x', Constant 2),
15                           Multiplication (Variable 'x', Variable 'y')))
17 Then the interpreter (or "evaluator") would convert that AST into an "expressed value": in this case, to the integer 3. We're not concerning ourselves with the parsing phase here, so we're just thinking about how to interpret expressions that are already in AST form.
19 The language we had in week 7 looked like this:
21         type term = Constant of int
22                 | Multiplication of (term * term)
23                 | Addition of (term * term)
24                 | Variable of char
25                 | Let of (char * term * term)
26         ;;
28 and the evaluation function looked like this:
30         let rec eval (t : term) (e: (char * int) list) = match t with
31           Constant x -> x
32         | Multiplication (t1, t2) -> (eval t1 e) * (eval t2 e)
33         | Addition (t1, t2) -> (eval t1 e) + (eval t2 e)
34         | Variable c ->
35                 (* lookup the value of c in the current environment
36                    This will fail if c isn't assigned anything by e *)
37                 List.assoc c e
38         | Let (c, t1, t2) ->
39                 (* evaluate t2 in a new environment where c has been associated
40                    with the result of evaluating t1 in the current environment *)
41                 eval t2 ((c, eval t1 e) :: e)
42         ;;
47 Let's tweak this a bit.
49 First, let's abstract away from the assumption that our terms always evaluate to `int`s. Let's suppose they evaluate to a more general type, which might have an `int` payload, or might have, for example, a `bool` payload.
51         type expressed_value = Int of int | Bool of bool;;
53 We'll add one boolean predicate, `Iszero`, and an `If...` construction.
55 Similarly, we might allow for some terms to express pairs of other terms:
57         type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value;;
59 We'd then want to add the ability to construct pairs, and extract their components.
61 We won't try here to catch any type errors, such as attempts to add a `bool` to an `int`, or attempts to check whether a `bool` iszero. Neither will we try here to monadize anything: these will be implementations of a calculator with all the plumbing exposed. What we will do is add more and more features to the calculator.
63 We'll switch over to using variable `g` for assignment functions, which is a convention many of you seem familiar with. As we mentioned a few times in week 9, for some purposes it's easier to implement environment or assignment functions as functions from `char`s to `int`s (or whatever variables are bound to), rather than as lists of pairs. However, we'll stick with this implementation for now. We will however abstract out the type that the variables are bound to. For now, we'll suppose that they're bound to the same types that terms can express.
65         type bound_value = expressed_value;;
66         type assignment = (char * bound_value) list;;
68 Here's where we should be now. We expand some of the clauses in the `eval` function for clarity, and we rename a few variables:
70         type term =
71                   Intconstant of int
72                 | Multiplication of (term * term)
73                 | Addition of (term * term)
74                 | Variable of char
75                 | Let of (char * term * term)
76                 | Iszero of term
77                 | If of (term * term * term)
78                 | Makepair of (term * term)
79                 | First of term
80         ;;
82         let rec eval (t : term) (g : assignment) = match t with
83           Intconstant x -> Int x
84         | Multiplication (t1, t2) ->
85                 (* we don't handle cases where the subterms don't evaluate to Ints *)
86                 let Int i1 = eval t1 g
87                 in let Int i2 = eval t2 g
88                 (* Multiplication (t1, t2) should evaluate to an Int *)
89                 in Int (i1 * i2)
90         | Addition (t1, t2) ->
91                 let Int i1 = eval t1 g
92                 in let Int i2 = eval t2 g
93                 in Int (i1 + i2)
94         | Variable (var) ->
95                 (* we don't handle cases where g doesn't bind var to any value *)
96                 List.assoc var g
97         | Let (var_to_bind, t2, t3) ->
98                 (* evaluate t3 under a new assignment where var_to_bind has been bound to
99                    the result of evaluating t2 under the current assignment *)
100                 let value2 = eval t2 g
101                 in let g' = (var_to_bind, value2) :: g
102                 in eval t3 g'
103         | Iszero (t1) ->
104                 (* we don't handle cases where t1 doesn't evaluate to an Int *)
105                 let Int i1 = eval t1 g
106                 (* Iszero t1 should evaluate to a Bool *)
107                 in Bool (i1 = 0)
108         | If (t1, t2, t3) ->
109                 (* we don't handle cases where t1 doesn't evaluate to a boolean *)
110                 let Bool b1 = eval t1 g
111                 in if b1 then eval t2 g
112                 else eval t3 g
113         | Makepair (t1, t2) ->
114                 let value1 = eval t1 g
115                 in let value2 = eval t2 g
116                 in Pair (value1, value2)
117         | First (t1) ->
118                 (* we don't handle cases where t1 doesn't evaluate to a Pair *)
119                 let Pair (value1, value2) = eval t1 g
120                 in value1
121         ;;
123 The complete code is available [here](/code/calculator/calc1.ml).
127 Now we want to add function values to our language, so that we can interpret (the abstract syntax trees of) expressions like this:
129         let x = 1 in let f = lambda y -> y + x in apply f 2
131 What changes do we need to handle this?
133 We can begin with our language:
135         type term =
136                   Intconstant of int
137                 | Multiplication of (term * term)
138                 | Addition of (term * term)
139                 | Variable of char
140                 | Let of (char * term * term)
141                 | Iszero of term
142                 | If of (term * term * term)
143                 | Makepair of (term * term)
144                 | First of term
145                 | Lambda of (char * term)
146                 | Apply of (term * term)
147         ;;
149 Next, we need to expand our stock of `expressed_value`s to include function values as well. How should we think of these? We've several times mentioned the issue of how to handle free variables in a function's body, like the `x` in `lambda y -> y + x`. We'll follow the usual functional programming standard for these (known as "lexical scoping"), which keeps track of what value `x` has in the function declaration's lexical environment. That shouldn't get shadowed by any different value `x` may have when the function value is later applied. So:
151         let x = 1 in let f = lambda y -> y + x in let x = 2 in apply f 2
153 should evaluate to `3` not to `4`. To handle this, the function values we construct need to keep track of the present values of all free variables in the function's body. The combination of the function's body and the values of its free variables is called a "function closure." We'll implement these closures in a straightforward though inefficient way: we'll just stash away a copy of the assignment in effect when the function value is being constructed. Our function values also need to keep track of which of their variables are to be bound to the arguments they get applied to. All together, then, we need three pieces of information: which variables are to be bound to arguments, what the function's body is, and something that keeps track of the right values for the free variables in the function body. We'll pack this all together into an additional variant for our `expressed_value` type:
155         type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
157 We'd like to define `bound_value`s and `assignment`s just as before:
159         type bound_value = expressed_value;;
160         type assignment = (char * bound_value) list;;
162 However, note that we have a recursive relation between these types: `expressed_value` is defined partly in terms of `assignment`, which is defined partly in terms of `bound_value`, which is equivalent to `expressed_value`. In OCaml one has to define such types using the following form:
164         type bound_value = expressed_value
165         and assignment = (char * bound_value) list
166         and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
168 Now our evaluation function needs two further clauses to interpret the two new expression forms `Lambda (...)` and `Apply (...)`:
170         let rec eval (t : term) (g : assignment) = match t with
171         ...
172         | Lambda (arg_var, t2) -> Closure (arg_var, t2, g)
173         | Apply (t1, t2) ->
174                 (* we don't handle cases where t1 doesn't evaluate to a function value *)
175                 let Closure (arg_var, body, savedg) = eval t1 g
176                 in let value2 = eval t2 g
177                 (* evaluate body under savedg, except with arg_var bound to value2 *)
178                 in let savedg' = (arg_var, value2) :: savedg
179                 in eval body savedg'
180         ;;
182 The complete code is available [here](/code/calculator/calc2.ml).
186 There are different ways to include recursion in our calculator. First, let's imagine our language expanded like this:
188         let x = 1 in letrec f = lambda y -> if iszero y then x else y * apply f (y - 1) in apply f 3
190 where the AST would be:
192         Let ('x', Intconstant 1,
193                 Letrec ('f',
194                         Lambda ('y',
195                                 If (Iszero (Variable 'y'),
196                                         Variable 'x',
197                                         Multiplication (Variable 'y',
198                                                 Apply (Variable 'f',
199                                                         Addition (Variable 'y', Intconstant (-1)))))),
200                         Apply (Variable 'f', Intconstant 3)))
202 Here is the expanded definition for our language type:
204         type term =
205                   Intconstant of int
206                 | Multiplication of (term * term)
207                 | Addition of (term * term)
208                 | Variable of char
209                 | Let of (char * term * term)
210                 | Iszero of term
211                 | If of (term * term * term)
212                 | Makepair of (term * term)
213                 | First of term
214                 | Lambda of (char * term)
215                 | Apply of (term * term)
216                 | Letrec of (char * term * term)
217         ;;
219 Now consider what we'll need to do when evaluating a term like `Letrec ('f', Lambda (...), t2)`. The subterm `Lambda (...)` will evaluate to something of the form `Closure ('y', body, savedg)`, where `Variable 'f'` may occur free in `body`. What we'll want to do is to ensure that when `body` is applied, it's applied using not the assignment `savedg` but a modified assignment `savedg'` which binds `'f'` to this very function value. That is, we want to bind `'f'` not to:
221         Closure ('y', body, savedg)
225         let orig_closure = Closure ('y', body, savedg)
226         in let savedg' = ('f', orig_closure) :: savedg
227         in let new_closure = Closure ('y', body, savedg')
228         in new_closure
230 Except, this isn't quite right. It's almost what we want, but not exactly. Can you see the flaw?
232 The flaw is this: inside `new_closure`, what is `'f'` bound to? It's bound by `savedg'` to `orig_closure`, which in turn leaves `'f'` free (or bound to whatever existing value it had according to `savedg`). This isn't what we want. It'll break if we need to make applications of `Variable 'f'` which recurse more than once.
234 What we really want is for `'f'` to be bound to `new_closure`, something like this:
236         let rec new_closure = Closure ('y', body, ('f', new_closure) :: savedg)
237         in new_closure
239 And as a matter of fact, OCaml *does* permit us to recursively define cyclical lists in this way. So a minimal change to our evaluation function would suffice:
241         let rec eval (t : term) (g : assignment) = match t with
242         ...
243         | Letrec (var_to_bind, t2, t3) ->
244                 (* we don't handle cases where t2 doesn't evaluate to a function value *)
245                 let Closure (arg_var, body, savedg) = eval t2 g
246         in let rec new_closure = Closure (arg_var, body, (var_to_bind, new_closure) :: savedg)
247         in let g' = (var_to_bind, new_closure) :: g
248                 in eval t3 g'
249         ;;
251 However, this is a somewhat exotic ability in a programming language, so it would be good to work out how to interpret `Letrec (...)` forms without relying on it.
253 If we implemented assignments as functions rather than as lists of pairs, the corresponding move would be less exotic. In that case, our `Let (...)` and `Letrec (...)` clauses would look something like this:
256         | Let (var_to_bind, t2, t3) ->
257                 let value2 = eval t2 g
258                 in let g' = fun var -> if var = var_to_bind then value2 else g var
259                 in eval t3 g'
260         ...
261         | Letrec (var_to_bind, t2, t3) ->
262                 let Closure (arg_var, body, savedg) = eval t2 g
263                 in let rec savedg' = fun var -> if var = var_to_bind then Closure (arg_var, body, savedg') else savedg var
264                 in let g' = fun var -> if var = var_to_bind then Closure (arg_var, body, savedg') else g var
265                 in eval t3 g'
266         ;;
268 and this is just a run-of-the-mill use of recursive functions. However, for this exercise we'll continue using lists of pairs, and work out how to interpret `Letrec (...)` forms using them.
270 The way we'll do this is that, when we bind a variable to a value, we'll keep track of whether the term was bound via `Let` or `Letrec`. We'll rely on that to interpret pairs of terms like these differently:
272         Let ('f',
273                 Intconstant 1,
274                 Let ('f', Lambda ('y', Variable 'f')),
275                 ...)
277         Let ('f',
278                 Intconstant 1,
279                 Letrec ('f', Lambda ('y', Variable 'f')),
280                 ...)
282 In the first case, an application of `Variable 'f'` to any argument should evaluate to `Int 1`; in the second case, it should evaluate to the same function closure that `Variable 'f'` evaluates to. We'll keep track of which way a variable was bound by expanding our `bound_value` type:
284         type bound_value = Nonrecursive of expressed_value |
285                 Recursive_Closure of char * char * term * assignment
286         and assignment = (char * bound_value) list
287         and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
290 Since we're not permitting ourselves OCaml's ability to recursively define cyclical lists, we're not going to be able to update the saved assignment in a closure when that closure is recursively bound to a variable. Instead, we'll just make a note that variable `'f'` is supposed to be the recursively bound one---by binding it not to `Nonrecursive (Closure (arg_var, body, savedg))` but rather to `Recursive_Closure ('f', arg_var, body, savedg)`. We'll do the work to make the saved assignment recursive in the right way *later*, when we *evaluate* `Variable 'f'`. The result will look like this:
292         let rec eval (t : term) (g : assignment) = match t with
293         ...
294         | Variable (var) -> (
295                 (* we don't handle cases where g doesn't bind var to any value *)
296                 match List.assoc var g with
297           | Nonrecursive value -> value
298           | Recursive_Closure (self_var, arg_var, body, savedg) as rec_closure ->
299                           (* we update savedg to bind self_var to rec_closure here *)
300               let savedg' = (self_var, rec_closure) :: savedg
301               in Closure (arg_var, body, savedg')
302         )
303         | Let (var_to_bind, t2, t3) ->
304                 (* evaluate t3 under a new assignment where var_to_bind has been bound to
305            the result of evaluating t2 under the current assignment *)
306                 let value2 = eval t2 g
307                 (* we have to wrap value2 in Nonrecursive *)
308                 in let g' = (var_to_bind, Nonrecursive value2) :: g
309                 in eval t3 g'
310         ...
311         | Lambda (arg_var, t2) -> Closure (arg_var, t2, g)
312         | Apply (t1, t2) ->
313                 (* we don't handle cases where t1 doesn't evaluate to a function value *)
314                 let Closure (arg_var, body, savedg) = eval t1 g
315                 in let value2 = eval t2 g
316                 (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
317                 in let savedg' = (arg_var, Nonrecursive value2) :: savedg
318                 in eval body savedg'
319         | Letrec (var_to_bind, t2, t3) ->
320                 (* we don't handle cases where t2 doesn't evaluate to a function value *)
321                 let Closure (arg_var, body, savedg) = eval t2 g
322         (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *)
323                 in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
324                 in eval t3 g'
325         ;;
327 The complete code is available [here](/code/calculator/calc3.ml).
331 Next, we'll add mutable cells (explicit-style mutation) to our calculator, as we did in [[week9]].
333 We'll add a few more syntactic forms to the language:
335         type term =
336                   Intconstant of int
337                 | Multiplication of (term * term)
338                 | Addition of (term * term)
339                 | Variable of char
340                 | Let of (char * term * term)
341                 | Iszero of term
342                 | If of (term * term * term)
343                 | Makepair of (term * term)
344                 | First of term
345                 | Lambda of (char * term)
346                 | Apply of (term * term)
347                 | Letrec of (char * term * term)
348                 | Newref of term
349                 | Deref of term
350                 | Setref of (term * term)
351         ;;
353 And we now have to allow for `Mutcell`s as an additional kind of `expressed_value`. These are implemented as wrappers around an index into a `store`:
355         type index = int;;
357         type bound_value = Nonrecursive of expressed_value |
358                 Recursive_Closure of char * char * term * assignment
359         and assignment = (char * bound_value) list
360         and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment | Mutcell of index;;
362         type store = expressed_value list;;
364 Our evaluation function will now expect a `store` argument as well as an `assignment`, and will return an `expressed_value * store` pair:
366         let rec eval (t : term) (g : assignment) (s : store) = match t with
367           Intconstant x -> (Int x, s)
368           ...
369         | Variable (var) -> (
370                 (* we don't handle cases where g doesn't bind var to any value *)
371                 match List.assoc var g with
372           | Nonrecursive value -> value
373           | Recursive_Closure (self_var, arg_var, body, savedg) as rec_closure ->
374                           (* we update savedg to bind self_var to rec_closure here *)
375               let savedg' = (self_var, rec_closure) :: savedg
376               in Closure (arg_var, body, savedg')
377         ), s
378           ...
379         | Lambda (arg_var, t2) -> (Closure (arg_var, t2, g), s)
380           ...
382 also, we'll need to be sure to thread the store argument through the evaluation of any subterms, as here:
384         ...
385         | Multiplication (t1, t2) ->
386                 (* we don't handle cases where the subterms don't evaluate to Ints *)
387                 let (Int i1, s') = eval t1 g s
388                 in let (Int i2, s'') = eval t2 g s'
389                 (* Multiplication (t1, t2) should evaluate to an Int *)
390                 in (Int (i1 * i2), s'')
391         | Addition (t1, t2) ->
392                 let (Int i1, s') = eval t1 g s
393                 in let (Int i2, s'') = eval t2 g s'
394                 in (Int (i1 + i2), s'')
395         ...
396         | Let (var_to_bind, t2, t3) ->
397                 (* evaluate t3 under a new assignment where var_to_bind has been bound to
398            the result of evaluating t2 under the current assignment *)
399                 let (value2, s') = eval t2 g s
400                 (* we have to wrap value2 in Nonrecursive *)
401                 in let g' = (var_to_bind, Nonrecursive value2) :: g
402                 in eval t3 g' s'
403         | Iszero (t1) ->
404                 (* we don't handle cases where t1 doesn't evaluate to an Int *)
405                 let (Int i1, s') = eval t1 g s
406                 (* Iszero t1 should evaluate to a Bool *)
407                 in (Bool (i1 = 0), s')
408         ...
409         | Makepair (t1, t2) ->
410                 let (value1, s') = eval t1 g s
411                 in let (value2, s'') = eval t2 g s'
412                 in (Pair (value1, value2), s'')
413         | First (t1) ->
414                 (* we don't handle cases where t1 doesn't evaluate to a Pair *)
415                 let (Pair (value1, value2), s') = eval t1 g s
416                 in (value1, s')
417         ...
418         | Apply (t1, t2) ->
419                 (* we don't handle cases where t1 doesn't evaluate to a function value *)
420                 let (Closure (arg_var, body, savedg), s') = eval t1 g s
421                 in let (value2, s'') = eval t2 g s'
422                 (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
423                 in let savedg' = (arg_var, Nonrecursive value2) :: savedg
424                 in eval body savedg' s''
425         | Letrec (var_to_bind, t2, t3) ->
426                 (* we don't handle cases where t2 doesn't evaluate to a function value *)
427                 let (Closure (arg_var, body, savedg), s') = eval t2 g s
428         (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *)
429                 in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
430                 in eval t3 g' s'
431         ...
433 The clause for `If (...)` is notable:
435         ...
436         | If (t1, t2, t3) ->
437                 (* we don't handle cases where t1 doesn't evaluate to a boolean *)
438                 let (Bool b1, s') = eval t1 g s
439         (* note we thread s' through only one of the then/else clauses *)
440                 in if b1 then eval t2 g s'
441                 else eval t3 g s'
442         ...
444 Now we need to formulate the clauses for evaluating the new forms `Newref (...)`, `Deref (...)`, and `Setref (...)`.
446         ...
447         | Newref (t1) ->
448                 let (starting_val, s') = eval t1 g s
449                 (* note that s' may be different from s, if t1 itself contained any mutation operations *)
450                 (* now we want to retrieve the next free index in s' *)
451                 in let new_index = List.length s'
452                 (* now we want to insert starting_val there; the following is an easy but inefficient way to do it *)
453                 in let s'' = List.append s' [starting_val]
454                 (* now we return a pair of a wrapped new_index, and the new store *)
455                 in (Mutcell new_index, s'')
456         | Deref (t1) ->
457                 (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
458                 let (Mutcell index1, s') = eval t1 g s
459                 (* note that s' may be different from s, if t1 itself contained any mutation operations *)
460                 in (List.nth s' index1, s')
461         | Setref (t1, t2) ->
462                 (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
463                 let (Mutcell index1, s') = eval t1 g s
464                 (* note that s' may be different from s, if t1 itself contained any mutation operations *)
465                 in let (new_value, s'') = eval t2 g s'
466                 (* now we create a list which is just like s'' except it has new_value in index1 *)
467                 in let rec replace_nth lst m =
468                         match lst with
469                         | [] -> failwith "list too short"
470                         | x::xs when m = 0 -> new_value :: xs
471                         | x::xs -> x :: replace_nth xs (m - 1)
472                 in let s''' = replace_nth s'' index1
473                 (* we'll arbitrarily return Int 42 as the expressed_value of a Setref operation *)
474                 in (Int 42, s''')
475         ;;
477 The complete code is available [here](/code/calculator/calc4.ml).
481 Suppose we wanted to work with pairs where we could mutate either component of the pair. Well, we've already given ourselves pairs, and mutable cells, so we could just work here with pairs of mutable cells. But it might sometimes be more wieldy to work with a structure that fused these two structures together, to give us a mutable pair. With the mutable pair, we wouldn't ask for the first element, and then apply `Deref` to it to get the value it then temporarily contains. Instead, asking for the first element would *constitute* asking for the value the mutable pair then temporarily contains in its first position.
483 This means a mutable pair is an interesting hybrid between explicit-style and implicit-style mutation. Looked at one way, it's just a generalization of an explicit mutable cell: it's just that where the mutable cells we implemented before were boxes with only one position, now we have boxes with two positions. Looked at another way, though, mutable pairs are similar to implicit-style mutation: for we don't have separate ways of referring to the first position of the mutable pair, and its dereferenced value. Peeking at the first position *just will be* peeking at its current dereferenced value.
485 To keep our codebase smaller, we'll implement mutable pairs instead of, not in addition to, the mutable cells from the previous section. Also, we'll leave out the immutable pairs we've been working with up to this point; in this implementation, all pairs will be mutable.
487 This implementation will largely parallel the previous one. Here are the differences. First, we remove the `Newref`, `Deref`, and `Setref` forms from the language. Our existing form `Makepair` will serve to create mutable pairs, and so will take over a role analogous to `Newref`. Our existing form `First` will take over a role analogous to `Deref`. We'll introduce one new form `Setfirst` that will take over a role analogous to `Setref`:
489         type term =
490                   Intconstant of int
491                 | Multiplication of (term * term)
492                 | Addition of (term * term)
493                 | Variable of char
494                 | Let of (char * term * term)
495                 | Iszero of term
496                 | If of (term * term * term)
497                 | Makepair of (term * term)
498                 | First of term
499                 | Lambda of (char * term)
500                 | Apply of (term * term)
501                 | Letrec of (char * term * term)
502         | Setfirst of (term * term)
503         ;;
505 Our `expressed_value` type changes in two ways: first, we eliminate the `Mutcell` variant added in the previous implementation. Instead, we now have our `Pair` variant wrap `index`es into the `store`:
507         type index = int;;
509         type bound_value = Nonrecursive of expressed_value |
510                 Recursive_Closure of char * char * term * assignment
511         and assignment = (char * bound_value) list
512         and expressed_value = Int of int | Bool of bool | Pair of index * index | Closure of char * term * assignment;;
514         type store = expressed_value list;;
516 Finally, here are the changed or added clauses to the evaluation function:
518         let rec eval (t : term) (g : assignment) (s : store) = match t with
519         ...
520         | Makepair (t1, t2) ->
521                 let (value1, s') = eval t1 g s
522                 in let (value2, s'') = eval t2 g s'
523         (* now we want to retrieve the next free index in s'' *)
524         in let new_index = List.length s''
525         (* now we want to insert value1 and value2 there; the following is an easy but inefficient way to do it *)
526         in let s''' = List.append s'' [value1; value2]
527                 in (Pair (new_index, new_index + 1), s''')
528         | First (t1) ->
529                 (* we don't handle cases where t1 doesn't evaluate to a Pair *)
530                 let (Pair (index1, index2), s') = eval t1 g s
531         (* note that s' may be different from s, if t1 itself contained any mutation operations *)
532         in (List.nth s' index1, s')
533         ...
534     | Setfirst (t1, t2) ->
535         (* we don't handle cases where t1 doesn't evaluate to a Pair *)
536         let (Pair (index1, index2), s') = eval t1 g s
537         (* note that s' may be different from s, if t1 itself contained any mutation operations *)
538         in let (new_value, s'') = eval t2 g s'
539         (* now we create a list which is just like s'' except it has new_value in index1 *)
540         in let rec replace_nth lst m =
541             match lst with
542             | [] -> failwith "list too short"
543             | x::xs when m = 0 -> new_value :: xs
544             | x::xs -> x :: replace_nth xs (m - 1)
545         in let s''' = replace_nth s'' index1
546         in (Int 42, s''')
547         ;;
549 Compare these to the clauses for `Newref`, `Deref`, and `Setref` in the previous implementation.
551 The complete code is available [here](/code/calculator/calc5.ml).
555 Next we implement implicit-style mutation, as we did in [[week9]]. Here we don't have any explicit reference cells or mutable pairs; we'll return pairs back to their original immutable form. Instead, all variables will have mutable bindings. New reference cells will be implicitly introduced by the `Let` form. They'll also be implicitly introduced by the `Apply` form---we didn't have function values on the table during the [[week9]] discussion, so this didn't come up then. The reason we introduce new reference cells when `Apply`ing a function value to arguments is that we don't want mutation of those arguments inside the body of the function to propagate out and affect the reference cell that may have supplied the argument. When we call functions in this implementation, we just want to supply them with *values*, not with the reference cells we may be drawing those values from. Below, after we discuss *aliases*, we'll consider another strategy, where function bodies are given the ability to mutate the reference cells implicitly associated with the arguments they're supplied.
557 Our language for the present implementation will be the language for the calculator with recursive functions, with one added syntactic form, `Change (...)`:
559         type term =
560                   Intconstant of int
561                 | Multiplication of (term * term)
562                 | Addition of (term * term)
563                 | Variable of char
564                 | Let of (char * term * term)
565                 | Iszero of term
566                 | If of (term * term * term)
567                 | Makepair of (term * term)
568                 | First of term
569                 | Lambda of (char * term)
570                 | Apply of (term * term)
571                 | Letrec of (char * term * term)
572                 | Change of (char * term * term)
573         ;;
575 In the present implementation, we separate the roles of the `bound_value` and `expressed_value` types. As we discussed in [[week9]], our assignment will bind all variables to indexes in the store, and the latter will contain the `expressed_value`s that the variables evaluate to. A consequence of this is that our definitions of the `bound_value` and `expressed_value` types no longer need to be mutually recursive:
577         type index = int;;
579         type bound_value = index;;
580         type assignment = (char * bound_value) list;;
581         type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
583         type store = expressed_value list;;
585 Our evaluation function still interacts with a `store` argument in much the same way it did with explicit-style mutation. The clause for `Variable ...` works differently, because all `expressed_value`s now need to be retrieved from the `store`:
587         let rec eval (t : term) (g : assignment) (s : store) = match t with
588                 ...
589                 | Variable (var) ->
590                         (* we don't handle cases where g doesn't bind var to any value *)
591                         let index = List.assoc var g
592                         (* get value stored at location index in s *)
593                         in let value = List.nth s index
594                         in (value, s)
595                 ...
597 So this clause takes over the roles that were separately played by `Variable` and `Deref` in the calculator with mutable cells. The role played by `Newref` is absorbed into `Let`, `Letrec`, and `Apply`:
599                 ...
600                 | Let (var_to_bind, t2, t3) ->
601                         let (value2, s') = eval t2 g s
602                         (* note that s' may be different from s, if t2 itself contained any mutation operations *)
603                         (* get next free index in s' *)
604                         in let new_index = List.length s'
605                         (* now we want to insert value2 there; the following is an easy but inefficient way to do it *)
606                         in let s'' = List.append s' [value2]
607                         (* bind var_to_bind to location new_index in the store *)
608                         in let g' = ((var_to_bind, new_index) :: g)
609                         in eval t3 g' s''
610                 ...
611                 | Apply (t1, t2) ->
612                         (* we don't handle cases where t1 doesn't evaluate to a function value *)
613                         let (Closure (arg_var, body, savedg), s') = eval t1 g s
614                         in let (value2, s'') = eval t2 g s'
615                         (* evaluate body under savedg, except with arg_var bound to a new location containing value2 *)
616                         in let new_index = List.length s''
617                         in let s''' = List.append s'' [value2]
618                         in let savedg' = (arg_var, new_index) :: savedg
619                         in eval body savedg' s'''
620                 ...
622 `Letrec` requires some reworking from what we had before. Earlier, we resorted to a `Recursive_Closure` variant on `bound_value`s because it gave us a non-exotic way to update the `savedg` component of a `Closure` to refer to a `new_closure` that contained that very updated `savedg`. Now that we we've got a mutation-supporting infrastructure in place, we can do this directly, without needing the unwieldy `Recursive_Closure` wrapper:
624                 ...
625                 | Letrec (var_to_bind, t2, t3) ->
626                         (* we don't handle cases where t2 doesn't evaluate to a function value *)
627                         let (Closure (arg_var, body, savedg), s') = eval t2 g s
628                         in let new_index = List.length s'
629                         in let savedg' = (var_to_bind, new_index) :: savedg
630                         in let new_closure = Closure (arg_var, body, savedg')
631                         in let s'' = List.append s' [new_closure]
632                         in let g' = (var_to_bind, new_index) :: g
633                         in eval t3 g' s''
634                 ...
636 Finally, here is the clause for `Change (...)`, which takes over the role earlier played by `Setref`:
638                 | Change (var, t2, t3) ->
639                         (* we don't handle cases where g doesn't bind var to any value *)
640                         let index = List.assoc var g
641                         in let (value2, s') = eval t2 g s
642                         (* note that s' may be different from s, if t2 itself contained any mutation operations *)
643                         (* now we create a list which is just like s' except it has value2 at index *)
644                         in let rec replace_nth lst m =
645                                 match lst with
646                                 | [] -> failwith "list too short"
647                                 | x::xs when m = 0 -> value2 :: xs
648                                 | x::xs -> x :: replace_nth xs (m - 1)
649                         in let s'' = replace_nth s' index
650                         (* evaluate t3 using original assignment function and new store *)
651                         in eval t3 g s''
652                 ;;
654 Note that because the `savedg` component of a `Closure` keeps track of which `index`es in the store free variables were bound to, the values at those `index`es can later be changed, and later applications of the `Closure` will use the changed values.
656 The complete code is available [here](/code/calculator/calc6.ml).
658 ##Adding Aliasing and Passing by Reference##
660         type term =
661                   Intconstant of int
662                 | Multiplication of (term * term)
663                 | Addition of (term * term)
664                 | Variable of char
665                 | Let of (char * term * term)
666                 | Iszero of term
667                 | If of (term * term * term)
668                 | Makepair of (term * term)
669                 | First of term
670                 | Lambda of (char * term)
671                 | Apply of (term * term)
672                 | Letrec of (char * term * term)
673                 | Change of (char * term * term)
674                 | Alias of (char * char * term)
675                 | Applyalias of (term * char)
676         ;;
678         let rec eval (t : term) (g : assignment) (s : store) = match t with
679                 ...
680                 | Alias (var_to_bind, orig_var, t3) ->
681                         (* we don't handle cases where g doesn't bind orig_var to any value *)
682                         let index = List.assoc orig_var g
683                         (* bind var_to_bind to the same index in the store *)
684                         in let g' = ((var_to_bind, index) :: g)
685                         in eval t3 g' s
686                 | Applyalias (t1, var) ->
687                         (* we don't handle cases where t1 doesn't evaluate to a function value *)
688                         let (Closure (arg_var, body, savedg), s') = eval t1 g s
689                         (* we don't handle cases where g doesn't bind var to any value *)
690                         in let index = List.assoc var g
691                         (* evaluate body under savedg, except with arg_var bound to existing index *)
692                         in let savedg' = (arg_var, index) :: savedg
693                         in eval body savedg' s'
694                 ;;
696 The complete code is available [here](/code/calculator/calc7.ml).