scmno****@osdn*****
scmno****@osdn*****
Thu Jun 14 04:31:25 JST 2018
changeset ecd20888911f in quipu/quipu details: http://hg.osdn.jp/view/quipu/quipu?cmd=changeset;node=ecd20888911f user: Agustina Arzille <avarz****@riseu*****> date: Wed Jun 13 16:31:14 2018 -0300 description: First approach at implementing io_printf diffstat: compiler.cpp | 83 +++++++++++++++++++++-------------------------------------- interp.cpp | 11 +++++-- interp.h | 2 + io.h | 19 +++++++++++++ str.cpp | 1 - 5 files changed, 59 insertions(+), 57 deletions(-) diffs (252 lines): diff -r 57dab2c70117 -r ecd20888911f compiler.cpp --- a/compiler.cpp Wed Jun 13 03:14:52 2018 +0000 +++ b/compiler.cpp Wed Jun 13 16:31:14 2018 -0300 @@ -685,29 +685,6 @@ interp->raise2 ("syntax-error", buf); } -static void -raise_e (interpreter *interp, const char *m1, const char *m2, - object obj, const char *excty) -{ - valref str (interp, alloc_str (interp, 0)); - stream *out = strstream (interp, *str, STRM_WRITE); - out->write (interp, m1, (uint32_t)strlen (m1)); - out->putb (interp, ' '); - xwrite (interp, out, obj); - - if (m2) - out->write (interp, m2, (uint32_t)strlen (m2)); - - object s = sstream_get (interp, out); - interp->raise2 (excty, str_cdata (s)); -} - -static void -raise_e (interpreter *interp, const char *m1, const char *m2, object obj) -{ - raise_e (interp, m1, m2, obj, "arg-error"); -} - // XXX: Ordered list. static const struct { @@ -1498,17 +1475,20 @@ { invalid_arglist: if (orig == args) - raise_e (interp, "invalid argument list", 0, orig, ""); + interp->raise2 ("arg-error", + io_sprintf (interp, "invalid argument list: %Q", orig)); else - raise_e (interp, "invalid required argument", 0, args); + interp->raise2 ("arg-error", + io_sprintf (interp, "invalid required argument: %Q", args)); } object tmp = xcar (args); if (symbol_p (tmp)) { if (optargs || kwargs) - raise_e (interp, "invalid argument list", " - optional " - "arguments must come after required", orig); + interp->raise2 ("arg-error", io_sprintf (interp, + "invalid argument list: %Q - optional arguments must " + "come after required", orig)); req.add_sym (this->buf, tmp); } @@ -1516,7 +1496,8 @@ goto invalid_arglist; else if (!cons_p (xcdr (tmp)) || xcddr (tmp) != NIL || !symbol_p (xcar (tmp))) - raise_e (interp, "invalid optional argument", 0, tmp); + interp->raise2 ("arg-error", io_sprintf (interp, + "invalid optional argument: %Q", tmp)); else if (keyword_p (xcar (tmp))) { kwargs = true; @@ -1525,8 +1506,9 @@ else { if (kwargs) - raise_e (interp, "invalid argument list", "- keyword " - "arguments must come last", orig); + interp->raise2 ("arg-error", io_sprintf (interp, "invalid " + "argument list: %Q - keyword arguments " + "must come last", orig)); optargs = true; this->opt.add_sym (this->buf + this->req.n, tmp); @@ -1782,11 +1764,11 @@ if (!xcons_p (bindings)) { if (!nksymbol_p (bindings)) - raise_e (this->interp, "let bindings must be a symbol " - "or cons, not ", 0, bindings); + this->interp->raise2 ("arg-error", io_sprintf (interp, + "let bindings must be a symbol or cons, not %Q", bindings)); else if (!xcons_p (xcdr (expr))) - raise_e (this->interp, "let: got a dotted list " - "in the body", 0, expr); + this->interp->raise2 ("arg-error", io_sprintf (interp, + "let: got a dotted list in the body: %Q", expr)); else if (xcdr (expr) == NIL) this->interp->raise2 ("arg-error", "missing body in let"); @@ -1806,17 +1788,17 @@ for (object tmp = bindings; tmp != NIL; ++nargs) { if (!nksymbol_p (xcar (tmp))) - raise_e (this->interp, "let bindings must be " - "symbols, not", 0, xcar (tmp)); + this->interp->raise2 ("arg-error", io_sprintf (interp, + "let bindings must be symbols, not %Q", xcar (tmp))); dbind = dbind || special_symbol_p (xcar (tmp)); if (xcdr (tmp) == NIL) - raise_e (this->interp, "let bindings must come in pairs, " - "got:", 0, bindings); + this->interp->raise2 ("arg-error", io_sprintf (interp, + "let bindings must come in pairs, got: %Q", bindings)); else if (!xcons_p (xcdr (tmp)) || !xcons_p (tmp = xcddr (tmp))) - raise_e (this->interp, "let bindings must not come " - "in a dotted list:", 0, bindings); + this->interp->raise2 ("arg-error", io_sprintf (interp, + "let bindings must not come in a dotted list: %Q", bindings)); } QP_TMARK (this->interp); @@ -2547,12 +2529,10 @@ OP_(LOADGL): retval = xaref (fct_vals (stack[bp - 1]), ip_ival (ip)); - if (!symbol_p (retval)) - raise_e (interp, "apply: expected a symbol, not", 0, retval); - else if ((as_symbol(retval)->flagged_p (symbol::ctv_flag)) || + if ((as_symbol(retval)->flagged_p (symbol::ctv_flag)) || (interp->aux = symval (retval)) == UNBOUND) - raise_e (interp, "apply: symbol", " is unbound", - retval, "unbound-error"); + interp->raise2 ("unbound-error", io_sprintf (interp, + "apply: symbol %Q is unbound", retval)); U_PUSH (interp->aux); NEXT_OP; @@ -2561,10 +2541,7 @@ OP_(SETGL): retval = xaref (fct_vals (stack[bp - 1]), ip_ival (ip)); - if (!symbol_p (retval)) - raise_e (interp, "setq requires a symbol as its argument, " - "not ", 0, retval); - else if (as_varobj(retval)->flagged_p (FLAGS_CONST)) + if (as_varobj(retval)->flagged_p (FLAGS_CONST)) interp->raise2 ("const-error", "setq: cannot assign to a constant"); else if (!(as_symbol(retval)->flagged_p (symbol::special_flag)) || !interp->update_dbind (retval, interp->stktop ())) @@ -2653,8 +2630,8 @@ retval = interp->find_dbind (interp->aux); if (retval == UNBOUND && (retval = symval (interp->aux)) == UNBOUND) - raise_e (interp, "apply: symbol", " is unbound", - interp->aux, "unbound-error"); + interp->raise2 ("unbound-error", io_sprintf (interp, + "apply: symbol %Q is unbound", interp->aux)); U_PUSH (retval); NEXT_OP; @@ -2985,8 +2962,8 @@ interp->retval = symval (expr); if (interp->retval == UNBOUND) - raise_e (interp, "apply: symbol", " is unbound", - expr, "unbound-error"); + interp->raise2 ("unbound-error", io_sprintf (interp, + "apply: symbol %Q is unbound", expr)); return (interp->retval); case typecode::CONS: diff -r 57dab2c70117 -r ecd20888911f interp.cpp --- a/interp.cpp Wed Jun 13 03:14:52 2018 +0000 +++ b/interp.cpp Wed Jun 13 16:31:14 2018 -0300 @@ -259,11 +259,16 @@ throw (this->lasterr = exc); } +void interpreter::raise2 (const char *exctp, object str) +{ + valref msg (this, str); + valref sym (this, string::make (this, exctp)); + this->raise (call_fct (this, p_make_exception, *sym, *msg)); +} + void interpreter::raise2 (const char *exctp, const char *msg) { - valref sym (this, string::make (this, exctp)); - valref smg (this, string::make (this, msg)); - this->raise (call_fct (this, p_make_exception, *sym, *smg)); + this->raise2 (exctp, string::make (this, msg)); } void interpreter::raise_nargs (const char *name, diff -r 57dab2c70117 -r ecd20888911f interp.h --- a/interp.h Wed Jun 13 03:14:52 2018 +0000 +++ b/interp.h Wed Jun 13 16:31:14 2018 -0300 @@ -190,6 +190,8 @@ [[noreturn]] void raise2 (const char *__exctype, const char *__msg); + [[noreturn]] void raise2 (const char *__exctype, object __msg); + [[noreturn]] void raise_nargs (int __min, int __max, int __passed); [[noreturn]] void raise_nargs (const char *__name, diff -r 57dab2c70117 -r ecd20888911f io.h --- a/io.h Wed Jun 13 03:14:52 2018 +0000 +++ b/io.h Wed Jun 13 16:31:14 2018 -0300 @@ -4,6 +4,9 @@ #include "interp.h" #include "stream.h" #include "initop.h" +#include "str.h" +#include "function.h" +#include "symbol.h" QP_DECLS_BEGIN @@ -23,6 +26,22 @@ return (xwrite (__interp, __strm, __obj, __info)); } +QP_EXPORT object io_printf (interpreter *__interp, + object *__argv, int __argc); + +template <class ...Args> +object io_sprintf (interpreter *__interp, const char *__fmt, Args... __args) +{ + valref __tmp (__interp, symval (intern (__interp, "%fmt-str", 8))); + string __sf; + + __sf.full = 0; + __sf.type = typecode::STR; + __sf.data = (unsigned char *)__fmt; + __sf.nbytes = ustrlen (__fmt, &__sf.len); + return (call_fct (__interp, *__tmp, __sf.as_obj (), __args...)); +} + QP_EXPORT init_op init_io; QP_DECLS_END diff -r 57dab2c70117 -r ecd20888911f str.cpp --- a/str.cpp Wed Jun 13 03:14:52 2018 +0000 +++ b/str.cpp Wed Jun 13 16:31:14 2018 -0300 @@ -566,7 +566,6 @@ fmt_info fi (argc); stream *strm = strstream (interp, alloc_str (interp, 0), STRM_WRITE); - valref tmp (interp, strm->as_obj ()); for (int i = 0; i < sp->nbytes; ) {
Fork