System: Redhat 5.1 with all updates, Linux 2.1.125, glibc 2.0.7,
        Dual Pentium II 300Mhz, egcs 1.1b compiler with PGCC patches.
GHC: GHC-4.00 binary distribution installed in /opt/ghc-4.00.

Trying to compile the following Haskell program

----------------------------------
module Main where

data Foo = forall a. MkFoo a (a -> Bool)

foo_list = [MkFoo 7 even, MkFoo True id]

f :: Foo -> Bool
f (MkFoo e p) = p e

main :: IO ()
main = putStrLn (show (map f foo_list))
----------------------------------

resulted in the following compiler output using the command
`ghc -fglasgow-exts -c Main.hs':

-------------------------------------
panic! (the `impossible' happened):
 applyTypeToArgs Main.MkFoo{-r1l,x-} {B1 PrelBase.True{-6y,w-}}

Please report it as a compiler bug to
[EMAIL PROTECTED]
-------------------------------------

A minor modification for this program:

------------------------------------
module Main where

data Foo = forall a. MkFoo a (a -> Bool)

foo1 = MkFoo 7 even

main = putStrLn "foo"
------------------------------------

resulted in this compiler error (same command as before):

------------------------------------
panic! (the `impossible' happened):
 lookupBindC:no info!
 for: B1
        (probably: data dependencies broken by an optimisation pass)
        static binds for:
        local binds for:
        cZx

Please report it as a compiler bug to
[EMAIL PROTECTED]
------------------------------------


Erik


Reply via email to