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:
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.
-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.
+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 [[week9]], 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.
type bound_value = expressed_value;;
type assignment = (char * bound_value) list;;
-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:
+Here's where we should be now. We'll work with 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
+ 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
;;
+Here is our evaluation function. We expand some of the clauses and rename a few variables for clarity. Our implementation should make it clear how to add additional constants or native predicates, such as a `Second` predicate for extracting the second element of a pair.
+
let rec eval (t : term) (g : assignment) = match t with
Intconstant x -> Int x
| Multiplication (t1, t2) ->
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).