From 450aeea15d986efde6107565278fc436e53dff32 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 20 Dec 1999 23:11:01 +0000 Subject: [PATCH] Eliminate instances of WRITE-LINE. --- v7/src/compiler/base/debug.scm | 19 +++++++++---- v7/src/compiler/etc/comcmp.scm | 6 ++-- v7/src/runtime/debug.scm | 6 ++-- v7/src/runtime/load.scm | 50 +++++++++++++++++----------------- 4 files changed, 46 insertions(+), 35 deletions(-) diff --git a/v7/src/compiler/base/debug.scm b/v7/src/compiler/base/debug.scm index 4b57b2a06..0f915c329 100644 --- a/v7/src/compiler/base/debug.scm +++ b/v7/src/compiler/base/debug.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: debug.scm,v 4.14 1999/01/02 06:06:43 cph Exp $ +$Id: debug.scm,v 4.15 1999/12/20 23:07:24 cph Exp $ Copyright (c) 1988, 1989, 1990, 1999 Massachusetts Institute of Technology @@ -25,7 +25,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (po object) (let ((object (->tagged-vector object))) - (write-line object) + (newline) + (write object) (for-each pp ((tagged-vector/description object) object)))) (define (debug/find-procedure name) @@ -50,17 +51,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (debug/find-entry-node node) (let ((node (->tagged-vector node))) (if (eq? (expression-entry-node *root-expression*) node) - (write-line *root-expression*)) + (begin + (newline) + (write *root-expression*))) (for-each (lambda (procedure) (if (eq? (procedure-entry-node procedure) node) - (write-line procedure))) + (begin + (newline) + (write procedure)))) *procedures*))) (define (debug/where object) (cond ((compiled-code-block? object) - (write-line (compiled-code-block/debugging-info object))) + (newline) + (write (compiled-code-block/debugging-info object))) ((compiled-code-address? object) - (write-line + (newline) + (write (compiled-code-block/debugging-info (compiled-code-address->block object))) (write-string "\nOffset: ") diff --git a/v7/src/compiler/etc/comcmp.scm b/v7/src/compiler/etc/comcmp.scm index a3f1d0c8b..6845e1cb2 100644 --- a/v7/src/compiler/etc/comcmp.scm +++ b/v7/src/compiler/etc/comcmp.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: comcmp.scm,v 1.5 1999/01/02 06:06:43 cph Exp $ +$Id: comcmp.scm,v 1.6 1999/12/20 23:07:27 cph Exp $ Copyright (c) 1989-1999 Massachusetts Institute of Technology @@ -92,7 +92,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda () (let ((result (core))) (if result - (write-line `(subblocks ,b1 ,b2 ,result))) + (begin + (newline) + (write `(subblocks ,b1 ,b2 ,result)))) result)))))) (define (memoize! b1 b2 do-it) diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm index dd82d5d11..a98edb96d 100644 --- a/v7/src/runtime/debug.scm +++ b/v7/src/runtime/debug.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: debug.scm,v 14.39 1999/01/02 06:11:34 cph Exp $ +$Id: debug.scm,v 14.40 1999/12/20 23:08:22 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -800,7 +800,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (write-string "Stack frame elements: " port) (for-each-vector-element (stack-frame/elements (dstate/subproblem dstate)) - write-line)))) + (lambda (element) + (newline) + (write element)))))) ;;;; Low-level Side-effects diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 3c9ebe2b7..a8ed66a04 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 14.53 1999/05/11 20:35:15 cph Exp $ +$Id: load.scm,v 14.54 1999/12/20 23:11:01 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -26,9 +26,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (initialize-package!) (set! *purification-root-marker* (intern "#[PURIFICATION-ROOT]")) - (set! load-noisily? false) - (set! load/loading? false) - (set! load/suppress-loading-message? false) + (set! load-noisily? #f) + (set! load/loading? #f) + (set! load/suppress-loading-message? #f) (set! load/default-types `(("com" ,load/internal) ("so" ,load-object-file) @@ -68,23 +68,20 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. default-object (->environment environment))) (syntax-table - ;; Kludge until optional defaulting fixed. (if (or (default-object? syntax-table) (eq? syntax-table default-object)) default-object (guarantee-syntax-table syntax-table 'LOAD))) (purify? - (if (or (default-object? purify?) - (eq? purify? default-object)) - false + (if (or (default-object? purify?) (eq? purify? default-object)) + #f purify?))) (handle-load-hooks (lambda () (let ((kernel (lambda (filename last-file?) (call-with-values - (lambda () - (find-pathname filename load/default-types)) + (lambda () (find-pathname filename load/default-types)) (lambda (pathname loader) (fluid-let ((load/current-pathname pathname)) (let ((load-it @@ -95,16 +92,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. purify? load-noisily?)))) (cond (last-file? (load-it)) - (load-noisily? (write-line (load-it))) + (load-noisily? + (let ((value (load-it))) + (newline) + (write value))) (else (load-it) unspecific))))))))) (if (pair? filename/s) (let loop ((filenames filename/s)) (if (null? (cdr filenames)) - (kernel (car filenames) true) + (kernel (car filenames) #t) (begin - (kernel (car filenames) false) + (kernel (car filenames) #f) (loop (cdr filenames))))) - (kernel filename/s true))))))) + (kernel filename/s #t))))))) (define (fasload filename #!optional suppress-loading-message?) (call-with-values (lambda () (find-pathname filename fasload/default-types)) @@ -126,7 +126,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (handle-load-hooks thunk) (call-with-values (lambda () - (fluid-let ((load/loading? true) + (fluid-let ((load/loading? #t) (load/after-load-hooks '())) (let ((result (thunk))) (values result (reverse load/after-load-hooks))))) @@ -138,7 +138,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. "default-object") (define (load-noisily filename #!optional environment syntax-table purify?) - (fluid-let ((load-noisily? true)) + (fluid-let ((load-noisily? #t)) (load filename ;; This defaulting is a kludge until we get the optional ;; defaulting fixed. Right now it must match the defaulting @@ -191,7 +191,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (search-types-in-order pathname default-types) (let loop ((types default-types)) (if (null? types) - (values false false) + (values #f #f) (let ((pathname (pathname-new-type pathname (caar types)))) (if (file-exists? pathname) (values pathname (cadar types)) @@ -199,8 +199,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (find-latest-file pathname default-types) (let loop ((types default-types) - (latest-pathname false) - (latest-loader false) + (latest-pathname #f) + (latest-loader #f) (latest-time 0)) (if (not (pair? types)) (values latest-pathname latest-loader) @@ -239,7 +239,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (loading-message load/suppress-loading-message? pathname (lambda () (write-stream (value-stream) - (lambda (exp&value) exp&value false))))))))) + (lambda (exp&value) exp&value #f))))))))) (define (fasload/internal pathname suppress-loading-message?) (let ((value @@ -317,7 +317,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (and (eof-object? object) (begin (close-input-port port) - true))))) + #t))))) (define (eval-stream stream environment syntax-table) (stream-map stream @@ -408,7 +408,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (begin (set! *unused-command-line*) - (fluid-let ((*load-init-file?* true)) + (fluid-let ((*load-init-file?* #t)) (set! *unused-command-line* (process-keyword (vector->list unused-command-line) '())) (for-each (lambda (act) (act)) @@ -632,7 +632,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 'with-binary-input-file)) (define (with-binary-file-channel file action open extract-channel name) - (let ((port false)) + (let ((port #f)) (dynamic-wind (lambda () (if port @@ -642,7 +642,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (action (channel-descriptor (extract-channel port)))) (lambda () (if (and port - (not (eq? port true))) + (not (eq? port #t))) (begin (close-port port) - (set! port true))))))) \ No newline at end of file + (set! port #t))))))) \ No newline at end of file -- 2.25.1