lloda pushed a commit to branch wip-vector-cleanup
in repository guile.
commit 114f331a656cf0085560990886a1869a7dbd35a5
Author: Daniel Llorens <ll...@sarc.name>
AuthorDate: Thu Feb 6 17:16:07 2020 +0100
Merge generalized-arrays.[ch] in arrays.[ch]
The split was just confusing.
---
NEWS-wip-vector-cleanup.txt | 4 +-
libguile.h | 1 -
libguile/Makefile.am | 4 -
libguile/array-handle.h | 2 +-
libguile/array-map.c | 2 -
libguile/arrays.c | 361 ++++++++++++++++++++++++++++++++++++-
libguile/arrays.h | 31 ++++
libguile/eq.c | 2 +-
libguile/generalized-arrays.c | 401 ------------------------------------------
libguile/generalized-arrays.h | 72 --------
libguile/init.c | 2 -
libguile/random.c | 1 -
libguile/sort.c | 2 +-
13 files changed, 395 insertions(+), 490 deletions(-)
diff --git a/NEWS-wip-vector-cleanup.txt b/NEWS-wip-vector-cleanup.txt
index 7e382e8..84b5c7a 100644
--- a/NEWS-wip-vector-cleanup.txt
+++ b/NEWS-wip-vector-cleanup.txt
@@ -15,9 +15,9 @@ Use array->list and array-copy (from (ice-9 arrays)) on
general arrays.
Use scm_is_vector instead.
-** libguile/generalized-vectors.[hc] has been removed.
+** libguile/generalized-vectors.[hc] libguile/generalized-arrays.[hc] and have
been removed.
-If you were including libguile/generalized-vectors.h directly for any reason,
just include libguile.h instead.
+If you were including these headers directly for any reason, just include
libguile.h instead.
* Backward incompatible changes
diff --git a/libguile.h b/libguile.h
index 12d8100..7a2ff8f 100644
--- a/libguile.h
+++ b/libguile.h
@@ -61,7 +61,6 @@ extern "C" {
#include "libguile/fports.h"
#include "libguile/frames.h"
#include "libguile/gc.h"
-#include "libguile/generalized-arrays.h"
#include "libguile/goops.h"
#include "libguile/gsubr.h"
#include "libguile/guardians.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 8e933a2..e6cedaa 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -163,7 +163,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =
\
gc-malloc.c \
gc.c \
gettext.c \
- generalized-arrays.c \
goops.c \
gsubr.c \
guardians.c \
@@ -277,7 +276,6 @@ DOT_X_FILES = \
gc-malloc.x \
gc.x \
gettext.x \
- generalized-arrays.x \
goops.x \
gsubr.x \
guardians.x \
@@ -384,7 +382,6 @@ DOT_DOC_FILES = \
gc-malloc.doc \
gc.doc \
gettext.doc \
- generalized-arrays.doc \
goops.doc \
gsubr.doc \
guardians.doc \
@@ -631,7 +628,6 @@ modinclude_HEADERS = \
gc.h \
gc-inline.h \
gettext.h \
- generalized-arrays.h \
goops.h \
gsubr.h \
guardians.h \
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
index c2ff204..cb5c324 100644
--- a/libguile/array-handle.h
+++ b/libguile/array-handle.h
@@ -72,7 +72,7 @@ typedef struct scm_t_array_handle {
solution would be, well, nice.
*/
size_t base;
- size_t ndims; /* ndims == the rank of the array */
+ size_t ndims; /* the rank of the array */
scm_t_array_dim *dims;
scm_t_array_dim dim0;
scm_t_array_element_type element_type;
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 6460a24..34b2b63 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -30,13 +30,11 @@
#include <string.h>
#include "arrays.h"
-#include "bitvectors.h"
#include "boolean.h"
#include "chars.h"
#include "eq.h"
#include "eval.h"
#include "feature.h"
-#include "generalized-arrays.h"
#include "gsubr.h"
#include "list.h"
#include "numbers.h"
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 0531f14..26e2fab 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -38,7 +38,6 @@
#include "eval.h"
#include "feature.h"
#include "fports.h"
-#include "generalized-arrays.h"
#include "gsubr.h"
#include "list.h"
#include "modules.h"
@@ -100,7 +99,365 @@ SCM_DEFINE (scm_make_generalized_vector,
"make-generalized-vector", 2, 1, 0,
/* ------------------- */
/* Basic array library */
-/* ------------------- */
+/* ------------------- */
+
+SCM_INTERNAL SCM scm_i_array_ref (SCM v,
+ SCM idx0, SCM idx1, SCM idxN);
+SCM_INTERNAL SCM scm_i_array_set_x (SCM v, SCM obj,
+ SCM idx0, SCM idx1, SCM idxN);
+
+
+int
+scm_is_array (SCM 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, "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_is_array (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_length (SCM array)
+{
+ scm_t_array_handle handle;
+ size_t res;
+
+ scm_array_get_handle (array, &handle);
+ if (scm_array_handle_rank (&handle) < 1)
+ {
+ scm_array_handle_release (&handle);
+ scm_wrong_type_arg_msg (NULL, 0, array, "array of nonzero rank");
+ }
+ res = handle.dims[0].ubnd - handle.dims[0].lbnd + 1;
+ scm_array_handle_release (&handle);
+
+ return res;
+}
+
+SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
+ (SCM array),
+ "Return the length of an array: its first dimension.\n"
+ "It is an error to ask for the length of an array of rank 0.")
+#define FUNC_NAME s_scm_array_length
+{
+ return scm_from_size_t (scm_c_array_length (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_array_type, "array-type", 1, 0, 0,
+ (SCM ra),
+ "")
+#define FUNC_NAME s_scm_array_type
+{
+ scm_t_array_handle h;
+ SCM type;
+
+ 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_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"
+ "@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
+scm_c_array_ref_1 (SCM array, ssize_t idx0)
+{
+ scm_t_array_handle handle;
+ SCM res;
+
+ scm_array_get_handle (array, &handle);
+ res = scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, idx0));
+ scm_array_handle_release (&handle);
+ return res;
+}
+
+
+SCM
+scm_c_array_ref_2 (SCM array, ssize_t idx0, ssize_t idx1)
+{
+ scm_t_array_handle handle;
+ SCM res;
+
+ scm_array_get_handle (array, &handle);
+ res = scm_array_handle_ref (&handle, scm_array_handle_pos_2 (&handle, idx0,
idx1));
+ scm_array_handle_release (&handle);
+ return res;
+}
+
+
+SCM
+scm_array_ref (SCM v, SCM args)
+{
+ 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;
+}
+
+
+void
+scm_c_array_set_1_x (SCM array, SCM obj, ssize_t idx0)
+{
+ scm_t_array_handle handle;
+
+ scm_array_get_handle (array, &handle);
+ scm_array_handle_set (&handle, scm_array_handle_pos_1 (&handle, idx0),
+ obj);
+ scm_array_handle_release (&handle);
+}
+
+
+void
+scm_c_array_set_2_x (SCM array, SCM obj, ssize_t idx0, ssize_t idx1)
+{
+ scm_t_array_handle handle;
+
+ scm_array_get_handle (array, &handle);
+ scm_array_handle_set (&handle, scm_array_handle_pos_2 (&handle, idx0, idx1),
+ obj);
+ scm_array_handle_release (&handle);
+}
+
+
+SCM
+scm_array_set_x (SCM v, SCM obj, SCM args)
+{
+ 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;
+}
+
+
+SCM_DEFINE (scm_i_array_ref, "array-ref", 1, 2, 1,
+ (SCM v, SCM idx0, SCM idx1, SCM idxN),
+ "Return the element at the @code{(idx0, idx1, idxN...)}\n"
+ "position in array @var{v}.")
+#define FUNC_NAME s_scm_i_array_ref
+{
+ if (SCM_UNBNDP (idx0))
+ return scm_array_ref (v, SCM_EOL);
+ else if (SCM_UNBNDP (idx1))
+ return scm_c_array_ref_1 (v, scm_to_ssize_t (idx0));
+ else if (scm_is_null (idxN))
+ return scm_c_array_ref_2 (v, scm_to_ssize_t (idx0), scm_to_ssize_t (idx1));
+ else
+ return scm_array_ref (v, scm_cons (idx0, scm_cons (idx1, idxN)));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_i_array_set_x, "array-set!", 2, 2, 1,
+ (SCM v, SCM obj, SCM idx0, SCM idx1, SCM idxN),
+ "Set the element at the @code{(idx0, idx1, idxN...)} position\n"
+ "in the array @var{v} to @var{obj}. The value returned by\n"
+ "@code{array-set!} is unspecified.")
+#define FUNC_NAME s_scm_i_array_set_x
+{
+ if (SCM_UNBNDP (idx0))
+ scm_array_set_x (v, obj, SCM_EOL);
+ else if (SCM_UNBNDP (idx1))
+ scm_c_array_set_1_x (v, obj, scm_to_ssize_t (idx0));
+ else if (scm_is_null (idxN))
+ scm_c_array_set_2_x (v, obj, scm_to_ssize_t (idx0), scm_to_ssize_t (idx1));
+ else
+ scm_array_set_x (v, obj, scm_cons (idx0, scm_cons (idx1, idxN)));
+
+ 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;
+
+ i = h->dims[dim].ubnd - h->dims[dim].lbnd + 1;
+ inc = h->dims[dim].inc;
+ pos += (i - 1) * inc;
+
+ for (; i > 0; 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),
+ "Return a list representation of @var{array}.\n\n"
+ "It is easiest to specify the behavior of this function by\n"
+ "example:\n"
+ "@example\n"
+ "(array->list #0(a)) @result{} 1\n"
+ "(array->list #1(a b)) @result{} (a b)\n"
+ "(array->list #2((aa ab) (ba bb)) @result{} ((aa ab) (ba bb))\n"
+ "@end example\n")
+#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
+
size_t
scm_c_array_rank (SCM array)
diff --git a/libguile/arrays.h b/libguile/arrays.h
index f96a019..dc8cf86 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -36,6 +36,37 @@ SCM_API SCM scm_make_generalized_vector (SCM type, SCM len,
SCM fill);
/** Arrays */
+#define SCM_VALIDATE_ARRAY(pos, v) \
+ do { \
+ SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
+ && scm_is_true (scm_array_p (v)), \
+ v, pos, FUNC_NAME); \
+ } while (0)
+
+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_length (SCM ra);
+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);
+SCM_API SCM scm_c_array_ref_2 (SCM v, ssize_t idx0, ssize_t idx1);
+
+SCM_API void scm_c_array_set_1_x (SCM v, SCM obj, ssize_t idx0);
+SCM_API void scm_c_array_set_2_x (SCM v, SCM obj, ssize_t idx0, ssize_t idx1);
+
+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_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,
diff --git a/libguile/eq.c b/libguile/eq.c
index 627d6f0..bf18cda 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -32,7 +32,7 @@
#include "bytevectors.h"
#include "eval.h"
#include "foreign.h"
-#include "generalized-arrays.h"
+#include "arrays.h"
#include "goops.h"
#include "gsubr.h"
#include "hashtab.h"
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
deleted file mode 100644
index a48012f..0000000
--- a/libguile/generalized-arrays.c
+++ /dev/null
@@ -1,401 +0,0 @@
-/* Copyright 1995-1998,2000-2006,2009-2010,2013-2014,2018
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile 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.
-
- Guile 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 Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <errno.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "array-handle.h"
-#include "gsubr.h"
-#include "list.h"
-#include "numbers.h"
-#include "pairs.h"
-
-#include "generalized-arrays.h"
-
-
-SCM_INTERNAL SCM scm_i_array_ref (SCM v,
- SCM idx0, SCM idx1, SCM idxN);
-SCM_INTERNAL SCM scm_i_array_set_x (SCM v, SCM obj,
- SCM idx0, SCM idx1, SCM idxN);
-
-
-int
-scm_is_array (SCM 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, "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_is_array (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_length (SCM array)
-{
- scm_t_array_handle handle;
- size_t res;
-
- scm_array_get_handle (array, &handle);
- if (scm_array_handle_rank (&handle) < 1)
- {
- scm_array_handle_release (&handle);
- scm_wrong_type_arg_msg (NULL, 0, array, "array of nonzero rank");
- }
- res = handle.dims[0].ubnd - handle.dims[0].lbnd + 1;
- scm_array_handle_release (&handle);
-
- return res;
-}
-
-SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
- (SCM array),
- "Return the length of an array: its first dimension.\n"
- "It is an error to ask for the length of an array of rank 0.")
-#define FUNC_NAME s_scm_array_length
-{
- return scm_from_size_t (scm_c_array_length (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_array_type, "array-type", 1, 0, 0,
- (SCM ra),
- "")
-#define FUNC_NAME s_scm_array_type
-{
- scm_t_array_handle h;
- SCM type;
-
- 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_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"
- "@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
-scm_c_array_ref_1 (SCM array, ssize_t idx0)
-{
- scm_t_array_handle handle;
- SCM res;
-
- scm_array_get_handle (array, &handle);
- res = scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, idx0));
- scm_array_handle_release (&handle);
- return res;
-}
-
-
-SCM
-scm_c_array_ref_2 (SCM array, ssize_t idx0, ssize_t idx1)
-{
- scm_t_array_handle handle;
- SCM res;
-
- scm_array_get_handle (array, &handle);
- res = scm_array_handle_ref (&handle, scm_array_handle_pos_2 (&handle, idx0,
idx1));
- scm_array_handle_release (&handle);
- return res;
-}
-
-
-SCM
-scm_array_ref (SCM v, SCM args)
-{
- 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;
-}
-
-
-void
-scm_c_array_set_1_x (SCM array, SCM obj, ssize_t idx0)
-{
- scm_t_array_handle handle;
-
- scm_array_get_handle (array, &handle);
- scm_array_handle_set (&handle, scm_array_handle_pos_1 (&handle, idx0),
- obj);
- scm_array_handle_release (&handle);
-}
-
-
-void
-scm_c_array_set_2_x (SCM array, SCM obj, ssize_t idx0, ssize_t idx1)
-{
- scm_t_array_handle handle;
-
- scm_array_get_handle (array, &handle);
- scm_array_handle_set (&handle, scm_array_handle_pos_2 (&handle, idx0, idx1),
- obj);
- scm_array_handle_release (&handle);
-}
-
-
-SCM
-scm_array_set_x (SCM v, SCM obj, SCM args)
-{
- 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;
-}
-
-
-SCM_DEFINE (scm_i_array_ref, "array-ref", 1, 2, 1,
- (SCM v, SCM idx0, SCM idx1, SCM idxN),
- "Return the element at the @code{(idx0, idx1, idxN...)}\n"
- "position in array @var{v}.")
-#define FUNC_NAME s_scm_i_array_ref
-{
- if (SCM_UNBNDP (idx0))
- return scm_array_ref (v, SCM_EOL);
- else if (SCM_UNBNDP (idx1))
- return scm_c_array_ref_1 (v, scm_to_ssize_t (idx0));
- else if (scm_is_null (idxN))
- return scm_c_array_ref_2 (v, scm_to_ssize_t (idx0), scm_to_ssize_t (idx1));
- else
- return scm_array_ref (v, scm_cons (idx0, scm_cons (idx1, idxN)));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_i_array_set_x, "array-set!", 2, 2, 1,
- (SCM v, SCM obj, SCM idx0, SCM idx1, SCM idxN),
- "Set the element at the @code{(idx0, idx1, idxN...)} position\n"
- "in the array @var{v} to @var{obj}. The value returned by\n"
- "@code{array-set!} is unspecified.")
-#define FUNC_NAME s_scm_i_array_set_x
-{
- if (SCM_UNBNDP (idx0))
- scm_array_set_x (v, obj, SCM_EOL);
- else if (SCM_UNBNDP (idx1))
- scm_c_array_set_1_x (v, obj, scm_to_ssize_t (idx0));
- else if (scm_is_null (idxN))
- scm_c_array_set_2_x (v, obj, scm_to_ssize_t (idx0), scm_to_ssize_t (idx1));
- else
- scm_array_set_x (v, obj, scm_cons (idx0, scm_cons (idx1, idxN)));
-
- 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;
-
- i = h->dims[dim].ubnd - h->dims[dim].lbnd + 1;
- inc = h->dims[dim].inc;
- pos += (i - 1) * inc;
-
- for (; i > 0; 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),
- "Return a list representation of @var{array}.\n\n"
- "It is easiest to specify the behavior of this function by\n"
- "example:\n"
- "@example\n"
- "(array->list #0(a)) @result{} 1\n"
- "(array->list #1(a b)) @result{} (a b)\n"
- "(array->list #2((aa ab) (ba bb)) @result{} ((aa ab) (ba bb))\n"
- "@end example\n")
-#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 "generalized-arrays.x"
-}
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
deleted file mode 100644
index 5e7e981..0000000
--- a/libguile/generalized-arrays.h
+++ /dev/null
@@ -1,72 +0,0 @@
-#ifndef SCM_GENERALIZED_ARRAYS_H
-#define SCM_GENERALIZED_ARRAYS_H
-
-/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2013-2014,2018
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile 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.
-
- Guile 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 Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-
-
-#include "libguile/array-handle.h"
-#include "libguile/boolean.h"
-#include <libguile/error.h>
-
-
-
-/* These functions operate on all kinds of arrays that Guile knows about.
- */
-
-
-#define SCM_VALIDATE_ARRAY(pos, v) \
- do { \
- SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
- && scm_is_true (scm_array_p (v)), \
- v, pos, FUNC_NAME); \
- } while (0)
-
-
-/** 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_length (SCM ra);
-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);
-SCM_API SCM scm_c_array_ref_2 (SCM v, ssize_t idx0, ssize_t idx1);
-
-SCM_API void scm_c_array_set_1_x (SCM v, SCM obj, ssize_t idx0);
-SCM_API void scm_c_array_set_2_x (SCM v, SCM obj, ssize_t idx0, ssize_t idx1);
-
-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 */
diff --git a/libguile/init.c b/libguile/init.c
index d248ba7..59038b2 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -71,7 +71,6 @@
#include "fports.h"
#include "frames.h"
#include "gc.h"
-#include "generalized-arrays.h"
#include "gettext.h"
#include "goops.h"
#include "gsubr.h"
@@ -440,7 +439,6 @@ scm_i_init_guile (void *base)
scm_init_srcprop (); /* requires smob_prehistory */
scm_init_stackchk ();
- scm_init_generalized_arrays ();
scm_init_vectors (); /* Requires array-handle, */
scm_init_uniform ();
scm_init_bitvectors (); /* Requires smob_prehistory, array-handle */
diff --git a/libguile/random.c b/libguile/random.c
index ed234f8..b8f6503 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -34,7 +34,6 @@
#include "arrays.h"
#include "feature.h"
-#include "generalized-arrays.h"
#include "gsubr.h"
#include "list.h"
#include "modules.h"
diff --git a/libguile/sort.c b/libguile/sort.c
index 090a621..b8ee9a3 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -40,13 +40,13 @@
#endif
#include "array-map.h"
+#include "array-handle.h"
#include "arrays.h"
#include "async.h"
#include "boolean.h"
#include "dynwind.h"
#include "eval.h"
#include "feature.h"
-#include "generalized-arrays.h"
#include "gsubr.h"
#include "list.h"
#include "pairs.h"
