From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Feb 2017 09:48:40 +0000 (-0800)
Subject: Move string-compare into ustring and merge with order predicates.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~18
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ecc87c5341839caaa847cdee1f330b1e41de7971;p=mit-scheme.git

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

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index becea1c84..017096073 100644
--- 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 80f230186..416f638c6 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -89,56 +89,6 @@ USA.
 	(string-set! result j (string-ref string i)))
       result)))
 
-;;;; 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>)))))))
-
 (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 c3663c4f9..9ec0aef21 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -296,37 +296,53 @@ USA.
 (define (string-tail string start)
   (string-copy string start))
 
+;;;; 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)