1 /*
2 * Copyright (c) 2021 Calvin Rose
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "gc.h"
27 #include "util.h"
28 #include "state.h"
29 #endif
30
31 #include <string.h>
32
33 /* Creates a new array */
janet_array(int32_t capacity)34 JanetArray *janet_array(int32_t capacity) {
35 JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
36 Janet *data = NULL;
37 if (capacity > 0) {
38 janet_vm.next_collection += capacity * sizeof(Janet);
39 data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
40 if (NULL == data) {
41 JANET_OUT_OF_MEMORY;
42 }
43 }
44 array->count = 0;
45 array->capacity = capacity;
46 array->data = data;
47 return array;
48 }
49
50 /* Creates a new array from n elements. */
janet_array_n(const Janet * elements,int32_t n)51 JanetArray *janet_array_n(const Janet *elements, int32_t n) {
52 JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
53 array->capacity = n;
54 array->count = n;
55 array->data = janet_malloc(sizeof(Janet) * (size_t) n);
56 if (!array->data) {
57 JANET_OUT_OF_MEMORY;
58 }
59 safe_memcpy(array->data, elements, sizeof(Janet) * n);
60 return array;
61 }
62
63 /* Ensure the array has enough capacity for elements */
janet_array_ensure(JanetArray * array,int32_t capacity,int32_t growth)64 void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
65 Janet *newData;
66 Janet *old = array->data;
67 if (capacity <= array->capacity) return;
68 int64_t new_capacity = ((int64_t) capacity) * growth;
69 if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
70 capacity = (int32_t) new_capacity;
71 newData = janet_realloc(old, capacity * sizeof(Janet));
72 if (NULL == newData) {
73 JANET_OUT_OF_MEMORY;
74 }
75 janet_vm.next_collection += (capacity - array->capacity) * sizeof(Janet);
76 array->data = newData;
77 array->capacity = capacity;
78 }
79
80 /* Set the count of an array. Extend with nil if needed. */
janet_array_setcount(JanetArray * array,int32_t count)81 void janet_array_setcount(JanetArray *array, int32_t count) {
82 if (count < 0)
83 return;
84 if (count > array->count) {
85 int32_t i;
86 janet_array_ensure(array, count, 1);
87 for (i = array->count; i < count; i++) {
88 array->data[i] = janet_wrap_nil();
89 }
90 }
91 array->count = count;
92 }
93
94 /* Push a value to the top of the array */
janet_array_push(JanetArray * array,Janet x)95 void janet_array_push(JanetArray *array, Janet x) {
96 if (array->count == INT32_MAX) {
97 janet_panic("array overflow");
98 }
99 int32_t newcount = array->count + 1;
100 janet_array_ensure(array, newcount, 2);
101 array->data[array->count] = x;
102 array->count = newcount;
103 }
104
105 /* Pop a value from the top of the array */
janet_array_pop(JanetArray * array)106 Janet janet_array_pop(JanetArray *array) {
107 if (array->count) {
108 return array->data[--array->count];
109 } else {
110 return janet_wrap_nil();
111 }
112 }
113
114 /* Look at the last value in the array */
janet_array_peek(JanetArray * array)115 Janet janet_array_peek(JanetArray *array) {
116 if (array->count) {
117 return array->data[array->count - 1];
118 } else {
119 return janet_wrap_nil();
120 }
121 }
122
123 /* C Functions */
124
125 JANET_CORE_FN(cfun_array_new,
126 "(array/new capacity)",
127 "Creates a new empty array with a pre-allocated capacity. The same as "
128 "(array) but can be more efficient if the maximum size of an array is known.") {
129 janet_fixarity(argc, 1);
130 int32_t cap = janet_getinteger(argv, 0);
131 JanetArray *array = janet_array(cap);
132 return janet_wrap_array(array);
133 }
134
135 JANET_CORE_FN(cfun_array_new_filled,
136 "(array/new-filled count &opt value)",
137 "Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
138 janet_arity(argc, 1, 2);
139 int32_t count = janet_getinteger(argv, 0);
140 Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
141 JanetArray *array = janet_array(count);
142 for (int32_t i = 0; i < count; i++) {
143 array->data[i] = x;
144 }
145 array->count = count;
146 return janet_wrap_array(array);
147 }
148
149 JANET_CORE_FN(cfun_array_fill,
150 "(array/fill arr &opt value)",
151 "Replace all elements of an array with `value` (defaulting to nil) without changing the length of the array. "
152 "Returns the modified array.") {
153 janet_arity(argc, 1, 2);
154 JanetArray *array = janet_getarray(argv, 0);
155 Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
156 for (int32_t i = 0; i < array->count; i++) {
157 array->data[i] = x;
158 }
159 return argv[0];
160 }
161
162 JANET_CORE_FN(cfun_array_pop,
163 "(array/pop arr)",
164 "Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
165 "the input array.") {
166 janet_fixarity(argc, 1);
167 JanetArray *array = janet_getarray(argv, 0);
168 return janet_array_pop(array);
169 }
170
171 JANET_CORE_FN(cfun_array_peek,
172 "(array/peek arr)",
173 "Returns the last element of the array. Does not modify the array.") {
174 janet_fixarity(argc, 1);
175 JanetArray *array = janet_getarray(argv, 0);
176 return janet_array_peek(array);
177 }
178
179 JANET_CORE_FN(cfun_array_push,
180 "(array/push arr x)",
181 "Insert an element in the end of an array. Modifies the input array and returns it.") {
182 janet_arity(argc, 1, -1);
183 JanetArray *array = janet_getarray(argv, 0);
184 if (INT32_MAX - argc + 1 <= array->count) {
185 janet_panic("array overflow");
186 }
187 int32_t newcount = array->count - 1 + argc;
188 janet_array_ensure(array, newcount, 2);
189 if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet));
190 array->count = newcount;
191 return argv[0];
192 }
193
194 JANET_CORE_FN(cfun_array_ensure,
195 "(array/ensure arr capacity growth)",
196 "Ensures that the memory backing the array is large enough for `capacity` "
197 "items at the given rate of growth. Capacity and growth must be integers. "
198 "If the backing capacity is already enough, then this function does nothing. "
199 "Otherwise, the backing memory will be reallocated so that there is enough space.") {
200 janet_fixarity(argc, 3);
201 JanetArray *array = janet_getarray(argv, 0);
202 int32_t newcount = janet_getinteger(argv, 1);
203 int32_t growth = janet_getinteger(argv, 2);
204 if (newcount < 1) janet_panic("expected positive integer");
205 janet_array_ensure(array, newcount, growth);
206 return argv[0];
207 }
208
209 JANET_CORE_FN(cfun_array_slice,
210 "(array/slice arrtup &opt start end)",
211 "Takes a slice of array or tuple from `start` to `end`. The range is half open, "
212 "[start, end). Indexes can also be negative, indicating indexing from the "
213 "end of the array. By default, `start` is 0 and `end` is the length of the array. "
214 "Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
215 "negative slice range. Returns a new array.") {
216 JanetView view = janet_getindexed(argv, 0);
217 JanetRange range = janet_getslice(argc, argv);
218 JanetArray *array = janet_array(range.end - range.start);
219 if (array->data)
220 memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
221 array->count = range.end - range.start;
222 return janet_wrap_array(array);
223 }
224
225 JANET_CORE_FN(cfun_array_concat,
226 "(array/concat arr & parts)",
227 "Concatenates a variable number of arrays (and tuples) into the first argument, "
228 "which must be an array. If any of the parts are arrays or tuples, their elements will "
229 "be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. "
230 "Return the modified array `arr`.") {
231 int32_t i;
232 janet_arity(argc, 1, -1);
233 JanetArray *array = janet_getarray(argv, 0);
234 for (i = 1; i < argc; i++) {
235 switch (janet_type(argv[i])) {
236 default:
237 janet_array_push(array, argv[i]);
238 break;
239 case JANET_ARRAY:
240 case JANET_TUPLE: {
241 int32_t j, len = 0;
242 const Janet *vals = NULL;
243 janet_indexed_view(argv[i], &vals, &len);
244 if (array->data == vals) {
245 int32_t newcount = array->count + len;
246 janet_array_ensure(array, newcount, 2);
247 janet_indexed_view(argv[i], &vals, &len);
248 }
249 for (j = 0; j < len; j++)
250 janet_array_push(array, vals[j]);
251 }
252 break;
253 }
254 }
255 return janet_wrap_array(array);
256 }
257
258 JANET_CORE_FN(cfun_array_insert,
259 "(array/insert arr at & xs)",
260 "Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
261 "0 and the length of the array. A negative value for `at` will index backwards from "
262 "the end of the array, such that inserting at -1 appends to the array. "
263 "Returns the array.") {
264 size_t chunksize, restsize;
265 janet_arity(argc, 2, -1);
266 JanetArray *array = janet_getarray(argv, 0);
267 int32_t at = janet_getinteger(argv, 1);
268 if (at < 0) {
269 at = array->count + at + 1;
270 }
271 if (at < 0 || at > array->count)
272 janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
273 chunksize = (argc - 2) * sizeof(Janet);
274 restsize = (array->count - at) * sizeof(Janet);
275 if (INT32_MAX - (argc - 2) < array->count) {
276 janet_panic("array overflow");
277 }
278 janet_array_ensure(array, array->count + argc - 2, 2);
279 if (restsize) {
280 memmove(array->data + at + argc - 2,
281 array->data + at,
282 restsize);
283 }
284 safe_memcpy(array->data + at, argv + 2, chunksize);
285 array->count += (argc - 2);
286 return argv[0];
287 }
288
289 JANET_CORE_FN(cfun_array_remove,
290 "(array/remove arr at &opt n)",
291 "Remove up to `n` elements starting at index `at` in array `arr`. `at` can index from "
292 "the end of the array with a negative index, and `n` must be a non-negative integer. "
293 "By default, `n` is 1. "
294 "Returns the array.") {
295 janet_arity(argc, 2, 3);
296 JanetArray *array = janet_getarray(argv, 0);
297 int32_t at = janet_getinteger(argv, 1);
298 int32_t n = 1;
299 if (at < 0) {
300 at = array->count + at + 1;
301 }
302 if (at < 0 || at > array->count)
303 janet_panicf("removal index %d out of range [0,%d]", at, array->count);
304 if (argc == 3) {
305 n = janet_getinteger(argv, 2);
306 if (n < 0)
307 janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
308 }
309 if (at + n > array->count) {
310 n = array->count - at;
311 }
312 memmove(array->data + at,
313 array->data + at + n,
314 (array->count - at - n) * sizeof(Janet));
315 array->count -= n;
316 return argv[0];
317 }
318
319 JANET_CORE_FN(cfun_array_trim,
320 "(array/trim arr)",
321 "Set the backing capacity of an array to its current length. Returns the modified array.") {
322 janet_fixarity(argc, 1);
323 JanetArray *array = janet_getarray(argv, 0);
324 if (array->count) {
325 if (array->count < array->capacity) {
326 Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
327 if (NULL == newData) {
328 JANET_OUT_OF_MEMORY;
329 }
330 array->data = newData;
331 array->capacity = array->count;
332 }
333 } else {
334 array->capacity = 0;
335 janet_free(array->data);
336 array->data = NULL;
337 }
338 return argv[0];
339 }
340
341 JANET_CORE_FN(cfun_array_clear,
342 "(array/clear arr)",
343 "Empties an array, setting it's count to 0 but does not free the backing capacity. "
344 "Returns the modified array.") {
345 janet_fixarity(argc, 1);
346 JanetArray *array = janet_getarray(argv, 0);
347 array->count = 0;
348 return argv[0];
349 }
350
351 /* Load the array module */
janet_lib_array(JanetTable * env)352 void janet_lib_array(JanetTable *env) {
353 JanetRegExt array_cfuns[] = {
354 JANET_CORE_REG("array/new", cfun_array_new),
355 JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
356 JANET_CORE_REG("array/fill", cfun_array_fill),
357 JANET_CORE_REG("array/pop", cfun_array_pop),
358 JANET_CORE_REG("array/peek", cfun_array_peek),
359 JANET_CORE_REG("array/push", cfun_array_push),
360 JANET_CORE_REG("array/ensure", cfun_array_ensure),
361 JANET_CORE_REG("array/slice", cfun_array_slice),
362 JANET_CORE_REG("array/concat", cfun_array_concat),
363 JANET_CORE_REG("array/insert", cfun_array_insert),
364 JANET_CORE_REG("array/remove", cfun_array_remove),
365 JANET_CORE_REG("array/trim", cfun_array_trim),
366 JANET_CORE_REG("array/clear", cfun_array_clear),
367 JANET_REG_END
368 };
369 janet_core_cfuns_ext(env, NULL, array_cfuns);
370 }
371