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

Fix type error message pruning for tc-any-results.

Browse Source 
original commit: 1e82e5bd6228430fd60e68ff09a8b1615f978887
This commit is contained in:
Vincent St-Amour 2013-09-03 17:53:50 -04:00
parent d2bafc4ef3
commit 5efbf50364
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -215,17 +215,24 @@
others))
;; currently does not take advantage of multi-valued or arbitrary-valued expected types,
(define expected-ty (and expected (match expected [(tc-result1: t) t] [_ #f])))
(define expected-ty
(and expected
(match expected
[(tc-result1: t) t]
[(tc-any-results:) #t] ; anything is a subtype of expected
[_ #f]))) ; don't know what it is, don't do any pruning
(define (returns-subtype-of-expected? fun-ty)
(or (not expected)
(match fun-ty
[(Function: (list (arr: _ rng _ _ _)))
(let ([rng (match rng
[(Values: (list (Result: t _ _)))
t]
[(ValuesDots: (list (Result: t _ _)) _ _)
t])])
(subtype rng expected-ty))])))
(or (not expected) ; no expected type, anything is fine
(eq? expected-ty #t) ; expected is tc-anyresults, anything is fine
(and expected-ty ; not some unknown expected tc-result
(match fun-ty
[(Function: (list (arr: _ rng _ _ _)))
(let ([rng (match rng
[(Values: (list (Result: t _ _)))
t]
[(ValuesDots: (list (Result: t _ _)) _ _)
t])])
(subtype rng expected-ty))]))))
(define orig (map list doms rngs rests drests))