some printing improvements
- don't print shared references to cprims, and estimate their size better. previously you could get output like this: ``` (#0=#\a #0#) ``` Now it looks like: ``` (#\a #\a) ``` - print `#\ ` and `#\newline` instead of `#\space` and `#\linefeed`. these seem to be more standard.
This commit is contained in:
parent
11b5964376
commit
75455f4029
23
print.c
23
print.c
|
@ -89,9 +89,6 @@ void print_traverse(value_t v)
|
||||||
for(i=0; i < vector_size(v); i++)
|
for(i=0; i < vector_size(v); i++)
|
||||||
print_traverse(vector_elt(v,i));
|
print_traverse(vector_elt(v,i));
|
||||||
}
|
}
|
||||||
else if (iscprim(v)) {
|
|
||||||
mark_cons(v);
|
|
||||||
}
|
|
||||||
else if (isclosure(v)) {
|
else if (isclosure(v)) {
|
||||||
mark_cons(v);
|
mark_cons(v);
|
||||||
function_t *f = (function_t*)ptr(v);
|
function_t *f = (function_t*)ptr(v);
|
||||||
|
@ -171,7 +168,7 @@ static inline int tinyp(value_t v)
|
||||||
if (fl_isstring(v))
|
if (fl_isstring(v))
|
||||||
return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
|
return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
|
||||||
return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL ||
|
return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL ||
|
||||||
v == FL_EOF);
|
v == FL_EOF || iscprim(v));
|
||||||
}
|
}
|
||||||
|
|
||||||
static int smallp(value_t v)
|
static int smallp(value_t v)
|
||||||
|
@ -208,6 +205,8 @@ static int lengthestimate(value_t v)
|
||||||
// get the width of an expression if we can do so cheaply
|
// get the width of an expression if we can do so cheaply
|
||||||
if (issymbol(v))
|
if (issymbol(v))
|
||||||
return u8_strwidth(symbol_name(v));
|
return u8_strwidth(symbol_name(v));
|
||||||
|
if (iscprim(v) && cp_class((cprim_t*)ptr(v)) == wchartype)
|
||||||
|
return 4;
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -441,9 +440,13 @@ void fl_print_child(ios_t *f, value_t v)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case TAG_CVALUE:
|
|
||||||
case TAG_CPRIM:
|
case TAG_CPRIM:
|
||||||
if (v == UNBOUND) { outs("#<undefined>", f); break; }
|
if (v == UNBOUND)
|
||||||
|
outs("#<undefined>", f);
|
||||||
|
else
|
||||||
|
cvalue_print(f, v);
|
||||||
|
break;
|
||||||
|
case TAG_CVALUE:
|
||||||
case TAG_VECTOR:
|
case TAG_VECTOR:
|
||||||
case TAG_CONS:
|
case TAG_CONS:
|
||||||
if (print_circle_prefix(f, v)) break;
|
if (print_circle_prefix(f, v)) break;
|
||||||
|
@ -477,7 +480,7 @@ void fl_print_child(ios_t *f, value_t v)
|
||||||
outc(']', f);
|
outc(']', f);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
if (iscvalue(v) || iscprim(v))
|
if (iscvalue(v))
|
||||||
cvalue_print(f, v);
|
cvalue_print(f, v);
|
||||||
else
|
else
|
||||||
print_pair(f, v);
|
print_pair(f, v);
|
||||||
|
@ -640,13 +643,13 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
|
||||||
else if (wc == 0x07) outsn("alarm", f, 5);
|
else if (wc == 0x07) outsn("alarm", f, 5);
|
||||||
else if (wc == 0x08) outsn("backspace", f, 9);
|
else if (wc == 0x08) outsn("backspace", f, 9);
|
||||||
else if (wc == 0x09) outsn("tab", f, 3);
|
else if (wc == 0x09) outsn("tab", f, 3);
|
||||||
else if (wc == 0x0A) outsn("linefeed", f, 8);
|
//else if (wc == 0x0A) outsn("linefeed", f, 8);
|
||||||
//else if (wc == 0x0A) outsn("newline", f, 7);
|
else if (wc == 0x0A) outsn("newline", f, 7);
|
||||||
else if (wc == 0x0B) outsn("vtab", f, 4);
|
else if (wc == 0x0B) outsn("vtab", f, 4);
|
||||||
else if (wc == 0x0C) outsn("page", f, 4);
|
else if (wc == 0x0C) outsn("page", f, 4);
|
||||||
else if (wc == 0x0D) outsn("return", f, 6);
|
else if (wc == 0x0D) outsn("return", f, 6);
|
||||||
else if (wc == 0x1B) outsn("esc", f, 3);
|
else if (wc == 0x1B) outsn("esc", f, 3);
|
||||||
else if (wc == 0x20) outsn("space", f, 5);
|
//else if (wc == 0x20) outsn("space", f, 5);
|
||||||
else if (wc == 0x7F) outsn("delete", f, 6);
|
else if (wc == 0x7F) outsn("delete", f, 6);
|
||||||
else if (iswprint(wc)) outs(seq, f);
|
else if (iswprint(wc)) outs(seq, f);
|
||||||
else HPOS+=ios_printf(f, "x%04x", (int)wc);
|
else HPOS+=ios_printf(f, "x%04x", (int)wc);
|
||||||
|
|
4
string.c
4
string.c
|
@ -230,7 +230,7 @@ value_t fl_char_upcase(value_t *args, u_int32_t nargs)
|
||||||
argcount("char.upcase", nargs, 1);
|
argcount("char.upcase", nargs, 1);
|
||||||
cprim_t *cp = (cprim_t*)ptr(args[0]);
|
cprim_t *cp = (cprim_t*)ptr(args[0]);
|
||||||
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
|
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
|
||||||
type_error("char.upcase", "wchar", args[0]);
|
type_error("char.upcase", "wchar", args[0]);
|
||||||
return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
|
return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
|
||||||
}
|
}
|
||||||
value_t fl_char_downcase(value_t *args, u_int32_t nargs)
|
value_t fl_char_downcase(value_t *args, u_int32_t nargs)
|
||||||
|
@ -238,7 +238,7 @@ value_t fl_char_downcase(value_t *args, u_int32_t nargs)
|
||||||
argcount("char.downcase", nargs, 1);
|
argcount("char.downcase", nargs, 1);
|
||||||
cprim_t *cp = (cprim_t*)ptr(args[0]);
|
cprim_t *cp = (cprim_t*)ptr(args[0]);
|
||||||
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
|
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
|
||||||
type_error("char.downcase", "wchar", args[0]);
|
type_error("char.downcase", "wchar", args[0]);
|
||||||
return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
|
return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue