From 23c734685aec977bb947d1e1e08c06b2304029b1 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 7 Mar 2003 19:08:28 +0000
Subject: [PATCH] Remove angle brackets ("<...>") from record-type name.

---
 v7/src/runtime/record.scm | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/v7/src/runtime/record.scm b/v7/src/runtime/record.scm
index 8b04ce058..3c5173631 100644
--- a/v7/src/runtime/record.scm
+++ b/v7/src/runtime/record.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: record.scm,v 1.33 2003/03/07 18:32:38 cph Exp $
+$Id: record.scm,v 1.34 2003/03/07 19:08:28 cph Exp $
 
 Copyright 1989,1990,1991,1993,1994,1996 Massachusetts Institute of Technology
 Copyright 1997,2002,2003 Massachusetts Institute of Technology
@@ -137,7 +137,7 @@ USA.
 	   (default-record (%make-record (fix:+ 1 n) #f))
 	   (record-type
 	    (%record record-type-type-tag
-		     (->string type-name)
+		     (->type-name type-name)
 		     names
 		     #f
 		     default-record))
@@ -398,10 +398,17 @@ USA.
 					(error:no-such-slot record-type name)
 					error?))))))
 
-(define (->string object)
-  (if (string? object)
-      object
-      (write-to-string object)))
+(define (->type-name object)
+  (let* ((string
+	  (if (string? object)
+	      object
+	      (write-to-string object)))
+	 (n (string-length string)))
+    (if (and (fix:> n 2)
+	     (char=? (string-ref string 0) #\<)
+	     (char=? (string-ref string (fix:- n 1)) #\>))
+	(substring string 1 (fix:- n 1))
+	string)))
 
 (define-integrable (guarantee-list-of-unique-symbols object procedure)
   (if (not (list-of-unique-symbols? object))
-- 
2.25.1