Multi-line, indented printing of structure.

* eval.c (op_error): New static function.
(macro_form_p, fboundp): Static to external.
(special_operator_p): New function.
(eval_init): Register macrolet and symacrolet to op_error.
These are recognized and processed by expand, but we want
them in the op table so they are reported by special_operator_p.

* eval.h (fboundp, macro_form_p, special_operator_p): Declared.

* hash.c (print_key_val): Break long lines on spaces
between pairs with stream_width_check.
(hash_print_op): Implement split and indented printing.

* lib.c (obj_print_impl): New static function, resulting
from a merge of obj_print and obj_pprint. Fixes some
wrong-way recursion bugs: obj_pprint recursed into obj_print
in some places. Adds support for multi-line printing of
vectors and lists, with indentation using the new
interfaces in streams.

* stream.c (strm_base_init): Update initializer.
(put_indent, indent_mode_put_string): New static functions.
(put_string): Use indent_mode_put_string in either of the
two indent modes.
(put_char): Implement indent mode.
(get_indent_mode, test_set_indent_mode,
set_indent_mode, get_indent, set_indent,
inc_indent, width_check): New functions.

* stream.h (enum indent_mode): New.
(struct strm_base): indent_on member becomes indent_mode.
New members data_width and code_width.
(get_indent_mode, test_set_indent_mode,
set_indent_mode, get_indent, set_indent,
inc_indent, width_check): Declared.

* tests/009/json.expected: Updated.

* tests/010/seq.expected: Likewise.

* tests/011/macros-2.expected: Likewise.

1 files changed, 120 insertions, 166 deletions

diff --git a/lib.c b/lib.c
index 6a662fbc..05f94f15 100644
--- a/lib.c
+++ b/lib.c
@@ -6905,49 +6905,54 @@ static void obj_init(void)
   prog_string = string(progname);
 }
 
