Liberation from libc

1 files changed, 291 insertions, 0 deletions

diff --git a/src/native.c b/src/native.c
new file mode 100644
index 0000000..c30833b
--- /dev/null
+++ b/src/native.c
@@ -0,0 +1,291 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include <lcq/pit/lexer.h>
+#include <lcq/pit/parser.h>
+#include <lcq/pit/runtime.h>
+#include <lcq/pit/library.h>
+
+i64 pit_lex_file(pit_lexer *ret, char *path) {
+    FILE *f = fopen(path, "r");
+    if (f == NULL) { return -1; }
+    fseek(f, 0, SEEK_END);
+    i64 len = ftell(f);
+    fseek(f, 0, SEEK_SET);
+    char *buf = calloc((size_t) len, sizeof(char));
+    if ((size_t) len != fread(buf, sizeof(char), (size_t) len, f)) {
+        fclose(f);
+        return -1;
+    }
+    fclose(f);
+    pit_lex_bytes(ret, buf, len);
+    return 0;
+}
+
+bool pit_runtime_print_error(pit_runtime *rt) {
+    if (!pit_eq(rt->error, PIT_NIL)) {
+        char buf[1024] = {0};
+        i64 end = pit_dump(rt, buf, sizeof(buf) - 1, rt->error, false);
+        buf[end] = 0;
+        fprintf(stderr, "error at line %ld, column %ld: %s\n", rt->error_line, rt->error_column, buf);
+        return true;
+    }
+    return false;
+}
+
+void pit_trace_(pit_runtime *rt, char *format, pit_value v) {
+    char buf[1024] = {0};
+    i64 end = pit_dump(rt, buf, sizeof(buf) - 1, v, true);
+    buf[end] = 0;
+    fprintf(stderr, format, buf);
+}
+
+pit_value pit_bytes_new_file(pit_runtime *rt, char *path) {
+    if (rt->error != PIT_NIL) return PIT_NIL;
+    FILE *f = fopen(path, "r");
+    if (f == NULL) {
+        pit_error(rt, "failed to open file: %s", path);
+        return PIT_NIL;
+    }
+    fseek(f, 0, SEEK_END);
+    i64 len = ftell(f);
+    fseek(f, 0, SEEK_SET);
+    u8 *dest = pit_arena_alloc_bulk(rt->heap, len);
+    if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; }
+    if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) {
+        fclose(f);
+        pit_error(rt, "failed to read file: %s", path);
+        return PIT_NIL;
+    }
+    fclose(f);
+    pit_value ret = pit_heavy_new(rt);
+    pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
+    if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; }
+    h->hsort = PIT_VALUE_HEAVY_SORT_BYTES;
+    h->in.bytes.data = dest;
+    h->in.bytes.len = len;
+    return ret;
+}
+
+static void check_invariants(pit_runtime *rt) {
+    if (rt->scratch->next != 0) {
+        pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next);
+    }
+    if (rt->scratch->next != 0) {
+        pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next);
+    }
+}
+pit_value pit_load_file(pit_runtime *rt, char *path) {
+    pit_lexer lex;
+    pit_parser parse;
+    bool eof = false;
+    pit_value p = PIT_NIL;
+    pit_value ret = PIT_NIL;
+    if (pit_lex_file(&lex, path) < 0) {
+        pit_error(rt, "failed to lex file: %s", path);
+        return PIT_NIL;
+    }
+    pit_parser_from_lexer(&parse, &lex);
+    while (p = pit_parse(rt, &parse, &eof), !eof) {
+        check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+        ret = pit_eval(rt, p);
+        check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+        pit_collect_garbage(rt);
+        check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+    }
+    check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+    return ret;
+}
+
+void pit_repl(pit_runtime *rt) {
+    size_t bufcap = 8;
+    char *buf = malloc(bufcap);
+    i64 len = 0;
+    pit_runtime_freeze(rt);
+    check_invariants(rt); if (pit_runtime_print_error(rt)) exit(1);
+    setbuf(stdout, NULL);
+    printf("> ");
+    while ((buf[len++] = (char) getchar()) != EOF) {
+        if (len >= (i64) bufcap) {
+            bufcap *= 2;
+            buf = realloc(buf, bufcap);
+        }
+        pit_value res;
+        pit_lexer lex;
+        pit_parser parse;
+        bool eof = false;
+        pit_value p = PIT_NIL;
+        i64 depth = 0;
+        bool lex_error = false;
+        pit_lex_token tok = PIT_LEX_TOKEN_EOF;
+        if (buf[len - 1] != '\n') continue;
+        pit_lex_bytes(&lex, buf, len);
+        while (!lex_error && (tok = pit_lex_next(&lex)) != PIT_LEX_TOKEN_EOF) {
+            switch (tok) {
+            case PIT_LEX_TOKEN_ERROR: lex_error = true; break;
+            case PIT_LEX_TOKEN_LPAREN: depth += 1; break;
+            case PIT_LEX_TOKEN_RPAREN: depth -= 1; break;
+            default: break;
+            }
+        }
+        if (lex_error || depth > 0) continue;
+        buf[len - 1] = 0;
+        pit_lex_bytes(&lex, buf, len);
+        pit_parser_from_lexer(&parse, &lex);
+        while (p = pit_parse(rt, &parse, &eof), !eof) {
+            check_invariants(rt);
+            res = pit_eval(rt, p);
+            check_invariants(rt);
+        }
+        if (pit_runtime_print_error(rt)) {
+            rt->error = PIT_NIL;
+            printf("> ");
+        } else {
+            char dumpbuf[1024] = {0};
+            pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true);
+            pit_collect_garbage(rt);
+            printf("%s\n> ", dumpbuf);
+        }
+        len = 0;
+    }
+    if (len >= (i64) sizeof(buf)) {
+        fprintf(stderr, "expression exceeded REPL buffer size\n");
+    } else {
+        printf("bye!\n");
+    }
+    free(buf);
+}
+
+static pit_value impl_diagnostics(pit_runtime *rt, pit_value args) {
+    (void) args;
+    fprintf(stderr, "value allocs: %ld\n", rt->heap->next);
+    return PIT_NIL;
+}
+static pit_value impl_print(pit_runtime *rt, pit_value args) {
+    pit_value x = pit_car(rt, args);
+    char buf[1024] = {0};
+    pit_dump(rt, buf, sizeof(buf), x, true);
+    buf[1023] = 0;
+    puts(buf);
+    return x;
+}
+static pit_value impl_princ(pit_runtime *rt, pit_value args) {
+    pit_value x = pit_car(rt, args);
+    char buf[1024] = {0};
+    pit_dump(rt, buf, sizeof(buf), x, false);
+    buf[1023] = 0;
+    puts(buf);
+    return x;
+}
+static pit_value impl_load(pit_runtime *rt, pit_value args) {
+    pit_value path = pit_car(rt, args);
+    char pathbuf[1024] = {0};
+    i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1);
+    if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; }
+    pathbuf[len] = 0;
+    return pit_load_file(rt, pathbuf);
+}
+void pit_install_library_io(pit_runtime *rt) {
+    /* diagnostics */
+    pit_fset(rt, pit_intern_cstr(rt, "diagnostics!"), pit_nativefunc_new(rt, impl_diagnostics));
+    /* stream IO */
+    pit_fset(rt, pit_intern_cstr(rt, "print!"), pit_nativefunc_new(rt, impl_print));
+    pit_fset(rt, pit_intern_cstr(rt, "princ!"), pit_nativefunc_new(rt, impl_princ));
+    /* disk IO */
+    pit_fset(rt, pit_intern_cstr(rt, "load!"), pit_nativefunc_new(rt, impl_load));
+}
+
+struct bytestring {
+    i64 len, cap;
+    u8 *data;
+};
+static pit_value impl_bs_new(pit_runtime *rt, pit_value args) {
+    (void) args;
+    i64 cap = 256;
+    struct bytestring *bs = malloc(sizeof(struct bytestring));
+    bs->len = 0;
+    bs->cap = cap;
+    bs->data = calloc((size_t) cap, 1);
+    return pit_nativedata_new(rt, pit_intern_cstr(rt, "bs"), (void *) bs);
+}
+static pit_value impl_bs_delete(pit_runtime *rt, pit_value args) {
+    pit_value v = pit_car(rt, args);
+    pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v));
+    if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; }
+    if (h->hsort != PIT_VALUE_HEAVY_SORT_NATIVEDATA) {
+        pit_error(rt, "invalid use of value as bytestring nativedata");
+        return PIT_NIL;
+    }
+    if (!pit_eq(h->in.nativedata.tag, pit_intern_cstr(rt, "bs"))) {
+        pit_error(rt, "native value is not a bytestring");
+        return PIT_NIL;
+    }
+    if (!h->in.nativedata.data) {
+        pit_error(rt, "bytestring was already freed");
+        return PIT_NIL;
+    }
+    struct bytestring *bs = h->in.nativedata.data;
+    if (bs->data) free(bs->data);
+    bs->data = NULL;
+    free(bs);
+    h->in.nativedata.data = NULL;
+    return PIT_T;
+}
+static pit_value impl_bs_grow(pit_runtime *rt, pit_value args) {
+    pit_value vsz = pit_car(rt, args);
+    pit_value v = pit_car(rt, pit_cdr(rt, args));
+    struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v);
+    if (!bs) return PIT_NIL;
+    i64 sz = pit_as_integer(rt, vsz);
+    if (sz > bs->len) {
+        if (sz > bs->cap) {
+            while (bs->cap < sz) bs->cap <<= 1;
+            bs->data = realloc(bs->data, (size_t) bs->cap);
+        }
+        bs->len = sz;
+    }
+    return v;
+}
+static pit_value impl_bs_spit(pit_runtime *rt, pit_value args) {
+    pit_value path = pit_car(rt, args);
+    char pathbuf[1024] = {0};
+    i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1);
+    if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; }
+    pathbuf[len] = 0;
+    pit_value v = pit_car(rt, pit_cdr(rt, args));
+    struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v);
+    if (!bs) return PIT_NIL;
+    FILE *f = fopen(pathbuf, "w+");
+    if (!f) { pit_error(rt, "failed to open file: %s", pathbuf); return PIT_NIL; }
+    size_t written = fwrite(bs->data, 1, (size_t) bs->len, f);
+    fclose(f);
+    if (written != (size_t) bs->len) {
+        pit_error(rt, "failed to write bytestring to file: %s", pathbuf);
+        return PIT_NIL;
+    }
+    return v;
+}
+static pit_value impl_bs_write8(pit_runtime *rt, pit_value args) {
+    pit_value v = pit_car(rt, args);
+    pit_value vidx = pit_car(rt, pit_cdr(rt, args));
+    pit_value vx = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args)));
+    struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v);
+    if (!bs) return PIT_NIL;
+    i64 idx = pit_as_integer(rt, vidx);
+    u8 x = (u8) pit_as_integer(rt, vx);
+    if (idx >= bs->len) {
+        pit_error(rt, "index %d out of bounds in bytestring (length %d)", idx, bs->len);
+        return PIT_NIL;
+    }
+    bs->data[idx] = x;
+    return v;
+}
+void pit_install_library_bytestring(pit_runtime *rt) {
+    /* bytestrings */
+    pit_fset(rt, pit_intern_cstr(rt, "bs/new!"), pit_nativefunc_new(rt, impl_bs_new));
+    pit_fset(rt, pit_intern_cstr(rt, "bs/delete!"), pit_nativefunc_new(rt, impl_bs_delete));
+    pit_fset(rt, pit_intern_cstr(rt, "bs/grow!"), pit_nativefunc_new(rt, impl_bs_grow));
+    pit_fset(rt, pit_intern_cstr(rt, "bs/spit!"), pit_nativefunc_new(rt, impl_bs_spit));
+    pit_fset(rt, pit_intern_cstr(rt, "bs/write8!"), pit_nativefunc_new(rt, impl_bs_write8));
+}