summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-13 00:16:44 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-13 00:16:44 +0100
commit34898db352d020fcf5d9a37abafe2f160b57039f (patch)
treecae55da041e113ecf3c0e9921d42d79df5ac238b
parentd9d671f76e0a77dfc643e487fa8d7db6be139366 (diff)
downloadguile-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.scm8
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