-val obj_print(val obj, val out)
+static val obj_print_impl(val obj, val out, val pretty)
 {
-  out = default_arg(out, std_output);
+  val ret = obj;
 
   switch (type(obj)) {
   case NIL:
-    put_string(lit("nil"), out);
-    return obj;
+    put_string(if3(get_indent_mode(out) == num_fast(indent_code),
+                   lit("()"), lit("nil")), out);
+    break;
   case CONS:
   case LCONS:
     {
-      val obj_in = obj;
       val sym = car(obj);
+      val save_mode = test_set_indent_mode(out, num_fast(indent_off),
+                                           num_fast(indent_data));
+      val save_indent = nil;
 
       if (sym == quote_s && consp(cdr(obj)) && !(cdr(cdr(obj)))) {
         put_char(chr('\''), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == sys_qquote_s) {
         put_char(chr('^'), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == sys_unquote_s) {
         put_char(chr(','), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == sys_splice_s) {
         put_string(lit(",*"), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == vector_lit_s) {
         put_string(lit("#"), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == hash_lit_s) {
         put_string(lit("#H"), out);
-        obj_print(rest(obj), out);
+        obj_print_impl(rest(obj), out, pretty);
       } else if (sym == var_s && (symbolp(second(obj)) || integerp(second(obj)))
                  && !cdr(cdr(obj)))
       {
         put_char(chr('@'), out);
-        obj_print(second(obj), out);
+        obj_print_impl(second(obj), out, pretty);
       } else if (sym == expr_s) {
         put_char(chr('@'), out);
-        obj_print(rest(obj), out);
+        obj_print_impl(rest(obj), out, pretty);
       } else {
         val iter;
         val closepar = chr(')');
+        val indent = zero;
+
         if (sym == dwim_s && consp(cdr(obj))) {
           put_char(chr('['), out);
           obj = cdr(obj);
@@ -6957,37 +6962,58 @@ val obj_print(val obj, val out)
         }
 
         if (sym == lambda_s && consp(cdr(obj)) && symbolp(second(obj))) {
-          obj_print(sym, out);
+          indent = one;
+          save_indent = inc_indent(out, indent);
+          set_indent_mode(out, num_fast(indent_code));
+          obj_print_impl(sym, out, pretty);
           if (second(obj)) {
             put_string(lit(" (. "), out);
-            obj_print(second(obj), out);
+            obj_print_impl(second(obj), out, pretty);
             put_char(chr(')'), out);
           } else {
             put_string(lit(" ()"), out);
           }
-          iter = (cdr(obj));
+          iter = cdr(obj);
+          goto finish;
+        } else if (special_operator_p(sym) || macro_form_p(obj, nil)) {
+          indent = one;
+          set_indent_mode(out, num_fast(indent_code));
+        } else if (fboundp(sym)) {
+          obj_print_impl(sym, out, pretty);
+          indent = one;
+          save_indent = inc_indent(out, indent);
+          set_indent_mode(out, num_fast(indent_code));
+          iter = obj;
           goto finish;
         }
 
+        save_indent = inc_indent(out, indent);
+
         for (iter = obj; consp(iter); iter = cdr(iter)) {
-          obj_print(car(iter), out);
+          obj_print_impl(car(iter), out, pretty);
 finish:
           if (nilp(cdr(iter))) {
             put_char(closepar, out);
           } else if (consp(cdr(iter))) {
-            put_char(chr(' '), out);
+            width_check(out, chr(' '));
           } else {
             put_string(lit(" . "), out);
-            obj_print(cdr(iter), out);
+            obj_print_impl(cdr(iter), out, pretty);
             put_char(closepar, out);
           }
         }
       }
-      return obj_in;
+
+      if (save_indent)
+        set_indent(out, save_indent);
+      set_indent_mode(out, save_mode);
+      break;
     }
   case LIT:
   case STR:
-    {
+    if (pretty) {
+      put_string(obj, out);
+    } else {
       const wchar_t *ptr;
       int semi_flag = 0;
       put_char(chr('"'), out);
@@ -7018,9 +7044,11 @@ finish:
       }
       put_char(chr('"'), out);
     }
-    return obj;
+    break;
   case CHR:
-    {
+    if (pretty) {
+      put_char(obj, out);
+    } else {
       wchar_t ch = c_chr(obj);
 
       put_string(lit("#\\"), out);
@@ -7047,189 +7075,115 @@ finish:
           put_char(chr(ch), out);
       }
     }
-    return obj;
+    break;
   case NUM:
   case BGNUM:
   case FLNUM:
     format(out, lit("~s"), obj, nao);
-    return obj;
+    break;
   case SYM:
-    if (obj->s.package != user_package) {
-      if (!obj->s.package)
-        put_char(chr('#'), out);
-      else if (obj->s.package != keyword_package)
-        put_string(obj->s.package->pk.name, out);
-      put_char(chr(':'), out);
+    if (!pretty) {
+      if (obj->s.package != user_package) {
+        if (!obj->s.package)
+          put_char(chr('#'), out);
+        else if (obj->s.package != keyword_package)
+          put_string(obj->s.package->pk.name, out);
+        put_char(chr(':'), out);
+      }
     }
     put_string(symbol_name(obj), out);
-    return obj;
+    break;
   case PKG:
     format(out, lit("#<package: ~s>"), obj->pk.name, nao);
-    return obj;
+    break;
   case FUN:
     format(out, lit("#<function: type ~a>"), num(obj->f.functype), nao);
-    return obj;
+    break;
   case VEC:
     {
       cnum i, length = c_num(obj->v.vec[vec_length]);
+      val save_mode = test_set_indent_mode(out, num_fast(indent_off),
+                                           num_fast(indent_data));
+      val save_indent;
+
       put_string(lit("#("), out);
+
+      save_indent = inc_indent(out, zero);
+
       for (i = 0; i < length; i++) {
-        obj_print(obj->v.vec[i], out);
+        val elem = obj->v.vec[i];
+        obj_print_impl(elem, out, pretty);
         if (i < length - 1)
-          put_char(chr(' '), out);
+          width_check(out, chr(' '));
       }
+
       put_char(chr(')'), out);
+
+      set_indent(out, save_indent);
+      set_indent_mode(out, save_mode);
     }
-    return obj;
+    break;
   case LSTR:
     if (obj->ls.list)
       format(out, lit("#<lazy-string: ~s (~s ...)>"), obj->ls.prefix,
              obj->ls.list, nao);
     else
-      obj_print(obj->ls.prefix, out);
-    return obj;
+      obj_print_impl(obj->ls.prefix, out, pretty);
+    break;
   case COBJ:
     obj->co.ops->print(obj, out);
-    return obj;
+    break;
   case ENV:
     format(out, lit("#<environment: ~p>"), obj, nao);
-    return obj;
+    break;
+  default:
+    format(out, lit("#<garbage: ~p>"), obj, nao);
+    break;
   }
 
-  format(out, lit("#<garbage: ~p>"), obj, nao);
-  return obj;
+  return ret;
 }
 
-val obj_pprint(val obj, val out)
+val obj_print(val obj, val stream)
 {
-  out = default_arg(out, std_output);
+  volatile val ret = nil;
+  val out = default_arg(stream, std_output);
+  val save_mode = get_indent_mode(out);
+  val save_indent = get_indent(out);
 
-  switch (type(obj)) {
-  case NIL:
-    put_string(lit("nil"), out);
-    return obj;
-  case CONS:
-  case LCONS:
-    {
-      val obj_in = obj;
-      val sym = car(obj);
+  uw_simple_catch_begin;
 
-      if (sym == quote_s && consp(cdr(obj)) && !(cdr(cdr(obj)))) {
-        put_char(chr('\''), out);
-        obj_print(second(obj), out);
-      } else if (sym == sys_qquote_s) {
-        put_char(chr('^'), out);
-        obj_print(second(obj), out);
-      } else if (sym == sys_unquote_s) {
-        put_char(chr(','), out);
-        obj_pprint(second(obj), out);
-      } else if (sym == sys_splice_s) {
-        put_string(lit(",*"), out);
-        obj_pprint(second(obj), out);
-      } else if (sym == vector_lit_s) {
-        put_string(lit("#"), out);
-        obj_print(second(obj), out);
-      } else if (sym == hash_lit_s) {
-        put_string(lit("#H"), out);
-        obj_print(rest(obj), out);
-      } else if (sym == var_s && (symbolp(second(obj)) || integerp(second(obj)))
-                 && !cdr(cdr(obj)))
-      {
-        put_char(chr('@'), out);
-        obj_print(second(obj), out);
-      } else if (sym == expr_s) {
-        put_char(chr('@'), out);
-        obj_print(rest(obj), out);
-      } else {
-        val iter;
-        val closepar = chr(')');
-        if (sym == dwim_s && consp(cdr(obj))) {
-          put_char(chr('['), out);
-          obj = cdr(obj);
-          closepar = chr(']');
-        } else {
-          put_char(chr('('), out);
-        }
+  ret = obj_print_impl(obj, out, nil);
 
-        if (sym == lambda_s && consp(cdr(obj)) && symbolp(second(obj))) {
-          obj_print(sym, out);
-          if (second(obj)) {
-            put_string(lit(" (. "), out);
-            obj_pprint(second(obj), out);
-            put_char(chr(')'), out);
-          } else {
-            put_string(lit(" ()"), out);
-          }
-          iter = (cdr(obj));
-          goto finish;
-        }
+  uw_unwind {
+    set_indent_mode(out, save_mode);
+    set_indent(out, save_indent);
+  }
 
-        for (iter = obj; consp(iter); iter = cdr(iter)) {
-          obj_pprint(car(iter), out);
-finish:
-          if (nilp(cdr(iter))) {
-            put_char(closepar, out);
-          } else if (consp(cdr(iter))) {
-            put_char(chr(' '), out);
-          } else {
-            put_string(lit(" . "), out);
-            obj_pprint(cdr(iter), out);
-            put_char(closepar, out);
-          }
-        }
-      }
-      return obj_in;
-    }
-  case LIT:
-  case STR:
-    put_string(obj, out);
-    return obj;
-  case CHR:
-    put_char(obj, out);
-    return obj;
-  case NUM:
-  case BGNUM:
-  case FLNUM:
-    format(out, lit("~s"), obj, nao);
-    return obj;
-  case SYM:
-    put_string(symbol_name(obj), out);
-    return obj;
-  case PKG:
-    format(out, lit("#<package: ~s>"), obj->pk.name, nao);
-    return obj;
-  case FUN:
-    format(out, lit("#<function: type ~a>"), num(obj->f.functype), nao);
-    return obj;
-  case VEC:
-    {
-      cnum i, length = c_num(obj->v.vec[vec_length]);
-      put_string(lit("#("), out);
-      for (i = 0; i < length; i++) {
-        obj_pprint(obj->v.vec[i], out);
-        if (i < length - 1)
-          put_char(chr(' '), out);
-      }
-      put_char(chr(')'), out);
-    }
-    return obj;
-  case LSTR:
-    if (obj->ls.list)
-      format(out, lit("#<lazy-string: ~s (~s ...)>"), obj->ls.prefix,
-             obj->ls.list, nao);
-    else
-      obj_pprint(obj->ls.prefix, out);
-    return obj;
-  case COBJ:
-    obj->co.ops->print(obj, out);
-    return obj;
-  case ENV:
-    format(out, lit("#<environment: ~p>"), obj, nao);
-    return obj;
+  uw_catch_end;
+
+  return ret;
+}
+
+val obj_pprint(val obj, val stream)
+{
+  volatile val ret = nil;
+  val out = default_arg(stream, std_output);
+  val save_mode = get_indent_mode(out);
+  val save_indent = get_indent(out);
+
+  uw_simple_catch_begin;
+
+  ret = obj_print_impl(obj, out, t);
+
+  uw_unwind {
+    set_indent_mode(out, save_mode);
+    set_indent(out, save_indent);
   }
 
-  format(out, lit("#<garbage: ~p>"), obj, nao);
-  return obj;
+  uw_catch_end;
+
+  return ret;
 }
 
 val tostring(val obj)