From facdfbaf35edae7afb51f6c3dc4d5baa119ea605 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 14 Jul 2014 07:07:48 -0700
Subject: * eval.c (eval_init): Register interpose and lconsp as intrinsics.

* lib.c (lconsp, interpose): New functions.
(lazy_interpose_func, lazy_interpose): New static functions.

* lib.h (lconsp, interpose): Declared.

* txr.1: Documented lconsp and interpose.
---
 lib.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)

(limited to 'lib.c')

diff --git a/lib.c b/lib.c
index d6f4f080..9289250a 100644
--- a/lib.c
+++ b/lib.c
@@ -1612,6 +1612,11 @@ val consp(val obj)
   return (ty == CONS || ty == LCONS) ? t : nil;
 }
 
+val lconsp(val obj)
+{
+  return type(obj) == LCONS ? t : nil;
+}
+
 val atom(val obj)
 {
   return if3(consp(obj), nil, t);
@@ -4974,6 +4979,62 @@ val mappend(val fun, val list)
   return make_like(out, list_orig);
 }
 
+static val lazy_interpose_func(val env, val lcons)
+{
+  cons_bind (sep, list, env);
+  val next = cdr(list);
+  val fun = lcons_fun(lcons);
+
+  rplaca(lcons, car(list));
+
+  if (next) {
+    rplacd(env, next);
+    func_set_env(fun, env);
+    rplacd(lcons, cons(sep, make_lazy_cons(fun)));
+  }
+
+  return nil;
+}
+
+static val lazy_interpose(val sep, val list)
+{
+  return make_lazy_cons(func_f1(cons(sep, list),
+                                lazy_interpose_func));
+}
+
+val interpose(val sep, val seq)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+    {
+      val next;
+      list_collect_decl (out, ptail);
+      for (next = cdr(seq); next; seq = next, next = cdr(seq)) {
+        ptail = list_collect(ptail, car(seq));
+        ptail = list_collect(ptail, sep);
+        if (lconsp(next)) {
+          list_collect_nconc(ptail, lazy_interpose(sep, next));
+          return out;
+        }
+      }
+      list_collect(ptail, car(seq));
+      return out;
+    }
+  case LCONS:
+    return lazy_interpose(sep, seq);
+  case LIT:
+  case STR:
+  case LSTR:
+    return cat_str(interpose(sep, tolist(seq)), nil);
+  case VEC:
+    return vector_list(interpose(sep, tolist(seq)));
+  default:
+    type_mismatch(lit("interpose: ~s is not a sequence"), seq, nao);
+  }
+}
+
 val merge(val list1, val list2, val lessfun, val keyfun)
 {
   list_collect_decl (out, ptail);
-- 
cgit v1.2.3