[Haskell] type inference & instance extensions

Lennart Augustsson lennart at augustsson.net
Mon Jan 19 10:17:41 EST 2009


A loop without turning on a flag to allow it must be a bug.

  -- Lennart

On Mon, Jan 19, 2009 at 2:04 PM, Sittampalam, Ganesh
<ganesh.sittampalam at credit-suisse.com> wrote:
> Doug McIlroy wrote:
>> A fragment of an attempt to make pairs serve as complex numbers,
>> using ghc/hugs extensions:
>>
>>         instance Num a => Num (a,a) where
>>                 (x,y) * (u,v) = (x*u-y*v, x*v+y*u)
>>
>> Unfortunately, type inference isn't strong enough to cope with
>>
>>         (1,1)*(1,1)
>>
>> Why shouldn't it be strengthened to do so?
>
> The problem is that type classes are an "open" system. Although
> it's obvious that your instance is the only one in this code
> that can be used to type-check (1,1), that doesn't preclude new
> code adding an instance that could make it behave differently.
>
> I had hoped that the code below (GHC 6.10+) would work, but it
> just sends GHC into a loop when you actually try to typecheck
> (1,1). I don't know if that's a bug in GHC or a misunderstanding
> on my part of how the typechecking should work.
>
> {-# LANGUAGE FlexibleInstances, TypeFamilies #-}
>
> instance (a~b, Num a) => Num (a, b) where
>  fromInteger k = (fromInteger k, fromInteger 0)
>  (x,y) * (u,v) = (x*u-y*v, x*v+y*u)
>
> Ganesh
>
> ==============================================================================
> Please access the attached hyperlink for an important electronic communications disclaimer:
>
> http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
> ==============================================================================
>
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>


More information about the Haskell mailing list