#include #include #include #include #include #include #include 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 *data) { (void) data; (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, void *data) { (void) data; 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, void *data) { (void) data; 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, void *data) { (void) data; 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 *data) { (void) data; (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, void *data) { (void) data; 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, void *data) { (void) data; 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, void *data) { (void) data; 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, void *data) { (void) data; 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)); }