Recursive type family causes <<loop>>
This file:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
data Proxy a = Proxy
foo :: Proxy (F (Fix Id)) -> ()
foo = undefined
newtype Fix a = Fix (a (Fix a))
newtype Id a = Id a
type family F a
type instance F (Fix a) = F (a (Fix a))
type instance F (Id a) = F a
main :: IO ()
main = print $ foo Proxy
Dies with <<loop>>
. The type family is recursive, of course:
*Main> :kind! F (Fix Id)
F (Fix Id) :: *^CInterrupted.
But <<loop>>
is still not the behavior I'd expect. The actual value is just undefined
.
In the file that this example came up, the situation was even worse -- there was a situation where
moldMapOf l f = runAccessor . l (Accessor . f)
main = print $ (flip appEndo [] . moldMapOf (ix 3) (Endo . (:)) $ testVal :: [Int]) -- <<loop>>
main = print $ (flip appEndo [] . runAccessor . (ix 3) (Accessor . Endo . (:)) $ testVal :: [Int]) -- undefined
I.e. substitution can turn one program (which happens to be ⊥ here, admittedly, but that's not fundamental) into another (<<loop>>
). This makes it very tricky to track down the recursive type family. If necessary I can hunt down a working test case and post it here -- it's a bit tricky to get working, though.
Trac metadata
Trac field | Value |
---|---|
Version | 7.6.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |