Blocks don't evaluate their name
This commit is contained in:
+18
-2
@@ -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
@@ -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) {
|
||||
|
||||
Reference in New Issue
Block a user