From 6c9893d4790f1a27c900b2d84a3532ae7c402463 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 24 Jan 2015 22:22:27 -0800 Subject: * eval.c (callf): New static function. (eval_init): callf registered. * txr.1: Documented callf. --- ChangeLog | 7 +++++++ eval.c | 8 ++++++++ txr.1 | 32 ++++++++++++++++++++++++++++++++ 3 files changed, 47 insertions(+) diff --git a/ChangeLog b/ChangeLog index d1a6fa7e..0009d647 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2015-01-24 Kaz Kylheku + + * eval.c (callf): New static function. + (eval_init): callf registered. + + * txr.1: Documented callf. + 2015-01-22 Kaz Kylheku Basic implementation of constantp. Does not diff --git a/eval.c b/eval.c index bba8be6e..de125ea0 100644 --- a/eval.c +++ b/eval.c @@ -3455,6 +3455,13 @@ static val ipf(val fun) return func_f0v(fun, do_ipf); } +static val callf(val func, val funlist) +{ + val juxt_fun = juxtv(funlist); + val apf_fun = apf(func); + return chain(juxt_fun, apf_fun, nao); +} + static val prinl(val obj, val stream) { val ret = obj_print(obj, stream); @@ -3902,6 +3909,7 @@ void eval_init(void) reg_fun(intern(lit("retf"), user_package), func_n1(retf)); reg_fun(apf_s, func_n1(apf)); reg_fun(ipf_s, func_n1(ipf)); + reg_fun(intern(lit("callf"), user_package), func_n1v(callf)); reg_fun(intern(lit("tf"), user_package), func_n0v(tf)); reg_fun(intern(lit("nilf"), user_package), func_n0v(nilf)); diff --git a/txr.1 b/txr.1 index 95cfdb29..1c7a0aff 100644 --- a/txr.1 +++ b/txr.1 @@ -21414,6 +21414,38 @@ macro. (call [apf +] '(1 2 3)) -> 6 .cble +.coNP Function @ callf +.synb +.mets (callf < main-function << arg-function *) +.syne +.desc +The +.code callf +function returns a function which applies its arguments to each +.metn arg-function , +juxtaposing the return values of these calls to form arguments +which are then passed to +.metn main-function . +The return value of +.meta main-function +is returned. + +The following equivalence holds, except for the order of evaluation of +arguments: + +.cblk + (callf fm f0 f1 f2 ...) <--> (chain (juxt f0 f1 f2 ...) (apf fm)) +.cble + +.TP* Example: + +.cblk + ;; Keep those pairs which are two of a kind + + (keep-if [callf eql first second] '((1 1) (2 3) (4 4) (5 6))) + -> ((1 1) (4 4)) +.cble + .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