Beginnings of a common lisp-like type system

This commit is contained in:
2025-09-20 19:26:38 -07:00
parent bdb4bf6824
commit 4f1c2fea55
2 changed files with 159 additions and 64 deletions

View File

@ -380,7 +380,12 @@ LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
self->oargs = Qnil;
self->rest_arg = Qnil;
self->kwargs = Qnil;
void *cl = register_cleanup(&lisp_free, self);
self->name = Qnil;
self->return_tag = Qnil;
self->lexenv = Qnil;
self->doc = Qnil;
self->body = Qnil;
void *cl = register_cleanup(&refcount_unref_as_callback, self);
set_function_args(self, args);
cancel_cleanup(cl);
@ -1390,6 +1395,7 @@ static LispVal *call_builtin(LispVal *name, LispFunction *func, LispVal *args,
static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
LispVal **lexenv) {
LispVal *added_kwds = make_lisp_hashtable(Qnil, Qnil);
void *cl_handle = register_cleanup(&refcount_unref_as_callback, added_kwds);
enum { REQ, OPT, KEY, REST } mode = REQ;
LispVal *rargs = func->rargs;
LispVal *oargs = func->oargs;
@ -1491,6 +1497,7 @@ static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
push_to_lexenv(lexenv, func->rest_arg, Qnil);
}
done_adding:
cancel_cleanup(cl_handle);
refcount_unref(added_kwds);
return;
// TODO different messages
@ -1498,6 +1505,7 @@ missing_required:
too_many_args:
missing_value:
unknown_key:
cancel_cleanup(cl_handle);
refcount_unref(added_kwds);
Fthrow(Qargument_error, Fpair(fname, Qnil));
}
@ -2285,14 +2293,18 @@ 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(exp_args, {
WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, return_tag, exp_args,
the_stack->lexenv, expanded_body, false);
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));
@ -2306,14 +2318,18 @@ 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(exp_args, {
WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, return_tag, exp_args,
the_stack->lexenv, expanded_body, true);
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));
@ -2336,14 +2352,18 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) {
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
tag_name = name;
}
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(exp_args, {
WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, return_tag, args, the_stack->lexenv,
expanded_body, false);
WITH_CLEANUP(return_tag, {
LispVal *expanded_body =
expand_function_body(tag_name, return_tag, body);
LispVal *exp_args = Fcopy_list(args);
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);
});
});
});
return func;
@ -2580,7 +2600,8 @@ DEFUN(plist_set, "plist-set",
if (NILP(TAIL(cur))) {
break;
}
return refcount_ref(HEAD(TAIL(cur)));
Fsethead(TAIL(cur), value);
return refcount_ref(plist);
}
}
return push_many(plist, 2, value, key);