summaryrefslogtreecommitdiff
path: root/libguile/generalized-arrays.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/generalized-arrays.c')
-rw-r--r--libguile/generalized-arrays.c37
1 files changed, 34 insertions, 3 deletions
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index 59925a09e..9a001eb3c 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
@@ -42,7 +42,20 @@ SCM_INTERNAL SCM scm_i_array_set_x (SCM v, SCM obj,
int
scm_is_array (SCM obj)
{
- return scm_i_array_implementation_for_obj (obj) ? 1 : 0;
+ if (!SCM_HEAP_OBJECT_P (obj))
+ return 0;
+
+ switch (SCM_TYP7 (obj))
+ {
+ case scm_tc7_string:
+ case scm_tc7_vector:
+ case scm_tc7_bitvector:
+ case scm_tc7_bytevector:
+ case scm_tc7_array:
+ return 1;
+ default:
+ return 0;
+ }
}
SCM_DEFINE (scm_array_p_2, "array?", 1, 0, 0,
@@ -69,7 +82,7 @@ int
scm_is_typed_array (SCM obj, SCM type)
{
int ret = 0;
- if (scm_i_array_implementation_for_obj (obj))
+ if (scm_is_array (obj))
{
scm_t_array_handle h;
@@ -189,6 +202,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"