Add stream printing context.

This is some infrastructure which will support *print-circle*.

* lib.h (struct strm_ctx): Forward declared.
(struct cobj_ops): Add context parameter to print function
pointer.
(cobj_print_op, obj_print_impl): Add context parameter to
declarations.

* hash.c (hash_print_op): Take context argument and
pass it down in obj_print_impl calls.

* lib.c (cobj_print_op, out_quasi_str): Likewise
(obj_print_impl): Likewise, and also pass to
COBJ print method.
(obj_print, obj_pprint): Pass null pointer
as context argument to obj_print_impl.

* regex.c (regex_print): Take context parameter and ignore it.

* socket.c (dgram_print): Likewise.

* stream.h (struct strm_ctx): New struct type.
(struct strm_base): New ctx member, pointer to struct
strm_ctx.
(stream_print_op): Add context parameter to declaration.
(get_set_ctx, get_ctx): Declared.

* stream.c (strm_base_init): Add null pointer to initializer.
(strm_base_cleanup): Add assertion against context pointer
being non-null: that indicates that some stream operation
installed a context pointer and neglected to restore it to
null before returning, which is bad because context will be
stack allocated.
(stream_print_op, stdio_stream_print, cat_stream_print): Take
context parameter and ignore it.
(get_set_ctx, get_ctx): New functions.

* struct.c (struct_type_print): Take context parameter and
ignore it.
(struct_inst_print): Take context parameter and pass
down to obj_print_impl.

8 files changed, 91 insertions, 55 deletions

diff --git a/hash.c b/hash.c
index b98ac2ff..cd49db16 100644
--- a/hash.c
+++ b/hash.c
@@ -374,7 +374,7 @@ static cnum hash_hash_op(val obj, int *count)
   return out;
 }
 
-static void hash_print_op(val hash, val out, val pretty)
+static void hash_print_op(val hash, val out, val pretty, struct strm_ctx *ctx)
 {
   struct hash *h = coerce(struct hash *, hash->co.handle);
   int need_space = 0;
@@ -398,13 +398,13 @@ static void hash_print_op(val hash, val out, val pretty)
     need_space = 1;
     switch (h->flags) {
     case hash_weak_both:
-      obj_print_impl(weak_keys_k, out, pretty);
+      obj_print_impl(weak_keys_k, out, pretty, ctx);
       /* fallthrough */
     case hash_weak_vals:
-      obj_print_impl(weak_vals_k, out, pretty);
+      obj_print_impl(weak_vals_k, out, pretty, ctx);
       break;
     case hash_weak_keys:
-      obj_print_impl(weak_keys_k, out, pretty);
+      obj_print_impl(weak_keys_k, out, pretty, ctx);
       break;
     default:
       break;
@@ -413,9 +413,9 @@ static void hash_print_op(val hash, val out, val pretty)
   if (h->userdata) {
     if (need_space)
       put_char(chr(' '), out);
-    obj_print_impl(userdata_k, out, pretty);
+    obj_print_impl(userdata_k, out, pretty, ctx);
     put_char(chr(' '), out);
-    obj_print_impl(h->userdata, out, pretty);
+    obj_print_impl(h->userdata, out, pretty, ctx);
   }
   put_string(lit(")"), out);
   maphash(curry_123_23(func_n3(print_key_val), out), hash);
diff --git a/lib.c b/lib.c
index e4f7f912..ef928983 100644
--- a/lib.c
+++ b/lib.c
@@ -6808,10 +6808,10 @@ struct cobj_ops *cobj_ops(val cobj, val cls_sym)
   return cobj->co.ops;
 }
 
-void cobj_print_op(val obj, val out, val pretty)
+void cobj_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
 {
   put_string(lit("#<"), out);
-  obj_print_impl(obj->co.cls, out, pretty);
+  obj_print_impl(obj->co.cls, out, pretty, ctx);
   format(out, lit(": ~p>"), coerce(val, obj->co.handle), nao);
 }
 
@@ -9012,7 +9012,7 @@ static void out_lazy_str(val lstr, val out)
   put_char(chr('"'), out);
 }
 
