1
/*===========================================================================
5
* Copyright (C) 2005 Kazuki Ohta <mover AT hct.zaq.ne.jp>
6
* Copyright (C) 2005-2006 Jun Inoue <jun.lambda AT gmail.com>
7
* Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
8
* Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
10
* All rights reserved.
12
* Redistribution and use in source and binary forms, with or without
13
* modification, are permitted provided that the following conditions
16
* 1. Redistributions of source code must retain the above copyright
17
* notice, this list of conditions and the following disclaimer.
18
* 2. Redistributions in binary form must reproduce the above copyright
19
* notice, this list of conditions and the following disclaimer in the
20
* documentation and/or other materials provided with the distribution.
21
* 3. Neither the name of authors nor the names of its contributors
22
* may be used to endorse or promote products derived from this software
23
* without specific prior written permission.
25
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
26
* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
29
* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30
* EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
32
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
33
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
34
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
35
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36
===========================================================================*/
40
#include "sigscheme.h"
41
#include "sigschemeinternal.h"
43
/*=======================================
44
File Local Macro Definitions
45
=======================================*/
47
/*=======================================
48
File Local Type Definitions
49
=======================================*/
51
/*=======================================
53
=======================================*/
55
/*=======================================
56
File Local Function Declarations
57
=======================================*/
59
/*=======================================
61
=======================================*/
62
/*===========================================================================
63
R5RS : 6.3 Other data types : 6.3.6 Vectors
64
===========================================================================*/
66
scm_p_vectorp(ScmObj obj)
68
DECLARE_FUNCTION("vector?", procedure_fixed_1);
70
return MAKE_BOOL(VECTORP(obj));
74
scm_p_make_vector(ScmObj scm_len, ScmObj args)
78
DECLARE_FUNCTION("make-vector", procedure_variadic_1);
82
len = SCM_INT_VALUE(scm_len);
84
ERR_OBJ("length must be a positive integer", scm_len);
86
vec = scm_malloc(sizeof(ScmObj) * len);
91
ASSERT_NO_MORE_ARG(args);
93
for (i = 0; i < len; i++)
96
return MAKE_VECTOR(vec, len);
100
scm_p_vector(ScmObj args)
102
DECLARE_FUNCTION("vector", procedure_variadic_0);
104
return scm_p_list2vector(args);
108
scm_p_vector_length(ScmObj vec)
110
DECLARE_FUNCTION("vector-length", procedure_fixed_1);
114
return MAKE_INT(SCM_VECTOR_LEN(vec));
118
scm_p_vector_ref(ScmObj vec, ScmObj _k)
121
DECLARE_FUNCTION("vector-ref", procedure_fixed_2);
126
k = SCM_INT_VALUE(_k);
128
if (!SCM_VECTOR_VALID_INDEXP(vec, k))
129
ERR_OBJ("index out of range", _k);
131
return SCM_VECTOR_VEC(vec)[k];
135
scm_p_vector_setx(ScmObj vec, ScmObj _k, ScmObj obj)
138
DECLARE_FUNCTION("vector-set!", procedure_fixed_3);
141
#if SCM_CONST_VECTOR_LITERAL
142
ENSURE_MUTABLE_VECTOR(vec);
146
k = SCM_INT_VALUE(_k);
148
if (!SCM_VECTOR_VALID_INDEXP(vec, k))
149
ERR_OBJ("index out of range", _k);
151
SCM_VECTOR_VEC(vec)[k] = obj;
157
scm_p_vector2list(ScmObj vec)
162
DECLARE_FUNCTION("vector->list", procedure_fixed_1);
166
v = SCM_VECTOR_VEC(vec);
167
len = SCM_VECTOR_LEN(vec);
170
SCM_QUEUE_POINT_TO(q, ret);
171
for (i = 0; i < len; i++)
172
SCM_QUEUE_ADD(q, v[i]);
178
scm_p_list2vector(ScmObj lst)
182
DECLARE_FUNCTION("list->vector", procedure_fixed_1);
184
len = scm_length(lst);
185
if (!SCM_LISTLEN_PROPERP(len))
186
ERR_OBJ("proper list required but got", lst);
188
vec = scm_malloc(sizeof(ScmObj) * len);
189
for (i = 0; i < len; i++)
192
return MAKE_VECTOR(vec, len);
196
scm_p_vector_fillx(ScmObj vec, ScmObj fill)
200
DECLARE_FUNCTION("vector-fill!", procedure_fixed_2);
203
#if SCM_CONST_VECTOR_LITERAL
204
ENSURE_MUTABLE_VECTOR(vec);
207
v = SCM_VECTOR_VEC(vec);
208
len = SCM_VECTOR_LEN(vec);
209
for (i = 0; i < len; i++)