Support conversions between symbols and wide strings.

diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index ea9736360809d519b5f143239181fe8610c4a72d..2609bbf562c186346877e85a901aa3f9d2374f05 100644 (file)
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parse.scm,v 14.59 2005/04/12 18:28:31 cph Exp $
+$Id: parse.scm,v 14.60 2005/05/30 18:48:43 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1994,1997,1998,1999 Massachusetts Institute of Technology
@@ -220,15 +220,15 @@ USA.
   ctx
   (receive (string quoted?) (parse-atom port db (list char))
     (if quoted?
-       (%string->symbol string)
+       (string->symbol string)
        (or (string->number string (db-radix db))
-           (%string->symbol string)))))
+           (string->symbol string)))))
 
 (define (handler:symbol port db ctx char)
   ctx
   (receive (string quoted?) (parse-atom port db (list char))
     quoted?
-    (%string->symbol string)))
+    (string->symbol string)))
 
 (define (handler:number port db ctx char1 char2)
   ctx

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index dde9d1fc334c5844d82159881cb6f5c9a0d3ecdf..6da2d8df837fb8d571131ad4ce573ac6c9b46674 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.550 2005/05/30 04:42:24 cph Exp $
+$Id: runtime.pkg,v 14.551 2005/05/30 18:48:53 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -504,6 +504,7 @@ USA.
          symbol
          symbol->string
          symbol->utf8-string
+         symbol->wide-string
          symbol-append
          symbol-hash
          symbol-hash-mod
@@ -512,9 +513,7 @@ USA.
          symbol?
          uninterned-symbol?
          utf8-string->symbol
-         utf8-string->uninterned-symbol)
-  (export (runtime parser)
-         %string->symbol))
+         utf8-string->uninterned-symbol))
 
 (define-package (runtime microcode-data)
   (files "udata")

diff --git a/v7/src/runtime/symbol.scm b/v7/src/runtime/symbol.scm
index 10f78e9ad413974f36f99934a769733fa50c8ab6..180b216936b09132076e38af8d7a9cdbed0ef908 100644 (file)
--- a/v7/src/runtime/symbol.scm
+++ b/v7/src/runtime/symbol.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: symbol.scm,v 1.18 2005/05/24 04:50:35 cph Exp $
+$Id: symbol.scm,v 1.19 2005/05/30 18:49:01 cph Exp $
 
 Copyright 1992,1993,2001,2003,2004,2005 Massachusetts Institute of Technology
 
@@ -51,32 +51,30 @@ USA.
       (error:wrong-type-argument object "uninterned symbol" caller)))
 
 (define (string->uninterned-symbol string)
-  (guarantee-string string 'STRING->UNINTERNED-SYMBOL)
-  ((ucode-primitive system-pair-cons) (ucode-type uninterned-symbol)
-                                     (string->utf8-string string)
-                                     (make-unmapped-unbound-reference-trap)))
+  (make-uninterned-symbol (if (string? string)
+                             (string->utf8-string string)
+                             (wide-string->utf8-string string))))
 
 (define (utf8-string->uninterned-symbol string)
-  (guarantee-utf8-string string 'UTF8-STRING->UNINTERNED-SYMBOL)
+  (make-uninterned-symbol (if (utf8-string? string)
+                             (string-copy string)
+                             (wide-string->utf8-string string))))
+
+(define (make-uninterned-symbol string)
   ((ucode-primitive system-pair-cons) (ucode-type uninterned-symbol)
-                                     (string-copy string)
+                                     string
                                      (make-unmapped-unbound-reference-trap)))
 
 (define (string->symbol string)
-  (guarantee-string string 'STRING->SYMBOL)
-  (let ((string* (string->utf8-string string)))
-    (if (eq? string* string)
-       (or ((ucode-primitive find-symbol) string)
-           ((ucode-primitive string->symbol) (string-copy string)))
-       ((ucode-primitive string->symbol) string*))))
+  ((ucode-primitive string->symbol) (if (string? string)
+                                       (string->utf8-string string)
+                                       (wide-string->utf8-string string))))
 
 (define (utf8-string->symbol string)
-  (guarantee-utf8-string string 'UTF8-STRING->SYMBOL)
-  (or ((ucode-primitive find-symbol) string)
-      ((ucode-primitive string->symbol) (string-copy string))))
-
-(define (%string->symbol string)
-  ((ucode-primitive string->symbol) (string->utf8-string string)))
+  (if (utf8-string? string)
+      (or ((ucode-primitive find-symbol) string)
+         ((ucode-primitive string->symbol) (string-copy string)))
+      ((ucode-primitive string->symbol) (wide-string->utf8-string string))))
 
 (define (substring->symbol string start end)
   (guarantee-substring string start end 'SUBSTRING->SYMBOL)
@@ -149,5 +147,8 @@ USA.
 (define (symbol->utf8-string symbol)
   (string-copy (symbol-name symbol)))
 
+(define (symbol->wide-string symbol)
+  (utf8-string->wide-string (symbol-name symbol)))
+
 (define (symbol->string symbol)
-  (wide-string->string (utf8-string->wide-string (symbol-name symbol))))
\ No newline at end of file
+  (wide-string->string (symbol->wide-string symbol)))
\ No newline at end of file