#2935: "A lazy (~) pattern cannot bind existential type variables" happens for
non-existential GADTs
-----------------------------+----------------------------------------------
Reporter: ganesh | Owner:
Type: bug | Status: new
Priority: normal | Component: Compiler
Version: 6.10.1 | Severity: normal
Keywords: | Testcase:
Os: Unknown/Multiple | Architecture: Unknown/Multiple
-----------------------------+----------------------------------------------
This program:
{{{
{-# LANGUAGE GADTs #-}
module Foo where
data Foo a where
Foo :: a -> Foo (a, Int)
foo :: Foo (a, Int) -> a
foo ~(Foo a) = a
}}}
causes this error:
{{{
Foo.hs:8:4:
A lazy (~) pattern cannot bind existential type variables
`a' is a rigid type variable bound by
the constructor `Foo' at Foo.hs:8:6
In the pattern: ~(Foo a)
In the definition of `foo': foo ~(Foo a) = a
}}}
This doesn't seem like an existential, as there aren't any type variables
in the arguments to Foo that aren't in the result type.
If easy it would be nice if the restriction were relaxed to allow for this
case, otherwise I think the error message should be improved.
Tested with ghc 6.10.1.20081209 and ghc 6.11.20090107.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2935>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs