X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fcalculator%2Fcalc1.ml;h=b0c5cea766b3aea45b28f65bd808e07219fa0de5;hp=35b32ffb7db6029982a017b2a157ffce6866bc32;hb=911d868126d0b91047b362cb909cdfeb503cd16b;hpb=bd90f2eb8b87c2f44169fe209c5e35dd113c3d21 diff --git a/code/calculator/calc1.ml b/code/calculator/calc1.ml index 35b32ffb..b0c5cea7 100644 --- a/code/calculator/calc1.ml +++ b/code/calculator/calc1.ml @@ -1,6 +1,6 @@ -(* Original calculator from Week7, enhanced with Booleans and Immutable Pairs *) +(* calc1.ml: original calculator from Week7, enhanced with Booleans and Immutable Pairs *) - type term = + type term = Intconstant of int | Multiplication of (term * term) | Addition of (term * term) @@ -12,47 +12,47 @@ | First of term ;; - type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value;; - type bound_value = expressed_value;; - type assignment = (char * bound_value) list;; + type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value;; + type bound_value = expressed_value;; + type assignment = (char * bound_value) list;; - 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 t2 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 + 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 t2 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 ;;