X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/fb7dd00169304a5922838e4d2f25253640a35def..8051cf23044e5dbbece0d328102197a04ce5718d:/libguile/generalized-arrays.c

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"