From 0367ad753c7749c33f57e1e0805e0dbcea115af3 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 27 Jun 2014 07:23:08 -0700
Subject: Bugfix: apply_intrinsic and iapply must not destructively manipulate
 argument lists.

* eval.c (apply_frob_args): Rewrite to non-destructive
one-pass version.
(iapply): Likewise.

* lib.c (term): New function.

* lib.h (term): Declared.
---
 ChangeLog | 13 +++++++++++++
 eval.c    | 49 +++++++++++++++++++++++++++----------------------
 lib.c     |  7 +++++++
 lib.h     |  1 +
 4 files changed, 48 insertions(+), 22 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 7e6d401c..67295649 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2014-06-27  Kaz Kylheku  <kaz@kylheku.com>
+
+	Bugfix: apply_intrinsic and iapply must not destructively
+	manipulate argument lists.
+
+	* eval.c (apply_frob_args): Rewrite to non-destructive
+	one-pass version.
+	(iapply): Likewise.
+
+	* lib.c (term): New function.
+
+	* lib.h (term): Declared.
+
 2014-06-26  Kaz Kylheku  <kaz@kylheku.com>
 
 	Fixes to bignum bit operations affecting pretty much all bit operations
diff --git a/eval.c b/eval.c
index f113d879..6b6fbc16 100644
--- a/eval.c
+++ b/eval.c
@@ -646,12 +646,16 @@ val apply(val fun, val arglist, val ctx_form)
 
 static val apply_frob_args(val args)
 {
-  loc plast = lastcons(args);
-  if (!nullocp(plast)) {
-    deref(plast) = car(deref(plast));
-    return args;
-  } else {
+  if (!cdr(args)) {
     return car(args);
+  } else {
+    list_collect_decl (out, ptail);
+
+    for (; cdr(args); args = cdr(args))
+      ptail = list_collect(ptail, car(args));
+
+    list_collect_nconc(ptail, car(args));
+    return out;
   }
 }
 
@@ -662,27 +666,28 @@ val apply_intrinsic(val fun, val args)
 
 static val iapply(val fun, val args)
 {
-  if (args && atom(args)) {
-    args = cons(args, nil);
-  } else {
-    loc plast = lastcons(args);
-    if (!nullocp(plast)) {
-      deref(plast) = car(deref(plast));
-    } else {
-      args = car(args);
-    }
+  list_collect_decl (mod_args, ptail);
+  loc saved_ptail;
+
+  for (; cdr(args); args = cdr(args))
+    ptail = list_collect(ptail, car(args));
+
+  saved_ptail = ptail;
+
+  ptail = list_collect_nconc(ptail, car(args));
+
+  {
+    loc pterm = term(ptail);
+    val tatom = deref(pterm);
 
-    if (args && atom(args)) {
-      args = cons(args, nil);
-    } else if (args) {
-      val la = last(args);
-      val cd = cdr(la);
-      if (cd && atom(cd))
-        rplacd(la, cons(cd, nil));
+    if (tatom) {
+      deref(ptail) = nil;
+      ptail = list_collect_nconc(saved_ptail, copy_list(car(args)));
+      set(term(ptail), cons(tatom, nil));
     }
   }
 
-  return apply(fun, args, nil);
+  return apply(fun, mod_args, nil);
 }
 
 static val call(val fun, val args)
diff --git a/lib.c b/lib.c
index bb0d580f..e84b098f 100644
--- a/lib.c
+++ b/lib.c
@@ -408,6 +408,13 @@ loc tail(val cons)
   return cdr_l(cons);
 }
 
+loc term(loc head)
+{
+  while (consp(deref(head)))
+    head = cdr_l(deref(head));
+  return head;
+}
+
 loc lastcons(val list)
 {
   loc ret = nulloc;
diff --git a/lib.h b/lib.h
index 448447b4..2a07d982 100644
--- a/lib.h
+++ b/lib.h
@@ -418,6 +418,7 @@ val lazy_conses(val list);
 val listref(val list, val ind);
 loc listref_l(val list, val ind);
 loc tail(val cons);
+loc term(loc head);
 loc lastcons(val list);
 val last(val list);
 loc ltail(loc cons);
-- 
cgit v1.2.3