From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 21 Feb 2017 08:42:13 +0000 (-0800)
Subject: Eliminate references to symbol-name.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~40
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6121300125cacaf29b61f0d3de199af73d43f725;p=mit-scheme.git

Eliminate references to symbol-name.
---

diff --git a/doc/ref-manual/io.texi b/doc/ref-manual/io.texi
index 116c28ee6..f68b14aba 100644
--- a/doc/ref-manual/io.texi
+++ b/doc/ref-manual/io.texi
@@ -3225,7 +3225,7 @@ Returns the @dfn{URI} of @var{xml-name}.  The result always satisfies
 Returns the @dfn{qname} of @var{xml-name} as a string.  Equivalent to
 
 @example
-(symbol-name (xml-name->symbol @var{xml-name}))
+(symbol->string (xml-name->symbol @var{xml-name}))
 @end example
 @end deffn
 
diff --git a/src/compiler/base/infnew.scm b/src/compiler/base/infnew.scm
index 5dd26fef3..ef9fc11a7 100644
--- a/src/compiler/base/infnew.scm
+++ b/src/compiler/base/infnew.scm
@@ -272,14 +272,14 @@ USA.
 		label-bindings)
       (let ((map-label/fail
 	     (lambda (label)
-	       (let ((key (symbol-name label)))
+	       (let ((key (symbol->string label)))
 		 (let ((datum (hash-table/get labels key no-datum)))
 		   (if (eq? datum no-datum)
 		       (error "Missing label:" key))
 		   datum))))
 	    (map-label/false
 	     (lambda (label)
-	       (hash-table/get labels (symbol-name label) #f))))
+	       (hash-table/get labels (symbol->string label) #f))))
 	(for-each (lambda (label)
 		    (set-dbg-label/external?! (map-label/fail label) true))
 		  external-labels)
@@ -321,7 +321,7 @@ USA.
        (let ((offsets (make-rb-tree = <)))
 	 (for-each (lambda (binding)
 		     (let ((offset (cdr binding))
-			   (name (symbol-name (car binding))))
+			   (name (symbol->string (car binding))))
 		       (let ((datum (rb-tree/lookup offsets offset #f)))
 			 (if datum
 			     (set-cdr! datum (cons name (cdr datum)))
diff --git a/src/compiler/machines/C/cutl.scm b/src/compiler/machines/C/cutl.scm
index c5bd9b55e..75d4e54d7 100644
--- a/src/compiler/machines/C/cutl.scm
+++ b/src/compiler/machines/C/cutl.scm
@@ -97,7 +97,7 @@ USA.
 (define (c:line-item item)
   (cond ((string? item) item)
 	((char? item) (string item))
-	((symbol? item) (symbol-name item))
+	((symbol? item) (symbol->string item))
 	((number? item)
 	 ;; XXX Kludgey test for negative zero, to support building
 	 ;; from versions when NUMBER->STRING failed to do that itself.
@@ -387,11 +387,11 @@ USA.
   (let ((types
 	 (let ((types '(char short int long float double)))
 	   `(,@(map (lambda (t)
-		      (cons t (symbol-name t)))
+		      (cons t (symbol->string t)))
 		    types)
 	     ,@(map (lambda (t)
 		      (cons (symbol 'u t)
-			    (string-append "unsigned " (symbol-name t))))
+			    (string-append "unsigned " (symbol->string t))))
 		    types)
 	     (sobj . "SCHEME_OBJECT")))))
     `(,@types
@@ -412,7 +412,7 @@ USA.
 
 (define (c:var item)
   (cond ((string? item) item)
-	((symbol? item) (symbol-name item))
+	((symbol? item) (symbol->string item))
 	(else (error:wrong-type-argument item "C variable" 'C:VAR))))
 
 (define (c:array-decl type name dim items)
diff --git a/src/compiler/machines/C/stackify.scm b/src/compiler/machines/C/stackify.scm
index 737f0719d..85d200544 100644
--- a/src/compiler/machines/C/stackify.scm
+++ b/src/compiler/machines/C/stackify.scm
@@ -498,7 +498,7 @@ USA.
 	  (if (uninterned-symbol? obj)
 	      stackify-opcode/push-uninterned-symbol
 	      stackify-opcode/push-symbol)
-	  (symbol-name obj)
+	  (symbol->string obj)
 	  prog))
 	((bit-string? obj)
 	 (build/string stackify-opcode/push-bit-string
@@ -509,7 +509,7 @@ USA.
 		       (build/push-nat (bit-string-length obj) prog)))
 	((scode/primitive-procedure? obj)
 	 (let ((arity (primitive-procedure-arity obj))
-	       (name (symbol-name (primitive-procedure-name obj))))
+	       (name (symbol->string (primitive-procedure-name obj))))
 	   (cond ((fix:< arity 0)
 		  (build/string stackify-opcode/push-primitive-lexpr
 				name
diff --git a/src/compiler/machines/C/stackops.scm b/src/compiler/machines/C/stackops.scm
index aa8beb671..b288f8411 100644
--- a/src/compiler/machines/C/stackops.scm
+++ b/src/compiler/machines/C/stackops.scm
@@ -402,7 +402,7 @@ push-primitive-7			; name in string table
 	    (for-each
 	     write-string
 	     (list "\t"
-		   (stackify/C-quotify (symbol-name (car binding)))
+		   (stackify/C-quotify (symbol->string (car binding)))
 		   " = 0"
 		   (if (zero? value)
 		       ""
diff --git a/src/compiler/machines/svm/assembler-compiler.scm b/src/compiler/machines/svm/assembler-compiler.scm
index 50f5a1f2e..38335289f 100644
--- a/src/compiler/machines/svm/assembler-compiler.scm
+++ b/src/compiler/machines/svm/assembler-compiler.scm
@@ -692,7 +692,7 @@ USA.
        coding-types))))
 
 (define (defn-name-length defn)
-  (string-length (symbol-name (defn-name defn))))
+  (string-length (symbol->string (defn-name defn))))
 
 (define (wrap-scheme-output title pathname generator)
   (call-with-output-file pathname
@@ -860,7 +860,7 @@ USA.
   (newline port))
 
 (define (name->c-string name upcase?)
-  (name-string->c-string (symbol-name name) upcase?))
+  (name-string->c-string (symbol->string name) upcase?))
 
 (define (name-string->c-string name upcase?)
   (call-with-output-string
@@ -868,7 +868,7 @@ USA.
       (write-c-name-string name upcase? port))))
 
 (define (write-c-name name upcase? port)
-  (write-c-name-string (symbol-name name) upcase? port))
+  (write-c-name-string (symbol->string name) upcase? port))
 
 (define (write-c-name-string name upcase? port)
   (let ((e (string-length name))
diff --git a/src/cref/object.scm b/src/cref/object.scm
index 8c7d18ff7..ec4832153 100644
--- a/src/cref/object.scm
+++ b/src/cref/object.scm
@@ -199,7 +199,7 @@ USA.
 (declare (integrate-operator name->string))
 (define (name->string name)
   (if (interned-symbol? name)
-      (symbol-name name)
+      (symbol->string name)
       (write-to-string name)))
 
 (define-integrable (name<? x y)
diff --git a/src/cref/redpkg.scm b/src/cref/redpkg.scm
index 787a5bb12..4d6cb228a 100644
--- a/src/cref/redpkg.scm
+++ b/src/cref/redpkg.scm
@@ -54,7 +54,7 @@ USA.
 
 (define (find-global-definitions name model-pathname os-type)
   (let* ((filename (->pathname
-		    (cond ((symbol? name) (symbol-name name))
+		    (cond ((symbol? name) (symbol->string name))
 			  ((string? name) name)
 			  (else (error "Not a globals name:" name)))))
 	 (pkd (package-set-pathname filename os-type)))
diff --git a/src/edwin/abbrev.scm b/src/edwin/abbrev.scm
index 9e89578bd..e56690dd4 100644
--- a/src/edwin/abbrev.scm
+++ b/src/edwin/abbrev.scm
@@ -78,7 +78,7 @@ USA.
   (let ((abbrev
 	 (string-downcase
 	  (cond ((string? abbrev) abbrev)
-		((symbol? abbrev) (symbol-name abbrev))
+		((symbol? abbrev) (symbol->string abbrev))
 		(else
 		 (error:wrong-type-argument abbrev "string"
 					    'ABBREV-EXPANSION))))))
@@ -472,7 +472,7 @@ Mark is set after the inserted text."
      (lambda (name)
        (let ((table (get-named-abbrev-table name)))
 	 (insert-string "(" mark)
-	 (insert-string (symbol-name name) mark)
+	 (insert-string (symbol->string name) mark)
 	 (insert-string ")\n\n" mark)
 	 (hash-table/for-each table
 	   (lambda (abbrev entry)
diff --git a/src/edwin/autold.scm b/src/edwin/autold.scm
index de41536eb..c45114150 100644
--- a/src/edwin/autold.scm
+++ b/src/edwin/autold.scm
@@ -185,7 +185,7 @@ Second arg is prefix arg when called interactively."
     (list
      (prompt-for-alist-value "Load library"
 			     (map (lambda (library)
-				    (cons (symbol-name (car library))
+				    (cons (symbol->string (car library))
 					  (car library)))
 				  known-libraries))
      (command-argument)))
diff --git a/src/edwin/calias.scm b/src/edwin/calias.scm
index 22da0e65d..922750fa8 100644
--- a/src/edwin/calias.scm
+++ b/src/edwin/calias.scm
@@ -244,7 +244,7 @@ USA.
 
 (define (special-key/name special-key)
   (string-append (bucky-bits->prefix (special-key/bucky-bits special-key))
-		 (symbol-name (special-key/symbol special-key))))
+		 (symbol->string (special-key/symbol special-key))))
 
 (define (make-special-key name bits)
   (hook/make-special-key name bits))
diff --git a/src/edwin/comman.scm b/src/edwin/comman.scm
index d6af13203..11a69d735 100644
--- a/src/edwin/comman.scm
+++ b/src/edwin/comman.scm
@@ -43,13 +43,13 @@ USA.
   (let ((desc (command-%description command)))
     (if (description? desc)
 	desc
-	(let ((new (->doc-string (symbol-name (command-name command)) desc)))
+	(let ((new (->doc-string (symbol->string (command-name command)) desc)))
 	  (if new
 	      (set-command-%description! command new))
 	  new))))
 
 (define (command-name-string command)
-  (editor-name/internal->external (symbol-name (command-name command))))
+  (editor-name/internal->external (symbol->string (command-name command))))
 
 (define (editor-name/internal->external string)
   string)
@@ -58,7 +58,7 @@ USA.
   string)
 
 (define (make-command name description specification procedure)
-  (let* ((sname (symbol-name name))
+  (let* ((sname (symbol->string name))
 	 (command
 	  (or (string-table-get editor-commands sname)
 	      (let ((command (%make-command)))
@@ -74,7 +74,7 @@ USA.
   (make-string-table 500))
 
 (define (name->command name #!optional if-undefined)
-  (or (string-table-get editor-commands (symbol-name name))
+  (or (string-table-get editor-commands (symbol->string name))
       (case (if (default-object? if-undefined) 'INTERN if-undefined)
 	((#F) #f)
 	((ERROR) (error "Undefined command:" name))
@@ -120,7 +120,8 @@ USA.
   (let ((desc (variable-%description variable)))
     (if (description? desc)
 	desc
-	(let ((new (->doc-string (symbol-name (variable-name variable)) desc)))
+	(let ((new
+	       (->doc-string (symbol->string (variable-name variable)) desc)))
 	  (if new
 	      (set-variable-%description! variable new))
 	  new))))
@@ -129,11 +130,11 @@ USA.
 (define-integrable variable-default-value variable-%default-value)
 
 (define (variable-name-string variable)
-  (editor-name/internal->external (symbol-name (variable-name variable))))
+  (editor-name/internal->external (symbol->string (variable-name variable))))
 
 (define (make-variable name description value buffer-local?
 		       #!optional test normalization)
-  (let* ((sname (symbol-name name))
+  (let* ((sname (symbol->string name))
 	 (variable
 	  (or (string-table-get editor-variables sname)
 	      (let ((variable (%make-variable)))
@@ -183,7 +184,7 @@ USA.
   (make-string-table 50))
 
 (define (name->variable name #!optional if-undefined)
-  (or (string-table-get editor-variables (symbol-name name))
+  (or (string-table-get editor-variables (symbol->string name))
       (case (if (default-object? if-undefined) 'INTERN if-undefined)
 	((#F) #f)
 	((ERROR) (error "Undefined variable:" name))
diff --git a/src/edwin/comtab.scm b/src/edwin/comtab.scm
index cdda563fa..620d5d301 100644
--- a/src/edwin/comtab.scm
+++ b/src/edwin/comtab.scm
@@ -126,7 +126,7 @@ USA.
 
 (define (mode-name? object)
   (and (symbol? object)
-       (string-table-get editor-modes (symbol-name object))))
+       (string-table-get editor-modes (symbol->string object))))
 
 (define (list-of-comtabs? object)
   (and (not (null? object))
diff --git a/src/edwin/edtstr.scm b/src/edwin/edtstr.scm
index 93c7c4a32..cfed6ea23 100644
--- a/src/edwin/edtstr.scm
+++ b/src/edwin/edtstr.scm
@@ -127,7 +127,7 @@ USA.
        (not (button-down? object))))
 
 (define (button-name button)
-  (symbol-name (button-symbol button)))
+  (symbol->string (button-symbol button)))
 
 (set-record-type-unparser-method! <button>
   (simple-unparser-method (record-type-name <button>)
diff --git a/src/edwin/hlpcom.scm b/src/edwin/hlpcom.scm
index eef9ddb8d..c60226365 100644
--- a/src/edwin/hlpcom.scm
+++ b/src/edwin/hlpcom.scm
@@ -252,7 +252,7 @@ If you want VALUE to be a string, you must surround it with doublequotes."
 
 (define (mode-apropos regexp)
   (for-each (lambda (mode)
-	      (write-string (symbol-name (mode-name mode)))
+	      (write-string (symbol->string (mode-name mode)))
 	      (newline)
 	      (print-short-description "Mode" (mode-description mode)))
 	    (string-table-apropos editor-modes regexp)))
@@ -403,7 +403,7 @@ If you want VALUE to be a string, you must surround it with doublequotes."
 		    (if (pair? bindings)
 			(xkey->name (car bindings))
 			(string-append "M-x " (command-name-string command))))
-		  (string-append "M-x " (symbol-name argument))))
+		  (string-append "M-x " (symbol->string argument))))
 	    (find-escape next comtabs)))
 
     (define (show-bindings argument next comtabs)
diff --git a/src/edwin/modes.scm b/src/edwin/modes.scm
index 486d9b8a7..96cc943e5 100644
--- a/src/edwin/modes.scm
+++ b/src/edwin/modes.scm
@@ -52,7 +52,7 @@ USA.
   (if (not (or (not super-mode)
 	       (and major? (major-mode? super-mode))))
       (error:wrong-type-argument super-mode "major mode" 'MAKE-MODE))
-  (let ((sname (symbol-name name))
+  (let ((sname (symbol->string name))
 	(major? (if major? #t #f))
 	(super-comtabs (if super-mode (mode-comtabs super-mode) '())))
     (let ((mode (string-table-get editor-modes sname))
@@ -81,7 +81,7 @@ USA.
   (make-string-table))
 
 (define (name->mode name #!optional if-undefined)
-  (let ((sname (symbol-name name)))
+  (let ((sname (symbol->string name)))
     (or (string-table-get editor-modes sname)
 	(case (if (default-object? if-undefined) 'INTERN if-undefined)
 	  ((#F) #f)
@@ -113,7 +113,7 @@ USA.
   (let ((desc (mode-%description mode)))
     (if (description? desc)
 	desc
-	(let ((new (->doc-string (symbol-name (mode-name mode)) desc)))
+	(let ((new (->doc-string (symbol->string (mode-name mode)) desc)))
 	  (if new
 	      (set-mode-%description! mode new))
 	  new))))
diff --git a/src/edwin/modlin.scm b/src/edwin/modlin.scm
index fe0029a45..1b6b70cb7 100644
--- a/src/edwin/modlin.scm
+++ b/src/edwin/modlin.scm
@@ -276,7 +276,7 @@ If #F, the normal method is used."
 	   ((#\s)
 	    (let ((process (get-buffer-process buffer)))
 	      (if process
-		  (symbol-name (process-status process))
+		  (symbol->string (process-status process))
 		  "no process")))
 	   ((#\p)
 	    (let ((group (buffer-group buffer)))
diff --git a/src/edwin/process.scm b/src/edwin/process.scm
index 204acd63b..69bb43765 100644
--- a/src/edwin/process.scm
+++ b/src/edwin/process.scm
@@ -507,7 +507,7 @@ after the listing is made.)"
 	    (let ((process (car processes)))
 	      (write-line (or (process-name process) "")
 			  (let ((status (process-status process)))
-			    (let ((name (symbol-name status)))
+			    (let ((name (symbol->string status)))
 			      (if (or (eq? 'EXIT status)
 				      (eq? 'SIGNAL status))
 				  (let ((reason (process-exit-reason process)))
diff --git a/src/edwin/rmail.scm b/src/edwin/rmail.scm
index 61c39a15f..7fed612a9 100644
--- a/src/edwin/rmail.scm
+++ b/src/edwin/rmail.scm
@@ -933,7 +933,7 @@ and reverse search is specified by a negative numeric arg."
 		(number->string (msg-memo/number (msg-memo/last memo)))
 		(append-map!
 		 (lambda (label) (list "," label))
-		 (append! (map symbol-name (msg-memo/attributes memo))
+		 (append! (map symbol->string (msg-memo/attributes memo))
 			  (parse-labels (msg-memo/start memo))))))))
 
 ;;;; Message deletion
@@ -1767,7 +1767,7 @@ Completion is performed over known labels when reading."
 	  rmail-last-label
 	  (alist->string-table
 	   (map list
-		(append! (map symbol-name attributes)
+		(append! (map symbol->string attributes)
 			 (buffer-keywords (current-buffer)))))
 	  'REQUIRE-MATCH? require-match?)))
     (set! rmail-last-label label)
@@ -1825,7 +1825,7 @@ Completion is performed over known labels when reading."
 	      (update-mode-line! (mark-buffer start))))))))
 
 (define (attribute->string attribute)
-  (string-append " " (string-downcase (symbol-name attribute)) ","))
+  (string-append " " (string-downcase (symbol->string attribute)) ","))
 
 (define (label->attribute label)
   (let ((s (intern-soft label)))
diff --git a/src/edwin/schmod.scm b/src/edwin/schmod.scm
index 7ca1c7b4a..b2ed4862a 100644
--- a/src/edwin/schmod.scm
+++ b/src/edwin/schmod.scm
@@ -279,9 +279,9 @@ The following commands evaluate Scheme expressions:
 	    (cond ((not (pair? completions))
 		   (if-not-found))
 		  ((null? (cdr completions))
-		   (if-unique (symbol-name (car completions))))
+		   (if-unique (symbol->string (car completions))))
 		  (else
-		   (let ((completions (map symbol-name completions)))
+		   (let ((completions (map symbol->string completions)))
 		     (if-not-unique
 		      (string-greatest-common-prefix completions)
 		      (lambda () (sort completions string<=?))))))))
@@ -293,7 +293,7 @@ The following commands evaluate Scheme expressions:
   (let ((completions '()))
     (for-each-interned-symbol
      (lambda (symbol)
-       (if (and (string-prefix? prefix (symbol-name symbol))
+       (if (and (string-prefix? prefix (symbol->string symbol))
 		(filter symbol))
 	   (set! completions (cons symbol completions)))
        unspecific))
@@ -353,13 +353,13 @@ Otherwise, it is shown in the echo area."
 			(cond ((pair? argl)
 			       (insert-char #\space point)
 			       (insert-string (if (symbol? (car argl))
-						  (symbol-name (car argl))
+						  (symbol->string (car argl))
 						  (write-to-string (car argl)))
 					      point)
 			       (loop (cdr argl)))
 			      ((symbol? argl)
 			       (insert-string " . " point)
-			       (insert-string (symbol-name argl) point)))))
+			       (insert-string (symbol->string argl) point)))))
 		    (parameterize*
 		     (list (cons param:unparse-uninterned-symbols-by-name? #t))
 		     (lambda ()
diff --git a/src/edwin/sendmail.scm b/src/edwin/sendmail.scm
index 49ae7b36c..e0714d944 100644
--- a/src/edwin/sendmail.scm
+++ b/src/edwin/sendmail.scm
@@ -1415,9 +1415,9 @@ the user from the mailer."
 	(subtype (mime-attachment-subtype attachment)))
     (write-message-header-field
      "Content-Type"
-     (string-append (symbol-name type)
+     (string-append (symbol->string type)
 		    "/"
-		    (symbol-name subtype)
+		    (symbol->string subtype)
 		    (mime-parameters->string
 		     (mime-attachment-parameters attachment)))
      port)
@@ -1539,14 +1539,14 @@ the user from the mailer."
   (decorated-string-append
    "; " "" ""
    (map (lambda (parameter)
-	  (string-append (symbol-name (car parameter))
+	  (string-append (symbol->string (car parameter))
 			 "=\""
 			 (cadr parameter)
 			 "\""))
 	parameters)))
 
 (define (mime-disposition->string disposition)
-  (string-append (symbol-name (car disposition))
+  (string-append (symbol->string (car disposition))
 		 (mime-parameters->string (cdr disposition))))
 
 (define (guarantee-mime-compliant-headers h-start h-end)
@@ -1659,9 +1659,9 @@ You can add and delete attachments from that buffer."
   (let ((start (mark-right-inserting-copy mark))
 	(type (mime-attachment-type attachment))
 	(subtype (mime-attachment-subtype attachment)))
-    (insert-string-pad-right (string-append (symbol-name type)
+    (insert-string-pad-right (string-append (symbol->string type)
 					    "/"
-					    (symbol-name subtype))
+					    (symbol->string subtype))
 			     30 #\space mark)
     (if (not (and (eq? type 'MESSAGE) (eq? subtype 'RFC822)))
 	(begin
diff --git a/src/edwin/xterm.scm b/src/edwin/xterm.scm
index bdfd7f48b..cdba200d8 100644
--- a/src/edwin/xterm.scm
+++ b/src/edwin/xterm.scm
@@ -903,7 +903,7 @@ USA.
 	(or (hash-table/get table name #f)
 	    (let ((atom
 		   (x-intern-atom display
-				  (string-upcase (symbol-name name))
+				  (string-upcase (symbol->string name))
 				  soft?)))
 	      (if (not (= atom 0))
 		  (hash-table/put! table name atom))
diff --git a/src/ffi/cdecls.scm b/src/ffi/cdecls.scm
index f16e897f2..b0b4def55 100644
--- a/src/ffi/cdecls.scm
+++ b/src/ffi/cdecls.scm
@@ -250,7 +250,7 @@ USA.
   ;; munge the correct alist in INCLUDES.
   (if (not (and (pair? rest) (symbol? (car rest))
 		(list? (cdr rest))))
-      (cerror form "malformed "(symbol-name (car form))" declaration"))
+      (cerror form "malformed " (symbol->string (car form)) " declaration"))
   (let* ((name (car rest))
 	 (params (cdr rest))
 	 (others (if (eq? 'EXTERN (car form))
@@ -261,7 +261,7 @@ USA.
 		      (alien-function/filename (cdr entry))))
     (let ((new (cons name
 		     (make-alien-function
-		      (symbol-name name)
+		      (symbol->string name)
 		      (c-includes/library includes)
 		      (valid-ctype rettype includes)
 		      (valid-params params includes)
@@ -285,7 +285,7 @@ USA.
 		(null? (cddr form))))
       (cerror form "malformed parameter declaration"))
   (if (string-find-next-char-in-set
-       (symbol-name (car form)) char-set:not-c-symbol)
+       (symbol->string (car form)) char-set:not-c-symbol)
       (cerror form "invalid parameter name"))
   (let ((name (car form))
 	(ctype (valid-ctype (cadr form) includes)))
diff --git a/src/ffi/generator.scm b/src/ffi/generator.scm
index 65575a18a..9d29f1011 100644
--- a/src/ffi/generator.scm
+++ b/src/ffi/generator.scm
@@ -108,7 +108,7 @@ USA.
 	     (callout-restores name tos-var ret-var ret-ctype includes))
 	    (return
 	     (callout-return tos-var ret-var ret-ctype includes))
-	    (name (symbol-name name)))
+	    (name (symbol->string name)))
 	(write-string
 	 (string-append "
 SCM
@@ -126,7 +126,7 @@ Scm_continue_"name" (void)
 	  (inits (callout-inits ret-ctype params includes))
 	  (call (callout-call name ret-var ret-ctype params includes))
 	  (saves (callout-saves ret-var ret-ctype includes)))
-      (let ((name (symbol-name name)))
+      (let ((name (symbol->string name)))
 	(write-string
 	 (string-append "
 SCM
@@ -148,7 +148,7 @@ Scm_"name" (void)
 
 (define (matching-param? string params)
   (find-matching-item params
-    (lambda (param) (string=? string (symbol-name (car param))))))
+    (lambda (param) (string=? string (symbol->string (car param))))))
 
 (define (new-variable root-name params)
   ;; Returns a name (string) for a variable that must be distinct from
@@ -174,7 +174,7 @@ Scm_"name" (void)
 
 (define (callout-restores name tos-var ret-var ret-ctype includes)
   (let* ((ctype (definite-ctype ret-ctype includes))
-	 (tramp2 (string-append "&Scm_continue_" (symbol-name name)))
+	 (tramp2 (string-append "&Scm_continue_" (symbol->string name)))
 	 (ret-decl (decl-string ret-ctype)))
     (string-append "
   "tos-var" = callout_lunseal ("tramp2");"
@@ -214,7 +214,7 @@ Scm_"name" (void)
 			    (if (null? params) '()
 				(cons
 				 (let* ((param (car params))
-					(name (symbol-name (car param)))
+					(name (symbol->string (car param)))
 					(type (cadr param))
 					(decl (decl-string type)))
 				   (string-append "
@@ -242,7 +242,7 @@ Scm_"name" (void)
 			  (name (car param))
 			  (ctype (cadr param))
 			  (funcast (callout-arg-converter name ctype includes))
-			  (name (symbol-name name))
+			  (name (symbol->string name))
 			  (num (number->string n)))
 		     (string-append "
   "name" = "funcast" ("num");"))
@@ -256,9 +256,9 @@ Scm_"name" (void)
 
 (define (callout-call name ret-var ret-ctype params includes)
   ;; Returns a multi-line string in C syntax for the Call section.
-  (let ((name (symbol-name name))
+  (let ((name (symbol->string name))
 	(args (decorated-string-append
-	       "" ", " "" (map (lambda (param) (symbol-name (car param)))
+	       "" ", " "" (map (lambda (param) (symbol->string (car param)))
 			       params))))
     (if (not (ctype/void? (definite-ctype ret-ctype includes)))
 	(string-append "
@@ -326,7 +326,7 @@ Scm_"name" (void)
 	((eq? ctype 'ushort) "unsigned short")
 	((eq? ctype 'uint) "unsigned int")
 	((eq? ctype 'ulong) "unsigned long")
-	((symbol? ctype) (symbol-name ctype))
+	((symbol? ctype) (symbol->string ctype))
 	((ctype/pointer? ctype)
 	 (string-append (decl-string (ctype-pointer/target-type ctype))
 			" *"))
@@ -334,11 +334,11 @@ Scm_"name" (void)
 	 (string-append (decl-string (ctype-const/qualified-type ctype))
 			" const"))
 	((ctype/struct-name? ctype)
-	 (string-append "struct " (symbol-name (ctype-struct/name ctype))))
+	 (string-append "struct " (symbol->string (ctype-struct/name ctype))))
 	((ctype/union-name? ctype)
-	 (string-append "union " (symbol-name (ctype-union/name ctype))))
+	 (string-append "union " (symbol->string (ctype-union/name ctype))))
 	((ctype/enum-name? ctype)
-	 (string-append "enum " (symbol-name (ctype-enum/name ctype))))
+	 (string-append "enum " (symbol->string (ctype-enum/name ctype))))
 	(else
 	 (error "Could not generate a C type declaration:" ctype))))
 
@@ -374,7 +374,7 @@ Scm_"name" (void)
       (let ((declares (callback-decls params))
 	    (restores (callback-restores params tos-var))
 	    (constructs (callback-conses params args-var includes))
-	    (name (symbol-name name)))
+	    (name (symbol->string name)))
 	(write-string
 	 (string-append "
 static void
@@ -399,7 +399,7 @@ Scm_kernel_"name" (void)
 	  (saves (callback-saves params))
 	  (return (callback-return ret-ctype includes))
 	  (ret-decl (decl-string ret-ctype))
-	  (name (symbol-name name)))
+	  (name (symbol->string name)))
       (write-string
        (string-append
 	"
@@ -415,7 +415,7 @@ Scm_"name" ("arglist")
   ;; the second (inner, kernel) part of a callback trampoline.
   (apply string-append (map (lambda (param)
 			      (let ((decl (decl-string (cadr param)))
-				    (name (symbol-name (car param))))
+				    (name (symbol->string (car param))))
 				(string-append "
   "decl" "name";")))
 			    params)))
@@ -423,7 +423,7 @@ Scm_"name" ("arglist")
 (define (callback-restores params tos-var)
   ;; Returns a multi-line string setting the params from the C data stack.
   (apply string-append (map (lambda (param)
-			      (let ((name (symbol-name (car param)))
+			      (let ((name (symbol->string (car param)))
 				    (decl (decl-string (cadr param))))
 				(string-append "
   CSTACK_LPOP ("decl", "name", "tos-var");")))
@@ -437,7 +437,7 @@ Scm_"name" ("arglist")
 		      (ctype (cadr param)))
 		  (if (eq? name '|ID|)
 		      ""
-		      (let ((name (symbol-name name)))
+		      (let ((name (symbol->string name)))
 			(let ((construction
 			       (callback-arg-cons name ctype includes)))
 			  (string-append "
@@ -449,13 +449,13 @@ Scm_"name" ("arglist")
    "" ", " ""				;prefix, infix, suffix
    (map (lambda (param)
 	  (string-append (decl-string (cadr param))
-			 " " (symbol-name (car param))))
+			 " " (symbol->string (car param))))
 	params)))
 
 (define (callback-saves params)
   (apply string-append
    (map (lambda (param)
-	  (let ((name (symbol-name (car param)))
+	  (let ((name (symbol->string (car param)))
 		(ctype (cadr param)))
 	    (string-append "
   CSTACK_PUSH ("(decl-string ctype)", "name");")))
@@ -561,7 +561,7 @@ grovel_basics (FILE * out)
 	  (map (lambda (entry)
 		 (let* ((name (car entry))
 			(decl (decl-string name))
-			(name (symbol-name name)))
+			(name (symbol->string name)))
 		   (string-append "
   fprintf (out, \"   ((sizeof "name") . %ld)\\n\", (long) sizeof ("decl"));")))
 		    peek-poke-primitives))
@@ -577,7 +577,7 @@ grovel_enums (FILE * out)
 \{"
    (apply string-append
 	  (map (lambda (constant)
-		 (let ((name (symbol-name (car constant))))
+		 (let ((name (symbol->string (car constant))))
 		   (string-append "
   fprintf (out, \"   (|"name"| . %ld)\\n\", ((long)"name"));")))
 	       (c-includes/enum-constants includes)))
@@ -623,12 +623,12 @@ grovel_enums (FILE * out)
   ;; Generate C code for a grovel_NAME function.
   (let ((fname (cond ((ctype/struct-name? name)
 		      (string-append "grovel_struct_"
-				     (symbol-name (ctype-struct/name name))))
+				     (symbol->string (ctype-struct/name name))))
 		     ((ctype/union-name? name)
 		      (string-append "grovel_union_"
-				     (symbol-name (ctype-union/name name))))
+				     (symbol->string (ctype-union/name name))))
 		     ((symbol? name)
-		      (string-append "grovel_type_" (symbol-name name)))
+		      (string-append "grovel_type_" (symbol->string name)))
 		     (else (error "Unexpected name:" name))))
 	(ctype (definite-ctype name includes))
 	(decl (decl-string name))
@@ -644,7 +644,7 @@ void
      ctype includes
      (lambda (path brief-type)
        (let ((path (decorated-string-append
-		    "" "." "" (map symbol-name path)))
+		    "" "." "" (map symbol->string path)))
 	     (key (cons* 'OFFSET name path)))
 	 (_ "
   fprintf (out, \"   (")(write key)(_" %ld . ")(write brief-type)(_")\\n\", (long)((char*)&(S."path") - (char*)&S));"))))
diff --git a/src/gdbm/gdbm.scm b/src/gdbm/gdbm.scm
index 309237aa7..9120344ca 100644
--- a/src/gdbm/gdbm.scm
+++ b/src/gdbm/gdbm.scm
@@ -261,7 +261,7 @@ USA.
    (lambda ()
      (let ((args (gdbf-args gdbf)))
        (if (alien-null? args)
-	   (error (string-append (symbol-name operator) " failed: closed")))
+	   (error (string-append (symbol->string operator) " failed: closed")))
        (receiver args)))))
 
 (define (gdbm-error gdbf msg)
diff --git a/src/imail/imail-imap.scm b/src/imail/imail-imap.scm
index 39ab4e5be..92988310b 100644
--- a/src/imail/imail-imap.scm
+++ b/src/imail/imail-imap.scm
@@ -2010,7 +2010,7 @@ USA.
 		  (map (lambda (x)
 			 (if (exact-nonnegative-integer? x)
 			     (number->string x)
-			     (symbol-name x)))
+			     (symbol->string x)))
 		       section))
 		 "]"))
 
@@ -2043,7 +2043,7 @@ USA.
    `(,@(imap-message-cache-specifier message)
      ,(encode-cache-namestring
        (if (symbol? keyword)
-	   (symbol-name keyword)
+	   (symbol->string keyword)
 	   keyword)))))
 
 (define (imap-message-cache-pathname message)
@@ -2576,7 +2576,7 @@ USA.
 	  (flush-output imap-trace-port)))
     (imap-transcript-write-string tag port)
     (imap-transcript-write-char #\space port)
-    (imap-transcript-write-string (symbol-name command) port)
+    (imap-transcript-write-string (symbol->string command) port)
     (for-each (lambda (argument)
 		(if argument
 		    (begin
@@ -2594,7 +2594,7 @@ USA.
       (cond ((exact-nonnegative-integer? argument)
 	     (imap-transcript-write argument port))
 	    ((symbol? argument)
-	     (imap-transcript-write-string (symbol-name argument) port))
+	     (imap-transcript-write-string (symbol->string argument) port))
 	    ((and (pair? argument)
 		  (eq? (car argument) 'QUOTE)
 		  (pair? (cdr argument))
diff --git a/src/runtime/apropos.scm b/src/runtime/apropos.scm
index 419144500..2545f12c7 100644
--- a/src/runtime/apropos.scm
+++ b/src/runtime/apropos.scm
@@ -60,10 +60,10 @@ USA.
       names)))
 
 (define (aproposer text env search-parents? process-env process-symbol)
-  (let ((text (if (symbol? text) (symbol-name text) text)))
+  (let ((text (if (symbol? text) (symbol->string text) text)))
     (process-env env)
     (for-each (lambda (symbol)
-		(if (substring? text (symbol-name symbol))
+		(if (substring? text (symbol->string symbol))
 		    (process-symbol symbol env)))
 	      (sort (environment-bound-names env) symbol<?))
     (if (and search-parents? (environment-has-parent? env))
diff --git a/src/runtime/dbgutl.scm b/src/runtime/dbgutl.scm
index ae5ec03f7..25f146386 100644
--- a/src/runtime/dbgutl.scm
+++ b/src/runtime/dbgutl.scm
@@ -55,7 +55,7 @@ USA.
   (cond ((string? name)
 	 (write-string name port))
 	((interned-symbol? name)
-	 (write-string (symbol-name name) port))
+	 (write-string (symbol->string name) port))
 	(else
 	 (write name port))))
 
@@ -63,7 +63,7 @@ USA.
   (cond ((string? name)
 	 (write-string (string-upcase name)))
 	((interned-symbol? name)
-	 (write-string (string-upcase (symbol-name name)) port))
+	 (write-string (string-upcase (symbol->string name)) port))
 	(else
 	 (write name port))))
 
diff --git a/src/runtime/file-attributes.scm b/src/runtime/file-attributes.scm
index acd73f148..ef2c7b96a 100644
--- a/src/runtime/file-attributes.scm
+++ b/src/runtime/file-attributes.scm
@@ -210,7 +210,7 @@ This file is part of MIT/GNU Scheme.
 				     (trim-initial-token token)
 				     token)))
 		     (cond ((not token*) (tokenize confusion-count tokens))
-			   ((string-suffix? "-*-" (symbol-name token*))
+			   ((string-suffix? "-*-" (symbol->string token*))
 			    (let ((token** (trim-final-token token*)))
 			      (if token**
 				  (reverse (cons token** tokens))
@@ -232,8 +232,8 @@ This file is part of MIT/GNU Scheme.
 ;;;  -*-*- coding: latin-1 -*-*-
 
 (define (trim-initial-token sym)
-  (if (string-prefix? "*-" (symbol-name sym))
-      (do ((token-string (symbol-name sym) (string-tail token-string 2)))
+  (if (string-prefix? "*-" (symbol->string sym))
+      (do ((token-string (symbol->string sym) (string-tail token-string 2)))
 	  ((not (string-prefix? "*-" token-string))
 	   (if (zero? (string-length token-string))
 	       #f
@@ -248,7 +248,7 @@ This file is part of MIT/GNU Scheme.
 ;;; -*-outline-*-*-
 (define (trim-final-token sym)
   (do ((token-string
-	(let ((s (symbol-name sym)))
+	(let ((s (symbol->string sym)))
 	  (string-head s (- (string-length s) 3)))
 	(string-head token-string (- (string-length token-string) 2))))
       ((not (string-suffix? "-*" token-string))
diff --git a/src/runtime/gensym.scm b/src/runtime/gensym.scm
index 465a17d3a..3c6b424c3 100644
--- a/src/runtime/gensym.scm
+++ b/src/runtime/gensym.scm
@@ -36,7 +36,7 @@ USA.
 	       ((string? argument)
 		argument)
 	       ((symbol? argument)
-		(symbol-name argument))
+		(symbol->string argument))
 	       ((exact-nonnegative-integer? argument)
 		(set! name-counter argument)
 		name-prefix)
diff --git a/src/runtime/html-form-codec.scm b/src/runtime/html-form-codec.scm
index 733aafa4a..581114986 100644
--- a/src/runtime/html-form-codec.scm
+++ b/src/runtime/html-form-codec.scm
@@ -112,7 +112,7 @@ USA.
      (port/set-line-ending port 'crlf)
      (let ((write-datum
 	    (lambda (datum)
-	      (encode-segment (symbol-name (car datum)) port)
+	      (encode-segment (symbol->string (car datum)) port)
 	      (write-char #\= port)
 	      (encode-segment (cdr datum) port))))
        (if (pair? data)
diff --git a/src/runtime/http-syntax.scm b/src/runtime/http-syntax.scm
index 581e4288e..1f6175c41 100644
--- a/src/runtime/http-syntax.scm
+++ b/src/runtime/http-syntax.scm
@@ -292,12 +292,12 @@ USA.
 
 (define (http-token? object)
   (and (interned-symbol? object)
-       (string-is-http-token? (symbol-name object))))
+       (string-is-http-token? (symbol->string object))))
 
 (define-guarantee http-token "HTTP token")
 
 (define (write-http-token token port)
-  (write-string (symbol-name token) port))
+  (write-string (symbol->string token) port))
 
 (define (http-token-string? object)
   (and (string? object)
@@ -656,7 +656,7 @@ USA.
 			(*matcher
 			 (seq segment
 			      (* (seq #\- segment)))))
-		      (symbol-name object))))
+		      (symbol->string object))))
 
 (define language-range?
   (alt-predicate *? language-tag?))
diff --git a/src/runtime/httpio.scm b/src/runtime/httpio.scm
index 212b4443f..7d8c971c8 100644
--- a/src/runtime/httpio.scm
+++ b/src/runtime/httpio.scm
@@ -443,7 +443,7 @@ USA.
 	    ((and (eq? (mime-type/top-level type) 'APPLICATION)
 		  (let ((sub (mime-type/subtype type)))
 		    (or (eq? sub 'XML)
-			(string-suffix-ci? "+xml" (symbol-name sub)))))
+			(string-suffix-ci? "+xml" (symbol->string sub)))))
 	     (port/set-coding port (or coding 'UTF-8))
 	     (port/set-line-ending port 'XML-1.0))
 	    (coding
diff --git a/src/runtime/infstr.scm b/src/runtime/infstr.scm
index cbd802db9..fbfc60c95 100644
--- a/src/runtime/infstr.scm
+++ b/src/runtime/infstr.scm
@@ -209,7 +209,7 @@ USA.
 	   `(DEFINE-INTEGRABLE ,symbol
 	      ',((ucode-primitive string->symbol)
 		 (string-append "#[(runtime compiler-info)"
-				(string-downcase (symbol-name symbol))
+				(string-downcase (symbol->string symbol))
 				"]"))))))))
   ;; Various names used in `layout' to identify things that wouldn't
   ;; otherwise have names.
diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm
index 96798d563..e5aef5d8b 100644
--- a/src/runtime/infutl.scm
+++ b/src/runtime/infutl.scm
@@ -332,7 +332,7 @@ USA.
     (and procedure
 	 (let ((name (dbg-procedure/name procedure)))
 	   (or (special-form-procedure-name? name)
-	       (symbol-name name))))))
+	       (symbol->string name))))))
 
 (define load-debugging-info-on-demand?
   #f)
@@ -340,7 +340,7 @@ USA.
 (define (special-form-procedure-name? name)
   (let ((association (assq name special-form-procedure-names)))
     (and association
-	 (symbol-name (cdr association)))))
+	 (symbol->string (cdr association)))))
 
 (define special-form-procedure-names)
 
diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index 5380c967c..e63698bb5 100644
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -1023,7 +1023,7 @@ USA.
 (define (lookup-file-attribute file-attribute-alist attribute)
   (assoc attribute file-attribute-alist
 	 (lambda (left right)
-	   (string-ci=? (symbol-name left) (symbol-name right)))))
+	   (string-ci=? (symbol->string left) (symbol->string right)))))
 
 ;;; Look for keyword-style: prefix or keyword-style: suffix
 (define (process-keyword-attribute file-attribute-alist port)
@@ -1032,14 +1032,14 @@ USA.
     (if (pair? keyword-entry)
 	(let ((value (cdr keyword-entry)))
 	  (cond ((and (symbol? value)
-		      (or (string-ci=? (symbol-name value) "none")
-			  (string-ci=? (symbol-name value) "false")))
+		      (or (string-ci=? (symbol->string value) "none")
+			  (string-ci=? (symbol->string value) "false")))
 		 (set-port-property! port 'parser-keyword-style #f))
 		((and (symbol? value)
-		      (string-ci=? (symbol-name value) "prefix"))
+		      (string-ci=? (symbol->string value) "prefix"))
 		 (set-port-property! port 'parser-keyword-style 'prefix))
 		((and (symbol? value)
-		      (string-ci=? (symbol-name value) "suffix"))
+		      (string-ci=? (symbol->string value) "suffix"))
 		 (set-port-property! port 'parser-keyword-style 'suffix))
 		(else
 		 (warn "Unrecognized value for keyword-style" value)))))))
@@ -1052,9 +1052,9 @@ USA.
     (if (pair? mode-entry)
 	(let ((value (cdr mode-entry)))
 	  (if (or (not (symbol? value))
-		  (not (string-ci=? (symbol-name value) "scheme")))
+		  (not (string-ci=? (symbol->string value) "scheme")))
 	      (warn "Unexpected file mode:" (if (symbol? value)
-						(symbol-name value)
+						(symbol->string value)
 						value)))))))
 
 ;; If you want to turn on studly case, then the attribute must be
@@ -1068,21 +1068,21 @@ USA.
 	(let ((value (cdr studly-case-entry)))
 	  (cond ((or (eq? value #t)
 		     (and (symbol? value)
-			  (string-ci=? (symbol-name value) "true")))
+			  (string-ci=? (symbol->string value) "true")))
 		 ;; STricTly cHeck thE case.
-		 (cond ((not (string=? (symbol-name (car studly-case-entry))
+		 (cond ((not (string=? (symbol->string (car studly-case-entry))
 				       "sTuDly-case"))
 			(warn "Attribute name mismatch.  Expected sTuDly-case.")
 			#f)
 		       ((and (symbol? value)
-			     (not (string=? (symbol-name value) "True")))
+			     (not (string=? (symbol->string value) "True")))
 			(warn "Attribute value mismatch.  Expected True.")
 			#f)
 		       (else
 			(set-port-property! port 'parser-fold-case? #f))))
 		((or (not value)
 		     (and (symbol? value)
-			  (string-ci=? (symbol-name value) "false")))
+			  (string-ci=? (symbol->string value) "false")))
 		 (set-port-property! port 'parser-fold-case? #t))
 		(else
 		 (warn "Unrecognized value for sTuDly-case" value)))))))
diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 345078792..bc0d34b9a 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -603,7 +603,7 @@ USA.
 
 (define (->type-name object)
   (cond ((string? object) object)
-	((symbol? object) (symbol-name object))
+	((symbol? object) (symbol->string object))
 	(else (error:wrong-type-argument object "type name" #f))))
 
 (define (list-of-unique-symbols? object)
diff --git a/src/runtime/rfc2822-headers.scm b/src/runtime/rfc2822-headers.scm
index 7628d9b5b..e59554891 100644
--- a/src/runtime/rfc2822-headers.scm
+++ b/src/runtime/rfc2822-headers.scm
@@ -50,7 +50,7 @@ USA.
 (define (header-name? object)
   (and (interned-symbol? object)
        (not (eq? object '||))
-       (string-in-char-set? (symbol-name object) char-set:rfc2822-name)))
+       (string-in-char-set? (symbol->string object) char-set:rfc2822-name)))
 
 (define-guarantee header-name "RFC 2822 header-field name")
 
@@ -109,7 +109,7 @@ USA.
   (newline port))
 
 (define (write-name name port)
-  (let* ((name (symbol-name name))
+  (let* ((name (symbol->string name))
          (end (string-length name)))
     (if (char-alphabetic? (string-ref name 0))
 	(letrec
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 02cd64bfe..aceb8a08c 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -737,31 +737,29 @@ USA.
   (export-deprecated ()			;ignored on 9.2 hosts
 	  (substring->symbol string->symbol)
 	  (symbol-append symbol)
+	  (symbol-name symbol->string)
 	  error:not-interned-symbol
 	  error:not-symbol
 	  error:not-uninterned-symbol
 	  guarantee-interned-symbol
 	  guarantee-symbol
-	  guarantee-uninterned-symbol
-	  symbol-name)
+	  guarantee-uninterned-symbol)
   (export ()				;temporary duplicate for 9.2 hosts
 	  (substring->symbol string->symbol)
 	  (symbol-append symbol)
+	  (symbol-name symbol->string)
 	  error:not-interned-symbol
 	  error:not-symbol
 	  error:not-uninterned-symbol
 	  guarantee-interned-symbol
 	  guarantee-symbol
-	  guarantee-uninterned-symbol
-	  symbol-name)
+	  guarantee-uninterned-symbol)
   (export ()
 	  intern
 	  intern-soft
 	  interned-symbol?
 	  string->symbol
 	  string->uninterned-symbol
-	  string-head->symbol
-	  string-tail->symbol
 	  symbol
 	  symbol->string
 	  symbol-hash
diff --git a/src/runtime/sfile.scm b/src/runtime/sfile.scm
index 7b5f356f3..fec7f0d94 100644
--- a/src/runtime/sfile.scm
+++ b/src/runtime/sfile.scm
@@ -355,9 +355,9 @@ USA.
 
 (define (write-mime-type mime-type port)
   (guarantee-mime-type mime-type 'WRITE-MIME-TYPE)
-  (write-string (symbol-name (mime-type/top-level mime-type)) port)
+  (write-string (symbol->string (mime-type/top-level mime-type)) port)
   (write-string "/" port)
-  (write-string (symbol-name (mime-type/subtype mime-type)) port))
+  (write-string (symbol->string (mime-type/subtype mime-type)) port))
 
 (define (string->mime-type string #!optional start end)
   (vector-ref (or (*parse-string parser:mime-type string start end)
@@ -373,7 +373,7 @@ USA.
 
 (define (mime-token? object)
   (and (interned-symbol? object)
-       (string-is-mime-token? (symbol-name object))))
+       (string-is-mime-token? (symbol->string object))))
 
 (define (mime-token-string? object)
   (and (string? object)
diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index ef2f5876a..aafb58ccd 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -836,9 +836,9 @@ swank:xref
 	(completions '()))
     (for-each-interned-symbol
      (lambda (symbol)
-       (if (and (string-prefix? prefix (symbol-name symbol))
+       (if (and (string-prefix? prefix (symbol->string symbol))
 		(environment-bound? environment symbol))
-	   (set! completions (cons (symbol-name symbol) completions)))
+	   (set! completions (cons (symbol->string symbol) completions)))
        unspecific))
     completions))
 
diff --git a/src/runtime/symbol.scm b/src/runtime/symbol.scm
index 0cb6d10d7..12e398d72 100644
--- a/src/runtime/symbol.scm
+++ b/src/runtime/symbol.scm
@@ -53,19 +53,14 @@ USA.
   ((ucode-primitive string->symbol) (string->utf8 string start end)))
 
 (define (symbol->string symbol)
-  (guarantee symbol? symbol 'symbol->string)
+  (if (not (symbol? symbol))
+      (error:not-a symbol? symbol 'symbol->string))
   (let ((s (system-pair-car symbol)))
     (cond ((maybe-ascii s))
 	  ((bytevector? s) (utf8->string s))
 	  ((legacy-string? s) (utf8->string (%legacy-string->bytevector s)))
 	  (else (error "Illegal symbol name:" s)))))
 
-(define (string-head->symbol string end)
-  (string->symbol (string-slice string 0 end)))
-
-(define (string-tail->symbol string start)
-  (string->symbol (string-slice string start)))
-
 (define (symbol . objects)
   (string->symbol (%string* objects 'symbol)))
 
@@ -76,8 +71,6 @@ USA.
   ((ucode-primitive find-symbol) (foldcase->utf8 string)))
 
 (define (symbol-name symbol)
-  (if (not (symbol? symbol))
-      (error:not-a symbol? symbol 'symbol-name))
   (let ((bytes (system-pair-car symbol)))
     (or (maybe-ascii bytes)
 	(utf8->string bytes))))
diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm
index d36ece1e2..355d58740 100644
--- a/src/runtime/syntax-output.scm
+++ b/src/runtime/syntax-output.scm
@@ -92,7 +92,7 @@ USA.
 (define (output/letrec names values body)
   (let ((temps (map (lambda (name)
 		      (string->uninterned-symbol
-		       (string-append (symbol-name (identifier->symbol name))
+		       (string-append (symbol->string (identifier->symbol name))
 				      "-value"))) names)))
     (output/let
      names (map (lambda (name) name (output/unassigned)) names)
@@ -427,7 +427,7 @@ USA.
       (or (hash-table/get mapping-table key #f)
 	  (let ((mapped-identifier
 		 (string->uninterned-symbol
-		  (symbol-name (identifier->symbol identifier)))))
+		  (symbol->string (identifier->symbol identifier)))))
 	    (hash-table/put! mapping-table key mapped-identifier)
 	    (hash-table/put! (rename-database/unmapping-table renames)
 			     mapped-identifier
@@ -447,7 +447,7 @@ USA.
       ;; an uninterned symbol that guarantees uniqueness.
       (string->uninterned-symbol
        (string-append "."
-		      (symbol-name (identifier->symbol identifier))
+		      (symbol->string (identifier->symbol identifier))
 		      "."
 		      (number->string (force (make-rename-id)))))))
 
diff --git a/src/runtime/uerror.scm b/src/runtime/uerror.scm
index 4ddf11f29..adda0a717 100644
--- a/src/runtime/uerror.scm
+++ b/src/runtime/uerror.scm
@@ -317,7 +317,7 @@ USA.
 	(and code
 	     ((ucode-primitive system-call-error-message 1) code)))
       (if (symbol? error-type)
-	  (string-replace (symbol-name error-type) #\- #\space)
+	  (string-replace (symbol->string error-type) #\- #\space)
 	  (string-append "error " (write-to-string error-type)))))
 
 ;++ Whattakludge!
diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index 9df94dd8b..115cea49e 100644
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -438,7 +438,7 @@ USA.
 (define (unparse-symbol symbol context)
   (if (keyword? symbol)
       (unparse-keyword-name (keyword->string symbol) context)
-      (unparse-symbol-name (symbol-name symbol) context)))
+      (unparse-symbol-name (symbol->string symbol) context)))
 
 (define (unparse-keyword-name s context)
   (case (get-param:parser-keyword-style (context-environment context))
diff --git a/src/runtime/url.scm b/src/runtime/url.scm
index 5b0860706..f9055092f 100644
--- a/src/runtime/url.scm
+++ b/src/runtime/url.scm
@@ -1029,8 +1029,8 @@ USA.
 	     (actions (cdr clause)))
 	 `(,(cond ((eq? key 'EOF)
 		   `(EOF-OBJECT? CHAR))
-		  ((fix:= 1 (string-length (symbol-name key)))
-		   `(CHAR=? CHAR ,(string-ref (symbol-name key) 0)))
+		  ((fix:= 1 (string-length (symbol->string key)))
+		   `(CHAR=? CHAR ,(string-ref (symbol->string key) 0)))
 		  (else
 		   `(CHAR-SET-MEMBER? ,(symbol 'CHAR-SET:URI- key) CHAR)))
 	   ,@(map (lambda (action)
@@ -1046,7 +1046,7 @@ USA.
      (define (action:push? action) (syntax-match? '('PUSH ? SYMBOL) action))
      (define (expand:push action)
        `(WRITE-CHAR ,(if (pair? (cdr action))
-			 (string-ref (symbol-name (cadr action)) 0)
+			 (string-ref (symbol->string (cadr action)) 0)
 			 'CHAR)
 		    BUFFER))
 
diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index d96e1c91e..babe7e927 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -863,7 +863,7 @@ USA.
 (define (hackify-variable variable)
   (set-variable/name!
    variable
-   (string->uninterned-symbol (symbol-name (variable/name variable)))))
+   (string->uninterned-symbol (symbol->string (variable/name variable)))))
 
 (define (sequence-with-actions sequence actions)
   (sequence/make (sequence/scode sequence) actions))
diff --git a/src/ssp/mod-lisp.scm b/src/ssp/mod-lisp.scm
index 686c56ecf..1ffc91baa 100644
--- a/src/ssp/mod-lisp.scm
+++ b/src/ssp/mod-lisp.scm
@@ -78,7 +78,7 @@ USA.
 			      (list (car p) (cdr p)))
 			    (http-message-headers message)))))
   (for-each (lambda (header)
-	      (write-string (symbol-name (car header)) port)
+	      (write-string (symbol->string (car header)) port)
 	      (newline port)
 	      (write-string (cdr header) port)
 	      (newline port))
@@ -323,7 +323,7 @@ USA.
 			  (if (default-object? value)
 			      ""
 			      (string-append "; "
-					     (symbol-name name)
+					     (symbol->string name)
 					     "="
 					     (if map-value
 						 (map-value value)
@@ -331,7 +331,7 @@ USA.
 		     (attr
 		      (lambda (name map-value)
 			(%attr name name map-value))))
-		(string-append (symbol-name name) "=" value
+		(string-append (symbol->string name) "=" value
 			       (%attr 'max-age 'expires max-age->expires)
 			       (attr 'domain #f)
 			       (attr 'path #f)
@@ -415,7 +415,7 @@ USA.
 		  (write-string (status-message code) port)))))
 
 (define (set-content-type-header message type)
-  (set-header message 'CONTENT-TYPE (symbol-name type)))
+  (set-header message 'CONTENT-TYPE (symbol->string type)))
 
 (define (status-message code)
   (let loop ((low 0) (high (vector-length known-status-codes)))
diff --git a/src/star-parser/shared.scm b/src/star-parser/shared.scm
index 7018595a3..b0e56a8ea 100644
--- a/src/star-parser/shared.scm
+++ b/src/star-parser/shared.scm
@@ -274,7 +274,7 @@ USA.
   (string->uninterned-symbol
    (string-append
     internal-identifier-prefix
-    (symbol-name prefix)
+    (symbol->string prefix)
     (number->string
      (let ((entry (assq prefix *id-counters*)))
        (if entry
@@ -287,7 +287,7 @@ USA.
     internal-identifier-suffix)))
 
 (define (internal-identifier? identifier)
-  (let ((string (symbol-name identifier)))
+  (let ((string (symbol->string identifier)))
     (and (string-prefix? internal-identifier-prefix string)
 	 (string-suffix? internal-identifier-suffix string))))
 
diff --git a/src/win32/ffimacro.scm b/src/win32/ffimacro.scm
index 2987beea7..d719670cb 100644
--- a/src/win32/ffimacro.scm
+++ b/src/win32/ffimacro.scm
@@ -114,7 +114,7 @@ to inside a string that is being used as the buffer).
 		   (map (lambda (sym)
 			  (intern
 			   (string-append "[converted "
-					  (symbol-name sym)
+					  (symbol->string sym)
 					  "]")))
 			arg-names)))
 	     `((ACCESS PARAMETERIZE-WITH-MODULE-ENTRY
diff --git a/src/xdoc/db.scm b/src/xdoc/db.scm
index 7b0a334fc..42b158765 100644
--- a/src/xdoc/db.scm
+++ b/src/xdoc/db.scm
@@ -95,7 +95,7 @@ USA.
 	  (string-append "'"
 			 (escape-pgsql-string
 			  (if (symbol? object)
-			      (symbol-name object)
+			      (symbol->string object)
 			      object))
 			 "'"))
       "NULL"))
diff --git a/src/xdoc/xdoc.scm b/src/xdoc/xdoc.scm
index 8d5aec733..a543d094c 100644
--- a/src/xdoc/xdoc.scm
+++ b/src/xdoc/xdoc.scm
@@ -722,12 +722,12 @@ USA.
   (let ((bindings (http-request-post-parameter-bindings)))
     (let per-elt ((elt elt) (containers (xdoc-element-containers elt)))
       (let* ((id (xdoc-db-id elt))
-	     (suffix (string-append "-" (symbol-name id))))
+	     (suffix (string-append "-" (symbol->string id))))
 	(cond ((find-matching-item bindings
 		 (lambda (binding)
-		   (string-suffix? suffix (symbol-name (car binding)))))
+		   (string-suffix? suffix (symbol->string (car binding)))))
 	       => (lambda (binding)
-		    (values (let ((name (symbol-name (car binding))))
+		    (values (let ((name (symbol->string (car binding))))
 			      (substring->symbol
 			       name
 			       0
@@ -954,7 +954,7 @@ USA.
     source
     (let ((expected (boolean-attribute 'expected elt #t)))
       (if (or (string=? value "true") (string=? value "false"))
-	  (if (string=? value (symbol-name expected))
+	  (if (string=? value (symbol->string expected))
 	      "correct"
 	      "incorrect")
 	  "malformed"))))
@@ -1262,7 +1262,7 @@ USA.
     symbol))
 
 (define (xdoc-procedure-name? symbol)
-  (re-string-match "[A-Za-z_][0-9A-Za-z_]*" (symbol-name symbol)))
+  (re-string-match "[A-Za-z_][0-9A-Za-z_]*" (symbol->string symbol)))
 
 ;;;; Merging of attributes
 
diff --git a/src/xml/rdf-nt.scm b/src/xml/rdf-nt.scm
index 4b276ae00..4a13b2b1c 100644
--- a/src/xml/rdf-nt.scm
+++ b/src/xml/rdf-nt.scm
@@ -225,7 +225,7 @@ USA.
 	((rdf-literal-language literal)
 	 => (lambda (lang)
 	      (write-string "@" port)
-	      (write-string (symbol-name lang) port)))))
+	      (write-string (symbol->string lang) port)))))
 
 (define (write-rdf/nt-literal-text text port)
   (let ((text (open-input-string text)))
diff --git a/src/xml/rdf-struct.scm b/src/xml/rdf-struct.scm
index da4db7868..c8d9c686b 100644
--- a/src/xml/rdf-struct.scm
+++ b/src/xml/rdf-struct.scm
@@ -329,17 +329,17 @@ USA.
 
 (define (rdf-qname-prefix qname)
   (guarantee-rdf-qname qname 'RDF-QNAME-PREFIX)
-  (let ((s (symbol-name qname)))
+  (let ((s (symbol->string qname)))
     (symbol (string-head s (fix:+ (string-find-next-char s #\:) 1)))))
 
 (define (rdf-qname-local qname)
   (guarantee-rdf-qname qname 'RDF-QNAME-LOCAL)
-  (let ((s (symbol-name qname)))
+  (let ((s (symbol->string qname)))
     (string-tail s (fix:+ (string-find-next-char s #\:) 1))))
 
 (define (split-rdf-qname qname)
   (guarantee-rdf-qname qname 'SPLIT-RDF-QNAME)
-  (let ((s (symbol-name qname)))
+  (let ((s (symbol->string qname)))
     (let ((i (fix:+ (string-find-next-char s #\:) 1)))
       (values (symbol (string-head s i))
 	      (string-tail s i)))))
diff --git a/src/xml/turtle.scm b/src/xml/turtle.scm
index eadac3dab..44ed2eb64 100644
--- a/src/xml/turtle.scm
+++ b/src/xml/turtle.scm
@@ -612,8 +612,8 @@ USA.
 		(write-rdf/turtle-prefix (car p) (cdr p) port))
 	      (sort (hash-table->alist table)
 		(lambda (a b)
-		  (let ((a (symbol-name (car a)))
-			(b (symbol-name (car b))))
+		  (let ((a (symbol->string (car a)))
+			(b (symbol->string (car b))))
 		    (string<?
 		     (string-head a (fix:- (string-length a) 1))
 		     (string-head b (fix:- (string-length b) 1)))))))))
@@ -938,7 +938,7 @@ USA.
 	  (let ((start (string-length expansion)))
 	    (if (*match-string match:name s start end)
 		(begin
-		  (write-string (symbol-name prefix) port)
+		  (write-string (symbol->string prefix) port)
 		  (write-substring s start end port))
 		(write-rdf/nt-uri uri port)))
 	  (write-rdf/nt-uri uri port)))))
@@ -1003,7 +1003,7 @@ USA.
   (write-char #\space port))
 
 (define (write-symbol symbol port)
-  (write-string (symbol-name symbol) port))
+  (write-string (symbol->string symbol) port))
 
 (define (write-parens open close indentation port procedure)
   (write-string open port)
diff --git a/src/xml/xhtml.scm b/src/xml/xhtml.scm
index bdd4c498b..881140c52 100644
--- a/src/xml/xhtml.scm
+++ b/src/xml/xhtml.scm
@@ -282,7 +282,7 @@ USA.
   (guarantee-keyword-list keyword-list 'HTML:STYLE-ATTR)
   (if (pair? keyword-list)
       (let loop ((bindings keyword-list))
-	(string-append (symbol-name (car bindings))
+	(string-append (symbol->string (car bindings))
 		       ": "
 		       (cadr bindings)
 		       (if (pair? (cddr bindings))
diff --git a/src/xml/xml-names.scm b/src/xml/xml-names.scm
index 5e57c9070..fcf845caf 100644
--- a/src/xml/xml-names.scm
+++ b/src/xml/xml-names.scm
@@ -73,7 +73,7 @@ USA.
 (define-guarantee xml-name "an XML Name")
 
 (define (xml-name-string name)
-  (symbol-name (xml-name->symbol name)))
+  (symbol->string (xml-name->symbol name)))
 
 (define (xml-name->symbol name)
   (cond ((xml-name-symbol? name) name)
@@ -145,7 +145,7 @@ USA.
 	  (string->symbol object))
 	(begin
 	  (guarantee-symbol object constructor)
-	  (if (not (string-predicate (symbol-name object)))
+	  (if (not (string-predicate (symbol->string object)))
 	      (error:bad-range-argument object constructor))
 	  object))))
 
@@ -161,7 +161,7 @@ USA.
 (define (name-predicate string-predicate)
   (lambda (object)
     (and (symbol? object)
-	 (string-predicate (symbol-name object)))))
+	 (string-predicate (symbol->string object)))))
 
 (define xml-name-symbol? (name-predicate string-is-xml-name?))
 (define xml-nmtoken? (name-predicate string-is-xml-nmtoken?))
@@ -230,7 +230,7 @@ USA.
   (%xml-qname-prefix qname))
 
 (define (%xml-qname-prefix qname)
-  (let ((s (symbol-name qname)))
+  (let ((s (symbol->string qname)))
     (let ((c (string-find-next-char s #\:)))
       (if c
 	  (string->symbol (string-head s c))
@@ -241,7 +241,7 @@ USA.
   (%xml-qname-local qname))
 
 (define (%xml-qname-local qname)
-  (let ((s (symbol-name qname)))
+  (let ((s (symbol->string qname)))
     (let ((c (string-find-next-char s #\:)))
       (if c
 	  (string->symbol (string-tail s (fix:+ c 1)))
diff --git a/src/xml/xml-output.scm b/src/xml/xml-output.scm
index f1c0b1fbd..252ac3e07 100644
--- a/src/xml/xml-output.scm
+++ b/src/xml/xml-output.scm
@@ -196,7 +196,7 @@ USA.
   (emit-string " " ctx)
   (let ((type (xml-!element-content-type decl)))
     (cond ((symbol? type)
-	   (emit-string (string-upcase (symbol-name type)) ctx))
+	   (emit-string (string-upcase (symbol->string type)) ctx))
 	  ((and (pair? type) (eq? (car type) '|#PCDATA|))
 	   (emit-string "(#PCDATA" ctx)
 	   (if (pair? (cdr type))
@@ -258,7 +258,7 @@ USA.
 	   (emit-string " " ctx)
 	   (let ((type (cadr definition)))
 	     (cond ((symbol? type)
-		    (emit-string (string-upcase (symbol-name type)) ctx))
+		    (emit-string (string-upcase (symbol->string type)) ctx))
 		   ((and (pair? type) (eq? (car type) '|NOTATION|))
 		    (emit-string "NOTATION (" ctx)
 		    (if (pair? (cdr type))
@@ -285,9 +285,9 @@ USA.
 	   (let ((default (caddr definition)))
 	     (cond ((or (eq? default '|#REQUIRED|)
 			(eq? default '|#IMPLIED|))
-		    (emit-string (symbol-name default) ctx))
+		    (emit-string (symbol->string default) ctx))
 		   ((and (pair? default) (eq? (car default) '|#FIXED|))
-		    (emit-string (symbol-name (car default)) ctx)
+		    (emit-string (symbol->string (car default)) ctx)
 		    (emit-string " " ctx)
 		    (write-xml-attribute-value (cdr default) ctx))
 		   ((and (pair? default) (eq? (car default) 'default))
@@ -428,7 +428,7 @@ USA.
   (string-length (xml-name-string name)))
 
 (define (write-xml-nmtoken nmtoken ctx)
-  (emit-string (symbol-name nmtoken) ctx))
+  (emit-string (symbol->string nmtoken) ctx))
 
 (define (write-entity-value value col ctx)
   (if (xml-external-id? value)
@@ -489,7 +489,7 @@ USA.
 			   (((ctx-char-map ctx) char)
 			    => (lambda (name)
 				 (emit-char #\& ctx)
-				 (emit-string (symbol-name name) ctx)
+				 (emit-string (symbol->string name) ctx)
 				 (emit-char #\; ctx)))
 			   (else
 			    (emit-char char ctx))))
diff --git a/src/xml/xml-parser.scm b/src/xml/xml-parser.scm
index e4d314c81..c2b58363a 100644
--- a/src/xml/xml-parser.scm
+++ b/src/xml/xml-parser.scm
@@ -628,7 +628,7 @@ USA.
 	     (lambda (v)
 	       (let ((name (vector-ref v 0))
 		     (text (vector-ref v 1)))
-		 (if (string-ci=? (symbol-name name) "xml")
+		 (if (string-ci=? (symbol->string name) "xml")
 		     (perror p "Reserved XML processor name" name))
 		 (let ((entry (assq name *pi-handlers*)))
 		   (if entry
diff --git a/src/xml/xml-struct.scm b/src/xml/xml-struct.scm
index 9f9600049..fb15cc9a9 100644
--- a/src/xml/xml-struct.scm
+++ b/src/xml/xml-struct.scm
@@ -73,7 +73,7 @@ USA.
 		    (ERROR:WRONG-TYPE-ARGUMENT
 		     OBJECT
 		     ,(string-append "an XML "
-				     (string-replace (symbol-name (cadr form))
+				     (string-replace (symbol->string (cadr form))
 						     #\-
 						     #\space))
 		     CALLER))
@@ -609,7 +609,7 @@ USA.
 
 (define (convert-xml-string-value value)
   (cond ((xml-content-item? value) value)
-	((symbol? value) (symbol-name value))
+	((symbol? value) (symbol->string value))
 	((number? value) (number->string value))
 	((uri? value) (uri->string value))
 	((list-of-type? value xml-nmtoken?) (nmtokens->string value))
@@ -620,6 +620,6 @@ USA.
     (for-each (lambda (nmtokens)
 		(if (not (builder 'empty?))
 		    (builder #\space))
-		(builder (symbol-name (car nmtokens))))
+		(builder (symbol->string (car nmtokens))))
 	      nmtokens)
     (builder)))
\ No newline at end of file