Implement loading other scripts

src/apfl.h

@@ -563,6 +563,8 @@ struct apfl_string_source_reader_data apfl_string_source_reader_create(struct ap
  */
 struct apfl_source_reader apfl_string_source_reader(struct apfl_string_source_reader_data *);
 
+struct apfl_source_reader apfl_stdio_source_reader(FILE *f);
+
 struct apfl_parser_token_source {
     enum apfl_parse_result (*next)(void *, bool need);
     struct apfl_token (*get_token)(void *);
@@ -736,6 +738,8 @@ void *apfl_get_native_object(apfl_ctx, const struct apfl_native_object_type *typ
 void apfl_call(apfl_ctx, apfl_stackidx func, apfl_stackidx args);
 enum apfl_result apfl_call_protected(apfl_ctx, apfl_stackidx func, apfl_stackidx args);
 
+void apfl_load(apfl_ctx, struct apfl_source_reader, apfl_stackidx name);
+
 enum apfl_call_stack_entry_type {
     APFL_CSE_FUNCTION,
     APFL_CSE_CFUNCTION,
@@ -747,6 +751,7 @@ struct apfl_call_stack_entry_info {
     enum apfl_call_stack_entry_type type;
     bool toplevel; // Only set for type==APFL_CSE_FUNCTION.
     size_t subfunction_index; // Only set for type==APFL_CSE_FUNCTION && !toplevel
+    struct apfl_string_view filename;
     struct apfl_string_view name;
     int line_current; // only set for (type==APFL_CSE_FUNCTION && !toplevel) || type == APFL_CSE_FUNCTION_DISPATCH
     int line_defined; // only set for type==APFL_CSE_FUNCTION

src/bytecode.c

@@ -8,7 +8,7 @@
 #include "gc.h"
 
 struct instruction_list *
-apfl_instructions_new(struct gc *gc, int line)
+apfl_instructions_new(struct gc *gc, int line, struct apfl_string *filename)
 {
     struct instruction_list *ilist = apfl_gc_new_instructions(gc);
     if (ilist == NULL) {
@@ -19,6 +19,7 @@ apfl_instructions_new(struct gc *gc, int line)
         .len = 0,
         .cap = 0,
         .line = line,
+        .filename = filename,
     };
     return ilist;
 }
@@ -42,6 +43,10 @@ apfl_gc_instructions_traverse(struct instruction_list *ilist, gc_visitor cb, voi
 {
     union instruction_or_arg arg;
 
+    if (ilist->filename != NULL) {
+        cb(opaque, GC_OBJECT_FROM(ilist->filename, GC_TYPE_STRING));
+    }
+
     for (size_t i = 0; i < ilist->len; i++) {
         switch (ilist->instructions[i].instruction) {
         case INSN_NIL:

src/bytecode.h

@@ -86,12 +86,13 @@ struct instruction_list {
     size_t cap;
 
     int line;
+    struct apfl_string *filename;
 };
 
 const char *apfl_instruction_to_string(enum instruction);
 const char *apfl_matcher_instruction_to_string(enum matcher_instruction);
 
-struct instruction_list *apfl_instructions_new(struct gc *, int line);
+struct instruction_list *apfl_instructions_new(struct gc *, int line, struct apfl_string *filename);
 void apfl_instructions_deinit(struct apfl_allocator, struct instruction_list *);
 
 void apfl_gc_instructions_traverse(struct instruction_list *, gc_visitor, void *);

src/compile.c

@@ -296,11 +296,11 @@ compile_simple_assignment(
 }
 
 static struct instruction_list *
-tmp_ilist(struct compiler *compiler, int line)
+tmp_ilist(struct compiler *compiler, int line, struct apfl_string *filename)
 {
     struct instruction_list *ilist;
     if (
-        (ilist = apfl_instructions_new(compiler->gc, line)) == NULL
+        (ilist = apfl_instructions_new(compiler->gc, line, filename)) == NULL
         || !apfl_gc_tmproot_add(
             compiler->gc,
             GC_OBJECT_FROM(ilist, GC_TYPE_INSTRUCTIONS)
@@ -714,7 +714,7 @@ compile_simple_func_inner(
     struct apfl_string *name
 ) {
     struct instruction_list *body_ilist = NULL;
-    MALLOC_FAIL_IF_NULL(compiler, (body_ilist = tmp_ilist(compiler, line)));
+    MALLOC_FAIL_IF_NULL(compiler, (body_ilist = tmp_ilist(compiler, line, ilist->filename)));
 
     struct matcher_instruction_list *milist = NULL;
     MALLOC_FAIL_IF_NULL(compiler, (milist = tmp_milist(compiler)));
@@ -837,7 +837,7 @@ static bool
 compile_subfunc(struct compiler *compiler, struct apfl_expr_subfunc *subfunc, struct instruction_list *ilist, struct apfl_position position)
 {
     struct instruction_list *body_ilist = NULL;
-    MALLOC_FAIL_IF_NULL(compiler, (body_ilist = tmp_ilist(compiler, position.line)));
+    MALLOC_FAIL_IF_NULL(compiler, (body_ilist = tmp_ilist(compiler, position.line, ilist->filename)));
 
     struct matcher_instruction_list *milist = NULL;
     MALLOC_FAIL_IF_NULL(compiler, (milist = tmp_milist(compiler)));

src/context.c

@@ -6,6 +6,7 @@
 
 #include "apfl.h"
 #include "alloc.h"
+#include "compile.h"
 #include "context.h"
 #include "gc.h"
 #include "globals.h"
@@ -1455,6 +1456,24 @@ apfl_tostring(apfl_ctx ctx, apfl_stackidx index)
     apfl_stack_drop(ctx, -2); // Drop original value
 }
 
+struct apfl_string *
+apfl_to_dynamic_string(apfl_ctx ctx, apfl_stackidx index)
+{
+    apfl_tostring(ctx, index);
+    struct apfl_value value = apfl_stack_must_get(ctx, -1);
+    if (value.type == VALUE_STRING) {
+        return value.string;
+    }
+
+    assert(value.type == VALUE_CONST_STRING /* apfl_tostring results in either VALUE_STRING or VALUE_CONST_STRING */);
+
+    apfl_push_string_view_copy(ctx, value.const_string);
+    value = apfl_stack_must_get(ctx, -1);
+    apfl_drop(ctx, -2);
+
+    return value.string;
+}
+
 void
 apfl_join_strings(apfl_ctx ctx, apfl_stackidx glue, apfl_stackidx parts)
 {
@@ -1888,6 +1907,14 @@ apfl_call_stack_depth(apfl_ctx ctx)
     return ctx->call_stack.len;
 }
 
+static struct apfl_string_view
+get_string_view_or_empty(struct apfl_string *s)
+{
+    return s == NULL
+        ? (struct apfl_string_view) { .len = 0, .bytes = NULL, }
+        : apfl_string_view_from(*s);
+}
+
 struct apfl_call_stack_entry_info
 apfl_call_stack_inspect(apfl_ctx ctx, size_t n)
 {
@@ -1900,12 +1927,14 @@ apfl_call_stack_inspect(apfl_ctx ctx, size_t n)
     struct apfl_call_stack_entry_info info = {
         .type = cse->type,
         .name = (struct apfl_string_view) { .len = 0, .bytes = NULL, },
+        .filename = (struct apfl_string_view) { .len = 0, .bytes = NULL, },
         .toplevel = false,
     };
 
     switch (cse->type) {
     case APFL_CSE_FUNCTION:
         info.line_current = cse->func.execution_line;
+        info.filename = get_string_view_or_empty(cse->func.instructions->filename);
         if (cse->func.function == NULL) {
             info.toplevel = true;
         } else {
@@ -1919,9 +1948,7 @@ apfl_call_stack_inspect(apfl_ctx ctx, size_t n)
         }
         break;
     case APFL_CSE_CFUNCTION:
-        if (cse->cfunc.func->name) {
-            info.name = apfl_string_view_from(*cse->cfunc.func->name);
-        }
+        info.name = get_string_view_or_empty(cse->cfunc.func->name);
         break;
     case APFL_CSE_FUNCTION_DISPATCH: {
         struct apfl_string_view sv;
@@ -1929,6 +1956,7 @@ apfl_call_stack_inspect(apfl_ctx ctx, size_t n)
             info.name = sv;
         }
         info.line_defined = cse->func_dispatch.function->line_defined;
+        info.filename = get_string_view_or_empty(cse->func_dispatch.function->filename);
         break;
     }
     case APFL_CSE_MATCHER:
@@ -1938,9 +1966,19 @@ apfl_call_stack_inspect(apfl_ctx ctx, size_t n)
     return info;
 }
 
-static bool format_defined_at(struct apfl_format_writer w, struct apfl_call_stack_entry_info info)
-{
-    FMT_TRY(apfl_format_put_string(w, "defined in line "));
+static bool
+format_defined_at(
+    struct apfl_format_writer w,
+    struct apfl_call_stack_entry_info info,
+    struct apfl_string_view *filename
+) {
+    FMT_TRY(apfl_format_put_string(w, "defined in "));
+    if (filename != NULL && filename->len > 0) {
+        FMT_TRY(apfl_format_put_string(w, "file "));
+        FMT_TRY(apfl_format_put_string(w, *filename));
+        FMT_TRY(apfl_format_put_string(w, ", "));
+    }
+    FMT_TRY(apfl_format_put_string(w, "line "));
     FMT_TRY(apfl_format_put_int(w, info.line_defined));
     return true;
 }
@@ -1950,6 +1988,11 @@ apfl_call_stack_entry_info_format(struct apfl_format_writer w, struct apfl_call_
 {
     switch (info.type) {
     case APFL_CSE_FUNCTION:
+        if (info.filename.len > 0) {
+            FMT_TRY(apfl_format_put_string(w, "File "));
+            FMT_TRY(apfl_format_put_string(w, info.filename));
+            FMT_TRY(apfl_format_put_string(w, ", "));
+        }
         FMT_TRY(apfl_format_put_string(w, "Line "));
         FMT_TRY(apfl_format_put_int(w, info.line_current));
         FMT_TRY(apfl_format_put_string(w, ", "));
@@ -1960,7 +2003,7 @@ apfl_call_stack_entry_info_format(struct apfl_format_writer w, struct apfl_call_
             FMT_TRY(apfl_format_put_string(w, "anonymous function (subfunction "));
             FMT_TRY(apfl_format_put_int(w, (int)info.subfunction_index));
             FMT_TRY(apfl_format_put_string(w, "; "));
-            FMT_TRY(format_defined_at(w, info));
+            FMT_TRY(format_defined_at(w, info, NULL));
             FMT_TRY(apfl_format_put_string(w, ")"));
         } else {
             FMT_TRY(apfl_format_put_string(w, "function "));
@@ -1968,7 +2011,7 @@ apfl_call_stack_entry_info_format(struct apfl_format_writer w, struct apfl_call_
             FMT_TRY(apfl_format_put_string(w, " (subfunction "));
             FMT_TRY(apfl_format_put_int(w, (int)info.subfunction_index));
             FMT_TRY(apfl_format_put_string(w, "; "));
-            FMT_TRY(format_defined_at(w, info));
+            FMT_TRY(format_defined_at(w, info, NULL));
             FMT_TRY(apfl_format_put_string(w, ")"));
         }
         break;
@@ -1989,7 +2032,7 @@ apfl_call_stack_entry_info_format(struct apfl_format_writer w, struct apfl_call_
             FMT_TRY(apfl_format_put_string(w, info.name));
             FMT_TRY(apfl_format_put_string(w, "("));
         }
-        FMT_TRY(format_defined_at(w, info));
+        FMT_TRY(format_defined_at(w, info, &info.filename));
         FMT_TRY(apfl_format_put_string(w, ")"));
         break;
     case APFL_CSE_MATCHER:
@@ -1999,3 +2042,131 @@ apfl_call_stack_entry_info_format(struct apfl_format_writer w, struct apfl_call_
 
     return true;
 }
+
+static struct instruction_list *
+setup_function_for_load_inner(apfl_ctx ctx, struct apfl_string *filename)
+{
+    struct apfl_value *func_value = apfl_stack_push_placeholder(ctx);
+    if (func_value == NULL) {
+        return NULL;
+    }
+
+    if ((func_value->func = apfl_func_new(&ctx->gc, 1, NULL, 1, filename)) == NULL) {
+        apfl_drop(ctx, -1);
+        return NULL;
+    }
+    func_value->type = VALUE_FUNC;
+
+    struct instruction_list *ilist = apfl_instructions_new(&ctx->gc, 1, filename);
+    if (
+        ilist == NULL
+        || !apfl_gc_tmproot_add(&ctx->gc, GC_OBJECT_FROM(ilist, GC_TYPE_INSTRUCTIONS))
+    ) {
+        return NULL;
+    }
+
+    struct matcher_instruction_list *milist = apfl_matcher_instructions_new(&ctx->gc);
+    if (
+        milist == NULL
+        || !apfl_gc_tmproot_add(&ctx->gc, GC_OBJECT_FROM(milist, GC_TYPE_MATCHER_INSTRUCTIONS))
+    ) {
+        return NULL;
+    }
+
+    if (!apfl_resizable_append(
+        ctx->gc.allocator,
+        sizeof(union matcher_instruction_or_arg),
+        (void **)&milist->instructions,
+        &milist->len,
+        &milist->cap,
+        &(union matcher_instruction_or_arg[]) {
+            {.instruction = MATCHER_IGNORE},
+        },
+        1
+    )) {
+        return NULL;
+    }
+
+    struct matcher *matcher = apfl_matcher_new(&ctx->gc, milist);
+    if (
+        matcher == NULL
+        || !apfl_gc_tmproot_add(&ctx->gc, GC_OBJECT_FROM(matcher, GC_TYPE_MATCHER))
+    ) {
+        apfl_drop(ctx, -1);
+        return NULL;
+    }
+
+    if (!apfl_func_add_subfunc(func_value->func, ilist, matcher)) {
+        apfl_drop(ctx, -1);
+        return NULL;
+    }
+
+    return ilist;
+}
+
+static struct instruction_list *
+setup_function_for_load(apfl_ctx ctx, struct apfl_string *filename)
+{
+    size_t tmproots = apfl_gc_tmproots_begin(&ctx->gc);
+    struct instruction_list *out = setup_function_for_load_inner(ctx, filename);
+    apfl_gc_tmproots_restore(&ctx->gc, tmproots);
+    return out;
+}
+
+void
+apfl_load(apfl_ctx ctx, struct apfl_source_reader reader, apfl_stackidx name)
+{
+    struct apfl_string *filename = apfl_to_dynamic_string(ctx, name);
+
+    apfl_tokenizer_ptr tokenizer = apfl_tokenizer_new(ctx->gc.allocator, reader);
+    if (tokenizer == NULL) {
+        apfl_raise_alloc_error(ctx);
+    }
+
+    apfl_parser_ptr parser = apfl_parser_new(
+        ctx->gc.allocator,
+        apfl_tokenizer_as_token_source(tokenizer)
+    );
+    if (parser == NULL) {
+        apfl_tokenizer_destroy(tokenizer);
+        apfl_raise_alloc_error(ctx);
+    }
+
+    struct instruction_list *ilist = setup_function_for_load(ctx, filename);
+    if (ilist == NULL) {
+        apfl_parser_destroy(parser);
+        apfl_tokenizer_destroy(tokenizer);
+        apfl_raise_alloc_error(ctx);
+    }
+
+    for (;;) {
+        switch (apfl_parser_next(parser)) {
+        case APFL_PARSE_OK: {
+            struct apfl_error err;
+            if (!apfl_compile(
+                &ctx->gc,
+                apfl_parser_get_expr(parser),
+                &err,
+                ilist
+            )) {
+                apfl_drop(ctx, -1);
+                apfl_parser_destroy(parser);
+                apfl_tokenizer_destroy(tokenizer);
+                apfl_raise_error_object(ctx, err);
+            }
+
+            break;
+        }
+        case APFL_PARSE_ERROR:
+            apfl_drop(ctx, -1);
+            apfl_parser_destroy(parser);
+            apfl_tokenizer_destroy(tokenizer);
+            apfl_raise_error_object(ctx, apfl_parser_get_error(parser));
+            break;
+        case APFL_PARSE_EOF:
+            apfl_parser_destroy(parser);
+            apfl_tokenizer_destroy(tokenizer);
+            return;
+        }
+    }
+}

src/context.h

@@ -174,6 +174,9 @@ void apfl_stack_clear(apfl_ctx);
 struct apfl_value *apfl_stack_push_placeholder(apfl_ctx);
 bool apfl_move_string_onto_stack(apfl_ctx, struct apfl_string);
 
+// Like apfl_tostring, but ensures it's a dynamically allocated string and returns the underlying string.
+struct apfl_string *apfl_to_dynamic_string(apfl_ctx ctx, apfl_stackidx index);
+
 /* Raise an error with a message formatted according to fmt.
  *
  * fmt allows placeholders in the form of `{<param>:<type>}`, where `<param>:`

src/eval.c

@@ -275,7 +275,13 @@ func_inner(apfl_ctx ctx, struct func_call_stack_entry *cse, size_t count)
         apfl_raise_alloc_error(ctx);
     }
 
-    if ((func_value->func = apfl_func_new(&ctx->gc, count, scope, cse->execution_line)) == NULL) {
+    if ((func_value->func = apfl_func_new(
+        &ctx->gc,
+        count,
+        scope,
+        cse->execution_line,
+        cse->instructions->filename
+    )) == NULL) {
         stack_must_drop(ctx, -1);
         apfl_raise_alloc_error(ctx);
     }
@@ -1362,7 +1368,7 @@ iterative_runner_eval_expr_inner(apfl_iterative_runner runner, struct apfl_expr
 {
     apfl_ctx ctx = runner->ctx;
 
-    struct instruction_list *ilist = apfl_instructions_new(&ctx->gc, expr.position.line);
+    struct instruction_list *ilist = apfl_instructions_new(&ctx->gc, expr.position.line, NULL);
     if (ilist == NULL) {
         apfl_raise_alloc_error(ctx);
     }

src/globals.c

@@ -376,16 +376,20 @@ impl_backtrace(apfl_ctx ctx)
     }
 }
 
+static void
+closefile(FILE **f)
+{
+    if (*f != NULL) {
+        fclose(*f);
+        *f = NULL;
+    }
+}
+
 static void
 file_onbeforecollect(void *opaque)
 {
     FILE **f = opaque;
-    if (*f == NULL) {
-        return;
-    }
-
-    fclose(*f);
-    *f = NULL;
+    closefile(f);
 }
 
 static struct apfl_native_object_type file_object = {
@@ -502,13 +506,41 @@ impl_fclose(apfl_ctx ctx)
 {
     ONE_ARG(ctx, "fclose");
     FILE **fh = apfl_get_native_object(ctx, &file_object, -1);
-    if (*fh != NULL) {
-        fclose(*fh);
-        *fh = NULL;
-    }
+    closefile(fh);
     apfl_drop(ctx, -1);
 }
 
+static void
+loadfile(apfl_ctx ctx)
+{
+    ONE_ARG(ctx, "loadfile");
+    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
+
+    apfl_load(ctx, apfl_stdio_source_reader(*fh), -2);
+    closefile(fh);
+    apfl_drop(ctx, -2);
+}
+
+static void
+loadstring(apfl_ctx ctx)
+{
+    ONE_ARG(ctx, "loadstring");
+    apfl_tostring(ctx, -1);
+    apfl_push_const_string(ctx, "(loadstring)");
+
+    struct apfl_string_source_reader_data reader_data = apfl_string_source_reader_create(apfl_get_string(ctx, -2));
+    apfl_load(ctx, apfl_string_source_reader(&reader_data), -1);
+    apfl_drop(ctx, -2);
+}
+
 static const struct global_def globals[] = {
     {"if", impl_if},
     {"==", impl_eq},
@@ -536,6 +568,8 @@ static const struct global_def globals[] = {
     {"fread", impl_fread},
     {"fwrite", impl_fwrite},
     {"fclose", impl_fclose},
+    {"loadfile", loadfile},
+    {"loadstring", loadstring},
     {NULL, NULL},
 };
 

src/source_readers.c

@@ -4,7 +4,7 @@
 #include "apfl.h"
 
 static bool
-reader_callback(void *opaque, char *buf, size_t *len, bool need)
+string_reader_callback(void *opaque, char *buf, size_t *len, bool need)
 {
     (void)need;
 
@@ -32,7 +32,32 @@ apfl_string_source_reader_create(struct apfl_string_view sv)
 struct apfl_source_reader apfl_string_source_reader(struct apfl_string_source_reader_data *data)
 {
     return (struct apfl_source_reader) {
-        .callback = reader_callback,
+        .callback = string_reader_callback,
         .opaque = data,
     };
 }
+
+static bool
+stdio_reader_callback(void *opaque, char *buf, size_t *len, bool need)
+{
+    (void)need;
+
+    FILE *f = opaque;
+
+    size_t maxlen = *len;
+    *len = fread(buf, 1, maxlen, f);
+    if (*len == 0) {
+        return feof(f);
+    }
+
+    return true;
+}
+
+struct apfl_source_reader
+apfl_stdio_source_reader(FILE *f)
+{
+    return (struct apfl_source_reader) {
+        .callback = stdio_reader_callback,
+        .opaque = f,
+    };
+}

src/value.c

@@ -224,7 +224,7 @@ apfl_type_name(enum apfl_value_type type)
 }
 
 struct function *
-apfl_func_new(struct gc *gc, size_t cap, struct scope *scope, int line_defined)
+apfl_func_new(struct gc *gc, size_t cap, struct scope *scope, int line_defined, struct apfl_string *filename)
 {
     struct subfunction *subfunctions = ALLOC_LIST(gc->allocator, struct subfunction, cap);
     if (subfunctions == NULL) {
@@ -243,6 +243,7 @@ apfl_func_new(struct gc *gc, size_t cap, struct scope *scope, int line_defined)
         .scope = scope,
         .name = NULL,
         .line_defined = line_defined,
+        .filename = filename,
     };
 
     return function;
@@ -857,6 +858,9 @@ apfl_gc_func_traverse(struct function* function, gc_visitor cb, void *opaque)
     if (function->name != NULL) {
         cb(opaque, GC_OBJECT_FROM(function->name, GC_TYPE_STRING));
     }
+    if (function->filename != NULL) {
+        cb(opaque, GC_OBJECT_FROM(function->filename, GC_TYPE_STRING));
+    }
 }
 
 void

src/value.h

@@ -54,6 +54,7 @@ struct function {
     struct scope *scope;
     struct apfl_string *name;
     int line_defined;
+    struct apfl_string *filename;
 };
 
 struct cfunction {
@@ -144,7 +145,13 @@ bool apfl_dict_set_raw(
 size_t apfl_dict_len(struct dict_header *);
 void apfl_dict_deinit(struct dict_header *);
 
-struct function *apfl_func_new(struct gc *, size_t cap, struct scope *, int line_defined);
+struct function *apfl_func_new(
+    struct gc *,
+    size_t cap,
+    struct scope *,
+    int line_defined,
+    struct apfl_string *filename
+);
 bool apfl_func_add_subfunc(struct function *, struct instruction_list *, struct matcher *);
 bool apfl_func_get_name(struct function *, struct apfl_string_view *name);
 void apfl_func_set_name(struct function *, struct apfl_string *name);