GHC builds recursive coerctions when using recursive type families
Consider
{-# LANGUAGE TypeFamilies, GADTs, UndecidableInstances #-}
type family F a
type instance F () = F ()
data A where
A :: F () ~ () => A
x :: A
x = A
main = seq A (return ())
On GHC 7.6.3 it yields a context reduction stack overflow (despite F () ~ () being put into the “solved funeqs” list).
In HEAD, a recursive dictionary is built, but then detected:
[1 of 1] Compiling Foo ( Foo.hs, Foo.o )
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 7.7.20131108 for x86_64-unknown-linux):
Cycle in coercion bindings
[[cobox_ayX{v} [lid]
= CO main:Foo.TFCo:R:F(){tc rob}[0] ; cobox_ayZ{v} [lid],
cobox_ayZ{v} [lid] = CO cobox_ayX{v} [lid] ; cobox_az0{v} [lid]]]
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
Either this panic needs to be turned into an error, or we need to prevent recursive dictionaries for when solving funeqs (similar to how we do it for Coercible
).
Edited by Thomas Miedema