summaryrefslogtreecommitdiff
path: root/module/rnrs
diff options
context:
space:
mode:
authorAndreas Rottmann <a.rottmann@gmx.at>2011-05-07 23:40:14 +0200
committerAndreas Rottmann <a.rottmann@gmx.at>2011-05-07 23:48:46 +0200
commit2252321bb77fe83d98d5bcc9db1c76b914e9dd6a (patch)
tree2c31c9870fed7027a3997fc7597916a3cd548cb4 /module/rnrs
parent7be1705dbda377780335ecbcbfce04de523f2671 (diff)
downloadguile-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.scm10
-rw-r--r--module/rnrs/io/simple.scm86
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))
+
+ )