From 09435bffe025a96e0d9c3b44ee9c505973b383bd Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Mon, 6 Oct 2025 05:06:16 -0400 Subject: Cleanup, fix bugs Ensure everything builds on C89 --- src/runtime.c | 530 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 285 insertions(+), 245 deletions(-) (limited to 'src/runtime.c') diff --git a/src/runtime.c b/src/runtime.c index 2d30420..6c9add8 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -12,7 +12,7 @@ #include "library.h" pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { - pit_arena *a = malloc(sizeof(pit_arena) + capacity * elem_size); + pit_arena *a = malloc(sizeof(pit_arena) + (size_t) capacity * (size_t) elem_size); a->elem_size = elem_size; a->capacity = capacity; a->next = 0; @@ -49,22 +49,26 @@ void *pit_arena_alloc_bulk(pit_arena *a, i64 num) { } enum pit_value_sort pit_value_sort(pit_value v) { - // if this isn't a NaN, or it's a quiet NaN, this is a real double - if (((v >> 52) & 0b011111111111) != 0b011111111111 || ((v >> 51) & 0b1) == 1) return PIT_VALUE_SORT_DOUBLE; - // otherwise, we've packed something else in the significand - // 0 for signaling NaN -+ - // sign --+ +- 1 (NaN)| +- our sort tag + our data - // | | | | | - // s111111111110ttddddddddddddddddddddddddddddddddddddddddddddddddd - return (v & 0b0000000000000110000000000000000000000000000000000000000000000000) >> 49; + /* if this isn't a NaN, or it's a quiet NaN, this is a real double */ + /* if (((v >> 52) & 0b011111111111) != 0b011111111111 || ((v >> 51) & 0b1) == 1) return PIT_VALUE_SORT_DOUBLE; */ + if (((v >> 52) & 0x7ff) != 0x7ff || ((v >> 51) & 1) == 1) return PIT_VALUE_SORT_DOUBLE; + /* otherwise, we've packed something else in the significand + 0 for signaling NaN -+ + sign --+ +- 1 (NaN)| +- our sort tag + our data + | | | | | + s111111111110ttddddddddddddddddddddddddddddddddddddddddddddddddd */ + /* return (v & 0b0000000000000110000000000000000000000000000000000000000000000000) >> 49; */ + return (v & 0x6000000000000) >> 49; /* equivalent hex literal */ } u64 pit_value_data(pit_value v) { - return v & 0b0000000000000001111111111111111111111111111111111111111111111111; + /* return v & 0b0000000000000001111111111111111111111111111111111111111111111111; */ + return v & 0x1ffffffffffff; } pit_runtime *pit_runtime_new() { pit_runtime *ret = malloc(sizeof(*ret)); + pit_value nil, truth; 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(1024, sizeof(pit_symtab_entry)); @@ -80,9 +84,9 @@ pit_runtime *pit_runtime_new() { ret->error = PIT_NIL; ret->source_line = ret->source_column = -1; ret->error_line = ret->error_column = -1; - pit_value nil = pit_intern_cstr(ret, "nil"); // nil must be the 0th symbol for PIT_NIL to work + nil = pit_intern_cstr(ret, "nil"); /* nil must be the 0th symbol for PIT_NIL to work */ pit_set(ret, nil, PIT_NIL); - pit_value truth = pit_intern_cstr(ret, "t"); + truth = pit_intern_cstr(ret, "t"); pit_set(ret, truth, truth); pit_install_library_essential(ret); pit_runtime_freeze(ret); @@ -114,34 +118,35 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { if (len <= 0) return 0; switch (pit_value_sort(v)) { case PIT_VALUE_SORT_DOUBLE: - return snprintf(buf, len, "%lf", pit_as_double(rt, v)); + return snprintf(buf, (size_t) len, "%lf", pit_as_double(rt, v)); case PIT_VALUE_SORT_INTEGER: - return snprintf(buf, len, "%ld", pit_as_integer(rt, v)); - case PIT_VALUE_SORT_SYMBOL: + return snprintf(buf, (size_t) len, "%ld", pit_as_integer(rt, v)); + case PIT_VALUE_SORT_SYMBOL: { pit_symtab_entry *ent = pit_symtab_lookup(rt, v); if (ent && pit_value_sort(ent->name) == PIT_VALUE_SORT_REF && (h = pit_deref(rt, pit_as_ref(rt, ent->name))) ) { i64 i = 0; - for (; i < h->bytes.len && i < len - 1; ++i) { - buf[i] = h->bytes.data[i]; + for (; i < h->in.bytes.len && i < len - 1; ++i) { + buf[i] = (char) h->in.bytes.data[i]; } return i; } else { - return snprintf(buf, len, "", pit_as_symbol(rt, v)); + return snprintf(buf, (size_t) len, "", pit_as_symbol(rt, v)); } - case PIT_VALUE_SORT_REF: + } + case PIT_VALUE_SORT_REF: { pit_ref r = pit_as_ref(rt, v); h = pit_deref(rt, r); - if (!h) snprintf(buf, len, "", r); + if (!h) snprintf(buf, (size_t) len, "", 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->cell), readable); + buf += pit_dump(rt, buf, end - buf, pit_car(rt, h->in.cell), readable); *(buf++) = '}'; return buf - start; } @@ -155,7 +160,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur), readable); if (buf >= end) return end - buf; } else { - buf += snprintf(buf, end - buf, " . "); + 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; @@ -165,23 +170,26 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { *(buf++) = ')'; return buf - start; } - case PIT_VALUE_HEAVY_SORT_BYTES: - i64 i = 0; + case PIT_VALUE_HEAVY_SORT_BYTES: { + i64 i, maxlen, j; + i = 0; if (readable) buf[i++] = '"'; - i64 maxlen = len - i; - for (i64 j = 0; i < maxlen && j < h->bytes.len;) { - if (buf[i - 1] != '\\' && (h->bytes.data[j] == '\\' || h->bytes.data[j] == '"')) + maxlen = len - i; + for (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++] = h->bytes.data[j++]; + else buf[i++] = (char) h->in.bytes.data[j++]; } if (readable && i < len - 1) buf[i++] = '"'; return i; + } default: - return snprintf(buf, len, "", r); + return snprintf(buf, (size_t) len, "", r); } } break; } + } return 0; } @@ -192,7 +200,7 @@ void pit_trace_(pit_runtime *rt, const char *format, pit_value v) { } void pit_error(pit_runtime *rt, const char *format, ...) { - if (pit_eq(rt->error, PIT_NIL)) { // only record the first error encountered + if (pit_eq(rt->error, PIT_NIL)) { /* only record the first error encountered */ char buf[1024] = {0}; va_list vargs; va_start(vargs, format); @@ -206,22 +214,26 @@ void pit_error(pit_runtime *rt, const char *format, ...) { pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data) { if (s == PIT_VALUE_SORT_DOUBLE) { - if (((data >> 52) & 0b011111111111) == 0b011111111111 && ((data >> 51) & 0b1) == 0) { + /* if (((data >> 52) & 0b011111111111) == 0b011111111111 && ((data >> 51) & 0b1) == 0) { */ + if (((data >> 52) & 0x7ff) == 0x7ff && ((data >> 51) & 1) == 0) { pit_error(rt, "attempted to create a signalling NaN double"); return PIT_NIL; } return data; } return - 0b1111111111110000000000000000000000000000000000000000000000000000 - | (((u64) (s & 0b11)) << 49) - | (data & 0b1111111111111111111111111111111111111111111111111); + /* 0b1111111111110000000000000000000000000000000000000000000000000000 */ + 0xfff0000000000000 + /* | (((u64) (s & 0b11)) << 49) */ + | (((u64) (s & 3)) << 49) + /* | (data & 0b1111111111111111111111111111111111111111111111111); */ + | (data & 0x1ffffffffffff); } double pit_as_double(pit_runtime *rt, pit_value v) { if (pit_value_sort(v) != PIT_VALUE_SORT_DOUBLE) { pit_error(rt, "invalid use of value as double"); - return NAN; + return 0.0; } return (double) v; } @@ -230,12 +242,14 @@ pit_value pit_double_new(pit_runtime *rt, double d) { } i64 pit_as_integer(pit_runtime *rt, pit_value v) { + u64 lo; if (pit_value_sort(v) != PIT_VALUE_SORT_INTEGER) { pit_error(rt, "invalid use of value as integer"); return -1; } - u64 lo = pit_value_data(v); - return ((i64) (lo << 15)) >> 15; // sign-extend low 49 bits + lo = pit_value_data(v); + return ((i64) (lo << 15)) >> 15; /* sign-extend low 49 bits */ + } pit_value pit_integer_new(pit_runtime *rt, i64 i) { return pit_value_new(rt, PIT_VALUE_SORT_INTEGER, (u64) i); @@ -246,7 +260,7 @@ pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v) { pit_error(rt, "invalid use of value as symbol"); return -1; } - return pit_value_data(v) & 0xffffffff; + return (pit_symbol) (pit_value_data(v) & 0xffffffff); } pit_value pit_symbol_new(pit_runtime *rt, pit_symbol s) { return pit_value_new(rt, PIT_VALUE_SORT_SYMBOL, (u64) s); @@ -257,7 +271,7 @@ pit_ref pit_as_ref(pit_runtime *rt, pit_value v) { pit_error(rt, "invalid use of value as ref"); return -1; } - return pit_value_data(v) & 0xffffffff; + return (pit_ref) (pit_value_data(v) & 0xffffffff); } pit_value pit_ref_new(pit_runtime *rt, pit_ref r) { return pit_value_new(rt, PIT_VALUE_SORT_REF, (u64) r); @@ -286,10 +300,11 @@ bool pit_is_symbol(pit_runtime *rt, pit_value a) { } bool pit_is_value_heavy_sort(pit_runtime *rt, pit_value a, enum pit_value_heavy_sort e) { switch (pit_value_sort(a)) { - case PIT_VALUE_SORT_REF: - pit_value_heavy *ha = pit_deref(rt, a); + case PIT_VALUE_SORT_REF: { + pit_value_heavy *ha = pit_deref(rt, pit_as_ref(rt, a)); if (!ha) { pit_error(rt, "bad ref"); return false; } return ha->hsort == e; + } default: break; } @@ -323,135 +338,159 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { case PIT_VALUE_SORT_INTEGER: case PIT_VALUE_SORT_SYMBOL: return pit_value_data(a) == pit_value_data(b); - case PIT_VALUE_SORT_REF: - pit_value_heavy *ha = pit_deref(rt, a); + case PIT_VALUE_SORT_REF: { + pit_value_heavy *ha, *hb; + ha = pit_deref(rt, pit_as_ref(rt, a)); if (!ha) { pit_error(rt, "bad ref"); return false; } - pit_value_heavy *hb = pit_deref(rt, b); + hb = pit_deref(rt, pit_as_ref(rt, b)); if (!hb) { pit_error(rt, "bad ref"); return false; } if (ha->hsort != hb->hsort) return false; switch (ha->hsort) { case PIT_VALUE_HEAVY_SORT_CELL: - return pit_equal(rt, ha->cell, hb->cell); + return pit_equal(rt, ha->in.cell, hb->in.cell); case PIT_VALUE_HEAVY_SORT_CONS: - return pit_equal(rt, ha->cons.car, hb->cons.car) && pit_equal(rt, ha->cons.cdr, hb->cons.cdr); - case PIT_VALUE_HEAVY_SORT_ARRAY: - if (ha->array.len != hb->array.len) return false; - for (i64 i = 0; i < ha->array.len; ++i) { - if (!pit_equal(rt, ha->array.data[i], hb->array.data[i])) return false; + return pit_equal(rt, ha->in.cons.car, hb->in.cons.car) + && pit_equal(rt, ha->in.cons.cdr, hb->in.cons.cdr); + case PIT_VALUE_HEAVY_SORT_ARRAY: { + i64 i = 0; + if (ha->in.array.len != hb->in.array.len) return false; + for (i = 0; i < ha->in.array.len; ++i) { + if (!pit_equal(rt, ha->in.array.data[i], hb->in.array.data[i])) return false; } return true; - case PIT_VALUE_HEAVY_SORT_BYTES: - if (ha->bytes.len != hb->bytes.len) return false; - for (i64 i = 0; i < ha->bytes.len; ++i) { - if (ha->bytes.data[i] != hb->bytes.data[i]) return false; + } + case PIT_VALUE_HEAVY_SORT_BYTES: { + i64 i = 0; + if (ha->in.bytes.len != hb->in.bytes.len) return false; + for (i = 0; i < ha->in.bytes.len; ++i) { + if (ha->in.bytes.data[i] != hb->in.bytes.data[i]) return false; } return true; + } case PIT_VALUE_HEAVY_SORT_FUNC: return - pit_equal(rt, ha->func.env, hb->func.env) - && pit_equal(rt, ha->func.args, hb->func.args) - && pit_equal(rt, ha->func.body, hb->func.body); + pit_equal(rt, ha->in.func.env, hb->in.func.env) + && pit_equal(rt, ha->in.func.args, hb->in.func.args) + && pit_equal(rt, ha->in.func.body, hb->in.func.body); case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: - return ha->nativefunc == hb->nativefunc; + return ha->in.nativefunc == hb->in.nativefunc; } } + } return false; } pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len) { + pit_value ret; + pit_value_heavy *h; u8 *dest = pit_arena_alloc_bulk(rt->bytes, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); return PIT_NIL; } - memcpy(dest, buf, len); - pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + memcpy(dest, buf, (size_t) len); + ret = pit_heavy_new(rt); + h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; - h->bytes.data = dest; - h->bytes.len = len; + h->in.bytes.data = dest; + h->in.bytes.len = len; return ret; } pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s) { - return pit_bytes_new(rt, (u8 *) s, strlen(s)); + return pit_bytes_new(rt, (u8 *) s, (i64) strlen(s)); } pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { FILE *f = fopen(path, "r"); + i64 len; + u8 *dest; + pit_value ret; + pit_value_heavy *h; if (f == NULL) { pit_error(rt, "failed to open file: %s", path); return PIT_NIL; } fseek(f, 0, SEEK_END); - i64 len = ftell(f); + len = ftell(f); fseek(f, 0, SEEK_SET); - u8 *dest = pit_arena_alloc_bulk(rt->bytes, len); + dest = pit_arena_alloc_bulk(rt->bytes, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; } - fread(dest, sizeof(char), len, f); + if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) { + fclose(f); + pit_error(rt, "failed to read file: %s", path); + return PIT_NIL; + } fclose(f); - pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + ret = pit_heavy_new(rt); + h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; - h->bytes.data = dest; - h->bytes.len = len; + h->in.bytes.data = dest; + h->in.bytes.len = len; return ret; } -// return true if v is a reference to bytes that are the same as those in buf +/* return true if v is a reference to bytes that are the same as those in buf */ bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len) { + pit_value_heavy *h; + i64 i; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return false; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return false; } if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) return false; - if (h->bytes.len != len) return false; - for (i64 i = 0; i < len; ++i) - if (h->bytes.data[i] != buf[i]) { + if (h->in.bytes.len != len) return false; + for (i = 0; i < len; ++i) + if (h->in.bytes.data[i] != buf[i]) { return false; } return true; } i64 pit_as_bytes(pit_runtime *rt, pit_value v, u8 *buf, i64 maxlen) { + pit_value_heavy *h; + i64 len, i; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return -1; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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) { pit_error(rt, "invalid use of value as bytes"); return -1; } - i64 len = maxlen < h->bytes.len ? maxlen : h->bytes.len; - for (i64 i = 0; i < len; ++i) { - buf[i] = h->bytes.data[i]; + len = maxlen < h->in.bytes.len ? maxlen : h->in.bytes.len; + for (i = 0; i < len; ++i) { + buf[i] = h->in.bytes.data[i]; } return len; } bool pit_lexer_from_bytes(pit_runtime *rt, pit_lexer *ret, pit_value v) { + pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return false; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return false; } if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) { pit_error(rt, "invalid use of value as bytes"); return -1; } - pit_lex_bytes(ret, (char *) h->bytes.data, h->bytes.len); + pit_lex_bytes(ret, (char *) h->in.bytes.data, h->in.bytes.len); return true; } -pit_value pit_read_bytes(pit_runtime *rt, pit_value v) { // read a single lisp form from a bytestring +pit_value pit_read_bytes(pit_runtime *rt, pit_value v) { /* read a single lisp form from a bytestring */ pit_lexer lex; + pit_parser parse; if (!pit_lexer_from_bytes(rt, &lex, v)) { pit_error(rt, "failed to initialize lexer"); return PIT_NIL; } - pit_parser parse; pit_parser_from_lexer(&parse, &lex); - pit_value program = pit_parse(rt, &parse, NULL); - return pit_eval(rt, program); + return pit_parse(rt, &parse, NULL); } pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { - for (i64 i = 0; i < rt->symtab_len; ++i) { - pit_symbol idx = i * sizeof(pit_symtab_entry); - pit_symtab_entry *ent = pit_arena_idx(rt->symtab, idx); - if (!ent) { pit_error(rt, "corrupted symbol table"); return PIT_NIL; } - if (pit_bytes_match(rt, ent->name, nm, len)) return pit_symbol_new(rt, idx); - } - i64 idx = pit_arena_alloc_idx(rt->symtab); - pit_symtab_entry *ent = pit_arena_idx(rt->symtab, idx); + i64 i; + i32 idx; + pit_symtab_entry *ent; + for (i = 0; i < rt->symtab_len; ++i) { + pit_symbol sidx = (pit_symbol) (i * (i64) sizeof(pit_symtab_entry)); + pit_symtab_entry *sent = pit_arena_idx(rt->symtab, sidx); + if (!sent) { pit_error(rt, "corrupted symbol table"); return PIT_NIL; } + if (pit_bytes_match(rt, sent->name, nm, len)) return pit_symbol_new(rt, sidx); + } + idx = pit_arena_alloc_idx(rt->symtab); + ent = pit_arena_idx(rt->symtab, idx); if (!ent) { pit_error(rt, "failed to allocate symtab entry"); return PIT_NIL; } ent->name = pit_bytes_new(rt, nm, len); ent->value = PIT_NIL; @@ -461,14 +500,8 @@ pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { rt->symtab_len += 1; return pit_symbol_new(rt, idx); } - pit_value pit_intern_cstr(pit_runtime *rt, char *nm) { - return pit_intern(rt, (u8 *) nm, strlen(nm)); -} - -pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym) { - pit_symbol s = pit_as_symbol(rt, sym); - return pit_arena_idx(rt->symtab, s); + return pit_intern(rt, (u8 *) nm, (i64) strlen(nm)); } bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); @@ -476,7 +509,11 @@ bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) { return pit_bytes_match(rt, ent->name, buf, len); } bool pit_symbol_name_match_cstr(pit_runtime *rt, pit_value sym, char *s) { - return pit_symbol_name_match(rt, sym, (u8 *) s, strlen(s)); + return pit_symbol_name_match(rt, sym, (u8 *) s, (i64) strlen(s)); +} +pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym) { + pit_symbol s = pit_as_symbol(rt, sym); + return pit_arena_idx(rt->symtab, s); } pit_value pit_get_value_cell(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); @@ -493,8 +530,9 @@ pit_value pit_get(pit_runtime *rt, pit_value sym) { } void pit_set(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol idx = pit_as_symbol(rt, sym); + pit_symtab_entry *ent; if (idx < rt->frozen_symtab) { pit_error(rt, "attempted to modify frozen symbol"); return; } - pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } if (pit_value_sort(ent->value) != PIT_VALUE_SORT_REF) { ent->value = pit_cell_new(rt, PIT_NIL); @@ -506,8 +544,9 @@ pit_value pit_fget(pit_runtime *rt, pit_value sym) { } void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol idx = pit_as_symbol(rt, sym); + pit_symtab_entry *ent; if (idx < rt->frozen_symtab) { pit_error(rt, "attempted to modify frozen symbol"); return; } - pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } if (pit_value_sort(ent->function) != PIT_VALUE_SORT_REF) { ent->function = pit_cell_new(rt, PIT_NIL); @@ -543,7 +582,7 @@ void pit_sfset(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol_is_special_form(rt, sym); } void pit_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 + /* 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; } pit_values_push(rt, rt->saved_bindings, ent->value); @@ -551,104 +590,115 @@ void pit_bind(pit_runtime *rt, pit_value sym, pit_value cell) { } pit_value pit_unbind(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + pit_value old; if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; } - pit_value old = ent->value; + old = ent->value; ent->value = pit_values_pop(rt, rt->saved_bindings); return old; } pit_value pit_cell_new(pit_runtime *rt, pit_value v) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for cell"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_CELL; - h->cell = v; + h->in.cell = v; return ret; } pit_value pit_cell_get(pit_runtime *rt, pit_value cell) { + pit_value_heavy *h; if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) { pit_error(rt, "attempted to get cell value that is not ref"); return PIT_NIL; } - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, cell)); + h = pit_deref(rt, pit_as_ref(rt, cell)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CELL) { pit_error(rt, "cell value ref does not point to cell"); return PIT_NIL; } - return h->cell; + return h->in.cell; } void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v) { + pit_ref idx; + pit_value_heavy *h; if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) { pit_error(rt, "attempted to set cell value that is not ref"); return; } - pit_ref idx = pit_as_ref(rt, cell); + idx = pit_as_ref(rt, cell); if (idx < rt->frozen_values) { pit_error(rt, "attempt to modify frozen cell"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CELL) { pit_error(rt, "cell value ref does not point to cell"); return; } - h->cell = v; + h->in.cell = 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, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for cons"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_CONS; - h->cons.car = car; - h->cons.cdr = cdr; + h->in.cons.car = car; + h->in.cons.cdr = cdr; return ret; } pit_value pit_list(pit_runtime *rt, i64 num, ...) { pit_value temp[64]; - if (num > 64) { pit_error(rt, "failed to create list of size %d\n", num); return PIT_NIL; } va_list elems; + i64 i; + pit_value ret = PIT_NIL; + if (num > 64) { pit_error(rt, "failed to create list of size %d\n", num); return PIT_NIL; } va_start(elems, num); - for (i64 i = 0; i < num; ++i) { + for (i = 0; i < num; ++i) { temp[i] = va_arg(elems, pit_value); } va_end(elems); - pit_value ret = PIT_NIL; - for (i64 i = 0; i < num; ++i) { + for (i = 0; i < num; ++i) { ret = pit_cons(rt, temp[num - i - 1], ret); } return ret; } pit_value pit_car(pit_runtime *rt, pit_value v) { + pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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_CONS) return PIT_NIL; - return h->cons.car; + return h->in.cons.car; } pit_value pit_cdr(pit_runtime *rt, pit_value v) { + pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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_CONS) return PIT_NIL; - return h->cons.cdr; + return h->in.cons.cdr; } void pit_setcar(pit_runtime *rt, pit_value v, pit_value x) { + pit_ref idx; + pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return; } - pit_ref idx = pit_as_ref(rt, v); + idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) { pit_error(rt, "not a cons"); return; } - h->cons.car = x; + h->in.cons.car = x; } void pit_setcdr(pit_runtime *rt, pit_value v, pit_value x) { + pit_ref idx; + pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return; } - pit_ref idx = pit_as_ref(rt, v); + idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) { pit_error(rt, "not a cons"); return; } - h->cons.cdr = x; + h->in.cons.cdr = x; } pit_value pit_append(pit_runtime *rt, pit_value xs, pit_value ys) { pit_value ret = ys; @@ -675,9 +725,8 @@ pit_value pit_contains_eq(pit_runtime *rt, pit_value needle, pit_value haystack) return PIT_NIL; } -pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body) { +pit_value pit_free_vars(pit_runtime *rt, pit_value bound, pit_value body) { i64 expr_stack_reset = rt->expr_stack->top; - pit_value bound = args; pit_value ret = PIT_NIL; pit_values_push(rt, rt->expr_stack, body); while (rt->expr_stack->top > 0) { @@ -685,16 +734,16 @@ pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body) { if (pit_is_cons(rt, cur)) { pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); - pit_value args = pit_cdr(rt, cur); + 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, args), bound); + bound = pit_append(rt, pit_car(rt, fargs), bound); } 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! + /* don't look inside quote! + if we add other special forms, make sure to consider them here if necessary! */ } else { - while (args != PIT_NIL) { - pit_values_push(rt, rt->expr_stack, pit_car(rt, args)); - args = pit_cdr(rt, args); + while (fargs != PIT_NIL) { + pit_values_push(rt, rt->expr_stack, pit_car(rt, fargs)); + fargs = pit_cdr(rt, fargs); } if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); @@ -711,11 +760,12 @@ pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body) { } pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); + pit_value expanded, freevars, env, arg_cells; if (!h) { pit_error(rt, "failed to create new heavy value for lambda"); return PIT_NIL; } - pit_value expanded = pit_expand_macros(rt, pit_cons(rt, pit_intern_cstr(rt, "progn"), body)); - pit_value freevars = pit_free_vars(rt, args, expanded); - pit_value env = PIT_NIL; + expanded = pit_expand_macros(rt, pit_cons(rt, pit_intern_cstr(rt, "progn"), body)); + freevars = pit_free_vars(rt, args, expanded); + env = PIT_NIL; while (freevars != PIT_NIL) { pit_value sym = pit_car(rt, freevars); pit_value cell = pit_get_value_cell(rt, sym); @@ -723,7 +773,7 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { freevars = pit_cdr(rt, freevars); } h->hsort = PIT_VALUE_HEAVY_SORT_FUNC; - pit_value arg_cells = PIT_NIL; + arg_cells = PIT_NIL; while (args != PIT_NIL) { pit_value nm = pit_car(rt, args); pit_value ent = pit_cons(rt, nm, pit_cell_new(rt, PIT_NIL)); @@ -731,37 +781,38 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { args = pit_cdr(rt, args); } arg_cells = pit_reverse(rt, arg_cells); - h->func.args = arg_cells; - h->func.env = env; - h->func.body = expanded; + h->in.func.args = arg_cells; + h->in.func.env = env; + h->in.func.body = expanded; return ret; } pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for nativefunc"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_NATIVEFUNC; - h->nativefunc = f; + h->in.nativefunc = f; return ret; } pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { switch (pit_value_sort(f)) { - case PIT_VALUE_SORT_REF: + case PIT_VALUE_SORT_REF: { pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, f)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort == PIT_VALUE_HEAVY_SORT_FUNC) { - // calling a Lisp function is simple! + /* calling a Lisp function is simple! */ pit_value bound = PIT_NIL; - pit_value env = h->func.env; - while (env != PIT_NIL) { // first, bind all entries in the closure + pit_value env = h->in.func.env; + pit_value anames, ret; + while (env != PIT_NIL) { /* first, bind all entries in the closure */ pit_value b = pit_car(rt, env); pit_value nm = pit_car(rt, b); pit_bind(rt, nm, pit_cdr(rt, b)); bound = pit_cons(rt, nm, bound); env = pit_cdr(rt, env); } - pit_value anames = h->func.args; - while (anames != PIT_NIL) { // bind all argument names to their values + 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); @@ -771,19 +822,20 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { args = pit_cdr(rt, args); anames = pit_cdr(rt, anames); } - pit_value ret = pit_eval(rt, h->func.body); // evaluate the body - while (bound != PIT_NIL) { // unbind everything we bound earlier, in reverse + ret = pit_eval(rt, h->in.func.body); /* evaluate the body */ + while (bound != PIT_NIL) { /* unbind everything we bound earlier, in reverse */ pit_unbind(rt, pit_car(rt, bound)); bound = pit_cdr(rt, bound); } return ret; } else if (h->hsort == PIT_VALUE_HEAVY_SORT_NATIVEFUNC) { - // calling native functions is even simpler - return h->nativefunc(rt, args); + /* calling native functions is even simpler */ + return h->in.nativefunc(rt, args); } else { pit_error(rt, "attempt to apply non-nativefunc ref"); return PIT_NIL; } + } default: pit_error(rt, "attempted to apply non-function value"); return PIT_NIL; @@ -791,8 +843,8 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { } pit_values *pit_values_new(i64 capacity) { - i64 cap = capacity / sizeof(pit_value); - pit_values *ret = malloc(sizeof(*ret) + cap * sizeof(pit_value)); + i64 cap = capacity / (i64) sizeof(pit_value); + pit_values *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_value)); ret->top = 0; ret->cap = cap; return ret; @@ -808,26 +860,37 @@ pit_value pit_values_pop(pit_runtime *rt, pit_values *s) { } pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity) { - i64 cap = capacity / sizeof(pit_runtime_eval_program_entry); - pit_runtime_eval_program *ret = malloc(sizeof(*ret) + cap * sizeof(pit_runtime_eval_program_entry)); + i64 cap = capacity / (i64) sizeof(pit_runtime_eval_program_entry); + pit_runtime_eval_program *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_runtime_eval_program_entry)); ret->top = 0; ret->cap = cap; return ret; } -void pit_runtime_eval_program_push(pit_runtime *rt, pit_runtime_eval_program *s, pit_runtime_eval_program_entry x) { +void pit_runtime_eval_program_push_literal(pit_runtime *rt, pit_runtime_eval_program *s, pit_value x) { + pit_runtime_eval_program_entry *ent = &s->data[s->top++]; + ent->sort = EVAL_PROGRAM_ENTRY_LITERAL; + ent->in.literal = x; + if (s->top >= s->cap) { pit_error(rt, "evaluation program overflow"); } (void) rt; - s->data[s->top++] = x; +} +void pit_runtime_eval_program_push_apply(pit_runtime *rt, pit_runtime_eval_program *s, i64 arity) { + pit_runtime_eval_program_entry *ent = &s->data[s->top++]; + ent->sort = EVAL_PROGRAM_ENTRY_APPLY; + ent->in.apply = arity; if (s->top >= s->cap) { pit_error(rt, "evaluation program overflow"); } + (void) rt; } pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { i64 expr_stack_reset = rt->expr_stack->top; i64 result_stack_reset = rt->result_stack->top; i64 program_reset = rt->program->top; + i64 idx; pit_values_push(rt, rt->expr_stack, top); while (rt->expr_stack->top > expr_stack_reset) { + pit_value cur; if (rt->error != PIT_NIL) goto end; - pit_value cur = pit_values_pop(rt, rt->expr_stack); + cur = pit_values_pop(rt, rt->expr_stack); if (pit_is_cons(rt, cur)) { pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); @@ -838,35 +901,23 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { pit_values_push(rt, rt->expr_stack, res); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "defer")) { pit_value args = pit_cdr(rt, cur); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_car(rt, args), - }); + pit_runtime_eval_program_push_literal(rt, rt->program, pit_car(rt, args)); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "quote")) { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "lambda")) { pit_value args = pit_cdr(rt, cur); pit_value bindings = pit_car(rt, args); pit_value body = pit_cdr(rt, args); - pit_values_push(rt, rt->expr_stack, pit_list(rt, 2, pit_intern_cstr(rt, "defer"), bindings)); i64 argcount = 0; + pit_values_push(rt, rt->expr_stack, pit_list(rt, 2, pit_intern_cstr(rt, "defer"), bindings)); while (body != PIT_NIL) { pit_value a = pit_car(rt, body); pit_values_push(rt, rt->expr_stack, a); body = pit_cdr(rt, body); argcount += 1; } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount + 1, - }); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = fsym, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount + 1); + pit_runtime_eval_program_push_literal(rt, rt->program, fsym); } else { pit_value args = pit_cdr(rt, cur); i64 argcount = 0; @@ -879,76 +930,73 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount); if (is_symbol) { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = fsym, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, fsym); } } } else { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } } - for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { + for (idx = rt->program->top - 1; idx >= program_reset; --idx) { + pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; - pit_runtime_eval_program_entry *ent = &rt->program->data[idx]; + ent = &rt->program->data[idx]; switch (ent->sort) { case EVAL_PROGRAM_ENTRY_LITERAL: - pit_values_push(rt, rt->result_stack, ent->literal); + pit_values_push(rt, rt->result_stack, ent->in.literal); break; - case EVAL_PROGRAM_ENTRY_APPLY: + case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - for (i64 i = 0; i < ent->apply; ++i) { + i64 i; + for (i = 0; i < ent->in.apply; ++i) { args = pit_cons(rt, pit_values_pop(rt, rt->result_stack), args); } pit_values_push(rt, rt->result_stack, pit_cons(rt, f, args)); break; + } default: pit_error(rt, "unknown program entry"); goto end; } } -end: - pit_value ret = pit_values_pop(rt, rt->result_stack); - rt->expr_stack->top = expr_stack_reset; - rt->result_stack->top = result_stack_reset; - rt->program->top = program_reset; - return ret; +end: { + pit_value ret = pit_values_pop(rt, rt->result_stack); + rt->expr_stack->top = expr_stack_reset; + rt->result_stack->top = result_stack_reset; + rt->program->top = program_reset; + return ret; + } } pit_value pit_eval(pit_runtime *rt, pit_value top) { i64 expr_stack_reset = rt->expr_stack->top; i64 result_stack_reset = rt->result_stack->top; i64 program_reset = rt->program->top; + i64 idx; pit_values_push(rt, rt->expr_stack, top); - // first, convert the expression tree into "polish notation" in program + /* first, convert the expression tree into "polish notation" in program */ while (rt->expr_stack->top > expr_stack_reset) { + pit_value cur; if (rt->error != PIT_NIL) goto end; - pit_value cur = pit_values_pop(rt, rt->expr_stack); - if (pit_is_cons(rt, cur)) { // compound expressions: function/macro application special forms + cur = pit_values_pop(rt, rt->expr_stack); + if (pit_is_cons(rt, cur)) { /* compound expressions: function/macro application special forms */ pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); - if (is_symbol && pit_is_symbol_special_form(rt, fsym)) { // special forms + if (is_symbol && pit_is_symbol_special_form(rt, fsym)) { /* special forms */ pit_value f = pit_fget(rt, fsym); pit_value args = pit_cdr(rt, cur); - // special forms are nativefuncs that directly manipulate the stacks - // basically macros, but we don't need to evaluate the return value + /* special forms are nativefuncs that directly manipulate the stacks + basically macros, but we don't need to evaluate the return value */ pit_apply(rt, f, args); - } else if (is_symbol && pit_is_symbol_macro(rt, fsym)) { // macros + } else if (is_symbol && pit_is_symbol_macro(rt, fsym)) { /* macros */ pit_value f = pit_fget(rt, fsym); pit_value args = pit_cdr(rt, cur); pit_value res = pit_apply(rt, f, args); pit_values_push(rt, rt->expr_stack, res); - } else { // normal functions + } else { /* normal functions */ pit_value args = pit_cdr(rt, cur); i64 argcount = 0; while (args != PIT_NIL) { @@ -959,56 +1007,48 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount); if (is_symbol) { pit_value f = pit_fget(rt, fsym); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = f, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, f); } } - } else if (pit_is_symbol(rt, cur)) { // unquoted symbols: variable lookup - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_get(rt, cur), - }); - } else { // other expressions evaluate to themselves! - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + } else if (pit_is_symbol(rt, cur)) { /* unquoted symbols: variable lookup */ + pit_runtime_eval_program_push_literal(rt, rt->program, pit_get(rt, cur)); + } else { /* other expressions evaluate to themselves! */ + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } } - // then, execute the polish notation program from right to left - // this has the nice consequence of putting the arguments in the right order - for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { + /* then, execute the polish notation program from right to left + this has the nice consequence of putting the arguments in the right order */ + for (idx = rt->program->top - 1; idx >= program_reset; --idx) { + pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; - pit_runtime_eval_program_entry *ent = &rt->program->data[idx]; + ent = &rt->program->data[idx]; switch (ent->sort) { case EVAL_PROGRAM_ENTRY_LITERAL: - pit_values_push(rt, rt->result_stack, ent->literal); + pit_values_push(rt, rt->result_stack, ent->in.literal); break; - case EVAL_PROGRAM_ENTRY_APPLY: + case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - for (i64 i = 0; i < ent->apply; ++i) { + i64 i; + for (i = 0; i < ent->in.apply; ++i) { args = pit_cons(rt, pit_values_pop(rt, rt->result_stack), args); } pit_values_push(rt, rt->result_stack, pit_apply(rt, f, args)); break; + } default: pit_error(rt, "unknown program entry"); goto end; } } -end: - pit_value ret = pit_values_pop(rt, rt->result_stack); - rt->expr_stack->top = expr_stack_reset; - rt->result_stack->top = result_stack_reset; - rt->program->top = program_reset; - return ret; +end: { + pit_value ret = pit_values_pop(rt, rt->result_stack); + rt->expr_stack->top = expr_stack_reset; + rt->result_stack->top = result_stack_reset; + rt->program->top = program_reset; + return ret; + } } -- cgit v1.2.3