define-expanders.rkt (1819B)
1 #lang racket 2 3 (require (for-syntax syntax/parse 4 "expander-types.rkt" 5 "expanders.rkt" 6 "with-identifiers.rkt")) 7 8 (provide define-expander-type) 9 10 (define-for-syntax (remove-use-site-scope stx) 11 (define bd 12 (syntax-local-identifier-as-binding (syntax-local-introduce #'here))) 13 (define delta 14 (make-syntax-delta-introducer (syntax-local-introduce #'here) bd)) 15 (delta stx 'remove)) 16 17 (define-syntax define-expander-type 18 (syntax-parser 19 [(_ name:id) 20 (with-derived-ids #'name ([?-expander-type "~a-expander-type"] 21 [make-?-expander "make-~a-expander"] 22 [?-expander? "~a-expander?"] 23 [define-?-expander "define-~a-expander"] 24 [expand-all-?-expanders "expand-all-~a-expanders"]) 25 #`(begin 26 (define-for-syntax ?-expander-type (make-expander-type)) 27 (define-for-syntax (make-?-expander transformer) 28 (expander ?-expander-type transformer)) 29 (define-for-syntax (?-expander? v) 30 (and (expander? v) 31 (expander-of-type? ?-expander-type v))) 32 (define-syntax define-?-expander 33 (syntax-parser 34 [(_ expander-name:id transformer:expr) 35 (remove-use-site-scope 36 #'(define-syntax expander-name (make-?-expander transformer)))])) 37 (define-for-syntax (expand-all-?-expanders stx) 38 (expand-syntax-tree-with-expanders-of-type ?-expander-type stx))))]))