scmno****@osdn*****
scmno****@osdn*****
Fri Jun 22 23:37:29 JST 2018
changeset c7b157951a94 in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=c7b157951a94 user: Agustina Arzille <avarz****@riseu*****> date: Fri Jun 22 11:37:21 2018 -0300 description: Be more strict in top-level forms diffstat: compiler.cpp | 22 +++++++++++++++++----- 1 files changed, 17 insertions(+), 5 deletions(-) diffs (72 lines): diff -r f98d4eb31697 -r c7b157951a94 compiler.cpp --- a/compiler.cpp Fri Jun 22 00:11:38 2018 +0000 +++ b/compiler.cpp Fri Jun 22 11:37:21 2018 -0300 @@ -73,7 +73,8 @@ { flg_outer_ref = 0x01, flg_captured = 0x02, - flg_emitted_captenv = 0x04 + flg_emitted_captenv = 0x04, + flg_toplevel = 0x08 }; class frame_data @@ -133,12 +134,15 @@ return (this->frames.back ()); } - bc_emitter (interpreter *ip) : interp (ip), sp (ip->stkdiff ()) + bc_emitter (interpreter *ip, bool top = false) : + interp (ip), sp (ip->stkdiff ()) { this->xdo.expr.car = UNBOUND; this->ct_env = NIL; this->ctable.cmp.ip = ip; this->push_f (); + if (top) + this->rflags |= flg_toplevel; } ~bc_emitter () @@ -1338,7 +1342,9 @@ return (EVR_CONT); case SF_RETURN: - if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) + if (this->rflags & flg_toplevel) + this->interp->raise2 ("syntax-error", "'return' outside function"); + else if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) specform_error (this->interp, "return", SPECFORM_DOTTED); else if (xcddr (expr) != NIL) specform_error (this->interp, "return", SPECFORM_TOOMANY); @@ -1349,7 +1355,9 @@ case SF_YIELD: // (yield $x) is equivalent to (return (%make-cont $x)) - if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) + if (this->rflags & flg_toplevel) + this->interp->raise2 ("syntax-error", "'yield' outside function"); + else if (xcdr (expr) != NIL && !xcons_p (xcdr (expr))) specform_error (this->interp, "yield", SPECFORM_DOTTED); else if (xcddr (expr) != NIL) specform_error (this->interp, "yield", SPECFORM_TOOMANY); @@ -1379,6 +1387,10 @@ case SF_CALLCC: { + if (this->rflags & flg_toplevel) + this->interp->raise2 ("syntax-error", + "'call/cc' outside function"); + bc_emitter bc (this->interp); cons cc_env; @@ -1916,7 +1928,7 @@ object compile_expr (interpreter *interp, object expr) { - bc_emitter bc (interp); + bc_emitter bc (interp, true); bc.compile_in (NIL, true, expr); bc.emit (OPX_(RET));
Fork