* 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.

5 files changed, 107 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 3332e7a5..d0f2c9a9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2014-02-05  Kaz Kylheku  <kaz@kylheku.com>
+
+	* 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.
+
 2014-02-03  Kaz Kylheku  <kaz@kylheku.com>
 
 	* lib.c (nullp): Function removed.
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));
diff --git a/lib.c b/lib.c
index 3f01ab85..2055f80f 100644
--- a/lib.c
+++ b/lib.c
@@ -2833,6 +2833,7 @@ val func_f0(val env, val (*fun)(val))
   obj->f.variadic = 0;
   obj->f.fixparam = 0;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2846,6 +2847,7 @@ val func_f1(val env, val (*fun)(val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 1;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2859,6 +2861,7 @@ val func_f2(val env, val (*fun)(val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 2;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2872,6 +2875,7 @@ val func_f3(val env, val (*fun)(val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 3;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2885,6 +2889,7 @@ val func_f4(val env, val (*fun)(val, val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 4;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2898,6 +2903,7 @@ val func_n0(val (*fun)(void))
   obj->f.variadic = 0;
   obj->f.fixparam = 0;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2911,6 +2917,7 @@ val func_n1(val (*fun)(val))
   obj->f.variadic = 0;
   obj->f.fixparam = 1;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2924,6 +2931,7 @@ val func_n2(val (*fun)(val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 2;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2937,6 +2945,7 @@ val func_n3(val (*fun)(val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 3;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2950,6 +2959,7 @@ val func_n4(val (*fun)(val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 4;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2963,6 +2973,7 @@ val func_n5(val (*fun)(val, val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 5;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2976,6 +2987,7 @@ val func_n6(val (*fun)(val, val, val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 6;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -2989,6 +3001,7 @@ val func_n7(val (*fun)(val, val, val, val, val, val, val))
   obj->f.variadic = 0;
   obj->f.fixparam = 7;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3002,6 +3015,7 @@ val func_f0v(val env, val (*fun)(val, val))
   obj->f.variadic = 1;
   obj->f.fixparam = 0;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3015,6 +3029,7 @@ val func_f1v(val env, val (*fun)(val env, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 1;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3028,6 +3043,7 @@ val func_f2v(val env, val (*fun)(val env, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 2;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3041,6 +3057,7 @@ val func_f3v(val env, val (*fun)(val env, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 3;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3054,6 +3071,7 @@ val func_f4v(val env, val (*fun)(val env, val, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 4;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3067,6 +3085,7 @@ val func_n0v(val (*fun)(val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 0;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3080,6 +3099,7 @@ val func_n1v(val (*fun)(val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 1;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3093,6 +3113,7 @@ val func_n2v(val (*fun)(val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 2;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3106,6 +3127,7 @@ val func_n3v(val (*fun)(val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 3;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3119,6 +3141,7 @@ val func_n4v(val (*fun)(val, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 4;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3132,6 +3155,7 @@ val func_n5v(val (*fun)(val, val, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 5;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3145,6 +3169,7 @@ val func_n6v(val (*fun)(val, val, val, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 6;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3158,6 +3183,7 @@ val func_n7v(val (*fun)(val, val, val, val, val, val, val, val rest))
   obj->f.variadic = 1;
   obj->f.fixparam = 7;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3206,6 +3232,7 @@ val func_interp(val env, val form)
   obj->f.variadic = 1;
   obj->f.fixparam = 0;
   obj->f.optargs = 0;
+  obj->f.mark_missing_args = 0;
   return obj;
 }
 
@@ -3231,6 +3258,13 @@ val func_set_env(val fun, val env)
   return env;
 }
 
+val func_set_mark_missing(val fun)
+{
+  type_check(fun, FUN);
+  fun->f.mark_missing_args = 1;
+  return nil;
+}
+
 val functionp(val obj)
 {
   return type(obj) == FUN ? t : nil;
@@ -3244,9 +3278,11 @@ val interp_fun_p(val obj)
 static val generic_funcall(val fun, val arg[], int nargs)
 {
   int variadic, fixparam, reqargs;
+  val missing;
 
   type_check (fun, FUN);
 
+  missing = fun->f.mark_missing_args ? colon_k : nil;
   variadic = fun->f.variadic;
   fixparam = fun->f.fixparam;
   reqargs = fixparam - fun->f.optargs;
@@ -3259,7 +3295,7 @@ static val generic_funcall(val fun, val arg[], int nargs)
       uw_throw(error_s, lit("funcall: too many arguments"));
 
     for (; nargs < fixparam; )
-      arg[nargs++] = 0;
+      arg[nargs++] = missing;
 
     switch (fun->f.functype) {
     case F0:
@@ -3301,7 +3337,7 @@ static val generic_funcall(val fun, val arg[], int nargs)
       uw_throw(error_s, lit("funcall: missing required arguments"));
 
     for (; nargs < fixparam; )
-      arg[nargs++] = nil;
+      arg[nargs++] = missing;
 
     for (; nargs > fixparam; )
       arglist = cons(arg[--nargs], arglist);
@@ -3561,14 +3597,15 @@ val funcall4(val fun, val arg1, val arg2, val arg3, val arg4)
 
 val reduce_left(val fun, val list, val init, val key)
 {
-  if (!key)
+  if (null_or_missing_p(key))
     key = identity_f;
 
-  if (!init && list)
-    init = pop(&list);
-
-  if (!init && !list)
-    return funcall(fun);
+  if (missingp(init)) {
+    if (list)
+      init = pop(&list);
+    else
+      return funcall(fun);
+  }
 
   for (; list; list = cdr(list))
     init = funcall2(fun, init, funcall1(key, car(list)));
@@ -3578,11 +3615,11 @@ val reduce_left(val fun, val list, val init, val key)
 
 val reduce_right(val fun, val list, val init, val key)
 {
-  if (!key)
+  if (null_or_missing_p(key))
     key = identity_f;
 
   if (list) {
-    if (!init) {
+    if (missingp(init)) {
       if (!rest(list))
         return funcall1(key, first(list));
       if (!rest(rest(list)))
@@ -3594,7 +3631,7 @@ val reduce_right(val fun, val list, val init, val key)
         return funcall2(fun, funcall1(key, first(list)), init);
       /* fall through: init, and two or more items in list */
     }
-  } else if (init) {
+  } else if (!missingp(init)) {
     return init;
   } else {
     return funcall(fun);
diff --git a/lib.h b/lib.h
index dfc68db0..03a67406 100644
--- a/lib.h
+++ b/lib.h
@@ -106,7 +106,7 @@ struct func {
   unsigned fixparam : 7; /* total non-variadic parameters */
   unsigned optargs : 7;  /* fixparam - optargs = required args */
   unsigned variadic : 1;
-  unsigned : 1;
+  unsigned mark_missing_args: 1; /* missing opt. args given as special value */
   unsigned functype : 16;
   val env;
   union {
@@ -601,6 +601,7 @@ val func_interp(val env, val form);
 val func_get_form(val fun);
 val func_get_env(val fun);
 val func_set_env(val fun, val env);
+val func_set_mark_missing(val fun);
 val functionp(val);
 val interp_fun_p(val);
 val funcall(val fun);
@@ -717,6 +718,10 @@ INLINE val nullp(val v) { return v ? nil : t; }
 
 #define nao ((obj_t *) (1 << TAG_SHIFT)) /* "not an object" sentinel value. */
 
+INLINE val missingp(val v) { return v == colon_k ? t : nil; }
+
+INLINE val null_or_missing_p(val v) { return (!v || v == colon_k) ? t : nil; }
+
 #define if2(a, b) ((a) ? (b) : nil)
 
 #define if3(a, b, c) ((a) ? (b) : (c))
diff --git a/txr.1 b/txr.1
index bb2325a5..dc88581e 100644
--- a/txr.1
+++ b/txr.1
@@ -7247,18 +7247,17 @@ by <list> and <init-value> to a single value by the repeated application of
 <binary-function>. 
 
 An effective list of operands is formed by combining <list> and
-<init-value>.   If <key-function> is specified and not nil, then
-the items of <list> are mapped to a new values through <key-function>.
-If an <init-value> is supplied and not nil, then in the
-case of reduce-left, the effective list of operands is formed by prepending
-<init-value> to <lits>. In the case of reduce-right, the effective
+<init-value>.   If <key-function> is specified, then the items of <list> are
+mapped to a new values through <key-function>.  If <init-value> is supplied,
+then in the case of reduce-left, the effective list of operands is formed by
+prepending <init-value> to <lits>. In the case of reduce-right, the effective
 operand list is produced by appending <init-value> to <list>.
 
 The production of the effective list can be expressed like this,
-though this is not to be understood as the actual impelmentation:
+though this is not to be understood as the actual implementation:
 
   ;; reduce-left
-  (let ((eff-list (append (if init-value (list init-value))
+  (let ((eff-list (append (if init-value-present (list init-value))
                           [mapcar (or key-function identity) list])))
 
 In the reduce-right case, the arguments to append are reversed.
@@ -7273,6 +7272,13 @@ If the effective list contains one item, then that item is returned.
 Otherwise, the effective list contains two or more items, and is decimated as
 follows. 
 
+Note that an <init-value> specified as nil is not the same as a missing
+<init-value>; this means that the initial value is the object nil.  Omitting
+<init-value> is the same as specifying a value of : (the colon symbol).
+It is possible to specify <key-function> while omitting an <init-value>
+argument. This is achieved by explicitly specifying : as the <init-value>
+argument.
+
 Under reduce-left, the leftmost pair of operands is removed
 from the list and passed as arguments to <binary-function>, in the same order
 that they appear in the list, and the resulting value initializes an
@@ -7282,7 +7288,7 @@ from the list. After each call, the accumulator is updated with the return
 value of <binary-function>.  The final value of the accumulator is returned.
 
 Under reduce-right, the list is processed right to left.  The rightmost
-pair of elements in the effetive list is removed, and passed as arguments to
+pair of elements in the effective list is removed, and passed as arguments to
 <binary-function>, in the same order that they appear in the list. The
 resulting value initializes an accumulator. Then, for each remaining item in
 the list, <binary-function> is invoked on two arguments:  the