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.

diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index 2fe8d7b..d054bd3 100644 (file)
--- a/doc/ref/r6rs.texi
+++ b/doc/ref/r6rs.texi
@@ -1428,8 +1428,21 @@ functionality is documented in its own section of the manual;
 
 The @code{(rnrs io simple (6))} library provides convenience functions
 for performing textual I/O on ports.  This library also exports all of
-the condition types and associated procedures described in
-(@pxref{I/O Conditions}).
+the condition types and associated procedures described in (@pxref{I/O
+Conditions}).  In the context of this section, when stating that a
+procedure behaves ``identically'' to the corresponding procedure in
+Guile's core library, this is modulo the behavior wrt. conditions: such
+procedures raise the appropriate R6RS conditions in case of error, but
+otherwise behave identically.
+
+@c FIXME: remove the following note when proper condition behavior has
+@c been verified.
+
+@quotation Note
+There are still known issues regarding condition-correctness; some
+errors may still be thrown as native Guile exceptions instead of the
+appropriate R6RS conditions.
+@end quotation
 
 @deffn {Scheme Procedure} eof-object
 @deffnx {Scheme Procedure} eof-object? obj

diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 04d167a..3dbaa03 100644 (file)
--- 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:))
 
 
 \f
@@ -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)))
+
 \f
 ;;;
 ;;; Textual input.

diff --git a/module/rnrs/io/simple.scm b/module/rnrs/io/simple.scm
index 59e614d..031628b 100644 (file)
--- 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))
+
+  )