[regexp] checkpoint: added 'define-regexp:'

regexp.rkt

@@ -3,13 +3,11 @@
 ;; TODO byte-regexp
 
 (provide
-  regexp!
+  regexp:
-  ;; (-> String Regexp)
+  define-regexp:
+  pregexp:
 
-  pregexp!
+  regexp-match:
-  ;; (-> String Regexp)
-
-  regexp-match!
   ;; (-> Pattern String Any * (U #f (List String *N+1)))
   ;; Match the regular expression pattern against a string.
   ;; If the pattern is determined statically, result will be either #f
@@ -19,54 +17,80 @@
   ;; Will raise a compile-time exception if the pattern contains unmatched groups.
 )
 
-(require
+(require (for-syntax
-  (for-syntax racket/base syntax/parse racket/syntax))
+  racket/base
+  racket/syntax
+  syntax/id-table
+  syntax/parse
+))
 
 ;; =============================================================================
 
-(define-for-syntax num-groups-key 'num-groups)
+(define-for-syntax num-groups-key 'regexp-match:num-groups)
+(define-for-syntax errloc-key     'regexp-match:)
 
-;; TODO abstract these macros?
+(define-for-syntax id+num-groups (make-free-id-table))
-(define-syntax regexp!
+
+;; (define-matcher f)
+;; TODO document
+(define-syntax define-matcher
   (syntax-parser
-   [(_ x:str)
+   [(_ f:id)
-    (syntax-property #'(regexp x) num-groups-key (count-groups/regexp (syntax-e #'x)))]
+    #:with f: (format-id #'f "~a:" (syntax-e #'f))
-   [(_ arg* ...)
+    #:with define-f: (format-id #'f "define-~a:" (syntax-e #'f))
-    #'(regexp arg* ...)]))
+    #'(begin
+        ;; For expressions, (regexp: val)
+        (define-syntax f:
+          (syntax-parser
+           [(_ x:str)
+            (syntax-property #'(f x)
+              num-groups-key
+              (count-groups #'x))]
+           [(_ arg* (... ...))
+            #'(f arg* (... ...))]))
+        ;; For definitions, (define-regexp: id val)
+        (define-syntax define-f:
+          (syntax-parser
+           [(_ name:id x)
+            (free-id-table-set! id+num-groups #'name (count-groups #'x))
+            #'(define name x)]
+           [(_ arg* (... ...))
+            #'(define arg* (... ...))]))) ]))
 
-(define-syntax pregexp!
+(define-matcher regexp)
-  (syntax-parser
+(define-matcher pregexp)
-   [(_ x:str)
+(define-matcher byte-regexp)
-    (syntax-property #'(pregexp x) num-groups-key (count-groups/pregexp (syntax-e #'x)))]
+(define-matcher byte-pregexp)
-   [(_ arg* ...)
-    #'(pregexp arg* ...)]))
 
-(define-syntax regexp-match!
+(define-syntax regexp-match:
   (syntax-parser
    [(f pat-stx arg* ...)
-    #:with num-groups (count-groups #'pat-stx #:src #'f)
+    #:with num-groups (count-groups #'pat-stx)
+    #:when (syntax-e #'num-groups)
     #:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
     #'(let ([maybe-match (regexp-match pat-stx arg* ...)])
         (if maybe-match
           (let ([m : (Listof (Option String)) maybe-match])
             (list (car maybe-match)
                   (begin (set! m (cdr m))
-                         (or (car m) (error 'regexp-match! (format "Internal error at result index ~a, try Racket's regexp-match" index*))))
+                         (or (car m) (error 'regexp-match: (format "Internal error at result index ~a, try using Racket's regexp-match" index*))))
                   ...))
           #f))]
    [(f arg* ...)
     (syntax/loc #'f (regexp-match arg* ...))]))
 
-(define-for-syntax (count-groups v-stx #:src stx)
+;; -----------------------------------------------------------------------------
-  (or (syntax-property v-stx num-groups-key)
+
-    (let ([v (format "~a" (syntax-e v-stx))])
+(define-for-syntax (count-groups v-stx)
-      (cond
+  (let ([v (syntax-e v-stx)])
-       [(string? v)  (count-groups/string v #:src stx)]
+    (cond
-       ;[(regexp? v)  (count-groups/regexp v #:src stx)]
+     [(identifier? v-stx) (free-id-table-ref id+num-groups v-stx #f)]
-       ;[(pregexp? v) (count-groups/pregexp v #:src stx)]
+     [(string? v)       (count-groups/string v #:src v-stx)]
-       ;[(byte-regexp? v) (count-groups/byte-regexp v #:src stx)]
+     [(regexp? v)       (count-groups/regexp v #:src v-stx)]
-       ;[(byte-pregexp? v) (count-groups/byte-pregexp v #:src stx)]
+     [(pregexp? v)      (count-groups/pregexp v #:src v-stx)]
-       [else         (error 'regexp-match! "Internal error on input" v)]))))
+     [(byte-regexp? v)  (count-groups/byte-regexp v #:src v-stx)]
+     [(byte-pregexp? v) (count-groups/byte-pregexp v #:src v-stx)]
+     [else  (error errloc-key (format "Internal error on input '~e'" v))])))
 
 ;; Count the number of matched parentheses in a regexp pattern.
 ;; Raise an exception if there are unmatched parens.
@@ -92,13 +116,19 @@
         (loop (+ i 1) in-paren num-groups)]))))
 
 (define-for-syntax (count-groups/regexp rxp #:src stx)
-  (error 'regexp-match! "Not implemented"))
+  (error errloc-key "Not implemented"))
 
 (define-for-syntax (count-groups/pregexp pxp #:src stx)
-  (error 'regexp-match! "Not implemented"))
+  (error errloc-key "Not implemented"))
+
+(define-for-syntax (count-groups/byte-regexp rxp #:src stx)
+  (error errloc-key "Not implemented"))
+
+(define-for-syntax (count-groups/byte-pregexp pxp #:src stx)
+  (error errloc-key "Not implemented"))
 
 (define-for-syntax (group-error str reason)
   (raise-argument-error
-    'regexp-match!
+    errloc-key
     (format "Valid regexp pattern (contains unmatched ~a)" reason)
     str))

test/regexp/pass.rkt

@@ -0,0 +1,37 @@
+#lang typed/racket/base
+
+(require trivial/regexp)
+
+;(: m1 (U #f (List String)))
+;(define m1 (regexp-match: "hello" "hello world"))
+;
+;(: m2 (U #f (List String)))
+;(define m2 (regexp-match: "hello" "world"))
+;
+;(: m3 (U #f (List String String)))
+;(define m3 (regexp-match: "he(l*)o" "hellllloooo"))
+;
+;(: m4 (U #f (List String String String)))
+;(define m4 (regexp-match: "he(l*)(o*)" "hellllloooo"))
+
+(: m5 (U #f (List String String String)))
+(define m5
+  (let ()
+    (define-regexp: rx "he(l*)(o*)")
+    (regexp-match: rx "helloooooooo")))
+
+;(: m6 (U #f (List String String String)))
+;(define m6
+;  (let ()
+;    (define-regexp: rx #rx"he(l*)(o*)")
+;    (regexp-match: rx "helloooooooo")))
+
+;(: m7 (U #f (List String String String)))
+;(define m7
+;  (let ()
+;    (define-regexp: rx (regexp "he(l*)(o*)"))
+;    (regexp-match: rx "helloooooooo")))
+
+;(: m6 (U #f (List String String)))
+;(define m5 (regexp-match: #rx"he(l*)o" "hellllloooo"))
+