[Haskell-cafe] Function signatures and type class constraints

Ryan Ingram ryani.spam at gmail.com
Wed Aug 25 14:04:17 EDT 2010


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
<oscar.finnsson at gmail.com> wrote:
> 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
> <daniel.is.fischer at web.de> 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 at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list