X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fcalculator%2Fcalc2.ml;h=ef4a37c6ca981c0c83fd6a54025776a2ebd24d0f;hp=9db0dea61123e1e5da5e58b36f67857b963dc081;hb=060198e29e2a13552ee64c1e489eea555c8b1cae;hpb=12c7bba12e14ab2e1ea72a4b95f1aee0c114a188 diff --git a/code/calculator/calc2.ml b/code/calculator/calc2.ml index 9db0dea6..ef4a37c6 100644 --- a/code/calculator/calc2.ml +++ b/code/calculator/calc2.ml @@ -1,68 +1,68 @@ (* 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) - ;; + 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) + ;; 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' ;;