Fix typo in SET-RECORD-TYPE-UNPARSER-METHOD!.

diff --git a/v7/src/runtime/record.scm b/v7/src/runtime/record.scm
index 706749f3cc37c6859c7c0cfb60577f8e429f1b83..d15647c460d32c45754edb49a1177e4c68eaa267 100644 (file)
--- a/v7/src/runtime/record.scm
+++ b/v7/src/runtime/record.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: record.scm,v 1.51 2005/03/19 04:56:37 cph Exp $
+$Id: record.scm,v 1.52 2005/03/19 05:08:17 cph Exp $
 
 Copyright 1989,1990,1991,1993,1994,1996 Massachusetts Institute of Technology
 Copyright 1997,2002,2003,2004,2005 Massachusetts Institute of Technology
@@ -236,14 +236,18 @@ USA.
 
 (define set-record-type-unparser-method!/after-boot
   (named-lambda (set-record-type-unparser-method! record-type method)
-    (guarantee-unparser-method method 'SET-RECORD-TYPE-UNPARSER-METHOD!)
-    (let ((tag (record-type-dispatch-tag record-type)))
-      (remove-generic-procedure-generators unparse-record
-                                          (list (make-dispatch-tag #f) tag))
-      (add-generic-procedure-generator unparse-record
-       (lambda (generic tags)
-         generic
-         (and (eq? (cadr tags) tag) method))))))
+    (guarantee-record-type record-type 'SET-RECORD-TYPE-UNPARSER-METHOD!)
+    (if method
+       (guarantee-unparser-method method 'SET-RECORD-TYPE-UNPARSER-METHOD!))
+    (let ((tag (%record-type-dispatch-tag record-type)))
+      (remove-generic-procedure-generators
+       unparse-record
+       (list (record-type-dispatch-tag rtd:unparser-state) tag))
+      (if method
+         (add-generic-procedure-generator unparse-record
+           (lambda (generic tags)
+             generic
+             (and (eq? (cadr tags) tag) method)))))))
 
 (define (record-type-extension record-type)
   (guarantee-record-type record-type 'RECORD-TYPE-EXTENSION)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index ea2654c06bd7ee22678e7b85639125f5d32ebf71..acc7af69886b8f26dd67ade64bd171ecdfb6f69e 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.533 2005/03/19 04:57:53 cph Exp $
+$Id: runtime.pkg,v 14.534 2005/03/19 05:08:28 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -4016,6 +4016,8 @@ USA.
          unparser-table?
          user-object-type
          with-current-unparser-state)
+  (export (runtime record)
+         rtd:unparser-state)
   (export (runtime output-port)
          unparse-object/top-level)
   (export (runtime pretty-printer)