Add functions for reading/writing files and introduce native objects

src/apfl.h

@@ -677,6 +677,9 @@ void apfl_push_const_string(apfl_ctx, const char *);
 // glue and parts are popped off the stack. glue and the elements of parts are converted into a string if they are not
 // already one.
 void apfl_join_strings(apfl_ctx, apfl_stackidx glue, apfl_stackidx parts);
+// Joins two strings into a single one. Both input strings will be removed from the stack, the new one will be pushed.
+// The inputs will be converted to strings, if they are not already strings.
+void apfl_concat_strings(apfl_ctx, apfl_stackidx a, apfl_stackidx b);
 // Create a new empty list on the stack
 void apfl_list_create(apfl_ctx, size_t initial_capacity);
 // Append a value to a list. The value will be dropped.
@@ -722,6 +725,14 @@ void apfl_cfunc_self_setslot(apfl_ctx, apfl_slotidx, apfl_stackidx value);
 void apfl_push_userdata(apfl_ctx, void *);
 void *apfl_get_userdata(apfl_ctx, apfl_stackidx);
 
+struct apfl_native_object_type {
+    size_t size;
+    void (*onbeforecollect)(void *);
+};
+
+void *apfl_push_native_object(apfl_ctx, const struct apfl_native_object_type *type);
+void *apfl_get_native_object(apfl_ctx, const struct apfl_native_object_type *type, apfl_stackidx);
+
 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);
 

src/context.c

@@ -1364,6 +1364,7 @@ apfl_len(apfl_ctx ctx, apfl_stackidx index)
     case VALUE_FUNC:
     case VALUE_CFUNC:
     case VALUE_USERDATA:
+    case VALUE_NATIVE_OBJECT:
         apfl_raise_errorfmt(
             ctx,
             "Can not get length of value of type {value:type}",
@@ -1396,6 +1397,7 @@ get_string_view_of_value(struct apfl_string_view *sv, struct apfl_value value)
     case VALUE_USERDATA:
     case VALUE_LIST:
     case VALUE_DICT:
+    case VALUE_NATIVE_OBJECT:
         return false;
     case VALUE_STRING:
         *sv = apfl_string_view_from(*value.string);
@@ -1528,6 +1530,45 @@ error:
     apfl_raise_alloc_error(ctx);
 }
 
+void
+apfl_concat_strings(apfl_ctx ctx, apfl_stackidx a, apfl_stackidx b)
+{
+    apfl_multi_move_to_top_of_stack(ctx, 2, (apfl_stackidx[]){a, b});
+    apfl_tostring(ctx, -2);
+    apfl_tostring(ctx, -2);
+
+    struct apfl_string_view sv_a = apfl_get_string(ctx, -2);
+    struct apfl_string_view sv_b = apfl_get_string(ctx, -1);
+
+    struct apfl_string_builder sb = apfl_string_builder_init(ctx->gc.allocator);
+    if (!apfl_string_builder_prealloc(&sb, sv_a.len + sv_b.len)) {
+        goto error;
+    }
+
+    if (
+        !apfl_string_builder_append(&sb, sv_a)
+        || !apfl_string_builder_append(&sb, sv_b)
+    ) {
+        goto error;
+    }
+
+    struct apfl_string str = apfl_string_builder_move_string(&sb);
+    apfl_string_builder_deinit(&sb);
+    if (!apfl_move_string_onto_stack(ctx, str)) {
+        apfl_string_deinit(ctx->gc.allocator, &str);
+        goto error;
+    }
+
+    apfl_drop(ctx, -2);
+    apfl_drop(ctx, -2);
+    return;
+
+error:
+    apfl_drop(ctx, -1);
+    apfl_drop(ctx, -1);
+    apfl_raise_alloc_error(ctx);
+}
+
 bool
 apfl_is_truthy(apfl_ctx ctx, apfl_stackidx index)
 {
@@ -1752,6 +1793,29 @@ void *apfl_get_userdata(apfl_ctx ctx, apfl_stackidx index)
     return value.userdata;
 }
 
