Use of new args for function calls in interpreter.

* args.c (args_copy_to_list): New function.

* args.h (ARGS_MIN): New preprocessor symbol.
(args_add_list): New inline function.
(args_copy_to_list): Declared.

* debug.c (debug): Args in debug frame are now struct args *.
Pull them out nondestructively for printing using
args_copy_to_list.

* eval.c (do_eval_args): Fill struct args argument list
rather than returning evaluated list.
Dot position evaluation is handled by installing
the dot position value as args->list.
(do_eval): Allocate args of at least ARGS_MAX for the
call to do_eval_args. Then use generic_funcall to
invoke the function rather than apply.
(eval_args_lisp1): Modified similarly to do_eval_args.
(eval_lisp1): New static function.
(expand_macro): Construct struct args argument list for
the sake of debug_frame.
(op_dwim): Allocate args which are filled by eval_args_lisp1,
and applied to the function/object with generic_funcall.
The object expression is separately evaluated with
eval_lisp1.

* match.c (h_fun, v_fun): Construct struct args arglist for
the sake of debug_frame call.

* unwind.c (uw_push_debug): args argument becomes
struct args *.

* unwind.h (struct uw_debug): args member becomes
struct args *.
(uw_push_debug): Declaration updated.

* txr.1: Update documentation about dot position argument in
function calls. (list . a) now works, which previously didn't.

8 files changed, 152 insertions, 38 deletions

diff --git a/args.c b/args.c
index 5d603b57..fec83825 100644
--- a/args.c
+++ b/args.c
@@ -94,3 +94,16 @@ struct args *args_copy_zap(struct args *to, struct args *from)
   memset(from->arg, 0, sizeof *to->arg * to->fill);
   return to;
 }
+
+val args_copy_to_list(struct args *args)
+{
+  list_collect_decl (out, ptail);
+  cnum i;
+
+  for (i = 0; i < args->fill; i++)
+    ptail = list_collect(ptail, args->arg[i]);
+
+  list_collect_nconc(ptail, args->list);
+
+  return out;
+}
diff --git a/args.h b/args.h
index e75193d6..0349d160 100644
--- a/args.h
+++ b/args.h
@@ -88,6 +88,11 @@ INLINE void args_add4(struct args *args, val arg1, val arg2, val arg3, val arg4)
 
 val args_add_checked(val name, struct args *args, val arg);
 
+INLINE void args_add_list(struct args *args, val list)
+{
+  args->list = list;
+}
+
 INLINE int args_more(struct args *args, cnum index)
 {
   return index < args->fill || args->list;
@@ -120,7 +125,6 @@ INLINE val args_get_rest(struct args *args, cnum index)
   return z(args->list);
 }
 
-
 INLINE val args_at(struct args *args, cnum arg_index)
 {
   if (arg_index < args->fill)
@@ -150,3 +154,4 @@ INLINE void args_clear(struct args *args)
 val args_get_checked(val name, struct args *args, cnum *arg_index);
 struct args *args_copy(struct args *to, struct args *from);
 struct args *args_copy_zap(struct args *to, struct args *from);
+val args_copy_to_list(struct args *args);
diff --git a/debug.c b/debug.c
index 54052eef..370d13bd 100644
--- a/debug.c
+++ b/debug.c
@@ -37,6 +37,7 @@
 #include "lib.h"
 #include "debug.h"
 #include "gc.h"
+#include "args.h"
 #include "signal.h"
 #include "unwind.h"
 #include "stream.h"
@@ -224,10 +225,11 @@ val debug(val form, val bindings, val data, val line, val pos, val base)
             if (iter->uw.type == UW_DBG) {
               if (iter->db.ub_p_a_pairs)
                 format(std_debug, lit("(~s ~s ~s)\n"), iter->db.func,
-                       iter->db.args, iter->db.ub_p_a_pairs, nao);
+                       args_copy_to_list(iter->db.args),
+                       iter->db.ub_p_a_pairs, nao);
               else
                 format(std_debug, lit("(~s ~s)\n"), iter->db.func,
-                       iter->db.args, nao);
+                       args_copy_to_list(iter->db.args), nao);
             }
           }
         }
