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

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 89da4b8dc95e9c6e7d4c8ec00b33fe6b303b3bd0..32191c2c356d30ecb22c438bcf452cdb3df96768 100644 (file)
--- 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)))
 \f

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 6e6a40109da987869cc3c9bf046850cf35edc3b4..f7214dc0232b00bc68d4e5bc55c029a36c355e46 100644 (file)
--- 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 964e2ba43d142019a7041c795c24a6e899d0bfb3..1a8fcff3eac02143476a5d1fc8e0e0e16639fc7f 100644 (file)
--- 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)))
 \f
 ;;;; Optimizer