Fluidize (runtime load) exported variables: i.e. load/loading?...

and load/suppress-loading-message?.  Punted old load-noisily?.

diff --git a/doc/user-manual/user.texinfo b/doc/user-manual/user.texinfo
index 104dbfae87933ba597513bf409023ccbccbfb86e..919dd9cc201deb7b3c080183ad1054e29f5d94ec 100644 (file)
--- a/doc/user-manual/user.texinfo
+++ b/doc/user-manual/user.texinfo
@@ -1478,14 +1478,6 @@ pathname type @code{"com"}.  (See the description of
 Components of Pathnames, scheme, MIT/GNU Scheme Reference Manual}.)
 @end deffn
 
-@defvr variable load-noisily?
-If @code{load-noisily?} is set to @code{#t}, @code{load} will print the
-value of each expression in the file as it is evaluated.  Otherwise,
-nothing is printed except for the value of the last expression in the
-file.  (Note: the noisy loading feature is implemented for source-code
-files only.)
-@end defvr
-
 @cindex working directory
 @findex pwd
 @findex cd

diff --git a/src/6001/edextra.scm b/src/6001/edextra.scm
index b94bf89c1aa63c5f25efd7ac1e36bc0b7388790e..7aab858409e8cf0dbaca014ee7e9f5985083500b 100644 (file)
--- a/src/6001/edextra.scm
+++ b/src/6001/edextra.scm
@@ -296,8 +296,9 @@ Now, there is formatting stuff to be considered here, in print-pgm.sh.
                (groups/files-to-copy groups)))))
 
 (define (load-quietly pathname environment)
-  (fluid-let ((load/suppress-loading-message? #t))
-    (load pathname environment)))
+  (let-fluid load/suppress-loading-message? #t
+    (lambda ()
+      (load pathname environment))))
 
 (define (->string object)
   (if (string? object)

diff --git a/src/edwin/autold.scm b/src/edwin/autold.scm
index 0a66542903170c38a52e1e39577bafe7f13b8a74..fe13f358e041eeb33eb1f7ec5e1739e1b58f8fd7 100644 (file)
--- a/src/edwin/autold.scm
+++ b/src/edwin/autold.scm
@@ -206,10 +206,11 @@ Second arg is prefix arg when called interactively."
                         (bind-condition-handler (list condition-type:error)
                             evaluation-error-handler
                           (lambda ()
-                            (fluid-let ((load/suppress-loading-message? #t))
-                              ((message-wrapper #f "Loading " (car library))
-                               (lambda ()
-                                 (load-library library))))))))
+                            (let-fluid load/suppress-loading-message? #t
+                              (lambda ()
+                                ((message-wrapper #f "Loading " (car library))
+                                 (lambda ()
+                                   (load-library library)))))))))
                   (load-library library))))))
       (cond ((not (library-loaded? name))
             (do-it))
@@ -234,5 +235,6 @@ Second arg PURIFY? means purify the file's contents after loading;
      (bind-condition-handler (list condition-type:error)
         evaluation-error-handler
        (lambda ()
-        (fluid-let ((load/suppress-loading-message? #t))
-          (load filename environment 'DEFAULT purify?)))))))
\ No newline at end of file
+        (let-fluid load/suppress-loading-message? #t
+          (lambda ()
+            (load filename environment 'DEFAULT purify?))))))))
\ No newline at end of file

diff --git a/src/edwin/filcom.scm b/src/edwin/filcom.scm
index 53ebee4024fc3fb01489724dc964717eb155c952..7d1cd19aced15688293b69f493a334a1c5a728b4 100644 (file)
--- a/src/edwin/filcom.scm
+++ b/src/edwin/filcom.scm
@@ -218,8 +218,9 @@ procedures are called."
                    (lambda ()
                      (catch-file-errors (lambda (condition) condition #f)
                        (lambda ()
-                         (fluid-let ((load/suppress-loading-message? #t))
-                           (load pathname '(EDWIN)))))))))))
+                         (let-fluid load/suppress-loading-message? #t
+                           (lambda ()
+                             (load pathname '(EDWIN))))))))))))
          (if (and (procedure? database)
                   (procedure-arity-valid? database 1))
              (database buffer)

diff --git a/src/ffi/build.scm b/src/ffi/build.scm
index 63bd5a1461d6adab40df4c20f7fe9f3941c03c12..c5ce7312f7e88b375cb96eb8198dc994ccea0f8b 100644 (file)
--- a/src/ffi/build.scm
+++ b/src/ffi/build.scm
@@ -180,13 +180,15 @@ USA.
   (->namestring (system-library-directory-pathname)))
 
 (define (shim-conf)
-  (fluid-let ((load/suppress-loading-message? #t))
-    (load (system-library-pathname "shim-config.scm"))))
+  (let-fluid load/suppress-loading-message? #t
+    (lambda ()
+      (load (system-library-pathname "shim-config.scm")))))
 
 (define (doc-conf)
-  (fluid-let ((load/suppress-loading-message? #t))
-    (load (string-append (conf-value (shim-conf) 'INFODIR)
-                                    "mit-scheme-doc-config.scm"))))
+  (let-fluid load/suppress-loading-message? #t
+    (lambda ()
+      (load (string-append (conf-value (shim-conf) 'INFODIR)
+                          "mit-scheme-doc-config.scm")))))
 
 (define (conf-values conf name)
   (let ((entry (assq name conf)))

diff --git a/src/ffi/cdecls.scm b/src/ffi/cdecls.scm
index 417bb722d70b727630c79750f90520304d25429a..d334c16410257c9b860f38a8e2408036fbf96a6f 100644 (file)
--- a/src/ffi/cdecls.scm
+++ b/src/ffi/cdecls.scm
@@ -59,7 +59,7 @@ USA.
   ;; Toplevel entry point for the generator.
   ;; Returns a new C-INCLUDES structure.
   (let ((includes (make-c-includes library))
-       (cwd (if load/loading?
+       (cwd (if (fluid load/loading?)
                 (directory-pathname (current-load-pathname))
                 (working-directory-pathname))))
     (fluid-let ((c-include-noisily? #t))

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 0cae19f5d8c4f6cf7a1c1803010022e549ea0c61..e2155707838f3666525795b3d09e6dd137bc498f 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -553,8 +553,9 @@ USA.
 (define (load-ffi-quietly)
   (if (not (name->package '(FFI)))
       (let ((kernel (lambda ()
-                     (fluid-let ((load/suppress-loading-message? #t))
-                       (load-option 'FFI)))))
+                     (let-fluid load/suppress-loading-message? #t
+                       (lambda ()
+                         (load-option 'FFI))))))
        (if (nearest-cmdl/batch-mode?)
            (kernel)
            (with-notification (lambda (port)

diff --git a/src/runtime/load.scm b/src/runtime/load.scm
index d2bd605dafedec21955c1dd6dcb1e7fce612ca8d..210c45aa7e826302f675e9403a14d02825c918c1 100644 (file)
--- a/src/runtime/load.scm
+++ b/src/runtime/load.scm
@@ -34,6 +34,8 @@ USA.
   (set! condition-type:not-loading
        (make-condition-type 'NOT-LOADING condition-type:error '()
          "No file being loaded."))
+  (set! load/loading? (make-fluid #f))
+  (set! load/suppress-loading-message? (make-fluid #f))
   (set! load/after-load-hooks (make-fluid '()))
   (set! *eval-unit* (make-fluid #f))
   (set! *current-load-environment* (make-fluid 'NONE))
@@ -45,16 +47,13 @@ USA.
 
 (define load/loading?)
 (define load/after-load-hooks)
-(define load/suppress-loading-message? #f)
+(define load/suppress-loading-message?)
 (define *eval-unit*)
 (define *current-load-environment*)
 (define *write-notifications?*)
 
 (define *purification-root-marker*)
 (define condition-type:not-loading)
-
-;; Obsolete and ignored:
-(define load-noisily? #f)
 \f
 (define (load pathname #!optional environment syntax-table purify?)
   syntax-table                         ;ignored
@@ -77,7 +76,7 @@ USA.
 (define (load-1 pathname environment purify?)
   (receive (pathname* loader notifier) (choose-load-method pathname)
     (if pathname*
-       (maybe-notify load/suppress-loading-message?
+       (maybe-notify (fluid load/suppress-loading-message?)
                      (loader environment purify?)
                      notifier)
        (load-failure load-1 pathname environment purify?))))
@@ -229,7 +228,7 @@ USA.
 (define (maybe-notify suppress-notifications? loader notifier)
   (let ((notify?
         (if (if (default-object? suppress-notifications?)
-                load/suppress-loading-message?
+                (fluid load/suppress-loading-message?)
                 suppress-notifications?)
             #f
             (fluid *write-notifications?*))))
@@ -288,17 +287,17 @@ USA.
     thunk))
 
 (define (load/push-hook! hook)
-  (if (not load/loading?) (error condition-type:not-loading))
+  (if (not (fluid load/loading?)) (error condition-type:not-loading))
   (set-fluid! load/after-load-hooks (cons hook (fluid load/after-load-hooks)))
   unspecific)
 
 (define (handle-load-hooks thunk)
   (receive (result hooks)
-      (fluid-let ((load/loading? #t))
-       (let-fluid load/after-load-hooks '()
-         (lambda ()
-           (let ((result (thunk)))
-             (values result (reverse (fluid load/after-load-hooks)))))))
+      (let-fluids load/loading? #t
+                 load/after-load-hooks '()
+       (lambda ()
+         (let ((result (thunk)))
+           (values result (reverse (fluid load/after-load-hooks))))))
     (for-each (lambda (hook) (hook)) hooks)
     result))
 
@@ -684,8 +683,9 @@ ADDITIONAL OPTIONS supported by this band:\n")
     (lambda (arg)
       (run-in-nearest-repl
        (lambda (repl)
-        (fluid-let ((load/suppress-loading-message? (cmdl/batch-mode? repl)))
-          (load arg (repl/environment repl))))))
+        (let-fluid load/suppress-loading-message? (cmdl/batch-mode? repl)
+          (lambda ()
+            (load arg (repl/environment repl)))))))
     "Loads the argument files as if in the REPL."
     "In batch mode, loading messages are suppressed.")
   (argument-command-line-parser "eval" #t

diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index 561c44ef09c9afaf787739a60208485edb0dcbab..980ade71ec3f0a370076c1adce014cd1e14f95ba 100644 (file)
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -48,8 +48,9 @@ USA.
          (lambda ()
            (fluid-let ((*options* '())
                        (*parent* #f))
-             (fluid-let ((load/suppress-loading-message? #t))
-               (load pathname (make-load-environment)))
+             (let-fluid load/suppress-loading-message? #t
+               (lambda ()
+                 (load pathname (make-load-environment))))
              (values *options* *parent*)))
        find-option))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 17a4521c3a0a7802d406c01d6bfdef86191d9567..47aade8a68a864a501ac66d1aff2280afce56987 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2766,7 +2766,6 @@ USA.
          file-loadable?
          load
          load-library-object-file
-         load-noisily?
          load/loading?
          load/purification-root
          load/push-hook!

diff --git a/src/ssp/xhtml-expander.scm b/src/ssp/xhtml-expander.scm
index 4c6680105307069e7292792239dfa1e82abe48f8..5006dde61a88b62f1366fbd03cce8cf946fe00bd 100644 (file)
--- a/src/ssp/xhtml-expander.scm
+++ b/src/ssp/xhtml-expander.scm
@@ -94,15 +94,16 @@ USA.
     environment))
 
 (define ((pi-expander environment) text)
-  (fluid-let ((*outputs* (cons '() '()))
-             (load/suppress-loading-message? #t))
-    (let ((port (open-input-string text)))
-      (let loop ()
-       (let ((expression (read port)))
-         (if (not (eof-object? expression))
-             (begin
-               (expander-eval expression environment)
-               (loop))))))
+  (fluid-let ((*outputs* (cons '() '())))
+    (let-fluid load/suppress-loading-message? #t
+      (lambda ()
+       (let ((port (open-input-string text)))
+         (let loop ()
+           (let ((expression (read port)))
+             (if (not (eof-object? expression))
+                 (begin
+                   (expander-eval expression environment)
+                   (loop))))))))
     (car *outputs*)))
 
 (define expander-eval eval)

diff --git a/src/ssp/xmlrpc.scm b/src/ssp/xmlrpc.scm
index 6226135dec373ffbb60fbb3c724871ba53fe49ef..15c813d05b1ef66ca642e1ae976b97f457b61588 100644 (file)
--- a/src/ssp/xmlrpc.scm
+++ b/src/ssp/xmlrpc.scm
@@ -63,6 +63,7 @@ USA.
       (environment-define environment 'define-xmlrpc-method
        (lambda (name handler)
          (hash-table/put! methods name handler)))
-      (fluid-let ((load/suppress-loading-message? #t))
-       (load pathname environment)))
+      (let-fluid load/suppress-loading-message? #t
+       (lambda ()
+         (load pathname environment))))
     (hash-table/get methods name #f)))
\ No newline at end of file

diff --git a/tests/ffi/test-ffi.scm b/tests/ffi/test-ffi.scm
index df6a3bed87b981a4dd22472e2e23bab0897353fd..717aa47a6ffefb151c64f5cf87177a02e6a6b261 100644 (file)
--- a/tests/ffi/test-ffi.scm
+++ b/tests/ffi/test-ffi.scm
@@ -39,8 +39,9 @@ USA.
                          (notification-output-port))
            (error "Test FFI build failed:" status))
          (begin
-           (fluid-let ((load/suppress-loading-message? #t))
-             (load-option 'FFI))
+           (let-fluid load/suppress-loading-message? #t
+             (lambda ()
+               (load-option 'FFI)))
            (with-system-library-directories '("./")
              (lambda ()
                (compile-file "test-ffi-wrapper")))