Overlapping type families, segafult
Not entirely sure what's going on here. I don't think this should type check; it appears to segfault whilst calling show on the wrong type.
This is probably not the absolute minimum required to reproduce.
I have reproduced on 7.8.3 and 7.9.20140727.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}
import Data.Monoid
class C x where
data D x :: *
makeD :: D x
instance Monoid x => C x where
data D x = D1 (Either x ())
makeD = D1 (Left mempty)
instance (Monoid x, Monoid y) => C (x, y) where
data D (x,y) = D2 (x,y)
makeD = D2 (mempty, mempty)
instance Show x => Show (D x) where
show (D1 x) = show x
main = print (makeD :: D (String, String))
This does not segfault if you add:
instance (Show x, Show y) => Show (D (x,y)) where
show (D2 x) = show x
Trac metadata
| Trac field | Value |
|---|---|
| Version | 7.8.3 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture |