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

18
src/kernel.sl
View File

@ -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)

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.");

6
src/lisp.h
View File

@ -180,6 +180,7 @@ extern LispSymbol _Qt;
extern LispVal *Qbackquote;
extern LispVal *Qcomma;
extern LispVal *Qcomma_at;
extern LispVal *Qmacro;
extern LispVal *Qopt;
extern LispVal *Qkey;
extern LispVal *Qallow_other_keys;
@ -368,7 +369,8 @@ LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length);
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);
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);
LispVal *make_user_pointer(void *data, void (*free_func)(void *));
#define ALLOC_USERPTR(type, free_func) \
@ -417,8 +419,6 @@ DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
DECLARE_FUNCTION(setq, (LispVal * args));
DECLARE_FUNCTION(progn, (LispVal * forms));
DECLARE_FUNCTION(condition_case, (LispVal * form, LispVal *rest));
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));
DECLARE_FUNCTION(defmacro, (LispVal * name, LispVal *args, LispVal *body));
DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
DECLARE_FUNCTION(while, (LispVal * condition, LispVal *body));
DECLARE_FUNCTION(and, (LispVal * rest));