Import Upstream version 2c0upstream/2c0

1 files changed, 22 insertions, 5 deletions

diff --git a/record.scm b/record.scm
index 555d3ea..b0cc755 100644
--- a/record.scm
+++ b/record.scm
@@ -1,6 +1,6 @@
 ; "record.scm" record data types
 ; Written by David Carlton, carlton@husc.harvard.edu.
-; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu
+; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu, 1996, 1997
 ;
 ; This code is in the public domain.
 
@@ -17,6 +17,8 @@
 (define vector-set! vector-set!)
 (define vector-fill! vector-fill!)
 (define vector->list vector->list)
+(define display display)
+(define write write)
 
 (define record-modifier #f)
 (define record-accessor #f)
@@ -32,6 +34,8 @@
       (vect? vector?)
       (vect-ref vector-ref)
       (vect->list vector->list)
+      (disp display)
+      (wri write)
 
       ;; Need to wrap these to protect record data from being corrupted.
       (vect-set! vector-set!)
@@ -71,10 +75,15 @@
        (rtd-length (lambda (rtd) (vect-ref rtd 4)))
 
        (rec-rtd (lambda (x) (vect-ref x 0)))
+       (rec-disp-str
+	(lambda (x)
+	  (let ((name (rtd-name (rec-rtd x))))
+	    (string-append
+	     "#<" (if (symbol? name) (symbol->string name) name) ">"))))
 
        (make-rec-type
 	(lambda (type-name field-names)
-	  (if (not (string? type-name))
+	  (if (not (or (symbol? type-name) (string? type-name)))
 	      (slib:error 'make-record-type "non-string type-name argument."
 			  type-name))
 	  (if (or (and (list? field-names) (comlist:has-duplicates? field-names))
@@ -182,17 +191,17 @@
 	      (vect-set! x index y)))))
        )
 
-    (set! vector? (lambda (obj) (and (not (rec? obj)) (vector? obj))))
+    (set! vector? (lambda (obj) (and (not (rec? obj)) (vect? obj))))
     (set! vector-ref
 	  (lambda (vector k)
 	    (cond ((rec? vector)
 		   (vec:error 'vector-ref nvt vector))
 		  (else (vect-ref vector k)))))
     (set! vector->list
-	  (lambda (vector k)
+	  (lambda (vector)
 	    (cond ((rec? vector)
 		   (vec:error 'vector->list nvt vector))
-		  (else (vect->list vector k)))))
+		  (else (vect->list vector)))))
     (set! vector-set!
 	  (lambda (vector k obj)
 	    (cond ((rec? vector)
@@ -203,6 +212,14 @@
 	    (cond ((rec? vector)
 		   (vec:error 'vector-fill! nvt vector))
 		  (else (vect-fill! vector fill)))))
+    (set! display
+	  (lambda (obj . opt)
+	    (apply disp (if (rec? obj) (rec-disp-str obj) obj) opt)))
+    (set! write
+	  (lambda (obj . opt)
+	    (if (rec? obj)
+		(apply disp (rec-disp-str obj) opt)
+		(apply wri obj opt))))
     (set! record-modifier rec-modifier)
     (set! record-accessor rec-accessor)
     (set! record-constructor rec-constructor)