Mission: To take args from a list... generally

Haskellers, Let's say I want to evaluate a function of type (a->a->...->a->a), taking the arguments from a list. If know the function ahead of time, I can simply wrap it: foo a b c d = ... wrapFoo (a:b:c:d:_) = foo a b c d But, as an exercise, I challenged myself to write a function, multApply :: (a->a->...->a->a) -> [a] -> a, that automatically does the wrapping for any such function. On #haskell Don Stewart suggested I look at printf, but I've yet to put much thought into whether that method will work here. I'm posting my solution in hopes to learn from your comments. This solution uses fundeps, multi-parameter classes, and overlapping instances. Note that I don't actually understand these things! :) ------------------------ 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..] -------------------End File ------------------------ Results in ghci: *MultApply> oneArg 5.0 *MultApply> fiveArg -47.981487827787404 To compose your own examples in ghci, you'll need -fallow-overlapping-instances on the command line. Cheers, Joel

On 04/10/06, Joel Koerwer
I'm posting my solution in hopes to learn from your comments. This solution uses fundeps, multi-parameter classes, and overlapping instances. Note that I don't actually understand these things! :)
Nice work! I haven't tried it out, but you seem to have on the right trick here: typeclass hackery. An interesting related exercise to develop a similar function using Template Haskell [1]. Also of note might be Oleg's writings on true polyvariadic functions [2]. [1]: http://haskell.org/th [2]: http://okmij.org/ftp/Haskell/types.html#polyvar-fn -- -David House, dmhouse@gmail.com
participants (2)
-
David House
-
Joel Koerwer