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

Fix error message for 1-arg apply

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-17 15:57:13 -04:00
parent 7a1538764e
commit 1e15ce1f32
2 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -812,6 +812,7 @@
([j : Natural (+ i 'a) (+ j i)]) ([j : Natural (+ i 'a) (+ j i)])
((>= j 10)) ((>= j 10))
#f)] #f)]
[tc-err (apply +)]
[tc-e/t [tc-e/t
(let ([x eof]) (let ([x eof])
(if (procedure? x) (if (procedure? x)

6
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -257,7 +257,11 @@
;; produces the first n-1 elements of the list, and the last element ;; produces the first n-1 elements of the list, and the last element
(define (split l) (let-values ([(f r) (split-at l (sub1 (length l)))]) (define (split l) (let-values ([(f r) (split-at l (sub1 (length l)))])
(values f (car r)))) (values f (car r))))
(define-values (fixed-args tail) (split (syntax->list args))) (define-values (fixed-args tail)
(let ([args* (syntax->list args)])
(if (null? args*)
(tc-error "apply requires a final list argument, given only a function argument of type ~a" (match f-ty [(tc-result1: t) t]))
(split args*))))
(match f-ty (match f-ty
[(tc-result1: (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...))) [(tc-result1: (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...)))