#3421: Iface Lint failure panic with HEAD ghc-stage1
---------------------------+------------------------------------------------
Reporter:  Ashley Yakeley  |          Owner:                
    Type:  bug             |         Status:  new           
Priority:  normal          |      Component:  Compiler      
 Version:  6.11            |       Severity:  normal        
Keywords:                  |       Testcase:                
      Os:  Linux           |   Architecture:  x86_64 (amd64)
---------------------------+------------------------------------------------
 A.hs:
 {{{
 module A where

 class C1 a where
     c1 :: p a -> Maybe a

 class C2 a where
     c2 :: a

 instance (C1 a) => C2 (Maybe a) where
     c2 = c1 undefined
 }}}

 B.hs:
 {{{
 module B where
 import A

 c2' :: (C1 a) => Maybe a
 c2' = c2
 }}}
 Compiling them with "ghc-stage1 -dcore-lint -O2" gives this:
 {{{
 inplace/bin/ghc-stage1 -c A.hs -dcore-lint -O2 && inplace/bin/ghc-stage1
 -c B.hs -dcore-lint -O2
 ghc-stage1: panic! (the 'impossible' happened)
   (GHC version 6.11.20090806 for x86_64-unknown-linux):
         Iface Lint failure
     Unfolding of main:A.$fC2Maybe_c2{v r33}
       <no location info>:
           In the expression: ($dC1{v aed} [lid]
                               `cast` (main:A.NTCo:T:C1{tc r31} a{tv aec}
 [tv]
                                       :: <pred>main:A.T:C1{tc r36} a{tv
 aec} [tv]
                                                  ~
                                                forall (p{tv ael} [tv] ::
 ghc-prim:GHC.Prim.*{(w) tc 34d}
 -> ghc-prim:GHC.Prim.*{(w) tc 34d}).
                                                p{tv ael} [tv] a{tv aec}
 [tv]
                                                -> base:Data.Maybe.Maybe{tc
 rm} a{tv aec} [tv]))
                                @ ghc-prim:GHC.Prim.Any{(w) tc 31N}
           Kinds don't match in type application:
           Type variable:
               p{tv ael} [tv] :: ghc-prim:GHC.Prim.*{(w) tc 34d}
                                 -> ghc-prim:GHC.Prim.*{(w) tc 34d}
           Arg type:
               ghc-prim:GHC.Prim.Any{(w) tc 31N} :: ghc-prim:GHC.Prim.*{(w)
 tc 34d}

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3421>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to