Hi again, I've got another bug (and I'm sure this time -- ghc tells me
so).  Of course, this is with 5.04 (on linux, this time):

module Foralls
    where

data Foo a b = Foo { foo :: a -> b }

bar1 :: String -> (forall a . Foo a) -> IO ()
bar1 s _ = putStrLn s

{- bug:
*Foralls> :t bar

Couldn't match `* -> *' against `?'
When matching types `Foo a' and `t'
    Expected type: String -> t -> t1
    Inferred type: String -> (forall a1. Foo a1) -> IO ()

probably shouldn't be accepted at all
-}

bar2 :: String -> (forall a b . Foo a) -> IO ()
bar2 s (Foo { foo = foo }) = putStrLn s

{- bug:
Compiling Foralls          ( /home/hdaume/projects/Bugs/Foralls.hs, interpreted )
ghc-5.04: panic! (the `impossible' happened, GHC version 5.04):
        tcSplitTyConApp
    forall a{-r1ll-} :: *. Foralls.Foo{-r1kQ-} a{-r1ll-} b{-a1oY-}

Please report it as a compiler bug to [EMAIL PROTECTED],
or http://sourceforge.net/projects/ghc/.

this even happens in the case when bar2 is given the type:

bar2 :: String -> (forall a b . Foo a b) -> IO ()
-}

--
Hal Daume III

 "Computer science is no more about computers    | [EMAIL PROTECTED]
  than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume


_______________________________________________
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to