Change `load' to interact better with Emacs interface. Dissect REP

loop slightly to allow its parts to be used independently by `load'.
Now whenever `load' prints a value it is also entered in the REP
printer history.  Also, the value of the last file loaded is returned
to the REP loop as the value of the `load' expression.

All of this is useful for allowing Emacs to use `load' for zapping.
Now, zapping from a file is more or less equivalent to zapping through
a pipe.  Before, there were significant differences, especially
noticeable in interaction with the printer history.

diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 169b1f5d82b603aa6edafc523855800ccd69a311..9908b83f16c67b28fe475e8c0064576a724eb5ef 100644 (file)
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 13.50 1987/07/24 22:11:16 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 13.51 1988/04/26 19:41:49 cph Exp $
 ;;;
-;;;    Copyright (c) 1987 Massachusetts Institute of Technology
+;;;    Copyright (c) 1988 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -443,74 +443,89 @@
   (and ((access :char-ready? port) 0)
        (read-char port)))
 \f
-(define load)
-(define load-noisily)
-(define load-noisily? false)
+(define load/default-types '("bin" "scm"))
+(define load-noisily? true)
+
+(define (load-noisily filename #!optional environment)
+  (let ((environment
+        (if (unassigned? environment) (rep-environment) environment)))
+    (fluid-let ((load-noisily? true))
+      (load filename environment))))
+
 (define read-file)
+(define load)
 (let ()
 
-(define default-pathname
-  (make-pathname false false false false 'NEWEST))
+(set! read-file
+  (named-lambda (read-file filename)
+    (call-with-input-file
+       (pathname-default-version (->pathname filename) 'NEWEST)
+      (access *parse-objects-until-eof parser-package))))
 
 ;;; This crufty piece of code, once it decides which file to load,
 ;;; does `file-exists?' on that file at least three times!!
 
-(define (basic-load filename environment)
-  (define (kernel pathname)
-    (let ((pathname
-          (or (pathname->input-truename pathname)
-              (let ((pathname (merge-pathnames pathname default-pathname)))
-                  (if (pathname-type pathname)
-                      (pathname->input-truename pathname)
-                      (or (pathname->input-truename
-                           (pathname-new-type pathname "bin"))
-                          (pathname->input-truename
-                           (pathname-new-type pathname "scm")))))
-              (error "No such file" pathname))))
-      (if (call-with-input-file pathname
-           (lambda (port)
-             (= 250 (char->ascii (peek-char port)))))
-         (scode-load pathname)
-         (sexp-load pathname))))
-
-  (define (sexp-load filename)
-    (call-with-input-file filename
-      (lambda (port)
-       (define (load-loop previous-object)
-         (let ((object (read port)))
-           (if (eof-object? object)
-               previous-object
-               (let ((value (eval object environment)))
-                 (if load-noisily? (begin (newline) (write value)))
-                 (load-loop value)))))
-       (load-loop *the-non-printing-object*))))
-
-  (define (scode-load filename)
-    (scode-eval (fasload filename) environment))
-
-  (for-each kernel (stickify-input-filenames filename false)))
-\f
 (set! load
-  (named-lambda (load filename #!optional environment)
-    (if (unassigned? environment) (set! environment (rep-environment)))
-    (basic-load filename environment)))
-
-(set! load-noisily
-  (named-lambda (load-noisily filename #!optional environment)
-    (if (unassigned? environment) (set! environment (rep-environment)))
-    (fluid-let ((load-noisily? true))
-      (basic-load filename environment))))
+  (named-lambda (load filename/s #!optional environment)
+    (let ((environment
+          (if (unassigned? environment) (rep-environment) environment)))
+      (let ((kernel
+            (lambda (filename last-file?)
+              (let ((value
+                     (load/internal (find-true-filename (->pathname filename)
+                                                        load/default-types)
+                                    environment
+                                    load-noisily?)))
+                (cond (last-file? value)
+                      (load-noisily? (rep-value value)))))))
+       (if (pair? filename/s)
+           (let loop ((filenames filename/s))
+             (if (null? (cdr filenames))
+                 (kernel (car filenames) true)
+                 (begin (kernel (car filenames) false)
+                        (loop (cdr filenames)))))
+           (kernel filename/s true))))))
+\f
+(define (load/internal true-filename environment load-noisily?)
+  (let ((port (open-input-file true-filename)))
+    (if (= 250 (char->ascii (peek-char port)))
+       (begin (close-input-port port)
+              (scode-eval (fasload true-filename) environment))
+       (let ((syntax-table (rep-syntax-table))
+             (no-value "no value"))
+         (let load-loop ((value no-value))
+           (let ((s-expression (read port)))
+             (if (eof-object? s-expression)
+                 (begin (close-input-port port)
+                        value)
+                 (begin (if (and load-noisily? (not (eq? no-value value)))
+                            (rep-value value))
+                        (load-loop (rep-eval-hook s-expression
+                                                  environment
+                                                  syntax-table))))))))))
+
+(define (find-true-filename pathname default-types)
+  (pathname->string
+   (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 (pathname-default-version pathname version)
+  (if (pathname-version pathname)
+      pathname
+      (pathname-new-version pathname version)))
 
-(set! read-file
-  (named-lambda (read-file filename)
-    (let ((name (pathname->input-truename
-                (merge-pathnames (->pathname filename) default-pathname))))
-      (if name
-         (call-with-input-file name
-           (access *parse-objects-until-eof parser-package))
-         (error "Read-file: No such file" name)))))
 )
-
+\f
 (define (stickify-input-filenames filename/s default-pathname)
   (map (if default-pathname
           (lambda (filename)

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index e1131e7b4dbd8a252e00cf3ec3f494030f5b9a59..4e174feee4a33bf55488866603f5847450d6318e 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 13.43 1987/12/05 16:39:25 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 13.44 1988/04/26 19:41:15 cph Exp $
 ;;;
-;;;    Copyright (c) 1987 Massachusetts Institute of Technology
+;;;    Copyright (c) 1988 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -229,6 +229,8 @@
 
 (define make-rep)
 (define push-rep)
+(define rep-eval-hook)
+(define rep-value)
 (define reader-history)
 (define printer-history)
 (let ()
@@ -268,18 +270,22 @@
 
 (define (rep-driver state)
   (*rep-current-prompt*)
-  (let ((object
-        (let ((scode
-               (let ((s-expression (rep-read-hook)))
-                 (record-in-history! (rep-state-reader-history state)
-                                     s-expression)
-                 (syntax s-expression *rep-current-syntax-table*))))
-          (with-new-history
-           (lambda ()
-             (scode-eval scode *rep-current-environment*))))))
-    (record-in-history! (rep-state-printer-history state) object)
-    (rep-value-hook object))
+  (rep-value (rep-eval-hook (rep-read-hook)
+                           *rep-current-environment*
+                           *rep-current-syntax-table*))
   state)
+
+(set! rep-eval-hook
+  (named-lambda (rep-eval-hook s-expression environment syntax-table)
+    (record-in-history! (rep-state-reader-history (rep-state)) s-expression)
+    (with-new-history
+     (let ((scode (syntax s-expression syntax-table)))
+       (lambda () (scode-eval scode environment))))))
+
+(set! rep-value
+  (named-lambda (rep-value object)
+    (record-in-history! (rep-state-printer-history (rep-state)) object)
+    (rep-value-hook object)))
 \f
 ;;; History Manipulation