apfl/src/builtins.c

#include <assert.h>
#include <errno.h>
#include <stdio.h>
#include <string.h>

#include "apfl.h"

#include "alloc.h"
#include "builtins.h"
#include "bytecode.h"
#include "context.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
serialize_bytecode(apfl_ctx ctx)
{
    apfl_get_list_member_by_index(ctx, 0, 0);
    struct apfl_value value = apfl_stack_must_get(ctx, -1);
    if (value.type == VALUE_CFUNC) {
        apfl_raise_const_error(ctx, "-serialize-bytecode needs a apfl function, got a native function instead");
    } else if (value.type != VALUE_FUNC) {
        apfl_raise_errorfmt(ctx, "-serialize-bytecode needs a apfl function, got value of type {value:type} instead", value);
    }

    apfl_get_list_member_by_index(ctx, 0, 1);
    FILE **fh = apfl_get_native_object(ctx, &file_object, -1);

    struct apfl_io_writer w = apfl_io_file_writer(*fh);

    if (!apfl_bytecode_serialize(ctx->gc.allocator, w, value.func->subfunctions[0].body)) {
        apfl_raise_const_error(ctx, "Could not serialize function");
    }

    apfl_push_nil(ctx);
}

static void
unserialize_bytecode(apfl_ctx ctx)
{
    apfl_get_list_member_by_index(ctx, 0, 0);
    apfl_drop(ctx, -2);
    FILE **fh = apfl_get_native_object(ctx, &file_object, -1);

    struct apfl_io_reader r = apfl_io_file_reader(*fh);

    apfl_load_bytecode(ctx, r);
}

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 need 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 int cmod_searcher_registry_key;

static void
cmod_searcher(apfl_ctx ctx)
{
    ONE_ARG(ctx, "cmod-searcher");
    if (!apfl_registry_try_get(ctx, &cmod_searcher_registry_key, 0)) {
        apfl_drop(ctx, -1);
        apfl_push_nil(ctx);
        return;
    }

    if (apfl_get_member_if_exists(ctx, -1, -2)) {
        apfl_sym_some(ctx);
        apfl_push_pair(ctx, -1, -2);
    } else {
        apfl_push_nil(ctx);
    }
}

void
apfl_modules_register(apfl_ctx ctx, const char *name, apfl_stackidx modloader)
{
    apfl_move_to_top_of_stack(ctx, modloader);

    if (!apfl_registry_try_get(ctx, &cmod_searcher_registry_key, 0)) {
        apfl_dict_create(ctx);
    }

    apfl_push_const_string(ctx, name);
    apfl_dict_set(ctx, -2, -1, -3);

    apfl_registry_set(ctx, &cmod_searcher_registry_key, 0, -1);
}

void
apfl_builtins(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, "-serialize-bytecode", serialize_bytecode);
    add_builtin(ctx, "-unserialize-bytecode", unserialize_bytecode);
    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);
}