mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00
Code Activity

Array-map refactors

Browse source 
* libguile/array-map.c (scm_ra_matchp): Refactor logic a bit.
  (array_index_map_1, array_index_map_n)
  (scm_array_index_map_x): Internally refactor array-index-map! to use
  separate implementations for rank 1 versus rank >1 arrays.
This commit is contained in:
Andy Wingo 2014-02-06 11:43:39 +01:00
parent 16259ae3dc
commit f0521cdabc
1 changed files with 75 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

96
libguile/array-map.c
View file

@ -92,20 +92,20 @@ scm_ra_matchp (SCM ra0, SCM ras)
int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
if (!scm_is_array (ra0))
return 0;
else if (!SCM_I_ARRAYP (ra0))
if (SCM_I_ARRAYP (ra0))
{
ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_I_ARRAY_BASE (ra0);
}
else if (scm_is_array (ra0))
{
s0->lbnd = 0;
s0->inc = 1;
s0->ubnd = scm_c_array_length (ra0) - 1;
}
else
{
ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_I_ARRAY_BASE (ra0);
}
return 0;
while (scm_is_pair (ras))
{
@ -778,48 +778,26 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
}
#undef FUNC_NAME
SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
(SCM ra, SCM proc),
"Apply @var{proc} to the indices of each element of @var{ra} in\n"
"turn, storing the result in the corresponding element. The value\n"
"returned and the order of application are unspecified.\n\n"
"One can implement @var{array-indexes} as\n"
"@lisp\n"
"(define (array-indexes array)\n"
" (let ((ra (apply make-array #f (array-shape array))))\n"
" (array-index-map! ra (lambda x x))\n"
" ra))\n"
"@end lisp\n"
"Another example:\n"
"@lisp\n"
"(define (apl:index-generator n)\n"
" (let ((v (make-uniform-vector n 1)))\n"
" (array-index-map! v (lambda (i) i))\n"
" v))\n"
"@end lisp")
#define FUNC_NAME s_scm_array_index_map_x
static SCM
array_index_map_1 (SCM ra, SCM proc)
{
unsigned long i;
SCM_VALIDATE_PROC (2, proc);
if (!scm_is_array (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
else if (!SCM_I_ARRAYP (ra))
{
size_t length = scm_c_array_length (ra);
for (i = 0; i < length; ++i)
ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED;
}
else
{
}
/* Here we assume that the array is a scm_tc7_array, as that is the only
kind of array in Guile that supports rank > 1. */
static SCM
array_index_map_n (SCM ra, SCM proc)
{
SCM args = SCM_EOL;
int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
unsigned long i;
long *vinds;
if (kmax < 0)
return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra),
indices_gc_hint);
@ -854,7 +832,45 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
while (k >= 0);
return SCM_UNSPECIFIED;
}
SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
(SCM ra, SCM proc),
"Apply @var{proc} to the indices of each element of @var{ra} in\n"
"turn, storing the result in the corresponding element. The value\n"
"returned and the order of application are unspecified.\n\n"
"One can implement @var{array-indexes} as\n"
"@lisp\n"
"(define (array-indexes array)\n"
" (let ((ra (apply make-array #f (array-shape array))))\n"
" (array-index-map! ra (lambda x x))\n"
" ra))\n"
"@end lisp\n"
"Another example:\n"
"@lisp\n"
"(define (apl:index-generator n)\n"
" (let ((v (make-uniform-vector n 1)))\n"
" (array-index-map! v (lambda (i) i))\n"
" v))\n"
"@end lisp")
#define FUNC_NAME s_scm_array_index_map_x
{
SCM_VALIDATE_PROC (2, proc);
switch (scm_c_array_rank (ra))
{
case 0:
scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
break;
case 1:
array_index_map_1 (ra, proc);
break;
default:
array_index_map_n (ra, proc);
break;
}
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME