guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, ra0, updated. v2.1.0-741-g1a51415


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, ra0, updated. v2.1.0-741-g1a51415
Date: Sun, 09 Feb 2014 12:33:04 +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=1a51415615fbe0f0fce4cd97437b846b82894d9a

The branch, ra0 has been updated
  discards  a5340d7288407c6c6cf5c842ae3925d184bf95eb (commit)
  discards  c361f6b17705fdadc4da436d3ec291713c2d7113 (commit)
  discards  27230bb012bc93f9c5f02e8c0f855c2a6d4f69cc (commit)
  discards  c420dbfc03f8772beae9183d7b1773466e5a4056 (commit)
  discards  9888660409d2a9cf1b762936b6b503c9d4be8d77 (commit)
  discards  bfc9277082b55ac6cc52544910bc0bff75ee9eb7 (commit)
  discards  b28367a36e3e536557fdc9072bd223835eb71a19 (commit)
  discards  b84542a9c8493ac5abba18a8336acf481a200856 (commit)
  discards  fcf95b5cf299e5d3b86f8d171586bf7f1faa17f8 (commit)
  discards  24ff9de6901cd07d5dfdb8272ee287b1f3302049 (commit)
  discards  6517d315f58d75fb1b9b8609ceb5e0745f9878fc (commit)
  discards  a5721d789ab516512dccc03dd4964c85c5f02fb5 (commit)
  discards  390c9cfe05d921c08642b4358b18c54b5a0e1a7f (commit)
  discards  1fadf71223da8b68ff60f8f68d08b7d8c4ab5d21 (commit)
  discards  a9967184071de59cd69f468d61bd1637916fe18e (commit)
  discards  08a7b5f893965fefe402d21b45946e7d4f29fc41 (commit)
  discards  5569daa0806414015bb07aa0c3ffaf017d8259bf (commit)
  discards  4ec2c043676ed1b31a1a0ba5eed9d049a7b6c821 (commit)
  discards  0e5c6f5ae96f19e9941f8068b83918a8f0a26744 (commit)
  discards  cde8b37582288b7e0c2bde14cf0b76b88198f084 (commit)
  discards  e3717f38901acdcd57a664265714878b02cd2789 (commit)
  discards  f7239ac53d7bd4c939cda1ec9420ecc82550579b (commit)
  discards  2c533af6e0f88ea046597db736561052b3777c59 (commit)
  discards  b3ceb8bc0e6786e65a3ca58ca6af0205b456ad22 (commit)
  discards  d9c9aa16e0768788013bcb35bd84f592066088b0 (commit)
  discards  4042884c89b122082d7463ae2630f8b5993661bc (commit)
  discards  dca733a69556f072ed9c36697a6b673d20967137 (commit)
  discards  fdf483f3fc265d0b94675d967ade8f2b0ffb0cc7 (commit)
  discards  53120e777ab87d8a751cc5e820abdb826c16d5e8 (commit)
  discards  d0513caa740073d599bc39f0e9de0f074012585e (commit)
  discards  d0028906e89d6c03e8a51a0a67058b7e6f8c242d (commit)
  discards  1776cdfa0c2d3da155b7098db4c5b26bbc06ff09 (commit)
  discards  97d339e9c264aded2d439d96c8af61a93e43a4e4 (commit)
  discards  afe96cbfbf4e446ff57126d27cf0f29e71dbd3d8 (commit)
  discards  823ebc0d6bd0ad2469fb6138a8d90b2e96946ff5 (commit)
  discards  95b759adcc195adfe2d947f6ea1a4686518ea5a8 (commit)
       via  1a51415615fbe0f0fce4cd97437b846b82894d9a (commit)
       via  0c0e0c8b6b45d140892de87b3365a1d70ca0e5a2 (commit)
       via  61d5e4df33311b9a3fe472de7070b4a5e775787b (commit)
       via  88c7cda479f9cafc88add7bcd1769c4d22ecb01c (commit)
       via  ad95aa9ebaed86a0bfc1f8a55566e10bbd190e55 (commit)
       via  726cc95ffbc38b9006e16bb0a1ce50b5d587d478 (commit)
       via  4af4068efa2558c2df3b85c4d8170a14dfcdd614 (commit)
       via  688034187a3f2726aff2e431f610d135495b46be (commit)
       via  c0e0b6f171522826cfcacb41e9983dfc89582745 (commit)
       via  1cc0d91efea68c742d86d851c9577801171b790f (commit)
       via  e0e8802b34b127de835683774159f7da61a45e3b (commit)
       via  96199263de84a65277dd5fa44cce0d837e4cc37f (commit)
       via  17f90ef90a4c5a7e1c268257a67255e6ba75b192 (commit)
       via  f1d289bf582f525e62c65bcc3c9701e9cabf63be (commit)
       via  9ef4bc075dee74a0f1490bcaa157831b7ded1f3b (commit)
       via  d41d5bf05ecea7ac0bb30a501ba4801043991b63 (commit)
       via  19239bbfcb89dfaf6ae3c40896645b0dbbc4783a (commit)
       via  cf64dca65c4ee4d845a73e7d7c15ab7583aff15b (commit)
       via  8269f0be18c046d94f01f83dcff80794e97e6c27 (commit)
       via  b0d9b0744a6bfadbf172a90ed3b5b788555ca11d (commit)
       via  a0ef1252af3204e9d86087c5752f48790575d372 (commit)
       via  e6658f527e2decf4b353f14b36b71c6009ebe3d6 (commit)
       via  2b5625ad0c93045d181d6c05eb9b94dc21462f22 (commit)
       via  7070f12b9dc13f3b204acf2bd68c68b26e764990 (commit)
       via  d747313100cafb2d2e05c84b146e70df295d0931 (commit)
       via  a32488ba13e81e51c1fef9fb057bdd805e8b3d72 (commit)
       via  787f7b644fa480b4815974c9850d5707881cf9f7 (commit)
       via  e0a00fe7e400aeb4d4314af410d43aea706cef62 (commit)
       via  24cac6554073bb6e691605cd6ac6196f3c0851a3 (commit)
       via  5cfeff11cc58148c58a85a879fd7a3e7cfbbe8e2 (commit)
       via  8051cf23044e5dbbece0d328102197a04ce5718d (commit)
       via  54f17b7b597a3695a25babac92255ed52fbeec4a (commit)
       via  c8b7b0dad33d6221682c5f49b7635d8de7e15bab (commit)
       via  12b8487d5d7272ae5bda62477df60d3e795aa645 (commit)
       via  adf06a72d53821d34e14fa69b20b10e2f809f593 (commit)
       via  04023cceb7584810005906b86c876d703a0e98b5 (commit)
       via  d4a5776ac5fd39fc65100d626ca3c147ca3dc2c2 (commit)
       via  5fc051babef5ea07cf48c02c31ef729344639f9a (commit)
       via  730639e9a7bca966c6e884ec47b3166544767f2f (commit)
       via  fb7dd00169304a5922838e4d2f25253640a35def (commit)
       via  dc65b88d839c326889618112c4870ad3a64e9446 (commit)
       via  b9b88351ea2c4b43a6f90938554dc5693b17e328 (commit)
       via  0ce224594ae5a673f6a397c284db5f5a61935334 (commit)
       via  5bc7c6dbab302c8ac991dfd2c3b254ff3524ba65 (commit)
       via  495cea0c931de23f074892b3f32808e676712a18 (commit)
       via  b86069c1308a6ca36f3a3bc56134b3f8fd693592 (commit)
       via  54cded99dc5db94b1df0dc417161ebef7c60d874 (commit)
       via  2f3b7e9a41677bfe802e8a1ee851827297384c58 (commit)
       via  85d3339d7e11c861e64bf2a4131fea8666ad8340 (commit)
       via  b5f9ba49db8e1ced6d70833b8104a266764a6537 (commit)
       via  a675a2e81b792b9f860bec57c38a1948631c7a41 (commit)

This update added new revisions after undoing existing revisions.  That is
to say, the old revision is not a strict subset of the new revision.  This
situation occurs when you --force push a change and generate a repository
containing something like this:

 * -- * -- B -- O -- O -- O (a5340d7288407c6c6cf5c842ae3925d184bf95eb)
            \
             N -- N -- N (1a51415615fbe0f0fce4cd97437b846b82894d9a)

When this happens we assume that you've already had alert emails for all
of the O revisions, and so we here report only the revisions in the N
branch from the common base, B.

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 1a51415615fbe0f0fce4cd97437b846b82894d9a
Author: Daniel Llorens <address@hidden>
Date:   Wed May 8 16:06:40 2013 +0200

    array-contents returns root for empty arrays with empty root
    
    This fixes a compiler issue where (uniform-array->bytevector #2f64())
    failed because of the stricter definition of uniform-vector? on this branch.
    
    Perhaps it would be better if uniform-array->bytevector didn't require
    a contiguous argument.
    
    * libguile/arrays.c: (scm_array_contents): return the root regardless of
      the value of SCM_I_ARRAY_DIMS (ra)->inc.
    * test-suite/tests/arrays.test: check.

commit 0c0e0c8b6b45d140892de87b3365a1d70ca0e5a2
Author: Daniel Llorens <address@hidden>
Date:   Thu May 2 11:43:31 2013 +0200

    Fix compilation bugs with some kinds of typed arrays
    
    * module/language/glil/compile-assembly.scm: pass (array-contents x)
      to uniform-array->bytevector instead of x, when x is a typed array.
    * test-suite/tests/arrays.test: test an instance of the above that
      failed in Guile 2.0.9.

commit 61d5e4df33311b9a3fe472de7070b4a5e775787b
Author: Daniel Llorens <address@hidden>
Date:   Tue Apr 30 16:11:07 2013 +0200

    Preallocate index list in scm_array_index_map_x
    
    * libguile/array-map.c
      - (scm_array_index_map_x): preallocate the index list instead of
        constructing it on each rank-1 iteration.
      - (ramap, rafe): use SCM_I_ARRAY_V just once.

commit 88c7cda479f9cafc88add7bcd1769c4d22ecb01c
Author: Daniel Llorens <address@hidden>
Date:   Mon Apr 29 14:19:52 2013 +0200

    Match types used in arrays.c to struct field types
    
    * libguile/arrays.c
      - scm_shared_array_root: check for SCM_I_ARRAYP first.
      - scm_i_shap2ra:
        * check valid bounds in the '(lbnd ubnd) case. This makes
          (make-array 0 '(4 -3)) fail with a 'bad dimension' instead of
          with a 'wrong index' error.
        * use ssize_t for lbnd/ubnd/inc, not long.
      - scm_make_shared_array: use ssize_t for indices, not long.
      - scm_transpose_array: use size_t for ndim, not ulong.
      - scm_i_print_array: idem.

commit ad95aa9ebaed86a0bfc1f8a55566e10bbd190e55
Author: Daniel Llorens <address@hidden>
Date:   Fri Apr 26 13:02:38 2013 +0200

    Don't use ASET in scm_array_index_map_x
    
    * libguile/array-map.c: (scm_array_index_map_x): replace ASET by direct
      use of handle->impl.

commit 726cc95ffbc38b9006e16bb0a1ce50b5d587d478
Author: Daniel Llorens <address@hidden>
Date:   Fri Apr 26 02:05:22 2013 +0200

    In scm_ramapc, only check unrolled axes for emptiness
    
    * libguile/array-map.c: (scm_ramapc)
      - Don't check emptiness while preparing ra0, but only after kroll is 
known,
        and only before kroll. len = 0 will be caught by the unrolled loop.
      - Use ra0 axis length in unroll check depth for rest args, not ra1's.
      - Recover early exit feature when cproc returns 0.

commit 4af4068efa2558c2df3b85c4d8170a14dfcdd614
Author: Daniel Llorens <address@hidden>
Date:   Thu Apr 25 18:49:14 2013 +0200

    Fix scm_ramapc bugs with 0-inc arrays
    
    * libguile/array-map.c: (scm_ramapc): Cannot flag empty on the product
      inc * dim * dim ... Check every dim.
    * test-suite/tests/ramap.test: Tests the 0-inc, non empty case for both
      array-map! and array-copy!.

commit 688034187a3f2726aff2e431f610d135495b46be
Author: Daniel Llorens <address@hidden>
Date:   Thu Apr 25 15:18:05 2013 +0200

    Fix corner cases of scm_ramapc
    
    * libguile/array-map.c
      - (scm_ramapc): mismatched axes limit unrollk (kroll). Reorganize
        the function to do all checking as we go.
      - (scm_ra_matchp): unused; remove.
      - (find_unrollk): inlined in scm_ramapc; remove.
      - (klen): inlined in scm_ramapc; remove.
      - (rafill): n is size_t.
      - (racp): n is size_t. Use n and not i0end to bound the loop.
      - (ramap): Use n and not i0end to bound the loop. This is needed for the 
rank
        0 case to work with the new scm_ramapc, as inc may be set to 0 in that 
case.
      - (rafe): idem.
    * test-suite/tests/ramap.test
      - check that size mismatch prevents unrolling (matching behavior III) with
        both array-copy! and array-map!.
      - check that non-contiguous stride in non-ref args prevents unrolling
        (rank 2, discontinuous) with both array-copy! and array-map!.
      - check rank 0 cases with array-for-each, array-map!.

commit c0e0b6f171522826cfcacb41e9983dfc89582745
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 24 23:29:48 2013 +0200

    Rewrite scm_ramapc()
    
    * libguile/array-map.c
      - (cind): replace by cindk, that operates only on the unrolled index set.
      - (klen): new function.
      - (make1array): take extra inc argument.
      - (scm_ramapc): rewrite to unroll as many axes as possible instead of 
just all
        or one.
      - (AREF): lbnd is known to be 0: remove.
      - (ASET): v is known to come from SCM_I_ARRAY_V; assume base, inc, lbnd.
      - (racp): use ssize_t instead of long for the indices.
      - (scm_array_index_map_x): build the index list at the last-but-one axis, 
then
        set the car of the last element, instead of building the list at the 
last axis.
    * test-suite/tests/ramap.test
      - add array-map! test with offset arguments.

commit 1cc0d91efea68c742d86d851c9577801171b790f
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 24 17:13:56 2013 +0200

    Check more cases of array-contents
    
    * libguile/arrays.c: (scm_array_contents): fix comment.
    * test-suite/tests/arrays.test: add cases that depend on correct
      setting of CONTIGUOUS_FLAG.

commit e0e8802b34b127de835683774159f7da61a45e3b
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 24 16:34:31 2013 +0200

    Check the documented matching behavior of array-map!/copy!
    
    * test-suite/tests/arrays.test: move array-copy! tests to ramap.test.
    * test-suite/tests/ramap.test: check the dissimilar matching behavior of
      array-copy! and array-map! with arguments of different size.

commit 96199263de84a65277dd5fa44cce0d837e4cc37f
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 24 16:00:06 2013 +0200

    Simplify ASET in array-map.c
    
    * libguile/array-map.c: (ASET): this is only ever used with a true vector
      type, so remove use of inc/base/lbnd.

commit 17f90ef90a4c5a7e1c268257a67255e6ba75b192
Author: Daniel Llorens <address@hidden>
Date:   Sat Apr 20 01:27:42 2013 +0200

    Fix compilation errors when reading arrays at the repl
    
    * compile-assembly.scm
      - vector-fold2: handle rank 1 arrays, since this is called with
        the result of array-contents which need not be a vector.
      - dump-constants: fix uses of vector-fold2. Replace vector-length
        on result of array-contents by array-length.
    * libguile/arrays.c
      - scm_array_contents: branch cases not on scm_is_generalized_vector but
        on SCM_I_ARRAYP. Thus lbnd!=0, which could happen with
        scm_is_generalized_vector, never appears in the output.
    * test-suite/tests/arrays.test
      - tests for array-contents.

commit f1d289bf582f525e62c65bcc3c9701e9cabf63be
Author: Daniel Llorens <address@hidden>
Date:   Fri Apr 19 16:44:48 2013 +0200

    Factor out make1array() in scm_ramapc()
    
    * libguile/array-map.c: (scm_ramapc): factor out vector->array conversion
      to aux function make1array.

commit 9ef4bc075dee74a0f1490bcaa157831b7ded1f3b
Author: Daniel Llorens <address@hidden>
Date:   Fri Apr 19 14:53:34 2013 +0200

    Raw pointer loop in array-copy! for vector/vector case
    
    This special case improves
    
    (define a (make-array 1. 1000000 10))
    (define b (make-array *unspecified* 1000000 10))
    (define c (transpose-array (make-array *unspecified* 10 1000000) 1 0))
    ,time (array-copy! a b)
    ,time (array-copy! a c)
    
    from 0.041598s / 0.072561 to 0.012164s / 0.041886s on a i7-3930K.
    
    * libguile/array-map.c: (racp): if both src and dst are on vectors, use
      the element pointers to do the copy.

commit d41d5bf05ecea7ac0bb30a501ba4801043991b63
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 17 14:33:40 2013 +0200

    Test that typed-array? returns #f with non-array argument
    
    * test-suite/tests/arrays.test: ditto.

commit 19239bbfcb89dfaf6ae3c40896645b0dbbc4783a
Author: Daniel Llorens <address@hidden>
Date:   Wed Apr 17 10:19:26 2013 +0200

    Replace SCM_IMP in array-map.c
    
    * libguile/array-map.c
      - scm_ramapc: check scm_array_contents with scm_is_false.

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

Summary of changes:
 doc/ref/api-foreign.texi                |   12 +-
 doc/ref/api-memory.texi                 |   12 +-
 doc/ref/posix.texi                      |   51 +-------
 doc/ref/srfi-modules.texi               |   60 --------
 libguile/array-handle.c                 |  244 ++++++++++++++++++++++++++-----
 libguile/array-handle.h                 |   46 ++-----
 libguile/array-map.c                    |   22 ++--
 libguile/bitvectors.c                   |   45 ++-----
 libguile/bitvectors.h                   |    3 +-
 libguile/bytevectors.c                  |  223 ++++------------------------
 libguile/bytevectors.h                  |    9 -
 libguile/generalized-arrays.c           |   67 ++++++---
 libguile/generalized-arrays.h           |    3 +-
 libguile/socket.c                       |   46 +------
 libguile/socket.h                       |    6 +-
 libguile/sort.c                         |   28 +++--
 libguile/srfi-4.c                       |   52 ++++---
 libguile/srfi-4.h                       |    7 +-
 libguile/strings.c                      |   34 +----
 libguile/tags.h                         |   15 +--
 libguile/uniform.c                      |  177 +----------------------
 libguile/uniform.h                      |   29 +----
 libguile/validate.h                     |    5 +-
 libguile/vectors.c                      |  151 ++++++++-----------
 libguile/vectors.h                      |    5 +-
 libguile/vm-engine.c                    |   67 ++++-----
 libguile/vm.c                           |   15 ++
 libguile/weak-table.c                   |    4 +-
 libguile/weak-vector.c                  |    4 +-
 module/ice-9/pretty-print.scm           |   11 +-
 module/oop/goops.scm                    |   11 +-
 module/srfi/srfi-4.scm                  |   27 +---
 module/srfi/srfi-4/gnu.scm              |   45 +-----
 module/system/vm/assembler.scm          |   24 ++-
 test-suite/guile-test                   |    8 +-
 test-suite/tests/00-socket.test         |   44 +------
 test-suite/tests/arrays.test            |   77 ++++------
 test-suite/tests/bitvectors.test        |   19 +--
 test-suite/tests/bytevectors.test       |    7 +-
 test-suite/tests/encoding-iso88591.test |   11 +-
 test-suite/tests/encoding-iso88597.test |   12 +-
 test-suite/tests/encoding-utf8.test     |   10 +-
 test-suite/tests/format.test            |    7 +-
 test-suite/tests/ports.test             |    4 +-
 test-suite/tests/regexp.test            |    6 +-
 test-suite/tests/srfi-14.test           |   10 +-
 test-suite/tests/srfi-19.test           |    5 +-
 test-suite/tests/srfi-4.test            |   50 +++---
 test-suite/tests/tree-il.test           |    6 +-
 49 files changed, 646 insertions(+), 1190 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index e595668..381c10d 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
 @c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008,
address@hidden   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
address@hidden   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, 
Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Foreign Function Interface
@@ -613,12 +613,10 @@ Scheme objects such as strings, floating point numbers, 
or integers.
 Return a bytevector aliasing the @var{len} bytes pointed to by
 @var{pointer}.
 
-The user may specify an alternate default interpretation for
-the memory by passing the @var{uvec_type} argument, to indicate
-that the memory is an array of elements of that type.
address@hidden should be something that
address@hidden would return, like @code{f32}
-or @code{s16}.
+The user may specify an alternate default interpretation for the memory
+by passing the @var{uvec_type} argument, to indicate that the memory is
+an array of elements of that type.  @var{uvec_type} should be something
+that @code{array-type} would return, like @code{f32} or @code{s16}.
 
 When @var{offset} is passed, it specifies the offset in bytes relative
 to @var{pointer} of the memory region aliased by the returned
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index 130ff84..01bfe81 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -296,9 +296,9 @@ they constitute a doubly-weak table has to be used.
 @node Weak hash tables
 @subsubsection Weak hash tables
 
address@hidden {Scheme Procedure} make-weak-key-hash-table size
address@hidden {Scheme Procedure} make-weak-value-hash-table size
address@hidden {Scheme Procedure} make-doubly-weak-hash-table size
address@hidden {Scheme Procedure} make-weak-key-hash-table [size]
address@hidden {Scheme Procedure} make-weak-value-hash-table [size]
address@hidden {Scheme Procedure} make-doubly-weak-hash-table [size]
 @deffnx {C Function} scm_make_weak_key_hash_table (size)
 @deffnx {C Function} scm_make_weak_value_hash_table (size)
 @deffnx {C Function} scm_make_doubly_weak_hash_table (size)
@@ -324,9 +324,6 @@ nor a weak value hash table.
 @node Weak vectors
 @subsubsection Weak vectors
 
-Weak vectors are mainly useful in Guile's implementation of weak hash
-tables.
-
 @deffn {Scheme Procedure} make-weak-vector size [fill]
 @deffnx {C Function} scm_make_weak_vector (size, fill)
 Return a weak vector with @var{size} elements. If the optional
@@ -346,8 +343,7 @@ the same way @code{list->vector} would.
 
 @deffn {Scheme Procedure} weak-vector? obj
 @deffnx {C Function} scm_weak_vector_p (obj)
-Return @code{#t} if @var{obj} is a weak vector. Note that all
-weak hashes are also weak vectors.
+Return @code{#t} if @var{obj} is a weak vector.
 @end deffn
 
 @deffn {Scheme Procedure} weak-vector-ref wvect k
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 9091d9f..6cd90bc 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
 @c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
address@hidden   2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, 
Inc.
address@hidden   2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software 
Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node POSIX
@@ -3393,55 +3393,6 @@ file descriptor:
 any unflushed buffered port data is ignored.
 @end deffn
 
-The following functions can be used to convert short and long integers
-between ``host'' and ``network'' order.  Although the procedures above do
-this automatically for addresses, the conversion will still need to
-be done when sending or receiving encoded integer data from the network.
-
address@hidden {Scheme Procedure} htons value
address@hidden {C Function} scm_htons (value)
-Convert a 16 bit quantity from host to network byte ordering.
address@hidden is packed into 2 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} ntohs value
address@hidden {C Function} scm_ntohs (value)
-Convert a 16 bit quantity from network to host byte ordering.
address@hidden is packed into 2 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} htonl value
address@hidden {C Function} scm_htonl (value)
-Convert a 32 bit quantity from host to network byte ordering.
address@hidden is packed into 4 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} ntohl value
address@hidden {C Function} scm_ntohl (value)
-Convert a 32 bit quantity from network to host byte ordering.
address@hidden is packed into 4 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
-These procedures are inconvenient to use at present, but consider:
-
address@hidden
-(define write-network-long
-  (lambda (value port)
-    (let ((v (make-uniform-vector 1 1 0)))
-      (uniform-vector-set! v 0 (htonl value))
-      (uniform-vector-write v port))))
-
-(define read-network-long
-  (lambda (port)
-    (let ((v (make-uniform-vector 1 1 0)))
-      (uniform-vector-read! v port)
-      (ntohl (uniform-vector-ref v 0)))))
address@hidden example
-
 
 @node Internet Socket Examples
 @subsubsection Network Socket Examples
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 746ee62..161d372 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -1346,7 +1346,6 @@ C had modules!)
 @menu
 * SRFI-4 Overview::             The warp and weft of uniform numeric vectors.
 * SRFI-4 API::                  Uniform vectors, from Scheme and from C.
-* SRFI-4 Generic Operations::   The general, operating on the specific.
 * SRFI-4 and Bytevectors::      SRFI-4 vectors are backed by bytevectors.
 * SRFI-4 Extensions::           Guile-specific extensions to the standard.
 @end menu
@@ -1731,65 +1730,6 @@ C}), but returns a pointer to the elements of a uniform 
numeric vector
 of the indicated kind.
 @end deftypefn
 
address@hidden SRFI-4 Generic Operations
address@hidden SRFI-4 - Generic operations
-
-Guile also provides procedures that operate on all types of uniform numeric
-vectors.  In what is probably a bug, these procedures are currently available 
in
-the default environment as well; however prudent hackers will make sure to
-import @code{(srfi srfi-4 gnu)} before using these.
-
address@hidden {C Function} int scm_is_uniform_vector (SCM uvec)
-Return non-zero when @var{uvec} is a uniform numeric vector, zero
-otherwise.
address@hidden deftypefn
-
address@hidden {C Function} size_t scm_c_uniform_vector_length (SCM uvec)
-Return the number of elements of @var{uvec} as a @code{size_t}.
address@hidden deftypefn
-
address@hidden  {Scheme Procedure} uniform-vector? obj
address@hidden {C Function} scm_uniform_vector_p (obj)
-Return @code{#t} if @var{obj} is a homogeneous numeric vector of the
-indicated type.
address@hidden deffn
-
address@hidden  {Scheme Procedure} uniform-vector-length vec
address@hidden {C Function} scm_uniform_vector_length (vec)
-Return the number of elements in @var{vec}.
address@hidden deffn
-
address@hidden  {Scheme Procedure} uniform-vector-ref vec i
address@hidden {C Function} scm_uniform_vector_ref (vec, i)
-Return the element at index @var{i} in @var{vec}.  The first element
-in @var{vec} is index 0.
address@hidden deffn
-
address@hidden  {Scheme Procedure} uniform-vector-set! vec i value
address@hidden {C Function} scm_uniform_vector_set_x (vec, i, value)
-Set the element at index @var{i} in @var{vec} to @var{value}.  The
-first element in @var{vec} is index 0.  The return value is
-unspecified.
address@hidden deffn
-
address@hidden  {Scheme Procedure} uniform-vector->list vec
address@hidden {C Function} scm_uniform_vector_to_list (vec)
-Return a newly allocated list holding all elements of @var{vec}.
address@hidden deffn
-
address@hidden  {C Function} {const void *} scm_uniform_vector_elements (SCM 
vec, scm_t_array_handle *handle, size_t *lenp, ssize_t *incp)
-Like @code{scm_vector_elements} (@pxref{Vector Accessing from C}), but
-returns a pointer to the elements of a uniform numeric vector.
address@hidden deftypefn
-
address@hidden  {C Function} {void *} scm_uniform_vector_writable_elements (SCM 
vec, scm_t_array_handle *handle, size_t *lenp, ssize_t *incp)
-Like @code{scm_vector_writable_elements} (@pxref{Vector Accessing from
-C}), but returns a pointer to the elements of a uniform numeric vector.
address@hidden deftypefn
-
-Unless you really need to the limited generality of these functions, it
-is best to use the type-specific functions, or the array accessors.
-
 @node SRFI-4 and Bytevectors
 @subsubsection SRFI-4 - Relation to bytevectors
 
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 76502e7..84e9f88 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005,
- * 2006, 2009, 2011, 2013 Free Software Foundation, Inc.
+ * 2006, 2009, 2011, 2013, 2014 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,56 +33,222 @@
 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;
+/* Bytevectors as generalized vectors & arrays.  */
 
+#define DEFINE_BYTEVECTOR_ACCESSORS(type, tag, infix)           \
+  static SCM                                                    \
+  bytevector_##tag##_ref (SCM bv, size_t pos)                   \
+  {                                                             \
+    SCM idx = scm_from_size_t (pos * sizeof (type));            \
+    return scm_bytevector_##infix##_ref (bv, idx);              \
+  }                                                             \
+  static void                                                   \
+  bytevector_##tag##_set (SCM bv, size_t pos, SCM val)          \
+  {                                                             \
+    SCM idx = scm_from_size_t (pos * sizeof (type));            \
+    scm_bytevector_##infix##_set_x (bv, idx, val);              \
+  }
 
-void
-scm_i_register_array_implementation (scm_t_array_implementation *impl)
+DEFINE_BYTEVECTOR_ACCESSORS (uint8_t, u8, u8);
+DEFINE_BYTEVECTOR_ACCESSORS (int8_t, s8, s8);
+DEFINE_BYTEVECTOR_ACCESSORS (uint16_t, u16, u16_native);
+DEFINE_BYTEVECTOR_ACCESSORS (int16_t, s16, s16_native);
+DEFINE_BYTEVECTOR_ACCESSORS (uint32_t, u32, u32_native);
+DEFINE_BYTEVECTOR_ACCESSORS (int32_t, s32, s32_native);
+DEFINE_BYTEVECTOR_ACCESSORS (uint64_t, u64, u64_native);
+DEFINE_BYTEVECTOR_ACCESSORS (int64_t, s64, s64_native);
+DEFINE_BYTEVECTOR_ACCESSORS (float, f32, ieee_single_native);
+DEFINE_BYTEVECTOR_ACCESSORS (double, f64, ieee_double_native);
+
+/* Since these functions are only called by Guile's C code, we can abort
+   instead of throwing if there is an error.  */
+static SCM
+bytevector_c32_ref (SCM bv, size_t pos)
+{
+  char *c_bv;
+  float real, imag;
+
+  if (!SCM_BYTEVECTOR_P (bv))
+    abort ();
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  pos *= 2 * sizeof (float);
+  if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+    abort ();
+
+  memcpy (&real, &c_bv[pos], sizeof (float));
+  memcpy (&imag, &c_bv[pos + sizeof (float)], sizeof (float));
+  return scm_c_make_rectangular (real, imag);
+}
+
+static SCM
+bytevector_c64_ref (SCM bv, size_t pos)
+{
+  char *c_bv;
+  double real, imag;
+
+  if (!SCM_BYTEVECTOR_P (bv))
+    abort ();
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  pos *= 2 * sizeof (double);
+  if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+    abort ();
+
+  memcpy (&real, &c_bv[pos], sizeof (double));
+  memcpy (&imag, &c_bv[pos + sizeof (double)], sizeof (double));
+  return scm_c_make_rectangular (real, imag);
+}
+
+static void
+bytevector_c32_set (SCM bv, size_t pos, SCM val)
+{
+  char *c_bv;
+  float real, imag;
+
+  if (!SCM_BYTEVECTOR_P (bv))
+    abort ();
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  pos *= 2 * sizeof (float);
+  if (pos + 2 * sizeof (float) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
+    abort ();
+
+  real = scm_c_real_part (val);
+  imag = scm_c_imag_part (val);
+  memcpy (&c_bv[pos], &real, sizeof (float));
+  memcpy (&c_bv[pos + sizeof (float)], &imag, sizeof (float));
+}
+
+static void
+bytevector_c64_set (SCM bv, size_t pos, SCM val)
 {
-  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
-    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
+  char *c_bv;
+  double real, imag;
+
+  if (!SCM_BYTEVECTOR_P (bv))
+    abort ();
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  pos *= 2 * sizeof (double);
+  if (pos + 2 * sizeof (double) - 1 >= SCM_BYTEVECTOR_LENGTH (bv))
     abort ();
-  else
-    array_impls[num_array_impls_registered++] = *impl;
+
+  real = scm_c_real_part (val);
+  imag = scm_c_imag_part (val);
+  memcpy (&c_bv[pos], &real, sizeof (double));
+  memcpy (&c_bv[pos + sizeof (double)], &imag, sizeof (double));
 }
 
-scm_t_array_implementation*
-scm_i_array_implementation_for_obj (SCM obj)
+static void
+initialize_vector_handle (scm_t_array_handle *h, size_t len,
+                          scm_t_array_element_type element_type,
+                          scm_t_vector_ref vref, scm_t_vector_set vset,
+                          void *writable_elements)
 {
-  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;
+  h->base = 0;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = (ssize_t) (len - 1U);
+  h->dim0.inc = 1;
+  h->element_type = element_type;
+  h->elements = h->writable_elements = writable_elements;
+  h->vector = h->array;
+  h->vref = vref;
+  h->vset = vset;
 }
 
-/* see bitvector_get_handle, string_get_handle, bytevector_get_handle,
-   vector_get_handle, only ever called from here */
 void
 scm_array_get_handle (SCM array, scm_t_array_handle *h)
 {
-  scm_t_array_implementation *impl;
-  if (SCM_I_ARRAYP (array))
+  if (!SCM_HEAP_OBJECT_P (array))
+    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+
+  h->array = array;
+
+  switch (SCM_TYP7 (array))
     {
-      SCM v = SCM_I_ARRAY_V (array);
-      impl = scm_i_array_implementation_for_obj (v);
-      h->impl = impl;
-      h->impl->get_handle (v, h);
-      /* this works because the v's impl NEVER uses dims/ndims/base */
-      h->dims = SCM_I_ARRAY_DIMS (array);
-      h->ndims = SCM_I_ARRAY_NDIM (array);
+    case scm_tc7_string:
+      initialize_vector_handle (h, scm_c_string_length (array),
+                                SCM_ARRAY_ELEMENT_TYPE_CHAR,
+                                scm_c_string_ref, scm_c_string_set_x,
+                                NULL);
+      break;
+    case scm_tc7_vector:
+      initialize_vector_handle (h, scm_c_vector_length (array),
+                                SCM_ARRAY_ELEMENT_TYPE_SCM,
+                                scm_c_vector_ref, scm_c_vector_set_x,
+                                SCM_I_VECTOR_WELTS (array));
+      break;
+    case scm_tc7_bitvector:
+      initialize_vector_handle (h, scm_c_bitvector_length (array),
+                                SCM_ARRAY_ELEMENT_TYPE_BIT,
+                                scm_c_bitvector_ref, scm_c_bitvector_set_x,
+                                scm_i_bitvector_bits (array));
+      break;
+    case scm_tc7_bytevector:
+      {
+        size_t byte_length, length, element_byte_size;
+        scm_t_array_element_type element_type;
+        scm_t_vector_ref vref;
+        scm_t_vector_set vset;
+
+        byte_length = scm_c_bytevector_length (array);
+        element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array);
+        element_byte_size = scm_i_array_element_type_sizes[element_type] / 8;
+        length = byte_length / element_byte_size;
+
+        switch (element_type)
+          {
+#define ACCESSOR_CASE(tag, TAG)                 \
+          case SCM_ARRAY_ELEMENT_TYPE_##TAG:    \
+            vref = bytevector_##tag##_ref;      \
+            vset = bytevector_##tag##_set;      \
+            break
+
+          case SCM_ARRAY_ELEMENT_TYPE_VU8:
+          ACCESSOR_CASE(u8, U8);
+          ACCESSOR_CASE(s8, S8);
+          ACCESSOR_CASE(u16, U16);
+          ACCESSOR_CASE(s16, S16);
+          ACCESSOR_CASE(u32, U32);
+          ACCESSOR_CASE(s32, S32);
+          ACCESSOR_CASE(u64, U64);
+          ACCESSOR_CASE(s64, S64);
+          ACCESSOR_CASE(f32, F32);
+          ACCESSOR_CASE(f64, F64);
+          ACCESSOR_CASE(c32, C32);
+          ACCESSOR_CASE(c64, C64);
+
+          case SCM_ARRAY_ELEMENT_TYPE_SCM:
+          case SCM_ARRAY_ELEMENT_TYPE_BIT:
+          case SCM_ARRAY_ELEMENT_TYPE_CHAR:
+          default:
+            abort ();
+
+#undef ACCESSOR_CASE
+          }
+
+        initialize_vector_handle (h, length, element_type, vref, vset,
+                                  SCM_BYTEVECTOR_CONTENTS (array));
+      }
+      break;
+    case scm_tc7_array:
       h->base = SCM_I_ARRAY_BASE (array);
-    }
-  else
-    {
-      impl = scm_i_array_implementation_for_obj (array);
-      if (!impl)
-        scm_wrong_type_arg_msg (NULL, 0, array, "array");
-      h->impl = impl;
-      h->impl->get_handle (array, h);
+      h->ndims = SCM_I_ARRAY_NDIM (array);
+      h->dims = SCM_I_ARRAY_DIMS (array);
+      {
+        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;
+        h->vector = vh.vector;
+        h->vref = vh.vref;
+        h->vset = vh.vset;
+        scm_array_handle_release (&vh);
+      }
+      break;
+    default:
+      scm_wrong_type_arg_msg (NULL, 0, array, "array");
     }
 }
 
@@ -167,7 +333,7 @@ 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->root, "non-uniform array");
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
   return ((const SCM*)h->elements) + h->base;
 }
 
@@ -175,7 +341,7 @@ 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->root, "non-uniform array");
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
   return ((SCM*)h->elements) + h->base;
 }
 
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
index ac54825..a623b4e 100644
--- a/libguile/array-handle.h
+++ b/libguile/array-handle.h
@@ -4,7 +4,7 @@
 #define SCM_ARRAY_HANDLE_H
 
 /* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2004, 2006,
- *   2008, 2009, 2011, 2013 Free Software Foundation, Inc.
+ *   2008, 2009, 2011, 2013, 2014 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
@@ -30,35 +30,8 @@
 
 
 
-struct scm_t_array_handle;
-
-typedef SCM (*scm_i_t_array_ref) (SCM, size_t);
-typedef void (*scm_i_t_array_set) (SCM, 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 SCM (*scm_t_vector_ref) (SCM, size_t);
+typedef void (*scm_t_vector_set) (SCM, size_t, SCM);
 
 typedef struct scm_t_array_dim
 {
@@ -92,8 +65,8 @@ SCM_INTERNAL SCM scm_i_array_element_types[];
 
 
 typedef struct scm_t_array_handle {
-  SCM root;
-  scm_t_array_implementation *impl;
+  SCM array;
+
   /* `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
@@ -107,6 +80,11 @@ typedef struct scm_t_array_handle {
   scm_t_array_element_type element_type;
   const void *elements;
   void *writable_elements;
+
+  /* The backing store for the array, and its accessors.  */
+  SCM vector;
+  scm_t_vector_ref vref;
+  scm_t_vector_set vset;
 } scm_t_array_handle;
 
 #define scm_array_handle_rank(h) ((h)->ndims)
@@ -135,7 +113,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
     /* catch overflow */
     scm_out_of_range (NULL, scm_from_ssize_t (p));
   /* perhaps should catch overflow here too */
-  return h->impl->vref (h->root, h->base + p);
+  return h->vref (h->vector, h->base + p);
 }
 
 SCM_INLINE_IMPLEMENTATION void
@@ -145,7 +123,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM 
v)
     /* catch overflow */
     scm_out_of_range (NULL, scm_from_ssize_t (p));
   /* perhaps should catch overflow here too */
-  h->impl->vset (h->root, h->base + p, v);
+  h->vset (h->vector, h->base + p, v);
 }
 
 #endif
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 48ed149..1670b32 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -234,7 +234,7 @@ rafill (SCM dst, SCM fill)
   dst = SCM_I_ARRAY_V (dst);
 
   for (; n-- > 0; i += inc)
-    h.impl->vset (dst, i, fill);
+    h.vset (h.vector, i, fill);
 
   scm_array_handle_release (&h);
   return 1;
@@ -271,7 +271,8 @@ racp (SCM src, SCM dst)
   scm_array_get_handle (src, &h_s);
   scm_array_get_handle (dst, &h_d);
 
-  if (scm_is_vector (src) && scm_is_vector (dst))
+  if (h_s.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM
+      && h_d.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
     {
       SCM const * el_s = h_s.elements;
       SCM * el_d = h_d.writable_elements;
@@ -280,7 +281,7 @@ racp (SCM src, SCM dst)
     }
   else
     for (; n-- > 0; i_s += inc_s, i_d += inc_d)
-      h_d.impl->vset (dst, i_d, h_s.impl->vref (src, i_s));
+      h_d.vset (h_d.vector, i_d, h_s.vref (h_s.vector, i_s));
 
   scm_array_handle_release (&h_d);
   scm_array_handle_release (&h_s);
@@ -581,7 +582,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
   scm_array_get_handle (ra0, &h0);
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
-      h0.impl->vset (ra0, i0, scm_call_0 (proc));
+      h0.vset (h0.vector, i0, scm_call_0 (proc));
   else
     {
       SCM ra1 = SCM_CAR (ras);
@@ -595,7 +596,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
       scm_array_get_handle (ra1, &h1);
       if (scm_is_null (ras))
         for (; n--; i0 += inc0, i1 += inc1)
-          h0.impl->vset (ra0, i0, scm_call_1 (proc, h1.impl->vref (ra1, i1)));
+          h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
       else
         {
           ras = scm_vector (ras);
@@ -605,7 +606,8 @@ ramap (SCM ra0, SCM proc, SCM ras)
               unsigned long k;
               for (k = scm_c_vector_length (ras); k--;)
                 args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
-              h0.impl->vset (ra0, i0, scm_apply_1 (proc, h1.impl->vref (ra1, 
i1), args));
+              h0.vset (h0.vector, i0,
+                       scm_apply_1 (proc, h1.vref (h1.vector, i1), args));
             }
         }
       scm_array_handle_release (&h1);
@@ -655,7 +657,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
   scm_array_get_handle (ra0, &h0);
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
-      scm_call_1 (proc, h0.impl->vref (ra0, i0));
+      scm_call_1 (proc, h0.vref (h0.vector, i0));
   else
     {
       ras = scm_vector (ras);
@@ -665,7 +667,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
           unsigned long k;
           for (k = scm_c_vector_length (ras); k--;)
             args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
-          scm_apply_1 (proc, h0.impl->vref (ra0, i0), args);
+          scm_apply_1 (proc, h0.vref (h0.vector, i0), args);
         }
     }
   scm_array_handle_release (&h0);
