Make bytevectors accessible using the generalized-vector API.

As a side effect, this allows compilation of literal bytevectors
("#vu8(...)"), which gets done by the generic array handling
of the GLIL->assembly compiler.

* doc/ref/api-compound.texi (Generalized Vectors): Mention bytevectors.
  (Arrays, Array Syntax): Likewise.

* doc/ref/api-data.texi (Bytevectors as Generalized Vectors): New node.

* libguile/bytevectors.c (scm_i_bytevector_generalized_set_x): New.

* libguile/bytevectors.h (scm_i_bytevector_generalized_set_x): New
  declaration.

* libguile/srfi-4.c (scm_i_generalized_vector_type,
  scm_array_handle_uniform_element_size,
  scm_array_handle_uniform_writable_elements): Add support for
  bytevectors.

* libguile/unif.c (type_creator_table): Add `vu8'.
  (bytevector_ref, bytevector_set): New functions.
  (memoize_ref, memoize_set): Add support for bytevectors.

* libguile/vectors.c (scm_is_generalized_vector,
  scm_c_generalized_vector_length, scm_c_generalized_vector_ref,
  scm_c_generalized_vector_set_x): Add support for bytevectors.

* test-suite/tests/bytevectors.test ("Generalized Vectors"): New test
  set.

doc/ref/api-compound.texi

@@ -1649,9 +1649,9 @@ and writing.
 @subsection Generalized Vectors
 
 Guile has a number of data types that are generally vector-like:
-strings, uniform numeric vectors, bitvectors, and of course ordinary
+strings, uniform numeric vectors, bytevectors, bitvectors, and of course
-vectors of arbitrary Scheme values.  These types are disjoint: a
+ordinary vectors of arbitrary Scheme values.  These types are disjoint:
-Scheme value belongs to at most one of the four types listed above.
+a Scheme value belongs to at most one of the four types listed above.
 
 If you want to gloss over this distinction and want to treat all four
 types with common code, you can use the procedures in this section.
@@ -1749,9 +1749,9 @@ matrix with zero columns and 3 rows is different from a matrix with 3
 columns and zero rows, which again is different from a vector of
 length zero.
 
-Generalized vectors, such as strings, uniform numeric vectors, bit
+Generalized vectors, such as strings, uniform numeric vectors,
-vectors and ordinary vectors, are the special case of one dimensional
+bytevectors, bit vectors and ordinary vectors, are the special case of
-arrays.
+one dimensional arrays.
 
 @menu
 * Array Syntax::                
@@ -1834,6 +1834,16 @@ is a rank-zero array with contents 12.
 
 @end table
 
+In addition, bytevectors are also arrays, but use a different syntax
+(@pxref{Bytevectors}):
+
+@table @code
+
+@item #vu8(1 2 3)
+is a 3-byte long bytevector, with contents 1, 2, 3.
+
+@end table
+
 @node Array Procedures
 @subsubsection Array Procedures
 

doc/ref/api-data.texi

@@ -3789,6 +3789,7 @@ R6RS (@pxref{R6RS I/O Ports}).
 * Bytevectors and Integer Lists::  Converting to/from an integer list.
 * Bytevectors as Floats::       Interpreting bytes as real numbers.
 * Bytevectors as Strings::      Interpreting bytes as Unicode strings.
+* Bytevectors as Generalized Vectors::  Guile extension to the bytevector API.
 @end menu
 
 @node Bytevector Endianness
@@ -4156,6 +4157,32 @@ Return a newly allocated string that contains from the UTF-8-, UTF-16-,
 or UTF-32-decoded contents of bytevector @var{utf}.
 @end deffn
 
+@node Bytevectors as Generalized Vectors
+@subsubsection Accessing Bytevectors with the Generalized Vector API
+
+As an extension to the R6RS, Guile allows bytevectors to be manipulated
+with the @dfn{generalized vector} procedures (@pxref{Generalized
+Vectors}).  This also allows bytevectors to be accessed using the
+generic @dfn{array} procedures (@pxref{Array Procedures}).  When using
+these APIs, bytes are accessed one at a time as 8-bit unsigned integers:
+
+@example
+(define bv #vu8(0 1 2 3))
+
+(generalized-vector? bv)
+@result{} #t
+
+(generalized-vector-ref bv 2)
+@result{} 2
+
+(generalized-vector-set! bv 2 77)
+(array-ref bv 2)
+@result{} 77
+
+(array-type bv)
+@result{} vu8
+@end example
+
 
 @node Regular Expressions
 @subsection Regular Expressions

libguile/bytevectors.c

@@ -328,6 +328,15 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
 }
 #undef FUNC_NAME
 
+/* This procedure is used by `scm_c_generalized_vector_set_x ()'.  */
+void
+scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
+#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
+{
+  scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
+}
+#undef FUNC_NAME
+
 SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
 		bv, port, pstate)
 {

libguile/bytevectors.h

@@ -136,6 +136,7 @@ SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
    : scm_i_shrink_bytevector ((_bv), (_len)))
 
 SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, size_t);
+SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
 SCM_INTERNAL SCM scm_null_bytevector;
 
 #endif /* SCM_BYTEVECTORS_H */

libguile/srfi-4.c

@@ -1,6 +1,6 @@
 /* srfi-4.c --- Uniform numeric vector datatypes.
  *
- * 	Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
+ * 	Copyright (C) 2001, 2004, 2006, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -29,6 +29,7 @@
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
 #include "libguile/srfi-4.h"
+#include "libguile/bytevectors.h"
 #include "libguile/error.h"
 #include "libguile/read.h"
 #include "libguile/ports.h"
@@ -609,6 +610,8 @@ scm_i_generalized_vector_type (SCM v)
     return scm_sym_b;
   else if (scm_is_uniform_vector (v))
     return scm_from_locale_symbol (uvec_tags[SCM_UVEC_TYPE(v)]);
+  else if (scm_is_bytevector (v))
+    return scm_from_locale_symbol ("vu8");
   else
     return SCM_BOOL_F;
 }
@@ -750,6 +753,8 @@ scm_array_handle_uniform_element_size (scm_t_array_handle *h)
     vec = SCM_I_ARRAY_V (vec);
   if (scm_is_uniform_vector (vec))
     return uvec_sizes[SCM_UVEC_TYPE(vec)];
+  if (scm_is_bytevector (vec))
+    return 1U;
   scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
 }
 
@@ -790,6 +795,8 @@ scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
       char *elts = SCM_UVEC_BASE (vec);
       return (void *) (elts + size*h->base);
     }
+  if (scm_is_bytevector (vec))
+    return SCM_BYTEVECTOR_CONTENTS (vec);
   scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
 }
 

libguile/unif.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -47,6 +47,7 @@
 #include "libguile/srfi-13.h"
 #include "libguile/srfi-4.h"
 #include "libguile/vectors.h"
+#include "libguile/bytevectors.h"
 #include "libguile/list.h"
 #include "libguile/deprecation.h"
 #include "libguile/dynwind.h"
@@ -109,6 +110,7 @@ struct {
   { "f64", SCM_UNSPECIFIED, scm_make_f64vector },
   { "c32", SCM_UNSPECIFIED, scm_make_c32vector },
   { "c64", SCM_UNSPECIFIED, scm_make_c64vector },
+  { "vu8", SCM_UNSPECIFIED, scm_make_bytevector },
   { NULL }
 };
 
@@ -313,6 +315,12 @@ bitvector_ref (scm_t_array_handle *h, ssize_t pos)
     scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
 }
 
+static SCM
+bytevector_ref (scm_t_array_handle *h, ssize_t pos)
+{
+  return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
+}
+
 static SCM
 memoize_ref (scm_t_array_handle *h, ssize_t pos)
 {
@@ -346,6 +354,11 @@ memoize_ref (scm_t_array_handle *h, ssize_t pos)
       h->elements = scm_array_handle_bit_elements (h);
       h->ref = bitvector_ref;
     }
+  else if (scm_is_bytevector (v))
+    {
+      h->elements = scm_array_handle_uniform_elements (h);
+      h->ref = bytevector_ref;
+    }
   else
     scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
 
@@ -386,6 +399,17 @@ bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
     ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
 }
 
+static void
+bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
+{
+  scm_t_uint8 c_value;
+  scm_t_uint8 *elements;
+
+  c_value = scm_to_uint8 (val);
+  elements = (scm_t_uint8 *) h->elements;
+  elements[pos] = (scm_t_uint8) c_value;
+}
+
 static void
 memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
 {
@@ -420,6 +444,11 @@ memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
       h->writable_elements = scm_array_handle_bit_writable_elements (h);
       h->set = bitvector_set;
     }
+  else if (scm_is_bytevector (v))
+    {
+      h->elements = scm_array_handle_uniform_writable_elements (h);
+      h->set = bytevector_set;
+    }
   else
     scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
 

libguile/vectors.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -31,6 +31,7 @@
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
 #include "libguile/unif.h"
+#include "libguile/bytevectors.h"
 #include "libguile/ramap.h"
 #include "libguile/srfi-4.h"
 #include "libguile/strings.h"
@@ -523,7 +524,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
 }
 #undef FUNC_NAME
 
-
+
 /* Generalized vectors. */
 
 int
