1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

vref, vset members of scm_t_array_handle

* libguile/array-handle.h (scm_t_array_ref, scm_t_array_set): Rename
  from scm_i_t_array_ref, scm_i_t_array_set.
  (scm_t_array_handle): Copy vref and vset from impl to handle.
  (scm_array_handle_ref, scm_array_handle_set):

* libguile/array-map.c (racp, ramap, rafe, rafill, array_index_map_1):
* libguile/array-handle.c (scm_array_get_handle): Adapt.
This commit is contained in:
Andy Wingo 2014-02-08 21:02:48 +01:00
parent d747313100
commit 7070f12b9d
4 changed files with 23 additions and 19 deletions

View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005,
* 2006, 2009, 2011, 2013 Free Software Foundation, Inc. * 2006, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -74,6 +74,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
something... */ something... */
h->elements = NULL; h->elements = NULL;
h->writable_elements = NULL; h->writable_elements = NULL;
h->vref = h->impl->vref;
h->vset = h->impl->vset;
h->impl->get_handle (array, h); h->impl->get_handle (array, h);
} }

View file

@ -4,7 +4,7 @@
#define SCM_ARRAY_HANDLE_H #define SCM_ARRAY_HANDLE_H
/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2004, 2006, /* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2004, 2006,
* 2008, 2009, 2011, 2013 Free Software Foundation, Inc. * 2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -32,15 +32,15 @@
struct scm_t_array_handle; struct scm_t_array_handle;
typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t); typedef SCM (*scm_t_array_ref) (struct scm_t_array_handle *, size_t);
typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM); typedef void (*scm_t_array_set) (struct scm_t_array_handle *, size_t, SCM);
typedef struct typedef struct
{ {
scm_t_bits tag; scm_t_bits tag;
scm_t_bits mask; scm_t_bits mask;
scm_i_t_array_ref vref; scm_t_array_ref vref;
scm_i_t_array_set vset; scm_t_array_set vset;
void (*get_handle)(SCM, struct scm_t_array_handle*); void (*get_handle)(SCM, struct scm_t_array_handle*);
} scm_t_array_implementation; } scm_t_array_implementation;
@ -107,6 +107,8 @@ typedef struct scm_t_array_handle {
scm_t_array_element_type element_type; scm_t_array_element_type element_type;
const void *elements; const void *elements;
void *writable_elements; void *writable_elements;
scm_t_array_ref vref;
scm_t_array_set vset;
} scm_t_array_handle; } scm_t_array_handle;
#define scm_array_handle_rank(h) ((h)->ndims) #define scm_array_handle_rank(h) ((h)->ndims)
@ -135,7 +137,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
/* catch overflow */ /* catch overflow */
scm_out_of_range (NULL, scm_from_ssize_t (p)); scm_out_of_range (NULL, scm_from_ssize_t (p));
/* perhaps should catch overflow here too */ /* perhaps should catch overflow here too */
return h->impl->vref (h, h->base + p); return h->vref (h, h->base + p);
} }
SCM_INLINE_IMPLEMENTATION void SCM_INLINE_IMPLEMENTATION void
@ -145,7 +147,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
/* catch overflow */ /* catch overflow */
scm_out_of_range (NULL, scm_from_ssize_t (p)); scm_out_of_range (NULL, scm_from_ssize_t (p));
/* perhaps should catch overflow here too */ /* perhaps should catch overflow here too */
h->impl->vset (h, h->base + p, v); h->vset (h, h->base + p, v);
} }
#endif #endif

View file

@ -336,7 +336,7 @@ rafill (SCM dst, SCM fill)
inc = SCM_I_ARRAY_DIMS (dst)->inc; inc = SCM_I_ARRAY_DIMS (dst)->inc;
for (; n-- > 0; i += inc) for (; n-- > 0; i += inc)
h.impl->vset (&h, i, fill); h.vset (&h, i, fill);
scm_array_handle_release (&h); scm_array_handle_release (&h);
return 1; return 1;
@ -372,7 +372,7 @@ racp (SCM src, SCM dst)
inc_d = SCM_I_ARRAY_DIMS (dst)->inc; inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
for (; n-- > 0; i_s += inc_s, i_d += inc_d) for (; n-- > 0; i_s += inc_s, i_d += inc_d)
h_d.impl->vset (&h_d, i_d, h_s.impl->vref (&h_s, i_s)); h_d.vset (&h_d, i_d, h_s.vref (&h_s, i_s));
scm_array_handle_release (&h_d); scm_array_handle_release (&h_d);
scm_array_handle_release (&h_s); scm_array_handle_release (&h_s);
@ -674,7 +674,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
i0end = i0 + n*inc0; i0end = i0 + n*inc0;
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0) for (; i0 < i0end; i0 += inc0)
h0.impl->vset (&h0, i0, scm_call_0 (proc)); h0.vset (&h0, i0, scm_call_0 (proc));
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
@ -687,7 +687,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
ras = SCM_CDR (ras); ras = SCM_CDR (ras);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0, i1 += inc1) for (; i0 < i0end; i0 += inc0, i1 += inc1)
h0.impl->vset (&h0, i0, scm_call_1 (proc, h1.impl->vref (&h1, i1))); h0.vset (&h0, i0, scm_call_1 (proc, h1.vref (&h1, i1)));
else else
{ {
ras = scm_vector (ras); ras = scm_vector (ras);
@ -697,7 +697,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
unsigned long k; unsigned long k;
for (k = scm_c_vector_length (ras); k--;) for (k = scm_c_vector_length (ras); k--;)
args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1, i1), args)); h0.vset (&h0, i0, scm_apply_1 (proc, h1.vref (&h1, i1), args));
} }
} }
scm_array_handle_release (&h1); scm_array_handle_release (&h1);
@ -747,7 +747,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
i0end = i0 + n*inc0; i0end = i0 + n*inc0;
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0) for (; i0 < i0end; i0 += inc0)
scm_call_1 (proc, h0.impl->vref (&h0, i0)); scm_call_1 (proc, h0.vref (&h0, i0));
else else
{ {
ras = scm_vector (ras); ras = scm_vector (ras);
@ -757,7 +757,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
unsigned long k; unsigned long k;
for (k = scm_c_vector_length (ras); k--;) for (k = scm_c_vector_length (ras); k--;)
args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
scm_apply_1 (proc, h0.impl->vref (&h0, i0), args); scm_apply_1 (proc, h0.vref (&h0, i0), args);
} }
} }
scm_array_handle_release (&h0); scm_array_handle_release (&h0);
@ -788,7 +788,7 @@ array_index_map_1 (SCM ra, SCM proc)
v = h.array; v = h.array;
inc = h.dims[0].inc; inc = h.dims[0].inc;
for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc) for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc)
h.impl->vset (&h, p, scm_call_1 (proc, scm_from_ulong (i))); h.vset (&h, p, scm_call_1 (proc, scm_from_ulong (i)));
scm_array_handle_release (&h); scm_array_handle_release (&h);
} }

View file

@ -2,7 +2,7 @@
#define SCM_SRFI_4_H #define SCM_SRFI_4_H
/* srfi-4.c --- Homogeneous numeric vector datatypes. /* srfi-4.c --- Homogeneous numeric vector datatypes.
* *
* Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. * Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010, 2011, 2014 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -276,8 +276,8 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec,
SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec); SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec);
SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec); SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec);
SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); SCM_INTERNAL scm_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec);
SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); SCM_INTERNAL scm_t_array_set scm_i_uniform_vector_set_proc (SCM uvec);
SCM_INTERNAL void scm_init_srfi_4 (void); SCM_INTERNAL void scm_init_srfi_4 (void);