guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-96-gc6a


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-96-gc6a1380
Date: Tue, 25 Aug 2009 19:55:52 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c6a1380bde978194ee5c533246285f6af4bbb554

The branch, master has been updated
       via  c6a1380bde978194ee5c533246285f6af4bbb554 (commit)
       via  108e18b18abc066b2709a09283751e9138ccc935 (commit)
       via  cd43fdc5b7a7c851ee0f2b4e96a1f394fb50d869 (commit)
       via  e286c973fcd63c0930d9302cc5f1a280b9b22615 (commit)
       via  f332089ed43761440a2a8c272ee61a709b38cc24 (commit)
       via  ac8ed3db31769d7ede5e75fba1697e8dde55fae4 (commit)
       via  943a0a8759504c4a367c1904bef4a8afbc6208dd (commit)
       via  f45eccffa73c043466a4cc0f5037132ee5795eee (commit)
       via  476b894c71b436f3befb8af46b899aaf244763e2 (commit)
       via  f332e9571703ddcd27c51ebe3c847459c2a649b7 (commit)
       via  1030b45049f564f4abd459abd8e59db34c7867cc (commit)
       via  66b9d7d304a349d5bb4f763a47143f09da58d97f (commit)
       via  2a610be59412a9d633a373c6f6ec4d4794c40fd8 (commit)
       via  2fa901a51f62da8a01112aefbf687530f4bff160 (commit)
       via  cf396142405d9076cc20eca9bf53376e80359a56 (commit)
       via  c53c0893a3bad3312230003707f71c2f441460d4 (commit)
       via  5d1b3b2db9349b615baac313ae5a111fa68573ac (commit)
       via  b6149d8d9f35c8091a31b12fb3aeecee0e3a470c (commit)
       via  a4a0d399c877cb802cdaf2c48713d3377a412c4f (commit)
       via  4b126598445c4f12c0aebca2adfaa45f3edd86ab (commit)
       via  86d88a223c64276e7cd9b4503e7e2ecca5aae320 (commit)
      from  889975e51accb80491af76fc5db980aeb3edd342 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c6a1380bde978194ee5c533246285f6af4bbb554
Merge: 108e18b18abc066b2709a09283751e9138ccc935 
889975e51accb80491af76fc5db980aeb3edd342
Author: Andy Wingo <address@hidden>
Date:   Tue Aug 25 21:43:00 2009 +0200

    Merge commit 'origin/master'
    
    Conflicts:
        libguile/unif.c

commit 108e18b18abc066b2709a09283751e9138ccc935
Merge: c15d8e6ab9bf991ca55038fa895993bbb4c1efaa 
cd43fdc5b7a7c851ee0f2b4e96a1f394fb50d869
Author: Andy Wingo <address@hidden>
Date:   Tue Aug 25 18:04:02 2009 +0200

    Merge wip-array refactor, up to cd43fdc5b7a7c
    
    Conflicts:
        NEWS
        libguile/print.c

-----------------------------------------------------------------------

Summary of changes:
 NEWS                              |  156 +--
 libguile.h                        |    9 +-
 libguile/Makefile.am              |  488 +++++-
 libguile/array-handle.c           |  162 ++
 libguile/array-handle.h           |  129 ++
 libguile/{ramap.c => array-map.c} |   25 +-
 libguile/{ramap.h => array-map.h} |   10 +-
 libguile/arrays.c                 | 1156 ++++++++++++++
 libguile/arrays.h                 |   91 ++
 libguile/bitvectors.c             |  910 +++++++++++
 libguile/bitvectors.h             |   81 +
 libguile/bytevectors.c            |  318 +++-
 libguile/bytevectors.h            |   16 +-
 libguile/convert.c                |  147 --
 libguile/convert.h                |   51 -
 libguile/convert.i.c              |  171 ---
 libguile/deprecated.c             |    3 +-
 libguile/deprecated.h             |    3 +-
 libguile/eq.c                     |    6 +-
 libguile/extensions.c             |    5 +-
 libguile/gc-card.c                |    2 +-
 libguile/gc-malloc.c              |    4 +-
 libguile/gc-mark.c                |    2 +-
 libguile/gc.c                     |    4 +-
 libguile/generalized-arrays.c     |  276 ++++
 libguile/generalized-arrays.h     |   63 +
 libguile/generalized-vectors.c    |  201 +++
 libguile/generalized-vectors.h    |   61 +
 libguile/init.c                   |   27 +-
 libguile/inline.h                 |   17 +-
 libguile/print.c                  |    1 -
 libguile/random.c                 |    5 +-
 libguile/read.c                   |    3 +-
 libguile/socket.c                 |    4 +-
 libguile/sort.c                   |    6 +-
 libguile/srfi-4.c                 |  329 +---
 libguile/srfi-4.h                 |   31 +-
 libguile/srfi-4.i.c               |   15 +-
 libguile/strings.c                |   31 +
 libguile/strports.c               |    2 +-
 libguile/unif.c                   | 3031 -------------------------------------
 libguile/unif.h                   |  198 ---
 libguile/uniform.c                |  254 ++++
 libguile/uniform.h                |   77 +
 libguile/vectors.c                |  153 +--
 libguile/vectors.h                |   17 +-
 module/Makefile.am                |    1 +
 module/ice-9/deprecated.scm       |   12 +-
 module/srfi/srfi-4/gnu.scm        |   52 +
 test-suite/tests/unif.test        |    4 +-
 50 files changed, 4478 insertions(+), 4342 deletions(-)
 create mode 100644 libguile/array-handle.c
 create mode 100644 libguile/array-handle.h
 rename libguile/{ramap.c => array-map.c} (98%)
 rename libguile/{ramap.h => array-map.h} (90%)
 create mode 100644 libguile/arrays.c
 create mode 100644 libguile/arrays.h
 create mode 100644 libguile/bitvectors.c
 create mode 100644 libguile/bitvectors.h
 delete mode 100644 libguile/convert.c
 delete mode 100644 libguile/convert.h
 delete mode 100644 libguile/convert.i.c
 create mode 100644 libguile/generalized-arrays.c
 create mode 100644 libguile/generalized-arrays.h
 create mode 100644 libguile/generalized-vectors.c
 create mode 100644 libguile/generalized-vectors.h
 delete mode 100644 libguile/unif.c
 delete mode 100644 libguile/unif.h
 create mode 100644 libguile/uniform.c
 create mode 100644 libguile/uniform.h
 create mode 100644 module/srfi/srfi-4/gnu.scm

