From 3d94d4500167a8327473e15cf477727968ee36a2 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Fri, 16 Aug 2019 01:12:54 +0100 Subject: [PATCH] Fix typechecking with bindings --- codegen.scm | 2 +- typecheck.scm | 9 +++++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/codegen.scm b/codegen.scm index 6203cfd..985ad44 100644 --- a/codegen.scm +++ b/codegen.scm @@ -492,7 +492,7 @@ (if (eqv? 'var (ast-type x)) (list (cons x inner-offset)) (begin - (emit "cmp $~a, ~a(%rbp)" x inner-offset) + (emit "cmpq $~a, ~a(%rbp)" x inner-offset) (emit "jne ~a" jne-label) '() ))))) diff --git a/typecheck.scm b/typecheck.scm index b346675..f6d7c86 100644 --- a/typecheck.scm +++ b/typecheck.scm @@ -194,10 +194,14 @@ (define (get-bindings product-types pattern) (define (go product-type product) - (case (ast-type x) + (case (ast-type product) ['var (list (cons product product-type))] ; an inner pattern match - ['app (get-bindings product-type product)])) + ['app (let* ([inner-sum (car product)] + [inner-sums (cdr (assoc product-type dls))] + [inner-product-types (cdr (assoc inner-sum inner-sums))]) + (get-bindings inner-product-types product))] + [else '()])) (flat-map go product-types (cdr pattern))) @@ -211,6 +215,7 @@ (let* ([names (cdr pattern)] [product-types (cdr sum)] [new-env (append (get-bindings product-types pattern) env)]) + (check dls new-env expr)))] ; pattern match with binding and no constructor ['var (check dls (env-insert env pattern switch-type) expr)] -- 2.30.2