~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to sigscheme/src/vector.c

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*===========================================================================
 
2
 *  Filename : vector.c
 
3
 *  About    : R5RS vectors
 
4
 *
 
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>
 
9
 *
 
10
 *  All rights reserved.
 
11
 *
 
12
 *  Redistribution and use in source and binary forms, with or without
 
13
 *  modification, are permitted provided that the following conditions
 
14
 *  are met:
 
15
 *
 
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.
 
24
 *
 
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
===========================================================================*/
 
37
 
 
38
#include <config.h>
 
39
 
 
40
#include "sigscheme.h"
 
41
#include "sigschemeinternal.h"
 
42
 
 
43
/*=======================================
 
44
  File Local Macro Definitions
 
45
=======================================*/
 
46
 
 
47
/*=======================================
 
48
  File Local Type Definitions
 
49
=======================================*/
 
50
 
 
51
/*=======================================
 
52
  Variable Definitions
 
53
=======================================*/
 
54
 
 
55
/*=======================================
 
56
  File Local Function Declarations
 
57
=======================================*/
 
58
 
 
59
/*=======================================
 
60
  Function Definitions
 
61
=======================================*/
 
62
/*===========================================================================
 
63
  R5RS : 6.3 Other data types : 6.3.6 Vectors
 
64
===========================================================================*/
 
65
SCM_EXPORT ScmObj
 
66
scm_p_vectorp(ScmObj obj)
 
67
{
 
68
    DECLARE_FUNCTION("vector?", procedure_fixed_1);
 
69
 
 
70
    return MAKE_BOOL(VECTORP(obj));
 
71
}
 
72
 
 
73
SCM_EXPORT ScmObj
 
74
scm_p_make_vector(ScmObj scm_len, ScmObj args)
 
75
{
 
76
    ScmObj *vec, filler;
 
77
    scm_int_t len, i;
 
78
    DECLARE_FUNCTION("make-vector", procedure_variadic_1);
 
79
 
 
80
    ENSURE_INT(scm_len);
 
81
 
 
82
    len = SCM_INT_VALUE(scm_len);
 
83
    if (len < 0)
 
84
        ERR_OBJ("length must be a positive integer", scm_len);
 
85
 
 
86
    vec = scm_malloc(sizeof(ScmObj) * len);
 
87
    if (NULLP(args)) {
 
88
        filler = SCM_UNDEF;
 
89
    } else {
 
90
        filler = POP(args);
 
91
        ASSERT_NO_MORE_ARG(args);
 
92
    }
 
93
    for (i = 0; i < len; i++)
 
94
        vec[i] = filler;
 
95
 
 
96
    return MAKE_VECTOR(vec, len);
 
97
}
 
98
 
 
99
SCM_EXPORT ScmObj
 
100
scm_p_vector(ScmObj args)
 
101
{
 
102
    DECLARE_FUNCTION("vector", procedure_variadic_0);
 
103
 
 
104
    return scm_p_list2vector(args);
 
105
}
 
106
 
 
107
SCM_EXPORT ScmObj
 
108
scm_p_vector_length(ScmObj vec)
 
109
{
 
110
    DECLARE_FUNCTION("vector-length", procedure_fixed_1);
 
111
 
 
112
    ENSURE_VECTOR(vec);
 
113
 
 
114
    return MAKE_INT(SCM_VECTOR_LEN(vec));
 
115
}
 
116
 
 
117
SCM_EXPORT ScmObj
 
118
scm_p_vector_ref(ScmObj vec, ScmObj _k)
 
119
{
 
120
    scm_int_t k;
 
121
    DECLARE_FUNCTION("vector-ref", procedure_fixed_2);
 
122
 
 
123
    ENSURE_VECTOR(vec);
 
124
    ENSURE_INT(_k);
 
125
 
 
126
    k = SCM_INT_VALUE(_k);
 
127
 
 
128
    if (!SCM_VECTOR_VALID_INDEXP(vec, k))
 
129
        ERR_OBJ("index out of range", _k);
 
130
 
 
131
    return SCM_VECTOR_VEC(vec)[k];
 
132
}
 
133
 
 
134
SCM_EXPORT ScmObj
 
135
scm_p_vector_setx(ScmObj vec, ScmObj _k, ScmObj obj)
 
136
{
 
137
    scm_int_t k;
 
138
    DECLARE_FUNCTION("vector-set!", procedure_fixed_3);
 
139
 
 
140
    ENSURE_VECTOR(vec);
 
141
#if SCM_CONST_VECTOR_LITERAL
 
142
    ENSURE_MUTABLE_VECTOR(vec);
 
143
#endif
 
144
    ENSURE_INT(_k);
 
145
 
 
146
    k = SCM_INT_VALUE(_k);
 
147
 
 
148
    if (!SCM_VECTOR_VALID_INDEXP(vec, k))
 
149
        ERR_OBJ("index out of range", _k);
 
150
 
 
151
    SCM_VECTOR_VEC(vec)[k] = obj;
 
152
 
 
153
    return SCM_UNDEF;
 
154
}
 
155
 
 
156
SCM_EXPORT ScmObj
 
157
scm_p_vector2list(ScmObj vec)
 
158
{
 
159
    ScmQueue q;
 
160
    ScmObj ret, *v;
 
161
    scm_int_t len, i;
 
162
    DECLARE_FUNCTION("vector->list", procedure_fixed_1);
 
163
 
 
164
    ENSURE_VECTOR(vec);
 
165
 
 
166
    v   = SCM_VECTOR_VEC(vec);
 
167
    len = SCM_VECTOR_LEN(vec);
 
168
 
 
169
    ret = SCM_NULL;
 
170
    SCM_QUEUE_POINT_TO(q, ret);
 
171
    for (i = 0; i < len; i++)
 
172
        SCM_QUEUE_ADD(q, v[i]);
 
173
 
 
174
    return ret;
 
175
}
 
176
 
 
177
SCM_EXPORT ScmObj
 
178
scm_p_list2vector(ScmObj lst)
 
179
{
 
180
    ScmObj *vec;
 
181
    scm_int_t len, i;
 
182
    DECLARE_FUNCTION("list->vector", procedure_fixed_1);
 
183
 
 
184
    len = scm_length(lst);
 
185
    if (!SCM_LISTLEN_PROPERP(len))
 
186
        ERR_OBJ("proper list required but got", lst);
 
187
 
 
188
    vec = scm_malloc(sizeof(ScmObj) * len);
 
189
    for (i = 0; i < len; i++)
 
190
        vec[i] = POP(lst);
 
191
 
 
192
    return MAKE_VECTOR(vec, len);
 
193
}
 
194
 
 
195
SCM_EXPORT ScmObj
 
196
scm_p_vector_fillx(ScmObj vec, ScmObj fill)
 
197
{
 
198
    ScmObj *v;
 
199
    scm_int_t len, i;
 
200
    DECLARE_FUNCTION("vector-fill!", procedure_fixed_2);
 
201
 
 
202
    ENSURE_VECTOR(vec);
 
203
#if SCM_CONST_VECTOR_LITERAL
 
204
    ENSURE_MUTABLE_VECTOR(vec);
 
205
#endif
 
206
 
 
207
    v   = SCM_VECTOR_VEC(vec);
 
208
    len = SCM_VECTOR_LEN(vec);
 
209
    for (i = 0; i < len; i++)
 
210
        v[i] = fill;
 
211
 
 
212
    return vec;
 
213
}