<div dir="ltr"><div class="gmail_quote"><div dir="ltr">An
 extension of the message Tom sent a little while back, we've discovered
 a more in depth example of this possible GHC bug. It is exacerbated by 
GADTs, but can be fixed with NoMonoLocalBinds. Without GADTs and just 
leveraging ExistentialQuanitification it works fine. We've included a 
pretty exhaustive set of examples.<br><br>  {-# LANGUAGE ExistentialQuantification, GADTs #-}<br>  <br>  {- removing MonoLocalBinds fixes all of these errors<br>  {-# LANGUAGE ExistentialQuantification, GADTs, NoMonoLocalBinds #-}<br>  -}<br>  <br>  module PossibleGHCBug where<br>  <br>  data SumType = SumFoo | SumBar<br>  <br>  class SomeClass a where<br>    someType :: a -> SumType<br>  <br>  data SomeExistential = forall a. SomeClass a => SomeExistential a<br>  <br>  noError :: String -> [SomeExistential] -> String<br>  noError n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> "asdf"<br>  <br>  noError2 :: String -> [SomeExistential] -> String<br>  noError2 n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c :: SumType -> String<br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> "asdf" ++ n<br>  <br>  noError3 :: String -> [SomeExistential] -> String<br>  noError3 n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d :: SomeClass a => a -> String<br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> "asdf" ++ n<br>  <br>  <br>  partialTypedError :: String -> [SomeExistential] -> String<br>  partialTypedError n st = n ++ concatMap cname st<br>    where cname :: SomeExistential -> String<br>          cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> "asdf" ++ n<br>  <br>  fullError :: String -> [SomeExistential] -> String<br>  fullError n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> "asdf" ++ n<br>  <br>  justNError :: String -> [SomeExistential] -> String<br>  justNError n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> n<br>  <br>  ignoreNError :: String -> [SomeExistential] -> String<br>  ignoreNError n st = n ++ concatMap cname st<br>    where cname (SomeExistential p) = d p<br>  <br>          d p = c $ someType p<br>  <br>          c p = case p of<br>                    SumFoo -> "foo"<br>                    _ -> fst ("foo", n)<br><br></div>
</div><br></div>