summaryrefslogtreecommitdiff
path: root/pit/src
diff options
context:
space:
mode:
Diffstat (limited to 'pit/src')
-rw-r--r--pit/src/library.c6
-rw-r--r--pit/src/main.c3
-rw-r--r--pit/src/native.c40
-rw-r--r--pit/src/runtime.c46
-rw-r--r--pit/src/runtime/dump.c14
-rw-r--r--pit/src/runtime/eval.c15
-rw-r--r--pit/src/runtime/value/small.c2
7 files changed, 83 insertions, 43 deletions
diff --git a/pit/src/library.c b/pit/src/library.c
index 098c6f9..2d28646 100644
--- a/pit/src/library.c
+++ b/pit/src/library.c
@@ -4,6 +4,8 @@
#include <lcq/pit/runtime.h>
#include <lcq/pit/library.h>
+#include <lisp/essential.h>
+
static pit_value impl_m_defun(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value nm = pit_value_cons_car(rt, args);
@@ -866,7 +868,7 @@ void pit_install_library_essential(pit_runtime *rt) {
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/concat"), pit_value_nativefunc_new(rt, impl_list_concat));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/take"), pit_value_nativefunc_new(rt, impl_list_take));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/drop"), pit_value_nativefunc_new(rt, impl_list_drop));
- pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/map"), pit_value_nativefunc_new(rt, impl_list_map));
+ // pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/map"), pit_value_nativefunc_new(rt, impl_list_map));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/foldl"), pit_value_nativefunc_new(rt, impl_list_foldl));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/filter"), pit_value_nativefunc_new(rt, impl_list_filter));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "list/find"), pit_value_nativefunc_new(rt, impl_list_find));
@@ -912,6 +914,8 @@ void pit_install_library_essential(pit_runtime *rt) {
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "bitwise/not"), pit_value_nativefunc_new(rt, impl_bitwise_not));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "bitwise/lshift"), pit_value_nativefunc_new(rt, impl_bitwise_lshift));
pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "bitwise/rshift"), pit_value_nativefunc_new(rt, impl_bitwise_rshift));
+ /* lisp code */
+ pit_load_bytes(rt, (u8 *) lisp_essential_pit, (i64) lisp_essential_pit_len);
}
static pit_value impl_plist_get(pit_runtime *rt, pit_value args, void *data) {
diff --git a/pit/src/main.c b/pit/src/main.c
index 2b741c1..ee6a63b 100644
--- a/pit/src/main.c
+++ b/pit/src/main.c
@@ -11,12 +11,11 @@ int main(int argc, char **argv) {
i64 sz = 256 * 1024 * 1024;
u8 *buf = malloc((size_t) sz);
pit_runtime *rt = pit_runtime_new(buf, sz);
- rt->fuel = 10000000;
pit_install_library_essential(rt);
- pit_install_library_io(rt);
pit_install_library_plist(rt);
pit_install_library_alist(rt);
pit_install_library_bytestring(rt);
+ pit_install_library_io(rt);
if (argc < 2) {
pit_repl(rt);
} else {
diff --git a/pit/src/native.c b/pit/src/native.c
index 8ef886d..7d61a50 100644
--- a/pit/src/native.c
+++ b/pit/src/native.c
@@ -39,9 +39,10 @@ i64 pit_fprintf(pit_runtime *rt, void *vf, char *format, ...) {
va_list ap;
va_start(ap, format);
char buf[8192];
- pit_printf_handler h[1];
+ pit_printf_handler h[2];
h[0].specifier = 'v'; h[0].callback = pit_dump_printf_callback;
- int ret = pit_vsnprintf_helper(buf, sizeof(buf) - 1, format, ap, h, 1, rt);
+ h[1].specifier = 'V'; h[1].callback = pit_dump_readable_printf_callback;
+ int ret = pit_vsnprintf_helper(buf, sizeof(buf) - 1, format, ap, h, 2, rt);
buf[ret] = 0;
va_end(ap);
fputs(buf, f);
@@ -101,27 +102,6 @@ pit_value pit_value_bytes_new_file(pit_runtime *rt, char *path) {
return ret;
}
-/* check invariants - these should always hold between top-level evaluations! */
-static void check_invariants(pit_runtime *rt) {
- if (rt->saved_bindings->next != 0) {
- pit_error(rt, "leaked saved_bindings memory! %ld", rt->saved_bindings->next);
- }
- if (rt->expr_stack->next != 0) {
- pit_error(rt, "leaked expr_stack memory! %ld", rt->expr_stack->next);
- }
- if (rt->result_stack->next != 0) {
- pit_error(rt, "leaked result_stack memory! %ld", rt->result_stack->next);
- }
- if (rt->compilation_stack->next != 0) {
- pit_error(rt, "leaked compilation_stack memory! %ld", rt->compilation_stack->next);
- }
- if (rt->traversal->next != 0) {
- pit_error(rt, "leaked traversal memory! %ld", rt->traversal->next);
- }
- if (rt->callstack->next != 0) {
- pit_error(rt, "leaked callstack memory! %ld", rt->result_stack->next);
- }
-}
pit_value pit_load_file(pit_runtime *rt, char *path) {
pit_lexer lex;
pit_parser parse;
@@ -135,13 +115,13 @@ pit_value pit_load_file(pit_runtime *rt, char *path) {
}
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;
+ pit_check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
compiled = pit_compile(rt, p);
- check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+ pit_check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
ret = pit_vm_eval(rt, compiled);
- check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+ pit_check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
}
- check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
+ pit_check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
return ret;
}
@@ -149,7 +129,7 @@ void pit_repl(pit_runtime *rt) {
size_t bufcap = 8;
char *buf = malloc(bufcap);
i64 len = 0;
- check_invariants(rt); if (pit_runtime_print_error(rt)) exit(1);
+ pit_check_invariants(rt); if (pit_runtime_print_error(rt)) exit(1);
setbuf(stdout, NULL);
printf("> ");
while ((buf[len++] = (char) getchar()) != EOF) {
@@ -180,9 +160,9 @@ void pit_repl(pit_runtime *rt) {
pit_lex_bytes(&lex, buf, len);
pit_parser_from_lexer(&parse, &lex);
while (p = pit_parse(rt, &parse, &eof), !eof) {
- check_invariants(rt);
+ pit_check_invariants(rt);
res = pit_vm_eval(rt, pit_compile(rt, pit_macroexpand(rt, p)));
- check_invariants(rt);
+ pit_check_invariants(rt);
}
if (pit_runtime_print_error(rt)) {
rt->error = PIT_NIL;
diff --git a/pit/src/runtime.c b/pit/src/runtime.c
index ab65d71..429e923 100644
--- a/pit/src/runtime.c
+++ b/pit/src/runtime.c
@@ -163,3 +163,49 @@ void pit_traversal_push_end_code(struct pit_runtime *rt, pit_vec(pit_traversal_e
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
+
+/* check invariants - these should always hold between top-level evaluations! */
+void pit_check_invariants(pit_runtime *rt) {
+ if (rt->saved_bindings->next != 0) {
+ pit_error(rt, "leaked saved_bindings memory! %ld", rt->saved_bindings->next);
+ }
+ if (rt->expr_stack->next != 0) {
+ pit_error(rt, "leaked expr_stack memory! %ld", rt->expr_stack->next);
+ }
+ if (rt->result_stack->next != 0) {
+ pit_error(rt, "leaked result_stack memory! %ld", rt->result_stack->next);
+ }
+ if (rt->compilation_stack->next != 0) {
+ pit_error(rt, "leaked compilation_stack memory! %ld", rt->compilation_stack->next);
+ }
+ if (rt->traversal->next != 0) {
+ pit_error(rt, "leaked traversal memory! %ld", rt->traversal->next);
+ }
+ if (rt->callstack->next != 0) {
+ pit_error(rt, "leaked callstack memory! %ld", rt->callstack->next);
+ }
+}
+
+pit_value pit_load_bytes(pit_runtime *rt, u8 *data, i64 len) {
+ pit_lexer lex;
+ pit_parser parse;
+ bool eof = false;
+ pit_value p = PIT_NIL;
+ pit_value compiled = PIT_NIL;
+ pit_value ret = PIT_NIL;
+ pit_lex_bytes(&lex, (char *) data, len);
+ pit_parser_from_lexer(&parse, &lex);
+ while (p = pit_parse(rt, &parse, &eof), !eof) {
+ pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
+ compiled = pit_compile(rt, p);
+ pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
+ ret = pit_vm_eval(rt, compiled);
+ pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
+ }
+ pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
+ return ret;
+}
+pit_value pit_load_cstr(pit_runtime *rt, char *data) {
+ i64 len = (i64) pit_libc_string_strlen(data);
+ return pit_load_bytes(rt, (u8 *) data, len);
+}
diff --git a/pit/src/runtime/dump.c b/pit/src/runtime/dump.c
index 734c379..52441a8 100644
--- a/pit/src/runtime/dump.c
+++ b/pit/src/runtime/dump.c
@@ -111,8 +111,8 @@ pit_dump_condition pit_dump_with_callback(
if (readable) { buf[i++] = '"'; }
i64 maxlen = len - i;
for (i64 j = 0; i < maxlen && j < h->in.bytes.len;) {
- bool needs_backslash =
- (i == 0 || buf[i - 1] != '\\')
+ bool needs_backslash = readable
+ && (i == 0 || buf[i - 1] != '\\')
&& (h->in.bytes.data[j] == '\\' || h->in.bytes.data[j] == '"');
if (needs_backslash) {
buf[i++] = '\\';
@@ -192,11 +192,17 @@ i64 pit_dump_printf_callback(va_list ap, char *buf, size_t len, void *data) {
pit_value arg = va_arg(ap, pit_value);
return pit_dump(rt, buf, (i64) len, arg, false);
}
+i64 pit_dump_readable_printf_callback(va_list ap, char *buf, size_t len, void *data) {
+ pit_runtime *rt = (pit_runtime *) data;
+ pit_value arg = va_arg(ap, pit_value);
+ return pit_dump(rt, buf, (i64) len, arg, true);
+}
i64 pit_vsnprintf(pit_runtime *rt, char *buf, i64 len, char *format, va_list ap) {
if (len == 0) return 0;
- pit_printf_handler h[1];
+ pit_printf_handler h[2];
h[0].specifier = 'v'; h[0].callback = pit_dump_printf_callback;
- i64 ret = pit_vsnprintf_helper(buf, (size_t) (len - 1), format, ap, h, 1, rt);
+ h[1].specifier = 'V'; h[1].callback = pit_dump_readable_printf_callback;
+ i64 ret = pit_vsnprintf_helper(buf, (size_t) (len - 1), format, ap, h, 2, rt);
buf[ret] = 0;
return ret;
}
diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c
index a2ed166..3cd1c1f 100644
--- a/pit/src/runtime/eval.c
+++ b/pit/src/runtime/eval.c
@@ -152,13 +152,14 @@ static pit_value vm_erase_empty(pit_runtime *rt, bool unbind) {
/* run one instruction of the VM */
bool pit_vm_run_one(pit_runtime *rt) {
vm_erase_empty(rt, true);
- if (rt->callstack->next < 1 || rt->error != PIT_NIL) return false;
+ if (rt->callstack->next < 1) return false;
+ if (rt->error != PIT_NIL) goto err;
pit_callstack_entry *ent = pit_vec_get(pit_callstack_entry)(rt->callstack, rt->callstack->next - 1);
- if (ent == NULL) { pit_error(rt, "malformed call stack"); return false; }
- if (rt->fuel == 0) { pit_error(rt, "out of fuel"); return false; }
+ if (ent == NULL) { pit_error(rt, "malformed call stack"); goto err; }
+ if (rt->fuel == 0) { pit_error(rt, "out of fuel"); goto err; }
rt->fuel -= 1;
pit_value ins = pit_value_cons_car(rt, ent->code);
- if (ins == PIT_NIL) { pit_error(rt, "malformed vm instruction: %v %v", ins); return false; }
+ if (ins == PIT_NIL) { pit_error(rt, "malformed vm instruction: %v %v", ins); goto err; }
ent->code = pit_value_cons_cdr(rt, ent->code);
pit_value op = pit_value_cons_car(rt, ins);
if (pit_symtab_symbol_name_match_cstr(rt, op, "literal")) {
@@ -196,13 +197,17 @@ bool pit_vm_run_one(pit_runtime *rt) {
pit_value args = PIT_NIL;
while (arity-- > 0) args = pit_value_cons(rt, vm_pop(rt), args);
pit_value bindings = vm_erase_empty(rt, false);
- if (!vm_call(rt, f, args, bindings)) return false;
+ if (!vm_call(rt, f, args, bindings)) goto err;
} else {
pit_error(rt, "unrecognized vm instruction: %v", ins);
return false;
}
vm_erase_empty(rt, true);
return true;
+err:
+ rt->result_stack->next = 0;
+ rt->callstack->next = 0;
+ return false;
}
/* run the VM until evaluation of this code finishes, returning the result */
diff --git a/pit/src/runtime/value/small.c b/pit/src/runtime/value/small.c
index e0bdf0a..7b9057e 100644
--- a/pit/src/runtime/value/small.c
+++ b/pit/src/runtime/value/small.c
@@ -23,7 +23,7 @@ pit_value pit_value_double_new(pit_runtime *rt, double d) {
i64 pit_value_as_integer(pit_runtime *rt, pit_value v) {
if (pit_value_sort(v) != PIT_VALUE_SORT_INTEGER) {
- pit_error(rt, "invalid use of value %v as integer", v);
+ pit_error(rt, "invalid use of value %V as integer", v);
return -1;
}
u64 lo = pit_value_data(v);
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-31 05:26:22 +0000