diff --git a/eval.c b/eval.c
index 28456b85..47e3285c 100644
--- a/eval.c
+++ b/eval.c
@@ -54,6 +54,9 @@
 #include "lisplib.h"
 #include "eval.h"
 
+#define max(a, b) ((a) > (b) ? (a) : (b))
+#define min(a, b) ((a) < (b) ? (a) : (b))
+
 typedef val (*opfun_t)(val, val);
 typedef val (*mefun_t)(val, val);
 
@@ -900,18 +903,17 @@ twocol:
 static val do_eval(val form, val env, val ctx_form,
                    val (*lookup)(val env, val sym));
 
-static val do_eval_args(val form, val env, val ctx_form,
-                        val (*lookup)(val env, val sym))
+static void do_eval_args(val form, val env, val ctx_form,
+                         val (*lookup)(val env, val sym),
+                         struct args *args)
 {
-  list_collect_decl (values, ptail);
   for (; consp(form); form = cdr(form))
-    ptail = list_collect(ptail, do_eval(car(form), env, ctx_form, lookup));
+    args_add(args, do_eval(car(form), env, ctx_form, lookup));
+
   if (form) {
     val dotpos = do_eval(form, env, ctx_form, lookup);
-    ptail = list_collect_append(ptail, if3(listp(dotpos),
-                                           dotpos, tolist(dotpos)));
+    args_add_list(args, if3(listp(dotpos), dotpos, tolist(dotpos)));
   }
-  return values;
 }
 
 static val set_dyn_env(val de)
@@ -984,11 +986,22 @@ static val do_eval(val form, val env, val ctx_form,
         eval_error(form, lit("no such function or operator: ~s"), oper, nao);
         abort();
       } else {
-        val args = do_eval_args(rest(form), env, form, &lookup_var);
+        val arglist = rest(form);
+        cnum alen = if3(consp(arglist), c_num(length(arglist)), 0);
+        cnum argc = max(alen, ARGS_MAX);
         val ret, lfe_save = last_form_evaled;
-        debug_frame(oper, args, nil, env, nil, nil, nil);
+        struct args *args = args_alloc(argc);
+
+        args_init(args, argc);
+
+        do_eval_args(rest(form), env, form, &lookup_var, args);
+
         last_form_evaled = form;
-        ret = apply(cdr(fbinding), z(args), form);
+
+        debug_frame(oper, args, nil, env, nil, nil, nil);
+
+        ret = generic_funcall(cdr(fbinding), args);
+
         last_form_evaled = lfe_save;
         debug_end;
         debug_return (ret);
@@ -1006,9 +1019,14 @@ val eval(val form, val env, val ctx_form)
   return do_eval(form, env, ctx_form, &lookup_var);
 }
 
-static val eval_args_lisp1(val form, val env, val ctx_form)
+static void eval_args_lisp1(val form, val env, val ctx_form, struct args *args)
 {
-  return do_eval_args(form, env, ctx_form, &lookup_sym_lisp1);
+  do_eval_args(form, env, ctx_form, &lookup_sym_lisp1, args);
+}
+
+static val eval_lisp1(val form, val env, val ctx_form)
+{
+  return do_eval(form, env, ctx_form, &lookup_sym_lisp1);
 }
 
 val bindable(val obj)
