From 5388b3ddd03e924c0b46b268efc74b29b816cb19 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 2 May 2025 21:57:12 -0700
Subject: New function: progf.

* eval.c (do_progf, progf): New static functions.
(eva_init): Register progf intrinsic.

* tests/012/callable.tl: New test.

* txr.1: Documented.
---
 eval.c                | 23 +++++++++++++++++++++++
 tests/012/callable.tl |  5 +++++
 txr.1                 | 15 +++++++++++++++
 3 files changed, 43 insertions(+)

diff --git a/eval.c b/eval.c
index d4a5cf7e..e1515b2b 100644
--- a/eval.c
+++ b/eval.c
@@ -7138,6 +7138,28 @@ static val juxt(varg funlist)
   return callf(list_f, funlist);
 }
 
+static val do_progf(val dargs, varg inargs)
+{
+  val self = lit("progf");
+  varg funlist = (type_check(self, dargs, DARG), dargs->a.args);
+  cnum inacount = args_count(inargs, self);
+  args_decl(inargs_cp, max(inacount, ARGS_MIN));
+  cnum index = 0;
+  val res = nil;
+
+  while ((args_copy(inargs_cp, inargs), args_more(funlist, index))) {
+    val afun = args_get(funlist, &index);
+    res = generic_funcall(afun, inargs_cp);
+  }
+
+  return res;
+}
+
+static val progf(varg funlist)
+{
+  return func_f0v(dyn_args(funlist, nil, nil), do_progf);
+}
+
 static val do_mapf(val env, varg args)
 {
   cons_bind (fun, funlist, env);
@@ -7823,6 +7845,7 @@ void eval_init(void)
   reg_fun(intern(lit("apf"), user_package), func_n1v(apf));
   reg_fun(intern(lit("ipf"), user_package), func_n1v(ipf));
   reg_fun(intern(lit("callf"), user_package), func_n1v(callf));
+  reg_fun(intern(lit("progf"), user_package), func_n0v(progf));
   reg_fun(intern(lit("mapf"), user_package), func_n1v(mapf));
   reg_fun(intern(lit("tf"), user_package), func_n0v(tf));
 
diff --git a/tests/012/callable.tl b/tests/012/callable.tl
index 9e88b955..47e20129 100644
--- a/tests/012/callable.tl
+++ b/tests/012/callable.tl
@@ -29,3 +29,8 @@
   (set [1..2 1..2] 2) :error
   (let ((abc "abc")) (set [1..2 abc] "42") abc) "a42c"
   (let ((abc "abc")) (set [1 abc] #\d) abc) "adc")
+
+(test
+  (let (stk)
+    [[progf (lopip succ (push stk)) (ldo push stk) (lopip pred (push stk))] 1])
+  (0 1 2))
diff --git a/txr.1 b/txr.1
index 286f6cd2..b1c84350 100644
--- a/txr.1
+++ b/txr.1
@@ -63889,6 +63889,21 @@ The following equivalence holds:
 
 .brev
 
+.coNP Function @ progf
+.synb
+.mets (progf <> { function }*)
+.syne
+.desc
+The
+.code progf
+function takes zero or more arguments which are functions.
+It returns a function which passes its arguments to each of these
+functions in turn, in left-to-right order.
+
+The return value is that of the last function, or
+.code nil
+if there are no functions.
+
 .SS* Input and Output (Streams)
 \*(TL supports input and output streams of various kinds, with
 generic operations that work across the stream types.
-- 
cgit v1.2.3