diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-18 11:32:24 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-07-06 18:32:14 +0200 |
commit | 581bd72a7d8346d32d02379d64b3012fdd6eef31 (patch) | |
tree | 6a97a0ef5ff09c3b7ee5533ce8c181308aa4bc41 | |
parent | 2921f537609547e7c9ee0df555a840407313eabd (diff) | |
download | guile-581bd72a7d8346d32d02379d64b3012fdd6eef31.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 f4ed1df38..5ed543a1c 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1050,16 +1050,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)))) |