<div dir="ltr">Thanks Richard, will do.<br></div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Mar 2, 2015 at 1:12 PM, Richard Eisenberg <span dir="ltr"><<a href="mailto:eir@cis.upenn.edu" target="_blank">eir@cis.upenn.edu</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">This is admittedly a dark corner of the inference algorithm, but perhaps these examples can shed some light. Post a bug report!<br>
<br>
Thanks for creating nice, small examples.<br>
<span class="HOEnZb"><font color="#888888"><br>
Richard<br>
</font></span><br>
PS: I offer no strong guarantees that you've found bugs here... but in any case, posting a bug report gets more serious attention than a Haskell-cafe post.<br>
<div class="HOEnZb"><div class="h5"><br>
On Feb 27, 2015, at 1:23 PM, "<a href="mailto:evan@evan-borden.com">evan@evan-borden.com</a>" <<a href="mailto:evan@evanrutledgeborden.dreamhosters.com">evan@evanrutledgeborden.dreamhosters.com</a>> wrote:<br>
<br>
> 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>
><br>
</div></div><div class="HOEnZb"><div class="h5">> _______________________________________________<br>
> Haskell-Cafe mailing list<br>
> <a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
<br>
</div></div></blockquote></div><br></div>