Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move defun and defmacro into kernel.el

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-24 00:52:32 -07:00
parent f961673670
commit 6d34641c5a
3 changed files with 52 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

120
src/lisp.c
View File

@ -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, "<builtin ");
} else {
if (name == Qlambda) {
fprintf(stream, "<lambda"); // no space!
name = NULL;
} else if (fobj->is_macro) {
fprintf(stream, "<macro ");
} else {
fprintf(stream, "<function ");
}
@ -3144,6 +3091,7 @@ static void register_symbols_and_functions(void) {
REGISTER_DO_INTERN(nil, system_package);
REGISTER_DO_INTERN(t, system_package);
REGISTER_SYMBOL(macro);
REGISTER_SYMBOL(opt);
REGISTER_SYMBOL(allow_other_keys);
REGISTER_SYMBOL(key);
@ -3222,10 +3170,6 @@ static void register_symbols_and_functions(void) {
REGISTER_FUNCTION(setplist, "(sym plist)",
"Set the plist of SYM to PLIST.");
REGISTER_FUNCTION(fset, "(sym new-func)", "");
REGISTER_FUNCTION(defun, "(name args &rest body)",
"Define NAME to be a new function.");
REGISTER_FUNCTION(defmacro, "(name args &rest body)",
"Define NAME to be a new macro.");
REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure.");
REGISTER_FUNCTION(while, "(cond &rest body)",
"Run BODY until COND returns nil.");