Commit | Line | Data |
---|---|---|
1d4e6ee3 | 1 | /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, |
13af75bf | 2 | * 2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. |
1d4e6ee3 | 3 | * |
f332e957 AW |
4 | * This library is free software; you can redistribute it and/or |
5 | * modify it under the terms of the GNU Lesser General Public License | |
6 | * as published by the Free Software Foundation; either version 3 of | |
7 | * the License, or (at your option) any later version. | |
8 | * | |
9 | * This library is distributed in the hope that it will be useful, but | |
10 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
12 | * Lesser General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU Lesser General Public | |
15 | * License along with this library; if not, write to the Free Software | |
16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
17 | * 02110-1301 USA | |
18 | */ | |
19 | ||
20 | ||
21 | \f | |
22 | ||
23 | #ifdef HAVE_CONFIG_H | |
24 | # include <config.h> | |
25 | #endif | |
26 | ||
27 | #include "libguile/_scm.h" | |
28 | #include "libguile/__scm.h" | |
29 | ||
30 | #include "libguile/array-handle.h" | |
31 | #include "libguile/generalized-arrays.h" | |
32 | #include "libguile/generalized-vectors.h" | |
33 | ||
34 | ||
f45eccff AW |
35 | struct scm_t_vector_ctor |
36 | { | |
37 | SCM tag; | |
38 | SCM (*ctor)(SCM, SCM); | |
39 | }; | |
40 | ||
41 | #define VECTOR_CTORS_N_STATIC_ALLOC 20 | |
42 | static struct scm_t_vector_ctor vector_ctors[VECTOR_CTORS_N_STATIC_ALLOC]; | |
43 | static int num_vector_ctors_registered = 0; | |
44 | ||
45 | void | |
46 | scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM)) | |
47 | { | |
48 | if (num_vector_ctors_registered >= VECTOR_CTORS_N_STATIC_ALLOC) | |
49 | /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */ | |
50 | abort (); | |
51 | else | |
52 | { | |
53 | vector_ctors[num_vector_ctors_registered].tag = type; | |
54 | vector_ctors[num_vector_ctors_registered].ctor = ctor; | |
55 | num_vector_ctors_registered++; | |
56 | } | |
57 | } | |
58 | ||
59 | SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0, | |
60 | (SCM type, SCM len, SCM fill), | |
61 | "Make a generalized vector") | |
62 | #define FUNC_NAME s_scm_make_generalized_vector | |
63 | { | |
64 | int i; | |
65 | for (i = 0; i < num_vector_ctors_registered; i++) | |
d223c3fc | 66 | if (scm_is_eq (vector_ctors[i].tag, type)) |
f45eccff AW |
67 | return vector_ctors[i].ctor(len, fill); |
68 | scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type"); | |
69 | } | |
70 | #undef FUNC_NAME | |
71 | ||
f332e957 AW |
72 | int |
73 | scm_is_generalized_vector (SCM obj) | |
74 | { | |
75 | int ret = 0; | |
76 | if (scm_is_array (obj)) | |
77 | { | |
78 | scm_t_array_handle h; | |
79 | scm_array_get_handle (obj, &h); | |
80 | ret = scm_array_handle_rank (&h) == 1; | |
81 | scm_array_handle_release (&h); | |
82 | } | |
83 | return ret; | |
84 | } | |
85 | ||
f332e957 AW |
86 | #define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle) \ |
87 | scm_generalized_vector_get_handle (val, handle) | |
88 | ||
89 | ||
90 | void | |
91 | scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h) | |
92 | { | |
93 | scm_array_get_handle (vec, h); | |
94 | if (scm_array_handle_rank (h) != 1) | |
95 | { | |
96 | scm_array_handle_release (h); | |
97 | scm_wrong_type_arg_msg (NULL, 0, vec, "vector"); | |
98 | } | |
99 | } | |
100 | ||
101 | size_t | |
102 | scm_c_generalized_vector_length (SCM v) | |
103 | { | |
13af75bf | 104 | return scm_c_array_length (v); |
f332e957 AW |
105 | } |
106 | ||
f332e957 | 107 | SCM |
13af75bf | 108 | scm_c_generalized_vector_ref (SCM v, ssize_t idx) |
f332e957 | 109 | { |
13af75bf | 110 | return scm_c_array_ref_1 (v, idx); |
f332e957 AW |
111 | } |
112 | ||
f332e957 | 113 | void |
13af75bf | 114 | scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val) |
f332e957 | 115 | { |
13af75bf | 116 | scm_c_array_set_1_x (v, val, idx); |
f332e957 AW |
117 | } |
118 | ||
f332e957 AW |
119 | void |
120 | scm_init_generalized_vectors () | |
121 | { | |
122 | #include "libguile/generalized-vectors.x" | |
123 | } | |
124 | ||
125 | /* | |
126 | Local Variables: | |
127 | c-file-style: "gnu" | |
128 | End: | |
129 | */ |