Refactor renamer datastructures

This patch significantly refactors key renamer datastructures (primarily Avail
and GlobalRdrElt) in order to treat DuplicateRecordFields in a more robust way.
In particular it allows the extension to be used with pattern synonyms (fixes
where mangled record selector names could be printed instead of field labels
(e.g. with -Wpartial-fields or hole fits, see new tests).

The key idea is the introduction of a new type GreName for names that may
represent either normal entities or field labels.  This is then used in
GlobalRdrElt and AvailInfo, in place of the old way of representing fields
using FldParent (yuck) and an extra list in AvailTC.

Updates the haddock submodule.

11 files changed, 148 insertions, 170 deletions

diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index 32091e7836..6514968b39 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -22,7 +22,8 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Core.DataCon
 import GHC.Types.Name
-import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..), globalRdrEnvElts )
+import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..)
+                             , globalRdrEnvElts, greMangledName, grePrintableName )
 import GHC.Builtin.Names ( gHC_ERR )
 import GHC.Types.Id
 import GHC.Types.Var.Set
@@ -441,8 +442,7 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
 pprHoleFit _ (RawHoleFit sd) = sd
 pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
  hang display 2 provenance
- where name =  getName hfCand
-       tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap
+ where tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap
          where pprArg b arg = case binderArgFlag b of
                                 -- See Note [Explicit Case Statement for Specificity]
                                 (Invisible spec) -> case spec of
@@ -471,7 +471,10 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
        holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
        holeDisp = if sMs then holeVs
                   else sep $ replicate (length hfMatches) $ text "_"
-       occDisp = pprPrefixOcc name
+       occDisp = case hfCand of
+                   GreHFCand gre   -> pprPrefixOcc (grePrintableName gre)
+                   NameHFCand name -> pprPrefixOcc name
+                   IdHFCand id_    -> pprPrefixOcc id_
        tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
        has = not . null
        wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
@@ -490,7 +493,8 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
        provenance = ppWhen sProv $ parens $
              case hfCand of
                  GreHFCand gre -> pprNameProvenance gre
-                 _ -> text "bound at" <+> ppr (getSrcLoc name)
+                 NameHFCand name -> text "bound at" <+> ppr (getSrcLoc name)
+                 IdHFCand id_ -> text "bound at" <+> ppr (getSrcLoc id_)
 
 getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id]
 getLocalBindings tidy_orig ct_loc
@@ -784,7 +788,7 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
 #if __GLASGOW_HASKELL__ <= 810
                            IdHFCand id -> idName id
 #endif
-                           GreHFCand gre -> gre_name gre
+                           GreHFCand gre -> greMangledName gre
                            NameHFCand name -> name
           discard_it = go subs seen maxleft ty elts
           keep_it eid eid_ty wrp ms = go (fit:subs) (extendVarSet seen eid)
diff --git a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
index 23943a8617..9c00c23cd1 100644
--- a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
+++ b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
@@ -56,11 +56,11 @@ instance NamedThing HoleFitCandidate where
   getName hfc = case hfc of
                      IdHFCand cid -> idName cid
                      NameHFCand cname -> cname
-                     GreHFCand cgre -> gre_name cgre
+                     GreHFCand cgre -> greMangledName cgre
   getOccName hfc = case hfc of
                      IdHFCand cid -> occName cid
                      NameHFCand cname -> occName cname
-                     GreHFCand cgre -> occName (gre_name cgre)
+                     GreHFCand cgre -> occName (greMangledName cgre)
 
 instance HasOccName HoleFitCandidate where
   occName = getOccName
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 0e730a0b84..4d0c8da8e3 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -147,7 +147,7 @@ accumExports f = fmap (catMaybes . snd) . mapAccumLM f' emptyExportAccum
             Just (Just (acc', y)) -> (acc', Just y)
             _                     -> (acc, Nothing)
 
-type ExportOccMap = OccEnv (Name, IE GhcPs)
+type ExportOccMap = OccEnv (GreName, IE GhcPs)
         -- Tracks what a particular exported OccName
         --   in an export list refers to, and which item
         --   it came from.  It's illegal to export two distinct things
@@ -248,13 +248,9 @@ exports_from_avail Nothing rdr_env _imports _this_mod
     -- Even though we don't check whether this is actually a data family
     -- only data families can locally define subordinate things (`ns` here)
     -- without locally defining (and instead importing) the parent (`n`)
-    fix_faminst (AvailTC n ns flds) =
-      let new_ns =
-            case ns of
-              [] -> [n]
-              (p:_) -> if p == n then ns else n:ns
-      in AvailTC n new_ns flds
-
+    fix_faminst avail@(AvailTC n ns)
+      | availExportsDecl avail = avail
+      | otherwise = AvailTC n (NormalGreName n:ns)
     fix_faminst avail = avail
 
 
@@ -273,8 +269,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
 
     -- See Note [Avails of associated data families]
     expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]
