| リビジョン | 5bba0093232150057725306f652a8c67921e6994 (tree) |
|---|---|
| 日時 | 2018-07-13 04:34:22 |
| 作者 | Agustina Arzille <avarzille@rise...> |
| コミッター | Agustina Arzille |
Fix constant folding for non-local symbols
compiler.cpp (diff) eval.cpp (diff)| @@ -846,7 +846,7 @@ | ||
| 846 | 846 | } |
| 847 | 847 | |
| 848 | 848 | static object |
| 849 | -always_evals_to (interpreter *interp, object expr, object env) | |
| 849 | +cfold (interpreter *interp, object expr, object env, object ct_env) | |
| 850 | 850 | { |
| 851 | 851 | switch (itype (expr)) |
| 852 | 852 | { |
| @@ -880,20 +880,20 @@ | ||
| 880 | 880 | { |
| 881 | 881 | xt = global_builtins[idx].code; |
| 882 | 882 | 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 && | |
| 884 | 884 | xcons_p (head)) |
| 885 | 885 | return (xt == OPX_(CAR) ? xcar (head) : xcdr (head)); |
| 886 | 886 | else if (xt == OPX_(IS)) |
| 887 | 887 | { |
| 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); | |
| 890 | 890 | |
| 891 | 891 | if (a1 != UNBOUND && a2 != UNBOUND) |
| 892 | 892 | return (a1 == a2 ? QP_S(t) : NIL); |
| 893 | 893 | |
| 894 | 894 | 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)) | |
| 897 | 897 | return (QP_S(t)); |
| 898 | 898 | } |
| 899 | 899 | } |
| @@ -1409,7 +1409,7 @@ | ||
| 1409 | 1409 | else if (atom_p (expr)) |
| 1410 | 1410 | return (this->compile_atom (env, tail, expr)); |
| 1411 | 1411 | |
| 1412 | - object e1 = always_evals_to (this->interp, expr, this->ct_env); | |
| 1412 | + object e1 = cfold (this->interp, expr, env, this->ct_env); | |
| 1413 | 1413 | if (e1 != UNBOUND) |
| 1414 | 1414 | // A constant expression is always implicitly quoted. |
| 1415 | 1415 | return (this->compile_atom (env, tail, e1, true)); |
| @@ -198,7 +198,7 @@ | ||
| 198 | 198 | captenv (interpreter *interp, uint32_t lastf) |
| 199 | 199 | { |
| 200 | 200 | uint32_t cf = interp->cur_frame; |
| 201 | - object *lp = nullptr; | |
| 201 | + object dummy, *lp = &dummy; | |
| 202 | 202 | object *retp = &interp->stack[cf - interpreter::frame_size - |
| 203 | 203 | as_int (interp->stack[cf - 3])]; |
| 204 | 204 |
| @@ -216,9 +216,7 @@ | ||
| 216 | 216 | array *ap = as_array (alloc_array (interp, sx + 1, NIL)); |
| 217 | 217 | int nbp = cf - interpreter::frame_size - sx; |
| 218 | 218 | 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; | |
| 222 | 220 | |
| 223 | 221 | lp = &ap->data[sx]; |
| 224 | 222 | interp->dynframe_set_captured (cf - 1); |
| @@ -739,14 +737,7 @@ | ||
| 739 | 737 | else |
| 740 | 738 | ix = fetch32 (ip), n = fetch32 (ip); |
| 741 | 739 | |
| 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) | |
| 750 | 741 | { |
| 751 | 742 | n -= nargs; |
| 752 | 743 | stkend += n; |
| @@ -853,7 +844,14 @@ | ||
| 853 | 844 | OP_(CLOSURE): |
| 854 | 845 | { |
| 855 | 846 | 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 | + | |
| 857 | 855 | r_stkend(1) = fp->as_obj (); |
| 858 | 856 | fp->env = captenv (interp, lastf); |
| 859 | 857 | NEXT_OP; |
Fork