@@ -532,7 +533,8 @@ scm_is_generalized_vector (SCM obj)
   return (scm_is_vector (obj)
 	  || scm_is_string (obj)
 	  || scm_is_bitvector (obj)
-	  || scm_is_uniform_vector (obj));
+	  || scm_is_uniform_vector (obj)
+	  || scm_is_bytevector (obj));
 }
 
 SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
@@ -564,6 +566,8 @@ scm_c_generalized_vector_length (SCM v)
     return scm_c_bitvector_length (v);
   else if (scm_is_uniform_vector (v))
     return scm_c_uniform_vector_length (v);
+  else if (scm_is_bytevector (v))
+    return scm_c_bytevector_length (v);
   else
     scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
 }
@@ -588,6 +592,8 @@ scm_c_generalized_vector_ref (SCM v, size_t idx)
     return scm_c_bitvector_ref (v, idx);
   else if (scm_is_uniform_vector (v))
     return scm_c_uniform_vector_ref (v, idx);
+  else if (scm_is_bytevector (v))
+    return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
   else
     scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
 }
@@ -613,6 +619,8 @@ scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
     scm_c_bitvector_set_x (v, idx, val);
   else if (scm_is_uniform_vector (v))
     scm_c_uniform_vector_set_x (v, idx, val);
+  else if (scm_is_bytevector (v))
+    scm_i_bytevector_generalized_set_x (v, idx, val);
   else
     scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
 }

test-suite/tests/bytevectors.test

@@ -583,6 +583,77 @@
     exception:wrong-type-arg
     (with-input-from-string "#vu8(0 256)" read)))
 
+
+(with-test-prefix "Generalized Vectors"
+
+  (pass-if "generalized-vector?"
+    (generalized-vector? #vu8(1 2 3)))
+
+  (pass-if "generalized-vector-length"
+    (equal? (iota 16)
+            (map generalized-vector-length
+                 (map make-bytevector (iota 16)))))
+
+  (pass-if "generalized-vector-ref"
+    (let ((bv #vu8(255 127)))
+      (and (= 255 (generalized-vector-ref bv 0))
+           (= 127 (generalized-vector-ref bv 1)))))
+
+  (pass-if-exception "generalized-vector-ref [index out-of-range]"
+    exception:out-of-range
+    (let ((bv #vu8(1 2)))
+      (generalized-vector-ref bv 2)))
+
+  (pass-if "generalized-vector-set!"
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 0 255)
+      (generalized-vector-set! bv 1 77)
+      (equal? '(255 77)
+              (bytevector->u8-list bv))))
+
+  (pass-if-exception "generalized-vector-set! [index out-of-range]"
+    exception:out-of-range
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 2 0)))
+
+  (pass-if-exception "generalized-vector-set! [value out-of-range]"
+    exception:out-of-range
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 0 256)))
+
+  (pass-if "array-type"
+    (eq? 'vu8 (array-type #vu8())))
+
+  (pass-if "array-contents"
+    (let ((bv (u8-list->bytevector (iota 10))))
+      (eq? bv (array-contents bv))))
+
+  (pass-if "array-ref"
+    (let ((bv (u8-list->bytevector (iota 10))))
+      (equal? (iota 10)
+              (map (lambda (i) (array-ref bv i))
+                   (iota 10)))))
+
+  (pass-if "array-set!"
+    (let ((bv (make-bytevector 10)))
+      (for-each (lambda (i)
+                  (array-set! bv i i))
+                (iota 10))
+      (equal? (iota 10)
+              (bytevector->u8-list bv))))
+
+  (pass-if "make-typed-array"
+    (let ((bv (make-typed-array 'vu8 77 33)))
+      (equal? bv (u8-list->bytevector (make-list 33 77)))))
+
+  (pass-if-exception "make-typed-array [out-of-range]"
+    exception:out-of-range
+    (make-typed-array 'vu8 256 77))
+
+  (pass-if "uniform-array->bytevector"
+    (let ((bv #vu8(0 1 128 255)))
+      (equal? bv (uniform-array->bytevector bv)))))
+
 
 ;;; Local Variables:
 ;;; coding: latin-1