Add PIT_DEFAULT_MAIN

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) {