move generic array foo out to its own file

* libguile/arrays.h:
* libguile/arrays.c:
* libguile/generalized-arrays.h:
* libguile/generalized-arrays.c: Move some generic functionality out of
  arrays.c to a new file.

* libguile/array-map.c:
* libguile/deprecated.c:
* libguile/init.c: Update includers.

libguile.h

@@ -54,6 +54,7 @@ extern "C" {
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"

libguile/Makefile.am

@@ -143,6 +143,7 @@ libguile_la_SOURCES =				\
 	gc_os_dep.c				\
 	gdbint.c				\
 	gettext.c				\
+	generalized-arrays.c			\
 	goops.c					\
 	gsubr.c					\
 	guardians.c				\
@@ -250,6 +251,7 @@ DOT_X_FILES =					\
 	gc-segment.x				\
 	gc.x					\
 	gettext.x				\
+	generalized-arrays.x			\
 	goops.x					\
 	gsubr.x					\
 	guardians.x				\
@@ -348,6 +350,7 @@ DOT_DOC_FILES = 				\
 	gc-segment.doc				\
 	gc.doc					\
 	gettext.doc				\
+	generalized-arrays.doc			\
 	goops.doc				\
 	gsubr.doc				\
 	guardians.doc				\
@@ -490,6 +493,7 @@ modinclude_HEADERS =				\
 	gdb_interface.h				\
 	gdbint.h				\
 	gettext.h				\
+	generalized-arrays.h			\
 	goops.h					\
 	gsubr.h					\
 	guardians.h				\

libguile/array-map.c

@@ -38,6 +38,7 @@
 #include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/dynwind.h"
+#include "libguile/generalized-arrays.h"
 
 #include "libguile/validate.h"
 #include "libguile/array-map.h"

libguile/arrays.c

@@ -17,13 +17,6 @@
  */
 
 
-/*
-  This file has code for arrays in lots of variants (double, integer,
-  unsigned etc. ). It suffers from hugely repetitive code because
-  there is similar (but different) code for every variant included. (urg.)
-
-  --hwn
-*/
 
 
 #ifdef HAVE_CONFIG_H
@@ -54,6 +47,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/arrays.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/array-map.h"
 #include "libguile/print.h"
 #include "libguile/read.h"
@@ -145,107 +139,6 @@ make_typed_vector (SCM type, size_t len)
   return creator (scm_from_size_t (len), SCM_UNDEFINED);
 }
 
