summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/library.c28
-rw-r--r--src/main.c44
-rw-r--r--src/parser.c14
-rw-r--r--src/runtime.c65
4 files changed, 81 insertions, 70 deletions
diff --git a/src/library.c b/src/library.c
index 2cdbef7..7c63066 100644
--- a/src/library.c
+++ b/src/library.c
@@ -255,6 +255,11 @@ static pit_value impl_funcall(pit_runtime *rt, pit_value args) {
pit_value f = pit_car(rt, args);
return pit_apply(rt, f, pit_cdr(rt, args));
}
+static pit_value impl_apply(pit_runtime *rt, pit_value args) {
+ pit_value f = pit_car(rt, args);
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ return pit_apply(rt, f, xs);
+}
static pit_value impl_error(pit_runtime *rt, pit_value args) {
rt->error = PIT_T;
rt->error = pit_car(rt, args);
@@ -323,6 +328,22 @@ static pit_value impl_list(pit_runtime *rt, pit_value args) {
(void) rt;
return args;
}
+static pit_value impl_list_nth(pit_runtime *rt, pit_value args) {
+ i64 n = pit_as_integer(rt, pit_car(rt, args));
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ while (xs != PIT_NIL && n-- > 0) {
+ xs = pit_cdr(rt, xs);
+ }
+ return pit_car(rt, xs);
+}
+static pit_value impl_list_iota(pit_runtime *rt, pit_value args) {
+ i64 n = pit_as_integer(rt, pit_car(rt, args));
+ pit_value ret = PIT_NIL;
+ while (n > 0) {
+ ret = pit_cons(rt, pit_integer_new(rt, --n), ret);
+ }
+ return ret;
+}
static pit_value impl_list_len(pit_runtime *rt, pit_value args) {
pit_value arr = pit_car(rt, args);
return pit_integer_new(rt, pit_list_len(rt, arr));
@@ -685,7 +706,9 @@ static pit_value impl_bitwise_lshift(pit_runtime *rt, pit_value args) {
static pit_value impl_bitwise_rshift(pit_runtime *rt, pit_value args) {
i64 val = pit_as_integer(rt, pit_car(rt, args));
i64 shift = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
- return pit_integer_new(rt, val >> shift);
+ if (shift >= 64) val = 0;
+ else val >>= shift;
+ return pit_integer_new(rt, val);
}
void pit_install_library_essential(pit_runtime *rt) {
/* special forms */
@@ -722,6 +745,7 @@ void pit_install_library_essential(pit_runtime *rt) {
pit_fset(rt, pit_intern_cstr(rt, "fset!"), pit_nativefunc_new(rt, impl_fset));
pit_fset(rt, pit_intern_cstr(rt, "symbol-is-macro!"), pit_nativefunc_new(rt, impl_symbol_is_macro));
pit_fset(rt, pit_intern_cstr(rt, "funcall"), pit_nativefunc_new(rt, impl_funcall));
+ pit_fset(rt, pit_intern_cstr(rt, "apply"), pit_nativefunc_new(rt, impl_apply));
/* cons cells */
pit_fset(rt, pit_intern_cstr(rt, "cons"), pit_nativefunc_new(rt, impl_cons));
pit_fset(rt, pit_intern_cstr(rt, "car"), pit_nativefunc_new(rt, impl_car));
@@ -730,6 +754,8 @@ void pit_install_library_essential(pit_runtime *rt) {
pit_fset(rt, pit_intern_cstr(rt, "setcdr!"), pit_nativefunc_new(rt, impl_setcdr));
/* cons lists*/
pit_fset(rt, pit_intern_cstr(rt, "list"), pit_nativefunc_new(rt, impl_list));
+ pit_fset(rt, pit_intern_cstr(rt, "list/nth"), pit_nativefunc_new(rt, impl_list_nth));
+ pit_fset(rt, pit_intern_cstr(rt, "list/iota"), pit_nativefunc_new(rt, impl_list_iota));
pit_fset(rt, pit_intern_cstr(rt, "list/len"), pit_nativefunc_new(rt, impl_list_len));
pit_fset(rt, pit_intern_cstr(rt, "list/reverse"), pit_nativefunc_new(rt, impl_list_reverse));
pit_fset(rt, pit_intern_cstr(rt, "list/uniq"), pit_nativefunc_new(rt, impl_list_uniq));
diff --git a/src/main.c b/src/main.c
index 0b9a336..086f647 100644
--- a/src/main.c
+++ b/src/main.c
@@ -14,47 +14,5 @@ int main(int argc, char **argv) {
pit_install_library_plist(rt);
pit_install_library_alist(rt);
pit_install_library_bytestring(rt);
- if (argc < 2) { /* run repl */
- char buf[1024] = {0};
- i64 len = 0;
- pit_runtime_freeze(rt);
- if (pit_runtime_print_error(rt)) { exit(1); }
- setbuf(stdout, NULL);
- printf("> ");
- while (len < (i64) sizeof(buf) && (buf[len++] = (char) getchar()) != EOF) {
- if (buf[len - 1] == '\n') {
- pit_value bs, prog, res;
- buf[len - 1] = 0;
- bs = pit_bytes_new_cstr(rt, buf);
- prog = pit_read_bytes(rt, bs);
- res = pit_eval(rt, prog);
- if (pit_runtime_print_error(rt)) {
- rt->error = PIT_NIL;
- printf("> ");
- } else {
- char dumpbuf[1024] = {0};
- pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true);
- printf("%s\n> ", dumpbuf);
- }
- len = 0;
- }
- }
- } else { /* run file */
- pit_value bs = pit_bytes_new_file(rt, argv[1]);
- pit_lexer lex;
- pit_parser parse;
- bool eof = false;
- pit_value p = PIT_NIL;
- if (!pit_lexer_from_bytes(rt, &lex, bs)) {
- pit_error(rt, "failed to initialize lexer");
- }
- pit_parser_from_lexer(&parse, &lex);
- while (p = pit_parse(rt, &parse, &eof), !eof) {
- if (pit_runtime_print_error(rt)) exit(1);
- pit_eval(rt, p);
- if (pit_runtime_print_error(rt)) exit(1);
- }
- if (pit_runtime_print_error(rt)) exit(1);
- }
- return 0;
+ PIT_DEFAULT_MAIN(rt);
}
diff --git a/src/parser.c b/src/parser.c
index 9c112c2..b2d0f31 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -86,8 +86,18 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) {
i64 scratch_reset = rt->scratch->next;
pit_value ret = PIT_NIL;
while (!match(st, PIT_LEX_TOKEN_RPAREN)) {
- pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value));
- *cell = pit_parse(rt, st, eof);
+ if (match(st, PIT_LEX_TOKEN_DOT)) {
+ ret = pit_parse(rt, st, eof);
+ if (match(st, PIT_LEX_TOKEN_RPAREN)) {
+ break;
+ } else {
+ pit_error(rt, "unterminated dotted list");
+ return PIT_NIL;
+ }
+ } else {
+ pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value));
+ *cell = pit_parse(rt, st, eof);
+ }
if (rt->error != PIT_NIL || (eof != NULL && *eof)) {
pit_error(rt, "unterminated list");
return PIT_NIL; /* if we hit an error, stop!*/
diff --git a/src/runtime.c b/src/runtime.c
index 6ea9aa1..668ad4b 100644
--- a/src/runtime.c
+++ b/src/runtime.c
@@ -24,7 +24,9 @@ i32 pit_arena_next_idx(pit_arena *a) {
}
i32 pit_arena_alloc_idx(pit_arena *a) {
i32 byte_idx = pit_arena_next_idx(a);
- if (byte_idx >= a->capacity) { return -1; }
+ if (byte_idx >= a->capacity) {
+ return -1;
+ }
a->next += 1;
return byte_idx;
}
@@ -36,7 +38,9 @@ i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num) {
return byte_idx;
}
void *pit_arena_idx(pit_arena *a, i32 idx) {
- if (idx < 0 || idx >= a->capacity) return NULL;
+ if (idx < 0 || idx >= a->capacity) {
+ return NULL;
+ }
return &a->data[idx];
}
void *pit_arena_alloc(pit_arena *a) {
@@ -68,16 +72,16 @@ u64 pit_value_data(pit_value v) {
pit_runtime *pit_runtime_new() {
pit_runtime *ret = malloc(sizeof(*ret));
- ret->values = pit_arena_new(1024 * 1024, sizeof(pit_value_heavy));
+ ret->values = pit_arena_new(64 * 1024 * 1024, sizeof(pit_value_heavy));
ret->arrays = pit_arena_new(1024 * 1024, sizeof(pit_value));
ret->bytes = pit_arena_new(1024 * 1024, sizeof(u8));
ret->symtab = pit_arena_new(1024 * 1024, sizeof(pit_symtab_entry));
ret->symtab_len = 0;
ret->scratch = pit_arena_new(1024 * 1024, sizeof(u8));
- ret->expr_stack = pit_values_new(1024);
- ret->result_stack = pit_values_new(1024);
+ ret->expr_stack = pit_values_new(64 * 1024);
+ ret->result_stack = pit_values_new(64 * 1024);
ret->program = pit_runtime_eval_program_new(64 * 1024);
- ret->saved_bindings = pit_values_new(1024);
+ ret->saved_bindings = pit_values_new(64 * 1024);
ret->frozen_values = 0;
ret->frozen_arrays = 0;
ret->frozen_bytes = 0;
@@ -227,6 +231,7 @@ void pit_error(pit_runtime *rt, const char *format, ...) {
va_end(vargs);
rt->error = PIT_T; /* we set the error now to prevent infinite recursion */
rt->error = pit_bytes_new_cstr(rt, buf); /* in case this errs also */
+ if (rt->error == PIT_NIL) rt->error = PIT_T;
rt->error_line = rt->source_line;
rt->error_column = rt->source_column;
}
@@ -302,6 +307,10 @@ pit_value pit_ref_new(pit_runtime *rt, pit_ref r) {
pit_value pit_heavy_new(pit_runtime *rt) {
i32 idx = pit_arena_alloc_idx(rt->values);
+ if (idx < 0) {
+ pit_error(rt, "failed to allocate space for heavy value");
+ return PIT_NIL;
+ }
return pit_ref_new(rt, idx);
}
@@ -557,7 +566,6 @@ void pit_set(pit_runtime *rt, pit_value sym, pit_value v) {
if (pit_value_sort(ent->value) != PIT_VALUE_SORT_REF) {
ent->value = pit_cell_new(rt, PIT_NIL);
}
- fprintf(stderr, "setting "); pit_trace(rt, sym); fprintf(stderr, " to "); pit_trace(rt, v);
pit_cell_set(rt, ent->value, v, sym);
}
pit_value pit_fget(pit_runtime *rt, pit_value sym) {
@@ -606,7 +614,6 @@ void pit_bind(pit_runtime *rt, pit_value sym, pit_value cell) {
pit_symtab_entry *ent = pit_symtab_lookup(rt, sym);
if (!ent) { pit_error(rt, "bad symbol"); return; }
pit_values_push(rt, rt->saved_bindings, ent->value);
- fprintf(stderr, "binding "); pit_trace(rt, sym); fprintf(stderr, " to "); pit_trace(rt, cell);
ent->value = cell;
}
pit_value pit_unbind(pit_runtime *rt, pit_value sym) {
@@ -817,28 +824,35 @@ pit_value pit_plist_get(pit_runtime *rt, pit_value k, pit_value vs) {
return PIT_NIL;
}
-pit_value pit_free_vars(pit_runtime *rt, pit_value bound, pit_value body) {
+pit_value pit_free_vars(pit_runtime *rt, pit_value initial_bound, pit_value body) {
i64 expr_stack_reset = rt->expr_stack->top;
pit_value ret = PIT_NIL;
- pit_values_push(rt, rt->expr_stack, body);
+ pit_values_push(rt, rt->expr_stack, pit_cons(rt, initial_bound, body));
while (rt->expr_stack->top > expr_stack_reset) {
- pit_value cur = pit_values_pop(rt, rt->expr_stack);
+ pit_value boundscur = pit_values_pop(rt, rt->expr_stack);
+ pit_value bound = pit_car(rt, boundscur);
+ pit_value cur = pit_cdr(rt, boundscur);
if (pit_is_cons(rt, cur)) {
pit_value fsym = pit_car(rt, cur);
bool is_symbol = pit_is_symbol(rt, fsym);
pit_value fargs = pit_cdr(rt, cur);
if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "lambda")) {
- bound = pit_append(rt, pit_car(rt, fargs), bound);
+ pit_value new_bound = pit_append(rt, pit_car(rt, fargs), bound);
+ fargs = pit_cdr(rt, fargs);
+ while (fargs != PIT_NIL) {
+ pit_values_push(rt, rt->expr_stack, pit_cons(rt, new_bound, pit_car(rt, fargs)));
+ fargs = pit_cdr(rt, fargs);
+ }
} else if (is_symbol && pit_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 {
while (fargs != PIT_NIL) {
- pit_values_push(rt, rt->expr_stack, pit_car(rt, fargs));
+ pit_values_push(rt, rt->expr_stack, pit_cons(rt, bound, pit_car(rt, fargs)));
fargs = pit_cdr(rt, fargs);
}
if (!is_symbol) {
- pit_values_push(rt, rt->expr_stack, fsym);
+ pit_values_push(rt, rt->expr_stack, pit_cons(rt, bound, fsym));
}
}
} else if (pit_is_symbol(rt, cur)) {
@@ -873,12 +887,10 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) {
pit_value next_nm = pit_car(rt, pit_cdr(rt, args));
if (next_nm == PIT_NIL) { pit_error(rt, "invalid & in lambda list"); return PIT_NIL; }
arg_rest_nm = next_nm;
- pit_value ent = pit_cons(rt, next_nm, pit_cell_new(rt, PIT_NIL));
- arg_cells = pit_cons(rt, ent, arg_cells);
+ arg_cells = pit_cons(rt, next_nm, arg_cells);
break;
} else {
- pit_value ent = pit_cons(rt, nm, pit_cell_new(rt, PIT_NIL));
- arg_cells = pit_cons(rt, ent, arg_cells);
+ arg_cells = pit_cons(rt, nm, arg_cells);
args = pit_cdr(rt, args);
}
}
@@ -898,6 +910,7 @@ pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f) {
return ret;
}
pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) {
+ char buf[256] = {0};
if (pit_is_symbol(rt, f)) {
f = pit_fget(rt, f);
}
@@ -921,9 +934,8 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) {
}
pit_value anames = h->in.func.args;
while (anames != PIT_NIL) { /* bind all argument names to their values */
- pit_value aform = pit_car(rt, anames);
- pit_value nm = pit_car(rt, aform);
- pit_value cell = pit_cdr(rt, aform);
+ pit_value nm = pit_car(rt, anames);
+ pit_value cell = pit_cell_new(rt, PIT_NIL);
if (h->in.func.arg_rest_nm != PIT_NIL && pit_eq(nm, h->in.func.arg_rest_nm)) {
pit_cell_set(rt, cell, args, nm);
pit_bind(rt, nm, cell);
@@ -946,14 +958,19 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) {
/* calling native functions is even simpler */
return h->in.nativefunc(rt, args);
} else {
- pit_error(rt, "attempt to apply non-nativefunc ref");
+ 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 PIT_NIL;
}
}
- default:
- pit_error(rt, "attempted to apply non-function value");
+ 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 PIT_NIL;
}
+ }
}
pit_value pit_nativedata_new(pit_runtime *rt, pit_value tag, void *d) {
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-09 08:55:24 +0000