mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +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

92
libguile/array-map.c
View file

@ -92,20 +92,20 @@ scm_ra_matchp (SCM ra0, SCM ras)
int i, ndim = 1; int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */ int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
if (!scm_is_array (ra0)) if (SCM_I_ARRAYP (ra0))
return 0; {
else 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->lbnd = 0;
s0->inc = 1; s0->inc = 1;
s0->ubnd = scm_c_array_length (ra0) - 1; s0->ubnd = scm_c_array_length (ra0) - 1;
} }
else else
{ return 0;
ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_I_ARRAY_BASE (ra0);
}
while (scm_is_pair (ras)) while (scm_is_pair (ras))
{ {
@ -778,48 +778,26 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, static SCM
(SCM ra, SCM proc), array_index_map_1 (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
{ {
unsigned long i; 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); size_t length = scm_c_array_length (ra);
for (i = 0; i < length; ++i) for (i = 0; i < length; ++i)
ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i))); ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED; 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; SCM args = SCM_EOL;
int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1; int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
unsigned long i;
long *vinds; 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), vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra),
indices_gc_hint); indices_gc_hint);
@ -855,6 +833,44 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
return SCM_UNSPECIFIED; 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 #undef FUNC_NAME