[Haskell-cafe] Currying function using values from array

[Ryan Ingram]

2008/8/7 Sukit Tretriluxana <tretriluxana.s at gmail.com>:
> 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"