[Haskell-cafe] Skolems!

Jan Stolarek jan.stolarek at p.lodz.pl
Mon Mar 2 19:02:26 UTC 2015


> A quick clarification. It s trac still the location to submit bugs or is
> Phabricator more appropriate?
Trac is still the place to submit bugs. Once a bug-fix is ready we use Phabricator to code-review 
the patch.

Janek

>
> On Mon, Mar 2, 2015 at 1:49 PM, evan at evan-borden.com <
>
> evan at evanrutledgeborden.dreamhosters.com> wrote:
> > Thanks Richard, will do.
> >
> > On Mon, Mar 2, 2015 at 1:12 PM, Richard Eisenberg <eir at cis.upenn.edu>
> >
> > wrote:
> >> This is admittedly a dark corner of the inference algorithm, but perhaps
> >> these examples can shed some light. Post a bug report!
> >>
> >> Thanks for creating nice, small examples.
> >>
> >> Richard
> >>
> >> 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.
> >>
> >> On Feb 27, 2015, at 1:23 PM, "evan at evan-borden.com" <
> >>
> >> evan at evanrutledgeborden.dreamhosters.com> wrote:
> >> > 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



---
Politechnika Łódzka
Lodz University of Technology

Treść tej wiadomości zawiera informacje przeznaczone tylko dla adresata.
Jeżeli nie jesteście Państwo jej adresatem, bądź otrzymaliście ją przez pomyłkę
prosimy o powiadomienie o tym nadawcy oraz trwałe jej usunięcie.

This email contains information intended solely for the use of the individual to whom it is addressed.
If you are not the intended recipient or if you have received this message in error,
please notify the sender and delete it from your system.


More information about the Haskell-Cafe mailing list