From 22ffac93219faa2025f807aae2566eb9b70d289a Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Wed, 28 Jan 2026 16:07:48 -0800 Subject: [PATCH] Add basic lexenv support --- src/base.c | 3 ++- src/base.h | 4 ++++ src/function.c | 10 ++++---- src/function.h | 1 - src/hashtable.c | 2 +- src/lisp.c | 61 +++++++++++++++++++++++++++++++++++++------------ src/lisp.h | 4 +++- src/list.c | 23 +++++++++++++++++++ src/list.h | 7 ++++-- src/main.c | 16 ++++--------- src/stack.c | 30 +++++++++++++++++++++++- src/stack.h | 17 ++++++++++++++ 12 files changed, 141 insertions(+), 37 deletions(-) diff --git a/src/base.c b/src/base.c index e9ba282..f8c8b6c 100644 --- a/src/base.c +++ b/src/base.c @@ -3,6 +3,7 @@ #include "gc.h" #include "hashtable.h" #include "lisp.h" +#include "list.h" #include "stack.h" #include @@ -75,7 +76,7 @@ DEFUN(id, "id", (LispVal * obj), "(id)", "") { } DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") { - return obj1 == obj2 ? Qt : Qnil; + return EQ(obj1, obj2) ? Qt : Qnil; } DEFSPECIAL(quote, "quote", (LispVal * form), "(form)", "") { diff --git a/src/base.h b/src/base.h index cd7a136..7f748d3 100644 --- a/src/base.h +++ b/src/base.h @@ -282,6 +282,10 @@ static ALWAYS_INLINE bool NILP(LispVal *val) { return val == Qnil; } +static ALWAYS_INLINE bool EQ(LispVal *val1, LispVal *val2) { + return val1 == val2; +} + // Some core functions DECLARE_FUNCTION(id, (LispVal * obj)); DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2)); diff --git a/src/function.c b/src/function.c index 28d389f..0074845 100644 --- a/src/function.c +++ b/src/function.c @@ -106,7 +106,7 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) { out->kw = Qnil; out->rest = Qnil; size_t cur_idx = 0; // for keyword args - FOREACH_TAIL(list, tail) { + DOTAILS(tail, list) { if (!LISTP(tail)) { RETURN_ERROR(LLPS_DOTTED, list); } else if (out->allow_other_keys) { @@ -178,7 +178,7 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) { } #undef RETURN_ERROR -LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(), +LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void), const char *lisp_args, size_t args_len, LispVal *docstr) { LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION); @@ -230,11 +230,11 @@ call_simple_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) { } LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS]; size_t acount = 0; - FOREACH(args, arg) { + DOLIST(arg, args) { if (fobj->flags.no_eval_args) { arg_arr[acount] = arg; } else { - arg_arr[acount] = Feval(arg); + arg_arr[acount] = Feval(arg, PARENT_LEXENV()); } add_local_reference(arg_arr[acount++]); } @@ -361,7 +361,7 @@ call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) { if (!arg_arr[i]) { arg_arr[i] = Qnil; } else if (!fobj->flags.no_eval_args) { - arg_arr[i] = Feval(arg_arr[i]); + arg_arr[i] = Feval(arg_arr[i], PARENT_LEXENV()); } add_local_reference(arg_arr[i]); } diff --git a/src/function.h b/src/function.h index e9ff7b1..2e5408b 100644 --- a/src/function.h +++ b/src/function.h @@ -2,7 +2,6 @@ #define INCLUDED_FUNCTION_H #include "base.h" -#include "lisp_string.h" DECLARE_SYMBOL(and_optional); DECLARE_SYMBOL(and_rest); diff --git a/src/hashtable.c b/src/hashtable.c index 02090e0..c6dfe75 100644 --- a/src/hashtable.c +++ b/src/hashtable.c @@ -56,7 +56,7 @@ static uintptr_t hash_key_for_table(LispHashTable *ht, LispVal *key) { static bool compare_keys(LispHashTable *ht, LispVal *key1, LispVal *key2) { if (NILP(ht->eq_fn) || ht->eq_fn == Qeq) { - return key1 == key2; + return EQ(key1, key2); } else if (ht->eq_fn == Qstrings_equal) { // needed for initialization return !NILP(Fstrings_equal(key1, key2)); } diff --git a/src/lisp.c b/src/lisp.c index affb0a7..a42f8da 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -57,7 +57,23 @@ void lisp_shutdown(void) { lisp_teardown_stack(); } -DEFUN(eval, "eval", (LispVal * form), "(form)", "") { +static inline LispVal *lookup_variable(LispSymbol *name, LispVal *lexenv) { + LispVal *lexval = Fplist_get(lexenv, name, Qunbound); + if (lexval != Qunbound) { + return lexval; + } + if (name->value == Qunbound) { + // TODO better error + printf("Unbound symbol: "); + debug_print(stdout, name); + fputc('\n', stdout); + abort(); + } + return name->value; +} + +DEFUN(eval, "eval", (LispVal * form, LispVal *lexenv), + "(form &optional lexenv)", "") { if (!OBJECTP(form)) { // fixnum or float return form; @@ -75,21 +91,12 @@ DEFUN(eval, "eval", (LispVal * form), "(form)", "") { out_data[i] = Qnil; } for (size_t i = 0; i < vec->length; ++i) { - out_data[i] = Feval(vec->data[i]); + out_data[i] = Feval(vec->data[i], lexenv); } 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_SYMBOL: + return lookup_variable(form, lexenv); case TYPE_CONS: { return Ffuncall(XCAR(form), XCDR(form)); } @@ -131,7 +138,7 @@ void debug_print(FILE *file, LispVal *obj) { } case TYPE_CONS: { fputc('(', file); - FOREACH_TAIL(obj, tail) { + DOTAILS(tail, obj) { if (CONSP(tail)) { debug_print(file, XCAR(tail)); if (!NILP(XCDR(tail))) { @@ -162,6 +169,32 @@ void debug_print(FILE *file, LispVal *obj) { } } +DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") { + LispVal *rval = Qnil; + DOLIST(form, forms) { + rval = Feval(form, TOP_LEXENV()); + } + return rval; +} + +DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body), + "(bindings &rest body)", "") { + CHECK_LISTP(bindings); + copy_parent_lexenv(); + DOLIST(binding, bindings) { + if (SYMBOLP(binding)) { + new_lexical_variable(binding, Qnil); + } else if (CONSP(binding) && list_length_eq(binding, 2)) { + new_lexical_variable(FIRST(binding), + Feval(SECOND(binding), TOP_LEXENV())); + } else { + // TODO better error + abort(); + } + } + return Fprogn(body); +} + void debug_obj_info(FILE *file, LispVal *obj) { fprintf(file, "%s -> ", LISP_TYPE_NAMES[TYPE_OF(obj)]); debug_print(file, obj); diff --git a/src/lisp.h b/src/lisp.h index 148757c..7661845 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -16,7 +16,9 @@ void lisp_init(void); void lisp_shutdown(void); -DECLARE_FUNCTION(eval, (LispVal * form)); +DECLARE_FUNCTION(eval, (LispVal * form, LispVal *lexenv)); +DECLARE_FUNCTION(progn, (LispVal * forms)); +DECLARE_FUNCTION(let, (LispVal * bindings, LispVal *body)); __attribute__((no_sanitize("address"))) void debug_print(FILE *file, LispVal *obj); diff --git a/src/list.c b/src/list.c index cc45a59..4fb48a6 100644 --- a/src/list.c +++ b/src/list.c @@ -60,3 +60,26 @@ DEFUN(listp, "listp", (LispVal * obj), "(obj)", "") { DEFUN(list, "list", (LispVal * args), "(&rest args)", "") { return args; } + +DEFUN(plist_put, "plist-put", (LispVal * plist, LispVal *prop, LispVal *value), + "(plist prop value)", "") { + CHECK_LISTP(plist); + DOTAILS(rest, plist) { + if (EQ(XCAR(rest), prop)) { + RPLACA(XCDR(rest), value); + return plist; + } + } + return CONS(prop, CONS(value, plist)); +} + +DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def), + "(plist prop &optional default)", "") { + CHECK_LISTP(plist); + DOTAILS(rest, plist) { + if (EQ(XCAR(rest), prop)) { + return SECOND(rest); + } + } + return def; +} diff --git a/src/list.h b/src/list.h index eb80f29..dc2dfdd 100644 --- a/src/list.h +++ b/src/list.h @@ -99,11 +99,11 @@ static ALWAYS_INLINE LispVal *LIST_N(int count, ...) { #define FOURTH(x) XCAR(XCDR(XCDR(XCDR(x)))) #define FIFTH(x) XCAR(XCDR(XCDR(XCDR(XCDR(x))))) -#define FOREACH(l, v) \ +#define DOLIST(v, l) \ for (LispVal *_tail = (l), *v = XCAR(_tail); !NILP(_tail); \ _tail = XCDR(_tail), v = XCAR(_tail)) -#define FOREACH_TAIL(l, v) for (LispVal *v = (l); !NILP(v); v = XCDR_SAFE(v)) +#define DOTAILS(v, l) for (LispVal *v = (l); !NILP(v); v = XCDR_SAFE(v)) // return -1 list is circular intptr_t list_length(LispVal *list); @@ -122,4 +122,7 @@ static ALWAYS_INLINE void CHECK_LISTP(LispVal *obj) { } } +DECLARE_FUNCTION(plist_put, (LispVal * plist, LispVal *prop, LispVal *value)); +DECLARE_FUNCTION(plist_get, (LispVal * plist, LispVal *prop, LispVal *def)); + #endif diff --git a/src/main.c b/src/main.c index 0ebcfdb..2703c85 100644 --- a/src/main.c +++ b/src/main.c @@ -1,26 +1,20 @@ #include "lisp.h" #include "read.h" -#include - -DEFUN(cool_func, "cool-func", (LispVal * a, LispVal *b), "(a &optional b)", - "") { - printf("A: "); - debug_obj_info(stdout, a); - printf("B: "); - debug_obj_info(stdout, b); +DEFUN(print, "print", (LispVal * v), "(v)", "") { + debug_obj_info(stdout, v); return Qnil; } int main(int argc, const char **argv) { lisp_init(); - REGISTER_GLOBAL_FUNCTION(cool_func); + REGISTER_GLOBAL_FUNCTION(print); push_stack_frame(Qnil, Qnil, Qnil); ReadStream s; - const char BUF[] = "(cool-func 1 (cons 1 2))"; + const char BUF[] = "(let ((a 1)) (print a))"; read_stream_init(&s, BUF, sizeof(BUF) - 1); LispVal *l = read(&s); - Feval(l); + Feval(l, Qnil); lisp_gc_now(NULL); pop_stack_frame(); lisp_shutdown(); diff --git a/src/stack.c b/src/stack.c index eacee16..1810674 100644 --- a/src/stack.c +++ b/src/stack.c @@ -161,7 +161,7 @@ static inline void add_local_refs_for_object_sub_vals(LispVal *seen_objs, break; } case TYPE_STRING: - // ho held refs + // no held refs break; case TYPE_FIXNUM: case TYPE_FLOAT: @@ -190,3 +190,31 @@ void compact_stack_frame(struct StackFrame *restrict frame) { lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *)); refs->num_blocks = 1; } + +bool set_lexical_variable(LispVal *name, LispVal *value, + bool create_if_absent) { + assert(the_stack.depth != 0); + DOTAILS(rest, LISP_STACK_TOP()->lexenv) { + if (EQ(XCAR(rest), name)) { + RPLACA(XCDR(rest), value); + return true; + } + } + if (create_if_absent) { + new_lexical_variable(name, value); + } + return create_if_absent; +} + +void new_lexical_variable(LispVal *name, LispVal *value) { + assert(the_stack.depth != 0); + LISP_STACK_TOP()->lexenv = + CONS(name, CONS(value, LISP_STACK_TOP()->lexenv)); +} + +void copy_parent_lexenv(void) { + assert(the_stack.depth != 0); + if (the_stack.depth > 1) { + LISP_STACK_TOP()->lexenv = the_stack.frames[the_stack.depth - 2].lexenv; + } +} diff --git a/src/stack.h b/src/stack.h index 85c53f7..a007425 100644 --- a/src/stack.h +++ b/src/stack.h @@ -40,6 +40,15 @@ static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP(void) { return the_stack.depth ? &the_stack.frames[the_stack.depth - 1] : NULL; } +static ALWAYS_INLINE LispVal *TOP_LEXENV(void) { + return the_stack.depth ? LISP_STACK_TOP()->lexenv : Qnil; +} + +static ALWAYS_INLINE LispVal *PARENT_LEXENV(void) { + return the_stack.depth > 1 ? the_stack.frames[the_stack.depth - 2].lexenv + : Qnil; +} + void lisp_init_stack(void); void lisp_teardown_stack(void); void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args); @@ -47,6 +56,14 @@ void pop_stack_frame(void); void add_local_reference_no_recurse(LispVal *obj); void add_local_reference(LispVal *obj); +// Return true if successful, false if not found and not created +bool set_lexical_variable(LispVal *name, LispVal *value, bool create_if_absent); +// Just add a new lexical variable without any checking +void new_lexical_variable(LispVal *name, LispVal *value); + +// Copy the previous frame's lexenv to the top of the stack. +void copy_parent_lexenv(void); + // used by the GC void compact_stack_frame(struct StackFrame *restrict frame);