Mathematica Nested Anonymous Variable Arity Functions

Question

I'm trying to translate the following scheme code into Mathematica (version 8, if that matters):

(define (((lift g) . fs) . args)
  (apply g
         (map (lambda (f) (apply f args))
              fs)))

Then, you can do things like:

(let ((add (lift +))
      (square (lift sqr)))
  ((add (square sin) (square cos)) 42))
; returns 1, since sin^2(42) + cos^2(42) = 1

The part (add (square sin) (square cos)) creates a function x -> sin^2(x) + cos^2(x).

Anyway, I tried coding this in Mathematica, but I can't seem to get very far. Here's what I want to write:

lift[g_] := Function[{fs__}, Function[{args__},
            g @@ Map[(# @@ args)&, fs]]]

I want fs__ and args__ to be bound to the list of all arguments to their respective functions. But then Mathematica complains that the "parameter specification" for Function should be "a symbol or a list of symbols". I know that I can use the ()& style anonymous functions and use ## to get all arguments, but the problem is that when I nest two of these anonymous functions, I lose the ability to access the outer arguments from within the inner function.

How can I write anonymous functions with variable arity (and named arguments)? Or should I solve this problem another way in Mathematica?

Answer 1

I'm not sure if this function does what you want, but you can capture the SlotSequence (##) of the outer function using With

lift[g_] := Function[
  With[{fs = ##},
   Function[
    With[{args = ##},
     g @@ Map[(#[args]) &, List[fs]]]]]]

Then:

lift[f][a, b][c, d]

-> f[a[c, d], b[c, d]]

Or, more readable:

lift[g_] := Function[
  With[{fs = g[##]},
   Through[fs[##]] &]]

Answer 2

nikie gave a great answer. I hope this one complements it.

You can create temporary functions using Module, which gives you the full set of pattern options for the parameter specification. For example, using nikie's concise method:

lift1[g_] := Module[{fn}, fn[a__] := Through[g[a][##]] &; fn]

lift1[f][a, b][c, d]

f[a[c, d], b[c, d]]

In this particular case you could also use a SubValues rule like this:

lift2[g_][h__] := Through[g[h][##]] &

lift2[f][a, b][c, d]

f[a[c, d], b[c, d]]

Or even without Function at all:

lift3[g_][h__][i__] := Through[ g[h][i] ]

lift3[f][a, b][c, d]

f[a[c, d], b[c, d]]