author Jim Pryor Fri, 26 Nov 2010 02:46:51 +0000 (21:46 -0500) committer Jim Pryor Fri, 26 Nov 2010 02:46:51 +0000 (21:46 -0500)
Signed-off-by: Jim Pryor <profjim@jimpryor.net>
 advanced_topics/calculator_improvements.mdwn patch | blob | history code/calculator/calc1.ml patch | blob | history code/calculator/calc2.ml patch | blob | history code/calculator/calc3.ml patch | blob | history code/calculator/calc4.ml patch | blob | history code/calculator/calc5.ml patch | blob | history code/calculator/calc6.ml patch | blob | history code/calculator/calc7.ml patch | blob | history

index f50a4be..d6654db 100644 (file)
@@ -18,11 +18,12 @@ Then the interpreter (or "evaluator") would convert that AST into an "expressed

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:
@@ -68,15 +69,15 @@ We'll switch over to using variable `g` for assignment functions, which is a con
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
@@ -133,17 +134,17 @@ What changes do we need to handle this?
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:
@@ -202,18 +203,18 @@ where the AST would be:
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:
@@ -333,21 +334,21 @@ Next, we'll add mutable cells (explicit-style mutation) to our calculator, as we
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`:
@@ -487,19 +488,19 @@ To keep our codebase smaller, we'll implement mutable pairs instead of, not in a
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`:
@@ -557,19 +558,19 @@ Next we implement implicit-style mutation, as we did in [[week9]]. Here we don't
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:
@@ -585,71 +586,72 @@ In the present implementation, we separate the roles of the `bound_value` and `e
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.

@@ -658,40 +660,40 @@ 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)
+         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).

index 46afcc3..35b32ff 100644 (file)
@@ -1,16 +1,16 @@
(* Original calculator from Week7, enhanced with Booleans and Immutable Pairs *)

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
+    ;;

type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value;;
type bound_value = expressed_value;;
index 9db0dea..57a3342 100644 (file)
@@ -1,18 +1,18 @@
(* calc1.ml, enhanced with Function Values *)

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)
+    ;;

type bound_value = expressed_value
and assignment = (char * bound_value) list
index bcf15cd..522ca28 100644 (file)
@@ -1,19 +1,19 @@
(* calc2.ml, enhanced with Recursive Function Values *)

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)
+    ;;

type bound_value = Nonrecursive of expressed_value | Recursive_Closure of char * char * term * assignment
and assignment = (char * bound_value) list
index d2fc94e..571d277 100644 (file)
@@ -1,22 +1,22 @@
(* calc3.ml, enhanced with Mutable Cells *)

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)
+    ;;

type index = int;;

index 8572706..bfc91d9 100644 (file)
@@ -1,20 +1,20 @@
(* calc3,ml, enhanced with Mutable Pairs *)

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)
+    ;;

type index = int;;

index f0154f2..381e543 100644 (file)
@@ -1,20 +1,20 @@
(* calc3.ml, enhanced with Mutable 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
-               | 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)
+    ;;

type index = int;;

index df67512..5bfba38 100644 (file)
@@ -1,22 +1,22 @@
(* calc6.ml, enhanced with Aliases 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)
+    ;;

type index = int;;