Main definitions

Split out utils
This commit is contained in:
JackFirth 2014-12-09 22:30:29 -08:00
parent c0eb198419
commit 972537a464

View File

@ -2,37 +2,10 @@
(require syntax/parse/define
(for-syntax syntax/parse
syntax/parse/define
racket/syntax
predicates
(for-syntax racket/base
syntax/parse)))
"stx-utils.rkt"))
(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
(syntax-parser
[(_ foo:id transformer-expr)
@ -46,13 +19,11 @@
(define-syntax foo
(compose transformer-expr
(stx-expander
(compose
(list-with-head? (identifier-bound-to? foo-expander?))
syntax->list)
(λ (expander-stx)
(call-expander foo-expander-transformer
(car (syntax->list expander-stx))
expander-stx)))))))]))
(syntax-list-with-head? (identifier-bound-to? foo-expander?))
(λ (expander-stx)
(call-expander foo-expander-transformer
(car (syntax->list expander-stx))
expander-stx)))))))]))
;; Helpers for define-syntax-with-expanders
@ -73,15 +44,4 @@
;; at phase level 1, and extracts the expander's transformer procedure with accessor then
;; calls that transformer on stx-to-expand
(define-for-syntax (call-expander accessor 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]))
((accessor (syntax-local-value expander-stx)) stx-to-expand))