generic vector ops to own file

* libguile/Makefile.am:
* libguile/vectors.c:
* libguile/vectors.h:
* libguile/generalized-vectors.c:
* libguile/generalized-vectors.h: Move generic vector ops off into their
  own file too. The implementation is now based on the generic
  array-handle infrastructure.

* libguile.h:
* libguile/array-map.c:
* libguile/bitvectors.c:
* libguile/random.c:
* libguile/srfi-4.c: Update includers.

12 files changed, 232 insertions, 145 deletions

diff --git a/libguile.h b/libguile.h
index 3fdafc2ba..4eaedbf3e 100644
--- a/libguile.h
+++ b/libguile.h
@@ -55,6 +55,7 @@ extern "C" {
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
 #include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 3b5828f50..9918672d5 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -144,6 +144,7 @@ libguile_la_SOURCES =				\
 	gdbint.c				\
 	gettext.c				\
 	generalized-arrays.c			\
+	generalized-vectors.c			\
 	goops.c					\
 	gsubr.c					\
 	guardians.c				\
@@ -252,6 +253,7 @@ DOT_X_FILES =					\
 	gc.x					\
 	gettext.x				\
 	generalized-arrays.x			\
+	generalized-vectors.x			\
 	goops.x					\
 	gsubr.x					\
 	guardians.x				\
@@ -351,6 +353,7 @@ DOT_DOC_FILES = 				\
 	gc.doc					\
 	gettext.doc				\
 	generalized-arrays.doc			\
+	generalized-vectos.doc			\
 	goops.doc				\
 	gsubr.doc				\
 	guardians.doc				\
@@ -494,6 +497,7 @@ modinclude_HEADERS =				\
 	gdbint.h				\
 	gettext.h				\
 	generalized-arrays.h			\
+	generalized-vectors.h			\
 	goops.h					\
 	gsubr.h					\
 	guardians.h				\
diff --git a/libguile/array-map.c b/libguile/array-map.c
index c6f5ead1d..fb9ceea37 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -39,6 +39,7 @@
 #include "libguile/srfi-4.h"
 #include "libguile/dynwind.h"
 #include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/array-map.h"
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 0d2302d9c..bc01c6182 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -48,6 +48,7 @@
 #include "libguile/validate.h"
 #include "libguile/arrays.h"
 #include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/array-map.h"
 #include "libguile/print.h"
 #include "libguile/read.h"
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index f0bb5c6c8..ed2e9a09a 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -34,6 +34,7 @@
 #include "libguile/arrays.h"
 #include "libguile/vectors.h"
 #include "libguile/srfi-4.h"
+#include "libguile/generalized-vectors.h"
 
 /* Bit vectors. Would be nice if they were implemented on top of bytevectors,
  * but alack, all we have is this crufty C.
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
new file mode 100644
index 000000000..0c85f368a
--- /dev/null
+++ b/libguile/generalized-vectors.c
@@ -0,0 +1,164 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
+
+
+int
+scm_is_generalized_vector (SCM obj)
+{
+  int ret = 0;
+  if (scm_is_array (obj))
+    {
+      scm_t_array_handle h;
+      scm_array_get_handle (obj, &h);
+      ret = scm_array_handle_rank (&h) == 1;
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} if @var{obj} is a vector, string,\n"
+	    "bitvector, or uniform numeric vector.")
+#define FUNC_NAME s_scm_generalized_vector_p
+{
+  return scm_from_bool (scm_is_generalized_vector (obj));
+}
+#undef FUNC_NAME
+
+#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
+  scm_generalized_vector_get_handle (val, handle)
+   
+
+void
+scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
+{
+  scm_array_get_handle (vec, h);
+  if (scm_array_handle_rank (h) != 1)
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
+    }
+}
+
+size_t
+scm_c_generalized_vector_length (SCM v)
+{
+  scm_t_array_handle h;
+  size_t ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
+	    (SCM v),
+	    "Return the length of the generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_length
+{
+  return scm_from_size_t (scm_c_generalized_vector_length (v));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_generalized_vector_ref (SCM v, size_t idx)
+{
+  scm_t_array_handle h;
+  SCM ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.impl->vref (&h, idx);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
+	    (SCM v, SCM idx),
+	    "Return the element at index @var{idx} of the\n"
+	    "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_ref
+{
+  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  h.impl->vset (&h, idx, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
+	    (SCM v, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the\n"
+	    "generalized vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_generalized_vector_set_x
+{
+  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
+	    (SCM v),
+	    "Return a new list whose elements are the elements of the\n"
+	    "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_to_list
+{
+  SCM ret = SCM_EOL;
+  ssize_t pos, i = 0;
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  // FIXME CHECKME
+  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
+       i >= 0;
+       pos += h.dims[0].inc)
+    ret = scm_cons (h.impl->vref (&h, pos), ret);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_vectors ()
+{
+#include "libguile/generalized-vectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
new file mode 100644
index 000000000..08321d106
--- /dev/null
+++ b/libguile/generalized-vectors.h
@@ -0,0 +1,55 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_VECTORS_H
+#define SCM_GENERALIZED_VECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Generalized vectors */
+
+SCM_API SCM scm_generalized_vector_p (SCM v);
+SCM_API SCM scm_generalized_vector_length (SCM v);
+SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_generalized_vector_to_list (SCM v);
+
+SCM_API int scm_is_generalized_vector (SCM obj);
+SCM_API size_t scm_c_generalized_vector_length (SCM v);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API void scm_generalized_vector_get_handle (SCM vec,
+						scm_t_array_handle *h);
+
+
+SCM_INTERNAL void scm_init_generalized_vectors (void);
+
+#endif  /* SCM_GENERALIZED_VECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/init.c b/libguile/init.c
index 7478676dc..16b560e1b 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -64,6 +64,7 @@
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
 #include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
@@ -544,6 +545,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_random ();
   scm_init_array_handle ();
   scm_init_generalized_arrays ();
+  scm_init_generalized_vectors ();
   scm_init_bitvectors ();
   scm_init_array_map ();
   scm_init_arrays ();
diff --git a/libguile/random.c b/libguile/random.c
index dfda4d082..32c770a99 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -36,6 +36,7 @@
 #include "libguile/arrays.h"
 #include "libguile/srfi-4.h"
 #include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/random.h"
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 408355d38..ba7e9e6a0 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -31,6 +31,7 @@
 #include "libguile/srfi-4.h"
 #include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/error.h"
 #include "libguile/read.h"
 #include "libguile/ports.h"
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 2d77f158b..f1388cf12 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -30,6 +30,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/arrays.h"
 #include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
@@ -526,136 +527,6 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
 #undef FUNC_NAME
 
 
-/* Generalized vectors. */
-
-int
-scm_is_generalized_vector (SCM obj)
-{
-  return (scm_is_vector (obj)
-	  || scm_is_string (obj)
-	  || scm_is_bitvector (obj)
-	  || scm_is_uniform_vector (obj)
-	  || scm_is_bytevector (obj));
-}
-
-SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} if @var{obj} is a vector, string,\n"
-	    "bitvector, or uniform numeric vector.")
-#define FUNC_NAME s_scm_generalized_vector_p
-{
-  return scm_from_bool (scm_is_generalized_vector (obj));
-}
-#undef FUNC_NAME
-
-void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-    scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-}
-
-size_t
-scm_c_generalized_vector_length (SCM v)
-{
-  if (scm_is_vector (v))
-    return scm_c_vector_length (v);
-  else if (scm_is_string (v))
-    return scm_c_string_length (v);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_length (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_length (v);
-  else if (scm_is_bytevector (v))
-    return scm_c_bytevector_length (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
-	    (SCM v),
-	    "Return the length of the generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_length
-{
-  return scm_from_size_t (scm_c_generalized_vector_length (v));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
-{
-  if (scm_is_vector (v))
-    return scm_c_vector_ref (v, idx);
-  else if (scm_is_string (v))
-    return scm_c_string_ref (v, idx);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_ref (v, idx);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_ref (v, idx);
-  else if (scm_is_bytevector (v))
-    return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
-	    (SCM v, SCM idx),
-	    "Return the element at index @var{idx} of the\n"
-	    "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_ref
-{
-  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  if (scm_is_vector (v))
-    scm_c_vector_set_x (v, idx, val);
-  else if (scm_is_string (v))
-    scm_c_string_set_x (v, idx, val);
-  else if (scm_is_bitvector (v))
-    scm_c_bitvector_set_x (v, idx, val);
-  else if (scm_is_uniform_vector (v))
-    scm_c_uniform_vector_set_x (v, idx, val);
-  else if (scm_is_bytevector (v))
-    scm_i_bytevector_generalized_set_x (v, idx, val);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
-	    (SCM v, SCM idx, SCM val),
-	    "Set the element at index @var{idx} of the\n"
-	    "generalized vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_generalized_vector_set_x
-{
-  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
-	    (SCM v),
-	    "Return a new list whose elements are the elements of the\n"
-	    "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_to_list
-{
-  if (scm_is_vector (v))
-    return scm_vector_to_list (v);
-  else if (scm_is_string (v))
-    return scm_string_to_list (v);
-  else if (scm_is_bitvector (v))
-    return scm_bitvector_to_list (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_uniform_vector_to_list (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-#undef FUNC_NAME
-
 static SCM
 vector_handle_ref (scm_t_array_handle *h, size_t idx)
 {
diff --git a/libguile/vectors.h b/libguile/vectors.h
index eb0c9436e..bc5b41cb9 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -61,21 +61,6 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
-/* Generalized vectors */
-
-SCM_API SCM scm_generalized_vector_p (SCM v);
-SCM_API SCM scm_generalized_vector_length (SCM v);
-SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_generalized_vector_to_list (SCM v);
-
-SCM_API int scm_is_generalized_vector (SCM obj);
-SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-						scm_t_array_handle *h);
-
 /* Internals */
 
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))