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

betterer

Browse Source
This commit is contained in:
Matthew Butterick 2016-03-20 10:20:06 -07:00
parent f3b176025e
commit 912010a172
1 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
br/define.rkt
View File

@ -2,16 +2,16 @@
(require (for-syntax racket/base syntax/parse racket/syntax syntax/datum syntax/strip-context))
(provide (all-defined-out))
;; a little tricky because we have to mix two levels of macrology.
;; does not work with ellipses in the input pattern
(define-syntax (br:debug-define stx)
(syntax-parse stx
#:literals (syntax)
[(_ (syntax (id pat-arg ... . rest-arg)) body-exp) ; (define #'(foo arg) #'(+ arg arg))
#'(define-syntax id (λ (stx)
(define result (syntax-case stx ()
[(_ pat-arg ... . rest-arg)
body-exp]))
[(_ pat-arg ... . rest-arg)
body-exp]))
(define arg-printing (syntax-case stx ()
[(_ pat-arg ... . rest-arg)
#`(begin
@ -25,6 +25,17 @@
(displayln (format "expanded syntax = #'~a" 'syntaxed-result))
syntaxed-result))))]))
(module+ test
(require rackunit racket/port)
(check-equal? (parameterize ([current-output-port (open-output-nowhere)])
(br:debug-define #'(foo <x> <y> <z>)
#'(apply + (list <x> <y> <z>)))
(foo 1 2 3)) 6))
;; does not work with ellipses in the input pattern
#;(br:debug-define #'(foo <x> ...)
#'(apply + (list <x> ...)))
(define-syntax (br:define stx)
(define-syntax-class syntaxed-id
#:literals (syntax)