mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +02:00
Move array-map / array-cell functions to Scheme module
* libguile/array-map.c: * libguile/array-map.h: Remove. * module/ice-9/deprecated.scm: * libguile/deprecated.h: * libguile/deprecated.c: Add deprecation shims. * module/ice-9/arrays.scm: Move all array-map functionality here. * libguile/Makefile.am: * libguile/init.c: * libguile.h: Remove array-map.h use. * libguile/arrays.c (scm_i_array_equal_p, scm_i_array_copy): New helpers. (scm_array_cell_ref, scm_array_cell_set_x): Move to Scheme. * libguile/arrays.h: * libguile/eq.c (scm_equal_p): * libguile/sort.c (scm_sort): Use new arrays.c helpers. * module/ice-9/pretty-print.scm: * module/oop/goops/save.scm: Import (ice-9 arrays).
This commit is contained in:
Andy Wingo
parent
0134abce74
commit
12e8772403
17 changed files with 867 additions and 1097 deletions
|
|
@ -28,7 +28,6 @@
|
|||
#include <errno.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "array-map.h"
|
||||
#include "bitvectors.h"
|
||||
#include "boolean.h"
|
||||
#include "chars.h"
|
||||
|
|
@ -49,7 +48,9 @@
|
|||
#include "srfi-13.h"
|
||||
#include "srfi-4.h"
|
||||
#include "strings.h"
|
||||
#include "threads.h"
|
||||
#include "uniform.h"
|
||||
#include "variable.h"
|
||||
#include "vectors.h"
|
||||
|
||||
#include "arrays.h"
|
||||
|
|
@ -785,109 +786,6 @@ SCM_DEFINE (scm_array_slice, "array-slice", 1, 0, 1,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_array_cell_ref, "array-cell-ref", 1, 0, 1,
|
||||
(SCM ra, SCM indices),
|
||||
"Return the element at the @code{(@var{indices} ...)} position\n"
|
||||
"in array @var{ra}, or the array slice @var{ra}[@var{indices} ..., ...]\n"
|
||||
"if the rank of @var{ra} is larger than the number of indices.\n\n"
|
||||
"See also @code{array-ref}, @code{array-slice}, @code{array-cell-set!}.\n\n"
|
||||
"@code{array-cell-ref} never returns a rank 0 array. For example:\n"
|
||||
"@lisp\n"
|
||||
"(array-cell-ref #2((1 2 3) (4 5 6)) 1 1) @result{} 5\n"
|
||||
"(array-cell-ref #2((1 2 3) (4 5 6)) 1) @result{} #(4 5 6)\n"
|
||||
"(array-cell-ref #2((1 2 3) (4 5 6))) @result{} #2((1 2 3) (4 5 6))\n"
|
||||
"(array-cell-ref #0(5) @result{} 5.\n"
|
||||
"@end lisp")
|
||||
#define FUNC_NAME s_scm_array_cell_ref
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
scm_array_get_handle (ra, &handle);
|
||||
SCM i = indices;
|
||||
size_t k;
|
||||
ssize_t pos = 0;
|
||||
scm_t_array_dim *s;
|
||||
array_from_pos (&handle, &k, &i, &pos, &s);
|
||||
if (!s)
|
||||
{
|
||||
scm_array_handle_release (&handle);
|
||||
scm_misc_error (FUNC_NAME, "indices ~a out of range for array bounds ~a", scm_list_2 (indices, scm_array_dimensions (ra)));
|
||||
}
|
||||
SCM o;
|
||||
if (k>0)
|
||||
array_from_get_o (&handle, k, s, pos, &o);
|
||||
else if (scm_is_null(i))
|
||||
o = scm_array_handle_ref (&handle, pos);
|
||||
else
|
||||
{
|
||||
scm_array_handle_release (&handle);
|
||||
scm_misc_error (FUNC_NAME, "too many indices ~a for rank ~a", scm_list_2 (indices, scm_array_rank (ra)));
|
||||
}
|
||||
scm_array_handle_release (&handle);
|
||||
return o;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_array_cell_set_x, "array-cell-set!", 2, 0, 1,
|
||||
(SCM ra, SCM b, SCM indices),
|
||||
"Set the array slice @var{ra}[@var{indices} ..., ...] to @var{b}\n."
|
||||
"Equivalent to @code{(array-copy! @var{b} (apply array-cell-ref @var{ra} @var{indices}))}\n"
|
||||
"if the number of indices is smaller than the rank of @var{ra}; otherwise\n"
|
||||
"equivalent to @code{(apply array-set! @var{ra} @var{b} @var{indices})}.\n"
|
||||
"This function returns the modified array @var{ra}.\n\n"
|
||||
"See also @code{array-ref}, @code{array-cell-ref}, @code{array-slice}.\n\n"
|
||||
"For example:\n"
|
||||
"@lisp\n"
|
||||
"(define A (list->array 2 '((1 2 3) (4 5 6))))\n"
|
||||
"(array-cell-set! A #0(99) 1 1) @result{} #2((1 2 3) (4 #0(99) 6))\n"
|
||||
"(array-cell-set! A 99 1 1) @result{} #2((1 2 3) (4 99 6))\n"
|
||||
"(array-cell-set! A #(a b c) 0) @result{} #2((a b c) (4 99 6))\n"
|
||||
"(array-cell-set! A #2((x y z) (9 8 7))) @result{} #2((x y z) (9 8 7))\n\n"
|
||||
"(define B (make-array 0))\n"
|
||||
"(array-cell-set! B 15) @result{} #0(15)\n"
|
||||
"@end lisp")
|
||||
#define FUNC_NAME s_scm_array_cell_set_x
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
scm_array_get_handle (ra, &handle);
|
||||
SCM i = indices;
|
||||
size_t k;
|
||||
ssize_t pos = 0;
|
||||
scm_t_array_dim *s;
|
||||
array_from_pos (&handle, &k, &i, &pos, &s);
|
||||
if (!s)
|
||||
{
|
||||
scm_array_handle_release (&handle);
|
||||
scm_misc_error (FUNC_NAME, "indices ~a out of range for array bounds ~a", scm_list_2 (indices, scm_array_dimensions (ra)));
|
||||
}
|
||||
if (k>0)
|
||||
{
|
||||
SCM o;
|
||||
array_from_get_o(&handle, k, s, pos, &o);
|
||||
scm_array_handle_release(&handle);
|
||||
/* an error is still possible here if o and b don't match. */
|
||||
/* FIXME copying like this wastes the handle, and the bounds matching
|
||||
behavior of array-copy! is not strict. */
|
||||
scm_array_copy_x(b, o);
|
||||
}
|
||||
else if (scm_is_null(i))
|
||||
{
|
||||
scm_array_handle_set (&handle, pos, b); /* ra may be non-ARRAYP */
|
||||
scm_array_handle_release (&handle);
|
||||
}
|
||||
else
|
||||
{
|
||||
scm_array_handle_release (&handle);
|
||||
scm_misc_error (FUNC_NAME, "too many indices ~a for rank ~a", scm_list_2 (indices, scm_array_rank (ra)));
|
||||
}
|
||||
return ra;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
#undef ARRAY_FROM_GET_O
|
||||
|
||||
|
||||
/* args are RA . DIMS */
|
||||
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
||||
(SCM ra, SCM args),
|
||||
|
|
@ -1235,6 +1133,37 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
|
|||
return d;
|
||||
}
|
||||
|
||||
static SCM array_equal_p_var;
|
||||
static SCM array_copy_var;
|
||||
|
||||
static void
|
||||
init_array_map_vars (void)
|
||||
{
|
||||
array_equal_p_var = scm_c_public_lookup ("ice-9 arrays", "array-equal?");
|
||||
array_copy_var = scm_c_public_lookup ("ice-9 arrays", "array-copy");
|
||||
}
|
||||
|
||||
static void
|
||||
init_array_map_functions (void)
|
||||
{
|
||||
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
|
||||
scm_i_pthread_once (&once, init_array_map_vars);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_i_array_equal_p (SCM ra0, SCM ra1)
|
||||
{
|
||||
init_array_map_functions ();
|
||||
return scm_call_2 (scm_variable_ref (array_equal_p_var), ra0, ra1);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_i_array_copy (SCM ra)
|
||||
{
|
||||
init_array_map_functions ();
|
||||
return scm_call_1 (scm_variable_ref (array_copy_var), ra);
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_arrays ()
|
||||
{
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue