[Haskell-cafe] Skolems!

amindfv at gmail.com amindfv at gmail.com
Sat Feb 28 17:02:02 UTC 2015


The weirdest part of this to me is the very last line --

This typechecks:

  _ -> "bar" :: String

But this complains about a (rigid, skolem) type (and "n" really is just a string):

  _ -> fst ("bar" :: String, n :: String)

Tom


El Feb 27, 2015, a las 13:23, "evan at evan-borden.com" <evan at evanrutledgeborden.dreamhosters.com> escribió:

> 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.
> 
>  {-# 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)
> 
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe


More information about the Haskell-Cafe mailing list