-    expand_tyty_gre (gre@GRE { gre_name = me, gre_par = ParentIs p })
-      | isTyConName p, isTyConName me = [gre, gre{ gre_par = NoParent }]
+    expand_tyty_gre (gre@GRE { gre_par = ParentIs p })
+      | isTyConName p, isTyConName (greMangledName gre) = [gre, gre{ gre_par = NoParent }]
     expand_tyty_gre gre = [gre]
 
     imported_modules = [ imv_name imv
@@ -355,10 +351,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
             (n, avail, flds) <- lookup_ie_all ie n'
             let name = unLoc n
             return (IEThingAll noExtField (replaceLWrappedName n' (unLoc n))
-                   , AvailTC name (name:avail) flds)
+                   , availTC name (name:avail) flds)
 
 
-    lookup_ie ie@(IEThingWith _ l wc sub_rdrs _)
+    lookup_ie ie@(IEThingWith _ l wc sub_rdrs)
         = do
             (lname, subs, avails, flds)
               <- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs
@@ -367,9 +363,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
                 NoIEWildcard -> return (lname, [], [])
                 IEWildcard _ -> lookup_ie_all ie l
             let name = unLoc lname
-            return (IEThingWith noExtField (replaceLWrappedName l name) wc subs
-                                (flds ++ (map noLoc all_flds)),
-                    AvailTC name (name : avails ++ all_avail)
+            let flds' = flds ++ (map noLoc all_flds)
+            return (IEThingWith flds' (replaceLWrappedName l name) wc subs,
+                    availTC name (name : avails ++ all_avail)
                                  (map unLoc flds ++ all_flds))
 
 
@@ -420,15 +416,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
     addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
 
 classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
-classifyGREs = partitionEithers . map classifyGRE
-
-classifyGRE :: GlobalRdrElt -> Either Name FieldLabel
-classifyGRE gre = case gre_par gre of
-  FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False n)
-  FldParent _ (Just lbl) -> Right (FieldLabel lbl True n)
-  _                      -> Left  n
-  where
-    n = gre_name gre
+classifyGREs = partitionGreNames . map gre_name
 
 -- Renaming and typechecking of exports happens after everything else has
 -- been typechecked.
@@ -529,11 +517,12 @@ lookupChildrenExport spec_parent rdr_items =
             NameNotFound -> do { ub <- reportUnboundName unboundName
                                ; let l = getLoc n
                                ; return (Left (L l (IEName (L l ub))))}
-            FoundFL fls -> return $ Right (L (getLoc n) fls)
-            FoundName par name -> do { checkPatSynParent spec_parent par name
-                                     ; return
-                                       $ Left (replaceLWrappedName n name) }
-            IncorrectParent p g td gs -> failWithDcErr p g td gs
+            FoundChild par child -> do { checkPatSynParent spec_parent par child
+                                       ; return $ case child of
+                                           FieldGreName fl   -> Right (L (getLoc n) fl)
+                                           NormalGreName  name -> Left (replaceLWrappedName n name)
+                                       }
+            IncorrectParent p c gs -> failWithDcErr p c gs
 
 
 -- Note: [Typing Pattern Synonym Exports]
@@ -595,33 +584,30 @@ lookupChildrenExport spec_parent rdr_items =
 checkPatSynParent :: Name    -- ^ Alleged parent type constructor
                              -- User wrote T( P, Q )
                   -> Parent  -- The parent of P we discovered
-                  -> Name    -- ^ Either a
+                  -> GreName   -- ^ Either a
                              --   a) Pattern Synonym Constructor
                              --   b) A pattern synonym selector
                   -> TcM ()  -- Fails if wrong parent
 checkPatSynParent _ (ParentIs {}) _
   = return ()
 
-checkPatSynParent _ (FldParent {}) _
-  = return ()
-
-checkPatSynParent parent NoParent mpat_syn
+checkPatSynParent parent NoParent gname
   | isUnboundName parent -- Avoid an error cascade
   = return ()
 
   | otherwise
   = do { parent_ty_con <- tcLookupTyCon parent
-       ; mpat_syn_thing <- tcLookupGlobal mpat_syn
+       ; mpat_syn_thing <- tcLookupGlobal (greNameMangledName gname)
 
         -- 1. Check that the Id was actually from a thing associated with patsyns
        ; case mpat_syn_thing of
             AnId i | isId i
                    , RecSelId { sel_tycon = RecSelPatSyn p } <- idDetails i
-                   -> handle_pat_syn (selErr i) parent_ty_con p
+                   -> handle_pat_syn (selErr gname) parent_ty_con p
 
             AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p
 
-            _ -> failWithDcErr parent mpat_syn (ppr mpat_syn) [] }
+            _ -> failWithDcErr parent gname [] }
   where
     psErr  = exportErrCtxt "pattern synonym"
     selErr = exportErrCtxt "pattern synonym record selector"
@@ -669,40 +655,47 @@ checkPatSynParent parent NoParent mpat_syn
 check_occs :: IE GhcPs -> ExportOccMap -> [AvailInfo]
            -> RnM ExportOccMap
 check_occs ie occs avails
-  -- 'names' and 'fls' are the entities specified by 'ie'
-  = foldlM check occs names_with_occs
+  -- 'avails' are the entities specified by 'ie'
+  = foldlM check occs children
   where
-    -- Each Name specified by 'ie', paired with the OccName used to
-    -- refer to it in the GlobalRdrEnv
-    -- (see Note [Representing fields in AvailInfo] in GHC.Types.Avail).
-    --
-    -- We check for export clashes using the selector Name, but need
-    -- the field label OccName for presenting error messages.
-    names_with_occs = availsNamesWithOccs avails
-
-    check occs (name, occ)
-      = case lookupOccEnv occs name_occ of
-          Nothing -> return (extendOccEnv occs name_occ (name, ie))
+    children = concatMap availGreNames avails
+
+    -- Check for distinct children exported with the same OccName (an error) or
+    -- for duplicate exports of the same child (a warning).
+    check :: ExportOccMap -> GreName -> RnM ExportOccMap
+    check occs child
+      = case try_insert occs child of
+          Right occs' -> return occs'
 
