ref: a70379d7e4b822f532fb0a8ccdd1624a90b64a68
dir: /src/print.c/
#include "sl.h"
#include "operators.h"
#include "cvalues.h"
#include "ieee754.h"
#include "print.h"
#include "read.h"
#define LOG2_10 3.321928094887362347870319429489
static inline void
outc(sl_ios *f, char c)
{
if(ios_putc(f, c) != 1)
lerrorf(sl_errio, "write failed");
if(c == '\n')
sl.hpos = 0;
else
sl.hpos++;
}
static inline void
outsn(sl_ios *f, const char *s, usize n)
{
if(ios_write(f, s, n) != n)
lerrorf(sl_errio, "write failed");
ssize w;
const char *nl = llt_memrchr(s, '\n', n);
if(nl == nil){
if((w = u8_strwidth(s, n)) > 0)
sl.hpos += w;
}else if((w = u8_strwidth(nl+1, s+n-nl+1)) > 0)
sl.hpos = w;
}
static inline void
outs(sl_ios *f, const char *s)
{
outsn(f, s, strlen(s));
}
#define outsc(f, s) do{ \
const char vs[] = s; \
outsn(f, vs, sizeof(vs)-1); \
}while(0)
static int
outindent(sl_ios *f, int n)
{
// move back to left margin if we get too indented
if(n > sl.scr_width-12)
n = 2;
int n0 = n;
if(ios_putc(f, '\n') != 1)
goto err;
sl.vpos++;
sl.hpos = n;
while(n){
if(ios_putc(f, ' ') != 1)
goto err;
n--;
}
return n0;
err:
lerrorf(sl_errio, "write failed");
}
void
sl_print_chr(sl_ios *f, char c)
{
outc(f, c);
}
void
sl_print_str(sl_ios *f, const char *s)
{
outs(f, s);
}
void
print_traverse(sl_v v)
{
sl_v *bp;
while(iscons(v)){
if(ismarked(v)){
bp = (sl_v*)ptrhash_bp(&sl.printconses, (void*)v);
if(*bp == (sl_v)HT_NOTFOUND)
*bp = fixnum(sl.printlabel++);
return;
}
mark_cons(v);
print_traverse(car_(v));
v = cdr_(v);
}
if(!ismanaged(v) || issym(v))
return;
if(ismarked(v)){
bp = (sl_v*)ptrhash_bp(&sl.printconses, (void*)v);
if(*bp == (sl_v)HT_NOTFOUND)
*bp = fixnum(sl.printlabel++);
return;
}
if(isvec(v)){
if(vec_size(v) > 0)
mark_cons(v);
unsigned int i;
for(i = 0; i < vec_size(v); i++)
print_traverse(vec_elt(v, i));
}else if(iscprim(v)){
// don't consider shared references to e.g. chars
}else if(isfn(v)){
mark_cons(v);
sl_fn *f = ptr(v);
print_traverse(f->bcode);
print_traverse(f->vals);
print_traverse(f->env);
}else if(iscvalue(v)){
sl_cv *cv = ptr(v);
// don't consider shared references to ""
if(!cv_isstr(cv) || cv_len(cv) != 0)
mark_cons(v);
sl_type *t = cv_class(cv);
if(t->vtable != nil && t->vtable->print_traverse != nil)
t->vtable->print_traverse(v);
}
}
static void
print_sym_name(sl_ios *f, const char *name)
{
int i;
bool escape = false, charescape = false;
if((name[0] == '\0') ||
(name[0] == '.' && name[1] == '\0') ||
(name[0] == '#') ||
sl_read_numtok(name, nil, 0))
escape = true;
i = 0;
while(name[i]){
if(!symchar(name[i])){
escape = true;
if(name[i] == '|' || name[i] == '\\'){
charescape = true;
break;
}
}
i++;
}
if(escape){
if(charescape){
outc(f, '|');
i = 0;
while(name[i]){
if(name[i] == '|' || name[i] == '\\')
outc(f, '\\');
outc(f, name[i]);
i++;
}
outc(f, '|');
}else{
outc(f, '|');
outs(f, name);
outc(f, '|');
}
}else{
outs(f, name);
}
}
/*
The following implements a simple pretty-printing algorithm. This is
an unlimited-width approach that doesn't require an extra pass.
It uses some heuristics to guess whether an expression is "small",
and avoids wrapping symbols across lines. The result is high
performance and nice output for typical code. Quality is poor for
pathological or deeply-nested expressions, but those are difficult
to print anyway.
*/
#define SMALL_STR_LEN 24
static inline int
tinyp(sl_v v)
{
if(issym(v)){
const char *s = sym_name(v);
return u8_strwidth(s, strlen(s)) < SMALL_STR_LEN;
}
if(sl_isstr(v))
return cv_len(ptr(v)) < SMALL_STR_LEN;
return (
isfixnum(v) || isbuiltin(v) || iscprim(v) ||
v == sl_t || v == sl_nil || v == sl_eof || v == sl_void
);
}
static bool
smallp(sl_v v)
{
if(tinyp(v))
return true;
if(sl_isnum(v))
return true;
if(iscons(v)){
if(tinyp(car_(v)) &&
(tinyp(cdr_(v)) || (iscons(cdr_(v)) && tinyp(car_(cdr_(v))) && cdr_(cdr_(v)) == sl_nil)))
return true;
return false;
}
if(isvec(v)){
usize s = vec_size(v);
return (
s == 0 ||
(tinyp(vec_elt(v, 0)) && (s == 1 || (s == 2 && tinyp(vec_elt(v, 1)))))
);
}
return false;
}
static int
specialindent(sl_v head)
{
// indent these forms 2 spaces, not lined up with the first argument
if(head == sl_lambda || head == sl_trycatch || head == sl_defsym ||
head == sl_defmacrosym || head == sl_forsym)
return 2;
return -1;
}
static int
lengthestimate(sl_v v)
{
// get the width of an expression if we can do so cheaply
if(issym(v)){
const char *s = sym_name(v);
return u8_strwidth(s, strlen(s));
}
if(iscprim(v) && ptr(v) != nil && cp_class(ptr(v)) == sl_runetype)
return 4;
return -1;
}
static int
allsmallp(sl_v v)
{
int n = 1;
while(iscons(v)){
if(!smallp(car_(v)))
return 0;
v = cdr_(v);
n++;
if(n > 25)
return n;
}
return n;
}
static int
indentafter3(sl_v head, sl_v v)
{
// for certain X always indent (X a b c) after b
return head == sl_forsym && !allsmallp(cdr_(v));
}
static int
indentafter2(sl_v head, sl_v v)
{
// for certain X always indent (X a b) after a
return (head == sl_defsym || head == sl_defmacrosym) && !allsmallp(cdr_(v));
}
static bool
indentevery(sl_v v)
{
// indent before every subform of a special form, unless every
// subform is "small"
sl_v c = car_(v);
if(c == sl_lambda || c == sl_setqsym)
return false;
//if(c == sl.IF) // TODO: others
// return !allsmallp(cdr_(v));
return false;
}
static bool
blockindent(sl_v v)
{
// in this case we switch to block indent mode, where the head
// is no longer considered special:
// (a b c d e
// f g h i j)
return allsmallp(v) > 9;
}
static void
print_cons(sl_ios *f, sl_v v)
{
sl_v cd;
const char *op;
if(iscons(cdr_(v)) && cdr_(cdr_(v)) == sl_nil &&
!ptrhash_has(&sl.printconses, (void*)cdr_(v)) &&
((car_(v) == sl_quote && (op = "'")) ||
(car_(v) == sl_backquote && (op = "`")) ||
(car_(v) == sl_comma && (op = ",")) ||
(car_(v) == sl_commaat && (op = ",@")) ||
(car_(v) == sl_commadot && (op = ",.")))){
// special prefix syntax
unmark_cons(v);
unmark_cons(cdr_(v));
outs(f, op);
sl_print_child(f, car_(cdr_(v)));
return;
}
int startpos = sl.hpos;
outc(f, '(');
int newindent = sl.hpos;
int lastv, n = 0, si, ind, est, nextsmall, thistiny;
bool always = false, blk = blockindent(v);
if(!blk)
always = indentevery(v);
sl_v head = car_(v);
int after3 = indentafter3(head, v);
int after2 = indentafter2(head, v);
int n_unindented = 1;
while(1){
cd = cdr_(v);
if(sl.print_length >= 0 && n >= sl.print_length && cd != sl_nil){
outsc(f, "...)");
break;
}
lastv = sl.vpos;
unmark_cons(v);
sl_print_child(f, car_(v));
if(!iscons(cd) || ptrhash_has(&sl.printconses, (void*)cd)){
if(cd != sl_nil){
outsc(f, " . ");
sl_print_child(f, cd);
}
outc(f, ')');
break;
}
if(!sl.print_pretty ||
(head == sl_lambda && n == 0)){
// never break line before lambda-list
ind = 0;
}else{
est = lengthestimate(car_(cd));
nextsmall = smallp(car_(cd));
thistiny = tinyp(car_(v));
ind = ((sl.vpos > lastv ||
(sl.hpos>sl.scr_width/2 && !nextsmall && !thistiny && n>0)) ||
(sl.hpos > sl.scr_width-4) ||
(est != -1 && sl.hpos+est > sl.scr_width-2) ||
(head == sl_lambda && !nextsmall) ||
(n > 0 && always) ||
(n == 2 && after3) ||
(n == 1 && after2) ||
(n_unindented >= 3 && !nextsmall) ||
(n == 0 && !smallp(head)));
}
if(ind){
newindent = outindent(f, newindent);
n_unindented = 1;
}else{
n_unindented++;
outc(f, ' ');
if(n == 0){
// set indent level after printing head
si = specialindent(head);
if(si != -1)
newindent = startpos + si;
else if(!blk)
newindent = sl.hpos;
}
}
n++;
v = cd;
}
}
static void cvalue_print(sl_ios *f, sl_v v);
static bool
print_circle_prefix(sl_ios *f, sl_v v)
{
sl_v label;
if((label = (sl_v)ptrhash_get(&sl.printconses, (void*)v)) != (sl_v)HT_NOTFOUND){
if(!ismarked(v)){
int n = ios_printf(f, "#%"PRIdPTR"#", (intptr)numval(label));
if(n < 1)
lerrorf(sl_errio, "write failed");
sl.hpos += n;
return true;
}
int n = ios_printf(f, "#%"PRIdPTR"=", (intptr)numval(label));
if(n < 1)
lerrorf(sl_errio, "write failed");
sl.hpos += n;
}
if(ismanaged(v))
unmark_cons(v);
return false;
}
void
sl_print_child(sl_ios *f, sl_v v)
{
const char *name;
if(sl.print_level >= 0 && sl.p_level >= sl.print_level && (iscons(v) || isvec(v) || isfn(v))){
outc(f, '#');
return;
}
sl.p_level++;
int n;
switch(tag(v)){
case TAG_FIXNUM:
n = ios_printf(f, "%"PRIdFIXNUM, numval(v));
if(n < 1)
lerrorf(sl_errio, "write failed");
sl.hpos += n;
break;
case TAG_SYM:
name = sym_name(v);
if(sl.print_princ)
outs(f, name);
else if(ismanaged(v)){
outsc(f, "#:");
outs(f, name);
}else
print_sym_name(f, name);
break;
case TAG_FN:
if(v == sl_t)
outc(f, 'T');
else if(v == sl_nil)
outsc(f, "NIL");
else if(v == sl_eof)
outsc(f, "#<eof>");
else if(v == sl_void){
outsc(f, "#<void>");
}else if(isbuiltin(v)){
if(!sl.print_princ)
outsc(f, "#.");
outs(f, builtins[uintval(v)].name);
}else{
assert(isfn(v));
if(!sl.print_princ){
if(print_circle_prefix(f, v))
break;
sl_fn *fn = ptr(v);
outs(f, "#fn(");
char *data = cvalue_data(fn->bcode);
usize i, sz = cvalue_len(fn->bcode);
for(i = 0; i < sz; i++)
data[i] += 48;
sl_print_child(f, fn->bcode);
for(i = 0; i < sz; i++)
data[i] -= 48;
if(fn->vals != sl_emptyvec || fn->env != sl_nil || fn->name != sl_lambda){
outc(f, ' ');
sl_print_child(f, fn->vals);
if(fn->env != sl_nil){
outc(f, ' ');
sl_print_child(f, fn->env);
}
if(fn->name != sl_lambda){
outc(f, ' ');
sl_print_child(f, fn->name);
}
}
outc(f, ')');
}else{
outs(f, "#<fn>");
}
}
break;
case TAG_CPRIM:
if(v == UNBOUND)
outs(f, "#<undefined>");
else
cvalue_print(f, v);
break;
case TAG_CVALUE:
case TAG_VEC:
case TAG_CONS:
if(!sl.print_princ && print_circle_prefix(f, v))
break;
if(isvec(v)){
outs(f, "#(");
int newindent = sl.hpos, est;
int i, sz = vec_size(v);
for(i = 0; i < sz; i++){
if(sl.print_length >= 0 && i >= sl.print_length && i < sz-1){
outsc(f, "...");
break;
}
sl_print_child(f, vec_elt(v, i));
if(i < sz-1){
if(!sl.print_pretty)
outc(f, ' ');
else{
est = lengthestimate(vec_elt(v, i+1));
if(sl.hpos > sl.scr_width-4 ||
(est != -1 && (sl.hpos+est > sl.scr_width-2)) ||
(sl.hpos > sl.scr_width/2 && !smallp(vec_elt(v, i+1)) && !tinyp(vec_elt(v, i))))
newindent = outindent(f, newindent);
else
outc(f, ' ');
}
}
}
outc(f, ')');
break;
}
if(iscvalue(v))
cvalue_print(f, v);
else
print_cons(f, v);
break;
}
sl.p_level--;
}
static void
print_str(sl_ios *f, const char *str, usize sz)
{
char buf[64];
u8int c;
static const char hexdig[] = "0123456789abcdef";
usize i = 0;
if(!u8_isvalid(str, sz)){
// alternate print algorithm that preserves data if it's not UTF-8
for(; i < sz; i++){
c = str[i];
if(c == '\\')
outsc(f, "\\\\");
else if(c == '"')
outsc(f, "\\\"");
else if(c >= 32 && c < 0x7f)
outc(f, c);
else{
outsc(f, "\\x");
outc(f, hexdig[c>>4]);
outc(f, hexdig[c&0xf]);
}
}
}else{
while(i < sz){
usize n = u8_escape(buf, sizeof(buf), str, &i, sz, true, false);
outsn(f, buf, n-1);
}
}
}
static int
double_exponent(double d)
{
union ieee754_double dl;
dl.d = d;
return dl.ieee.exponent - IEEE754_DOUBLE_BIAS;
}
static void
snprint_real(char *s, usize cnt, double r,
int width, // printf field width, or 0
int dec, // # decimal digits desired, recommend 16
// # of zeros in .00...0x before using scientific notation
// recommend 3-4 or so
int max_digs_rt,
// # of digits left of decimal before scientific notation
// recommend 10
int max_digs_lf)
{
bool keepz = false;
int mag, sz;
s[0] = '\0';
if(width == -1){
width = 0;
keepz = true;
}
if(isinf(r)){
strncpy(s, signbit(r) ? "-inf" : "inf", cnt);
return;
}
if(isnan(r)){
strncpy(s, signbit(r) ? "-nan" : "nan", cnt);
return;
}
if(r == 0){
strncpy(s, "0", cnt);
return;
}
char num_format[4];
num_format[0] = 'l';
num_format[2] = '\0';
mag = double_exponent(r);
mag = (int)(((double)mag)/LOG2_10 + 0.5);
if(r == 0)
mag = 0;
double fpart, temp;
if(mag > max_digs_lf-1 || mag < -max_digs_rt){
num_format[1] = 'e';
temp = r/pow(10, mag); /* see if number will have a decimal */
fpart = temp - floor(temp); /* when written in scientific notation */
}else{
num_format[1] = 'f';
fpart = r - floor(r);
}
if(fpart == 0)
dec = 0;
char format[28];
if(width == 0)
snprintf(format, sizeof(format), "%%.%d%s", dec, num_format);
else
snprintf(format, sizeof(format), "%%%d.%d%s", width, dec, num_format);
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wformat-nonliteral"
sz = snprintf(s, cnt, format, r);
#pragma GCC diagnostic pop
/* trim trailing zeros from fractions. not when using scientific
notation, since we might have e.g. 1.2000e+100. also not when we
need a specific output width */
if(width == 0 && !keepz){
if(sz > 2 && fpart){
char *e = nil;
if(num_format[1] == 'e'){
while(s[--sz] != 'e');
e = s + sz--;
}
while(s[sz-1] == '0'){
s[sz-1] = '\0';
sz--;
}
// don't need trailing .
if(s[sz-1] == '.')
s[--sz] = '\0';
if(num_format[1] == 'e'){
while(*e)
s[sz++] = *e++;
s[sz] = 0;
}
}
}
}
// 'weak' means we don't need to accurately reproduce the type, so
// for example #s32(0) can be printed as just 0. this is used
// printing in a context where a type is already implied, e.g. inside
// an array.
static void
cvalue_printdata(sl_ios *f, void *data, usize len, sl_v type, int weak)
{
int n;
if(type == sl_bytesym){
u8int ch = *(u8int*)data;
if(sl.print_princ)
outc(f, ch);
else{
n = ios_printf(f, weak ? "0x%hhx" : "#byte(0x%hhx)", ch);
if(n < 1)
goto err;
sl.hpos += n;
}
}else if(type == sl_runesym){
Rune r = *(Rune*)data;
char seq[UTFmax+1];
int nb = runetochar(seq, &r);
seq[nb] = '\0';
if(sl.print_princ){
outsn(f, seq, nb);
}else{
outsc(f, "#\\");
switch(r){
case 0x00: outsc(f, "nul"); break;
case 0x07: outsc(f, "alarm"); break;
case 0x08: outsc(f, "backspace"); break;
case 0x09: outsc(f, "tab"); break;
case 0x0a: outsc(f, "newline"); break;
case 0x0b: outsc(f, "vtab"); break;
case 0x0c: outsc(f, "page"); break;
case 0x0d: outsc(f, "return"); break;
case 0x1b: outsc(f, "esc"); break;
case ' ': outsc(f, "space"); break;
case 0x7f: outsc(f, "delete"); break;
default:
if(sl_iswprint(r))
outs(f, seq);
else{
n = ios_printf(f, "x%04"PRIx32, r);
if(n < 1)
goto err;
sl.hpos += n;
}
break;
}
}
}else if(type == sl_floatsym || type == sl_doublesym){
char buf[64];
double d;
int ndec;
if(type == sl_floatsym){
d = (double)*(float*)data;
ndec = 8;
}else{
d = *(double*)data;
ndec = 16;
}
if(!isfinite(d)){
const char *rep;
if(isinf(d))
rep = signbit(d) ? "-inf.0" : "+inf.0";
else if(isnan(d))
rep = signbit(d) ? "-nan.0" : "+nan.0";
else
rep = signbit(d) ? "-wtf.0" : "+wtf.0";
if(type == sl_floatsym && !sl.print_princ && !weak){
n = ios_printf(f, "#%s(%s)", sym_name(type), rep);
if(n < 1)
goto err;
sl.hpos += n;
}else
outs(f, rep);
}else if(d == 0){
if(1/d < 0)
outsc(f, "-0.0");
else
outsc(f, "0.0");
if(type == sl_floatsym && !sl.print_princ && !weak)
outc(f, 'f');
}else{
snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
int hasdec = (strpbrk(buf, ".eE") != nil);
outs(f, buf);
if(!hasdec)
outsc(f, ".0");
if(type == sl_floatsym && !sl.print_princ && !weak)
outc(f, 'f');
}
}else if(type == sl_u64sym){
u64int ui64 = *(u64int*)data;
n = (weak || sl.print_princ)
? ios_printf(f, "%"PRIu64, ui64)
: ios_printf(f, "#%s(%"PRIu64")", sym_name(type), ui64);
if(n < 1)
goto err;
sl.hpos += n;
}else if(type == sl_bignumsym){
mpint *i = *(mpint**)data;
char *s = mptoa(i, 10, nil, 0);
n = ios_printf(f, "%s", s);
if(n < 1)
goto err;
sl.hpos += n;
MEM_FREE(s);
}else if(issym(type)){
// handle other integer prims. we know it's smaller than uint64
// at this point, so int64 is big enough to capture everything.
sl_numtype nt = sym_to_numtype(type);
if(valid_numtype(nt)){
s64int i64 = conv_to_s64(data, nt);
n = (weak || sl.print_princ)
? ios_printf(f, "%"PRId64, i64)
: ios_printf(f, "#%s(%"PRId64")", sym_name(type), i64);
}else{
n = ios_printf(f, "#<%s>", sym_name(type));
}
if(n < 1)
goto err;
sl.hpos += n;
}else if(iscons(type)){
if(car_(type) == sl_arrsym){
usize i;
sl_v eltype = car(cdr_(type));
usize cnt, elsize;
if(iscons(cdr_(cdr_(type)))){
cnt = tosize(car_(cdr_(cdr_(type))));
elsize = cnt ? len/cnt : 0;
}else{
// incomplete array type
elsize = ctype_sizeof(eltype);
cnt = elsize ? len/elsize : 0;
}
if(eltype == sl_bytesym){
if(sl.print_princ){
outsn(f, data, len);
}else{
outc(f, '"');
print_str(f, (char*)data, len);
outc(f, '"');
}
return;
}else if(eltype == sl_runesym){
char buf[UTFmax+1];
if(!sl.print_princ)
outc(f, '"');
for(i = 0; i < cnt; i++, data = (char*)data + elsize){
n = runetochar(buf, (Rune*)data);
buf[n] = 0;
if(!sl.print_princ)
print_str(f, buf, n);
else
outsn(f, buf, n);
}
if(!sl.print_princ)
outc(f, '"');
return;
}
if(!weak){
if(eltype == sl_u8sym){
outsc(f, "#vu8(");
}else{
outsc(f, "#arr(");
sl_print_child(f, eltype);
if(cnt > 0)
outc(f, ' ');
}
}else{
outs(f, "#(");
}
for(i = 0; i < cnt; i++){
if(i > 0)
outc(f, ' ');
cvalue_printdata(f, data, elsize, eltype, 1);
data = (char*)data + elsize;
}
outc(f, ')');
}
}
return;
err:
lerrorf(sl_errio, "write failed");
}
static void
cvalue_print(sl_ios *f, sl_v v)
{
sl_cv *cv = ptr(v);
void *data = cptr(v);
sl_v label;
if(cv_class(cv) == sl_builtintype){
label = (sl_v)ptrhash_get(&slg.reverse_dlsym_lookup, cv);
assert(label != (sl_v)HT_NOTFOUND);
if(sl.print_princ){
outs(f, sym_name(label));
}else{
outsc(f, "#fn(");
outs(f, sym_name(label));
outc(f, ')');
}
}else if(cv_class(cv)->vtable != nil && cv_class(cv)->vtable->print != nil){
cv_class(cv)->vtable->print(v, f);
}else{
sl_v type = cv_type(cv);
usize len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
cvalue_printdata(f, data, len, type, 0);
}
}
static void
set_print_width(void)
{
sl_v pw = sym_value(sl_printwidthsym);
if(!isfixnum(pw))
return;
sl.scr_width = numval(pw);
}
void
sl_print(sl_ios *f, sl_v v)
{
sl.print_pretty = sym_value(sl_printprettysym) != sl_nil;
if(sl.print_pretty)
set_print_width();
sl.print_princ = sym_value(sl_printreadablysym) == sl_nil;
sl_v pl = sym_value(sl_printlengthsym);
sl.print_length = isfixnum(pl) ? numval(pl) : -1;
pl = sym_value(sl_printlevelsym);
sl.print_level = isfixnum(pl) ? numval(pl) : -1;
sl.p_level = 0;
sl.printlabel = 0;
if(!sl.print_princ)
print_traverse(v);
sl.hpos = sl.vpos = 0;
sl_print_child(f, v);
if(sl.print_level >= 0 || sl.print_length >= 0)
memset(sl.consflags, 0, 4*bitvector_nwords(slg.heapsize/sizeof(sl_cons)));
if((iscons(v) || isvec(v) || isfn(v) || iscvalue(v)) &&
!sl_isstr(v) && v != sl_t && v != sl_nil && v != sl_void)
htable_reset(&sl.printconses, 32);
}