diff --git a/define-with-expanders.rkt b/define-with-expanders.rkt new file mode 100644 index 0000000..5104b5f --- /dev/null +++ b/define-with-expanders.rkt @@ -0,0 +1,85 @@ +#lang racket + +(require syntax/parse/define + (for-syntax syntax/parse + syntax/parse/define + racket/syntax + predicates + (for-syntax racket/base + syntax/parse))) + +(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) + (with-derived-ids ([foo-expander "~a-expander" #'foo] + [foo-expander? "~a-expander?" #'foo] + [foo-expander-transformer "~a-expander-transformer" #'foo] + [define-foo-expander "define-~a-expander" #'foo]) + #'(begin + (define-expander-struct foo-expander) + (define-expander-definer define-foo-expander foo-expander) + (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)))))))])) + +;; Helpers for define-syntax-with-expanders + +;; Binds id as a struct at phase level 1 that will contain a single field named "transformer" +;; that is a procedure accepting a syntax object and returning a syntax object +(define-simple-macro (define-expander-struct id:id) + (begin-for-syntax + (struct id (transformer)))) + +;; Binds definer-id as a form that defines expanders for another syntactic form by using the +;; phase level 1 struct created with define-expander-struct +(define-simple-macro (define-expander-definer definer-id:id expander-struct-id:id) + (define-simple-macro (definer-id expander:id transformer) + (define-syntax expander + (expander-struct-id transformer)))) + +;; Small helper that assumes expander-stx is an identifier bound to an expander struct value +;; 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])) +