-          Just (name', ie')
-            | name == name'   -- Duplicate export
+          Left (child', ie')
+            | greNameMangledName child == greNameMangledName child'   -- Duplicate export
             -- But we don't want to warn if the same thing is exported
             -- by two different module exports. See ticket #4478.
             -> do { warnIfFlag Opt_WarnDuplicateExports
-                               (not (dupExport_ok name ie ie'))
-                               (dupExportWarn occ ie ie')
+                               (not (dupExport_ok child ie ie'))
+                               (dupExportWarn child ie ie')
                   ; return occs }
 
             | otherwise    -- Same occ name but different names: an error
             ->  do { global_env <- getGlobalRdrEnv ;
-                     addErr (exportClashErr global_env occ name' name ie' ie) ;
+                     addErr (exportClashErr global_env child' child ie' ie) ;
                      return occs }
+
+    -- Try to insert a child into the map, returning Left if there is something
+    -- already exported with the same OccName
+    try_insert :: ExportOccMap -> GreName -> Either (GreName, IE GhcPs) ExportOccMap
+    try_insert occs child
+      = case lookupOccEnv occs name_occ of
+          Nothing -> Right (extendOccEnv occs name_occ (child, ie))
+          Just x  -> Left x
       where
-        name_occ = nameOccName name
+        -- For fields, we check for export clashes using the (OccName of the)
+        -- selector Name
+        name_occ = nameOccName (greNameMangledName child)
 
 
-dupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool
--- The Name is exported by both IEs. Is that ok?
+dupExport_ok :: GreName -> IE GhcPs -> IE GhcPs -> Bool
+-- The GreName is exported by both IEs. Is that ok?
 -- "No"  iff the name is mentioned explicitly in both IEs
 --        or one of the IEs mentions the name *alone*
 -- "Yes" otherwise
@@ -728,13 +721,13 @@ dupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool
 --        import Foo
 --        data instance T Int = TInt
 
-dupExport_ok n ie1 ie2
+dupExport_ok child ie1 ie2
   = not (  single ie1 || single ie2
         || (explicit_in ie1 && explicit_in ie2) )
   where
     explicit_in (IEModuleContents {}) = False                   -- module M
     explicit_in (IEThingAll _ r)
-      = nameOccName n == rdrNameOcc (ieWrappedName $ unLoc r)  -- T(..)
+      = occName child == rdrNameOcc (ieWrappedName $ unLoc r)  -- T(..)
     explicit_in _              = True
 
     single IEVar {}      = True
@@ -788,9 +781,9 @@ exportItemErr export_item
           text "attempts to export constructors or class methods that are not visible here" ]
 
 
-dupExportWarn :: OccName -> IE GhcPs -> IE GhcPs -> SDoc
-dupExportWarn occ_name ie1 ie2
-  = hsep [quotes (ppr occ_name),
+dupExportWarn :: GreName -> IE GhcPs -> IE GhcPs -> SDoc
+dupExportWarn child ie1 ie2
+  = hsep [quotes (ppr child),
           text "is exported by", quotes (ppr ie1),
           text "and",            quotes (ppr ie2)]
 
@@ -806,11 +799,11 @@ dcErrMsg ty_con what_is thing parents =
                       [_] -> text "Parent:"
                       _  -> text "Parents:") <+> fsep (punctuate comma parents)
 
-failWithDcErr :: Name -> Name -> SDoc -> [Name] -> TcM a
-failWithDcErr parent thing thing_doc parents = do
-  ty_thing <- tcLookupGlobal thing
+failWithDcErr :: Name -> GreName -> [Name] -> TcM a
+failWithDcErr parent child parents = do
+  ty_thing <- tcLookupGlobal (greNameMangledName child)
   failWithTc $ dcErrMsg parent (tyThingCategory' ty_thing)
-                        thing_doc (map ppr parents)
+                        (ppr child) (map ppr parents)
   where
     tyThingCategory' :: TyThing -> String
     tyThingCategory' (AnId i)
@@ -818,32 +811,37 @@ failWithDcErr parent thing thing_doc parents = do
     tyThingCategory' i = tyThingCategory i
 
 
-exportClashErr :: GlobalRdrEnv -> OccName
-               -> Name -> Name
+exportClashErr :: GlobalRdrEnv
+               -> GreName -> GreName
                -> IE GhcPs -> IE GhcPs
                -> MsgDoc
-exportClashErr global_env occ name1 name2 ie1 ie2
+exportClashErr global_env child1 child2 ie1 ie2
   = vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon
-         , ppr_export ie1' name1'
-         , ppr_export ie2' name2' ]
+         , ppr_export child1' gre1' ie1'
+         , ppr_export child2' gre2' ie2'
+         ]
   where
-    ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> text "exports" <+>
-                                       quotes (ppr_name name))
-                                    2 (pprNameProvenance (get_gre name)))
+    occ = occName child1
+
+    ppr_export child gre ie = nest 3 (hang (quotes (ppr ie) <+> text "exports" <+>
+                                            quotes (ppr_name child))
+                                        2 (pprNameProvenance gre))
 
     -- DuplicateRecordFields means that nameOccName might be a mangled
     -- $sel-prefixed thing, in which case show the correct OccName alone
-    ppr_name name
-      | nameOccName name == occ = ppr name
-      | otherwise               = ppr occ
+    -- (but otherwise show the Name so it will have a module qualifier)
+    ppr_name (FieldGreName fl) | flIsOverloaded fl = ppr fl
+                               | otherwise         = ppr (flSelector fl)
+    ppr_name (NormalGreName name) = ppr name
 
     -- get_gre finds a GRE for the Name, so that we can show its provenance
-    get_gre name
-        = fromMaybe (pprPanic "exportClashErr" (ppr name))
-                    (lookupGRE_Name_OccName global_env name occ)
-    get_loc name = greSrcSpan (get_gre name)
-    (name1', ie1', name2', ie2') =
-      case SrcLoc.leftmost_smallest (get_loc name1) (get_loc name2) of
-        LT -> (name1, ie1, name2, ie2)
-        GT -> (name2, ie2, name1, ie1)
+    gre1 = get_gre child1
+    gre2 = get_gre child2
+    get_gre child
+        = fromMaybe (pprPanic "exportClashErr" (ppr child))
+                    (lookupGRE_GreName global_env child)
+    (child1', gre1', ie1', child2', gre2', ie2') =
+      case SrcLoc.leftmost_smallest (greSrcSpan gre1) (greSrcSpan gre2) of
+        LT -> (child1, gre1, ie1, child2, gre2, ie2)
+        GT -> (child2, gre2, ie2, child1, gre1, ie1)
         EQ -> panic "exportClashErr: clashing exports have idential location"
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 15ca20b738..14c55d1627 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -1356,12 +1356,12 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
           Just gre -> do { unless (null (tail xs)) $ do
                              let L loc _ = hsRecFieldLbl (unLoc upd)
                              setSrcSpan loc $ addUsedGRE True gre
-                         ; lookupSelector (upd, gre_name gre) }
+                         ; lookupSelector (upd, greMangledName gre) }
                       -- The field doesn't belong to this parent, so report
                       -- an error but keep going through all the fields
           Nothing  -> do { addErrTc (fieldNotInType p
                                       (unLoc (hsRecUpdFieldRdr (unLoc upd))))
-                         ; lookupSelector (upd, gre_name (snd (head xs))) }
+                         ; lookupSelector (upd, greMangledName (snd (head xs))) }
 
     -- Given a (field update, selector name) pair, look up the
     -- selector to give a field update with an unambiguous Id
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 524d97077d..e5806637b0 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -493,11 +493,12 @@ tc_rec_sel_id lbl sel_name
   = do { thing <- tcLookup sel_name
        ; case thing of
              ATcId { tct_id = id }
-               -> do { check_local_id occ id
+               -> do { check_naughty occ id
+                     ; check_local_id id
                      ; return id }
 
              AGlobal (AnId id)
-               -> do { check_global_id occ id
+               -> do { check_naughty occ id
                      ; return id }
                     -- A global cannot possibly be ill-staged
                     -- nor does it need the 'lifting' treatment
@@ -545,7 +546,7 @@ finish_ambiguous_selector lr@(L _ rdr) parent_type
            Just gre ->
 
     do { addUsedGRE True gre
-       ; return (gre_name gre) } } } } }
+       ; return (greMangledName gre) } } } } }
 
 -- This field name really is ambiguous, so add a suitable "ambiguous
 -- occurrence" error, then give up.
