Re: Why no multiple default method implementations?

2011-11-24 Thread José Pedro Magalhães
Hi Bas,

On Thu, Nov 24, 2011 at 09:23, Bas van Dijk v.dijk@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.


Cheers,
Pedro


 Regards,

 Bas

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Why no multiple default method implementations?

2011-11-24 Thread Bas van Dijk
On 24 November 2011 16:46, José Pedro Magalhães j...@cs.uu.nl wrote:
 Hi Bas,

 On Thu, Nov 24, 2011 at 09:23, Bas van Dijk v.dijk@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

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users