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

Make wrong arity messages work again.

Browse Source 
Closes PR14138.

original commit: 520c33906ef1a79efadfe5495725952e435c209a
This commit is contained in:
Eric Dobson 2013-11-06 21:45:44 -08:00
parent 029e55dead
commit c0bcae41f9
3 changed files with 27 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
View File

@ -342,22 +342,25 @@
(cons formal+body formals+bodies*)])
(arities-seen-add arities-seen arity))])))
(apply append
(for/list ([fb* (in-list used-formals+bodies)])
(match-define (list f* b*) fb*)
(match (find-matching-arities f*)
[(list)
(if (and (= 1 (length used-formals+bodies)) expected-type)
;; TODO improve error message.
(tc-error/expr #:return (list (lam-result null null (list (generate-temporary) Univ) #f (ret (Un))))
"Expected a function of type ~a, but got a function with the wrong arity"
expected-type)
(tc/lambda-clause f* b*))]
[(list (arr: argss rets rests drests '()) ...)
(for/list ([args (in-list argss)] [ret (in-list rets)] [rest (in-list rests)] [drest (in-list drests)])
(tc/lambda-clause/check
f* b* args (values->tc-results ret (formals->list f*)) rest drest))]))))
(if (and
(empty? used-formals+bodies)
;; If the empty function is expected, then don't error out
(match expected-type
[(Function: (list)) #f]
[_ #t]))
;; TODO improve error message.
(tc-error/expr #:return (list (lam-result null null (list (generate-temporary) Univ) #f (ret (Un))))
"Expected a function of type ~a, but got a function with the wrong arity"
expected-type)
(apply append
(for/list ([fb* (in-list used-formals+bodies)])
(match-define (list f* b*) fb*)
(match (find-matching-arities f*)
[(list) (tc/lambda-clause f* b*)]
[(list (arr: argss rets rests drests '()) ...)
(for/list ([args (in-list argss)] [ret (in-list rets)] [rest (in-list rests)] [drest (in-list drests)])
(tc/lambda-clause/check
f* b* args (values->tc-results ret (formals->list f*)) rest drest))])))))
(define (tc/mono-lambda/type formals bodies expected)
(make-Function (map lam-result->type

5
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/wrong-arity.rkt Normal file
View File

@ -0,0 +1,5 @@
#;
(exn-pred "wrong arity")
#lang typed/racket
(: f (Number Number -> Number))
(define (f x) 0)

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/empty-case-arrow.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang typed/racket
(: f (case->))
(define (f x) 0)