@@ -596,10 +597,10 @@ lookupParents rdr
        ; mapM lookupParent gres }
   where
     lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
-    lookupParent gre = do { id <- tcLookupId (gre_name gre)
+    lookupParent gre = do { id <- tcLookupId (greMangledName gre)
                           ; case recordSelectorTyCon_maybe id of
                               Just rstc -> return (rstc, gre)
-                              Nothing -> failWithTc (notSelector (gre_name gre)) }
+                              Nothing -> failWithTc (notSelector (greMangledName gre)) }
 
 
 fieldNotInType :: RecSelParent -> RdrName -> SDoc
@@ -758,12 +759,14 @@ tc_infer_id id_name
       ; global_env <- getGlobalRdrEnv
       ; case thing of
              ATcId { tct_id = id }
-               -> do { check_local_id occ id
+               -> do { check_local_id id
                      ; return_id id }
 
              AGlobal (AnId id)
-               -> do { check_global_id occ id
-                     ; return_id id }
+               -> return_id id
+               -- A global cannot possibly be ill-staged
+               -- nor does it need the 'lifting' treatment
+               -- Hence no checkTh stuff here
 
              AGlobal (AConLike cl) -> case cl of
                  RealDataCon con -> return_data_con con
@@ -798,8 +801,6 @@ tc_infer_id id_name
       = text "Illegal term-level use of the type constructor"
           <+> quotes (ppr (tyConName ty_con))
 
-    occ = nameOccName id_name
-
     return_id id = return (HsVar noExtField (noLoc id), idType id)
 
     return_data_con con
@@ -845,19 +846,11 @@ tc_infer_id id_name
                                   , mkInvisForAllTys tvs $ mkInvisFunTysMany theta $ mkVisFunTys scaled_arg_tys res)
            }
 
-check_local_id :: OccName -> Id -> TcM ()
-check_local_id occ id
-  = do { check_naughty occ id  -- See Note [HsVar: naughty record selectors]
-       ; checkThLocalId id
+check_local_id :: Id -> TcM ()
+check_local_id id
+  = do { checkThLocalId id
        ; tcEmitBindingUsage $ unitUE (idName id) One }
 
-check_global_id :: OccName -> Id -> TcM ()
-check_global_id occ id
-  = check_naughty occ id  -- See Note [HsVar: naughty record selectors]
-  -- A global cannot possibly be ill-staged
-  -- nor does it need the 'lifting' treatment
-  -- Hence no checkTh stuff here
-
 check_naughty :: OccName -> TcId -> TcM ()
 check_naughty lbl id
   | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl)
