summaryrefslogtreecommitdiff
path: root/libguile/generalized-arrays.c
diff options
context:
space:
mode:
authorDaniel Llorens <lloda@sarc.name>2021-08-03 14:19:18 +0200
committerDaniel Llorens <lloda@sarc.name>2021-08-03 14:21:41 +0200
commitbc7bd22267903fcaab945fa6e4c03318f9fc664b (patch)
tree27eaf18624c0959fb7487f0073951b157ec9e835 /libguile/generalized-arrays.c
parentc78c130b1ddef6d6c290533f74ce1fbd51a4b19d (diff)
downloadguile-bc7bd22267903fcaab945fa6e4c03318f9fc664b.tar.gz
Merge libguile/generalized-arrays.* into libguile/arrays.*
* libguile/arrays.h: * libguile/arrays.c: As stated. * libguile/init.c: Remove call to scm_init_generalized_arrays(). Elsewhere fix references to generalized-arrays.*.
Diffstat (limited to 'libguile/generalized-arrays.c')
-rw-r--r--libguile/generalized-arrays.c410
1 files changed, 0 insertions, 410 deletions
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
deleted file mode 100644
index 28ca6b3c7..000000000
--- a/libguile/generalized-arrays.c
+++ /dev/null
@@ -1,410 +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_2, "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_2
-{
- return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-/* The array type predicate, with an extra argument kept for backward
- compatibility. Note that we can't use `SCM_DEFINE' directly because there
- would be an argument count mismatch that would be caught by
- `snarf-check-and-output-texi.scm'. */
-SCM
-scm_array_p (SCM obj, SCM unused)
-{
- return scm_array_p_2 (obj);
-}
-
-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"
-}