From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Tue, 4 Feb 2014 21:07:55 +0000 (-0700)
Subject: Fluidize (runtime compiler-info) internal directory-rewriting-rules.
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~18
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5cf14f45c6994fecfb2f2b7757cad24abc9e6af2;p=mit-scheme.git

Fluidize (runtime compiler-info) internal directory-rewriting-rules.
---

diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm
index 2330dfe80..75b387900 100644
--- a/src/runtime/infutl.scm
+++ b/src/runtime/infutl.scm
@@ -37,6 +37,7 @@ USA.
 	  (,lambda-tag:internal-lexpr . LAMBDA)
 	  (,lambda-tag:let . LET)
 	  (,lambda-tag:fluid-let . FLUID-LET)))
+  (set! directory-rewriting-rules (make-fluid '()))
   (add-secondary-gc-daemon! discard-debugging-info!)
   (initialize-uncompressed-files!)
   (add-event-receiver! event:after-restore initialize-uncompressed-files!)
@@ -219,33 +220,32 @@ USA.
 		 (pathname=? (debugging-wrapper/pathname wrapper) pathname))
 	    (set-debugging-wrapper/pathname! wrapper pathname*))))))
 
-(define directory-rewriting-rules
-  '())
+(define directory-rewriting-rules)
 
 (define (with-directory-rewriting-rule match replace thunk)
-  (fluid-let ((directory-rewriting-rules
-	       (cons (cons (pathname-as-directory (merge-pathnames match))
-			   replace)
-		     directory-rewriting-rules)))
-    (thunk)))
+  (let-fluid directory-rewriting-rules
+	     (cons (cons (pathname-as-directory (merge-pathnames match))
+			 replace)
+		   (fluid directory-rewriting-rules))
+    thunk))
 
 (define (add-directory-rewriting-rule! match replace)
   (let ((match (pathname-as-directory (merge-pathnames match))))
     (let ((rule
-	   (list-search-positive directory-rewriting-rules
+	   (list-search-positive (fluid directory-rewriting-rules)
 	     (lambda (rule)
 	       (equal? (pathname-directory (car rule))
 		       (pathname-directory match))))))
       (if rule
 	  (set-cdr! rule replace)
-	  (set! directory-rewriting-rules
-		(cons (cons match replace)
-		      directory-rewriting-rules)))))
+	  (set-fluid! directory-rewriting-rules
+		      (cons (cons match replace)
+			    (fluid directory-rewriting-rules))))))
   unspecific)
 
 (define (rewrite-directory pathname)
   (let ((rule
-	 (list-search-positive directory-rewriting-rules
+	 (list-search-positive (fluid directory-rewriting-rules)
 	   (lambda (rule)
 	     (directory-prefix? (pathname-directory pathname)
 				(pathname-directory (car rule)))))))