From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 3 Apr 2011 21:14:59 +0000 (+0000)
Subject: Use a (hidden) top-level variable for tag in structure predicates.
X-Git-Tag: 20110426-Gtk~2^2~20
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=78d5edb8ed13252cb48998cbdc76a19a73413019;p=mit-scheme.git

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 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)