diff options
| -rw-r--r-- | hash.c | 8 | ||||
| -rw-r--r-- | lib.c | 190 | ||||
| -rw-r--r-- | lib.h | 3 | ||||
| -rw-r--r-- | stream.c | 31 | ||||
| -rw-r--r-- | stream.h | 6 | ||||
| -rw-r--r-- | txr.1 | 154 |
6 files changed, 356 insertions, 36 deletions
@@ -494,12 +494,20 @@ static void hash_print_op(val hash, val out, val pretty, struct strm_ctx *ctx) put_string(lit(")"), out); { val iter = hash_begin(hash), cell; + cnum max_len = ctx->strm->max_length; + cnum max_count = max_len; + while ((cell = hash_next(iter))) { val key = us_car(cell); val value = us_cdr(cell); if (width_check(out, chr(' '))) force_br = 1; + if (max_len && --max_count < 0) { + put_string(lit("..."), out); + break; + } + put_string(lit("("), out); obj_print_impl(key, out, pretty, ctx); @@ -7492,11 +7492,13 @@ val lazy_str_force(val lstr) return lstr->ls.prefix; } -val lazy_str_put(val lstr, val stream) +val lazy_str_put(val lstr, val stream, struct strm_base *s) { - val lim, term, iter; - lim = lstr->ls.props->limit; - term = lstr->ls.props->term; + val lim = lstr->ls.props->limit; + val term = lstr->ls.props->term; + val iter; + cnum max_len = s->max_length; + cnum max_chr = if3(max_len, max(max_len, 15), 0); put_string(lstr->ls.prefix, stream); @@ -7506,6 +7508,15 @@ val lazy_str_put(val lstr, val stream) val str = car(iter); if (!str) break; + if (max_len) { + if (length_str_gt(str, num(max_chr))) { + put_string(sub_str(str, zero, num(max_chr)), stream); + goto max_reached; + } + if (--max_len == 0) + goto max_reached; + max_chr -= c_num(length_str(str)); + } if (lim) lim = pred(lim); put_string(str, stream); @@ -7513,6 +7524,11 @@ val lazy_str_put(val lstr, val stream) } return t; + +max_reached: + put_string(lit("..."), stream); + put_string(term, stream); + return t; } val lazy_str_force_upto(val lstr, val index) @@ -10901,14 +10917,16 @@ static void out_str_readable(const wchar_t *ptr, val out, int *semi_flag) out_str_char(*ptr, out, semi_flag, 0); } -static void out_lazy_str(val lstr, val out) +static void out_lazy_str(val lstr, val out, struct strm_base *strm) { int semi_flag = 0; - val lim, term, iter; + val lim = lstr->ls.props->limit; + val term = lstr->ls.props->term; + val iter; const wchar_t *wcterm; + cnum max_len = strm->max_length; + cnum max_chr = if3(max_len, max(max_len, 15), 0); - lim = lstr->ls.props->limit; - term = lstr->ls.props->term; wcterm = c_str(term); put_char(chr('"'), out); @@ -10921,12 +10939,25 @@ static void out_lazy_str(val lstr, val out) val str = car(iter); if (!str) break; + if (max_len) { + if (length_str_gt(str, num(max_chr))) { + out_str_readable(c_str(sub_str(str, zero, num(max_chr))), out, &semi_flag); + goto max_reached; + } + if (--max_len == 0) + goto max_reached; + max_chr -= c_num(length_str(str)); + } out_str_readable(c_str(str), out, &semi_flag); out_str_readable(wcterm, out, &semi_flag); if (lim) lim = pred(lim); } + if (0) { +max_reached: + put_string(lit("\\..."), out); + } put_char(chr('"'), out); } @@ -10951,7 +10982,7 @@ static void out_quasi_str_sym(val name, val mods, val rem_args, put_char(chr('@'), out); if (need_brace) put_char(chr('{'), out); - obj_print_impl(namestr, out, t, ctx); + put_string(namestr, out); while (mods) { put_char(chr(' '), out); obj_print_impl(car(mods), out, nil, ctx); @@ -10964,6 +10995,10 @@ static void out_quasi_str_sym(val name, val mods, val rem_args, static void out_quasi_str(val args, val out, struct strm_ctx *ctx) { val iter, next; + cnum max_len = ctx->strm->max_length, max_count = max_len; + + if (max_len) + max_len = max(15, max_len); for (iter = cdr(args); iter; iter = next) { val elem = car(iter); @@ -10971,7 +11006,18 @@ static void out_quasi_str(val args, val out, struct strm_ctx *ctx) if (stringp(elem)) { int semi_flag = 0; - out_str_readable(c_str(elem), out, &semi_flag); + if (max_len && length_str_gt(elem, num(max_len))) { + out_str_readable(c_str(sub_str(elem, zero, num(max_len))), out, &semi_flag); + goto max_exceeded; + } else { + out_str_readable(c_str(elem), out, &semi_flag); + if (max_len) { + max_len -= c_num(length(elem)); + if (max_len == 0) { + goto max_reached; + } + } + } } else if (consp(elem)) { val sym = car(elem); if (sym == var_s) @@ -10987,7 +11033,17 @@ static void out_quasi_str(val args, val out, struct strm_ctx *ctx) } else { obj_print_impl(elem, out, nil, ctx); } + + if (--max_count == 0) + goto max_reached; } + + return; + +max_reached: + if (next) +max_exceeded: + put_string(lit("\\..."), out); } INLINE int circle_print_eligible(val obj) @@ -11008,8 +11064,9 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) { val self = lit("print"); val ret = obj; + cnum save_depth = ctx->depth; - if (ctx && circle_print_eligible(obj)) { + if (ctx->obj_hash && circle_print_eligible(obj)) { loc pcdr = gethash_l(self, ctx->obj_hash, obj, nulloc); val label = deref(pcdr); @@ -11026,6 +11083,37 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) } } + if (ctx->strm->max_depth) { + if (ctx->depth > ctx->strm->max_depth) { + put_string(lit("..."), out); + return obj; + } + + if (ctx->depth == ctx->strm->max_depth) { + switch (type(obj)) { + case CONS: + case LCONS: + put_string(lit("(...)"), out); + return obj; + case VEC: + put_string(lit("#(...)"), out); + return obj; + case COBJ: + if (hashp(obj)) { + put_string(lit("#H(...)"), out); + return obj; + } else if (structp(obj)) { + put_string(lit("#S(...)"), out); + return obj; + } + default: + break; + } + } + + ctx->depth++; + } + switch (type(obj)) { case NIL: put_string(if3(get_indent_mode(out) == num_fast(indent_code), @@ -11095,6 +11183,7 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) out_quasi_str(obj, out, ctx); put_char(chr('`'), out); } else if (sym == quasilist_s && consp(cdr(obj))) { + cnum max_length = ctx->strm->max_length; val args = cdr(obj); put_string(lit("#`"), out); if (args) { @@ -11103,6 +11192,10 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) } while (args) { put_char(chr(' '), out); + if (max_length && --max_length == 0) { + put_string(lit("..."), out); + break; + } out_quasi_str(car(args), out, ctx); args = cdr(args); } @@ -11112,6 +11205,8 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) val closepar = chr(')'); val indent = zero; int force_br = 0; + cnum max_len = ctx->strm->max_length; + cnum max_count = max_len; if (sym == dwim_s && consp(cdr(obj))) { put_char(chr('['), out); @@ -11174,13 +11269,18 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) } } - obj_print_impl(a, out, pretty, ctx); + if (max_len && --max_count < 0) { + put_string(lit("..."), out); + iter = nil; + } else { + obj_print_impl(a, out, pretty, ctx); + } } finish: d = cdr(iter); if (nilp(d)) { put_char(closepar, out); - } else if (ctx && gethash(ctx->obj_hash, d)) { + } else if (ctx->obj_hash && gethash(ctx->obj_hash, d)) { iter = nil; goto dot; } else if (consp(d)) { @@ -11205,15 +11305,31 @@ dot: } case LIT: case STR: - if (pretty) { - put_string(obj, out); - } else { - int semi_flag = 0; - put_char(chr('"'), out); + { + cnum max_length = ctx->strm->max_length; + cnum eff_max_length = max(15, max_length); - out_str_readable(c_str(obj), out, &semi_flag); + if (pretty) { + if (!max_length || le(length_str(obj), num(eff_max_length))) { + put_string(obj, out); + } else { + put_string(sub_str(obj, zero, num(eff_max_length)), out); + put_string(lit("..."), out); + } + } else { + int semi_flag = 0; + put_char(chr('"'), out); - put_char(chr('"'), out); + if (!max_length || le(length_str(obj), num(eff_max_length))) { + out_str_readable(c_str(obj), out, &semi_flag); + } else { + out_str_readable(c_str(sub_str(obj, zero, num(eff_max_length))), + out, &semi_flag); + put_string(lit("\\..."), out); + } + + put_char(chr('"'), out); + } } break; case CHR: @@ -11305,6 +11421,7 @@ dot: case VEC: { cnum i, length = c_num(obj->v.vec[vec_length]); + cnum max_length = ctx->strm->max_length; val save_mode = test_set_indent_mode(out, num_fast(indent_off), num_fast(indent_data)); val save_indent; @@ -11316,6 +11433,10 @@ dot: for (i = 0; i < length; i++) { val elem = obj->v.vec[i]; + if (max_length && i >= max_length) { + put_string(lit("..."), out); + break; + } obj_print_impl(elem, out, pretty, ctx); if (i < length - 1) if (width_check(out, chr(' '))) @@ -11333,9 +11454,9 @@ dot: break; case LSTR: if (pretty) { - lazy_str_put(obj, out); + lazy_str_put(obj, out, ctx->strm); } else { - out_lazy_str(obj, out); + out_lazy_str(obj, out, ctx->strm); } break; case COBJ: @@ -11360,6 +11481,9 @@ dot: break; } + if (ctx->depth != save_depth) + ctx->depth = save_depth; + return ret; } @@ -11466,6 +11590,7 @@ static void obj_hash_merge(val parent_hash, val child_hash) val obj_print(val obj, val out, val pretty) { + val self = lit("print"); val ret = nil; val save_mode = get_indent_mode(out); val save_indent = get_indent(out); @@ -11486,18 +11611,21 @@ val obj_print(val obj, val out, val pretty) obj_hash_merge(ctx->obj_hash_prev, ctx->obj_hash); ctx->obj_hash = ctx->obj_hash_prev; ctx->obj_hash_prev = nil; - } else { - ctx = 0; } } else { - if (print_circle_s && cdr(lookup_var(nil, print_circle_s))) { - ctx = &ctx_struct; - ctx->obj_hash = make_hash(nil, nil, nil); - ctx->obj_hash_prev = nil; - ctx->counter = zero; - get_set_ctx(out, ctx); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, out, stream_s)); + ctx = &ctx_struct; + ctx->strm = s; + ctx->counter = zero; + ctx->obj_hash_prev = nil; + ctx->obj_hash = if2(print_circle_s && + cdr(lookup_var(nil, print_circle_s)), + make_hash(nil, nil, nil)); + ctx->depth = 0; + get_set_ctx(out, ctx); + if (ctx->obj_hash) populate_obj_hash(obj, ctx); - } } ret = obj_print_impl(obj, out, pretty, ctx); @@ -1006,7 +1006,8 @@ val lazy_stream_cons(val stream); val lazy_str(val list, val term, val limit); val lazy_str_force_upto(val lstr, val index); val lazy_str_force(val lstr); -val lazy_str_put(val lstr, val stream); +struct strm_base; +val lazy_str_put(val lstr, val stream, struct strm_base *); val lazy_str_get_trailing_list(val lstr, val index); val length_str_gt(val str, val len); val length_str_ge(val str, val len); @@ -102,7 +102,7 @@ val shell, shell_arg; void strm_base_init(struct strm_base *s) { - static struct strm_base init = { indent_off, 60, 10, 0, 0, 0, 0 }; + static struct strm_base init = { indent_off, 60, 10, 0, 0, 0, 0, 0, 0 }; *s = init; } @@ -3547,13 +3547,14 @@ static val put_indent(val stream, struct strm_ops *ops, cnum chars) val put_string(val string, val stream_in) { val self = lit("put-string"); + val stream = default_arg(stream_in, std_output); + struct strm_base *s = coerce(struct strm_base *, stream->co.handle); + if (lazy_stringp(string)) { - return lazy_str_put(string, stream_in); + return lazy_str_put(string, stream_in, s); } else { - val stream = default_arg(stream_in, std_output); struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(self, stream, stream_s)); - struct strm_base *s = coerce(struct strm_base *, stream->co.handle); cnum col = s->column; const wchar_t *str = c_str(string), *p = str; @@ -3810,6 +3811,26 @@ val force_break(val stream) return stream; } +val set_max_length(val stream, val length) +{ + val self = lit("set-max-length"); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_s)); + cnum old_max = s->max_length; + s->max_length = c_num(length); + return num(old_max); +} + +val set_max_depth(val stream, val depth) +{ + val self = lit("set-max-depth"); + struct strm_base *s = coerce(struct strm_base *, + cobj_handle(self, stream, stream_s)); + cnum old_max = s->max_depth; + s->max_depth = c_num(depth); + return num(old_max); +} + struct strm_ctx *get_set_ctx(val stream, struct strm_ctx *ctx) { struct strm_base *s = coerce(struct strm_base *, stream->co.handle); @@ -4702,6 +4723,8 @@ void stream_init(void) reg_fun(intern(lit("inc-indent"), user_package), func_n2(inc_indent)); reg_fun(intern(lit("width-check"), user_package), func_n2(width_check)); reg_fun(intern(lit("force-break"), user_package), func_n1(force_break)); + reg_fun(intern(lit("set-max-length"), user_package), func_n2(set_max_length)); + reg_fun(intern(lit("set-max-depth"), user_package), func_n2(set_max_depth)); reg_varl(intern(lit("indent-off"), user_package), num_fast(indent_off)); reg_varl(intern(lit("indent-data"), user_package), num_fast(indent_data)); reg_varl(intern(lit("indent-code"), user_package), num_fast(indent_code)); @@ -42,6 +42,8 @@ struct strm_ctx { val obj_hash; val obj_hash_prev; val counter; + cnum depth; + struct strm_base *strm; }; struct strm_base { @@ -51,6 +53,8 @@ struct strm_base { cnum indent_chars; cnum column; unsigned force_break; + cnum max_length; + cnum max_depth; struct strm_ctx *ctx; }; @@ -213,6 +217,8 @@ val set_indent(val stream, val indent); val inc_indent(val stream, val delta); val width_check(val stream, val alt); val force_break(val stream); +val set_max_length(val stream, val length); +val set_max_depth(val stream, val depth); struct strm_ctx *get_set_ctx(val stream, struct strm_ctx *); struct strm_ctx *get_ctx(val stream); val get_string(val stream, val nchars, val close_after_p); @@ -47207,6 +47207,160 @@ and in the same way so that application-defined output integrates with the formatting algorithm. +.SS* Stream Output Limitation + +Streams have two properties which are used by the The \*(TL object printer to +optionally truncate the output generated by aggregate objects. + +A stream can specify a maximum length for aggregate objects via the +.code set-max-length +function. Using the +.code set-max-depth +function, the maximum depth can also be specified. + +This feature is +useful when diagnostic output is being produced, and the objects involved are +so large that the diagnostic output overwhelms the output device or the user, +so as to become uninformative. Output limiting also prevents the printer's +non-termination on infinite, lazy structures. + +It is recommended that functions which operate on streams passed in as +parameters save and restore these parameters, if they need to manipulate them, +for instance using +.codn with-resources : + +.verb + (defun output-function (arg stream) + ;; temporarily impose maximum width and depth + (with-resources ((ml (set-max-length stream 42) + (set-max-length stream ml)) + (mw (set-max-depth stream 12) + (set-max-depth stream mw))) + (prinl arg stream) + ...)) +.brev + +.coNP Function @ set-max-length +.synb +.mets (set-max-length < stream << value ) +.syne +.desc +The +.code set-max-length +function establishes the maximum length for aggregate object printing. +It affects the printing of lists, vectors, hash tables, strings +as well as quasiliterals and quasiword list literals (QLLs). + +The default value is 0 and this value means that no limit is imposed. +Otherwise, the value must be a positive integer. + +When the list, vector or hash table object being printed has more +elements than the maximum length, then elements are printed only up to +the maximum count, and then the remaining elements are summarized by +printing the +.code ... +(three dots) character sequence as if it were an additional element. +This sequence is an invalid token; it cannot be read as input. + +When a character string is printed, any positive value of +the maximum length which is less than 15 is considered to be 15. +The maximum length specifies the number of characters of the +a string which are output. + +If a string which exceeds the maximum length is being printed +with read-print consistency, as by the +.code print +function, then only a prefix of the string is printed, limited +to the maximum number of characters. Then, the literal syntax is +closed using the character sequence +.code \e...\(dq +(backslash, dot, dot, dot, double quote) +whose leading invalid escape sequence +.code \e. +(backslash, dot) ensures that the truncated object is not readable. + +If a string which exceeds the maximum length is being printed +without read-print consistency, as by the +.code pprint +function, then only a prefix of the string is printed, limited +to the maximum number of characters. Then the +character sequence +.code ... +is emitted. + +Quasiliterals are treated using a combination of behaviors. Elements of a +quasiliteral are literal sequence of text, and embedded variables and +expressions. The maximum length specifies both the maximum number of elements +in the quasiliteral, and the maximum number of characters in any element which +is a sequence of text. When either limit is exceeded, the quasiliteral +is immediately terminated with the sequence +.code \e...` +(escaped dot, dot, dot, backtick). The maximum limit is applied to +the units of text cumulatively, rather than individually. As in the case of +string literals, smaller limit values than 15 are treated as 15, +but only for the cumulative text length limit. For limiting the number of +elements, the count is used as-is. + +When a QLL is printed, the space-separated elements +of the literal are individually subject to the maximum length limit as if +they were independent quasiliterals. Furthermore, the sequence of these +elements is subject to the maximum length. If there are more elements in the +QLL, then the sequence +.code \e...` +(escaped dot, dot, dot, backtick) is emitted and thus the QLL ends. + +The +.code set-max-length +function returns the previous value. + +.coNP Function @ set-max-depth +.synb +.mets (set-max-depth < stream << value ) +.syne +.desc +The +.code set-max-length +function establishes the maximum depth for the printing of nested +objects. It affects the printing of lists, vectors, hash tables +and structures. The default value is 0 and this value means that no limit is +imposed. Otherwise, the value must be a positive integer. + +The depth of an object not enclosed in any object is zero. The depth of the +element of an aggregate is one greater than the depth of the aggregate itself. +For instance, given the list +.code "(1 (2 3))" +the list itself has depth 0, the atom +.code 1 +has depth 1, as does the sublist +.codn "(2 3)" , +and the +.code 2 +and +.code 3 +atoms have depth 2. + +When an object is printed whose depth exceeds the maximum depth, then three dot +character sequence +.code ... +is printed instead of that object. This notation is an invalid token; it cannot be +read as input. + +Additionally, when a vector, list, hash table or structure is printed which itself +doesn't exceed the maximum depth, but whose elements do exceed, then that object +is summarized, respectively, as +.codn "(...)" , +.codn "#(...)" , +.code "H#(...)" +and +.codn "S#(...)" , +rather than repeating the +.code ... +sequence for each of its elements. + +The +.code set-max-depth +function returns the previous value. + .SS* Coprocesses .coNP Functions @ open-command and @ open-process .synb |