+ let (Closure (arg_var, body, savedg), s') = eval t1 g s
+ in let (value2, s'') = eval t2 g s'
+ (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
+ in let savedg' = (arg_var, Nonrecursive value2) :: savedg
+ in eval body savedg' s''
+ | Letrec (var_to_bind, t2, t3) ->
+ (* we don't handle cases where t2 doesn't evaluate to a function value *)
+ let (Closure (arg_var, body, savedg), s') = eval t2 g s
+ (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *)
+ in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
+ in eval t3 g' s'
+ ...
+
+The clause for `If (...)` is notable:
+
+ ...
+ | If (t1, t2, t3) ->
+ (* we don't handle cases where t1 doesn't evaluate to a boolean *)
+ let (Bool b1, s') = eval t1 g s
+ (* note we thread s' through only one of the then/else clauses *)
+ in if b1 then eval t2 g s'
+ else eval t3 g s'
+ ...
+
+Now we need to formulate the clauses for evaluating the new forms `Newref (...)`, `Deref (...)`, and `Setref (...)`.
+
+ ...
+ | Newref (t1) ->
+ let (starting_val, s') = eval t1 g s
+ (* note that s' may be different from s, if t1 itself contained any mutation operations *)
+ (* now we want to retrieve the next free index in s' *)
+ in let new_index = List.length s'
+ (* now we want to insert starting_val there; the following is an easy but inefficient way to do it *)
+ in let s'' = List.append s' [starting_val]
+ (* now we return a pair of a wrapped new_index, and the new store *)
+ in (Mutcell new_index, s'')
+ | Deref (t1) ->
+ (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
+ let (Mutcell index1, s') = eval t1 g s
+ (* note that s' may be different from s, if t1 itself contained any mutation operations *)
+ in (List.nth s' index1, s')
+ | Setref (t1, t2) ->
+ (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
+ let (Mutcell index1, s') = eval t1 g s
+ (* note that s' may be different from s, if t1 itself contained any mutation operations *)
+ in let (new_value, s'') = eval t2 g s'
+ (* now we create a list which is just like s'' except it has new_value in index1 *)
+ in let rec replace_nth lst m =
+ match lst with
+ | [] -> failwith "list too short"
+ | x::xs when m = 0 -> new_value :: xs
+ | x::xs -> x :: replace_nth xs (m - 1)
+ in let s''' = replace_nth s'' index1
+ (* we'll arbitrarily return Int 42 as the expressed_value of a Setref operation *)
+ in (Int 42, s''')
+ ;;
+
+The complete code is available [here](/code/calculator/calc4.ml).
+
+##Adding Mutable Pairs##
+
+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.
+
+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.
+
+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.
+
+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`:
+
+ type term =
+ Intconstant of int
+ | Multiplication of (term * term)
+ | Addition of (term * term)
+ | Variable of char
+ | Let of (char * term * term)
+ | Iszero of term
+ | If of (term * term * term)
+ | Makepair of (term * term)
+ | First of term
+ | Lambda of (char * term)
+ | Apply of (term * term)
+ | Letrec of (char * term * term)
+ | Setfirst of (term * term)
+ ;;
+
+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`:
+
+ type index = int;;
+
+ type bound_value = Nonrecursive of expressed_value |
+ Recursive_Closure of char * char * term * assignment
+ and assignment = (char * bound_value) list
+ and expressed_value = Int of int | Bool of bool | Pair of index * index | Closure of char * term * assignment;;
+
+ type store = expressed_value list;;
+
+Finally, here are the changed or added clauses to the evaluation function:
+
+ let rec eval (t : term) (g : assignment) (s : store) = match t with
+ ...
+ | Makepair (t1, t2) ->
+ let (value1, s') = eval t1 g s
+ in let (value2, s'') = eval t2 g s'
+ (* now we want to retrieve the next free index in s'' *)
+ in let new_index = List.length s''
+ (* now we want to insert value1 and value2 there; the following is an easy but inefficient way to do it *)
+ in let s''' = List.append s'' [value1; value2]
+ in (Pair (new_index, new_index + 1), s''')
+ | First (t1) ->
+ (* we don't handle cases where t1 doesn't evaluate to a Pair *)
+ let (Pair (index1, index2), s') = eval t1 g s
+ (* note that s' may be different from s, if t1 itself contained any mutation operations *)
+ in (List.nth s' index1, s')
+ ...
+ | Setfirst (t1, t2) ->
+ (* we don't handle cases where t1 doesn't evaluate to a Pair *)
+ let (Pair (index1, index2), s') = eval t1 g s
+ (* note that s' may be different from s, if t1 itself contained any mutation operations *)
+ in let (new_value, s'') = eval t2 g s'
+ (* now we create a list which is just like s'' except it has new_value in index1 *)
+ in let rec replace_nth lst m =
+ match lst with
+ | [] -> failwith "list too short"
+ | x::xs when m = 0 -> new_value :: xs
+ | x::xs -> x :: replace_nth xs (m - 1)
+ in let s''' = replace_nth s'' index1
+ in (Int 42, s''')
+ ;;
+
+Compare these to the clauses for `Newref`, `Deref`, and `Setref` in the previous implementation.
+
+The complete code is available [here](/code/calculator/calc5.ml).
+
+##Adding Implicit Mutation##
+
+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.
+
+Our language for the present implementation will be the language for the calculator with recursive functions, with one added syntactic form, `Change (...)`:
+
+ type term =
+ Intconstant of int
+ | Multiplication of (term * term)
+ | Addition of (term * term)
+ | Variable of char
+ | Let of (char * term * term)
+ | Iszero of term
+ | If of (term * term * term)
+ | Makepair of (term * term)
+ | First of term
+ | Lambda of (char * term)
+ | Apply of (term * term)
+ | Letrec of (char * term * term)
+ | Change of (char * term * term)
+ ;;
+
+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:
+
+ type index = int;;
+
+ type bound_value = index;;
+ type assignment = (char * bound_value) list;;
+ type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
+
+ type store = expressed_value list;;
+
+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`:
+
+ let rec eval (t : term) (g : assignment) (s : store) = match t with
+ ...
+ | Variable (var) ->
+ (* we don't handle cases where g doesn't bind var to any value *)
+ let index = List.assoc var g
+ (* get value stored at location index in s *)
+ in let value = List.nth s index
+ in (value, s)
+ ...
+
+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`:
+
+ ...
+ | Let (var_to_bind, t2, t3) ->
+ let (value2, s') = eval t2 g s
+ (* note that s' may be different from s, if t2 itself contained any mutation operations *)
+ (* get next free index in s' *)
+ in let new_index = List.length s'
+ (* now we want to insert value2 there; the following is an easy but inefficient way to do it *)
+ in let s'' = List.append s' [value2]
+ (* bind var_to_bind to location new_index in the store *)
+ in let g' = ((var_to_bind, new_index) :: g)
+ in eval t3 g' s''
+ ...
+ | Apply (t1, t2) ->
+ (* we don't handle cases where t1 doesn't evaluate to a function value *)
+ let (Closure (arg_var, body, savedg), s') = eval t1 g s
+ in let (value2, s'') = eval t2 g s'
+ (* evaluate body under savedg, except with arg_var bound to a new location containing value2 *)
+ in let new_index = List.length s''
+ in let s''' = List.append s'' [value2]
+ in let savedg' = (arg_var, new_index) :: savedg
+ in eval body savedg' s'''
+ ...
+
+`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:
+
+ ...
+ | Letrec (var_to_bind, t2, t3) ->
+ (* we don't handle cases where t2 doesn't evaluate to a function value *)
+ let (Closure (arg_var, body, savedg), s') = eval t2 g s
+ in let new_index = List.length s'
+ in let savedg' = (var_to_bind, new_index) :: savedg
+ in let new_closure = Closure (arg_var, body, savedg')
+ in let s'' = List.append s' [new_closure]
+ in let g' = (var_to_bind, new_index) :: g
+ in eval t3 g' s''
+ ...
+
+Finally, here is the clause for `Change (...)`, which takes over the role earlier played by `Setref`:
+
+ ...
+ | Change (var, t2, t3) ->
+ (* we don't handle cases where g doesn't bind var to any value *)
+ let index = List.assoc var g
+ in let (value2, s') = eval t2 g s
+ (* note that s' may be different from s, if t2 itself contained any mutation operations *)
+ (* now we create a list which is just like s' except it has value2 at index *)
+ in let rec replace_nth lst m =
+ match lst with
+ | [] -> failwith "list too short"
+ | x::xs when m = 0 -> value2 :: xs
+ | x::xs -> x :: replace_nth xs (m - 1)
+ in let s'' = replace_nth s' index
+ (* evaluate t3 using original assignment function and new store *)
+ in eval t3 g s''
+ ;;
+
+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.
+
+The complete code is available [here](/code/calculator/calc6.ml).
+
+##Adding Aliasing and Passing by Reference##
+
+ type term =
+ Intconstant of int
+ | Multiplication of (term * term)
+ | Addition of (term * term)
+ | Variable of char
+ | Let of (char * term * term)
+ | Iszero of term
+ | If of (term * term * term)
+ | Makepair of (term * term)
+ | First of term
+ | Lambda of (char * term)
+ | Apply of (term * term)
+ | Letrec of (char * term * term)
+ | Change of (char * term * term)
+ | Alias of (char * char * term)
+ | Applyalias of (term * char)
+ ;;
+
+ let rec eval (t : term) (g : assignment) (s : store) = match t with
+ ...
+ | Alias (var_to_bind, orig_var, t3) ->
+ (* we don't handle cases where g doesn't bind orig_var to any value *)
+ let index = List.assoc orig_var g
+ (* bind var_to_bind to the same index in the store *)
+ in let g' = ((var_to_bind, index) :: g)
+ in eval t3 g' s
+ | Applyalias (t1, var) ->
+ (* we don't handle cases where t1 doesn't evaluate to a function value *)
+ let (Closure (arg_var, body, savedg), s') = eval t1 g s
+ (* we don't handle cases where g doesn't bind var to any value *)
+ in let index = List.assoc var g
+ (* evaluate body under savedg, except with arg_var bound to existing index *)
+ in let savedg' = (arg_var, index) :: savedg
+ in eval body savedg' s'
+ ;;