diff options
| author | LLLL Colonq <llll@colonq> | 2026-09-01 06:26:13 -0400 |
|---|---|---|
| committer | LLLL Colonq <llll@colonq> | 2026-09-01 06:26:13 -0400 |
| commit | ff7407c146b8129c2f1cc7ebe3b5771ad2f5dfdd (patch) | |
| tree | bc70d9773ebc0deb25773d3b5c86ec7ea96eef6d /pit/src/runtime | |
| parent | 6ebac820c84b218a45368eeaf1c853ff9c9d638f (diff) | |
pit: Fix evaluator
Diffstat (limited to 'pit/src/runtime')
| -rw-r--r-- | pit/src/runtime/compile.c | 372 | ||||
| -rw-r--r-- | pit/src/runtime/eval.c | 78 | ||||
| -rw-r--r-- | pit/src/runtime/gc.c | 13 | ||||
| -rw-r--r-- | pit/src/runtime/macroexpand.c | 23 | ||||
| -rw-r--r-- | pit/src/runtime/symtab.c | 7 | ||||
| -rw-r--r-- | pit/src/runtime/value/cell.c | 1 | ||||
| -rw-r--r-- | pit/src/runtime/value/func.c | 5 |
7 files changed, 299 insertions, 200 deletions
diff --git a/pit/src/runtime/compile.c b/pit/src/runtime/compile.c index a676a61..e7a4ab8 100644 --- a/pit/src/runtime/compile.c +++ b/pit/src/runtime/compile.c @@ -1,35 +1,30 @@ #include <lcq/pit/runtime/compile.h> -#include <stdio.h> - -static void 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; - } - } +/* helper functions for manipulating the compiler state */ +static void c_now(pit_runtime *rt, pit_value v) { + /* push a literal value to the traversal */ + pit_traversal_push_value(rt, rt->traversal, v); +} +static void c_compile(pit_runtime *rt, pit_value e) { + /* schedule an expression to be compiled */ + /* the resulting entries will be pushed to the traversal subsequently */ + pit_compilation_push_value(rt, rt->compilation_stack, e); +} +static void c_drop(pit_runtime *rt) { + /* schedule a drop to be compiled */ + pit_compilation_push_drop(rt, rt->compilation_stack); +} +static void c_code(pit_runtime *rt, pit_value e) { + /* schedule an expression to be compiled, and then captured as code */ + /* this will result in a literal code value being included in the program, */ + /* rather than the code itself (as in c_compile) */ + pit_compilation_push_end_code(rt, rt->compilation_stack); + pit_compilation_push_value(rt, rt->compilation_stack, e); + pit_compilation_push_begin_code(rt, rt->compilation_stack); } +/* given an expression and some initially bound variables (e.g. arguments), */ +/* compute the free variables in the expression */ static pit_value free_vars(pit_runtime *rt, pit_value initial_bound, pit_value body) { i64 expr_stack_reset = rt->expr_stack->next; pit_value ret = PIT_NIL; @@ -46,38 +41,50 @@ static pit_value free_vars(pit_runtime *rt, pit_value initial_bound, pit_value b bound = pit_value_cons_car(rt, boundscur); cur = pit_value_cons_cdr(rt, boundscur); if (pit_value_is_cons(rt, cur)) { + /* if the expression is a list, determine if it is a normal application */ pit_value fsym = pit_value_cons_car(rt, cur); bool is_symbol = pit_value_is_symbol(rt, fsym); + bool is_special_form = is_symbol && pit_symtab_is_symbol_special_form(rt, fsym); pit_value fargs = pit_value_cons_cdr(rt, cur); - if (is_symbol && pit_symtab_symbol_name_match_cstr(rt, fsym, "lambda")) { + /* first, consider special forms that have special behavior with regard to binding */ + if (is_special_form && pit_symtab_symbol_name_match_cstr(rt, fsym, "quote")) { + /* don't look inside quote! + NOTICE if we add other special forms, make sure to consider them here if necessary! */ + } else if (is_special_form && pit_symtab_symbol_name_match_cstr(rt, fsym, "lambda")) { + /* the variables from the lambda argument list are now bound */ pit_value new_bound = pit_value_list_append(rt, pit_value_cons_car(rt, fargs), bound); fargs = pit_value_cons_cdr(rt, fargs); + /* consider all body forms within the lambda with these new bindings in mind */ while (fargs != PIT_NIL) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, new_bound, pit_value_cons_car(rt, fargs))) < 0) { + pit_value bindings_expr_pair = pit_value_cons(rt, new_bound, pit_value_cons_car(rt, fargs)); + if (pit_vec_push(pit_value)(rt->expr_stack, bindings_expr_pair) < 0) { pit_error(rt, "free variable search stack overflow"); return PIT_NIL; } fargs = pit_value_cons_cdr(rt, fargs); } - } else if (is_symbol && pit_symtab_symbol_name_match_cstr(rt, fsym, "quote")) { - /* don't look inside quote! - if we add other special forms, make sure to consider them here if necessary! */ } else { + /* otherwise, this is a normal application form */ + /* first consider all arguments to the application */ while (fargs != PIT_NIL) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, bound, pit_value_cons_car(rt, fargs))) < 0) { + pit_value bindings_expr_pair = pit_value_cons(rt, bound, pit_value_cons_car(rt, fargs)); + if (pit_vec_push(pit_value)(rt->expr_stack, bindings_expr_pair) < 0) { pit_error(rt, "free variable search stack overflow"); return PIT_NIL; } fargs = pit_value_cons_cdr(rt, fargs); } if (!is_symbol) { - if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, bound, fsym)) < 0) { + /* ... and then consider the function being applied, if it is not a symbol */ + pit_value bindings_expr_pair = pit_value_cons(rt, bound, fsym); + if (pit_vec_push(pit_value)(rt->expr_stack, bindings_expr_pair) < 0) { pit_error(rt, "free variable search stack overflow"); return PIT_NIL; } } } } else if (pit_value_is_symbol(rt, cur)) { + /* if the expression is a symbol, check if it's free! */ if (pit_value_list_contains_eq(rt, cur, bound) == PIT_NIL) { ret = pit_value_cons(rt, cur, ret); } @@ -87,136 +94,219 @@ static pit_value free_vars(pit_runtime *rt, pit_value initial_bound, pit_value b return ret; } -static pit_value lambda(pit_runtime *rt, pit_value args, pit_value body) { - pit_value expanded = pit_macroexpand(rt, pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), body)); - fprintf(stderr, "lambda: "); pit_dump_to_file(rt, stderr, expanded, false); fprintf(stderr, "\n"); - return pit_value_list(rt, 4, - pit_symtab_intern_cstr(rt, "lambda"), - args, - free_vars(rt, args, expanded), - pit_compile(rt, expanded) - ); +static void compile_special_form(pit_runtime *rt, pit_value f, pit_value args) { + char buf[256] = {0}; + if (pit_symtab_symbol_name_match_cstr(rt, f, "quote")) { + /* quote compiles to a literal instruction */ + c_now(rt, + pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), pit_value_cons_car(rt, args)) + ); + } else if (pit_symtab_symbol_name_match_cstr(rt, f, "if")) { + /* if compiles the condition, and then code for the branches, and then the if instruction */ + pit_value c = pit_value_cons_car(rt, args); + args = pit_value_cons_cdr(rt, args); + pit_value t = pit_value_cons_car(rt, args); + args = pit_value_cons_cdr(rt, args); + pit_value e = pit_value_cons_car(rt, args); + c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "if"))); + c_code(rt, e); + c_code(rt, t); + c_compile(rt, c); + } else if (pit_symtab_symbol_name_match_cstr(rt, f, "progn")) { + /* progn simply compiles each of its argument forms in order */ + /* after every form but the final form, it inserts a drop to ignore the return value */ + while (args != PIT_NIL) { + pit_value form = pit_value_cons_car(rt, args); + args = pit_value_cons_cdr(rt, args); + c_compile(rt, form); + if (args != PIT_NIL) { + c_drop(rt); + } + } + } else if (pit_symtab_symbol_name_match_cstr(rt, f, "lambda")) { + pit_value arglist = pit_value_cons_car(rt, args); + pit_value body = pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_cons_cdr(rt, args)); + c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "lambda"))); + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), arglist)); + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), free_vars(rt, arglist, body))); + c_code(rt, body); + } else { + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, f, true); + buf[end] = 0; + pit_error(rt, "unknown special form: %s", buf); + } } -static void c_now(pit_runtime *rt, pit_value v) { - pit_traversal_push_value(rt, rt->traversal, v); +static void compile_output_instruction(pit_runtime *rt, pit_value ins) { + /* write an instruction to the code block at the top of the compilation stack */ + pit_compilation_entry b; + if (pit_vec_pop(pit_compilation_entry)(rt->compilation_stack, &b) < 0) { + pit_error(rt, "compilation block stack underflow"); + return; + } + pit_value new = pit_value_cons(rt, ins, b.in.value); + pit_compilation_push_value(rt, rt->compilation_stack, new); } -static void c_eval(pit_runtime *rt, pit_value e) { - if (pit_vec_push(pit_value)(rt->expr_stack, e) < 0) - pit_error(rt, "evaluation stack overflow"); +static void compile_interpret_traversal_entry(pit_runtime *rt, pit_traversal_entry *ent) { + if (ent == NULL) { + pit_error(rt, "evaluation traversal invalid"); + return; + } + switch (ent->sort) { + case PIT_TRAVERSAL_ENTRY_VALUE: { + /* normal traversal entries just cons values to the code block at the top of the compilation stack */ + compile_output_instruction(rt, ent->in.value); + return; + } + case PIT_TRAVERSAL_ENTRY_BEGIN_CODE: { + /* starting a new code block pushes a new list to the top of the compilation stack */ + pit_compilation_push_value(rt, rt->compilation_stack, PIT_NIL); + return; + } + case PIT_TRAVERSAL_ENTRY_END_CODE: { + /* ending a code block pops a code block, and pushes it as a literal in the frame below */ + pit_compilation_entry b; + if (pit_vec_pop(pit_compilation_entry)(rt->compilation_stack, &b) < 0) { + pit_error(rt, "compilation block stack underflow"); + return; + } + compile_output_instruction(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), b.in.value)); + return; + } + default: + pit_error(rt, "unknown traversal entry"); + return; + } } pit_value pit_compile(pit_runtime *rt, pit_value top) { + /* compilation proceeds in a somewhat unintuitive manner */ + /* typically, we would simply recursively traverse the tree, accumulating the output code */ + /* (this also has the advantage of allowing the results of the recursive compilation call to */ + /* be used in nonstandard contexts, such as compiling the body of lambdas. */ + /* however, in pit we would like to avoid this sort of recursion, as we'd like to be able to */ + /* make claims about the interpreter's C stack usage (and also, in general, it seems quite */ + /* nice to avoid C stack usage growing with expression size!) */ + /* as such, we must explicitly represent the control/data flow that would otherwise be handled */ + /* implicitly by the recursion. we do this by breaking the compilation step into several steps. */ + /* first, we traverse the expression using a stack (rt->compilation_stack). during this step, we */ + /* push subexpression to be compiled to the stack, and append "generated code" to an intermediate */ + /* structure (rt->traversal). this intermediate structure contains "operations" to later perform */ + /* - think of it as the "continuation" of the code that produced it. finally, these intermediate */ + /* operations are "interpreted" to generate the real compiled code, which is a Lisp list of instructions */ + /* each instruction is itself a list of opcode and operands (see eval.c for more information on this) */ char buf[256] = {0}; - pit_value ret = PIT_NIL; - i64 expr_stack_reset = rt->expr_stack->next; + i64 compilation_stack_reset = rt->compilation_stack->next; i64 traversal_reset = rt->traversal->next; - fprintf(stderr, "compile: "); pit_dump_to_file(rt, stderr, top, false); fprintf(stderr, "\n"); - c_eval(rt, top); - /* convert the expression tree into "polish notation" in traversal */ - while (rt->expr_stack->next > expr_stack_reset) { - pit_value cur = PIT_NIL; - if (rt->error != PIT_NIL) goto end; - if (pit_vec_pop(pit_value)(rt->expr_stack, &cur) < 0) - pit_error(rt, "evaluation stack underflow"); - 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); - call_special_form(rt, f, args); - } else if (is_symbol && pit_symtab_is_symbol_macro(rt, fsym)) { /* macros */ - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, fsym, true); - buf[end] = 0; - pit_error(rt, "encountered an unexpanded macro while compiling: %s", buf); - } else { /* normal functions */ - pit_value args = pit_value_cons_cdr(rt, cur); - i64 argcount = 0; - while (args != PIT_NIL) { - // fprintf(stderr, "push1: "); pit_dump_to_file(rt, stderr, pit_value_cons_car(rt, args), false); fprintf(stderr, "\n"); - c_eval(rt, pit_value_cons_car(rt, args)); - args = pit_value_cons_cdr(rt, args); - argcount += 1; - } - if (!is_symbol) { - // fprintf(stderr, "push2: "); pit_dump_to_file(rt, stderr, fsym, false); fprintf(stderr, "\n"); - c_eval(rt, fsym); + /* before we do anything else, we fully macroexpand the input */ + top = pit_macroexpand(rt, top); + c_compile(rt, top); + while (rt->compilation_stack->next > compilation_stack_reset) { + pit_compilation_entry curent; + if (rt->error != PIT_NIL) goto err; + if (pit_vec_pop(pit_compilation_entry)(rt->compilation_stack, &curent) < 0) { + pit_error(rt, "compilation stack underflow"); + goto err; + } + switch (curent.sort) { + case PIT_COMPILATION_ENTRY_VALUE: { + pit_value cur = curent.in.value; + 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); + if (is_symbol && pit_symtab_is_symbol_special_form(rt, fsym)) { /* special forms */ + pit_value args = pit_value_cons_cdr(rt, cur); + compile_special_form(rt, fsym, args); + } else if (is_symbol && pit_symtab_is_symbol_macro(rt, fsym)) { /* macros */ + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, fsym, true); + buf[end] = 0; + pit_error(rt, "encountered an unexpanded macro while compiling: %s", buf); + } else { /* normal functions */ + pit_value args = pit_value_cons_cdr(rt, cur); + i64 argcount = 0; + while (args != PIT_NIL) { + c_compile(rt, pit_value_cons_car(rt, args)); + args = pit_value_cons_cdr(rt, args); + argcount += 1; + } + if (!is_symbol) { + c_compile(rt, fsym); + } + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "apply"), pit_value_integer_new(rt, argcount))); + if (is_symbol) { + c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "fget"))); + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), fsym)); + } } - c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "apply"), pit_value_integer_new(rt, argcount))); - if (is_symbol) { - c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "fget"))); - c_now(rt, 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) { + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur)); + } else { + c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "get"))); + c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur)); } - } - } 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) { - c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur)); - } else { - c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "get"))); + } else { /* other expressions evaluate to themselves! */ c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur)); } - } else { /* other expressions evaluate to themselves! */ - c_now(rt, pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), cur)); + break; + } + case PIT_COMPILATION_ENTRY_DROP: { + /* a BEGIN_CODE is a marker indicating that a new "block" of code has started */ + c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "drop"))); + break; + } + case PIT_COMPILATION_ENTRY_BEGIN_CODE: { + /* a BEGIN_CODE is a marker indicating that a new "block" of code has started */ + pit_traversal_push_begin_code(rt, rt->traversal); + break; + } + case PIT_COMPILATION_ENTRY_END_CODE: { + /* an END_CODE is a marker indicating that the current "block" of code has finished */ + pit_traversal_push_end_code(rt, rt->traversal); + break; + } } } + /* now that we've built up the traversal, we iterate over it to build up the final program */ + /* the "current" code is at the top of the compilation stack (which we now repurpose to this end) */ + /* (note that this usage of the compilation state is entirely separate from the previous usage!) */ + rt->compilation_stack->next = compilation_stack_reset; + pit_compilation_push_value(rt, rt->compilation_stack, PIT_NIL); 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: { - ret = pit_value_cons(rt, ent->in.value, ret); - break; - } - default: - pit_error(rt, "unknown traversal entry"); - ret = PIT_NIL; - goto end; - } + compile_interpret_traversal_entry(rt, ent); + } + goto end; +err: { + /* in case of error, we should always consider the stack empty, so we don't return something spurious */ + rt->compilation_stack->next = compilation_stack_reset; } end: { - rt->expr_stack->next = expr_stack_reset; + /* finally, we are done (possibly due to an error) */ + pit_value ret = PIT_NIL; + if (rt->compilation_stack->next > compilation_stack_reset) { + /* if the compilation stack is not empty, the top is our compiled code! */ + pit_compilation_entry ent; + pit_vec_pop(pit_compilation_entry)(rt->compilation_stack, &ent); + ret = ent.in.value; + } + if (rt->compilation_stack->next != compilation_stack_reset) { + /* if there was more than one entry on the compilation stack, this is a bug */ + pit_error(rt, "compilation did not reduce stack to single code! this is a bug!"); + } + rt->compilation_stack->next = compilation_stack_reset; rt->traversal->next = traversal_reset; - fprintf(stderr, "compiled: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); return ret; } } -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_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); - args = pit_value_cons_cdr(rt, args); - pit_value t = pit_value_cons_car(rt, args); - args = pit_value_cons_cdr(rt, args); - pit_value e = pit_value_cons_car(rt, args); - c_now(rt, pit_value_list(rt, 1, pit_symtab_intern_cstr(rt, "if"))); - c_now(rt, lambda(rt, PIT_NIL, pit_value_list(rt, 1, t))); - c_now(rt, lambda(rt, PIT_NIL, pit_value_list(rt, 1, e))); - c_eval(rt, c); - 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); - c_now(rt, lambda(rt, as, body)); - return PIT_NIL; -} - +/* mark the symbols for the special forms as such */ void pit_compile_install_special_forms(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, "lambda"), pit_value_nativefunc_new(rt, impl_sf_lambda)); + pit_symtab_symbol_mark_special_form(rt, pit_symtab_intern_cstr(rt, "quote")); + pit_symtab_symbol_mark_special_form(rt, pit_symtab_intern_cstr(rt, "if")); + pit_symtab_symbol_mark_special_form(rt, pit_symtab_intern_cstr(rt, "progn")); + pit_symtab_symbol_mark_special_form(rt, pit_symtab_intern_cstr(rt, "lambda")); } diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 3903a64..f149246 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -4,12 +4,12 @@ /* add a new stack frame to the vm (with a tag and callsite annotation) */ static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_annotation ann, pit_value bound) { + fprintf(stderr, "running: "); pit_dump_to_file(rt, stderr, code, false); fprintf(stderr, "\n"); 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"); } @@ -24,10 +24,10 @@ static void vm_push_code(pit_runtime *rt, pit_value code) { } static void 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"); } + fprintf(stderr, "result push!: %ld\n", rt->result_stack->next); } static pit_value vm_pop(pit_runtime *rt) { @@ -35,7 +35,7 @@ static pit_value vm_pop(pit_runtime *rt) { 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"); + fprintf(stderr, "result pop!: %ld\n", rt->result_stack->next); return ret; } @@ -46,8 +46,6 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_ 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; - // fprintf(stderr, "call lisp: "); pit_dump_to_file(rt, stderr, closure, false); fprintf(stderr, "\n"); - // fprintf(stderr, "binding: "); pit_dump_to_file(rt, stderr, env, false); fprintf(stderr, "\n"); 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); @@ -111,56 +109,54 @@ static bool vm_call(pit_runtime *rt, pit_value f, pit_value args) { /* run one instruction of the VM */ bool pit_vm_run_one(pit_runtime *rt) { +start: 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; } - // fprintf(stderr, "code: "); pit_dump_to_file(rt, stderr, ent->code, false); fprintf(stderr, "\n"); - pit_value ins = pit_value_cons_car(rt, ent->code); - if (ins == PIT_NIL) { - pit_error(rt, "malformed vm instruction"); - return false; + if (ent->code == PIT_NIL) { /* if we encounter an empty stack frame... */ + pit_value bound = ent->bound; + 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); + } + pit_vec_pop(pit_callstack_entry)(rt->callstack, NULL); /* pop the frame, and try again */ + goto start; } - 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 ins = pit_value_cons_car(rt, ent->code); + if (ins == PIT_NIL) { pit_error(rt, "malformed vm instruction"); return false; } + ent->code = pit_value_cons_cdr(rt, ent->code); pit_value op = pit_value_cons_car(rt, ins); + fprintf(stderr, "ins: "); pit_dump_to_file(rt, stderr, ins, false); fprintf(stderr, "\n"); if (pit_symtab_symbol_name_match_cstr(rt, op, "literal")) { /* push a lisp value to the vm stack */ vm_push(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "lambda")) { - /* create and push a function with the given arguments, free variables, and (compiled) body */ + /* pop an argument list, a free variable list, and a body block */ + /* create and push a function */ /* notably, this builds the closure by recording the currently-bound cells for each free variable! */ - pit_value args = pit_value_cons_cdr(rt, ins); - pit_value as = pit_value_cons_car(rt, args); - args = pit_value_cons_cdr(rt, args); - pit_value freevars = pit_value_cons_car(rt, args); - args = pit_value_cons_cdr(rt, args); - pit_value body = pit_value_cons_car(rt, args); - vm_push(rt, pit_value_func_lambda(rt, as, freevars, body)); + pit_value args = vm_pop(rt); + pit_value freevars = vm_pop(rt); + pit_value body = vm_pop(rt); + vm_push(rt, pit_value_func_lambda(rt, args, freevars, body)); + } else if (pit_symtab_symbol_name_match_cstr(rt, op, "drop")) { + /* pop a value and ignore it */ + vm_pop(rt); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "get")) { - pit_value nm = vm_pop(rt); - // fprintf(stderr, "get: "); pit_dump_to_file(rt, stderr, nm, false); fprintf(stderr, "\n"); - vm_push(rt, pit_symtab_get(rt, nm)); /* pop a symbol and look up its value */ - // vm_push(rt, pit_symtab_get(rt, vm_pop(rt))); + vm_push(rt, pit_symtab_get(rt, vm_pop(rt))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "fget")) { /* pop a symbol and look up its function value */ vm_push(rt, pit_symtab_fget(rt, vm_pop(rt))); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "if")) { - /* pop a then-function, an else-function, and a condition */ - /* call (no args) the then-function if the condition is true, otherwise call the else-function */ + /* pop a condition, a then-block, and an else-block */ + /* run the then-block if the condition is true, otherwise run the else-block */ + pit_value c = vm_pop(rt); pit_value t = vm_pop(rt); pit_value e = vm_pop(rt); - pit_value c = vm_pop(rt); - if (!vm_call(rt, c != PIT_NIL ? t : e, PIT_NIL)) return false; + vm_push_code(rt, c != PIT_NIL ? t : e); } else if (pit_symtab_symbol_name_match_cstr(rt, op, "apply")) { /* pop an arity n and a function, and then n arguments, and apply the function */ i64 arity = pit_value_as_integer(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, ins))); @@ -172,13 +168,6 @@ bool pit_vm_run_one(pit_runtime *rt) { 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; } @@ -186,7 +175,12 @@ bool pit_vm_run_one(pit_runtime *rt) { pit_value pit_vm_eval(pit_runtime *rt, pit_value v) { i64 start = rt->callstack->next; vm_push_code(rt, v); - while (pit_vm_run_one(rt) && rt->callstack->next > start); + while (pit_vm_run_one(rt) && rt->callstack->next > start) { + // if (rt->expr_stack->next == 0 && rt->compilation_stack->next == 0) { + // fprintf(stderr, "running gc\n"); + // pit_gc(rt); /* TODO hack to avoid running GC during macroexpansion */ + // } + } return vm_pop(rt); } diff --git a/pit/src/runtime/gc.c b/pit/src/runtime/gc.c index 0880592..1cc6547 100644 --- a/pit/src/runtime/gc.c +++ b/pit/src/runtime/gc.c @@ -37,6 +37,17 @@ void pit_gc(pit_runtime *rt) { pit_arena_reset(tospace); pit_hashtable_reset(pit_ref, pit_annotation)(tospace_ann); /* populate tospace with immediately reachable values */ + /* any values saved directly to the runtime are reachable */ + rt->msg_out_of_memory = gc_copy_value(rt, rt->msg_out_of_memory); + /* everything on the call stack is reachable */ + for (i64 i = 0; i < rt->callstack->next; ++i) { + pit_callstack_entry *ent = pit_vec_get(pit_callstack_entry)(rt->callstack, i); + if (ent == NULL) continue; /* TODO warn on failure here? */ + ent->tag = gc_copy_value(rt, ent->tag); + ent->bound = gc_copy_value(rt, ent->bound); + ent->code = gc_copy_value(rt, ent->code); + } + /* the symbol table is reachable */ for (i64 i = 0; i < rt->symtab->next; ++i) { pit_symtab_entry *ent = pit_vec_get(pit_symtab_entry)(rt->symtab, i); if (ent == NULL) continue; /* TODO warn on failure here? */ @@ -44,10 +55,12 @@ void pit_gc(pit_runtime *rt) { ent->value = gc_copy_value(rt, ent->value); ent->function = gc_copy_value(rt, ent->function); } + /* all saved bindings are reachable */ for (i64 i = 0; i < rt->saved_bindings->next; ++i) { pit_value *v = pit_vec_get(pit_value)(rt->saved_bindings, i); if (v != NULL) *v = gc_copy_value(rt, *v); /* TODO warn on failure here? */ } + /* recursively populate all reachable values from that initial set */ for (i64 scan = 0; scan < tospace->next; ++scan) { pit_value_heavy *h = pit_arena_get(tospace, scan); switch (h->hsort) { diff --git a/pit/src/runtime/macroexpand.c b/pit/src/runtime/macroexpand.c index ffa796d..fdc1f14 100644 --- a/pit/src/runtime/macroexpand.c +++ b/pit/src/runtime/macroexpand.c @@ -1,9 +1,6 @@ #include <lcq/pit/runtime/macroexpand.h> -#include <stdio.h> - -pit_value pit_macroexpand(pit_runtime *rt, pit_value top) { - fprintf(stderr, "macroexpand: "); pit_dump_to_file(rt, stderr, top, false); fprintf(stderr, "\n"); +pit_value pit_macroexpand_1(pit_runtime *rt, pit_value top) { i64 expr_stack_reset = rt->expr_stack->next; i64 result_stack_reset = rt->result_stack->next; i64 traversal_reset = rt->traversal->next; @@ -17,10 +14,14 @@ pit_value pit_macroexpand(pit_runtime *rt, pit_value top) { 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); + bool is_special_form = is_symbol && pit_symtab_is_symbol_special_form(rt, fsym); + bool is_macro = is_symbol && pit_symtab_is_symbol_macro(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)) { + if (is_special_form && pit_symtab_symbol_name_match_cstr(rt, fsym, "quote")) { + /* don't macroexpand inside quote! + NOTICE if we add other special forms, make sure to consider them here if necessary! */ pit_traversal_push_value(rt, rt->traversal, cur); - } else if (is_symbol && pit_symtab_is_symbol_macro(rt, fsym)) { + } else if (is_macro) { pit_value f = pit_symtab_fget(rt, fsym); pit_value args = pit_value_cons_cdr(rt, cur); pit_value res = pit_vm_apply(rt, f, args); @@ -90,7 +91,15 @@ end: { rt->expr_stack->next = expr_stack_reset; rt->result_stack->next = result_stack_reset; rt->traversal->next = traversal_reset; - fprintf(stderr, "macroexpand result: "); pit_dump_to_file(rt, stderr, ret, false); fprintf(stderr, "\n"); return ret; } } + +pit_value pit_macroexpand(pit_runtime *rt, pit_value prev) { + pit_value next = prev; + do { + prev = next; + next = pit_macroexpand_1(rt, prev); + } while (!pit_value_equal(rt, next, prev)); + return next; +} diff --git a/pit/src/runtime/symtab.c b/pit/src/runtime/symtab.c index 33ed3ba..1894208 100644 --- a/pit/src/runtime/symtab.c +++ b/pit/src/runtime/symtab.c @@ -104,21 +104,20 @@ void pit_symtab_symbol_mark_special_form(pit_runtime *rt, pit_value sym) { if (!ent) { pit_error(rt, "bad symbol"); return; } ent->is_special_form = true; } -void pit_symtab_sfset(pit_runtime *rt, pit_value sym, pit_value v) { - pit_symtab_fset(rt, sym, v); - pit_symtab_symbol_mark_special_form(rt, sym); -} +#include <stdio.h> void pit_symtab_bind(pit_runtime *rt, pit_value sym, pit_value cell) { /* although we cannot set frozen symbols, we can still bind them temporarily - no need to check */ pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } if (pit_vec_push(pit_value)(rt->saved_bindings, ent->value) < 0) pit_error(rt, "binding stack overflow"); ent->value = cell; + fprintf(stderr, "binding: "); pit_dump_to_file(rt, stderr, sym, false); fprintf(stderr, "\n"); } pit_value pit_symtab_unbind(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; } pit_value old = ent->value; if (pit_vec_pop(pit_value)(rt->saved_bindings, &ent->value) < 0) pit_error(rt, "binding stack underflow"); + fprintf(stderr, "unbinding: "); pit_dump_to_file(rt, stderr, sym, false); fprintf(stderr, "\n"); return old; } diff --git a/pit/src/runtime/value/cell.c b/pit/src/runtime/value/cell.c index a9cbe72..34b9226 100644 --- a/pit/src/runtime/value/cell.c +++ b/pit/src/runtime/value/cell.c @@ -11,7 +11,6 @@ pit_value pit_value_cell_new(pit_runtime *rt, pit_value v) { h->in.cell = v; return ret; } -#include <stdio.h> pit_value pit_value_cell_get(pit_runtime *rt, pit_value cell, pit_value sym) { if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) { char buf[256]; diff --git a/pit/src/runtime/value/func.c b/pit/src/runtime/value/func.c index ad5ce4c..a27a4f9 100644 --- a/pit/src/runtime/value/func.c +++ b/pit/src/runtime/value/func.c @@ -1,7 +1,5 @@ #include <lcq/pit/runtime/value/func.h> -#include <stdio.h> - bool pit_value_is_func(pit_runtime *rt, pit_value a) { return pit_value_is_ref_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_FUNC); } @@ -9,9 +7,6 @@ bool pit_value_is_nativefunc(pit_runtime *rt, pit_value a) { return pit_value_is_ref_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_NATIVEFUNC); } pit_value pit_value_func_lambda(pit_runtime *rt, pit_value args, pit_value freevars, pit_value compiled) { - // fprintf(stderr, "lambda args: "); pit_dump_to_file(rt, stderr, args, false); fprintf(stderr, "\n"); - // fprintf(stderr, "lambda freevars: "); pit_dump_to_file(rt, stderr, freevars, false); fprintf(stderr, "\n"); - // fprintf(stderr, "lambda compiled: "); pit_dump_to_file(rt, stderr, compiled, false); fprintf(stderr, "\n"); pit_value ret = pit_value_ref_heavy_new(rt); pit_value_heavy *h = pit_value_ref_deref(rt, pit_value_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for lambda"); return PIT_NIL; } |
