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)))
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel
