[project @ 2004-12-23 09:07:30 by simonpj]

---------------------------------
          Template Haskell: names again
  	---------------------------------

On 2 Dec 04 I made this commit (1.58 in Convert.lhs)

    Fix a Template Haskell bug that meant that top-level names created
    with newName were not made properly unique.

But that just introduced a new bug!  THe trouble is that names created by
newName are NameUs; but I was *also* using NameU for names of free varaibles,
such as the 'x' in the quoted code here
	f x = $( g [| \y -> (x,y) |])

But when converting to HsSyn, the x and y must be treated diffferently.
The 'x' must convert to an Exact RdrName, so that it binds to the 'x' that's
in the type environment; but the 'y' must generate a nice unique RdrName.

So this commit adds NameL for the lexically-scoped bindings like 'x'.

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 34eb1ae..150b90e 100644 (file)
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -911,7 +911,7 @@ globalVar name
   | otherwise
   = do         { MkC occ <- occNameLit name
        ; MkC uni <- coreIntLit (getKey (getUnique name))
-       ; rep2 mkNameUName [occ,uni] }
+       ; rep2 mkNameLName [occ,uni] }
   where
       name_mod = moduleUserString (nameModule name)
       name_occ = nameOccName name
@@ -1326,7 +1326,7 @@ templateHaskellNames :: [Name]
 
 templateHaskellNames = [
     returnQName, bindQName, sequenceQName, newNameName, liftName,
-    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameUName, 
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName, 
 
     -- Lit
     charLName, stringLName, integerLName, intPrimLName,
@@ -1422,7 +1422,7 @@ mkNameName     = thFun FSLIT("mkName")     mkNameIdKey
 mkNameG_vName  = thFun FSLIT("mkNameG_v")  mkNameG_vIdKey
 mkNameG_dName  = thFun FSLIT("mkNameG_d")  mkNameG_dIdKey
 mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
-mkNameUName    = thFun FSLIT("mkNameU")    mkNameUIdKey
+mkNameLName    = thFun FSLIT("mkNameL")    mkNameLIdKey
 
 
 -------------------- TH.Lib -----------------------
@@ -1604,7 +1604,7 @@ mkNameIdKey          = mkPreludeMiscIdUnique 205
 mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
 mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
 mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
-mkNameUIdKey         = mkPreludeMiscIdUnique 209
+mkNameLIdKey         = mkPreludeMiscIdUnique 209
 
 
 -- data Lit = ...

diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index 08d0cc6..3839c7b 100644 (file)
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/ghc/compiler/hsSyn/Convert.lhs
@@ -15,7 +15,8 @@ import Language.Haskell.TH.Syntax as TH
 
 import HsSyn as Hs
 import qualified Class (FunDep)
-import RdrName ( RdrName, mkRdrUnqual, mkRdrQual, mkOrig, getRdrName )
+import RdrName ( RdrName, mkRdrUnqual, mkRdrQual, mkOrig, getRdrName, nameRdrName )
+import Name    ( mkInternalName )
 import Module   ( Module, mkModule )
 import RdrHsSyn        ( mkClassDecl, mkTyData )
 import qualified OccName
@@ -28,9 +29,10 @@ import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..),
                      CExportSpec(..)) 
 import Char    ( isAscii, isAlphaNum, isAlpha )
 import List    ( partition )
-import Unique  ( mkUniqueGrimily )
+import Unique  ( Unique, mkUniqueGrimily )
 import ErrUtils (Message)
-import GLAEXTS ( Int(..) )
+import GLAEXTS ( Int(..), Int# )
+import SrcLoc  ( noSrcLoc )
 import Bag     ( emptyBag, consBag )
 import FastString
 import Outputable
@@ -406,10 +408,11 @@ thRdrName :: OccName.NameSpace -> TH.Name -> RdrName
 thRdrName ns (TH.Name occ TH.NameS)           = mkRdrUnqual (mk_occ ns occ)
 thRdrName ns (TH.Name occ (TH.NameQ mod))     = mkRdrQual (mk_mod mod) (mk_occ ns occ)
 thRdrName ns (TH.Name occ (TH.NameG ns' mod)) = mkOrig    (mk_mod mod) (mk_occ ns occ)
+thRdrName ns (TH.Name occ (TH.NameL uniq))    = nameRdrName (mkInternalName (mk_uniq uniq) (mk_occ ns occ) noSrcLoc)
 thRdrName ns (TH.Name occ (TH.NameU uniq))    
   = mkRdrUnqual (OccName.mkOccName ns uniq_str)
   where
-    uniq_str = TH.occString occ ++ '[' : shows (mkUniqueGrimily (I# uniq)) "]"
+    uniq_str = TH.occString occ ++ '[' : shows (mk_uniq uniq) "]"
        -- The idea here is to make a name that 
        -- a) the user could not possibly write, and
        -- b) cannot clash with another NameU
@@ -425,5 +428,8 @@ mk_occ ns occ = OccName.mkOccFS ns (mkFastString (TH.occString occ))
 
 mk_mod :: TH.ModName -> Module
 mk_mod mod = mkModule (TH.modString mod)
+
+mk_uniq :: Int# -> Unique
+mk_uniq u = mkUniqueGrimily (I# u)
 \end{code}
 

diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index dcd4195..982ac91 100644 (file)
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -656,6 +656,10 @@ reifyName :: NamedThing n => n -> TH.Name
 reifyName thing
   | isExternalName name = mk_varg mod occ_str
   | otherwise          = TH.mkNameU occ_str (getKey (getUnique name))
+       -- Many of the things we reify have local bindings, and 
+       -- NameL's aren't supposed to appear in binding positions, so
+       -- we use NameU.  When/if we start to reify nested things, that
+       -- have free variables, we may need to generate NameL's for them.
   where
     name    = getName thing
     mod     = moduleUserString (nameModule name)