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

Remove extraneous patterns in tc/funapp.

Browse Source 
Also improves error messages on cases which return AnyValues/ValuesDots.
This commit is contained in:
Eric Dobson 2014-05-18 18:12:29 -07:00
parent 82d8094d1a
commit 919e03b9f7
2 changed files with 8 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
View File

@ -35,14 +35,12 @@
(define (tc/funapp f-stx args-stx ftype0 argtys expected) (define (tc/funapp f-stx args-stx ftype0 argtys expected)
(match* (ftype0 argtys) (match* (ftype0 argtys)
;; we special-case this (no case-lambda) for improved error messages ;; we special-case this (no case-lambda) for improved error messages
[((tc-result1: (and t (Function: (list (and a (arr: dom (Values: _) ;; tc/funapp1 currently cannot handle drest arities
rest #f kws)))))) [((tc-result1: (Function: (list (and a (arr: _ _ _ #f _)))))
argtys) argtys)
(tc/funapp1 f-stx args-stx a argtys expected)] (tc/funapp1 f-stx args-stx a argtys expected)]
[((tc-result1: (and t (Function: (and arrs (list (arr: doms rngs rests [((tc-result1: (and t (Function: (and arrs (list (arr: doms rngs rests (and drests #f) kws) ...)))))
(and drests #f) kws) (list (tc-result1: argtys-t) ...))
...)))))
(and argtys (list (tc-result1: argtys-t) ...)))
(or (or
;; find the first function where the argument types match ;; find the first function where the argument types match
(for/first ([dom (in-list doms)] [rng (in-list rngs)] [rest (in-list rests)] [a (in-list arrs)] (for/first ([dom (in-list doms)] [rng (in-list rngs)] [rest (in-list rests)] [a (in-list arrs)]
@ -63,8 +61,7 @@
[((tc-result1: [((tc-result1:
(and t (PolyDots: (and t (PolyDots:
(and vars (list fixed-vars ... dotted-var)) (and vars (list fixed-vars ... dotted-var))
(Function: (list (and arrs (arr: doms rngs rests drests (Function: (list (and arrs (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)))
(list (Keyword: _ _ #f) ...)))
...))))) ...)))))
(list (tc-result1: argtys-t) ...)) (list (tc-result1: argtys-t) ...))
(handle-clauses (handle-clauses
@ -95,10 +92,8 @@
;; regular polymorphic functions without dotted rest, ;; regular polymorphic functions without dotted rest,
;; we do not choose any instantiations with mandatory keyword arguments ;; we do not choose any instantiations with mandatory keyword arguments
[((tc-result1: [((tc-result1:
(and t (Poly: (and t (Poly: vars
vars (Function: (list (and arrs (arr: doms rngs rests #f (list (Keyword: _ _ kw?) ...)))
(Function: (list (and arrs (arr: doms rngs rests (and drests #f)
(list (Keyword: _ _ kw?) ...)))
...))))) ...)))))
(list (tc-result1: argtys-t) ...)) (list (tc-result1: argtys-t) ...))
(handle-clauses (handle-clauses

2
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/pr13577.rkt
View File

@ -1,5 +1,5 @@
#; #;
(exn-pred #rx"Expected result: AnyValues") (exn-pred #rx"expected: Integer")
#lang typed/racket #lang typed/racket