Move string-match into ustring.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 0170960734b2e26a0e4a12716c44eda8257ae8a0..547d9dfd89fc48f2aa40272e31675a42870e00fb 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1038,10 +1038,6 @@ USA.
          guarantee-substring-start-index
          reverse-string
          reverse-substring
-         string-match-backward
-         string-match-backward-ci
-         string-match-forward
-         string-match-forward-ci
          string-pad-left
          string-pad-right
          string-search-all
@@ -1050,10 +1046,6 @@ USA.
          string-trim
          string-trim-left
          string-trim-right
-         substring-match-backward
-         substring-match-backward-ci
-         substring-match-forward
-         substring-match-forward-ci
          substring-search-all
          substring-search-backward
          substring-search-forward
@@ -1134,6 +1126,10 @@ USA.
          string-length
          string-lower-case?
          string-map
+         string-match-backward
+         string-match-backward-ci
+         string-match-forward
+         string-match-forward-ci
          string-null?
          string-prefix-ci?
          string-prefix?

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 416f638c6b5679cbec5efc5cd198008ad9ac1782..b2a6bac1a8e0cdf33890e4e1b5682e1fea5115d2 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -89,90 +89,6 @@ USA.
        (string-set! result j (string-ref string i)))
       result)))
 \f
-(define (string-match-forward string1 string2)
-  (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD)
-  (%substring-match-forward string1 0 (string-length string1)
-                           string2 0 (string-length string2)))
-
-(define (substring-match-forward string1 start1 end1 string2 start2 end2)
-  (guarantee-2-substrings string1 start1 end1
-                         string2 start2 end2
-                         'SUBSTRING-MATCH-FORWARD)
-  (%substring-match-forward string1 start1 end1 string2 start2 end2))
-
-(define (%substring-match-forward string1 start1 end1 string2 start2 end2)
-  (let ((end (fix:+ start1 (fix:min (fix:- end1 start1) (fix:- end2 start2)))))
-    (let loop ((i1 start1) (i2 start2))
-      (if (or (fix:= i1 end)
-             (not (char=? (string-ref string1 i1)
-                          (string-ref string2 i2))))
-         (fix:- i1 start1)
-         (loop (fix:+ i1 1) (fix:+ i2 1))))))
-
-(define (string-match-forward-ci string1 string2)
-  (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD-CI)
-  (%substring-match-forward-ci string1 0 (string-length string1)
-                              string2 0 (string-length string2)))
-
-(define (substring-match-forward-ci string1 start1 end1 string2 start2 end2)
-  (guarantee-2-substrings string1 start1 end1
-                         string2 start2 end2
-                         'SUBSTRING-MATCH-FORWARD-CI)
-  (%substring-match-forward-ci string1 start1 end1 string2 start2 end2))
-
-(define (%substring-match-forward-ci string1 start1 end1 string2 start2 end2)
-  (let ((end (fix:+ start1 (fix:min (fix:- end1 start1) (fix:- end2 start2)))))
-    (let loop ((i1 start1) (i2 start2))
-      (if (or (fix:= i1 end)
-             (not (char-ci=? (string-ref string1 i1)
-                             (string-ref string2 i2))))
-         (fix:- i1 start1)
-         (loop (fix:+ i1 1) (fix:+ i2 1))))))
-\f
-(define (string-match-backward string1 string2)
-  (guarantee-2-strings string1 string2 'STRING-MATCH-BACKWARD)
-  (%substring-match-backward string1 0 (string-length string1)
-                            string2 0 (string-length string2)))
-
-(define (substring-match-backward string1 start1 end1 string2 start2 end2)
-  (guarantee-2-substrings string1 start1 end1
-                         string2 start2 end2
-                         'SUBSTRING-MATCH-BACKWARD)
-  (%substring-match-backward string1 start1 end1 string2 start2 end2))
-
-(define (%substring-match-backward string1 start1 end1 string2 start2 end2)
-  (let ((start (fix:- end1 (fix:min (fix:- end1 start1) (fix:- end2 start2)))))
-    (if (fix:= end1 start)
-       0
-       (let loop ((i1 (fix:- end1 1)) (i2 (fix:- end2 1)))
-         (if (char=? (string-ref string1 i1) (string-ref string2 i2))
-             (if (fix:= i1 start)
-                 (fix:- end1 i1)
-                 (loop (fix:- i1 1) (fix:- i2 1)))
-             (fix:- end1 (fix:+ i1 1)))))))
-
-(define (string-match-backward-ci string1 string2)
-  (guarantee-2-strings string1 string2 'STRING-MATCH-BACKWARD-CI)
-  (%substring-match-backward-ci string1 0 (string-length string1)
-                               string2 0 (string-length string2)))
-
-(define (substring-match-backward-ci string1 start1 end1 string2 start2 end2)
-  (guarantee-2-substrings string1 start1 end1
-                         string2 start2 end2
-                         'SUBSTRING-MATCH-BACKWARD-CI)
-  (%substring-match-backward-ci string1 start1 end1 string2 start2 end2))
-
-(define (%substring-match-backward-ci string1 start1 end1 string2 start2 end2)
-  (let ((start (fix:- end1 (fix:min (fix:- end1 start1) (fix:- end2 start2)))))
-    (if (fix:= end1 start)
-       0
-       (let loop ((i1 (fix:- end1 1)) (i2 (fix:- end2 1)))
-         (if (char-ci=? (string-ref string1 i1) (string-ref string2 i2))
-             (if (fix:= i1 start)
-                 (fix:- end1 i1)
-                 (loop (fix:- i1 1) (fix:- i2 1)))
-             (fix:- end1 (fix:+ i1 1)))))))
-\f
 ;;;; Trim
 
 (define (string-trim-left string #!optional char-set)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 9ec0aef21473eb59d03f8711d81cf85eb4e822a0..1f34cc2665333e66faf25e9400f81301173a9643 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -364,6 +364,38 @@ USA.
 (define string-ci>? (string-comparison-maker %string-ci>?))
 (define string-ci>=? (string-comparison-maker %string-ci>=?))
 \f
+;;;; Match
+
+(define (string-match-forward string1 string2)
+  (let ((end1 (string-length string1))
+       (end2 (string-length string2)))
+    (let ((end (fix:min end1 end2)))
+      (let loop ((i 0))
+       (if (and (fix:< i end)
+                (char=? (string-ref string1 i)
+                        (string-ref string2 i)))
+           (loop (fix:+ i 1))
+           i)))))
+
+(define (string-match-forward-ci string1 string2)
+  (string-match-forward (string-foldcase string1)
+                       (string-foldcase string2)))
+
+(define (string-match-backward string1 string2)
+  (let ((s1 (fix:- (string-length string1) 1)))
+    (let loop ((i s1) (j (fix:- (string-length string2) 1)))
+      (if (and (fix:>= i 0)
+              (fix:>= j 0)
+              (char=? (string-ref string1 i)
+                      (string-ref string2 j)))
+         (loop (fix:- i 1)
+               (fix:- j 1))
+         (fix:- s1 i)))))
+
+(define (string-match-backward-ci string1 string2)
+  (string-match-backward (string-foldcase string1)
+                        (string-foldcase string2)))
+
 (define-integrable (prefix-maker c= caller)
   (lambda (prefix string #!optional start end)
     (let* ((end (fix:end-index end (string-length string) caller))
@@ -394,6 +426,8 @@ USA.
 ;;; Incorrect implementation: should do string-foldcase on both args.
 (define string-prefix-ci? (prefix-maker char-ci=? 'string-prefix-ci?))
 (define string-suffix-ci? (suffix-maker char-ci=? 'string-suffix-ci?))
+\f
+;;;; Case
 
 (define (string-downcase string)
   (case-transform char-downcase-full string))