summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-19 13:43:30 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:45:54 +0100
commit8190effae22e1ad1086fb0cae429ae42ff6f761d (patch)
tree7e634b863538a22c17454e883c90e30e94cf2e2c
parentf1fcf88b1f2c7955bda03b5243b904ba16f79b71 (diff)
downloadguile-8190effae22e1ad1086fb0cae429ae42ff6f761d.tar.gz
Have array impl->vref, vset take SCM, not handles
* libguile/array-handle.h - scm_i_t_array_ref, scm_i_t_array_set take SCM. - scm_array_handle_ref, scm_array_handle_set: pass h->array. * libguile/array-map.c - AREF, ASET, rafill, racp, ramap, rafe: pass storage vector SCM instead of handle. * libguile/bitvector.c - bitvector_handle_ref, bitvector_handle_set_x: take bitvector arg. * libguile/bytevectors.c - bv_handle_ref, bv_handle_set_x: take bytevector arg. - scm_i_print_bytevectors: don't use array handles. * libguile/deprecated.c - scm_generalized_vector_to_list: pass h.array. * libguile/strings.c - string_handle_ref, string_handle_set: take string arg. * libguile/uniform.c - scm_c_uniform_vector_ref, scm_c_uniform_vector_set_x: pass h.array. * libguile/vectors.c - vector_handle_ref, vector_handle_set: take vector arg.
-rw-r--r--libguile/array-handle.h8
-rw-r--r--libguile/array-map.c18
-rw-r--r--libguile/bitvectors.c13
-rw-r--r--libguile/bytevectors.c62
-rw-r--r--libguile/strings.c12
-rw-r--r--libguile/uniform.c6
-rw-r--r--libguile/vectors.c12
7 files changed, 66 insertions, 65 deletions
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
index fa2449dea..94f368977 100644
--- a/libguile/array-handle.h
+++ b/libguile/array-handle.h
@@ -32,8 +32,8 @@
struct scm_t_array_handle;
-typedef SCM (*scm_i_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 SCM (*scm_i_t_array_ref) (SCM, size_t);
+typedef void (*scm_i_t_array_set) (SCM, size_t, SCM);
typedef struct
{
@@ -135,7 +135,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
/* catch overflow */
scm_out_of_range (NULL, scm_from_ssize_t (p));
/* perhaps should catch overflow here too */
- return h->impl->vref (h, h->base + p);
+ return h->impl->vref (h->array, h->base + p);
}
SCM_INLINE_IMPLEMENTATION void
@@ -145,7 +145,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
/* catch overflow */
scm_out_of_range (NULL, scm_from_ssize_t (p));
/* perhaps should catch overflow here too */
- h->impl->vset (h, h->base + p, v);
+ h->impl->vset (h->array, h->base + p, v);
}
#endif
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 971df1bfd..b2c5f4bed 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -57,7 +57,7 @@ AREF (SCM v, size_t pos)
SCM ret;
scm_array_get_handle (v, &h);
pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc;
- ret = h.impl->vref (&h, pos);
+ ret = h.impl->vref (h.array, pos);
scm_array_handle_release (&h);
return ret;
}
@@ -68,7 +68,7 @@ ASET (SCM v, size_t pos, SCM val)
scm_t_array_handle h;
scm_array_get_handle (v, &h);
pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc;
- h.impl->vset (&h, pos, val);
+ h.impl->vset (h.array, pos, val);
scm_array_handle_release (&h);
}
@@ -323,7 +323,7 @@ rafill (SCM dst, SCM fill)
inc = SCM_I_ARRAY_DIMS (dst)->inc;
for (; n-- > 0; i += inc)
- h.impl->vset (&h, i, fill);
+ h.impl->vset (SCM_I_ARRAY_V (dst), i, fill);
scm_array_handle_release (&h);
return 1;
@@ -359,7 +359,7 @@ racp (SCM src, SCM dst)
inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
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.impl->vset (SCM_I_ARRAY_V (dst), i_d, h_s.impl->vref (SCM_I_ARRAY_V (src), i_s));
scm_array_handle_release (&h_d);
scm_array_handle_release (&h_s);
@@ -661,7 +661,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
i0end = i0 + n*inc0;
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0)
- h0.impl->vset (&h0, i0, scm_call_0 (proc));
+ h0.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_call_0 (proc));
else
{
SCM ra1 = SCM_CAR (ras);
@@ -674,7 +674,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
ras = SCM_CDR (ras);
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0, i1 += inc1)
- h0.impl->vset (&h0, i0, scm_call_1 (proc, h1.impl->vref (&h1, i1)));
+ h0.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_call_1 (proc, h1.impl->vref (SCM_I_ARRAY_V (ra1), i1)));
else
{
ras = scm_vector (ras);
@@ -684,7 +684,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
unsigned long k;
for (k = scm_c_vector_length (ras); k--;)
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.impl->vset (SCM_I_ARRAY_V (ra0), i0, scm_apply_1 (proc, h1.impl->vref (SCM_I_ARRAY_V (ra1), i1), args));
}
}
scm_array_handle_release (&h1);
@@ -734,7 +734,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
i0end = i0 + n*inc0;
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0)
- scm_call_1 (proc, h0.impl->vref (&h0, i0));
+ scm_call_1 (proc, h0.impl->vref (SCM_I_ARRAY_V (ra0), i0));
else
{
ras = scm_vector (ras);
@@ -744,7 +744,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
unsigned long k;
for (k = scm_c_vector_length (ras); k--;)
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.impl->vref (SCM_I_ARRAY_V (ra0), i0), args);
}
}
scm_array_handle_release (&h0);
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 2d36110d4..3a88731b2 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -845,24 +845,25 @@ scm_istr2bve (SCM str)
goto exit;
}
}
-
+
exit:
scm_array_handle_release (&handle);
scm_remember_upto_here_1 (str);
return res;
}
-/* FIXME: h->array should be h->vector */
+/* FIXME: We know that bitvector is such, so can skip the checks in
+ scm_c_bitvector_... */
static SCM
-bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+bitvector_handle_ref (SCM bitvector, size_t pos)
{
- return scm_c_bitvector_ref (h->array, pos);
+ return scm_c_bitvector_ref (bitvector, pos);
}
static void
-bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+bitvector_handle_set (SCM bitvector, size_t pos, SCM val)
{
- scm_c_bitvector_set_x (h->array, pos, val);
+ scm_c_bitvector_set_x (bitvector, pos, val);
}
static void
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index f197be342..ccb438cea 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -402,31 +402,6 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
}
#undef FUNC_NAME
-
-
-int
-scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
- ssize_t ubnd, inc, i;
- scm_t_array_handle h;
-
- scm_array_get_handle (bv, &h);
-
- scm_putc_unlocked ('#', port);
- scm_write (scm_array_handle_element_type (&h), port);
- scm_putc_unlocked ('(', port);
- for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
- i <= ubnd; i += inc)
- {
- if (i > 0)
- scm_putc_unlocked (' ', port);
- scm_write (scm_array_handle_ref (&h, i), port);
- }
- scm_putc_unlocked (')', port);
-
- return 1;
-}
-
/* General operations. */
@@ -2149,15 +2124,17 @@ bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] =
};
static SCM
-bv_handle_ref (scm_t_array_handle *h, size_t index)
+bv_handle_ref (SCM bv, size_t index)
{
SCM byte_index;
scm_t_bytevector_ref_fn ref_fn;
- ref_fn = bytevector_ref_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (h->array)];
+ assert (SCM_BYTEVECTOR_P (bv));
+
+ ref_fn = bytevector_ref_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)];
byte_index =
- scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (h->array));
- return ref_fn (h->array, byte_index);
+ scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bv));
+ return ref_fn (bv, byte_index);
}
/* Template for native modification of complex numbers of type TYPE. */
@@ -2212,15 +2189,15 @@ const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1
};
static void
-bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
+bv_handle_set_x (SCM bytevector, size_t index, SCM val)
{
SCM byte_index;
scm_t_bytevector_set_fn set_fn;
- set_fn = bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (h->array)];
+ set_fn = bytevector_set_fns[SCM_BYTEVECTOR_ELEMENT_TYPE (bytevector)];
byte_index =
- scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (h->array));
- set_fn (h->array, byte_index, val);
+ scm_from_size_t (index * SCM_BYTEVECTOR_TYPE_SIZE (bytevector));
+ set_fn (bytevector, byte_index, val);
}
static void
@@ -2238,6 +2215,25 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h)
}
+int
+scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
+{
+ size_t len, i;
+
+ scm_putc_unlocked ('#', port);
+ scm_write (scm_i_array_element_types[SCM_BYTEVECTOR_ELEMENT_TYPE (bv)], port);
+ scm_putc_unlocked ('(', port);
+ for (i = 0, len = SCM_BYTEVECTOR_TYPED_LENGTH (bv); i < len; ++i)
+ {
+ if (i > 0)
+ scm_putc_unlocked (' ', port);
+ scm_write (bv_handle_ref (bv, i), port);
+ }
+ scm_putc_unlocked (')', port);
+ return 1;
+}
+
+
/* Initialization. */
void
diff --git a/libguile/strings.c b/libguile/strings.c
index 9aa6a2180..3952b205d 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -2459,17 +2459,19 @@ scm_i_get_substring_spec (size_t len,
else
*cend = scm_to_unsigned_integer (end, *cstart, len);
}
-
+
+/* FIXME: We know that bitvector is such, so can skip the checks in
+ scm_c_string_... */
static SCM
-string_handle_ref (scm_t_array_handle *h, size_t index)
+string_handle_ref (SCM string, size_t index)
{
- return scm_c_string_ref (h->array, index);
+ return scm_c_string_ref (string, index);
}
static void
-string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
+string_handle_set (SCM string, size_t index, SCM val)
{
- scm_c_string_set_x (h->array, index, val);
+ scm_c_string_set_x (string, index, val);
}
static void
diff --git a/libguile/uniform.c b/libguile/uniform.c
index e6fcb531a..f12b5eaec 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -182,8 +182,9 @@ scm_c_uniform_vector_ref (SCM v, size_t pos)
if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+ /* need the handle for bitvectors only */
scm_array_get_handle (v, &h);
- ret = h.impl->vref (&h, pos);
+ ret = h.impl->vref (h.array, pos);
scm_array_handle_release (&h);
return ret;
@@ -207,8 +208,9 @@ scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val)
if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+ /* need the handle for bitvectors only */
scm_array_get_handle (v, &h);
- h.impl->vset (&h, pos, val);
+ h.impl->vset (h.array, pos, val);
scm_array_handle_release (&h);
}
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 74d8a7ccb..19a0392b2 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -434,19 +434,19 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
static SCM
-vector_handle_ref (scm_t_array_handle *h, size_t idx)
+vector_handle_ref (SCM vector, size_t idx)
{
- if (idx >= SCM_I_VECTOR_LENGTH (h->array))
+ if (idx >= SCM_I_VECTOR_LENGTH (vector))
scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
- return SCM_I_VECTOR_WELTS(h->array)[idx];
+ return SCM_I_VECTOR_WELTS(vector)[idx];
}
static void
-vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
+vector_handle_set (SCM vector, size_t idx, SCM val)
{
- if (idx >= SCM_I_VECTOR_LENGTH (h->array))
+ if (idx >= SCM_I_VECTOR_LENGTH (vector))
scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
- SCM_I_VECTOR_WELTS(h->array)[idx] = val;
+ SCM_I_VECTOR_WELTS(vector)[idx] = val;
}
static void