From bd90f2eb8b87c2f44169fe209c5e35dd113c3d21 Mon Sep 17 00:00:00 2001 From: Jim Pryor Date: Thu, 25 Nov 2010 21:46:51 -0500 Subject: [PATCH 1/1] tweak calc improvements Signed-off-by: Jim Pryor --- advanced_topics/calculator_improvements.mdwn | 332 ++++++++++++++------------- code/calculator/calc1.ml | 20 +- code/calculator/calc2.ml | 24 +- code/calculator/calc3.ml | 26 +-- code/calculator/calc4.ml | 32 +-- code/calculator/calc5.ml | 28 +-- code/calculator/calc6.ml | 28 +-- code/calculator/calc7.ml | 32 +-- 8 files changed, 262 insertions(+), 260 deletions(-) diff --git a/advanced_topics/calculator_improvements.mdwn b/advanced_topics/calculator_improvements.mdwn index f50a4be2..d6654db6 100644 --- a/advanced_topics/calculator_improvements.mdwn +++ b/advanced_topics/calculator_improvements.mdwn @@ -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). diff --git a/code/calculator/calc1.ml b/code/calculator/calc1.ml index 46afcc3c..35b32ffb 100644 --- a/code/calculator/calc1.ml +++ b/code/calculator/calc1.ml @@ -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;; diff --git a/code/calculator/calc2.ml b/code/calculator/calc2.ml index 9db0dea6..57a3342a 100644 --- a/code/calculator/calc2.ml +++ b/code/calculator/calc2.ml @@ -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 diff --git a/code/calculator/calc3.ml b/code/calculator/calc3.ml index bcf15cdf..522ca287 100644 --- a/code/calculator/calc3.ml +++ b/code/calculator/calc3.ml @@ -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 diff --git a/code/calculator/calc4.ml b/code/calculator/calc4.ml index d2fc94e6..571d2776 100644 --- a/code/calculator/calc4.ml +++ b/code/calculator/calc4.ml @@ -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;; diff --git a/code/calculator/calc5.ml b/code/calculator/calc5.ml index 85727060..bfc91d9f 100644 --- a/code/calculator/calc5.ml +++ b/code/calculator/calc5.ml @@ -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;; diff --git a/code/calculator/calc6.ml b/code/calculator/calc6.ml index f0154f2d..381e543f 100644 --- a/code/calculator/calc6.ml +++ b/code/calculator/calc6.ml @@ -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;; diff --git a/code/calculator/calc7.ml b/code/calculator/calc7.ml index df675124..5bfba385 100644 --- a/code/calculator/calc7.ml +++ b/code/calculator/calc7.ml @@ -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;; -- 2.11.0