From 4c04e7107829951673840ad8d97a16ab7599bb5c Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Tue, 20 Jan 2026 01:23:52 -0800 Subject: [PATCH] Add eval --- src/base.c | 28 ++++++++++++++++++-------- src/base.h | 34 ++++++++++++++++++++++++++----- src/function.c | 33 +++++++++++++++++++----------- src/gc.h | 2 +- src/gen-init-globals.awk | 5 +++++ src/lisp.c | 43 ++++++++++++++++++++++++++++++++++++++++ src/lisp.h | 2 ++ src/list.c | 9 ++++++++- src/list.h | 7 +++++++ src/main.c | 2 +- src/stack.c | 13 +++++++----- 11 files changed, 145 insertions(+), 33 deletions(-) diff --git a/src/base.c b/src/base.c index 1612723..dfb0d60 100644 --- a/src/base.c +++ b/src/base.c @@ -22,14 +22,14 @@ void *lisp_alloc_object(size_t size, LispValType type) { LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size); obj->type = type; obj->gc.mark = false; - obj->gc.local_ref_count = 0; + obj->gc.has_local_ref = false; // TODO set the below obj->gc.entry = NULL; return obj; } -void signal_type_error(LispVal *obj, size_t count, - const LispValType types[count]) { +void internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count, + const LispValType types[count]) { // TODO actually throw an error fprintf(stderr, "Type error! Got: %s | Expected: (or ", LISP_TYPE_NAMES[TYPE_OF(obj)]); @@ -40,15 +40,19 @@ void signal_type_error(LispVal *obj, size_t count, abort(); } +noreturn void signal_type_error(LispVal *obj, LispVal *typespec) { + // TODO actually throw an error + fprintf(stderr, + "Type error! Got: %s | Expected: ", LISP_TYPE_NAMES[TYPE_OF(obj)]); + debug_print(stderr, typespec); + fputc('\n', stderr); + abort(); +} + DEFINE_SYMBOL(nil, "nil"); DEFINE_SYMBOL(t, "t"); DEFINE_SYMBOL(unbound, "unbound"); -DEFINE_SYMBOL(quote, "quote"); -DEFINE_SYMBOL(backquote, "`"); -DEFINE_SYMBOL(comma, ","); -DEFINE_SYMBOL(comma_at, ",@"); - DEFUN(id, "id", (LispVal * obj), "(id)", "") { // TODO not all values are handled here return MAKE_FIXNUM((uintptr_t) obj); @@ -58,6 +62,10 @@ DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") { return obj1 == obj2 ? Qt : Qnil; } +DEFSPECIAL(quote, "quote", (LispVal * form), "(form)", "") { + return form; +} + // ################ // # Constructors # // ################ @@ -109,3 +117,7 @@ DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve), } return sym; } + +DEFINE_SYMBOL(backquote, "`"); +DEFINE_SYMBOL(comma, ","); +DEFINE_SYMBOL(comma_at, ",@"); diff --git a/src/base.h b/src/base.h index a1e36ed..735f660 100644 --- a/src/base.h +++ b/src/base.h @@ -111,6 +111,17 @@ static ALWAYS_INLINE bool OBJECT_MARKED_P(LispVal *val) { return ((LispObject *) val)->gc.mark; } +static ALWAYS_INLINE void SET_OBJECT_HAS_LOCAL_REFERENCE(LispVal *val, + bool has_local_ref) { + assert(OBJECTP(val)); + ((LispObject *) val)->gc.has_local_ref = has_local_ref; +} + +static ALWAYS_INLINE bool OBJECT_HAS_LOCAL_REFERENCE_P(LispVal *val) { + assert(OBJECTP(val)); + return ((LispObject *) val)->gc.has_local_ref; +} + static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) { if (FIXNUMP(val)) { return TYPE_FIXNUM; @@ -131,8 +142,9 @@ static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) { } } -noreturn void signal_type_error(LispVal *obj, size_t count, - const LispValType types[count]); +noreturn void +internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count, + const LispValType types[count]); static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count, LispValType v1, LispValType v2, LispValType v3, LispValType v4, @@ -144,7 +156,7 @@ static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count, } } // Failed - signal_type_error(obj, count, types); + internal_CHECK_TYPE_signal_type_error(obj, count, types); } #define internal_CHECK_TYPE1(obj, type) internal_CHECK_TYPE(obj, v1, ) #define internal_CHECK_TYPE_SUB(obj, count, a1, a2, a3, a4, a5, a6, ...) \ @@ -154,6 +166,8 @@ static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count, TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM, \ TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM) +noreturn void signal_type_error(LispVal *obj, LispVal *typespec); + #define DEFOBJTYPE(Name, NAME, NAME_P, body) \ typedef struct { \ LispObject header; \ @@ -218,6 +232,8 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, { const size_t internal_F##cname##_docstr_len = sizeof(doc) - 1; \ LispVal *Q##cname; \ LispVal *F##cname cargs +#define DEFSPECIAL(cname, lisp_name, cargs, lisp_args, doc) \ + DEFUN(cname, lisp_name, cargs, lisp_args, doc) #define REGISTER_GLOBAL_SYMBOL(cname) \ { \ @@ -231,6 +247,14 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, { ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \ } +#define REGISTER_GLOBAL_SPECIAL(cname) \ + { \ + REGISTER_GLOBAL_SYMBOL(cname); \ + ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \ + ((LispFunction *) ((LispSymbol *) Q##cname)->function) \ + ->flags.no_eval_args = true; \ + } + DECLARE_SYMBOL(nil); DECLARE_SYMBOL(t); DECLARE_SYMBOL(unbound); @@ -242,6 +266,7 @@ static ALWAYS_INLINE bool NILP(LispVal *val) { // Some core functions DECLARE_FUNCTION(id, (LispVal * obj)); DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2)); +DECLARE_FUNCTION(quote, (LispVal * form)); // TODO probably move these to another file LispVal *make_vector(LispVal **data, size_t length, bool take); @@ -249,8 +274,7 @@ DECLARE_FUNCTION(make_symbol, (LispVal * name)); DECLARE_FUNCTION(intern, (LispVal * name)); DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve)); -// TODO these are actually special-forms -DECLARE_SYMBOL(quote); +// Defined in lisp code (eventually) but used in read.c DECLARE_SYMBOL(backquote); DECLARE_SYMBOL(comma); DECLARE_SYMBOL(comma_at); diff --git a/src/function.c b/src/function.c index a6a4c7f..f6c461e 100644 --- a/src/function.c +++ b/src/function.c @@ -226,37 +226,44 @@ call_simple_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) { fprintf(stderr, "Wrong arg count!!\n"); abort(); } + LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS]; + size_t acount = 0; FOREACH(args, arg) { - add_local_reference(arg); + if (fobj->flags.no_eval_args) { + arg_arr[acount] = arg; + } else { + arg_arr[acount] = Feval(arg); + } + add_local_reference(arg_arr[acount++]); } LispVal *retval; - switch (fobj->args.n_req) { + switch (acount) { case 0: retval = fobj->impl.native.zero(); break; case 1: - retval = fobj->impl.native.one(FIRST(args)); + retval = fobj->impl.native.one(arg_arr[0]); break; case 2: - retval = fobj->impl.native.two(FIRST(args), SECOND(args)); + retval = fobj->impl.native.two(arg_arr[0], arg_arr[1]); break; case 3: - retval = - fobj->impl.native.three(FIRST(args), SECOND(args), THIRD(args)); + retval = fobj->impl.native.three(arg_arr[0], arg_arr[1], arg_arr[2]); break; case 4: - retval = fobj->impl.native.four(FIRST(args), SECOND(args), THIRD(args), - FOURTH(args)); + retval = fobj->impl.native.four(arg_arr[0], arg_arr[1], arg_arr[2], + arg_arr[3]); break; case 5: - retval = fobj->impl.native.five(FIRST(args), SECOND(args), THIRD(args), - FOURTH(args), FIFTH(args)); + retval = fobj->impl.native.five(arg_arr[0], arg_arr[1], arg_arr[2], + arg_arr[3], arg_arr[4]); break; default: abort(); } the_stack.nogc_retval = retval; pop_stack_frame(); + add_local_reference(the_stack.nogc_retval); return retval; } @@ -351,9 +358,10 @@ call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) { for (intptr_t i = 0; i < count; ++i) { if (!arg_arr[i]) { arg_arr[i] = Qnil; - } else { - add_local_reference(arg_arr[i]); + } else if (!fobj->flags.no_eval_args) { + arg_arr[i] = Feval(arg_arr[i]); } + add_local_reference(arg_arr[i]); } LispVal *retval; switch (count) { @@ -382,6 +390,7 @@ call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) { } the_stack.nogc_retval = retval; pop_stack_frame(); + add_local_reference(the_stack.nogc_retval); return retval; } diff --git a/src/gc.h b/src/gc.h index 6c43239..656f132 100644 --- a/src/gc.h +++ b/src/gc.h @@ -11,7 +11,7 @@ typedef struct GCEntry { typedef struct { unsigned int mark : 1; - unsigned int local_ref_count : 7; + unsigned int has_local_ref : 1; GCEntry *entry; } ObjectGCInfo; diff --git a/src/gen-init-globals.awk b/src/gen-init-globals.awk index c18ce3f..c381729 100644 --- a/src/gen-init-globals.awk +++ b/src/gen-init-globals.awk @@ -76,6 +76,11 @@ function maybe_emit_next_symbol(entity) { maybe_emit_next_symbol("FUNCTION") } +/DEFSPECIAL\(/ { + maybe_print_file_header() + maybe_emit_next_symbol("SPECIAL") +} + /DEFINE_SYMBOL\(/ { maybe_print_file_header() maybe_emit_next_symbol("SYMBOL") diff --git a/src/lisp.c b/src/lisp.c index d2e1e22..46d2e99 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -49,6 +49,49 @@ void lisp_init() { void lisp_shutdown() {} +DEFUN(eval, "eval", (LispVal * form), "(form)", "") { + if (!OBJECTP(form)) { + // fixnum or float + return form; + } + switch (((LispObject *) form)->type) { + case TYPE_HASH_TABLE: + case TYPE_FUNCTION: + case TYPE_STRING: + return form; + case TYPE_VECTOR: { + LispVector *vec = form; + LispVal **out_data = lisp_malloc(sizeof(LispVal *) * vec->length); + LispVector *newvec = make_vector(out_data, vec->length, true); + for (size_t i = 0; i < vec->length; ++i) { + out_data[i] = Qnil; + } + for (size_t i = 0; i < vec->length; ++i) { + out_data[i] = Feval(vec->data[i]); + } + return newvec; + } + case TYPE_SYMBOL: { + // TODO local bindings + LispSymbol *sym = form; + if (sym->value == Qunbound) { + printf("Unbound symbol: "); + debug_print(stdout, form); + fputc('\n', stdout); + abort(); + } + return sym->value; + } + case TYPE_CONS: { + return Ffuncall(XCAR(form), XCDR(form)); + } + case TYPE_FIXNUM: + case TYPE_FLOAT: + default: + abort(); + } +} + void debug_print(FILE *file, LispVal *obj) { switch (TYPE_OF(obj)) { case TYPE_FIXNUM: diff --git a/src/lisp.h b/src/lisp.h index 33f3103..d50a4c0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -16,6 +16,8 @@ void lisp_init(void); void lisp_shutdown(void); +DECLARE_FUNCTION(eval, (LispVal * form)); + void debug_print(FILE *file, LispVal *obj); void debug_obj_info(FILE *file, LispVal *obj); diff --git a/src/list.c b/src/list.c index 20b5c7b..efc4b09 100644 --- a/src/list.c +++ b/src/list.c @@ -17,7 +17,6 @@ intptr_t list_length(LispVal *list) { } bool list_length_eq(LispVal *list, intptr_t size) { - assert(LISTP(list)); while (size && CONSP(list)) { list = XCDR(list); --size; @@ -52,3 +51,11 @@ DEFUN(nreverse, "nreverse", (LispVal * list), "(list)", "") { } return rev; } + +DEFUN(listp, "listp", (LispVal * obj), "(obj)", "") { + return LISTP(obj) ? Qt : Qnil; +} + +DEFUN(list, "list", (LispVal * args), "(&rest args)", "") { + return args; +} diff --git a/src/list.h b/src/list.h index c19e009..cf3af12 100644 --- a/src/list.h +++ b/src/list.h @@ -112,5 +112,12 @@ DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr)); DECLARE_FUNCTION(length, (LispVal * list)); DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length)); DECLARE_FUNCTION(nreverse, (LispVal * list)); +DECLARE_FUNCTION(listp, (LispVal * obj)); +DECLARE_FUNCTION(list, (LispVal * args)); +static ALWAYS_INLINE void CHECK_LISTP(LispVal *obj) { + if (!LISTP(obj)) { + signal_type_error(obj, LIST(Qlist)); + } +} #endif diff --git a/src/main.c b/src/main.c index 7413f4c..f53773c 100644 --- a/src/main.c +++ b/src/main.c @@ -17,7 +17,7 @@ int main(int argc, const char **argv) { REGISTER_GLOBAL_FUNCTION(cool_func); push_stack_frame(Qnil, Qnil, Qnil); ReadStream s; - const char BUF[] = "()"; + const char BUF[] = "(1 'a)"; read_stream_init(&s, BUF, sizeof(BUF) - 1); LispVal *l = read(&s); Ffuncall(Qcool_func, l); diff --git a/src/stack.c b/src/stack.c index 36d02b0..8d5da3c 100644 --- a/src/stack.c +++ b/src/stack.c @@ -45,13 +45,15 @@ static void reset_local_refs(struct LocalReferences *refs) { for (size_t i = 0; i < num_full_blocks; ++i) { for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) { assert(OBJECTP(refs->blocks[i]->refs[j])); - --((LispObject *) refs->blocks[i]->refs[j])->gc.local_ref_count; + // TODO recurse into object + SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[i]->refs[j], false); } } for (size_t i = 0; i < last_block_size; ++i) { assert(OBJECTP(refs->blocks[num_full_blocks]->refs[i])); - --((LispObject *) refs->blocks[num_full_blocks]->refs[i]) - ->gc.local_ref_count; + // TODO recurse into object + SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[num_full_blocks]->refs[i], + false); } } @@ -84,10 +86,11 @@ static bool store_local_reference_in_frame(struct StackFrame *frame, void add_local_reference(LispVal *obj) { assert(the_stack.depth > 0); - if (OBJECTP(obj)) { + if (OBJECTP(obj) && OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { if (store_local_reference_in_frame(LISP_STACK_TOP(), obj)) { the_stack.first_clear_local_refs = the_stack.depth; } - ++((LispObject *) obj)->gc.local_ref_count; + // TODO recurse into object + SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true); } }