Adding revappend and nreconc.

* eval.c (eval_init): Register revappend and nreconc
intrinsics.

* lib.c (list_collect_nreconc): New function.
(revlist): New static function.
(list_collect_revappend): New function.
(revappend, nreconc): New functions.

* lib.h (revappend, nreconc): Declared.
(list_collect_nreconc, list_collect_revappend): Declared.

* txr.1: Documented revappend and nreconc.

4 files changed, 143 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 099c1327..fd5a720f 100644
--- a/eval.c
+++ b/eval.c
@@ -4420,6 +4420,8 @@ void eval_init(void)
   reg_fun(append_s, func_n0v(appendv));
   reg_fun(intern(lit("append*"), user_package), func_n0v(lazy_appendv));
   reg_fun(intern(lit("nconc"), user_package), func_n0v(nconcv));
+  reg_fun(intern(lit("revappend"), user_package), func_n2(revappend));
+  reg_fun(intern(lit("nreconc"), user_package), func_n2(nreconc));
   reg_fun(list_s, list_f);
   reg_fun(intern(lit("list*"), user_package), func_n0v(list_star_intrinsic));
   reg_fun(identity_s, identity_f);
diff --git a/lib.c b/lib.c
index a8f637dd..bddf7f4a 100644
--- a/lib.c
+++ b/lib.c
@@ -791,6 +791,96 @@ loc list_collect_append(loc ptail, val obj)
   }
 }
 
+loc list_collect_nreconc(loc ptail, val obj)
+{
+  val rev = nreverse(nullify(obj));
+
+  switch (type(deref(ptail))) {
+  case CONS:
+  case LCONS:
+    ptail = tail(deref(ptail));
+    /* fallthrough */
+  case NIL:
+    set(ptail, rev);
+    switch (type(obj)) {
+    case CONS:
+    case LCONS:
+      return cdr_l(obj);
+    default:
+      return ptail;
+    }
+  case VEC:
+    replace_vec(deref(ptail), rev, t, t);
+    return ptail;
+  case STR:
+  case LIT:
+  case LSTR:
+    replace_str(deref(ptail), rev, t, t);
+    return ptail;
+  default:
+    uw_throwf(error_s, lit("cannot nconc ~s to ~s"), obj, deref(ptail), nao);
+  }
+}
+
+static val revlist(val in, val *tail)
+{
+  val rev = nil;
+
+  *tail = nil;
+
+  if (in) {
+    *tail = rev = cons(car(in), rev);
+    in = cdr(in);
+  }
+
+  while (in) {
+    rev = cons(car(in), rev);
+    in = cdr(in);
+  }
+
+  return rev;
+}
+
+loc list_collect_revappend(loc ptail, val obj)
+{
+  val last;
+  obj = nullify(obj);
+
+  switch (type(deref(ptail))) {
+  case CONS:
+  case LCONS:
+    set(ptail, copy_list(deref(ptail)));
+    ptail = tail(deref(ptail));
+    /* fallthrough */
+  case NIL:
+    switch (type(obj)) {
+    case CONS:
+    case LCONS:
+      set(ptail, revlist(obj, &last));
+      return cdr_l(last);
+    case NIL:
+      return ptail;
+    default:
+      set(ptail, reverse(obj));
+      return ptail;
+    }
+    set(ptail, obj);
+    return ptail;
+  case VEC:
+    set(ptail, copy_vec(deref(ptail)));
+    replace_vec(deref(ptail), reverse(obj), t, t);
+    return ptail;
+  case STR:
+  case LIT:
+  case LSTR:
+    set(ptail, copy_str(deref(ptail)));
+    replace_str(deref(ptail), reverse(obj), t, t);
+    return ptail;
+  default:
+    uw_throwf(error_s, lit("cannot append to ~s"), deref(ptail), nao);
+  }
+}
+
 val nreverse(val in)
 {
   switch (type(in)) {
@@ -905,6 +995,26 @@ val nappend2(val list1, val list2)
   return out;
 }
 
+val revappend(val list1, val list2)
+{
+  list_collect_decl (out, ptail);
+
+  ptail = list_collect_revappend(ptail, list1);
+  ptail = list_collect_nconc(ptail, list2);
+
+  return out;
+}
+
+val nreconc(val list1, val list2)
+{
+  list_collect_decl (out, ptail);
+
+  ptail = list_collect_nreconc(ptail, list1);
+  ptail = list_collect_nconc(ptail, list2);
+
+  return out;
+}
+
 val nconcv(struct args *lists)
 {
   cnum index = 0;
diff --git a/lib.h b/lib.h
index db7b6e95..20021f57 100644
--- a/lib.h
+++ b/lib.h
@@ -499,6 +499,8 @@ val nreverse(val in);
 val reverse(val in);
 val append2(val list1, val list2);
 val nappend2(val list1, val list2);
+val revappend(val list1, val list2);
+val nreconc(val list1, val list2);
 val appendv(struct args *lists);
 val nconcv(struct args *lists);
 val sub_list(val list, val from, val to);
@@ -999,6 +1001,8 @@ INLINE val default_arg_strict(val arg, val dfl)
 loc list_collect(loc pptail, val obj);
 loc list_collect_nconc(loc pptail, val obj);
 loc list_collect_append(loc pptail, val obj);
+loc list_collect_nreconc(loc pptail, val obj);
+loc list_collect_revappend(loc pptail, val obj);
 
 #define cons_bind(CAR, CDR, CONS)               \
   obj_t *c_o_n_s ## CAR ## CDR = CONS;          \
diff --git a/txr.1 b/txr.1
index aa22c111..f56cccb2 100644
--- a/txr.1
+++ b/txr.1
@@ -14447,6 +14447,33 @@ traverse the last argument.)
   (append '(a . b) 3 '(1 2 3)) -> **error**
 .cble
 
+.coNP Functions @ revappend and @ nreconc
+.synb
+.mets (revappend < list1 << list2 )
+.mets (nreconc < list1 << list2 )
+.syne
+.desc
+The
+.code revappend
+function returns a list consisting of
+.code list2
+appended to a reversed copy of
+.metn list1 .
+The returned object shares structure
+with
+.metn list2 ,
+which is unmodified.
+
+The
+.code nreconc
+function behaves similarly, except
+that the the returned object may share
+structure with not only
+.meta list2
+but also
+.metn list1 ,
+which is modified.
+
 .coNP Function @ list
 .synb
 .mets (list << value *)