From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sat, 8 Feb 2014 17:32:18 +0000 (-0700)
Subject: Fluidize (runtime structure-parser) internal variable name-counters.
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~8
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b51d9193a7aa9dea301cde6c1e27b1f9c8a4a7b3;p=mit-scheme.git

Fluidize (runtime structure-parser) internal variable name-counters.
---

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 89da4b8dc..32191c2c3 100644
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -545,6 +545,7 @@ USA.
    (OPTIONAL (RUNTIME WIN32-REGISTRY))
    (OPTIONAL (RUNTIME FFI))
    (RUNTIME SAVE/RESTORE)
+   (RUNTIME STRUCTURE-PARSER)
    (RUNTIME SWANK)
    (RUNTIME STACK-SAMPLER)))
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 6e6a40109..f7214dc02 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5961,7 +5961,8 @@ USA.
 	  structure-parser-values-length
 	  structure-parser-values-ref
 	  structure-parser-values?
-	  vector-parser))
+	  vector-parser)
+  (initialization (initialize-package!)))
 
 (define-package (runtime postgresql)
   (file-case options
diff --git a/src/runtime/structure-parser.scm b/src/runtime/structure-parser.scm
index 964e2ba43..1a8fcff3e 100644
--- a/src/runtime/structure-parser.scm
+++ b/src/runtime/structure-parser.scm
@@ -82,9 +82,10 @@ USA.
 ;;;; Compiler
 
 (define (compile-top-level pattern caller-context env)
-  (fluid-let ((name-counters (make-strong-eq-hash-table)))
-    (optimize-result
-     (compile-pattern pattern caller-context env))))
+  (let-fluid name-counters (make-strong-eq-hash-table)
+    (lambda ()
+      (optimize-result
+       (compile-pattern pattern caller-context env)))))
 
 (define (compile-pattern pattern caller-context env)
   (let ((pattern* (rewrite-pattern pattern)))
@@ -776,12 +777,16 @@ USA.
 (define (call-with-new-names names procedure)
   (apply procedure
 	 (map (lambda (name)
-		(let ((n (hash-table-ref/default name-counters name 0)))
-		  (hash-table-set! name-counters name (+ n 1))
+		(let* ((t (fluid name-counters))
+		       (n (hash-table-ref/default t name 0)))
+		  (hash-table-set! t name (+ n 1))
 		  (symbol name '. n)))
 	      names)))
 
 (define name-counters)
+
+(define (initialize-package!)
+  (set! name-counters (make-fluid unspecific)))
 
 ;;;; Optimizer