summaryrefslogtreecommitdiff
path: root/module/rnrs/io
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-05-27 18:18:07 +0200
committerLudovic Courtès <ludo@gnu.org>2009-05-28 23:12:01 +0200
commit1ee2c72eafaae5f91f4c899bc4b4853af5c16f28 (patch)
treebdb474d8adc13a6b99358c8d79d988fdbd7401a7 /module/rnrs/io
parent24d56127bb0f07bcb477e2c73ccc3cac0c51ee73 (diff)
downloadguile-1ee2c72eafaae5f91f4c899bc4b4853af5c16f28.tar.gz
Import R6RS bytevectors and I/O ports from Guile-R6RS-Libs 0.2.
* README: Document dependency on GNU libunistring. * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add `benchmark/bytevectors.bm'. * configure.in: Make sure we have libunistring; update $LIBS. * libguile.h: Include "bytevectors.h" and "r6rs-ports.h". * libguile/Makefile.am (libguile_la_SOURCES): Add `bytevectors.c' and `r6rs-ports.c' (DOT_X_FILES): Add `bytevectors.x' and `r6rs-ports.x'. (DOT_DOC_FILES): Add `bytevectors.doc' and `r6rs-ports.doc'. (noinst_HEADERS): Add `ieee-754.h'. (modinclude_HEADERS): Add `bytevectors.h' and `r6rs-ports.h' * libguile/validate.h (SCM_VALIDATE_BYTEVECTOR): New macro. * module/Makefile.am (SOURCES): Add $(RNRS_SOURCES). (RNRS_SOURCES): New variable. * test-suite/Makefile.am (SCM_TESTS): Add `bytevectors.test' and `r6rs-ports.test'.
Diffstat (limited to 'module/rnrs/io')
-rw-r--r--module/rnrs/io/ports.scm111
1 files changed, 111 insertions, 0 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
new file mode 100644
index 000000000..73843ee55
--- /dev/null
+++ b/module/rnrs/io/ports.scm
@@ -0,0 +1,111 @@
+;;;; ports.scm --- R6RS port API
+
+;;;; Copyright (C) 2009 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; The I/O port API of the R6RS is provided by this module. In many areas
+;;; it complements or refines Guile's own historical port API. For instance,
+;;; it allows for binary I/O with bytevectors.
+;;;
+;;; Code:
+
+(define-module (rnrs io ports)
+ :re-export (eof-object? port? input-port? output-port?)
+ :export (eof-object
+
+ ;; input & output ports
+ port-transcoder binary-port? transcoded-port
+ port-position set-port-position!
+ port-has-port-position? port-has-set-port-position!?
+ call-with-port
+
+ ;; input ports
+ open-bytevector-input-port
+ make-custom-binary-input-port
+
+ ;; binary input
+ get-u8 lookahead-u8
+ get-bytevector-n get-bytevector-n!
+ get-bytevector-some get-bytevector-all
+
+ ;; output ports
+ open-bytevector-output-port
+ make-custom-binary-output-port
+
+ ;; binary output
+ put-u8 put-bytevector))
+
+(load-extension "libguile" "scm_init_r6rs_ports")
+
+
+
+;;;
+;;; Input and output ports.
+;;;
+
+(define (port-transcoder port)
+ (error "port transcoders are not supported" port))
+
+(define (binary-port? port)
+ ;; So far, we don't support transcoders other than the binary transcoder.
+ #t)
+
+(define (transcoded-port port)
+ (error "port transcoders are not supported" port))
+
+(define (port-position port)
+ "Return the offset (an integer) indicating where the next octet will be
+read from/written to in @var{port}."
+
+ ;; FIXME: We should raise an `&assertion' error when not supported.
+ (seek port 0 SEEK_CUR))
+
+(define (set-port-position! port offset)
+ "Set the position where the next octet will be read from/written to
+@var{port}."
+
+ ;; FIXME: We should raise an `&assertion' error when not supported.
+ (seek port offset SEEK_SET))
+
+(define (port-has-port-position? port)
+ "Return @code{#t} is @var{port} supports @code{port-position}."
+ (and (false-if-exception (port-position port)) #t))
+
+(define (port-has-set-port-position!? port)
+ "Return @code{#t} is @var{port} supports @code{set-port-position!}."
+ (and (false-if-exception (set-port-position! port (port-position port)))
+ #t))
+
+(define (call-with-port port proc)
+ "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
+@var{proc}. Return the return values of @var{proc}."
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (proc port))
+ (lambda ()
+ (close-port port))))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; ports.scm ends here