• R/O
  • SSH

quipu: Commit

quipu mercurial repository


Commit MetaInfo

Revision5bba0093232150057725306f652a8c67921e6994 (tree)
Time2018-07-13 04:34:22
AuthorAgustina Arzille <avarzille@rise...>
CommiterAgustina Arzille

Log Message

Fix constant folding for non-local symbols

Change Summary

Incremental Difference

diff -r 4d5386cc0e34 -r 5bba00932321 compiler.cpp
--- a/compiler.cpp Wed Jul 11 18:48:24 2018 -0300
+++ b/compiler.cpp Thu Jul 12 16:34:22 2018 -0300
@@ -846,7 +846,7 @@
846846 }
847847
848848 static object
849-always_evals_to (interpreter *interp, object expr, object env)
849+cfold (interpreter *interp, object expr, object env, object ct_env)
850850 {
851851 switch (itype (expr))
852852 {
@@ -880,20 +880,20 @@
880880 {
881881 xt = global_builtins[idx].code;
882882 if ((xt == OPX_(CAR) || xt == OPX_(CDR)) &&
883- (head = always_evals_to (interp, xcadr (expr), env)) != UNBOUND &&
883+ (head = cfold (interp, xcadr (expr), env, ct_env)) != UNBOUND &&
884884 xcons_p (head))
885885 return (xt == OPX_(CAR) ? xcar (head) : xcdr (head));
886886 else if (xt == OPX_(IS))
887887 {
888- object a1 = always_evals_to (interp, xcadr (expr), env),
889- a2 = always_evals_to (interp, xcar (xcddr (expr)), env);
888+ object a1 = cfold (interp, xcadr (expr), env, ct_env),
889+ a2 = cfold (interp, xcar (xcddr (expr)), env, ct_env);
890890
891891 if (a1 != UNBOUND && a2 != UNBOUND)
892892 return (a1 == a2 ? QP_S(t) : NIL);
893893
894894 object elem = xcadr (expr);
895- if (symbol_p (elem) && lookup_alias (env, elem) == elem &&
896- elem == xcar (xcddr (expr)))
895+ if (symbol_p (elem) && elem == xcar (xcddr (expr)) &&
896+ lookup_alias (ct_env, elem) == elem && in_env (elem, env))
897897 return (QP_S(t));
898898 }
899899 }
@@ -1409,7 +1409,7 @@
14091409 else if (atom_p (expr))
14101410 return (this->compile_atom (env, tail, expr));
14111411
1412- object e1 = always_evals_to (this->interp, expr, this->ct_env);
1412+ object e1 = cfold (this->interp, expr, env, this->ct_env);
14131413 if (e1 != UNBOUND)
14141414 // A constant expression is always implicitly quoted.
14151415 return (this->compile_atom (env, tail, e1, true));
diff -r 4d5386cc0e34 -r 5bba00932321 eval.cpp
--- a/eval.cpp Wed Jul 11 18:48:24 2018 -0300
+++ b/eval.cpp Thu Jul 12 16:34:22 2018 -0300
@@ -198,7 +198,7 @@
198198 captenv (interpreter *interp, uint32_t lastf)
199199 {
200200 uint32_t cf = interp->cur_frame;
201- object *lp = nullptr;
201+ object dummy, *lp = &dummy;
202202 object *retp = &interp->stack[cf - interpreter::frame_size -
203203 as_int (interp->stack[cf - 3])];
204204
@@ -216,9 +216,7 @@
216216 array *ap = as_array (alloc_array (interp, sx + 1, NIL));
217217 int nbp = cf - interpreter::frame_size - sx;
218218 copy_objs (ap->data, &interp->stack[nbp], sx + 1);
219- interp->stack[nbp] = interp->alval;
220- if (lp != nullptr)
221- *lp = interp->alval;
219+ interp->stack[nbp] = *lp = interp->alval;
222220
223221 lp = &ap->data[sx];
224222 interp->dynframe_set_captured (cf - 1);
@@ -739,14 +737,7 @@
739737 else
740738 ix = fetch32 (ip), n = fetch32 (ip);
741739
742- if (nargs < ix)
743- interp->raise2 ("arg-error", "apply: too few arguments");
744- else if ((int32_t)n <= 0)
745- n = -n;
746- else if (nargs > n)
747- interp->raise2 ("arg-error", "apply: too many arguments");
748-
749- if (n > nargs)
740+ if ((n = abs (n)) > nargs)
750741 {
751742 n -= nargs;
752743 stkend += n;
@@ -853,7 +844,14 @@
853844 OP_(CLOSURE):
854845 {
855846 function *fp = as_fct (alloc_fct (interp));
856- memcpy (fp, as_fct (r_stkend (1)), sizeof (*fp));
847+ const auto infct = as_fct (r_stkend (1));
848+
849+ fp->max_sp = infct->max_sp;
850+ fp->min_argc = infct->min_argc;
851+ fp->max_argc = infct->max_argc;
852+ fp->bcode = infct->bcode;
853+ fp->vals = infct->vals;
854+
857855 r_stkend(1) = fp->as_obj ();
858856 fp->env = captenv (interp, lastf);
859857 NEXT_OP;
Show on old repository browser