Move string-compare into ustring and merge with order predicates.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index becea1c84f614023ea77a74e32546282b2ca34ff..0170960734b2e26a0e4a12716c44eda8257ae8a0 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1038,8 +1038,6 @@ USA.
          guarantee-substring-start-index
          reverse-string
          reverse-substring
-         string-compare
-         string-compare-ci
          string-match-backward
          string-match-backward-ci
          string-match-forward
@@ -1116,6 +1114,8 @@ USA.
          string-ci=?
          string-ci>=?
          string-ci>?
+         string-compare
+         string-compare-ci
          string-copy
          string-copy!
          string-count

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 80f230186697d5a1f664b088fb0bf0068826524f..416f638c6b5679cbec5efc5cd198008ad9ac1782 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -89,56 +89,6 @@ USA.
        (string-set! result j (string-ref string i)))
       result)))
 \f
-;;;; Compare
-
-(define (string-compare string1 string2 if= if< if>)
-  (guarantee-2-strings string1 string2 'STRING-COMPARE)
-  (%string-compare string1 string2 if= if< if>))
-
-(define (%string-compare string1 string2 if= if< if>)
-  (let ((length1 (string-length string1))
-       (length2 (string-length string2)))
-    (let ((end (fix:min length1 length2)))
-      (let loop ((index 0))
-       (cond ((fix:= index end)
-              (if (fix:= index length1)
-                  (if (fix:= index length2)
-                      (if=)
-                      (if<))
-                  (if>)))
-             ((char=? (string-ref string1 index)
-                      (string-ref string2 index))
-              (loop (fix:+ index 1)))
-             ((char<? (string-ref string1 index)
-                      (string-ref string2 index))
-              (if<))
-             (else
-              (if>)))))))
-
-(define (string-compare-ci string1 string2 if= if< if>)
-  (guarantee-2-strings string1 string2 'STRING-COMPARE-CI)
-  (%string-compare-ci string1 string2 if= if< if>))
-
-(define (%string-compare-ci string1 string2 if= if< if>)
-  (let ((length1 (string-length string1))
-       (length2 (string-length string2)))
-    (let ((end (fix:min length1 length2)))
-      (let loop ((index 0))
-       (cond ((fix:= index end)
-              (if (fix:= index length1)
-                  (if (fix:= index length2)
-                      (if=)
-                      (if<))
-                  (if>)))
-             ((char-ci=? (string-ref string1 index)
-                         (string-ref string2 index))
-              (loop (fix:+ index 1)))
-             ((char-ci<? (string-ref string1 index)
-                         (string-ref string2 index))
-              (if<))
-             (else
-              (if>)))))))
-\f
 (define (string-match-forward string1 string2)
   (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD)
   (%substring-match-forward string1 0 (string-length string1)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index c3663c4f942331bc7a19d32cdc4951b9aaf5fddc..9ec0aef21473eb59d03f8711d81cf85eb4e822a0 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -296,37 +296,53 @@ USA.
 (define (string-tail string start)
   (string-copy string start))
 \f
+;;;; Compare
+
 ;; Non-Unicode implementation, acceptable to R7RS.
-(define-integrable (%string-comparison-maker c= c< f<)
+(define-integrable (string-compare string1 string2 if= if< if>)
+  (let ((end1 (string-length string1))
+       (end2 (string-length string2)))
+    (let ((end (fix:min end1 end2)))
+      (let loop ((i 0))
+       (if (fix:< i end)
+           (let ((c1 (string-ref string1 i))
+                 (c2 (string-ref string2 i)))
+             (cond ((char<? c1 c2) (if<))
+                   ((char<? c2 c1) (if>))
+                   (else (loop (fix:+ i 1)))))
+           (cond ((fix:< end1 end2) (if<))
+                 ((fix:< end2 end1) (if>))
+                 (else (if=))))))))
+
+(define-integrable (string-compare-ci string1 string2 if= if< if>)
+  (string-compare (string-foldcase string1)
+                 (string-foldcase string2)
+                 if=
+                 if<
+                 if>))
+
+(define-integrable (true) #t)
+(define-integrable (false) #f)
+
+(define-integrable (%string-comparison-maker if= if< if>)
   (lambda (string1 string2)
-    (let ((end1 (string-length string1))
-         (end2 (string-length string2)))
-      (let ((end (fix:min end1 end2)))
-       (let loop ((i 0))
-         (if (fix:< i end)
-             (let ((c1 (string-ref string1 i))
-                   (c2 (string-ref string2 i)))
-               (if (c= c1 c2)
-                   (loop (fix:+ i 1))
-                   (c< c1 c2)))
-             (f< end1 end2)))))))
-
-(define %string<? (%string-comparison-maker char=? char<? fix:<))
-(define %string<=? (%string-comparison-maker char=? char<=? fix:<=))
-(define %string=? (%string-comparison-maker char=? char=? fix:=))
-(define %string>? (%string-comparison-maker char=? char>? fix:>))
-(define %string>=? (%string-comparison-maker char=? char>=? fix:<=))
-
-(define-integrable (%string-ci-comparison-maker string-compare)
+    (string-compare string1 string2 if= if< if>)))
+
+(define %string=?  (%string-comparison-maker  true false false))
+(define %string<?  (%string-comparison-maker false  true false))
+(define %string<=? (%string-comparison-maker  true  true false))
+(define %string>?  (%string-comparison-maker false false  true))
+(define %string>=? (%string-comparison-maker  true false  true))
+
+(define-integrable (%string-ci-comparison-maker if= if< if>)
   (lambda (string1 string2)
-    (string-compare (string-foldcase string1)
-                   (string-foldcase string2))))
-
-(define %string-ci<? (%string-ci-comparison-maker %string<?))
-(define %string-ci<=? (%string-ci-comparison-maker %string<=?))
-(define %string-ci=? (%string-ci-comparison-maker %string=?))
-(define %string-ci>? (%string-ci-comparison-maker %string>?))
-(define %string-ci>=? (%string-ci-comparison-maker %string>=?))
+    (string-compare-ci string1 string2 if= if< if>)))
+
+(define %string-ci=?  (%string-ci-comparison-maker  true false false))
+(define %string-ci<?  (%string-ci-comparison-maker false  true false))
+(define %string-ci<=? (%string-ci-comparison-maker  true  true false))
+(define %string-ci>?  (%string-ci-comparison-maker false false  true))
+(define %string-ci>=? (%string-ci-comparison-maker  true false  true))
 
 (define-integrable (string-comparison-maker %compare)
   (lambda (string1 string2 . strings)