1 files changed, 26 insertions, 23 deletions

diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index f23072c04a..f7ebe42da0 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                       -- in module Language.Haskell.Syntax.Extension
 {-
@@ -1248,31 +1249,34 @@ type LFieldOcc pass = XRec pass (FieldOcc pass)
 
 -- | Field Occurrence
 --
--- Represents an *occurrence* of an unambiguous field.  This may or may not be a
+-- Represents an *occurrence* of a field. This may or may not be a
 -- binding occurrence (e.g. this type is used in 'ConDeclField' and
--- 'RecordPatSynField' which bind their fields, but also in 'HsRecField' for
--- record construction and patterns, which do not).
+-- 'RecordPatSynField' which bind their fields, but also in
+-- 'HsRecField' for record construction and patterns, which do not).
 --
--- We store both the 'RdrName' the user originally wrote, and after the renamer,
--- the selector function.
-data FieldOcc pass = FieldOcc { extFieldOcc     :: XCFieldOcc pass
-                              , rdrNameFieldOcc :: LocatedN RdrName
-                                 -- ^ See Note [Located RdrNames] in "GHC.Hs.Expr"
-                              }
-
-  | XFieldOcc
-      !(XXFieldOcc pass)
-
-deriving instance (Eq (XCFieldOcc pass), Eq (XXFieldOcc pass)) => Eq (FieldOcc pass)
+-- We store both the 'RdrName' the user originally wrote, and after
+-- the renamer we use the extension field to store the selector
+-- function.
+data FieldOcc pass
+  = FieldOcc {
+        foExt :: XCFieldOcc pass
+      , foLabel :: XRec pass RdrName -- See Note [Located RdrNames] in Language.Haskell.Syntax.Expr
+      }
+  | XFieldOcc !(XXFieldOcc pass)
+deriving instance (
+    Eq (XRec pass RdrName)
+  , Eq (XCFieldOcc pass)
+  , Eq (XXFieldOcc pass)
+  ) => Eq (FieldOcc pass)
 
-instance Outputable (FieldOcc pass) where
-  ppr = ppr . rdrNameFieldOcc
+instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where
+  ppr = ppr . foLabel
 
-instance OutputableBndr (FieldOcc pass) where
-  pprInfixOcc  = pprInfixOcc . unLoc . rdrNameFieldOcc
-  pprPrefixOcc = pprPrefixOcc . unLoc . rdrNameFieldOcc
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where
+  pprInfixOcc  = pprInfixOcc . unXRec @pass . foLabel
+  pprPrefixOcc = pprPrefixOcc . unXRec @pass . foLabel
 
-instance OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
   pprInfixOcc  = pprInfixOcc . unLoc
   pprPrefixOcc = pprPrefixOcc . unLoc
 
@@ -1285,9 +1289,8 @@ instance OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
 -- (for unambiguous occurrences) or the typechecker (for ambiguous
 -- occurrences).
 --
--- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat" and
--- Note [Disambiguating record fields] in "GHC.Tc.Gen.Head".
--- See Note [Located RdrNames] in "GHC.Hs.Expr"
+-- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat".
+-- See Note [Located RdrNames] in "GHC.Hs.Expr".
 data AmbiguousFieldOcc pass
   = Unambiguous (XUnambiguous pass) (LocatedN RdrName)
   | Ambiguous   (XAmbiguous pass)   (LocatedN RdrName)