-int
-scm_is_array (SCM obj)
-{
-  return (SCM_I_ARRAYP (obj)
-	  || scm_is_generalized_vector (obj));
-}
-
-int
-scm_is_typed_array (SCM obj, SCM type)
-{
-  /* Get storage vector. 
-   */
-  if (SCM_I_ARRAYP (obj))
-    obj = SCM_I_ARRAY_V (obj);
-
-  /* It must be a generalized vector (which includes vectors, strings, etc).
-   */
-  if (!scm_is_generalized_vector (obj))
-    return 0;
-
-  return scm_is_eq (type, scm_i_generalized_vector_type (obj));
-}
-
-/* We keep the old 2-argument C prototype for a while although the old
-   PROT argument is always ignored now.  C code should probably use
-   scm_is_array or scm_is_typed_array anyway.
-*/
-
-SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
-           (SCM obj),
-	    "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-	    "not.")
-#define FUNC_NAME s_scm_array_p
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
-           (SCM obj, SCM type),
-	    "Return @code{#t} if the @var{obj} is an array of type\n"
-	    "@var{type}, and @code{#f} if not.")
-#define FUNC_NAME s_scm_typed_array_p
-{
-  return scm_from_bool (scm_is_typed_array (obj, type));
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_array_rank (SCM array)
-{
-  scm_t_array_handle handle;
-  size_t res;
-
-  scm_array_get_handle (array, &handle);
-  res = scm_array_handle_rank (&handle);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
-           (SCM array),
-	    "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
-  return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
-           (SCM ra),
-	    "@code{array-dimensions} is similar to @code{array-shape} but replaces\n"
-	    "elements with a @code{0} minimum with one greater than the maximum. So:\n"
-	    "@lisp\n"
-	    "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n"
-	    "@end lisp")
-#define FUNC_NAME s_scm_array_dimensions
-{
-  scm_t_array_handle handle;
-  scm_t_array_dim *s;
-  SCM res = SCM_EOL;
-  size_t k;
-      
-  scm_array_get_handle (ra, &handle);
-  s = scm_array_handle_dims (&handle);
-  k = scm_array_handle_rank (&handle);
-
-  while (k--)
-    res = scm_cons (s[k].lbnd
-		    ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
-				 scm_from_ssize_t (s[k].ubnd),
-				 SCM_EOL)
-		    : scm_from_ssize_t (1 + s[k].ubnd),
-		    res);
-
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
 
 SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
            (SCM ra),
@@ -679,97 +572,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
-           (SCM v, SCM args),
-	    "Return @code{#t} if its arguments would be acceptable to\n"
-	    "@code{array-ref}.")
-#define FUNC_NAME s_scm_array_in_bounds_p
-{
-  SCM res = SCM_BOOL_T;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-
-  if (SCM_I_ARRAYP (v))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (v);
-      scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
-
-      for (k = 0; k < ndim; k++)
-	{
-	  long ind;
-
-	  if (!scm_is_pair (args))
-	    SCM_WRONG_NUM_ARGS ();
-	  ind = scm_to_long (SCM_CAR (args));
-	  args = SCM_CDR (args);
-
-	  if (ind < s[k].lbnd || ind > s[k].ubnd)
-	    {
-	      res = SCM_BOOL_F;
-	      /* We do not stop the checking after finding a violation
-		 since we want to validate the type-correctness and
-		 number of arguments in any case.
-	      */
-	    }
-	}
-    }
-  else if (scm_is_generalized_vector (v))
-    {
-      /* Since real arrays have been covered above, all generalized
-	 vectors are guaranteed to be zero-origin here.
-      */
-
-      long ind;
-
-      if (!scm_is_pair (args))
-	SCM_WRONG_NUM_ARGS ();
-      ind = scm_to_long (SCM_CAR (args));
-      args = SCM_CDR (args);
-      res = scm_from_bool (ind >= 0
-			   && ind < scm_c_generalized_vector_length (v));
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "array");
-
-  if (!scm_is_null (args))
-    SCM_WRONG_NUM_ARGS ();
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
-           (SCM v, SCM args),
-	    "Return the element at the @code{(index1, index2)} element in\n"
-	    "@var{array}.")
-#define FUNC_NAME s_scm_array_ref
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (v, &handle);
-  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
-           (SCM v, SCM obj, SCM args),
-	    "Set the element at the @code{(index1, index2)} element in @var{array} to\n"
-	    "@var{new-value}.  The value returned by array-set! is unspecified.")
-#define FUNC_NAME s_scm_array_set_x           
-{
-  scm_t_array_handle handle;
-
-  scm_array_get_handle (v, &handle);
-  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
-  scm_array_handle_release (&handle);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
 /* attempts to unroll an array into a one-dimensional array.
    returns the unrolled array or #f if it can't be done.  */
   /* if strict is not SCM_UNDEFINED, return #f if returned array
@@ -975,46 +777,6 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
 #undef FUNC_NAME
 
 
-static SCM 
-ra2l (SCM ra, unsigned long base, unsigned long k)
-{
-  SCM res = SCM_EOL;
-  long inc;
-  size_t i;
-  
-  if (k == SCM_I_ARRAY_NDIM (ra))
-    return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (ra), base);
-
-  inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
-  if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
-    return SCM_EOL;
-  i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * inc;
-  do
-    {
-      i -= inc;
-      res = scm_cons (ra2l (ra, i, k + 1), res);
-    }
-  while (i != base);
-  return res;
-}
-
-
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
-           (SCM v),
-	    "Return a list consisting of all the elements, in order, of\n"
-	    "@var{array}.")
-#define FUNC_NAME s_scm_array_to_list
-{
-  if (scm_is_generalized_vector (v))
-    return scm_generalized_vector_to_list (v);
-  else if (SCM_I_ARRAYP (v))
-    return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
-
-  scm_wrong_type_arg_msg (NULL, 0, v, "array");
-}
-#undef FUNC_NAME
-
-
 static void l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k);
 
 SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
@@ -1410,19 +1172,6 @@ scm_i_read_array (SCM port, int c)
   return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
 }
 
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
-           (SCM ra),
-	    "")
-#define FUNC_NAME s_scm_array_type
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_generalized_vector_type (ra);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
 
 static SCM
 array_mark (SCM ptr)

libguile/arrays.h

@@ -1,7 +1,7 @@
 /* classes: h_files */
 
-#ifndef SCM_UNIF_H
+#ifndef SCM_ARRAY_H
-#define SCM_UNIF_H
+#define SCM_ARRAY_H
 
 /* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
@@ -25,47 +25,33 @@
 
 #include "libguile/__scm.h"
 #include "libguile/print.h"
-#include "libguile/array-handle.h"
 
 
 
-/* This file contains the definitions for arrays and bit vectors.
+/* Multidimensional arrays. Woo hoo!
-   Uniform numeric vectors are now in srfi-4.c.
+   Also see ....
-*/
+ */
 
 
 /** Arrays */
 
-SCM_API SCM scm_array_p (SCM v);
-SCM_API SCM scm_typed_array_p (SCM v, SCM type);
 SCM_API SCM scm_make_array (SCM fill, SCM bounds);
 SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
 SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
                                              const void *bytes,
                                              size_t byte_len);
