Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More exception stuff

Browse Source
This commit is contained in:
Zander671
2026-09-03 11:33:44 -07:00
parent dc313fafa0
commit 2533b0db7d
15 changed files with 200 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/function.c
+57 -27
View File
@@ -2,6 +2,7 @@
#include "hashtable.h"
#include "lisp.h"
#include "lisp_string.h"
#include "list.h"
#include "read.h"
#include "stack.h"
@@ -327,6 +328,12 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
return PROCESS_ARGS_OK;
}
static noreturn void signal_argument_error(enum ProcessArgsResult res) {
const char *c_msg = process_args_strerror(res);
LispVal *msg = make_lisp_string(c_msg, strlen(c_msg), false, false);
lisp_signal(Qargument_error, LIST(msg));
}
static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispFunction *fobj, LispVal *args) {
StackFrame *stack_ref = LISP_STACK_REF();
@@ -340,11 +347,7 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
enum ProcessArgsResult res =
process_complex_native_args(fobj, args, arg_arr, &rest_idx);
if (res != PROCESS_ARGS_OK) {
// TODO better errors
printf("Bad arguments to builtin \"");
debug_print(stdout, orig_func);
printf("\": %s\n", process_args_strerror(res));
abort();
signal_argument_error(res);
}
for (intptr_t i = 0; i < count; ++i) {
if (!arg_arr[i]) {
@@ -461,18 +464,12 @@ call_interpreted(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
enum ProcessArgsResult par =
push_interpreted_args_to_lexenv(fobj, evaled_args);
if (par != PROCESS_ARGS_OK) {
// TODO better error handling
fprintf(stderr, "Bad args to interp func: %s\n",
process_args_strerror(par));
abort();
signal_argument_error(par);
}
return UNWIND_AND_RETURN(stack_ref, Fprogn(fobj->impl.interp.body));
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
static LispFunction *coerce_to_function(LispVal *func) {
LispFunction *fobj = func;
if (SYMBOLP(func)) {
fobj = Fsymbol_function(func, Qt);
@@ -480,15 +477,19 @@ DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
fobj = Feval(func, Vlexical_environment);
}
if (NILP(fobj)) {
// TODO throw exception
fprintf(stderr, "Not a function: ");
debug_print(stderr, func);
fputc('\n', stderr);
abort();
signal_type_error(fobj, LIST(Qcallable));
}
// include symbol here for the error message
CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL);
assert(FUNCTIONP(fobj));
return fobj;
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
LispFunction *fobj = coerce_to_function(func);
switch (fobj->type) {
case FUNCTION_NATIVE:
return UNWIND_AND_RETURN(stack_ref, call_native(func, fobj, args));
@@ -506,9 +507,9 @@ static LispVal *parse_lambda_declare_form(LispFunction *fobj, LispVal *body) {
if (EQ(XCAR(decl), Qname)) {
CHECK_TYPE(SECOND(decl), TYPE_SYMBOL);
if (!list_length_eq(decl, 2)) {
// TODO better error
fprintf(stderr, "Invalid (declare (name ...)) form!\n");
abort();
lisp_signal(
Qfunction_declare_form_error,
LIST(LISP_LITSTR("Invalid (declare (name ...)) form")));
}
fobj->name = SECOND(decl);
}
@@ -523,12 +524,9 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
LambdaListParseResult llpr;
parse_lambda_list(&llpr, args);
if (llpr.status != LLPS_OK) {
// TODO better handling
fprintf(stderr,
"Lambda list parse error: %s: ", llps_strerror(llpr.status));
debug_print(stderr, args);
fputc('\n', stderr);
abort();
const char *c_msg = llps_strerror(llpr.status);
LispVal *msg = make_lisp_string(c_msg, strlen(c_msg), false, false);
lisp_signal(Qlambda_list_error, msg);
}
CHECK_LISTP(body);
LispFunction *fobj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION);
@@ -549,5 +547,37 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
return fobj;
}
DEFUN(callablep, "callablep", (LispVal * obj), "(obj)", "") {
if (FUNCTIONP(obj) || (CONSP(obj) && EQ(XCAR(obj), Qlambda))
|| (SYMBOLP(obj) && FUNCTIONP(Fsymbol_function(obj, Qt)))) {
return Qt;
}
return Qnil;
}
DEFUN(function_arity, "function-arity", (LispVal * func), "(func)",
"Return a list of the form (NUM-REQ NUM-OPT KW-NAMES HAS-REST).") {
LispFunction *fobj = coerce_to_function(func);
LispVal *kw = Qnil;
if (HASH_TABLE_P(fobj->args.kw)) {
HT_FOREACH_INDEX(fobj->args.kw, i) {
kw = CONS(SECOND(HASH_VALUE(fobj->args.kw, i)), kw);
}
}
return LIST(MAKE_FIXNUM(fobj->args.n_req), MAKE_FIXNUM(fobj->args.n_opt),
kw, NILP(fobj->args.rest) ? Qnil : Qt);
}
DEFINE_SYMBOL(declare, "declare");
DEFINE_SYMBOL(name, "name");
DEFINE_SYMBOL(callable, "callable");
DEFINE_SYMBOL(argument_error, "argument-error");
DEFINE_CONDITION_CLASS(argument_error, error);
DEFINE_SYMBOL(function_definition_error, "function-definition-error");
DEFINE_CONDITION_CLASS(function_definition_error, error);
DEFINE_SYMBOL(lambda_list_error, "lambda-list-error");
DEFINE_CONDITION_CLASS(lambda_list_error, function_definition_error);
DEFINE_SYMBOL(function_declare_form_error, "function-declare-form-error");
DEFINE_CONDITION_CLASS(function_declare_form_error, function_definition_error);