* eval.c (apply): Pass missing optional arguments as colon_k.

to functions for which this is requested.
(reg_fun_mark): New static function.
(eval_init): Register reduce_left and reduce_right as requiring
marking for missing optionals.

* lib.c (func_set_mark_missing): New function.
(generic_funcall): Pass missing optional arguments as colon_k
to functions for which this is requested.
(reduce_left, reduce_right): Handle missing values of init and key.
(func_f0, func_f1, func_f2, func_f3, func_f4, func_n0, func_n1,
func_n2, func_n3, func_n4, func_n5, func_n6, func_n7, func_f0v,
func_f1v, func_f2v, func_f3v, func_f4v, func_n0v, func_n1v,
func_n2v, func_n3v, func_n4v, func_n5v, func_n6v, func_n7v):
Initialize new mark_missing_args member of struct func.

* lib.h (struct func): New bitfield member, mark_missing_args.
(func_set_mark_missing): Declared.
(missingp, null_or_missing_p): New inline functions.

* txr.1: Updated descriptions of reduce-left and reduce-right.

1 files changed, 15 insertions, 4 deletions

diff --git a/eval.c b/eval.c
index ddfb1185..7c3bb8da 100644
--- a/eval.c
+++ b/eval.c
@@ -288,6 +288,7 @@ twocol:
 val apply(val fun, val arglist, val ctx_form)
 {
   val arg[32], *p = arg;
+  val missing;
   int variadic, fixparam, reqargs, nargs;
 
   if (symbolp(fun)) {
@@ -299,6 +300,8 @@ val apply(val fun, val arglist, val ctx_form)
 
   type_check (fun, FUN);
 
+  missing = fun->f.mark_missing_args ? colon_k : nil;
+
   if (!listp(arglist)) {
     val arglist_conv = tolist(arglist);
     type_assert (listp(arglist_conv),
@@ -326,7 +329,7 @@ val apply(val fun, val arglist, val ctx_form)
                  car(ctx_form), nao);
 
     for (; nargs < fixparam; nargs++)
-      *p++ = nil;
+      *p++ = missing;
 
     switch (fun->f.functype) {
     case F0:
@@ -369,7 +372,7 @@ val apply(val fun, val arglist, val ctx_form)
                  car(ctx_form), nao);
 
     for (; nargs < fixparam; nargs++)
-      *p++ = nil;
+      *p++ = missing;
 
     switch (fun->f.functype) {
     case FINTERP:
@@ -2211,6 +2214,12 @@ static void reg_fun(val sym, val fun)
   sethash(top_fb, sym, cons(sym, fun));
 }
 
+static void reg_fun_mark(val sym, val fun)
+{
+  sethash(top_fb, sym, cons(sym, fun));
+  func_set_mark_missing(fun);
+}
+
 static void c_var_mark(val obj)
 {
   struct c_var *cv = (struct c_var *) obj->co.handle;
@@ -2389,8 +2398,10 @@ void eval_init(void)
   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_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));
+  reg_fun_mark(intern(lit("reduce-left"), user_package),
+               func_n4o(reduce_left, 2));
+  reg_fun_mark(intern(lit("reduce-right"), user_package),
+               func_n4o(reduce_right, 2));
 
   reg_fun(intern(lit("second"), user_package), func_n1(second));
   reg_fun(intern(lit("third"), user_package), func_n1(third));