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

tiny

Browse Source
This commit is contained in:
Matthew Butterick 2016-04-29 19:31:42 -07:00
parent fb0522957a
commit 5a0e8982b7
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
beautiful-racket-lib/br/define.rkt
View File

@ -154,16 +154,16 @@
[(_ (syntax id) (syntax thing)) ; (define #'f1 #'42) [(_ (syntax id) (syntax thing)) ; (define #'f1 #'42)
#'(br:define-cases (syntax id) [#'_ (syntax thing)])] #'(br:define-cases (syntax id) [#'_ (syntax thing)])]
[(_ (sid:syntaxed-id stx-arg ...) expr ...) ; (define (#'f1 stx) expr ...) [(_ (sid:syntaxed-id stx-arg ...) . exprs) ; (define (#'f1 stx) expr ...)
(raise-syntax-error 'define "definition of a syntax transformer must use lambda notation, because otherwise it's too easy to confuse the compile-time shape and the run-time shape" (syntax->datum #'sid.name))] (raise-syntax-error 'define "definition of a syntax transformer must use lambda notation, because otherwise it's too easy to confuse the compile-time shape and the run-time shape" (syntax->datum #'sid.name))]
[(_ sid:syntaxed-id (λ (stx-arg ...) expr ...)) ; (define #'f1 (λ(stx) expr ...) [(_ sid:syntaxed-id (λ (stx-arg ...) . exprs)) ; (define #'f1 (λ(stx) expr ...)
#:fail-when (not (= (length (syntax->datum #'(stx-arg ...))) 1)) #:fail-when (not (= (length (syntax->datum #'(stx-arg ...))) 1))
(raise-syntax-error 'define "did not get exactly one argument for macro" (syntax->datum #'(stx-arg ...))) (raise-syntax-error 'define "did not get exactly one argument for macro" (syntax->datum #'(stx-arg ...)))
(with-syntax ([(first-stx-arg other ...) #'(stx-arg ...)]) (with-syntax ([(first-stx-arg other ...) #'(stx-arg ...)])
#'(define-syntax (sid.name first-stx-arg) expr ...))] #'(define-syntax (sid.name first-stx-arg) . exprs))]
[(_ arg ...) #'(define arg ...)])) [(_ . args) #'(define . args)]))
(module+ test (module+ test
(require rackunit) (require rackunit)