From 4b4ccab0c0e3d5dd3068e12a8a0d924cbdff9072 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 26 Jan 2017 22:08:09 -0800 Subject: [PATCH] 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. --- src/runtime/runtime.pkg | 2 ++ src/runtime/ustring.scm | 25 ++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) 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 -- 2.25.1