From 6d34641c5acedc3abfd6a448fa64964236fec15f Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Wed, 24 Sep 2025 00:52:32 -0700 Subject: [PATCH] Move defun and defmacro into kernel.el --- src/kernel.sl | 18 +++++++- src/lisp.c | 120 ++++++++++++++------------------------------------ src/lisp.h | 6 +-- 3 files changed, 52 insertions(+), 92 deletions(-) diff --git a/src/kernel.sl b/src/kernel.sl index 7ef8bc6..f84fe8d 100644 --- a/src/kernel.sl +++ b/src/kernel.sl @@ -1,7 +1,23 @@ ;; -*- mode: lisp-data -*- (fset 'null 'not) -(defun list (&rest r) r) +(fset 'list (lambda (&rest r) (declare (name list)) r)) + +(fset 'defmacro + (lambda (name args &rest body) + (declare (name defmacro) macro) + (list 'progn + (list 'fset (list '\' name) + (apply 'list 'lambda args + (list 'declare (list 'name name) 'macro) + body))))) + +(defmacro defun (name args &rest body) + (list 'progn + (list 'fset (list '\' name) + (apply 'list 'lambda args + (list 'declare (list 'name name)) + body)))) (defun ensure-list (arg) (if (pairp arg) diff --git a/src/lisp.c b/src/lisp.c index 2a7e5f3..cb7872e 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -66,6 +66,7 @@ LispSymbol _Qt = { DEF_STATIC_SYMBOL(backquote, "`"); DEF_STATIC_SYMBOL(comma, ","); DEF_STATIC_SYMBOL(comma_at, ",@"); +DEF_STATIC_SYMBOL(macro, "macro"); DEF_STATIC_SYMBOL(opt, "&opt"); DEF_STATIC_SYMBOL(key, "&key"); DEF_STATIC_SYMBOL(allow_other_keys, "&allow-other-keys"); @@ -325,7 +326,8 @@ static bool parse_opt_arg_entry(LispVal *ent, struct OptArgDesc *aod, } LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args, - LispVal *lexenv, LispVal *body, bool is_macro) { + LispVal *lexenv, LispVal *body, LispVal *doc, + bool is_macro) { CONSTRUCT_OBJECT(self, LispFunction, TYPE_FUNCTION); self->is_builtin = false; self->is_macro = is_macro; @@ -347,13 +349,8 @@ LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args, self->name = refcount_ref(name); self->return_tag = refcount_ref(return_tag); self->lexenv = refcount_ref(lexenv); - if (STRINGP(HEAD(body))) { - self->doc = refcount_ref(HEAD(body)); - self->body = refcount_ref(TAIL(body)); - } else { - self->doc = Qnil; - self->body = refcount_ref(body); - } + self->doc = refcount_ref(doc); + self->body = refcount_ref(body); return LISPVAL(self); } @@ -1030,6 +1027,9 @@ DEFUN(macroexpand_1, "macroexpand-1", TAIL(form)); } else if (FUNCTIONP(HEAD(form))) { fobj = refcount_ref(HEAD(form)); + } else if (PAIRP(HEAD(form)) && HEAD(HEAD(form)) == Qlambda) { + fobj = (LispFunction *) Feval(HEAD(form)); + assert(FUNCTIONP(fobj)); } else { fobj = (LispFunction *) Fsymbol_function(HEAD(form), Qt); } @@ -1161,9 +1161,7 @@ static void expand_builtin_macro(LispFunction *fobj, LispVal *args, } } } - } else if (fobj->builtin == (lisp_function_ptr_t) Fdefmacro - || fobj->builtin == (lisp_function_ptr_t) Fdefun - || fobj->builtin == (lisp_function_ptr_t) Flambda) { + } else if (fobj->builtin == (lisp_function_ptr_t) Flambda) { if (!LISTP(args)) { return; } @@ -1171,23 +1169,10 @@ static void expand_builtin_macro(LispFunction *fobj, LispVal *args, 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 *copy = Fcopy_list(HEAD(args)); + Fsethead(args, copy); + refcount_unref(copy); + expand_lambda_list(HEAD(args), func, user_data); LispVal *first_form = HEAD(expand_from); if (PAIRP(first_form) && HEAD(first_form) == Qdeclare) { expand_from = TAIL(expand_from); // declare statement @@ -1403,12 +1388,15 @@ DEFMACRO(condition_case, "condition-case", (LispVal * form, LispVal *rest)) { } // true if the form was a declare form -static bool parse_function_declare(LispVal *form, LispVal **name_ptr) { +static bool parse_function_declare(LispVal *form, LispVal **name_ptr, + bool *is_macro_ptr) { if (PAIRP(form) && HEAD(form) == Qdeclare) { FOREACH(elt, TAIL(form)) { if (name_ptr && PAIRP(elt) && HEAD(elt) == Qname && PAIRP(TAIL(elt))) { *name_ptr = HEAD(TAIL(elt)); + } else if (is_macro_ptr && elt == Qmacro) { + *is_macro_ptr = true; } } return true; @@ -1465,59 +1453,15 @@ 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)) { - body = TAIL(body); - } - LispVal *return_tag = - make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name)); - LispVal *func = Qnil; - WITH_CLEANUP(return_tag, { - LispVal *exp_args = Fcopy_list(args); - WITH_CLEANUP(exp_args, { - expand_lambda_list_for_toplevel(exp_args); - LispVal *expanded_body = - expand_function_body(name, return_tag, body); - 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; -} - -DEFMACRO(defmacro, "defmacro", (LispVal * name, LispVal *args, LispVal *body)) { - CHECK_TYPE(TYPE_SYMBOL, name); - if (parse_function_declare(HEAD(body), NULL)) { - body = TAIL(body); - } - LispVal *return_tag = - make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name)); - LispVal *func = Qnil; - WITH_CLEANUP(return_tag, { - LispVal *exp_args = Fcopy_list(args); - WITH_CLEANUP(exp_args, { - expand_lambda_list_for_toplevel(exp_args); - LispVal *expanded_body = - expand_function_body(name, return_tag, body); - 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; -} - DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) { + LispVal *doc = Qnil; + if (STRINGP(HEAD(body))) { + doc = HEAD(body); + body = TAIL(body); + } LispVal *name = Qunbound; - if (parse_function_declare(HEAD(body), &name)) { + bool is_macro = false; + if (parse_function_declare(HEAD(body), &name, &is_macro)) { body = TAIL(body); } LispVal *return_tag; @@ -1539,9 +1483,9 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) { WITH_CLEANUP(exp_args, { expand_lambda_list_for_toplevel(exp_args); WITH_CLEANUP(expanded_body, { - func = - make_lisp_function(name, return_tag, args, - the_stack->lexenv, expanded_body, false); + func = make_lisp_function(name, return_tag, args, + the_stack->lexenv, expanded_body, doc, + is_macro); }); }); }); @@ -3063,13 +3007,16 @@ static void debug_dump_real(FILE *stream, void *obj, bool first) { fputc(']', stream); } break; case TYPE_FUNCTION: { + LispFunction *fobj = obj; LispVal *name = ((LispFunction *) obj)->name; - if (((LispFunction *) obj)->is_builtin) { + if (fobj->is_builtin) { fprintf(stream, "is_macro) { + fprintf(stream, "