Commit e12e0bb7 authored by simonpj's avatar simonpj
Browse files

[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'.
parent 20e39e0e
......@@ -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 = ...
......
......@@ -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}
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment