#5375: Regression in newName
---------------------------------+------------------------------------------
    Reporter:  reinerp           |       Owner:                           
        Type:  bug               |      Status:  new                      
    Priority:  normal            |   Component:  Template Haskell         
     Version:  7.3               |    Keywords:                           
    Testcase:                    |   Blockedby:                           
          Os:  Unknown/Multiple  |    Blocking:                           
Architecture:  Unknown/Multiple  |     Failure:  GHC rejects valid program
---------------------------------+------------------------------------------
 Template Haskell's {{{newName}}} no longer works properly, with GHC HEAD.
 Consider:

 {{{
 {-# LANGUAGE TemplateHaskell #-}

 module B where

 import Language.Haskell.TH

 data D = D

 -- declare 'data E = D' with a fresh name 'D'
 $(do
     nm <- newName "D"
     return $ [DataD [] (mkName "E") [] [NormalC nm []] []]
  )
 }}}

 With {{{ghc-7.0.3}}}, this compiles without error, as it should. However,
 with {{{ghc-7.3.20110803}}}, we get:

 {{{
 B.hs:8:3:
     Multiple declarations of `D'
     Declared at: B.hs:7:10
                  B.hs:8:3
 }}}

 which is wrong.

 The following might also be related. Given:

 {{{
 {-# LANGUAGE TemplateHaskell #-}

 module C where

 import Language.Haskell.TH

 g = $(do
         nm <- newName "f"
         return $ VarE nm
      )
 }}}

 with {{{ghc-7.0.3}}} we get the correct error message

 {{{
 C.hs:7:7:
     Not in scope: `f[aK5]'
     In the result of the splice:
       $(do { nm <- newName "f";
                return $ VarE nm })
     To see what the splice expanded to, use -ddump-splices
     In the expression:
       $(do { nm <- newName "f";
                return $ VarE nm })
     In an equation for `g':
         g = $(do { nm <- newName "f";
                      return $ VarE nm })
 }}}

 but with {{{ghc-7.3.20110803}}} we get a GHC internal error message:

 {{{
 C.hs:7:7:
     GHC internal error: `f_aOw' is not in scope during type checking, but
 it passed the renamer
     tcg_type_env of environment: []
     tcl_env of environment: [(rgQ, Identifier[g::t_a, 1])]
     In the expression: f_aOw
     In the result of the splice:
       $(do { nm <- newName "f";
              return $ VarE nm })
     To see what the splice expanded to, use -ddump-splices
     In the expression:
       $(do { nm <- newName "f";
              return $ VarE nm })
 }}}

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