Changes to HsRecField'

4 files changed, 53 insertions, 45 deletions

diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index e7afc89226..a9592304e6 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -100,7 +100,7 @@ minimize modifying existing code by having these new rules calculate
 @LHsRecProj GhcPs (Located b)@ ("record projection") values instead:
 @
 newtype FieldLabelStrings = FieldLabelStrings [Located FieldLabelString]
-type RecProj arg = HsRecField' FieldLabelStrings arg
+type RecProj arg = HsFieldBind FieldLabelStrings arg
 type LHsRecProj p arg = Located (RecProj arg)
 @
 
@@ -137,6 +137,8 @@ values (see function @mkRdrRecordUpd@ in 'GHC.Parser.PostProcess').
 
 -- | RecordDotSyntax field updates
 
+type LFieldLabelStrings p = XRec p (FieldLabelStrings p)
+
 newtype FieldLabelStrings p =
   FieldLabelStrings [Located (HsFieldLabel p)]
 
@@ -148,6 +150,10 @@ instance OutputableBndr (FieldLabelStrings p) where
   pprInfixOcc = pprFieldLabelStrings
   pprPrefixOcc = pprFieldLabelStrings
 
+instance OutputableBndr (Located (FieldLabelStrings p)) where
+  pprInfixOcc = pprInfixOcc . unLoc
+  pprPrefixOcc = pprInfixOcc . unLoc
+
 pprFieldLabelStrings :: FieldLabelStrings p -> SDoc
 pprFieldLabelStrings (FieldLabelStrings flds) =
     hcat (punctuate dot (map (ppr . unLoc) flds))
@@ -158,7 +164,7 @@ instance Outputable (HsFieldLabel p) where
 
 -- Field projection updates (e.g. @foo.bar.baz = 1@). See Note
 -- [RecordDotSyntax field updates].
-type RecProj p arg = HsRecField' (FieldLabelStrings p) arg
+type RecProj p arg = HsFieldBind (LFieldLabelStrings p) arg
 
 -- The phantom type parameter @p@ is for symmetry with @LHsRecField p
 -- arg@ in the definition of @data Fbind@ (see GHC.Parser.Process).
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index a7780a0cc1..44695066d4 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -562,25 +562,25 @@ type family XXOverLit x
 -- =====================================================================
 -- Type families for the HsPat extension points
 
-type family XWildPat    x
-type family XVarPat     x
-type family XLazyPat    x
-type family XAsPat      x
-type family XParPat     x
-type family XBangPat    x
-type family XListPat    x
-type family XTuplePat   x
-type family XSumPat     x
-type family XConPat     x
-type family XViewPat    x
-type family XSplicePat  x
-type family XLitPat     x
-type family XNPat       x
-type family XNPlusKPat  x
-type family XSigPat     x
-type family XCoPat      x
-type family XXPat       x
-type family XHsRecField x
+type family XWildPat     x
+type family XVarPat      x
+type family XLazyPat     x
+type family XAsPat       x
+type family XParPat      x
+type family XBangPat     x
+type family XListPat     x
+type family XTuplePat    x
+type family XSumPat      x
+type family XConPat      x
+type family XViewPat     x
+type family XSplicePat   x
+type family XLitPat      x
+type family XNPat        x
+type family XNPlusKPat   x
+type family XSigPat      x
+type family XCoPat       x
+type family XXPat        x
+type family XHsFieldBind x
 
 -- =====================================================================
 -- Type families for the HsTypes type families
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 76530f3c2f..051f7d8f72 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -22,7 +22,7 @@ module Language.Haskell.Syntax.Pat (
         ConLikeP,
 
         HsConPatDetails, hsConPatArgs,
-        HsRecFields(..), HsRecField'(..), LHsRecField',
+        HsRecFields(..), HsFieldBind(..), LHsFieldBind,
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
         hsRecFields, hsRecFieldSel, hsRecFieldsArgs,
@@ -225,7 +225,7 @@ type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRec
 
 hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p]
 hsConPatArgs (PrefixCon _ ps) = ps
-hsConPatArgs (RecCon fs)      = map (hsRecFieldArg . unXRec @p) (rec_flds fs)
+hsConPatArgs (RecCon fs)      = map (hfbRHS . unXRec @p) (rec_flds fs)
 hsConPatArgs (InfixCon p1 p2) = [p1,p2]
 
 -- | Haskell Record Fields
@@ -256,7 +256,7 @@ data HsRecFields p arg         -- A bunch of record fields
 --                     and the remainder being 'filled in' implicitly
 
 -- | Located Haskell Record Field
-type LHsRecField' p id arg = XRec p (HsRecField' id arg)
+type LHsFieldBind p id arg = XRec p (HsFieldBind id arg)
 
 -- | Located Haskell Record Field
 type LHsRecField  p arg = XRec p (HsRecField  p arg)
@@ -265,21 +265,21 @@ type LHsRecField  p arg = XRec p (HsRecField  p arg)
 type LHsRecUpdField p   = XRec p (HsRecUpdField p)
 
 -- | Haskell Record Field
-type HsRecField    p arg = HsRecField' (FieldOcc p) arg
+type HsRecField p arg   = HsFieldBind (LFieldOcc p) arg
 
 -- | Haskell Record Update Field
-type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
+type HsRecUpdField p    = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr p)
 
--- | Haskell Record Field
+-- | Haskell Field Binding
 --
 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',
 --
 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
-data HsRecField' id arg = HsRecField {
-        hsRecFieldAnn :: XHsRecField id,
-        hsRecFieldLbl :: Located id,
-        hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning
-        hsRecPun      :: Bool           -- ^ Note [Punning]
+data HsFieldBind lhs rhs = HsFieldBind {
+        hfbAnn :: XHsFieldBind lhs,
+        hfbLHS :: lhs,
+        hfbRHS :: rhs,           -- ^ Filled in by renamer when punning
+        hfbPun :: Bool           -- ^ Note [Punning]
   } deriving (Functor, Foldable, Traversable)
 
 
@@ -324,28 +324,27 @@ data HsRecField' id arg = HsRecField {
 --
 -- The parsed HsRecUpdField corresponding to the record update will have:
 --
---     hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
+--     hfbLHS = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
 --
 -- After the renamer, this will become:
 --
---     hsRecFieldLbl = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name
+--     hfbLHS = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name
 --
 -- (note that the Unambiguous constructor is not type-correct here).
 -- The typechecker will determine the particular selector:
 --
---     hsRecFieldLbl = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id
+--     hfbLHS = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id
 --
 -- See also Note [Disambiguating record fields] in GHC.Tc.Gen.Head.
 
-hsRecFields :: forall p arg. UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
-hsRecFields rbinds = map (unLoc . hsRecFieldSel . unXRec @p) (rec_flds rbinds)
+hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
+hsRecFields rbinds = map (hsRecFieldSel . unXRec @p) (rec_flds rbinds)
 
--- Probably won't typecheck at once, things have changed :/
 hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
-hsRecFieldsArgs rbinds = map (hsRecFieldArg . unXRec @p) (rec_flds rbinds)
+hsRecFieldsArgs rbinds = map (hfbRHS . unXRec @p) (rec_flds rbinds)
 
-hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)
-hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl
+hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
+hsRecFieldSel = extFieldOcc . unXRec @p . hfbLHS
 
 
 {-
@@ -366,7 +365,7 @@ instance (Outputable arg, Outputable (XRec p (HsRecField p arg)))
           dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))
 
 instance (Outputable p, OutputableBndr p, Outputable arg)
-      => Outputable (HsRecField' p arg) where
-  ppr (HsRecField { hsRecFieldLbl = L _ f, hsRecFieldArg = arg,
-                    hsRecPun = pun })
+      => Outputable (HsFieldBind p arg) where
+  ppr (HsFieldBind { hfbLHS = f, hfbRHS = arg,
+                     hfbPun = pun })
     = pprPrefixOcc f <+> (ppUnless pun $ equals <+> ppr arg)
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index c872236c78..0829e9a637 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -46,7 +46,7 @@ module Language.Haskell.Syntax.Type (
         HsConDetails(..), noTypeArgs,
 
         FieldOcc(..), LFieldOcc,
-        AmbiguousFieldOcc(..),
+        AmbiguousFieldOcc(..), LAmbiguousFieldOcc,
 
         mapHsOuterImplicit,
         hsQTvExplicit,
@@ -1321,6 +1321,9 @@ instance OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
   pprInfixOcc  = pprInfixOcc . unLoc
   pprPrefixOcc = pprPrefixOcc . unLoc
 
+-- | Located Ambiguous Field Occurence
+type LAmbiguousFieldOcc pass = XRec pass (AmbiguousFieldOcc pass)
+
 -- | Ambiguous Field Occurrence
 --
 -- Represents an *occurrence* of a field that is potentially