-SCM_API SCM scm_array_rank (SCM ra);
-SCM_API size_t scm_c_array_rank (SCM ra);
-SCM_API SCM scm_array_dimensions (SCM ra);
 SCM_API SCM scm_shared_array_root (SCM ra);
 SCM_API SCM scm_shared_array_offset (SCM ra);
 SCM_API SCM scm_shared_array_increments (SCM ra);
 SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
 SCM_API SCM scm_transpose_array (SCM ra, SCM args);
-SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
-SCM_API SCM scm_array_ref (SCM v, SCM args);
-SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
 SCM_API SCM scm_array_contents (SCM ra, SCM strict);
 SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
 				      SCM start, SCM end);
 SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
 				     SCM start, SCM end);
-SCM_API SCM scm_array_to_list (SCM v);
 SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
 SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
-SCM_API SCM scm_array_type (SCM ra);
-
-SCM_API int scm_is_array (SCM obj);
-SCM_API int scm_is_typed_array (SCM obj, SCM type);
 
 SCM_API SCM scm_ra2contig (SCM ra, int copy);
 
@@ -96,7 +82,7 @@ SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
 
 SCM_INTERNAL void scm_init_arrays (void);
 
-#endif  /* SCM_UNIF_H */
+#endif  /* SCM_ARRAYS_H */
 
 /*
   Local Variables:

libguile/deprecated.c

@@ -34,6 +34,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"

libguile/generalized-arrays.c

@@ -0,0 +1,276 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+
+
+int
+scm_is_array (SCM obj)
+{
+  return scm_i_array_implementation_for_obj (obj) ? 1 : 0;
+}
+
+SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
+           (SCM obj),
+	    "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
+	    "not.")
+#define FUNC_NAME s_scm_array_p
+{
+  return scm_from_bool (scm_is_array (obj));
+}
+#undef FUNC_NAME
+
+int
+scm_is_typed_array (SCM obj, SCM type)
+{
+  int ret = 0;
+  if (scm_i_array_implementation_for_obj (obj))
+    {
+      scm_t_array_handle h;
+
+      scm_array_get_handle (obj, &h);
+      ret = scm_is_eq (scm_array_handle_element_type (&h), type);
+      scm_array_handle_release (&h);
+    }
+
+  return ret;
+}
+
+SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
+           (SCM obj, SCM type),
+	    "Return @code{#t} if the @var{obj} is an array of type\n"
+	    "@var{type}, and @code{#f} if not.")
+#define FUNC_NAME s_scm_typed_array_p
+{
+  return scm_from_bool (scm_is_typed_array (obj, type));
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_array_rank (SCM array)
+{
+  scm_t_array_handle handle;
+  size_t res;
+
+  scm_array_get_handle (array, &handle);
+  res = scm_array_handle_rank (&handle);
+  scm_array_handle_release (&handle);
+  return res;
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
+           (SCM array),
+	    "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+  return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
+           (SCM ra),
+	    "@code{array-dimensions} is similar to @code{array-shape} but replaces\n"
+	    "elements with a @code{0} minimum with one greater than the maximum. So:\n"
+	    "@lisp\n"
+	    "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_array_dimensions
+{
+  scm_t_array_handle handle;
+  scm_t_array_dim *s;
+  SCM res = SCM_EOL;
+  size_t k;
+      
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  k = scm_array_handle_rank (&handle);
+
+  while (k--)
+    res = scm_cons (s[k].lbnd
+		    ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
+				 scm_from_ssize_t (s[k].ubnd),
+				 SCM_EOL)
+		    : scm_from_ssize_t (1 + s[k].ubnd),
+		    res);
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+/* HACK*/
+#include "libguile/bytevectors.h"
+
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
+           (SCM ra),
+	    "")
+#define FUNC_NAME s_scm_array_type
+{
+  scm_t_array_handle h;
+  SCM type;
+
+  /* a hack, until srfi-4 and bytevectors are reunited */
+  if (scm_is_bytevector (ra))
+    return scm_from_locale_symbol ("vu8");
+
+  scm_array_get_handle (ra, &h);
+  type = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  
+  return type;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
+           (SCM ra, SCM args),
+	    "Return @code{#t} if its arguments would be acceptable to\n"
+	    "@code{array-ref}.")
+#define FUNC_NAME s_scm_array_in_bounds_p
+{
+  SCM res = SCM_BOOL_T;
+  size_t k, ndim;
+  scm_t_array_dim *s;
+  scm_t_array_handle handle;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  ndim = scm_array_handle_rank (&handle);
+
+  for (k = 0; k < ndim; k++)
+    {
+      long ind;
+
+      if (!scm_is_pair (args))
+        SCM_WRONG_NUM_ARGS ();
+      ind = scm_to_long (SCM_CAR (args));
+      args = SCM_CDR (args);
+
+      if (ind < s[k].lbnd || ind > s[k].ubnd)
+        {
+          res = SCM_BOOL_F;
+          /* We do not stop the checking after finding a violation
+             since we want to validate the type-correctness and
+             number of arguments in any case.
+          */
+        }
+    }
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
+           (SCM v, SCM args),
+	    "Return the element at the @code{(index1, index2)} element in\n"
+	    "@var{array}.")
+#define FUNC_NAME s_scm_array_ref
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (v, &handle);
+  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
+           (SCM v, SCM obj, SCM args),
+	    "Set the element at the @code{(index1, index2)} element in @var{array} to\n"
+	    "@var{new-value}.  The value returned by array-set! is unspecified.")
+#define FUNC_NAME s_scm_array_set_x           
+{
+  scm_t_array_handle handle;
+
+  scm_array_get_handle (v, &handle);
+  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
+  scm_array_handle_release (&handle);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM 
+array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos)
+{
+  if (dim == scm_array_handle_rank (h))
+    return scm_array_handle_ref (h, pos);
+  else
+    {
+      SCM res = SCM_EOL;
+      long inc;
+      size_t i, lbnd;
+
+      i = h->dims[dim].ubnd;
+      lbnd = h->dims[dim].lbnd;
+      inc = h->dims[dim].inc;
+      pos += (i - h->dims[dim].ubnd) * inc;
+
+      for (; i >= lbnd; i--, pos -= inc)
+        res = scm_cons (array_to_list (h, dim + 1, pos), res);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
+            (SCM array),
+	    "FIXME description a list consisting of all the elements, in order, of\n"
+	    "@var{array}.")
+#define FUNC_NAME s_scm_array_to_list
+{
+  scm_t_array_handle h;
+  SCM res;  
+  
+  scm_array_get_handle (array, &h);
+  res = array_to_list (&h, 0, 0);
+  scm_array_handle_release (&h);
+
+  return res;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_arrays ()
+{
+#include "libguile/generalized-arrays.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/generalized-arrays.h

@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_ARRAYS_H
+#define SCM_GENERALIZED_ARRAYS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* These functions operate on all kinds of arrays that Guile knows about.
+ */
+
+
+/** Arrays */
+
+SCM_API int scm_is_array (SCM obj);
+SCM_API SCM scm_array_p (SCM v);
+
+SCM_API int scm_is_typed_array (SCM obj, SCM type);
+SCM_API SCM scm_typed_array_p (SCM v, SCM type);
+
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
+SCM_API SCM scm_array_dimensions (SCM ra);
+SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
+
+SCM_API SCM scm_array_ref (SCM v, SCM args);
+SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
+SCM_API SCM scm_array_to_list (SCM v);
+
+SCM_INTERNAL void scm_init_generalized_arrays (void);
+
+
+#endif  /* SCM_GENERALIZED_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/init.c

@@ -63,6 +63,7 @@
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
@@ -542,6 +543,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_debug ();	/* Requires macro smobs */
   scm_init_random ();
   scm_init_array_handle ();
+  scm_init_generalized_arrays ();
   scm_init_bitvectors ();
   scm_init_array_map ();
   scm_init_arrays ();