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

fixed PR 9155

Browse Source 
svn: r8368
This commit is contained in:
Robby Findler 2008-01-19 18:00:16 +00:00
parent 7f09b3cf39
commit ccceb3368a
1 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/scheme/private/contract-arrow.ss
View File

@ -1286,7 +1286,7 @@ v4 todo:
(if (zero? dom-length) "no" dom-length) (if (zero? dom-length) "no" dom-length)
(if (null? mandatory-kwds) "" " ordinary") (if (null? mandatory-kwds) "" " ordinary")
(if (= 1 dom-length) "" "s") (if (= 1 dom-length) "" "s")
(keyword-error-text mandatory-kwds) (keyword-error-text mandatory-kwds optional-keywords)
val))) val)))
(define (procedure-arity-includes?/optionals f base optionals) (define (procedure-arity-includes?/optionals f base optionals)
@ -1302,17 +1302,30 @@ v4 todo:
(not (member kwd proc-mandatory)))) (not (member kwd proc-mandatory))))
optional-kwds)))) optional-kwds))))
(define (keyword-error-text mandatory-keywords) (define (keyword-error-text mandatory-keywords optional-keywords)
(define (format-keywords-error type kwds)
(cond
[(null? kwds) ""]
[(null? (cdr kwds))
(format "the ~a keyword ~a" type (car kwds))]
[else
(format
"the ~a keywords ~a~a"
type
(car kwds)
(apply string-append (map (λ (x) (format " ~a" x)) (cdr kwds))))]))
(cond (cond
[(null? mandatory-keywords) " without any keywords"] [(and (null? optional-keywords) (null? mandatory-keywords)) " without any keywords"]
[(null? (cdr mandatory-keywords)) [(null? optional-keywords)
(format " and the mandatory keyword ~a" (car mandatory-keywords))] (string-append " and " (format-keywords-error 'mandatory mandatory-keywords))]
[(null? mandatory-keywords)
(string-append " and " (format-keywords-error 'optional optional-keywords))]
[else [else
(format (string-append ", "
" and the mandatory keywords ~a~a" (format-keywords-error 'mandatory mandatory-keywords)
(car mandatory-keywords) ", and "
(apply string-append (map (λ (x) (format " ~a" x)) (cdr mandatory-keywords))))])) (format-keywords-error 'optional optional-keywords))]))
(define (check-procedure/more val mtd? dom-length mandatory-kwds optional-kwds src-info blame orig-str) (define (check-procedure/more val mtd? dom-length mandatory-kwds optional-kwds src-info blame orig-str)
(unless (and (procedure? val) (unless (and (procedure? val)
(procedure-accepts-and-more? val (if mtd? (+ dom-length 1) dom-length)) (procedure-accepts-and-more? val (if mtd? (+ dom-length 1) dom-length))
@ -1328,7 +1341,7 @@ v4 todo:
[(zero? dom-length) "no"] [(zero? dom-length) "no"]
[else dom-length]) [else dom-length])
(if (= 1 dom-length) "" "s") (if (= 1 dom-length) "" "s")
(keyword-error-text mandatory-kwds) (keyword-error-text mandatory-kwds optional-kwds)
val))) val)))
;; timing & size tests ;; timing & size tests