www

commit 902b858c5b46a6e0f97139249a481f2fde2fcebe
parent 232eaa43174794fafaf501377fcc18fa97d7f7d2
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Fri, 14 Jul 2017 01:21:58 +0200

Moved ~rx-id from phc-graph

Diffstat:
M
syntax-parse.rkt
 | 
25
+++++++++++++++++++------

1 file changed, 19 insertions(+), 6 deletions(-)
diff --git a/syntax-parse.rkt b/syntax-parse.rkt
@@ -36,6 +36,7 @@
            ~with
            ~attr
            ~or-bug
+           ~rx-id
            (rename-out [~or-bug ~either])
            define-simple-macro
            ;template/loc
@@ -99,10 +100,10 @@
          (define/with-syntax name
            (format-id #'kw "~a" (keyword->string (syntax-e #'kw))))
          #`(#,base-pattern (~seq (~and name kw) pat ...)
-                               #,@(if name?
-                                      #`(#:name #,(format "the ~a keyword"
-                                                          (syntax-e #'kw)))
-                                      #'())))]))
+                           #,@(if name?
+                                  #`(#:name #,(format "the ~a keyword"
+                                                      (syntax-e #'kw)))
+                                  #'())))]))
   
   (define-syntax ~optkw
     (pattern-expander
@@ -293,4 +294,17 @@
       #:attributes (id)
       (pattern id:id)
       (pattern (:name-or-curry . curry-args))))
-  (require 'm-name-or-curry))
-\ No newline at end of file
+  (require 'm-name-or-curry)
+
+  (define (match-id [rx : Regexp] [id : Identifier])
+    (let ([m (regexp-match rx (symbol->string (syntax-e id)))])
+      (and m (map (λ ([% : (U #f String)])
+                    (and % (datum->syntax id (string->symbol %) id id)))
+                  (cdr m)))))
+  (define-syntax ~rx-id
+    (pattern-expander
+     (λ (stx)
+       (syntax-case stx ()
+         [(_ rx . g*)
+          #'(~and x:id
+                  {~parse g* (match-id rx #'x)})])))))