[Haskell-cafe] Ambiguous reified dictionaries
Martijn van Steenbergen
martijn at van.steenbergen.nl
Thu Apr 9 04:35:03 EDT 2009
Good morning,
The [1]GHC user's guide, section 8.4.5 says:
"The new feature is that pattern-matching on MkSet (as in the definition
of insert) makes available an (Eq a) context. In implementation terms,
the MkSet constructor has a hidden field that stores the (Eq a)
dictionary that is passed to MkSet; so when pattern-matching that
dictionary becomes available for the right-hand side of the match."
But what happens if there are several dictionaries available?
Consider these three modules:
ReifyMonoid.hs:
> {-# LANGUAGE GADTs #-}
>
> module ReifyMonoid where
>
> import Data.Monoid
>
> data MonoidInst a where
> MkMonoidInst :: Monoid a => MonoidInst a
ReifySum.hs:
> module ReifySum where
>
> import ReifyMonoid
> import Data.Monoid
>
> instance Monoid Int where
> mempty = 0
> mappend = (+)
>
> intSum :: MonoidInst Int
> intSum = MkMonoidInst
ReifyProd.hs:
> module ReifyProd where
>
> import ReifyMonoid
> import Data.Monoid
>
> instance Monoid Int where
> mempty = 1
> mappend = (*)
>
> intProd :: MonoidInst Int
> intProd = MkMonoidInst
Now a function
> emp :: MonoidInst a -> a
> emp MkMonoidInst = mempty
works as you'd expect:
*ReifySum ReifyProd> emp intSum
0
*ReifySum ReifyProd> emp intProd
1
But what about this function?
> empAmb :: MonoidInst a -> MonoidInst a -> a
> empAmb MkMonoidInst MkMonoidInst = mempty
Now there are two dictionaries available. GHC consistently picks the one
from the second argument:
*ReifySum ReifyProd> empAmb intProd intSum
1
*ReifySum ReifyProd> empAmb intSum intProd
0
My questions are:
1) Shouldn't GHC reject this as being ambiguous?
2) Should class constraints only be available on existentially qualified
type variables to prevent this from happening at all?
3) Is it possible to implement the following function?
> mkMonoidInst :: a -> (a -> a -> a) -> MonoidInst a
> mkMonoidInst mempty mappend = ...
Thank you,
Martijn.
[1]
http://www.haskell.org/ghc/docs/latest/html/users_guide/data-type-extensions.html#gadt-style
More information about the Haskell-Cafe
mailing list