www

commit 972537a4641363c9557e21f77e9b8fc58c4eb0d9
parent c0eb19841905fcac58cbba0fcbe711d9257e42ca
Author: JackFirth <jackhfirth@gmail.com>
Date:   Tue,  9 Dec 2014 22:30:29 -0800

Main definitions

Split out utils

Diffstat:
M
generic-syntax-expanders.rkt
 | 
55
++++++++-----------------------------------------------

1 file changed, 8 insertions(+), 47 deletions(-)
diff --git 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