mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Merge libguile/generalized-arrays.* into libguile/arrays.*

Browse source 
* libguile/arrays.h:
* libguile/arrays.c: As stated.
* libguile/init.c: Remove call to scm_init_generalized_arrays().

Elsewhere fix references to generalized-arrays.*.
This commit is contained in:
Daniel Llorens 2021-08-03 14:19:18 +02:00
parent c78c130b1d
commit bc7bd22267
11 changed files with 614 additions and 714 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile.h
View file

@ -58,7 +58,6 @@ extern "C" {
#include "libguile/fports.h" #include "libguile/fports.h"
#include "libguile/frames.h" #include "libguile/frames.h"
#include "libguile/gc.h" #include "libguile/gc.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h" #include "libguile/generalized-vectors.h"
#include "libguile/goops.h" #include "libguile/goops.h"
#include "libguile/gsubr.h" #include "libguile/gsubr.h"

4
libguile/Makefile.am
View file

@ -163,7 +163,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
gc-malloc.c \ gc-malloc.c \
gc.c \ gc.c \
gettext.c \ gettext.c \
generalized-arrays.c \
generalized-vectors.c \ generalized-vectors.c \
goops.c \ goops.c \
gsubr.c \ gsubr.c \
@ -281,7 +280,6 @@ DOT_X_FILES = \
gc-malloc.x \ gc-malloc.x \
gc.x \ gc.x \
gettext.x \ gettext.x \
generalized-arrays.x \
generalized-vectors.x \ generalized-vectors.x \
goops.x \ goops.x \
gsubr.x \ gsubr.x \
@ -388,7 +386,6 @@ DOT_DOC_FILES = \
gc-malloc.doc \ gc-malloc.doc \
gc.doc \ gc.doc \
gettext.doc \ gettext.doc \
generalized-arrays.doc \
generalized-vectors.doc \ generalized-vectors.doc \
goops.doc \ goops.doc \
gsubr.doc \ gsubr.doc \
@ -636,7 +633,6 @@ modinclude_HEADERS = \
gc.h \ gc.h \
gc-inline.h \ gc-inline.h \
gettext.h \ gettext.h \
generalized-arrays.h \
generalized-vectors.h \ generalized-vectors.h \
goops.h \ goops.h \
gsubr.h \ gsubr.h \

1
libguile/array-map.c
View file

@ -36,7 +36,6 @@
#include "eq.h" #include "eq.h"
#include "eval.h" #include "eval.h"
#include "feature.h" #include "feature.h"
#include "generalized-arrays.h"
#include "gsubr.h" #include "gsubr.h"
#include "list.h" #include "list.h"
#include "numbers.h" #include "numbers.h"

800
libguile/arrays.c
View file

File diff suppressed because it is too large Load diff

33
libguile/arrays.h
View file

@ -22,8 +22,8 @@
#include "libguile/gc.h"
#include "libguile/print.h" #include "libguile/print.h"
#include "libguile/array-handle.h"
@ -31,6 +31,12 @@
Also see .... Also see ....
*/ */
#define SCM_VALIDATE_ARRAY(pos, v) \
do { \
SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
&& scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
v, pos, FUNC_NAME); \
} while (0)
/** Arrays */ /** Arrays */
@ -57,6 +63,31 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
SCM_API size_t scm_c_array_rank (SCM ra); SCM_API size_t scm_c_array_rank (SCM ra);
SCM_API SCM scm_array_rank (SCM ra); SCM_API SCM scm_array_rank (SCM ra);
SCM_API int scm_is_array (SCM obj);
SCM_API SCM scm_array_p (SCM v, SCM unused);
SCM_INTERNAL SCM scm_array_p_2 (SCM);
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);
/* internal. */ /* internal. */
/* see scm_from_contiguous_array for these three */ /* see scm_from_contiguous_array for these three */

2
libguile/eq.c
View file

@ -32,7 +32,7 @@
#include "bytevectors.h" #include "bytevectors.h"
#include "eval.h" #include "eval.h"
#include "foreign.h" #include "foreign.h"
#include "generalized-arrays.h" #include "arrays.h"
#include "goops.h" #include "goops.h"
#include "gsubr.h" #include "gsubr.h"
#include "hashtab.h" #include "hashtab.h"

410
libguile/generalized-arrays.c
View file

@ -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"
}

73
libguile/generalized-arrays.h
View file

@ -1,73 +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, SCM_UNDEFINED)), \
v, pos, FUNC_NAME); \
} while (0)
/** Arrays */
SCM_API int scm_is_array (SCM obj);
SCM_API SCM scm_array_p (SCM v, SCM unused);
SCM_INTERNAL SCM scm_array_p_2 (SCM);
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 */

2
libguile/init.c
View file

@ -77,7 +77,6 @@
#include "fports.h" #include "fports.h"
#include "frames.h" #include "frames.h"
#include "gc.h" #include "gc.h"
#include "generalized-arrays.h"
#include "generalized-vectors.h" #include "generalized-vectors.h"
#include "gettext.h" #include "gettext.h"
#include "goops.h" #include "goops.h"
@ -446,7 +445,6 @@ scm_i_init_guile (void *base)
scm_init_srcprop (); /* requires smob_prehistory */ scm_init_srcprop (); /* requires smob_prehistory */
scm_init_stackchk (); scm_init_stackchk ();
scm_init_generalized_arrays ();
scm_init_generalized_vectors (); scm_init_generalized_vectors ();
scm_init_vectors (); /* Requires array-handle, */ scm_init_vectors (); /* Requires array-handle, */
scm_init_uniform (); scm_init_uniform ();

1
libguile/random.c
View file

@ -39,7 +39,6 @@
#include "arrays.h" #include "arrays.h"
#include "feature.h" #include "feature.h"
#include "generalized-arrays.h"
#include "generalized-vectors.h" #include "generalized-vectors.h"
#include "gsubr.h" #include "gsubr.h"
#include "list.h" #include "list.h"

1
libguile/sort.c
View file

@ -46,7 +46,6 @@
#include "dynwind.h" #include "dynwind.h"
#include "eval.h" #include "eval.h"
#include "feature.h" #include "feature.h"
#include "generalized-arrays.h"
#include "gsubr.h" #include "gsubr.h"
#include "list.h" #include "list.h"
#include "pairs.h" #include "pairs.h"