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

adjust Sam's edit so the file is now properly indented

Browse Source
This commit is contained in:
Robby Findler 2010-12-17 13:53:03 -06:00
parent 4917d2af4a
commit 2dc15061a8
1 changed files with 3 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -43,14 +43,13 @@
(define-syntax define/chk (define-syntax define/chk
(λ (stx) (λ (stx)
(define (adjust-case fn-name 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)
(let ([len (length (syntax->list #'(args ...)))]) (let ([len (length (syntax->list #'(args ...)))])
(with-syntax ([(i ...) (build-list len add1)]) (with-syntax ([(i ...) (build-list len add1)])
#`((args ... . final-arg) #`((args ... . final-arg)
(let ([args (check/normalize 'fn-name 'args args i)] ... (let ([args (check/normalize '#,fn-name 'args args i)] ...
[final-arg [final-arg
(for/list ([x (in-list final-arg)] (for/list ([x (in-list final-arg)]
[j (in-naturals #,(+ len 1))]) [j (in-naturals #,(+ len 1))])
@ -71,8 +70,8 @@
(raise-syntax-error 'define/chk "unknown argument spec" stx arg)])) (raise-syntax-error 'define/chk "unknown argument spec" stx arg)]))
(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 (lambda (a b) (adjust-case #'fn-name a b)) (with-syntax ([((args body) ...) (map (lambda (a b) (adjust-case #'fn-name a b))