Implement regexp-search-all and fix two typos.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index dcaa149292d472e5568803315d84b5a5945ead2f..f2fe3fe5905f54551656a20d6419ef3d15a3c775 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5596,6 +5596,7 @@ USA.
          regexp-replace
          regexp-replace-all
          regexp-search
+         regexp-search-all             ;extension
          regexp?
          valid-cset-sre?               ;extension
          valid-sre?))

diff --git a/src/runtime/srfi-115.scm b/src/runtime/srfi-115.scm
index 1a2fbe614542e748598df6fd06036b560c4c77ec..b6bb81178361a0d2bee426cb90f1a93c27d4cb8e 100644 (file)
--- a/src/runtime/srfi-115.scm
+++ b/src/runtime/srfi-115.scm
@@ -129,6 +129,19 @@ USA.
            (loop (fix:+ index 1)))
        (%regexp-match regexp string index end))))
 
+(define (regexp-search-all re string #!optional start end)
+  (guarantee nfc-string? string 'regexp-search)
+  (let* ((end (fix:end-index end (string-length string) 'regexp-search))
+        (start (fix:start-index start end 'regexp-search)))
+    (%regexp-search-all (regexp re) string start end)))
+
+(define (%regexp-search-all regexp string start end)
+  (let loop ((index start))
+    (let ((match (%regexp-search regexp string index end)))
+      (if match
+         (cons match (loop (regexp-match-submatch-start match 0)))
+         '()))))
+\f
 (define-record-type <regexp-match>
     (make-regexp-match group0 groups)
     regexp-match?
@@ -202,13 +215,6 @@ USA.
         (start (fix:start-index start end 'regexp-replace-all))
         (regexp (regexp re)))
 
-    (define (find-matches index)
-      (let ((match (%regexp-search regexp string index end)))
-       (if match
-           (cons match
-                 (find-matches (regexp-match-submatch-start match 0)))
-           '())))
-
     (define (subst-matches matches start)
       (if (pair? matches)
          (let ((match (car matches))
@@ -222,7 +228,7 @@ USA.
                   (subst-matches matches (regexp-match-submatch-end match 0))))
          '()))
 
-    (let ((matches (find-matches start)))
+    (let ((matches (%regexp-search regexp string start end)))
       (if (pair? matches)
          (string-append* (subst-matches matches start))
          (substring string start end)))))
@@ -240,7 +246,7 @@ USA.
        ((eq? 'pre subst)
         (string-slice string start (regexp-match-submatch-start match 0)))
        ((eq? 'post subst)
-        (string-slice starting (regexp-match-submatch-end match 0) end))
+        (string-slice string (regexp-match-submatch-end match 0) end))
        (else
         (or (regexp-match-submatch match subst) ""))))
 
@@ -253,7 +259,7 @@ USA.
   (or (string? object)
       (regexp-match-key? object)
       (and (list? object)
-          (every subst-template? object))))
+          (every regexp-match-replace-template? object))))
 (register-predicate! regexp-match-replace-template?
                     'regexp-match-replace-template)