-static void out_quasi_str(val args, val out)
+static void out_quasi_str(val args, val out, struct strm_ctx *ctx)
 {
   val iter, next;
 
@@ -9040,25 +9040,25 @@ static void out_quasi_str(val args, val out)
         put_char(chr('@'), out);
         if (need_brace)
           put_char(chr('{'), out);
-        obj_print_impl(name, out, nil);
+        obj_print_impl(name, out, nil, ctx);
         while (mods) {
           put_char(chr(' '), out);
-          obj_print_impl(car(mods), out, nil);
+          obj_print_impl(car(mods), out, nil, ctx);
           mods = cdr(mods);
         }
         if (need_brace)
           put_char(chr('}'), out);
       } else if (sym == expr_s) {
         put_char(chr('@'), out);
-        obj_print_impl(rest(elem), out, nil);
+        obj_print_impl(rest(elem), out, nil, ctx);
       }
     } else {
-      obj_print_impl(elem, out, nil);
+      obj_print_impl(elem, out, nil, ctx);
     }
   }
 }
 
-val obj_print_impl(val obj, val out, val pretty)
+val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx)
 {
   val ret = obj;
 
@@ -9078,62 +9078,62 @@ val obj_print_impl(val obj, val out, val pretty)
 
       if (sym == quote_s && two_elem) {
         put_char(chr('\''), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == sys_qquote_s && two_elem) {
         put_char(chr('^'), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == sys_unquote_s && two_elem) {
         put_char(chr(','), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == sys_splice_s && two_elem) {
         put_string(lit(",*"), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == vector_lit_s && two_elem) {
         put_string(lit("#"), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == hash_lit_s) {
         put_string(lit("#H"), out);
-        obj_print_impl(rest(obj), out, pretty);
+        obj_print_impl(rest(obj), out, pretty, ctx);
       } else if (sym == var_s && two_elem &&
                  (symbolp(second(obj)) || integerp(second(obj))))
       {
         put_char(chr('@'), out);
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
       } else if (sym == expr_s) {
         put_char(chr('@'), out);
-        obj_print_impl(rest(obj), out, pretty);
+        obj_print_impl(rest(obj), out, pretty, ctx);
       } else if (sym == rcons_s && consp(cdr(obj))
                  && consp(cddr(obj)) && !(cdddr(obj)))
       {
-        obj_print_impl(second(obj), out, pretty);
+        obj_print_impl(second(obj), out, pretty, ctx);
         put_string(lit(".."), out);
-        obj_print_impl(third(obj), out, pretty);
+        obj_print_impl(third(obj), out, pretty, ctx);
       } else if (sym == qref_s && simple_qref_args_p(cdr(obj), zero)) {
         val iter, next;
         for (iter = cdr(obj); iter; iter = next) {
           next = cdr(iter);
-          obj_print_impl(car(iter), out, pretty);
+          obj_print_impl(car(iter), out, pretty, ctx);
           if (next)
             put_string(lit("."), out);
           iter = next;
         }
       } else if (sym == quasi_s) {
         put_char(chr('`'), out);
-        out_quasi_str(obj, out);
+        out_quasi_str(obj, out, ctx);
         put_char(chr('`'), out);
       } else if (sym == quasilist_s) {
         val args = cdr(obj);
         put_string(lit("#`"), out);
         if (args) {
-          out_quasi_str(car(args), out);
+          out_quasi_str(car(args), out, ctx);
           args = cdr(args);
         }
         while (args) {
           put_char(chr(' '), out);
-          out_quasi_str(car(args), out);
+          out_quasi_str(car(args), out, ctx);
           args = cdr(args);
         }
-        out_quasi_str(cdr(obj), out);
+        out_quasi_str(cdr(obj), out, ctx);
         put_char(chr('`'), out);
       } else {
         val iter;
@@ -9152,10 +9152,10 @@ val obj_print_impl(val obj, val out, val pretty)
           indent = one;
           save_indent = inc_indent(out, indent);
           set_indent_mode(out, num_fast(indent_code));
-          obj_print_impl(sym, out, pretty);
+          obj_print_impl(sym, out, pretty, ctx);
           if (second(obj)) {
             put_string(lit(" (. "), out);
-            obj_print_impl(second(obj), out, pretty);
+            obj_print_impl(second(obj), out, pretty, ctx);
             put_char(chr(')'), out);
           } else {
             put_string(lit(" ()"), out);
@@ -9166,7 +9166,7 @@ val obj_print_impl(val obj, val out, val pretty)
           indent = one;
           set_indent_mode(out, num_fast(indent_code));
         } else if (fboundp(sym)) {
-          obj_print_impl(sym, out, pretty);
+          obj_print_impl(sym, out, pretty, ctx);
           indent = one;
           save_indent = inc_indent(out, indent);
           set_indent_mode(out, num_fast(indent_code));
@@ -9177,7 +9177,7 @@ val obj_print_impl(val obj, val out, val pretty)
         save_indent = inc_indent(out, indent);
 
         for (iter = obj; consp(iter); iter = cdr(iter)) {
-          obj_print_impl(car(iter), out, pretty);
+          obj_print_impl(car(iter), out, pretty, ctx);
 finish:
           if (nilp(cdr(iter))) {
             put_char(closepar, out);
@@ -9185,7 +9185,7 @@ finish:
             width_check(out, chr(' '));
           } else {
             put_string(lit(" . "), out);
-            obj_print_impl(cdr(iter), out, pretty);
+            obj_print_impl(cdr(iter), out, pretty, ctx);
             put_char(closepar, out);
           }
         }
@@ -9302,7 +9302,7 @@ finish:
 
       for (i = 0; i < length; i++) {
         val elem = obj->v.vec[i];
-        obj_print_impl(elem, out, pretty);
+        obj_print_impl(elem, out, pretty, ctx);
         if (i < length - 1)
           width_check(out, chr(' '));
       }
@@ -9321,7 +9321,7 @@ finish:
     }
     break;
   case COBJ:
-    obj->co.ops->print(obj, out, pretty);
+    obj->co.ops->print(obj, out, pretty, ctx);
     break;
   case ENV:
     format(out, lit("#<environment: ~p>"), obj, nao);
@@ -9347,7 +9347,7 @@ val obj_print(val obj, val stream)
 
   uw_simple_catch_begin;
 
-  ret = obj_print_impl(obj, out, nil);
+  ret = obj_print_impl(obj, out, nil, 0);
 
   uw_unwind {
     set_indent_mode(out, save_mode);
@@ -9368,7 +9368,7 @@ val obj_pprint(val obj, val stream)
 
   uw_simple_catch_begin;
 
-  ret = obj_print_impl(obj, out, t);
+  ret = obj_print_impl(obj, out, t, 0);
 
   uw_unwind {
     set_indent_mode(out, save_mode);
diff --git a/lib.h b/lib.h
index 9e1405a0..5d620446 100644
--- a/lib.h
+++ b/lib.h
@@ -228,9 +228,11 @@ struct cobj {
   val cls;
 };
 
+struct strm_ctx;
+
 struct cobj_ops {
   val (*equal)(val self, val other);
-  void (*print)(val self, val stream, val pretty);
+  void (*print)(val self, val stream, val pretty, struct strm_ctx *);
   void (*destroy)(val self);
   void (*mark)(val self);
   cnum (*hash)(val self, int *count);
@@ -248,7 +250,7 @@ struct cobj_ops {
  * Default equal is eq
  */
 
-void cobj_print_op(val, val, val);
+void cobj_print_op(val, val, val, struct strm_ctx *);
 void cobj_destroy_stub_op(val);
 void cobj_destroy_free_op(val);
 void cobj_mark_op(val);
@@ -975,7 +977,7 @@ val set_from(val range, val from);
 val set_to(val range, val to);
 val env(void);
 void out_str_char(wchar_t ch, val out, int *semi_flag);
-val obj_print_impl(val obj, val out, val pretty);
+val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *);
 val obj_print(val obj, val stream);
 val obj_pprint(val obj, val stream);
 val tostring(val obj);
diff --git a/regex.c b/regex.c
index 14f89fcc..bd6ed971 100644
--- a/regex.c
+++ b/regex.c
@@ -1373,7 +1373,7 @@ static void regex_mark(val obj)
   gc_mark(regex->source);
 }
 
-static void regex_print(val obj, val stream, val pretty);
+static void regex_print(val obj, val stream, val pretty, struct strm_ctx *);
 
 static struct cobj_ops regex_obj_ops = cobj_ops_init(eq,
                                                      regex_print,
@@ -2308,12 +2308,14 @@ static void print_rec(val exp, val stream, int *semi_flag)
   }
 }
 
-static void regex_print(val obj, val stream, val pretty)
+static void regex_print(val obj, val stream, val pretty, struct strm_ctx *ctx)
 {
   regex_t *regex = coerce(regex_t *, cobj_handle(obj, regex_s));
   int semi_flag = 0;
 
   (void) pretty;
+  (void) ctx;
+
   put_string(lit("#/"), stream);
   print_rec(regex->source, stream, &semi_flag);
   put_char(chr('/'), stream);
diff --git a/socket.c b/socket.c
index bf398357..fe0c4a83 100644
--- a/socket.c
+++ b/socket.c
@@ -320,13 +320,14 @@ static val make_dgram_sock_stream(int fd, val family, val peer,
   return stream;
 }
 
-static void dgram_print(val stream, val out, val pretty)
+static void dgram_print(val stream, val out, val pretty, struct strm_ctx *ctx)
 {
   struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
   val name = static_str(ops->name);
   val descr = ops->get_prop(stream, name_k);
 
   (void) pretty;
+  (void) ctx;
 
   format(out, lit("#<~a ~a ~p>"), name, descr, stream, nao);
 }
diff --git a/stream.c b/stream.c
index 0c7fa12b..3282b7f6 100644
--- a/stream.c
+++ b/stream.c
@@ -90,13 +90,13 @@ val shell, shell_arg;
 
 void strm_base_init(struct strm_base *s)
 {
-  static struct strm_base init = { indent_off, 60, 10, 0, 0 };
+  static struct strm_base init = { indent_off, 60, 10, 0, 0, 0 };
   *s = init;
 }
 
 void strm_base_cleanup(struct strm_base *s)
 {
-  (void) s;
+  bug_unless (s->ctx == 0);
 }
 
 void strm_base_mark(struct strm_base *s)
@@ -104,10 +104,11 @@ void strm_base_mark(struct strm_base *s)
   (void) s;
 }
 
-void stream_print_op(val stream, val out, val pretty)
+void stream_print_op(val stream, val out, val pretty, struct strm_ctx *ctx)
 {
   val name = stream_get_prop(stream, name_k);
   (void) pretty;
+  (void) ctx;
   format(out, lit("#<~a ~p>"), name, stream, nao);
 }
 
@@ -388,7 +389,8 @@ struct stdio_handle {
 #endif
 };
 
-static void stdio_stream_print(val stream, val out, val pretty)
+static void stdio_stream_print(val stream, val out, val pretty,
+                               struct strm_ctx *ctx)
 {
   struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle);
   struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
@@ -396,6 +398,7 @@ static void stdio_stream_print(val stream, val out, val pretty)
   val descr = ops->get_prop(stream, name_k);
 
   (void) pretty;
+  (void) ctx;
 
   if (h->pid)
     format(out, lit("#<~a ~a ~a ~p>"), name, descr, num(h->pid), stream, nao);
@@ -2181,13 +2184,15 @@ struct cat_strm {
   val streams;
 };
 
-static void cat_stream_print(val stream, val out, val pretty)
+static void cat_stream_print(val stream, val out, val pretty,
+                             struct strm_ctx *ctx)
 {
   struct cat_strm *s = coerce(struct cat_strm *, stream->co.handle);
   struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
   val name = static_str(ops->name);
 
   (void) pretty;
+  (void) ctx;
 
   format(out, lit("#<~a ~s>"), name, s->streams, nao);
 }
@@ -3535,6 +3540,22 @@ val width_check(val stream, val alt)
   return t;
 }
 
+struct strm_ctx *get_set_ctx(val stream, struct strm_ctx *ctx)
+{
+  struct strm_base *s = coerce(struct strm_base *,
+                               cobj_handle(stream, stream_s));
+  struct strm_ctx *ret = s->ctx;
+  s->ctx = ctx;
+  return ret;
+}
+
+struct strm_ctx *get_ctx(val stream)
+{
+  struct strm_base *s = coerce(struct strm_base *,
+                               cobj_handle(stream, stream_s));
+  return s->ctx;
+}
+
 val get_string(val stream_in, val nchars, val close_after_p)
 {
   val stream = default_arg(stream_in, std_input);
diff --git a/stream.h b/stream.h
index 14ef8e4f..818ad9cd 100644
--- a/stream.h
+++ b/stream.h
@@ -37,12 +37,18 @@ enum indent_mode {
   indent_code
 };
 
+struct strm_ctx {
+  val obj_hash;
+  val counter;
+};
+
 struct strm_base {
   enum indent_mode indent_mode;
   cnum data_width;
   cnum code_width;
   cnum indent_chars;
   cnum column;
+  struct strm_ctx *ctx;
 };
 
 struct strm_ops {
@@ -126,7 +132,7 @@ void strm_base_init(struct strm_base *s);
 void strm_base_cleanup(struct strm_base *s);
 void strm_base_mark(struct strm_base *s);
 void fill_stream_ops(struct strm_ops *ops);
-void stream_print_op(val stream, val out, val pretty);
+void stream_print_op(val stream, val out, val pretty, struct strm_ctx *);
 void stream_mark_op(val stream);
 void stream_destroy_op(val stream);
 struct stdio_mode parse_mode(val mode_str, struct stdio_mode m_dfl);
@@ -189,6 +195,8 @@ val get_indent(val stream);
 val set_indent(val stream, val indent);
 val inc_indent(val stream, val delta);
 val width_check(val stream, val alt);
+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);
 val open_directory(val path);
 val open_file(val path, val mode_str);
diff --git a/struct.c b/struct.c
index 54631098..b109751c 100644
--- a/struct.c
+++ b/struct.c
@@ -373,9 +373,10 @@ val super(val type)
   }
 }
 
-static void struct_type_print(val obj, val out, val pretty)
+static void struct_type_print(val obj, val out, val pretty, struct strm_ctx *c)
 {
   struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+  (void) c;
   format(out, lit("#<struct-type ~s>"), st->name, nao);
 }
 
@@ -1225,7 +1226,8 @@ val umethod(val slot, struct args *args)
     return func_f0v(cons(slot, args_get_list(args)), umethod_args_fun);
 }
 
-static void struct_inst_print(val obj, val out, val pretty)
+static void struct_inst_print(val obj, val out, val pretty,
+                              struct strm_ctx *ctx)
 {
   struct struct_inst *si = coerce(struct struct_inst *, obj->co.handle);
   struct struct_type *st = si->type;
@@ -1242,7 +1244,7 @@ static void struct_inst_print(val obj, val out, val pretty)
   }
 
   put_string(lit("#S("), out);
-  obj_print_impl(st->name, out, pretty);
+  obj_print_impl(st->name, out, pretty, ctx);
   save_indent = inc_indent(out, one);
 
   for (iter = st->slots, once = t; iter; iter = cdr(iter)) {
@@ -1254,9 +1256,9 @@ static void struct_inst_print(val obj, val out, val pretty)
       } else {
         width_check(out, chr(' '));
       }
-      obj_print_impl(sym, out, pretty);
+      obj_print_impl(sym, out, pretty, ctx);
       put_char(chr(' '), out);
-      obj_print_impl(slot(obj, sym), out, pretty);
+      obj_print_impl(slot(obj, sym), out, pretty, ctx);
     }
   }
   put_char(chr(')'), out);