Rigid/Skolum produced by unassociated values.
Here is an in depth example of a possible GHC bug. It is exacerbated by GADTs, but can be fixed with NoMonoLocalBinds. Without GADTs and just leveraging ExistentialQuantification it works fine. We've included a pretty exhaustive set of examples.
{-# LANGUAGE ExistentialQuantification, GADTs #-}
{- removing MonoLocalBinds fixes all of these errors
{-# LANGUAGE ExistentialQuantification, GADTs, NoMonoLocalBinds #-}
-}
module PossibleGHCBug where
data SumType = SumFoo | SumBar
class SomeClass a where
someType :: a -> SumType
data SomeExistential = forall a. SomeClass a => SomeExistential a
noError :: String -> [SomeExistential] -> String
noError n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> "asdf"
noError2 :: String -> [SomeExistential] -> String
noError2 n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d p = c $ someType p
c :: SumType -> String
c p = case p of
SumFoo -> "foo"
_ -> "asdf" ++ n
noError3 :: String -> [SomeExistential] -> String
noError3 n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d :: SomeClass a => a -> String
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> "asdf" ++ n
partialTypedError :: String -> [SomeExistential] -> String
partialTypedError n st = n ++ concatMap cname st
where cname :: SomeExistential -> String
cname (SomeExistential p) = d p
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> "asdf" ++ n
fullError :: String -> [SomeExistential] -> String
fullError n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> "asdf" ++ n
justNError :: String -> [SomeExistential] -> String
justNError n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> n
ignoreNError :: String -> [SomeExistential] -> String
ignoreNError n st = n ++ concatMap cname st
where cname (SomeExistential p) = d p
d p = c $ someType p
c p = case p of
SumFoo -> "foo"
_ -> fst ("foo", n)
Trac metadata
Trac field | Value |
---|---|
Version | 7.8.4 |
Type | Bug |
TypeOfFailure | CompileTimeCrash |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |