diff options
| author | LLLL Colonq <llll@colonq> | 2026-08-10 21:49:57 -0400 |
|---|---|---|
| committer | LLLL Colonq <llll@colonq> | 2026-08-10 21:49:57 -0400 |
| commit | 7b9c4a3ac265026d98624ac614eead866a190042 (patch) | |
| tree | 2c5024583a047223ad7f5866d800554c9b81e191 | |
| parent | d70a6e5310607a25aabde85d0aa18948704f8f6a (diff) | |
pit: VM-style evaluation
| -rw-r--r-- | 6502/6502.pdf | bin | 0 -> 5586896 bytes | |||
| -rw-r--r-- | pit/include/lcq/pit/runtime.h | 11 | ||||
| -rw-r--r-- | pit/include/lcq/pit/runtime/eval.h | 3 | ||||
| -rw-r--r-- | pit/include/lcq/pit/vec.h | 2 | ||||
| -rw-r--r-- | pit/src/library.c | 99 | ||||
| -rw-r--r-- | pit/src/native.c | 51 | ||||
| -rw-r--r-- | pit/src/runtime.c | 2 | ||||
| -rw-r--r-- | pit/src/runtime/eval.c | 305 | ||||
| -rw-r--r-- | pit/src/runtime/value/func.c | 7 | ||||
| -rw-r--r-- | pit/test/compile.pit | 6 | ||||
| -rw-r--r-- | pit/test/recurse.pit | 5 |
11 files changed, 363 insertions, 128 deletions
diff --git a/6502/6502.pdf b/6502/6502.pdf Binary files differnew file mode 100644 index 0000000..3ed6b30 --- /dev/null +++ b/6502/6502.pdf diff --git a/pit/include/lcq/pit/runtime.h b/pit/include/lcq/pit/runtime.h index a55c2d2..075d94c 100644 --- a/pit/include/lcq/pit/runtime.h +++ b/pit/include/lcq/pit/runtime.h @@ -31,12 +31,13 @@ PIT_DECLARE_HASHTABLE(pit_ref, pit_annotation) void pit_annotation_set(struct pit_runtime *rt, pit_ref ref, pit_annotation annotation); pit_annotation *pit_annotation_get(struct pit_runtime *rt, pit_ref ref); -/* entry in the backtrace */ typedef struct { - pit_value val; + pit_value tag; /* (possibly nil) identifier for this frame for error messages */ pit_annotation ann; -} pit_backtrace_entry; -PIT_DECLARE_VEC(pit_backtrace_entry) + pit_value bound; /* list of bound names */ + pit_value code; /* list of vm expressions */ +} pit_callstack_entry; +PIT_DECLARE_VEC(pit_callstack_entry) /* entries on a stack used when traversing trees of values */ typedef struct { @@ -70,7 +71,7 @@ typedef struct pit_runtime { pit_vec(pit_value) *expr_stack; /* stack of subexpressions to evaluate during evaluation */ pit_vec(pit_value) *result_stack; /* stack of intermediate values during evaluation */ pit_vec(pit_traversal_entry) *traversal; /* intermediate stack used during tree traversal */ - pit_vec(pit_backtrace_entry) *backtrace; /* stack of enclosing function calls */ + pit_vec(pit_callstack_entry) *callstack; /* stack of enclosing function calls */ /* bookkeeping */ /* "frozen" values offsets: values before these offsets are immutable, and we can reset here later */ i64 frozen_values, frozen_symtab; diff --git a/pit/include/lcq/pit/runtime/eval.h b/pit/include/lcq/pit/runtime/eval.h index 3dc9e3c..41ec046 100644 --- a/pit/include/lcq/pit/runtime/eval.h +++ b/pit/include/lcq/pit/runtime/eval.h @@ -3,6 +3,7 @@ #include <lcq/pit/runtime.h> -pit_value pit_eval(pit_runtime *rt, pit_value e); +pit_value pit_vm_compile(pit_runtime *rt, pit_value top); +pit_value pit_vm_eval(pit_runtime *rt, pit_value v); #endif diff --git a/pit/include/lcq/pit/vec.h b/pit/include/lcq/pit/vec.h index b60140f..e4f918c 100644 --- a/pit/include/lcq/pit/vec.h +++ b/pit/include/lcq/pit/vec.h @@ -45,7 +45,7 @@ static __attribute__ ((unused)) i64 pit_vec_pop(ty)(pit_vec(ty) *s, ty *v) { \ i64 idx = (s->next - 1); \ if (s->next == 0 || idx + 1 > s->capacity) return -1; \ - *v = s->data[idx]; \ + if (v) *v = s->data[idx]; \ return --s->next; \ } diff --git a/pit/src/library.c b/pit/src/library.c index cbe7f71..e70a705 100644 --- a/pit/src/library.c +++ b/pit/src/library.c @@ -6,65 +6,64 @@ static pit_value impl_sf_quote(pit_runtime *rt, pit_value args, void *data) { (void) data; - pit_traversal_push_value(rt, rt->traversal, pit_value_cons_car(rt, args)); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), pit_value_cons_car(rt, args)) + ); return PIT_NIL; } static pit_value impl_sf_if(pit_runtime *rt, pit_value args, void *data) { (void) data; - pit_value c = pit_value_cons_car(rt, args); - if (pit_eval(rt, c) != PIT_NIL) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, args))) < 0) - pit_error(rt, "in special form \"if\": evaluation stack overflow"); - } else { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)))) < 0) - pit_error(rt, "in special form \"if\": evaluation stack overflow"); - } + // TODO + // pit_value c = pit_value_cons_car(rt, args); + // if (pit_eval(rt, c) != PIT_NIL) { + // if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, args))) < 0) + // pit_error(rt, "in special form \"if\": evaluation stack overflow"); + // } else { + // if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)))) < 0) + // pit_error(rt, "in special form \"if\": evaluation stack overflow"); + // } return PIT_NIL; } static pit_value impl_sf_cond(pit_runtime *rt, pit_value args, void *data) { (void) data; - while (args != PIT_NIL) { - pit_value clause = pit_value_cons_car(rt, args); - pit_value cond = pit_value_cons_car(rt, clause); - if (pit_eval(rt, cond) != PIT_NIL) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_cons_cdr(rt, clause))) < 0) - pit_error(rt, "in special form \"cond\": evaluation stack overflow"); - return PIT_NIL; - } - args = pit_value_cons_cdr(rt, args); - } - if (pit_vec_push(pit_value)(rt->expr_stack, PIT_NIL) < 0) - pit_error(rt, "in special form \"cond\": evaluation stack overflow"); - return PIT_NIL; -} -static pit_value impl_sf_progn(pit_runtime *rt, pit_value args, void *data) { - (void) data; - pit_value bodyforms = args; - pit_value final = PIT_NIL; - while (bodyforms != PIT_NIL) { - final = pit_eval(rt, pit_value_cons_car(rt, bodyforms)); - bodyforms = pit_value_cons_cdr(rt, bodyforms); - } - pit_traversal_push_value(rt, rt->traversal, final); + // TODO + // while (args != PIT_NIL) { + // pit_value clause = pit_value_cons_car(rt, args); + // pit_value cond = pit_value_cons_car(rt, clause); + // if (pit_eval(rt, cond) != PIT_NIL) { + // if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_cons_cdr(rt, clause))) < 0) + // pit_error(rt, "in special form \"cond\": evaluation stack overflow"); + // return PIT_NIL; + // } + // args = pit_value_cons_cdr(rt, args); + // } + // if (pit_vec_push(pit_value)(rt->expr_stack, PIT_NIL) < 0) + // pit_error(rt, "in special form \"cond\": evaluation stack overflow"); return PIT_NIL; } static pit_value impl_sf_or(pit_runtime *rt, pit_value args, void *data) { (void) data; - pit_value bodyforms = args; - pit_value final = PIT_NIL; - while (bodyforms != PIT_NIL) { - final = pit_eval(rt, pit_value_cons_car(rt, bodyforms)); - if (final != PIT_NIL) break; - bodyforms = pit_value_cons_cdr(rt, bodyforms); - } - pit_traversal_push_value(rt, rt->traversal, final); + // TODO + // pit_value bodyforms = args; + // pit_value final = PIT_NIL; + // while (bodyforms != PIT_NIL) { + // final = pit_eval(rt, pit_value_cons_car(rt, bodyforms)); + // if (final != PIT_NIL) break; + // bodyforms = pit_value_cons_cdr(rt, bodyforms); + // } + // pit_traversal_push_value(rt, rt->traversal, final); return PIT_NIL; } static pit_value impl_sf_lambda(pit_runtime *rt, pit_value args, void *data) { (void) data; pit_value as = pit_value_cons_car(rt, args); pit_value body = pit_value_cons_cdr(rt, args); - pit_traversal_push_value(rt, rt->traversal, pit_value_func_lambda(rt, as, body)); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, + pit_symtab_intern_cstr(rt, "literal"), + pit_value_func_lambda(rt, as, body) + ) + ); return PIT_NIL; } static pit_value impl_m_defun(pit_runtime *rt, pit_value args, void *data) { @@ -246,6 +245,16 @@ static pit_value impl_m_case(pit_runtime *rt, pit_value args, void *data) { pit_value_cons(rt, pit_symtab_intern_cstr(rt, "cond"), pit_value_list_reverse(rt, clauses)) ); } + +static pit_value impl_progn(pit_runtime *rt, pit_value args, void *data) { + (void) data; + pit_value ret = PIT_NIL; + while (args != PIT_NIL) { + ret = pit_value_cons_car(rt, args); + args = pit_value_cons_cdr(rt, args); + } + return ret; +} static pit_value impl_set(pit_runtime *rt, pit_value args, void *data) { (void) data; pit_value sym = pit_value_cons_car(rt, args); @@ -287,7 +296,9 @@ static pit_value impl_error(pit_runtime *rt, pit_value args, void *data) { } static pit_value impl_eval(pit_runtime *rt, pit_value args, void *data) { (void) data; - return pit_eval(rt, pit_value_cons_car(rt, args)); + // TODO + return PIT_NIL; + // return pit_eval(rt, pit_value_cons_car(rt, args)); } static pit_value impl_eq_p(pit_runtime *rt, pit_value args, void *data) { (void) data; @@ -790,7 +801,6 @@ void pit_install_library_essential(pit_runtime *rt) { pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "quote"), pit_value_nativefunc_new(rt, impl_sf_quote)); pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "if"), pit_value_nativefunc_new(rt, impl_sf_if)); pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "cond"), pit_value_nativefunc_new(rt, impl_sf_cond)); - pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_nativefunc_new(rt, impl_sf_progn)); pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "or"), pit_value_nativefunc_new(rt, impl_sf_or)); pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "lambda"), pit_value_nativefunc_new(rt, impl_sf_lambda)); /* macros */ @@ -803,7 +813,8 @@ void pit_install_library_essential(pit_runtime *rt) { pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "case"), pit_value_nativefunc_new(rt, impl_m_case)); /* error */ pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "error!"), pit_value_nativefunc_new(rt, impl_error)); - /* eval */ + /* basics */ + pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_nativefunc_new(rt, impl_progn)); pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "eval!"), pit_value_nativefunc_new(rt, impl_eval)); /* predicates */ pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "eq?"), pit_value_nativefunc_new(rt, impl_eq_p)); diff --git a/pit/src/native.c b/pit/src/native.c index 2ffba0a..e4e0bf1 100644 --- a/pit/src/native.c +++ b/pit/src/native.c @@ -33,11 +33,11 @@ void pit_dump_to_file(pit_runtime *rt, void *vf, pit_value v, bool readable) { bool pit_runtime_print_error(pit_runtime *rt) { if (!pit_value_eq(rt->error, PIT_NIL)) { - for (i64 i = 0; i < rt->backtrace->next; ++i) { - pit_backtrace_entry *a = pit_vec_get(pit_backtrace_entry)(rt->backtrace, i); + for (i64 i = 0; i < rt->callstack->next; ++i) { + pit_callstack_entry *a = pit_vec_get(pit_callstack_entry)(rt->callstack, i); if (a == NULL) continue; fprintf(stderr, "on line %ld, column %ld (call to ", a->ann.line, a->ann.column); - pit_dump_to_file(rt, stderr, a->val, false); + pit_dump_to_file(rt, stderr, a->tag, false); fprintf(stderr, "):\n"); } fprintf(stderr, "error at line %ld, column %ld: ", rt->error_line, rt->error_column); @@ -45,7 +45,7 @@ bool pit_runtime_print_error(pit_runtime *rt) { fprintf(stderr, "\n"); return true; } - pit_vec_reset(pit_backtrace_entry)(rt->backtrace); + pit_vec_reset(pit_callstack_entry)(rt->callstack); return false; } @@ -95,25 +95,27 @@ static void check_invariants(pit_runtime *rt) { } } 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_gc(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; + // TODO + return PIT_NIL; + // 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_gc(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) { @@ -153,7 +155,8 @@ void pit_repl(pit_runtime *rt) { pit_parser_from_lexer(&parse, &lex); while (p = pit_parse(rt, &parse, &eof), !eof) { check_invariants(rt); - res = pit_eval(rt, p); + // res = pit_eval(rt, p); + res = pit_vm_eval(rt, pit_vm_compile(rt, p)); check_invariants(rt); } if (pit_runtime_print_error(rt)) { diff --git a/pit/src/runtime.c b/pit/src/runtime.c index b8ac178..bef7578 100644 --- a/pit/src/runtime.c +++ b/pit/src/runtime.c @@ -42,7 +42,7 @@ pit_runtime *pit_runtime_new(u8 *buf, i64 len) { ret->expr_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size); ret->result_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size); ret->traversal = pit_vec_new(pit_traversal_entry)(pit_arena_alloc_back(a, stack_size), stack_size); - ret->backtrace = pit_vec_new(pit_backtrace_entry)(pit_arena_alloc_back(a, stack_size), stack_size); + ret->callstack = pit_vec_new(pit_callstack_entry)(pit_arena_alloc_back(a, stack_size), stack_size); ret->saved_bindings = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size); ret->frozen_values = 0; ret->frozen_symtab = 0; diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 44c9a57..1822bc5 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -1,10 +1,39 @@ #include <lcq/pit/runtime/eval.h> -pit_value pit_eval(pit_runtime *rt, pit_value top) { +#include <stdio.h> + +void pit_vm_call_special_form(pit_runtime *rt, pit_value f, pit_value args) { + char buf[256] = {0}; + switch (pit_value_sort(f)) { + case PIT_VALUE_SORT_REF: { + pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, f)); + if (!h) { pit_error(rt, "bad ref for special form"); return; } + switch (h->hsort) { + case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: + h->in.nativefunc.f(rt, args, h->in.nativefunc.data); + break; + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-nativefunc special form: %s", buf); + return; + } + } + break; + } + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function special form: %s", buf); + return; + } + } +} + +pit_value pit_vm_compile(pit_runtime *rt, pit_value top) { + pit_value ret = PIT_NIL; i64 expr_stack_reset = rt->expr_stack->next; - i64 result_stack_reset = rt->result_stack->next; i64 traversal_reset = rt->traversal->next; - // pit_vec_reset(pit_annotated_ref)(rt->backtrace); if (pit_vec_push(pit_value)(rt->expr_stack, top) < 0) pit_error(rt, "evaluation stack overflow"); /* first, convert the expression tree into "polish notation" in traversal */ @@ -13,22 +42,17 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { if (rt->error != PIT_NIL) goto end; if (pit_vec_pop(pit_value)(rt->expr_stack, &cur) < 0) pit_error(rt, "evaluation stack underflow"); - if (pit_value_is_cons(rt, cur)) { /* compound expressions: function/macro application special forms */ + fprintf(stderr, "cur: "); pit_dump_to_file(rt, stderr, cur, false); fprintf(stderr, "\n"); + if (pit_value_is_cons(rt, cur)) { pit_value fsym = pit_value_cons_car(rt, cur); bool is_symbol = pit_value_is_symbol(rt, fsym); pit_annotation *ann = pit_annotation_get(rt, pit_value_as_ref(rt, cur)); if (is_symbol && pit_symtab_is_symbol_special_form(rt, fsym)) { /* special forms */ pit_value f = pit_symtab_fget(rt, fsym); pit_value args = pit_value_cons_cdr(rt, cur); - /* special forms are nativefuncs that directly manipulate the stacks - basically macros, but we don't need to evaluate the return value */ - pit_value_apply(rt, f, args); + pit_vm_call_special_form(rt, f, args); } else if (is_symbol && pit_symtab_is_symbol_macro(rt, fsym)) { /* macros */ - pit_value f = pit_symtab_fget(rt, fsym); - pit_value args = pit_value_cons_cdr(rt, cur); - pit_value res = pit_value_apply(rt, f, args); - if (pit_vec_push(pit_value)(rt->expr_stack, res) < 0) - pit_error(rt, "evaluation stack overflow"); + pit_error(rt, "encountered a macro while evaluating"); } else { /* normal functions */ pit_value args = pit_value_cons_cdr(rt, cur); i64 argcount = 0; @@ -42,69 +66,250 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { if (pit_vec_push(pit_value)(rt->expr_stack, fsym) < 0) pit_error(rt, "evaluation stack overflow"); } - pit_traversal_push_application(rt, rt->traversal, argcount, ann); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "apply"), pit_value_integer_new(rt, argcount)) + ); if (is_symbol) { - pit_value f = pit_symtab_fget(rt, fsym); - pit_traversal_push_value(rt, rt->traversal, f); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "fget")) + ); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), fsym) + ); } } } else if (pit_value_is_symbol(rt, cur)) { /* unquoted symbols: variable lookup */ pit_symtab_entry *ent = pit_symtab_lookup(rt, cur); if (ent->is_keyword) { - pit_traversal_push_value(rt, rt->traversal, cur); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) + ); } else { - pit_traversal_push_value(rt, rt->traversal, pit_symtab_get(rt, cur)); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "get")) + ); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) + ); } } else { /* other expressions evaluate to themselves! */ - pit_traversal_push_value(rt, rt->traversal, cur); + pit_traversal_push_value(rt, rt->traversal, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur) + ); } } - /* then, execute the polish notation traversal from right to left - this has the nice consequence of putting the arguments in the right order */ - for (i64 idx = rt->traversal->next - 1; idx >= traversal_reset; --idx) { + for (i64 idx = traversal_reset; idx < rt->traversal->next; idx++) { pit_traversal_entry *ent = pit_vec_get(pit_traversal_entry)(rt->traversal, idx); if (ent == NULL) pit_error(rt, "evaluation traversal invalid"); if (rt->error != PIT_NIL) goto end; switch (ent->sort) { - case PIT_TRAVERSAL_ENTRY_VALUE: - if (pit_vec_push(pit_value)(rt->result_stack, ent->in.value) < 0) - pit_error(rt, "evaluation result stack overflow"); - break; - case PIT_TRAVERSAL_ENTRY_APPLICATION: { - pit_value f = PIT_NIL; - pit_value args = PIT_NIL; - if (pit_vec_pop(pit_value)(rt->result_stack, &f) < 0) - pit_error(rt, "evaluation result stack underflow"); - for (i64 i = 0; i < ent->in.application.arity; ++i) { - pit_value a = PIT_NIL; - if (pit_vec_pop(pit_value)(rt->result_stack, &a) < 0) - pit_error(rt, "evaluation result stack underflow"); - args = pit_value_cons(rt, a, args); - } - if (ent->in.application.annotation != NULL) { - pit_backtrace_entry be; - be.val = f; - be.ann = *ent->in.application.annotation; - rt->source_line = ent->in.application.annotation->line; - rt->source_column = ent->in.application.annotation->column; - pit_vec_push(pit_backtrace_entry)(rt->backtrace, be); - } - if (pit_vec_push(pit_value)(rt->result_stack, pit_value_apply(rt, f, args)) < 0) - pit_error(rt, "evaluation result stack underflow"); + case PIT_TRAVERSAL_ENTRY_VALUE: { + ret = pit_value_cons(rt, ent->in.value, ret); break; } default: pit_error(rt, "unknown traversal entry"); + ret = PIT_NIL; goto end; } } end: { - pit_value ret = PIT_NIL; - if (pit_vec_pop(pit_value)(rt->result_stack, &ret) < 0) - pit_error(rt, "evaluation result stack underflow"); rt->expr_stack->next = expr_stack_reset; - rt->result_stack->next = result_stack_reset; rt->traversal->next = traversal_reset; + fprintf(stderr, "compiled: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); return ret; } } + +/* add a new stack frame to the vm (with a tag and callsite annotation) */ +void pit_vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_annotation ann, pit_value bound) { + pit_callstack_entry ent; + ent.tag = tag; + ent.ann = ann; + ent.code = code; + ent.bound = bound; + fprintf(stderr, "push code: "); pit_dump_to_file(rt, stderr, code, false); fprintf(stderr, "\n"); + if (pit_vec_push(pit_callstack_entry)(rt->callstack, ent) < 0) { + pit_error(rt, "call stack overflow"); + } +} + +/* add a new stack frame to the vm (with no annotation) */ +void pit_vm_push_code(pit_runtime *rt, pit_value code) { + pit_annotation ann; + ann.line = -1; + ann.column = -1; + pit_vm_push_code_func(rt, code, PIT_NIL, ann, PIT_NIL); +} + +void pit_vm_push(pit_runtime *rt, pit_value v) { + fprintf(stderr, "push: "); pit_dump_to_file(rt, stderr, v, false); fprintf(stderr, "\n"); + if (pit_vec_push(pit_value)(rt->result_stack, v) < 0) { + pit_error(rt, "vm stack overflow"); + } +} + +pit_value pit_vm_pop(pit_runtime *rt) { + pit_value ret = PIT_NIL; + if (pit_vec_pop(pit_value)(rt->result_stack, &ret) < 0) { + pit_error(rt, "vm stack underflow"); + } + fprintf(stderr, "pop: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); + return ret; +} + +void pit_vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args) { + pit_value bound = PIT_NIL; + pit_value env = pit_value_array_get(rt, closure, 0); + pit_value anames = pit_value_array_get(rt, closure, 1); + pit_value arg_rest_nm = pit_value_array_get(rt, closure, 2); + pit_value body = pit_value_array_get(rt, closure, 3); + if (rt->error != PIT_NIL) return; + while (env != PIT_NIL) { /* first, bind all entries in the closure */ + pit_value b = pit_value_cons_car(rt, env); + pit_value nm = pit_value_cons_car(rt, b); + pit_symtab_bind(rt, nm, pit_value_cons_cdr(rt, b)); + bound = pit_value_cons(rt, nm, bound); + env = pit_value_cons_cdr(rt, env); + } + while (anames != PIT_NIL) { /* bind all argument names to their values */ + pit_value nm = pit_value_cons_car(rt, anames); + pit_value cell = pit_value_cell_new(rt, PIT_NIL); + if (arg_rest_nm != PIT_NIL && pit_value_eq(nm, arg_rest_nm)) { + pit_value_cell_set(rt, cell, args, nm); + pit_symtab_bind(rt, nm, cell); + break; + } else { + pit_value_cell_set(rt, cell, pit_value_cons_car(rt, args), nm); + pit_symtab_bind(rt, nm, cell); + } + bound = pit_value_cons(rt, nm, bound); + args = pit_value_cons_cdr(rt, args); + anames = pit_value_cons_cdr(rt, anames); + } + pit_annotation ann; + ann.line = -1; + ann.column = -1; + pit_vm_push_code_func(rt, body, tag, ann, bound); +} + +void pit_vm_call(pit_runtime *rt, pit_value f, pit_value args) { + char buf[256] = {0}; + if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f); + switch (pit_value_sort(f)) { + case PIT_VALUE_SORT_REF: { + pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, f)); + if (!h) { pit_error(rt, "bad ref for function"); return; } + switch (h->hsort) { + case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: + pit_vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); + break; + case PIT_VALUE_HEAVY_SORT_FUNC: + pit_vm_call_lisp(rt, h->in.func.nm, h->in.func.closure, args); + break; + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function ref: %s", buf); + return; + } + } + break; + } + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function value: %s", buf); + return; + } + } +} + +/* run one instruction of the VM */ +bool pit_vm_run_one(pit_runtime *rt) { + char buf[256] = {0}; + if (rt->callstack->next < 1) return false; + 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; + } + pit_value ins = pit_value_cons_car(rt, ent->code); + if (ins == PIT_NIL) { + pit_error(rt, "malformed vm instruction"); + return false; + } + pit_value bound = ent->bound; + pit_value rest = pit_value_cons_cdr(rt, ent->code); + bool final = false; + if (rest == PIT_NIL) { + final = true; + pit_vec_pop(pit_callstack_entry)(rt->callstack, NULL); + } else ent->code = rest; + fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); + pit_value op = pit_value_cons_car(rt, ins); + if (pit_symtab_symbol_name_match_cstr(rt, op, "literal")) { + pit_vm_push(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); + } else if (pit_symtab_symbol_name_match_cstr(rt, op, "get")) { + pit_vm_push(rt, pit_symtab_get(rt, pit_vm_pop(rt))); + } else if (pit_symtab_symbol_name_match_cstr(rt, op, "fget")) { + pit_vm_push(rt, pit_symtab_fget(rt, pit_vm_pop(rt))); + } else if (pit_symtab_symbol_name_match_cstr(rt, op, "apply")) { + i64 arity = pit_value_as_integer(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); + pit_value f = pit_vm_pop(rt); + pit_value args = PIT_NIL; + while (arity-- > 0) args = pit_value_cons(rt, pit_vm_pop(rt), args); + if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f); + switch (pit_value_sort(f)) { + case PIT_VALUE_SORT_REF: { + pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, f)); + if (!h) { pit_error(rt, "bad ref for function"); return PIT_NIL; } + switch (h->hsort) { + case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: + pit_vm_push(rt, h->in.nativefunc.f(rt, args, h->in.nativefunc.data)); + break; + case PIT_VALUE_HEAVY_SORT_FUNC: + pit_vm_call_lisp(rt, h->in.func.nm, h->in.func.closure, args); + break; + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function ref: %s", buf); + return false; + } + } + break; + } + default: { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "attempted to apply non-function value: %s", buf); + return false; + } + } + } else { + pit_error(rt, "unknown vm operation"); + return false; + } + if (final) { /* if we have finished this stack frame */ + fprintf(stderr, "unbinding: "); pit_dump_to_file(rt, stderr, bound, false); fprintf(stderr, "\n"); + while (bound != PIT_NIL) { /* unbind everything we bound for the frame, in reverse */ + pit_symtab_unbind(rt, pit_value_cons_car(rt, bound)); + bound = pit_value_cons_cdr(rt, bound); + } + } + return true; +} + +/* run the VM until evaluation finishes, returning the result */ +pit_value pit_vm_eval(pit_runtime *rt, pit_value v) { + pit_vm_push_code(rt, v); + while (pit_vm_run_one(rt)); + pit_vm_pop(rt); +} + +pit_value pit_vm_apply(pit_runtime *rt, pit_value f, pit_value args) { + pit_vm_call(rt, f, args); + while (pit_vm_run_one(rt)); + pit_vm_pop(rt); +} diff --git a/pit/src/runtime/value/func.c b/pit/src/runtime/value/func.c index 3843553..5f88cb0 100644 --- a/pit/src/runtime/value/func.c +++ b/pit/src/runtime/value/func.c @@ -94,7 +94,8 @@ pit_value pit_value_func_lambda(pit_runtime *rt, pit_value args, pit_value body) } } arg_cells = pit_value_list_reverse(rt, arg_cells); - pit_value closure[4] = {env, arg_cells, arg_rest_nm, expanded}; + pit_value compiled = pit_vm_compile(rt, expanded); + pit_value closure[4] = {env, arg_cells, arg_rest_nm, compiled}; h->in.func.nm = PIT_NIL; h->in.func.closure = pit_value_array_from_buf(rt, closure, 4); return ret; @@ -153,7 +154,9 @@ pit_value pit_value_apply(pit_runtime *rt, pit_value f, pit_value args) { args = pit_value_cons_cdr(rt, args); anames = pit_value_cons_cdr(rt, anames); } - pit_value ret = pit_eval(rt, body); /* evaluate the body */ + /* TODO */ + pit_value ret = body; + // pit_value ret = pit_eval(rt, body); /* evaluate the body */ while (bound != PIT_NIL) { /* unbind everything we bound earlier, in reverse */ pit_symtab_unbind(rt, pit_value_cons_car(rt, bound)); bound = pit_value_cons_cdr(rt, bound); diff --git a/pit/test/compile.pit b/pit/test/compile.pit new file mode 100644 index 0000000..37d7f57 --- /dev/null +++ b/pit/test/compile.pit @@ -0,0 +1,6 @@ +(defmacro! foo () + (setq! bar (lambda (x) (foo) (+ x 1))) + '(print 'hi)) + +(foo) +(print (funcall bar 1))
\ No newline at end of file diff --git a/pit/test/recurse.pit b/pit/test/recurse.pit new file mode 100644 index 0000000..8e1f784 --- /dev/null +++ b/pit/test/recurse.pit @@ -0,0 +1,5 @@ +(defun! foo () + (print! 'hi) + (foo)) + +(foo)
\ No newline at end of file |
