diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-18 11:32:24 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-11-24 11:47:36 +0100 |
commit | f7bbc75d0474a36d8ec5d72df8f938c0dff5395e (patch) | |
tree | 61c989b0fe8145bf29f89d2f61521ff494b39a16 | |
parent | fb5f79a8b0e0915d1bf228c20a06a95ad201764f (diff) | |
download | guile-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.scm | 17 |
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)))) |