diff options
| -rw-r--r-- | eval.c | 23 | ||||
| -rw-r--r-- | tests/012/callable.tl | 5 | ||||
| -rw-r--r-- | txr.1 | 15 |
3 files changed, 43 insertions, 0 deletions
@@ -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)) @@ -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. |