diff options
Diffstat (limited to 'pit/src')
| -rw-r--r-- | pit/src/native.c | 12 | ||||
| -rw-r--r-- | pit/src/parser.c | 14 | ||||
| -rw-r--r-- | pit/src/runtime/eval.c | 2 |
3 files changed, 22 insertions, 6 deletions
diff --git a/pit/src/native.c b/pit/src/native.c index 7d61a50..e776f38 100644 --- a/pit/src/native.c +++ b/pit/src/native.c @@ -188,6 +188,17 @@ static pit_value impl_diagnostics(pit_runtime *rt, pit_value args, void *data) { fprintf(stderr, "value allocs: %ld\n", rt->heap->next); return PIT_NIL; } +static pit_value impl_assert(pit_runtime *rt, pit_value args, void *data) { + (void) data; + pit_value msg = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args); + pit_value expected = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args); + pit_value actual = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args); + if (!pit_value_equal(rt, expected, actual)) { + pit_fprintf(rt, stderr, "assertion %v failed!\nexpected: %v\nactual: %v\n", msg, expected, actual); + exit(1); + } + return actual; +} static pit_value impl_print(pit_runtime *rt, pit_value args, void *data) { (void) data; pit_value x = pit_value_cons_car(rt, args); @@ -259,6 +270,7 @@ void pit_install_library_io(pit_runtime *rt) { pit_symtab_set(rt, pit_symtab_intern_cstr(rt, "*load-path*"), load_path); /* diagnostics */ pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "diagnostics!"), pit_value_nativefunc_new(rt, impl_diagnostics)); + pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "assert!"), pit_value_nativefunc_new(rt, impl_assert)); /* stream IO */ pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "print!"), pit_value_nativefunc_new(rt, impl_print)); pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "princ!"), pit_value_nativefunc_new(rt, impl_princ)); diff --git a/pit/src/parser.c b/pit/src/parser.c index 6c633c9..2541344 100644 --- a/pit/src/parser.c +++ b/pit/src/parser.c @@ -80,9 +80,10 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { return PIT_NIL; case PIT_LEX_TOKEN_LPAREN: { pit_value ret = PIT_NIL; + pit_value term = PIT_NIL; while (!match(st, PIT_LEX_TOKEN_RPAREN)) { if (match(st, PIT_LEX_TOKEN_DOT)) { - ret = pit_parse(rt, st, eof); + term = pit_parse(rt, st, eof); if (match(st, PIT_LEX_TOKEN_RPAREN)) { break; } else { @@ -97,14 +98,17 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { return PIT_NIL; /* if we hit an error, stop!*/ } } - ret = pit_value_list_reverse(rt, ret); - if (pit_value_sort(ret) == PIT_VALUE_SORT_REF) { + while (ret != PIT_NIL) { + term = pit_value_cons(rt, pit_value_cons_car(rt, ret), term); + ret = pit_value_cons_cdr(rt, ret); + } + if (pit_value_sort(term) == PIT_VALUE_SORT_REF) { pit_annotation a = {0}; a.line = rt->source_line; a.column = rt->source_column; - pit_annotation_set(rt, pit_value_as_ref(rt, ret), a); + pit_annotation_set(rt, pit_value_as_ref(rt, term), a); } - return ret; + return term; } case PIT_LEX_TOKEN_LSQUARE: { pit_value ret = PIT_NIL; diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c index 3cd1c1f..43c8998 100644 --- a/pit/src/runtime/eval.c +++ b/pit/src/runtime/eval.c @@ -38,7 +38,7 @@ static pit_value vm_pop(pit_runtime *rt) { } static pit_value vm_bind_or_replace(pit_runtime *rt, pit_value nm, pit_value cell, pit_value bound) { - if (pit_value_list_contains_eq(rt, nm, bound)) { + if (pit_value_list_contains_eq(rt, nm, bound) != PIT_NIL) { /* if we're already responsible for unbinding this symbol (e.g. in a tail call), */ /* simply replace the old binding - this keeps the binding stack from growing for TCO purposes */ pit_symtab_replace(rt, nm, cell); |