From 98c27b65ad0685aafd911e2a17a7075955e78bce Mon Sep 17 00:00:00 2001 From: Jim Blandy Date: Tue, 29 Oct 1996 03:48:15 +0000 Subject: [PATCH] Get Guile to be a little less chatty by default. The new user should see as little clutter as possible. * r4rs.scm (%load-verbosely): Make this #f by default. * boot-9.scm (scm-repl-verbose): Make this #f by default. (scm-style-repl): Don't run 'pk' on the value passed to quit. * r4rs.scm: New file. * boot-9.scm: Load r4rs.scm, first thing. (OPEN_READ, OPEN_WRITE, OPEN_BOTH, *null-device*, open-input-file, open-output-file, open-io-file, close-input-port, close-output-port, close-io-port, call-with-input-file, call-with-output-file, with-input-from-port, with-output-to-port, with-error-to-port, with-input-from-file, with-output-to-file, with-error-to-file, with-input-from-string, with-output-to-string, with-error-to-string, the-eof-object): Definitions moved to r4rs.scm. Not all of them are R4RS, but those that are use those that are not. (load, %load-verbosely, %load-announce): Moved, along with code to set %load-hook, to r4rs.scm. --- ice-9/r4rs.scm | 149 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 149 insertions(+) create mode 100644 ice-9/r4rs.scm diff --git a/ice-9/r4rs.scm b/ice-9/r4rs.scm new file mode 100644 index 000000000..1d2d92972 --- /dev/null +++ b/ice-9/r4rs.scm @@ -0,0 +1,149 @@ +;;;; r4rs.scm --- definitions needed for libguile to be R4RS compliant +;;;; Jim Blandy --- October 1996 + +;;;; Copyright (C) 1996 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; apply and call-with-current-continuation + +;;; These turn syntax, @apply and @call-with-current-continuation, +;;; into procedures. If someone knows why they have to be syntax to +;;; begin with, please fix this comment. +(set! apply (lambda (fun . args) (@apply fun (apply:nconc2last args)))) +(define (call-with-current-continuation proc) + (@call-with-current-continuation proc)) + + +;;;; Basic Port Code + +;;; Specifically, the parts of the low-level port code that are written in +;;; Scheme rather than C. +;;; +;;; WARNING: the parts of this interface that refer to file ports +;;; are going away. It would be gone already except that it is used +;;; "internally" in a few places. + + +;; OPEN_READ, OPEN_WRITE, and OPEN_BOTH are used to request the proper +;; mode to open files in. MSDOS does carraige return - newline +;; translation if not opened in `b' mode. +;; +(define OPEN_READ (case (software-type) + ((MS-DOS WINDOWS ATARIST) "rb") + (else "r"))) +(define OPEN_WRITE (case (software-type) + ((MS-DOS WINDOWS ATARIST) "wb") + (else "w"))) +(define OPEN_BOTH (case (software-type) + ((MS-DOS WINDOWS ATARIST) "r+b") + (else "r+"))) + +(define *null-device* "/dev/null") + +(define (open-input-file str) + (open-file str OPEN_READ)) + +(define (open-output-file str) + (open-file str OPEN_WRITE)) + +(define (open-io-file str) (open-file str OPEN_BOTH)) +(define close-input-port close-port) +(define close-output-port close-port) +(define close-io-port close-port) + +(define (call-with-input-file str proc) + (let* ((file (open-input-file str)) + (ans (proc file))) + (close-input-port file) + ans)) + +(define (call-with-output-file str proc) + (let* ((file (open-output-file str)) + (ans (proc file))) + (close-output-port file) + ans)) + +(define (with-input-from-port port thunk) + (let* ((swaports (lambda () (set! port (set-current-input-port port))))) + (dynamic-wind swaports thunk swaports))) + +(define (with-output-to-port port thunk) + (let* ((swaports (lambda () (set! port (set-current-output-port port))))) + (dynamic-wind swaports thunk swaports))) + +(define (with-error-to-port port thunk) + (let* ((swaports (lambda () (set! port (set-current-error-port port))))) + (dynamic-wind swaports thunk swaports))) + +(define (with-input-from-file file thunk) + (let* ((nport (open-input-file file)) + (ans (with-input-from-port nport thunk))) + (close-port nport) + ans)) + +(define (with-output-to-file file thunk) + (let* ((nport (open-output-file file)) + (ans (with-output-to-port nport thunk))) + (close-port nport) + ans)) + +(define (with-error-to-file file thunk) + (let* ((nport (open-output-file file)) + (ans (with-error-to-port nport thunk))) + (close-port nport) + ans)) + +(define (with-input-from-string string thunk) + (call-with-input-string string + (lambda (p) (with-input-from-port p thunk)))) + +(define (with-output-to-string thunk) + (call-with-output-string + (lambda (p) (with-output-to-port p thunk)))) + +(define (with-error-to-string thunk) + (call-with-output-string + (lambda (p) (with-error-to-port p thunk)))) + +(define the-eof-object (call-with-input-string "" (lambda (p) (read-char p)))) + + +;;;; Loading + +(if (not (defined? %load-verbosely)) + (define %load-verbosely #f)) +(define (assert-load-verbosity v) (set! %load-verbosely v)) + +(define (%load-announce file) + (if %load-verbosely + (with-output-to-port (current-error-port) + (lambda () + (display ";;; ") + (display "loading ") + (display file) + (newline) + (force-output))))) + +(set! %load-hook %load-announce) + +;;; If we load boot-9.scm, it provides a definition for this which is +;;; more sophisticated. +(define read-sharp #f) + +(define (load name) + (start-stack 'load-stack + (primitive-load name #t read-sharp)))