From cc3a224a7bd5565e4c6694a2ed94d1c1a911b92c Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Wed, 13 Aug 2014 15:38:14 -0400 Subject: [PATCH] stlc bug: cases expr had no type --- stlc-tests.rkt | 13 ++++++++++++- stlc.rkt | 3 ++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/stlc-tests.rkt b/stlc-tests.rkt index 5113568..7160328 100644 --- a/stlc-tests.rkt +++ b/stlc-tests.rkt @@ -125,4 +125,15 @@ (check-type-and-result (map/BoolList (λ ([b : Bool]) (if b 0 1)) (BoolCons #f (BoolNull))) : IntList => (Cons 1 (Null))) -(check-not-type (map/BoolList (λ ([b : Bool]) (if b 0 1)) (BoolNull)) : BoolList) \ No newline at end of file +(check-not-type (map/BoolList (λ ([b : Bool]) (if b 0 1)) (BoolNull)) : BoolList) +;; check typename is available +(check-type (λ ([lst : IntList]) + (cases lst + [Null () (None)] + [Cons (x xs) (Just x)])) + : (→ IntList MaybeInt)) +(check-type ((λ ([lst : IntList]) + (cases lst + [Null () (None)] + [Cons (x xs) (Just x)])) + (Null)) : MaybeInt) \ No newline at end of file diff --git a/stlc.rkt b/stlc.rkt index 06da1af..74feac0 100644 --- a/stlc.rkt +++ b/stlc.rkt @@ -201,7 +201,8 @@ #:when (or (null? (syntax->list #'(τ_result ...))) (andmap (λ (τ) (type=? τ (car (syntax->list #'(τ_result ...))))) (cdr (syntax->list #'(τ_result ...))))) - #`(match e+ [(Cons+ x+ ...) body+ ... body_result+] ...)])) + (⊢ (syntax/loc stx (match e+ [(Cons+ x+ ...) body+ ... body_result+] ...)) + (car (syntax->list #'(τ_result ...))))])) ;; typed forms ---------------------------------------------------------------- (define-syntax (datum/tc stx)