+void *
+apfl_push_native_object(apfl_ctx ctx, const struct apfl_native_object_type *type)
+{
+    CREATE_GC_OBJECT_VALUE_ON_STACK(
+        ctx,
+        VALUE_NATIVE_OBJECT,
+        native_object,
+        apfl_native_object_new(&ctx->gc, type)
+    )
+
+    return apfl_get_native_object(ctx, type, -1);
+}
+
+void *
+apfl_get_native_object(apfl_ctx ctx, const struct apfl_native_object_type *type, apfl_stackidx index)
+{
+    struct apfl_value value = apfl_stack_must_get(ctx, index);
+    if (value.type != VALUE_NATIVE_OBJECT || value.native_object->type != type) {
+        apfl_raise_const_error(ctx, apfl_messages.wrong_type);
+    }
+    return value.native_object->memory;
+}
+
 struct apfl_format_writer apfl_get_output_writer(apfl_ctx ctx)
 {
     return ctx->output_writer;

src/gc.c

@@ -33,6 +33,7 @@ struct gc_object {
         struct cfunction cfunction;
         struct matcher_instruction_list matcher_instructions;
         struct matcher matcher;
+        struct native_object native_object;
     };
     enum gc_type type;
     enum gc_status status;
@@ -187,6 +188,7 @@ IMPL_NEW(struct function,                 apfl_gc_new_func,                 GC_T
 IMPL_NEW(struct cfunction,                apfl_gc_new_cfunc,                GC_TYPE_CFUNC,                cfunction           )
 IMPL_NEW(struct matcher_instruction_list, apfl_gc_new_matcher_instructions, GC_TYPE_MATCHER_INSTRUCTIONS, matcher_instructions)
 IMPL_NEW(struct matcher,                  apfl_gc_new_matcher,              GC_TYPE_MATCHER,              matcher             )
+IMPL_NEW(struct native_object,            apfl_gc_new_native_object,        GC_TYPE_NATIVE_OBJECT,        native_object       )
 
 size_t
 apfl_gc_tmproots_begin(struct gc *gc)
@@ -275,6 +277,7 @@ visit_children(struct gc_object *object, gc_visitor cb, void *opaque)
         apfl_gc_scope_traverse(&object->scope, cb, opaque);
         return;
     case GC_TYPE_STRING:
+    case GC_TYPE_NATIVE_OBJECT:
         // Intentionally left blank. Object doesn't reference other objects.
         return;
     case GC_TYPE_INSTRUCTIONS:
@@ -366,6 +369,9 @@ deinit_object(struct gc *gc, struct gc_object *object)
     case GC_TYPE_MATCHER:
         apfl_matcher_deinit(gc->allocator, &object->matcher);
         return;
+    case GC_TYPE_NATIVE_OBJECT:
+        apfl_native_object_deinit(gc->allocator, &object->native_object);
+        return;
     }
 
     assert(false);
@@ -511,6 +517,8 @@ type_to_string(enum gc_type type)
         return "matcher instructions";
     case GC_TYPE_MATCHER:
         return "matcher";
+    case GC_TYPE_NATIVE_OBJECT:
+        return "native object";
     }
 
     assert(false);

src/gc.h

@@ -32,6 +32,7 @@ enum gc_type {
     GC_TYPE_CFUNC,
     GC_TYPE_MATCHER_INSTRUCTIONS,
     GC_TYPE_MATCHER,
+    GC_TYPE_NATIVE_OBJECT,
 };
 
 struct gc_tmproots {
@@ -87,6 +88,7 @@ struct function*                 apfl_gc_new_func(struct gc *);
 struct cfunction*                apfl_gc_new_cfunc(struct gc *);
 struct matcher_instruction_list* apfl_gc_new_matcher_instructions(struct gc *);
 struct matcher*                  apfl_gc_new_matcher(struct gc *);
+struct native_object*            apfl_gc_new_native_object(struct gc *);
 
 #ifdef __cplusplus
 }

src/globals.c

@@ -1,8 +1,11 @@
 #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"
@@ -373,6 +376,139 @@ impl_backtrace(apfl_ctx ctx)
     }
 }
 
+static void
+file_onbeforecollect(void *opaque)
+{
+    FILE **f = opaque;
+    if (*f == NULL) {
+        return;
+    }
+
+    fclose(*f);
+    *f = NULL;
+}
+
+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 = (char [1]) {'\0'}, .len = 1, });
+    apfl_concat_strings(ctx, -2, -1);
+    return 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;
+
+    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);
+    if (*fh != NULL) {
+        fclose(*fh);
+        *fh = NULL;
+    }
+    apfl_drop(ctx, -1);
+}
+
 static const struct global_def globals[] = {
     {"if", impl_if},
     {"==", impl_eq},
@@ -396,6 +532,10 @@ static const struct global_def globals[] = {
     {"while", impl_while},
     {"gc", impl_gc},
     {"backtrace", impl_backtrace},
+    {"fopen", impl_fopen},
+    {"fread", impl_fread},
+    {"fwrite", impl_fwrite},
+    {"fclose", impl_fclose},
     {NULL, NULL},
 };
 

src/value.c

@@ -1,4 +1,5 @@
 #include <assert.h>
+#include <string.h>
 
 #include "apfl.h"
 
@@ -157,6 +158,7 @@ format(unsigned indent, struct apfl_format_writer w, struct apfl_value value, bo
         }
         return true;
     case VALUE_USERDATA:
+    case VALUE_NATIVE_OBJECT:
         TRY(apfl_format_put_string(w, "userdata"));
         return true;
     }
@@ -188,6 +190,7 @@ apfl_value_type_to_abstract_type(enum value_type type)
     case VALUE_CFUNC:
         return APFL_VALUE_FUNC;
     case VALUE_USERDATA:
+    case VALUE_NATIVE_OBJECT:
         return APFL_VALUE_USERDATA;
     }
 
@@ -318,6 +321,44 @@ apfl_cfunction_deinit(struct apfl_allocator allocator, struct cfunction *cfunc)
     FREE_LIST(allocator, cfunc->slots, cfunc->slots_len);
 }
 
