#4003: tcIfaceGlobal panic building HEAD with 6.12.2
---------------------------------+------------------------------------------
    Reporter:  simonmar          |        Owner:                    
        Type:  bug               |       Status:  new               
    Priority:  highest           |    Milestone:  6.12.3            
   Component:  Compiler          |      Version:  6.12.2            
    Keywords:                    |   Difficulty:                    
          Os:  Unknown/Multiple  |     Testcase:                    
Architecture:  Unknown/Multiple  |      Failure:  Compile-time crash
       Patch:  0                 |  
---------------------------------+------------------------------------------

Comment(by igloo):

 Testcase:

 `HsExpr.hs-boot`:
 {{{
 module HsExpr where

 import Data.Data

 data HsExpr i

 instance Data i => Data (HsExpr i)
 }}}

 `HsLit.hs`:
 {{{
 {-# LANGUAGE DeriveDataTypeable #-}

 module HsLit where

 import {-# SOURCE #-} HsExpr( HsExpr )

 import Data.Data

 data HsLit = HsChar
   deriving (Data, Typeable)

 data HsOverLit id
   = OverLit (HsExpr id)
   deriving (Data, Typeable)

 data OverLitVal = HsIntegral
   deriving (Data, Typeable)
 }}}

 `HsExpr.hs`:
 {{{
 {-# LANGUAGE DeriveDataTypeable #-}

 module HsExpr where

 import HsLit

 import Data.Data

 data MyId = MyId
     deriving (Data, Typeable)

 data HsExpr id
   = HsOverLit (HsOverLit id)
   | HsBracketOut (HsExpr MyId)
   deriving (Data, Typeable)
 }}}

 {{{
 $ ghc -O -c HsExpr.hs-boot
 $ ghc -O -c HsLit.hs
 $ ghc -O -c HsExpr.hs
 ghc: panic! (the 'impossible' happened)
   (GHC version 6.12.2 for x86_64-unknown-linux):
         tcIfaceGlobal (local): not found:
     main:HsExpr.$fxDataHsExpr{v r3C}
     [(ayP, Identifier `typeOf1{v ayP}'),
      (ayV, Identifier `typeOf{v ayV}'),
      (azj, Identifier `gfoldl{v azj}'), (azo, Identifier `ic{v azo}'),
      (azK, Identifier `gunfold{v azK}'), (azP, Identifier `ic{v azP}'),
      (azT, Identifier `toConstr{v azT}'),
      (azZ, Identifier `dataTypeOf{v azZ}'),
      (aAS, Identifier `dataCast1{v aAS}'),
      (aCH, Identifier `gfoldl{v aCH}'),
      (aCM, Identifier `gunfold{v aCM}'),
      (aCQ, Identifier `toConstr{v aCQ}'),
      (aCU, Identifier `dataTypeOf{v aCU}'),
      (r3D, Type constructor `main:HsExpr.HsExpr{tc r3D}'),
      (rsH, Data constructor `main:HsExpr.HsBracketOut{d rsH}'),
      (rsJ, Data constructor `main:HsExpr.HsOverLit{d rsJ}'),
      (rsL, Type constructor `main:HsExpr.MyId{tc rsL}'),
      (rsN, Data constructor `main:HsExpr.MyId{d rsN}'),
      (rsX, Identifier `main:HsExpr.HsOverLit{v rsX}'),
      (rt0, Identifier `main:HsExpr.HsBracketOut{v rt0}'),
      (rt3, Identifier `main:HsExpr.MyId{v rt3}'),
      (rwZ, Identifier `main:HsExpr.$fDataHsExpr{v rwZ}'),
      (rx3, Identifier `main:HsExpr.$fTypeable1HsExpr{v rx3}'),
      (rx6, Identifier `main:HsExpr.$fTypeableMyId{v rx6}'),
      (rx7, Identifier `main:HsExpr.$fDataMyId{v rx7}'),
      (rxB, Identifier `main:HsExpr.$cMyId{v rxB}'),
      (rxD, Identifier `main:HsExpr.$tMyId{v rxD}'),
      (rxF, Identifier `main:HsExpr.$cHsBracketOut{v rxF}'),
      (rxH, Identifier `main:HsExpr.$cHsOverLit{v rxH}'),
      (rxJ, Identifier `main:HsExpr.$tHsExpr{v rxJ}')]

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

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/4003#comment:1>
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