Hacked file-loading code so that we could load from ports. This to support

the new -s- switch.
This commit is contained in:
shivers 1996-08-30 07:15:14 +00:00
parent 0d7befeb82
commit d8d1758d11
9 changed files with 818 additions and 770 deletions

View File

@ -38,6 +38,10 @@
p filename run p filename run
noisy?)) noisy?))
(define (compile-and-run-port port p run noisy?)
(compile-and-run-scanned-forms (really-scan-port port p)
p #f run noisy?))
; -------------------- ; --------------------
; If non-noisy, this tail-recurs to last form. ; If non-noisy, this tail-recurs to last form.

View File

@ -40,29 +40,40 @@
(define (scan-file pathname p . env-option) (define (scan-file pathname p . env-option)
(apply really-scan-file pathname p (current-output-port) env-option)) (apply really-scan-file pathname p (current-output-port) env-option))
(define (really-scan-file pathname p noise . env-option) (define (really-scan-port port p . env-option) ; For scsh
(let* ((env (if (null? env-option) (let* ((env (if (null? env-option)
(package->environment p) (package->environment p)
(car env-option))) (car env-option)))
(filename (namestring pathname #f *scheme-file-type*)) (reader (environment-reader env)))
(truename (translate filename))) (let recur ()
(let ((form (reader port)))
(if (eof-object? form)
'()
(append (scan-form form p env)
(recur)))))))
(define (really-scan-file pathname p noise . env-option)
(let* ((env (if (null? env-option)
(package->environment p)
(car env-option)))
(filename (namestring pathname #f *scheme-file-type*))
(truename (translate filename)))
(call-with-input-file truename (call-with-input-file truename
(lambda (port) (lambda (port)
(if filename ((fluid $note-file-package) filename p)) (if filename ((fluid $note-file-package) filename p))
(let ((env (bind-source-file-name filename env)) (let ((env (bind-source-file-name filename env))
(reader (environment-reader env))) (reader (environment-reader env)))
(cond (noise (display truename noise) (cond (noise (display truename noise)
(force-output noise))) (force-output noise)))
(let ((result (let recur () (let ((result (let recur ()
(let ((form (read port))) (let ((form (read port)))
(if (eof-object? form) (if (eof-object? form)
'() '()
(append (scan-form form p env) (append (scan-form form p env)
(recur))))))) (recur)))))))
(cond (noise (display #\space noise) (cond (noise (display #\space noise)
(force-output noise))) (force-output noise)))
result)))))) result))))))
; -------------------- ; --------------------
; Process a list of forms. ; Process a list of forms.

View File

@ -85,7 +85,20 @@
(eval form env) (eval form env)
(loop)))))))) (loop))))))))
(define load-quietly load-into) ; For scsh. ;;; For scsh.
;;; Identical to LOAD-INTO, but accepts either a filename or port.
(define (load-quietly from env)
(let ((doit (lambda (port)
(let loop ()
(let ((form (read port)))
(cond ((eof-object? form))
(else
(eval form env)
(loop))))))))
(if (input-port? from) (doit from)
(call-with-input-file from doit))))
(define (eval-from-file forms env filename) (define (eval-from-file forms env filename)
(for-each (lambda (form) (eval form env)) forms)) (for-each (lambda (form) (eval form env)) forms))

View File

