Add HsEmbellished type to hsSynwip/embelleshed-rdr

Summary:
A RdrName can be parsed with parens or backquotes if it is used prefix or infix
respectively when it is normally not used that way.

This is not captured in hsSyn, and must be inferred from the occName when pretty
printing, or using the API annotations.

Introduce a wrapper type around the name to capture this

    data Embellished name
      = EName       name
      | EParens     (Located name)
      | EBackquotes (Located name)

So that we now have

    data HsExpr id
      = HsVar     (LEmbellished id)   -- ^ Variable

and in the other relevant points in hsSyn.

Test Plan: ./validate

Reviewers: bgamari, austin, goldfire

Subscribers: goldfire, thomie, mpickering, snowleopard

Differential Revision: https://phabricator.haskell.org/D3145

8 files changed, 168 insertions, 131 deletions

diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index f6a22f5df2..05a7080425 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -409,14 +409,15 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
 rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname })
   | isTopRecNameMaker name_maker
   = do { addLocM checkConName rdrname
-       ; name <- lookupLocatedTopBndrRn rdrname   -- Should be in scope already
-       ; return (PatSynBind psb{ psb_id = name }) }
+       ; L _ name <- lookupLocatedTopBndrRn $ unLEmb rdrname
+                    -- Should be in scope already
+       ; return (PatSynBind psb{ psb_id = reLEmb rdrname name }) }
 
   | otherwise  -- Pattern synonym, not at top level
   = do { addErr localPatternSynonymErr  -- Complain, but make up a fake
                                         -- name so that we can carry on
-       ; name <- applyNameMaker name_maker rdrname
-       ; return (PatSynBind psb{ psb_id = name }) }
+       ; L _ name <- applyNameMaker name_maker $ unLEmb rdrname
+       ; return (PatSynBind psb{ psb_id = reLEmb rdrname name }) }
   where
     localPatternSynonymErr :: SDoc
     localPatternSynonymErr
@@ -565,11 +566,11 @@ mkSigTvFn sigs = \n -> lookupNameEnv env n `orElse` []
     get_scoped_tvs :: LSig Name -> Maybe ([Located Name], [Name])
     -- Returns (binders, scoped tvs for those binders)
     get_scoped_tvs (L _ (ClassOpSig _ names sig_ty))
-      = Just (names, hsScopedTvs sig_ty)
+      = Just (map unLEmb names, hsScopedTvs sig_ty)
     get_scoped_tvs (L _ (TypeSig names sig_ty))
-      = Just (names, hsWcScopedTvs sig_ty)
+      = Just (map unLEmb names, hsWcScopedTvs sig_ty)
     get_scoped_tvs (L _ (PatSynSig names sig_ty))
-      = Just (names, hsScopedTvs sig_ty)
+      = Just (map unLEmb names, hsScopedTvs sig_ty)
     get_scoped_tvs _ = Nothing
 
 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
@@ -587,19 +588,19 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
      foldlM add_one env [ (loc,name_loc,name,fixity)
                         | L name_loc name <- names ]
 
