From 4ec024cdc9544c244cbd8b630e8f631fc05c6075 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 25 Jan 2015 08:39:15 -0800
Subject: * eval.c (eval_init): Register dupl and swap_12_21 as the dup and
 flip intrinsics.

* lib.c (do_dup): New static function.
(dupl): New function.

* lib.h (dupl): Declared.

* txr.1: Documented dup and flip.
---
 ChangeLog | 12 ++++++++++++
 eval.c    |  2 ++
 lib.c     | 10 ++++++++++
 lib.h     |  1 +
 txr.1     | 31 +++++++++++++++++++++++++++++++
 5 files changed, 56 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 0009d647..5d6958b3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2015-01-25  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Register dupl and swap_12_21 as
+	the dup and flip intrinsics.
+
+	* lib.c (do_dup): New static function.
+	(dupl): New function.
+
+	* lib.h (dupl): Declared.
+
+	* txr.1: Documented dup and flip.
+
 2015-01-24  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (callf): New static function.
diff --git a/eval.c b/eval.c
index de125ea0..4929973a 100644
--- a/eval.c
+++ b/eval.c
@@ -3903,6 +3903,8 @@ void eval_init(void)
   reg_fun(intern(lit("notf"), user_package), func_n1(notf));
   reg_fun(intern(lit("iff"), user_package), func_n3o(iff, 1));
   reg_fun(intern(lit("iffi"), user_package), func_n3o(iffi, 2));
+  reg_fun(intern(lit("dup"), user_package), func_n1(dupl));
+  reg_fun(intern(lit("flip"), user_package), func_n1(swap_12_21));
   reg_fun(intern(lit("if"), user_package), func_n3o(if_fun, 2));
   reg_fun(intern(lit("or"), user_package), func_n0v(or_fun));
   reg_fun(intern(lit("and"), user_package), func_n0v(and_fun));
diff --git a/lib.c b/lib.c
index 41a9c29f..7c857423 100644
--- a/lib.c
+++ b/lib.c
@@ -4756,6 +4756,16 @@ val iffi(val condfun, val thenfun, val elsefun)
   return func_f0v(cons(condfun, cons(thenfun, elsefun)), do_iff);
 }
 
+static val do_dup(val fun, val arg)
+{
+  return funcall2(fun, arg, arg);
+}
+
+val dupl(val fun)
+{
+  return func_f1(fun, do_dup);
+}
+
 val vector(val length, val initval)
 {
   int i;
diff --git a/lib.h b/lib.h
index 378973e6..cd753e52 100644
--- a/lib.h
+++ b/lib.h
@@ -758,6 +758,7 @@ val orv(val funlist);
 val notf(val fun);
 val iff(val condfun, val thenfun, val elsefun);
 val iffi(val condfun, val thenfun, val elsefun);
+val dupl(val fun);
 val swap_12_21(val fun);
 val vector(val length, val initval);
 val vectorp(val vec);
diff --git a/txr.1 b/txr.1
index 1c7a0aff..29e9fa7b 100644
--- a/txr.1
+++ b/txr.1
@@ -20990,6 +20990,37 @@ and the expression
 returns a function similar to
 .codn (lambda (. rest) 42) .
 
+.coNP Function @ dup
+.synb
+.mets (dup << func )
+.syne
+.desc
+The
+.code dup
+function returns a one-argument function which calls the two-argument
+function
+.metn func
+by duplicating its argument.
+
+.TP* Example:
+
+.cblk
+  ;; square the elements of a list
+  (mapcar [dup *] '(1 2 3)) -> (1 4 9)
+.cble
+
+.coNP Function @ flip
+.synb
+.mets (flip << func )
+.syne
+.desc
+The
+.code flip
+function returns a two-argument function which calls the two-argument
+function
+.metn func
+with reversed arguments.
+
 .coNP Functions @ chain and @ chand
 .synb
 .mets (chain << func *)
-- 
cgit v1.2.3