← Back to branch summary

~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to src/vector.c

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2006-05-23 21:46:41 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060523214641-6ix4gz34wpiehub8
Tags: 0.5.0-2
http://bugs.debian.org/368571
* debian/control (Build-Depends): Added ruby.
  Thanks to Frederik Schueler.  Closes: #368571
* debian/rules (clean): invoke 'distclean' instead of 'clean'.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/vector.c
 
1
/*===========================================================================
 
2
 *  FileName : vector.c
 
3
 *  About    : R5RS vectors
 
4
 *
 
5
 *  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
6
 *
 
7
 *  All rights reserved.
 
8
 *
 
9
 *  Redistribution and use in source and binary forms, with or without
 
10
 *  modification, are permitted provided that the following conditions
 
11
 *  are met:
 
12
 *
 
13
 *  1. Redistributions of source code must retain the above copyright
 
14
 *     notice, this list of conditions and the following disclaimer.
 
15
 *  2. Redistributions in binary form must reproduce the above copyright
 
16
 *     notice, this list of conditions and the following disclaimer in the
 
17
 *     documentation and/or other materials provided with the distribution.
 
18
 *  3. Neither the name of authors nor the names of its contributors
 
19
 *     may be used to endorse or promote products derived from this software
 
20
 *     without specific prior written permission.
 
21
 *
 
22
 *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
23
 *  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
24
 *  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
25
 *  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
26
 *  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
27
 *  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
28
 *  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 
29
 *  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 
30
 *  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 
31
 *  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 
32
 *  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
33
===========================================================================*/
 
34
 
 
35
#include "config.h"
 
36
 
 
37
/*=======================================
 
38
  System Include
 
39
=======================================*/
 
40
 
 
41
/*=======================================
 
42
  Local Include
 
43
=======================================*/
 
44
#include "sigscheme.h"
 
45
#include "sigschemeinternal.h"
 
46
 
 
47
/*=======================================
 
48
  File Local Struct Declarations
 
49
=======================================*/
 
50
 
 
51
/*=======================================
 
52
  File Local Macro Declarations
 
53
=======================================*/
 
54
 
 
55
/*=======================================
 
56
  Variable Declarations
 
57
=======================================*/
 
58
 
 
59
/*=======================================
 
60
  File Local Function Declarations
 
61
=======================================*/
 
62
 
 
63
/*=======================================
 
64
  Function Implementations
 
65
=======================================*/
 
66
/*===========================================================================
 
67
  R5RS : 6.3 Other data types : 6.3.6 Vectors
 
68
===========================================================================*/
 
69
ScmObj
 
70
scm_p_vectorp(ScmObj obj)
 
71
{
 
72
    DECLARE_FUNCTION("vector?", procedure_fixed_1);
 
73
 
 
74
    return MAKE_BOOL(VECTORP(obj));
 
75
}
 
76
 
 
77
ScmObj
 
78
scm_p_make_vector(ScmObj scm_len, ScmObj args)
 
79
{
 
80
    ScmObj *vec, filler;
 
81
    scm_int_t len, i;
 
82
    DECLARE_FUNCTION("make-vector", procedure_variadic_1);
 
83
 
 
84
    ENSURE_INT(scm_len);
 
85
 
 
86
    len = SCM_INT_VALUE(scm_len);
 
87
    if (len < 0)
 
88
        ERR_OBJ("length must be a positive integer", scm_len);
 
89
 
 
90
    vec = scm_malloc(sizeof(ScmObj) * len);
 
91
    if (NULLP(args)) {
 
92
        filler = SCM_UNDEF;
 
93
    } else {
 
94
        filler = POP(args);
 
95
        ASSERT_NO_MORE_ARG(args);
 
96
    }
 
97
    for (i = 0; i < len; i++)
 
98
        vec[i] = filler;
 
99
 
 
100
    return MAKE_VECTOR(vec, len);
 
101
}
 
102
 
 
103
ScmObj
 
104
scm_p_vector(ScmObj args)
 
105
{
 
106
    DECLARE_FUNCTION("vector", procedure_variadic_0);
 
107
 
 
108
    return scm_p_list2vector(args);
 
109
}
 
110
 
 
111
ScmObj
 
112
scm_p_vector_length(ScmObj vec)
 
