* eval.c (prinl, pprinl): Become external functions.

(tprint): New function.
(eval_init): Register tprint as intrinsic.

* eval.h (prinl, pprinl, tprint): Declared.

* txr.c (txr_main): New option, -t.

* txr.1: Documented tprint and -t option.

5 files changed, 90 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index a8ddd5fd..054fcfc7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2015-03-28  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (prinl, pprinl): Become external functions.
+	(tprint): New function.
+	(eval_init): Register tprint as intrinsic.
+
+	* eval.h (prinl, pprinl, tprint): Declared.
+
+	* txr.c (txr_main): New option, -t.
+
+	* txr.1: Documented tprint and -t option.
+
+2015-03-28  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (eval_init): register get-lines as having one optional
 	argument.
 
diff --git a/eval.c b/eval.c
index c4196e72..cb7229b0 100644
--- a/eval.c
+++ b/eval.c
@@ -3664,20 +3664,43 @@ static val mapf(val fun, val funlist)
   return func_f0v(cons(fun, funlist), do_mapf);
 }
 
-static val prinl(val obj, val stream)
+val prinl(val obj, val stream)
 {
   val ret = obj_print(obj, stream);
   put_char(chr('\n'), stream);
   return ret;
 }
 
-static val pprinl(val obj, val stream)
+val pprinl(val obj, val stream)
 {
   val ret = obj_pprint(obj, stream);
   put_char(chr('\n'), stream);
   return ret;
 }
 
+val tprint(val obj, val out)
+{
+  switch (type(obj)) {
+  case NIL:
+    break;
+  case CONS:
+  case LCONS:
+  case VEC:
+    mapdo(curry_12_1(func_n2(tprint), out), obj);
+    break;
+  case LIT:
+  case STR:
+  case LSTR:
+    put_line(obj, out);
+    break;
+  default:
+    pprinl(obj, out);
+    break;
+  }
+
+  return nil;
+}
+
 static val merge_wrap(val seq1, val seq2, val lessfun, val keyfun)
 {
   if (!nullify(seq1)) {
@@ -4139,6 +4162,7 @@ void eval_init(void)
   reg_fun(intern(lit("tostringp"), user_package), func_n1(tostringp));
   reg_fun(intern(lit("prinl"), user_package), func_n2o(prinl, 1));
   reg_fun(intern(lit("pprinl"), user_package), func_n2o(pprinl, 1));
+  reg_fun(intern(lit("tprint"), user_package), func_n2o(tprint, 1));
 
   reg_var(user_package_s = intern(lit("*user-package*"), user_package_var),
           user_package_var);
diff --git a/eval.h b/eval.h
index f027de1a..39344c05 100644
--- a/eval.h
+++ b/eval.h
@@ -49,5 +49,8 @@ val bindable(val obj);
 val mapcarv(val fun, val list_of_lists);
 val lazy_mapcar(val fun, val list);
 val generate(val while_pred, val gen_fun);
+val prinl(val obj, val stream);
+val pprinl(val obj, val stream);
+val tprint(val obj, val out);
 
 void eval_init(void);
diff --git a/txr.1 b/txr.1
index 8c654150..daf29a76 100644
--- a/txr.1
+++ b/txr.1
@@ -618,6 +618,13 @@ but prints using the
 .code pprinl
 function.
 
+.meIP -t < expression
+Like
+.code -p
+but prints using the
+.code tprint
+function.
+
 .meIP -C < number
 .meIP >> --compat= number
 
@@ -22256,6 +22263,40 @@ which is rendered as
 .codn #\ex ,
 they look like a hex character code.
 
+.coNP Function @ tprint
+.synb
+.mets (tprint < obj <> [ stream ])
+.syne
+.desc
+
+The
+.codn tprint
+function prints a represntation of
+.meta obj
+on
+.metn stream .
+
+If the stream argument is not supplied, then
+the destination is the stream currently stored in the
+.code *stdout*
+variable.
+
+For all object types except lists and vectors,
+.code tprint
+behaves like
+.codn pprinl .
+
+If
+.code obj
+is a list or vector, then
+.code tprint
+recurses: the
+.code tprint
+function is applied to each element.  An empty list or vector
+results in no output at all.  This effectively means that an arbitrarily nested
+structure of lists and vectors is printed flattened, with one element on each
+line.
+
 .coNP Function @ streamp
 .synb
 .mets (streamp << obj )
diff --git a/txr.c b/txr.c
index 1a33cfec..d0e97a42 100644
--- a/txr.c
+++ b/txr.c
@@ -127,6 +127,7 @@ static void help(void)
 "-p expression          Like -e, but prints the result of the expression\n"
 "                       using the prinl function.\n"
 "-P expression          Like -p, but prints using pprinl.\n"
+"-t expression          Like -p, but prints using tprint.\n"
 "-C N                   Request backward-compatible behavior to the\n"
 "                       specified version of TXR.\n"
 "--help                 You already know!\n"
@@ -503,7 +504,7 @@ int txr_main(int argc, char **argv)
 
 
     /* Single letter options with args: non-clumping. */
-    if (length(arg) == two && find(ref(arg, one), lit("acfepPC"), nil, nil))
+    if (length(arg) == two && find(ref(arg, one), lit("acfepPtC"), nil, nil))
     {
       val opt = chr_str(arg, one);
 
@@ -536,12 +537,15 @@ int txr_main(int argc, char **argv)
         break;
       case 'p':
       case 'P':
+      case 't':
         {
           val (*pf)(val obj, val out) = if3(c_chr(opt) == 'p',
-                                            obj_print, obj_pprint);
+                                            prinl,
+                                            if3(c_chr(opt) == 'P',
+                                                pprinl,
+                                                tprint));
           pf(eval_intrinsic(lisp_parse(arg, std_error, colon_k),
                             make_env(bindings, nil, nil)), std_output);
-          put_char(chr('\n'), std_output);
           evaled = t;
         }
         break;
@@ -590,6 +594,7 @@ int txr_main(int argc, char **argv)
         case 'P':
         case 'f':
         case 'C':
+        case 't':
         case 'D':
           format(std_error, lit("~a: option -~a does not clump\n"),
                  prog_string, opch, nao);