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

Inline ASET in array-index-map! for rank 1 arguments

Browse source 
* libguile/array-map.c: (scm_array_index_map_x): branch to special case on
    rank 1, instead of !SCM_I_ARRAYP (ra). Inline ASET in this case.
This commit is contained in:
Daniel Llorens 2013-04-22 09:02:32 +02:00 • committed by Andy Wingo
parent b713626073
commit 1c22510af4
1 changed files with 14 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/array-map.c
View file

@ -793,20 +793,27 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_array_index_map_x #define FUNC_NAME s_scm_array_index_map_x
{ {
unsigned long i;
SCM_VALIDATE_PROC (2, proc); SCM_VALIDATE_PROC (2, proc);
if (!scm_is_array (ra)) if (!scm_is_array (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
else if (!SCM_I_ARRAYP (ra)) /* This also covers the not-SCM_I_ARRAYP case */
else if (1 == scm_c_array_rank(ra))
{ {
size_t length = scm_c_array_length (ra); scm_t_array_handle h;
for (i = 0; i < length; ++i) ssize_t i, inc;
ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i))); size_t p;
return SCM_UNSPECIFIED; SCM v;
scm_array_get_handle (ra, &h);
v = h.array;
inc = h.dims[0].inc;
for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc)
h.impl->vset (v, p, scm_call_1 (proc, scm_from_ulong (i)));
scm_array_handle_release (&h);
} }
else else
{ {
size_t i;
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;
long *vinds; long *vinds;
@ -851,9 +858,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
} }
} }
while (k >= 0); while (k >= 0);
return SCM_UNSPECIFIED;
} }
return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME