summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-02-08 15:31:37 +0100
committerAndy Wingo <wingo@pobox.com>2014-02-08 15:31:37 +0100
commit8051cf23044e5dbbece0d328102197a04ce5718d (patch)
tree71287078307d5ff47fd54c1b2aed097975bc81b9 /libguile
parent54f17b7b597a3695a25babac92255ed52fbeec4a (diff)
parentfb7dd00169304a5922838e4d2f25253640a35def (diff)
downloadguile-8051cf23044e5dbbece0d328102197a04ce5718d.tar.gz
Merge commit 'fb7dd00169304a5922838e4d2f25253640a35def'
This commit also renames uniform-vector-element-type-code to array-type-code. Conflicts: libguile/uniform.c libguile/uniform.h test-suite/tests/arrays.test
Diffstat (limited to 'libguile')
-rw-r--r--libguile/generalized-arrays.c20
-rw-r--r--libguile/generalized-arrays.h3
-rw-r--r--libguile/uniform.c172
-rw-r--r--libguile/uniform.h29
4 files changed, 24 insertions, 200 deletions
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index 59925a09e..88c1cdeab 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -189,6 +189,24 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_array_type_code,
+ "array-type-code", 1, 0, 0,
+ (SCM array),
+ "Return the type of the elements in @var{array},\n"
+ "as an integer code.")
+#define FUNC_NAME s_scm_array_type_code
+{
+ scm_t_array_handle h;
+ scm_t_array_element_type element_type;
+
+ scm_array_get_handle (array, &h);
+ element_type = h.element_type;
+ scm_array_handle_release (&h);
+
+ return scm_from_uint16 (element_type);
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
(SCM ra, SCM args),
"Return @code{#t} if its arguments would be acceptable to\n"
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index d9fcea63d..dfdb8bd03 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -3,7 +3,7 @@
#ifndef SCM_GENERALIZED_ARRAYS_H
#define SCM_GENERALIZED_ARRAYS_H
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -49,6 +49,7 @@ SCM_API SCM scm_array_length (SCM ra);
SCM_API SCM scm_array_dimensions (SCM ra);
SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_type_code (SCM ra);
SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
SCM_API SCM scm_c_array_ref_1 (SCM v, ssize_t idx0);
diff --git a/libguile/uniform.c b/libguile/uniform.c
index e81f5046a..f7ca7bce9 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -81,178 +81,6 @@ scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
return ret;
}
-int
-scm_is_uniform_vector (SCM obj)
-{
- scm_t_array_handle h;
- int ret = 0;
-
- if (scm_is_array (obj))
- {
- scm_array_get_handle (obj, &h);
- ret = (scm_array_handle_rank (&h) == 1
- && SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type));
- scm_array_handle_release (&h);
- }
- return ret;
-}
-
-size_t
-scm_c_uniform_vector_length (SCM uvec)
-{
- if (!scm_is_uniform_vector (uvec))
- scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
- "uniform vector");
- return scm_c_array_length (uvec);
-}
-
-SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is a uniform vector.")
-#define FUNC_NAME s_scm_uniform_vector_p
-{
- return scm_from_bool (scm_is_uniform_vector (obj));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 0, 0,
- (SCM v),
- "Return the type of the elements in the uniform vector, @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_element_type
-{
- scm_t_array_handle h;
- SCM ret;
-
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
- scm_array_get_handle (v, &h);
- ret = scm_array_handle_element_type (&h);
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_type_code,
- "uniform-vector-element-type-code", 1, 0, 0,
- (SCM v),
- "Return the type of the elements in the uniform vector, @var{v},\n"
- "as an integer code.")
-#define FUNC_NAME s_scm_uniform_vector_element_type_code
-{
- scm_t_array_handle h;
- SCM ret;
-
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
- scm_array_get_handle (v, &h);
- ret = scm_from_uint16 (h.element_type);
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0, 0,
- (SCM v),
- "Return the number of bytes allocated to each element in the\n"
- "uniform vector, @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_element_size
-{
- scm_t_array_handle h;
- size_t len;
- ssize_t inc;
- SCM ret;
- scm_uniform_vector_elements (v, &h, &len, &inc);
- ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM
-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");
- return scm_c_array_ref_1 (v, pos);
-}
-
-SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
- (SCM v, SCM idx),
- "Return the element at index @var{idx} of the\n"
- "homogeneous numeric vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_ref
-{
- return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-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");
- scm_c_array_set_1_x (v, val, pos);
-}
-
-SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
- (SCM v, SCM idx, SCM val),
- "Set the element at index @var{idx} of the\n"
- "homogeneous numeric vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_uniform_vector_set_x
-{
- scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
- (SCM uvec),
- "Convert the uniform numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_scm_uniform_vector_to_list
-{
- if (!scm_is_uniform_vector (uvec))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector");
- return scm_array_to_list (uvec);
-}
-#undef FUNC_NAME
-
-const void *
-scm_uniform_vector_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp)
-{
- return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
-void *
-scm_uniform_vector_writable_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp)
-{
- void *ret;
- scm_array_get_handle (uvec, h);
- if (scm_array_handle_rank (h) != 1)
- scm_wrong_type_arg_msg (0, SCM_ARG1, uvec, "uniform vector");
- ret = scm_array_handle_uniform_writable_elements (h);
- if (lenp)
- {
- scm_t_array_dim *dim = scm_array_handle_dims (h);
- *lenp = dim->ubnd - dim->lbnd + 1;
- *incp = dim->inc;
- }
- return ret;
-}
-
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
- (SCM v),
- "Return the number of elements in the uniform vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_length
-{
- return scm_from_size_t (scm_c_uniform_vector_length (v));
-}
-#undef FUNC_NAME
-
-
void
scm_init_uniform (void)
{
diff --git a/libguile/uniform.h b/libguile/uniform.h
index 57e214b36..ad8428f6f 100644
--- a/libguile/uniform.h
+++ b/libguile/uniform.h
@@ -3,7 +3,8 @@
#ifndef SCM_UNIFORM_H
#define SCM_UNIFORM_H
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
+ * 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -43,33 +44,9 @@ SCM_API size_t scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h)
SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle *h);
-SCM_API SCM scm_uniform_vector_p (SCM v);
-SCM_API SCM scm_uniform_vector_length (SCM v);
-SCM_API SCM scm_uniform_vector_element_type (SCM v);
-SCM_API SCM scm_uniform_vector_element_type_code (SCM v);
-SCM_API SCM scm_uniform_vector_element_size (SCM v);
-SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_uniform_vector_to_list (SCM v);
-SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
- SCM start, SCM end);
-SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
- SCM start, SCM end);
-
-SCM_API int scm_is_uniform_vector (SCM obj);
-SCM_API size_t scm_c_uniform_vector_length (SCM v);
-SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API const void *scm_uniform_vector_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp);
-SCM_API void *scm_uniform_vector_writable_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp,
- ssize_t *incp);
-
SCM_INTERNAL void scm_init_uniform (void);
+
#endif /* SCM_UNIFORM_H */
/*