Optimizing record accessors

[Ludovic Courtès]

Hi,

Currently, accessing a record is slow.  Consider this sample:

===File ~/src/guile-core/,,record-prof.scm==================
(use-modules (statprof)
             (srfi srfi-9))

(define-record-type <stuff>
  (make-stuff x y z)
  stuff?
  (x  stuff-x)
  (y  stuff-y)
  (z  stuff-z))

(define stuff (make-stuff 1 2 3))

(with-statprof #:hz 20 #:loop 1000000
  (stuff-x stuff))
============================================================

(SRFI-9 uses the record layer.)

Here is what we observe:

  $ ./pre-inst-guile ,,record-prof.scm
  %     cumulative   self             
  time   seconds     seconds      name
   33.33      2.95      0.98  #{statprof\ 0}#
   27.45      0.81      0.81  record-type-descriptor
   17.65      1.91      0.52  stuff-x
   15.69      1.39      0.46  %record-type-check
    3.92      0.93      0.12  eq?
    1.96      0.06      0.06  not
  ---
  Sample count: 51
  Total time: 2.95 seconds (9/25 seconds in GC)

Changing `record-accessor' as in the attached file yields this:

  $ ./pre-inst-guile ,,record-prof.scm
  %     cumulative   self             
  time   seconds     seconds      name
   46.88      1.89      0.89  #{statprof\ 0}#
   43.75      0.95      0.83  stuff-x
    6.25      0.12      0.12  eq?
    3.13      0.06      0.06  not
  ---
  Sample count: 32
  Total time: 1.89 seconds (1/5 seconds in GC)

A 36% improvement.

Type-safety is still guaranteed (e.g., `struct-vtable' will fail if OBJ
is not a struct), though not as precisely (e.g., instead of a
`not-a-record' error, we get a `wrong-type-arg' error in
`struct-vtable').  Thus, for instance, `srfi-9.test' will have to be
relaxed as to the exception type expected (which is reasonable anyway
since SRFI-9 does not specify error types).

I believe the improvement is worth the change, otherwise people may end
up using vectors or their own record abstraction.

Ok to commit?

Thanks,
Ludovic.

--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -429,7 +429,7 @@
 (define (record-predicate rtd)
   (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
 
-(define (%record-type-check rtd obj)  ;; private helper
+(define (%record-type-error rtd obj)  ;; private helper
   (or (eq? rtd (record-type-descriptor obj))
       (scm-error 'wrong-type-arg "%record-type-check"
                 "Wrong type record (want `~S'): ~S"
@@ -441,8 +441,9 @@
     (if (not pos)
        (error 'no-such-field field-name))
     (local-eval `(lambda (obj)
-                  (%record-type-check ',rtd obj)
-                  (struct-ref obj ,pos))
+                   (if (eq? (struct-vtable obj) ,rtd)
+                       (struct-ref obj ,pos)
+                       (%record-type-error ,rtd obj)))
                the-root-environment)))
 
 (define (record-modifier rtd field-name)
@@ -450,7 +451,8 @@
     (if (not pos)
        (error 'no-such-field field-name))
     (local-eval `(lambda (obj val)
-                  (%record-type-check ',rtd obj)
-                  (struct-set! obj ,pos val))
+                   (if (eq? (struct-vtable obj) ,rtd)
+                       (struct-set! obj ,pos val)
+                       (%record-type-error ,rtd obj)))
                the-root-environment)))