Ticket #281: irregex-chicken-and-named-submatch-stacking.patch

irregex-chicken.scm

@@ -1 +1 @@
 
-(cond-expand
- (compiling
-  (declare
-   (export
-    irregex string->irregex sre->irregex
-    string->sre maybe-string->sre
-    irregex? irregex-match-data?
-    irregex-new-matches irregex-reset-matches!
-    irregex-search irregex-search/matches irregex-match
-    irregex-search/chunked irregex-match/chunked make-irregex-chunker
-    irregex-match-substring irregex-match-subchunk
-    irregex-match-start-source irregex-match-start-index
-    irregex-match-end-source irregex-match-end-index
-    irregex-match-num-submatches
-    irregex-fold irregex-replace irregex-replace/all
-    irregex-dfa irregex-dfa/search irregex-dfa/extract
-    irregex-nfa irregex-flags irregex-lengths irregex-names
-    irregex-num-submatches
-    ))))
-
+(module irregex
+ (irregex string->irregex sre->irregex
+  string->sre maybe-string->sre
+  irregex? irregex-match-data?
+  irregex-new-matches irregex-reset-matches!
+  irregex-search irregex-search/matches irregex-match
+  irregex-search/chunked irregex-match/chunked make-irregex-chunker
+  irregex-match-substring irregex-match-subchunk
+  irregex-match-start-chunk irregex-match-start-index
+  irregex-match-end-chunk irregex-match-end-index
+  irregex-match-num-submatches
+  irregex-fold irregex-replace irregex-replace/all
+  irregex-dfa irregex-dfa/search irregex-dfa/extract
+  irregex-nfa irregex-flags irregex-lengths irregex-names
+  irregex-num-submatches
+  )
+  (import scheme)
+  (import chicken)
+  (include "irregex.scm")
+)

irregex.doc

@@ -170 +170 @@
 Returns \q{#t} iff the object is a successful match result from
 \q{irregex-search} or \q{irregex-match}.
 
+\subsubsection*{(irregex-num-submatches <irx>)}
+\subsubsection*{(irregex-match-num-submatches <match>)}
+
+Returns the number of numbered submatches that are defined in the
+irregex or match object.
+
+\subsubsection*{(irregex-names <irx>)}
+\subsubsection*{(irregex-match-names <match>)}
+
+Returns an association list of named submatches that are defined in
+the irregex or match object.  The \q{car} of each item in this list is
+the name of a submatch, the \q{cdr} of each item is the numerical
+submatch corresponding to this name.  If a named submatch occurs
+multiple times in the irregex, it will also occur multiple times in
+this list.
+
 \subsubsection*{(irregex-match-substring <match> [<index-or-name>])}
 \subsubsection*{(irregex-match-start-index <match> <index-or-name>)}
 \subsubsection*{(irregex-match-end-index <match> <index-or-name>)}

irregex.scm

@@ -155 +155 @@
 
 (define (irregex-match-index m opt)
   (if (pair? opt)
-      (cond ((number? (car opt)) (car opt))
-            ((assq (car opt) (irregex-match-names m)) => cdr)
-            (else (error "unknown match name" (car opt))))
+      (if (number? (car opt))
+          (car opt)
+          (let lp ((ls (irregex-match-names m)))
+            (cond ((null? ls) (error "unknown match name" (car opt)))
+                  ((and (eq? (car opt) (caar ls))
+                        (%irregex-match-start-chunk m (cdar ls)))
+                   (cdar ls))
+                  (else (lp (cdr ls))))))
       0))
 
 (define (%irregex-match-valid-index? m n)

irregex.setup

@@ -1 @@
-(define has-exports? (string>=? (chicken-version) "2.310"))
 
-(compile irregex.scm -s -O2 -f -inline -lambda-lift -disable-interrupts ;-d0
-         -prologue irregex-chicken.scm
-         ,@(if has-exports?
-               '(-check-imports -emit-exports irregex.exports)
-               '())
-         -o irregex.so)
+(compile irregex-chicken.scm -s -O3 -f -inline -lambda-lift -disable-interrupts ;-d0
+         -j irregex -o irregex.so)
+(compile irregex.import.scm -s -Os -d0)
 (install-extension
  'irregex
  '("irregex.so")
- `((version 0.7.0)
-   (documentation "irregex.html")
-   ,@(if has-exports? `((exports "irregex.exports")) '())))
+ `((version 0.8.1)
+   (documentation "irregex.html")))

test-irregex.scm

@@ -283 +283 @@
        (lambda (src i s) (reverse s))))
   )
 
+
+(define (extract name irx str)
+  (irregex-match-substring (irregex-match irx str) name))
+
+(test-group "named submatches"
+  (test "matching alternative is used"
+        "first" (extract 'sub `(or (submatch-named sub "first")
+                                   (submatch-named sub "second"))
+                         "first"))
+  (test "matching alternative is used (second match)"
+        "second" (extract 'sub `(or (submatch-named sub "first")
+                                    (submatch-named sub "second"))
+                         "second"))
+  (test "last match is used with multiple matches for a name"
+        "second" (extract 'sub `(seq (submatch-named sub "first")
+                                     space
+                                     (submatch-named sub "second"))
+                         "first second")))
+
 (test-end)