113
{
 
114
    DECLARE_FUNCTION("vector-length", procedure_fixed_1);
 
115
 
 
116
    ENSURE_VECTOR(vec);
 
117
 
 
118
    return MAKE_INT(SCM_VECTOR_LEN(vec));
 
119
}
 
120
 
 
121
ScmObj
 
122
scm_p_vector_ref(ScmObj vec, ScmObj _k)
 
123
{
 
124
    scm_int_t k;
 
125
    DECLARE_FUNCTION("vector-ref", procedure_fixed_2);
 
126
 
 
127
    ENSURE_VECTOR(vec);
 
128
    ENSURE_INT(_k);
 
129
 
 
130
    k = SCM_INT_VALUE(_k);
 
131
 
 
132
    if (!SCM_VECTOR_VALID_INDEXP(vec, k))
 
133
        ERR_OBJ("index out of range", _k);
 
134
 
 
135
    return SCM_VECTOR_VEC(vec)[k];
 
136
}
 
137
 
 
138
ScmObj
 
139
scm_p_vector_setd(ScmObj vec, ScmObj _k, ScmObj obj)
 
140
{
 
141
    scm_int_t k;
 
142
    DECLARE_FUNCTION("vector-set!", procedure_fixed_3);
 
143
 
 
144
    ENSURE_VECTOR(vec);
 
145
#if SCM_CONST_VECTOR_LITERAL
 
146
    ENSURE_MUTABLE_VECTOR(vec);
 
147
#endif
 
148
    ENSURE_INT(_k);
 
149
 
 
150
    k = SCM_INT_VALUE(_k);
 
151
 
 
152
    if (!SCM_VECTOR_VALID_INDEXP(vec, k))
 
153
        ERR_OBJ("index out of range", _k);
 
154
 
 
155
    SCM_VECTOR_VEC(vec)[k] = obj;
 
156
 
 
157
    return SCM_UNDEF;
 
158
}
 
159
 
 
160
ScmObj
 
161
scm_p_vector2list(ScmObj vec)
 
162
{
 
163
    ScmQueue q;
 
164
    ScmObj ret, *v;
 
165
    scm_int_t len, i;
 
166
    DECLARE_FUNCTION("vector->list", procedure_fixed_1);
 
167
 
 
168
    ENSURE_VECTOR(vec);
 
169
 
 
170
    v   = SCM_VECTOR_VEC(vec);
 
171
    len = SCM_VECTOR_LEN(vec);
 
172
 
 
173
    ret = SCM_NULL;
 
174
    SCM_QUEUE_POINT_TO(q, ret);
 
175
    for (i = 0; i < len; i++)
 
176
        SCM_QUEUE_ADD(q, v[i]);
 
177
 
 
178
    return ret;
 
179
}
 
180
 
 
181
ScmObj
 
182
scm_p_list2vector(ScmObj lst)
 
183
{
 
184
    ScmObj *vec;
 
185
    scm_int_t len, i;
 
186
    DECLARE_FUNCTION("list->vector", procedure_fixed_1);
 
187
 
 
188
    len = scm_length(lst);
 
189
    if (!SCM_LISTLEN_PROPERP(len))
 
190
        ERR_OBJ("proper list required but got", lst);
 
191
 
 
192
    vec = scm_malloc(sizeof(ScmObj) * len);
 
193
    for (i = 0; i < len; i++)
 
194
        vec[i] = POP(lst);
 
195
 
 
196
    return MAKE_VECTOR(vec, len);
 
197
}
 
198
 
 
199
ScmObj
 
200
scm_p_vector_filld(ScmObj vec, ScmObj fill)
 
201
{
 
202
    ScmObj *v;
 
203
    scm_int_t len, i;
 
204
    DECLARE_FUNCTION("vector-fill!", procedure_fixed_2);
 
205
 
 
206
    ENSURE_VECTOR(vec);
 
207
#if SCM_CONST_VECTOR_LITERAL
 
208
    ENSURE_MUTABLE_VECTOR(vec);
 
209
#endif
 
210
 
 
211
    v   = SCM_VECTOR_VEC(vec);
 
212
    len = SCM_VECTOR_LEN(vec);
 
213
    for (i = 0; i < len; i++)
 
214
        v[i] = fill;
 
215
 
 
216
    return vec;
 
217
}