+struct native_object *
+apfl_native_object_new(struct gc *gc, const struct apfl_native_object_type *type)
+{
+    void *memory = ALLOC_BYTES(gc->allocator, type->size);
+    if (memory == NULL) {
+        return NULL;
+    }
+
+    struct native_object *obj = apfl_gc_new_native_object(gc);
+    if (obj == NULL) {
+        FREE_BYTES(gc->allocator, memory, type->size);
+        return NULL;
+    }
+
+    memset(memory, 0, type->size);
+
+    obj->type = type;
+    obj->memory = memory;
+
+    return obj;
+}
+
+void
+apfl_native_object_deinit(struct apfl_allocator allocator, struct native_object *obj)
+{
+    if (obj->type == NULL || obj->memory == NULL) {
+        return;
+    }
+
+    if (obj->type->onbeforecollect != NULL) {
+        obj->type->onbeforecollect(obj->memory);
+    }
+
+    FREE_BYTES(allocator, obj->memory, obj->type->size);
+    obj->memory = NULL;
+    obj->type = NULL;
+}
+
 struct apfl_value
 apfl_value_move(struct apfl_value *src)
 {
@@ -413,6 +454,8 @@ apfl_value_eq(const struct apfl_value a, const struct apfl_value b)
         return b.type == VALUE_CFUNC && a.cfunc == b.cfunc;
     case VALUE_USERDATA:
         return b.type == VALUE_USERDATA && a.userdata == b.userdata;
+    case VALUE_NATIVE_OBJECT:
+        return b.type == VALUE_NATIVE_OBJECT && a.native_object == b.native_object;
     }
 
     assert(false);
@@ -447,12 +490,10 @@ apfl_value_cmp(const struct apfl_value a, const struct apfl_value b)
         }
         return CMP(apfl_string_cmp(as_string_view(a), as_string_view(b)), 0);
     case VALUE_LIST:
-        if (b.type != VALUE_LIST) {
-            return CMP_INCOMPATIBLE_TYPES;
-        }
-        return CMP_UNCOMPARABLE;
     case VALUE_DICT:
-        if (b.type != VALUE_DICT) {
+    case VALUE_USERDATA:
+    case VALUE_NATIVE_OBJECT:
+        if (b.type != a.type) {
             return CMP_INCOMPATIBLE_TYPES;
         }
         return CMP_UNCOMPARABLE;
@@ -462,11 +503,6 @@ apfl_value_cmp(const struct apfl_value a, const struct apfl_value b)
             return CMP_INCOMPATIBLE_TYPES;
         }
         return CMP_UNCOMPARABLE;
-    case VALUE_USERDATA:
-        if (b.type != VALUE_USERDATA) {
-            return CMP_INCOMPATIBLE_TYPES;
-        }
-        return CMP_UNCOMPARABLE;
     }
 
     assert(false);
@@ -734,6 +770,8 @@ apfl_value_hash(const struct apfl_value value)
         return apfl_hash_fnv1a_add(&value.cfunc, sizeof(struct cfunction *), hash);
     case VALUE_USERDATA:
         return apfl_hash_fnv1a_add(&value.userdata, sizeof(void *), hash);
+    case VALUE_NATIVE_OBJECT:
+        return apfl_hash_fnv1a_add(&value.native_object, sizeof(struct native_object *), hash);
     }
 
     assert(false);
@@ -761,6 +799,8 @@ apfl_value_get_gc_object(struct apfl_value value)
         return GC_OBJECT_FROM(value.func, GC_TYPE_FUNC);
     case VALUE_CFUNC:
         return GC_OBJECT_FROM(value.cfunc, GC_TYPE_CFUNC);
+    case VALUE_NATIVE_OBJECT:
+        return GC_OBJECT_FROM(value.native_object, GC_TYPE_NATIVE_OBJECT);
     }
 
     assert(false);

src/value.h

@@ -27,6 +27,7 @@ enum value_type {
     VALUE_FUNC,
     VALUE_CFUNC,
     VALUE_USERDATA,
+    VALUE_NATIVE_OBJECT,
 };
 
 struct list_header {
@@ -64,6 +65,11 @@ struct cfunction {
 
 typedef struct dict_header *apfl_dict;
 
+struct native_object {
+    void *memory;
+    const struct apfl_native_object_type *type;
+};
+
 struct apfl_value {
     enum value_type type;
     union {
@@ -76,6 +82,7 @@ struct apfl_value {
         struct function *func;
         struct cfunction *cfunc;
         void *userdata;
+        struct native_object *native_object;
     };
 };
 
@@ -146,6 +153,9 @@ void apfl_function_deinit(struct apfl_allocator, struct function *);
 struct cfunction *apfl_cfunc_new(struct gc *, apfl_cfunc, size_t nslots);
 void apfl_cfunction_deinit(struct apfl_allocator, struct cfunction *);
 
+struct native_object *apfl_native_object_new(struct gc *, const struct apfl_native_object_type *);
+void apfl_native_object_deinit(struct apfl_allocator, struct native_object *);
+
 // Functions for garbage collection
 struct gc_object *apfl_value_get_gc_object(struct apfl_value);
 void apfl_value_visit_gc_object(struct apfl_value value, gc_visitor cb, void *opaque);