Laria Carolin Chabowski
c5fbd92f75
Instead of passing a flag through the parser and tokenizer for telling the input source if we need further input or not, we steal a trick from Lua: In the REPL, we just continue to read lines and append them to the input, until the input was loaded with no "unexpected EOF" error. After all, when we didn't expect an EOF is exactly the scenario, when we need more input. Doing things this way simplifies a bunch of places and lets us remove the ugly source_reader and iterative_runner concepts. To allow the REPL to see the error that happened during loading required some smaller refactorings, but those were honestly for the better anyway. I also decided to get rid of the token_source concept, the parser now gets the tokenizer directly. This also made things a bit simpler, also I want to soon-ish implement string interpolation, and for that the parser needs to do more with the tokenizer than just reading the next token. One last thing: This also cleans up the web playground and makes the playground and REPL share a bunch of code. Nice!
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, w));
|
|
} else if (apfl_string_eq(sv, "collect")) {
|
|
apfl_gc_full(ctx);
|
|
} 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, 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, 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, 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());
|
|
}
|