GADT and problems with rigid type variables

Hello, playing with GADTs I ran into a problem with rigid type variables which is ilustrated by the following example. I think it should be pretty clear what I'am trying to express... Any suggestions? ---- snip ---- {-# LANGUAGE GADTs #-} data Foo where Foo :: (Eq t) => t -> Foo instance Eq Foo where (Foo a) == (Foo b) = a == b {- Scratch.hs:7:28: Couldn't match expected type `t' against inferred type `t1' `t' is a rigid type variable bound by the constructor `Foo' at /home/alios/src/lab/Scratch.hs:7:3 `t1' is a rigid type variable bound by the constructor `Foo' at /home/alios/src/lab/Scratch.hs:7:14 In the second argument of `(==)', namely `b' In the expression: a == b In the definition of `==': (Foo a) == (Foo b) = a == b Failed, modules loaded: none. -} ---- snip ---- thnx Markus

The problem is that you have an existential `t` there, and two values of the
type Foo might not have the same `t` inside them.
What do you want to happen if someone writes Foo True == Foo "yep"?
The only real solution here is to parametrize your Foo type by the t that
lives within it, so you can ensure the inner types are the same. You could
also do some (in my opinion) fairly nasty stuff with Dynamic or Typeable,
adding a constraint to the Eq and attempting to cast at runtime (returning
False if the cast returns Nothing).
Hope this helps!
On Mon, Aug 23, 2010 at 12:36 AM, Markus Barenhoff
Hello, playing with GADTs I ran into a problem with rigid type variables which is ilustrated by the following example. I think it should be pretty clear what I'am trying to express... Any suggestions?
---- snip ---- {-# LANGUAGE GADTs #-}
data Foo where Foo :: (Eq t) => t -> Foo
instance Eq Foo where (Foo a) == (Foo b) = a == b
{- Scratch.hs:7:28: Couldn't match expected type `t' against inferred type `t1' `t' is a rigid type variable bound by the constructor `Foo' at /home/alios/src/lab/Scratch.hs:7:3 `t1' is a rigid type variable bound by the constructor `Foo' at /home/alios/src/lab/Scratch.hs:7:14 In the second argument of `(==)', namely `b' In the expression: a == b In the definition of `==': (Foo a) == (Foo b) = a == b Failed, modules loaded: none. -} ---- snip ----
thnx Markus _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sun, Aug 22, 2010 at 7:47 PM, Daniel Peebles
You could also do some (in my opinion) fairly nasty stuff with Dynamic or Typeable, adding a constraint to the Eq and attempting to cast at runtime (returning False if the cast returns Nothing).
This is what he's talking about:
{-# LANGUAGE GADTs #-}
import Data.Typeable (Typeable, cast)
data Foo where Foo :: (Typeable t, Eq t) => t -> Foo
instance Eq Foo where (Foo a) == (Foo b) = maybe False (== b) (cast a)
Cheers, -- Felipe.
participants (3)
-
Daniel Peebles
-
Felipe Lessa
-
Markus Barenhoff