1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
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.
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.
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
26 #include "libguile/_scm.h"
27 #include "libguile/__scm.h"
29 #include "libguile/array-handle.h"
30 #include "libguile/generalized-arrays.h"
31 #include "libguile/generalized-vectors.h"
34 struct scm_t_vector_ctor
37 SCM (*ctor
)(SCM
, SCM
);
40 #define VECTOR_CTORS_N_STATIC_ALLOC 20
41 static struct scm_t_vector_ctor vector_ctors
[VECTOR_CTORS_N_STATIC_ALLOC
];
42 static int num_vector_ctors_registered
= 0;
45 scm_i_register_vector_constructor (SCM type
, SCM (*ctor
)(SCM
, SCM
))
47 if (num_vector_ctors_registered
>= VECTOR_CTORS_N_STATIC_ALLOC
)
48 /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
52 vector_ctors
[num_vector_ctors_registered
].tag
= type
;
53 vector_ctors
[num_vector_ctors_registered
].ctor
= ctor
;
54 num_vector_ctors_registered
++;
58 SCM_DEFINE (scm_make_generalized_vector
, "make-generalized-vector", 2, 1, 0,
59 (SCM type
, SCM len
, SCM fill
),
60 "Make a generalized vector")
61 #define FUNC_NAME s_scm_make_generalized_vector
64 for (i
= 0; i
< num_vector_ctors_registered
; i
++)
65 if (vector_ctors
[i
].tag
== type
)
66 return vector_ctors
[i
].ctor(len
, fill
);
67 scm_wrong_type_arg_msg (FUNC_NAME
, SCM_ARG1
, type
, "array type");
72 scm_is_generalized_vector (SCM obj
)
75 if (scm_is_array (obj
))
78 scm_array_get_handle (obj
, &h
);
79 ret
= scm_array_handle_rank (&h
) == 1;
80 scm_array_handle_release (&h
);
85 SCM_DEFINE (scm_generalized_vector_p
, "generalized-vector?", 1, 0, 0,
87 "Return @code{#t} if @var{obj} is a vector, string,\n"
88 "bitvector, or uniform numeric vector.")
89 #define FUNC_NAME s_scm_generalized_vector_p
91 return scm_from_bool (scm_is_generalized_vector (obj
));
95 #define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle) \
96 scm_generalized_vector_get_handle (val, handle)
100 scm_generalized_vector_get_handle (SCM vec
, scm_t_array_handle
*h
)
102 scm_array_get_handle (vec
, h
);
103 if (scm_array_handle_rank (h
) != 1)
105 scm_array_handle_release (h
);
106 scm_wrong_type_arg_msg (NULL
, 0, vec
, "vector");
111 scm_c_generalized_vector_length (SCM v
)
113 scm_t_array_handle h
;
115 scm_generalized_vector_get_handle (v
, &h
);
116 ret
= h
.dims
[0].ubnd
- h
.dims
[0].lbnd
+ 1;
117 scm_array_handle_release (&h
);
121 SCM_DEFINE (scm_generalized_vector_length
, "generalized-vector-length", 1, 0, 0,
123 "Return the length of the generalized vector @var{v}.")
124 #define FUNC_NAME s_scm_generalized_vector_length
126 return scm_from_size_t (scm_c_generalized_vector_length (v
));
131 scm_c_generalized_vector_ref (SCM v
, size_t idx
)
133 scm_t_array_handle h
;
135 scm_generalized_vector_get_handle (v
, &h
);
136 ret
= h
.impl
->vref (&h
, idx
);
137 scm_array_handle_release (&h
);
141 SCM_DEFINE (scm_generalized_vector_ref
, "generalized-vector-ref", 2, 0, 0,
143 "Return the element at index @var{idx} of the\n"
144 "generalized vector @var{v}.")
145 #define FUNC_NAME s_scm_generalized_vector_ref
147 return scm_c_generalized_vector_ref (v
, scm_to_size_t (idx
));
152 scm_c_generalized_vector_set_x (SCM v
, size_t idx
, SCM val
)
154 scm_t_array_handle h
;
155 scm_generalized_vector_get_handle (v
, &h
);
156 h
.impl
->vset (&h
, idx
, val
);
157 scm_array_handle_release (&h
);
160 SCM_DEFINE (scm_generalized_vector_set_x
, "generalized-vector-set!", 3, 0, 0,
161 (SCM v
, SCM idx
, SCM val
),
162 "Set the element at index @var{idx} of the\n"
163 "generalized vector @var{v} to @var{val}.")
164 #define FUNC_NAME s_scm_generalized_vector_set_x
166 scm_c_generalized_vector_set_x (v
, scm_to_size_t (idx
), val
);
167 return SCM_UNSPECIFIED
;
171 SCM_DEFINE (scm_generalized_vector_to_list
, "generalized-vector->list", 1, 0, 0,
173 "Return a new list whose elements are the elements of the\n"
174 "generalized vector @var{v}.")
175 #define FUNC_NAME s_scm_generalized_vector_to_list
179 scm_t_array_handle h
;
180 scm_generalized_vector_get_handle (v
, &h
);
182 for (pos
= h
.dims
[0].ubnd
, i
= (h
.dims
[0].ubnd
- h
.dims
[0].lbnd
+ 1);
184 pos
+= h
.dims
[0].inc
)
185 ret
= scm_cons (h
.impl
->vref (&h
, pos
), ret
);
186 scm_array_handle_release (&h
);
192 scm_init_generalized_vectors ()
194 #include "libguile/generalized-vectors.x"