/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- vector_print
- make_vector
- Scm_MakeVector
- Scm_ListToVector
- Scm_VectorToList
- Scm_VectorRef
- Scm_VectorSet
- Scm_VectorFill
- Scm_VectorCopy
1 /*
2 * vector.c - vector implementation
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: vector.c,v 1.25 2005/10/05 13:27:28 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38
39 /*
40 * Constructor
41 */
42
43 static void vector_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
44 {
45 int i;
46 SCM_PUTZ("#(", -1, port);
47 for (i=0; i<SCM_VECTOR_SIZE(obj); i++) {
48 if (i != 0) SCM_PUTC(' ', port);
49 Scm_Write(SCM_VECTOR_ELEMENT(obj, i), SCM_OBJ(port), ctx->mode);
50 }
51 SCM_PUTZ(")", -1, port);
52 }
53
54 SCM_DEFINE_BUILTIN_CLASS(Scm_VectorClass, vector_print, NULL, NULL, NULL,
55 SCM_CLASS_SEQUENCE_CPL);
56
57 static ScmVector *make_vector(int size)
58 {
59 ScmVector *v = SCM_NEW2(ScmVector *,
60 sizeof(ScmVector) + sizeof(ScmObj)*(size-1));
61 SCM_SET_CLASS(v, SCM_CLASS_VECTOR);
62 v->size = size;
63 return v;
64 }
65
66 ScmObj Scm_MakeVector(int size, ScmObj fill)
67 {
68 int i;
69 ScmVector *v;
70 if (size < 0) {
71 Scm_Error("vector size must be a positive integer, but got %d", size);
72 }
73 v = make_vector(size);
74 if (SCM_UNBOUNDP(fill)) fill = SCM_UNDEFINED;
75 for (i=0; i<size; i++) v->elements[i] = fill;
76 return SCM_OBJ(v);
77 }
78
79 ScmObj Scm_ListToVector(ScmObj l, int start, int end)
80 {
81 ScmVector *v;
82 ScmObj e;
83 int i;
84
85 if (end < 0) {
86 int size = Scm_Length(l);
87 if (size < 0) Scm_Error("bad list: %S", l);
88 SCM_CHECK_START_END(start, end, size);
89 v = make_vector(size - start);
90 } else {
91 SCM_CHECK_START_END(start, end, end);
92 v = make_vector(end - start);
93 }
94 e = Scm_ListTail(l, start, SCM_UNBOUND);
95 for (i=0; i<end-start; i++, e=SCM_CDR(e)) {
96 if (!SCM_PAIRP(e)) {
97 Scm_Error("list too short: %S", l);
98 }
99 v->elements[i] = SCM_CAR(e);
100 }
101 return SCM_OBJ(v);
102 }
103
104 ScmObj Scm_VectorToList(ScmVector *v, int start, int end)
105 {
106 int len = SCM_VECTOR_SIZE(v);
107 SCM_CHECK_START_END(start, end, len);
108 return Scm_ArrayToList(SCM_VECTOR_ELEMENTS(v)+start,
109 end-start);
110 }
111
112 /*
113 * Accessors
114 */
115
116 ScmObj Scm_VectorRef(ScmVector *vec, int i, ScmObj fallback)
117 {
118 if (i < 0 || i >= vec->size) {
119 if (SCM_UNBOUNDP(fallback)) {
120 Scm_Error("argument out of range: %d", i);
121 } else {
122 return fallback;
123 }
124 }
125 return vec->elements[i];
126 }
127
128 ScmObj Scm_VectorSet(ScmVector *vec, int i, ScmObj obj)
129 {
130 if (i < 0 || i >= vec->size)
131 Scm_Error("argument out of range: %d", i);
132 return (vec->elements[i] = obj);
133 }
134
135 ScmObj Scm_VectorFill(ScmVector *vec, ScmObj fill, int start, int end)
136 {
137 int i, len = SCM_VECTOR_SIZE(vec);
138 SCM_CHECK_START_END(start, end, len);
139 for (i=start; i < end; i++) {
140 SCM_VECTOR_ELEMENT(vec, i) = fill;
141 }
142 return SCM_OBJ(vec);
143 }
144
145 ScmObj Scm_VectorCopy(ScmVector *vec, int start, int end, ScmObj fill)
146 {
147 int i, len = SCM_VECTOR_SIZE(vec);
148 ScmVector *v = NULL;
149 if (end < 0) end = len;
150 if (end < start) {
151 Scm_Error("vector-copy: start (%d) is greater than end (%d)",
152 start, end);
153 } else if (end == start) {
154 v = make_vector(0);
155 } else {
156 if (SCM_UNBOUNDP(fill)) fill = SCM_UNDEFINED;
157 v = make_vector(end - start);
158 for (i=0; i<end-start; i++) {
159 if (i+start < 0 || i+start >= len) {
160 SCM_VECTOR_ELEMENT(v, i) = fill;
161 } else {
162 SCM_VECTOR_ELEMENT(v, i) = SCM_VECTOR_ELEMENT(vec, i+start);
163 }
164 }
165 }
166 return SCM_OBJ(v);
167 }
168