
It uses less space. Conceptually:
data X a = Num a => ConX a
looks like this in memory: { ConX tag, a, proof of Num a } where the proof is usually a pointer to the dictionary for that typeclass at that type. Whereas
data Num a => Y a = ConY a
looks like this:
{ ConY tag, a }
This is why the rhs constraint lets you access methods of the
typeclass inside the function; pattern matching on ConX provides a Num
dictionary for the code to call. For ConY, it has to get that
dictionary from somewhere-- the caller has to pass it in.
-- ryan
On Wed, Aug 25, 2010 at 9:59 AM, Oscar Finnsson
Thanks for the tip. You saved my day (and code)!
So what is the point of having the constraint on the left side of the '='? Will it allow me to do anything that the right-side constraint won't?
-- Oscar
On Mon, Aug 23, 2010 at 11:06 PM, Daniel Fischer
wrote: On Monday 23 August 2010 22:30:03, Oscar Finnsson wrote:
Hi,
I'm wondering why I have to repeat the class constraints at every function.
If I got the data type
data (Eq a, Show a, Data a, Eq b, Show b, Data b, Eq c, Show c, Data c) => Foo a b c = Foo a b c
Type class constraints on datatypes are considered a wart. They don't do what people expect, in particular they don't make the constraints available at the use site.
It works if you move the constraints across the '=':
{-# LANGUAGE ExistentialQuantification #-}
data Foo a b c = (Eq a, Show a, ...) => Foo a b c
or with GADT syntax:
{-# LANGUAGE GADTs #-}
data Foo x y z where Foo :: (Eq a, Show a, ...) => a -> b -> c -> Foo a b c
Both make the constraints available at the use site,
bar :: Foo a b c -> String bar (Foo a b c) = "Foo " ++ show a ++ " " ++ show b ++ " " ++ show c ++ ", Yay!"
and then a function from Foo to String I have to supply the signature
bar :: (Eq a, Show a, Data a, Eq b, Show b, Data b, Eq c, Show c, Data c) => Foo a b c -> String
even though it should be clear that a, b and c *must* fulfill the constraints already so I should be able to just supply the signature
One would think so. It's a wart.
bar :: Foo a b c -> String
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe