X-Git-Url: http://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=typecheck.scm;h=1b2f21479eb539915b5e46bd0d646b78330d6d27;hp=6aca2c1161ab5506189da5fdea2a0675d4761567;hb=adbf51b9013353037797f4cc830a6c55628ce038;hpb=7bcc8cc8aa41849a6f6e0615a1309b7ac3b3956f diff --git a/typecheck.scm b/typecheck.scm index 6aca2c1..1b2f214 100644 --- 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 ")