-tconName = mkName tcName
-
-mkName :: NameSpace -> String -> RdrName
--- Parse the string to see if it has a "." or ":" in it
--- so we know whether to generate a qualified or original name
--- It's a bit tricky because we need to parse
--- Foo.Baz.x as Qual Foo.Baz x
--- So we parse it from back to front
-
-mkName ns str
- = split [] (reverse str)
- where
- split occ [] = mkRdrUnqual (mk_occ occ)
- split occ (c:d:rev) -- 'd' is the last char before the separator
- | is_sep c -- E.g. Fo.x d='o'
- && isAlphaNum d -- Fo.+: d='+' perhaps
- = mk_qual (reverse (d:rev)) c occ
- split occ (c:rev) = split (c:occ) rev
-
- mk_qual mod '.' occ = mkRdrQual (mk_mod mod) (mk_occ occ)
- mk_qual mod ':' occ = mkOrig (mk_mod mod) (mk_occ occ)
-
- mk_occ occ = mkOccFS ns (mkFastString occ)
- mk_mod mod = mkModuleName mod
-
- is_sep '.' = True
- is_sep ':' = True
- is_sep other = False
+tconName = thRdrName OccName.tcName
+
+thRdrName :: OccName.NameSpace -> TH.Name -> RdrName
+-- This turns a Name into a RdrName
+-- The passed-in name space tells what the context is expecting;
+-- use it unless the TH name knows what name-space it comes
+-- from, in which case use the latter
+thRdrName ctxt_ns (TH.Name occ (TH.NameG th_ns mod)) = mkOrig (mk_mod mod) (mk_occ (mk_ghc_ns th_ns) occ)
+thRdrName ctxt_ns (TH.Name occ (TH.NameL uniq)) = nameRdrName (mkInternalName (mk_uniq uniq) (mk_occ ctxt_ns occ) noSrcLoc)
+thRdrName ctxt_ns (TH.Name occ (TH.NameQ mod)) = mkRdrQual (mk_mod mod) (mk_occ ctxt_ns occ)
+thRdrName ctxt_ns (TH.Name occ TH.NameS) = mkRdrUnqual (mk_occ ctxt_ns occ)
+thRdrName ctxt_ns (TH.Name occ (TH.NameU uniq)) = mkRdrUnqual (mk_uniq_occ ctxt_ns occ uniq)
+
+mk_uniq_occ :: OccName.NameSpace -> TH.OccName -> Int# -> OccName.OccName
+mk_uniq_occ ns occ uniq
+ = OccName.mkOccName ns (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
+ -- Previously I generated an Exact RdrName with mkInternalName.
+ -- This works fine for local binders, but does not work at all for
+ -- top-level binders, which must have External Names, since they are
+ -- rapidly baked into data constructors and the like. Baling out
+ -- and generating an unqualified RdrName here is the simple solution
+
+mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
+mk_ghc_ns DataName = OccName.dataName
+mk_ghc_ns TH.TcClsName = OccName.tcClsName
+mk_ghc_ns TH.VarName = OccName.varName
+
+-- The packing and unpacking is rather turgid :-(
+mk_occ :: OccName.NameSpace -> TH.OccName -> OccName.OccName
+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)