diff --git a/generic-syntax-expanders.rkt b/generic-syntax-expanders.rkt index 2b5428e..7a0c08b 100644 --- a/generic-syntax-expanders.rkt +++ b/generic-syntax-expanders.rkt @@ -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)) \ No newline at end of file