scmno****@osdn*****
scmno****@osdn*****
Mon Jun 25 13:08:03 JST 2018
changeset 280a5b1d438f in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=280a5b1d438f user: Agustina Arzille <avarz****@riseu*****> date: Mon Jun 25 04:07:47 2018 +0000 description: Small refactor diffstat: compiler.cpp | 38 ++++++++++++++++++++++---------------- eval.cpp | 2 +- 2 files changed, 23 insertions(+), 17 deletions(-) diffs (130 lines): diff -r 9abf7dece43a -r 280a5b1d438f compiler.cpp --- a/compiler.cpp Sun Jun 24 04:43:53 2018 +0000 +++ b/compiler.cpp Mon Jun 25 04:07:47 2018 +0000 @@ -1124,8 +1124,8 @@ int r = this->compile_cond (env, false, xcar (forms)) & ~EVR_SE; - if (r == EVR_IRET) - // Ignore every expression after the return form. + if (r == EVR_IRET || r == EVR_BRK || r == EVR_CONT) + // Ignore every expression after this form. return (r); else if (r != EVR_NIL && r != EVR_ATOM) this->emit (OPX_(POP)); @@ -1294,6 +1294,14 @@ OPX_(SETA), OPX_(SETC), OPX_(SETG), OPX_(SETAP), OPX_(SETG) }; +[[noreturn]] static void +outside_error (interpreter *interp, const char *form, const char *where) +{ + char buf[64]; + sprintf (buf, "'%s' outside %s", form, where); + interp->raise2 ("syntax-error", buf); +} + int bc_emitter::compile_in (object env, bool tail, object expr) { if (symbol_p (expr)) @@ -1368,7 +1376,7 @@ case SF_BREAK: if (!this->whl) - this->interp->raise2 ("syntax-error", "'break' outside while loop"); + outside_error (this->interp, "break", "while loop"); else if (!xcons_p (xcdr (expr))) specform_error (this->interp, "break", SPECFORM_DOTTED); else if (xcddr (expr) != NIL) @@ -1381,8 +1389,7 @@ case SF_CONTINUE: if (!this->whl) - this->interp->raise2 ("syntax-error", - "'continue' outside while loop"); + outside_error (this->interp, "continue", "while loop"); else if (xcdr (expr) != NIL) this->interp->raise2 ("syntax-error", "invalid argument in 'continue' expression"); @@ -1394,7 +1401,7 @@ case SF_RETURN: if (this->rflags & flg_toplevel) - this->interp->raise2 ("syntax-error", "'return' outside function"); + outside_error (this->interp, "return", "function"); else if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) specform_error (this->interp, "return", SPECFORM_DOTTED); else if (xcddr (expr) != NIL) @@ -1407,7 +1414,7 @@ case SF_YIELD: // (yield $x) is equivalent to (return (%make-cont $x)) if (this->rflags & flg_toplevel) - this->interp->raise2 ("syntax-error", "'yield' outside function"); + outside_error (this->interp, "yield", "function"); else if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) specform_error (this->interp, "yield", SPECFORM_DOTTED); else if (xcddr (expr) != NIL) @@ -1439,8 +1446,7 @@ case SF_CALLCC: { if (this->rflags & flg_toplevel) - this->interp->raise2 ("syntax-error", - "'call/cc' outside function"); + outside_error (this->interp, "call/cc", "function"); bc_emitter bc (this->interp); cons cc_env; @@ -1460,6 +1466,9 @@ } case SF_RECUR: + if (this->rflags & flg_toplevel) + outside_error (this->interp, "recur", "function"); + { this->emit (OPX_(LOADNIL)); // XXX: Should be LOADCALLER int n = this->compile_arglist (env, xcdr (expr)); @@ -1504,10 +1513,8 @@ class arglist { public: - cons *ptr; - int n; - - arglist () : ptr (0), n (0) {} + cons *ptr = nullptr; + int n = 0; void add_sym (cons *basep, object sym) { @@ -1973,8 +1980,7 @@ object compile_fct (interpreter *interp, object expr) { - bc_emitter bc (interp); - return (bc.compile_fct (NIL, expr)); + return (bc_emitter(interp).compile_fct (NIL, expr)); } object compile_expr (interpreter *interp, object expr) @@ -2025,7 +2031,7 @@ for (expr = xcdr (expr); expr != NIL; expr = xcdr (expr), ++n) { if (!xcons_p (expr)) - interp->raise2 ("type-error", "macro expasion requires " + interp->raise2 ("arg-error", "macro expasion requires " "a proper list as arguments"); interp->push (macroexp_atom (interp, env, xcar (expr))); diff -r 9abf7dece43a -r 280a5b1d438f eval.cpp --- a/eval.cpp Sun Jun 24 04:43:53 2018 +0000 +++ b/eval.cpp Mon Jun 25 04:07:47 2018 +0000 @@ -518,7 +518,7 @@ interp->raise2 ("type-error", "apply: argument to 'cadr' is not a cons"); - *(stkend - 1) = xcdr (*(stkend - 1)); + r_stkend(1) = xcdr (r_stkend (1)); if (!xcons_p (r_stkend (1))) interp->raise2 ("type-error", "apply: argument to 'cadr' is not a cons");
Fork