diff --git a/NEWS b/NEWS
index 3cc579b..0f2d693 100644
--- a/NEWS
+++ b/NEWS
@@ -8,100 +8,25 @@ Please send Guile bug reports to address@hidden
 (During the 1.9 series, we will keep an incremental NEWS for the latest
 prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
-Changes in 1.9.2 (since the 1.9.1 prerelease):
+Changes in 1.9.3 (since the 1.9.2 prerelease):
 
-** VM speed improvements
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
 
-Closures now copy the free variables that they need into a flat vector
-instead of capturing all heap-allocated variables. This speeds up access
-to free variables, avoids unnecessary garbage retention, and allows all
-variables to be allocated on the stack.
+These functions have been deprecated since early 2005.
 
-Variables which are `set!' are now allocated on the stack, but in
-"boxes". This allows a more uniform local variable allocation
-discipline, and allows faster access to these variables.
+** scm_array_p has one argument, not two
 
-The VM has new special-case operations, `add1' and `sub1'.
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
 
-** VM robustness improvements
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
 
-The maximum number of live local variables has been increased from 256
-to 65535.
-
-The default VM stack size is 64 kilo-words, up from 16 kilo-words. This
-allows more programs to execute in the default stack space. In the
-future we will probably implement extensible stacks via overflow
-handlers.
-
-Some lingering cases in which the VM could perform unaligned accesses
-have been fixed.
-
-The address range for relative jumps has been expanded from 16-bit
-addresses to 19-bit addresses via 8-byte alignment of jump targets. This
-will probably change to a 24-bit byte-addressable strategy before Guile
-2.0.
-
-** Compiler optimizations
-
-Procedures bound by `letrec' are no longer allocated on the heap,
-subject to a few constraints. In many cases, procedures bound by
-`letrec' and `let' can be rendered inline to their parent function, with
-loop detection for mutually tail-recursive procedures.
-
-Unreferenced variables are now optimized away.
-
-** Compiler robustness
-
-Guile may now warn about unused lexically-bound variables. Pass
-`-Wunused-variable' to `guile-tools compile', or `#:warnings
-(unused-variable)' within the #:opts argument to the `compile' procedure
-from `(system base compile)'.
-
-** Incomplete support for Unicode characters and strings
-
-Preliminary support for Unicode has landed. Characters may be entered in
-octal format via e.g. `#\454', or created via (integer->char 300). A hex
-external representation will probably be introduced at some point.
-
-Internally, strings are now represented either in the `latin-1'
-encoding, one byte per character, or in UTF-32, with four bytes per
-character. Strings manage their own allocation, switching if needed.
-
-Currently no locale conversion is performed. Extended characters may be
-written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
-`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
-
-This support is obviously incomplete. Many C functions have not yet been
-updated to deal with the new representations. Users are advised to wait
-for the next release for more serious use of Unicode strings.
-
-** `defined?' may accept a module as its second argument
-
-Previously it only accepted internal structures from the evaluator.
-
-** `let-values' is now implemented with a hygienic macro
-
-This could have implications discussed below in the NEWS entry titled,
-"Lexical bindings introduced by hygienic macros may not be referenced by
-nonhygienic macros".
-
-** Global variables `scm_charnames' and `scm_charnums' are removed
-
-These variables contained the names of control characters and were
-used when writing characters.  While these were global, they were
-never intended to be public API.  They have been replaced with private
-functions.
-
-** EBCDIC support is removed
-
-There was an EBCDIC compile flag that altered some of the character
-processing.  It appeared that full EBCDIC support was never completed
-and was unmaintained.
-
-** Packaging changes
-
-Guile now provides `guile-2.0.pc' (used by pkg-config) instead of
-`guile-1.8.pc'.
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
 
 ** And of course, the usual collection of bugfixes
  
@@ -555,6 +480,35 @@ This decision may be revisited before the 2.0 release. 
Feedback welcome
 to address@hidden (subscription required) or address@hidden (no
 subscription required).
 
+** Unicode characters
+
+Unicode characters may be entered in octal format via e.g. `#\454', or
+created via (integer->char 300). A hex external representation will
+probably be introduced at some point.
+
+** Unicode strings
+
+Internally, strings are now represented either in the `latin-1'
+encoding, one byte per character, or in UTF-32, with four bytes per
+character. Strings manage their own allocation, switching if needed.
+
+Currently no locale conversion is performed. Extended characters may be
+written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
+`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
+
+** Global variables `scm_charnames' and `scm_charnums' are removed
+
+These variables contained the names of control characters and were
+used when writing characters.  While these were global, they were
+never intended to be public API.  They have been replaced with private
+functions.
+
+** EBCDIC support is removed
+
+There was an EBCDIC compile flag that altered some of the character
+processing.  It appeared that full EBCDIC support was never completed
+and was unmaintained.
+
 ** New macro type: syncase-macro
 
 XXX Need to decide whether to document this for 2.0, probably should:
@@ -588,6 +542,10 @@ These are analogous to %load-path and %load-extensions.
 
 `(make-promise (lambda () foo))' is equivalent to `(delay foo)'.
 
+** `defined?' may accept a module as its second argument
+
+Previously it only accepted internal structures from the evaluator.
+
 ** New entry into %guile-build-info: `ccachedir'
 
 ** Fix bug in `module-bound?'.
@@ -601,6 +559,12 @@ the variable. This was an error, and was fixed.
 As syntax-case is available by default, importing `(ice-9 syncase)' has
 no effect, and will trigger a deprecation warning.
 
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
+
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
+
 * Changes to the C interface
 
 ** The GH interface (deprecated in version 1.6, 2001) was removed.
@@ -629,6 +593,18 @@ definition depends on the application's value for 
`_FILE_OFFSET_BITS'.
 
 ** The `long_long' C type, deprecated in 1.8, has been removed
 
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
+
+These functions have been deprecated since early 2005.
+
+** scm_array_p has one argument, not two
+
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
+
 * Changes to the distribution
 
 ** Guile's license is now LGPLv3+
@@ -656,8 +632,8 @@ to /usr/lib/guile/1.9/ccache. These files are 
architecture-specific.
 
 ** New dependency: GNU libunistring.
 
-See http://www.gnu.org/software/libunistring/. We hope to merge in
-Unicode support in the next prerelease.
+See http://www.gnu.org/software/libunistring/, for more information. Our
+unicode support uses routines from libunistring.
 
 
 
diff --git a/libguile.h b/libguile.h
index 7b5649b..74674d5 100644
--- a/libguile.h
+++ b/libguile.h
@@ -31,8 +31,12 @@ extern "C" {
 #include "libguile/__scm.h"
 #include "libguile/alist.h"
 #include "libguile/arbiters.h"
+#include "libguile/array-handle.h"
+#include "libguile/array-map.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
@@ -50,6 +54,8 @@ extern "C" {
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"
@@ -78,7 +84,6 @@ extern "C" {
 #include "libguile/properties.h"
 #include "libguile/procs.h"
 #include "libguile/r6rs-ports.h"
-#include "libguile/ramap.h"
 #include "libguile/random.h"
 #include "libguile/read.h"
 #include "libguile/root.h"
@@ -101,7 +106,7 @@ extern "C" {
 #include "libguile/symbols.h"
 #include "libguile/tags.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/uniform.h"
 #include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 09be878..ab372b6 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -105,27 +105,109 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
-libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
-    bytevectors.c chars.c continuations.c                              \
-    convert.c debug.c deprecation.c                                    \
-    deprecated.c discouraged.c dynwind.c eq.c error.c  \
-    eval.c evalext.c extensions.c feature.c fluids.c fports.c          \
-    futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c                
\
-    gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c     \
-    goops.c gsubr.c            \
-    guardians.c hash.c hashtab.c hooks.c init.c inline.c               \
-    ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c         \
-    modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c  \
-    print.c procprop.c procs.c properties.c                            \
-    r6rs-ports.c random.c rdelim.c read.c                              \
-    root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c    \
-    stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c \
-    strorder.c strports.c struct.c symbols.c threads.c null-threads.c  \
-    throw.c values.c variable.c vectors.c version.c vports.c weaks.c   \
-    ramap.c unif.c
-
-# vm-related sources
-libguile_la_SOURCES += frames.c instructions.c objcodes.c programs.c vm.c
+libguile_la_SOURCES =                          \
+       alist.c                                 \
+       arbiters.c                              \
+       array-handle.c                          \
+       array-map.c                             \
+       arrays.c                                \
+       async.c                                 \
+       backtrace.c                             \
+       boolean.c                               \
+       bitvectors.c                            \
+       bytevectors.c                           \
+       chars.c                                 \
+       continuations.c                         \
+       debug.c                                 \
+       deprecated.c                            \
+       deprecation.c                           \
+       discouraged.c                           \
+       dynwind.c                               \
+       eq.c                                    \
+       error.c                                 \
+       eval.c                                  \
+       evalext.c                               \
+       extensions.c                            \
+       feature.c                               \
+       fluids.c                                \
+       fports.c                                \
+       frames.c                                \
+       futures.c                               \
+       gc-card.c                               \
+       gc-freelist.c                           \
+       gc-malloc.c                             \
+       gc-mark.c                               \
+       gc-segment-table.c                      \
+       gc-segment.c                            \
+       gc.c                                    \
+       gc_os_dep.c                             \
+       gdbint.c                                \
+       gettext.c                               \
+       generalized-arrays.c                    \
+       generalized-vectors.c                   \
+       goops.c                                 \
+       gsubr.c                                 \
+       guardians.c                             \
+       hash.c                                  \
+       hashtab.c                               \
+       hooks.c                                 \
+       init.c                                  \
+       inline.c                                \
+       instructions.c                          \
+       ioext.c                                 \
+       keywords.c                              \
+       lang.c                                  \
+       list.c                                  \
+       load.c                                  \
+       macros.c                                \
+       mallocs.c                               \
+       modules.c                               \
+       null-threads.c                          \
+       numbers.c                               \
+       objcodes.c                              \
+       objects.c                               \
+       objprop.c                               \
+       options.c                               \
+       pairs.c                                 \
+       ports.c                                 \
+       print.c                                 \
+       procprop.c                              \
+       procs.c                                 \
+       programs.c                              \
+       properties.c                            \
+       r6rs-ports.c                            \
+       random.c                                \
+       rdelim.c                                \
+       read.c                                  \
+       root.c                                  \
+       rw.c                                    \
+       scmsigs.c                               \
+       script.c                                \
+       simpos.c                                \
+       smob.c                                  \
+       sort.c                                  \
+       srcprop.c                               \
+       srfi-13.c                               \
+       srfi-14.c                               \
+       srfi-4.c                                \
+       stackchk.c                              \
+       stacks.c                                \
+       stime.c                                 \
+       strings.c                               \
+       strorder.c                              \
+       strports.c                              \
+       struct.c                                \
+       symbols.c                               \
+       threads.c                               \
+       throw.c                                 \
+       uniform.c                               \
+       values.c                                \
+       variable.c                              \
+       vectors.c                               \
+       version.c                               \
+       vm.c                                    \
+       vports.c                                \
+       weaks.c
 
 address@hidden@_la_SOURCES = i18n.c
 address@hidden@_la_CFLAGS =    \
@@ -136,48 +218,202 @@ address@hidden@_la_LDFLAGS =     \
    -module -L$(builddir) -lguile                               \
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x         \
-    bytevectors.x chars.x                                              \
-    continuations.x debug.x deprecation.x deprecated.x discouraged.x   \
-    dynl.x dynwind.x eq.x error.x eval.x evalext.x     \
-    extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x  \
-    gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x               \
-    gsubr.x guardians.x gc-segment-table.x                              \
-    hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x   \
-    list.x load.x macros.x mallocs.x modules.x numbers.x objects.x     \
-    objprop.x options.x pairs.x ports.x print.x procprop.x procs.x     \
-    properties.x r6rs-ports.x random.x rdelim.x                                
\
-    read.x root.x rw.x scmsigs.x                                       \
-    script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x      \
-    stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x          \
-    strports.x struct.x symbols.x threads.x throw.x values.x           \
-    variable.x vectors.x version.x vports.x weaks.x ramap.x unif.x
+DOT_X_FILES =                                  \
+       alist.x                                 \
+       arbiters.x                              \
+       array-handle.x                          \
+       array-map.x                             \
+       arrays.x                                \
+       async.x                                 \
+       backtrace.x                             \
+       boolean.x                               \
+       bitvectors.x                            \
+       bytevectors.x                           \
+       chars.x                                 \
+       continuations.x                         \
+       debug.x                                 \
+       deprecated.x                            \
+       deprecation.x                           \
+       discouraged.x                           \
+       dynl.x                                  \
+       dynwind.x                               \
+       eq.x                                    \
+       error.x                                 \
+       eval.x                                  \
+       evalext.x                               \
+       extensions.x                            \
+       feature.x                               \
+       fluids.x                                \
+       fports.x                                \
+       futures.x                               \
+       gc-card.x                               \
+       gc-malloc.x                             \
+       gc-mark.x                               \
+       gc-segment-table.x                      \
+       gc-segment.x                            \
+       gc.x                                    \
+       gettext.x                               \
+       generalized-arrays.x                    \
+       generalized-vectors.x                   \
+       goops.x                                 \
+       gsubr.x                                 \
+       guardians.x                             \
+       hash.x                                  \
+       hashtab.x                               \
+       hooks.x                                 \
+       i18n.x                                  \
+       init.x                                  \
+       ioext.x                                 \
+       keywords.x                              \
+       lang.x                                  \
+       list.x                                  \
+       load.x                                  \
+       macros.x                                \
+       mallocs.x                               \
+       modules.x                               \
+       numbers.x                               \
+       objects.x                               \
+       objprop.x                               \
+       options.x                               \
+       pairs.x                                 \
+       ports.x                                 \
+       print.x                                 \
+       procprop.x                              \
+       procs.x                                 \
+       properties.x                            \
+       r6rs-ports.x                            \
+       random.x                                \
+       rdelim.x                                \
+       read.x                                  \
+       root.x                                  \
+       rw.x                                    \
+       scmsigs.x                               \
+       script.x                                \
+       simpos.x                                \
+       smob.x                                  \
+       sort.x                                  \
+       srcprop.x                               \
+       srfi-13.x                               \
+       srfi-14.x                               \
+       srfi-4.x                                \
+       stackchk.x                              \
+       stacks.x                                \
+       stime.x                                 \
+       strings.x                               \
+       strorder.x                              \
+       strports.x                              \
+       struct.x                                \
+       symbols.x                               \
+       threads.x                               \
+       throw.x                                 \
+       uniform.x                               \
+       values.x                                \
+       variable.x                              \
+       vectors.x                               \
+       version.x                               \
+       vports.x                                \
+       weaks.x
 
 # vm-related snarfs
 DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x
 
 EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
 
-DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc         \
-    boolean.doc bytevectors.doc chars.doc                              \
-    continuations.doc debug.doc deprecation.doc                                
\
-    deprecated.doc discouraged.doc dynl.doc dynwind.doc                        
\
-    eq.doc error.doc eval.doc evalext.doc              \
-    extensions.doc feature.doc fluids.doc fports.doc futures.doc       \
-    gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
-    gc-malloc.doc gc-card.doc gettext.doc gc-segment-table.doc          \
-    guardians.doc hash.doc hashtab.doc                                 \
-    hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc                
\
-    list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc   \
-    objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc  \
-    procprop.doc procs.doc properties.doc r6rs-ports.doc               \
-    random.doc rdelim.doc                                              \
-    read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc         \
-    smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc    \
-    strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc                
\
-    strports.doc struct.doc symbols.doc threads.doc throw.doc          \
-    values.doc variable.doc vectors.doc version.doc vports.doc         \
-    weaks.doc ramap.doc unif.doc
+DOT_DOC_FILES =                                \
+       alist.doc                               \
+       arbiters.doc                            \
+       array-handle.doc                        \
+       array-map.doc                           \
+       arrays.doc                              \
+       async.doc                               \
+       backtrace.doc                           \
+       boolean.doc                             \
+       bitvectors.doc                          \
+       bytevectors.doc                         \
+       chars.doc                               \
+       continuations.doc                       \
+       debug.doc                               \
+       deprecated.doc                          \
+       deprecation.doc                         \
+       discouraged.doc                         \
+       dynl.doc                                \
+       dynwind.doc                             \
+       eq.doc                                  \
+       error.doc                               \
+       eval.doc                                \
+       evalext.doc                             \
+       extensions.doc                          \
+       feature.doc                             \
+       fluids.doc                              \
+       fports.doc                              \
+       futures.doc                             \
+       gc-card.doc                             \
+       gc-malloc.doc                           \
+       gc-mark.doc                             \
+       gc-segment-table.doc                    \
+       gc-segment.doc                          \
+       gc.doc                                  \
+       gettext.doc                             \
+       generalized-arrays.doc                  \
+       generalized-vectors.doc                 \
+       goops.doc                               \
+       gsubr.doc                               \
+       guardians.doc                           \
+       hash.doc                                \
+       hashtab.doc                             \
+       hooks.doc                               \
+       i18n.doc                                \
+       init.doc                                \
+       ioext.doc                               \
+       keywords.doc                            \
+       lang.doc                                \
+       list.doc                                \
+       load.doc                                \
+       macros.doc                              \
+       mallocs.doc                             \
+       modules.doc                             \
+       numbers.doc                             \
+       objects.doc                             \
+       objprop.doc                             \
+       options.doc                             \
+       pairs.doc                               \
+       ports.doc                               \
+       print.doc                               \
+       procprop.doc                            \
+       procs.doc                               \
+       properties.doc                          \
+       r6rs-ports.doc                          \
+       random.doc                              \
+       rdelim.doc                              \
+       read.doc                                \
+       root.doc                                \
+       rw.doc                                  \
+       scmsigs.doc                             \
+       script.doc                              \
+       simpos.doc                              \
+       smob.doc                                \
+       sort.doc                                \
+       srcprop.doc                             \
+       srfi-13.doc                             \
+       srfi-14.doc                             \
+       srfi-4.doc                              \
+       stackchk.doc                            \
+       stacks.doc                              \
+       stime.doc                               \
+       strings.doc                             \
+       strorder.doc                            \
+       strports.doc                            \
+       struct.doc                              \
+       symbols.doc                             \
+       threads.doc                             \
+       throw.doc                               \
+       uniform.doc                             \
+       values.doc                              \
+       variable.doc                            \
+       vectors.doc                             \
+       version.doc                             \
+       vports.doc                              \
+       weaks.doc
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 
@@ -208,8 +444,7 @@ install-exec-hook:
 ## compile, since they are #included.  So instead we list them here.
 ## Perhaps we can deal with them normally once the merge seems to be
 ## working.
-noinst_HEADERS = convert.i.c                                   \
-                 conv-integer.i.c conv-uinteger.i.c            \
+noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c            \
                  eval.i.c ieee-754.h                           \
                  srfi-4.i.c                                    \
                  quicksort.i.c                                  \
@@ -235,28 +470,119 @@ pkginclude_HEADERS =
 
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(includedir)/libguile
-modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h    \
-    boolean.h bytevectors.h chars.h continuations.h convert.h          \
-    debug.h debug-malloc.h                                             \
-    deprecation.h deprecated.h discouraged.h dynl.h dynwind.h          \
-    eq.h error.h eval.h evalext.h extensions.h         \
-    feature.h filesys.h fluids.h fports.h futures.h gc.h               \
-    gdb_interface.h gdbint.h gettext.h goops.h                         \
-    gsubr.h guardians.h hash.h                                         \
-    hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h         \
-    keywords.h lang.h list.h load.h macros.h mallocs.h modules.h       \
-    net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h   \
-    posix.h r6rs-ports.h regex-posix.h print.h                         \
-    procprop.h procs.h properties.h                                    \
-    random.h ramap.h rdelim.h read.h root.h rw.h scmsigs.h validate.h  \
-    script.h simpos.h smob.h snarf.h socket.h sort.h srcprop.h         \
-    stackchk.h stacks.h stime.h strings.h srfi-4.h srfi-13.h srfi-14.h \
-    strorder.h strports.h struct.h symbols.h tags.h threads.h          \
-    pthread-threads.h null-threads.h throw.h unif.h values.h           \
-    variable.h vectors.h vports.h weaks.h
-
-modinclude_HEADERS += vm-bootstrap.h frames.h instructions.h objcodes.h        
\
-    programs.h vm.h vm-engine.h vm-expand.h
+modinclude_HEADERS =                           \
+       __scm.h                                 \
+       alist.h                                 \
+       arbiters.h                              \
+       array-handle.h                          \
+       array-map.h                             \
+       arrays.h                                \
+       async.h                                 \
+       backtrace.h                             \
+       boolean.h                               \
+       bitvectors.h                            \
+       bytevectors.h                           \
+       chars.h                                 \
+       continuations.h                         \
+       debug-malloc.h                          \
+       debug.h                                 \
+       deprecated.h                            \
+       deprecation.h                           \
+       discouraged.h                           \
+       dynl.h                                  \
+       dynwind.h                               \
+       eq.h                                    \
+       error.h                                 \
+       eval.h                                  \
+       evalext.h                               \
+       extensions.h                            \
+       feature.h                               \
+       filesys.h                               \
+       fluids.h                                \
+       fports.h                                \
+       frames.h                                \
+       futures.h                               \
+       gc.h                                    \
+       gdb_interface.h                         \
+       gdbint.h                                \
+       gettext.h                               \
+       generalized-arrays.h                    \
+       generalized-vectors.h                   \
+       goops.h                                 \
+       gsubr.h                                 \
+       guardians.h                             \
+       hash.h                                  \
+       hashtab.h                               \
+       hooks.h                                 \
+       i18n.h                                  \
+       init.h                                  \
+       inline.h                                \
+       instructions.h                          \
+       ioext.h                                 \
+       iselect.h                               \
+       keywords.h                              \
+       lang.h                                  \
+       list.h                                  \
+       load.h                                  \
+       macros.h                                \
+       mallocs.h                               \
+       modules.h                               \
+       net_db.h                                \
+       null-threads.h                          \
+       numbers.h                               \
+       objcodes.h                              \
+       objects.h                               \
+       objprop.h                               \
+       options.h                               \
+       pairs.h                                 \
+       ports.h                                 \
+       posix.h                                 \
+       print.h                                 \
+       procprop.h                              \
+       procs.h                                 \
+       programs.h                              \
+       properties.h                            \
+       pthread-threads.h                       \
+       r6rs-ports.h                            \
+       random.h                                \
+       rdelim.h                                \
+       read.h                                  \
+       regex-posix.h                           \
+       root.h                                  \
+       rw.h                                    \
+       scmsigs.h                               \
+       script.h                                \
+       simpos.h                                \
+       smob.h                                  \
+       snarf.h                                 \
+       socket.h                                \
+       sort.h                                  \
+       srcprop.h                               \
+       srfi-13.h                               \
+       srfi-14.h                               \
+       srfi-4.h                                \
+       stackchk.h                              \
+       stacks.h                                \
+       stime.h                                 \
+       strings.h                               \
+       strorder.h                              \
+       strports.h                              \
+       struct.h                                \
+       symbols.h                               \
+       tags.h                                  \
+       threads.h                               \
+       throw.h                                 \
+       validate.h                              \
+       uniform.h                               \
+       values.h                                \
+       variable.h                              \
+       vectors.h                               \
+       vm-bootstrap.h                          \
+       vm-engine.h                             \
+       vm-expand.h                             \
+       vm.h                                    \
+       vports.h                                \
+       weaks.h
 
 nodist_modinclude_HEADERS = version.h scmconfig.h
 
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
new file mode 100644
index 0000000..cd5a466
--- /dev/null
+++ b/libguile/array-handle.c
@@ -0,0 +1,162 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+
+
+SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
+
+
+#define ARRAY_IMPLS_N_STATIC_ALLOC 7
+static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC];
+static int num_array_impls_registered = 0;
+
+
+void
+scm_i_register_array_implementation (scm_t_array_implementation *impl)
+{
+  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
+    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    array_impls[num_array_impls_registered++] = *impl;
+}
+
+scm_t_array_implementation*
+scm_i_array_implementation_for_obj (SCM obj)
+{
+  int i;
+  for (i = 0; i < num_array_impls_registered; i++)
+    if (SCM_NIMP (obj)
+        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
+      return &array_impls[i];
+  return NULL;
+}
+
+void
+scm_array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj 
(array);
+  if (!impl)
+    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+  h->array = array;
+  h->impl = impl;
+  h->base = 0;
+  h->ndims = 0;
+  h->dims = NULL;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
+                                                   something... */
+  h->elements = NULL;
+  h->writable_elements = NULL;
+  h->impl->get_handle (array, h);
+}
+
+ssize_t
+scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
+{
+  scm_t_array_dim *s = scm_array_handle_dims (h);
+  ssize_t pos = 0, i;
+  size_t k = scm_array_handle_rank (h);
+  
+  while (k > 0 && scm_is_pair (indices))
+    {
+      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
+      pos += (i - s->lbnd) * s->inc;
+      k--;
+      s++;
+      indices = SCM_CDR (indices);
+    }
+  if (k > 0 || !scm_is_null (indices))
+    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
+                   scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
+  return pos;
+}
+
+SCM
+scm_array_handle_element_type (scm_t_array_handle *h)
+{
+  if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
+    abort (); /* guile programming error */
+  return scm_i_array_element_types[h->element_type];
+}
+
+void
+scm_array_handle_release (scm_t_array_handle *h)
+{
+  /* Nothing to do here until arrays need to be reserved for real.
+   */
+}
+
+const SCM *
+scm_array_handle_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((const SCM*)h->elements) + h->base;
+}
+
+SCM *
+scm_array_handle_writable_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((SCM*)h->elements) + h->base;
+}
+
+void
+scm_init_array_handle (void)
+{
+#define DEFINE_ARRAY_TYPE(tag, TAG)                             \
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG]   \
+    = (scm_permanent_object (scm_from_locale_symbol (#tag)))
+  
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
+  DEFINE_ARRAY_TYPE (a, CHAR);
+  DEFINE_ARRAY_TYPE (b, BIT);
+  DEFINE_ARRAY_TYPE (vu8, VU8);
+  DEFINE_ARRAY_TYPE (u8, U8);
+  DEFINE_ARRAY_TYPE (s8, S8);
+  DEFINE_ARRAY_TYPE (u16, U16);
+  DEFINE_ARRAY_TYPE (s16, S16);
+  DEFINE_ARRAY_TYPE (u32, U32);
+  DEFINE_ARRAY_TYPE (s32, S32);
+  DEFINE_ARRAY_TYPE (u64, U64);
+  DEFINE_ARRAY_TYPE (s64, S64);
+  DEFINE_ARRAY_TYPE (f32, F32);
+  DEFINE_ARRAY_TYPE (f64, F64);
+  DEFINE_ARRAY_TYPE (c32, C32);
+  DEFINE_ARRAY_TYPE (c64, C64);
+
+#include "libguile/array-handle.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
new file mode 100644
index 0000000..caf9cef
--- /dev/null
+++ b/libguile/array-handle.h
@@ -0,0 +1,129 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_HANDLE_H
+#define SCM_ARRAY_HANDLE_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+
+struct scm_t_array_handle;
+
+typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t);
+typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM);
+
+typedef struct
+{
+  scm_t_bits tag;
+  scm_t_bits mask;
+  scm_i_t_array_ref vref;
+  scm_i_t_array_set vset;
+  void (*get_handle)(SCM, struct scm_t_array_handle*);
+} scm_t_array_implementation;
+  
+#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \
+  SCM_SNARF_INIT ({                                                     \
+      scm_t_array_implementation impl;                                  \
+      impl.tag = tag_; impl.mask = mask_;                               \
+      impl.vref = vref_; impl.vset = vset_;                             \
+      impl.get_handle = handle_;                                        \
+      scm_i_register_array_implementation (&impl);                      \
+  })
+  
+
+SCM_INTERNAL void scm_i_register_array_implementation 
(scm_t_array_implementation *impl);
+SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj 
(SCM obj);
+
+
+
+
+typedef struct scm_t_array_dim
+{
+  ssize_t lbnd;
+  ssize_t ubnd;
+  ssize_t inc;
+} scm_t_array_dim;
+
+typedef enum {    
+  SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */
+  SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */
+  SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */
+  SCM_ARRAY_ELEMENT_TYPE_VU8 = 3,
+  SCM_ARRAY_ELEMENT_TYPE_U8 = 4,
+  SCM_ARRAY_ELEMENT_TYPE_S8 = 5,
+  SCM_ARRAY_ELEMENT_TYPE_U16 = 6,
+  SCM_ARRAY_ELEMENT_TYPE_S16 = 7,
+  SCM_ARRAY_ELEMENT_TYPE_U32 = 8,
+  SCM_ARRAY_ELEMENT_TYPE_S32 = 9,
+  SCM_ARRAY_ELEMENT_TYPE_U64 = 10,
+  SCM_ARRAY_ELEMENT_TYPE_S64 = 11,
+  SCM_ARRAY_ELEMENT_TYPE_F32 = 12,
+  SCM_ARRAY_ELEMENT_TYPE_F64 = 13,
+  SCM_ARRAY_ELEMENT_TYPE_C32 = 14,
+  SCM_ARRAY_ELEMENT_TYPE_C64 = 15,
+  SCM_ARRAY_ELEMENT_TYPE_LAST = 15,
+} scm_t_array_element_type;
+
+SCM_INTERNAL SCM scm_i_array_element_types[];
+
+
+typedef struct scm_t_array_handle {
+  SCM array;
+  scm_t_array_implementation *impl;
+  /* `Base' is an offset into elements or writable_elements, corresponding to
+     the first element in the array. It would be nicer just to adjust the
+     elements/writable_elements pointer, but we can't because that element 
might
+     not even be byte-addressable, as is the case with bitvectors. A nicer
+     solution would be, well, nice.
+   */
+  size_t base;
+  size_t ndims; /* ndims == the rank of the array */
+  scm_t_array_dim *dims;
+  scm_t_array_dim dim0;
+  scm_t_array_element_type element_type;
+  const void *elements;
+  void *writable_elements;
+} scm_t_array_handle;
+
+#define scm_array_handle_rank(h) ((h)->ndims)
+#define scm_array_handle_dims(h) ((h)->dims)
+
+SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
+SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
+SCM_API SCM scm_array_handle_element_type (scm_t_array_handle *h);
+SCM_API void scm_array_handle_release (scm_t_array_handle *h);
+SCM_API const SCM* scm_array_handle_elements (scm_t_array_handle *h);
+SCM_API SCM* scm_array_handle_writable_elements (scm_t_array_handle *h);
+
+/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
+
+SCM_INTERNAL void scm_init_array_handle (void);
+
+
+#endif  /* SCM_ARRAY_HANDLE_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/ramap.c b/libguile/array-map.c
similarity index 98%
rename from libguile/ramap.c
rename to libguile/array-map.c
index e141c18..fb9ceea 100644
--- a/libguile/ramap.c
+++ b/libguile/array-map.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 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
@@ -17,10 +17,6 @@
  */
 
 
-/*
-  HWN:FIXME::
-  Someone should rename this to arraymap.c; that would reflect the
-  contents better.  */
 
 
 
@@ -31,7 +27,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"
 #include "libguile/eq.h"
@@ -39,11 +35,14 @@
 #include "libguile/feature.h"
 #include "libguile/root.h"
 #include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/dynwind.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 
 
 typedef struct
@@ -223,7 +222,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       if (!SCM_I_ARRAYP (vra0))
        {
          size_t length = scm_c_generalized_vector_length (vra0);
-         vra1 = scm_i_make_ra (1, 0);
+         vra1 = scm_i_make_array (1);
          SCM_I_ARRAY_BASE (vra1) = 0;
          SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
          SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
@@ -236,7 +235,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
        {
          ra1 = SCM_CAR (z);
-         vra1 = scm_i_make_ra (1, 0);
+         vra1 = scm_i_make_array (1);
          SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
          SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
          if (!SCM_I_ARRAYP (ra1))
@@ -259,7 +258,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       return (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
     case 1:
     gencase:                   /* Have to loop over all dimensions. */
-    vra0 = scm_i_make_ra (1, 0);
+      vra0 = scm_i_make_array (1);
     if (SCM_I_ARRAYP (ra0))
       {
        kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
@@ -294,7 +293,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
     for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
       {
        ra1 = SCM_CAR (z);
-       vra1 = scm_i_make_ra (1, 0);
+       vra1 = scm_i_make_array (1);
        SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
        SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
        if (SCM_I_ARRAYP (ra1))
@@ -1222,13 +1221,13 @@ init_raprocs (ra_iproc *subra)
 
 
 void
-scm_init_ramap ()
+scm_init_array_map (void)
 {
   init_raprocs (ra_rpsubrs);
   init_raprocs (ra_asubrs);
   scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
   scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
-#include "libguile/ramap.x"
+#include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
 
diff --git a/libguile/ramap.h b/libguile/array-map.h
similarity index 90%
rename from libguile/ramap.h
rename to libguile/array-map.h
index d6cb191..a198099 100644
--- a/libguile/ramap.h
+++ b/libguile/array-map.h
@@ -1,9 +1,9 @@
 /* classes: h_files */
 
-#ifndef SCM_RAMAP_H
-#define SCM_RAMAP_H
+#ifndef SCM_ARRAY_MAP_H
+#define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 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
@@ -48,9 +48,9 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
 SCM_API SCM scm_raequal (SCM ra0, SCM ra1);
 SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
-SCM_INTERNAL void scm_init_ramap (void);
+SCM_INTERNAL void scm_init_array_map (void);
 
-#endif  /* SCM_RAMAP_H */
+#endif  /* SCM_ARRAY_MAP_H */
 
 /*
   Local Variables:
diff --git a/libguile/arrays.c b/libguile/arrays.c
new file mode 100644
index 0000000..2be9ec3
--- /dev/null
+++ b/libguile/arrays.c
@@ -0,0 +1,1156 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/eq.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/fports.h"
+#include "libguile/smob.h"
+#include "libguile/feature.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-4.h"
+#include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
+#include "libguile/list.h"
+#include "libguile/dynwind.h"
+#include "libguile/read.h"
+
+#include "libguile/validate.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/uniform.h"
+
+
+scm_t_bits scm_i_tc16_array;
+#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
SCM_I_ARRAY_FLAG_CONTIGUOUS))
+#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~SCM_I_ARRAY_FLAG_CONTIGUOUS))
+
+
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
+           (SCM ra),
+           "Return the root vector of a shared array.")
+#define FUNC_NAME s_scm_shared_array_root
+{
+  if (SCM_I_ARRAYP (ra))
+    return SCM_I_ARRAY_V (ra);
+  else if (scm_is_generalized_vector (ra))
+    return ra;
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
+           (SCM ra),
+           "Return the root vector index of the first element in the array.")
+#define FUNC_NAME s_scm_shared_array_offset
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (ra, &handle);
+  res = scm_from_size_t (handle.base);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
+           (SCM ra),
+           "For each dimension, return the distance between elements in the 
root vector.")
+#define FUNC_NAME s_scm_shared_array_increments
+{
+  scm_t_array_handle handle;
+  SCM res = SCM_EOL;
+  size_t k;
+  scm_t_array_dim *s;
+
+  scm_array_get_handle (ra, &handle);
+  k = scm_array_handle_rank (&handle);
+  s = scm_array_handle_dims (&handle);
+  while (k--)
+    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM 
+scm_i_make_array (int ndim)
+{
+  SCM ra;
+  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_i_tc16_array,
+              scm_gc_malloc ((sizeof (scm_i_t_array) +
+                             ndim * sizeof (scm_t_array_dim)),
+                            "array"));
+  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
+  return ra;
+}
+
+static char s_bad_spec[] = "Bad scm_array dimension";
+
+
+/* Increments will still need to be set. */
+
+static SCM 
+scm_i_shap2ra (SCM args)
+{
+  scm_t_array_dim *s;
+  SCM ra, spec, sp;
+  int ndim = scm_ilength (args);
+  if (ndim < 0)
+    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+
+  ra = scm_i_make_array (ndim);
+  SCM_I_ARRAY_BASE (ra) = 0;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
+    {
+      spec = SCM_CAR (args);
+      if (scm_is_integer (spec))
+       {
+         if (scm_to_long (spec) < 0)
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->lbnd = 0;
+         s->ubnd = scm_to_long (spec) - 1;
+         s->inc = 1;
+       }
+      else
+       {
+         if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->lbnd = scm_to_long (SCM_CAR (spec));
+         sp = SCM_CDR (spec);
+         if (!scm_is_pair (sp) 
+             || !scm_is_integer (SCM_CAR (sp))
+             || !scm_is_null (SCM_CDR (sp)))
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->ubnd = scm_to_long (SCM_CAR (sp));
+         s->inc = 1;
+       }
+    }
+  return ra;
+}
+
+SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
+           (SCM type, SCM fill, SCM bounds),
+           "Create and return an array of type @var{type}.")
+#define FUNC_NAME s_scm_make_typed_array
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+
+  if (scm_is_eq (fill, SCM_UNSPECIFIED))
+    fill = SCM_UNDEFINED;
+
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM
+scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
+                                 size_t byte_len)
+#define FUNC_NAME "scm_from_contiguous_typed_array"
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  scm_t_array_handle h;
+  void *base;
+  size_t sz;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
+
+
+  scm_array_get_handle (ra, &h);
+  base = scm_array_handle_uniform_writable_elements (&h);
+  sz = scm_array_handle_uniform_element_size (&h);
+  scm_array_handle_release (&h);
+
+  if (byte_len % sz)
+    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
+  if (byte_len / sz != rlen)
+    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
+
+  memcpy (base, bytes, byte_len);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
+           (SCM fill, SCM bounds),
+           "Create and return an array.")
+#define FUNC_NAME s_scm_make_array
+{
+  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
+}
+#undef FUNC_NAME
+
+static void 
+scm_i_ra_set_contp (SCM ra)
+{
+  size_t k = SCM_I_ARRAY_NDIM (ra);
+  if (k)
+    {
+      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
+      while (k--)
+       {
+         if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
+           {
+             SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
+             return;
+           }
+         inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
+                 - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
+       }
+    }
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+}
+
+
+SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
+           (SCM oldra, SCM mapfunc, SCM dims),
+           "@code{make-shared-array} can be used to create shared subarrays of 
other\n"
+           "arrays.  The @var{mapper} is a function that translates 
coordinates in\n"
+           "the new array into coordinates in the old array.  A @var{mapper} 
must be\n"
+           "linear, and its range must stay within the bounds of the old 
array, but\n"
+           "it can be otherwise arbitrary.  A simple example:\n"
+           "@lisp\n"
+           "(define fred (make-array #f 8 8))\n"
+           "(define freds-diagonal\n"
+           "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
+           "(array-set! freds-diagonal 'foo 3)\n"
+           "(array-ref fred 3 3) @result{} foo\n"
+           "(define freds-center\n"
+           "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 
2))\n"
+           "(array-ref freds-center 0 0) @result{} foo\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_make_shared_array
+{
+  scm_t_array_handle old_handle;
+  SCM ra;
+  SCM inds, indptr;
+  SCM imap;
+  size_t k;
+  ssize_t i;
+  long old_base, old_min, new_min, old_max, new_max;
+  scm_t_array_dim *s;
+
+  SCM_VALIDATE_REST_ARGUMENT (dims);
+  SCM_VALIDATE_PROC (2, mapfunc);
+  ra = scm_i_shap2ra (dims);
+
+  scm_array_get_handle (oldra, &old_handle);
+
+  if (SCM_I_ARRAYP (oldra))
+    {
+      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
+      s = scm_array_handle_dims (&old_handle);
+      k = scm_array_handle_rank (&old_handle);
+      while (k--)
+       {
+         if (s[k].inc > 0)
+           old_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+         else
+           old_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+       }
+    }
+  else
+    {
+      SCM_I_ARRAY_V (ra) = oldra;
+      old_base = old_min = 0;
+      old_max = scm_c_generalized_vector_length (oldra) - 1;
+    }
+
+  inds = SCM_EOL;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+    {
+      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
+      if (s[k].ubnd < s[k].lbnd)
+       {
+         if (1 == SCM_I_ARRAY_NDIM (ra))
+           ra = scm_make_generalized_vector (scm_array_type (ra),
+                                              SCM_INUM0, SCM_UNDEFINED);
+         else
+           SCM_I_ARRAY_V (ra) =
+              scm_make_generalized_vector (scm_array_type (ra),
+                                           SCM_INUM0, SCM_UNDEFINED);
+         scm_array_handle_release (&old_handle);
+         return ra;
+       }
+    }
+
+  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+  i = scm_array_handle_pos (&old_handle, imap);
+  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
+  indptr = inds;
+  k = SCM_I_ARRAY_NDIM (ra);
+  while (k--)
+    {
+      if (s[k].ubnd > s[k].lbnd)
+       {
+         SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
+         imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+         s[k].inc = scm_array_handle_pos (&old_handle, imap) - i;
+         i += s[k].inc;
+         if (s[k].inc > 0)
+           new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+         else
+           new_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+       }
+      else
+       s[k].inc = new_max - new_min + 1;       /* contiguous by default */
+      indptr = SCM_CDR (indptr);
+    }
+
+  scm_array_handle_release (&old_handle);
+
+  if (old_min > new_min || old_max < new_max)
+    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    {
+      SCM v = SCM_I_ARRAY_V (ra);
+      size_t length = scm_c_generalized_vector_length (v);
+      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
+       return v;
+      if (s->ubnd < s->lbnd)
+       return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
+                                            SCM_UNDEFINED);
+    }
+  scm_i_ra_set_contp (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+
+/* args are RA . DIMS */
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
+           (SCM ra, SCM args),
+           "Return an array sharing contents with @var{array}, but with\n"
+           "dimensions arranged in a different order.  There must be one\n"
+           "@var{dim} argument for each dimension of @var{array}.\n"
+           "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
+           "and the rank of the array to be returned.  Each integer in that\n"
+           "range must appear at least once in the argument list.\n"
+           "\n"
+           "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
+           "dimensions in the array to be returned, their positions in the\n"
+           "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
+           "may have the same value, in which case the returned array will\n"
+           "have smaller rank than @var{array}.\n"
+           "\n"
+           "@lisp\n"
+           "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
+           "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
+           "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) 
@result{}\n"
+           "                #2((a 4) (b 5) (c 6))\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_transpose_array
+{
+  SCM res, vargs;
+  scm_t_array_dim *s, *r;
+  int ndim, i, k;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
+
+  if (scm_is_generalized_vector (ra))
+    {
+      /* Make sure that we are called with a single zero as
+        arguments. 
+      */
+      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
+       SCM_WRONG_NUM_ARGS ();
+      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
+      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
+      return ra;
+    }
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      vargs = scm_vector (args);
+      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
+       SCM_WRONG_NUM_ARGS ();
+      ndim = 0;
+      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+       {
+         i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
+                                    0, SCM_I_ARRAY_NDIM(ra));
+         if (ndim < i)
+           ndim = i;
+       }
+      ndim++;
+      res = scm_i_make_array (ndim);
+      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
+      for (k = ndim; k--;)
+       {
+         SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
+         SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
+       }
+      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+       {
+         i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
+         s = &(SCM_I_ARRAY_DIMS (ra)[k]);
+         r = &(SCM_I_ARRAY_DIMS (res)[i]);
+         if (r->ubnd < r->lbnd)
+           {
+             r->lbnd = s->lbnd;
+             r->ubnd = s->ubnd;
+             r->inc = s->inc;
+             ndim--;
+           }
+         else
+           {
+             if (r->ubnd > s->ubnd)
+               r->ubnd = s->ubnd;
+             if (r->lbnd < s->lbnd)
+               {
+                 SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+                 r->lbnd = s->lbnd;
+               }
+             r->inc += s->inc;
+           }
+       }
+      if (ndim > 0)
+       SCM_MISC_ERROR ("bad argument list", SCM_EOL);
+      scm_i_ra_set_contp (res);
+      return res;
+    }
+
+  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+/* attempts to unroll an array into a one-dimensional array.
+   returns the unrolled array or #f if it can't be done.  */
+  /* if strict is not SCM_UNDEFINED, return #f if returned array
+                    wouldn't have contiguous elements.  */
+SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
+           (SCM ra, SCM strict),
+           "If @var{array} may be @dfn{unrolled} into a one dimensional shared 
array\n"
+           "without changing their order (last subscript changing fastest), 
then\n"
+           "@code{array-contents} returns that shared array, otherwise it 
returns\n"
+           "@code{#f}.  All arrays made by @var{make-array} and\n"
+           "@var{make-uniform-array} may be unrolled, some arrays made by\n"
+           "@var{make-shared-array} may not be.\n\n"
+           "If the optional argument @var{strict} is provided, a shared array 
will\n"
+           "be returned only if its elements are stored internally contiguous 
in\n"
+           "memory.")
+#define FUNC_NAME s_scm_array_contents
+{
+  SCM sra;
+
+  if (scm_is_generalized_vector (ra))
+    return ra;
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
+      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
+       return SCM_BOOL_F;
+      for (k = 0; k < ndim; k++)
+       len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
+      if (!SCM_UNBNDP (strict) && scm_is_true (strict))
+       {
+         if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
+           return SCM_BOOL_F;
+         if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+           {
+             if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
+                 SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+                 len % SCM_LONG_BIT)
+               return SCM_BOOL_F;
+           }
+       }
+      
+      {
+       SCM v = SCM_I_ARRAY_V (ra);
+       size_t length = scm_c_generalized_vector_length (v);
+       if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS 
(ra)->inc)
+         return v;
+      }
+      
+      sra = scm_i_make_array (1);
+      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
+      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
+      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 
1].inc : 1);
+      return sra;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM 
+scm_ra2contig (SCM ra, int copy)
+{
+  SCM ret;
+  long inc = 1;
+  size_t k, len = 1;
+  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+  k = SCM_I_ARRAY_NDIM (ra);
+  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 
1].inc)))
+    {
+      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+       return ra;
+      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
+          0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+          0 == len % SCM_LONG_BIT))
+       return ra;
+    }
+  ret = scm_i_make_array (k);
+  SCM_I_ARRAY_BASE (ret) = 0;
+  while (k--)
+    {
+      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
+      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
+      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+    }
+  SCM_I_ARRAY_V (ret) = scm_make_generalized_vector (scm_array_type (ra),
+                                                     scm_from_long (inc),
+                                                     SCM_UNDEFINED);
+  if (copy)
+    scm_array_copy_x (ra, ret);
+  return ret;
+}
+
+
+
+SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+           "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] 
[start] [end]\n"
+           "Attempt to read all elements of @var{ura}, in lexicographic order, 
as\n"
+           "binary objects from @var{port-or-fdes}.\n"
+           "If an end of file is encountered,\n"
+           "the objects up to that point are put into @var{ura}\n"
+           "(starting at the beginning) and the remainder of the array is\n"
+           "unchanged.\n\n"
+           "The optional arguments @var{start} and @var{end} allow\n"
+           "a specified region of a vector (or linearized array) to be read,\n"
+           "leaving the remainder of the vector unchanged.\n\n"
+           "@code{uniform-array-read!} returns the number of objects read.\n"
+           "@var{port-or-fdes} may be omitted, in which case it defaults to 
the value\n"
+           "returned by @code{(current-input-port)}.")
+#define FUNC_NAME s_scm_uniform_array_read_x
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_input_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 0);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+       {
+         cstart = scm_to_unsigned_integer (start, 0, vlen);
+         if (!SCM_UNBNDP (end))
+           cend = scm_to_unsigned_integer (end, cstart, vlen);
+       }
+
+      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
+                                      scm_from_size_t (base + cstart),
+                                      scm_from_size_t (base + cend));
+
+      if (!scm_is_eq (cra, ura))
+       scm_array_copy_x (cra, ura);
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+           "Writes all elements of @var{ura} as binary objects to\n"
+           "@var{port-or-fdes}.\n\n"
+           "The optional arguments @var{start}\n"
+           "and @var{end} allow\n"
+           "a specified region of a vector (or linearized array) to be 
written.\n\n"
+           "The number of objects actually written is returned.\n"
+           "@var{port-or-fdes} may be\n"
+           "omitted, in which case it defaults to the value returned by\n"
+           "@code{(current-output-port)}.")
+#define FUNC_NAME s_scm_uniform_array_write
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_output_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_write (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 1);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+       {
+         cstart = scm_to_unsigned_integer (start, 0, vlen);
+         if (!SCM_UNBNDP (end))
+           cend = scm_to_unsigned_integer (end, cstart, vlen);
+       }
+
+      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
+                                     scm_from_size_t (base + cstart),
+                                     scm_from_size_t (base + cend));
+
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+
+static void
+list_to_array (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
+{
+  if (k == scm_array_handle_rank (handle))
+    scm_array_handle_set (handle, pos, lst);
+  else
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
+      ssize_t inc = dim->inc;
+      size_t len = 1 + dim->ubnd - dim->lbnd, n;
+      char *errmsg = NULL;
+
+      n = len;
+      while (n > 0 && scm_is_pair (lst))
+       {
+         list_to_array (SCM_CAR (lst), handle, pos, k + 1);
+         pos += inc;
+         lst = SCM_CDR (lst);
+         n -= 1;
+       }
+      if (n != 0)
+       errmsg = "too few elements for array dimension ~a, need ~a";
+      if (!scm_is_null (lst))
+       errmsg = "too many elements for array dimension ~a, want ~a";
+      if (errmsg)
+       scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
+                                                 scm_from_size_t (len)));
+    }
+}
+  
+
+SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
+           (SCM type, SCM shape, SCM lst),
+           "Return an array of the type @var{type}\n"
+           "with elements the same as those of @var{lst}.\n"
+           "\n"
+           "The argument @var{shape} determines the number of dimensions\n"
+           "of the array and their shape.  It is either an exact integer,\n"
+           "giving the\n"
+           "number of dimensions directly, or a list whose length\n"
+           "specifies the number of dimensions and each element specified\n"
+           "the lower and optionally the upper bound of the corresponding\n"
+           "dimension.\n"
+           "When the element is list of two elements, these elements\n"
+           "give the lower and upper bounds.  When it is an exact\n"
+           "integer, it gives only the lower bound.")
+#define FUNC_NAME s_scm_list_to_typed_array
+{
+  SCM row;
+  SCM ra;
+  scm_t_array_handle handle;
+
+  row = lst;
+  if (scm_is_integer (shape))
+    {
+      size_t k = scm_to_size_t (shape);
+      shape = SCM_EOL;
+      while (k-- > 0)
+       {
+         shape = scm_cons (scm_length (row), shape);
+         if (k > 0 && !scm_is_null (row))
+           row = scm_car (row);
+       }
+    }
+  else
+    {
+      SCM shape_spec = shape;
+      shape = SCM_EOL;
+      while (1)
+       {
+         SCM spec = scm_car (shape_spec);
+         if (scm_is_pair (spec))
+           shape = scm_cons (spec, shape);
+         else
+           shape = scm_cons (scm_list_2 (spec,
+                                         scm_sum (scm_sum (spec,
+                                                           scm_length (row)),
+                                                  scm_from_int (-1))),
+                             shape);
+         shape_spec = scm_cdr (shape_spec);
+         if (scm_is_pair (shape_spec))
+           {
+             if (!scm_is_null (row))
+               row = scm_car (row);
+           }
+         else
+           break;
+       }
+    }
+
+  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
+                            scm_reverse_x (shape, SCM_EOL));
+
+  scm_array_get_handle (ra, &handle);
+  list_to_array (lst, &handle, 0, 0);
+  scm_array_handle_release (&handle);
+
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
+           (SCM ndim, SCM lst),
+           "Return an array with elements the same as those of @var{lst}.")
+#define FUNC_NAME s_scm_list_to_array
+{
+  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
+}
+#undef FUNC_NAME
+
+/* Print dimension DIM of ARRAY.
+ */
+
+static int
+scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
+                            SCM port, scm_print_state *pstate)
+{
+  if (dim == h->ndims)
+    scm_iprin1 (scm_array_handle_ref (h, pos), port, pstate);
+  else
+    {
+      ssize_t i;
+      scm_putc ('(', port);
+      for (i = h->dims[dim].lbnd; i <= h->dims[dim].ubnd;
+           i++, pos += h->dims[dim].inc)
+        {
+          scm_i_print_array_dimension (h, dim+1, pos, port, pstate);
+          if (i < h->dims[dim].ubnd)
+            scm_putc (' ', port);
+        }
+      scm_putc (')', port);
+    }
+  return 1;
+}
+
+/* Print an array.
+*/
+
+static int
+scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
+{
+  scm_t_array_handle h;
+  long i;
+  int print_lbnds = 0, zero_size = 0, print_lens = 0;
+
+  scm_array_get_handle (array, &h);
+
+  scm_putc ('#', port);
+  if (h.ndims != 1 || h.dims[0].lbnd != 0)
+    scm_intprint (h.ndims, 10, port);
+  if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_write (scm_array_handle_element_type (&h), port);
+  
+  for (i = 0; i < h.ndims; i++)
+    {
+      if (h.dims[i].lbnd != 0)
+       print_lbnds = 1;
+      if (h.dims[i].ubnd - h.dims[i].lbnd + 1 == 0)
+       zero_size = 1;
+      else if (zero_size)
+       print_lens = 1;
+    }
+
+  if (print_lbnds || print_lens)
+    for (i = 0; i < h.ndims; i++)
+      {
+       if (print_lbnds)
+         {
+           scm_putc ('@', port);
+           scm_intprint (h.dims[i].lbnd, 10, port);
+         }
+       if (print_lens)
+         {
+           scm_putc (':', port);
+           scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
+                         10, port);
+         }
+      }
+
+  if (h.ndims == 0)
+    {
+      /* Rank zero arrays, which are really just scalars, are printed
+        specially.  The consequent way would be to print them as
+
+            #0 OBJ
+
+         where OBJ is the printed representation of the scalar, but we
+         print them instead as
+
+            #0(OBJ)
+
+         to make them look less strange.
+
+        Just printing them as
+
+            OBJ
+
+         would be correct in a way as well, but zero rank arrays are
+         not really the same as Scheme values since they are boxed and
+         can be modified with array-set!, say.
+      */
+      scm_putc ('(', port);
+      scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+      scm_putc (')', port);
+      return 1;
+    }
+  else
+    return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+}
+
+/* Read an array.  This function can also read vectors and uniform
+   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
+   handled here.
+
+   C is the first character read after the '#'.
+*/
+
+static SCM
+tag_to_type (const char *tag, SCM port)
+{
+  if (*tag == '\0')
+    return SCM_BOOL_T;
+  else
+    return scm_from_locale_symbol (tag);
+}
+
+static int
+read_decimal_integer (SCM port, int c, ssize_t *resp)
+{
+  ssize_t sign = 1;
+  ssize_t res = 0;
+  int got_it = 0;
+
+  if (c == '-')
+    {
+      sign = -1;
+      c = scm_getc (port);
+    }
+
+  while ('0' <= c && c <= '9')
+    {
+      res = 10*res + c-'0';
+      got_it = 1;
+      c = scm_getc (port);
+    }
+
+  if (got_it)
+    *resp = sign * res;
+  return c;
+}
+
+SCM
+scm_i_read_array (SCM port, int c)
+{
+  ssize_t rank;
+  int got_rank;
+  char tag[80];
+  int tag_len;
+
+  SCM shape = SCM_BOOL_F, elements;
+
+  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
+     the array code can not deal with zero-length dimensions yet, and
+     we want to allow zero-length vectors, of course.
+  */
+  if (c == '(')
+    {
+      scm_ungetc (c, port);
+      return scm_vector (scm_read (port));
+    }
+
+  /* Disambiguate between '#f' and uniform floating point vectors.
+   */
+  if (c == 'f')
+    {
+      c = scm_getc (port);
+      if (c != '3' && c != '6')
+       {
+         if (c != EOF)
+           scm_ungetc (c, port);
+         return SCM_BOOL_F;
+       }
+      rank = 1;
+      got_rank = 1;
+      tag[0] = 'f';
+      tag_len = 1;
+      goto continue_reading_tag;
+    }
+
+  /* Read rank. 
+   */
+  rank = 1;
+  c = read_decimal_integer (port, c, &rank);
+  if (rank < 0)
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
+                      SCM_EOL);
+
+  /* Read tag. 
+   */
+  tag_len = 0;
+ continue_reading_tag:
+  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
+    {
+      tag[tag_len++] = c;
+      c = scm_getc (port);
+    }
+  tag[tag_len] = '\0';
+  
+  /* Read shape. 
+   */
+  if (c == '@' || c == ':')
+    {
+      shape = SCM_EOL;
+      
+      do
+       {
+         ssize_t lbnd = 0, len = 0;
+         SCM s;
+
+         if (c == '@')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &lbnd);
+           }
+         
+         s = scm_from_ssize_t (lbnd);
+
+         if (c == ':')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &len);
+             if (len < 0)
+               scm_i_input_error (NULL, port,
+                                  "array length must be non-negative",
+                                  SCM_EOL);
+
+             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
+           }
+
+         shape = scm_cons (s, shape);
+       } while (c == '@' || c == ':');
+
+      shape = scm_reverse_x (shape, SCM_EOL);
+    }
+
+  /* Read nested lists of elements.
+   */
+  if (c != '(')
+    scm_i_input_error (NULL, port,
+                      "missing '(' in vector or array literal",
+                      SCM_EOL);
+  scm_ungetc (c, port);
+  elements = scm_read (port);
+
+  if (scm_is_false (shape))
+    shape = scm_from_ssize_t (rank);
+  else if (scm_ilength (shape) != rank)
+    scm_i_input_error 
+      (NULL, port,
+       "the number of shape specifications must match the array rank",
+       SCM_EOL);
+
+  /* Handle special print syntax of rank zero arrays; see
+     scm_i_print_array for a rationale.
+  */
+  if (rank == 0)
+    {
+      if (!scm_is_pair (elements))
+       scm_i_input_error (NULL, port,
+                          "too few elements in array literal, need 1",
+                          SCM_EOL);
+      if (!scm_is_null (SCM_CDR (elements)))
+       scm_i_input_error (NULL, port,
+                          "too many elements in array literal, want 1",
+                          SCM_EOL);
+      elements = SCM_CAR (elements);
+    }
+
+  /* Construct array. 
+   */
+  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
+}
+
+
+static SCM
+array_mark (SCM ptr)
+{
+  return SCM_I_ARRAY_V (ptr);
+}
+
+static size_t
+array_free (SCM ptr)
+{
+  scm_gc_free (SCM_I_ARRAY_MEM (ptr),
+              (sizeof (scm_i_t_array) 
+               + SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
+              "array");
+  return 0;
+}
+
+static SCM
+array_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos);
+}
+
+static void
+array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val);
+}
+
+/* FIXME: should be handle for vect? maybe not, because of dims */
+static void
+array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_handle vh;
+  scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
+  h->element_type = vh.element_type;
+  h->elements = vh.elements;
+  h->writable_elements = vh.writable_elements;
+  scm_array_handle_release (&vh);
+
+  h->dims = SCM_I_ARRAY_DIMS (array);
+  h->ndims = SCM_I_ARRAY_NDIM (array);
+  h->base = SCM_I_ARRAY_BASE (array);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_i_tc16_array, 0xffff,
+                          array_handle_ref, array_handle_set,
+                          array_get_handle);
+
+void
+scm_init_arrays ()
+{
+  scm_i_tc16_array = scm_make_smob_type ("array", 0);
+  scm_set_smob_mark (scm_i_tc16_array, array_mark);
+  scm_set_smob_free (scm_i_tc16_array, array_free);
+  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
+  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
+
+  scm_add_feature ("array");
+
+#include "libguile/arrays.x"
+
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/arrays.h b/libguile/arrays.h
new file mode 100644
index 0000000..35e5471
--- /dev/null
+++ b/libguile/arrays.h
@@ -0,0 +1,91 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_H
+#define SCM_ARRAY_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/print.h"
+
+
+
+/* Multidimensional arrays. Woo hoo!
+   Also see ....
+ */
+
+
+/** Arrays */
+
+SCM_API SCM scm_make_array (SCM fill, SCM bounds);
+SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
+SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
+                                             const void *bytes,
+                                             size_t byte_len);
+SCM_API SCM scm_shared_array_root (SCM ra);
+SCM_API SCM scm_shared_array_offset (SCM ra);
+SCM_API SCM scm_shared_array_increments (SCM ra);
+SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
+SCM_API SCM scm_transpose_array (SCM ra, SCM args);
+SCM_API SCM scm_array_contents (SCM ra, SCM strict);
+SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
+                                     SCM start, SCM end);
+SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
+                                    SCM start, SCM end);
+SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
+SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
+
+SCM_API SCM scm_ra2contig (SCM ra, int copy);
+
+/* internal. */
+
+typedef struct scm_i_t_array
+{
+  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
+  unsigned long base;
+} scm_i_t_array;
+
+SCM_API scm_t_bits scm_i_tc16_array;
+
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
+
+#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+
+#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) \
+  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+
+SCM_INTERNAL SCM scm_i_make_array (int ndim);
+SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
+
+SCM_INTERNAL void scm_init_arrays (void);
+
+#endif  /* SCM_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
new file mode 100644
index 0000000..f1d8473
--- /dev/null
+++ b/libguile/bitvectors.c
@@ -0,0 +1,910 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/smob.h"
+#include "libguile/strings.h"
+#include "libguile/array-handle.h"
+#include "libguile/bitvectors.h"
+#include "libguile/arrays.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/srfi-4.h"
+
+/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
+ * but alack, all we have is this crufty C.
+ */
+
+static scm_t_bits scm_tc16_bitvector;
+
+#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
+#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
+#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
+
+static size_t
+bitvector_free (SCM vec)
+{
+  scm_gc_free (BITVECTOR_BITS (vec),
+              sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
+              "bitvector");
+  return 0;
+}
+
+static int
+bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
+  size_t i, j;
+
+  scm_puts ("#*", port);
+  for (i = 0; i < word_len; i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
+       scm_putc ((bits[i] & mask)? '1' : '0', port);
+    }
+    
+  return 1;
+}
+
+static SCM
+bitvector_equalp (SCM vec1, SCM vec2)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec1);
+  size_t word_len = (bit_len + 31) / 32;
+  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
+  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
+  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
+
+  /* compare lengths */
+  if (BITVECTOR_LENGTH (vec2) != bit_len)
+    return SCM_BOOL_F;
+  /* avoid underflow in word_len-1 below. */
+  if (bit_len == 0)
+    return SCM_BOOL_T;
+  /* compare full words */
+  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
+    return SCM_BOOL_F;
+  /* compare partial last words */
+  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
+    return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+int
+scm_is_bitvector (SCM vec)
+{
+  return IS_BITVECTOR (vec);
+}
+
+SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} when @var{obj} is a bitvector, else\n"
+           "return @code{#f}.")
+#define FUNC_NAME s_scm_bitvector_p
+{
+  return scm_from_bool (scm_is_bitvector (obj));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_bitvector (size_t len, SCM fill)
+{
+  size_t word_len = (len + 31) / 32;
+  scm_t_uint32 *bits;
+  SCM res;
+
+  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
+                       "bitvector");
+  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+
+  if (!SCM_UNBNDP (fill))
+    scm_bitvector_fill_x (res, fill);
+      
+  return res;
+}
+
+SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
+           (SCM len, SCM fill),
+           "Create a new bitvector of length @var{len} and\n"
+           "optionally initialize all elements to @var{fill}.")
+#define FUNC_NAME s_scm_make_bitvector
+{
+  return scm_c_make_bitvector (scm_to_size_t (len), fill);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
+           (SCM bits),
+           "Create a new bitvector with the arguments as elements.")
+#define FUNC_NAME s_scm_bitvector
+{
+  return scm_list_to_bitvector (bits);
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_bitvector_length (SCM vec)
+{
+  scm_assert_smob_type (scm_tc16_bitvector, vec);
+  return BITVECTOR_LENGTH (vec);
+}
+
+SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
+           (SCM vec),
+           "Return the length of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_length
+{
+  return scm_from_size_t (scm_c_bitvector_length (vec));
+}
+#undef FUNC_NAME
+
+const scm_t_uint32 *
+scm_array_handle_bit_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+scm_t_uint32 *
+scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
+{
+  SCM vec = h->array;
+  if (SCM_I_ARRAYP (vec))
+    vec = SCM_I_ARRAY_V (vec);
+  if (IS_BITVECTOR (vec))
+    return BITVECTOR_BITS (vec) + h->base/32;
+  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+}
+
+size_t
+scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
+{
+  return h->base % 32;
+}
+
+const scm_t_uint32 *
+scm_bitvector_elements (SCM vec,
+                       scm_t_array_handle *h,
+                       size_t *offp,
+                       size_t *lenp,
+                       ssize_t *incp)
+{
+  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
+}
+
+
+scm_t_uint32 *
+scm_bitvector_writable_elements (SCM vec,
+                                scm_t_array_handle *h,
+                                size_t *offp,
+                                size_t *lenp,
+                                ssize_t *incp)
+{
+  scm_generalized_vector_get_handle (vec, h);
+  if (offp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *offp = scm_array_handle_bit_elements_offset (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+SCM
+scm_c_bitvector_ref (SCM vec, size_t idx)
+{
+  scm_t_array_handle handle;
+  const scm_t_uint32 *bits;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+    }
+  else
+    {
+      SCM res;
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+      scm_array_handle_release (&handle);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
+           (SCM vec, SCM idx),
+           "Return the element at index @var{idx} of the bitvector\n"
+           "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_ref
+{
+  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits, mask;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+    }
+  else
+    {
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+    }
+
+  mask = 1L << (idx%32);
+  if (scm_is_true (val))
+    bits[idx/32] |= mask;
+  else
+    bits[idx/32] &= ~mask;
+
+  if (!IS_BITVECTOR (vec))
+      scm_array_handle_release (&handle);
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+           (SCM vec, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the bitvector\n"
+           "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
+           (SCM vec, SCM val),
+           "Set all elements of the bitvector\n"
+           "@var{vec} when @var{val} is true, else clear them.")
+#define FUNC_NAME s_scm_bitvector_fill_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+
+      if (scm_is_true (val))
+       {
+         memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
+         bits[word_len-1] |= last_mask;
+       }
+      else
+       {
+         memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
+         bits[word_len-1] &= ~last_mask;
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       scm_array_handle_set (&handle, i*inc, val);
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
+           (SCM list),
+           "Return a new bitvector initialized with the elements\n"
+           "of @var{list}.")
+#define FUNC_NAME s_scm_list_to_bitvector
+{
+  size_t bit_len = scm_to_size_t (scm_length (list));
+  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
+                                                       NULL, NULL, NULL);
+  size_t i, j;
+
+  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      bits[i] = 0;
+      for (j = 0; j < 32 && j < bit_len;
+          j++, mask <<= 1, list = SCM_CDR (list))
+       if (scm_is_true (SCM_CAR (list)))
+         bits[i] |= mask;
+    }
+
+  scm_array_handle_release (&handle);
+
+  return vec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
+           (SCM vec),
+           "Return a new list initialized with the elements\n"
+           "of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_to_list
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  SCM res = SCM_EOL;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      size_t i, j;
+
+      for (i = 0; i < word_len; i++, len -= 32)
+       {
+         scm_t_uint32 mask = 1;
+         for (j = 0; j < 32 && j < len; j++, mask <<= 1)
+           res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
+    }
+
+  scm_array_handle_release (&handle);
+  
+  return scm_reverse_x (res, SCM_EOL);
+}
+#undef FUNC_NAME
+
+/* From mmix-arith.w by Knuth.
+
+  Here's a fun way to count the number of bits in a tetrabyte.
+
+  [This classical trick is called the ``Gillies--Miller method for
+  sideways addition'' in {\sl The Preparation of Programs for an
+  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
+  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
+  the tricks used here were suggested by Balbir Singh, Peter
+  Rossmanith, and Stefan Schwoon.]
+*/
+
+static size_t
+count_ones (scm_t_uint32 x)
+{
+  x=x-((x>>1)&0x55555555);
+  x=(x&0x33333333)+((x>>2)&0x33333333);
+  x=(x+(x>>4))&0x0f0f0f0f;
+  x=x+(x>>8);
+  return (x+(x>>16)) & 0xff;
+}
+
+SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
+           (SCM b, SCM bitvector),
+           "Return the number of occurrences of the boolean @var{b} in\n"
+           "@var{bitvector}.")
+#define FUNC_NAME s_scm_bit_count
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  int bit = scm_to_bool (b);
+  size_t count = 0;
+
+  bits = scm_bitvector_writable_elements (bitvector, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+       count += count_ones (bits[i]);
+      count += count_ones (bits[i] & last_mask);
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
+         count++;
+    }
+  
+  scm_array_handle_release (&handle);
+
+  return scm_from_size_t (bit? count : len-count);
+}
+#undef FUNC_NAME
+
+/* returns 32 for x == 0. 
+*/
+static size_t
+find_first_one (scm_t_uint32 x)
+{
+  size_t pos = 0;
+  /* do a binary search in x. */
+  if ((x & 0xFFFF) == 0)
+    x >>= 16, pos += 16;
+  if ((x & 0xFF) == 0)
+    x >>= 8, pos += 8;
+  if ((x & 0xF) == 0)
+    x >>= 4, pos += 4;
+  if ((x & 0x3) == 0)
+    x >>= 2, pos += 2;
+  if ((x & 0x1) == 0)
+    pos += 1;
+  return pos;
+}
+
+SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
+           (SCM item, SCM v, SCM k),
+           "Return the index of the first occurrance of @var{item} in bit\n"
+           "vector @var{v}, starting from @var{k}.  If there is no\n"
+           "@var{item} entry between @var{k} and the end of\n"
+           "@var{bitvector}, then return @code{#f}.  For example,\n"
+           "\n"
+           "@example\n"
+           "(bit-position #t #*000101 0)  @result{} 3\n"
+           "(bit-position #f #*0001111 3) @result{} #f\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_position
+{
+  scm_t_array_handle handle;
+  size_t off, len, first_bit;
+  ssize_t inc;
+  const scm_t_uint32 *bits;
+  int bit = scm_to_bool (item);
+  SCM res = SCM_BOOL_F;
+  
+  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
+  first_bit = scm_to_unsigned_integer (k, 0, len);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t i, word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t first_word = first_bit / 32;
+      scm_t_uint32 first_mask =
+       ((scm_t_uint32)-1) << (first_bit - 32*first_word);
+      scm_t_uint32 w;
+      
+      for (i = first_word; i < word_len; i++)
+       {
+         w = (bit? bits[i] : ~bits[i]);
+         if (i == first_word)
+           w &= first_mask;
+         if (i == word_len-1)
+           w &= last_mask;
+         if (w)
+           {
+             res = scm_from_size_t (32*i + find_first_one (w));
+             break;
+           }
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = first_bit; i < len; i++)
+       {
+         SCM elt = scm_array_handle_ref (&handle, i*inc);
+         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+           {
+             res = scm_from_size_t (i);
+             break;
+           }
+       }
+    }
+
+  scm_array_handle_release (&handle);
+
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+           "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+           "selecting the entries to change.  The return value is\n"
+           "unspecified.\n"
+           "\n"
+           "If @var{kv} is a bit vector, then those entries where it has\n"
+           "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
+           "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
+           "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
+           "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+           "\n"
+           "@example\n"
+           "(define bv #*01000010)\n"
+           "(bit-set*! bv #*10010001 #t)\n"
+           "bv\n"
+           "@result{} #*11010011\n"
+           "@end example\n"
+           "\n"
+           "If @var{kv} is a u32vector, then its elements are\n"
+           "indices into @var{v} which are set to @var{obj}.\n"
+           "\n"
+           "@example\n"
+           "(define bv #*01000010)\n"
+           "(bit-set*! bv #u32(5 2 7) #t)\n"
+           "bv\n"
+           "@result{} #*01100111\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  scm_t_uint32 *v_bits;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_writable_elements (v, &v_handle,
+                                           &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+                                       &kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+       scm_misc_error (NULL,
+                       "bit vectors must have equal length",
+                       SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+       {
+         size_t word_len = (kv_len + 31) / 32;
+         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+         size_t i;
+ 
+         if (bit == 0)
+           {
+             for (i = 0; i < word_len-1; i++)
+               v_bits[i] &= ~kv_bits[i];
+             v_bits[i] &= ~(kv_bits[i] & last_mask);
+           }
+         else
+           {
+             for (i = 0; i < word_len-1; i++)
+               v_bits[i] |= kv_bits[i];
+             v_bits[i] |= kv_bits[i] & last_mask;
+           }
+       }
+      else
+       {
+         size_t i;
+         for (i = 0; i < kv_len; i++)
+           if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
+             scm_array_handle_set (&v_handle, i*v_inc, obj);
+       }
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+       scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+           "Return a count of how many entries in bit vector @var{v} are\n"
+           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
+           "consider.\n"
+           "\n"
+           "If @var{kv} is a bit vector, then those entries where it has\n"
+           "@code{#t} are the ones in @var{v} which are considered.\n"
+           "@var{kv} and @var{v} must be the same length.\n"
+           "\n"
+           "If @var{kv} is a u32vector, then it contains\n"
+           "the indexes in @var{v} to consider.\n"
+           "\n"
+           "For example,\n"
+           "\n"
+           "@example\n"
+           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
+           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_count_star
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  const scm_t_uint32 *v_bits;
+  size_t count = 0;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_elements (v, &v_handle,
+                                  &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+                                       &kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+       scm_misc_error (NULL,
+                       "bit vectors must have equal length",
+                       SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+       {
+         size_t i, word_len = (kv_len + 31) / 32;
+         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+         scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
+
+         for (i = 0; i < word_len-1; i++)
+           count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
+         count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
+       }
+      else
+       {
+         size_t i;
+         for (i = 0; i < kv_len; i++)
+           if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
+             {
+               SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
+               if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+                 count++;
+             }
+       }
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+       {
+         SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+           count++;
+       }
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return scm_from_size_t (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
+           (SCM v),
+           "Modify the bit vector @var{v} by replacing each element with\n"
+           "its negation.")
+#define FUNC_NAME s_scm_bit_invert_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
+  
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+       bits[i] = ~bits[i];
+      bits[i] = bits[i] ^ last_mask;
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       scm_array_handle_set (&handle, i*inc,
+                             scm_not (scm_array_handle_ref (&handle, i*inc)));
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM
+scm_istr2bve (SCM str)
+{
+  scm_t_array_handle handle;
+  size_t len = scm_i_string_length (str);
+  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
+  SCM res = vec;
+
+  scm_t_uint32 mask;
+  size_t k, j;
+  const char *c_str;
+  scm_t_uint32 *data;
+
+  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
+  c_str = scm_i_string_chars (str);
+
+  for (k = 0; k < (len + 31) / 32; k++)
+    {
+      data[k] = 0L;
+      j = len - k * 32;
+      if (j > 32)
+       j = 32;
+      for (mask = 1L; j--; mask <<= 1)
+       switch (*c_str++)
+         {
+         case '0':
+           break;
+         case '1':
+           data[k] |= mask;
+           break;
+         default:
+           res = SCM_BOOL_F;
+           goto exit;
+         }
+    }
+  
+ exit:
+  scm_array_handle_release (&handle);
+  scm_remember_upto_here_1 (str);
+  return res;
+}
+
+/* FIXME: h->array should be h->vector */
+static SCM
+bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_bitvector_ref (h->array, pos);
+}
+
+static void
+bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_bitvector_set_x (h->array, pos, val);
+}
+
+static void
+bitvector_get_handle (SCM bv, scm_t_array_handle *h)
+{
+  h->array = bv;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT;
+  h->elements = h->writable_elements = BITVECTOR_BITS (bv);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
+                          bitvector_handle_ref, bitvector_handle_set,
+                          bitvector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
+
+void
+scm_init_bitvectors ()
+{
+  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
+  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
+  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
+  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
+
+#include "libguile/bitvectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
new file mode 100644
index 0000000..b6cf383
--- /dev/null
+++ b/libguile/bitvectors.h
@@ -0,0 +1,81 @@
+/* classes: h_files */
+
+#ifndef SCM_BITVECTORS_H
+#define SCM_BITVECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Bitvectors. Exciting stuff, maybe!
+ */
+
+
+/** Bit vectors */
+
+SCM_API SCM scm_bitvector_p (SCM vec);
+SCM_API SCM scm_bitvector (SCM bits);
+SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
+SCM_API SCM scm_bitvector_length (SCM vec);
+SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
+SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
+SCM_API SCM scm_list_to_bitvector (SCM list);
+SCM_API SCM scm_bitvector_to_list (SCM vec);
+SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
+
+SCM_API SCM scm_bit_count (SCM item, SCM seq);
+SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
+SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_invert_x (SCM v);
+SCM_API SCM scm_istr2bve (SCM str);
+
+SCM_API int scm_is_bitvector (SCM obj);
+SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
+SCM_API size_t scm_c_bitvector_length (SCM vec);
+SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle 
*h);
+SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements 
(scm_t_array_handle *h);
+SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
+SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
+                                                   scm_t_array_handle *h,
+                                                   size_t *offp,
+                                                   size_t *lenp,
+                                                   ssize_t *incp);
+SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
+                                                      scm_t_array_handle *h,
+                                                      size_t *offp,
+                                                      size_t *lenp,
+                                                      ssize_t *incp);
+
+SCM_INTERNAL void scm_init_bitvectors (void);
+
+#endif  /* SCM_BITVECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 24afd24..9c2b119 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -31,7 +31,9 @@
 #include "libguile/strings.h"
 #include "libguile/validate.h"
 #include "libguile/ieee-754.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/array-handle.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 
 #include <byteswap.h>
@@ -175,47 +177,99 @@
 
 scm_t_bits scm_tc16_bytevector;
 
-#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)   \
+#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
+#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
+  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
   SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
-#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf)          \
   SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
+#define SCM_BYTEVECTOR_SET_INLINE(bv)                                   \
+  SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)                          \
+  SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
+  SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
 
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
 static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, void *contents,
