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

Basic support for lisp functions

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-07-03 02:43:12 +09:00
parent a19071c35c
commit 625b8238e6
3 changed files with 159 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

168
src/lisp.c
View File

@ -1,6 +1,7 @@
#include "lisp.h"
#include "read.h"
// used by static function registering macros
#include "read.h" // IWYU pragma: keep
#include <ctype.h>
#include <stdarg.h>
@ -92,6 +93,9 @@ void _internal_lisp_delete_object(LispVal *val) {
LispFunction *fn = (LispFunction *) val;
lisp_unref(fn->doc);
lisp_unref(fn->args);
lisp_unref(fn->rargs);
lisp_unref(fn->oargs);
lisp_unref(fn->rest_arg);
lisp_unref(fn->kwargs);
if (!fn->is_builtin) {
lisp_unref(fn->body);
@ -219,23 +223,30 @@ DEF_STATIC_SYMBOL(allow_other_keys, "&allow-other-keys");
DEF_STATIC_SYMBOL(rest, "&rest");
void set_function_args(LispFunction *func, LispVal *args) {
// in case func is static
if (func->args) {
lisp_unref(func->args);
}
if (func->kwargs) {
lisp_unref(func->kwargs);
}
// TODO disallow duplicate args
lisp_unref(func->args);
lisp_unref(func->kwargs);
lisp_unref(func->rargs);
lisp_unref(func->oargs);
lisp_unref(func->rest_arg);
int mode = 0; // required
bool has_opt = false; // mode 1
bool has_key = false; // mode 2
bool has_rest = false; // mode 3
func->n_req = 0;
func->rargs = Qnil;
func->n_opt = 0;
func->has_rest = false;
func->oargs = Qnil;
func->rest_arg = Qnil;
size_t n_kw = 0;
func->kwargs = lisp_ref(make_lisp_hashtable(Qnil, Qnil));
func->allow_other_keys = false;
LispVal *rargs_end;
LispVal *oargs_end;
FOREACH(arg, args) {
if (!SYMBOLP(arg) || VALUE_CONSTANTP(arg)) {
goto malformed;
@ -266,9 +277,25 @@ void set_function_args(LispFunction *func, LispVal *args) {
} else {
switch (mode) {
case 0:
if (NILP(func->rargs)) {
func->rargs = Fpair(arg, Qnil);
rargs_end = func->rargs;
} else {
LispVal *new_end = Fpair(arg, Qnil);
Fsettail(rargs_end, new_end);
rargs_end = new_end;
}
++func->n_req;
break;
case 1:
if (NILP(func->oargs)) {
func->oargs = Fpair(arg, Qnil);
oargs_end = func->oargs;
} else {
LispVal *new_end = Fpair(arg, Qnil);
Fsettail(oargs_end, new_end);
oargs_end = new_end;
}
++func->n_opt;
break;
case 2: {
@ -280,14 +307,15 @@ void set_function_args(LispFunction *func, LispVal *args) {
LispVal *kn =
make_lisp_string(kns, sn->length + 1, false, false);
lisp_ref(kn);
Fputhash(func->kwargs, Fintern(kn), make_lisp_integer(n_kw));
Fputhash(func->kwargs, Fintern(kn),
Fpair(make_lisp_integer(n_kw), arg));
lisp_unref(kn);
} break;
case 3:
if (func->has_rest) {
if (!NILP(func->rest_arg)) {
goto malformed;
}
func->has_rest = true;
func->rest_arg = lisp_ref(arg);
mode = -1;
break;
case -1:
@ -295,6 +323,8 @@ void set_function_args(LispFunction *func, LispVal *args) {
}
}
}
lisp_ref(func->rargs);
lisp_ref(func->oargs);
// do this last
func->args = lisp_ref(args);
return;
@ -311,6 +341,9 @@ LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
self->is_builtin = false;
self->is_macro = is_macro;
self->args = Qnil;
self->rargs = Qnil;
self->oargs = Qnil;
self->rest_arg = Qnil;
self->kwargs = Qnil;
void *cl = register_cleanup(&free_double_ptr, &self);
set_function_args(self, args);
@ -775,7 +808,9 @@ void lisp_init() {
REGISTER_SYMBOL(allow_other_keys);
REGISTER_SYMBOL(key);
REGISTER_SYMBOL(rest);
REGISTER_SYMBOL(type_error);
REGISTER_FUNCTION(throw, "(signal &rest data)", "");
REGISTER_FUNCTION(pair, "(head tail)",
"Return a new pair with HEAD and TAIL.");
REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR.");
@ -802,6 +837,11 @@ void lisp_init() {
REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS.");
REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", "");
REGISTER_FUNCTION(fset, "(sym new-func)", "");
REGISTER_FUNCTION(defun, "(name args &rest body)",
"Define NAME to be a new function.");
REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR");
REGISTER_FUNCTION(read, "(source)",
"Read and return the next s-expr from SOURCE.");
}
void lisp_shutdown() {
@ -876,7 +916,7 @@ static LispVal **process_builtin_args(LispFunction *func, LispVal *args,
size_t *nargs) {
size_t raw_count =
(func->n_req + func->n_opt + ((LispHashtable *) func->kwargs)->count
+ (func->has_rest));
+ !NILP(func->rest_arg));
*nargs = raw_count;
LispVal **vec = lisp_malloc(sizeof(LispVal *) * raw_count);
memset(vec, 0, sizeof(LispVal *) * raw_count);
@ -890,7 +930,7 @@ static LispVal **process_builtin_args(LispFunction *func, LispVal *args,
if (have_count < func->n_req + func->n_opt) {
vec[have_count++] = lisp_ref(arg);
} else if (KEYWORDP(arg)
&& !NILP(index = Fgethash(func->kwargs, arg, Qnil))
&& !NILP(index = Fhead(Fgethash(func->kwargs, arg, Qnil)))
&& NILP(rest)) {
LispInteger *n = (LispInteger *) index;
if (vec[n->value]) {
@ -903,7 +943,7 @@ static LispVal **process_builtin_args(LispFunction *func, LispVal *args,
vec[n->value] = lisp_ref(Fhead(arg));
} else if (KEYWORDP(arg) && !func->allow_other_keys && NILP(rest)) {
goto unknown_key;
} else if (!func->has_rest) {
} else if (NILP(func->rest_arg)) {
goto too_many;
} else if (NILP(rest)) {
rest = Fpair(arg, Qnil);
@ -918,7 +958,7 @@ static LispVal **process_builtin_args(LispFunction *func, LispVal *args,
if (have_count < func->n_req) {
goto too_few;
}
if (func->has_rest) {
if (!NILP(func->rest_arg)) {
vec[raw_count - 1] = lisp_ref(rest);
}
for (size_t i = 0; i < raw_count; ++i) {
@ -994,13 +1034,90 @@ static LispVal *call_builtin(LispVal *name, LispFunction *func, LispVal *args) {
return retval;
}
static LispVal *call_lisp_function(LispVal *name, LispFunction *func,
LispVal *args) {
// TODO do this
return Qnil;
static void process_lisp_args(LispFunction *func, LispVal *args,
LispVal *lexenv) {
enum { REQ, OPT, KEY, REST } mode = REQ;
LispVal *rargs = func->rargs;
LispVal *oargs = func->oargs;
// TODO fix macro to avoid warnings
HASHTABLE_FOREACH(arg, info, func->kwargs, {
// TODO allow default values
Fputhash(lexenv, Fhead(info), Qnil);
});
while (!NILP(args)) {
LispVal *arg = Fhead(args);
switch (mode) {
case REQ: {
if (NILP(rargs)) {
mode = OPT;
continue; // skip increment
}
Fputhash(lexenv, Fhead(rargs), arg);
rargs = Ftail(rargs);
} break;
case OPT: {
if (NILP(oargs)) {
mode = KEY;
continue; // skip increment
}
Fputhash(lexenv, Fhead(oargs), arg);
oargs = Ftail(oargs);
} break;
case KEY:
if (!KEYWORDP(arg)) {
mode = REST;
continue; // skip increment
}
LispVal *var_name = Fhead(Fgethash(func->kwargs, arg, Qnil));
if (NILP(var_name)) {
if (!func->allow_other_keys) {
goto unknown_key;
}
mode = REST;
continue; // skip increment
}
args = Ftail(args);
if (NILP(args)) {
goto missing_value;
}
LispVal *value = Fhead(args);
Fputhash(lexenv, var_name, value);
case REST:
if (NILP(func->rest_arg)) {
goto too_many_args;
}
Fputhash(lexenv, func->rest_arg, args);
// done processing
return;
}
args = Ftail(args);
}
if (!NILP(rargs)) {
goto missing_required;
}
FOREACH(arg, oargs) {
Fputhash(lexenv, arg, Qnil);
}
return;
// TODO different messages
missing_required:
too_many_args:
missing_value:
unknown_key:
Fthrow(Qargument_error, Qnil);
}
static void check_args_for_function(LispFunction *fun, LispVal *args) {}
static LispVal *call_lisp_function(LispVal *name, LispFunction *func,
LispVal *args) {
process_lisp_args(func, args, the_stack->lexenv);
// TODO handle macros
LispVal *body = Fpair(Qprogn, func->body);
LispVal *retval = Qnil;
WITH_CLEANUP(body, {
retval = Feval(body); //
});
return retval;
}
static LispVal *call_function(LispVal *func, LispVal *args,
LispVal *args_lexenv, bool eval_args) {
@ -1023,7 +1140,6 @@ static LispVal *call_function(LispVal *func, LispVal *args,
WITH_PUSH_FRAME(func, args, fobj->is_macro && fobj->is_builtin, {
void *cl_handle = register_cleanup(
(lisp_cleanup_func_t) &lisp_unref_double_ptr, &args);
check_args_for_function(fobj, args);
if (fobj->is_builtin) {
retval = call_builtin(func, fobj, args);
} else {
@ -1213,6 +1329,14 @@ DEFUN(fset, "fset", (LispVal * sym, LispVal *new_func)) {
return new_func;
}
DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) {
CHECK_TYPE(TYPE_SYMBOL, name);
LispVal *func =
make_lisp_function(args, Qnil, the_stack->lexenv, body, false);
Ffset(name, func);
return func;
}
static void debug_dump_real(FILE *stream, void *obj, bool first) {
switch (TYPEOF(obj)) {
case TYPE_STRING: {

8
src/lisp.h
View File

@ -99,10 +99,12 @@ typedef struct {
bool is_macro;
size_t n_req;
LispVal *rargs;
size_t n_opt;
LispVal *oargs;
LispVal *kwargs; // hash table
bool allow_other_keys;
bool has_rest;
LispVal *rest_arg;
union {
void *builtin;
LispVal *body;
@ -220,6 +222,9 @@ inline static bool NUMBERP(LispVal *v) {
.builtin = &F##c_name, \
.doc = Qnil, \
.args = Qnil, \
.rargs = Qnil, \
.oargs = Qnil, \
.rest_arg = Qnil, \
.kwargs = Qnil, \
.lexenv = Qnil, \
}; \
@ -490,6 +495,7 @@ DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value));
DECLARE_FUNCTION(progn, (LispVal * forms));
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);

6
src/main.c
View File

@ -12,6 +12,9 @@ static LispFunction _Ftoplevel_exit_handler_function = {
.builtin = &Ftoplevel_exit_handler,
.args = Qnil,
.kwargs = Qnil,
.rargs = Qnil,
.oargs = Qnil,
.rest_arg = Qnil,
.lexenv = Qnil,
};
#define Ftoplevel_exit_handler_function \
@ -38,6 +41,9 @@ static LispFunction _Ftoplevel_error_handler_function = {
.args = Qnil,
.kwargs = Qnil,
.lexenv = Qnil,
.rargs = Qnil,
.oargs = Qnil,
.rest_arg = Qnil,
};
#define Ftoplevel_error_handler_function \
LISPVAL(&_Ftoplevel_error_handler_function)