@@ -694,7 +696,7 @@ array_index_map_1 (SCM ra, SCM proc)
   scm_array_get_handle (ra, &h);
   inc = h.dims[0].inc;
   for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc)
-    h.impl->vset (h.root, p, scm_call_1 (proc, scm_from_ssize_t (i)));
+    h.vset (h.vector, p, scm_call_1 (proc, scm_from_ssize_t (i)));
   scm_array_handle_release (&h);
 }
 
@@ -735,7 +737,7 @@ array_index_map_n (SCM ra, SCM proc)
           for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd; ++vi[kmax])
             {
               *(si[kmax]) = scm_from_ssize_t (vi[kmax]);
-              h.impl->vset (h.root, i, scm_apply_0 (proc, args));
+              h.vset (h.vector, i, scm_apply_0 (proc, args));
               i += SCM_I_ARRAY_DIMS (ra)[kmax].inc;
             }
           k--;
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 354895c..1611119 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010, 2011, 2012, 2013, 2014 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
@@ -42,6 +42,13 @@
 #define BITVECTOR_LENGTH(obj)   ((size_t)SCM_CELL_WORD_1(obj))
 #define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_CELL_WORD_2(obj))
 
+scm_t_uint32 *scm_i_bitvector_bits (SCM vec)
+{
+  if (!IS_BITVECTOR (vec))
+    abort ();
+  return BITVECTOR_BITS (vec);
+}
+
 int
 scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
 {
@@ -165,12 +172,12 @@ scm_array_handle_bit_elements (scm_t_array_handle *h)
 scm_t_uint32 *
 scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
 {
-  SCM vec = h->root;
+  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->root, "bit array");
+  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
 }
 
 size_t
@@ -845,43 +852,13 @@ scm_istr2bve (SCM str)
            goto exit;
          }
     }
-
+  
  exit:
   scm_array_handle_release (&handle);
   scm_remember_upto_here_1 (str);
   return res;
 }
 
-/* FIXME: We know that bitvector is such, so can skip the checks */
-static SCM
-bitvector_handle_ref (SCM bitvector, size_t pos)
-{
-  return scm_c_bitvector_ref (bitvector, pos);
-}
-
-static void
-bitvector_handle_set (SCM bitvector, size_t pos, SCM val)
-{
-  scm_c_bitvector_set_x (bitvector, pos, val);
-}
-
-static void
-bitvector_get_handle (SCM bv, scm_t_array_handle *h)
-{
-  h->base = 0;
-  h->root = 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_tc7_bitvector, 0x7f,
-                          bitvector_handle_ref, bitvector_handle_set,
-                          bitvector_get_handle)
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
 
 void
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 6b25327..6b2cb1e 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -3,7 +3,7 @@
 #ifndef SCM_BITVECTORS_H
 #define SCM_BITVECTORS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2014 
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
@@ -70,6 +70,7 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM 
vec,
                                                       size_t *lenp,
                                                       ssize_t *incp);
 
+SCM_INTERNAL scm_t_uint32 *scm_i_bitvector_bits (SCM vec);
 SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state 
*pstate);
 SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
 SCM_INTERNAL void scm_init_bitvectors (void);
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 3fde042..c7908d7 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -195,6 +195,8 @@
 #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent)        \
   SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
 
+#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))
 
@@ -402,6 +404,31 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 
value)
 }
 #undef FUNC_NAME
 
+
+
+int
+scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
+{
+  ssize_t ubnd, inc, i;
+  scm_t_array_handle h;
+  
+  scm_array_get_handle (bv, &h);
+
+  scm_putc_unlocked ('#', port);
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc_unlocked ('(', 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_unlocked (' ', port);
+      scm_write (scm_array_handle_ref (&h, i), port);
+    }
+  scm_putc_unlocked (')', port);
+
+  return 1;
+}
+
 
 /* General operations.  */
 
@@ -2054,186 +2081,6 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 #undef FUNC_NAME
 
 
-/* Bytevectors as generalized vectors & arrays.  */
-
-#define COMPLEX_ACCESSOR_PROLOGUE(_type)                       \
-  size_t c_len, c_index;                                       \
-  char *c_bv;                                                  \
-                                                               \
-  SCM_VALIDATE_BYTEVECTOR (1, bv);                             \
-  c_index = scm_to_size_t (index);                             \
-                                                               \
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);                          \
-  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                        \
-                                                               \
-  if (SCM_UNLIKELY (c_index + 2 * sizeof (_type) - 1 >= c_len))        \
-    scm_out_of_range (FUNC_NAME, index);
-
-/* Template for native access to complex numbers of type TYPE.  */
-#define COMPLEX_NATIVE_REF(_type)                                      \
-  SCM result;                                                          \
-                                                                       \
-  COMPLEX_ACCESSOR_PROLOGUE (_type);                                   \
-                                                                       \
-  {                                                                    \
-    _type real, imag;                                                  \
-                                                                       \
-    memcpy (&real, &c_bv[c_index], sizeof (_type));                    \
-    memcpy (&imag, &c_bv[c_index + sizeof (_type)], sizeof (_type));   \
-                                                                       \
-    result = scm_c_make_rectangular (real, imag);                      \
-  }                                                                    \
-                                                                       \
-  return result;
-
-static SCM
-bytevector_ref_c32 (SCM bv, SCM index)
-#define FUNC_NAME "bytevector_ref_c32"
-{
-  COMPLEX_NATIVE_REF (float);
-}
-#undef FUNC_NAME
-
-static SCM
-bytevector_ref_c64 (SCM bv, SCM index)
-#define FUNC_NAME "bytevector_ref_c64"
-{
-  COMPLEX_NATIVE_REF (double);
-}
-#undef FUNC_NAME
-
-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 bv, size_t index)
-{
-  SCM byte_index;
-  scm_t_bytevector_ref_fn ref_fn;
-
-  assert (SCM_BYTEVECTOR_P (bv));
-
-  ref_fn = bytevector_ref_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)];
-  byte_index =
-    scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bv));
-  return ref_fn (bv, byte_index);
-}
-
-/* Template for native modification of complex numbers of type TYPE.  */
-#define COMPLEX_NATIVE_SET(_type)                                      \
-  COMPLEX_ACCESSOR_PROLOGUE (_type);                                   \
-                                                                       \
-  {                                                                    \
-    _type real, imag;                                                  \
-    real = scm_c_real_part (value);                                    \
-    imag = scm_c_imag_part (value);                                    \
-                                                                       \
-    memcpy (&c_bv[c_index], &real, sizeof (_type));                    \
-    memcpy (&c_bv[c_index + sizeof (_type)], &imag, sizeof (_type));   \
-  }                                                                    \
-                                                                       \
-  return SCM_UNSPECIFIED;
-
-static SCM
-bytevector_set_c32 (SCM bv, SCM index, SCM value)
-#define FUNC_NAME "bytevector_set_c32"
-{
-  COMPLEX_NATIVE_SET (float);
-}
-#undef FUNC_NAME
-
-static SCM
-bytevector_set_c64 (SCM bv, SCM index, SCM value)
-#define FUNC_NAME "bytevector_set_c64"
-{
-  COMPLEX_NATIVE_SET (double);
-}
-#undef FUNC_NAME
-
-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 bytevector, size_t index, SCM val)
-{
-  SCM byte_index;
-  scm_t_bytevector_set_fn set_fn;
-
-  set_fn = bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bytevector)];
-  byte_index =
-    scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bytevector));
-  set_fn (bytevector, byte_index, val);
-}
-
-static void
-bytevector_get_handle (SCM v, scm_t_array_handle *h)
-{
-  h->base = 0;
-  h->root = 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);
-}
-
-
-int
-scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  size_t len, i;
-
-  scm_putc_unlocked ('#', port);
-  scm_write (scm_i_array_element_types[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)], 
port);
-  scm_putc_unlocked ('(', port);
-  for (i = 0, len = SCM_BYTEVECTOR_TYPED_LENGTH (bv); i < len; ++i)
-    {
-      if (i > 0)
-       scm_putc_unlocked (' ', port);
-      scm_write (bv_handle_ref (bv, i), port);
-    }
-  scm_putc_unlocked (')', port);
-  return 1;
-}
-
-
 /* Initialization.  */
 
 void
@@ -2255,19 +2102,9 @@ scm_bootstrap_bytevectors (void)
                            (scm_t_extension_init_func) scm_init_bytevectors,
                            NULL);
 
-  {
-    scm_t_array_implementation impl;
-
-    impl.tag = scm_tc7_bytevector;
-    impl.mask = 0x7f;
-    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);
-  }
+  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 f930589..a5eeaea 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -112,13 +112,6 @@ SCM_API SCM scm_utf8_to_string (SCM);
 SCM_API SCM scm_utf16_to_string (SCM, SCM);
 SCM_API SCM scm_utf32_to_string (SCM, SCM);
 
-typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
-SCM_INTERNAL const scm_t_bytevector_ref_fn
-bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
-
-typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
-SCM_INTERNAL const scm_t_bytevector_set_fn
-bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
 
 
 /* Internal API.  */
@@ -135,8 +128,6 @@ bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
   (SCM_BYTEVECTOR_FLAGS (_bv) & 0xffUL)
 #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv)       \
   (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL)
