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

generics: adjust generated error messages

Browse Source
This commit is contained in:
Matthew Flatt 2020-11-01 06:49:52 -07:00 committed by Matthew Flatt
parent 9dbfeb2c6a
commit 5f4480e39e
1 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
racket/collects/racket/private/generic.rkt
View File

@ -441,10 +441,10 @@
(define/with-syntax (opt-name ...) opt) (define/with-syntax (opt-name ...) opt)
(define/with-syntax ((optkw-key optkw-val) ...) opt-kw) (define/with-syntax ((optkw-key optkw-val) ...) opt-kw)
(define/with-syntax arg-labels/restargs ; labels for args (define/with-syntax arg-labels/restargs ; labels for args
#'((symbol->string 'req-name) ... #'((string-append (symbol->string 'req-name) " argument...") ...
(string-append (symbol->string 'opt-name) " (optional)") ... (string-append (symbol->string 'opt-name) " (optional) argument...") ...
(string-append "#:" (keyword->string 'reqkw-key)) ... (string-append "#:" (keyword->string 'reqkw-key) " argument...") ...
(string-append "#:" (keyword->string 'optkw-key) " (optional)") ... (string-append "#:" (keyword->string 'optkw-key) " (optional) argument...") ...
"rest args")) "rest args"))
(define/with-syntax arg-labels ; drop restargs if none (define/with-syntax arg-labels ; drop restargs if none
(if rest #'arg-labels/restargs (stx-drop-last #'arg-labels/restargs))) (if rest #'arg-labels/restargs (stx-drop-last #'arg-labels/restargs)))
@ -462,12 +462,9 @@
(apply append (stx-map list #'other-arg-labels #'other-args))) (apply append (stx-map list #'other-arg-labels #'other-args)))
(define/with-syntax err-fmt-str (define/with-syntax err-fmt-str
(string-append "contract violation:\n" (string-append "contract violation:\n"
"expected: ~a\n" " expected: ~a\n"
"given: ~v\n" " given: ~e\n"
(if (null? (syntax->list #'other-arg-labels)) " argument position: ~a"))
"argument position: ~a"
(string-append "argument position: ~a\n"
"other arguments...:"))))
(define/with-syntax contract-str (define/with-syntax contract-str
(format "~s?" (syntax-e #'self-name))) (format "~s?" (syntax-e #'self-name)))
(define/with-syntax self-i-stx self-i) (define/with-syntax self-i-stx self-i)