Laria Carolin Chabowski
0361000e7c
We'll soon need the full apfl_ctx, where we previously only needed the gc. apflc was the only place manually constructing a struct gc without an apfl_ctx, so lets change that.
887 lines
25 KiB
C
887 lines
25 KiB
C
#include <assert.h>
|
|
#include <errno.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
|
|
#include "apfl.h"
|
|
|
|
#include "alloc.h"
|
|
#include "bytecode.h"
|
|
#include "context.h"
|
|
#include "globals.h"
|
|
#include "modules.h"
|
|
#include "parsing.h"
|
|
#include "scope.h"
|
|
|
|
#define TRY_FORMAT(ctx, x) \
|
|
do { \
|
|
if (!(x)) { \
|
|
apfl_raise_const_error((ctx), apfl_messages.io_error); \
|
|
} \
|
|
} while (0)
|
|
|
|
static void
|
|
call_then_or_else(apfl_ctx ctx, size_t arg)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, arg);
|
|
apfl_list_create(ctx, 0);
|
|
apfl_call(ctx, -2, -1);
|
|
}
|
|
|
|
static void
|
|
impl_if(apfl_ctx ctx)
|
|
{
|
|
size_t len = apfl_len(ctx, 0);
|
|
|
|
if (len < 2) {
|
|
apfl_raise_const_error(ctx, "if needs at least 2 arguments");
|
|
}
|
|
|
|
size_t i = 0;
|
|
while (i+1 < len) {
|
|
size_t cond = i++;
|
|
size_t then = i++;
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, cond);
|
|
if (apfl_get_type(ctx, -1) == APFL_VALUE_FUNC) {
|
|
apfl_list_create(ctx, 0);
|
|
apfl_call(ctx, -2, -1);
|
|
}
|
|
|
|
if (apfl_is_truthy(ctx, -1)) {
|
|
apfl_get_list_member_by_index(ctx, 0, then);
|
|
apfl_list_create(ctx, 0);
|
|
apfl_call(ctx, -2, -1);
|
|
return;
|
|
}
|
|
}
|
|
|
|
if (i == len) {
|
|
// Empty else. Return nil
|
|
apfl_push_nil(ctx);
|
|
} else {
|
|
assert(i+1 == len /*exactly one argument remains as final else*/);
|
|
|
|
call_then_or_else(ctx, i);
|
|
}
|
|
}
|
|
|
|
static void
|
|
impl_eq(apfl_ctx ctx)
|
|
{
|
|
size_t len = apfl_len(ctx, 0);
|
|
if (len < 2) {
|
|
apfl_raise_const_error(ctx, "== needs at least 2 arguments");
|
|
}
|
|
|
|
for (size_t i = 0; i < len-1; i++) {
|
|
apfl_get_list_member_by_index(ctx, 0, i);
|
|
apfl_get_list_member_by_index(ctx, 0, i+1);
|
|
if (!apfl_eq(ctx, -2, -1)) {
|
|
apfl_push_bool(ctx, false);
|
|
return;
|
|
}
|
|
}
|
|
|
|
apfl_push_bool(ctx, true);
|
|
}
|
|
|
|
#define IMPLEMENT_COMPARISON(impl_name, name, cmp) \
|
|
static void \
|
|
impl_name(apfl_ctx ctx) \
|
|
{ \
|
|
size_t len = apfl_len(ctx, 0); \
|
|
if (len < 2) { \
|
|
apfl_raise_const_error(ctx, name " needs at least 2 arguments"); \
|
|
} \
|
|
\
|
|
for (size_t i = 0; i < len-1; i++) { \
|
|
apfl_get_list_member_by_index(ctx, 0, i); \
|
|
apfl_get_list_member_by_index(ctx, 0, i+1); \
|
|
if (!(apfl_cmp(ctx, -2, -1) cmp 0)) { \
|
|
apfl_push_bool(ctx, false); \
|
|
return; \
|
|
} \
|
|
} \
|
|
\
|
|
apfl_push_bool(ctx, true); \
|
|
} \
|
|
|
|
IMPLEMENT_COMPARISON(impl_gt, ">", >)
|
|
IMPLEMENT_COMPARISON(impl_lt, "<", <)
|
|
IMPLEMENT_COMPARISON(impl_ge, ">=", >=)
|
|
IMPLEMENT_COMPARISON(impl_le, "<=", <=)
|
|
|
|
#define IMPL_MATH_OP(name, op) \
|
|
static apfl_number \
|
|
name(apfl_ctx ctx, apfl_number a, apfl_number b) \
|
|
{ \
|
|
(void)ctx; \
|
|
return a op b; \
|
|
}
|
|
|
|
#define IMPL_MATH_OP_FUNC(impl, name, single, op) \
|
|
static void \
|
|
impl(apfl_ctx ctx) \
|
|
{ \
|
|
size_t len = apfl_len(ctx, 0); \
|
|
if (len < 1) { \
|
|
apfl_raise_const_error(ctx, name " needs at least 1 argument"); \
|
|
} \
|
|
\
|
|
apfl_get_list_member_by_index(ctx, 0, 0); \
|
|
apfl_number num = apfl_get_number(ctx, -1); \
|
|
if (len == 1) { \
|
|
apfl_push_number(ctx, single(num)); \
|
|
return; \
|
|
} \
|
|
\
|
|
for (size_t i = 1; i < len; i++) { \
|
|
apfl_get_list_member_by_index(ctx, 0, i); \
|
|
num = op(ctx, num, apfl_get_number(ctx, -1)); \
|
|
} \
|
|
\
|
|
apfl_push_number(ctx, num); \
|
|
}
|
|
|
|
static apfl_number
|
|
single_identity(apfl_number number)
|
|
{
|
|
return number;
|
|
}
|
|
|
|
static apfl_number
|
|
single_negate(apfl_number number)
|
|
{
|
|
return -number;
|
|
}
|
|
|
|
IMPL_MATH_OP(op_plus, +)
|
|
IMPL_MATH_OP(op_minus, -)
|
|
IMPL_MATH_OP(op_mult, *)
|
|
IMPL_MATH_OP_FUNC(impl_plus, "+", single_identity, op_plus)
|
|
IMPL_MATH_OP_FUNC(impl_minus, "-", single_negate, op_minus)
|
|
IMPL_MATH_OP_FUNC(impl_mult, "*", single_identity, op_mult)
|
|
|
|
static apfl_number
|
|
op_div(apfl_ctx ctx, apfl_number a, apfl_number b)
|
|
{
|
|
if (b == 0.0 || b == -0.0) { // apfl_number is a double, so there are technically two zeroes :/
|
|
apfl_raise_const_error(ctx, "Division by zero");
|
|
}
|
|
return a / b;
|
|
}
|
|
|
|
IMPL_MATH_OP_FUNC(impl_div, "/", single_identity, op_div)
|
|
|
|
static void
|
|
impl_concat(apfl_ctx ctx)
|
|
{
|
|
apfl_push_const_string(ctx, "");
|
|
apfl_join_strings(ctx, -1, -2);
|
|
}
|
|
|
|
static void
|
|
impl_join(apfl_ctx ctx)
|
|
{
|
|
size_t len = apfl_len(ctx, 0);
|
|
if (len != 2) {
|
|
apfl_raise_const_error(ctx, "join expects exactly 2 arguments");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_drop(ctx, 0);
|
|
apfl_join_strings(ctx, -2, -1);
|
|
}
|
|
|
|
static void
|
|
print(apfl_ctx ctx)
|
|
{
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
|
|
size_t len = apfl_len(ctx, 0);
|
|
for (size_t i = 0; i < len; i++) {
|
|
if (i > 0) {
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, " "));
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, i);
|
|
apfl_tostring(ctx, -1);
|
|
struct apfl_string_view sv = apfl_get_string(ctx, -1);
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, sv));
|
|
apfl_drop(ctx, -1);
|
|
}
|
|
|
|
if (len > 0) {
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "\n"));
|
|
}
|
|
|
|
apfl_push_nil(ctx);
|
|
}
|
|
|
|
static void
|
|
dump(apfl_ctx ctx)
|
|
{
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_drop(ctx, 0);
|
|
TRY_FORMAT(ctx, apfl_debug_print_val(ctx, -1, w));
|
|
}
|
|
|
|
static void
|
|
disasm(apfl_ctx ctx)
|
|
{
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_drop(ctx, 0);
|
|
struct apfl_value value = apfl_stack_must_get(ctx, -1);
|
|
if (value.type == VALUE_CFUNC) {
|
|
apfl_raise_const_error(ctx, "disasm needs a apfl function, got a native function instead");
|
|
} else if (value.type != VALUE_FUNC) {
|
|
apfl_raise_errorfmt(ctx, "disasm needs a apfl function, got value of type {value:type} instead", value);
|
|
}
|
|
|
|
struct function *func = value.func;
|
|
|
|
for (size_t i = 0; i < func->subfunctions_len; i++) {
|
|
struct subfunction *subfunction = &func->subfunctions[i];
|
|
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "Subfunction #"));
|
|
TRY_FORMAT(ctx, apfl_format_put_number(w, (int)i));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "\n"));
|
|
if (subfunction->matcher == NULL) {
|
|
TRY_FORMAT(ctx, apfl_format_put_indent(w, 1));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "No matcher (matches everything)\n"));
|
|
} else {
|
|
TRY_FORMAT(ctx, apfl_format_put_indent(w, 1));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "Matcher\n"));
|
|
TRY_FORMAT(ctx, apfl_bytecode_dump_matcher(2, w, subfunction->matcher->instructions));
|
|
}
|
|
TRY_FORMAT(ctx, apfl_format_put_indent(w, 1));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "Instructions\n"));
|
|
TRY_FORMAT(ctx, apfl_bytecode_dump(2, w, subfunction->body));
|
|
}
|
|
}
|
|
|
|
static void
|
|
require_exactly_one_arg(apfl_ctx ctx, const char *error)
|
|
{
|
|
size_t len = apfl_len(ctx, 0);
|
|
if (len != 1) {
|
|
apfl_raise_const_error(ctx, error);
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_drop(ctx, 0);
|
|
}
|
|
|
|
#define ONE_ARG(ctx, name) require_exactly_one_arg((ctx), name " needs exactly 1 argument")
|
|
|
|
static void
|
|
tostring(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "tostring");
|
|
apfl_tostring(ctx, -1);
|
|
}
|
|
|
|
struct numparse_data {
|
|
struct apfl_string_view sv;
|
|
size_t off;
|
|
};
|
|
|
|
static enum read_result
|
|
numparse_read(void *opaque, unsigned char *b)
|
|
{
|
|
struct numparse_data *data = opaque;
|
|
if (data->off >= data->sv.len) {
|
|
return RR_EOF;
|
|
}
|
|
|
|
*b = data->sv.bytes[data->off];
|
|
data->off++;
|
|
return RR_OK;
|
|
}
|
|
|
|
static void
|
|
numparse_unread(void *opaque)
|
|
{
|
|
struct numparse_data *data = opaque;
|
|
assert(data->off > 0);
|
|
data->off--;
|
|
}
|
|
|
|
static void
|
|
tonumber(apfl_ctx ctx)
|
|
{
|
|
(void)ctx;
|
|
if (apfl_len(ctx, 0) != 2) {
|
|
apfl_raise_const_error(ctx, "tonumber needs exactly 2 arguments");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
unsigned base = (unsigned)apfl_get_number(ctx, -1);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
struct apfl_string_view sv = apfl_get_string(ctx, -1);
|
|
apfl_drop(ctx, 0);
|
|
|
|
if (base < 2 || base > 36) {
|
|
apfl_raise_const_error(ctx, "base must be between 2 and 36");
|
|
}
|
|
|
|
bool negative = false;
|
|
if (sv.len > 0 && sv.bytes[0] == '-') {
|
|
negative = true;
|
|
sv = apfl_string_view_offset(sv, 1);
|
|
}
|
|
|
|
apfl_number number = 0;
|
|
struct numparse_data data = {
|
|
.sv = sv,
|
|
.off = 0,
|
|
};
|
|
bool ok = apfl_parse_number(base, numparse_read, numparse_unread, &data, &number);
|
|
assert(ok);
|
|
|
|
if (data.off != sv.len) {
|
|
apfl_raise_const_error(ctx, "Can not parse as number");
|
|
}
|
|
|
|
if (negative) {
|
|
number *= -1;
|
|
}
|
|
|
|
apfl_push_number(ctx, number);
|
|
}
|
|
|
|
static void
|
|
not(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "not");
|
|
bool b = apfl_is_truthy(ctx, -1);
|
|
apfl_push_bool(ctx, !b);
|
|
}
|
|
|
|
static void
|
|
len(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "len");
|
|
size_t l = apfl_len(ctx, -1);
|
|
apfl_push_number(ctx, (apfl_number)l);
|
|
}
|
|
|
|
static void
|
|
type(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "type");
|
|
apfl_push_const_string(ctx, apfl_type_name(apfl_get_type(ctx, -1)));
|
|
}
|
|
|
|
static void
|
|
impl_loop(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "loop");
|
|
apfl_list_create(ctx, 0);
|
|
for (;;) {
|
|
apfl_copy(ctx, -2);
|
|
apfl_copy(ctx, -2);
|
|
apfl_call(ctx, -2, -1);
|
|
if (!apfl_is_truthy(ctx, -1)) {
|
|
apfl_push_nil(ctx);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
static void
|
|
impl_gc(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "gc");
|
|
apfl_tostring(ctx, -1);
|
|
struct apfl_string_view sv = apfl_get_string(ctx, -1);
|
|
|
|
if (apfl_string_eq(sv, "dump")) {
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
TRY_FORMAT(ctx, apfl_gc_debug_dump_graph(&ctx->gc, w));
|
|
} else if (apfl_string_eq(sv, "collect")) {
|
|
apfl_gc_full(&ctx->gc);
|
|
} else if (apfl_string_eq(sv, "blockstats")) {
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
TRY_FORMAT(ctx, apfl_gc_debug_blockstats(&ctx->gc, w));
|
|
} else {
|
|
apfl_raise_const_error(ctx, "Unknown gc command");
|
|
}
|
|
|
|
apfl_drop(ctx, -1);
|
|
}
|
|
|
|
static void
|
|
impl_backtrace(apfl_ctx ctx)
|
|
{
|
|
apfl_drop(ctx, -1);
|
|
|
|
struct apfl_io_writer w = apfl_get_output_writer(ctx);
|
|
|
|
size_t depth = apfl_call_stack_depth(ctx);
|
|
for (size_t i = 1; i < depth; i++) {
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "#"));
|
|
TRY_FORMAT(ctx, apfl_format_put_int(w, (int)i));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, ": "));
|
|
TRY_FORMAT(ctx, apfl_call_stack_entry_info_format(
|
|
w,
|
|
apfl_call_stack_inspect(ctx, i)
|
|
));
|
|
TRY_FORMAT(ctx, apfl_io_write_string(w, "\n"));
|
|
}
|
|
}
|
|
|
|
static void
|
|
closefile(FILE **f)
|
|
{
|
|
if (*f != NULL) {
|
|
fclose(*f);
|
|
*f = NULL;
|
|
}
|
|
}
|
|
|
|
static void
|
|
file_onbeforecollect(void *opaque)
|
|
{
|
|
FILE **f = opaque;
|
|
closefile(f);
|
|
}
|
|
|
|
static struct apfl_native_object_type file_object = {
|
|
.size = sizeof(FILE *),
|
|
.onbeforecollect = file_onbeforecollect,
|
|
};
|
|
|
|
static const char *
|
|
getcstring(apfl_ctx ctx, apfl_stackidx index)
|
|
{
|
|
apfl_move_to_top_of_stack(ctx, index);
|
|
apfl_push_string_view_copy(ctx, (struct apfl_string_view) { .bytes = (unsigned char [1]) {'\0'}, .len = 1, });
|
|
apfl_concat_strings(ctx, -2, -1);
|
|
return (const char *)apfl_get_string(ctx, -1).bytes;
|
|
}
|
|
|
|
static void
|
|
raise_errno(apfl_ctx ctx)
|
|
{
|
|
char *err = strerror(errno);
|
|
apfl_push_string_view_copy(ctx, apfl_string_view_from(err));
|
|
apfl_raise_error(ctx, -1);
|
|
}
|
|
|
|
static void
|
|
impl_fopen(apfl_ctx ctx)
|
|
{
|
|
size_t argc = apfl_len(ctx, 0);
|
|
if (argc == 0) {
|
|
apfl_raise_const_error(ctx, "fopen needs at least one argument");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
const char *filename = getcstring(ctx, -1);
|
|
|
|
if (argc > 1) {
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
} else {
|
|
apfl_push_const_string(ctx," rb");
|
|
}
|
|
const char *mode = getcstring(ctx, -1);
|
|
|
|
FILE **fh = apfl_push_native_object(ctx, &file_object);
|
|
|
|
*fh = fopen(filename, mode);
|
|
if (*fh == NULL) {
|
|
raise_errno(ctx);
|
|
}
|
|
}
|
|
|
|
static void
|
|
impl_fread(apfl_ctx ctx)
|
|
{
|
|
size_t argc = apfl_len(ctx, 0);
|
|
if (argc != 2) {
|
|
apfl_raise_const_error(ctx, "fread needs exactly 2 arguments");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
FILE **fh = apfl_get_native_object(ctx, &file_object, -1);
|
|
if (*fh == NULL) {
|
|
apfl_raise_const_error(ctx, "File already closed");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_number presize = apfl_get_number(ctx, -1);
|
|
if (presize < 0) {
|
|
apfl_raise_const_error(ctx, "Can not read a negative amount of bytes from file");
|
|
}
|
|
|
|
size_t size = (size_t)presize;
|
|
|
|
unsigned char *buf = ALLOC_BYTES(ctx->gc.allocator, size);
|
|
if (buf == NULL) {
|
|
apfl_raise_alloc_error(ctx);
|
|
}
|
|
|
|
size_t actual = fread(buf, 1, size, *fh);
|
|
|
|
if (!apfl_move_string_onto_stack(ctx, (struct apfl_string) {
|
|
.bytes = buf,
|
|
.len = actual,
|
|
.cap = size,
|
|
})) {
|
|
FREE_BYTES(ctx->gc.allocator, buf, size);
|
|
}
|
|
}
|
|
|
|
static void
|
|
impl_fwrite(apfl_ctx ctx)
|
|
{
|
|
size_t argc = apfl_len(ctx, 0);
|
|
if (argc != 2) {
|
|
apfl_raise_const_error(ctx, "fread needs exactly 2 arguments");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
FILE **fh = apfl_get_native_object(ctx, &file_object, -1);
|
|
if (*fh == NULL) {
|
|
apfl_raise_const_error(ctx, "File already closed");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
struct apfl_string_view sv = apfl_get_string(ctx, -1);
|
|
if (fwrite(sv.bytes, 1, sv.len, *fh) != sv.len) {
|
|
raise_errno(ctx);
|
|
}
|
|
|
|
apfl_push_nil(ctx);
|
|
}
|
|
|
|
static void
|
|
impl_fclose(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "fclose");
|
|
FILE **fh = apfl_get_native_object(ctx, &file_object, -1);
|
|
closefile(fh);
|
|
apfl_drop(ctx, -1);
|
|
}
|
|
|
|
static void
|
|
loadfile(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "load-file");
|
|
apfl_copy(ctx, -1);
|
|
const char *filename = getcstring(ctx, -1);
|
|
|
|
FILE **fh = apfl_push_native_object(ctx, &file_object);
|
|
*fh = fopen(filename, "rb");
|
|
if (*fh == NULL) {
|
|
raise_errno(ctx);
|
|
}
|
|
apfl_drop(ctx, -2); // drop cstring
|
|
|
|
struct apfl_io_reader r = apfl_io_file_reader(*fh);
|
|
apfl_load(ctx, apfl_io_reader_as_source_reader(&r), -2);
|
|
closefile(fh);
|
|
apfl_drop(ctx, -2);
|
|
}
|
|
|
|
static void
|
|
loadstring(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "load-string");
|
|
apfl_tostring(ctx, -1);
|
|
apfl_push_const_string(ctx, "(load-string)");
|
|
|
|
struct apfl_io_string_reader_data reader_data = apfl_io_string_reader_create(apfl_get_string(ctx, -2));
|
|
struct apfl_io_reader r = apfl_io_string_reader(&reader_data);
|
|
apfl_load(ctx, apfl_io_reader_as_source_reader(&r), -1);
|
|
apfl_drop(ctx, -2);
|
|
}
|
|
|
|
static void
|
|
set_func_name(apfl_ctx ctx)
|
|
{
|
|
size_t argc = apfl_len(ctx, 0);
|
|
if (argc != 2) {
|
|
apfl_raise_const_error(ctx, "set-func-name needs exactly 2 arguments");
|
|
}
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_set_func_name(ctx, -2, -1);
|
|
}
|
|
|
|
static void
|
|
substring(apfl_ctx ctx)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
struct apfl_string_view sv = apfl_get_string(ctx, -1);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_number start = apfl_get_number(ctx, -1);
|
|
apfl_get_list_member_by_index(ctx, 0, 2);
|
|
apfl_number len = apfl_get_number(ctx, -1);
|
|
|
|
apfl_push_string_view_copy(ctx, apfl_string_view_substr(sv, (size_t)start, (size_t)len));
|
|
}
|
|
|
|
static void
|
|
stringsearch(apfl_ctx ctx)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
struct apfl_string_view haystack = apfl_get_string(ctx, -1);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
struct apfl_string_view needle = apfl_get_string(ctx, -1);
|
|
|
|
ptrdiff_t off = apfl_string_view_search(haystack, needle);
|
|
if (off < 0) {
|
|
apfl_push_nil(ctx);
|
|
} else {
|
|
apfl_push_number(ctx, (apfl_number)off);
|
|
}
|
|
}
|
|
|
|
static bool
|
|
iterate_dict_callback(apfl_ctx ctx, void *opaque)
|
|
{
|
|
(void)opaque;
|
|
|
|
apfl_list_create(ctx, 2);
|
|
apfl_list_append(ctx, -1, -3);
|
|
apfl_list_append(ctx, -1, -2);
|
|
apfl_copy(ctx, -2);
|
|
apfl_call(ctx, -1, -2);
|
|
|
|
return apfl_is_truthy(ctx, -1);
|
|
}
|
|
|
|
static void
|
|
iterate_dict(apfl_ctx ctx)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_drop(ctx, 0);
|
|
apfl_iterate_dict(ctx, -2, NULL, iterate_dict_callback);
|
|
apfl_push_nil(ctx);
|
|
}
|
|
|
|
static int argv_registry_key;
|
|
|
|
void
|
|
apfl_argv_set(apfl_ctx ctx, apfl_stackidx args)
|
|
{
|
|
apfl_registry_set(ctx, &argv_registry_key, 0, args);
|
|
}
|
|
|
|
static void
|
|
get_argv(apfl_ctx ctx)
|
|
{
|
|
if (!apfl_registry_try_get(ctx, &argv_registry_key, 0)) {
|
|
apfl_push_nil(ctx);
|
|
}
|
|
}
|
|
|
|
static void
|
|
get_optional(apfl_ctx ctx)
|
|
{
|
|
size_t args = apfl_len(ctx, 0);
|
|
if (args != 2) {
|
|
apfl_raise_const_error(ctx, "get-optional needs exactly 2 arguments");
|
|
}
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_get_list_member_by_index(ctx, 0, 1);
|
|
apfl_stack_drop(ctx, 0);
|
|
|
|
if (apfl_get_member_if_exists(ctx, -1, -2)) {
|
|
apfl_sym_some(ctx);
|
|
apfl_push_pair(ctx, -1, -2);
|
|
} else {
|
|
apfl_push_nil(ctx);
|
|
}
|
|
}
|
|
|
|
static void
|
|
impl_raise(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "raise");
|
|
apfl_raise_error(ctx, -1);
|
|
}
|
|
|
|
static void
|
|
symbol(apfl_ctx ctx)
|
|
{
|
|
size_t args = apfl_len(ctx, 0);
|
|
switch (args) {
|
|
case 0:
|
|
apfl_push_anon_symbol(ctx);
|
|
return;
|
|
case 1:
|
|
apfl_get_list_member_by_index(ctx, 0, 0);
|
|
apfl_drop(ctx, 0);
|
|
apfl_push_symbol(ctx, -1);
|
|
return;
|
|
default:
|
|
apfl_raise_const_error(ctx, "symbol needs 0 or 1 argument");
|
|
}
|
|
}
|
|
|
|
struct splice_info {
|
|
size_t off;
|
|
size_t len;
|
|
};
|
|
|
|
static apfl_number
|
|
getnumarg(apfl_ctx ctx, size_t arg)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, arg);
|
|
return apfl_get_number(ctx, -1);
|
|
}
|
|
|
|
static size_t
|
|
splice_off(apfl_ctx ctx, size_t list_len, size_t arg)
|
|
{
|
|
size_t off;
|
|
apfl_number off_num = getnumarg(ctx, arg);
|
|
if (off_num < 0) {
|
|
off = (size_t)(-off_num);
|
|
off = off > list_len ? 0 : list_len - off;
|
|
} else {
|
|
off = (size_t)off_num;
|
|
if (off >= list_len) {
|
|
off = list_len;
|
|
}
|
|
}
|
|
return off;
|
|
}
|
|
|
|
static size_t
|
|
splice_len(apfl_ctx ctx, size_t list_len, size_t off, size_t arg)
|
|
{
|
|
assert(off <= list_len);
|
|
list_len -= off;
|
|
|
|
apfl_get_list_member_by_index(ctx, 0, arg);
|
|
if (apfl_get_type(ctx, -1) == APFL_VALUE_NIL) {
|
|
apfl_drop(ctx, -1);
|
|
return list_len;
|
|
}
|
|
|
|
apfl_number num = apfl_get_number(ctx, -1);
|
|
if (num < 0) {
|
|
size_t len = (size_t)(-num);
|
|
return len > list_len ? 0 : list_len - len;
|
|
}
|
|
|
|
size_t len = (size_t)num;
|
|
return len > list_len ? list_len : len;
|
|
}
|
|
|
|
static struct splice_info
|
|
splice_get_list(apfl_ctx ctx, size_t args_base)
|
|
{
|
|
apfl_get_list_member_by_index(ctx, 0, args_base);
|
|
if (apfl_get_type(ctx, -1) != APFL_VALUE_LIST) {
|
|
apfl_raise_errorfmt(
|
|
ctx,
|
|
"Expected a list argument to splice, got {stack:type} instead",
|
|
-1
|
|
);
|
|
}
|
|
|
|
size_t list_len = apfl_len(ctx, -1);
|
|
|
|
size_t off = splice_off(ctx, list_len, args_base + 1);
|
|
size_t len = splice_len(ctx, list_len, off, args_base + 2);
|
|
|
|
return (struct splice_info) {
|
|
.off = off,
|
|
.len = len,
|
|
};
|
|
}
|
|
|
|
static void
|
|
splice(apfl_ctx ctx)
|
|
{
|
|
if (apfl_len(ctx, 0) != 6) {
|
|
apfl_raise_const_error(ctx, "splice needs exactly 6 arguments");
|
|
}
|
|
|
|
struct splice_info a = splice_get_list(ctx, 0);
|
|
struct splice_info b = splice_get_list(ctx, 3);
|
|
|
|
apfl_list_splice(ctx, -2, a.off, a.len, -1, b.off, b.len);
|
|
}
|
|
|
|
static void
|
|
add_builtin(apfl_ctx ctx, const char *name, apfl_cfunc func)
|
|
{
|
|
apfl_push_const_string(ctx, name);
|
|
apfl_push_cfunc(ctx, func, 0);
|
|
apfl_push_const_string(ctx, name);
|
|
apfl_set_func_name(ctx, -2, -1);
|
|
apfl_dict_set(ctx, -3, -2, -1);
|
|
}
|
|
|
|
static void
|
|
cmod_searcher(apfl_ctx ctx)
|
|
{
|
|
ONE_ARG(ctx, "cmod-searcher");
|
|
if (apfl_modules_query(ctx, -1)) {
|
|
apfl_sym_some(ctx);
|
|
apfl_push_pair(ctx, -1, -2);
|
|
} else {
|
|
apfl_push_nil(ctx);
|
|
}
|
|
}
|
|
|
|
void
|
|
apfl_globals(apfl_ctx ctx)
|
|
{
|
|
apfl_dict_create(ctx);
|
|
|
|
add_builtin(ctx, "if", impl_if);
|
|
add_builtin(ctx, "==", impl_eq);
|
|
add_builtin(ctx, ">", impl_gt);
|
|
add_builtin(ctx, "<", impl_lt);
|
|
add_builtin(ctx, ">=", impl_ge);
|
|
add_builtin(ctx, "<=", impl_le);
|
|
add_builtin(ctx, "+", impl_plus);
|
|
add_builtin(ctx, "-", impl_minus);
|
|
add_builtin(ctx, "*", impl_mult);
|
|
add_builtin(ctx, "/", impl_div);
|
|
add_builtin(ctx, "&", impl_concat);
|
|
add_builtin(ctx, "join", impl_join);
|
|
add_builtin(ctx, "print", print);
|
|
add_builtin(ctx, "dump", dump);
|
|
add_builtin(ctx, "disasm", disasm);
|
|
add_builtin(ctx, "tostring", tostring);
|
|
add_builtin(ctx, "not", not);
|
|
add_builtin(ctx, "len", len);
|
|
add_builtin(ctx, "type", type);
|
|
add_builtin(ctx, "loop", impl_loop);
|
|
add_builtin(ctx, "gc", impl_gc);
|
|
add_builtin(ctx, "backtrace", impl_backtrace);
|
|
add_builtin(ctx, "fopen", impl_fopen);
|
|
add_builtin(ctx, "fread", impl_fread);
|
|
add_builtin(ctx, "fwrite", impl_fwrite);
|
|
add_builtin(ctx, "fclose", impl_fclose);
|
|
add_builtin(ctx, "load-file", loadfile);
|
|
add_builtin(ctx, "load-string", loadstring);
|
|
add_builtin(ctx, "set-func-name", set_func_name);
|
|
add_builtin(ctx, "substring", substring);
|
|
add_builtin(ctx, "stringsearch", stringsearch);
|
|
add_builtin(ctx, "iterate-dict", iterate_dict);
|
|
add_builtin(ctx, "symbol", symbol);
|
|
add_builtin(ctx, "get-optional", get_optional);
|
|
add_builtin(ctx, "raise", impl_raise);
|
|
add_builtin(ctx, "getsym-Some", apfl_sym_some);
|
|
add_builtin(ctx, "get-argv", get_argv);
|
|
add_builtin(ctx, "cmod-searcher", cmod_searcher);
|
|
add_builtin(ctx, "tonumber", tonumber);
|
|
add_builtin(ctx, "splice", splice);
|
|
|
|
apfl_build_native_and_bytecode_combined_module(ctx, -1, apfl_mod_globals());
|
|
}
|