suzanne.soy/generic-syntax-expanders
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Main definitions

Browse Source 
Split out utils
This commit is contained in:
JackFirth 2014-12-09 22:30:29 -08:00
parent c0eb198419
commit 972537a464
1 changed files with 7 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
generic-syntax-expanders.rkt
View File

@ -2,37 +2,10 @@
(require syntax/parse/define (require syntax/parse/define
(for-syntax syntax/parse (for-syntax syntax/parse
syntax/parse/define "stx-utils.rkt"))
racket/syntax
predicates
(for-syntax racket/base
syntax/parse)))
(provide define-syntax-with-expanders) (provide define-syntax-with-expanders)
(define-for-syntax (disp a) (displayln a) a)
(define-for-syntax syntax-list? (and? syntax? (compose list? syntax->list)))
(define-for-syntax (identifier-bound-to? p)
(and? identifier? (compose p maybe-syntax-local-value)))
(define-for-syntax (maybe-syntax-local-value stx)
(syntax-local-value stx (λ () #f)))
(define-for-syntax ((stx-expander expand? transformer) stx)
(if (expand? stx)
(transformer stx)
(syntax-parse stx
[(a . b) #`(#,((stx-expander expand? transformer) #'a)
#,@((stx-expander expand? transformer) #'b))]
[() #'()]
[a #'a])))
(begin-for-syntax
(define-simple-macro (with-derived-ids ([pat-id:id format base-id-stx] ...) stx-expr)
(with-syntax ([pat-id (format-id base-id-stx format base-id-stx)] ...)
stx-expr)))
(define-syntax define-syntax-with-expanders (define-syntax define-syntax-with-expanders
(syntax-parser (syntax-parser
[(_ foo:id transformer-expr) [(_ foo:id transformer-expr)
@ -46,13 +19,11 @@
(define-syntax foo (define-syntax foo
(compose transformer-expr (compose transformer-expr
(stx-expander (stx-expander
(compose (syntax-list-with-head? (identifier-bound-to? foo-expander?))
(list-with-head? (identifier-bound-to? foo-expander?)) (λ (expander-stx)
syntax->list) (call-expander foo-expander-transformer
(λ (expander-stx) (car (syntax->list expander-stx))
(call-expander foo-expander-transformer expander-stx)))))))]))
(car (syntax->list expander-stx))
expander-stx)))))))]))
;; Helpers for define-syntax-with-expanders ;; Helpers for define-syntax-with-expanders
@ -73,15 +44,4 @@
;; at phase level 1, and extracts the expander's transformer procedure with accessor then ;; at phase level 1, and extracts the expander's transformer procedure with accessor then
;; calls that transformer on stx-to-expand ;; calls that transformer on stx-to-expand
(define-for-syntax (call-expander accessor expander-stx stx-to-expand) (define-for-syntax (call-expander accessor expander-stx stx-to-expand)
((accessor (syntax-local-value expander-stx)) stx-to-expand)) ((accessor (syntax-local-value expander-stx)) stx-to-expand))
(define-syntax-with-expanders foo
(syntax-parser
[(_ blah ...)
#'(blah ...)]))
(define-foo-expander baz
(syntax-parser
[(_ n:number blah)
#'blah]))