suzanne.soy/macrotypes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

stlc bug: cases expr had no type

Browse Source
This commit is contained in:
Stephen Chang 2014-08-13 15:38:14 -04:00
parent 10674298c4
commit cc3a224a7b
2 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
stlc-tests.rkt
View File

@ -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)
(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)

3
stlc.rkt
View File

@ -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)