Remove array impl. registry; instead, hard-code array handle creation

[bpt/guile.git] / libguile / arrays.c

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 4401a97..84d0f71 100644 (file)
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -27,6 +27,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
+#include <assert.h>
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
@@ -60,21 +61,22 @@
   (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 
 
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
            (SCM ra),
            "Return the root vector of a shared array.")
 #define FUNC_NAME s_scm_shared_array_root
 {
-  if (SCM_I_ARRAYP (ra))
+  if (!scm_is_array (ra))
+    scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+  else if (SCM_I_ARRAYP (ra))
     return SCM_I_ARRAY_V (ra);
-  else if (scm_is_generalized_vector (ra))
+  else
     return ra;
-  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
            (SCM ra),
            "Return the root vector index of the first element in the array.")
 #define FUNC_NAME s_scm_shared_array_offset
@@ -195,8 +197,9 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
     scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
 
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+    if (0 == s->lbnd)
       return SCM_I_ARRAY_V (ra);
+
   return ra;
 }
 #undef FUNC_NAME
@@ -254,7 +257,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
   memcpy (elts, bytes, byte_len);
 
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+    if (0 == s->lbnd)
       return SCM_I_ARRAY_V (ra);
   return ra;
 }
@@ -289,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
   scm_array_handle_release (&h);
 
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+    if (0 == s->lbnd)
       return SCM_I_ARRAY_V (ra);
   return ra;
 }
@@ -475,20 +478,22 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
   SCM_VALIDATE_REST_ARGUMENT (args);
   SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
 
-  if (scm_is_generalized_vector (ra))
+  switch (scm_c_array_rank (ra))
     {
+    case 0:
+      if (!scm_is_null (args))
+       SCM_WRONG_NUM_ARGS ();
+      return ra;
+    case 1:
       /* Make sure that we are called with a single zero as
-        arguments. 
+        arguments.
       */
       if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
        SCM_WRONG_NUM_ARGS ();
       SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
       SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
       return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra))
-    {
+    default:
       vargs = scm_vector (args);
       if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
        SCM_WRONG_NUM_ARGS ();
@@ -538,8 +543,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
       scm_i_ra_set_contp (res);
       return res;
     }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
 
@@ -816,39 +819,6 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
 }
 
-static SCM
-array_handle_ref (scm_t_array_handle *hh, size_t pos)
-{
-  return scm_c_array_ref_1 (SCM_I_ARRAY_V (hh->array), pos);
-}
-
-static void
-array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
-{
-  scm_c_array_set_1_x (SCM_I_ARRAY_V (hh->array), val, pos);
-}
-
-/* FIXME: should be handle for vect? maybe not, because of dims */
-static void
-array_get_handle (SCM array, scm_t_array_handle *h)
-{
-  scm_t_array_handle vh;
-  scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
-  h->element_type = vh.element_type;
-  h->elements = vh.elements;
-  h->writable_elements = vh.writable_elements;
-  scm_array_handle_release (&vh);
-
-  h->dims = SCM_I_ARRAY_DIMS (array);
-  h->ndims = SCM_I_ARRAY_NDIM (array);
-  h->base = SCM_I_ARRAY_BASE (array);
-}
-
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_array,
-                          0x7f,
-                          array_handle_ref, array_handle_set,
-                          array_get_handle)
-
 void
 scm_init_arrays ()
 {