scmno****@osdn*****
scmno****@osdn*****
Tue Jun 5 04:34:53 JST 2018
changeset 41f759fb7070 in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=41f759fb7070 user: Agustina Arzille <avarz****@riseu*****> date: Mon Jun 04 16:34:44 2018 -0300 description: Optimize interfaces with the new event protocol diffstat: builtins.cpp | 8 ++------ compiler.cpp | 14 +++++++------- cons.cpp | 57 +++++++++++++++++++++++++++------------------------------ 3 files changed, 36 insertions(+), 43 deletions(-) diffs (196 lines): diff -r 0d8c126c26e1 -r 41f759fb7070 builtins.cpp --- a/builtins.cpp Mon Jun 04 14:52:02 2018 -0300 +++ b/builtins.cpp Mon Jun 04 16:34:44 2018 -0300 @@ -480,8 +480,6 @@ // (%make-exception type message) DEFBUILTIN (p_make_exception) { - valref exc (interp, alloc_cons (interp)); - if (argc != 2) { char buf[128]; @@ -492,12 +490,10 @@ valref sym (interp, alloc_sym (interp)); symname(*sym) = string::make (interp, "arg-error"); - xcar(*exc) = *sym, xcdr(*exc) = *msg; - interp->raise (*exc); + interp->raise (cons::make (interp, *sym, *msg)); } - xcar(*exc) = argv[0], xcdr(*exc) = argv[1]; - qp_return (*exc); + return (cons::make (interp, argv[0], argv[1])); } // (car arg) diff -r 0d8c126c26e1 -r 41f759fb7070 compiler.cpp --- a/compiler.cpp Mon Jun 04 14:52:02 2018 -0300 +++ b/compiler.cpp Mon Jun 04 16:34:44 2018 -0300 @@ -2931,13 +2931,13 @@ static object macroexp_atom (interpreter *interp, object env, object sym) { - valref s2 (interp, sym); - - if (nksymbol_p (*s2) && (*s2 = lookup_alias (env, sym)) == sym && - (as_symbol(*s2)->flagged_p (symbol::alias_flag))) - *s2 = symval (*s2); - - qp_return (*s2); + object s2 = sym; + + if (nksymbol_p (s2) && (s2 = lookup_alias (env, sym)) == sym && + (as_symbol(s2)->flagged_p (symbol::alias_flag))) + s2 = symval (s2); + + qp_return (s2); } static object diff -r 0d8c126c26e1 -r 41f759fb7070 cons.cpp --- a/cons.cpp Mon Jun 04 14:52:02 2018 -0300 +++ b/cons.cpp Mon Jun 04 16:34:44 2018 -0300 @@ -38,23 +38,23 @@ } static object& -cons_ref (interpreter *interp, const char *caller, int idx, valref& ref) +cons_ref (interpreter *interp, const char *caller, int idx, object& obj) { if (idx < 0) { object tail; - if ((idx += len_L (interp, *ref, tail)) < 0) + if ((idx += len_L (interp, obj, tail)) < 0) interp->raise_oob (caller, 0, -1); } while (true) { - if (!cons_p (*ref)) + if (!cons_p (obj)) interp->raise_oob (caller, 0, -1); else if (--idx < 0) - return (*ref); + return (obj); - *ref = xcdr (*ref); + obj = xcdr (obj); } } @@ -67,8 +67,7 @@ interp->raise2 ("type-error", "nthcdr: second argument must be a cons"); - valref ref (interp, cons); - qp_return (cons_ref (interp, "nthcdr", as_int (idx), ref)); + qp_return (cons_ref (interp, "nthcdr", as_int (idx), cons)); } object get_L (interpreter *interp, object cons, @@ -79,8 +78,7 @@ else if (qp_unlikely (!int_p (idx))) interp->raise2 ("type-error", "get:cons: value is not an integer"); - valref ref (interp, cons); - qp_return (xcar (cons_ref (interp, "get:cons", as_int (idx), ref))); + qp_return (xcar (cons_ref (interp, "get:cons", as_int (idx), cons))); } object nput_L (interpreter *interp, object cons, @@ -89,8 +87,7 @@ if (qp_unlikely (!int_p (idx))) interp->raise2 ("type-error", "nput:cons: value is not an integer"); - valref ref (interp, cons); - xcar(cons_ref (interp, "nput:cons", as_int (idx), ref)) = val; + xcar(cons_ref (interp, "nput:cons", as_int (idx), cons)) = val; qp_return (val); } @@ -151,10 +148,10 @@ interp->raise2 ("index-error", "subseq:cons: indices out of bounds"); valref r1 (interp, cons); - object l1 = cons_ref (interp, "subseq:cons", i1, r1); + object l1 = cons_ref (interp, "subseq:cons", i1, *r1); valref r2 (interp, l1); int rlen = i2 - i1; - cons_ref (interp, "subseq:cons", rlen, r2); + cons_ref (interp, "subseq:cons", rlen, *r2); object ret = alloc_cons (interp, rlen); for (int i = 0; i < rlen; ++i, ret = xcdr (ret), l1 = xcdr (l1)) @@ -214,21 +211,21 @@ object nreverse_L (interpreter *interp, object obj) { - valref prev (interp, NIL), tmp (interp, obj); - object *pp = &*prev, *pt = &*tmp; + object prev = NIL, tmp = obj; + object *pp = &prev; - while (*tmp != NIL) + while (tmp != NIL) { - interp->aux = xcdr (*pt); - if (!xcons_p (interp->aux)) - interp->raise2 ("type-error", "nreverse:cons: " + object qx = xcdr (tmp); + if (!xcons_p (qx)) + interp->raise2 ("arg-error", "nreverse:cons: " "argument is not a proper list"); - xcdr(*pt) = *pp; - *pp = *pt, *pt = interp->aux; + xcdr(tmp) = *pp; + *pp = tmp, tmp = qx; } - qp_return (*prev); + qp_return (prev); } object reverse_L (interpreter *interp, object obj) @@ -323,7 +320,7 @@ else if (argv[i] != NIL) break; - valref ret (interp, argv[i++]), tail (interp, last_L (interp, *ret)); + object ret = argv[i++], tail = last_L (interp, ret); for (; i < argc - 1; ++i) { @@ -332,12 +329,12 @@ else if (!xcons_p (argv[i])) interp->raise2 ("arg-error", "nconcat: arguments must be lists"); - xcdr(*tail) = argv[i]; - *tail = last_L (interp, argv[i]); + xcdr(tail) = argv[i]; + tail = last_L (interp, argv[i]); } - xcdr(*tail) = argv[argc - 1]; - qp_return (*ret); + xcdr(tail) = argv[argc - 1]; + qp_return (ret); } #if 0 @@ -377,9 +374,9 @@ if (!xcons_p (lst)) interp->raise2 ("arg-error", "nrevconc: first argument must be a list"); - valref ret (interp, lst); - nreverse_L (interp, *ret); // sets interp->retval. - xcdr(*ret) = tail; + object ret = lst; + nreverse_L (interp, ret); // sets interp->retval. + xcdr(ret) = tail; return (interp->retval); }
Fork