From 7f68c8fcbf30cb86c7b3e4d9b4c4f0f9c4826833 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Fri, 19 Sep 2025 23:50:23 -0700 Subject: [PATCH] Improve macro expansion and returns --- src/kernel.sl | 9 +- src/lisp.c | 231 ++++++++++++++++++++++++++++++++++++++++++++------ src/lisp.h | 14 ++- 3 files changed, 220 insertions(+), 34 deletions(-) diff --git a/src/kernel.sl b/src/kernel.sl index 8346a54..c0a6c65 100644 --- a/src/kernel.sl +++ b/src/kernel.sl @@ -87,7 +87,8 @@ (throw 'argument-error)))) (apply 'list 'funcall (apply 'list 'lambda (reverse vars) - '(declare (name nil)) + (list 'declare (list 'name + (make-symbol "let"))) body) (reverse vals))))) @@ -139,7 +140,5 @@ (list 'condition-case form (pair :finally unwind-forms))) -(defun test () - (return-from test 10)) - -(println (test)) +(defmacro return (&opt value) + (list 'return-from nil value)) diff --git a/src/lisp.c b/src/lisp.c index 635a249..a6c97fd 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -801,17 +801,20 @@ DEFUN(backtrace, "backtrace", (void) ) { } DEFMACRO(return_from, "return-from", (LispVal * name, LispVal *value)) { - Fthrow(Qreturn_frame_error, const_list(true, 2, name, value)); + Fthrow(Qreturn_frame_error, + const_list(false, 2, refcount_ref(name), Feval(value))); } STATIC_DEFMACRO(internal_real_return, "internal-real-return", (LispVal * name, LispVal *tag, LispVal *value)) { for (StackFrame *cur = the_stack; cur; cur = cur->next) { - if (!NILP(cur->return_tag) && cur->return_tag == tag) { - Fthrow(cur->return_tag, const_list(true, 1, value)); + if (!NILP(cur->return_tag) && cur->enable_handlers + && cur->return_tag == tag) { + Fthrow(cur->return_tag, const_list(false, 1, Feval(value))); } } - Fthrow(Qreturn_frame_error, const_list(true, 2, name, value)); + Fthrow(Qreturn_frame_error, + const_list(false, 2, refcount_ref(name), Feval(value))); } #pragma GCC diagnostic push @@ -1509,10 +1512,13 @@ static LispVal *call_lisp_function(LispVal *name, LispFunction *func, } LispVal *expansion = Fprogn(func->body); LispVal *retval = Qnil; - WITH_CLEANUP_DOUBLE_PTR(expansion, { + // disable internal handlers + the_stack->enable_handlers = false; + WITH_CLEANUP(expansion, { // eval in the outer lexenv retval = Feval_in_env(expansion, args_lexenv); }); + the_stack->enable_handlers = true; // just in case return retval; } else { return Fprogn(func->body); @@ -1682,19 +1688,37 @@ DEFUN(copy_tree, "copy-tree", (LispVal * tree)) { DEFUN(macroexpand_1, "macroexpand-1", (LispVal * form)) { if (PAIRP(form)) { - LispFunction *fobj = (LispFunction *) Fsymbol_function(Fhead(form), Qt); + LispFunction *fobj; + if (FUNCTIONP(HEAD(form))) { + fobj = refcount_ref(HEAD(form)); + } else { + fobj = (LispFunction *) Fsymbol_function(HEAD(form), Qt); + } if (!FUNCTIONP(fobj) || fobj->is_builtin || !fobj->is_macro) { refcount_unref(fobj); return refcount_ref(form); } LispVal *expansion = Qnil; - WITH_CLEANUP_DOUBLE_PTR(fobj, { - WITH_PUSH_FRAME(HEAD(form), TAIL(form), false, { - the_stack->hidden = false; - the_stack->lexenv = refcount_ref(fobj->lexenv); - process_lisp_args(Fhead(form), fobj, Ftail(form), - &the_stack->lexenv); - expansion = Fprogn(fobj->body); + LispVal *return_ptr = Fpair(Qnil, Qnil); + WITH_CLEANUP(return_ptr, { + WITH_CLEANUP(fobj, { + WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS( + refcount_ref(HEAD(form)), refcount_ref(TAIL(form)), false, + { + the_stack->hidden = false; + if (!NILP(fobj->return_tag)) { + the_stack->return_tag = + refcount_ref(fobj->return_tag); + setup_return_handler(fobj->return_tag, return_ptr); + } + the_stack->lexenv = refcount_ref(fobj->lexenv); + process_lisp_args(Fhead(form), fobj, Ftail(form), + &the_stack->lexenv); + expansion = Fprogn(fobj->body); + }, + { + expansion = refcount_ref(HEAD(return_ptr)); // + }); }); }); return expansion; @@ -1719,6 +1743,117 @@ DEFUN(macroexpand_toplevel, "macroexpand-toplevel", (LispVal * form)) { } } +static LispVal *filter_body_form(LispVal *form, + LispVal *(*func)(LispVal *body, + void *user_data), + void *user_data); + +#define EXPAND_HEAD(form) \ + { \ + LispVal *expansion = filter_body_form(HEAD(form), func, user_data); \ + WITH_CLEANUP(expansion, { Fsethead(form, expansion); }); \ + } +static void expand_lambda_list(LispVal *list, + LispVal *(*func)(LispVal *body, void *user_data), + void *user_data) { + bool enable_extended = false; + FOREACH_TAIL(entry, list) { + if (enable_extended && PAIRP(HEAD(entry))) { + LispVal *copy = Fcopy_list(HEAD(entry)); + Fsethead(entry, copy); + refcount_unref(copy); + if (PAIRP(TAIL(copy))) { + EXPAND_HEAD(TAIL(copy)); + } + } else if (HEAD(entry) == Qrest) { + enable_extended = false; + } else if (HEAD(entry) == Qopt || HEAD(entry) == Qkey) { + enable_extended = true; + } + } +} + +static void expand_builtin_macro(LispFunction *fobj, LispVal *args, + LispVal *(*func)(LispVal *body, + void *user_data), + void *user_data) { + if (fobj->builtin == (lisp_function_ptr_t) Fquote) { + return; // do nothing + } else if (fobj->builtin == (lisp_function_ptr_t) Fsetq) { + bool is_var = true; + FOREACH_TAIL(form, args) { + if (!is_var) { + EXPAND_HEAD(form); + } + is_var = !is_var; + } + } else if (fobj->builtin == (lisp_function_ptr_t) Freturn_from) { + if (PAIRP(args) && PAIRP(TAIL(args))) { + EXPAND_HEAD(TAIL(args)); + } + } else if (fobj->builtin == (lisp_function_ptr_t) Finternal_real_return) { + if (PAIRP(args) && PAIRP(TAIL(args)) && PAIRP(TAIL(TAIL(args)))) { + EXPAND_HEAD(TAIL(TAIL(args))); + } + } else if (fobj->builtin == (lisp_function_ptr_t) Fcondition_case) { + if (PAIRP(args)) { + EXPAND_HEAD(args); + FOREACH_TAIL(entry_tail, TAIL(args)) { + LispVal *copy = Fcopy_list(HEAD(entry_tail)); + Fsethead(entry_tail, copy); + refcount_unref(copy); + if (PAIRP(HEAD(entry_tail))) { + FOREACH_TAIL(form, TAIL(HEAD(entry_tail))) { + EXPAND_HEAD(form); + } + } + } + } + } else if (fobj->builtin == (lisp_function_ptr_t) Fdefmacro + || fobj->builtin == (lisp_function_ptr_t) Fdefun + || fobj->builtin == (lisp_function_ptr_t) Flambda) { + if (!LISTP(args)) { + return; + } + LispVal *expand_from = TAIL(args); // skip lambda list + if (!LISTP(expand_from)) { + return; + } + LispVal *lambda_list; + if (fobj->builtin != (lisp_function_ptr_t) Flambda) { + LispVal *copy = Fcopy_list(HEAD(expand_from)); + Fsethead(expand_from, copy); + refcount_unref(copy); + lambda_list = HEAD(expand_from); + expand_from = TAIL(expand_from); // skip the name + if (!LISTP(expand_from)) { + return; + } + } else { + LispVal *copy = Fcopy_list(HEAD(args)); + Fsethead(args, copy); + refcount_unref(copy); + lambda_list = HEAD(args); + } + expand_lambda_list(lambda_list, func, user_data); + LispVal *first_form = HEAD(expand_from); + if (PAIRP(first_form) && HEAD(first_form) == Qdeclare) { + expand_from = TAIL(expand_from); // declare statement + if (!LISTP(expand_from)) { + return; + } + } + FOREACH_TAIL(form, expand_from) { + EXPAND_HEAD(form); + } + } else { + FOREACH_TAIL(form, args) { + EXPAND_HEAD(form); + } + } +} +#undef EXPAND_HEAD + // func should ref its return value static LispVal *filter_body_form(LispVal *form, LispVal *(*func)(LispVal *body, @@ -1732,10 +1867,27 @@ static LispVal *filter_body_form(LispVal *form, }); WITH_PUSH_FRAME(Qnil, Qnil, true, { void *cl_handler = register_cleanup(&unref_double_ptr, &toplevel); - if (PAIRP(toplevel) && NILP(Feq(Qquote, HEAD(toplevel)))) { - FOREACH_TAIL(tail, TAIL(toplevel)) { - Fsethead(tail, - filter_body_form(HEAD(tail), func, user_data)); + if (PAIRP(toplevel)) { + LispFunction *fobj = NULL; + if (FUNCTIONP(HEAD(toplevel))) { + fobj = refcount_ref(HEAD(toplevel)); + } else if (SYMBOLP(HEAD(toplevel))) { + fobj = + (LispFunction *) Fsymbol_function(HEAD(toplevel), Qt); + } + if (fobj) { + WITH_CLEANUP(fobj, { + if (fobj->is_builtin && fobj->is_macro) { + expand_builtin_macro(fobj, TAIL(toplevel), func, + user_data); + } else { + FOREACH_TAIL(tail, TAIL(toplevel)) { + Fsethead(tail, + filter_body_form(HEAD(tail), func, + user_data)); + } + } + }); } } cancel_cleanup(cl_handler); @@ -1795,7 +1947,7 @@ DEFUN(apply, "apply", (LispVal * function, LispVal *rest)) { if (LISTP(HEAD(rest))) { // ensure the list is not circular refcount_ref(args); - WITH_CLEANUP_DOUBLE_PTR(args, { + WITH_CLEANUP(args, { list_length(Fhead(rest)); // }); if (NILP(args)) { @@ -2118,6 +2270,14 @@ static inline LispVal *expand_function_body(LispVal *name, LispVal *return_tag, &(struct NameAndReturnTag) {.name = name, .return_tag = return_tag}); } +static LispVal *macroexpand_all_as_callback(LispVal *form, void *ignored) { + return Fmacroexpand_all(form); +} + +static inline void expand_lambda_list_for_toplevel(LispVal *list) { + expand_lambda_list(list, macroexpand_all_as_callback, NULL); +} + DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) { CHECK_TYPE(TYPE_SYMBOL, name); if (parse_function_declare(HEAD(body), NULL)) { @@ -2125,11 +2285,15 @@ DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) { } LispVal *return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name)); + LispVal *exp_args = Fcopy_list(args); + expand_lambda_list_for_toplevel(exp_args); LispVal *expanded_body = expand_function_body(name, return_tag, body); LispVal *func = Qnil; - WITH_CLEANUP(expanded_body, { - func = make_lisp_function(name, return_tag, args, the_stack->lexenv, - expanded_body, false); + WITH_CLEANUP(exp_args, { + WITH_CLEANUP(expanded_body, { + func = make_lisp_function(name, return_tag, exp_args, + the_stack->lexenv, expanded_body, false); + }); }); refcount_unref(Ffset(name, func)); return func; @@ -2142,11 +2306,15 @@ DEFMACRO(defmacro, "defmacro", (LispVal * name, LispVal *args, LispVal *body)) { } LispVal *return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name)); + LispVal *exp_args = Fcopy_list(args); + expand_lambda_list_for_toplevel(exp_args); LispVal *expanded_body = expand_function_body(name, return_tag, body); LispVal *func = Qnil; - WITH_CLEANUP(expanded_body, { - func = make_lisp_function(name, return_tag, args, the_stack->lexenv, - expanded_body, true); + WITH_CLEANUP(exp_args, { + WITH_CLEANUP(expanded_body, { + func = make_lisp_function(name, return_tag, exp_args, + the_stack->lexenv, expanded_body, true); + }); }); refcount_unref(Ffset(name, func)); return func; @@ -2158,18 +2326,25 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) { body = TAIL(body); } LispVal *return_tag; + LispVal *tag_name; if (name == Qunbound) { name = Qlambda; + tag_name = Qnil; return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) Qnil)->name)); } else { CHECK_TYPE(TYPE_SYMBOL, name); return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name)); + tag_name = name; } - LispVal *expanded_body = Fmacroexpand_all(body); + LispVal *expanded_body = expand_function_body(tag_name, return_tag, body); + LispVal *exp_args = Fcopy_list(args); + expand_lambda_list_for_toplevel(exp_args); LispVal *func = Qnil; - WITH_CLEANUP(expanded_body, { - func = make_lisp_function(name, return_tag, args, the_stack->lexenv, - expanded_body, false); + WITH_CLEANUP(exp_args, { + WITH_CLEANUP(expanded_body, { + func = make_lisp_function(name, return_tag, args, the_stack->lexenv, + expanded_body, false); + }); }); return func; } diff --git a/src/lisp.h b/src/lisp.h index e394511..1a7cecc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -295,7 +295,7 @@ inline static bool NUMBERP(LispVal *v) { !NILP(__foreach_cur); \ __foreach_cur = TAIL(__foreach_cur), var = HEAD(__foreach_cur)) #define FOREACH_TAIL(var, list) \ - for (LispVal *var = list; !NILP(var); var = TAIL(var)) + for (LispVal *var = list; PAIRP(var); var = TAIL(var)) // ############################# // # Allocation and references # @@ -650,5 +650,17 @@ static inline LispVal *TAIL(LispVal *list) { CHECK_TYPE(TYPE_PAIR, list); return ((LispPair *) list)->tail; } +static inline LispVal *HEAD_SAFE(LispVal *list) { + if (!PAIRP(list)) { + return Qnil; + } + return ((LispPair *) list)->head; +} +static inline LispVal *TAIL_SAFE(LispVal *list) { + if (!PAIRP(list)) { + return Qnil; + } + return ((LispPair *) list)->tail; +} #endif