Fix classic bug: incorrect interaction between stream and side-effect.

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index 2c3b6c9a5460be395aacfe7c0a5e564f0ff23241..87e3f9eee56b7345fbbe93cb82d7a53886dad986 100644 (file)
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.8 1989/08/17 14:51:08 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.9 1989/08/17 16:02:55 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -144,6 +144,20 @@ MIT in each case. |#
 (define default-object
   "default-object")
 
+(define (find-true-pathname pathname default-types)
+  (or (let ((try
+            (lambda (pathname)
+              (pathname->input-truename
+               (pathname-default-version pathname 'NEWEST)))))
+       (if (pathname-type pathname)
+           (try pathname)
+           (or (pathname->input-truename pathname)
+               (let loop ((types default-types))
+                 (and (not (null? types))
+                      (or (try (pathname-new-type pathname (car types)))
+                          (loop (cdr types))))))))
+      (error "No such file" pathname)))
+\f
 (define (load/internal pathname true-pathname environment syntax-table
                       purify? load-noisily?)
   (let ((true-filename (pathname->string true-pathname)))
@@ -167,29 +181,16 @@ MIT in each case. |#
                 (nearest-repl/environment)
                 environment)))
          (let ((value-stream
-                (eval-stream (read-stream port) environment syntax-table)))
+                (lambda ()
+                  (eval-stream (read-stream port) environment syntax-table))))
            (if load-noisily?
-               (write-stream value-stream
+               (write-stream (value-stream)
                              (lambda (value)
                                (hook/repl-write (nearest-repl) value)))
                (loading-message load/suppress-loading-message? true-filename
                  (lambda ()
-                   (write-stream value-stream
+                   (write-stream (value-stream)
                                  (lambda (value) value false))))))))))
-\f
-(define (find-true-pathname pathname default-types)
-  (or (let ((try
-            (lambda (pathname)
-              (pathname->input-truename
-               (pathname-default-version pathname 'NEWEST)))))
-       (if (pathname-type pathname)
-           (try pathname)
-           (or (pathname->input-truename pathname)
-               (let loop ((types default-types))
-                 (and (not (null? types))
-                      (or (try (pathname-new-type pathname (car types)))
-                          (loop (cdr types))))))))
-      (error "No such file" pathname)))
 (define (read-stream port)
   (parse-objects port
                 (current-parser-table)

diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm
index 5256f0981b53e741aea11fae2672bb6a3a1be85f..131f83171910b5d176a24da87d096f085dea4fed 100644 (file)
--- a/v8/src/runtime/load.scm
+++ b/v8/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.8 1989/08/17 14:51:08 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.9 1989/08/17 16:02:55 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -144,6 +144,20 @@ MIT in each case. |#
 (define default-object
   "default-object")
 
+(define (find-true-pathname pathname default-types)
+  (or (let ((try
+            (lambda (pathname)
+              (pathname->input-truename
+               (pathname-default-version pathname 'NEWEST)))))
+       (if (pathname-type pathname)
+           (try pathname)
+           (or (pathname->input-truename pathname)
+               (let loop ((types default-types))
+                 (and (not (null? types))
+                      (or (try (pathname-new-type pathname (car types)))
+                          (loop (cdr types))))))))
+      (error "No such file" pathname)))
+\f
 (define (load/internal pathname true-pathname environment syntax-table
                       purify? load-noisily?)
   (let ((true-filename (pathname->string true-pathname)))
@@ -167,29 +181,16 @@ MIT in each case. |#
                 (nearest-repl/environment)
                 environment)))
          (let ((value-stream
-                (eval-stream (read-stream port) environment syntax-table)))
+                (lambda ()
+                  (eval-stream (read-stream port) environment syntax-table))))
            (if load-noisily?
-               (write-stream value-stream
+               (write-stream (value-stream)
                              (lambda (value)
                                (hook/repl-write (nearest-repl) value)))
                (loading-message load/suppress-loading-message? true-filename
                  (lambda ()
-                   (write-stream value-stream
+                   (write-stream (value-stream)
                                  (lambda (value) value false))))))))))
-\f
-(define (find-true-pathname pathname default-types)
-  (or (let ((try
-            (lambda (pathname)
-              (pathname->input-truename
-               (pathname-default-version pathname 'NEWEST)))))
-       (if (pathname-type pathname)
-           (try pathname)
-           (or (pathname->input-truename pathname)
-               (let loop ((types default-types))
-                 (and (not (null? types))
-                      (or (try (pathname-new-type pathname (car types)))
-                          (loop (cdr types))))))))
-      (error "No such file" pathname)))
 (define (read-stream port)
   (parse-objects port
                 (current-parser-table)