Re: [Haskell-cafe] Class annotation on datatype ineffective in function

2006-12-19 Thread Brian Hulley

Reto Kramer wrote:

The code below does not compile unless the bar function is
annotated with a suitable constraint on the class of the formal
parameter.


class (C a)
data (C foo) = XY foo = X foo | Y foo

bar :: a - XY a
bar aFoo = X aFoo


As suggested, this works:


bar :: (C a) = a - XY a


Can someone explain to me why the compiler can not infer that a (in
bar) must be (C a) from the bar result type XY a (by way of the C
class provided for the datatype)?


Hi Reto -
If you'd not given any signature at all the compiler would have inferred the 
correct type for bar, but since you gave an explicit signature, the compiler 
had no option but to complain that you missed out the C a constraint. (ie if 
you decide to provide a signature you must give the full signature including 
constraints since the compiler won't add anything to them - partial 
signatures are not (yet) supported)


Regards, Brian.
--
http://www.metamilk.com 


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Class annotation on datatype ineffective in function

2006-12-18 Thread Reto Kramer
The code below does not compile unless the bar function is  
annotated with a suitable constraint on the class of the formal  
parameter.


 module Main where

 class (C a)
 data (C foo) = XY foo = X foo | Y foo

 bar :: a - XY a
 bar aFoo = X aFoo

 main = return ()

I get:

 $ ghc Test.hs

 Test.hs:8:8:
No instance for (C a)
  arising from use of `X' at Test.hs:8:8-10
Possible fix: add (C a) to the type signature(s) for `foo'
In the expression: X a
In the definition of `foo': foo a = X a

As suggested, this works:

 bar :: (C a) = a - XY a

Can someone explain to me why the compiler can not infer that a (in  
bar) must be (C a) from the bar result type XY a (by way of the C  
class provided for the datatype)?


Thanks,
- Reto
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Class annotation on datatype ineffective in function

2006-12-18 Thread Stefan Holdermans

Reto,

You gave us a code snippet:

The code below does not compile unless the bar function is  
annotated with a suitable constraint on the class of the formal  
parameter.


 module Main where

 class (C a)
 data (C foo) = XY foo = X foo | Y foo

 bar :: a - XY a
 bar aFoo = X aFoo

 main = return ()


And asked:

Can someone explain to me why the compiler can not infer that  
a (in bar) must be (C a) from the bar result type XY a (by way  
of the C class provided for the datatype)?


Well, the compiler can infer this type, but it does not even try to  
do so, because you yourself explicitly gave a type signature for bar.  
So, then the compiler only checks whether bar indeed has the claimed  
type. Here, it does not, because the type you gave is too general. If  
you would have omit the signature, the compiler would have inferred  
the right type, i.e., including the class constraint.


If you look at type signatures as machine-checkable documentation,  
then the compiler here pointed you at a flaw in your documentation.


Cheers,

  Stefan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe