Fix up typechecking of case

diff --git a/typecheck.scm b/typecheck.scm
index 6aca2c1161ab5506189da5fdea2a0675d4761567..1b2f21479eb539915b5e46bd0d646b78330d6d27 100644 (file)
--- a/typecheck.scm
+++ b/typecheck.scm
@@ -247,23 +247,23 @@
          ('app (check-app env x))
          ['case
              (let* ([expr-type-res (check env (case-expr x))]
-                    [expr-type (cadr env)]
+                    [expr-type (cadr expr-type-res)]
                     [case-match-type-res (map (lambda (x) (check env x))
                                               (map car (case-cases x)))]
                     [case-match-types (map cadr case-match-type-res)]
                     
                     [case-expr-type-res (map (lambda (x) (check env x))
                                              (map cadr (case-cases x)))]
-                    [case-expr-types (map cadr case-expr-types-res)]
+                    [case-expr-types (map cadr case-expr-type-res)]
 
                     [case-match-equality-cs (fold-left constraint-merge '()
                                                        (map (lambda (t) (~ t expr-type)) case-match-types))]
 
                     [case-expr-equality-cs (fold-left constraint-merge '()
-                                                      (map (lambda (t) (~ t (car case-expr-type-res)))
-                                                           (cdr case-expr-type-res)))]
+                                                      (map (lambda (t) (~ t (car case-expr-types)))
+                                                           (cdr case-expr-types)))]
 
-                    [resolved-type (substitute case-expr-eqaulity-cs (car case-expr-type-res))]
+                    [resolved-type (substitute case-expr-equality-cs (car case-expr-types))]
 
                     [annotated `((case (,(case-expr x) : ,expr-type)
                                    ,(map (lambda (c e et)
@@ -275,7 +275,7 @@
                     [cs (fold-left constraint-merge '()
                                    (append case-match-equality-cs
                                            case-expr-equality-cs
-                                           (cadr expr-type-res)))])
+                                           (car expr-type-res)))])
                (list cs resolved-type annotated))])))
                
     ;; (display "result of ")