Why no multiple default method implementations?

Bas van Dijk v.dijk.bas at gmail.com
Thu Nov 24 18:17:17 CET 2011


On 24 November 2011 16:46, José Pedro Magalhães <jpm at cs.uu.nl> wrote:
> Hi Bas,
>
> On Thu, Nov 24, 2011 at 09:23, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
>>
>> Hello,
>>
>> Now that we have DefaultSignatures, why is it not allowed to have
>> multiple default method implementations, as in:
>>
>> {-# LANGUAGE DefaultSignatures #-}
>>
>> class Foo a where
>>    foo :: a
>>    foo = error "foo"
>>
>>    default foo :: Num a => a
>>    foo = 1
>>
>> GHC complains: "Conflicting definitions for `foo'"
>>
>> The following use of multiple default signatures also gives the same
>> error:
>>
>> class Foo a where
>>    foo :: a
>>
>>    default foo :: Fractional a => a
>>    foo = 0.5
>>
>>    default foo :: Num a => a
>>    foo = 1
>>
>> Couldn't GHC always pick the most specific default method, just as it
>> does with instances when OverlappingInstances is enabled?
>
> As far as I understand, GHC never looks at the context to decide which
> instance is
> applicable: http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/type-class-extensions.html#instance-overlap
>  Your instances above are duplicates.

Right. The reason I asked is that I'm adding default generic
implementations for the 'arbitrary' and 'shrink' methods of the
Arbitrary type class of QuickCheck:

class Arbitrary a where
  arbitrary :: Gen a

  shrink :: a -> [a]
  shrink _ = []

  default arbitrary :: (Generic a, GArbitrary (Rep a)) => Gen a
  arbitrary = fmap to gArbitrary

  default shrink :: (Generic a, GArbitrary (Rep a)) => a -> [a]
  shrink = map to . gShrink . from

However the normal default implementation of 'shrink' conflicts with
the generic default implementation. So I had to remove it and manually
add it to each of the instances that previously implicitly used the
default implementation.

This is not a big deal though.

Bas



More information about the Glasgow-haskell-users mailing list