static int allsmallp(value_t 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 allsmallp(fl_context_t *fl_ctx, value_t v) { int n = 1; while (iscons(v)) { if (!smallp(fl_ctx, car_(v))) return 0; v = cdr_(v); n++; if (n > 25) return n; } return n; }
void fl_print_child(ios_t *f, value_t v) { char *name, *str; char buf[64]; if (print_level >= 0 && P_LEVEL >= print_level && (iscons(v) || isvector(v) || isclosure(v))) { outc('#', f); return; } P_LEVEL++; switch (tag(v)) { case TAG_NUM : case TAG_NUM1: //HPOS+=ios_printf(f, "%ld", numval(v)); break; str = uint2str(&buf[1], sizeof(buf)-1, labs(numval(v)), 10); if (numval(v)<0) *(--str) = '-'; outs(str, f); break; case TAG_SYM: name = symbol_name(v); if (print_princ) outs(name, f); else if (ismanaged(v)) { outsn("#:", f, 2); outs(name, f); } else print_symbol_name(f, name); break; case TAG_FUNCTION: if (v == FL_T) { outsn("#t", f, 2); } else if (v == FL_F) { outsn("#f", f, 2); } else if (v == FL_NIL) { outsn("()", f, 2); } else if (v == FL_EOF) { outsn("#<eof>", f, 6); } else if (isbuiltin(v)) { if (!print_princ) outsn("#.", f, 2); outs(builtin_names[uintval(v)], f); } else { assert(isclosure(v)); if (!print_princ) { if (print_circle_prefix(f, v)) break; function_t *fn = (function_t*)ptr(v); outs("#fn(", f); char *data = cvalue_data(fn->bcode); size_t i, sz = cvalue_len(fn->bcode); for(i=0; i < sz; i++) data[i] += 48; fl_print_child(f, fn->bcode); for(i=0; i < sz; i++) data[i] -= 48; outc(' ', f); fl_print_child(f, fn->vals); if (fn->env != NIL) { outc(' ', f); fl_print_child(f, fn->env); } if (fn->name != LAMBDA) { outc(' ', f); fl_print_child(f, fn->name); } outc(')', f); } else { outs("#<function>", f); } } break; case TAG_CVALUE: case TAG_CPRIM: if (v == UNBOUND) { outs("#<undefined>", f); break; } case TAG_VECTOR: case TAG_CONS: if (print_circle_prefix(f, v)) break; if (isvector(v)) { outc('[', f); int newindent = HPOS, est; int i, sz = vector_size(v); for(i=0; i < sz; i++) { if (print_length >= 0 && i >= print_length && i < sz-1) { outsn("...", f, 3); break; } fl_print_child(f, vector_elt(v,i)); if (i < sz-1) { if (!print_pretty) { outc(' ', f); } else { est = lengthestimate(vector_elt(v,i+1)); if (HPOS > SCR_WIDTH-4 || (est!=-1 && (HPOS+est > SCR_WIDTH-2)) || (HPOS > SCR_WIDTH/2 && !smallp(vector_elt(v,i+1)) && !tinyp(vector_elt(v,i)))) newindent = outindent(newindent, f); else outc(' ', f); } } } outc(']', f); break; } if (iscvalue(v) || iscprim(v)) cvalue_print(f, v); else print_pair(f, v); break; } P_LEVEL--; }
static void print_pair(ios_t *f, value_t v) { value_t cd; char *op = NULL; if (iscons(cdr_(v)) && cdr_(cdr_(v)) == NIL && !ptrhash_has(&printconses, (void*)cdr_(v)) && (((car_(v) == QUOTE) && (op = "'")) || ((car_(v) == BACKQUOTE) && (op = "`")) || ((car_(v) == COMMA) && (op = ",")) || ((car_(v) == COMMAAT) && (op = ",@")) || ((car_(v) == COMMADOT) && (op = ",.")))) { // special prefix syntax unmark_cons(v); unmark_cons(cdr_(v)); outs(op, f); fl_print_child(f, car_(cdr_(v))); return; } int startpos = HPOS; outc('(', f); int newindent=HPOS, blk=blockindent(v); int lastv, n=0, si, ind=0, est, always=0, nextsmall, thistiny; if (!blk) always = indentevery(v); value_t head = car_(v); int after3 = indentafter3(head, v); int after2 = indentafter2(head, v); int n_unindented = 1; while (1) { cd = cdr_(v); if (print_length >= 0 && n >= print_length && cd!=NIL) { outsn("...)", f, 4); break; } lastv = VPOS; unmark_cons(v); fl_print_child(f, car_(v)); if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) { if (cd != NIL) { outsn(" . ", f, 3); fl_print_child(f, cd); } outc(')', f); break; } if (!print_pretty || ((head == 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 = (((VPOS > lastv) || (HPOS>SCR_WIDTH/2 && !nextsmall && !thistiny && n>0)) || (HPOS > SCR_WIDTH-4) || (est!=-1 && (HPOS+est > SCR_WIDTH-2)) || ((head == LAMBDA) && !nextsmall) || (n > 0 && always) || (n == 2 && after3) || (n == 1 && after2) || (n_unindented >= 3 && !nextsmall) || (n == 0 && !smallp(head))); } if (ind) { newindent = outindent(newindent, f); 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 = HPOS; } } n++; v = cd; } }