Re: [PATCH] Performance improvement for R6RS records

[Andy Wingo <wingo@pobox.com>]

Hello :)

;; First, get the set of required fields in a vtable. There should be a
;; better way for this, but there isn't.
;;
(define vtable-base-layout
  (symbol->string (struct-layout (make-vtable ""))))

;; Now make the vtable for record-types. It has the base layout, plus
;; one more field to hold the list of fields in its instances.
;;
(define record-type-vtable
  (let ((rtv (make-vtable (string-append vtable-base-layout "pr")
                          (lambda (x port)
                            (format port "<record-type ~a ~x>"
                                    (struct-vtable-name x)
                                    (object-address x))))))
    (set-struct-vtable-name! rtv 'record-type)
    rtv))

;; Each field of a record will be writable. Obviously here we could do
;; "pr" fields instead.
;;
;; fields := NAME...
;;
(define (fields->layout fields)
  (apply symbol-append (map (lambda (x) 'pw) fields)))

;; A function to allow us to make new record types. They will be
;; instances of record-type-vtable. They themselves will be vtables.
;;
(define (make-record-type name fields)
  (let ((rt (make-struct/no-tail record-type-vtable
                         (fields->layout fields) ; layout
                         record-printer          ; printer
                         fields)))               ; fields, the 'pr slot
                                                 ; from above
    (set-struct-vtable-name! rt name)
    rt))

;; Since fields and names are stored in the vtable, we can access them
;; from a printer.
;;
(define (record-type-name rt)
  (struct-vtable-name rt))
(define (record-type-fields rt)
  (struct-ref rt vtable-offset-user))
(define (record-printer x port)
  (define fields (record-type-fields (struct-vtable x)))
  (format port "<~a ~x"
          (record-type-name (struct-vtable x))
          (object-address x))
  (for-each (lambda (f i)
              (format port " ~a: ~a" f (struct-ref x i)))
            fields (iota (length fields)))
  (format port ">"))

;; Record types are instances of record-type-vtable.
;;
(define (record-type? x)
  (and (struct? x) (eq? (struct-vtable x) record-type-vtable)))

;; Records are instances of record types. Obviously you could inline
;; record-type? here.
;;
(define (record? x)
  (and (struct? x) (record-type? (struct-vtable x))))

;; A little syntax, just to try things out.
(define-syntax define-record-type
  (syntax-rules ()
    ((_ (name make) field ...)
     (begin
       (define name (make-record-type 'name '(field ...)))
       (define (make field ...)
         (make-struct/no-tail name field ...))))))

(define-record-type (foo make-foo)
  bar baz)

(make-foo 'a 'b)
=> <foo 1ea1a40 bar: a baz: b>

Hope that helps,

Andy
-- 
http://wingolog.org/