[Haskell-cafe] Mission: To take args from an n-tuple ... generally
Martin Hofmann
martin.hofmann at uni-bamberg.de
Thu Jan 31 08:47:41 EST 2008
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
More information about the Haskell-Cafe
mailing list