@@ -1399,13 +1417,15 @@ static val expand_macro(val form, val expander, val menv)
   } else {
     debug_enter;
     val name = car(form);
-    val args = rest(form);
+    val arglist = rest(form);
     val env = car(cdr(expander));
     val params = car(cdr(cdr(expander)));
     val body = cdr(cdr(cdr(expander)));
     val saved_de = set_dyn_env(make_env(nil, nil, dyn_env));
-    val exp_env = bind_macro_params(env, menv, params, args, nil, form);
+    val exp_env = bind_macro_params(env, menv, params, arglist, nil, form);
     val result;
+    struct args *args = args_alloc(ARGS_MIN);
+    args_init_list(args, ARGS_MIN, arglist);
     debug_frame(name, args, nil, env, nil, nil, nil);
     result = eval_progn(body, exp_env, body);
     debug_end;
@@ -1815,10 +1835,21 @@ static val op_return_from(val form, val env)
 
 static val op_dwim(val form, val env)
 {
-  val args = eval_args_lisp1(cdr(form), env, form);
-  val fi = car(args);
-  val re = cdr(z(args));
-  return apply(z(fi), z(re), form);
+  val argexps = rest(form);
+  val objexpr = pop(&argexps);
+  cnum alen = if3(consp(argexps), c_num(length(argexps)), 0);
+  cnum argc = max(alen, ARGS_MIN);
+  struct args *args = args_alloc(argc);
+  args_init(args, argc);
+
+  if (!consp(cdr(form)))
+    eval_error(form, lit("~s: missing argument"), car(form), nao);
+
+  {
+    val func = eval_lisp1(objexpr, env, form);
+    eval_args_lisp1(argexps, env, form, args);
+    return generic_funcall(func, args);
+  }
 }
 
 static val op_catch(val form, val env)
diff --git a/match.c b/match.c
index b6775232..4c08fbc6 100644
--- a/match.c
+++ b/match.c
@@ -24,6 +24,7 @@
  * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
+#include <stddef.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -34,8 +35,10 @@
 #include <wchar.h>
 #include <signal.h>
 #include "config.h"
+#include ALLOCA_H
 #include "lib.h"
 #include "gc.h"
+#include "args.h"
 #include "signal.h"
 #include "unwind.h"
 #include "regex.h"
@@ -1098,9 +1101,11 @@ static val h_fun(match_line_ctx *c)
     }
 
     {
+      struct args *args = args_alloc(ARGS_MIN);
+      args_init_list(args, ARGS_MIN, bindings_cp);
       uw_block_begin(nil, result);
       uw_env_begin;
-      debug_frame(sym, bindings_cp, ub_p_a_pairs, c->bindings, c->dataline, c->data_lineno, c->pos);
+      debug_frame(sym, args, ub_p_a_pairs, c->bindings, c->dataline, c->data_lineno, c->pos);
 
       result = match_line(ml_bindings_specline(*c, bindings_cp, body));
 
@@ -3584,9 +3589,11 @@ static val v_fun(match_files_ctx *c)
     }
 
     {
+      struct args *args = args_alloc(ARGS_MIN);
+      args_init_list(args, ARGS_MIN, bindings_cp);
       uw_block_begin(nil, result);
       uw_env_begin;
-      debug_frame(sym, bindings_cp, ub_p_a_pairs, c->bindings, if2(consp(c->data), car(c->data)),
+      debug_frame(sym, args, ub_p_a_pairs, c->bindings, if2(consp(c->data), car(c->data)),
                   c->data_lineno, nil);
       result = match_files(mf_spec_bindings(*c, body, bindings_cp));
       debug_end;
diff --git a/txr.1 b/txr.1
index 83ef5e2d..33fe9c35 100644
--- a/txr.1
+++ b/txr.1
@@ -9573,16 +9573,45 @@ also be an expression in the dotted position, if the form is a function call.
 If the form is a function call then the arguments are evaluated. If any of the
 arguments are symbols, they are treated according to Lisp-2 namespacing rules.
 
-Additionally, if there is an expression in the dotted position, it is also
-evaluated. It should evaluate to a sequence: a list, vector or string.  The
-elements of the sequence generate additional arguments for the function
-call. Note, however, that a compound form cannot be used in the dot position,
+.NP* Dot Position in Function Calls
+
+If there is an expression in the dotted position of a function call
+expression, it is also evaluated, and the resulting value is involved in the
+function call in a special way.
+
+Firstly, note that a compound form cannot be used in the dot position,
 for obvious reasons, namely that
 .code (a b c . (foo z))
 does not mean that there is
 a compound form in the dot position, but denotes an alternate spelling for
 .codn "(a b c foo z)" ,
-where foo behaves as a variable.
+where foo behaves as a variable. (There exists a special exception to this,
+namely that the meta-numbers and meta-symbols of the
+.code op
+operator can be used in the dot position).
+
+The value of the expression in the dot position is converted to a list, if it
+is a sequence. Otherwise if it is an non-sequence atom, no conversion is
+applied.  In either case, the resulting list's elements constitute
+additional arguments to the function.
+
+If the value emerging from the dot position is an atom (referred to as
+the "sole atom" below) other than
+.codn nil ,
+or an improper list (a list ending in a terminating atom
+other than
+.codn nil ),
+then the function being invoked must be a variadic function, otherwise
+the call is erroneous. Furthermore, all required argument positions of a
+function must be filled before encountering the sole atom or terminating
+atom: such an atom doesn't count as an argument, whether or not it is
+.codn nil ,
+and indicates that no more arguments follow.
+Only the trailing list argument of a variadic function (denoted in the
+.code lambda
+operator's syntax as the optional
+.metn rest-param )
+may take a sole atom or terminating atom as a value.
 
 The DWIM brackets are similar, except that the first position is an arbitrary
 expression which is evaluated according to the same rules as the remaining
@@ -9600,21 +9629,31 @@ Examples:
   ;; c contains #(5 6 7)
   ;; s contains "xyz"
 
-  (foo a b . c) ;; calls (foo 3 4 5 6 7)
-  (foo a)       ;; calls (foo 3)
-  (foo . s)     ;; calls (foo #\ex #\ey #\ez)
+  (foo a b . c)  ;; calls (foo 3 4 5 6 7)
+  (foo a)        ;; calls (foo 3)
+  (foo . s)      ;; calls (foo #\ex #\ey #\ez)
+
+  (list . a)     ;; yields 3
+  (list a . b)   ;; yields (3 . 4)
+  (list a . c)   ;; yields (3 5 6 7)
+  (list* a c)    ;; yields (3 . #(5 6 7))
+
+  (cons a . b)   ;; error: cons isn't variadic.
+  (cons a b . c) ;; error: cons requires exactly two arguments.
 
   [foo a b . c] ;; calls (foo 3 4 5 6 7)
 
   [c 1]         ;; indexes into vector #(5 6 7) to yield 6
+
+  (call (op list 1 . @1) 2) ;; yields 2
 .cble
 
 Dialect Note:
 
-In some other Lisp dialects, the improper list syntax is not supported;
-a function called apply (or similar) must be used for application even if
-the expression which gives the trailing arguments is a symbol. Moreover,
-applying sequences other than lists is not supported.
+In some other Lisp dialects like ANSI Common Lisp, the improper list syntax may
+not be used as a function call; a function called apply (or similar) must be
+used for application even if the expression which gives the trailing arguments
+is a symbol. Moreover, applying sequences other than lists is not supported.
 
 .NP* Regular Expression Literals
 In \*(TL, the
@@ -26045,6 +26084,23 @@ a parameter from the outermost
 into the innermost
 .codn op .
 
+Note that meta-numbers and meta-symbols belonging to an
+.code op
+can be used in the dot position of a function call, such as:
+
+.cblk
+  [(op list 1 . @1) 2] -> (1 . 2)
+.cble
+
+Even though the notation
+.code @1
+produces a compound form, which the dot notation then splices into
+the surrounding form, the expander for the
+.code op
+and
+.code do
+macro takes recognizes and takes care of this special case.
+
 The
 .code op
 syntax interacts with quasiliterals which are nested within it.
diff --git a/unwind.c b/unwind.c
index 6f646bd8..f3f6f74f 100644
--- a/unwind.c
+++ b/unwind.c
@@ -173,7 +173,7 @@ val uw_set_match_context(val context)
   return context;
 }
 
-void uw_push_debug(uw_frame_t *fr, val func, val args,
+void uw_push_debug(uw_frame_t *fr, val func, struct args *args,
                    val ub_p_a_pairs, val env, val data,
                    val line, val chr)
 {
diff --git a/unwind.h b/unwind.h
index c418eba5..2089608a 100644
--- a/unwind.h
+++ b/unwind.h
@@ -70,7 +70,7 @@ struct uw_debug {
   uw_frame_t *up;
   uw_frtype_t type;
   val func;
-  val args;
+  struct args *args;
   val ub_p_a_pairs;
   val env;
   val data;
@@ -107,7 +107,7 @@ noreturn val uw_errorfv(val fmt, struct args *args);
 val uw_register_subtype(val sub, val super);
 val uw_exception_subtype_p(val sub, val sup);
 void uw_continue(uw_frame_t *curr, uw_frame_t *target);
-void uw_push_debug(uw_frame_t *, val func, val args,
+void uw_push_debug(uw_frame_t *, val func, struct args *,
                    val ub_p_a_pairs, val env, val data,
                    val line, val chr);
 void uw_pop_frame(uw_frame_t *);