@@ -868,15 +861,7 @@ nonBidirectionalErr name = failWithTc $
     text "non-bidirectional pattern synonym"
     <+> quotes (ppr name) <+> text "used in an expression"
 
-{- Note [HsVar: naughty record selectors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-All record selectors should really be HsRecFld (ambiguous or
-unambiguous), but currently not all of them are: see #18452.  So we
-need to check for naughty record selectors in tc_infer_id, as well as
-in tc_rec_sel_id.
-
-Remove this code when fixing #18452.
-
+{-
 Note [Linear fields generalization]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 As per Note [Polymorphisation of linear fields], linear field of data
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 8da6031597..8f3cec19d0 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -1491,7 +1491,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                           foe_binds
 
             ; fo_gres = fi_gres `unionBags` foe_gres
-            ; fo_fvs = foldr (\gre fvs -> fvs `addOneFV` gre_name gre)
+            ; fo_fvs = foldr (\gre fvs -> fvs `addOneFV` greMangledName gre)
                                 emptyFVs fo_gres
 
             ; sig_names = mkNameSet (collectHsValBinders hs_val_binds)
@@ -1556,11 +1556,11 @@ tcPreludeClashWarn warnFlag name = do
             where
               isLocalDef = gre_lcl x == True
               -- Names are identical ...
-              nameClashes = nameOccName (gre_name x) == nameOccName name
+              nameClashes = nameOccName (greMangledName x) == nameOccName name
               -- ... but not the actual definitions, because we don't want to
               -- warn about a bad definition of e.g. <> in Data.Semigroup, which
               -- is the (only) proper place where this should be defined
-              isNotInProperModule = gre_name x /= name
+              isNotInProperModule = greMangledName x /= name
 
           -- List of all offending definitions
           clashingElts :: [GlobalRdrElt]
@@ -1569,9 +1569,9 @@ tcPreludeClashWarn warnFlag name = do
     ; traceTc "tcPreludeClashWarn/prelude_functions"
                 (hang (ppr name) 4 (sep [ppr clashingElts]))
 
-    ; let warn_msg x = addWarnAt (Reason warnFlag) (nameSrcSpan (gre_name x)) (hsep
+    ; let warn_msg x = addWarnAt (Reason warnFlag) (nameSrcSpan (greMangledName x)) (hsep
               [ text "Local definition of"
-              , (quotes . ppr . nameOccName . gre_name) x
+              , (quotes . ppr . nameOccName . greMangledName) x
               , text "clashes with a future Prelude name." ]
               $$
               text "This will become an error in a future release." )
@@ -2489,7 +2489,7 @@ isGHCiMonad hsc_env ty
         let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
         case occIO of
             Just [n] -> do
-                let name = gre_name n
+                let name = greMangledName n
                 ghciClass <- tcLookupClass ghciIoClassName
                 userTyCon <- tcLookupTyCon name
                 let userTy = mkTyConApp userTyCon []
@@ -2857,7 +2857,7 @@ loadUnqualIfaces hsc_env ictxt
 
     unqual_mods = [ nameModule name
                   | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
-                  , let name = gre_name gre
+                  , let name = greMangledName gre
                   , nameIsFromExternalPackage home_unit name
                   , isTcOcc (nameOccName name)   -- Types and classes only
                   , unQualOK gre ]               -- In scope unqualified
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs
index d01f8992b5..1a5aacdbe1 100644
--- a/compiler/GHC/Tc/Solver/Canonical.hs
+++ b/compiler/GHC/Tc/Solver/Canonical.hs
@@ -1465,7 +1465,7 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2
        ; addUsedGREs gre_list
          -- If a newtype constructor was imported, don't warn about not
          -- importing it...
-       ; traverse_ keepAlive $ map gre_name gre_list
+       ; traverse_ keepAlive $ map greMangledName gre_list
          -- ...and similarly, if a newtype constructor was defined in the same
          -- module, don't warn about it being unused.
          -- See Note [Tracking unused binding and imports] in GHC.Tc.Utils.
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 50d4f72610..b912baa04d 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -4152,9 +4152,8 @@ checkPartialRecordField all_cons fld
         (sep [text "Use of partial record field selector" <> colon,
               nest 2 $ quotes (ppr occ_name)])
   where
-    sel_name = flSelector fld
-    loc    = getSrcSpan sel_name
-    occ_name = getOccName sel_name
+    loc = getSrcSpan (flSelector fld)
+    occ_name = occName fld
 
     (cons_with_field, cons_without_field) = partition has_field all_cons
     has_field con = fld `elem` (dataConFieldLabels con)
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 13b5da759f..ae9dd613d3 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -57,6 +57,7 @@ import GHC.Types.Id.Make
 import GHC.Tc.TyCl.Utils
 import GHC.Core.ConLike
 import GHC.Types.FieldLabel
+import GHC.Rename.Env
 import GHC.Data.Bag
 import GHC.Utils.Misc
 import GHC.Utils.Error
@@ -95,7 +96,7 @@ recoverPSB (PSB { psb_id = L _ name
       ; gbl_env <- tcExtendGlobalEnv [placeholder] getGblEnv
       ; return (emptyBag, gbl_env) }
   where
-    (_arg_names, _rec_fields, is_infix) = collectPatSynArgInfo details
+    (_arg_names, is_infix) = collectPatSynArgInfo details
     mk_placeholder matcher_name
       = mkPatSyn name is_infix
                         ([mkTyVarBinder SpecifiedSpec alphaTyVar], []) ([], [])
@@ -144,7 +145,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
   = addPatSynCtxt lname $
     do { traceTc "tcInferPatSynDecl {" $ ppr name
 
-       ; let (arg_names, rec_fields, is_infix) = collectPatSynArgInfo details
+       ; let (arg_names, is_infix) = collectPatSynArgInfo details
        ; (tclvl, wanted, ((lpat', args), pat_ty))
             <- pushLevelAndCaptureConstraints  $
                tcInferPat PatSyn lpat          $
@@ -184,6 +185,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
        ; mapM_ dependentArgErr bad_args
 
        ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs)
+       ; rec_fields <- lookupConstructorFields name
        ; tc_patsyn_finish lname dir is_infix lpat'
                           (mkTyVarBinders InferredSpec univ_tvs
                             , req_theta,  ev_binds, req_dicts)
@@ -355,7 +357,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
               , ppr explicit_ex_bndrs, ppr prov_theta, ppr sig_body_ty ]
 
        ; let decl_arity = length arg_names
-             (arg_names, rec_fields, is_infix) = collectPatSynArgInfo details
+             (arg_names, is_infix) = collectPatSynArgInfo details
 
        ; (arg_tys, pat_ty) <- case tcSplitFunTysN decl_arity sig_body_ty of
                                  Right stuff  -> return stuff
@@ -440,6 +442,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
 
        ; traceTc "tcCheckPatSynDecl }" $ ppr name
 
+       ; rec_fields <- lookupConstructorFields name
        ; tc_patsyn_finish lname dir is_infix lpat'
                           (skol_univ_bndrs, skol_req_theta, ev_binds, req_dicts)
                           (skol_ex_bndrs, mkTyVarTys ex_tvs', skol_prov_theta, prov_dicts)
@@ -623,21 +626,12 @@ a pattern synonym.  What about the /building/ side?
 -}
 
 collectPatSynArgInfo :: HsPatSynDetails GhcRn
-                     -> ([Name], [Name], Bool)
+                     -> ([Name], Bool)
 collectPatSynArgInfo details =
   case details of
-    PrefixCon _ names    -> (map unLoc names, [], False)
-    InfixCon name1 name2 -> (map unLoc [name1, name2], [], True)
-    RecCon names         -> (vars, sels, False)
-                         where
-                            (vars, sels) = unzip (map splitRecordPatSyn names)
-  where
-    splitRecordPatSyn :: RecordPatSynField (Located Name)
-                      -> (Name, Name)
-    splitRecordPatSyn (RecordPatSynField
-                       { recordPatSynPatVar     = L _ patVar
-                       , recordPatSynSelectorId = L _ selId })
-      = (patVar, selId)
+    PrefixCon _ names    -> (map unLoc names, False)
+    InfixCon name1 name2 -> (map unLoc [name1, name2], True)
+    RecCon names         -> (map (unLoc . recordPatSynPatVar) names, False)
 
 addPatSynCtxt :: Located Name -> TcM a -> TcM a
 addPatSynCtxt (L loc name) thing_inside
@@ -663,7 +657,7 @@ tc_patsyn_finish :: Located Name      -- ^ PatSyn Name
                  -> ([TcInvisTVBinder], [TcType], [PredType], [EvTerm])
                  -> ([LHsExpr GhcTc], [TcType])  -- ^ Pattern arguments and types
                  -> TcType            -- ^ Pattern type
-                 -> [Name]            -- ^ Selector names
+                 -> [FieldLabel]      -- ^ Selector names
                  -- ^ Whether fields, empty if not record PatSyn
                  -> TcM (LHsBinds GhcTc, TcGblEnv)
 tc_patsyn_finish lname dir is_infix lpat'
@@ -709,13 +703,6 @@ tc_patsyn_finish lname dir is_infix lpat'
                                          ex_tvs   prov_theta
                                          arg_tys pat_ty
 
-         -- TODO: Make this have the proper information
-       ; let mkFieldLabel name = FieldLabel { flLabel = occNameFS (nameOccName name)
-                                            , flIsOverloaded = False
-                                            , flSelector = name }
-             field_labels' = map mkFieldLabel field_labels
-
-
        -- Make the PatSyn itself
        ; let patSyn = mkPatSyn (unLoc lname) is_infix
                         (univ_tvs, req_theta)
@@ -723,7 +710,7 @@ tc_patsyn_finish lname dir is_infix lpat'
                         arg_tys
                         pat_ty
                         matcher_id builder_id
-                        field_labels'
+                        field_labels
 
        -- Selectors
        ; let rn_rec_sel_binds = mkPatSynRecSelBinds patSyn (patSynFieldLabels patSyn)
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 7fff1a9e35..c1888c7f36 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -174,7 +174,8 @@ checkHsigIface tcg_env gr sig_iface
       -- The hsig did NOT define this function; that means it must
       -- be a reexport.  In this case, make sure the 'Name' of the
       -- reexport matches the 'Name exported here.
-      | [GRE { gre_name = name' }] <- lookupGlobalRdrEnv gr (nameOccName name) =
+      | [gre] <- lookupGlobalRdrEnv gr (nameOccName name) = do
+        let name' = greMangledName gre
         when (name /= name') $ do
             -- See Note [Error reporting bad reexport]
             -- TODO: Actually this error swizzle doesn't work
@@ -751,7 +752,7 @@ mergeSignatures
     let ifaces = lcl_iface : ext_ifaces
 
     -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
-    let fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
+    let fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
                             | (occ, f) <- concatMap mi_fixities ifaces
                             , rdr_elt <- lookupGlobalRdrEnv rdr_env occ ]
 
@@ -951,7 +952,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
 
     let avails = calculateAvails home_unit
                     impl_iface False{- safe -} NotBoot ImportedBySystem
-        fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
+        fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
                             | (occ, f) <- mi_fixities impl_iface
                             , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
     updGblEnv (\tcg_env -> tcg_env {
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index a1ca04b487..93a43795dc 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -625,7 +625,7 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id
                                       , psb_dir = dir }))
   = do { id' <- zonkIdBndr env id
        ; (env1, lpat') <- zonkPat env lpat
-       ; let details' = zonkPatSynDetails env1 details
+       ; details' <- zonkPatSynDetails env1 details
        ; (_env2, dir') <- zonkPatSynDir env1 dir
        ; return $ PatSynBind x $
                   bind { psb_id = L loc id'
@@ -635,13 +635,17 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id
 
 zonkPatSynDetails :: ZonkEnv
                   -> HsPatSynDetails GhcTc
-                  -> HsPatSynDetails GhcTc
+                  -> TcM (HsPatSynDetails GhcTc)
 zonkPatSynDetails env (PrefixCon _ as)
-  = PrefixCon noTypeArgs (map (zonkLIdOcc env) as)
+  = pure $ PrefixCon noTypeArgs (map (zonkLIdOcc env) as)
 zonkPatSynDetails env (InfixCon a1 a2)
-  = InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2)
+  = pure $ InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2)
 zonkPatSynDetails env (RecCon flds)
-  = RecCon (map (fmap (zonkLIdOcc env)) flds)
+  = RecCon <$> mapM (zonkPatSynField env) flds
+
+zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc)
+zonkPatSynField env (RecordPatSynField x y) =
+    RecordPatSynField <$> zonkFieldOcc env x <*> pure (zonkLIdOcc env y)
 
 zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc
               -> TcM (ZonkEnv, HsPatSynDir GhcTc)