From 78d5edb8ed13252cb48998cbdc76a19a73413019 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 3 Apr 2011 21:14:59 +0000 Subject: [PATCH] Use a (hidden) top-level variable for tag in structure predicates. This allows the predicates to be usefully integrated. Integrating the predicate and guarantor, and ignoring reference traps to the tag, measurably improves performance at least of contrived programs. --- src/runtime/defstr.scm | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm index eabad85a3..166836efd 100644 --- a/src/runtime/defstr.scm +++ b/src/runtime/defstr.scm @@ -781,15 +781,18 @@ differences: (close (structure/tag-expression structure) context))) (case (structure/physical-type structure) ((RECORD) - `((DEFINE ,predicate-name - (LET ((TAG - (,(absolute 'RECORD-TYPE-DISPATCH-TAG context) - ,tag-expression))) - (NAMED-LAMBDA (,predicate-name OBJECT) - (AND (,(absolute '%RECORD? context) OBJECT) - (,(absolute 'EQ? context) - (,(absolute '%RECORD-REF context) OBJECT 0) - TAG))))))) + (let ((tag-name (make-synthetic-identifier 'TAG))) + `((DEFINE ,tag-name + (,(absolute 'RECORD-TYPE-DISPATCH-TAG context) + ,tag-expression)) + (DEFINE (,predicate-name OBJECT) + (DECLARE + (IGNORE-REFERENCE-TRAPS (SET ,(close tag-name context)))) + (AND (,(absolute '%RECORD? context) OBJECT) + (,(absolute 'EQ? context) + (,(absolute '%RECORD-REF context) OBJECT 0) + ;++ Work around a bug in the expander. + ,(close tag-name context))))))) ((VECTOR) `((DEFINE (,predicate-name OBJECT) (AND (,(absolute 'VECTOR? context) OBJECT) -- 2.25.1