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

Fix use of 'fn-name in 2htdp/image error messages.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-12-17 12:37:32 -05:00
parent 4e85687d96
commit 24ea7d34fc
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/2htdp/private/img-err.rkt
View File

@ -42,7 +42,8 @@
(define-syntax define/chk (define-syntax define/chk
(λ (stx) (λ (stx)
(define (adjust-case case-args bodies) (define (adjust-case fn-name case-args bodies)
(with-syntax ([fn-name fn-name])
(syntax-case case-args () (syntax-case case-args ()
[(args ... . final-arg) [(args ... . final-arg)
(identifier? #'final-arg) (identifier? #'final-arg)
@ -71,17 +72,17 @@
(syntax->list #'(args ...)))]) (syntax->list #'(args ...)))])
#`((args ...) #`((args ...)
(let ([arg-ids (check/normalize 'fn-name 'arg-ids arg-ids i)] ...) (let ([arg-ids (check/normalize 'fn-name 'arg-ids arg-ids i)] ...)
#,@bodies)))])) #,@bodies)))])))
(syntax-case stx (case-lambda) (syntax-case stx (case-lambda)
[(define/chk fn-name (case-lambda [in-args in-body ...] ...)) [(define/chk fn-name (case-lambda [in-args in-body ...] ...))
(with-syntax ([((args body) ...) (map adjust-case (with-syntax ([((args body) ...) (map (lambda (a b) (adjust-case #'fn-name a b))
(syntax->list #'(in-args ...)) (syntax->list #'(in-args ...))
(syntax->list #'((in-body ...) ...)))]) (syntax->list #'((in-body ...) ...)))])
#'(define fn-name #'(define fn-name
(case-lambda (case-lambda
[args body] ...)))] [args body] ...)))]
[(define/chk (fn-name . args) body ...) [(define/chk (fn-name . args) body ...)
(with-syntax ([(args body) (adjust-case #'args #'(body ...))]) (with-syntax ([(args body) (adjust-case #'fn-name #'args #'(body ...))])
#`(define (fn-name . args) body))]))) #`(define (fn-name . args) body))])))
;; check/normalize : symbol symbol any number -> any ;; check/normalize : symbol symbol any number -> any