From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 27 Jan 2017 06:08:09 +0000 (-0800)
Subject: Implement converters between utf8-string and ustring.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~58
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4b4ccab0c0e3d5dd3068e12a8a0d924cbdff9072;p=mit-scheme.git

Implement converters between utf8-string and ustring.

These are temporary: both utf8-string and wide-string are going to be
eliminated.  Until then, we need some scaffolding to incrementally rewrite code
that uses them.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 836ce2b16..a01d66384 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1172,6 +1172,7 @@ USA.
 	  ustring*
 	  ustring->ascii
 	  ustring->list
+	  ustring->utf8-string		;temporary scaffolding
 	  ustring->vector
 	  ustring-any
 	  ustring-append
@@ -1213,6 +1214,7 @@ USA.
 	  ustring>=?
 	  ustring>?
 	  ustring?
+	  utf8-string->ustring		;temporary scaffolding
 	  ;; vector->ustring
 	  )
   (export (runtime predicate-metadata)
diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 1edfc8771..8937d66f0 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -702,4 +702,27 @@ USA.
 
 (define (string-for-primitive string)
   (or (ustring->ascii string)
-      (string->utf8 string)))
\ No newline at end of file
+      (string->utf8 string)))
+
+;; temporary scaffolding
+(define (ustring->utf8-string string #!optional start end)
+  (let* ((caller 'ustring->utf8-string)
+	 (end (fix:end-index end (ustring-length string) caller))
+	 (start (fix:start-index start end caller)))
+    (cond ((legacy-string? string)
+	   (if (%legacy-string-ascii? string start end)
+	       (legacy-string-copy string start end)
+	       (%string->utf8-string string start end)))
+	  ((utf32-string? string)
+	   (if (%utf32-string-ascii? string start end)
+	       (%utf32-string->ascii string start end)
+	       (%string->utf8-string string start end)))
+	  (else
+	   (error:not-a ustring? string caller)))))
+
+(define (%string->utf8-string string start end)
+  (object-new-type (ucode-type string) (string->utf8 string start end)))
+
+;; temporary scaffolding
+(define (utf8-string->ustring string #!optional start end)
+  (utf8->string (legacy-string->bytevector string) start end))
\ No newline at end of file