-#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
-  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index ac55728..9a001eb 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010, 2013, 2014 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
@@ -42,7 +42,20 @@ SCM_INTERNAL SCM scm_i_array_set_x (SCM v, SCM obj,
 int
 scm_is_array (SCM obj)
 {
-  return SCM_I_ARRAYP (obj) || scm_i_array_implementation_for_obj (obj);
+  if (!SCM_HEAP_OBJECT_P (obj))
+    return 0;
+
+  switch (SCM_TYP7 (obj))
+    {
+    case scm_tc7_string:
+    case scm_tc7_vector:
+    case scm_tc7_bitvector:
+    case scm_tc7_bytevector:
+    case scm_tc7_array:
+      return 1;
+    default:
+      return 0;
+    }
 }
 
 SCM_DEFINE (scm_array_p_2, "array?", 1, 0, 0,
@@ -68,18 +81,17 @@ scm_array_p (SCM obj, SCM unused)
 int
 scm_is_typed_array (SCM obj, SCM type)
 {
-  scm_t_array_implementation *impl;
-  if (SCM_I_ARRAYP (obj))
-    obj = SCM_I_ARRAY_V (obj);
-  impl = scm_i_array_implementation_for_obj (obj);
-  if (impl)
+  int ret = 0;
+  if (scm_is_array (obj))
     {
       scm_t_array_handle h;
-      impl->get_handle (obj, &h);
-      return scm_is_eq (scm_array_handle_element_type (&h), type);
+
+      scm_array_get_handle (obj, &h);
+      ret = scm_is_eq (scm_array_handle_element_type (&h), type);
+      scm_array_handle_release (&h);
     }
-  else
-    return 0;
+
+  return ret;
 }
 
 SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
@@ -95,15 +107,16 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
 size_t
 scm_c_array_rank (SCM array)
 {
-  if (SCM_I_ARRAYP (array))
-    return SCM_I_ARRAY_NDIM (array);
-  else if (scm_i_array_implementation_for_obj (array))
-    return 1;
-  else
-    scm_wrong_type_arg_msg (NULL, 0, array, "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_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
@@ -189,6 +202,24 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_array_type_code,
+            "array-type-code", 1, 0, 0,
+           (SCM array),
+           "Return the type of the elements in @var{array},\n"
+            "as an integer code.")
+#define FUNC_NAME s_scm_array_type_code
+{
+  scm_t_array_handle h;
+  scm_t_array_element_type element_type;
+
+  scm_array_get_handle (array, &h);
+  element_type = h.element_type;
+  scm_array_handle_release (&h);
+
+  return scm_from_uint16 (element_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"
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index d9fcea6..dfdb8bd 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -3,7 +3,7 @@
 #ifndef SCM_GENERALIZED_ARRAYS_H
 #define SCM_GENERALIZED_ARRAYS_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013, 
2014 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
@@ -49,6 +49,7 @@ SCM_API SCM scm_array_length (SCM ra);
 
 SCM_API SCM scm_array_dimensions (SCM ra);
 SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_type_code (SCM ra);
 SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
 
 SCM_API SCM scm_c_array_ref_1 (SCM v, ssize_t idx0);
diff --git a/libguile/socket.c b/libguile/socket.c
index 8c1326a..0516e52 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- *   2006, 2007, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2006, 2007, 2009, 2011, 2012, 2013, 2014 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
@@ -92,50 +92,6 @@ typedef union
 
 
 
-SCM_DEFINE (scm_htons, "htons", 1, 0, 0, 
-            (SCM value),
-           "Convert a 16 bit quantity from host to network byte ordering.\n"
-           "@var{value} is packed into 2 bytes, which are then converted\n"
-           "and returned as a new integer.")
-#define FUNC_NAME s_scm_htons
-{
-  return scm_from_ushort (htons (scm_to_ushort (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0, 
-            (SCM value),
-           "Convert a 16 bit quantity from network to host byte ordering.\n"
-           "@var{value} is packed into 2 bytes, which are then converted\n"
-           "and returned as a new integer.")
-#define FUNC_NAME s_scm_ntohs
-{
-  return scm_from_ushort (ntohs (scm_to_ushort (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0, 
-            (SCM value),
-           "Convert a 32 bit quantity from host to network byte ordering.\n"
-           "@var{value} is packed into 4 bytes, which are then converted\n"
-           "and returned as a new integer.")
-#define FUNC_NAME s_scm_htonl
-{
-  return scm_from_ulong (htonl (scm_to_uint32 (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0, 
-            (SCM value),
-           "Convert a 32 bit quantity from network to host byte ordering.\n"
-           "@var{value} is packed into 4 bytes, which are then converted\n"
-           "and returned as a new integer.")
-#define FUNC_NAME s_scm_ntohl
-{
-  return scm_from_ulong (ntohl (scm_to_uint32 (value)));
-}
-#undef FUNC_NAME
-
 #ifdef HAVE_INET_NETOF
 SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0, 
             (SCM address),
diff --git a/libguile/socket.h b/libguile/socket.h
index fcddd78..a211867 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -3,7 +3,7 @@
 #ifndef SCM_SOCKET_H
 #define SCM_SOCKET_H
 
-/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008, 2014 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,10 +27,6 @@
 
 
 
-SCM_API SCM scm_htons (SCM in);
-SCM_API SCM scm_ntohs (SCM in);
-SCM_API SCM scm_htonl (SCM in);
-SCM_API SCM scm_ntohl (SCM in);
 SCM_API SCM scm_inet_aton (SCM address);
 SCM_API SCM scm_inet_ntoa (SCM inetid);
 SCM_API SCM scm_inet_netof (SCM address);
diff --git a/libguile/sort.c b/libguile/sort.c
index 0dd8c8c..9373fb8 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2008, 2009,
- *   2010, 2011, 2012 Free Software Foundation, Inc.
+ *   2010, 2011, 2012, 2014 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
@@ -144,19 +144,25 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
       size_t i, len;
       ssize_t inc;
       const SCM *elts;
+      SCM result = SCM_BOOL_T;
 
       elts = scm_vector_elements (items, &handle, &len, &inc);
+
       for (i = 1; i < len; i++, elts += inc)
        {
          if (scm_is_true (scm_call_2 (less, elts[inc], elts[0])))
            {
-              scm_array_handle_release (&handle);
-             return SCM_BOOL_F;
+             result = SCM_BOOL_F;
+             break;
            }
        }
+
       scm_array_handle_release (&handle);
-      return SCM_BOOL_T;
+
+      return result;
     }
+
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -371,7 +377,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
       SCM_VALIDATE_LIST_COPYLEN (1, items, len);
       return scm_merge_list_step (&items, less, len);
     }
-  else if (scm_is_array (items))
+  else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
     {
       scm_restricted_vector_sort_x (items,
                                    less,
@@ -397,7 +403,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
 
   if (scm_is_pair (items))
     return scm_sort_x (scm_list_copy (items), less);
-  else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
+  else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
     return scm_sort_x (scm_vector_copy (items), less);
   else
     SCM_WRONG_TYPE_ARG (1, items);
@@ -483,20 +489,20 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
       SCM_VALIDATE_LIST_COPYLEN (1, items, len);
       return scm_merge_list_step (&items, less, len);
     }
-  else
+  else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
     {
       scm_t_array_handle temp_handle, vec_handle;
       SCM temp, *temp_elts, *vec_elts;
       size_t len;
       ssize_t inc;
-
+      
       vec_elts = scm_vector_writable_elements (items, &vec_handle,
                                               &len, &inc);
       if (len == 0) {
         scm_array_handle_release (&vec_handle);
         return items;
       }
-
+      
       temp = scm_c_make_vector (len, SCM_UNDEFINED);
       temp_elts = scm_vector_writable_elements (temp, &temp_handle,
                                                NULL, NULL);
@@ -508,11 +514,13 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
 
       return items;
     }
+  else
+    SCM_WRONG_TYPE_ARG (1, items);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
+SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, 
             (SCM items, SCM less),
            "Sort the sequence @var{items}, which may be a list or a\n"
            "vector. @var{less} is used for comparing the sequence elements.\n"
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 21574c7..d8a264c 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -1,6 +1,6 @@
 /* srfi-4.c --- Uniform numeric vector datatypes.
  *
- *     Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011 Free Software 
Foundation, Inc.
+ *     Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011, 2014 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
@@ -118,13 +118,13 @@
   const ctype* scm_array_handle_##tag##_elements (scm_t_array_handle *h) \
   {                                                                     \
     if (h->element_type != ETYPE (TAG))                                 \
-      scm_wrong_type_arg_msg (NULL, 0, h->root, #tag "vector");         \
+      scm_wrong_type_arg_msg (NULL, 0, h->array, #tag "vector");        \
     return ((const ctype*) h->elements) + h->base*width;                \
   }                                                                     \
   ctype* scm_array_handle_##tag##_writable_elements (scm_t_array_handle *h) \
   {                                                                     \
     if (h->element_type != ETYPE (TAG))                                 \
-      scm_wrong_type_arg_msg (NULL, 0, h->root, #tag "vector");         \
+      scm_wrong_type_arg_msg (NULL, 0, h->array, #tag "vector");        \
     return ((ctype*) h->writable_elements) + h->base*width;             \
   }                                                                     \
   const ctype *scm_##tag##vector_elements (SCM uvec,                    \
@@ -137,12 +137,15 @@
                                               scm_t_array_handle *h,    \
                                               size_t *lenp, ssize_t *incp) \
   {                                                                     \
-    scm_uniform_vector_elements (uvec, h, lenp, incp);                  \
-    if (h->element_type == ETYPE (TAG))                                 \
-      return ((ctype*)h->writable_elements) + h->base*width;            \
-    /* otherwise... */                                                  \
-    else                                                                \
-      scm_wrong_type_arg_msg (NULL, 0, h->root, #tag "vector");         \
+    if (!scm_is_bytevector (uvec)                                       \
+        || (scm_c_bytevector_length (uvec) % width))                    \
+      scm_wrong_type_arg_msg (NULL, 0, uvec, #tag "vector");            \
+    scm_array_get_handle (uvec, h);                                     \
+    if (lenp)                                                           \
+      *lenp = scm_c_bytevector_length (uvec) / width;                   \
+    if (incp)                                                           \
+      *incp = 1;                                                        \
+    return ((ctype *)h->writable_elements);                             \
   }
 
 
@@ -211,13 +214,15 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 
2, 1, 0,
             "Make a srfi-4 vector")
 #define FUNC_NAME s_scm_make_srfi_4_vector
 {
-  int i;
-  for (i = 0; i <= SCM_ARRAY_ELEMENT_TYPE_LAST; i++)
-    if (scm_is_eq (type, scm_i_array_element_types[i]))
+  int c_type;
+  size_t c_len;
+
+  for (c_type = 0; c_type <= SCM_ARRAY_ELEMENT_TYPE_LAST; c_type++)
+    if (scm_is_eq (type, scm_i_array_element_types[c_type]))
       break;
-  if (i > SCM_ARRAY_ELEMENT_TYPE_LAST)
+  if (c_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
     scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "vector type");
-  switch (i)
+  switch (c_type)
     {
     case SCM_ARRAY_ELEMENT_TYPE_U8:
     case SCM_ARRAY_ELEMENT_TYPE_S8:
@@ -232,8 +237,10 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 
2, 1, 0,
     case SCM_ARRAY_ELEMENT_TYPE_C32:
     case SCM_ARRAY_ELEMENT_TYPE_C64:
       {
-        size_t clen = scm_to_size_t (len);
-        SCM ret = scm_i_make_typed_bytevector (clen, i);
+        SCM ret;
+
+        c_len = scm_to_size_t (len);
+        ret = scm_i_make_typed_bytevector (c_len, c_type);
 
         if (SCM_UNBNDP (fill) || scm_is_eq (len, SCM_INUM0))
           ; /* pass */
@@ -242,12 +249,13 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector", 
2, 1, 0,
                   SCM_BYTEVECTOR_LENGTH (ret));
         else
           {
-            scm_t_bytevector_set_fn set_fn =
-              bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (ret)];
-            size_t step = SCM_BYTEVECTOR_TYPE_SIZE (ret);
-            size_t pos = 0;
-            for (pos = 0, clen *= step; pos < clen; pos += step)
-              set_fn(ret, scm_from_size_t (pos), fill);
+            scm_t_array_handle h;
+            size_t i;
+
+            scm_array_get_handle (ret, &h);
+            for (i = 0; i < c_len; i++)
+              scm_array_handle_set (&h, i, fill);
+            scm_array_handle_release (&h);
           }
         return ret;
       }
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index 0e5afc3..f56c3f3 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, 2009, 2010, 2011 Free Software 
Foundation, Inc.
+ *     Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010, 2011, 2014 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
@@ -274,11 +274,6 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec,
                                                 size_t *lenp,
                                                 ssize_t *incp);
 
-SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec);
-SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec);
-SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec);
-SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec);
-
 SCM_INTERNAL void scm_init_srfi_4 (void);
 
 #endif /* SCM_SRFI_4_H */
diff --git a/libguile/strings.c b/libguile/strings.c
index 0b83311..90dc83a 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 
2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 
2012, 2013, 2014 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
@@ -2464,37 +2464,7 @@ scm_i_get_substring_spec (size_t len,
   else
     *cend = scm_to_unsigned_integer (end, *cstart, len);
 }
-
-/* FIXME: We know that string is such, so can skip checks */
-static SCM
-string_handle_ref (SCM string, size_t index)
-{
-  return scm_c_string_ref (string, index);
-}
-
-static void
-string_handle_set (SCM string, size_t index, SCM val)
-{
-  scm_c_string_set_x (string, index, val);
-}
-
-static void
-string_get_handle (SCM v, scm_t_array_handle *h)
-{
-  h->base = 0;
-  h->root = 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,
-                          string_handle_ref, string_handle_set,
-                          string_get_handle)
+                 
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)
 
 void
diff --git a/libguile/tags.h b/libguile/tags.h
index 4a1b192..53d40d8 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -3,7 +3,7 @@
 #ifndef SCM_TAGS_H
 #define SCM_TAGS_H
 
-/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
+/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -335,14 +335,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
  *   111:  the cell belongs to some other heap object.
  *
  * tc7 (for tc3==1x1):
- *   See below for the list of types.  Note the special case of scm_tc7_vector
- *   and scm_tc7_wvect:  vectors and weak vectors are treated the same in many
- *   cases.  Thus, their tc7-codes are chosen to only differ in one bit.  This
- *   makes it possible to check an object at the same time for being a vector
- *   or a weak vector by comparing its tc7 code with that bit masked (using
- *   the TYP7S macro).  Three more special tc7-codes are of interest:
- *   numbers, ports and smobs in fact each represent collections of types,
- *   which are subdivided using tc16-codes.
+ *   See below for the list of types.  Three special tc7-codes are of
+ *   interest: numbers, ports and smobs in fact each represent
+ *   collections of types, which are subdivided using tc16-codes.
  *
  * tc16 (for tc7==scm_tc7_smob):
  *   The largest part of the space of smob types is not subdivided in a
@@ -396,11 +391,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 
 #define SCM_ITAG7(x)           (127 & SCM_UNPACK (x))
 #define SCM_TYP7(x)            (0x7f &        SCM_CELL_TYPE (x))
-#define SCM_TYP7S(x)           ((0x7f & ~2) & SCM_CELL_TYPE (x))
 #define SCM_HAS_HEAP_TYPE(x, type, tag)                         \
   (SCM_NIMP (x) && type (x) == (tag))
 #define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
-#define SCM_HAS_TYP7S(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP7S, tag))
 
 /* If you change these numbers, change them also in (system vm
    assembler).  */
diff --git a/libguile/uniform.c b/libguile/uniform.c
index b3c782d..f7ca7bc 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -49,9 +49,9 @@ scm_array_handle_uniform_element_size (scm_t_array_handle *h)
   if (ret && ret % 8 == 0)
     return ret / 8;
   else if (ret)
-    scm_wrong_type_arg_msg (NULL, 0, h->root, "byte-aligned uniform array");
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "byte-aligned uniform array");
   else
-    scm_wrong_type_arg_msg (NULL, 0, h->root, "uniform array");
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
 }
 
 size_t
@@ -61,7 +61,7 @@ scm_array_handle_uniform_element_bit_size (scm_t_array_handle 
*h)
   if (ret)
     return ret;
   else
-    scm_wrong_type_arg_msg (NULL, 0, h->root, "uniform array");
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
 }
 
 const void *
@@ -81,177 +81,6 @@ scm_array_handle_uniform_writable_elements 
(scm_t_array_handle *h)
   return ret;
 }
 
-int
-scm_is_uniform_vector (SCM obj)
-{
-  scm_t_array_handle h;
-  int ret = 0;
-
-  if (scm_is_array (obj) && !SCM_I_ARRAYP (obj))
-    {
-      scm_array_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)
-{
-  if (!scm_is_uniform_vector (uvec))
-    scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
-                            "uniform vector");
-  return scm_c_array_length (uvec);
-}
-
-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 type of the elements in the uniform vector, @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_element_type
-{
-  scm_t_array_handle h;
-  SCM ret;
-  
-  if (!scm_is_uniform_vector (v))
-    scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
-  scm_array_get_handle (v, &h);
-  ret = scm_array_handle_element_type (&h);
-  scm_array_handle_release (&h);
-  return ret;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_type_code,
-            "uniform-vector-element-type-code", 1, 0, 0,
-           (SCM v),
-           "Return the type of the elements in the uniform vector, @var{v},\n"
-            "as an integer code.")
-#define FUNC_NAME s_scm_uniform_vector_element_type_code
-{
-  scm_t_array_handle h;
-  SCM ret;
-
-  if (!scm_is_uniform_vector (v))
-    scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
-  scm_array_get_handle (v, &h);
-  ret = scm_from_uint16 (h.element_type);
-  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 pos)
-{
-  if (!scm_is_uniform_vector (v))
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
-  return scm_c_array_ref_1 (v, pos);
-}
-
-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"
-           "homogeneous 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 pos, SCM val)
-{
-  if (!scm_is_uniform_vector (v))
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
-  scm_c_array_set_1_x (v, val, pos);
-}
-
-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"
-           "homogeneous 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
-{
-  if (!scm_is_uniform_vector (uvec))
-    scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector");
-  return scm_array_to_list (uvec);
-}
-#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_array_get_handle (uvec, h);
-  if (scm_array_handle_rank (h) != 1)
-    scm_wrong_type_arg_msg (0, SCM_ARG1, uvec, "uniform vector");
-  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)
 {
diff --git a/libguile/uniform.h b/libguile/uniform.h
index 57e214b..ad8428f 100644
--- a/libguile/uniform.h
+++ b/libguile/uniform.h
@@ -3,7 +3,8 @@
 #ifndef SCM_UNIFORM_H
 #define SCM_UNIFORM_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
+ * 2013, 2014 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
@@ -43,33 +44,9 @@ SCM_API size_t scm_array_handle_uniform_element_bit_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_type_code (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 */
 
 /*
diff --git a/libguile/validate.h b/libguile/validate.h
index 7af698f..6d57b9e 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -4,7 +4,7 @@
 #define SCM_VALIDATE_H
 
 /* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2009,
- *   2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2011, 2012, 2013, 2014 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
@@ -363,8 +363,7 @@
 
 #define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
   do { \
-    SCM_ASSERT ((scm_is_vector (v) \
-                || (scm_is_true (scm_f64vector_p (v)))), \
+    SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
                 v, pos, FUNC_NAME); \
   } while (0)
 
diff --git a/libguile/vectors.c b/libguile/vectors.c
index d367ca0..5dab545 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -38,7 +38,7 @@
 
 #include "libguile/bdw-gc.h"
 
-#include <assert.h>
+
 
 
 #define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
@@ -55,6 +55,23 @@ scm_is_simple_vector (SCM obj)
   return SCM_I_IS_VECTOR (obj);
 }
 
+const SCM *
+scm_vector_elements (SCM vec, scm_t_array_handle *h,
+                    size_t *lenp, ssize_t *incp)
+{
+  if (SCM_I_WVECTP (vec))
+    scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
+
+  scm_generalized_vector_get_handle (vec, 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_elements (h);
+}
+
 SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
                              size_t *lenp, ssize_t *incp)
@@ -62,9 +79,7 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
   if (SCM_I_WVECTP (vec))
     scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
 
-  if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec))
-    scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array");
-  scm_array_get_handle (vec, h);
+  scm_generalized_vector_get_handle (vec, h);
   if (lenp)
     {
       scm_t_array_dim *dim = scm_array_handle_dims (h);
@@ -74,14 +89,7 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
   return scm_array_handle_writable_elements (h);
 }
 
-const SCM *
-scm_vector_elements (SCM vec, scm_t_array_handle *h,
-                    size_t *lenp, ssize_t *incp)
-{
-  return scm_vector_writable_elements (vec, h, lenp, incp);
-}
-
-SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
+SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, 
            (SCM obj),
            "Return @code{#t} if @var{obj} is a vector, otherwise return\n"
            "@code{#f}.")
@@ -91,26 +99,22 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-size_t
-scm_c_vector_length (SCM v)
+SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0, 
+           (SCM v),
+            "Returns the number of elements in @var{vector} as an exact 
integer.")
+#define FUNC_NAME s_scm_vector_length
 {
-  if (SCM_I_IS_NONWEAK_VECTOR (v))
-    return SCM_I_VECTOR_LENGTH (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
+  return scm_from_size_t (scm_c_vector_length (v));
 }
+#undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0,
-           (SCM v),
-            "Return the number of elements in vector @var{v} as an exact\n"
-            "integer.\n"
-           "\n"
-           "@lisp\n"
-           "(vector-length #(a b c)) @result{} 3\n"
-           "@end lisp")
+size_t
+scm_c_vector_length (SCM v)
 #define FUNC_NAME s_scm_vector_length
 {
-  return scm_from_size_t (scm_c_vector_length (v));
+  SCM_VALIDATE_VECTOR (1, v);
+
+  return SCM_I_VECTOR_LENGTH (v);
 }
 #undef FUNC_NAME
 
@@ -157,23 +161,10 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
 }
 #undef FUNC_NAME
 
-SCM
-scm_c_vector_ref (SCM v, size_t k)
-{
-  if (SCM_I_IS_NONWEAK_VECTOR (v))
-    {
-      if (k >= SCM_I_VECTOR_LENGTH (v))
-       scm_out_of_range (NULL, scm_from_size_t (k));
-      return SCM_SIMPLE_VECTOR_REF (v, k);
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
-}
-
-SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0,
-           (SCM v, SCM k),
+SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0, 
+           (SCM vector, SCM k),
             "@var{k} must be a valid index of @var{vector}.\n"
-            "@samp{vector-ref} returns the contents of element @var{k} of\n"
+            "@samp{Vector-ref} returns the contents of element @var{k} of\n"
             "@var{vector}.\n\n"
             "@lisp\n"
             "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
@@ -185,25 +176,25 @@ SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0,
             "@end lisp")
 #define FUNC_NAME s_scm_vector_ref
 {
-  return scm_c_vector_ref (v, scm_to_size_t (k));
+  return scm_c_vector_ref (vector, scm_to_size_t (k));
 }
 #undef FUNC_NAME
 
-void
-scm_c_vector_set_x (SCM v, size_t k, SCM obj)
+SCM
+scm_c_vector_ref (SCM v, size_t k)
+#define FUNC_NAME s_scm_vector_ref
 {
-  if (SCM_I_IS_NONWEAK_VECTOR (v))
-    {
-      if (k >= SCM_I_VECTOR_LENGTH (v))
-        scm_out_of_range (NULL, scm_from_size_t (k));
-      SCM_SIMPLE_VECTOR_SET (v, k, obj);
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
+  SCM_VALIDATE_VECTOR (1, v);
+
+  if (k >= SCM_I_VECTOR_LENGTH (v))
+    scm_out_of_range (NULL, scm_from_size_t (k));
+
+  return SCM_SIMPLE_VECTOR_REF (v, k);
 }
+#undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0,
-            (SCM v, SCM k, SCM obj),
+SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0, 
+           (SCM vector, SCM k, SCM obj),
             "@var{k} must be a valid index of @var{vector}.\n"
             "@code{Vector-set!} stores @var{obj} in element @var{k} of 
@var{vector}.\n"
             "The value returned by @samp{vector-set!} is unspecified.\n"
@@ -215,11 +206,24 @@ SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0,
             "@end lisp")
 #define FUNC_NAME s_scm_vector_set_x
 {
-  scm_c_vector_set_x (v, scm_to_size_t (k), obj);
+  scm_c_vector_set_x (vector, scm_to_size_t (k), obj);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+void
+scm_c_vector_set_x (SCM v, size_t k, SCM obj)
+#define FUNC_NAME s_scm_vector_set_x
+{
+  SCM_VALIDATE_VECTOR (1, v);
+
+  if (k >= SCM_I_VECTOR_LENGTH (v))
+    scm_out_of_range (NULL, scm_from_size_t (k)); 
+
+  SCM_SIMPLE_VECTOR_SET (v, k, obj);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
             (SCM k, SCM fill),
            "Return a newly allocated vector of @var{k} elements.  If a\n"
@@ -428,39 +432,6 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 
5, 0, 0,
 #undef FUNC_NAME
 
 
-static SCM
-vector_handle_ref (SCM vector, size_t idx)
-{
-  assert (idx < SCM_I_VECTOR_LENGTH (vector));
-  return SCM_I_VECTOR_WELTS(vector)[idx];
-}
-
-static void
-vector_handle_set (SCM vector, size_t idx, SCM val)
-{
-  assert (idx < SCM_I_VECTOR_LENGTH (vector));
-  SCM_I_VECTOR_WELTS(vector)[idx] = val;
-}
-
-static void
-vector_get_handle (SCM v, scm_t_array_handle *h)
-{
-  h->base = 0;
-  h->root = 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);
-}
-
-/* the & ~2 allows catching scm_tc7_wvect as well. needs changing if you change
-   tags.h. */
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
-                          vector_handle_ref, vector_handle_set,
-                          vector_get_handle)
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector)
 
 
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 4fe72b0..995f64f 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VECTORS_H
 #define SCM_VECTORS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 
2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 
2011, 2014 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
@@ -63,8 +63,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 
 /* Internals */
 
-#define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7S (x, scm_tc7_vector))
-#define SCM_I_IS_NONWEAK_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
+#define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7 (x, scm_tc7_vector))
 #define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
 #define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, 1))
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b5cd095..e95aad5 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2574,13 +2574,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
   VM_DEFINE_OP (95, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (vect);
-      if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
-        RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
-      else
-        {
-          SYNC_IP ();
-          RETURN (scm_vector_length (vect));
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
     }
 
   /* vector-ref dst:8 src:8 idx:8
@@ -2592,16 +2588,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
     {
       scm_t_signed_bits i = 0;
       ARGS2 (vect, idx);
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && SCM_I_INUMP (idx)
-                      && ((i = SCM_I_INUM (idx)) >= 0)
-                      && i < SCM_I_VECTOR_LENGTH (vect)))
-        RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
-      else
-        {
-          SYNC_IP ();
-          RETURN (scm_vector_ref (vect, idx));
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT ((SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)),
+                 vm_error_out_of_range ("vector-ref", idx));
+      RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
     }
 
   /* vector-ref/immediate dst:8 src:8 idx:8
@@ -2616,11 +2609,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       
       UNPACK_8_8_8 (op, dst, src, idx);
       v = LOCAL_REF (src);
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
-                      && idx < SCM_I_VECTOR_LENGTH (v)))
-        LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
-      else
-        LOCAL_SET (dst, scm_c_vector_ref (v, idx));
+      VM_ASSERT (SCM_I_IS_VECTOR (v),
+                 vm_error_not_a_vector ("vector-ref", v));
+      VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
+                 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+      LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
       NEXT (1);
     }
 
@@ -2639,16 +2632,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       idx = LOCAL_REF (idx_var);
       val = LOCAL_REF (src);
 
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && SCM_I_INUMP (idx)
-                      && ((i = SCM_I_INUM (idx)) >= 0)
-                      && i < SCM_I_VECTOR_LENGTH (vect)))
-        SCM_I_VECTOR_WELTS (vect)[i] = val;
-      else
-        {
-          SYNC_IP ();
-          scm_vector_set_x (vect, idx, val);
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT ((SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)),
+                 vm_error_out_of_range ("vector-ref", idx));
+      SCM_I_VECTOR_WELTS (vect)[i] = val;
       NEXT (1);
     }
 
@@ -2666,14 +2656,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       vect = LOCAL_REF (dst);
       val = LOCAL_REF (src);
 
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && idx < SCM_I_VECTOR_LENGTH (vect)))
-        SCM_I_VECTOR_WELTS (vect)[idx] = val;
-      else
-        {
-          SYNC_IP ();
-          scm_vector_set_x (vect, scm_from_uint8 (idx), val);
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
+                 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+      SCM_I_VECTOR_WELTS (vect)[idx] = val;
       NEXT (1);
     }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index b0918b6..4c67d50 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -423,6 +423,8 @@ static void vm_error_improper_list (SCM x) SCM_NORETURN 
SCM_NOINLINE;
 static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
 static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
 static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_out_of_range (const char *subr, SCM k) SCM_NORETURN 
SCM_NOINLINE;
 static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_wrong_number_of_values (scm_t_uint32 expected) 
SCM_NORETURN SCM_NOINLINE;
@@ -548,6 +550,19 @@ vm_error_not_a_struct (const char *subr, SCM x)
 }
 
 static void
+vm_error_not_a_vector (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "vector");
+}
+
+static void
+vm_error_out_of_range (const char *subr, SCM k)
+{
+  scm_to_size_t (k);
+  scm_out_of_range (subr, k);
+}
+
+static void
 vm_error_no_values (void)
 {
   vm_error ("Zero values returned to single-valued continuation",
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index e911069..4e3ed33 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2011, 2012, 2013, 2014 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
@@ -1079,7 +1079,7 @@ SCM_DEFINE (scm_make_weak_value_hash_table, 
"make-weak-value-hash-table", 0, 1,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 
0, 0, 
+SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 0, 
1, 0, 
             (SCM n),
            "Return a hash table with weak keys and values with @var{size}\n"
            "buckets.  (@pxref{Hash Tables})")
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
index b1fff1b..082cdde 100644
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -189,7 +189,7 @@ scm_c_weak_vector_ref (SCM wv, size_t k)
   d.k = k;
   
   if (k >= SCM_I_VECTOR_LENGTH (wv))
-    scm_out_of_range (NULL, scm_from_size_t (k)); 
+    scm_out_of_range ("weak-vector-ref", scm_from_size_t (k)); 
 
   ret = GC_call_with_alloc_lock (weak_vector_ref, &d);
   
@@ -227,7 +227,7 @@ scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
   d.k = k;
 
   if (k >= SCM_I_VECTOR_LENGTH (wv))
-    scm_out_of_range (NULL, scm_from_size_t (k)); 
+    scm_out_of_range ("weak-vector-set!", scm_from_size_t (k)); 
   
   prev = GC_call_with_alloc_lock (weak_vector_ref, &d);
 
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 1573c6f..007061f 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,7 +1,7 @@
 ;;;; -*- coding: utf-8; mode: scheme -*-
 ;;;;
 ;;;;   Copyright (C) 2001, 2004, 2006, 2009, 2010,
-;;;;      2012, 2013 Free Software Foundation, Inc.
+;;;;      2012, 2013, 2014 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
@@ -20,6 +20,7 @@
 (define-module (ice-9 pretty-print)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (rnrs bytevectors)
   #:export (pretty-print
             truncated-print))
 
@@ -418,12 +419,12 @@ sub-expression, via the @var{breadth-first?} keyword 
argument."
           (display ")"))
          (else
           (display "#"))))
-       ((uniform-vector? x)
+       ((bytevector? x)
         (cond
          ((>= width 9)
-          (format #t  "#~a(" (uniform-vector-element-type x))
-          (print-sequence x (- width 6) (uniform-vector-length x)
-                          uniform-vector-ref identity)
+          (format #t  "#~a(" (array-type x))
+          (print-sequence x (- width 6) (array-length x)
+                          array-ref identity)
           (display ")"))
          (else
           (display "#"))))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index a64e03b..0376d9e 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -134,11 +134,16 @@
 
 (define *goops-module* (current-module))
 
+;; XXX FIXME: figure out why the 'eval-when's in this file must use
+;; 'compile' and must avoid 'expand', but only in 2.2, and only when
+;; compiling something that imports goops, e.g. (ice-9 occam-channel),
+;; before (oop goops) itself has been compiled.
+
 ;; First initialize the builtin part of GOOPS
-(eval-when (expand load eval)
+(eval-when (compile load eval)
   (%init-goops-builtins))
 
-(eval-when (expand load eval)
+(eval-when (compile load eval)
   (use-modules ((language tree-il primitives) :select 
(add-interesting-primitive!)))
   (add-interesting-primitive! 'class-of))
 
@@ -149,7 +154,7 @@
 
 
 ;; FIXME: deprecate.
-(eval-when (expand load eval)
+(eval-when (compile load eval)
   (define min-fixnum (- (expt 2 29)))
   (define max-fixnum (- (expt 2 29) 1)))
 
diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index c6eb00b..b2e6f49 100644
--- a/module/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -1,7 +1,7 @@
 ;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes
 
 ;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010,
-;;   2012 Free Software Foundation, Inc.
+;;   2012, 2014 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
@@ -75,14 +75,11 @@
 (define-macro (define-bytevector-type tag infix size)
   `(begin
      (define (,(symbol-append tag 'vector?) obj)
-       (and (uniform-vector? obj)
-            (eq? (uniform-vector-element-type obj) ',tag)))
+       (and (bytevector? obj) (eq? (array-type obj) ',tag)))
      (define (,(symbol-append 'make- tag 'vector) len . fill)
        (apply make-srfi-4-vector ',tag len fill))
      (define (,(symbol-append tag 'vector-length) v)
-       (let ((len (* (uniform-vector-length v)
-                     (uniform-vector-element-size v)
-                     (/ ,size))))
+       (let ((len (/ (bytevector-length v) ,size)))
          (if (integer? len)
              len
              (error "fractional length" v ',tag ,size))))
@@ -119,21 +116,3 @@
 (define-bytevector-type s64 s64-native 8)
 (define-bytevector-type f32 ieee-single-native 4)
 (define-bytevector-type f64 ieee-double-native 8)
-
-(define (bytevector-c32-ref v i)
-  (make-rectangular (bytevector-ieee-single-native-ref v i)
-                    (bytevector-ieee-single-native-ref v (+ i 4))))
-(define (bytevector-c32-set! v i x)
-  (bytevector-ieee-single-native-set! v i x)
-  (bytevector-ieee-single-native-set! v (+ i 4) x))
-(define-bytevector-type c32 c32 8)
-
-(define (bytevector-c64-ref v i)
-  (make-rectangular (bytevector-ieee-double-native-ref v i)
-                    (bytevector-ieee-double-native-ref v (+ i 8))))
-(define (bytevector-c64-set! v i x)
-  (bytevector-ieee-double-native-set! v i x)
-  (bytevector-ieee-double-native-set! v (+ i 8) x))
-(define-bytevector-type c64 c64 16)
-
-
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
index 7f595d6..42bbf33 100644
--- a/module/srfi/srfi-4/gnu.scm
+++ b/module/srfi/srfi-4/gnu.scm
@@ -1,6 +1,6 @@
 ;;; Extensions to SRFI-4
 
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -42,44 +42,6 @@
 
 (define make-srfi-4-vector (@@ (srfi srfi-4) make-srfi-4-vector))
 
-;; Need quasisyntax to do this effectively using syntax-case
-(define-macro (define-bytevector-type tag infix size)
-  `(begin
-     (define (,(symbol-append tag 'vector?) obj)
-       (and (uniform-vector? obj)
-            (eq? (uniform-vector-element-type obj) ',tag)))
-     (define (,(symbol-append 'make- tag 'vector) len . fill)
-       (apply make-srfi-4-vector ',tag len fill))
-     (define (,(symbol-append tag 'vector-length) v)
-       (let ((len (* (uniform-vector-length v)
-                     (uniform-vector-element-size v)
-                     (/ ,size))))
-         (if (integer? len)
-             len
-             (error "fractional length" v ',tag ,size))))
-     (define (,(symbol-append tag 'vector) . elts)
-       (,(symbol-append 'list-> tag 'vector) elts))
-     (define (,(symbol-append 'list-> tag 'vector) elts)
-       (let* ((len (length elts))
-              (v (,(symbol-append 'make- tag 'vector) len)))
-         (let lp ((i 0) (elts elts))
-           (if (and (< i len) (pair? elts))
-               (begin
-                 (,(symbol-append tag 'vector-set!) v i (car elts))
-                 (lp (1+ i) (cdr elts)))
-               v))))
-     (define (,(symbol-append tag 'vector->list) v)
-       (let lp ((i (1- (,(symbol-append tag 'vector-length) v))) (elts '()))
-         (if (< i 0)
-             elts
-             (lp (1- i) (cons (,(symbol-append tag 'vector-ref) v i) elts)))))
-     (define (,(symbol-append tag 'vector-ref) v i)
-       (,(symbol-append 'bytevector- infix '-ref) v (* i ,size)))
-     (define (,(symbol-append tag 'vector-set!) v i x)
-       (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))
-     (define (,(symbol-append tag 'vector-set!) v i x)
-       (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))))
-
 (define (bytevector-c32-native-ref v i)
   (make-rectangular (bytevector-ieee-single-native-ref v i)
                     (bytevector-ieee-single-native-ref v (+ i 4))))
@@ -92,8 +54,9 @@
 (define (bytevector-c64-native-set! v i x)
   (bytevector-ieee-double-native-set! v i (real-part x))
   (bytevector-ieee-double-native-set! v (+ i 8) (imag-part x)))
-(define-bytevector-type c32 c32-native 8)
-(define-bytevector-type c64 c64-native 16)
+
+((@@ (srfi srfi-4) define-bytevector-type) c32 c32-native 8)
+((@@ (srfi srfi-4) define-bytevector-type) c64 c64-native 16)
 
 (define-macro (define-any->vector . tags)
   `(begin
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 5ddc642..597d878 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -604,14 +604,20 @@ table, its existing label is used directly."
         (static-set! 1 ,label 0)))
      ((uniform-vector-backing-store? obj) '())
      ((simple-uniform-vector? obj)
-      `((static-patch! ,label 2
-                       ,(recur (make-uniform-vector-backing-store
-                                (uniform-array->bytevector obj)
-                                (if (bitvector? obj)
-                                    ;; Bitvectors are addressed in
-                                    ;; 32-bit units.
-                                    4
-                                    (uniform-vector-element-size obj)))))))
+      (let ((width (case (array-type obj)
+                     ((vu8 u8 s8) 1)
+                     ((u16 s16) 2)
+                     ;; Bitvectors are addressed in 32-bit units.
+                     ;; Although a complex number is 8 or 16 bytes wide,
+                     ;; it should be byteswapped in 4 or 8 byte units.
+                     ((u32 s32 f32 c32 b) 4)
+                     ((u64 s64 f64 c64) 8)
+                     (else
+                      (error "unhandled array type" obj)))))
+        `((static-patch! ,label 2
+                         ,(recur (make-uniform-vector-backing-store
+                                  (uniform-array->bytevector obj)
+                                  width))))))
      (else
       (error "don't know how to intern" obj))))
   (cond
@@ -1041,7 +1047,7 @@ should be .data or .rodata), and return the resulting 
linker object.
        ((simple-uniform-vector? obj)
         (let ((tag (if (bitvector? obj)
                        tc7-bitvector
-                       (let ((type-code (uniform-vector-element-type-code 
obj)))
+                       (let ((type-code (array-type-code obj)))
                          (logior tc7-bytevector (ash type-code 7))))))
           (case word-size
             ((4)
diff --git a/test-suite/guile-test b/test-suite/guile-test
index cdcfe49..43ea481 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -5,7 +5,7 @@
 ;;;; guile-test --- run the Guile test suite
 ;;;; Jim Blandy <address@hidden> --- May 1999
 ;;;;
-;;;;   Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 2010, 2014 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -239,8 +239,9 @@
                  (lambda ()
                    (for-each (lambda (test)
                                (display (string-append "Running " test "\n"))
-                               (with-test-prefix test
-                                                 (load (test-file-name test))))
+                               (with-locale "C"
+                                 (with-test-prefix test
+                                   (load (test-file-name test)))))
                              tests))))
             (if (opt 'coverage #f)
                 (let-values (((coverage-data _)
@@ -262,4 +263,5 @@
 
 ;;; Local Variables:
 ;;; mode: scheme
+;;; eval: (put 'with-locale 'scheme-indent-function 1)
 ;;; End:
diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index 30a0257..211aaaf 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -1,7 +1,7 @@
 ;;;; 00-socket.test --- test socket functions     -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-;;;;   2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013, 2014 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
@@ -28,27 +28,6 @@
 
 
 ;;;
-;;; htonl
-;;;
-
-(if (defined? 'htonl)
-    (with-test-prefix "htonl"
-
-      (pass-if "0" (eqv? 0 (htonl 0)))
-
-      (pass-if-exception "-1" exception:out-of-range
-        (htonl -1))
-
-      ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't 
detect
-      ;; an overflow for values 2^32 <= x < 2^63
-      (pass-if-exception "2^32" exception:out-of-range
-        (htonl (ash 1 32)))
-
-      (pass-if-exception "2^1024" exception:out-of-range
-        (htonl (ash 1 1024)))))
-
-
-;;;
 ;;; inet-ntop
 ;;;
 
@@ -154,27 +133,6 @@
          (and (= (sockaddr:fam sa) AF_UNIX)
               (string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
 
-;;;
-;;; ntohl
-;;;
-
-(if (defined? 'ntohl)
-    (with-test-prefix "ntohl"
-
-      (pass-if "0" (eqv? 0 (ntohl 0)))
-
-      (pass-if-exception "-1" exception:out-of-range
-        (ntohl -1))
-
-      ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't 
detect
-      ;; an overflow for values 2^32 <= x < 2^63
-      (pass-if-exception "2^32" exception:out-of-range
-        (ntohl (ash 1 32)))
-
-      (pass-if-exception "2^1024" exception:out-of-range
-        (ntohl (ash 1 1024)))))
-
-
 
 ;;;
 ;;; AF_UNIX sockets and `make-socket-address'
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 57d23af..a715922 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -1,6 +1,6 @@
 ;;;; arrays.test --- tests guile's uniform arrays     -*- scheme -*-
 ;;;;
-;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software 
Foundation, Inc.
+;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -22,29 +22,16 @@
   #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-4 gnu))
 
+;;;
+;;; array?
+;;;
+
 (define exception:wrong-num-indices
   (cons 'misc-error "^wrong number of indices.*"))
 
 (define exception:length-non-negative
   (cons 'read-error ".*array length must be non-negative.*"))
 
-(define exception:mapping-out-of-range
-  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
-
-; see strings.test.
-(define exception:wrong-type-arg
-  (cons #t "Wrong type"))
-
-;;;
-;;; array?
-;;;
-
-(with-test-prefix "sanity"
-  ;; At the current time of writing, bignums have a tc7 that is one bit
-  ;; away from strings. It used to be that the vector implementation
-  ;; registered for strings had the TYP7S mask, not the TYP7 mask,
-  ;; making the system think that bignums were vectors. Doh!
-  (pass-if (not (uniform-vector? 12345678901234567890123456789))))
 
 (with-test-prefix "array?"
 
@@ -222,6 +209,9 @@
 ;;; make-shared-array
 ;;;
 
+(define exception:mapping-out-of-range
+  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
+
 (with-test-prefix "make-shared-array"
 
   ;; this failed in guile 1.8.0
@@ -400,6 +390,10 @@
 ;;; transpose-array
 ;;;
 
+; see strings.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
 (with-test-prefix "transpose-array"
 
   (pass-if-exception "non array argument" exception:wrong-type-arg
@@ -694,55 +688,40 @@
 ;;; uniform-vector
 ;;;
 
-(with-test-prefix "uniform-vector"
+(with-test-prefix "typed arrays"
 
-  (with-test-prefix "uniform-vector-ref byte"
+  (with-test-prefix "array-ref byte"
 
     (let ((a (make-s8vector 1)))
 
       (pass-if "0"
        (begin
          (array-set! a 0 0)
-         (= 0 (uniform-vector-ref a 0))))
+         (= 0 (array-ref a 0))))
       (pass-if "127"
        (begin
          (array-set! a 127 0)
-         (= 127 (uniform-vector-ref a 0))))
+         (= 127 (array-ref a 0))))
       (pass-if "-128"
        (begin
          (array-set! a -128 0)
-         (= -128 (uniform-vector-ref a 0))))))
-
-  (with-test-prefix "arrays with lbnd!=0 are not uniform vectors"
+         (= -128 (array-ref a 0))))))
 
-    (pass-if "bit"
-      (and (not (uniform-vector? address@hidden(#t #t #t)))
-           (uniform-vector? #1b(#t #t #t))))
-
-    (pass-if "s8"
-      (and (not (uniform-vector? address@hidden(0 1 2)))
-           (uniform-vector? #1s8(0 1 2)))))
-
-
-  (with-test-prefix "shared with rank 1 do not remain uniform vectors"
+  (with-test-prefix "shared with rank 1 equality"
 
     (let ((a #f64(1 2 3 4)))
 
-      (pass-if-exception "change offset -length" exception:wrong-type-arg
+      (pass-if "change offset"
         (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
-          (= 3 (uniform-vector-length b))))
-
-      (pass-if-exception "change offset -ref" exception:wrong-type-arg
-        (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
-          (= 2 (uniform-vector-ref b 0))))
-
-      (pass-if-exception "change stride -length" exception:wrong-type-arg
-        (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
-          (= 3 (uniform-vector-length b))))
-
-      (pass-if-exception "change stride -ref" exception:wrong-type-arg
-        (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
-          (= 2 (uniform-vector-ref b 0)))))))
+          (and (eq? (array-type b) (array-type a))
+               (= 3 (array-length b))
+               (array-equal? b #f64(2 3 4)))))
+
+      (pass-if "change stride"
+        (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+          (and (eq? (array-type c) (array-type a))
+               (= 2 (array-length c))
+               (array-equal? c #f64(1 3))))))))
 
 ;;;
 ;;; syntax
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index 4e32c61..8541576 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -1,6 +1,6 @@
 ;;;; bitvectors.test --- tests guile's bitvectors     -*- scheme -*-
 ;;;;
-;;;; Copyright 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright 2010, 2011, 2013, 2014 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
@@ -22,8 +22,8 @@
 
 (with-test-prefix "predicates"
   (pass-if (bitvector? #*1010101010))
-  (pass-if (uniform-vector? #*1010101010))
-  (pass-if (array? #*1010101010)))
+  (pass-if (array? #*1010101010))
+  (pass-if (eq? (array-type #*1010101010) 'b)))
 
 
 (with-test-prefix "equality"
@@ -36,23 +36,22 @@
 (with-test-prefix "lists"
   (pass-if (equal? (bitvector->list #*10010) '(#t #f #f #t #f)))
   (pass-if (equal? (array->list #*10010) '(#t #f #f #t #f)))
-  (pass-if (equal? (uniform-vector->list #*10010) '(#t #f #f #t #f)))
   (pass-if (equal? #*10010 (list->bitvector '(#t #f #f #t #f)))))
 
 (with-test-prefix "ref and set"
-  (with-test-prefix "bv"
+  (with-test-prefix "as bitvector"
     (let ((bv (list->bitvector '(#f #f #t #f #t))))
       (pass-if (eqv? (bitvector-ref bv 0) #f))
       (pass-if (eqv? (bitvector-ref bv 2) #t))
       (bitvector-set! bv 0 #t)
       (pass-if (eqv? (bitvector-ref bv 0) #t))))
 
-  (with-test-prefix "uv"
+  (with-test-prefix "as array"
     (let ((bv (list->bitvector '(#f #f #t #f #t))))
-      (pass-if (eqv? (uniform-vector-ref bv 0) #f))
-      (pass-if (eqv? (uniform-vector-ref bv 2) #t))
-      (uniform-vector-set! bv 0 #t)
-      (pass-if (eqv? (uniform-vector-ref bv 0) #t)))))
+      (pass-if (eqv? (array-ref bv 0) #f))
+      (pass-if (eqv? (array-ref bv 2) #t))
+      (array-set! bv #t 0)
+      (pass-if (eqv? (array-ref bv 0) #t)))))
 
 (with-test-prefix "bit-set*!"
   (pass-if "#t"
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index de20721..c4ae1bb 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,6 +1,8 @@
 ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; 
-*-
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
+;;;;   2014 Free Software Foundation, Inc.
+;;;;
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -393,7 +395,8 @@
 
 
 ;; Default to the C locale for the following tests.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
 
 
 (with-test-prefix "2.9 Operations on Strings"
diff --git a/test-suite/tests/encoding-iso88591.test 
b/test-suite/tests/encoding-iso88591.test
index 8265ff1..2af2b48 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -1,6 +1,6 @@
 ;;;; encoding-iso88591.test --- test suite for Guile's string encodings    -*- 
mode: scheme; coding: iso-8859-1 -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2014 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
@@ -25,9 +25,8 @@
   (apply string (map integer->char args)))
 
 ;; Set locale to the environment's locale, so that the prints look OK.
-(define oldlocale #f)
-(if (defined? 'setlocale)
-    (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL ""))
 
 (define ascii-a (integer->char 65))     ; LATIN CAPITAL LETTER A
 (define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@@ -177,7 +176,3 @@
                       (set-port-encoding! pt "ISO-8859-1")
                       (set-port-conversion-strategy! pt 'error)
                       (display (string-ints 256) pt))))
-
-;; Reset locales
-(if (defined? 'setlocale)
-    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-iso88597.test 
b/test-suite/tests/encoding-iso88597.test
index a577b2a..e88b9d3 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -1,6 +1,6 @@
 ;;;; encoding-iso88697.test --- test suite for Guile's string encodings    -*- 
mode: scheme; coding: iso-8859-7 -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2014 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
@@ -24,9 +24,9 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
-(define oldlocale #f)
-(if (defined? 'setlocale)
-    (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL ""))
+
 (define ascii-a (integer->char 65))     ; LATIN CAPITAL LETTER A
 (define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
 (define alpha (integer->char #x03b1))   ; GREEK SMALL LETTER ALPHA
@@ -167,7 +167,3 @@
                       (set-port-encoding! pt "ISO-8859-7")
                       (set-port-conversion-strategy! pt 'error)
                       (display (string-ints #x0400) pt))))
-
-;; Reset locale
-(if (defined? 'setlocale)
-    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-utf8.test 
b/test-suite/tests/encoding-utf8.test
index 1de3fa7..786170e 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -1,6 +1,6 @@
 ;;;; encoding-utf8.test --- test suite for Guile's string encodings    -*- 
mode: scheme; coding: utf-8 -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2014 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
@@ -24,9 +24,8 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
-(define oldlocale #f)
-(if (defined? 'setlocale)
-    (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL ""))
 
 (define ascii-a (integer->char 65))     ; LATIN CAPITAL LETTER A
 (define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@@ -189,6 +188,3 @@
           (let ((芥川龍之介  1)
                 (ñ 2))
             (eqv? (+  芥川龍之介 ñ) 3))))
-
-(if (defined? 'setlocale)
-    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index a411b49..3349847 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -1,7 +1,8 @@
 ;;;; format.test --- test suite for Guile's CL-ish format  -*- scheme -*-
 ;;;; Matthias Koeppe <address@hidden> --- June 2001
 ;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012,
+;;;;   2014 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
@@ -101,7 +102,9 @@
 ;;; ~h
 ;;;
 
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
+
 (with-test-prefix "~h localized number"
 
   (pass-if "1234.5"
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index bad4118..fb3299b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -243,7 +243,7 @@
                       (binary-test-string
                        (apply string
                               (map integer->char
-                                   (uniform-vector->list
+                                   (array->list
                                     (string->utf8 test-string))))))
                  (write-line test-string port)
                  (close-port port)
@@ -262,7 +262,7 @@
                       (binary-test-string
                        (apply string
                               (map integer->char
-                                   (uniform-vector->list
+                                   (array->list
                                     (string->utf8 test-string))))))
                  (write-line ";; coding: utf-8" port)
                  (write-line test-string port)
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index d25a3d4..2446dc7 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <address@hidden> --- September 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
-;;;;      2012, 2013 Free Software Foundation, Inc.
+;;;;      2012, 2013, 2014 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
@@ -23,8 +23,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 regex))
 
-(if (defined? 'setlocale)
-    (setlocale LC_ALL "C"))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
 
 ;; Don't fail if we can't display a test name to stdout/stderr.
 (set-port-conversion-strategy! (current-output-port) 'escape)
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index 5f93760..f511f1c 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -2,7 +2,7 @@
 ;;;; --- Test suite for Guile's SRFI-14 functions.
 ;;;; Martin Grabmueller, 2001-07-16
 ;;;;
-;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2009, 2010, 2014 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
@@ -745,9 +745,8 @@
 (define (every? pred lst)
   (not (not (every pred lst))))
 
-(define oldlocale #f)
-(if (defined? 'setlocale)
-    (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL ""))
 
 (with-test-prefix "Latin-1 (8-bit charset)"
 
@@ -844,6 +843,3 @@
                                             (map (lambda (x) (+ #x80 x))
                                                  (iota #x20))))))
                 char-set:iso-control)))
-
-(if (defined? 'setlocale)
-    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 8819c4f..d63e622 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -2,7 +2,7 @@
 ;;;; Matthias Koeppe <address@hidden> --- June 2001
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
-;;;;   2011 Free Software Foundation, Inc.
+;;;;   2011, 2014 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
@@ -28,7 +28,8 @@
   :use-module (ice-9 format))
 
 ;; Make sure we use the default locale.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
 
 (define (with-tz* tz thunk)
   "Temporarily set the TZ environment variable to the passed string
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 9b76c7a..ffb1851 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -1,7 +1,7 @@
 ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
 ;;;; Martin Grabmueller, 2001-06-26
 ;;;;
-;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013, 2014 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
@@ -50,9 +50,9 @@
     (equal? (u8vector->list (u8vector 1 2 3 4))
            (u8vector->list (list->u8vector '(1 2 3 4)))))
 
-  (pass-if "u8vector->list/uniform-vector->list"
+  (pass-if "u8vector->list/array->list"
     (equal? (u8vector->list (u8vector 1 2 3 4))
-           (uniform-vector->list (u8vector 1 2 3 4))))
+           (array->list (u8vector 1 2 3 4))))
 
   (pass-if "make-u8vector"
     (equal? (list->u8vector '(7 7 7 7))
@@ -87,9 +87,9 @@
     (equal? (s8vector->list (s8vector 1 2 3 4))
            (s8vector->list (list->s8vector '(1 2 3 4)))))
 
-  (pass-if "s8vector->list/uniform-vector->list"
+  (pass-if "s8vector->list/array->list"
     (equal? (s8vector->list (s8vector 1 2 3 4))
-           (uniform-vector->list (s8vector 1 2 3 4))))
+           (array->list (s8vector 1 2 3 4))))
 
   (pass-if "make-s8vector"
     (equal? (list->s8vector '(7 7 7 7))
@@ -125,9 +125,9 @@
     (equal? (u16vector->list (u16vector 1 2 3 4))
            (u16vector->list (list->u16vector '(1 2 3 4)))))
 
-  (pass-if "u16vector->list/uniform-vector->list"
+  (pass-if "u16vector->list/array->list"
     (equal? (u16vector->list (u16vector 1 2 3 4))
-           (uniform-vector->list (u16vector 1 2 3 4))))
+           (array->list (u16vector 1 2 3 4))))
 
   (pass-if "make-u16vector"
     (equal? (list->u16vector '(7 7 7 7))
@@ -162,9 +162,9 @@
     (equal? (s16vector->list (s16vector 1 2 3 4))
            (s16vector->list (list->s16vector '(1 2 3 4)))))
 
-  (pass-if "s16vector->list/uniform-vector->list"
+  (pass-if "s16vector->list/array->list"
     (equal? (s16vector->list (s16vector 1 2 3 4))
-           (uniform-vector->list (s16vector 1 2 3 4))))
+           (array->list (s16vector 1 2 3 4))))
 
   (pass-if "make-s16vector"
     (equal? (list->s16vector '(7 7 7 7))
@@ -199,9 +199,9 @@
     (equal? (u32vector->list (u32vector 1 2 3 4))
            (u32vector->list (list->u32vector '(1 2 3 4)))))
 
-  (pass-if "u32vector->list/uniform-vector->list"
+  (pass-if "u32vector->list/array->list"
     (equal? (u32vector->list (u32vector 1 2 3 4))
-           (uniform-vector->list (u32vector 1 2 3 4))))
+           (array->list (u32vector 1 2 3 4))))
 
   (pass-if "make-u32vector"
     (equal? (list->u32vector '(7 7 7 7))
@@ -236,9 +236,9 @@
     (equal? (s32vector->list (s32vector 1 2 3 4))
            (s32vector->list (list->s32vector '(1 2 3 4)))))
 
-  (pass-if "s32vector->list/uniform-vector->list"
+  (pass-if "s32vector->list/array->list"
     (equal? (s32vector->list (s32vector 1 2 3 4))
-           (uniform-vector->list (s32vector 1 2 3 4))))
+           (array->list (s32vector 1 2 3 4))))
 
   (pass-if "make-s32vector"
     (equal? (list->s32vector '(7 7 7 7))
@@ -273,9 +273,9 @@
     (equal? (u64vector->list (u64vector 1 2 3 4))
            (u64vector->list (list->u64vector '(1 2 3 4)))))
 
-  (pass-if "u64vector->list/uniform-vector->list"
+  (pass-if "u64vector->list/array->list"
     (equal? (u64vector->list (u64vector 1 2 3 4))
-           (uniform-vector->list (u64vector 1 2 3 4))))
+           (array->list (u64vector 1 2 3 4))))
 
   (pass-if "make-u64vector"
     (equal? (list->u64vector '(7 7 7 7))
@@ -310,9 +310,9 @@
     (equal? (s64vector->list (s64vector 1 2 3 4))
            (s64vector->list (list->s64vector '(1 2 3 4)))))
 
-  (pass-if "s64vector->list/uniform-vector->list"
+  (pass-if "s64vector->list/array->list"
     (equal? (s64vector->list (s64vector 1 2 3 4))
-           (uniform-vector->list (s64vector 1 2 3 4))))
+           (array->list (s64vector 1 2 3 4))))
 
   (pass-if "make-s64vector"
     (equal? (list->s64vector '(7 7 7 7))
@@ -347,9 +347,9 @@
     (equal? (f32vector->list (f32vector 1 2 3 4))
            (f32vector->list (list->f32vector '(1 2 3 4)))))
 
-  (pass-if "f32vector->list/uniform-vector->list"
+  (pass-if "f32vector->list/array->list"
     (equal? (f32vector->list (f32vector 1 2 3 4))
-           (uniform-vector->list (f32vector 1 2 3 4))))
+           (array->list (f32vector 1 2 3 4))))
 
   (pass-if "make-f32vector"
     (equal? (list->f32vector '(7 7 7 7))
@@ -387,9 +387,9 @@
     (equal? (f64vector->list (f64vector 1 2 3 4))
            (f64vector->list (list->f64vector '(1 2 3 4)))))
 
-  (pass-if "f64vector->list/uniform-vector->list"
+  (pass-if "f64vector->list/array->list"
     (equal? (f64vector->list (f64vector 1 2 3 4))
-           (uniform-vector->list (f64vector 1 2 3 4))))
+           (array->list (f64vector 1 2 3 4))))
 
   (pass-if "make-f64vector"
     (equal? (list->f64vector '(7 7 7 7))
@@ -427,9 +427,9 @@
     (equal? (c32vector->list (c32vector 1 2 3 4))
            (c32vector->list (list->c32vector '(1 2 3 4)))))
 
-  (pass-if "c32vector->list/uniform-vector->list"
+  (pass-if "c32vector->list/array->list"
     (equal? (c32vector->list (c32vector 1 2 3 4))
-           (uniform-vector->list (c32vector 1 2 3 4))))
+           (array->list (c32vector 1 2 3 4))))
 
   (pass-if "make-c32vector"
     (equal? (list->c32vector '(7 7 7 7))
@@ -486,9 +486,9 @@
     (equal? (c64vector->list (c64vector 1 2 3 4))
            (c64vector->list (list->c64vector '(1 2 3 4)))))
 
-  (pass-if "c64vector->list/uniform-vector->list"
+  (pass-if "c64vector->list/array->list"
     (equal? (c64vector->list (c64vector 1 2 3 4))
-           (uniform-vector->list (c64vector 1 2 3 4))))
+           (array->list (c64vector 1 2 3 4))))
 
   (pass-if "make-c64vector"
     (equal? (list->c64vector '(7 7 7 7))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index c2e6c65..0f6d945 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,8 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <address@hidden> --- May 2009
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, 
Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
+;;;;   2014 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
@@ -200,7 +201,8 @@
 ;;;
 
 ;; Make sure we get English messages.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
 
 (define (call-with-warnings thunk)
   (let ((port (open-output-string)))


hooks/post-receive
-- 
GNU Guile



reply via email to

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