From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 19 Mar 2017 00:08:31 +0000 (-0700)
Subject: Use ucd-X-value directly in ustring.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~89
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4d783841dbed026f90e9510032c169d12dafa771;p=mit-scheme.git

Use ucd-X-value directly in ustring.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2792eb329..0cb362bca 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1280,11 +1280,6 @@ USA.
 	  char-set:lower-case
 	  char-set:upper-case
 	  char-set:whitespace)
-  (export (runtime)
-	  (char-downcase-full ucd-lc-value)
-	  (char-foldcase-full ucd-cf-value)
-	  (char-titlecase-full ucd-tc-value)
-	  (char-upcase-full ucd-uc-value))
   (export (runtime character)
 	  ucd-gc-value
 	  ucd-nt-value
@@ -1292,6 +1287,8 @@ USA.
 	  ucd-scf-value
 	  ucd-slc-value
 	  ucd-suc-value)
+  (export (runtime parser)
+	  (char-foldcase-full ucd-cf-value))
   (export (runtime ucd-glue)
 	  char-set:changes-when-case-folded
 	  ucd-nt-value)
@@ -1301,8 +1298,12 @@ USA.
 	  char-changes-when-upper-cased?
 	  char-nfd-quick-check?
 	  ucd-ccc-value
+	  ucd-cf-value
 	  ucd-dm-value
 	  ucd-gcb-value
+	  ucd-lc-value
+	  ucd-tc-value
+	  ucd-uc-value
 	  ucd-wb-value))
 
 (define-package (runtime ucd-glue)
diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 8ed272258..1aaac2170 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -436,13 +436,13 @@ USA.
 ;;;; Case
 
 (define (string-downcase string)
-  (case-transform char-downcase-full string))
+  (case-transform ucd-lc-value string))
 
 (define (string-foldcase string)
-  (case-transform char-foldcase-full string))
+  (case-transform ucd-cf-value string))
 
 (define (string-upcase string)
-  (case-transform char-upcase-full string))
+  (case-transform ucd-uc-value string))
 
 (define (case-transform transform string)
   (let ((builder (string-builder))
@@ -466,10 +466,10 @@ USA.
 	(let ((char (string-ref string index)))
 	  (if (char-cased? char)
 	      (begin
-		(builder (char-titlecase-full char))
+		(builder (ucd-tc-value char))
 		(do ((index (fix:+ index 1) (fix:+ index 1)))
 		    ((not (fix:< index end)))
-		  (builder (char-downcase-full (string-ref string index)))))
+		  (builder (ucd-lc-value (string-ref string index)))))
 	      (begin
 		(builder char)
 		(loop (fix:+ index 1))))))))