From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 21 Apr 2017 23:48:44 +0000 (-0700)
Subject: Change string->nfc to return immutable value, and optimize a bit.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~19
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ef2299de3884a0be1d7fbce575aeb9f604c89dd4;p=mit-scheme.git

Change string->nfc to return immutable value, and optimize a bit.
---

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index ee7c65f6d..521c74d90 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -474,6 +474,16 @@ USA.
     ((1) (max-loop cp1-ref))
     ((2) (max-loop cp2-ref))
     (else (max-loop cp3-ref))))
+
+(define (%string->immutable string)
+  (unpack-slice string
+    (lambda (string* start end)
+      (let ((result
+	     (immutable-ustring-allocate
+	      (fix:- end start)
+	      (%general-max-cp string* start end))))
+	(%general-copy! result 0 string* start end)
+	result))))
 
 ;;;; Streaming builder
 
@@ -818,26 +828,6 @@ USA.
 
 ;;;; Normalization
 
-(define (string->nfd string)
-  (if (string-in-nfd? string)
-      (if (and (ustring? string) (not (ustring-mutable? string)))
-	  string
-	  (unpack-slice string
-	    (lambda (string* start end)
-	      (let ((result
-		     (immutable-ustring-allocate
-		      (fix:- end start)
-		      (%general-max-cp string* start end))))
-		(%general-copy! result 0 string* start end)
-		(ustring-in-nfd! result)
-		result))))
-      (canonical-decomposition&ordering string
-	(lambda (string* n max-cp)
-	  (let ((result (immutable-ustring-allocate n max-cp)))
-	    (%general-copy! result 0 string* 0 n)
-	    (ustring-in-nfd! result)
-	    result)))))
-
 (define (string-in-nfd? string)
   (cond ((or (legacy-string? string) (ustring? string))
 	 (if (ustring-mutable? string)
@@ -848,14 +838,6 @@ USA.
 	(else
 	 (error:not-a string? string 'string-in-nfd?))))
 
-(define (string->nfc string)
-  (if (string-in-nfc? string)
-      string
-      (canonical-composition (string->nfd string))))
-
-(define (string->nfc-cf string)
-  (string->nfc (string-foldcase string)))
-
 (define (string-in-nfc? string)
   (cond ((legacy-string? string)
 	 #t)
@@ -864,9 +846,7 @@ USA.
 	     (ustring-nfc-qc? string 0 (ustring-length string))
 	     (ustring-in-nfc? string)))
 	((slice? string)
-	 (ustring-nfc-qc? (slice-string string)
-			  (slice-start string)
-			  (slice-end string)))
+	 (unpack-slice string ustring-nfc-qc?))
 	(else
 	 (error:not-a string? string 'string-in-nfc?))))
 
@@ -898,6 +878,42 @@ USA.
 (define %ustring-nfc-qc? (string-nqc-loop #x300 char-nfc-quick-check?))
 (define %ustring-nfd-qc? (string-nqc-loop #xC0 char-nfd-quick-check?))
 
+(define (string->nfd string)
+  (cond ((and (ustring? string)
+	      (ustring-in-nfd? string))
+	 string)
+	((string-in-nfd? string)
+	 (let ((result (%string->immutable string)))
+	   (ustring-in-nfd! result)
+	   result))
+	(else
+	 (canonical-decomposition&ordering string
+	   (lambda (string* n max-cp)
+	     (let ((result (immutable-ustring-allocate n max-cp)))
+	       (%general-copy! result 0 string* 0 n)
+	       (ustring-in-nfd! result)
+	       result))))))
+
+(define (string->nfc string)
+  (cond ((and (ustring? string)
+	      (ustring-in-nfc? string))
+	 string)
+	((string-in-nfc? string)
+	 (let ((result (%string->immutable string)))
+	   (ustring-in-nfc! result)
+	   result))
+	(else
+	 (canonical-composition
+	  (if (string-in-nfd? string)
+	      string
+	      (canonical-decomposition&ordering string
+		(lambda (string* n max-cp)
+		  (declare (ignore n max-cp))
+		  string*)))))))
+
+(define (string->nfc-cf string)
+  (string->nfc (string-foldcase string)))
+
 (define (canonical-decomposition&ordering string k)
   (let ((end (string-length string))
 	(builder (make-string-builder 'result 'mutable)))