summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lexer.c19
-rw-r--r--src/library.c562
-rw-r--r--src/main.c7
-rw-r--r--src/parser.c57
-rw-r--r--src/runtime.c188
5 files changed, 764 insertions, 69 deletions
diff --git a/src/lexer.c b/src/lexer.c
index 019dcc5..623dd39 100644
--- a/src/lexer.c
+++ b/src/lexer.c
@@ -11,6 +11,8 @@ const char *PIT_LEX_TOKEN_NAMES[PIT_LEX_TOKEN__SENTINEL] = {
/* [PIT_LEX_TOKEN_EOF] = */ "eof",
/* [PIT_LEX_TOKEN_LPAREN] = */ "lparen",
/* [PIT_LEX_TOKEN_RPAREN] = */ "rparen",
+ /* [PIT_LEX_TOKEN_LSQUARE] = */ "lsquare",
+ /* [PIT_LEX_TOKEN_RSQUARE] = */ "rsquare",
/* [PIT_LEX_TOKEN_DOT] = */ "dot",
/* [PIT_LEX_TOKEN_QUOTE] = */ "quote",
/* [PIT_LEX_TOKEN_INTEGER_LITERAL] = */ "integer_literal",
@@ -30,6 +32,11 @@ static int is_symchar(int c) {
return c != '(' && c != ')' && c != '.' && c != '\'' && c != '"' && isprint(c) && !isspace(c);
}
+static int is_hexdigit(int c) {
+ return isdigit(c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F');
+}
+
+
static char peek(pit_lexer *st) {
if (is_more_input(st)) return st->input[st->end];
else return 0;
@@ -104,6 +111,8 @@ restart:
case ';': while (is_more_input(st) && advance(st) != '\n'); goto restart;
case '(': return PIT_LEX_TOKEN_LPAREN;
case ')': return PIT_LEX_TOKEN_RPAREN;
+ case '[': return PIT_LEX_TOKEN_LSQUARE;
+ case ']': return PIT_LEX_TOKEN_RSQUARE;
case '.': return PIT_LEX_TOKEN_DOT;
case '\'': return PIT_LEX_TOKEN_QUOTE;
case '"':
@@ -119,10 +128,14 @@ restart:
default:
if (isspace(c)) goto restart;
if (isdigit(c)) {
- while (match(st, isdigit)) {}
+ if (c == '0') {
+ int next = peek(st);
+ if (next != 'x' && next != 'o' && next != 'b') return PIT_LEX_TOKEN_INTEGER_LITERAL;
+ advance(st); /* skip base specifier */
+ }
+ while (match(st, is_hexdigit)) {}
return PIT_LEX_TOKEN_INTEGER_LITERAL;
- }
- else {
+ } else {
while (match(st, is_symchar)) {}
return PIT_LEX_TOKEN_SYMBOL;
}
diff --git a/src/library.c b/src/library.c
index 33982dc..2cdbef7 100644
--- a/src/library.c
+++ b/src/library.c
@@ -20,6 +20,21 @@ static pit_value impl_sf_if(pit_runtime *rt, pit_value args) {
}
return PIT_NIL;
}
+static pit_value impl_sf_cond(pit_runtime *rt, pit_value args) {
+ while (args != PIT_NIL) {
+ pit_value clause = pit_car(rt, args);
+ pit_value cond = pit_car(rt, clause);
+ if (pit_eval(rt, cond) != PIT_NIL) {
+ pit_values_push(rt, rt->expr_stack,
+ pit_cons(rt, pit_intern_cstr(rt, "progn"), pit_cdr(rt, clause))
+ );
+ return PIT_NIL;
+ }
+ args = pit_cdr(rt, args);
+ }
+ pit_values_push(rt, rt->expr_stack, PIT_NIL);
+ return PIT_NIL;
+}
static pit_value impl_sf_progn(pit_runtime *rt, pit_value args) {
pit_value bodyforms = args;
pit_value final = PIT_NIL;
@@ -30,6 +45,17 @@ static pit_value impl_sf_progn(pit_runtime *rt, pit_value args) {
pit_runtime_eval_program_push_literal(rt, rt->program, final);
return PIT_NIL;
}
+static pit_value impl_sf_or(pit_runtime *rt, pit_value args) {
+ pit_value bodyforms = args;
+ pit_value final = PIT_NIL;
+ while (bodyforms != PIT_NIL) {
+ final = pit_eval(rt, pit_car(rt, bodyforms));
+ if (final != PIT_NIL) break;
+ bodyforms = pit_cdr(rt, bodyforms);
+ }
+ pit_runtime_eval_program_push_literal(rt, rt->program, final);
+ return PIT_NIL;
+}
static pit_value impl_sf_lambda(pit_runtime *rt, pit_value args) {
pit_value as = pit_car(rt, args);
pit_value body = pit_cdr(rt, args);
@@ -54,6 +80,92 @@ static pit_value impl_m_defmacro(pit_runtime *rt, pit_value args) {
pit_list(rt, 2, pit_intern_cstr(rt, "set-symbol-macro!"), nm)
);
}
+static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args) {
+ pit_value ret = PIT_NIL;
+ pit_value df = PIT_NIL;
+ pit_value aargs = PIT_NIL;
+ char nm_str[128];
+ char field_str[128];
+ char buf[512];
+ pit_value nm = pit_car(rt, args);
+ pit_value fields = pit_cdr(rt, args);
+ i64 field_idx = 0;
+ i64 nm_len = pit_as_bytes(rt, pit_symbol_name(rt, nm), (u8 *) nm_str, sizeof(nm_str) - 1);
+ if (nm_len < 0) return PIT_NIL;
+ nm_str[nm_len] = 0;
+ /* constructor */
+ snprintf(buf, sizeof(buf), ":%s", nm_str);
+ aargs = pit_cons(rt, pit_intern_cstr(rt, buf), pit_cons(rt, pit_intern_cstr(rt, "array"), PIT_NIL));
+ fields = pit_cdr(rt, args);
+ while (fields != PIT_NIL) {
+ i64 field_len = pit_as_bytes(rt,
+ pit_symbol_name(rt, pit_car(rt, fields)),
+ (u8 *) field_str, sizeof(field_str) - 1
+ );
+ if (field_len < 0) return PIT_NIL;
+ field_str[field_len] = 0;
+ snprintf(buf, sizeof(buf), ":%s", field_str);
+ aargs = pit_cons(rt,
+ pit_list(rt, 3, pit_intern_cstr(rt, "plist/get"), pit_intern_cstr(rt, buf), pit_intern_cstr(rt, "kwargs")),
+ aargs
+ );
+ fields = pit_cdr(rt, fields);
+ }
+ snprintf(buf, sizeof(buf), "%s/new", nm_str);
+ df = pit_list(rt, 4,
+ pit_intern_cstr(rt, "defun!"),
+ pit_intern_cstr(rt, buf),
+ pit_list(rt, 2, pit_intern_cstr(rt, "&"), pit_intern_cstr(rt, "kwargs")),
+ pit_reverse(rt, aargs)
+ );
+ ret = pit_cons(rt, df, ret);
+ /* getters and setters */
+ fields = pit_cdr(rt, args);
+ field_idx = 0;
+ while (fields != PIT_NIL) {
+ i64 field_len = pit_as_bytes(rt,
+ pit_symbol_name(rt, pit_car(rt, fields)),
+ (u8 *) field_str, sizeof(field_str) - 1
+ );
+ if (field_len < 0) return PIT_NIL;
+ field_str[field_len] = 0;
+ /* getter */
+ snprintf(buf, sizeof(buf), "%s/get-%s", nm_str, field_str);
+ df = pit_list(rt, 4,
+ pit_intern_cstr(rt, "defun!"),
+ pit_intern_cstr(rt, buf),
+ pit_list(rt, 1, pit_intern_cstr(rt, "v")),
+ pit_list(rt, 3,
+ pit_intern_cstr(rt, "array/get"),
+ pit_integer_new(rt, field_idx + 1),
+ pit_intern_cstr(rt, "v")
+ )
+ );
+ ret = pit_cons(rt, df, ret);
+ /* setter */
+ snprintf(buf, sizeof(buf), "%s/set-%s!", nm_str, field_str);
+ df = pit_list(rt, 4,
+ pit_intern_cstr(rt, "defun!"),
+ pit_intern_cstr(rt, buf),
+ pit_list(rt, 2, pit_intern_cstr(rt, "v"), pit_intern_cstr(rt, "x")),
+ pit_list(rt, 4,
+ pit_intern_cstr(rt, "array/set!"),
+ pit_integer_new(rt, field_idx + 1),
+ pit_intern_cstr(rt, "x"),
+ pit_intern_cstr(rt, "v")
+ )
+ );
+ ret = pit_cons(rt, df, ret);
+ fields = pit_cdr(rt, fields);
+ field_idx += 1;
+ }
+ // (defstruct foo x y z)
+ // (defun foo/new (kwargs) ...)
+ // (defun foo/get-x (f) ...)
+ // (defun foo/set-x! (f v) ...)
+ // pit_trace(rt, ret);
+ return pit_cons(rt, pit_intern_cstr(rt, "progn"), ret);
+}
static pit_value impl_m_let(pit_runtime *rt, pit_value args) {
pit_value lparams = PIT_NIL;
pit_value largs = PIT_NIL;
@@ -94,6 +206,34 @@ static pit_value impl_m_setq(pit_runtime *rt, pit_value args) {
v
);
}
+
+// (case x (y 'foo) (z 'bar))
+// (cond ((eq x 'y) 'foo) ((eq x 'z) 'bar))
+static pit_value impl_m_case(pit_runtime *rt, pit_value args) {
+ pit_value x = pit_car(rt, args);
+ pit_value cases = pit_cdr(rt, args);
+ pit_value clauses = PIT_NIL;
+ pit_value xvar = pit_intern_cstr(rt, "(internal case)");
+ while (cases != PIT_NIL) {
+ pit_value c = pit_car(rt, cases);
+ clauses = pit_cons(rt,
+ pit_list(rt, 2,
+ pit_list(rt, 3, pit_intern_cstr(rt, "equal?"),
+ xvar,
+ pit_list(rt, 2, pit_intern_cstr(rt, "quote"), pit_car(rt, c))
+ ),
+ pit_car(rt, pit_cdr(rt, c))
+ ),
+ clauses
+ );
+ cases = pit_cdr(rt, cases);
+ }
+ return pit_list(rt, 3,
+ pit_intern_cstr(rt, "let"),
+ pit_list(rt, 1, pit_list(rt, 2, xvar, x)),
+ pit_cons(rt, pit_intern_cstr(rt, "cond"), pit_reverse(rt, clauses))
+ );
+}
static pit_value impl_set(pit_runtime *rt, pit_value args) {
pit_value sym = pit_car(rt, args);
pit_value v = pit_car(rt, pit_cdr(rt, args));
@@ -112,51 +252,53 @@ static pit_value impl_symbol_is_macro(pit_runtime *rt, pit_value args) {
return PIT_NIL;
}
static pit_value impl_funcall(pit_runtime *rt, pit_value args) {
- pit_value fsym = pit_car(rt, args);
- pit_value f = PIT_NIL;
- if (pit_is_symbol(rt, fsym)) {
- f = pit_fget(rt, fsym);
- } else {
- /* if f is not a symbol, assume it is a func or nativefunc
- most commonly, this happens when you funcall a variable
- with a function in the value cell, e.g. passing a lambda to a function */
- f = fsym;
- }
+ pit_value f = pit_car(rt, args);
return pit_apply(rt, f, pit_cdr(rt, args));
}
+static pit_value impl_error(pit_runtime *rt, pit_value args) {
+ rt->error = PIT_T;
+ rt->error = pit_car(rt, args);
+ rt->error_line = rt->source_line;
+ rt->error_column = rt->source_column;
+ return PIT_NIL;
+}
static pit_value impl_eval(pit_runtime *rt, pit_value args) {
return pit_eval(rt, pit_car(rt, args));
}
static pit_value impl_eq_p(pit_runtime *rt, pit_value args) {
pit_value x = pit_car(rt, args);
pit_value y = pit_car(rt, pit_cdr(rt, args));
- return pit_eq(x, y);
+ return pit_bool_new(rt, pit_eq(x, y));
}
static pit_value impl_equal_p(pit_runtime *rt, pit_value args) {
pit_value x = pit_car(rt, args);
pit_value y = pit_car(rt, pit_cdr(rt, args));
- return pit_equal(rt, x, y);
+ return pit_bool_new(rt, pit_equal(rt, x, y));
}
static pit_value impl_integer_p(pit_runtime *rt, pit_value args) {
- return pit_is_integer(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_integer(rt, pit_car(rt, args)));
}
static pit_value impl_double_p(pit_runtime *rt, pit_value args) {
- return pit_is_double(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_double(rt, pit_car(rt, args)));
}
static pit_value impl_symbol_p(pit_runtime *rt, pit_value args) {
- return pit_is_symbol(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_symbol(rt, pit_car(rt, args)));
}
static pit_value impl_cons_p(pit_runtime *rt, pit_value args) {
- return pit_is_cons(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_cons(rt, pit_car(rt, args)));
}
static pit_value impl_array_p(pit_runtime *rt, pit_value args) {
- return pit_is_array(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_array(rt, pit_car(rt, args)));
}
static pit_value impl_bytes_p(pit_runtime *rt, pit_value args) {
- return pit_is_bytes(rt, pit_car(rt, args));
+ return pit_bool_new(rt, pit_is_bytes(rt, pit_car(rt, args)));
}
static pit_value impl_function_p(pit_runtime *rt, pit_value args) {
- return pit_is_bytes(rt, pit_car(rt, args));
+ pit_value a = pit_car(rt, args);
+ bool b = (pit_is_symbol(rt, a) && pit_fget(rt, a) != PIT_NIL)
+ || pit_is_func(rt, a)
+ || pit_is_nativefunc(rt, a);
+ return pit_bool_new(rt, b);
}
static pit_value impl_cons(pit_runtime *rt, pit_value args) {
return pit_cons(rt, pit_car(rt, args), pit_car(rt, pit_cdr(rt, args)));
@@ -181,6 +323,62 @@ static pit_value impl_list(pit_runtime *rt, pit_value args) {
(void) rt;
return args;
}
+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));
+}
+static pit_value impl_list_reverse(pit_runtime *rt, pit_value args) {
+ return pit_reverse(rt, pit_car(rt, args));
+}
+static pit_value impl_list_uniq(pit_runtime *rt, pit_value args) {
+ pit_value xs = pit_car(rt, args);
+ pit_value ret = PIT_NIL;
+ while (xs != PIT_NIL) {
+ pit_value x = pit_car(rt, xs);
+ if (pit_contains_equal(rt, x, ret) == PIT_NIL) {
+ ret = pit_cons(rt, x, ret);
+ }
+ xs = pit_cdr(rt, xs);
+ }
+ return pit_reverse(rt, ret);
+}
+static pit_value impl_list_append(pit_runtime *rt, pit_value args) {
+ args = pit_reverse(rt, args);
+ pit_value ret = pit_car(rt, args);
+ pit_value ls = pit_cdr(rt, args);
+ while (ls != PIT_NIL) {
+ pit_value xs = pit_reverse(rt, pit_car(rt, ls));
+ while (xs != PIT_NIL) {
+ ret = pit_cons(rt, pit_car(rt, xs), ret);
+ xs = pit_cdr(rt, xs);
+ }
+ ls = pit_cdr(rt, ls);
+ }
+ return ret;
+}
+static pit_value impl_list_concat(pit_runtime *rt, pit_value args) {
+ return impl_list_append(rt, pit_car(rt, args));
+}
+static pit_value impl_list_take(pit_runtime *rt, pit_value args) {
+ i64 num = pit_as_integer(rt, pit_car(rt, args));
+ pit_value arr = pit_car(rt, pit_cdr(rt, args));
+ pit_value ret = PIT_NIL;
+ while (num > 0 && arr != PIT_NIL) {
+ ret = pit_cons(rt, pit_car(rt, arr), ret);
+ arr = pit_cdr(rt, arr);
+ num -= 1;
+ }
+ return pit_reverse(rt, ret);
+}
+static pit_value impl_list_drop(pit_runtime *rt, pit_value args) {
+ i64 num = pit_as_integer(rt, pit_car(rt, args));
+ pit_value arr = pit_car(rt, pit_cdr(rt, args));
+ while (num > 0 && arr != PIT_NIL) {
+ arr = pit_cdr(rt, arr);
+ num -= 1;
+ }
+ return arr;
+}
static pit_value impl_list_map(pit_runtime *rt, pit_value args) {
pit_value func = pit_car(rt, args);
pit_value xs = pit_car(rt, pit_cdr(rt, args));
@@ -192,6 +390,200 @@ static pit_value impl_list_map(pit_runtime *rt, pit_value args) {
}
return pit_reverse(rt, ret);
}
+static pit_value impl_list_foldl(pit_runtime *rt, pit_value args) {
+ pit_value func = pit_car(rt, args);
+ pit_value acc = pit_car(rt, pit_cdr(rt, args));
+ pit_value xs = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args)));
+ while (xs != PIT_NIL) {
+ acc = pit_apply(rt, func, pit_list(rt, 2, pit_car(rt, xs), acc));
+ xs = pit_cdr(rt, xs);
+ }
+ return acc;
+}
+static pit_value impl_list_filter(pit_runtime *rt, pit_value args) {
+ pit_value func = pit_car(rt, args);
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ pit_value ret = PIT_NIL;
+ while (xs != PIT_NIL) {
+ pit_value x = pit_car(rt, xs);
+ pit_value y = pit_apply(rt, func, pit_cons(rt, x, PIT_NIL));
+ if (y != PIT_NIL) {
+ ret = pit_cons(rt, x, ret);
+ }
+ xs = pit_cdr(rt, xs);
+ }
+ return pit_reverse(rt, ret);
+}
+static pit_value impl_list_find(pit_runtime *rt, pit_value args) {
+ pit_value func = pit_car(rt, args);
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ while (xs != PIT_NIL) {
+ pit_value x = pit_car(rt, xs);
+ pit_value y = pit_apply(rt, func, pit_cons(rt, x, PIT_NIL));
+ if (y != PIT_NIL) {
+ return x;
+ }
+ xs = pit_cdr(rt, xs);
+ }
+ return PIT_NIL;
+}
+static pit_value impl_list_contains_p(pit_runtime *rt, pit_value args) {
+ pit_value needle = pit_car(rt, args);
+ pit_value haystack = pit_car(rt, pit_cdr(rt, args));
+ while (haystack != PIT_NIL) {
+ if (pit_equal(rt, needle, pit_car(rt, haystack))) return PIT_T;
+ haystack = pit_cdr(rt, haystack);
+ }
+ return PIT_NIL;
+}
+static pit_value impl_list_all_p(pit_runtime *rt, pit_value args) {
+ pit_value f = pit_car(rt, args);
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ while (xs != PIT_NIL) {
+ pit_value x = pit_car(rt, xs);
+ if (pit_apply(rt, f, pit_cons(rt, x, PIT_NIL)) == PIT_NIL) {
+ return PIT_NIL;
+ }
+ xs = pit_cdr(rt, xs);
+ }
+ return PIT_T;
+}
+static pit_value impl_list_zip_with(pit_runtime *rt, pit_value args) {
+ pit_value f = pit_car(rt, args);
+ pit_value xs = pit_car(rt, pit_cdr(rt, args));
+ pit_value ys = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args)));
+ pit_value ret = PIT_NIL;
+ while (xs != PIT_NIL && ys != PIT_NIL) {
+ pit_value z = pit_apply(rt, f, pit_list(rt, 2, pit_car(rt, xs), pit_car(rt, ys)));
+ ret = pit_cons(rt, z, ret);
+ xs = pit_cdr(rt, xs); ys = pit_cdr(rt, ys);
+ }
+ return pit_reverse(rt, ret);
+}
+static pit_value impl_bytes_len(pit_runtime *rt, pit_value args) {
+ pit_value v = pit_car(rt, args);
+ if (pit_value_sort(v) != PIT_VALUE_SORT_REF) {
+ pit_error(rt, "value is not a ref");
+ return PIT_NIL;
+ }
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v));
+ if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; }
+ if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) { pit_error(rt, "ref is not bytes"); return PIT_NIL; }
+ return pit_integer_new(rt, h->in.bytes.len);
+}
+static pit_value impl_bytes_range(pit_runtime *rt, pit_value args) {
+ i64 start = pit_as_integer(rt, pit_car(rt, args));
+ i64 end = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+ pit_value v = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args)));
+ if (pit_value_sort(v) != PIT_VALUE_SORT_REF) {
+ pit_error(rt, "value is not a ref");
+ return PIT_NIL;
+ }
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v));
+ if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; }
+ if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) { pit_error(rt, "ref is not bytes"); return PIT_NIL; }
+ if (start < 0 || start >= h->in.bytes.len) {
+ pit_error(rt, "bytes range start index out of bounds: %d", start);
+ return PIT_NIL;
+ }
+ if (end < start || end < 0 || end > h->in.bytes.len) {
+ pit_error(rt, "bytes range end index out of bounds: %d", end);
+ return PIT_NIL;
+ }
+ return pit_bytes_new(rt, h->in.bytes.data + start, end - start);
+}
+static pit_value impl_array(pit_runtime *rt, pit_value args) {
+ i64 scratch_reset = rt->scratch->next;
+ i64 len = 0;
+ while (args != PIT_NIL) {
+ pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value));
+ *cell = pit_car(rt, args);
+ len += 1;
+ args = pit_cdr(rt, args);
+ }
+ rt->scratch->next = scratch_reset;
+ return pit_array_from_buf(rt, pit_arena_idx(rt->scratch, (i32) scratch_reset), len);
+}
+static pit_value impl_array_to_list(pit_runtime *rt, pit_value args) {
+ pit_value arr = pit_car(rt, args);
+ i64 ilen = pit_array_len(rt, arr);
+ pit_value ret = PIT_NIL;
+ i64 i = 0;
+ for (; i < ilen; ++i) {
+ ret = pit_cons(rt, pit_array_get(rt, arr, i), ret);
+ }
+ return pit_reverse(rt, ret);
+}
+static pit_value impl_array_from_list(pit_runtime *rt, pit_value args) {
+ i64 i = 0;
+ pit_value xs = pit_car(rt, args);
+ i64 ilen = pit_list_len(rt, xs);
+ pit_value ret = pit_array_new(rt, ilen);
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
+ if (!h) { pit_error(rt, "failed to deref heavy value for array"); return PIT_NIL; }
+ while (xs != PIT_NIL) {
+ h->in.array.data[i] = pit_car(rt, xs);
+ xs = pit_cdr(rt, xs);
+ i += 1;
+ }
+ return ret;
+}
+static pit_value impl_array_repeat(pit_runtime *rt, pit_value args) {
+ i64 i = 0;
+ pit_value v = pit_car(rt, args);
+ pit_value len = pit_car(rt, pit_cdr(rt, args));
+ i64 ilen = pit_as_integer(rt, len);
+ pit_value ret = pit_array_new(rt, ilen);
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
+ if (!h) { pit_error(rt, "failed to deref heavy value for array"); return PIT_NIL; }
+ for (; i < ilen; ++i) {
+ h->in.array.data[i] = v;
+ }
+ return ret;
+}
+static pit_value impl_array_len(pit_runtime *rt, pit_value args) {
+ pit_value arr = pit_car(rt, args);
+ return pit_integer_new(rt, pit_array_len(rt, arr));
+}
+static pit_value impl_array_get(pit_runtime *rt, pit_value args) {
+ pit_value idx = pit_car(rt, args);
+ pit_value arr = pit_car(rt, pit_cdr(rt, args));
+ return pit_array_get(rt, arr, pit_as_integer(rt, idx));
+}
+static pit_value impl_array_set(pit_runtime *rt, pit_value args) {
+ pit_value idx = pit_car(rt, args);
+ pit_value v = pit_car(rt, pit_cdr(rt, args));
+ pit_value arr = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args)));
+ return pit_array_set(rt, arr, pit_as_integer(rt, idx), v);
+}
+static pit_value impl_array_map(pit_runtime *rt, pit_value args) {
+ pit_value func = pit_car(rt, args);
+ pit_value arr = pit_car(rt, pit_cdr(rt, args));
+ i64 len = pit_array_len(rt, arr);
+ pit_value ret = pit_array_new(rt, len);
+ i64 i = 0;
+ for (i = 0; i < len; ++i) {
+ pit_value y = pit_apply(rt, func, pit_cons(rt, pit_array_get(rt, arr, i), PIT_NIL));
+ pit_array_set(rt, ret, i, y);
+ }
+ return ret;
+}
+static pit_value impl_array_map_mut(pit_runtime *rt, pit_value args) {
+ pit_value func = pit_car(rt, args);
+ pit_value arr = pit_car(rt, pit_cdr(rt, args));
+ i64 len = pit_array_len(rt, arr);
+ i64 i = 0;
+ for (i = 0; i < len; ++i) {
+ pit_value y = pit_apply(rt, func, pit_cons(rt, pit_array_get(rt, arr, i), PIT_NIL));
+ pit_array_set(rt, arr, i, y);
+ }
+ return arr;
+}
+static pit_value impl_abs(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ if (x < 0) return pit_integer_new(rt, -x);
+ return pit_integer_new(rt, x);
+}
static pit_value impl_add(pit_runtime *rt, pit_value args) {
i64 total = 0;
while (args != PIT_NIL) {
@@ -201,8 +593,7 @@ static pit_value impl_add(pit_runtime *rt, pit_value args) {
return pit_integer_new(rt, total);
}
static pit_value impl_sub(pit_runtime *rt, pit_value args) {
- i64 total = pit_as_integer(rt, pit_car(rt, args));
- args = pit_cdr(rt, args);
+ i64 total = 0;
while (args != PIT_NIL) {
total -= pit_as_integer(rt, pit_car(rt, args));
args = pit_cdr(rt, args);
@@ -231,18 +622,89 @@ static pit_value impl_div(pit_runtime *rt, pit_value args) {
}
return pit_integer_new(rt, total);
}
+static pit_value impl_not(pit_runtime *rt, pit_value args) {
+ if (pit_car(rt, args) == PIT_NIL) {
+ return PIT_T;
+ } else {
+ return PIT_NIL;
+ }
+}
+static pit_value impl_lt(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+ return pit_bool_new(rt, x < y);
+}
+static pit_value impl_gt(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+ return pit_bool_new(rt, x > y);
+}
+static pit_value impl_le(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+ return pit_bool_new(rt, x <= y);
+}
+static pit_value impl_ge(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+ return pit_bool_new(rt, x >= y);
+}
+static pit_value impl_bitwise_and(pit_runtime *rt, pit_value args) {
+ i64 total = -1;
+ while (args != PIT_NIL) {
+ total &= pit_as_integer(rt, pit_car(rt, args));
+ args = pit_cdr(rt, args);
+ }
+ return pit_integer_new(rt, total);
+}
+static pit_value impl_bitwise_or(pit_runtime *rt, pit_value args) {
+ i64 total = 0;
+ while (args != PIT_NIL) {
+ total |= pit_as_integer(rt, pit_car(rt, args));
+ args = pit_cdr(rt, args);
+ }
+ return pit_integer_new(rt, total);
+}
+static pit_value impl_bitwise_xor(pit_runtime *rt, pit_value args) {
+ i64 total = 0;
+ while (args != PIT_NIL) {
+ total ^= pit_as_integer(rt, pit_car(rt, args));
+ args = pit_cdr(rt, args);
+ }
+ return pit_integer_new(rt, total);
+}
+static pit_value impl_bitwise_not(pit_runtime *rt, pit_value args) {
+ i64 x = pit_as_integer(rt, pit_car(rt, args));
+ return pit_integer_new(rt, ~x);
+}
+static pit_value impl_bitwise_lshift(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);
+}
+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);
+}
void pit_install_library_essential(pit_runtime *rt) {
/* special forms */
pit_sfset(rt, pit_intern_cstr(rt, "quote"), pit_nativefunc_new(rt, impl_sf_quote));
pit_sfset(rt, pit_intern_cstr(rt, "if"), pit_nativefunc_new(rt, impl_sf_if));
+ pit_sfset(rt, pit_intern_cstr(rt, "cond"), pit_nativefunc_new(rt, impl_sf_cond));
pit_sfset(rt, pit_intern_cstr(rt, "progn"), pit_nativefunc_new(rt, impl_sf_progn));
+ pit_sfset(rt, pit_intern_cstr(rt, "or"), pit_nativefunc_new(rt, impl_sf_or));
pit_sfset(rt, pit_intern_cstr(rt, "lambda"), pit_nativefunc_new(rt, impl_sf_lambda));
/* macros */
pit_mset(rt, pit_intern_cstr(rt, "defun!"), pit_nativefunc_new(rt, impl_m_defun));
pit_mset(rt, pit_intern_cstr(rt, "defmacro!"), pit_nativefunc_new(rt, impl_m_defmacro));
+ pit_mset(rt, pit_intern_cstr(rt, "defstruct!"), pit_nativefunc_new(rt, impl_m_defstruct));
pit_mset(rt, pit_intern_cstr(rt, "let"), pit_nativefunc_new(rt, impl_m_let));
pit_mset(rt, pit_intern_cstr(rt, "and"), pit_nativefunc_new(rt, impl_m_and));
pit_mset(rt, pit_intern_cstr(rt, "setq!"), pit_nativefunc_new(rt, impl_m_setq));
+ pit_mset(rt, pit_intern_cstr(rt, "case"), pit_nativefunc_new(rt, impl_m_case));
+ /* error */
+ pit_fset(rt, pit_intern_cstr(rt, "error!"), pit_nativefunc_new(rt, impl_error));
/* eval */
pit_fset(rt, pit_intern_cstr(rt, "eval!"), pit_nativefunc_new(rt, impl_eval));
/* predicates */
@@ -268,12 +730,53 @@ 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/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));
+ pit_fset(rt, pit_intern_cstr(rt, "list/append"), pit_nativefunc_new(rt, impl_list_append));
+ pit_fset(rt, pit_intern_cstr(rt, "list/concat"), pit_nativefunc_new(rt, impl_list_concat));
+ pit_fset(rt, pit_intern_cstr(rt, "list/take"), pit_nativefunc_new(rt, impl_list_take));
+ pit_fset(rt, pit_intern_cstr(rt, "list/drop"), pit_nativefunc_new(rt, impl_list_drop));
pit_fset(rt, pit_intern_cstr(rt, "list/map"), pit_nativefunc_new(rt, impl_list_map));
+ pit_fset(rt, pit_intern_cstr(rt, "list/foldl"), pit_nativefunc_new(rt, impl_list_foldl));
+ pit_fset(rt, pit_intern_cstr(rt, "list/filter"), pit_nativefunc_new(rt, impl_list_filter));
+ pit_fset(rt, pit_intern_cstr(rt, "list/find"), pit_nativefunc_new(rt, impl_list_find));
+ pit_fset(rt, pit_intern_cstr(rt, "list/contains?"), pit_nativefunc_new(rt, impl_list_contains_p));
+ pit_fset(rt, pit_intern_cstr(rt, "list/all?"), pit_nativefunc_new(rt, impl_list_all_p));
+ pit_fset(rt, pit_intern_cstr(rt, "list/zip-with"), pit_nativefunc_new(rt, impl_list_zip_with));
+ /* bytestrings */
+ pit_fset(rt, pit_intern_cstr(rt, "bytes/len"), pit_nativefunc_new(rt, impl_bytes_len));
+ pit_fset(rt, pit_intern_cstr(rt, "bytes/range"), pit_nativefunc_new(rt, impl_bytes_range));
+ /* array */
+ pit_fset(rt, pit_intern_cstr(rt, "array"), pit_nativefunc_new(rt, impl_array));
+ pit_fset(rt, pit_intern_cstr(rt, "array/to-list"), pit_nativefunc_new(rt, impl_array_to_list));
+ pit_fset(rt, pit_intern_cstr(rt, "array/from-list"), pit_nativefunc_new(rt, impl_array_from_list));
+ pit_fset(rt, pit_intern_cstr(rt, "array/repeat"), pit_nativefunc_new(rt, impl_array_repeat));
+ pit_fset(rt, pit_intern_cstr(rt, "array/len"), pit_nativefunc_new(rt, impl_array_len));
+ pit_fset(rt, pit_intern_cstr(rt, "array/get"), pit_nativefunc_new(rt, impl_array_get));
+ pit_fset(rt, pit_intern_cstr(rt, "array/set!"), pit_nativefunc_new(rt, impl_array_set));
+ pit_fset(rt, pit_intern_cstr(rt, "array/map"), pit_nativefunc_new(rt, impl_array_map));
+ pit_fset(rt, pit_intern_cstr(rt, "array/map!"), pit_nativefunc_new(rt, impl_array_map_mut));
/* arithmetic */
+ pit_fset(rt, pit_intern_cstr(rt, "abs"), pit_nativefunc_new(rt, impl_abs));
pit_fset(rt, pit_intern_cstr(rt, "+"), pit_nativefunc_new(rt, impl_add));
pit_fset(rt, pit_intern_cstr(rt, "-"), pit_nativefunc_new(rt, impl_sub));
pit_fset(rt, pit_intern_cstr(rt, "*"), pit_nativefunc_new(rt, impl_mul));
pit_fset(rt, pit_intern_cstr(rt, "/"), pit_nativefunc_new(rt, impl_div));
+ /* booleans */
+ pit_fset(rt, pit_intern_cstr(rt, "not"), pit_nativefunc_new(rt, impl_not));
+ /* comparisons */
+ pit_fset(rt, pit_intern_cstr(rt, "<"), pit_nativefunc_new(rt, impl_lt));
+ pit_fset(rt, pit_intern_cstr(rt, ">"), pit_nativefunc_new(rt, impl_gt));
+ pit_fset(rt, pit_intern_cstr(rt, "<="), pit_nativefunc_new(rt, impl_le));
+ pit_fset(rt, pit_intern_cstr(rt, ">="), pit_nativefunc_new(rt, impl_ge));
+ /* bitwise arithmetic */
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/and"), pit_nativefunc_new(rt, impl_bitwise_and));
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/or"), pit_nativefunc_new(rt, impl_bitwise_or));
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/xor"), pit_nativefunc_new(rt, impl_bitwise_xor));
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/not"), pit_nativefunc_new(rt, impl_bitwise_not));
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/lshift"), pit_nativefunc_new(rt, impl_bitwise_lshift));
+ pit_fset(rt, pit_intern_cstr(rt, "bitwise/rshift"), pit_nativefunc_new(rt, impl_bitwise_rshift));
}
static pit_value impl_print(pit_runtime *rt, pit_value args) {
@@ -332,6 +835,23 @@ void pit_install_library_plist(pit_runtime *rt) {
pit_fset(rt, pit_intern_cstr(rt, "plist/get"), pit_nativefunc_new(rt, impl_plist_get));
}
+static pit_value impl_alist_get(pit_runtime *rt, pit_value args) {
+ pit_value k = pit_car(rt, args);
+ pit_value vs = pit_car(rt, pit_cdr(rt, args));
+ while (vs != PIT_NIL) {
+ pit_value v = pit_car(rt, vs);
+ if (pit_equal(rt, k, pit_car(rt, v))) {
+ return pit_cdr(rt, v);
+ }
+ vs = pit_cdr(rt, vs);
+ }
+ return PIT_NIL;
+}
+void pit_install_library_alist(pit_runtime *rt) {
+ /* association lists */
+ pit_fset(rt, pit_intern_cstr(rt, "alist/get"), pit_nativefunc_new(rt, impl_alist_get));
+}
+
struct bytestring {
i64 len, cap;
u8 *data;
diff --git a/src/main.c b/src/main.c
index bc697de..0b9a336 100644
--- a/src/main.c
+++ b/src/main.c
@@ -12,6 +12,7 @@ int main(int argc, char **argv) {
pit_install_library_essential(rt);
pit_install_library_io(rt);
pit_install_library_plist(rt);
+ pit_install_library_alist(rt);
pit_install_library_bytestring(rt);
if (argc < 2) { /* run repl */
char buf[1024] = {0};
@@ -49,11 +50,11 @@ int main(int argc, char **argv) {
}
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);
}
+ if (pit_runtime_print_error(rt)) exit(1);
}
return 0;
}
diff --git a/src/parser.c b/src/parser.c
index 4403323..9c112c2 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -37,6 +37,18 @@ static void get_token_string(pit_parser *st, char *buf, i64 len) {
buf[tlen] = 0;
}
+static i64 digit_value(char c) {
+ if (c >= '0' && c <= '9') {
+ return c - '0';
+ } else if (c >= 'a' && c <= 'f') {
+ return c - 'a' + 10;
+ } else if (c >= 'A' && c <= 'F') {
+ return c - 'A' + 10;
+ } else {
+ return 0;
+ }
+}
+
void pit_parser_from_lexer(pit_parser *ret, pit_lexer *lex) {
ret->lexer = lex;
ret->cur.token = ret->next.token = PIT_LEX_TOKEN_ERROR;
@@ -76,7 +88,10 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) {
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 (rt->error != PIT_NIL) return PIT_NIL; /* if we hit an error, stop!*/
+ if (rt->error != PIT_NIL || (eof != NULL && *eof)) {
+ pit_error(rt, "unterminated list");
+ return PIT_NIL; /* if we hit an error, stop!*/
+ }
}
for (i64 i = rt->scratch->next - (i64) sizeof(pit_value);
i >= scratch_reset;
@@ -88,11 +103,45 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) {
rt->scratch->next = scratch_reset;
return ret;
}
+ case PIT_LEX_TOKEN_LSQUARE: {
+ i64 scratch_reset = rt->scratch->next;
+ i64 len = 0;
+ while (!match(st, PIT_LEX_TOKEN_RSQUARE)) {
+ pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value));
+ *cell = pit_parse(rt, st, eof);
+ len += 1;
+ if (rt->error != PIT_NIL || (eof != NULL && *eof)) {
+ pit_error(rt, "unterminated array literal");
+ return PIT_NIL;
+ }
+ }
+ rt->scratch->next = scratch_reset;
+ return pit_array_from_buf(rt, pit_arena_idx(rt->scratch, (i32) scratch_reset), len);
+ }
case PIT_LEX_TOKEN_QUOTE:
return pit_list(rt, 2, pit_intern_cstr(rt, "quote"), pit_parse(rt, st, eof));
- case PIT_LEX_TOKEN_INTEGER_LITERAL:
- get_token_string(st, buf, sizeof(buf));
- return pit_integer_new(rt, atoi(buf));
+ case PIT_LEX_TOKEN_INTEGER_LITERAL: {
+ i64 idx = st->cur.start;
+ i64 base = 10;
+ i64 total = 0;
+ char c = st->lexer->input[idx++];
+ if (c == '0' && idx + 1 < st->cur.end) {
+ switch (st->lexer->input[idx++]) {
+ case 'b': base = 2; break;
+ case 'o': base = 8; break;
+ case 'x': base = 16; break;
+ default: pit_error(rt, "unknown integer base"); return PIT_NIL;
+ }
+ } else { total = digit_value(c); }
+ while (idx < st->cur.end) {
+ total *= base;
+ total += digit_value(st->lexer->input[idx++]);
+ if (total > 0x1ffffffffffff) {
+ pit_error(rt, "integer literal too large"); return PIT_NIL;
+ }
+ }
+ return pit_integer_new(rt, total);
+ }
case PIT_LEX_TOKEN_STRING_LITERAL: {
get_token_string(st, buf, sizeof(buf));
i64 len = (i64) strlen(buf);
diff --git a/src/runtime.c b/src/runtime.c
index b7e722a..6ea9aa1 100644
--- a/src/runtime.c
+++ b/src/runtime.c
@@ -68,16 +68,18 @@ u64 pit_value_data(pit_value v) {
pit_runtime *pit_runtime_new() {
pit_runtime *ret = malloc(sizeof(*ret));
- ret->values = pit_arena_new(64 * 1024, sizeof(pit_value_heavy));
- ret->bytes = pit_arena_new(64 * 1024, sizeof(u8));
- ret->symtab = pit_arena_new(64 * 1024, sizeof(pit_symtab_entry));
+ ret->values = pit_arena_new(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(64 * 1024, sizeof(u8));
+ ret->scratch = pit_arena_new(1024 * 1024, sizeof(u8));
ret->expr_stack = pit_values_new(1024);
ret->result_stack = pit_values_new(1024);
ret->program = pit_runtime_eval_program_new(64 * 1024);
ret->saved_bindings = pit_values_new(1024);
ret->frozen_values = 0;
+ ret->frozen_arrays = 0;
ret->frozen_bytes = 0;
ret->frozen_symtab = 0;
ret->error = PIT_NIL;
@@ -93,24 +95,29 @@ pit_runtime *pit_runtime_new() {
void pit_runtime_freeze(pit_runtime *rt) {
rt->frozen_values = pit_arena_next_idx(rt->values);
+ rt->frozen_arrays = pit_arena_next_idx(rt->arrays);
rt->frozen_bytes = pit_arena_next_idx(rt->bytes);
rt->frozen_symtab = pit_arena_next_idx(rt->symtab);
}
void pit_runtime_reset(pit_runtime *rt) {
rt->values->next = rt->frozen_values;
+ rt->arrays->next = rt->frozen_arrays;
rt->bytes->next = rt->frozen_bytes;
rt->symtab->next = rt->frozen_symtab;
}
bool pit_runtime_print_error(pit_runtime *rt) {
if (!pit_eq(rt->error, PIT_NIL)) {
char buf[1024] = {0};
- pit_dump(rt, buf, sizeof(buf), rt->error, false);
+ i64 end = pit_dump(rt, buf, sizeof(buf) - 1, rt->error, false);
+ buf[end] = 0;
fprintf(stderr, "error at line %ld, column %ld: %s\n", rt->error_line, rt->error_column, buf);
return true;
}
return false;
}
+#define CHECK_BUF if (buf >= end) { return buf - start; }
+#define CHECK_BUF_LABEL(label) if (buf >= end) { goto label; }
i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) {
pit_value_heavy *h = NULL;
if (len <= 0) return 0;
@@ -136,46 +143,60 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) {
}
case PIT_VALUE_SORT_REF: {
pit_ref r = pit_as_ref(rt, v);
+ char *end = buf + len;
+ char *start = buf;
h = pit_deref(rt, r);
if (!h) snprintf(buf, (size_t) len, "<ref %d>", r);
else {
switch (h->hsort) {
case PIT_VALUE_HEAVY_SORT_CELL: {
- char *end = buf + len;
- char *start = buf;
- *(buf++) = '{';
- buf += pit_dump(rt, buf, end - buf, pit_car(rt, h->in.cell), readable);
- *(buf++) = '}';
+ CHECK_BUF; *(buf++) = '{';
+ CHECK_BUF; buf += pit_dump(rt, buf, end - buf, pit_car(rt, h->in.cell), readable);
+ CHECK_BUF; *(buf++) = '}';
return buf - start;
}
case PIT_VALUE_HEAVY_SORT_CONS: {
- char *end = buf + len;
- char *start = buf;
pit_value cur = v;
+ CHECK_BUF_LABEL(list_end);
do {
if (pit_is_cons(rt, cur)) {
- *(buf++) = ' '; if (buf >= end) return end - buf;
- buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur), readable);
- if (buf >= end) return end - buf;
+ CHECK_BUF_LABEL(list_end); *(buf++) = ' ';
+ CHECK_BUF_LABEL(list_end); buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur), readable);
} else {
- buf += snprintf(buf, (size_t) (end - buf), " . ");
- if (buf >= end) return end - buf;
- buf += pit_dump(rt, buf, end - buf, cur, readable);
- if (buf >= end) return end - buf;
+ CHECK_BUF_LABEL(list_end); buf += snprintf(buf, (size_t) (end - buf), " . ");
+ CHECK_BUF_LABEL(list_end); buf += pit_dump(rt, buf, end - buf, cur, readable);
}
} while (!pit_eq((cur = pit_cdr(rt, cur)), PIT_NIL));
+ CHECK_BUF_LABEL(list_end); *(buf++) = ')';
+ list_end:
*start = '(';
- *(buf++) = ')';
+ return buf - start;
+ }
+ case PIT_VALUE_HEAVY_SORT_ARRAY: {
+ i64 i = 0;
+ CHECK_BUF_LABEL(array_end);
+ if (h->in.array.len == 0) {
+ CHECK_BUF_LABEL(array_end); *(buf++) = '[';
+ } else for (; i < h->in.array.len; ++i) {
+ CHECK_BUF_LABEL(array_end); *(buf++) = ' ';
+ CHECK_BUF_LABEL(array_end); buf += pit_dump(rt, buf, end - buf, h->in.array.data[i], readable);
+ }
+ CHECK_BUF_LABEL(array_end); *(buf++) = ']';
+ array_end:
+ *start = '[';
return buf - start;
}
case PIT_VALUE_HEAVY_SORT_BYTES: {
i64 i = 0;
- if (readable) buf[i++] = '"';
+ if (readable) { CHECK_BUF; buf[i++] = '"'; }
i64 maxlen = len - i;
for (i64 j = 0; i < maxlen && j < h->in.bytes.len;) {
- if (buf[i - 1] != '\\' && (h->in.bytes.data[j] == '\\' || h->in.bytes.data[j] == '"'))
- buf[i++] = '\\';
- else buf[i++] = (char) h->in.bytes.data[j++];
+ if (buf[i - 1] != '\\' && (h->in.bytes.data[j] == '\\' || h->in.bytes.data[j] == '"')) {
+ CHECK_BUF; buf[i++] = '\\';
+ }
+ else {
+ CHECK_BUF; buf[i++] = (char) h->in.bytes.data[j++];
+ }
}
if (readable && i < len - 1) buf[i++] = '"';
return i;
@@ -192,7 +213,8 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) {
void pit_trace_(pit_runtime *rt, const char *format, pit_value v) {
char buf[1024] = {0};
- pit_dump(rt, buf, sizeof(buf), v, true);
+ i64 end = pit_dump(rt, buf, sizeof(buf) - 1, v, true);
+ buf[end] = 0;
fprintf(stderr, format, buf);
}
@@ -249,7 +271,11 @@ i64 pit_as_integer(pit_runtime *rt, pit_value v) {
}
pit_value pit_integer_new(pit_runtime *rt, i64 i) {
- return pit_value_new(rt, PIT_VALUE_SORT_INTEGER, (u64) i);
+ return pit_value_new(rt, PIT_VALUE_SORT_INTEGER, 0x1ffffffffffff & (u64) i);
+}
+pit_value pit_bool_new(pit_runtime *rt, bool i) {
+ (void) rt;
+ return i ? PIT_T : PIT_NIL;
}
pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v) {
@@ -435,7 +461,7 @@ bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len) {
return true;
}
i64 pit_as_bytes(pit_runtime *rt, pit_value v, u8 *buf, i64 maxlen) {
- if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return -1;
+ if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return -1; }
pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v));
if (!h) { pit_error(rt, "bad ref"); return -1; }
if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) {
@@ -493,6 +519,11 @@ pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) {
pit_value pit_intern_cstr(pit_runtime *rt, char *nm) {
return pit_intern(rt, (u8 *) nm, (i64) strlen(nm));
}
+pit_value pit_symbol_name(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; }
+ return ent->name;
+}
bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) {
pit_symtab_entry *ent = pit_symtab_lookup(rt, sym);
if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; }
@@ -516,7 +547,7 @@ pit_value pit_get_function_cell(pit_runtime *rt, pit_value sym) {
return ent->function;
}
pit_value pit_get(pit_runtime *rt, pit_value sym) {
- return pit_cell_get(rt, pit_get_value_cell(rt, sym));
+ return pit_cell_get(rt, pit_get_value_cell(rt, sym), sym);
}
void pit_set(pit_runtime *rt, pit_value sym, pit_value v) {
pit_symbol idx = pit_as_symbol(rt, sym);
@@ -526,10 +557,11 @@ 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);
}
- pit_cell_set(rt, ent->value, v);
+ 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) {
- return pit_cell_get(rt, pit_get_function_cell(rt, sym));
+ return pit_cell_get(rt, pit_get_function_cell(rt, sym), sym);
}
void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) {
pit_symbol idx = pit_as_symbol(rt, sym);
@@ -539,7 +571,7 @@ void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) {
if (pit_value_sort(ent->function) != PIT_VALUE_SORT_REF) {
ent->function = pit_cell_new(rt, PIT_NIL);
}
- pit_cell_set(rt, ent->function, v);
+ pit_cell_set(rt, ent->function, v, sym);
}
bool pit_is_symbol_macro(pit_runtime *rt, pit_value sym) {
pit_symtab_entry *ent = pit_symtab_lookup(rt, sym);
@@ -574,6 +606,7 @@ 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) {
@@ -592,9 +625,12 @@ pit_value pit_cell_new(pit_runtime *rt, pit_value v) {
h->in.cell = v;
return ret;
}
-pit_value pit_cell_get(pit_runtime *rt, pit_value cell) {
+pit_value pit_cell_get(pit_runtime *rt, pit_value cell, pit_value sym) {
if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) {
- pit_error(rt, "attempted to get cell value that is not ref");
+ char buf[256];
+ i64 end = pit_dump(rt, buf, sizeof(buf) - 1, sym, false);
+ buf[end] = 0;
+ pit_error(rt, "attempted to get unbound variable/function: %s", buf);
return PIT_NIL;
}
pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, cell));
@@ -605,9 +641,12 @@ pit_value pit_cell_get(pit_runtime *rt, pit_value cell) {
}
return h->in.cell;
}
-void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v) {
+void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v, pit_value sym) {
if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) {
- pit_error(rt, "attempted to set cell value that is not ref");
+ char buf[256];
+ i64 end = pit_dump(rt, buf, sizeof(buf) - 1, sym, false);
+ buf[end] = 0;
+ pit_error(rt, "attempted to set unbound variable/function: %s", buf);
return;
}
pit_ref idx = pit_as_ref(rt, cell);
@@ -621,6 +660,58 @@ void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v) {
h->in.cell = v;
}
+pit_value pit_array_new(pit_runtime *rt, i64 len) {
+ if (len < 0) { pit_error(rt, "failed to create array of negative size"); return PIT_NIL; }
+ int i = 0;
+ pit_value *dest = pit_arena_alloc_bulk(rt->arrays, len);
+ if (!dest) { pit_error(rt, "failed to allocate array"); return PIT_NIL; }
+ for (; i < len; ++i) dest[i] = PIT_NIL;
+ pit_value ret = pit_heavy_new(rt);
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
+ if (!h) { pit_error(rt, "failed to create new heavy value for array"); return PIT_NIL; }
+ h->hsort = PIT_VALUE_HEAVY_SORT_ARRAY;
+ h->in.array.data = dest;
+ h->in.array.len = len;
+ return ret;
+}
+pit_value pit_array_from_buf(pit_runtime *rt, pit_value *xs, i64 len) {
+ pit_value ret = pit_array_new(rt, len);
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
+ if (!h) { pit_error(rt, "failed to deref heavy value for array"); return PIT_NIL; }
+ memcpy(h->in.array.data, xs, (size_t) len * (size_t) sizeof(pit_value));
+ return ret;
+}
+i64 pit_array_len(pit_runtime *rt, pit_value arr) {
+ if (pit_value_sort(arr) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return -1; }
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, arr));
+ if (!h) { pit_error(rt, "bad ref"); return -1; }
+ if (h->hsort != PIT_VALUE_HEAVY_SORT_ARRAY) { pit_error(rt, "not an array"); return -1; }
+ return h->in.array.len;
+}
+pit_value pit_array_get(pit_runtime *rt, pit_value arr, i64 idx) {
+ if (pit_value_sort(arr) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return PIT_NIL; }
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, arr));
+ if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; }
+ if (h->hsort != PIT_VALUE_HEAVY_SORT_ARRAY) { pit_error(rt, "not an array"); return PIT_NIL; }
+ if (idx < 0 || idx >= h->in.array.len) {
+ pit_error(rt, "array index out of bounds: %d", idx);
+ return PIT_NIL;
+ }
+ return h->in.array.data[idx];
+}
+pit_value pit_array_set(pit_runtime *rt, pit_value arr, i64 idx, pit_value v) {
+ if (pit_value_sort(arr) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return PIT_NIL; }
+ pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, arr));
+ if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; }
+ if (h->hsort != PIT_VALUE_HEAVY_SORT_ARRAY) { pit_error(rt, "not an array"); return PIT_NIL; }
+ if (idx < 0 || idx >= h->in.array.len) {
+ pit_error(rt, "array index out of bounds: %d", idx);
+ return PIT_NIL;
+ }
+ h->in.array.data[idx] = v;
+ return v;
+}
+
pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr) {
pit_value ret = pit_heavy_new(rt);
pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret));
@@ -645,6 +736,14 @@ pit_value pit_list(pit_runtime *rt, i64 num, ...) {
}
return ret;
}
+i64 pit_list_len(pit_runtime *rt, pit_value xs) {
+ i64 ret = 0;
+ while (xs != PIT_NIL) {
+ ret += 1;
+ xs = pit_cdr(rt, xs);
+ }
+ return ret;
+}
pit_value pit_car(pit_runtime *rt, pit_value v) {
if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL;
pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v));
@@ -696,7 +795,14 @@ pit_value pit_reverse(pit_runtime *rt, pit_value xs) {
}
pit_value pit_contains_eq(pit_runtime *rt, pit_value needle, pit_value haystack) {
while (haystack != PIT_NIL) {
- if (pit_eq(needle, pit_car(rt, haystack))) return pit_intern_cstr(rt, "t");
+ if (pit_eq(needle, pit_car(rt, haystack))) return PIT_T;
+ haystack = pit_cdr(rt, haystack);
+ }
+ return PIT_NIL;
+}
+pit_value pit_contains_equal(pit_runtime *rt, pit_value needle, pit_value haystack) {
+ while (haystack != PIT_NIL) {
+ if (pit_equal(rt, needle, pit_car(rt, haystack))) return PIT_T;
haystack = pit_cdr(rt, haystack);
}
return PIT_NIL;
@@ -792,6 +898,12 @@ 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) {
+ if (pit_is_symbol(rt, f)) {
+ f = pit_fget(rt, f);
+ }
+ /* if f is not a symbol, assume it is a func or nativefunc
+ most commonly, this happens when you funcall a variable
+ with a function in the value cell, e.g. passing a lambda to a function */
switch (pit_value_sort(f)) {
case PIT_VALUE_SORT_REF: {
pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, f));
@@ -813,11 +925,11 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) {
pit_value nm = pit_car(rt, aform);
pit_value cell = pit_cdr(rt, aform);
if (h->in.func.arg_rest_nm != PIT_NIL && pit_eq(nm, h->in.func.arg_rest_nm)) {
- pit_cell_set(rt, cell, args);
+ pit_cell_set(rt, cell, args, nm);
pit_bind(rt, nm, cell);
break;
} else {
- pit_cell_set(rt, cell, pit_car(rt, args));
+ pit_cell_set(rt, cell, pit_car(rt, args), nm);
pit_bind(rt, nm, cell);
}
bound = pit_cons(rt, nm, bound);
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-09 08:06:05 +0000