Don't return legacy strings containing UTF-8.
authorChris Hanson <org/chris-hanson/cph>
Fri, 27 Jan 2017 20:58:39 +0000 (12:58 -0800)
committerChris Hanson <org/chris-hanson/cph>
Fri, 27 Jan 2017 20:58:39 +0000 (12:58 -0800)
src/runtime/symbol.scm

index 2ab047c631f9a67df1940e4a8ab289ae8c429d25..735952c47b14b8852b0ee26abfbada823b3de826 100644 (file)
@@ -81,25 +81,30 @@ USA.
       (legacy-string-downcase string)
       (ustring-downcase string)))
 
+(define (symbol-name symbol)
+  (if (not (symbol? symbol))
+      (error:not-a symbol? symbol 'symbol-name))
+  (let* ((bytes (system-pair-car symbol))
+        (string (object-new-type (ucode-type string) bytes)))
+    (if (ascii-string? string)
+       ;; Needed during cold load.
+       string
+       (utf8->string bytes))))
+
 (define (ascii-string? string)
-  (and (legacy-string? string)
-       (let ((end (legacy-string-length string)))
+  (and ((ucode-primitive string?) string)
+       (let ((end ((ucode-primitive string-length) string)))
         (let loop ((i 0))
           (if (fix:< i end)
-              (and (fix:< (vector-8b-ref string i) #x80)
+              (and (fix:< ((ucode-primitive vector-8b-ref) string i) #x80)
                    (loop (fix:+ i 1)))
               #t)))))
 
-(define (symbol-name symbol)
-  (if (not (symbol? symbol))
-      (error:not-a symbol? symbol 'symbol-name))
-  (object-new-type (ucode-type string) (system-pair-car symbol)))
-
 (define (symbol-hash symbol #!optional modulus)
-  (legacy-string-hash (symbol-name symbol) modulus))
+  (ustring-hash (symbol-name symbol) modulus))
 
 (define (symbol<? x y)
-  (legacy-string<? (symbol-name x) (symbol-name y)))
+  (ustring<? (symbol-name x) (symbol-name y)))
 
 (define (symbol>? x y)
-  (legacy-string<? (symbol-name y) (symbol-name x)))
\ No newline at end of file
+  (ustring<? (symbol-name y) (symbol-name x)))
\ No newline at end of file