2008/8/7 Sukit Tretriluxana
How in Haskell that I can create a function that curries any other function, which receives multiple parameters, by using a the input from a list (same data type) or a tuple (mixed data type) such that it either returns another closure (if not all parameters are curried) or the final value of the computation (when all parameters are known)?
Here's a solution that uses tuples only (no lists, they are somewhat more difficult to typecheck correctly), along with several tests. The payoff is functions with signatures like this: -- tncurry :: (a -> b -> c -> r) -> (a,b,c) -> r -- trcurry :: ((a,b,c) -> r) -> a -> b -> c -> r -- ncurry :: (a -> b -> c -> r) -> (a, (b, (c, ()))) -> r -- rcurry :: ((a, (b, (c, ()))) -> r) -> a -> b -> c -> r but that work on any number of arguments. (disclaimer: I've only implemented tncurry & trcurry up to 4-tuples; additional tuple sizes require 3 lines of boilerplate code each). -- ryan {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fno-monomorphism-restriction #-} module Curry where -- no-monomorphism-restriction is just so we don't -- have to put dummy arguments on the tests. class IsFunction f a r | f -> a r, a r -> f where apply :: f -> a -> r instance IsFunction (a -> b) a b where apply = ($) class NCurry f a r | f a -> r where ncurry :: f -> a -> r instance NCurry r () r where ncurry x _ = x instance (IsFunction f' b f, NCurry f a r) => NCurry f' (b,a) r where ncurry f (b,a) = ncurry (apply f b) a class RCurry t x r | t x -> r where rcurry :: (t -> x) -> r instance RCurry () r r where rcurry f = f () instance RCurry t x r => RCurry (a,t) x (a -> r) where rcurry f x = rcurry (\t -> f (x,t)) -- some tests test1 = ncurry (+) (5, (10, ())) -- test1 :: Num f => f -- test1 => 15 plus :: Num a => (a, (a, ())) -> a plus = ncurry (+) test2 = rcurry plus -- test2 :: Num a => a -> a -> a test_broken = rcurry (ncurry (+)) -- test_broken :: (Num a, NCurry (a -> a -> a) t r, RCurry t r r1) => r1 {- test_broken 5 10 => No instances for (NCurry (a -> a -> a) t r, RCurry t r (t1 -> t2 -> t3)) This is an instance of the "read.show" problem; ncurry (+) has many types: ncurry (+) :: Num a => () -> a -> a -> a ncurry (+) :: Num a => (a,()) -> a -> a ncurry (+) :: Num a => (a,(a,())) -> a Even though rcurry would work on any of these, it's ambiguous which one to choose, so the type inferencer gives up. -} test3 = test2 5 10 -- test3 :: Num t => t -- test3 => 15 -- stupid constant function dumb a b c d = c test4 = ncurry dumb ("wrong", (5, ("correct", ([1..50], ())))) -- test4 :: [Char] -- test4 => "correct" dumb2 (a, (b, (c, (d, ())))) = c test5 = rcurry dumb2 -- test5 :: t -> t1 -> r -> t2 -> r test6 = rcurry dumb2 "wrong" 5 "correct" [1..50] -- test6 :: [Char] -- test6 => "correct" -- We can also use "real" tuples instead of tuple-lists, with -- some boilerplate... class TupleChange n t | n -> t, t -> n where toTuple :: n -> t fromTuple :: t -> n -- Haskell doesn't have a "1-tuple", so make it ourselves data Tuple1 x = Tuple1 x deriving (Eq, Show, Ord) instance TupleChange () () where toTuple = id fromTuple = id instance TupleChange (a, ()) (Tuple1 a) where toTuple (a, ()) = Tuple1 a fromTuple (Tuple1 a) = (a, ()) instance TupleChange (a, (b, ())) (a, b) where toTuple (a, (b, ())) = (a,b) fromTuple (a,b) = (a, (b, ())) instance TupleChange (a, (b, (c, ()))) (a,b,c) where toTuple (a, (b, (c, ()))) = (a,b,c) fromTuple (a,b,c) = (a, (b, (c, ()))) instance TupleChange (a, (b, (c, (d, ())))) (a,b,c,d) where toTuple (a, (b, (c, (d, ())))) = (a,b,c,d) fromTuple (a,b,c,d) = (a, (b, (c, (d, ())))) tncurry f = ncurry f . fromTuple trcurry f = rcurry (f . toTuple) -- Tests of tncurry/trcurry & show closures test7 = tncurry (+) (Tuple1 5) -- test7 :: Num a => a -> a -- test7 10 => 15 dumb3 (a,b,c,d) = c test8 = trcurry dumb3 -- test8 :: t -> t1 -> r -> t2 -> r -- test9 creates a closure waiting for more -- arguments... test9 = tncurry dumb ("foo", "bar", "hat") -- test9 :: t -> [Char] -- test9 "baz" => "hat" -- although you do have to use tncurry again -- with each call if you want to keep applying -- it with tuples test10 = tncurry (tncurry dumb ("foo", "bar", "hat")) (Tuple1 "baz") -- test10 :: [Char] -- test10 => "hat"