append can now take additional leading arguments before the list.

* eval.c (apply_frob_args): New static function.
(apply_intrinsic): Process arguments with apply_frob_args.
(eval_init): apply_intrinsic registered differently, as a
variadic function with one mandatory arg.

* lib.c (lastcons): New function.

* lib.h (lastcons): Declared.

* txr.1: Updated append documentation.

5 files changed, 64 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index e05820a9..508f4cd2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 2014-02-02  Kaz Kylheku  <kaz@kylheku.com>
 
+	append can now take additional leading arguments before the list.
+
+	* eval.c (apply_frob_args): New static function.
+	(apply_intrinsic): Process arguments with apply_frob_args.
+	(eval_init): apply_intrinsic registered differently, as a
+	variadic function with one mandatory arg.
+
+	* lib.c (lastcons): New function.
+
+	* lib.h (lastcons): Declared.
+
+	* txr.1: Updated append documentation.
+
+2014-02-02  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (apply): Support string and vector arglist.
 	(do_eval_args): Support string or vector in dot position.
 
diff --git a/eval.c b/eval.c
index 888c7e49..92922bd7 100644
--- a/eval.c
+++ b/eval.c
@@ -419,9 +419,20 @@ val apply(val fun, val arglist, val ctx_form)
   internal_error("corrupt function type field");
 }
 
+static val apply_frob_args(val args)
+{
+  val *plast = lastcons(args);
+  if (plast) {
+    *plast = car(*plast);
+    return args;
+  } else {
+    return car(args);
+  }
+}
+
 static val apply_intrinsic(val fun, val args)
 {
-  return apply(fun, args, cons(apply_s, nil));
+  return apply(fun, apply_frob_args(args), cons(apply_s, nil));
 }
 
 static val do_eval(val form, val env, val ctx_form,
@@ -2384,7 +2395,7 @@ void eval_init(void)
   reg_fun(intern(lit("mapcar*"), user_package), func_n1v(lazy_mapcarv));
   reg_fun(intern(lit("mappend"), user_package), func_n1v(mappendv));
   reg_fun(intern(lit("mappend*"), user_package), func_n1v(lazy_mappendv));
-  reg_fun(apply_s, func_n2(apply_intrinsic));
+  reg_fun(apply_s, func_n1v(apply_intrinsic));
   reg_fun(intern(lit("reduce-left"), user_package), func_n4o(reduce_left, 2));
   reg_fun(intern(lit("reduce-right"), user_package), func_n4o(reduce_right, 2));
 
diff --git a/lib.c b/lib.c
index d2fa0147..09ca61c6 100644
--- a/lib.c
+++ b/lib.c
@@ -400,6 +400,16 @@ val *tail(val cons)
   return cdr_l(cons);
 }
 
+val *lastcons(val list)
+{
+  val *ret = 0;
+  while (consp(cdr(list))) {
+    ret = cdr_l(list);
+    list = cdr(list);
+  }
+  return ret;
+}
+
 val *ltail(val *cons)
 {
   while (cdr(*cons))
diff --git a/lib.h b/lib.h
index 451fe234..37282579 100644
--- a/lib.h
+++ b/lib.h
@@ -371,6 +371,7 @@ val lazy_conses(val list);
 val listref(val list, val ind);
 val *listref_l(val list, val ind);
 val *tail(val cons);
+val *lastcons(val list);
 val *ltail(val *cons);
 val pop(val *plist);
 val push(val v, val *plist);
diff --git a/txr.1 b/txr.1
index a579aa61..e988e36c 100644
--- a/txr.1
+++ b/txr.1
@@ -7141,16 +7141,27 @@ can be expressed as:
 .TP
 Syntax:
 
-  (apply <function> <argsequence>)
+  (apply <function> [ {<arg>}* <trailing-args> ])
 
 .TP
 Description:
 
-The apply function converts a sequence of values <argsequence> into individual
-arguments which are passed to <function>. The return value of the apply
-invocation is that of <function>.
+The apply function invokes <function>, optionally passing to it an argument
+list. The return value of the apply call is that of <function>.
 
-<argsequence> must be list, vector or string. 
+If no arguments are present after <function>, then <function> is invoked
+without arguments.
+
+If one argument is present after <function>, then it is interpreted as
+<trailing-args>. If this is a sequence (a list, vector or string),
+then the elements of the sequence are passed as individual arguments to
+<function>.  If <trailing-args> is not a sequence, then the function is invoked
+with an improper argument list, terminated by the <trailing-args> atom.
+
+If two or more arguments are present after <function>, then the last of
+these arguments is interpreted as <trailing-args>. The previous arguments
+represent leading arguments which are applied to <function>, prior to the
+arguments taken from <trailing-args>.
 
 .TP
 Examples:
@@ -7158,11 +7169,17 @@ Examples:
   ;; '(1 2 3) becomes arguments to list, thus (list 1 2 3).
   (apply (fun list) '(1 2 3)) -> (1 2 3)
 
+  ;; this effectively invokes (list 1 2 3 4)
+  (apply (fun list) 1 2 '(3 4)) -> (1 2 3)
+
+  ;; this effectively invokes (list 1 2 . 3)
+  (apply (fun list) 1 2 3)) -> (1 2 . 3)
+
   ;; "abc" is separated into characters which become arguments of list
   (apply (fun list) "abc") -> (#\ea #\eb #\ec)
 
 .TP
-Dialect Note 1:
+Dialect Note:
 
 Note that some uses of this function that are necessary in other Lisp dialects
 are not necessary in TXR Lisp. The reason is that in TXR Lisp, improper list
@@ -7173,19 +7190,8 @@ syntax is accepted as a compound form, and performs application:
 Here, the variables a and b supply the first two arguments for foo. In
 the dotted position, x must evaluate to a list or vector. The list or
 vector's elements are pulled out and treated as additional arguments for foo.
-
-.TP
-Dialect Note 2:
-
-TXR Lisp apply does not take additional arguments before the list. 
-In Common Lisp we can write (apply #'list 1 2 (list 3 4 5)) which
-yields (1 2 3 4 5). 
-In TXR Lisp, 
-
-In TXR Lisp, this usage can be simulated using the approach in the
-previous Dialect Note 1, or by using code such as:
-(apply (fun list) (list 1 2 (list 3 4 5))) or
-(apply (fun list) '(,1 ,2 ,*(list 3 4 5))) .
+Of course, this syntax can only be used if x is a symbolic form or an atom.  It
+cannot be a compound form.
 
 .SS Functions reduce-left and reduce-right