-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)
+thRdrName ctxt_ns occ (TH.NameG th_ns mod) = (mkOrig $! (mk_mod mod)) $! (mk_occ (mk_ghc_ns th_ns) occ)
+thRdrName ctxt_ns occ (TH.NameL uniq) = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcLoc)
+thRdrName ctxt_ns occ (TH.NameQ mod) = (mkRdrQual $! (mk_mod mod)) $! (mk_occ ctxt_ns occ)
+thRdrName ctxt_ns occ (TH.NameU uniq) = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq)
+thRdrName ctxt_ns occ TH.NameS
+ | Just name <- isBuiltInOcc ctxt_ns occ = nameRdrName $! name
+ | otherwise = mkRdrUnqual $! (mk_occ ctxt_ns occ)
+
+isBuiltInOcc :: OccName.NameSpace -> String -> Maybe Name.Name
+-- Built in syntax isn't "in scope" so an Unqual RdrName won't do
+-- We must generate an Exact name, just as the parser does
+isBuiltInOcc ctxt_ns occ
+ = case occ of
+ ":" -> Just (Name.getName consDataCon)
+ "[]" -> Just (Name.getName nilDataCon)
+ "()" -> Just (tup_name 0)
+ '(' : ',' : rest -> go_tuple 2 rest
+ other -> Nothing
+ where
+ go_tuple n ")" = Just (tup_name n)
+ go_tuple n (',' : rest) = go_tuple (n+1) rest
+ go_tuple n other = Nothing