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.
---
 eval.c | 49 +++++++++++++++++++++++++++----------------------
 1 file changed, 27 insertions(+), 22 deletions(-)

(limited to 'eval.c')

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)
-- 
cgit v1.2.3