scmno****@osdn*****
scmno****@osdn*****
Wed Jun 13 12:15:06 JST 2018
changeset 57dab2c70117 in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=57dab2c70117 user: Agustina Arzille <avarz****@riseu*****> date: Wed Jun 13 03:14:52 2018 +0000 description: Improve 'let' form compilation diffstat: compiler.cpp | 118 ++++++++++++++++++++++++++++++++++------------------------ 1 files changed, 69 insertions(+), 49 deletions(-) diffs (184 lines): diff -r 7d3f6c2ffa43 -r 57dab2c70117 compiler.cpp --- a/compiler.cpp Tue Jun 12 19:26:27 2018 -0300 +++ b/compiler.cpp Wed Jun 13 03:14:52 2018 +0000 @@ -1697,40 +1697,68 @@ } static int -eval_ctv (bc_emitter& self, object ev, cons *ctvs, int nctvs) +ctv_letdef (object ev) { if (!cons_p (ev) || !nksymbol_p (xcar (ev))) return (-1); const string *np = as_str (symname (xcar (ev))); - int ret = 0; - - if (np->nbytes == 5 && (memcmp ("macro", np->data, 5) == 0 || - (memcmp ("alias", np->data, 5) == 0 && (ret = 1)))) + if (np->nbytes == 5) { - if (ret) - eval (self.interp, xcadr (ev)); - else + if (memcmp ("macro", np->data, 5) == 0) + return (0); + else if (memcmp ("alias", np->data, 5) == 0) + return (1); + } + + return (-1); +} + +static int +eval_ctv (bc_emitter& self, object bindings, + cons *ctvs, int& nctv, object*& cep) +{ + object ev = xcadr (bindings); + int r = ctv_letdef (ev); + if (r < 0) + return (r); + else if (r == 1) + eval (self.interp, xcadr (ev)); + else if (r == 0) + { + bc_emitter tmp (self.interp); + object prev = NIL; + + tmp.ct_env = self.ct_env; + if (nctv > 0) { - bc_emitter tmp (self.interp); - object prev = NIL; - - tmp.ct_env = self.ct_env; - if (nctvs > 0) - { - prev = ctvs[nctvs - 1].cdr; - ctvs[nctvs - 1].cdr = NIL; - } - - tmp.compile_fct (NIL, xcdr (ev)); - if (nctvs > 0) - ctvs[nctvs - 1].cdr = prev; + prev = ctvs[nctv - 1].cdr; + ctvs[nctv - 1].cdr = NIL; } - return (ret); + tmp.compile_fct (NIL, xcdr (ev)); + if (nctv > 0) + ctvs[nctv - 1].cdr = prev; } - return (-1); + self.interp->push (self.interp->retval); + ctvs[nctv].car = xcar (bindings) | (r ? EXTRA_BIT : 0); + ctvs[nctv].cdr = ctvs[nctv + 1].as_obj (); + xcar(ctvs[nctv].cdr) = self.interp->retval; + xcdr(ctvs[nctv].cdr) = ctvs[nctv + 2].as_obj (); + cep = &ctvs[nctv += 2].cdr; + + return (r); +} + +static int +count_let_nlex (object bindings) +{ + int nlex = 0; + for (; bindings != NIL; bindings = xcddr (bindings)) + nlex += ctv_letdef (xcadr (bindings)) < 0; + + return (nlex); } static inline bool @@ -1798,7 +1826,7 @@ cons t1, t2; object *sep = &syms[0].cdr, *cep = &ctvs[0].cdr; - int nctv = 0, nlex = 0, aarg; + int nctv = 0, nlex = 0; bool first = true; // Link the lexical and compile-time environments. @@ -1811,25 +1839,17 @@ t2.cdr = this->ct_env; this->ct_env = t2.as_obj (); + nargs = count_let_nlex (bindings); + for (; bindings != NIL; bindings = xcddr (bindings)) { - object ev = xcadr (bindings); *sep = *cep = NIL; - int nctv_p = eval_ctv (*this, ev, ctvs, nctv); - if (nctv_p >= 0) - { /* This is a compile-time (i.e: macro or alias) definition, - * rather than a lexical or dynamic binding. */ - this->interp->push (this->interp->retval); - ctvs[nctv].car = xcar (bindings) | (nctv_p ? EXTRA_BIT : 0); - ctvs[nctv].cdr = ctvs[nctv + 1].as_obj (); - xcar(ctvs[nctv].cdr) = this->interp->retval; - xcdr(ctvs[nctv].cdr) = ctvs[nctv + 2].as_obj (); - cep = &ctvs[nctv += 2].cdr; - continue; - } - - if (first) + if (eval_ctv (*this, bindings, ctvs, nctv, cep) >= 0) + /* This is a compile-time (i.e: macro or alias) definition, + * rather than a lexical or dynamic binding. */ + continue; + else if (first) { /* A 'let' form must be preceeded by a stack frame, and (optionally) * an environment capture in case the body refers to a variable * from the outer frame. Here we emit a few placeholders that we'll @@ -1840,14 +1860,13 @@ this->rflags |= flg_emitted_captenv; } - this->emit (OPX_(MKFRAME), intobj (0)); - aarg = (int)this->code.size () - 1; + this->emit (OPX_(MKFRAME), intobj (nargs)); ++this->cur_f().stkdisp; this->push_f (); first = false; } - object prev = NIL; + object prev = NIL, ev = xcadr (bindings); if (nlex > 0) { prev = syms[nlex - 1].cdr; @@ -1863,8 +1882,14 @@ this->emit (OPX_(BIND), xcar (bindings)); continue; } + else if (!(this->rflags & flg_captured)) + this->emit (OPX_(SETAPOP), intobj (nlex + this->cur_f().acc)); else - this->emit (OPX_(SETAPOP), intobj (nlex + this->cur_f().acc)); + { + this->emit (OPX_(SETAP), + intobj (this->cur_f().acc + nargs), intobj (nlex)); + this->emit (OPX_(POP)); + } ++this->cur_f().nargs; syms[nlex].car = xcar (bindings); @@ -1875,12 +1900,7 @@ if (nctv > 0) ctvs[nctv - 1].cdr = NIL; if (!first) - { - syms[nlex - 1].cdr = NIL; - this->code[aarg] = intobj (nlex); - if (nlex > 0xff) - this->code[aarg - 1] = OPX_(MKFRAMEL); - } + syms[nlex - 1].cdr = NIL; int r = this->compile_do (t1.as_obj (), tail && !dbind, xcdr (expr)); this->ct_env = t2.cdr;
Fork