+                             scm_t_array_element_type element_type)
 {
-  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
-  SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+  SCM ret;
+  size_t c_len;
+  
+  if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                    || scm_i_array_element_type_sizes[element_type] < 8
+                    || len >= (SCM_I_SIZE_MAX
+                               / 
(scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+  
+  c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+  if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents);
+  else
+    {
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+      SCM_BYTEVECTOR_SET_INLINE (ret);
+      if (contents)
+        {
+          memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
+          scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
+        }
+    }
+  SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+  return ret;
 }
 
 static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
 {
-  SCM bv;
+  size_t c_len;
 
-  if (SCM_UNLIKELY (len == 0))
-    bv = scm_null_bytevector;
+  if (SCM_UNLIKELY (len == 0 && element_type == 0))
+    return scm_null_bytevector;
+  else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                         || scm_i_array_element_type_sizes[element_type] < 8
+                         || len >= (SCM_I_SIZE_MAX
+                                    / 
(scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+
+  c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
+  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    {
+      SCM ret;
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+      SCM_BYTEVECTOR_SET_INLINE (ret);
+      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+      return ret;
+    }
   else
     {
-      signed char *contents = NULL;
-
-      if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
-       contents = (signed char *) scm_gc_malloc (len, SCM_GC_BYTEVECTOR);
-
-      bv = make_bytevector_from_buffer (len, contents);
+      void *buf = scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+      return make_bytevector_from_buffer (len, buf, element_type);
     }
-
-  return bv;
 }
 
 /* Return a new bytevector of size LEN octets.  */
 SCM
 scm_c_make_bytevector (size_t len)
 {
-  return (make_bytevector (len));
+  return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+/* Return a new bytevector of size LEN elements.  */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  return make_bytevector (len, element_type);
 }
 
 /* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
@@ -223,22 +277,14 @@ scm_c_make_bytevector (size_t len)
 SCM
 scm_c_take_bytevector (signed char *contents, size_t len)
 {
-  SCM bv;
-
-  if (SCM_UNLIKELY (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)))
-    {
-      /* Copy CONTENTS into an "in-line" buffer, then free CONTENTS.  */
-      signed char *c_bv;
-
-      bv = make_bytevector (len);
-      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-      memcpy (c_bv, contents, len);
-      scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
-    }
-  else
-    bv = make_bytevector_from_buffer (len, contents);
+  return make_bytevector_from_buffer (len, contents, 
SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
 
-  return bv;
+SCM
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
+                             scm_t_array_element_type element_type)
+{
+  return make_bytevector_from_buffer (len, contents, element_type);
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
@@ -246,6 +292,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
 SCM
 scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
 {
+  if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+    /* This would be an internal Guile programming error */
+    abort ();
+
   if (!SCM_BYTEVECTOR_INLINE_P (bv))
     {
       size_t c_len;
@@ -259,6 +309,7 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
       if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
        {
          /* Copy to the in-line buffer and free the current buffer.  */
+          SCM_BYTEVECTOR_SET_INLINE (bv);
          c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
          memcpy (c_new_bv, c_bv, c_new_len);
          scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
@@ -271,6 +322,8 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
          SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
        }
     }
+  else
+    SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   return bv;
 }
@@ -329,38 +382,30 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 
value)
 }
 #undef FUNC_NAME
 
-/* This procedure is used by `scm_c_generalized_vector_set_x ()'.  */
-void
-scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
-#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
-{
-  scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
-}
-#undef FUNC_NAME
+
+
+
 
 static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  unsigned c_len, i;
-  unsigned char *c_bv;
-
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  ssize_t ubnd, inc, i;
+  scm_t_array_handle h;
+  
+  scm_array_get_handle (bv, &h);
 
-  scm_puts ("#vu8(", port);
-  for (i = 0; i < c_len; i++)
+  scm_putc ('#', port);
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc ('(', port);
+  for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+       i <= ubnd; i += inc)
     {
       if (i > 0)
        scm_putc (' ', port);
-
-      scm_uintprint (c_bv[i], 10, port);
+      scm_write (scm_array_handle_ref (&h, i), port);
     }