-   add_one env (loc, name_loc, name,fixity) = do
+   add_one env (loc, name_loc, name, fixity) = do
      { -- this fixity decl is a duplicate iff
        -- the ReaderName's OccName's FastString is already in the env
        -- (we only need to check the local fix_env because
        --  definitions of non-local will be caught elsewhere)
-       let { fs = occNameFS (rdrNameOcc name)
+       let { fs = occNameFS (rdrNameOcc $ unEmb name)
            ; fix_item = L loc fixity };
 
        case lookupFsEnv env fs of
          Nothing -> return $ extendFsEnv env fs fix_item
          Just (L loc' _) -> do
            { setSrcSpan loc $
-             addErrAt name_loc (dupFixityDecl loc' name)
+             addErrAt name_loc (dupFixityDecl loc' (unEmb name))
            ; return env}
      }
 
@@ -625,7 +626,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
        -- invariant: no free vars here when it's a FunBind
   = do  { pattern_synonym_ok <- xoptM LangExt.PatternSynonyms
         ; unless pattern_synonym_ok (addErr patternSynonymErr)
-        ; let sig_tvs = sig_fn name
+        ; let sig_tvs = sig_fn $ unEmb name
 
         ; ((pat', details'), fvs1) <- bindSigTyVarsFV sig_tvs $
                                       rnPat PatSyn pat $ \pat' ->
@@ -662,10 +663,10 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
             Unidirectional -> return (Unidirectional, emptyFVs)
             ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
             ExplicitBidirectional mg ->
-                do { (mg', fvs) <- bindSigTyVarsFV sig_tvs $
-                                   rnMatchGroup (FunRhs (L l name) Prefix)
-                                                rnLExpr mg
-                   ; return (ExplicitBidirectional mg', fvs) }
+              do { (mg', fvs) <- bindSigTyVarsFV sig_tvs $
+                                 rnMatchGroup (FunRhs (L l $ unEmb name) Prefix)
+                                              rnLExpr mg
+                 ; return (ExplicitBidirectional mg', fvs) }
 
         ; mod <- getModule
         ; let fvs = fvs1 `plusFV` fvs2
@@ -684,7 +685,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
                                  _ -> []
 
         ; fvs' `seq` -- See Note [Free-variable space leak]
-          return (bind', name : selector_names , fvs1)
+          return (bind', unEmb name : selector_names , fvs1)
           -- Why fvs1?  See Note [Pattern synonym builders don't yield dependencies]
       }
   where
@@ -888,7 +889,7 @@ renameSig _ (IdSig x)
   = return (IdSig x, emptyFVs)    -- Actually this never occurs
 
 renameSig ctxt sig@(TypeSig vs ty)
-  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+  = do  { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
         ; let doc = TypeSigCtx (ppr_sig_bndrs vs)
         ; (new_ty, fvs) <- rnHsSigWcType doc ty
         ; return (TypeSig new_vs new_ty, fvs) }
@@ -897,7 +898,7 @@ renameSig ctxt sig@(ClassOpSig is_deflt vs ty)
   = do  { defaultSigs_on <- xoptM LangExt.DefaultSignatures
         ; when (is_deflt && not defaultSigs_on) $
           addErr (defaultSigErr sig)
-        ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
+        ; new_v <- mapM (lookupLESigOccRn ctxt sig) vs
         ; (new_ty, fvs) <- rnHsSigType ty_ctxt ty
         ; return (ClassOpSig is_deflt new_v new_ty, fvs) }
   where
@@ -915,8 +916,8 @@ renameSig _ (SpecInstSig src ty)
 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
 renameSig ctxt sig@(SpecSig v tys inl)
   = do  { new_v <- case ctxt of
-                     TopSigCtxt {} -> lookupLocatedOccRn v
-                     _             -> lookupSigOccRn ctxt sig v
+                     TopSigCtxt {} -> lookupLEmbellishedOccRn v
+                     _             -> lookupLESigOccRn ctxt sig v
         ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
         ; return (SpecSig new_v new_ty inl, fvs) }
   where
@@ -927,19 +928,19 @@ renameSig ctxt sig@(SpecSig v tys inl)
            ; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
 
 renameSig ctxt sig@(InlineSig v s)
-  = do  { new_v <- lookupSigOccRn ctxt sig v
+  = do  { new_v <- lookupLESigOccRn ctxt sig v
         ; return (InlineSig new_v s, emptyFVs) }
 
 renameSig ctxt sig@(FixSig (FixitySig vs f))
-  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+  = do  { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
         ; return (FixSig (FixitySig new_vs f), emptyFVs) }
 
 renameSig ctxt sig@(MinimalSig s (L l bf))
-  = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
+  = do new_bf <- traverse (lookupLESigOccRn ctxt sig) bf
        return (MinimalSig s (L l new_bf), emptyFVs)
 
 renameSig ctxt sig@(PatSynSig vs ty)
-  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+  = do  { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
         ; (ty', fvs) <- rnHsSigType ty_ctxt ty
         ; return (PatSynSig new_vs ty', fvs) }
   where
@@ -947,17 +948,17 @@ renameSig ctxt sig@(PatSynSig vs ty)
                           <+> ppr_sig_bndrs vs)
 
 renameSig ctxt sig@(SCCFunSig st v s)
-  = do  { new_v <- lookupSigOccRn ctxt sig v
+  = do  { new_v <- lookupLESigOccRn ctxt sig v
         ; return (SCCFunSig st new_v s, emptyFVs) }
 
 -- COMPLETE Sigs can refer to imported IDs which is why we use
 -- lookupLocatedOccRn rather than lookupSigOccRn
 renameSig _ctxt (CompleteMatchSig s (L l bf) mty)
-  = do new_bf <- traverse lookupLocatedOccRn bf
-       new_mty  <- traverse lookupLocatedOccRn mty
+  = do new_bf  <- traverse lookupLEmbellishedOccRn bf
+       new_mty <- traverse lookupLEmbellishedOccRn mty
        return (CompleteMatchSig s (L l new_bf) new_mty, emptyFVs)
 
-ppr_sig_bndrs :: [Located RdrName] -> SDoc
+ppr_sig_bndrs :: [LEmbellished RdrName] -> SDoc
 ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
 
 okHsSig :: HsSigCtxt -> LSig a -> Bool
@@ -1014,12 +1015,12 @@ findDupSigs :: [LSig RdrName] -> [[(Located RdrName, Sig RdrName)]]
 findDupSigs sigs
   = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)
   where
-    expand_sig sig@(FixSig (FixitySig ns _)) = zip ns (repeat sig)
-    expand_sig sig@(InlineSig n _)           = [(n,sig)]
-    expand_sig sig@(TypeSig ns _)            = [(n,sig) | n <- ns]
-    expand_sig sig@(ClassOpSig _ ns _)       = [(n,sig) | n <- ns]
-    expand_sig sig@(PatSynSig ns  _ )        = [(n,sig) | n <- ns]
-    expand_sig sig@(SCCFunSig _ n _)         = [(n,sig)]
+    expand_sig sig@(FixSig (FixitySig ns _)) = zip (map unLEmb ns) (repeat sig)
+    expand_sig sig@(InlineSig n _)           = [(unLEmb n,sig)]
+    expand_sig sig@(TypeSig ns _)            = [(unLEmb n,sig) | n <- ns]
+    expand_sig sig@(ClassOpSig _ ns _)       = [(unLEmb n,sig) | n <- ns]
+    expand_sig sig@(PatSynSig ns  _ )        = [(unLEmb n,sig) | n <- ns]
+    expand_sig sig@(SCCFunSig _ n _)         = [(unLEmb n,sig)]
     expand_sig _ = []
 
     matching_sig (L _ n1,sig1) (L _ n2,sig2)       = n1 == n2 && mtch sig1 sig2
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 7c05994c0a..3ed1bf8137 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -9,7 +9,9 @@
 module RnEnv (
         newTopSrcBinder,
         lookupLocatedTopBndrRn, lookupTopBndrRn,
+        lookupLEmbellishedTopBndrRn,
         lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
+        lookupLEmbellishedOccRn,
         lookupLocalOccRn_maybe, lookupInfoOccRn,
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
@@ -19,6 +21,7 @@ module RnEnv (
         addNameClashErrRn,
 
         HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
+        lookupLESigOccRn,
         lookupSigCtxtOccRn,
 
         lookupFixityRn, lookupFixityRn_help,
@@ -249,6 +252,13 @@ lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
                          Nothing -> do traceRn "lookupTopBndrRn fail" (ppr n)
                                        unboundName WL_LocalTop n
 
+lookupLEmbellishedTopBndrRn :: LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLEmbellishedTopBndrRn = wrapLocM lookup
+  where
+    lookup en = do
+      n <- lookupTopBndrRn (unEmb en)
+      return (reEmb en n)
+
 lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
 lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
 
@@ -668,6 +678,13 @@ getLookupOccRn
 mkUnboundNameRdr :: RdrName -> Name
 mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
 
+lookupLEmbellishedOccRn :: LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLEmbellishedOccRn = wrapLocM lookup
+  where
+    lookup emb = do
+      n <- lookupOccRn (unEmb emb)
+      return (reEmb emb n)
+
 lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
 lookupLocatedOccRn = wrapLocM lookupOccRn
 
@@ -921,7 +938,7 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
                                ; let
                                    fld_occ :: FieldOcc Name
                                    fld_occ
-                                     = FieldOcc (noLoc rdr_name) (gre_name gre)
+                                     = FieldOcc (noEmb rdr_name) (gre_name gre)
                                ; return (Just (Right [fld_occ])) }
                       | otherwise
                          -> do { addUsedGRE True gre
@@ -931,7 +948,7 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
                             -- until we know which is meant
                          -> return
                              (Just (Right
-                                     (map (FieldOcc (noLoc rdr_name) . gre_name)
+                                     (map (FieldOcc (noEmb rdr_name) . gre_name)
                                            gres)))
                 gres     -> do { addNameClashErrRn rdr_name gres
                                ; return (Just (Left (gre_name (head gres)))) } }
@@ -1224,6 +1241,13 @@ instance Outputable HsSigCtxt where
     ppr (HsBootCtxt ns) = text "HsBootCtxt" <+> ppr ns
     ppr (RoleAnnotCtxt ns) = text "RoleAnnotCtxt" <+> ppr ns
 
+lookupLESigOccRn :: HsSigCtxt
+                 -> Sig RdrName
+                 -> LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLESigOccRn ctxt sig le = do
+  L _ n <- lookupSigOccRn ctxt sig (unLEmb le)
+  return (reLEmb le n )
+
 lookupSigOccRn :: HsSigCtxt
                -> Sig RdrName
                -> Located RdrName -> RnM (Located Name)
@@ -1496,8 +1520,8 @@ lookupTyFixityRn (L _ n) = lookupFixityRn n
 -- multiple possible selectors with different fixities, generate an error.
 lookupFieldFixityRn :: AmbiguousFieldOcc Name -> RnM Fixity
 lookupFieldFixityRn (Unambiguous (L _ rdr) n)
-  = lookupFixityRn' n (rdrNameOcc rdr)
-lookupFieldFixityRn (Ambiguous   (L _ rdr) _) = get_ambiguous_fixity rdr
+  = lookupFixityRn' n (rdrNameOcc $ unEmb rdr)
+lookupFieldFixityRn (Ambiguous   (L _ rdr) _) = get_ambiguous_fixity $ unEmb rdr
   where
     get_ambiguous_fixity :: RdrName -> RnM Fixity
     get_ambiguous_fixity rdr_name = do
@@ -1636,10 +1660,10 @@ lookupSyntaxNames :: [Name]                          -- Standard names
 lookupSyntaxNames std_names
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if not rebindable_on then
-             return (map (HsVar . noLoc) std_names, emptyFVs)
+             return (map (HsVar . noEmb) std_names, emptyFVs)
         else
           do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
-             ; return (map (HsVar . noLoc) usr_names, mkFVs usr_names) } }
+             ; return (map (HsVar . noEmb) usr_names, mkFVs usr_names) } }
 
 {-
 *********************************************************
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 4e9192c26e..ddbd76249c 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -78,14 +78,14 @@ rnLExpr = wrapLocFstM rnExpr
 
 rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
 
-finishHsVar :: Located Name -> RnM (HsExpr Name, FreeVars)
+finishHsVar :: LEmbellished Name -> RnM (HsExpr Name, FreeVars)
 -- Separated from rnExpr because it's also used
 -- when renaming infix expressions
 finishHsVar (L l name)
  = do { this_mod <- getModule
-      ; when (nameIsLocalOrFrom this_mod name) $
-        checkThLocalName name
-      ; return (HsVar (L l name), unitFV name) }
+      ; when (nameIsLocalOrFrom this_mod $ unEmb name) $
+        checkThLocalName $ unEmb name
+      ; return (HsVar (L l name), unitFV $ unEmb name) }
 
 rnUnboundVar :: RdrName -> RnM (HsExpr Name, FreeVars)
 rnUnboundVar v
@@ -101,20 +101,20 @@ rnUnboundVar v
 
         else -- Fail immediately (qualified name)
              do { n <- reportUnboundName v
-                ; return (HsVar (noLoc n), emptyFVs) } }
+                ; return (HsVar (noEmb n), emptyFVs) } }
 
 rnExpr (HsVar (L l v))
   = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields
-       ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v
+       ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields $ unEmb v
        ; case mb_name of {
-           Nothing -> rnUnboundVar v ;
+           Nothing -> rnUnboundVar $ unEmb v ;
            Just (Left name)
               | name == nilDataConName -- Treat [] as an ExplicitList, so that
                                        -- OverloadedLists works correctly
               -> rnExpr (ExplicitList placeHolderType Nothing [])
 
               | otherwise
-              -> finishHsVar (L l name) ;
+              -> finishHsVar (L l (reEmb v name)) ;
             Just (Right [f@(FieldOcc (L _ fn) s)]) ->
                       return (HsRecFld (ambiguousFieldOcc (FieldOcc (L l fn) s))
                              , unitFV (selectorFieldOcc f)) ;
@@ -170,7 +170,7 @@ rnExpr (OpApp e1 op  _ e2)
         -- more, so I've removed the test.  Adding HsPars in TcGenDeriv
         -- should prevent bad things happening.
         ; fixity <- case op' of
-              L _ (HsVar (L _ n)) -> lookupFixityRn n
+              L _ (HsVar (L _ n)) -> lookupFixityRn $ unEmb n
               L _ (HsRecFld f)    -> lookupFieldFixityRn f
               _ -> return (Fixity NoSourceText minPrecedence InfixL)
                    -- c.f. lookupFixity for unbound
@@ -289,7 +289,7 @@ rnExpr (RecordCon { rcon_con_name = con_id
                            , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
                 , fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
   where
-    mk_hs_var l n = HsVar (L l n)
+    mk_hs_var l n = HsVar (L l $ EName n)
     rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
                             ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
 
@@ -481,7 +481,7 @@ rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
        ; (arg1',fv_arg1) <- rnCmdTop arg1
        ; (arg2',fv_arg2) <- rnCmdTop arg2
         -- Deal with fixity
-       ; fixity <- lookupFixityRn op_name
+       ; fixity <- lookupFixityRn $ unEmb op_name
        ; final_e <- mkOpFormRn arg1' op' fixity arg2'
        ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
 
@@ -972,12 +972,12 @@ lookupStmtNamePoly ctxt name
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if rebindable_on
          then do { fm <- lookupOccRn (nameRdrName name)
-                 ; return (HsVar (noLoc fm), unitFV fm) }
+                 ; return (HsVar (noEmb fm), unitFV fm) }
          else not_rebindable }
   | otherwise
   = not_rebindable
   where
-    not_rebindable = return (HsVar (noLoc name), emptyFVs)
+    not_rebindable = return (HsVar (noEmb name), emptyFVs)
 
 -- | Is this a context where we respect RebindableSyntax?
 -- but ListComp/PArrComp are never rebindable
@@ -1820,7 +1820,7 @@ isReturnApp monad_names (L _ e) = case e of
  where
   is_var f (L _ (HsPar e)) = is_var f e
   is_var f (L _ (HsAppType e _)) = is_var f e
-  is_var f (L _ (HsVar (L _ r))) = f r
+  is_var f (L _ (HsVar (L _ r))) = f $ unEmb r
        -- TODO: I don't know how to get this right for rebindable syntax
   is_var _ _ = False
 
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index dc9cdd9063..15e6133393 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -577,7 +577,7 @@ getLocalNonValBinders fixity_env
           --    type sigs in case of a hs-boot file only
         ; is_boot <- tcIsHsBootOrSig
         ; let val_bndrs | is_boot   = hs_boot_sig_bndrs
-                        | otherwise = for_hs_bndrs
+                        | otherwise = map lEmb for_hs_bndrs
         ; val_avails <- mapM new_simple val_bndrs
 
         ; let avails    = concat nti_availss ++ val_avails
@@ -607,15 +607,16 @@ getLocalNonValBinders fixity_env
 
       -- the SrcSpan attached to the input should be the span of the
       -- declaration, not just the name
-    new_simple :: Located RdrName -> RnM AvailInfo
-    new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
+    new_simple :: LEmbellished RdrName -> RnM AvailInfo
+    new_simple rdr_name = do{ nm <- newTopSrcBinder $ unLEmb rdr_name
                             ; return (avail nm) }
 
     new_tc :: Bool -> LTyClDecl RdrName
            -> RnM (AvailInfo, [(Name, [FieldLabel])])
     new_tc overload_ok tc_decl -- NOT for type/data instances
         = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
-             ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs
+             ; names@(main_name : sub_names)
+                                     <- mapM (newTopSrcBinder . unLEmb) bndrs
              ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
              ; let fld_env = case unLoc tc_decl of
                      DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
@@ -631,12 +632,12 @@ getLocalNonValBinders fixity_env
       where
         find_con_flds (L _ (ConDeclH98 { con_name    = L _ rdr
                                        , con_details = RecCon cdflds }))
-            = [( find_con_name rdr
+            = [( find_con_name $ unEmb rdr
                , concatMap find_con_decl_flds (unLoc cdflds) )]
         find_con_flds (L _ (ConDeclGADT
                               { con_names = rdrs
                               , con_type = (HsIB { hsib_body = res_ty})}))
-            = map (\ (L _ rdr) -> ( find_con_name rdr
+            = map (\ (L _ rdr) -> ( find_con_name $ unEmb rdr
                                   , concatMap find_con_decl_flds cdflds))
                   rdrs
             where
@@ -657,7 +658,7 @@ getLocalNonValBinders fixity_env
         find_con_decl_fld  (L _ (FieldOcc (L _ rdr) _))
           = expectJust "getLocalNonValBinders/find_con_decl_fld" $
               find (\ fl -> flLabel fl == lbl) flds
-          where lbl = occNameFS (rdrNameOcc rdr)
+          where lbl = occNameFS (rdrNameOcc $ unEmb rdr)
 
     new_assoc :: Bool -> LInstDecl RdrName
               -> RnM ([AvailInfo], [(Name, [FieldLabel])])
@@ -683,7 +684,7 @@ getLocalNonValBinders fixity_env
     new_di overload_ok mb_cls ti_decl
         = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
              ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
-             ; sub_names <- mapM newTopSrcBinder bndrs
+             ; sub_names <- mapM (newTopSrcBinder . unLEmb) bndrs
              ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
              ; let avail    = AvailTC (unLoc main_name) sub_names flds'
                                   -- main_name is not bound here!
@@ -697,19 +698,19 @@ getLocalNonValBinders fixity_env
 newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
 newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
 newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _))
-  = do { selName <- newTopSrcBinder $ L loc $ field
+  = do { selName <- newTopSrcBinder $ L loc $ unEmb field
        ; return $ qualFieldLbl { flSelector = selName } }
   where
-    fieldOccName = occNameFS $ rdrNameOcc fld
+    fieldOccName = occNameFS $ rdrNameOcc $ unEmb fld
     qualFieldLbl = mkFieldLabelOccs fieldOccName (nameOccName dc) overload_ok
-    field | isExact fld = fld
+    field | isExact $ unEmb fld = fld
               -- use an Exact RdrName as is to preserve the bindings
               -- of an already renamer-resolved field and its use
               -- sites. This is needed to correctly support record
               -- selectors in Template Haskell. See Note [Binders in
               -- Template Haskell] in Convert.hs and Note [Looking up
               -- Exact RdrNames] in RnEnv.hs.
-          | otherwise   = mkRdrUnqual (flSelector qualFieldLbl)
+          | otherwise   = EName $ mkRdrUnqual (flSelector qualFieldLbl)
 
 {-
 Note [Looking up family names in family instances]
@@ -1618,8 +1619,9 @@ packageImportErr
 --      data T = :% Int Int
 -- from interface files, which always print in prefix form
 
-checkConName :: RdrName -> TcRn ()
-checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
+checkConName :: Embellished RdrName -> TcRn ()
+checkConName name
+  = checkErr (isRdrDataCon $ unEmb name) (badDataCon $ unEmb name)
 
 badDataCon :: RdrName -> SDoc
 badDataCon name
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 3417494e21..fcaf891995 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -426,9 +426,9 @@ rnPatAndThen mk (NPlusKPat rdr (L l lit) _ _ _ _)
                 -- The Report says that n+k patterns must be in Integral
 
 rnPatAndThen mk (AsPat rdr pat)
-  = do { new_name <- newPatLName mk rdr
+  = do { new_name <- newPatLName mk $ unLEmb rdr
        ; pat' <- rnLPatAndThen mk pat
-       ; return (AsPat new_name pat') }
+       ; return (AsPat (reLEmb rdr (unLoc new_name)) pat') }
 
 rnPatAndThen mk p@(ViewPat expr pat _ty)
   = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
@@ -589,13 +589,13 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                                               = L loc (FieldOcc (L ll lbl) _)
                                           , hsRecFieldArg = arg
                                           , hsRecPun      = pun }))
-      = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc lbl
+      = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc (unEmb lbl)
            ; arg' <- if pun
-                     then do { checkErr pun_ok (badPun (L loc lbl))
-                               -- Discard any module qualifier (#11662)
-                             ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
-                             ; return (L loc (mk_arg loc arg_rdr)) }
-                     else return arg
+                   then do { checkErr pun_ok (badPun (L loc $ unEmb lbl))
+                             -- Discard any module qualifier (#11662)
+                           ; let arg_rdr = mkRdrUnqual (rdrNameOcc $ unEmb lbl)
+                           ; return (L loc (mk_arg loc arg_rdr)) }
+                   else return arg
            ; return (L l (HsRecField { hsRecFieldLbl
                                          = L loc (FieldOcc (L ll lbl) sel)
                                      , hsRecFieldArg = arg'
@@ -640,7 +640,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
 
            ; addUsedGREs dot_dot_gres
            ; return [ L loc (HsRecField
-                        { hsRecFieldLbl = L loc (FieldOcc (L loc arg_rdr) sel)
+                        { hsRecFieldLbl
+                                 = L loc (FieldOcc (L loc $ EName arg_rdr) sel)
                         , hsRecFieldArg = L loc (mk_arg loc arg_rdr)
                         , hsRecPun      = False })
                     | fl <- dot_dot_fields
@@ -724,17 +725,20 @@ rnHsRecUpdFields flds
                       -- Defer renaming of overloaded fields to the typechecker
                       -- See Note [Disambiguating record fields] in TcExpr
                       if overload_ok
-                          then do { mb <- lookupGlobalOccRn_overloaded overload_ok lbl
+                          then do { mb <- lookupGlobalOccRn_overloaded
+                                                    overload_ok (unEmb lbl)
                                   ; case mb of
-                                      Nothing -> do { addErr (unknownSubordinateErr doc lbl)
-                                                    ; return (Right []) }
+                                      Nothing -> do
+                                        { addErr (unknownSubordinateErr doc
+                                                  (unEmb lbl))
+                                        ; return (Right []) }
                                       Just r  -> return r }
-                          else fmap Left $ lookupGlobalOccRn lbl
+                          else fmap Left $ lookupGlobalOccRn $ unEmb lbl
            ; arg' <- if pun
-                     then do { checkErr pun_ok (badPun (L loc lbl))
-                               -- Discard any module qualifier (#11662)
-                             ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
-                             ; return (L loc (HsVar (L loc arg_rdr))) }
+                 then do { checkErr pun_ok (badPun (L loc $ unEmb lbl))
+                           -- Discard any module qualifier (#11662)
+                         ; let arg_rdr = mkRdrUnqual (rdrNameOcc $ unEmb lbl)
+                         ; return (L loc (HsVar (L loc (reEmb lbl arg_rdr)))) }
                      else return arg
            ; (arg'', fvs) <- rnLExpr arg'
 
@@ -766,10 +770,11 @@ getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds
 
 getFieldLbls :: [LHsRecField id arg] -> [RdrName]
 getFieldLbls flds
-  = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+  = map (unLocEmb . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
 
 getFieldUpdLbls :: [LHsRecUpdField id] -> [RdrName]
-getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+getFieldUpdLbls flds
+  = map (unEmb . rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
 
 needFlagDotDot :: HsRecFieldContext -> SDoc
 needFlagDotDot ctxt = vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
@@ -832,7 +837,7 @@ rnOverLit origLit
         ; (SyntaxExpr { syn_expr = from_thing_name }, fvs)
             <- lookupSyntaxName std_name
         ; let rebindable = case from_thing_name of
-                                HsVar (L _ v) -> v /= std_name
+                                HsVar (L _ v) -> unEmb v /= std_name
                                 _             -> panic "rnOverLit"
         ; return (lit { ol_witness = from_thing_name
                       , ol_rebindable = rebindable
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 3e462744e1..5234308475 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -284,12 +284,12 @@ rnSrcFixityDecls bndr_set fix_decls
            return [ L loc (FixitySig name fixity)
                   | name <- names ]
 
-    lookup_one :: Located RdrName -> RnM [Located Name]
+    lookup_one :: LEmbellished RdrName -> RnM [LEmbellished Name]
     lookup_one (L name_loc rdr_name)
       = setSrcSpan name_loc $
                     -- this lookup will fail if the definition isn't local
-        do names <- lookupLocalTcNames sig_ctxt what rdr_name
-           return [ L name_loc name | (_, name) <- names ]
+        do names <- lookupLocalTcNames sig_ctxt what $ unEmb rdr_name
+           return [ L name_loc (reEmb rdr_name name) | (_, name) <- names ]
     what = text "fixity signature"
 
 {-
@@ -325,14 +325,14 @@ rnSrcWarnDecls bndr_set decls'
 
    rn_deprec (Warning rdr_names txt)
        -- ensures that the names are defined locally
-     = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
+     = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLocEmb)
                                 rdr_names
           ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
 
    what = text "deprecation"
 
-   warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning ns _)) -> ns)
-                                               decls
+   warn_rdr_dups = findDupRdrNames
+                      $ concatMap (\(L _ (Warning ns _)) -> map unLEmb ns) decls
 
 findDupRdrNames :: [Located RdrName] -> [[Located RdrName]]
 findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
@@ -607,7 +607,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
     isAliasMG MG {mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = grhss })]}
         | GRHSs [L _ (GRHS [] body)] lbinds <- grhss
         , L _ EmptyLocalBinds <- lbinds
-        , L _ (HsVar (L _ rhsName)) <- body  = Just rhsName
+        , L _ (HsVar (L _ rhsName)) <- body  = Just $ unEmb rhsName
     isAliasMG _ = Nothing
 
     -- got "lhs = rhs" but expected something different
@@ -1051,7 +1051,7 @@ validRuleLhs foralls lhs
     check (OpApp e1 op _ e2)              = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
     check (HsApp e1 e2)                   = checkl e1 `mplus` checkl_e e2
     check (HsAppType e _)                 = checkl e
-    check (HsVar (L _ v)) | v `notElem` foralls = Nothing
+    check (HsVar (L _ v)) | unEmb v `notElem` foralls = Nothing
     check other                           = Just other  -- Failure
 
         -- Check an argument
@@ -1102,9 +1102,9 @@ rnHsVectDecl :: VectDecl RdrName -> RnM (VectDecl Name, FreeVars)
 -- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
 --        typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
 rnHsVectDecl (HsVect s var rhs@(L _ (HsVar _)))
-  = do { var' <- lookupLocatedOccRn var
+  = do { var' <- lookupLEmbellishedOccRn var
        ; (rhs', fv_rhs) <- rnLExpr rhs
-       ; return (HsVect s var' rhs', fv_rhs `addOneFV` unLoc var')
+       ; return (HsVect s var' rhs', fv_rhs `addOneFV` unLocEmb var')
        }
 rnHsVectDecl (HsVect _ _var _rhs)
   = failWith $ vcat
@@ -1112,24 +1112,26 @@ rnHsVectDecl (HsVect _ _var _rhs)
                , text "must be an identifier"
                ]
 rnHsVectDecl (HsNoVect s var)
-  = do { var' <- lookupLocatedTopBndrRn var           -- only applies to local (not imported) names
-       ; return (HsNoVect s var', unitFV (unLoc var'))
+  = do { var' <- lookupLEmbellishedTopBndrRn var
+                 -- only applies to local (not imported) names
+       ; return (HsNoVect s var', unitFV (unLocEmb var'))
        }
 rnHsVectDecl (HsVectTypeIn s isScalar tycon Nothing)
-  = do { tycon' <- lookupLocatedOccRn tycon
-       ; return (HsVectTypeIn s isScalar tycon' Nothing, unitFV (unLoc tycon'))
+  = do { tycon' <- lookupLEmbellishedOccRn tycon
+       ; return (HsVectTypeIn s isScalar tycon' Nothing
+                , unitFV (unLocEmb tycon'))
        }
 rnHsVectDecl (HsVectTypeIn s isScalar tycon (Just rhs_tycon))
-  = do { tycon'     <- lookupLocatedOccRn tycon
-       ; rhs_tycon' <- lookupLocatedOccRn rhs_tycon
+  = do { tycon'     <- lookupLEmbellishedOccRn tycon
+       ; rhs_tycon' <- lookupLEmbellishedOccRn rhs_tycon
        ; return ( HsVectTypeIn s isScalar tycon' (Just rhs_tycon')
-                , mkFVs [unLoc tycon', unLoc rhs_tycon'])
+                , mkFVs [unLocEmb tycon', unLocEmb rhs_tycon'])
        }
 rnHsVectDecl (HsVectTypeOut _ _ _)
   = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectTypeOut'"
 rnHsVectDecl (HsVectClassIn s cls)
-  = do { cls' <- lookupLocatedOccRn cls
-       ; return (HsVectClassIn s cls', unitFV (unLoc cls'))
+  = do { cls' <- lookupLEmbellishedOccRn cls
+       ; return (HsVectClassIn s cls', unitFV (unLocEmb cls'))
        }
 rnHsVectDecl (HsVectClassOut _)
   = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectClassOut'"
@@ -1514,8 +1516,8 @@ rnRoleAnnots tc_names role_annots
               -- decls defined in this group (see #10263)
              tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names)
                                           (text "role annotation")
-                                          tycon
-           ; return $ RoleAnnotDecl tycon' roles }
+                                          (unLEmb tycon)
+           ; return $ RoleAnnotDecl (reLEmb tycon (unLoc tycon')) roles }
 
 dupRoleAnnotErr :: [LRoleAnnotDecl RdrName] -> RnM ()
 dupRoleAnnotErr [] = panic "dupRoleAnnotErr"
@@ -1701,7 +1703,8 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
 
         -- Check the signatures
         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
-        ; let sig_rdr_names_w_locs = [op | L _ (ClassOpSig False ops _) <- sigs
+        ; let sig_rdr_names_w_locs = [unLEmb op
+                                         | L _ (ClassOpSig False ops _) <- sigs
                                          , op <- ops]
         ; checkDupRdrNames sig_rdr_names_w_locs
                 -- Typechecker is responsible for checking that we only
@@ -2014,8 +2017,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
                            , con_cxt = mcxt, con_details = details
                            , con_doc = mb_doc })
   = do  { _ <- addLocM checkConName name
-        ; new_name     <- lookupLocatedTopBndrRn name
-        ; let doc = ConDeclCtx [new_name]
+        ; new_name     <- lookupLEmbellishedTopBndrRn name
+        ; let doc = ConDeclCtx [unLEmb new_name]
         ; mb_doc'      <- rnMbLHsDoc mb_doc
         ; (kvs, qtvs') <- get_con_qtvs (hsConDeclArgTys details)
 
@@ -2025,7 +2028,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
                              Nothing   -> return (Nothing,emptyFVs)
                              Just lcxt -> do { (lctx',fvs) <- rnContext doc lcxt
                                              ; return (Just lctx',fvs) }
-        ; (new_details, fvs2) <- rnConDeclDetails (unLoc new_name) doc details
+        ; (new_details, fvs2)
+                            <- rnConDeclDetails (unLocEmb new_name) doc details
         ; let (new_details',fvs3) = (new_details,emptyFVs)
         ; traceRn "rnConDecl" (ppr name <+> vcat
              [ text "free_kvs:" <+> ppr kvs
@@ -2055,8 +2059,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
 rnConDecl decl@(ConDeclGADT { con_names = names, con_type = ty
                             , con_doc = mb_doc })
   = do  { mapM_ (addLocM checkConName) names
-        ; new_names    <- mapM lookupLocatedTopBndrRn names
-        ; let doc = ConDeclCtx new_names
+        ; new_names    <- mapM lookupLEmbellishedTopBndrRn names
+        ; let doc = ConDeclCtx $ map unLEmb new_names
         ; mb_doc'      <- rnMbLHsDoc mb_doc
 
         ; (ty', fvs) <- rnHsSigType doc ty
@@ -2115,16 +2119,16 @@ extendPatSynEnv val_decls local_fix_env thing = do {
       | L bind_loc (PatSynBind (PSB { psb_id = L _ n
                                     , psb_args = RecordPatSyn as })) <- bind
       = do
-          bnd_name <- newTopSrcBinder (L bind_loc n)
-          let rnames = map recordPatSynSelectorId as
-              mkFieldOcc :: Located RdrName -> LFieldOcc RdrName
+          bnd_name <- newTopSrcBinder (L bind_loc $ unEmb n)
+          let rnames = map (lEmb . recordPatSynSelectorId) as
+              mkFieldOcc :: LEmbellished RdrName -> LFieldOcc RdrName
               mkFieldOcc (L l name) = L l (FieldOcc (L l name) PlaceHolder)
               field_occs =  map mkFieldOcc rnames
           flds     <- mapM (newRecordSelector False [bnd_name]) field_occs
           return ((bnd_name, flds): names)
       | L bind_loc (PatSynBind (PSB { psb_id = L _ n})) <- bind
       = do
-        bnd_name <- newTopSrcBinder (L bind_loc n)
+        bnd_name <- newTopSrcBinder (L bind_loc $ unEmb n)
         return ((bnd_name, []): names)
       | otherwise
       = return names
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index b927a898c8..7e068c4e21 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -112,7 +112,7 @@ rnBracket e br_body
 
 rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
 rn_bracket outer_stage br@(VarBr flg rdr_name)
-  = do { name <- lookupOccRn rdr_name
+  = do { name <- lookupOccRn $ unLocEmb rdr_name
        ; this_mod <- getModule
 
        ; when (flg && nameIsLocalOrFrom this_mod name) $
@@ -133,7 +133,7 @@ rn_bracket outer_stage br@(VarBr flg rdr_name)
                                              (quotedNameStageErr br) }
                         }
                     }
-       ; return (VarBr flg name, unitFV name) }
+       ; return (VarBr flg (reLEmb rdr_name name), unitFV name) }
 
 rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
                             ; return (ExpBr e', fvs) }
@@ -344,11 +344,11 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHs
 -- which is what we must run in a quasi-quote
 mkQuasiQuoteExpr flavour quoter q_span quote
   = L q_span $ HsApp (L q_span $
-                      HsApp (L q_span (HsVar (L q_span quote_selector)))
+                      HsApp (L q_span (HsVar (L q_span $ EName quote_selector)))
                             quoterExpr)
                      quoteExpr
   where
-    quoterExpr = L q_span $! HsVar $! (L q_span quoter)
+    quoterExpr = L q_span $! HsVar $! (L q_span $ EName quoter)
     quoteExpr  = L q_span $! HsLit $! HsString NoSourceText quote
     quote_selector = case flavour of
                        UntypedExpSplice  -> quoteExpName
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index b74064751d..8fe4abdd79 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -465,8 +465,8 @@ rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
                 , fvs1 `plusFV` fvs2) }
 
 rnHsTyKi env (HsTyVar ip (L loc rdr_name))
-  = do { name <- rnTyVar env rdr_name
-       ; return (HsTyVar ip (L loc name), unitFV name) }
+  = do { name <- rnTyVar env $ unEmb rdr_name
+       ; return (HsTyVar ip (L loc (reEmb rdr_name name)), unitFV name) }
 
 rnHsTyKi env ty@(HsOpTy ty1 l_op ty2)
   = setSrcSpan (getLoc l_op) $
@@ -563,7 +563,7 @@ rnHsTyKi env overall_ty@(HsAppsTy tys)
          let (non_syms, syms) = splitHsAppsTy tys
 
              -- Step 2: rename the pieces
-       ; (syms1, fvs1)      <- mapFvRn (rnHsTyOp env overall_ty) syms
+       ; (syms1, fvs1)      <- mapFvRn (rnHsTyOp env overall_ty . unLEmb) syms
        ; (non_syms1, fvs2)  <- (mapFvRn . mapFvRn) (rnLHsTyKi env) non_syms
 
              -- Step 3: deal with *. See Note [Dealing with *]
@@ -586,7 +586,8 @@ rnHsTyKi env overall_ty@(HsAppsTy tys)
                    (non_syms1 : non_syms2 : non_syms) (L loc star : ops)
       | star `hasKey` starKindTyConKey || star `hasKey` unicodeStarKindTyConKey
       = deal_with_star acc1 acc2
-                       ((non_syms1 ++ L loc (HsTyVar NotPromoted (L loc star))
+                       ((non_syms1
+                            ++ L loc (HsTyVar NotPromoted (L loc $ EName star))
                             : non_syms2) : non_syms)
                        ops
     deal_with_star acc1 acc2 (non_syms1 : non_syms) (op1 : ops)
@@ -1104,7 +1105,7 @@ rnField fl_env env (L l (ConDeclField names ty haddock_doc))
     lookupField :: FieldOcc RdrName -> FieldOcc Name
     lookupField (FieldOcc (L lr rdr) _) = FieldOcc (L lr rdr) (flSelector fl)
       where
-        lbl = occNameFS $ rdrNameOcc rdr
+        lbl = occNameFS $ rdrNameOcc $ unEmb rdr
         fl  = expectJust "rnField" $ lookupFsEnv fl_env lbl
 
 {-
@@ -1239,7 +1240,7 @@ instance Outputable OpName where
 get_op :: LHsExpr Name -> OpName
 -- An unbound name could be either HsVar or HsUnboundVar
 -- See RnExpr.rnUnboundVar
-get_op (L _ (HsVar (L _ n)))   = NormalOp n
+get_op (L _ (HsVar (L _ n)))   = NormalOp $ unEmb n
 get_op (L _ (HsUnboundVar uv)) = UnboundOp uv
 get_op (L _ (HsRecFld fld))    = RecFldOp fld
 get_op other                   = pprPanic "get_op" (ppr other)
@@ -1643,7 +1644,7 @@ extract_lkind = extract_lty KindLevel
 extract_lty :: TypeOrKind -> LHsType RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
 extract_lty t_or_k (L _ ty) acc
   = case ty of
-      HsTyVar _  ltv            -> extract_tv t_or_k ltv acc
+      HsTyVar _  ltv            -> extract_tv t_or_k (unLEmb ltv) acc
       HsBangTy _ ty             -> extract_lty t_or_k ty acc
       HsRecTy flds              -> foldrM (extract_lty t_or_k
                                            . cd_fld_type . unLoc) acc
@@ -1687,7 +1688,7 @@ extract_apps t_or_k tys acc = foldrM (extract_app t_or_k) acc tys
 
 extract_app :: TypeOrKind -> LHsAppType RdrName -> FreeKiTyVars
             -> RnM FreeKiTyVars
-extract_app t_or_k (L _ (HsAppInfix tv))  acc = extract_tv t_or_k tv acc
+extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k (unLEmb tv) acc
 extract_app t_or_k (L _ (HsAppPrefix ty)) acc = extract_lty t_or_k ty acc
 
 extract_hs_tv_bndrs :: [LHsTyVarBndr RdrName] -> FreeKiTyVars