[Haskell-beginners] Wrong type inferred for polymorphic function in a case alternative

Ramin Honary ramin.honary at gmail.com
Wed Apr 11 19:01:52 CEST 2012


Thanks for your very prompt reply Brent.
I just now gave it a try, and it works just like you said.

Thank you!


On Thu, Apr 12, 2012 at 12:31 AM, Brent Yorgey <byorgey at seas.upenn.edu> wrote:
> Hi Ramin,
>
> What you need is Rank2Types:
>
>  {-# LANGUAGE Rank2Types #-}
>
>  module ABC where
>
>  ...
>
>  apply :: (forall a. TClass a => (a -> a -> a)) -> T -> T -> T
>  apply fn x y =
>    case (x, y) of
>      (TA x, TA y) -> TA (fn x y)
>      (TB x, TB y) -> TB (fn x y)
>      (TC x, TC y) -> TC (fn x y)
>      _            -> error "T constructors do not match"
>
> The problem with the old type signature of apply:
>
>  apply :: TClass a => (a -> a -> a) -> T -> T -> T
>
> is that this type means that the *caller* of apply gets to choose the
> type 'a', and may provide some function which only works for some
> particular type a (which must be an instance of TClass).  But that's
> not what you want.  The new type:
>
>  apply :: (forall a. TClass a => (a -> a -> a)) -> T -> T -> T
>
> means that the caller must provide a function which is guaranteed to
> work for *any* instance of TClass.  (Note the 'forall' and the extra
> parentheses.)
>
> -Brent
>
>
> On Thu, Apr 12, 2012 at 12:06:28AM +0900, Ramin Honary wrote:
>> Hi everyone,
>>
>> I am using GHC 7.0.4.
>> I boiled-down my problem into a simple program which I attached to
>> this message. I don't know how to get the program to compile.
>>
>> I need to pass arbitrary class member functions as a parameter to a
>> very large, complex, polymorphic function called "apply", and have
>> this class member function applied to abitrary fields of data
>> constructors of a very large, complex data type.
>>
>> What I expect to happen is this:
>> For each case alternative, GHC will infer the type of the polymorphic
>> function from the matched pattern in the case alternative, and use
>> that inference to select the correct instance function for that type.
>> So for case alternative (TA x, TA y) -> TA (fn x y), the correct
>> instance for "fn" is selected based on the type of "x" and "y" which
>> are determined by the pattern match, and by the type of "TA". If that
>> case alternative does not match, then it should try the next
>> alternative (TB x, TB y) -> TB (fn x y), and since "fn" is
>> polymorphic, it will still be able to select the correct instance for
>> the type given by the pattern match. So I can pass "f1" or "f2" or
>> "f3" to "apply" as the "fn" parameter, and have the correct instance
>> of "f1" or "f2" or "f3" be selected depending on where in the "case"
>> expression "fn" is used.
>>
>> What is actually happening is:
>> GHC arbitrarily selects one of the case alternatives (usually the last
>> case alternative, sometimes the first) and decides that from now on
>> this one type is the type for "fn" for every case alternative. So for
>> every other case alternative, it decides that "fn" is of the wrong
>> type and rejects the program, rather than trying to infer a different
>> type for "fn" specific to this case alternative. Said another way, the
>> type inference algorithm is being too strict, and I would like it to
>> be more lazy, computing the type once per each case alternative,
>> rather than computing the type only once for the entire case
>> statement. Is there a language option for that?
>>
>> I have tried using language options, like -XNoMonoPatBinds
>> -XNoMonomorphismRestriction -XMonoLocalBinds -XPolymorphicComponents
>> -XImpredicativeTypes, but none of those help. My current solution is
>> to use Template Haskell and make the "apply" function a splice, so the
>> whole case statement is copied to every place it is used (which takes
>> a very, very long for it time to comple). Is there a way to do this
>> without Template Haskell? Can I get GHC to behave as I expected it to?
>>
>> Thanks,
>>     Ramin
>
>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners



More information about the Beginners mailing list