[Haskell-cafe] Accepting and returning polyvariadic functions

Ryan Ingram ryani.spam at gmail.com
Wed Aug 11 14:08:00 EDT 2010


There's no (safe) way to go from

a -> IO b

to

IO (a -> b)

which is part of what vtuple does.

Consider

foo :: Int -> IO String
foo 0 = return "zero"
foo _ = launchMissles >> return "fired!"

How would you implement foo2 :: IO (Int -> String) with the same behavior?

You can't; you would somehow need to know the argument the function
was called at, and when it was going to be called, to implement foo2.

So I think you need a better specification!

  -- ryan

On Wed, Aug 11, 2010 at 8:50 AM, Will Jones <will at sacharissa.co.uk> wrote:
> Hi all,
>
> I'm trying to write a function (I'll call it `vtuple' for lack of a better
> name)
> that returns a function that itself returns multiple arguments in the form
> of a
> tuple. For example:
>
>> {-# LANGUAGE FlexibleInstances #-}
>> {-# LANGUAGE FunctionalDependencies #-}
>> {-# LANGUAGE MultiParamTypeClasses #-}
>
>> f :: Int -> IO ()
>> f = undefined
>
>> g :: Int -> Int -> IO ()
>> g = undefined
>
>> h :: Int -> Int -> Int -> IO ()
>> h = undefined
>
> vtuple f :: IO (Int -> (Int, ()))
> vtuple g :: IO (Int -> Int -> (Int, (Int, ())))
>
> I've tried to type vtuple using a type class; my current effort is something
> like:
>
>> class VTuple ia ir a r | r -> a, a -> ia where
>>   vtuple :: (ia -> ir) -> IO (a -> r)
>
>> instance VTuple Int (IO ()) Int (Int, ()) where
>> --vtuple :: (Int -> IO ()) -> IO (Int -> (Int, ()))
>>   vtuple = undefined
>
>> instance VTuple ia ir a r
>>       => VTuple Int (ia -> ir) Int (a -> (Int, r)) where
>
>> --vtuple :: (Int -> ia -> ir) -> IO (Int -> a -> (Int, r))
>>   vtuple = undefined
>
> But this is problematic, since arrows creep in:
>
> For one argument (fine):
>   vtuple :: (Int -> IO ()) -> IO (Int -> (Int, ()))
>
>> vf :: IO (Int -> (Int, ()))
>> vf = vtuple f
>
> For two arguments (also fine):
>   vtuple  :: (Int -> Int -> IO ())
>           -> IO (Int -> Int -> (Int, (Int, ())))
>
>> vg :: IO (Int -> Int -> (Int, (Int, ())))
>> vg = vtuple g
>
> For three (noooo!):
>   vtuple  :: (Int -> Int -> IO ())
>           -> IO (Int -> Int -> (Int, (Int -> (Int32, (Int32, ())))))
>
> And so on. I've thought about it and it seems impossible to solve this
> problem
> -- you keep needing to ``split'' the function type one arrow further on. Is
> this a job for Template Haskell or is there a solution I'm missing here?
> Note
> that I'd also like to use types other than Int, but I don't think this is
> the
> primary complication here (touch wood).
>
> Any help much appreciated, thanks,
> Will
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>


More information about the Haskell-Cafe mailing list