diff options
author | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-07 23:40:14 +0200 |
---|---|---|
committer | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-07 23:48:46 +0200 |
commit | 2252321bb77fe83d98d5bcc9db1c76b914e9dd6a (patch) | |
tree | 2c31c9870fed7027a3997fc7597916a3cd548cb4 /module/rnrs | |
parent | 7be1705dbda377780335ecbcbfce04de523f2671 (diff) | |
download | guile-2252321bb77fe83d98d5bcc9db1c76b914e9dd6a.tar.gz |
Make the R6RS simple I/O library use conditions
* module/rnrs/io/ports.scm (display): Implement as an
exception-converting wrapper around Guile's core display.
* module/rnrs/io/simple.scm: Don't export Guile's corresponding core
procedures, but use `(rnrs io ports)' instead. This way, we get the
conditions required by R6RS raised.
* doc/ref/r6rs.texi (rnrs io simple): Mention that these procedures are
supposed to raise R6RS conditions.
Diffstat (limited to 'module/rnrs')
-rw-r--r-- | module/rnrs/io/ports.scm | 10 | ||||
-rw-r--r-- | module/rnrs/io/simple.scm | 86 |
2 files changed, 69 insertions, 27 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index 04d167a2c..3dbaa039b 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -110,7 +110,9 @@ (rnrs files) ;for the condition types (srfi srfi-8) (ice-9 rdelim) - (except (guile) raise)) + (except (guile) raise display) + (prefix (only (guile) display) + guile:)) @@ -377,6 +379,12 @@ return the characters accumulated in that port." (else (display s port))))) +;; Defined here to be able to make use of `with-i/o-encoding-error', but +;; not exported from here, but from `(rnrs io simple)'. +(define* (display object #:optional (port (current-output-port))) + (with-i/o-encoding-error + (guile:display object port))) + ;;; ;;; Textual input. diff --git a/module/rnrs/io/simple.scm b/module/rnrs/io/simple.scm index 59e614de0..031628b38 100644 --- a/module/rnrs/io/simple.scm +++ b/module/rnrs/io/simple.scm @@ -1,6 +1,6 @@ ;;; simple.scm --- The R6RS simple I/O library -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -85,42 +85,76 @@ (import (only (rnrs io ports) call-with-port + close-port open-file-input-port open-file-output-port eof-object - eof-object? - + eof-object? + file-options + native-transcoder + get-char + lookahead-char + get-datum + put-char + put-datum + input-port? output-port?) - (only (guile) @@ - current-input-port - current-output-port - current-error-port - - with-input-from-file - with-output-to-file - - open-input-file - open-output-file - - close-input-port - close-output-port - - read-char - peek-char - read - write-char - newline - display - write) + (only (guile) + @@ + current-input-port + current-output-port + current-error-port + + define* + + with-input-from-port + with-output-to-port) (rnrs base (6)) (rnrs files (6)) ;for the condition types ) + (define display (@@ (rnrs io ports) display)) + (define (call-with-input-file filename proc) (call-with-port (open-file-input-port filename) proc)) (define (call-with-output-file filename proc) (call-with-port (open-file-output-port filename) proc)) - -) + + (define (with-input-from-file filename thunk) + (call-with-input-file filename + (lambda (port) (with-input-from-port port thunk)))) + + (define (with-output-to-file filename thunk) + (call-with-output-file filename + (lambda (port) (with-output-to-port port thunk)))) + + (define (open-input-file filename) + (open-file-input-port filename (file-options) (native-transcoder))) + + (define (open-output-file filename) + (open-file-output-port filename (file-options) (native-transcoder))) + + (define close-input-port close-port) + (define close-output-port close-port) + + (define* (read-char #:optional (port (current-input-port))) + (get-char port)) + + (define* (peek-char #:optional (port (current-input-port))) + (lookahead-char port)) + + (define* (read #:optional (port (current-input-port))) + (get-datum port)) + + (define* (write-char char #:optional (port (current-output-port))) + (put-char port char)) + + (define* (newline #:optional (port (current-output-port))) + (put-char port #\newline)) + + (define* (write object #:optional (port (current-output-port))) + (put-datum port object)) + + ) |