2019-02-05 17:45:04 +00:00
|
|
|
#include <stdlib.h>
|
2019-02-19 01:13:35 +00:00
|
|
|
#include <janet.h>
|
2019-02-05 17:45:04 +00:00
|
|
|
|
|
|
|
typedef struct {
|
2019-02-20 01:51:34 +00:00
|
|
|
double *data;
|
2019-02-06 00:11:43 +00:00
|
|
|
size_t size;
|
2019-02-05 17:45:04 +00:00
|
|
|
} num_array;
|
|
|
|
|
2019-02-20 01:51:34 +00:00
|
|
|
static num_array *num_array_init(num_array *array, size_t size) {
|
|
|
|
array->data = (double *)calloc(size, sizeof(double));
|
|
|
|
array->size = size;
|
2019-02-06 00:11:43 +00:00
|
|
|
return array;
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
2019-02-20 01:51:34 +00:00
|
|
|
static void num_array_deinit(num_array *array) {
|
2019-02-06 00:11:43 +00:00
|
|
|
free(array->data);
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static int num_array_gc(void *p, size_t s) {
|
2019-02-06 00:11:43 +00:00
|
|
|
(void) s;
|
2019-02-20 01:51:34 +00:00
|
|
|
num_array *array = (num_array *)p;
|
2019-02-06 00:11:43 +00:00
|
|
|
num_array_deinit(array);
|
|
|
|
return 0;
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
2020-05-24 09:30:23 +00:00
|
|
|
int num_array_get(void *p, Janet key, Janet *out);
|
2019-02-05 17:45:04 +00:00
|
|
|
void num_array_put(void *p, Janet key, Janet value);
|
|
|
|
|
|
|
|
static const JanetAbstractType num_array_type = {
|
|
|
|
"numarray",
|
|
|
|
num_array_gc,
|
|
|
|
NULL,
|
|
|
|
num_array_get,
|
2020-05-24 09:30:23 +00:00
|
|
|
num_array_put,
|
|
|
|
JANET_ATEND_PUT
|
2019-02-05 17:45:04 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
static Janet num_array_new(int32_t argc, Janet *argv) {
|
2019-02-06 00:11:43 +00:00
|
|
|
janet_fixarity(argc, 1);
|
2019-02-20 01:51:34 +00:00
|
|
|
int32_t size = janet_getinteger(argv, 0);
|
|
|
|
num_array *array = (num_array *)janet_abstract(&num_array_type, sizeof(num_array));
|
|
|
|
num_array_init(array, size);
|
2019-02-06 00:11:43 +00:00
|
|
|
return janet_wrap_abstract(array);
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static Janet num_array_scale(int32_t argc, Janet *argv) {
|
2019-02-06 00:11:43 +00:00
|
|
|
janet_fixarity(argc, 2);
|
2019-02-20 01:51:34 +00:00
|
|
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
|
|
|
double factor = janet_getnumber(argv, 1);
|
2019-02-06 00:11:43 +00:00
|
|
|
size_t i;
|
2019-02-20 01:51:34 +00:00
|
|
|
for (i = 0; i < array->size; i++) {
|
|
|
|
array->data[i] *= factor;
|
2019-02-06 00:11:43 +00:00
|
|
|
}
|
|
|
|
return argv[0];
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static Janet num_array_sum(int32_t argc, Janet *argv) {
|
2019-02-06 00:11:43 +00:00
|
|
|
janet_fixarity(argc, 1);
|
2019-02-20 01:51:34 +00:00
|
|
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
2019-02-06 00:11:43 +00:00
|
|
|
double sum = 0;
|
2019-02-20 01:51:34 +00:00
|
|
|
for (size_t i = 0; i < array->size; i++) sum += array->data[i];
|
2019-02-06 00:11:43 +00:00
|
|
|
return janet_wrap_number(sum);
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
void num_array_put(void *p, Janet key, Janet value) {
|
2019-02-06 00:11:43 +00:00
|
|
|
size_t index;
|
2019-02-20 01:51:34 +00:00
|
|
|
num_array *array = (num_array *)p;
|
2019-02-06 00:11:43 +00:00
|
|
|
if (!janet_checkint(key))
|
|
|
|
janet_panic("expected integer key");
|
2019-02-20 01:51:34 +00:00
|
|
|
if (!janet_checktype(value, JANET_NUMBER))
|
2019-02-06 00:11:43 +00:00
|
|
|
janet_panic("expected number value");
|
|
|
|
|
|
|
|
index = (size_t)janet_unwrap_integer(key);
|
|
|
|
if (index < array->size) {
|
2019-02-20 01:51:34 +00:00
|
|
|
array->data[index] = janet_unwrap_number(value);
|
2019-02-06 00:11:43 +00:00
|
|
|
}
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
2019-02-06 00:49:10 +00:00
|
|
|
static const JanetMethod methods[] = {
|
|
|
|
{"scale", num_array_scale},
|
|
|
|
{"sum", num_array_sum},
|
|
|
|
{NULL, NULL}
|
2019-02-05 17:45:04 +00:00
|
|
|
};
|
|
|
|
|
2020-05-24 09:30:23 +00:00
|
|
|
int num_array_get(void *p, Janet key, Janet *out) {
|
2019-02-06 00:11:43 +00:00
|
|
|
size_t index;
|
2019-02-20 01:51:34 +00:00
|
|
|
num_array *array = (num_array *)p;
|
2019-02-06 00:49:10 +00:00
|
|
|
if (janet_checktype(key, JANET_KEYWORD))
|
2020-05-24 09:30:23 +00:00
|
|
|
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
|
2019-02-06 00:11:43 +00:00
|
|
|
if (!janet_checkint(key))
|
|
|
|
janet_panic("expected integer key");
|
|
|
|
index = (size_t)janet_unwrap_integer(key);
|
|
|
|
if (index >= array->size) {
|
2020-05-24 09:30:23 +00:00
|
|
|
return 0;
|
2019-02-06 00:11:43 +00:00
|
|
|
} else {
|
2020-05-24 09:30:23 +00:00
|
|
|
*out = janet_wrap_number(array->data[index]);
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
2020-05-24 09:30:23 +00:00
|
|
|
return 1;
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static const JanetReg cfuns[] = {
|
2019-02-20 01:51:34 +00:00
|
|
|
{
|
2019-04-21 17:34:41 +00:00
|
|
|
"new", num_array_new,
|
2019-02-06 00:11:43 +00:00
|
|
|
"(numarray/new size)\n\n"
|
2019-02-20 01:51:34 +00:00
|
|
|
"Create new numarray"
|
2019-02-06 00:11:43 +00:00
|
|
|
},
|
2019-02-20 01:51:34 +00:00
|
|
|
{
|
2019-04-21 17:34:41 +00:00
|
|
|
"scale", num_array_scale,
|
2019-02-06 00:11:43 +00:00
|
|
|
"(numarray/scale numarray factor)\n\n"
|
2019-02-20 01:51:34 +00:00
|
|
|
"scale numarray by factor"
|
2019-02-06 00:11:43 +00:00
|
|
|
},
|
2019-02-20 01:51:34 +00:00
|
|
|
{NULL, NULL, NULL}
|
2019-02-05 17:45:04 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
JANET_MODULE_ENTRY(JanetTable *env) {
|
2019-02-06 00:11:43 +00:00
|
|
|
janet_cfuns(env, "numarray", cfuns);
|
2019-02-05 17:45:04 +00:00
|
|
|
}
|