generic-syntax-expanders/private/define-expanders.rkt

39 lines
1.8 KiB
Racket

#lang racket
(require (for-syntax syntax/parse
"expander-types.rkt"
"expanders.rkt"
"with-identifiers.rkt"))
(provide define-expander-type)
(define-for-syntax (remove-use-site-scope stx)
(define bd
(syntax-local-identifier-as-binding (syntax-local-introduce #'here)))
(define delta
(make-syntax-delta-introducer (syntax-local-introduce #'here) bd))
(delta stx 'remove))
(define-syntax define-expander-type
(syntax-parser
[(_ name:id)
(with-derived-ids #'name ([?-expander-type "~a-expander-type"]
[make-?-expander "make-~a-expander"]
[?-expander? "~a-expander?"]
[define-?-expander "define-~a-expander"]
[expand-all-?-expanders "expand-all-~a-expanders"])
#`(begin
(define-for-syntax ?-expander-type (make-expander-type))
(define-for-syntax (make-?-expander transformer)
(expander ?-expander-type transformer))
(define-for-syntax (?-expander? v)
(and (expander? v)
(expander-of-type? ?-expander-type v)))
(define-syntax define-?-expander
(syntax-parser
[(_ expander-name:id transformer:expr)
(remove-use-site-scope
#'(define-syntax expander-name (make-?-expander transformer)))]))
(define-for-syntax (expand-all-?-expanders stx)
(expand-syntax-tree-with-expanders-of-type ?-expander-type stx))))]))