The language we had in week 7 looked like this:
- type term = Constant of int
- | Multiplication of (term * term)
- | Addition of (term * term)
- | Variable of char
- | Let of (char * term * term)
+ type term =
+ Constant of int
+ | Multiplication of (term * term)
+ | Addition of (term * term)
+ | Variable of char
+ | Let of (char * term * term)
;;
and the evaluation function looked like this:
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:
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
+ 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
;;
let rec eval (t : term) (g : assignment) = match t with
We can begin with our language:
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)
+ 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)
;;
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:
Here is the expanded definition for our language type:
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)
+ 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)
;;
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:
We'll add a few more syntactic forms to the language:
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)
- | Newref of term
- | Deref of term
- | Setref of (term * 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)
+ | Newref of term
+ | Deref of term
+ | Setref of (term * term)
;;
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`:
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)
+ 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`:
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)
+ 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:
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)
- ...
+ ...
+ | 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'''
- ...
+ ...
+ | 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''
- ...
+ ...
+ | 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''
- ;;
+ ...
+ | 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.
##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)
+ 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'
- ;;
+ ...
+ | 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'
+ ;;
The complete code is available [here](/code/calculator/calc7.ml).