mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Import R6RS bytevectors and I/O ports from Guile-R6RS-Libs 0.2.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2009-05-27 18:18:07 +02:00
parent 24d56127bb
commit 1ee2c72eaf
18 changed files with 4688 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/Makefile.am
View file

@ -31,7 +31,7 @@ modpath =
# putting these core modules first.
SOURCES = \
ice-9/psyntax-pp.scm \
ice-9/psyntax-pp.scm \
system/base/pmatch.scm system/base/syntax.scm \
system/base/compile.scm system/base/language.scm \
\
@ -53,6 +53,7 @@ SOURCES = \
\
$(ICE_9_SOURCES) \
$(SRFI_SOURCES) \
$(RNRS_SOURCES) \
$(OOP_SOURCES) \
\
$(SCRIPTS_SOURCES)
@ -209,6 +210,10 @@ SRFI_SOURCES = \
srfi/srfi-69.scm \
srfi/srfi-88.scm
RNRS_SOURCES = \
rnrs/bytevector.scm \
rnrs/io/ports.scm
EXTRA_DIST += scripts/ChangeLog-2008
EXTRA_DIST += scripts/README

84
module/rnrs/bytevector.scm Normal file
View file

@ -0,0 +1,84 @@
;;;; bytevector.scm --- R6RS bytevector 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:
;;;
;;; A "bytevector" is a raw bit string. This module provides procedures to
;;; manipulate bytevectors and interpret their contents in a number of ways:
;;; bytevector contents can be accessed as signed or unsigned integer of
;;; various sizes and endianness, as IEEE-754 floating point numbers, or as
;;; strings. It is a useful tool to decode binary data.
;;;
;;; Code:
(define-module (rnrs bytevector)
:export-syntax (endianness)
:export (native-endianness bytevector?
make-bytevector bytevector-length bytevector=? bytevector-fill!
bytevector-copy! bytevector-copy bytevector-u8-ref
bytevector-s8-ref
bytevector-u8-set! bytevector-s8-set! bytevector->u8-list
u8-list->bytevector
bytevector-uint-ref bytevector-uint-set!
bytevector-sint-ref bytevector-sint-set!
bytevector->sint-list bytevector->uint-list
uint-list->bytevector sint-list->bytevector
bytevector-u16-ref bytevector-s16-ref
bytevector-u16-set! bytevector-s16-set!
bytevector-u16-native-ref bytevector-s16-native-ref
bytevector-u16-native-set! bytevector-s16-native-set!
bytevector-u32-ref bytevector-s32-ref
bytevector-u32-set! bytevector-s32-set!
bytevector-u32-native-ref bytevector-s32-native-ref
bytevector-u32-native-set! bytevector-s32-native-set!
bytevector-u64-ref bytevector-s64-ref
bytevector-u64-set! bytevector-s64-set!
bytevector-u64-native-ref bytevector-s64-native-ref
bytevector-u64-native-set! bytevector-s64-native-set!
bytevector-ieee-single-ref
bytevector-ieee-single-set!
bytevector-ieee-single-native-ref
bytevector-ieee-single-native-set!
bytevector-ieee-double-ref
bytevector-ieee-double-set!
bytevector-ieee-double-native-ref
bytevector-ieee-double-native-set!
string->utf8 string->utf16 string->utf32
utf8->string utf16->string utf32->string))
(load-extension "libguile" "scm_init_bytevectors")
(define-macro (endianness sym)
(if (memq sym '(big little))
`(quote ,sym)
(error "unsupported endianness" sym)))
;;; Local Variables:
;;; coding: latin-1
;;; End:
;;; bytevector.scm ends here

111
module/rnrs/io/ports.scm Normal file
View file

@ -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