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.

diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm
index eabad85a31fa74361aa4044b3687498027fd4b9a..166836efdc11c332ca6073426bc191d7d962ab12 100644 (file)
--- 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)