libguile/generalized-vectors.c

   1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21
  22 #ifdef HAVE_CONFIG_H
  23 #  include <config.h>
  24 #endif
  25
  26 #include "libguile/_scm.h"
  27 #include "libguile/__scm.h"
  28
  29 #include "libguile/array-handle.h"
  30 #include "libguile/generalized-arrays.h"
  31 #include "libguile/generalized-vectors.h"
  32
  33
  34 int
  35 scm_is_generalized_vector (SCM obj)
  36 {
  37   int ret = 0;
  38   if (scm_is_array (obj))
  39     {
  40       scm_t_array_handle h;
  41       scm_array_get_handle (obj, &h);
  42       ret = scm_array_handle_rank (&h) == 1;
  43       scm_array_handle_release (&h);
  44     }
  45   return ret;
  46 }
  47
  48 SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
  49             (SCM obj),
  50             "Return @code{#t} if @var{obj} is a vector, string,\n"
  51             "bitvector, or uniform numeric vector.")
  52 #define FUNC_NAME s_scm_generalized_vector_p
  53 {
  54   return scm_from_bool (scm_is_generalized_vector (obj));
  55 }
  56 #undef FUNC_NAME
  57
  58 #define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
  59   scm_generalized_vector_get_handle (val, handle)
  60
  61
  62 void
  63 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
  64 {
  65   scm_array_get_handle (vec, h);
  66   if (scm_array_handle_rank (h) != 1)
  67     {
  68       scm_array_handle_release (h);
  69       scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
  70     }
  71 }
  72
  73 size_t
  74 scm_c_generalized_vector_length (SCM v)
  75 {
  76   scm_t_array_handle h;
  77   size_t ret;
  78   scm_generalized_vector_get_handle (v, &h);
  79   ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
  80   scm_array_handle_release (&h);
  81   return ret;
  82 }
  83
  84 SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
  85             (SCM v),
  86             "Return the length of the generalized vector @var{v}.")
  87 #define FUNC_NAME s_scm_generalized_vector_length
  88 {
  89   return scm_from_size_t (scm_c_generalized_vector_length (v));
  90 }
  91 #undef FUNC_NAME
  92
  93 SCM
  94 scm_c_generalized_vector_ref (SCM v, size_t idx)
  95 {
  96   scm_t_array_handle h;
  97   SCM ret;
  98   scm_generalized_vector_get_handle (v, &h);
  99   ret = h.impl->vref (&h, idx);
 100   scm_array_handle_release (&h);
 101   return ret;
 102 }
 103
 104 SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
 105             (SCM v, SCM idx),
 106             "Return the element at index @var{idx} of the\n"
 107             "generalized vector @var{v}.")
 108 #define FUNC_NAME s_scm_generalized_vector_ref
 109 {
 110   return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
 111 }
 112 #undef FUNC_NAME
 113
 114 void
 115 scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
 116 {
 117   scm_t_array_handle h;
 118   scm_generalized_vector_get_handle (v, &h);
 119   h.impl->vset (&h, idx, val);
 120   scm_array_handle_release (&h);
 121 }
 122
 123 SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
 124             (SCM v, SCM idx, SCM val),
 125             "Set the element at index @var{idx} of the\n"
 126             "generalized vector @var{v} to @var{val}.")
 127 #define FUNC_NAME s_scm_generalized_vector_set_x
 128 {
 129   scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
 130   return SCM_UNSPECIFIED;
 131 }
 132 #undef FUNC_NAME
 133
 134 SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
 135             (SCM v),
 136             "Return a new list whose elements are the elements of the\n"
 137             "generalized vector @var{v}.")
 138 #define FUNC_NAME s_scm_generalized_vector_to_list
 139 {
 140   SCM ret = SCM_EOL;
 141   ssize_t pos, i = 0;
 142   scm_t_array_handle h;
 143   scm_generalized_vector_get_handle (v, &h);
 144   // FIXME CHECKME
 145   for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
 146        i >= 0;
 147        pos += h.dims[0].inc)
 148     ret = scm_cons (h.impl->vref (&h, pos), ret);
 149   scm_array_handle_release (&h);
 150   return ret;
 151 }
 152 #undef FUNC_NAME
 153
 154 void
 155 scm_init_generalized_vectors ()
 156 {
 157 #include "libguile/generalized-vectors.x"
 158 }
 159
 160 /*
 161   Local Variables:
 162   c-file-style: "gnu"
 163   End:
 164 */