From db10f6c3b7270e033563744974bd5979fc33b014 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 11 Jan 2013 16:18:02 -0800
Subject: * eval.c (eval_init): New instrinsic function iffi registered.

* lib.c (iff): Reversed argument names corrected. No functional
change.
(iffi): New function.

* lib.h (iffi): Declared.

* txr.1: Documented iffi.
---
 ChangeLog | 12 ++++++++++++
 eval.c    |  1 +
 lib.c     | 11 +++++++++--
 lib.h     |  1 +
 txr.1     | 16 ++++++++++++++--
 5 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 938c82e8..4f2cbea9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2013-01-11  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): New instrinsic function iffi registered.
+	
+	* lib.c (iff): Reversed argument names corrected. No functional
+	change.
+	(iffi): New function.
+
+	* lib.h (iffi): Declared.
+
+	* txr.1: Documented iffi.
+
 2013-01-10  Kaz Kylheku  <kaz@kylheku.com>
 
 	* debug.c (help): Help text updated.
diff --git a/eval.c b/eval.c
index ff1d846f..b80149af 100644
--- a/eval.c
+++ b/eval.c
@@ -2278,6 +2278,7 @@ void eval_init(void)
   reg_fun(intern(lit("andf"), user_package), func_n0v(andv));
   reg_fun(intern(lit("orf"), user_package), func_n0v(orv));
   reg_fun(intern(lit("iff"), user_package), func_n3o(iff, 2));
+  reg_fun(intern(lit("iffi"), user_package), func_n3o(iffi, 2));
 
   reg_var(intern(lit("*stdout*"), user_package), &std_output);
   reg_var(intern(lit("*stddebug*"), user_package), &std_debug);
diff --git a/lib.c b/lib.c
index a9138199..dfc1e75d 100644
--- a/lib.c
+++ b/lib.c
@@ -3280,9 +3280,16 @@ static val do_iff(val env, val args)
              if2(elsefun, apply(elsefun, args, nil)));
 }
 
-val iff(val condfun, val elsefun, val thenfun)
+val iff(val condfun, val thenfun, val elsefun)
 {
-  return func_f0v(cons(condfun, cons(elsefun, thenfun)), do_iff);
+  return func_f0v(cons(condfun, cons(thenfun, elsefun)), do_iff);
+}
+
+val iffi(val condfun, val thenfun, val elsefun)
+{
+  if (!elsefun)
+    elsefun = identity_f;
+  return func_f0v(cons(condfun, cons(thenfun, elsefun)), do_iff);
 }
 
 val vector(val length)
diff --git a/lib.h b/lib.h
index 55787074..e22a265c 100644
--- a/lib.h
+++ b/lib.h
@@ -596,6 +596,7 @@ val andv(val funlist);
 val orf(val first_fun, ...);
 val orv(val funlist);
 val iff(val condfun, val thenfun, val elsefun);
+val iffi(val condfun, val thenfun, val elsefun);
 val swap_12_21(val fun);
 val vector(val length);
 val vectorp(val vec);
diff --git a/txr.1 b/txr.1
index 6517e070..4cdc568c 100644
--- a/txr.1
+++ b/txr.1
@@ -9394,12 +9394,13 @@ not called. If all functions return nil, then nil is returned. The expression
 (orf) returns a function which accepts any arguments and returns nil.
 
 
-.SS Function iff
+.SS Functions iff and iffi
 
 .TP
 Syntax:
 
   (iff <cond-func> <then-func> [<else-func>])
+  (iffi <cond-func> <then-func> [<else-func>])
 
 .TP
 Description:
@@ -9410,10 +9411,21 @@ functional arguments and returns a function.
 The resulting function takes its arguments and applies them to <cond-func>.  If
 <cond-func> yields true, then the arguments are passed to <then-func,> and the
 resulting value is returned. Otherwise if <cond-func> yields a false result,
-and there is no <else-func,> then nil is returned. If <cond-func> yields false,
+and there is no <else-func>, then nil is returned. If <cond-func> yields false,
 and an <else-func> exists, then the original arguments are passed to
 <else-func> and the resulting value is returned.
 
+The iffi function differs from iff only in the defaulting behavior with respect
+to the <else-func> argument. The following equivalence holds:
+
+  (iffi a b c) <--> (iff a b c)
+
+  (iffi a b)   <--> (iff a b identity)
+
+The iffi function defaults to the identity function when <else-func> is
+omitted, and therefore is useful in situations when one value is to be replaced
+with another one when the condition is true, otherwise left alone.
+
 .SH INPUT AND OUTPUT
 
 TXR Lisp supports input and output streams of various kinds, with
-- 
cgit v1.2.3