diff --git a/lisp/kernel.gl b/lisp/kernel.gl index b3ee1ae..e4d2fd9 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -19,6 +19,7 @@ body))) (defun princln (datum &optional print-char-fun) + "`princ' DATUM to PRINT-CHAR-FUN. Then print a newline." (princ datum print-char-fun) (funcall (or print-char-fun 'write-byte) ?\n)) diff --git a/src/macro.c b/src/macro.c index 4a517cc..b0db236 100644 --- a/src/macro.c +++ b/src/macro.c @@ -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; } diff --git a/src/stack.c b/src/stack.c index c6cc4ca..4369d4a 100644 --- a/src/stack.c +++ b/src/stack.c @@ -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) {