-
   scm_putc (')', port);
 
-  /* Make GCC think we use it.  */
-  scm_remember_upto_here ((SCM) pstate);
-
   return 1;
 }
 
@@ -448,7 +493,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       c_fill = (signed char) value;
     }
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (fill != SCM_UNDEFINED)
     {
       unsigned i;
@@ -574,7 +619,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 
-  copy = make_bytevector (c_len);
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -604,7 +649,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, 
"uniform-array->bytevector",
   len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
   sz = scm_array_handle_uniform_element_size (&h);
 
-  ret = make_bytevector (len * sz);
+  ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
 
   scm_array_handle_release (&h);
@@ -693,7 +738,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, 
"u8-list->bytevector", 1, 0, 0,
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1130,7 +1175,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, 
"bytevector->uint-list",
   if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))   \
     scm_out_of_range (FUNC_NAME, size);                                        
\
                                                                        \
-  bv = make_bytevector (c_len * c_size);                               \
+  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);     \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                                
\
                                                                        \
   for (c_bv_ptr = c_bv;                                                        
\
@@ -1629,6 +1674,12 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
    _c_type ## _to_foreign_endianness
 
 
+/* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */
+#define VALIDATE_REAL(pos, v) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, 
"real"); \
+  } while (0)
+
 /* Templace getters and setters.  */
 
 #define IEEE754_ACCESSOR_PROLOGUE(_type)                       \
@@ -1665,7 +1716,7 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
   _type c_value;                                               \
                                                                \
   IEEE754_ACCESSOR_PROLOGUE (_type);                           \
-  SCM_VALIDATE_REAL (3, value);                                        \
+  VALIDATE_REAL (3, value);                                    \
   SCM_VALIDATE_SYMBOL (4, endianness);                         \
   c_value = IEEE754_FROM_SCM (_type) (value);                  \
                                                                \
@@ -1685,7 +1736,7 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
   _type c_value;                                       \
                                                        \
   IEEE754_ACCESSOR_PROLOGUE (_type);                   \
-  SCM_VALIDATE_REAL (3, value);                                \
+  VALIDATE_REAL (3, value);                            \
   c_value = IEEE754_FROM_SCM (_type) (value);          \
                                                        \
   memcpy (&c_bv[c_index], &c_value, sizeof (c_value)); \
@@ -1896,8 +1947,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM 
endianness)
                      scm_list_1 (str), err);                           \
   else                                                                 \
     /* C_UTF is null-terminated.  */                                   \
-    utf = scm_c_take_bytevector ((signed char *) c_utf,                        
\
-                                     c_utf_len);                       \
+    utf = scm_c_take_bytevector ((signed char *) c_utf, c_utf_len);     \
                                                                        \
   return (utf);
 
@@ -2059,6 +2109,127 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 
 
 
+/* Bytevectors as generalized vectors & arrays.  */
+
+
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+const scm_t_bytevector_ref_fn bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 
1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_ref, /* VU8 */
+  scm_bytevector_u8_ref, /* U8 */
+  scm_bytevector_s8_ref,
+  scm_bytevector_u16_native_ref,
+  scm_bytevector_s16_native_ref,
+  scm_bytevector_u32_native_ref,
+  scm_bytevector_s32_native_ref,
+  scm_bytevector_u64_native_ref,
+  scm_bytevector_s64_native_ref,
+  scm_bytevector_ieee_single_native_ref,
+  scm_bytevector_ieee_double_native_ref,
+  bytevector_ref_c32,
+  bytevector_ref_c64
+};
+
+static SCM
+bv_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  SCM byte_index;
+  scm_t_bytevector_ref_fn ref_fn;
+  
+  ref_fn = bytevector_ref_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  return ref_fn (h->array, byte_index);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/8] = scm_c_real_part (val);
+  contents[i/8 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+bytevector_set_c64 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/16] = scm_c_real_part (val);
+  contents[i/16 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
+
+const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 
1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_set_x, /* VU8 */
+  scm_bytevector_u8_set_x, /* U8 */
+  scm_bytevector_s8_set_x,
+  scm_bytevector_u16_native_set_x,
+  scm_bytevector_s16_native_set_x,
+  scm_bytevector_u32_native_set_x,
+  scm_bytevector_s32_native_set_x,
+  scm_bytevector_u64_native_set_x,
+  scm_bytevector_s64_native_set_x,
+  scm_bytevector_ieee_single_native_set_x,
+  scm_bytevector_ieee_double_native_set_x,
+  bytevector_set_c32,
+  bytevector_set_c64
+};
+
+static void
+bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
+{
+  SCM byte_index;
+  scm_t_bytevector_set_fn set_fn;
+  
+  set_fn = bytevector_set_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  set_fn (h->array, byte_index, val);
+}
+
+static void
+bytevector_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
+  h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
+}
+
+
 /* Initialization.  */
 
 void
@@ -2073,7 +2244,8 @@ scm_bootstrap_bytevectors (void)
   scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
 
   scm_null_bytevector =
-    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+    scm_gc_protect_object
+    (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol 
("big"));
@@ -2084,6 +2256,20 @@ scm_bootstrap_bytevectors (void)
   scm_c_register_extension ("libguile", "scm_init_bytevectors",
                            (scm_t_extension_init_func) scm_init_bytevectors,
                            NULL);
+
+  {
+    scm_t_array_implementation impl;
+    
+    impl.tag = scm_tc16_bytevector;
+    impl.mask = 0xffff;
+    impl.vref = bv_handle_ref;
+    impl.vset = bv_handle_set_x;
+    impl.get_handle = bytevector_get_handle;
+    scm_i_register_array_implementation (&impl);
+    scm_i_register_vector_constructor
+      (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
+       scm_make_bytevector);
+  }
 }
 
 void
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index cb27262..e29fe6d 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -116,17 +116,21 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
    i.e., without allocating memory beside the SMOB itself (a double cell).
    This optimization is necessary since small bytevectors are expected to be
    common.  */
-#define SCM_BYTEVECTOR_P(_bv)                  \
+#define SCM_BYTEVECTOR_P(_bv)                   \
   SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv)
-#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
-#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
-  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
-#define SCM_BYTEVECTOR_INLINE_P(_bv)                                \
-  (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (SCM_BYTEVECTOR_LENGTH (_bv)))
+#define SCM_F_BYTEVECTOR_INLINE 0x1
+#define SCM_BYTEVECTOR_INLINE_P(_bv)            \
+  (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)       \
+  (SCM_SMOB_FLAGS (_bv) >> 8)
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
 
+SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, 
scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+                                              scm_t_array_element_type);
+
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);
 
diff --git a/libguile/convert.c b/libguile/convert.c
deleted file mode 100644
index d87d724..0000000
--- a/libguile/convert.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/* Copyright (C) 2002, 2006 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 3 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
- */
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/pairs.h"
-#include "libguile/unif.h"
-#include "libguile/srfi-4.h"
-
-#include "libguile/convert.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-/* char *scm_c_scm2chars (SCM obj, char *dst);
-   SCM   scm_c_chars2scm (const char *src, long n);
-   SCM   scm_c_chars2byvect (const char *src, long n);
-*/
-
-#define CTYPE            char
-#define FROM_CTYPE       scm_from_char
-#define SCM2CTYPES       scm_c_scm2chars
-#define CTYPES2SCM       scm_c_chars2scm
-#define CTYPES2UVECT     scm_c_chars2byvect
-#if CHAR_MIN == 0
-/* 'char' is unsigned. */
-#define UVEC_TAG         u8
-#define UVEC_CTYPE       scm_t_uint8
-#else
-/* 'char' is signed. */
-#define UVEC_TAG         s8
-#define UVEC_CTYPE       scm_t_int8
-#endif
-#include "libguile/convert.i.c"
-
-/* short *scm_c_scm2shorts (SCM obj, short *dst);
-   SCM scm_c_shorts2scm (const short *src, long n);
-   SCM scm_c_shorts2svect (const short *src, long n);
-*/
-
-#define CTYPE            short
-#define FROM_CTYPE       scm_from_short
-#define SCM2CTYPES       scm_c_scm2shorts
-#define CTYPES2SCM       scm_c_shorts2scm
-#define CTYPES2UVECT     scm_c_shorts2svect
-#define UVEC_TAG         s16
-#define UVEC_CTYPE       scm_t_int16
-#include "libguile/convert.i.c"
-
-/* int *scm_c_scm2ints (SCM obj, int *dst);
-   SCM scm_c_ints2scm (const int *src, long n);
-   SCM scm_c_ints2ivect (const int *src, long n);
-   SCM scm_c_uints2uvect (const unsigned int *src, long n);
-*/
-
-#define CTYPE            int
-#define FROM_CTYPE       scm_from_int
-#define SCM2CTYPES       scm_c_scm2ints
-#define CTYPES2SCM       scm_c_ints2scm
-#define CTYPES2UVECT     scm_c_ints2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_uints2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* long *scm_c_scm2longs (SCM obj, long *dst);
-   SCM scm_c_longs2scm (const long *src, long n);
-   SCM scm_c_longs2ivect (const long *src, long n);
-   SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-*/
-
-#define CTYPE            long
-#define FROM_CTYPE       scm_from_long
-#define SCM2CTYPES       scm_c_scm2longs
-#define CTYPES2SCM       scm_c_longs2scm
-#define CTYPES2UVECT     scm_c_longs2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_ulongs2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* float *scm_c_scm2floats (SCM obj, float *dst);
-   SCM scm_c_floats2scm (const float *src, long n);
-   SCM scm_c_floats2fvect (const float *src, long n);
-*/
-
-#define CTYPE            float
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2floats
-#define CTYPES2SCM       scm_c_floats2scm
-#define CTYPES2UVECT     scm_c_floats2fvect
-#define UVEC_TAG         f32
-#define UVEC_CTYPE       float
-#include "libguile/convert.i.c"
-
-/* double *scm_c_scm2doubles (SCM obj, double *dst);
-   SCM scm_c_doubles2scm (const double *src, long n);
-   SCM scm_c_doubles2dvect (const double *src, long n);
-*/
-
-#define CTYPE            double
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2doubles
-#define CTYPES2SCM       scm_c_doubles2scm
-#define CTYPES2UVECT     scm_c_doubles2dvect
-#define UVEC_TAG         f64
-#define UVEC_CTYPE       double
-#include "libguile/convert.i.c"
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/convert.h b/libguile/convert.h
deleted file mode 100644
index 6ce7c22..0000000
--- a/libguile/convert.h
+++ /dev/null
@@ -1,51 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_CONVERT_H
-#define SCM_CONVERT_H
-
-/* Copyright (C) 2002, 2006 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 3 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
- */
-
-
-
-#include "libguile/__scm.h"
-
-SCM_API char *scm_c_scm2chars (SCM obj, char *dst);
-SCM_API short *scm_c_scm2shorts (SCM obj, short *dst);
-SCM_API int *scm_c_scm2ints (SCM obj, int *dst);
-SCM_API long *scm_c_scm2longs (SCM obj, long *dst);
-SCM_API float *scm_c_scm2floats (SCM obj, float *dst);
-SCM_API double *scm_c_scm2doubles (SCM obj, double *dst);
-
-SCM_API SCM scm_c_chars2scm (const char *src, long n);
-SCM_API SCM scm_c_shorts2scm (const short *src, long n);
-SCM_API SCM scm_c_ints2scm (const int *src, long n);
-SCM_API SCM scm_c_longs2scm (const long *src, long n);
-SCM_API SCM scm_c_floats2scm (const float *src, long n);
-SCM_API SCM scm_c_doubles2scm (const double *src, long n);
-
-SCM_API SCM scm_c_chars2byvect (const char *src, long n);
-SCM_API SCM scm_c_shorts2svect (const short *src, long n);
-SCM_API SCM scm_c_ints2ivect (const int *src, long n);
-SCM_API SCM scm_c_uints2uvect (const unsigned int *src, long n);
-SCM_API SCM scm_c_longs2ivect (const long *src, long n);
-SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-SCM_API SCM scm_c_floats2fvect (const float *src, long n);
-SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
-
-#endif /* SCM_CONVERT_H */
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
deleted file mode 100644
index 4e73bf9..0000000
--- a/libguile/convert.i.c
+++ /dev/null
@@ -1,171 +0,0 @@
-/* this file is #include'd (x times) by convert.c */
-
-/* You need to define the following macros before including this
-   template.  They are undefined at the end of this file to give a
-   clean slate for the next inclusion.
-
-   - CTYPE
-
-   The type of an element of the C array, for example 'char'.
-
-   - FROM_CTYPE
-
-   The function that converts a CTYPE to a SCM, for example
-   scm_from_char.
-
-   - UVEC_TAG
-
-   The tag of a suitable uniform vector that can hold the CTYPE, for
-   example 's8'.
-
-   - UVEC_CTYPE
-
-   The C type of an element of the uniform vector, for example
-   scm_t_int8.
-
-   - SCM2CTYPES
-
-   The name of the 'SCM-to-C' function, for example scm_c_scm2chars.
-
-   - CTYPES2SCM
-
-   The name of the 'C-to-SCM' function, for example, scm_c_chars2scm.
-
-   - CTYPES2UVECT
-
-   The name of the 'C-to-uniform-vector' function, for example
-   scm_c_chars2byvect.  It will create a uniform vector of kind
-   UVEC_TAG.
-
-   - CTYPES2UVECT_2
-
-   The name of a second 'C-to-uniform-vector' function.  Leave
-   undefined if you want only one such function.
-
-   - CTYPE_2
-   - UVEC_TAG_2
-   - UVEC_CTYPE_2
-
-   The tag and C type of the second kind of uniform vector, for use
-   with the function described above.
-
-*/
-
-/* The first level does not expand macros in the arguments. */
-#define paste(a1,a2,a3)   a1##a2##a3
-#define stringify(a)      #a
-
-/* But the second level does. */
-#define F(pre,T,suf)   paste(pre,T,suf)
-#define S(T)           stringify(T)
-
-/* Convert a vector, list or uniform vector into a C array.  If the
-   result array in argument 2 is NULL, malloc() a new one.
-*/
-
-CTYPE *
-SCM2CTYPES (SCM obj, CTYPE *data)
-{
-  scm_t_array_handle handle;
-  size_t i, len;
-  ssize_t inc;
-  const UVEC_CTYPE *uvec_elements;
-
-  obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
-  uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
-
-  if (data == NULL)
-    data = scm_malloc (len * sizeof (CTYPE));
-  for (i = 0; i < len; i++, uvec_elements += inc)
-    data[i] = uvec_elements[i];
-
-  scm_array_handle_release (&handle);
-
-  return data;
-}
-
-/* Converts a C array into a vector. */
-
-SCM
-CTYPES2SCM (const CTYPE *data, long n)
-{
-  long i;
-  SCM v;
-  
-  v = scm_c_make_vector (n, SCM_UNSPECIFIED);
-
-  for (i = 0; i < n; i++)
-    SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
-
-  return v;
-}
-
-/* Converts a C array into a uniform vector. */
-
-SCM
-CTYPES2UVECT (const CTYPE *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
-                                                            NULL, NULL);
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#ifdef CTYPE2UVECT_2
-
-SCM
-CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE_2 *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
-                                                              NULL, NULL);
-
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#endif
-
-#undef paste
-#undef stringify
-#undef F
-#undef S
-
-#undef CTYPE
-#undef FROM_CTYPE
-#undef UVEC_TAG
-#undef UVEC_CTYPE
-#undef SCM2CTYPES
-#undef CTYPES2SCM
-#undef CTYPES2UVECT
-#ifdef CTYPES2UVECT_2
-#undef CTYPES2UVECT_2
-#undef CTYPE_2
-#undef UVEC_TAG_2
-#undef UVEC_CTYPE_2
-#endif
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index ed3a11e..6ecef3b 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -34,6 +34,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"
@@ -1314,7 +1315,7 @@ scm_i_arrayp (SCM a)
 {
   scm_c_issue_deprecation_warning
     ("SCM_ARRAYP is deprecated.  Use scm_is_array instead.");
-  return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a);
+  return SCM_I_ARRAYP(a);
 }
 
 size_t
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 5b443c7..ad62a2b 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,7 +5,7 @@
 #ifndef SCM_DEPRECATED_H
 #define SCM_DEPRECATED_H
 
-/* Copyright (C) 2003,2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2003,2004, 2005, 2006, 2007, 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
@@ -24,6 +24,7 @@
  */
 
 #include "libguile/__scm.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 
 #if (SCM_ENABLE_DEPRECATED == 1)
diff --git a/libguile/eq.c b/libguile/eq.c
index 255c381..11dee27 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 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
@@ -22,13 +22,13 @@
 #endif
 
 #include "libguile/_scm.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/stackchk.h"
 #include "libguile/strorder.h"
 #include "libguile/async.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/vectors.h"
 
 #include "libguile/struct.h"
