diff options
author | Andy Wingo <wingo@pobox.com> | 2009-02-13 00:16:44 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-02-13 00:16:44 +0100 |
commit | 34898db352d020fcf5d9a37abafe2f160b57039f (patch) | |
tree | cae55da041e113ecf3c0e9921d42d79df5ac238b | |
parent | d9d671f76e0a77dfc643e487fa8d7db6be139366 (diff) | |
download | guile-34898db352d020fcf5d9a37abafe2f160b57039f.tar.gz |
inline record predicates into record-case
* module/system/base/syntax.scm (record-case): Inline record predicates
into the record-case. Shaves off a few more milliseconds from a GOOPS
load.
-rw-r--r-- | module/system/base/syntax.scm | 8 |
1 files changed, 5 insertions, 3 deletions
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index 67bcdb61b..0fe8a4ddf 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -165,7 +165,8 @@ (define-macro (record-case record . clauses) - (let ((r (gensym))) + (let ((r (gensym)) + (rtd (gensym))) (define (process-clause clause) (if (eq? (car clause) 'else) clause @@ -173,14 +174,15 @@ (slots (cdar clause)) (body (cdr clause))) (let ((stem (symbol-trim-both record-type (list->char-set '(#\< #\>))))) - `((,(symbol-append stem '?) ,r) + `((eq? ,rtd ,record-type) (let ,(map (lambda (slot) (if (pair? slot) `(,(car slot) (,(symbol-append stem '- (cadr slot)) ,r)) `(,slot (,(symbol-append stem '- slot) ,r)))) slots) ,@body)))))) - `(let ((,r ,record)) + `(let* ((,r ,record) + (,rtd (struct-vtable ,r))) (cond ,@(let ((clauses (map process-clause clauses))) (if (assq 'else clauses) clauses |