Hmm, strange. I have a project that uses data families with dozens of constructors per "clause"/instantiation of the type function. I use GADT syntax to define them though as they also refine one of the parameter type variables. Never had any issues with it, although I haven't tried building that project on GHC 7 yet (as some of its dependencies didn't work last time I tried), so maybe it's a new issue?

On Sun, Nov 14, 2010 at 2:15 PM, Michael Snoyman <michael@snoyman.com> wrote:
Hey all,

While trying to get a commit pushed for Yesod[1], Alexander Dunlap
pointed out one of his programs didn't work with the new code. After
some investigation, I was able to reproduce the bug with the following
code snippet:

{-# LANGUAGE TypeFamilies #-}
data family Foo a
data Bar = Bar
data instance Foo Bar
   = Bar1 | Bar2 | Bar3 | Bar4 | Bar5 | Bar6 | Bar7 | Bar8 | Bar9
   deriving Eq

This produces:

   Couldn't match expected type `Main.R:FooBar'
          against inferred type `Foo Bar'
     NB: `Foo' is a type function
   In the first argument of `Main.$con2tag_R:FooBar', namely `a'
   In the expression: (Main.$con2tag_R:FooBar a)
   In the expression:
       case (Main.$con2tag_R:FooBar a) of {
         a#
           -> case (Main.$con2tag_R:FooBar b) of {
                b# -> (a# GHC.Prim.==# b#) } }

The especially strange thing about this bug is that it only occurs
when there are more than 8 constructors; if I remove Bar9, everything
seems to work. Does anyone have experience with this occuring?

Michael

[1] http://docs.yesodweb.com/blog/please-break-yesod/
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe