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

generalizations

Browse Source
This commit is contained in:
Matthew Butterick 2016-03-17 10:14:26 -07:00
parent e16bb4c480
commit 1aea686c88
3 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
br/datum.rkt
View File

@ -13,11 +13,13 @@
(define-syntax format-datum (define-syntax format-datum
(λ(stx) (λ(stx)
(syntax-case stx (quote datum) (syntax-case stx (quote datum)
[(_ (quote datum-template) arg ...) [(_ (quote <datum-template>) <arg> ...)
#'(format-datum (datum datum-template) arg ...)] #'(format-datum (datum <datum-template>) <arg> ...)]
[(_ (datum datum-template) arg ...) [(_ (datum datum-template) <arg> ...)
(syntax-let ([#'format-string (format "~a" (syntax->datum #'datum-template))]) (syntax-let ([#'format-string (format "~a" (syntax->datum #'datum-template))])
#'(string->datum (apply format format-string (list arg ...))))]))) #'(string->datum (apply format format-string (map (λ(arg) (if (syntax? arg)
(syntax->datum arg)
arg)) (list <arg> ...)))))])))
(module+ test (module+ test

4
br/define.rkt
View File

@ -10,10 +10,10 @@
(syntax-parse stx (syntax-parse stx
#:literals (syntax) #:literals (syntax)
[(_ (syntax (id pat-arg ...)) body ...) ; (define #'(foo arg) #'(+ arg arg)) [(_ (syntax (id pat-arg ... . rest-arg)) body ...) ; (define #'(foo arg) #'(+ arg arg))
#'(define-syntax id (λ (stx) #'(define-syntax id (λ (stx)
(syntax-case stx () (syntax-case stx ()
[(_ pat-arg ...) body ...])))] [(_ pat-arg ... . rest-arg) body ...])))]
[(_ sid:syntaxed-id sid2:syntaxed-id) ; (define #'f1 #'f2) [(_ sid:syntaxed-id sid2:syntaxed-id) ; (define #'f1 #'f2)
#'(define-syntax sid.name (make-rename-transformer sid2))] #'(define-syntax sid.name (make-rename-transformer sid2))]

8
br/syntax.rkt
View File

@ -17,4 +17,12 @@
(define-syntax inject-syntax (make-rename-transformer #'add-syntax)) (define-syntax inject-syntax (make-rename-transformer #'add-syntax))
(define-syntax (map-syntax stx)
(syntax-case stx ()
[(_ <proc> <arg> ...)
#'(map <proc> (if (and (syntax? <arg>) (list? (syntax-e <arg>)))
(syntax->list <arg>)
<arg>) ...)]))
#;(define-syntax syntax-variable (make-rename-transformer #'format-id)) #;(define-syntax syntax-variable (make-rename-transformer #'format-id))