diff --git a/libguile/extensions.c b/libguile/extensions.c
index 54351dd..d01e9c6 100644
--- a/libguile/extensions.c
+++ b/libguile/extensions.c
@@ -1,6 +1,6 @@
 /* extensions.c - registering and loading extensions.
  *
- * Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2006, 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
@@ -41,7 +41,7 @@ typedef struct extension_t
   void *data;
 } extension_t;
 
-static extension_t *registered_extensions;
+static extension_t *registered_extensions = NULL;
 
 /* Register a LIB/INIT pair for use by `scm_load_extension'.  LIB is
    allowed to be NULL and then only INIT is used to identify the
@@ -157,7 +157,6 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
 void
 scm_init_extensions ()
 {
-  registered_extensions = NULL;
 #include "libguile/extensions.x"
 }
 
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index af29233..aa40312 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -43,7 +43,7 @@
 #include "libguile/strings.h"
 #include "libguile/struct.h"
 #include "libguile/tags.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 0a7220e..6e9120e 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 
2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 
2008, 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
@@ -37,7 +37,7 @@ extern unsigned long * 
__libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index bb307b4..cc881e8 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -38,7 +38,7 @@ extern unsigned long * 
__libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/programs.h"
 #include "libguile/ports.h"
diff --git a/libguile/gc.c b/libguile/gc.c
index b7a3bf0..01f5eff 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 
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
@@ -33,7 +33,7 @@
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
new file mode 100644
index 0000000..6394405
--- /dev/null
+++ b/libguile/generalized-arrays.c
@@ -0,0 +1,276 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+
+
+int
+scm_is_array (SCM obj)
+{
+  return scm_i_array_implementation_for_obj (obj) ? 1 : 0;
+}
+
+SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
+           "not.")
+#define FUNC_NAME s_scm_array_p
+{
+  return scm_from_bool (scm_is_array (obj));
+}
+#undef FUNC_NAME
+
+int
+scm_is_typed_array (SCM obj, SCM type)
+{
+  int ret = 0;
+  if (scm_i_array_implementation_for_obj (obj))
+    {
+      scm_t_array_handle h;
+
+      scm_array_get_handle (obj, &h);
+      ret = scm_is_eq (scm_array_handle_element_type (&h), type);
+      scm_array_handle_release (&h);
+    }
+
+  return ret;
+}
+
+SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
+           (SCM obj, SCM type),
+           "Return @code{#t} if the @var{obj} is an array of type\n"
+           "@var{type}, and @code{#f} if not.")
+#define FUNC_NAME s_scm_typed_array_p
+{
+  return scm_from_bool (scm_is_typed_array (obj, type));
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_array_rank (SCM array)
+{
+  scm_t_array_handle handle;
+  size_t res;
+
+  scm_array_get_handle (array, &handle);
+  res = scm_array_handle_rank (&handle);
+  scm_array_handle_release (&handle);
+  return res;
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
+           (SCM array),
+           "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+  return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
+           (SCM ra),
+           "@code{array-dimensions} is similar to @code{array-shape} but 
replaces\n"
+           "elements with a @code{0} minimum with one greater than the 
maximum. So:\n"
+           "@lisp\n"
+           "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 
5)\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_array_dimensions
+{
+  scm_t_array_handle handle;
+  scm_t_array_dim *s;
+  SCM res = SCM_EOL;
+  size_t k;
+      
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  k = scm_array_handle_rank (&handle);
+
+  while (k--)
+    res = scm_cons (s[k].lbnd
+                   ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
+                                scm_from_ssize_t (s[k].ubnd),
+                                SCM_EOL)
+                   : scm_from_ssize_t (1 + s[k].ubnd),
+                   res);
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+/* HACK*/
+#include "libguile/bytevectors.h"
+
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
+           (SCM ra),
+           "")
+#define FUNC_NAME s_scm_array_type
+{
+  scm_t_array_handle h;
+  SCM type;
+
+  /* a hack, until srfi-4 and bytevectors are reunited */
+  if (scm_is_bytevector (ra))
+    return scm_from_locale_symbol ("vu8");
+
+  scm_array_get_handle (ra, &h);
+  type = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  
+  return type;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
+           (SCM ra, SCM args),
+           "Return @code{#t} if its arguments would be acceptable to\n"
+           "@code{array-ref}.")
+#define FUNC_NAME s_scm_array_in_bounds_p
+{
+  SCM res = SCM_BOOL_T;
+  size_t k, ndim;
+  scm_t_array_dim *s;
+  scm_t_array_handle handle;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  ndim = scm_array_handle_rank (&handle);
+
+  for (k = 0; k < ndim; k++)
+    {
+      long ind;
+
+      if (!scm_is_pair (args))
+        SCM_WRONG_NUM_ARGS ();
+      ind = scm_to_long (SCM_CAR (args));
+      args = SCM_CDR (args);
+
+      if (ind < s[k].lbnd || ind > s[k].ubnd)
+        {
+          res = SCM_BOOL_F;
+          /* We do not stop the checking after finding a violation
+             since we want to validate the type-correctness and
+             number of arguments in any case.
+          */
+        }
+    }
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
+           (SCM v, SCM args),
+           "Return the element at the @code{(index1, index2)} element in\n"
+           "@var{array}.")
+#define FUNC_NAME s_scm_array_ref
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (v, &handle);
+  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
+           (SCM v, SCM obj, SCM args),
+           "Set the element at the @code{(index1, index2)} element in 
@var{array} to\n"
+           "@var{new-value}.  The value returned by array-set! is 
unspecified.")
+#define FUNC_NAME s_scm_array_set_x           
+{
+  scm_t_array_handle handle;
+
+  scm_array_get_handle (v, &handle);
+  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
+  scm_array_handle_release (&handle);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM 
+array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos)
+{
+  if (dim == scm_array_handle_rank (h))
+    return scm_array_handle_ref (h, pos);
+  else
+    {
+      SCM res = SCM_EOL;
+      long inc;
+      size_t i, lbnd;
+
+      i = h->dims[dim].ubnd;
+      lbnd = h->dims[dim].lbnd;
+      inc = h->dims[dim].inc;
+      pos += (i - h->dims[dim].ubnd) * inc;
+
+      for (; i >= lbnd; i--, pos -= inc)
+        res = scm_cons (array_to_list (h, dim + 1, pos), res);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
+            (SCM array),
+           "FIXME description a list consisting of all the elements, in order, 
of\n"
+           "@var{array}.")
+#define FUNC_NAME s_scm_array_to_list
+{
+  scm_t_array_handle h;
+  SCM res;  
+  
+  scm_array_get_handle (array, &h);
+  res = array_to_list (&h, 0, 0);
+  scm_array_handle_release (&h);
+
+  return res;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_arrays ()
+{
+#include "libguile/generalized-arrays.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
new file mode 100644
index 0000000..cc7214e
--- /dev/null
+++ b/libguile/generalized-arrays.h
@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_ARRAYS_H
+#define SCM_GENERALIZED_ARRAYS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* These functions operate on all kinds of arrays that Guile knows about.
+ */
+
+
+/** Arrays */
+
+SCM_API int scm_is_array (SCM obj);
+SCM_API SCM scm_array_p (SCM v);
+
+SCM_API int scm_is_typed_array (SCM obj, SCM type);
+SCM_API SCM scm_typed_array_p (SCM v, SCM type);
+
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
+SCM_API SCM scm_array_dimensions (SCM ra);
+SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
+
+SCM_API SCM scm_array_ref (SCM v, SCM args);
+SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
+SCM_API SCM scm_array_to_list (SCM v);
+
+SCM_INTERNAL void scm_init_generalized_arrays (void);
+
+
+#endif  /* SCM_GENERALIZED_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
new file mode 100644
index 0000000..2d437a4
--- /dev/null
+++ b/libguile/generalized-vectors.c
@@ -0,0 +1,201 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
+
+
+struct scm_t_vector_ctor
+{
+  SCM tag;
+  SCM (*ctor)(SCM, SCM);
+};
+
+#define VECTOR_CTORS_N_STATIC_ALLOC 20
+static struct scm_t_vector_ctor vector_ctors[VECTOR_CTORS_N_STATIC_ALLOC];
+static int num_vector_ctors_registered = 0;
+
+void
+scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM))
+{
+  if (num_vector_ctors_registered >= VECTOR_CTORS_N_STATIC_ALLOC)
+    /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    { 
+      vector_ctors[num_vector_ctors_registered].tag = type;
+      vector_ctors[num_vector_ctors_registered].ctor = ctor;
+      num_vector_ctors_registered++;
+    }
+}
+
+SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
+            (SCM type, SCM len, SCM fill),
+            "Make a generalized vector")
+#define FUNC_NAME s_scm_make_generalized_vector
+{
+  int i;
+  for (i = 0; i < num_vector_ctors_registered; i++)
+    if (vector_ctors[i].tag == type)
+      return vector_ctors[i].ctor(len, fill);
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type");
+}
+#undef FUNC_NAME
+
+int
+scm_is_generalized_vector (SCM obj)
+{
+  int ret = 0;
+  if (scm_is_array (obj))
+    {
+      scm_t_array_handle h;
+      scm_array_get_handle (obj, &h);
+      ret = scm_array_handle_rank (&h) == 1;
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if @var{obj} is a vector, string,\n"
+           "bitvector, or uniform numeric vector.")
+#define FUNC_NAME s_scm_generalized_vector_p
+{
+  return scm_from_bool (scm_is_generalized_vector (obj));
+}
+#undef FUNC_NAME
+
+#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
+  scm_generalized_vector_get_handle (val, handle)
+   
+
+void
+scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
+{
+  scm_array_get_handle (vec, h);
+  if (scm_array_handle_rank (h) != 1)
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
+    }
+}
+
+size_t
+scm_c_generalized_vector_length (SCM v)
+{
+  scm_t_array_handle h;
+  size_t ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 
0,
+           (SCM v),
+           "Return the length of the generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_length
+{
+  return scm_from_size_t (scm_c_generalized_vector_length (v));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_generalized_vector_ref (SCM v, size_t idx)
+{
+  scm_t_array_handle h;
+  SCM ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.impl->vref (&h, idx);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
+           (SCM v, SCM idx),
+           "Return the element at index @var{idx} of the\n"
+           "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_ref
+{
+  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  h.impl->vset (&h, idx, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
+           (SCM v, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the\n"
+           "generalized vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_generalized_vector_set_x
+{
+  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 
0,
+           (SCM v),
+           "Return a new list whose elements are the elements of the\n"
+           "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_to_list
+{
+  SCM ret = SCM_EOL;
+  ssize_t pos, i = 0;
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  // FIXME CHECKME
+  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
+       i >= 0;
+       pos += h.dims[0].inc)
+    ret = scm_cons (h.impl->vref (&h, pos), ret);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_vectors ()
+{
+#include "libguile/generalized-vectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
new file mode 100644
index 0000000..71b58d2
--- /dev/null
+++ b/libguile/generalized-vectors.h
@@ -0,0 +1,61 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_VECTORS_H
+#define SCM_GENERALIZED_VECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Generalized vectors */
+
+SCM_API SCM scm_generalized_vector_p (SCM v);
+SCM_API SCM scm_generalized_vector_length (SCM v);
+SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_generalized_vector_to_list (SCM v);
+
+SCM_API int scm_is_generalized_vector (SCM obj);
+SCM_API size_t scm_c_generalized_vector_length (SCM v);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API void scm_generalized_vector_get_handle (SCM vec,
+                                               scm_t_array_handle *h);
+
+SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
+SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM 
(*ctor)(SCM, SCM));
+
+#define SCM_VECTOR_IMPLEMENTATION(type, ctor)                   \
+  SCM_SNARF_INIT (scm_i_register_vector_constructor             \
+                  (scm_i_array_element_types[type], ctor))
+
+SCM_INTERNAL void scm_init_generalized_vectors (void);
+
+#endif  /* SCM_GENERALIZED_VECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/init.c b/libguile/init.c
index 5ece01f..da3bc0a 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -37,6 +37,7 @@
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/backtrace.h"
+#include "libguile/bitvectors.h"
 #include "libguile/boolean.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
@@ -62,6 +63,8 @@
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
@@ -92,7 +95,7 @@
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
 #include "libguile/properties.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/random.h"
 #include "libguile/rdelim.h"
 #include "libguile/read.h"
@@ -115,7 +118,7 @@
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
 #include "libguile/vectors.h"
@@ -125,6 +128,7 @@
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
 #include "libguile/extensions.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 #include "libguile/discouraged.h"
 #include "libguile/deprecated.h"
@@ -517,7 +521,19 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_sort ();
   scm_init_srcprop ();
   scm_init_stackchk ();
-  scm_init_strings ();
+
+  scm_init_array_handle ();
+  scm_init_generalized_arrays ();
+  scm_init_generalized_vectors ();
+  scm_init_vectors ();
+  scm_init_uniform ();
+  scm_init_bitvectors ();
+  scm_bootstrap_bytevectors ();
+  scm_init_srfi_4 ();
+  scm_init_arrays ();
+  scm_init_array_map ();
+
+  scm_init_strings ();  /* Requires array-handle */
   scm_init_struct ();   /* Requires strings */
   scm_init_stacks ();   /* Requires strings, struct */
   scm_init_symbols ();
@@ -531,7 +547,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_srfi_13 ();
   scm_init_srfi_14 ();
   scm_init_throw ();
-  scm_init_vectors ();
   scm_init_version ();
   scm_init_weaks ();
   scm_init_guardians ();
@@ -540,8 +555,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_evalext ();
   scm_init_debug ();   /* Requires macro smobs */
   scm_init_random ();
-  scm_init_ramap ();
-  scm_init_unif ();
   scm_init_simpos ();
   scm_init_load_path ();
   scm_init_standard_ports ();  /* Requires fports */
@@ -550,7 +563,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_lang ();
 #endif /* SCM_ENABLE_ELISP */
   scm_init_script ();
-  scm_init_srfi_4 ();
 
   scm_init_goops ();
 
@@ -574,7 +586,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_rw ();
   scm_init_extensions ();
 
-  scm_bootstrap_bytevectors ();
   scm_bootstrap_vm ();
 
   atexit (cleanup_for_exit);
diff --git a/libguile/inline.h b/libguile/inline.h
index b378345..574bbfc 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -3,7 +3,7 @@
 #ifndef SCM_INLINE_H
 #define SCM_INLINE_H
 
-/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, 
Inc.
+/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008, 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
@@ -34,8 +34,9 @@
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
 #include "libguile/threads.h"
-#include "libguile/unif.h"
+#include "libguile/array-handle.h"
 #include "libguile/ports.h"
+#include "libguile/numbers.h"
 #include "libguile/error.h"
 
 
@@ -241,7 +242,11 @@ SCM_C_EXTERN_INLINE
 SCM
 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 {
-  return h->ref (h, p);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  return h->impl->vref (h, h->base + p);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@@ -250,7 +255,11 @@ SCM_C_EXTERN_INLINE
 void
 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 {
-  h->set (h, p, v);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  h->impl->vset (h, h->base + p, v);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
diff --git a/libguile/print.c b/libguile/print.c
index 520a2d9..4d206eb 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -36,7 +36,6 @@
 #include "libguile/read.h"
 #include "libguile/weaks.h"
 #include "libguile/programs.h"
-#include "libguile/unif.h"
 #include "libguile/alist.h"
 #include "libguile/struct.h"
 #include "libguile/objects.h"
diff --git a/libguile/random.c b/libguile/random.c
index d7a1ffb..32c770a 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006 Free Software Foundation, 
Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 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 3 of
@@ -33,9 +33,10 @@
 #include "libguile/numbers.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/srfi-4.h"
 #include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/random.h"
diff --git a/libguile/read.c b/libguile/read.c
index 8abdf07..821e01c 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -34,7 +34,8 @@
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
 #include "libguile/keywords.h"
 #include "libguile/alist.h"
 #include "libguile/srcprop.h"
diff --git a/libguile/socket.c b/libguile/socket.c
index d463d04..3a81ed9 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 
Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 
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
@@ -27,7 +27,7 @@
 #include <gmp.h>
 
 #include "libguile/_scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/feature.h"
 #include "libguile/fports.h"
 #include "libguile/strings.h"
diff --git a/libguile/sort.c b/libguile/sort.c
index 644526e..a9e4dda 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008, 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 3 of
@@ -39,8 +39,8 @@
 
 #include "libguile/_scm.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
 #include "libguile/feature.h"
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index da571b0..67894b3 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -29,13 +29,17 @@
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
 #include "libguile/srfi-4.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/uniform.h"
 #include "libguile/error.h"
+#include "libguile/eval.h"
 #include "libguile/read.h"
 #include "libguile/ports.h"
 #include "libguile/chars.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 #include "libguile/strports.h"
 #include "libguile/dynwind.h"
@@ -496,11 +500,8 @@ uvec_to_list (int type, SCM uvec)
   SCM res = SCM_EOL;
 
   elts = uvec_elements (type, uvec, &handle, &len, &inc);
-  for (i = len*inc; i > 0;)
-    {
-      i -= inc;
-      res = scm_cons (scm_array_handle_ref (&handle, i), res);
-    }
+  for (i = len - 1; i >= 0; i--)
+    res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
   scm_array_handle_release (&handle);
   return res;
 }
@@ -573,29 +574,6 @@ list_to_uvec (int type, SCM list)
   return uvec;
 }
 
-static SCM
-coerce_to_uvec (int type, SCM obj)
-{
-  if (is_uvec (type, obj))
-    return obj;
-  else if (scm_is_pair (obj))
-    return list_to_uvec (type, obj);
-  else if (scm_is_generalized_vector (obj))
-    {
-      scm_t_array_handle handle;
-      size_t len = scm_c_generalized_vector_length (obj), i;
-      SCM uvec = alloc_uvec (type, len);
-      scm_array_get_handle (uvec, &handle);
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i,
-                             scm_c_generalized_vector_ref (obj, i));
-      scm_array_handle_release (&handle);
-      return uvec;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, obj, "list or generalized vector");
-}
-
 SCM_SYMBOL (scm_sym_a, "a");
 SCM_SYMBOL (scm_sym_b, "b");
 
@@ -616,222 +594,6 @@ scm_i_generalized_vector_type (SCM v)
     return SCM_BOOL_F;
 }
 
-int
-scm_is_uniform_vector (SCM obj)
-{
-  if (SCM_IS_UVEC (obj))
-    return 1;
-  if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
-    {
-      SCM v = SCM_I_ARRAY_V (obj);
-      return SCM_IS_UVEC (v);
-    }
-  return 0;
-}
-
-size_t
-scm_c_uniform_vector_length (SCM uvec)
-{
-  /* scm_generalized_vector_get_handle will ultimately call us to get
-     the length of uniform vectors, so we can't use uvec_elements for
-     naked vectors.
-  */
-
-  if (SCM_IS_UVEC (uvec))
-    return SCM_UVEC_LENGTH (uvec);
-  else
-    {
-      scm_t_array_handle handle;
-      size_t len;
-      ssize_t inc;
-      uvec_elements (-1, uvec, &handle, &len, &inc);
-      scm_array_handle_release (&handle);
-      return len;
-    }
-}
-
-SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if @var{obj} is a uniform vector.")
-#define FUNC_NAME s_scm_uniform_vector_p
-{
-  return scm_from_bool (scm_is_uniform_vector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_uniform_vector_ref (SCM v, size_t idx)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-  SCM res;
-
-  uvec_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  res = scm_array_handle_ref (&handle, idx*inc);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
-           (SCM v, SCM idx),
-           "Return the element at index @var{idx} of the\n"
-           "homogenous numeric vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_ref
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using a list as the index to uniform-vector-ref is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-       scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-
-  uvec_writable_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  scm_array_handle_set (&handle, idx*inc, val);
-  scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
-           (SCM v, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the\n"
-           "homogenous numeric vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_uniform_vector_set_x
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using a list as the index to uniform-vector-set! is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-       scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
-            (SCM uvec),
-           "Convert the uniform numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_scm_uniform_vector_to_list
-{
-  return uvec_to_list (-1, uvec);
-}
-#undef FUNC_NAME
-
-size_t
-scm_array_handle_uniform_element_size (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (scm_is_uniform_vector (vec))
-    return uvec_sizes[SCM_UVEC_TYPE(vec)];
-  if (scm_is_bytevector (vec))
-    return 1U;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
- 
-/* return the size of an element in a uniform array or 0 if type not
-   found.  */
-size_t
-scm_uniform_element_size (SCM obj)
-{
-  scm_c_issue_deprecation_warning 
-    ("scm_uniform_element_size is deprecated.  "
-     "Use scm_array_handle_uniform_element_size instead.");
-
-  if (SCM_IS_UVEC (obj))
-    return uvec_sizes[SCM_UVEC_TYPE(obj)];
-  else
-    return 0;
-}
-
-#endif
-
-const void *
-scm_array_handle_uniform_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-void *
-scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_IS_UVEC (vec))
-    {
-      size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];
-      char *elts = SCM_UVEC_BASE (vec);
-      return (void *) (elts + size*h->base);
-    }
-  if (scm_is_bytevector (vec))
-    return SCM_BYTEVECTOR_CONTENTS (vec);
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-const void *
-scm_uniform_vector_elements (SCM uvec, 
-                            scm_t_array_handle *h,
-                            size_t *lenp, ssize_t *incp)
-{
-  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
-void *
-scm_uniform_vector_writable_elements (SCM uvec, 
-                                     scm_t_array_handle *h,
-                                     size_t *lenp, ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (uvec, h);
-  if (lenp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
-           (SCM v),
-           "Return the number of elements in the uniform vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_length
-{
-  return uvec_length (-1, v);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
            (SCM uvec, SCM port_or_fd, SCM start, SCM end),
            "Fill the elements of @var{uvec} by reading\n"
@@ -1067,6 +829,36 @@ SCM_DEFINE (scm_uniform_vector_write, 
"uniform-vector-write", 1, 3, 0,
 #define CTYPE double
 #include "libguile/srfi-4.i.c"
 
+#define DEFINE_SCHEME_PROXY100(cname, modname, scmname)                 \
+  SCM cname (SCM arg1)                                                  \
+  {                                                                     \
+    static SCM var = SCM_BOOL_F;                                        \
+    if (scm_is_false (var))                                             \
+      var = scm_c_module_lookup (scm_c_resolve_module (modname), scmname); \
+    return scm_call_1 (SCM_VARIABLE_REF (var), arg1);                   \
+  }
+
+#define DEFPROXY100(cname, scmname)               \
+  DEFINE_SCHEME_PROXY100 (cname, MOD, scmname)
+
+#define DEFINE_SRFI_4_GNU_PROXIES(tag)                              \
+  DEFPROXY100 (scm_any_to_##tag##vector, "any->" #tag "vector")
+
+#define MOD "srfi srfi-4 gnu"
+DEFINE_SRFI_4_GNU_PROXIES (u8);
+DEFINE_SRFI_4_GNU_PROXIES (s8);
+DEFINE_SRFI_4_GNU_PROXIES (u16);
+DEFINE_SRFI_4_GNU_PROXIES (s16);
+DEFINE_SRFI_4_GNU_PROXIES (u32);
+DEFINE_SRFI_4_GNU_PROXIES (s32);
+DEFINE_SRFI_4_GNU_PROXIES (u64);
+DEFINE_SRFI_4_GNU_PROXIES (s64);
+DEFINE_SRFI_4_GNU_PROXIES (f32);
+DEFINE_SRFI_4_GNU_PROXIES (f64);
+DEFINE_SRFI_4_GNU_PROXIES (c32);
+DEFINE_SRFI_4_GNU_PROXIES (c64);
+
+
 static scm_i_t_array_ref uvec_reffers[12] = {
   u8ref, s8ref,
   u16ref, s16ref,
@@ -1085,18 +877,35 @@ static scm_i_t_array_set uvec_setters[12] = {
   c32set, c64set
 };
 
-scm_i_t_array_ref
-scm_i_uniform_vector_ref_proc (SCM uvec)
+static SCM
+uvec_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  return uvec_reffers [SCM_UVEC_TYPE(h->array)] (h, index);
+}
+
+static void
+uvec_handle_set (scm_t_array_handle *h, size_t index, SCM val)
 {
-  return uvec_reffers[SCM_UVEC_TYPE(uvec)];
+  uvec_setters [SCM_UVEC_TYPE(h->array)] (h, index, val);
 }
 
-scm_i_t_array_set
-scm_i_uniform_vector_set_proc (SCM uvec)
+static void
+uvec_get_handle (SCM v, scm_t_array_handle *h)
 {
-  return uvec_setters[SCM_UVEC_TYPE(uvec)];
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_UVEC_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_UVEC_TYPE (v) + SCM_ARRAY_ELEMENT_TYPE_U8;
+  h->elements = h->writable_elements = SCM_UVEC_BASE (v);
 }
 
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_uvec, 0xffff,
+                          uvec_handle_ref, uvec_handle_set,
+                          uvec_get_handle);
+
 void
 scm_init_srfi_4 (void)
 {
@@ -1119,6 +928,24 @@ scm_init_srfi_4 (void)
     scm_permanent_object (scm_c_read_string ("9223372036854775807"));
 #endif
 
+#define REGISTER(tag, TAG)                                       \
+  scm_i_register_vector_constructor                              \
+    (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG],    \
+     scm_make_##tag##vector)
+
+  REGISTER (u8, U8); 
+  REGISTER (s8, S8); 
+  REGISTER (u16, U16);
+  REGISTER (s16, S16);
+  REGISTER (u32, U32);
+  REGISTER (s32, S32);
+  REGISTER (u64, U64);
+  REGISTER (s64, S64);
+  REGISTER (f32, F32);
+  REGISTER (f64, F64);
+  REGISTER (c32, C32);
+  REGISTER (c64, C64);
+
 #include "libguile/srfi-4.x"
 
 }
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index a1a9baf..3a45fd9 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -2,7 +2,7 @@
 #define SCM_SRFI_4_H
 /* srfi-4.c --- Homogeneous numeric vector datatypes.
  *
- *     Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+ *     Copyright (C) 2001, 2004, 2006, 2008, 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
@@ -22,35 +22,6 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
-
-/* Generic procedures.
- */
-
-SCM_API SCM scm_uniform_vector_p (SCM v);
-SCM_API SCM scm_uniform_vector_length (SCM v);
-SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_uniform_vector_to_list (SCM v);
-SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
-                                      SCM start, SCM end);
-SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
-                                     SCM start, SCM end);
-
-SCM_API int scm_is_uniform_vector (SCM obj);
-SCM_API size_t scm_c_uniform_vector_length (SCM v);
-SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
-SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
-SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle 
*h);
-SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
-                                                scm_t_array_handle *h,
-                                                size_t *lenp, ssize_t *incp);
-SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
-                                                   scm_t_array_handle *h,
-                                                   size_t *lenp,
-                                                   ssize_t *incp);
 
 /* Specific procedures.
  */
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index 58a52c1..cecd6c6 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -121,17 +121,6 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), 
"list->"S(TAG)"vector", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
-           (SCM obj),
-           "Convert @var{obj}, which can be a list, vector, or\n"
-           "uniform vector, to a numeric uniform vector of\n"
-           "type " S(TAG)".")
-#define FUNC_NAME s_F(scm_any_to_,TAG,vector)
-{
-  return coerce_to_uvec (TYPE, obj);
-}
-#undef FUNC_NAME
-
 #ifdef CTYPE
 
 SCM
@@ -187,13 +176,13 @@ F(scm_,TAG,vector_writable_elements) (SCM uvec,
 #endif
 
 static SCM
-F(,TAG,ref) (scm_t_array_handle *handle, ssize_t pos)
+F(,TAG,ref) (scm_t_array_handle *handle, size_t pos)
 {
   return uvec_fast_ref (TYPE, handle->elements, pos);
 }
 
 static void
-F(,TAG,set) (scm_t_array_handle *handle, ssize_t pos, SCM val)
+F(,TAG,set) (scm_t_array_handle *handle, size_t pos, SCM val)
 {
   uvec_fast_set_x (TYPE, handle->writable_elements, pos, val);
 }
diff --git a/libguile/strings.c b/libguile/strings.c
index 5f5e4c6..4a8390d 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -34,6 +34,7 @@
 #include "libguile/chars.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/deprecation.h"
 #include "libguile/validate.h"
 #include "libguile/dynwind.h"
@@ -1962,6 +1963,36 @@ scm_i_deprecated_string_length (SCM str)
 
 #endif
 
+static SCM
+string_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  return scm_c_string_ref (h->array, index);
+}
+
+static void
+string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
+{
+  scm_c_string_set_x (h->array, index, val);
+}
+
+static void
+string_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = scm_c_string_length (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR;
+  h->elements = h->writable_elements = NULL;
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f & ~2,
+                          string_handle_ref, string_handle_set,
+                          string_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string);
+
 void
 scm_init_strings ()
 {
diff --git a/libguile/strports.c b/libguile/strports.c
index ed6275b..490a15f 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -30,7 +30,7 @@
 #include <unistd.h>
 #endif
 
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/eval.h"
 #include "libguile/ports.h"
 #include "libguile/read.h"
diff --git a/libguile/unif.c b/libguile/unif.c
deleted file mode 100644
index cf39d05..0000000
--- a/libguile/unif.c
+++ /dev/null
@@ -1,3031 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
- */
-
-
-/*
-  This file has code for arrays in lots of variants (double, integer,
-  unsigned etc. ). It suffers from hugely repetitive code because
-  there is similar (but different) code for every variant included. (urg.)
-
-  --hwn
-*/
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <stdio.h>
-#include <errno.h>
-#include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/eq.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"
-#include "libguile/smob.h"
-#include "libguile/feature.h"
-#include "libguile/root.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-4.h"
-#include "libguile/vectors.h"
-#include "libguile/bytevectors.h"
-#include "libguile/list.h"
-#include "libguile/deprecation.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/validate.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
-#include "libguile/print.h"
-#include "libguile/read.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#ifdef HAVE_IO_H
-#include <io.h>
-#endif
-
-
-/* The set of uniform scm_vector types is:
- *  Vector of:          Called:   Replaced by:
- * unsigned char       string
- * char                        byvect     s8 or u8, depending on signedness of 
'char'
- * boolean             bvect      
- * signed long         ivect      s32
- * unsigned long       uvect      u32
- * float               fvect      f32
- * double              dvect      d32
- * complex double      cvect      c64
- * short               svect      s16
- * long long           llvect     s64
- */
-
-scm_t_bits scm_i_tc16_array;
-scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
SCM_I_ARRAY_FLAG_CONTIGUOUS))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~SCM_I_ARRAY_FLAG_CONTIGUOUS))
-
-typedef SCM creator_proc (SCM len, SCM fill);
-
-struct {
-  char *type_name;
-  SCM type;
-  creator_proc *creator;
-} type_creator_table[] = {
-  { "a", SCM_UNSPECIFIED, scm_make_string },
-  { "b", SCM_UNSPECIFIED, scm_make_bitvector },
-  { "u8", SCM_UNSPECIFIED, scm_make_u8vector },
-  { "s8", SCM_UNSPECIFIED, scm_make_s8vector },
-  { "u16", SCM_UNSPECIFIED, scm_make_u16vector },
-  { "s16", SCM_UNSPECIFIED, scm_make_s16vector },
-  { "u32", SCM_UNSPECIFIED, scm_make_u32vector },
-  { "s32", SCM_UNSPECIFIED, scm_make_s32vector },
-  { "u64", SCM_UNSPECIFIED, scm_make_u64vector },
-  { "s64", SCM_UNSPECIFIED, scm_make_s64vector },
-  { "f32", SCM_UNSPECIFIED, scm_make_f32vector },
-  { "f64", SCM_UNSPECIFIED, scm_make_f64vector },
-  { "c32", SCM_UNSPECIFIED, scm_make_c32vector },
-  { "c64", SCM_UNSPECIFIED, scm_make_c64vector },
-  { "vu8", SCM_UNSPECIFIED, scm_make_bytevector },
-  { NULL }
-};
-
-static void
-init_type_creator_table ()
-{
-  int i;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    {
-      SCM sym = scm_from_locale_symbol (type_creator_table[i].type_name);
-      type_creator_table[i].type = scm_permanent_object (sym);
-    }
-}
-
-static creator_proc *
-type_to_creator (SCM type)
-{
-  int i;
-
-  if (scm_is_eq (type, SCM_BOOL_T))
-    return scm_make_vector;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    if (scm_is_eq (type, type_creator_table[i].type))
-      return type_creator_table[i].creator;
-
-  scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (type));
-}
-
-static SCM
-make_typed_vector (SCM type, size_t len)
-{
-  creator_proc *creator = type_to_creator (type);
-  return creator (scm_from_size_t (len), SCM_UNDEFINED);
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_SYMBOL (scm_sym_s, "s");
-SCM_SYMBOL (scm_sym_l, "l");
-
-static int
-singp (SCM obj)
-{
-  if (!SCM_REALP (obj))
-    return 0;
-  else
-    {
-      double x = SCM_REAL_VALUE (obj);
-      float fx = x;
-      return (- SCM_FLTMAX < x) && (x < SCM_FLTMAX) && (fx == x);
-    }
-}
-
-SCM_API int scm_i_inump (SCM obj);
-SCM_API scm_t_signed_bits scm_i_inum (SCM obj);
-
-static SCM
-prototype_to_type (SCM proto)
-{
-  const char *type_name;
-
-  if (scm_is_eq (proto, SCM_BOOL_T))
-    type_name = "b";
-  else if (scm_is_eq (proto, SCM_MAKE_CHAR (0)))
-    type_name = "s8";
-  else if (SCM_CHARP (proto))
-    type_name = "a";
-  else if (scm_i_inump (proto))
-    {
-      if (scm_i_inum (proto) > 0)
-       type_name = "u32";
-      else
-       type_name = "s32";
-    }
-  else if (scm_is_eq (proto, scm_sym_s))
-    type_name = "s16";
-  else if (scm_is_eq (proto, scm_sym_l))
-    type_name = "s64";
-  else if (SCM_REALP (proto)
-          || scm_is_true (scm_eqv_p (proto,
-                                     scm_divide (scm_from_int (1),
-                                                 scm_from_int (3)))))
-    {
-      if (singp (proto))
-       type_name = "f32";
-      else
-       type_name = "f64";
-    }
-  else if (SCM_COMPLEXP (proto))
-    type_name = "c64";
-  else if (scm_is_null (proto))
-    type_name = NULL;
-  else
-    type_name = NULL;
-
-  if (type_name)
-    return scm_from_locale_symbol (type_name);
-  else
-    return SCM_BOOL_T;
-}
-
-static SCM
-scm_i_get_old_prototype (SCM uvec)
-{
-  if (scm_is_bitvector (uvec))
-    return SCM_BOOL_T;
-  else if (scm_is_string (uvec))
-    return SCM_MAKE_CHAR ('a');
-  else if (scm_is_true (scm_s8vector_p (uvec)))
-    return SCM_MAKE_CHAR ('\0');
-  else if (scm_is_true (scm_s16vector_p (uvec)))
-    return scm_sym_s;
-  else if (scm_is_true (scm_u32vector_p (uvec)))
-    return scm_from_int (1);
-  else if (scm_is_true (scm_s32vector_p (uvec)))
-    return scm_from_int (-1);
-  else if (scm_is_true (scm_s64vector_p (uvec)))
-    return scm_sym_l;
-  else if (scm_is_true (scm_f32vector_p (uvec)))
-    return scm_from_double (1.0);
-  else if (scm_is_true (scm_f64vector_p (uvec)))
-    return scm_divide (scm_from_int (1), scm_from_int (3));
-  else if (scm_is_true (scm_c64vector_p (uvec)))
-    return scm_c_make_rectangular (0, 1);
-  else if (scm_is_vector (uvec))
-    return SCM_EOL;
-  else
-    scm_misc_error (NULL, "~a has no prototype", scm_list_1 (uvec));
-}
-
-SCM
-scm_make_uve (long k, SCM prot)
-#define FUNC_NAME "scm_make_uve"
-{
-  scm_c_issue_deprecation_warning
-    ("`scm_make_uve' is deprecated, see the manual for alternatives.");
-
-  return make_typed_vector (prototype_to_type (prot), k);
-}
-#undef FUNC_NAME
-
-#endif
-
-int
-scm_is_array (SCM obj)
-{
-  return (SCM_I_ENCLOSED_ARRAYP (obj)
-         || SCM_I_ARRAYP (obj)
-         || scm_is_generalized_vector (obj));
-}
-
-int
-scm_is_typed_array (SCM obj, SCM type)
-{
-  if (SCM_I_ENCLOSED_ARRAYP (obj))
-    {
-      /* Enclosed arrays are arrays but are not of any type.
-      */
-      return 0;
-    }
-
-  /* Get storage vector. 
-   */
-  if (SCM_I_ARRAYP (obj))
-    obj = SCM_I_ARRAY_V (obj);
-
-  /* It must be a generalized vector (which includes vectors, strings, etc).
-   */
-  if (!scm_is_generalized_vector (obj))
-    return 0;
-
-  return scm_is_eq (type, scm_i_generalized_vector_type (obj));
-}
-
-static SCM
-enclosed_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
-}
-
-static SCM
-vector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return ((const SCM *)h->elements)[pos];
-}
-
-static SCM
-string_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
-  else
-    return scm_c_string_ref (h->array, pos);
-}
-
-static SCM
-bitvector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += scm_array_handle_bit_elements_offset (h);
-  return
-    scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
-}
-
-static SCM
-bytevector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
-}
-
-static SCM
-memoize_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->ref = enclosed_ref;
-      return enclosed_ref (h, pos);
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->elements = scm_array_handle_elements (h);
-      h->ref = vector_ref;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->elements = scm_array_handle_uniform_elements (h);
-      h->ref = scm_i_uniform_vector_ref_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->ref = string_ref;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->elements = scm_array_handle_bit_elements (h);
-      h->ref = bitvector_ref;
-    }
-  else if (scm_is_bytevector (v))
-    {
-      h->elements = scm_array_handle_uniform_elements (h);
-      h->ref = bytevector_ref;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  return h->ref (h, pos);
-}
-
-static void
-enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
-}
-
-static void
-vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  ((SCM *)h->writable_elements)[pos] = val;
-}
-
-static void
-string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
-  else
-    scm_c_string_set_x (h->array, pos, val);
-}
-
-static void
-bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_t_uint32 mask;
-  pos += scm_array_handle_bit_elements_offset (h);
-  mask = 1l << (pos % 32);
-  if (scm_to_bool (val))
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
-  else
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
-}
-
-static void
-bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_t_uint8 c_value;
-  scm_t_uint8 *elements;
-
-  c_value = scm_to_uint8 (val);
-  elements = (scm_t_uint8 *) h->elements;
-  elements[pos] = (scm_t_uint8) c_value;
-}
-
-static void
-memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->set = enclosed_set;
-      enclosed_set (h, pos, val);
-      return;
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->writable_elements = scm_array_handle_writable_elements (h);
-      h->set = vector_set;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->writable_elements = scm_array_handle_uniform_writable_elements (h);
-      h->set = scm_i_uniform_vector_set_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->set = string_set;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->writable_elements = scm_array_handle_bit_writable_elements (h);
-      h->set = bitvector_set;
-    }
-  else if (scm_is_bytevector (v))
-    {
-      h->elements = scm_array_handle_uniform_writable_elements (h);
-      h->set = bytevector_set;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  h->set (h, pos, val);
-}
-
-void
-scm_array_get_handle (SCM array, scm_t_array_handle *h)
-{
-  h->array = array;
-  h->ref = memoize_ref;
-  h->set = memoize_set;
-
-  if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
-    {
-      h->dims = SCM_I_ARRAY_DIMS (array);
-      h->base = SCM_I_ARRAY_BASE (array);
-    }
-  else if (scm_is_generalized_vector (array))
-    {
-      h->dim0.lbnd = 0;
-      h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
-      h->dim0.inc = 1;
-      h->dims = &h->dim0;
-      h->base = 0;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, array, "array");
-}
-
-void
-scm_array_handle_release (scm_t_array_handle *h)
-{
-  /* Nothing to do here until arrays need to be reserved for real.
-   */
-}
-
-size_t
-scm_array_handle_rank (scm_t_array_handle *h)
-{
-  if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
-    return SCM_I_ARRAY_NDIM (h->array);
-  else
-    return 1;
-}
-
-scm_t_array_dim *
-scm_array_handle_dims (scm_t_array_handle *h)
-{
-  return h->dims;
-}
-
-const SCM *
-scm_array_handle_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_ELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-SCM *
-scm_array_handle_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_WELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
-           (SCM obj, SCM prot),
-           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-           "not.")
-#define FUNC_NAME s_scm_array_p
-{
-  if (!SCM_UNBNDP (prot))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using prototypes with `array?' is deprecated."
-        "  Use `typed-array?' instead.");
-
-      return scm_typed_array_p (obj, prototype_to_type (prot));
-    }
-  else
-    return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-#else /* !SCM_ENABLE_DEPRECATED */
-
-/* We keep the old 2-argument C prototype for a while although the old
-   PROT argument is always ignored now.  C code should probably use
-   scm_is_array or scm_is_typed_array anyway.
-*/
-
-static SCM scm_i_array_p (SCM obj);
-
-SCM_DEFINE (scm_i_array_p, "array?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-           "not.")
-#define FUNC_NAME s_scm_i_array_p
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_array_p (SCM obj, SCM prot)
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-
-#endif /* !SCM_ENABLE_DEPRECATED */
-
-
-SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
-           (SCM obj, SCM type),
-           "Return @code{#t} if the @var{obj} is an array of type\n"
-           "@var{type}, and @code{#f} if not.")
-#define FUNC_NAME s_scm_typed_array_p
-{
-  return scm_from_bool (scm_is_typed_array (obj, type));
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_array_rank (SCM array)
-{
-  scm_t_array_handle handle;
-  size_t res;
-
-  scm_array_get_handle (array, &handle);
-  res = scm_array_handle_rank (&handle);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
-           (SCM array),
-           "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
-  return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
-           (SCM ra),
-           "@code{array-dimensions} is similar to @code{array-shape} but 
replaces\n"
-           "elements with a @code{0} minimum with one greater than the 
maximum. So:\n"
-           "@lisp\n"
-           "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 
5)\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_array_dimensions
-{
-  scm_t_array_handle handle;
-  scm_t_array_dim *s;
-  SCM res = SCM_EOL;
-  size_t k;
-      
-  scm_array_get_handle (ra, &handle);
-  s = scm_array_handle_dims (&handle);
-  k = scm_array_handle_rank (&handle);
-
-  while (k--)
-    res = scm_cons (s[k].lbnd
-                   ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
-                                scm_from_ssize_t (s[k].ubnd),
-                                SCM_EOL)
-                   : scm_from_ssize_t (1 + s[k].ubnd),
-                   res);
-
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
-           (SCM ra),
-           "Return the root vector of a shared array.")
-#define FUNC_NAME s_scm_shared_array_root
-{
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_I_ARRAY_V (ra);
-  else if (scm_is_generalized_vector (ra))
-    return ra;
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
-           (SCM ra),
-           "Return the root vector index of the first element in the array.")
-#define FUNC_NAME s_scm_shared_array_offset
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (ra, &handle);
-  res = scm_from_size_t (handle.base);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
-           (SCM ra),
-           "For each dimension, return the distance between elements in the 
root vector.")
-#define FUNC_NAME s_scm_shared_array_increments
-{
-  scm_t_array_handle handle;
-  SCM res = SCM_EOL;
-  size_t k;
-  scm_t_array_dim *s;
-
-  scm_array_get_handle (ra, &handle);
-  k = scm_array_handle_rank (&handle);
-  s = scm_array_handle_dims (&handle);
-  while (k--)
-    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-ssize_t
-scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
-{
-  scm_t_array_dim *s = scm_array_handle_dims (h);
-  ssize_t pos = 0, i;
-  size_t k = scm_array_handle_rank (h);
-  
-  while (k > 0 && scm_is_pair (indices))
-    {
-      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
-      pos += (i - s->lbnd) * s->inc;
-      k--;
-      s++;
-      indices = SCM_CDR (indices);
-    }
-  if (k > 0 || !scm_is_null (indices))
-    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
-                   scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
-  return pos;
-}
-
-SCM 
-scm_i_make_ra (int ndim, int enclosed)
-{
-  scm_t_bits tag = enclosed? scm_i_tc16_enclosed_array : scm_i_tc16_array;
-  SCM ra;
-  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
-              scm_gc_malloc ((sizeof (scm_i_t_array) +
-                             ndim * sizeof (scm_t_array_dim)),
-                            "array"));
-  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
-  return ra;
-}
-
-static char s_bad_spec[] = "Bad scm_array dimension";
-
-
-/* Increments will still need to be set. */
-
-static SCM 
-scm_i_shap2ra (SCM args)
-{
-  scm_t_array_dim *s;
-  SCM ra, spec, sp;
-  int ndim = scm_ilength (args);
-  if (ndim < 0)
-    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-
-  ra = scm_i_make_ra (ndim, 0);
-  SCM_I_ARRAY_BASE (ra) = 0;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
-    {
-      spec = SCM_CAR (args);
-      if (scm_is_integer (spec))
-       {
-         if (scm_to_long (spec) < 0)
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->lbnd = 0;
-         s->ubnd = scm_to_long (spec) - 1;
-         s->inc = 1;
-       }
-      else
-       {
-         if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->lbnd = scm_to_long (SCM_CAR (spec));
-         sp = SCM_CDR (spec);
-         if (!scm_is_pair (sp) 
-             || !scm_is_integer (SCM_CAR (sp))
-             || !scm_is_null (SCM_CDR (sp)))
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->ubnd = scm_to_long (SCM_CAR (sp));
-         s->inc = 1;
-       }
-    }
-  return ra;
-}
-
-SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
-           (SCM type, SCM fill, SCM bounds),
-           "Create and return an array of type @var{type}.")
-#define FUNC_NAME s_scm_make_typed_array
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  creator_proc *creator;
-  SCM ra;
-  
-  creator = type_to_creator (type);
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-
-  if (scm_is_eq (fill, SCM_UNSPECIFIED))
-    fill = SCM_UNDEFINED;
-
-  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM
-scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
-                                 size_t byte_len)
-#define FUNC_NAME "scm_from_contiguous_typed_array"
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  creator_proc *creator;
-  SCM ra;
-  scm_t_array_handle h;
-  void *base;
-  size_t sz;
-  
-  creator = type_to_creator (type);
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), SCM_UNDEFINED);
-
-
-  scm_array_get_handle (ra, &h);
-  base = scm_array_handle_uniform_writable_elements (&h);
-  sz = scm_array_handle_uniform_element_size (&h);
-  scm_array_handle_release (&h);
-
-  if (byte_len % sz)
-    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
-  if (byte_len / sz != rlen)
-    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
-
-  memcpy (base, bytes, byte_len);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
-           (SCM fill, SCM bounds),
-           "Create and return an array.")
-#define FUNC_NAME s_scm_make_array
-{
-  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 
1, 0,
-           (SCM dims, SCM prot, SCM fill),
-           "@deffnx {Scheme Procedure} make-uniform-vector length prototype 
[fill]\n"
-           "Create and return a uniform array or vector of type\n"
-           "corresponding to @var{prototype} with dimensions @var{dims} or\n"
-           "length @var{length}.  If @var{fill} is supplied, it's used to\n"
-           "fill the array, otherwise @var{prototype} is used.")
-#define FUNC_NAME s_scm_dimensions_to_uniform_array
-{
-  scm_c_issue_deprecation_warning
-    ("`dimensions->uniform-array' is deprecated.  "
-     "Use `make-typed-array' instead.");
-
-  if (scm_is_integer (dims))
-    dims = scm_list_1 (dims);
-
-  if (SCM_UNBNDP (fill))
-    {
-      /* Using #\nul as the prototype yields a s8 array, but numeric
-        arrays can't store characters, so we have to special case this.
-      */
-      if (scm_is_eq (prot, SCM_MAKE_CHAR (0)))
-       fill = scm_from_int (0);
-      else
-       fill = prot;
-    }
-
-  return scm_make_typed_array (prototype_to_type (prot), fill, dims);
-}
-#undef FUNC_NAME
-
-#endif
-
-static void 
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-    {
-      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-      while (k--)
-       {
-         if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-           {
-             SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
-             return;
-           }
-         inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
-                 - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-       }
-    }
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
-
-SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
-           (SCM oldra, SCM mapfunc, SCM dims),
-           "@code{make-shared-array} can be used to create shared subarrays of 
other\n"
-           "arrays.  The @var{mapper} is a function that translates 
coordinates in\n"
-           "the new array into coordinates in the old array.  A @var{mapper} 
must be\n"
-           "linear, and its range must stay within the bounds of the old 
array, but\n"
-           "it can be otherwise arbitrary.  A simple example:\n"
-           "@lisp\n"
-           "(define fred (make-array #f 8 8))\n"
-           "(define freds-diagonal\n"
-           "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
-           "(array-set! freds-diagonal 'foo 3)\n"
-           "(array-ref fred 3 3) @result{} foo\n"
-           "(define freds-center\n"
-           "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 
2))\n"
-           "(array-ref freds-center 0 0) @result{} foo\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_make_shared_array
-{
-  scm_t_array_handle old_handle;
-  SCM ra;
-  SCM inds, indptr;
-  SCM imap;
-  size_t k;
-  ssize_t i;
-  long old_base, old_min, new_min, old_max, new_max;
-  scm_t_array_dim *s;
-
-  SCM_VALIDATE_REST_ARGUMENT (dims);
-  SCM_VALIDATE_PROC (2, mapfunc);
-  ra = scm_i_shap2ra (dims);
-
-  scm_array_get_handle (oldra, &old_handle);
-
-  if (SCM_I_ARRAYP (oldra))
-    {
-      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
-      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
-      s = scm_array_handle_dims (&old_handle);
-      k = scm_array_handle_rank (&old_handle);
-      while (k--)
-       {
-         if (s[k].inc > 0)
-           old_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-         else
-           old_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-       }
-    }
-  else
-    {
-      SCM_I_ARRAY_V (ra) = oldra;
-      old_base = old_min = 0;
-      old_max = scm_c_generalized_vector_length (oldra) - 1;
-    }
-
-  inds = SCM_EOL;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-    {
-      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
-      if (s[k].ubnd < s[k].lbnd)
-       {
-         if (1 == SCM_I_ARRAY_NDIM (ra))
-           ra = make_typed_vector (scm_array_type (ra), 0);
-         else
-           SCM_I_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
-         scm_array_handle_release (&old_handle);
-         return ra;
-       }
-    }
-
-  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-  i = scm_array_handle_pos (&old_handle, imap);
-  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
-  indptr = inds;
-  k = SCM_I_ARRAY_NDIM (ra);
-  while (k--)
-    {
-      if (s[k].ubnd > s[k].lbnd)
-       {
-         SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
-         imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-         s[k].inc = scm_array_handle_pos (&old_handle, imap) - i;
-         i += s[k].inc;
-         if (s[k].inc > 0)
-           new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-         else
-           new_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-       }
-      else
-       s[k].inc = new_max - new_min + 1;       /* contiguous by default */
-      indptr = SCM_CDR (indptr);
-    }
-
-  scm_array_handle_release (&old_handle);
-
-  if (old_min > new_min || old_max < new_max)
-    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    {
-      SCM v = SCM_I_ARRAY_V (ra);
-      size_t length = scm_c_generalized_vector_length (v);
-      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
-       return v;
-      if (s->ubnd < s->lbnd)
-       return make_typed_vector (scm_array_type (ra), 0);
-    }
-  scm_i_ra_set_contp (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-
-/* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
-           (SCM ra, SCM args),
-           "Return an array sharing contents with @var{array}, but with\n"
-           "dimensions arranged in a different order.  There must be one\n"
-           "@var{dim} argument for each dimension of @var{array}.\n"
-           "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
-           "and the rank of the array to be returned.  Each integer in that\n"
-           "range must appear at least once in the argument list.\n"
-           "\n"
-           "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
-           "dimensions in the array to be returned, their positions in the\n"
-           "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
-           "may have the same value, in which case the returned array will\n"
-           "have smaller rank than @var{array}.\n"
-           "\n"
-           "@lisp\n"
-           "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
-           "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
-           "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) 
@result{}\n"
-           "                #2((a 4) (b 5) (c 6))\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_transpose_array
-{
-  SCM res, vargs;
-  scm_t_array_dim *s, *r;
-  int ndim, i, k;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      /* Make sure that we are called with a single zero as
-        arguments. 
-      */
-      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
-       SCM_WRONG_NUM_ARGS ();
-      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
-      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
-      return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    {
-      vargs = scm_vector (args);
-      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
-       SCM_WRONG_NUM_ARGS ();
-      ndim = 0;
-      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-       {
-         i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
-                                    0, SCM_I_ARRAY_NDIM(ra));
-         if (ndim < i)
-           ndim = i;
-       }
-      ndim++;
-      res = scm_i_make_ra (ndim, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
-      for (k = ndim; k--;)
-       {
-         SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
-         SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
-       }
-      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-       {
-         i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
-         s = &(SCM_I_ARRAY_DIMS (ra)[k]);
-         r = &(SCM_I_ARRAY_DIMS (res)[i]);
-         if (r->ubnd < r->lbnd)
-           {
-             r->lbnd = s->lbnd;
-             r->ubnd = s->ubnd;
-             r->inc = s->inc;
-             ndim--;
-           }
-         else
-           {
-             if (r->ubnd > s->ubnd)
-               r->ubnd = s->ubnd;
-             if (r->lbnd < s->lbnd)
-               {
-                 SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
-                 r->lbnd = s->lbnd;
-               }
-             r->inc += s->inc;
-           }
-       }
-      if (ndim > 0)
-       SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-      scm_i_ra_set_contp (res);
-      return res;
-    }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-/* args are RA . AXES */
-SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, 
-           (SCM ra, SCM axes),
-           "@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less 
than\n"
-           "the rank of @var{array}.  @var{enclose-array} returns an array\n"
-           "resembling an array of shared arrays.  The dimensions of each 
shared\n"
-           "array are the same as the @var{dim}th dimensions of the original 
array,\n"
-           "the dimensions of the outer array are the same as those of the 
original\n"
-           "array that did not match a @var{dim}.\n\n"
-           "An enclosed array is not a general Scheme array.  Its elements may 
not\n"
-           "be set using @code{array-set!}.  Two references to the same 
element of\n"
-           "an enclosed array will be @code{equal?} but will not in general 
be\n"
-           "@code{eq?}.  The value returned by @var{array-prototype} when 
given an\n"
-           "enclosed array is unspecified.\n\n"
-           "examples:\n"
-           "@lisp\n"
-           "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) 
@result{}\n"
-           "   #<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) 
#1(3 6))>\n\n"
-           "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) 
@result{}\n"
-           "   #<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 
6))>\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_enclose_array
-{
-  SCM axv, res, ra_inr;
-  scm_t_array_dim vdim, *s = &vdim;
-  int ndim, j, k, ninr, noutr;
-
-  SCM_VALIDATE_REST_ARGUMENT (axes);
-  if (scm_is_null (axes))
-    axes = scm_cons ((SCM_I_ARRAYP (ra) ? scm_from_size_t (SCM_I_ARRAY_NDIM 
(ra) - 1) : SCM_INUM0), SCM_EOL);
-  ninr = scm_ilength (axes);
-  if (ninr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  ra_inr = scm_i_make_ra (ninr, 0);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      s->lbnd = 0;
-      s->ubnd = scm_c_generalized_vector_length (ra) - 1;
-      s->inc = 1;
-      SCM_I_ARRAY_V (ra_inr) = ra;
-      SCM_I_ARRAY_BASE (ra_inr) = 0;
-      ndim = 1;
-    }
-  else if (SCM_I_ARRAYP (ra))
-    {
-      s = SCM_I_ARRAY_DIMS (ra);
-      SCM_I_ARRAY_V (ra_inr) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (ra_inr) = SCM_I_ARRAY_BASE (ra);
-      ndim = SCM_I_ARRAY_NDIM (ra);
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-
-  noutr = ndim - ninr;
-  if (noutr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
-  res = scm_i_make_ra (noutr, 1);
-  SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra_inr);
-  SCM_I_ARRAY_V (res) = ra_inr;
-  for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
-    {
-      if (!scm_is_integer (SCM_CAR (axes)))
-       SCM_MISC_ERROR ("bad axis", SCM_EOL);
-      j = scm_to_int (SCM_CAR (axes));
-      SCM_I_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
-      scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
-    }
-  for (j = 0, k = 0; k < noutr; k++, j++)
-    {
-      while (!scm_i_string_ref (axv, j) == '\0')
-       j++;
-      SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (res)[k].inc = s[j].inc;
-    }
-  scm_remember_upto_here_1 (axv);
-  scm_i_ra_set_contp (ra_inr);
-  scm_i_ra_set_contp (res);
-  return res;
-}
-#undef FUNC_NAME
-
-
-
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
-           (SCM v, SCM args),
-           "Return @code{#t} if its arguments would be acceptable to\n"
-           "@code{array-ref}.")
-#define FUNC_NAME s_scm_array_in_bounds_p
-{
-  SCM res = SCM_BOOL_T;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-
-  if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (v);
-      scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
-
-      for (k = 0; k < ndim; k++)
-       {
-         long ind;
-
-         if (!scm_is_pair (args))
-           SCM_WRONG_NUM_ARGS ();
-         ind = scm_to_long (SCM_CAR (args));
-         args = SCM_CDR (args);
-
-         if (ind < s[k].lbnd || ind > s[k].ubnd)
-           {
-             res = SCM_BOOL_F;
-             /* We do not stop the checking after finding a violation
-                since we want to validate the type-correctness and
-                number of arguments in any case.
-             */
-           }
-       }
-    }
-  else if (scm_is_generalized_vector (v))
-    {
-      /* Since real arrays have been covered above, all generalized
-        vectors are guaranteed to be zero-origin here.
-      */
-
-      long ind;
-
-      if (!scm_is_pair (args))
-       SCM_WRONG_NUM_ARGS ();
-      ind = scm_to_long (SCM_CAR (args));
-      args = SCM_CDR (args);
-      res = scm_from_bool (ind >= 0
-                          && ind < scm_c_generalized_vector_length (v));
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "array");
-
-  if (!scm_is_null (args))
-    SCM_WRONG_NUM_ARGS ();
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM 
-scm_i_cvref (SCM v, size_t pos, int enclosed)
-{
-  if (enclosed)
-    {
-      int k = SCM_I_ARRAY_NDIM (v);
-      SCM res = scm_i_make_ra (k, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (v);
-      SCM_I_ARRAY_BASE (res) = pos;
-      while (k--)
-       {
-         SCM_I_ARRAY_DIMS (res)[k].ubnd = SCM_I_ARRAY_DIMS (v)[k].ubnd;
-         SCM_I_ARRAY_DIMS (res)[k].lbnd = SCM_I_ARRAY_DIMS (v)[k].lbnd;
-         SCM_I_ARRAY_DIMS (res)[k].inc = SCM_I_ARRAY_DIMS (v)[k].inc;
-       }
-      return res;
-    }
-  else
-    return scm_c_generalized_vector_ref (v, pos);
-}
-
-SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
-           (SCM v, SCM args),
-           "Return the element at the @code{(index1, index2)} element in\n"
-           "@var{array}.")
-#define FUNC_NAME s_scm_array_ref
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (v, &handle);
-  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
-           (SCM v, SCM obj, SCM args),
-           "Set the element at the @code{(index1, index2)} element in 
@var{array} to\n"
-           "@var{new-value}.  The value returned by array-set! is 
unspecified.")
-#define FUNC_NAME s_scm_array_set_x           
-{
-  scm_t_array_handle handle;
-
-  scm_array_get_handle (v, &handle);
-  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
-  scm_array_handle_release (&handle);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-  /* if strict is not SCM_UNDEFINED, return #f if returned array
-                    wouldn't have contiguous elements.  */
-SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
-           (SCM ra, SCM strict),
-           "If @var{array} may be @dfn{unrolled} into a one dimensional shared 
array\n"
-           "without changing their order (last subscript changing fastest), 
then\n"
-           "@code{array-contents} returns that shared array, otherwise it 
returns\n"
-           "@code{#f}.  All arrays made by @var{make-array} and\n"
-           "@var{make-uniform-array} may be unrolled, some arrays made by\n"
-           "@var{make-shared-array} may not be.\n\n"
-           "If the optional argument @var{strict} is provided, a shared array 
will\n"
-           "be returned only if its elements are stored internally contiguous 
in\n"
-           "memory.")
-#define FUNC_NAME s_scm_array_contents
-{
-  SCM sra;
-
-  if (scm_is_generalized_vector (ra))
-    return ra;
-
-  if (SCM_I_ARRAYP (ra))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
-       return SCM_BOOL_F;
-      for (k = 0; k < ndim; k++)
-       len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
-      if (!SCM_UNBNDP (strict))
-       {
-         if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
-           return SCM_BOOL_F;
-         if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-           {
-             if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
-                 SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
-                 len % SCM_LONG_BIT)
-               return SCM_BOOL_F;
-           }
-       }
-      
-      {
-       SCM v = SCM_I_ARRAY_V (ra);
-       size_t length = scm_c_generalized_vector_length (v);
-       if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS 
(ra)->inc)
-         return v;
-      }
-      
-      sra = scm_i_make_ra (1, 0);
-      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
-      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
-      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 
1].inc : 1);
-      return sra;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM 
-scm_ra2contig (SCM ra, int copy)
-{
-  SCM ret;
-  long inc = 1;
-  size_t k, len = 1;
-  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-  k = SCM_I_ARRAY_NDIM (ra);
-  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 
1].inc)))
-    {
-      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-       return ra;
-      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
-          0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
-          0 == len % SCM_LONG_BIT))
-       return ra;
-    }
-  ret = scm_i_make_ra (k, 0);
-  SCM_I_ARRAY_BASE (ret) = 0;
-  while (k--)
-    {
-      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
-      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
-      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
-      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-    }
-  SCM_I_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
-  if (copy)
-    scm_array_copy_x (ra, ret);
-  return ret;
-}
-
-
-
-SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-           "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] 
[start] [end]\n"
-           "Attempt to read all elements of @var{ura}, in lexicographic order, 
as\n"
-           "binary objects from @var{port-or-fdes}.\n"
-           "If an end of file is encountered,\n"
-           "the objects up to that point are put into @var{ura}\n"
-           "(starting at the beginning) and the remainder of the array is\n"
-           "unchanged.\n\n"
-           "The optional arguments @var{start} and @var{end} allow\n"
-           "a specified region of a vector (or linearized array) to be read,\n"
-           "leaving the remainder of the vector unchanged.\n\n"
-           "@code{uniform-array-read!} returns the number of objects read.\n"
-           "@var{port-or-fdes} may be omitted, in which case it defaults to 
the value\n"
-           "returned by @code{(current-input-port)}.")
-#define FUNC_NAME s_scm_uniform_array_read_x
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_input_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 0);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-       {
-         cstart = scm_to_unsigned_integer (start, 0, vlen);
-         if (!SCM_UNBNDP (end))
-           cend = scm_to_unsigned_integer (end, cstart, vlen);
-       }
-
-      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
-                                      scm_from_size_t (base + cstart),
-                                      scm_from_size_t (base + cend));
-
-      if (!scm_is_eq (cra, ura))
-       scm_array_copy_x (cra, ura);
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-           "Writes all elements of @var{ura} as binary objects to\n"
-           "@var{port-or-fdes}.\n\n"
-           "The optional arguments @var{start}\n"
-           "and @var{end} allow\n"
-           "a specified region of a vector (or linearized array) to be 
written.\n\n"
-           "The number of objects actually written is returned.\n"
-           "@var{port-or-fdes} may be\n"
-           "omitted, in which case it defaults to the value returned by\n"
-           "@code{(current-output-port)}.")
-#define FUNC_NAME s_scm_uniform_array_write
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_output_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_write (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 1);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-       {
-         cstart = scm_to_unsigned_integer (start, 0, vlen);
-         if (!SCM_UNBNDP (end))
-           cend = scm_to_unsigned_integer (end, cstart, vlen);
-       }
-
-      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
-                                     scm_from_size_t (base + cstart),
-                                     scm_from_size_t (base + cend));
-
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-
-/** Bit vectors */
-
-static scm_t_bits scm_tc16_bitvector;
-
-#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
-#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
-#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
-
-static size_t
-bitvector_free (SCM vec)
-{
-  scm_gc_free (BITVECTOR_BITS (vec),
-              sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
-              "bitvector");
-  return 0;
-}
-
-static int
-bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
-  size_t i, j;
-
-  scm_puts ("#*", port);
-  for (i = 0; i < word_len; i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
-       scm_putc ((bits[i] & mask)? '1' : '0', port);
-    }
-    
-  return 1;
-}
-
-static SCM
-bitvector_equalp (SCM vec1, SCM vec2)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec1);
-  size_t word_len = (bit_len + 31) / 32;
-  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
-  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
-  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
-
-  /* compare lengths */
-  if (BITVECTOR_LENGTH (vec2) != bit_len)
-    return SCM_BOOL_F;
-  /* avoid underflow in word_len-1 below. */
-  if (bit_len == 0)
-    return SCM_BOOL_T;
-  /* compare full words */
-  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
-    return SCM_BOOL_F;
-  /* compare partial last words */
-  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
-    return SCM_BOOL_F;
-  return SCM_BOOL_T;
-}
-
-int
-scm_is_bitvector (SCM vec)
-{
-  return IS_BITVECTOR (vec);
-}
-
-SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} when @var{obj} is a bitvector, else\n"
-           "return @code{#f}.")
-#define FUNC_NAME s_scm_bitvector_p
-{
-  return scm_from_bool (scm_is_bitvector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_make_bitvector (size_t len, SCM fill)
-{
-  size_t word_len = (len + 31) / 32;
-  scm_t_uint32 *bits;
-  SCM res;
-
-  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
-                       "bitvector");
-  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
-
-  if (!SCM_UNBNDP (fill))
-    scm_bitvector_fill_x (res, fill);
-      
-  return res;
-}
-
-SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
-           (SCM len, SCM fill),
-           "Create a new bitvector of length @var{len} and\n"
-           "optionally initialize all elements to @var{fill}.")
-#define FUNC_NAME s_scm_make_bitvector
-{
-  return scm_c_make_bitvector (scm_to_size_t (len), fill);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
-           (SCM bits),
-           "Create a new bitvector with the arguments as elements.")
-#define FUNC_NAME s_scm_bitvector
-{
-  return scm_list_to_bitvector (bits);
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_bitvector_length (SCM vec)
-{
-  scm_assert_smob_type (scm_tc16_bitvector, vec);
-  return BITVECTOR_LENGTH (vec);
-}
-
-SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
-           (SCM vec),
-           "Return the length of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_length
-{
-  return scm_from_size_t (scm_c_bitvector_length (vec));
-}
-#undef FUNC_NAME
-
-const scm_t_uint32 *
-scm_array_handle_bit_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-scm_t_uint32 *
-scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (IS_BITVECTOR (vec))
-    return BITVECTOR_BITS (vec) + h->base/32;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
-}
-
-size_t
-scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
-{
-  return h->base % 32;
-}
-
-const scm_t_uint32 *
-scm_bitvector_elements (SCM vec,
-                       scm_t_array_handle *h,
-                       size_t *offp,
-                       size_t *lenp,
-                       ssize_t *incp)
-{
-  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
-}
-
-
-scm_t_uint32 *
-scm_bitvector_writable_elements (SCM vec,
-                                scm_t_array_handle *h,
-                                size_t *offp,
-                                size_t *lenp,
-                                ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (vec, h);
-  if (offp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *offp = scm_array_handle_bit_elements_offset (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-SCM
-scm_c_bitvector_ref (SCM vec, size_t idx)
-{
-  scm_t_array_handle handle;
-  const scm_t_uint32 *bits;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-    }
-  else
-    {
-      SCM res;
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-      scm_array_handle_release (&handle);
-      return res;
-    }
-}
-
-SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
-           (SCM vec, SCM idx),
-           "Return the element at index @var{idx} of the bitvector\n"
-           "@var{vec}.")
-#define FUNC_NAME s_scm_bitvector_ref
-{
-  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits, mask;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-    }
-  else
-    {
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-    }
-
-  mask = 1L << (idx%32);
-  if (scm_is_true (val))
-    bits[idx/32] |= mask;
-  else
-    bits[idx/32] &= ~mask;
-
-  if (!IS_BITVECTOR (vec))
-      scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
-           (SCM vec, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the bitvector\n"
-           "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
-{
-  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
-           (SCM vec, SCM val),
-           "Set all elements of the bitvector\n"
-           "@var{vec} when @var{val} is true, else clear them.")
-#define FUNC_NAME s_scm_bitvector_fill_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-
-      if (scm_is_true (val))
-       {
-         memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
-         bits[word_len-1] |= last_mask;
-       }
-      else
-       {
-         memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
-         bits[word_len-1] &= ~last_mask;
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i*inc, val);
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
-           (SCM list),
-           "Return a new bitvector initialized with the elements\n"
-           "of @var{list}.")
-#define FUNC_NAME s_scm_list_to_bitvector
-{
-  size_t bit_len = scm_to_size_t (scm_length (list));
-  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
-                                                       NULL, NULL, NULL);
-  size_t i, j;
-
-  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      bits[i] = 0;
-      for (j = 0; j < 32 && j < bit_len;
-          j++, mask <<= 1, list = SCM_CDR (list))
-       if (scm_is_true (SCM_CAR (list)))
-         bits[i] |= mask;
-    }
-
-  scm_array_handle_release (&handle);
-
-  return vec;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
-           (SCM vec),
-           "Return a new list initialized with the elements\n"
-           "of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_to_list
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  SCM res = SCM_EOL;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      size_t i, j;
-
-      for (i = 0; i < word_len; i++, len -= 32)
-       {
-         scm_t_uint32 mask = 1;
-         for (j = 0; j < 32 && j < len; j++, mask <<= 1)
-           res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
-    }
-
-  scm_array_handle_release (&handle);
-  
-  return scm_reverse_x (res, SCM_EOL);
-}
-#undef FUNC_NAME
-
-/* From mmix-arith.w by Knuth.
-
-  Here's a fun way to count the number of bits in a tetrabyte.
-
-  [This classical trick is called the ``Gillies--Miller method for
-  sideways addition'' in {\sl The Preparation of Programs for an
-  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
-  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
-  the tricks used here were suggested by Balbir Singh, Peter
-  Rossmanith, and Stefan Schwoon.]
-*/
-
-static size_t
-count_ones (scm_t_uint32 x)
-{
-  x=x-((x>>1)&0x55555555);
-  x=(x&0x33333333)+((x>>2)&0x33333333);
-  x=(x+(x>>4))&0x0f0f0f0f;
-  x=x+(x>>8);
-  return (x+(x>>16)) & 0xff;
-}
-
-SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
-           (SCM b, SCM bitvector),
-           "Return the number of occurrences of the boolean @var{b} in\n"
-           "@var{bitvector}.")
-#define FUNC_NAME s_scm_bit_count
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  int bit = scm_to_bool (b);
-  size_t count = 0;
-
-  bits = scm_bitvector_writable_elements (bitvector, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-       count += count_ones (bits[i]);
-      count += count_ones (bits[i] & last_mask);
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
-         count++;
-    }
-  
-  scm_array_handle_release (&handle);
-
-  return scm_from_size_t (bit? count : len-count);
-}
-#undef FUNC_NAME
-
-/* returns 32 for x == 0. 
-*/
-static size_t
-find_first_one (scm_t_uint32 x)
-{
-  size_t pos = 0;
-  /* do a binary search in x. */
-  if ((x & 0xFFFF) == 0)
-    x >>= 16, pos += 16;
-  if ((x & 0xFF) == 0)
-    x >>= 8, pos += 8;
-  if ((x & 0xF) == 0)
-    x >>= 4, pos += 4;
-  if ((x & 0x3) == 0)
-    x >>= 2, pos += 2;
-  if ((x & 0x1) == 0)
-    pos += 1;
-  return pos;
-}
-
-SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
-           (SCM item, SCM v, SCM k),
-           "Return the index of the first occurrance of @var{item} in bit\n"
-           "vector @var{v}, starting from @var{k}.  If there is no\n"
-           "@var{item} entry between @var{k} and the end of\n"
-           "@var{bitvector}, then return @code{#f}.  For example,\n"
-           "\n"
-           "@example\n"
-           "(bit-position #t #*000101 0)  @result{} 3\n"
-           "(bit-position #f #*0001111 3) @result{} #f\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_position
-{
-  scm_t_array_handle handle;
-  size_t off, len, first_bit;
-  ssize_t inc;
-  const scm_t_uint32 *bits;
-  int bit = scm_to_bool (item);
-  SCM res = SCM_BOOL_F;
-  
-  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
-  first_bit = scm_to_unsigned_integer (k, 0, len);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t i, word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t first_word = first_bit / 32;
-      scm_t_uint32 first_mask =
-       ((scm_t_uint32)-1) << (first_bit - 32*first_word);
-      scm_t_uint32 w;
-      
-      for (i = first_word; i < word_len; i++)
-       {
-         w = (bit? bits[i] : ~bits[i]);
-         if (i == first_word)
-           w &= first_mask;
-         if (i == word_len-1)
-           w &= last_mask;
-         if (w)
-           {
-             res = scm_from_size_t (32*i + find_first_one (w));
-             break;
-           }
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = first_bit; i < len; i++)
-       {
-         SCM elt = scm_array_handle_ref (&handle, i*inc);
-         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-           {
-             res = scm_from_size_t (i);
-             break;
-           }
-       }
-    }
-
-  scm_array_handle_release (&handle);
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
-           (SCM v, SCM kv, SCM obj),
-           "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
-           "selecting the entries to change.  The return value is\n"
-           "unspecified.\n"
-           "\n"
-           "If @var{kv} is a bit vector, then those entries where it has\n"
-           "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
-           "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
-           "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
-           "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
-           "\n"
-           "@example\n"
-           "(define bv #*01000010)\n"
-           "(bit-set*! bv #*10010001 #t)\n"
-           "bv\n"
-           "@result{} #*11010011\n"
-           "@end example\n"
-           "\n"
-           "If @var{kv} is a u32vector, then its elements are\n"
-           "indices into @var{v} which are set to @var{obj}.\n"
-           "\n"
-           "@example\n"
-           "(define bv #*01000010)\n"
-           "(bit-set*! bv #u32(5 2 7) #t)\n"
-           "bv\n"
-           "@result{} #*01100111\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  scm_t_uint32 *v_bits;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_writable_elements (v, &v_handle,
-                                           &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t word_len = (kv_len + 31) / 32;
-         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-         size_t i;
- 
-         if (bit == 0)
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] &= ~kv_bits[i];
-             v_bits[i] &= ~(kv_bits[i] & last_mask);
-           }
-         else
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] |= kv_bits[i];
-             v_bits[i] |= kv_bits[i] & last_mask;
-           }
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
-             scm_array_handle_set (&v_handle, i*v_inc, obj);
-       }
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
-           (SCM v, SCM kv, SCM obj),
-           "Return a count of how many entries in bit vector @var{v} are\n"
-           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
-           "consider.\n"
-           "\n"
-           "If @var{kv} is a bit vector, then those entries where it has\n"
-           "@code{#t} are the ones in @var{v} which are considered.\n"
-           "@var{kv} and @var{v} must be the same length.\n"
-           "\n"
-           "If @var{kv} is a u32vector, then it contains\n"
-           "the indexes in @var{v} to consider.\n"
-           "\n"
-           "For example,\n"
-           "\n"
-           "@example\n"
-           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
-           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_count_star
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  const scm_t_uint32 *v_bits;
-  size_t count = 0;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_elements (v, &v_handle,
-                                  &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t i, word_len = (kv_len + 31) / 32;
-         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-         scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
-
-         for (i = 0; i < word_len-1; i++)
-           count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
-         count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
-             {
-               SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
-               if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-                 count++;
-             }
-       }
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       {
-         SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
-         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-           count++;
-       }
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return scm_from_size_t (count);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
-           (SCM v),
-           "Modify the bit vector @var{v} by replacing each element with\n"
-           "its negation.")
-#define FUNC_NAME s_scm_bit_invert_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
-  
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-       bits[i] = ~bits[i];
-      bits[i] = bits[i] ^ last_mask;
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i*inc,
-                             scm_not (scm_array_handle_ref (&handle, i*inc)));
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM
-scm_istr2bve (SCM str)
-{
-  scm_t_array_handle handle;
-  size_t len = scm_i_string_length (str);
-  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
-  SCM res = vec;
-
-  scm_t_uint32 mask;
-  size_t k, j, p;
-  scm_t_uint32 *data;
-
-  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
-
-  p = 0;
-  for (k = 0; k < (len + 31) / 32; k++)
-    {
-      data[k] = 0L;
-      j = len - k * 32;
-      if (j > 32)
-       j = 32;
-      for (mask = 1L; j--; mask <<= 1)
-       switch (scm_i_string_ref (str, p++))
-         {
-         case '0':
-           break;
-         case '1':
-           data[k] |= mask;
-           break;
-         default:
-           res = SCM_BOOL_F;
-           goto exit;
-         }
-    }
-  
- exit:
-  scm_array_handle_release (&handle);
-  scm_remember_upto_here_1 (str);
-  return res;
-}
-
-
-
-static SCM 
-ra2l (SCM ra, unsigned long base, unsigned long k)
-{
-  SCM res = SCM_EOL;
-  long inc;
-  size_t i;
-  int enclosed = SCM_I_ENCLOSED_ARRAYP (ra);
-  
-  if (k == SCM_I_ARRAY_NDIM (ra))
-    return scm_i_cvref (SCM_I_ARRAY_V (ra), base, enclosed);
-
-  inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
-  if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
-    return SCM_EOL;
-  i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS 
(ra)[k].lbnd) * inc;
-  do
-    {
-      i -= inc;
-      res = scm_cons (ra2l (ra, i, k + 1), res);
-    }
-  while (i != base);
-  return res;
-}
-
-
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
-           (SCM v),
-           "Return a list consisting of all the elements, in order, of\n"
-           "@var{array}.")
-#define FUNC_NAME s_scm_array_to_list
-{
-  if (scm_is_generalized_vector (v))
-    return scm_generalized_vector_to_list (v);
-  else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
-
-  scm_wrong_type_arg_msg (NULL, 0, v, "array");
-}
-#undef FUNC_NAME
-
-
-static void l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k);
-
-SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
-           (SCM type, SCM shape, SCM lst),
-           "Return an array of the type @var{type}\n"
-           "with elements the same as those of @var{lst}.\n"
-           "\n"
-           "The argument @var{shape} determines the number of dimensions\n"
-           "of the array and their shape.  It is either an exact integer,\n"
-           "giving the\n"
-           "number of dimensions directly, or a list whose length\n"
-           "specifies the number of dimensions and each element specified\n"
-           "the lower and optionally the upper bound of the corresponding\n"
-           "dimension.\n"
-           "When the element is list of two elements, these elements\n"
-           "give the lower and upper bounds.  When it is an exact\n"
-           "integer, it gives only the lower bound.")
-#define FUNC_NAME s_scm_list_to_typed_array
-{
-  SCM row;
-  SCM ra;
-  scm_t_array_handle handle;
-
-  row = lst;
-  if (scm_is_integer (shape))
-    {
-      size_t k = scm_to_size_t (shape);
-      shape = SCM_EOL;
-      while (k-- > 0)
-       {
-         shape = scm_cons (scm_length (row), shape);
-         if (k > 0 && !scm_is_null (row))
-           row = scm_car (row);
-       }
-    }
-  else
-    {
-      SCM shape_spec = shape;
-      shape = SCM_EOL;
-      while (1)
-       {
-         SCM spec = scm_car (shape_spec);
-         if (scm_is_pair (spec))
-           shape = scm_cons (spec, shape);
-         else
-           shape = scm_cons (scm_list_2 (spec,
-                                         scm_sum (scm_sum (spec,
-                                                           scm_length (row)),
-                                                  scm_from_int (-1))),
-                             shape);
-         shape_spec = scm_cdr (shape_spec);
-         if (scm_is_pair (shape_spec))
-           {
-             if (!scm_is_null (row))
-               row = scm_car (row);
-           }
-         else
-           break;
-       }
-    }
-
-  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
-                            scm_reverse_x (shape, SCM_EOL));
-
-  scm_array_get_handle (ra, &handle);
-  l2ra (lst, &handle, 0, 0);
-  scm_array_handle_release (&handle);
-
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
-           (SCM ndim, SCM lst),
-           "Return an array with elements the same as those of @var{lst}.")
-#define FUNC_NAME s_scm_list_to_array
-{
-  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
-}
-#undef FUNC_NAME
-
-static void
-l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
-{
-  if (k == scm_array_handle_rank (handle))
-    scm_array_handle_set (handle, pos, lst);
-  else
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
-      ssize_t inc = dim->inc;
-      size_t len = 1 + dim->ubnd - dim->lbnd, n;
-      char *errmsg = NULL;
-
-      n = len;
-      while (n > 0 && scm_is_pair (lst))
-       {
-         l2ra (SCM_CAR (lst), handle, pos, k + 1);
-         pos += inc;
-         lst = SCM_CDR (lst);
-         n -= 1;
-       }
-      if (n != 0)
-       errmsg = "too few elements for array dimension ~a, need ~a";
-      if (!scm_is_null (lst))
-       errmsg = "too many elements for array dimension ~a, want ~a";
-      if (errmsg)
-       scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
-                                                 scm_from_size_t (len)));
-    }
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
-           (SCM ndim, SCM prot, SCM lst),
-           "Return a uniform array of the type indicated by prototype\n"
-           "@var{prot} with elements the same as those of @var{lst}.\n"
-           "Elements must be of the appropriate type, no coercions are\n"
-           "done.\n"
-           "\n"
-           "The argument @var{ndim} determines the number of dimensions\n"
-           "of the array.  It is either an exact integer, giving the\n"
-           "number directly, or a list of exact integers, whose length\n"
-           "specifies the number of dimensions and each element is the\n"
-           "lower index bound of its dimension.")
-#define FUNC_NAME s_scm_list_to_uniform_array
-{
-  return scm_list_to_typed_array (prototype_to_type (prot), ndim, lst);
-}
-#undef FUNC_NAME
-
-#endif
-
-/* Print dimension DIM of ARRAY.
- */
-
-static int
-scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
-                            SCM port, scm_print_state *pstate)
-{
-  scm_t_array_dim *dim_spec = SCM_I_ARRAY_DIMS (array) + dim;
-  long idx;
-
-  scm_putc ('(', port);
-
-  for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++)
-    {
-      if (dim < SCM_I_ARRAY_NDIM(array)-1)
-       scm_i_print_array_dimension (array, dim+1, base, enclosed, 
-                                    port, pstate);
-      else
-       scm_iprin1 (scm_i_cvref (SCM_I_ARRAY_V (array), base, enclosed), 
-                   port, pstate);
-      if (idx < dim_spec->ubnd)
-       scm_putc (' ', port);
-      base += dim_spec->inc;
-    }
-
-  scm_putc (')', port);
-  return 1;
-}
-
-/* Print an array.  (Only for strict arrays, not for generalized vectors.)
-*/
-
-static int
-scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  long ndim = SCM_I_ARRAY_NDIM (array);
-  scm_t_array_dim *dim_specs = SCM_I_ARRAY_DIMS (array);
-  SCM v = SCM_I_ARRAY_V (array);
-  unsigned long base = SCM_I_ARRAY_BASE (array);
-  long i;
-  int print_lbnds = 0, zero_size = 0, print_lens = 0;
-
-  scm_putc ('#', port);
-  if (ndim != 1 || dim_specs[0].lbnd != 0)
-    scm_intprint (ndim, 10, port);
-  if (scm_is_uniform_vector (v))
-    scm_puts (scm_i_uniform_vector_tag (v), port);
-  else if (scm_is_bitvector (v))
-    scm_puts ("b", port);
-  else if (scm_is_string (v))
-    scm_puts ("a", port);
-  else if (!scm_is_vector (v))
-    scm_puts ("?", port);
-  
-  for (i = 0; i < ndim; i++)
-    {
-      if (dim_specs[i].lbnd != 0)
-       print_lbnds = 1;
-      if (dim_specs[i].ubnd - dim_specs[i].lbnd + 1 == 0)
-       zero_size = 1;
-      else if (zero_size)
-       print_lens = 1;
-    }
-
-  if (print_lbnds || print_lens)
-    for (i = 0; i < ndim; i++)
-      {
-       if (print_lbnds)
-         {
-           scm_putc ('@', port);
-           scm_intprint (dim_specs[i].lbnd, 10, port);
-         }
-       if (print_lens)
-         {
-           scm_putc (':', port);
-           scm_intprint (dim_specs[i].ubnd - dim_specs[i].lbnd + 1,
-                         10, port);
-         }
-      }
-
-  if (ndim == 0)
-    {
-      /* Rank zero arrays, which are really just scalars, are printed
-        specially.  The consequent way would be to print them as
-
-            #0 OBJ
-
-         where OBJ is the printed representation of the scalar, but we
-         print them instead as
-
-            #0(OBJ)
-
-         to make them look less strange.
-
-        Just printing them as
-
-            OBJ
-
-         would be correct in a way as well, but zero rank arrays are
-         not really the same as Scheme values since they are boxed and
-         can be modified with array-set!, say.
-      */
-      scm_putc ('(', port);
-      scm_iprin1 (scm_i_cvref (v, base, 0), port, pstate);
-      scm_putc (')', port);
-      return 1;
-    }
-  else
-    return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
-}
-
-static int
-scm_i_print_enclosed_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  size_t base;
-
-  scm_putc ('#', port);
-  base = SCM_I_ARRAY_BASE (array);
-  scm_puts ("<enclosed-array ", port);
-  scm_i_print_array_dimension (array, 0, base, 1, port, pstate);
-  scm_putc ('>', port);
-  return 1;
-}
-
-/* Read an array.  This function can also read vectors and uniform
-   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
-   handled here.
-
-   C is the first character read after the '#'.
-*/
-
-static SCM
-tag_to_type (const char *tag, SCM port)
-{
-#if SCM_ENABLE_DEPRECATED
-  {
-    /* Recognize the old syntax.
-     */
-    const char *instead;
-    switch (tag[0])
-      {
-      case 'u':
-       instead = "u32";
-       break;
-      case 'e':
-       instead = "s32";
-       break;
-      case 's':
-       instead = "f32";
-       break;
-      case 'i':
-       instead = "f64";
-       break;
-      case 'y':
-       instead = "s8";
-       break;
-      case 'h':
-       instead = "s16";
-       break;
-      case 'l':
-       instead = "s64";
-       break;
-      case 'c':
-       instead = "c64";
-       break;
-      default:
-       instead = NULL;
-       break;
-      }
-    
-    if (instead && tag[1] == '\0')
-      {
-       scm_c_issue_deprecation_warning_fmt
-         ("The tag '%c' is deprecated for uniform vectors. "
-          "Use '%s' instead.", tag[0], instead);
-       return scm_from_locale_symbol (instead);
-      }
-  }
-#endif
-  
-  if (*tag == '\0')
-    return SCM_BOOL_T;
-  else
-    return scm_from_locale_symbol (tag);
-}
-
-static int
-read_decimal_integer (SCM port, int c, ssize_t *resp)
-{
-  ssize_t sign = 1;
-  ssize_t res = 0;
-  int got_it = 0;
-
-  if (c == '-')
-    {
-      sign = -1;
-      c = scm_getc (port);
-    }
-
-  while ('0' <= c && c <= '9')
-    {
-      res = 10*res + c-'0';
-      got_it = 1;
-      c = scm_getc (port);
-    }
-
-  if (got_it)
-    *resp = sign * res;
-  return c;
-}
-
-SCM
-scm_i_read_array (SCM port, int c)
-{
-  ssize_t rank;
-  int got_rank;
-  char tag[80];
-  int tag_len;
-
-  SCM shape = SCM_BOOL_F, elements;
-
-  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
-     the array code can not deal with zero-length dimensions yet, and
-     we want to allow zero-length vectors, of course.
-  */
-  if (c == '(')
-    {
-      scm_ungetc (c, port);
-      return scm_vector (scm_read (port));
-    }
-
-  /* Disambiguate between '#f' and uniform floating point vectors.
-   */
-  if (c == 'f')
-    {
-      c = scm_getc (port);
-      if (c != '3' && c != '6')
-       {
-         if (c != EOF)
-           scm_ungetc (c, port);
-         return SCM_BOOL_F;
-       }
-      rank = 1;
-      got_rank = 1;
-      tag[0] = 'f';
-      tag_len = 1;
-      goto continue_reading_tag;
-    }
-
-  /* Read rank. 
-   */
-  rank = 1;
-  c = read_decimal_integer (port, c, &rank);
-  if (rank < 0)
-    scm_i_input_error (NULL, port, "array rank must be non-negative",
-                      SCM_EOL);
-
-  /* Read tag. 
-   */
-  tag_len = 0;
- continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
-    {
-      tag[tag_len++] = c;
-      c = scm_getc (port);
-    }
-  tag[tag_len] = '\0';
-  
-  /* Read shape. 
-   */
-  if (c == '@' || c == ':')
-    {
-      shape = SCM_EOL;
-      
-      do
-       {
-         ssize_t lbnd = 0, len = 0;
-         SCM s;
-
-         if (c == '@')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &lbnd);
-           }
-         
-         s = scm_from_ssize_t (lbnd);
-
-         if (c == ':')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &len);
-             if (len < 0)
-               scm_i_input_error (NULL, port,
-                                  "array length must be non-negative",
-                                  SCM_EOL);
-
-             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
-           }
-
-         shape = scm_cons (s, shape);
-       } while (c == '@' || c == ':');
-
-      shape = scm_reverse_x (shape, SCM_EOL);
-    }
-
-  /* Read nested lists of elements.
-   */
-  if (c != '(')
-    scm_i_input_error (NULL, port,
-                      "missing '(' in vector or array literal",
-                      SCM_EOL);
-  scm_ungetc (c, port);
-  elements = scm_read (port);
-
-  if (scm_is_false (shape))
-    shape = scm_from_ssize_t (rank);
-  else if (scm_ilength (shape) != rank)
-    scm_i_input_error 
-      (NULL, port,
-       "the number of shape specifications must match the array rank",
-       SCM_EOL);
-
-  /* Handle special print syntax of rank zero arrays; see
-     scm_i_print_array for a rationale.
-  */
-  if (rank == 0)
-    {
-      if (!scm_is_pair (elements))
-       scm_i_input_error (NULL, port,
-                          "too few elements in array literal, need 1",
-                          SCM_EOL);
-      if (!scm_is_null (SCM_CDR (elements)))
-       scm_i_input_error (NULL, port,
-                          "too many elements in array literal, want 1",
-                          SCM_EOL);
-      elements = SCM_CAR (elements);
-    }
-
-  /* Construct array. 
-   */
-  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
-}
-
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
-           (SCM ra),
-           "")
-#define FUNC_NAME s_scm_array_type
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_generalized_vector_type (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0, 
-           (SCM ra),
-           "Return an object that would produce an array of the same type\n"
-           "as @var{array}, if used as the @var{prototype} for\n"
-           "@code{make-uniform-array}.")
-#define FUNC_NAME s_scm_array_prototype
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_get_old_prototype (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_get_old_prototype (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_UNSPECIFIED;
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#endif
-
-static SCM
-array_mark (SCM ptr)
-{
-  return SCM_I_ARRAY_V (ptr);
-}
-
-static size_t
-array_free (SCM ptr)
-{
-  scm_gc_free (SCM_I_ARRAY_MEM (ptr),
-              (sizeof (scm_i_t_array) 
-               + SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
-              "array");
-  return 0;
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM 
-scm_make_ra (int ndim)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_make_ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_make_ra (ndim, 0);
-}
-
-SCM 
-scm_shap2ra (SCM args, const char *what)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_shap2ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_shap2ra (args);
-}
-
-SCM
-scm_cvref (SCM v, unsigned long pos, SCM last)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_cvref is deprecated.  Use scm_c_generalized_vector_ref instead.");
-  return scm_c_generalized_vector_ref (v, pos);
-}
-
-void 
-scm_ra_set_contp (SCM ra)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_ra_set_contp is deprecated.  There should be no need for it.");
-  scm_i_ra_set_contp (ra);
-}
-
-long 
-scm_aind (SCM ra, SCM args, const char *what)
-{
-  scm_t_array_handle handle;
-  ssize_t pos;
-
-  scm_c_issue_deprecation_warning
-    ("scm_aind is deprecated.  Use scm_array_handle_pos instead.");
-
-  if (scm_is_integer (args))
-    args = scm_list_1 (args);
-  
-  scm_array_get_handle (ra, &handle);
-  pos = scm_array_handle_pos (&handle, args) + SCM_I_ARRAY_BASE (ra);
-  scm_array_handle_release (&handle);
-  return pos;
-}
-
-int 
-scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_raprin1 is deprecated.  Use scm_display or scm_write instead.");
-
-  scm_iprin1 (exp, port, pstate);
-  return 1;
-}
-
-#endif
-
-void
-scm_init_unif ()
-{
-  scm_i_tc16_array = scm_make_smob_type ("array", 0);
-  scm_set_smob_mark (scm_i_tc16_array, array_mark);
-  scm_set_smob_free (scm_i_tc16_array, array_free);
-  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
-  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
-
-  scm_i_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
-  scm_set_smob_mark (scm_i_tc16_enclosed_array, array_mark);
-  scm_set_smob_free (scm_i_tc16_enclosed_array, array_free);
-  scm_set_smob_print (scm_i_tc16_enclosed_array, scm_i_print_enclosed_array);
-  scm_set_smob_equalp (scm_i_tc16_enclosed_array, scm_array_equal_p);
-
-  scm_add_feature ("array");
-
-  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
-  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
-  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
-  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
-
-  init_type_creator_table ();
-
-#include "libguile/unif.x"
-
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/unif.h b/libguile/unif.h
deleted file mode 100644
index 91d26c8..0000000
--- a/libguile/unif.h
+++ /dev/null
@@ -1,198 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_UNIF_H
-#define SCM_UNIF_H
-
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008 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 3 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
- */
-
-
-
-#include "libguile/__scm.h"
-#include "libguile/print.h"
-
-
-
-/* This file contains the definitions for arrays and bit vectors.
-   Uniform numeric vectors are now in srfi-4.c.
-*/
-
-
-/** Arrays */
-
-typedef struct scm_t_array_dim
-{
-  ssize_t lbnd;
-  ssize_t ubnd;
-  ssize_t inc;
-} scm_t_array_dim;
-
-SCM_API SCM scm_array_p (SCM v, SCM prot);
-SCM_API SCM scm_typed_array_p (SCM v, SCM type);
-SCM_API SCM scm_make_array (SCM fill, SCM bounds);
-SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
-SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
-                                             const void *bytes,
-                                             size_t byte_len);
-SCM_API SCM scm_array_rank (SCM ra);
-SCM_API size_t scm_c_array_rank (SCM ra);
-SCM_API SCM scm_array_dimensions (SCM ra);
-SCM_API SCM scm_shared_array_root (SCM ra);
-SCM_API SCM scm_shared_array_offset (SCM ra);
-SCM_API SCM scm_shared_array_increments (SCM ra);
-SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
-SCM_API SCM scm_transpose_array (SCM ra, SCM args);
-SCM_API SCM scm_enclose_array (SCM ra, SCM axes);
-SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
-SCM_API SCM scm_array_ref (SCM v, SCM args);
-SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
-SCM_API SCM scm_array_contents (SCM ra, SCM strict);
-SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
-                                     SCM start, SCM end);
-SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
-                                    SCM start, SCM end);
-SCM_API SCM scm_array_to_list (SCM v);
-SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
-SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
-SCM_API SCM scm_array_type (SCM ra);
-
-SCM_API int scm_is_array (SCM obj);
-SCM_API int scm_is_typed_array (SCM obj, SCM type);
-
-SCM_API SCM scm_ra2contig (SCM ra, int copy);
-
-struct scm_t_array_handle;
-
-typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
-typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
-
-typedef struct scm_t_array_handle {
-  SCM array;
-  size_t base;
-  scm_t_array_dim *dims;
-  scm_t_array_dim dim0;
-  scm_i_t_array_ref ref;
-  scm_i_t_array_set set;
-  const void *elements;
-  void *writable_elements;
-} scm_t_array_handle;
-
-SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
-SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
-SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
-SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
-SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
-SCM_API void scm_array_handle_release (scm_t_array_handle *h);
-
-/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
-
-
-/** Bit vectors */
-
-SCM_API SCM scm_bitvector_p (SCM vec);
-SCM_API SCM scm_bitvector (SCM bits);
-SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
-SCM_API SCM scm_bitvector_length (SCM vec);
-SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
-SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
-SCM_API SCM scm_list_to_bitvector (SCM list);
-SCM_API SCM scm_bitvector_to_list (SCM vec);
-SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
-
-SCM_API SCM scm_bit_count (SCM item, SCM seq);
-SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
-SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_invert_x (SCM v);
-SCM_API SCM scm_istr2bve (SCM str);
-
-SCM_API int scm_is_bitvector (SCM obj);
-SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
-SCM_API size_t scm_c_bitvector_length (SCM vec);
-SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
-SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
-SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle 
*h);
-SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements 
(scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
-SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
-                                                   scm_t_array_handle *h,
-                                                   size_t *offp,
-                                                   size_t *lenp,
-                                                   ssize_t *incp);
-SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
-                                                      scm_t_array_handle *h,
-                                                      size_t *offp,
-                                                      size_t *lenp,
-                                                      ssize_t *incp);
-
-/* internal. */
-
-typedef struct scm_i_t_array
-{
-  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
-  unsigned long base;
-} scm_i_t_array;
-
-SCM_API scm_t_bits scm_i_tc16_array;
-SCM_API scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
-
-#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
-#define SCM_I_ENCLOSED_ARRAYP(a) \
-                            SCM_TYP16_PREDICATE (scm_i_tc16_enclosed_array, a)
-#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
-#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
-
-#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
-#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
-#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
-#define SCM_I_ARRAY_DIMS(a) \
-  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
-
-SCM_INTERNAL SCM scm_i_make_ra (int ndim, int enclosed);
-SCM_INTERNAL SCM scm_i_cvref (SCM v, size_t p, int enclosed);
-SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
-
-/* deprecated. */
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_API SCM scm_make_uve (long k, SCM prot);
-SCM_API SCM scm_array_prototype (SCM ra);
-SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
-SCM_API SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
-SCM_API SCM scm_make_ra (int ndim);
-SCM_API SCM scm_shap2ra (SCM args, const char *what);
-SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
-SCM_API void scm_ra_set_contp (SCM ra);
-SCM_API long scm_aind (SCM ra, SCM args, const char *what);
-SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
-
-#endif
-
-SCM_INTERNAL void scm_init_unif (void);
-
-#endif  /* SCM_UNIF_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/uniform.c b/libguile/uniform.c
new file mode 100644
index 0000000..28125da
--- /dev/null
+++ b/libguile/uniform.c
@@ -0,0 +1,254 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/uniform.h"
+
+
+const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
{
+  0,
+  0,
+  1,
+  8,
+  8, 8,
+  16, 16,
+  32, 32,
+  64, 64,
+  32, 64,
+  64, 128
+};
+
+/* FIXME: return bit size instead of byte size? */
+size_t
+scm_array_handle_uniform_element_size (scm_t_array_handle *h)
+{
+  size_t ret = scm_i_array_element_type_sizes[h->element_type];
+  if (ret && ret % 8 == 0)
+    return ret / 8;
+  else
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
+}
+
+const void *
+scm_array_handle_uniform_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_uniform_writable_elements (h);
+}
+
+void *
+scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
+{
+  size_t esize;
+  scm_t_uint8 *ret;
+
+  esize = scm_array_handle_uniform_element_size (h);
+  ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize;
+  return ret;
+}
+
+int
+scm_is_uniform_vector (SCM obj)
+{
+  scm_t_array_handle h;
+  int ret = 0;
+
+  if (scm_is_generalized_vector (obj))
+    {
+      scm_generalized_vector_get_handle (obj, &h);
+      ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+size_t
+scm_c_uniform_vector_length (SCM uvec)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  scm_array_handle_release (&h);
+  return len;
+}
+
+SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if @var{obj} is a uniform vector.")
+#define FUNC_NAME s_scm_uniform_vector_p
+{
+  return scm_from_bool (scm_is_uniform_vector (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 
0, 0,
+           (SCM v),
+           "Return the number of elements in the uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_type
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 
0, 0,
+           (SCM v),
+           "Return the number of bytes allocated to each element in the\n"
+            "uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_size
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_uniform_vector_ref (SCM v, size_t idx)
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_ref (&h, idx*inc);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
+           (SCM v, SCM idx),
+           "Return the element at index @var{idx} of the\n"
+           "homogenous numeric vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_ref
+{
+  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  scm_array_handle_set (&h, idx*inc, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
+           (SCM v, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the\n"
+           "homogenous numeric vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_uniform_vector_set_x
+{
+  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
+            (SCM uvec),
+           "Convert the uniform numeric vector @var{uvec} to a list.")
+#define FUNC_NAME s_scm_uniform_vector_to_list
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  ret = scm_generalized_vector_to_list (uvec);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+const void *
+scm_uniform_vector_elements (SCM uvec, 
+                            scm_t_array_handle *h,
+                            size_t *lenp, ssize_t *incp)
+{
+  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
+}
+
+void *
+scm_uniform_vector_writable_elements (SCM uvec, 
+                                     scm_t_array_handle *h,
+                                     size_t *lenp, ssize_t *incp)
+{
+  void *ret;
+  scm_generalized_vector_get_handle (uvec, h);
+  /* FIXME nonlocal exit */
+  ret = scm_array_handle_uniform_writable_elements (h);
+  if (lenp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
+           (SCM v),
+           "Return the number of elements in the uniform vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_length
+{
+  return scm_from_size_t (scm_c_uniform_vector_length (v));
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_uniform (void)
+{
+#include "libguile/uniform.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/uniform.h b/libguile/uniform.h
new file mode 100644
index 0000000..b1f3965
--- /dev/null
+++ b/libguile/uniform.h
@@ -0,0 +1,77 @@
+/* classes: h_files */
+
+#ifndef SCM_UNIFORM_H
+#define SCM_UNIFORM_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 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 3 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/generalized-vectors.h"
+
+
+
+/*
+ * Uniform vectors contain unboxed values. They are not necessarily contiguous.
+ */
+
+SCM_INTERNAL const size_t scm_i_array_element_type_sizes[];
+#define SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED(t)    \
+  (scm_i_array_element_type_sizes[(t)] != 0)
+
+/* returns type size in bits */
+SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
+
+SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
+SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle 
*h);
+
+SCM_API SCM scm_uniform_vector_p (SCM v);
+SCM_API SCM scm_uniform_vector_length (SCM v);
+SCM_API SCM scm_uniform_vector_element_type (SCM v);
+SCM_API SCM scm_uniform_vector_element_size (SCM v);
+SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_uniform_vector_to_list (SCM v);
+SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
+                                      SCM start, SCM end);
+SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
+                                     SCM start, SCM end);
+
+SCM_API int scm_is_uniform_vector (SCM obj);
+SCM_API size_t scm_c_uniform_vector_length (SCM v);
+SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
+                                                scm_t_array_handle *h,
+                                                size_t *lenp, ssize_t *incp);
+SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
+                                                   scm_t_array_handle *h,
+                                                   size_t *lenp,
+                                                   ssize_t *incp);
+
+SCM_INTERNAL void scm_init_uniform (void);
+
+#endif  /* SCM_UNIFORM_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 6dc994f..89b822a 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -30,9 +30,11 @@
 
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/srfi-4.h"
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
@@ -525,135 +527,42 @@ SCM_DEFINE (scm_vector_move_right_x, 
"vector-move-right!", 5, 0, 0,
 #undef FUNC_NAME
 
 
-/* Generalized vectors. */
-
-int
-scm_is_generalized_vector (SCM obj)
-{
-  return (scm_is_vector (obj)
-         || scm_is_string (obj)
-         || scm_is_bitvector (obj)
-         || scm_is_uniform_vector (obj)
-         || scm_is_bytevector (obj));
-}
-
-SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if @var{obj} is a vector, string,\n"
-           "bitvector, or uniform numeric vector.")
-#define FUNC_NAME s_scm_generalized_vector_p
-{
-  return scm_from_bool (scm_is_generalized_vector (obj));
-}
-#undef FUNC_NAME
-
-void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-    scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-}
-
-size_t
-scm_c_generalized_vector_length (SCM v)
+static SCM
+vector_handle_ref (scm_t_array_handle *h, size_t idx)
 {
-  if (scm_is_vector (v))
-    return scm_c_vector_length (v);
-  else if (scm_is_string (v))
-    return scm_c_string_length (v);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_length (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_length (v);
-  else if (scm_is_bytevector (v))
-    return scm_c_bytevector_length (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
+  return ((SCM*)h->elements)[idx];
 }
 
-SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 
0,
-           (SCM v),
-           "Return the length of the generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_length
+static void
+vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
 {
-  return scm_from_size_t (scm_c_generalized_vector_length (v));
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
+  ((SCM*)h->writable_elements)[idx] = val;
 }
-#undef FUNC_NAME
 
-SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
+static void
+vector_get_handle (SCM v, scm_t_array_handle *h)
 {
-  if (scm_is_vector (v))
-    return scm_c_vector_ref (v, idx);
-  else if (scm_is_string (v))
-    return scm_c_string_ref (v, idx);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_ref (v, idx);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_ref (v, idx);
-  else if (scm_is_bytevector (v))
-    return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_I_VECTOR_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM;
+  h->elements = h->writable_elements = SCM_I_VECTOR_WELTS (v);
 }
 
-SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
-           (SCM v, SCM idx),
-           "Return the element at index @var{idx} of the\n"
-           "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_ref
-{
-  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  if (scm_is_vector (v))
-    scm_c_vector_set_x (v, idx, val);
-  else if (scm_is_string (v))
-    scm_c_string_set_x (v, idx, val);
-  else if (scm_is_bitvector (v))
-    scm_c_bitvector_set_x (v, idx, val);
-  else if (scm_is_uniform_vector (v))
-    scm_c_uniform_vector_set_x (v, idx, val);
-  else if (scm_is_bytevector (v))
-    scm_i_bytevector_generalized_set_x (v, idx, val);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
-           (SCM v, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the\n"
-           "generalized vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_generalized_vector_set_x
-{
-  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 
0,
-           (SCM v),
-           "Return a new list whose elements are the elements of the\n"
-           "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_to_list
-{
-  if (scm_is_vector (v))
-    return scm_vector_to_list (v);
-  else if (scm_is_string (v))
-    return scm_string_to_list (v);
-  else if (scm_is_bitvector (v))
-    return scm_bitvector_to_list (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_uniform_vector_to_list (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-#undef FUNC_NAME
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_wvect, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector);
 
 
 void
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 902e15a..bc5b41c 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -24,7 +24,7 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 
 
 
@@ -61,21 +61,6 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
-/* Generalized vectors */
-
-SCM_API SCM scm_generalized_vector_p (SCM v);
-SCM_API SCM scm_generalized_vector_length (SCM v);
-SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_generalized_vector_to_list (SCM v);
-
-SCM_API int scm_is_generalized_vector (SCM obj);
-SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-                                               scm_t_array_handle *h);
-
 /* Internals */
 
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
diff --git a/module/Makefile.am b/module/Makefile.am
index 5ef00be..d1c2d95 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -203,6 +203,7 @@ SRFI_SOURCES = \
   srfi/srfi-1.scm \
   srfi/srfi-2.scm \
   srfi/srfi-4.scm \
+  srfi/srfi-4/gnu.scm \
   srfi/srfi-6.scm \
   srfi/srfi-8.scm \
   srfi/srfi-9.scm \
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 53fc741..c8d7621 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2003, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2005, 2006, 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
@@ -169,16 +169,6 @@
 ;; The strange prototype system for uniform arrays has been
 ;; deprecated.
 
-(define uniform-vector-fill! array-fill!)
-
-(define make-uniform-vector dimensions->uniform-array)
-
-(define (make-uniform-array prot . bounds)
-  (dimensions->uniform-array bounds prot))
- 
-(define (list->uniform-vector prot lst)
-  (list->uniform-array 1 prot lst))
-
 (define-macro (eval-case . clauses)
   (issue-deprecation-warning
    "`eval-case' is deprecated.  Use `eval-when' instead.")
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
new file mode 100644
index 0000000..d3f73b3
--- /dev/null
+++ b/module/srfi/srfi-4/gnu.scm
@@ -0,0 +1,52 @@
+;;; Extensions to SRFI-4
+
+;;     Copyright (C) 2001, 2002, 2004, 2006, 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 3 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
+
+;;; Commentary:
+
+;; Extensions to SRFI-4. Fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-4 gnu)
+  #:use-module (srfi srfi-4)
+  #:export (;; Somewhat polymorphic conversions.
+            any->u8vector any->s8vector any->u16vector any->s16vector
+            any->u32vector any->s32vector any->u64vector any->s64vector
+            any->f32vector any->f64vector any->c32vector any->c64vector))
+
+
+(define-macro (define-any->vector . tags)
+  `(begin
+     ,@(map (lambda (tag)
+              `(define (,(symbol-append 'any-> tag 'vector) obj)
+                 (cond ((,(symbol-append tag 'vector?) obj) obj)
+                       ((pair? obj) (,(symbol-append 'list-> tag 'vector) obj))
+                       ((generalized-vector? obj)
+                        (let* ((len (generalized-vector-length obj))
+                               (v (,(symbol-append 'make- tag 'vector) len)))
+                          (let lp ((i 0))
+                            (if (< i len)
+                                (begin
+                                  (,(symbol-append tag 'vector-set!)
+                                   v i (generalized-vector-ref obj i))
+                                  (lp (1+ i)))
+                                v))))
+                       (else (scm-error 'wrong-type-arg #f "" '() (list 
obj))))))
+            tags)))
+
+(define-any->vector u8 s8 u16 s16 u32 s32 u64 s64 f32 f64 c32 c64)
diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test
index 61dbeb8..5d584e8 100644
--- a/test-suite/tests/unif.test
+++ b/test-suite/tests/unif.test
@@ -1,6 +1,6 @@
 ;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
 ;;;;
-;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006, 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
@@ -17,7 +17,7 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
 (define-module (test-suite test-unif)
-  #:use-module (test-suite lib))
+    #:use-module (test-suite lib))
 
 ;;;
 ;;; array?


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]