[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-42-g8761623

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8761623524d767e6e355f0de4c3be426ed3c8b09

The branch, stable-2.0 has been updated
       via  8761623524d767e6e355f0de4c3be426ed3c8b09 (commit)
      from  42f9581238b011d15114bfd31606cbda10574d17 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 8761623524d767e6e355f0de4c3be426ed3c8b09
Author: Andy Wingo <address@hidden>
Date:   Wed Aug 17 10:47:04 2011 +0200

    srfi-9 record compatibility with boot-9 records
    
    * module/srfi/srfi-9.scm (define-record-type): Instead of defining the
      RTD using make-vtable, use make-struct with the record-type-vtable,
      and record the type name and fields names in the vtable.  This way
      SRFI-9 records are compatible with boot-9 records.  Also we use a
      generic printer, instead of generating one anew.

-----------------------------------------------------------------------

Summary of changes:
 module/srfi/srfi-9.scm |   32 ++++++++++++++++++++++----------
 1 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index 6574a8d..cb8dd0a 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -95,6 +95,20 @@
                     (identifier? x)
                     #'proc-name))))))))))
 
+(define (default-record-printer s p)
+  (display "#<" p)
+  (display (record-type-name (record-type-descriptor s)) p)
+  (let loop ((fields (record-type-fields (record-type-descriptor s)))
+             (off 0))
+    (cond
+     ((not (null? fields))
+      (display " " p)
+      (display (car fields) p)
+      (display ": " p)
+      (write (struct-ref s off) p)
+      (loop (cdr fields) (+ 1 off)))))
+  (display ">" p))
+
 (define-syntax define-record-type
   (lambda (x)
     (define (field-identifiers field-specs)
@@ -177,16 +191,14 @@
               (indices     (field-indices (map syntax->datum fields))))
          #`(begin
              (define type-name
-               (make-vtable #,layout
-                            (lambda (obj port)
-                              (format port "#<~A" 'type-name)
-                              #,@(map (lambda (field)
-                                        (let* ((f (syntax->datum field))
-                                               (i (assoc-ref indices f)))
-                                          #`(format port " ~A: ~S" '#,field
-                                                    (struct-ref obj #,i))))
-                                      fields)
-                              (format port ">"))))
+               (let ((rtd (make-struct/no-tail
+                           record-type-vtable
+                           '#,(datum->syntax #'here (make-struct-layout 
layout))
+                           default-record-printer
+                           'type-name
+                           '#,fields)))
+                 (set-struct-vtable-name! rtd 'type-name)
+                 rtd))
              (define-inlinable (predicate-name obj)
                (and (struct? obj)
                     (eq? (struct-vtable obj) type-name)))


hooks/post-receive
-- 
GNU Guile