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

Make backtraces better

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-14 00:00:42 -08:00
parent f1d3a71c32
commit 460bcf507b
4 changed files with 100 additions and 221 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/lisp.c
View File

@ -75,6 +75,7 @@ DEF_STATIC_SYMBOL(allow_other_keys, "&allow-other-keys");
DEF_STATIC_SYMBOL(rest, "&rest");
DEF_STATIC_SYMBOL(declare, "declare");
DEF_STATIC_SYMBOL(name, "name");
DEF_STATIC_SYMBOL(no_backtrace, "no-backtrace");
DEF_STATIC_SYMBOL(symbol, "symbol");
DEF_STATIC_SYMBOL(integer, "integer");
@ -173,6 +174,7 @@ static bool held_refs_callback(void *obj, RefcountList **held, void *ignored) {
case TYPE_FUNCTION: {
LispFunction *fn = obj;
*held = refcount_list_push(*held, fn->name);
*held = refcount_list_push(*held, fn->props);
*held = refcount_list_push(*held, fn->return_tag);
*held = refcount_list_push(*held, fn->args);
*held = refcount_list_push(*held, fn->kwargs);
@ -351,7 +353,7 @@ 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, LispVal *doc,
bool is_macro) {
bool is_macro, LispVal *props) {
CONSTRUCT_OBJECT(self, LispFunction, TYPE_FUNCTION);
self->is_builtin = false;
self->is_macro = is_macro;
@ -375,6 +377,7 @@ LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
self->lexenv = refcount_ref(lexenv);
self->doc = refcount_ref(doc);
self->body = refcount_ref(body);
self->props = refcount_ref(props);
return LISPVAL(self);
}
@ -1007,7 +1010,7 @@ static LispVal *call_function(LispVal *func, LispVal *args,
refcount_ref(args);
WITH_CLEANUP(args, {
WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(
refcount_ref(fobj->name), refcount_ref(args),
refcount_ref(fobj), refcount_ref(args),
false, // make sure the lexenv is nil
{
the_stack->hidden = false;
@ -1205,7 +1208,7 @@ DEFUN(macroexpand_1, "macroexpand-1", (LispVal * form, LispVal *lexical_macros),
WITH_CLEANUP(return_ptr, {
WITH_CLEANUP(fobj, {
WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(
refcount_ref(HEAD(form)), refcount_ref(TAIL(form)), false,
refcount_ref(fobj), refcount_ref(TAIL(form)), false,
{
the_stack->hidden = false;
if (!NILP(fobj->return_tag)) {
@ -1590,14 +1593,20 @@ DEFMACRO(
// true if the form was a declare form
static bool parse_function_declare(LispVal *form, LispVal **name_ptr,
bool *is_macro_ptr) {
bool *is_macro_ptr, LispVal *props_ht) {
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) {
} else if (is_macro_ptr
&& (elt == Qmacro
|| (PAIRP(elt) && HEAD(elt) == Qmacro))) {
*is_macro_ptr = true;
} else if (SYMBOLP(elt)) {
puthash(props_ht, elt, Qt);
} else if (PAIRP(elt) && SYMBOLP(HEAD(elt)) && LISTP(TAIL(elt))) {
puthash(props_ht, HEAD(elt), HEAD(TAIL(elt)));
}
}
return true;
@ -1663,7 +1672,8 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body), "(args &rest body)",
}
LispVal *name = Qunbound;
bool is_macro = false;
if (parse_function_declare(HEAD(body), &name, &is_macro)) {
LispVal *props_ht = make_lisp_hashtable(Qnil, Qnil);
if (parse_function_declare(HEAD(body), &name, &is_macro, props_ht)) {
body = TAIL(body);
}
LispVal *return_tag;
@ -1673,21 +1683,26 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body), "(args &rest body)",
tag_name = Qnil;
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) Qnil)->name));
} else {
CHECK_TYPE(TYPE_SYMBOL, name);
if (!SYMBOLP(name)) {
refcount_unref(props_ht);
CHECK_TYPE(TYPE_SYMBOL, name);
}
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
tag_name = name;
}
LispVal *func = Qnil;
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, doc,
is_macro);
WITH_CLEANUP(props_ht, {
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,
doc, is_macro, props_ht);
});
});
});
});
@ -1838,6 +1853,12 @@ DEFUN(function_docstr, "function-docstr", (LispVal * func), "(func)",
return retval;
}
DEFUN(function_properties, "function-properties", (LispVal * func), "(func)",
"Return the property hash table of FUNC.") {
CHECK_TYPE(TYPE_FUNCTION, func);
return refcount_ref(((LispFunction *) func)->props);
}
void free_opt_arg_desc(void *obj) {
struct OptArgDesc *oad = obj;
refcount_unref(oad->name);
@ -3716,7 +3737,9 @@ static int64_t internal_print(void *obj, int64_t fd, bool readably,
int64_t np = CHECK_IO_RESULT(dprintf(fd, "["), fd);
for (size_t i = 0; i < v->length; ++i) {
np += internal_print(v->data[i], fd, readably, true);
np += CHECK_IO_RESULT(dprintf(fd, " "), fd);
if (i != v->length - 1) {
np += CHECK_IO_RESULT(dprintf(fd, " "), fd);
}
}
np += CHECK_IO_RESULT(dprintf(fd, "]"), fd);
return np;
@ -4228,6 +4251,7 @@ static void register_symbols_and_functions(void) {
REGISTER_SYMBOL(rest);
REGISTER_SYMBOL(declare);
REGISTER_SYMBOL(name);
REGISTER_SYMBOL(no_backtrace);
REGISTER_SYMBOL(comma);
REGISTER_SYMBOL(comma_at);
REGISTER_SYMBOL(backquote);
@ -4316,6 +4340,7 @@ static void register_symbols_and_functions(void) {
REGISTER_FUNCTION(builtinp);
REGISTER_FUNCTION(special_form_p);
REGISTER_FUNCTION(function_docstr);
REGISTER_FUNCTION(function_properties);
// ###########################
// # Pair and List Functions #