X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fcalculator%2Fcalc2.ml;h=521b81ddcfb2eb757af61febbc30dee549091604;hp=57a3342a32b3bc0316ae457859ab0926e8e84bb2;hb=c51397c5a41cbf75e37382905b212868e427b16b;hpb=bd90f2eb8b87c2f44169fe209c5e35dd113c3d21 diff --git a/code/calculator/calc2.ml b/code/calculator/calc2.ml index 57a3342a..521b81dd 100644 --- a/code/calculator/calc2.ml +++ b/code/calculator/calc2.ml @@ -1,6 +1,6 @@ -(* calc1.ml, enhanced with Function Values *) +(* calc2.ml: calc1.ml enhanced with Function Values *) - type term = + type term = Intconstant of int | Multiplication of (term * term) | Addition of (term * term) @@ -15,54 +15,54 @@ ;; type bound_value = expressed_value - and assignment = (char * bound_value) list + and assignment = (char * bound_value) list and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;; - let rec eval (t : term) (g : assignment) = match t with - Intconstant x -> Int x - | Multiplication (t1, t2) -> - (* we don't handle cases where the subterms don't evaluate to Ints *) - let Int i1 = eval t1 g - in let Int i2 = eval t2 g - (* Multiplication (t1, t2) should evaluate to an Int *) - in Int (i1 * i2) - | Addition (t1, t2) -> - let Int i1 = eval t1 g - in let Int i2 = eval t2 g - in Int (i1 + i2) - | Variable (var) -> - (* we don't handle cases where g doesn't bind var to any value *) - List.assoc var g - | Let (var_to_bind, t2, t3) -> - (* evaluate t3 under a new assignment where var_to_bind has been bound to - the result of evaluating t1 under the current assignment *) - let value2 = eval t2 g - in let g' = (var_to_bind, value2) :: g - in eval t3 g' - | Iszero (t1) -> - (* we don't handle cases where t1 doesn't evaluate to an Int *) - let Int i1 = eval t1 g - (* Iszero t1 should evaluate to a Bool *) - in Bool (i1 = 0) - | If (t1, t2, t3) -> - (* we don't handle cases where t1 doesn't evaluate to a boolean *) - let Bool b1 = eval t1 g - in if b1 then eval t2 g - else eval t3 g - | Makepair (t1, t2) -> - let value1 = eval t1 g - in let value2 = eval t2 g - in Pair (value1, value2) - | First (t1) -> - (* we don't handle cases where t1 doesn't evaluate to a Pair *) - let Pair (value1, value2) = eval t1 g - in value1 - | Lambda (arg_var, t2) -> Closure (arg_var, t2, g) - | Apply (t1, t2) -> - (* we don't handle cases where t1 doesn't evaluate to a function value *) - let Closure (arg_var, body, savedg) = eval t1 g - in let value2 = eval t2 g - (* evaluate body under savedg, except with arg_var bound to value2 *) - in let savedg' = (arg_var, value2) :: savedg - in eval body savedg' + let rec eval (t : term) (g : assignment) = match t with + Intconstant x -> Int x + | Multiplication (t1, t2) -> + (* we don't handle cases where the subterms don't evaluate to Ints *) + let Int i1 = eval t1 g + in let Int i2 = eval t2 g + (* Multiplication (t1, t2) should evaluate to an Int *) + in Int (i1 * i2) + | Addition (t1, t2) -> + let Int i1 = eval t1 g + in let Int i2 = eval t2 g + in Int (i1 + i2) + | Variable (var) -> + (* we don't handle cases where g doesn't bind var to any value *) + List.assoc var g + | Let (var_to_bind, t2, t3) -> + (* evaluate t3 under a new assignment where var_to_bind has been bound to + the result of evaluating t1 under the current assignment *) + let value2 = eval t2 g + in let g' = (var_to_bind, value2) :: g + in eval t3 g' + | Iszero (t1) -> + (* we don't handle cases where t1 doesn't evaluate to an Int *) + let Int i1 = eval t1 g + (* Iszero t1 should evaluate to a Bool *) + in Bool (i1 = 0) + | If (t1, t2, t3) -> + (* we don't handle cases where t1 doesn't evaluate to a boolean *) + let Bool b1 = eval t1 g + in if b1 then eval t2 g + else eval t3 g + | Makepair (t1, t2) -> + let value1 = eval t1 g + in let value2 = eval t2 g + in Pair (value1, value2) + | First (t1) -> + (* we don't handle cases where t1 doesn't evaluate to a Pair *) + let Pair (value1, value2) = eval t1 g + in value1 + | Lambda (arg_var, t2) -> Closure (arg_var, t2, g) + | Apply (t1, t2) -> + (* we don't handle cases where t1 doesn't evaluate to a function value *) + let Closure (arg_var, body, savedg) = eval t1 g + in let value2 = eval t2 g + (* evaluate body under savedg, except with arg_var bound to value2 *) + in let savedg' = (arg_var, value2) :: savedg + in eval body savedg' ;;