summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-11-18 11:32:24 +0100
committerAndy Wingo <wingo@pobox.com>2011-11-24 11:47:36 +0100
commitf7bbc75d0474a36d8ec5d72df8f938c0dff5395e (patch)
tree61c989b0fe8145bf29f89d2f61521ff494b39a16
parentfb5f79a8b0e0915d1bf228c20a06a95ad201764f (diff)
downloadguile-f7bbc75d0474a36d8ec5d72df8f938c0dff5395e.tar.gz
record-type-vtable is not a new root of the vtable hierarchy
* module/ice-9/boot-9.scm (record-type-vtable): Simplify to use make-vtable instead of make-vtable-vtable.
-rw-r--r--module/ice-9/boot-9.scm17
1 files changed, 7 insertions, 10 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 84d8dd1a0..b6c9d44d3 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -955,16 +955,13 @@ VALUE."
;; 0: type-name, 1: fields, 2: constructor
(define record-type-vtable
- ;; FIXME: This should just call make-vtable, not make-vtable-vtable; but for
- ;; that we need to expose the bare vtable-vtable to Scheme.
- (make-vtable-vtable "prprpw" 0
- (lambda (s p)
- (cond ((eq? s record-type-vtable)
- (display "#<record-type-vtable>" p))
- (else
- (display "#<record-type " p)
- (display (record-type-name s) p)
- (display ">" p))))))
+ (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
+ (lambda (s p)
+ (display "#<record-type " p)
+ (display (record-type-name s) p)
+ (display ">" p)))))
+ (set-struct-vtable-name! s 'record-type)
+ s))
(define (record-type? obj)
(and (struct? obj) (eq? record-type-vtable (struct-vtable obj))))