Blocks don't evaluate their name

This commit is contained in:
2026-09-05 07:50:21 -07:00
parent 8ec08a55ea
commit 58089ce956
3 changed files with 22 additions and 12 deletions
+18 -2
View File
@@ -102,8 +102,7 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
return macroexpand_lambda_form(form, lexical_macros);
} else if (IS(quote)) {
return form;
} else if (IS(progn) || IS(if) || IS(and) || IS(or) || IS(block)
|| IS(return_from)) {
} else if (IS(progn) || IS(if) || IS(and) || IS(or)) {
if (LISTP(XCDR(form))) {
return CONS(XCAR(form),
macroexpand_list(XCDR(form), lexical_macros));
@@ -120,6 +119,9 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
}
return CONS(XCAR(form), args);
} else if (IS(let)) {
if (!CONSP(XCDR(form))) {
return form;
}
LispVal *bindings = Fcopy_list(SECOND(form));
DOTAILS(rest, bindings) {
if (!LISTP(rest)) {
@@ -134,6 +136,20 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
LispVal *prog =
macroexpand_list(XCDR_SAFE(XCDR_SAFE(form)), lexical_macros);
return CONS(XCAR(form), CONS(bindings, prog));
} else if (IS(block)) {
if (!CONSP(XCDR(form)) || !CONSP(XCDR(XCDR(form)))) {
return form;
}
return CONS(FIRST(form),
CONS(SECOND(form),
macroexpand_list(XCDR(XCDR(form)), lexical_macros)));
} else if (IS(return_from)) {
if (!CONSP(XCDR(form)) || !LISTP(XCDR(XCDR(form)))) {
return form;
}
return CONS(
FIRST(form),
CONS(SECOND(form), Fmacroexpand_all(THIRD(form), lexical_macros)));
} else if (IS(declare)) {
return form;
}
+3 -10
View File
@@ -365,16 +365,9 @@ noreturn void lisp_signal(LispVal *name, LispVal *data) {
top_of_stack_exception_handler(name, data);
}
static void check_block_name(LispVal *name) {
if (!SYMBOLP(name) || NILP(name)) {
signal_type_error(name, LIST(Qsymbol, LIST(Qnot, Qnull)));
}
}
DEFSPECIAL(block, "block", (LispVal * name, LispVal *body), "(name &rest body)",
"") {
name = eval(name);
check_block_name(name);
CHECK_TYPE(name, TYPE_SYMBOL);
if (!SYMBOLP(name))
CHECK_TYPE(name, TYPE_SYMBOL);
LispVal *volatile return_value = Qnil;
@@ -406,8 +399,8 @@ static LispVal *lookup_block_tag(LispVal *name) {
DEFSPECIAL(return_from, "return-from", (LispVal * name, LispVal *value),
"(name &optional value)", "") {
name = eval(name);
check_block_name(name);
CHECK_TYPE(name, TYPE_SYMBOL);
value = eval(value);
LispVal *tag = lookup_block_tag(name);
if (tag != Qunbound) {
for (ptrdiff_t i = the_stack.depth; i >= 0; --i) {