commit cc3a224a7bd5565e4c6694a2ed94d1c1a911b92c parent 10674298c49f3b47a77f1d1fa674c7dc4763106f Author: Stephen Chang <stchang@ccs.neu.edu> Date: Wed, 13 Aug 2014 15:38:14 -0400 stlc bug: cases expr had no type Diffstat:
| M | stlc-tests.rkt | | | 15 | +++++++++++++-- |
| M | stlc.rkt | | | 3 | ++- |
2 files changed, 15 insertions(+), 3 deletions(-)
diff --git 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 @@ -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)