scmno****@osdn*****
scmno****@osdn*****
Sun Jun 24 13:44:07 JST 2018
changeset 9abf7dece43a in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=9abf7dece43a user: Agustina Arzille <avarz****@riseu*****> date: Sun Jun 24 04:43:53 2018 +0000 description: Optimize identity comparisons diffstat: compiler.cpp | 49 +++++++++++++++++++++++++++---------------------- 1 files changed, 27 insertions(+), 22 deletions(-) diffs (87 lines): diff -r 2c805fd0d70d -r 9abf7dece43a compiler.cpp --- a/compiler.cpp Sat Jun 23 19:38:02 2018 +0000 +++ b/compiler.cpp Sun Jun 24 04:43:53 2018 +0000 @@ -743,7 +743,24 @@ } static object -always_evals_to (interpreter *interp, object expr) +lookup_ctv (object env, object sym) +{ + for (; env != NIL; env = xcdr (env)) + for (object sub = xcar (env); sub != NIL; sub = xcddr (sub)) + if (sym == xcar (sub)) + return (xcadr (sub)); + + return (sym & ~EXTRA_BIT); +} + +static inline object +lookup_alias (object env, object sym) +{ + return (lookup_ctv (env, sym | EXTRA_BIT)); +} + +static object +always_evals_to (interpreter *interp, object expr, object env) { switch (itype (expr)) { @@ -777,16 +794,21 @@ { xt = global_builtins[idx].code; if ((xt == OPX_(CAR) || xt == OPX_(CDR)) && - (head = always_evals_to (interp, xcadr (expr))) != UNBOUND && + (head = always_evals_to (interp, xcadr (expr), env)) != UNBOUND && xcons_p (head)) return (xt == OPX_(CAR) ? xcar (head) : xcdr (head)); else if (xt == OPX_(IS)) { - object a1 = always_evals_to (interp, xcadr (expr)), - a2 = always_evals_to (interp, xcar (xcddr (expr))); + object a1 = always_evals_to (interp, xcadr (expr), env), + a2 = always_evals_to (interp, xcar (xcddr (expr)), env); if (a1 != UNBOUND && a2 != UNBOUND) return (a1 == a2 ? QP_S(t) : NIL); + + object elem = xcadr (expr); + if (symbol_p (elem) && lookup_alias (env, elem) == elem && + elem == xcar (xcddr (expr))) + return (QP_S(t)); } } @@ -1279,7 +1301,7 @@ else if (atom_p (expr)) return (this->compile_atom (env, tail, expr)); - object e1 = always_evals_to (this->interp, expr); + object e1 = always_evals_to (this->interp, expr, this->ct_env); if (e1 != UNBOUND) // A constant expression is always implicitly quoted. return (this->compile_atom (env, tail, e1, true)); @@ -1970,23 +1992,6 @@ } static object -lookup_ctv (object env, object sym) -{ - for (; env != NIL; env = xcdr (env)) - for (object sub = xcar (env); sub != NIL; sub = xcddr (sub)) - if (sym == xcar (sub)) - return (xcadr (sub)); - - return (sym & ~EXTRA_BIT); -} - -static inline object -lookup_alias (object env, object sym) -{ - return (lookup_ctv (env, sym | EXTRA_BIT)); -} - -static object macroexp_atom (interpreter *interp, object env, object sym) { object s2 = sym;
Fork