summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--flake.nix1
-rw-r--r--pit/Makefile18
-rw-r--r--pit/include/lcq/pit/runtime.h3
-rw-r--r--pit/include/lcq/pit/runtime/dump.h1
-rw-r--r--pit/lisp/essential.pit4
-rw-r--r--pit/packages.nix3
-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
13 files changed, 108 insertions, 48 deletions
diff --git a/flake.nix b/flake.nix
index 9421eed..b7a7dc2 100644
--- a/flake.nix
+++ b/flake.nix
@@ -16,6 +16,7 @@
pkgs.musl
pkgs.valgrind
pkgs.universal-ctags
+ pkgs.xxd
];
buildInputs = [];
};
diff --git a/pit/Makefile b/pit/Makefile
index 6667b91..2eeb084 100644
--- a/pit/Makefile
+++ b/pit/Makefile
@@ -2,12 +2,15 @@ EXE ?= pit
CC ?= gcc
AR ?= ar
-override CPPFLAGS += -MMD -MP
-override CFLAGS += -O2 -fPIC --std=c99 -g -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -fwrapv # -ftrapv
-override LDFLAGS += -g -static
BUILD = build_$(CC)
+override CPPFLAGS += -MMD -MP
+override CFLAGS += -O2 -fPIC --std=c99 -g -I$(BUILD) -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -fanalyzer -fwrapv # -ftrapv
+override LDFLAGS += -g -static
+# override CFLAGS += -O2 -fanalyzer -fsanitize=undefined -fPIC --std=c99 -g -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -fwrapv # -ftrapv
+# override LDFLAGS += -fsanitize=undefined -g
+
SRCS_CORE := \
src/utils.c src/arena.c src/lexer.c src/parser.c src/runtime.c \
src/runtime/value.c \
@@ -16,6 +19,9 @@ SRCS_CORE := \
src/library.c
OBJECTS_CORE := $(SRCS_CORE:src/%.c=$(BUILD)/%.o)
LIB_CORE := libcolonq-pit.a
+SRCS_LISP := \
+ lisp/essential.pit
+HEADERS_LISP := $(SRCS_LISP:lisp/%.pit=$(BUILD)/lisp/%.h)
SRCS_NATIVE := src/native.c
OBJECTS_NATIVE := $(SRCS_NATIVE:src/%.c=$(BUILD)/%.o)
LIB_NATIVE := libcolonq-pit-native.a
@@ -48,10 +54,14 @@ $(BUILD):
mkdir $(BUILD)/
mkdir $(BUILD)/runtime/
mkdir $(BUILD)/runtime/value/
+ mkdir $(BUILD)/lisp/
-$(BUILD)/%.o: src/%.c | $(BUILD)
+$(BUILD)/%.o: src/%.c $(HEADERS_LISP) | $(BUILD)
$(CC) $(CPPFLAGS) $(CFLAGS) -o $@ -c $<
+$(BUILD)/lisp/%.h: lisp/%.pit | $(BUILD)
+ xxd -i $< $@
+
clean:
-rm $(EXE)
-rm $(LIB_CORE)
diff --git a/pit/include/lcq/pit/runtime.h b/pit/include/lcq/pit/runtime.h
index 96d0351..44d3c67 100644
--- a/pit/include/lcq/pit/runtime.h
+++ b/pit/include/lcq/pit/runtime.h
@@ -120,6 +120,9 @@ pit_value pit_error_get(pit_runtime *rt);
void pit_error(pit_runtime *rt, char *format, ...);
/* repl / file loading */
+void pit_check_invariants(pit_runtime *rt);
+pit_value pit_load_bytes(pit_runtime *rt, u8 *data, i64 len);
+pit_value pit_load_cstr(pit_runtime *rt, char *data);
pit_value pit_load_file(pit_runtime *rt, char *path);
void pit_repl(pit_runtime *rt);
diff --git a/pit/include/lcq/pit/runtime/dump.h b/pit/include/lcq/pit/runtime/dump.h
index 40b2a70..6df9045 100644
--- a/pit/include/lcq/pit/runtime/dump.h
+++ b/pit/include/lcq/pit/runtime/dump.h
@@ -23,6 +23,7 @@ i64 pit_dump_to_stdout(pit_runtime *rt, char *buf, i64 len, pit_value v, bool re
void pit_dump_to_file(pit_runtime *rt, void *vf, pit_value v, bool readable);
i64 pit_dump_printf_callback(va_list ap, char *buf, size_t len, void *data);
+i64 pit_dump_readable_printf_callback(va_list ap, char *buf, size_t len, void *data);
i64 pit_vsnprintf(pit_runtime *rt, char *buf, i64 len, char *format, va_list ap);
i64 pit_snprintf(pit_runtime *rt, char *buf, i64 len, char *format, ...);
i64 pit_fprintf(pit_runtime *rt, void *vf, char *format, ...);
diff --git a/pit/lisp/essential.pit b/pit/lisp/essential.pit
new file mode 100644
index 0000000..6235264
--- /dev/null
+++ b/pit/lisp/essential.pit
@@ -0,0 +1,4 @@
+(defun! list/map (f xs)
+ (if xs
+ (cons (funcall f (car xs)) (list/map f (cdr xs)))
+ nil)) \ No newline at end of file
diff --git a/pit/packages.nix b/pit/packages.nix
index 7f256b1..558cc55 100644
--- a/pit/packages.nix
+++ b/pit/packages.nix
@@ -1,5 +1,6 @@
pkgs: lcq: {
- native = pkgs.pkgsMusl.stdenv.mkDerivation {
+ # native = pkgs.pkgsMusl.stdenv.mkDerivation {
+ native = pkgs.stdenv.mkDerivation {
pname = "libcolonq-pit";
version = "git";
src = ./.;
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 04:49:56 +0000