Mission: To take args from an n-tuple ... generally

Dear Community. I have recently read Joel Koerwer's posting how to evaluate a function of type (a->a->...->a->a), taking the arguments from a list (http://haskell.org/pipermail/haskell-cafe/2006-October/018658.html). Therefore, he introduced a function multApply: multApply :: (a->a->...->a->a) -> [a] -> a I wondered, why not take an n-tuple of arguments s.t. multApply' :: (a1->a2->...->an->o) -> (a1,(a2,(...(an,o)...))) -> o I naively tried to modify Joel's code, but in vain. As far as I can deduce from the error messages, GHC fails to fix the accordant types. However, in my understanding the type solely depends on the type of the passed function. Or am I wrong? Maybe there is a reason nobody has tried it this way? Following the code. First Joel's original multApply and then my attempt to define multApply'. ------------------------ MultApply.hs ------------------------------ {-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-} module MultApply where class MultApply func arg | func -> arg where multApply :: func -> [arg] -> arg instance MultApply (a->a) a where multApply f (x:xs) = f x multApply f _ = error "MultApply: one too few args" instance MultApply cascade a => MultApply (a -> cascade) a where multApply f (x:xs) = multApply (f x) xs multApply f _ = error "MultApply: n too few args" -- some random examples oneArg = multApply sqrt [25..] twoArg = multApply (+) [1..] fiveArg = multApply (\a b c d e -> sqrt ((a+b)^2+(d-e)^2)-5*c) [13..] class MultApply' f arg out | f -> arg out where multApply' :: f -> arg -> out instance MultApply' (a->b) a b where multApply' f x = f x multApply' f _ = error "MultApply: one too few args" instance MultApply' cascade a2 b => MultApply' (a1 -> cascade) (a1,a2) b where multApply' f (x,xs) = multApply' (f x) xs multApply' f _ = error "MultApply: n too few args" -------------------End File ------------------------ Hope I didn't stumble in a stupid newbie question. Thanks a lot to everybody who could give me some explanation and hints. Cheers, Martin

Hello,
I wondered, why not take an n-tuple of arguments s.t.
multApply' :: (a1->a2->...->an->o) -> (a1,(a2,(...(an,o)...))) -> o
I'm not sure what you're trying to do here. Why is there an o in the argument? Also, do you really mean the number of arguments expected to match the number of arguments given? Also you might want to check out Olegon polyvariadic functions: http://okmij.org/ftp/Haskell/vararg-fn.lhs -Jeff --- This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.
participants (2)
-
Jeff Polakow
-
Martin Hofmann