From a3f6e3e039769fc7438b5a0be28f6e90f0e80d0b Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 12 Mar 2008 18:12:57 -0400
Subject: [PATCH] Cut down bootstrap time by 10% by caching the values of
 scheme-stx. Macroexpansion time is reduced by 25%.

---
 scheme/last-revision       |  2 +-
 scheme/psyntax.expander.ss | 29 ++++++++++++++++++-----------
 2 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/scheme/last-revision b/scheme/last-revision
index 26e58c7..5b23536 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1411
+1412
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 9c787a0..78b6b76 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -811,19 +811,26 @@
   ;;; (psyntax system $all) library, it creates a fresh identifier
   ;;; that maps only the symbol to its label in that library.
   ;;; Symbols not in that library become fresh.
+  (define scheme-stx-hashtable (make-eq-hashtable))
   (define scheme-stx
     (lambda (sym)
-      (let ((subst
-             (library-subst
-               (find-library-by-name '(psyntax system $all)))))
-        (cond
-          ((assq sym subst) =>
-           (lambda (x)
-             (let ((name (car x)) (label (cdr x)))
-               (add-subst
-                 (make-rib (list name) (list top-mark*) (list label) #f)
-                 (mkstx sym top-mark* '() '())))))
-          (else (mkstx sym top-mark* '() '()))))))
+      (or (hashtable-ref scheme-stx-hashtable sym #f) 
+          (let* ((subst
+                  (library-subst
+                    (find-library-by-name '(psyntax system $all))))
+                 (stx (mkstx sym top-mark* '() '()))
+                 (stx
+                  (cond
+                    ((assq sym subst) =>
+                     (lambda (x)
+                       (let ((name (car x)) (label (cdr x)))
+                         (add-subst
+                           (make-rib (list name) 
+                             (list top-mark*) (list label) #f)
+                           stx))))
+                    (else stx))))
+            (hashtable-set! scheme-stx-hashtable sym stx)
+            stx))))
 
   ;;; macros
   (define lexical-var car)