Changeset 12192 in project

Timestamp:

10/18/08 15:33:16 (12 years ago)

Author:

Alex Shinn

Message:

Making irregex.scm reflect the upcoming API (not incorporating changes
directly from upstream yet). Fixing string-{match,search}-positions.

Location:

chicken/branches/irregular

Files:

• irregex.scm (modified) (12 diffs)
• regex.scm (modified) (3 diffs)

chicken/branches/irregular/irregex.scm

@@ -73 +73 @@
     res))
 
+(define (irregex-match-num-submatches m)
+  (quotient (- (vector-length m) 3) 2))
+
 (define (irregex-match-string m)
   (vector-ref m 1))
@@ -80 +83 @@
   (vector-set! m 1 str))
 
-(define (%irregex-match-start m n)
+(define (irregex-match-start-index m n)
   (vector-ref m (+ 3 (* n 2))))
-(define (%irregex-match-end m n)
+(define (irregex-match-end-index m n)
   (vector-ref m (+ 4 (* n 2))))
 
-(define (%irregex-match-start-set! m n start)
+(define (irregex-match-start-index-set! m n start)
   (vector-set! m (+ 3 (* n 2)) start))
-(define (%irregex-match-end-set! m n end)
+(define (irregex-match-end-index-set! m n end)
   (vector-set! m (+ 4 (* n 2)) end))
 
-(define (%irregex-match-index m opt)
+(define (irregex-match-index m opt)
   (if (pair? opt)
       (cond ((number? (car opt)) (car opt))
@@ -97 +100 @@
       0))
 
-(define (%irregex-match-valid-index? m n)
+(define (irregex-match-valid-index? m n)
   (and (< (+ 3 (* n 2)) (vector-length m))
        (vector-ref m (+ 4 (* n 2)))))
 
 (define (irregex-match-substring m . opt)
-  (let ((n (%irregex-match-index m opt)))
-    (and (%irregex-match-valid-index? m n)
+  (let ((n (irregex-match-index m opt)))
+    (and (irregex-match-valid-index? m n)
          (substring (irregex-match-string m)
                     (vector-ref m (+ 3 (* n 2)))
@@ -109 +112 @@
 
 (define (irregex-match-start m . opt)
-  (let ((n (%irregex-match-index m opt)))
-    (and (%irregex-match-valid-index? m n)
+  (let ((n (irregex-match-index m opt)))
+    (and (irregex-match-valid-index? m n)
          (vector-ref m (+ 3 (* n 2))))))
 
 (define (irregex-match-end m . opt)
-  (%irregex-match-valid-index? m (%irregex-match-index m opt)))
+  (irregex-match-valid-index? m (irregex-match-index m opt)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1507 +1510 @@
         (cond
          (m-end
-          (%irregex-match-start-set! matches 0 start)
-          (%irregex-match-end-set! matches 0 m-end)
+          (irregex-match-start-index-set! matches 0 start)
+          (irregex-match-end-index-set! matches 0 m-end)
           ((irregex-dfa/extract irx) str start m-end matches)
           matches)
@@ -1529 +1532 @@
                     (cond
                      (m-end
-                      (%irregex-match-start-set! matches 0 m-start)
-                      (%irregex-match-end-set! matches 0 m-end)
+                      (irregex-match-start-index-set! matches 0 m-start)
+                      (irregex-match-end-index-set! matches 0 m-end)
                       ((irregex-dfa/extract irx) str m-start m-end matches)
                       matches)
@@ -1542 +1545 @@
                (cond
                 (i
-                 (%irregex-match-start-set! matches 0 start)
-                 (%irregex-match-end-set! matches 0 i)
+                 (irregex-match-start-index-set! matches 0 start)
+                 (irregex-match-end-index-set! matches 0 i)
                  matches)
                 (else
@@ -1559 +1562 @@
         (cond
          ((equal? m-end end)
-          (%irregex-match-start-set! matches 0 start)
-          (%irregex-match-end-set! matches 0 m-end)
+          (irregex-match-start-index-set! matches 0 start)
+          (irregex-match-end-index-set! matches 0 m-end)
           ((irregex-dfa/extract irx) str start m-end matches)
           matches)
@@ -1570 +1573 @@
         (cond
          ((equal? i end)
-          (%irregex-match-start-set! matches 0 start)
-          (%irregex-match-end-set! matches 0 i)
+          (irregex-match-start-index-set! matches 0 start)
+          (irregex-match-end-index-set! matches 0 i)
           matches)
          (else
@@ -2114 +2117 @@
                (cond
                 ((number? res)
-                 (%irregex-match-start-set! matches n i)
-                 (%irregex-match-end-set! matches n res)))
+                 (irregex-match-start-index-set! matches n i)
+                 (irregex-match-end-index-set! matches n res)))
                res))))
         (else
@@ -2337 +2340 @@
                             (cadr sre))))
                    (lambda (str i matches fail2)
-                     (if (%irregex-match-end matches index)
+                     (if (irregex-match-end-index matches index)
                          (pass str i matches fail2)
                          (fail str i matches fail2)))))
@@ -2370 +2373 @@
                         flags
                         (lambda (str i matches fail)
-                          (let ((old (%irregex-match-end matches n)))
-                            (%irregex-match-end-set! matches n i)
+                          (let ((old (irregex-match-end-index matches n)))
+                            (irregex-match-end-index-set! matches n i)
                             (next str i matches
                                   (lambda ()
-                                    (%irregex-match-end-set! matches n old)
+                                    (irregex-match-end-index-set! matches n old)
                                     (fail))))))))
                (lambda (str i matches fail)
-                 (let ((old (%irregex-match-start matches n)))
-                   (%irregex-match-start-set! matches n i)
+                 (let ((old (irregex-match-start-index matches n)))
+                   (irregex-match-start-index-set! matches n i)
                    (body str i matches
                          (lambda ()
-                           (%irregex-match-start-set! matches n old)
+                           (irregex-match-start-index-set! matches n old)
                            (fail)))))))
             ((submatch-named)

chicken/branches/irregular/regex.scm

@@ -45 +45 @@
     irregex-new-matches irregex-reset-matches!
     irregex-match-start irregex-match-end irregex-match-substring
+    irregex-match-num-submatches
     irregex-search irregex-search/matches irregex-match irregex-match-string
     irregex-replace irregex-replace/all
@@ -73 +74 @@
     (let ((opts '()))
       (when caseless (set! opts (cons 'i opts)))
+      (when extended (set! opts (cons 'x opts)))
       (when utf8 (set! opts (cons 'utf8 opts)))
       opts))) )
@@ -84 +86 @@
   (let ((rx (unregexp rx)))
     (and-let* ((m (irregex-match rx str)))
-      (let ((n (irregex-submatches rx)))
-        (cons 
-         str
-         (let loop ((i 0))
-           (if (fx>= i n)
-               '()
-               (cons (irregex-match-substring m i) (loop (fx+ i 1))))))))))
+      (let loop ((i (irregex-match-num-submatches m))
+                 (res '()))
+        (if (fx<= i 0)
+            (cons str res)
+            (loop (fx- i 1) (cons (irregex-match-substring m i) res)))))))
 
 (define (string-match-positions rx str)
   (let ((rx (unregexp rx)))
     (and-let* ((m (irregex-match rx str)))
-      (let ((n (irregex-submatches m)))
-        (cons
-         (list (%irregex-match-start m 0)
-               (%irregex-match-end m 0))
-         (let loop ((i 0))
-           (if (fx>= i n)
-               '()
-               (cons (list (irregex-match-start m i)
-                           (irregex-match-end m i))
-                     (loop (fx+ i 1))))))))))
+      (let loop ((i (irregex-match-num-submatches m))
+                 (res '()))
+        (if (fx<= i 0)
+            (cons (list 0 (string-length str)) res)
+            (loop (fx- i 1) (cons (list (irregex-match-start-index m i)
+                                        (irregex-match-end-index m i))
+                                  res)))))))
 
 (define (string-search rx str #!optional (start 0) (range (string-length str)))
   (let ((rx (unregexp rx)))
     (and-let* ((m (irregex-search rx str start (fx+ start range))))
-      (let loop ((i (irregex-submatches rx)) 
-                 (res (list (irregex-match-string m))))
-        (if (fx< i 0)
-            res
-            (loop (fx- i 1)
-                  (cons (irregex-match-substring m i) res)))))))
+      (let loop ((i (irregex-match-num-submatches m))
+                 (res '()))
+        (if (fx< i 0)
+            res
+            (loop (fx- i 1) (cons (irregex-match-substring m i) res)))))))
 
 (define (string-search-positions rx str #!optional (start 0) (range (string-length str)))
   (let ((rx (unregexp rx)))
     (and-let* ((m (irregex-search rx str start (fx+ start range))))
-      (let loop ((i (irregex-submatches rx))
-                 (res (list (list (%irregex-match-start m 0)
-                                  (%irregex-match-end m 0)))))
-          (if (fx< i 0)
-              '()
-              (loop (fx- i 1)
-                    (cons (list (irregex-match-start m i)
-                                (irregex-match-end m i))
-                          res)))))))
+      (let loop ((i (irregex-match-num-submatches m))
+                 (res '()))
+        (if (fx< i 0)
+            res
+            (loop (fx- i 1) (cons (list (irregex-match-start-index m i)
+                                        (irregex-match-end-index m i))
+                                  res)))))))