From 6989fa9402d952b2118f59b845b1a24e69c5d9f8 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 8 Mar 2003 02:26:01 +0000
Subject: [PATCH] Implement GUARANTEE- procedures for symbols.

---
 v7/src/runtime/runtime.pkg |  5 ++++-
 v7/src/runtime/symbol.scm  | 22 ++++++++++++++++------
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index d3ad735be..518234301 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.434 2003/03/07 21:23:46 cph Exp $
+$Id: runtime.pkg,v 14.435 2003/03/08 02:26:01 cph Exp $
 
 Copyright (c) 1988,1989,1990,1991,1992 Massachusetts Institute of Technology
 Copyright (c) 1993,1994,1995,1996,1997 Massachusetts Institute of Technology
@@ -449,6 +449,9 @@ USA.
   (files "symbol")
   (parent (runtime))
   (export ()
+	  guarantee-interned-symbol
+	  guarantee-symbol
+	  guarantee-uninterned-symbol
 	  intern
 	  intern-soft
 	  interned-symbol?
diff --git a/v7/src/runtime/symbol.scm b/v7/src/runtime/symbol.scm
index 78aa09985..0ab499144 100644
--- a/v7/src/runtime/symbol.scm
+++ b/v7/src/runtime/symbol.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: symbol.scm,v 1.9 2003/02/14 18:28:34 cph Exp $
+$Id: symbol.scm,v 1.10 2003/03/08 02:25:19 cph Exp $
 
-Copyright (c) 1992-2001 Massachusetts Institute of Technology
+Copyright 1992,1993,2001,2003 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -38,9 +38,20 @@ USA.
 (define-integrable (uninterned-symbol? object)
   (object-type? (ucode-type uninterned-symbol) object))
 
+(define-integrable (guarantee-symbol object caller)
+  (if (not (symbol? object))
+      (error:wrong-type-argument object "symbol" caller)))
+
+(define-integrable (guarantee-interned-symbol object caller)
+  (if (not (interned-symbol? object))
+      (error:wrong-type-argument object "interned symbol" caller)))
+
+(define-integrable (guarantee-uninterned-symbol object caller)
+  (if (not (uninterned-symbol? object))
+      (error:wrong-type-argument object "uninterned symbol" caller)))
+
 (define (string->uninterned-symbol string)
-  (if (not (string? string))
-      (error:wrong-type-argument string "string" 'STRING->UNINTERNED-SYMBOL))
+  (guarantee-string string 'STRING->UNINTERNED-SYMBOL)
   ((ucode-primitive system-pair-cons) (ucode-type uninterned-symbol)
 				      string
 				      (make-unmapped-unbound-reference-trap)))
@@ -64,8 +75,7 @@ USA.
        (string-downcase string))))
 
 (define (symbol-name symbol)
-  (if (not (symbol? symbol))
-      (error:wrong-type-argument symbol "symbol" 'SYMBOL-NAME))
+  (guarantee-symbol symbol 'SYMBOL-NAME)
   (system-pair-car symbol))
 
 (define-integrable (symbol->string symbol)
-- 
2.25.1