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

fix subtyping w/ filters

Browse Source 
svn: r14640

original commit: 7b6702c9e77f1ea1e4adcf52c62cd4fa74cd1a44
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-28 14:56:18 +00:00
parent 6ecd33b765
commit 3161d6d8a3
3 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/typed-scheme/test.ss
View File

@ -43,4 +43,9 @@
;; Error
#;#{(case-lambda: [() 1]
[([x : Number]) x]) :: String}
#{(lambda: ([x : Number]) 1) :: (Number -> Number)}
#{(lambda: ([x : Number]) 1) :: Any}
#{(lambda: ([x : Number]) 1) :: (Integer -> Any)}
#{(lambda: ([x : Number]) x) :: (Number -> Number)}
#{(lambda: ([x : Number]) x) :: (Integer -> Any)}

10
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -136,24 +136,24 @@
(match* (tr1 expected)
[((tc-results: t1) (tc-results: t2))
(unless (andmap subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(tc-error/expr "1 Expected ~a, but got ~a" t2 t1))
expected]
[((tc-result1: t1 f o) (? Type? t2))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(tc-error/expr "1 Expected ~a, but got ~a" t2 t1))
(ret t2 f o)]
[((? Type? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(tc-error/expr "3 Expected ~a, but got ~a" t2 t1))
t1]
[((? Type? t1) (tc-result1: t2 f o))
(if (subtype t1 t2)
(tc-error/expr "Expected result with filter ~a and object ~a, got ~a" f o t1)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(tc-error/expr "4 Expected ~a, but got ~a" t2 t1))
t1]
[((? Type? t1) (? Type? t2))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
(tc-error/expr "5 Expected ~a, but got ~a" t2 t1))
expected]))
(define (tc-expr/check/type form expected)

9
collects/typed-scheme/types/subtype.ss
View File

@ -125,6 +125,12 @@
(match* (s t)
;; top for functions is above everything
[(_ (top-arr:)) A0]
;; the really simple case
[((arr: s1 s2 #f #f '())
(arr: t1 t2 #f #f '()))
(subtype-seq A0
(subtypes* t1 s1)
(subtype* s2 t2))]
[((arr: s1 s2 #f #f s-kws)
(arr: t1 t2 #f #f t-kws))
(subtype-seq A0
@ -301,6 +307,9 @@
;; trivial case for Result
[(list (Result: t f o) (Result: t* f o))
(subtype* A0 t t*)]
;; we can ignore interesting results
[(list (Result: t f o) (Result: t* (LFilterSet: (list) (list)) (LEmpty:)))
(subtype* A0 t t*)]
;; single values shouldn't actually happen, but they're just like the type
[(list t (Values: (list t*))) (int-err "BUG - singleton values type~a" (make-Values (list t*)))]
[(list (Values: (list t)) t*) (int-err "BUG - singleton values type~a" (make-Values (list t)))]