@ -245,11 +245,15 @@
(package->environment package) (package->environment package)
filename)) filename))
(define (load-quietly filename package) (define (load-quietly from package) ; No noise. For scsh.
(eval-nodes (really-scan-file filename package #f) ; No noise. For scsh. (display from)
(package->environment package) (if (string? from)
filename)) (eval-nodes (really-scan-file from package #f)
(package->environment package)
from)
(eval-nodes (really-scan-port from package)
(package->environment package)
#f)))
(define (eval-from-file forms p file) ;Scheme 48 internal thing (define (eval-from-file forms p file) ;Scheme 48 internal thing
(eval-forms forms p file)) (eval-forms forms p file))

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -732,6 +732,7 @@
(export scan-forms (export scan-forms
scan-file scan-file
really-scan-file really-scan-file
really-scan-port ; for scsh
scan-structures ;load-package.scm, link/link.scm scan-structures ;load-package.scm, link/link.scm
really-scan-structures really-scan-structures
scan-package scan-package
@ -762,6 +763,7 @@
(define-interface compiler-interface (define-interface compiler-interface
(export compile (export compile
compile-and-run-file ;for LOAD compile-and-run-file ;for LOAD
compile-and-run-port ;for LOAD (in scsh)
compile-and-run-forms ;for EVAL compile-and-run-forms ;for EVAL
compile-and-run-scanned-forms ;for eval.scm / ensure-loaded compile-and-run-scanned-forms ;for eval.scm / ensure-loaded
compile-file ;link/link.scm compile-file ;link/link.scm

View File

@ -25,11 +25,12 @@
; For scsh. ; For scsh.
(define (load-quietly filename p) (define (load-quietly from p)
(compile-and-run-file filename p ((if (string? from) compile-and-run-file compile-and-run-port)
(lambda (template) from p
(invoke-template template p)) (lambda (template)
#f)) (invoke-template template p))
#f))
; Evaluate forms as if they came from the given file. ; Evaluate forms as if they came from the given file.

View File

@ -45,6 +45,7 @@
;;; Terminating switches: ;;; Terminating switches:
;;; -c <exp> Eval <exp>, then exit. ;;; -c <exp> Eval <exp>, then exit.
;;; -s <script> Specify <script> to be loaded by a -ds or -dm. ;;; -s <script> Specify <script> to be loaded by a -ds or -dm.
;;; -s- Script is standard input.
;;; -- Interactive scsh. ;;; -- Interactive scsh.
@ -53,8 +54,10 @@
;;; - We first expand out any initial \ <filename> meta-arg. ;;; - We first expand out any initial \ <filename> meta-arg.
;;; - A switch-list elt is either "-ds", "-dm", or a (switch . arg) pair ;;; - A switch-list elt is either "-ds", "-dm", or a (switch . arg) pair
;;; for a -o, -n, -m, -l, or -lm switch. ;;; for a -o, -n, -m, -l, or -lm switch.
;;; - Terminating switch is one of {s, c, #f} for -s, -c, and -- respectively. ;;; - Terminating switch is one of {s, c, #f} for -s or -s-, -c,
;;; - Terminating arg is the <exp> arg to -c, the <script> arg to -s, otw #f. ;;; and -- respectively.
;;; - Terminating arg is the <exp> arg to -c, the <script> arg to -s,
;;; the standard input port for -s-, otw #f.
;;; - top-entry is the <entry> arg to a -e; #f if none. ;;; - top-entry is the <entry> arg to a -e; #f if none.
;;; - command-line args are what's left over after picking off the scsh ;;; - command-line args are what's left over after picking off the scsh
;;; switches. ;;; switches.
@ -80,6 +83,10 @@
(values (reverse switches) 's (car args) (values (reverse switches) 's (car args)
top-entry (cdr args)))) top-entry (cdr args))))
((string=? arg "-s-")
(values (reverse switches) 's (current-input-port)
top-entry args))
((string=? arg "--") ((string=? arg "--")
(if need-script? (if need-script?
(bad-arg "-ds or -dm switch requires -s <script>") (bad-arg "-ds or -dm switch requires -s <script>")
@ -280,9 +287,10 @@ switch: -e <entry-point> Specify top-level entry point.
-ds Do script. -ds Do script.
-dm Do script module. -dm Do script module.
end-option: -s <script> end-option: -s <script> Specify script.
-c <exp> -s- Script is standard input.
-- -c <exp> Evaluate expression.
-- Interactive session.
")) "))
(exit -1)) (exit -1))