summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Hs/Expr.hs2
-rw-r--r--compiler/GHC/Hs/Instances.hs2
-rw-r--r--compiler/GHC/Hs/Pat.hs26
-rw-r--r--compiler/GHC/Hs/Type.hs8
-rw-r--r--compiler/GHC/Hs/Utils.hs4
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs8
-rw-r--r--compiler/GHC/HsToCore/Expr.hs6
-rw-r--r--compiler/GHC/HsToCore/Match.hs4
-rw-r--r--compiler/GHC/HsToCore/Match/Constructor.hs6
-rw-r--r--compiler/GHC/HsToCore/Pmc/Desugar.hs2
-rw-r--r--compiler/GHC/HsToCore/Quote.hs12
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs14
-rw-r--r--compiler/GHC/Parser.y4
-rw-r--r--compiler/GHC/Parser/PostProcess.hs22
-rw-r--r--compiler/GHC/Rename/Expr.hs20
-rw-r--r--compiler/GHC/Rename/Pat.hs54
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs62
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs4
-rw-r--r--compiler/GHC/Tc/TyCl/PatSyn.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Utils.hs10
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs18
-rw-r--r--compiler/GHC/ThToHs.hs20
22 files changed, 156 insertions, 154 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 776e1cb8b5..9b409f4232 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1892,6 +1892,8 @@ type instance Anno (HsSplice (GhcPass p)) = SrcSpanAnnA
type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnL
type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnL
+type instance Anno (FieldLabelStrings (GhcPass p)) = SrcSpan
+
instance (Anno a ~ SrcSpanAnn' (EpAnn an))
=> WrapXRec (GhcPass p) a where
wrapXRec = noLocA
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 68b55196ca..db7af75d9b 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -426,7 +426,7 @@ deriving instance Data ConPatTc
deriving instance Data ListPatTc
-deriving instance (Data a, Data b) => Data (HsRecField' a b)
+deriving instance (Data a, Data b) => Data (HsFieldBind a b)
deriving instance (Data body) => Data (HsRecFields GhcPs body)
deriving instance (Data body) => Data (HsRecFields GhcRn body)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 577321ea0a..1b9b7817e0 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -28,7 +28,7 @@ module GHC.Hs.Pat (
ConLikeP,
HsConPatDetails, hsConPatArgs,
- HsRecFields(..), HsRecField'(..), LHsRecField',
+ HsRecFields(..), HsFieldBind(..), LHsFieldBind,
HsRecField, LHsRecField,
HsRecUpdField, LHsRecUpdField,
hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
@@ -51,7 +51,7 @@ module GHC.Hs.Pat (
import GHC.Prelude
import Language.Haskell.Syntax.Pat
-import Language.Haskell.Syntax.Expr (HsExpr, SyntaxExpr)
+import Language.Haskell.Syntax.Expr (SyntaxExpr)
import {-# SOURCE #-} GHC.Hs.Expr (pprLExpr, pprSplice)
@@ -156,7 +156,7 @@ type instance ConLikeP GhcPs = RdrName -- IdP GhcPs
type instance ConLikeP GhcRn = Name -- IdP GhcRn
type instance ConLikeP GhcTc = ConLike
-type instance XHsRecField _ = EpAnn [AddEpAnn]
+type instance XHsFieldBind _ = EpAnn [AddEpAnn]
-- ---------------------------------------------------------------------
@@ -216,17 +216,17 @@ data CoPat
co_pat_ty :: Type
}
-hsRecFieldId :: HsRecField GhcTc arg -> Located Id
+hsRecFieldId :: HsRecField GhcTc arg -> Id
hsRecFieldId = hsRecFieldSel
hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
-hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
+hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hfbLHS
-hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
+hsRecUpdFieldId :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located Id
hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
-hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
-hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
+hsRecUpdFieldOcc :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
+hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS
{-
@@ -684,12 +684,4 @@ collectEvVarsPat pat =
type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsOverLit (GhcPass p)) = SrcSpan
type instance Anno ConLike = SrcSpanAnnN
-
-type instance Anno (HsRecField' p arg) = SrcSpanAnnA
-type instance Anno (HsRecField' (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) = SrcSpanAnnA
-type instance Anno (HsRecField (GhcPass p) arg) = SrcSpanAnnA
-
--- type instance Anno (HsRecUpdField p) = SrcSpanAnnA
-type instance Anno (HsRecField' (AmbiguousFieldOcc p) (LocatedA (HsExpr p))) = SrcSpanAnnA
-
-type instance Anno (AmbiguousFieldOcc GhcTc) = SrcSpanAnnA
+type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index b4553e2ec4..c3b83eefe8 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -51,7 +51,7 @@ module GHC.Hs.Type (
HsConDetails(..), noTypeArgs,
FieldOcc(..), LFieldOcc, mkFieldOcc,
- AmbiguousFieldOcc(..), mkAmbiguousFieldOcc,
+ AmbiguousFieldOcc(..), LAmbiguousFieldOcc, mkAmbiguousFieldOcc,
rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
unambiguousFieldOcc, ambiguousFieldOcc,
@@ -823,6 +823,10 @@ instance OutputableBndr (AmbiguousFieldOcc (GhcPass p)) where
pprInfixOcc = pprInfixOcc . rdrNameAmbiguousFieldOcc
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
+instance OutputableBndr (Located (AmbiguousFieldOcc (GhcPass p))) where
+ pprInfixOcc = pprInfixOcc . unLoc
+ pprPrefixOcc = pprPrefixOcc . unLoc
+
mkAmbiguousFieldOcc :: LocatedN RdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr
@@ -1239,4 +1243,6 @@ type instance Anno (HsTyVarBndr _flag GhcTc) = SrcSpanAnnA
type instance Anno (HsOuterTyVarBndrs _ (GhcPass _)) = SrcSpanAnnA
type instance Anno HsIPName = SrcSpan
type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA
+
type instance Anno (FieldOcc (GhcPass p)) = SrcSpan
+type instance Anno (AmbiguousFieldOcc (GhcPass p)) = SrcSpan
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 68d6c9ca94..524071154f 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1600,8 +1600,8 @@ lPatImplicits = hs_lpat
[(err_loc, collectPatsBinders CollNoDictBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]
++ hs_lpats explicit_pats
- where implicit_pats = map (hsRecFieldArg . unLoc) implicit
- explicit_pats = map (hsRecFieldArg . unLoc) explicit
+ where implicit_pats = map (hfbRHS . unLoc) implicit
+ explicit_pats = map (hfbRHS . unLoc) explicit
(explicit, implicit) = partitionEithers [if pat_explicit then Left fld else Right fld
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 4f9b85a53f..e2aa7607b6 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -993,11 +993,11 @@ addTickHsRecordBinds (HsRecFields fields dd)
= do { fields' <- mapM addTickHsRecField fields
; return (HsRecFields fields' dd) }
-addTickHsRecField :: LHsRecField' GhcTc id (LHsExpr GhcTc)
- -> TM (LHsRecField' GhcTc id (LHsExpr GhcTc))
-addTickHsRecField (L l (HsRecField x id expr pun))
+addTickHsRecField :: LHsFieldBind GhcTc id (LHsExpr GhcTc)
+ -> TM (LHsFieldBind GhcTc id (LHsExpr GhcTc))
+addTickHsRecField (L l (HsFieldBind x id expr pun))
= do { expr' <- addTickLHsExpr expr
- ; return (L l (HsRecField x id expr' pun)) }
+ ; return (L l (HsFieldBind x id expr' pun)) }
addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
addTickArithSeqInfo (From e1) =
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 4fb61136a2..75e72d6d9c 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -632,7 +632,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields
-- else we shadow other uses of the record selector
-- Hence 'lcl_id'. Cf #2735
ds_field (L _ rec_field)
- = do { rhs <- dsLExpr (hsRecFieldArg rec_field)
+ = do { rhs <- dsLExpr (hfbRHS rec_field)
; let fld_id = unLoc (hsRecUpdFieldId rec_field)
; lcl_id <- newSysLocalDs (idMult fld_id) (idType fld_id)
; return (idName fld_id, lcl_id, rhs) }
@@ -818,8 +818,8 @@ dsSyntaxExpr NoSyntaxExprTc _ = panic "dsSyntaxExpr"
findField :: [LHsRecField GhcTc arg] -> Name -> [arg]
findField rbinds sel
- = [hsRecFieldArg fld | L _ fld <- rbinds
- , sel == idName (unLoc $ hsRecFieldId fld) ]
+ = [hfbRHS fld | L _ fld <- rbinds
+ , sel == idName (hsRecFieldId fld) ]
{-
%--------------------------------------------------------------------
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 38d9c2101d..f8ba578775 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -577,9 +577,9 @@ push_bang_into_newtype_arg l _ty (PrefixCon ts (arg:args))
PrefixCon ts [L l (BangPat noExtField arg)]
push_bang_into_newtype_arg l _ty (RecCon rf)
| HsRecFields { rec_flds = L lf fld : flds } <- rf
- , HsRecField { hsRecFieldArg = arg } <- fld
+ , HsFieldBind { hfbRHS = arg } <- fld
= assert (null flds) $
- RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg
+ RecCon (rf { rec_flds = [L lf (fld { hfbRHS
= L l (BangPat noExtField arg) })] })
push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
| HsRecFields { rec_flds = [] } <- rf
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index 526614d933..303ca416d2 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -223,7 +223,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct
where
fld_var_env = mkNameEnv $ zipEqual "get_arg_vars" fields1 arg_vars
lookup_fld (L _ rpat) = lookupNameEnv_NF fld_var_env
- (idName (unLoc (hsRecFieldId rpat)))
+ (idName (hsRecFieldId rpat))
select_arg_vars _ [] = panic "matchOneCon/select_arg_vars []"
-----------------
@@ -239,7 +239,7 @@ same_fields :: HsRecFields GhcTc (LPat GhcTc) -> HsRecFields GhcTc (LPat GhcTc)
-> Bool
same_fields flds1 flds2
= all2 (\(L _ f1) (L _ f2)
- -> unLoc (hsRecFieldId f1) == unLoc (hsRecFieldId f2))
+ -> hsRecFieldId f1 == hsRecFieldId f2)
(rec_flds flds1) (rec_flds flds2)
@@ -263,7 +263,7 @@ conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats }))
| null rpats = map WildPat (map scaledThing arg_tys)
-- Important special case for C {}, which can be used for a
-- datacon that isn't declared to have fields at all
- | otherwise = map (unLoc . hsRecFieldArg . unLoc) rpats
+ | otherwise = map (unLoc . hfbRHS . unLoc) rpats
{-
Note [Record patterns]
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 4c9e043c25..c835832702 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -287,7 +287,7 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case
-- LHsRecField
rec_field_ps fs = map (tagged_pat . unLoc) fs
where
- tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hsRecFieldArg f)
+ tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hfbRHS f)
-- Unfortunately the label info is empty when the DataCon wasn't defined
-- with record field labels, hence we desugar to field index.
orig_lbls = map flSelector $ conLikeFieldLabels con
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index b911eea798..50e8458726 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1707,17 +1707,17 @@ repFields (HsRecFields { rec_flds = flds })
where
rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
-> MetaM (Core (M TH.FieldExp))
- rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld)
- ; e <- repLE (hsRecFieldArg fld)
+ rep_fld (L _ fld) = do { fn <- lookupOcc (hsRecFieldSel fld)
+ ; e <- repLE (hfbRHS fld)
; repFieldExp fn e }
repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M TH.FieldExp])
repUpdFields = repListM fieldExpTyConName rep_fld
where
rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M TH.FieldExp))
- rep_fld (L l fld) = case unLoc (hsRecFieldLbl fld) of
+ rep_fld (L l fld) = case unLoc (hfbLHS fld) of
Unambiguous sel_name _ -> do { fn <- lookupLOcc (L l sel_name)
- ; e <- repLE (hsRecFieldArg fld)
+ ; e <- repLE (hfbRHS fld)
; repFieldExp fn e }
Ambiguous{} -> notHandled "Ambiguous record updates" (ppr fld)
@@ -2068,8 +2068,8 @@ repP (ConPat NoExtField dc details)
}
where
rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat)))
- rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld)
- ; MkC p <- repLP (hsRecFieldArg fld)
+ rep_fld (L _ fld) = do { MkC v <- lookupOcc (hsRecFieldSel fld)
+ ; MkC p <- repLP (hfbRHS fld)
; rep2 fieldPatName [v,p] }
repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l
; repPlit a }
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index ccc99696d8..573cba529d 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1038,10 +1038,10 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r
contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a
where
- go :: RScoped (LocatedA (HsRecField' id a1))
- -> LocatedA (HsRecField' id (PScoped a1)) -- AZ
- go (RS fscope (L spn (HsRecField x lbl pat pun))) =
- L spn $ HsRecField x lbl (PS rsp scope fscope pat) pun
+ go :: RScoped (LocatedA (HsFieldBind id a1))
+ -> LocatedA (HsFieldBind id (PScoped a1)) -- AZ
+ go (RS fscope (L spn (HsFieldBind x lbl pat pun))) =
+ L spn $ HsFieldBind x lbl (PS rsp scope fscope pat) pun
scoped_fds = listScopes pscope fds
instance ToHie (TScoped (HsPatSigType GhcRn)) where
@@ -1333,12 +1333,12 @@ instance ( ToHie arg , HasLoc arg , Data arg
, HiePass p ) => ToHie (RContext (HsRecFields (GhcPass p) arg)) where
toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields
-instance ( ToHie (RFContext (Located label))
+instance ( ToHie (RFContext label)
, ToHie arg, HasLoc arg, Data arg
, Data label
- ) => ToHie (RContext (LocatedA (HsRecField' label arg))) where
+ ) => ToHie (RContext (LocatedA (HsFieldBind label arg))) where
toHie (RC c (L span recfld)) = concatM $ makeNode recfld (locA span) : case recfld of
- HsRecField _ label expr _ ->
+ HsFieldBind _ label expr _ ->
[ toHie $ RFC c (getRealSpan $ loc expr) label
, toHie expr
]
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 26f6e8b836..f9f7acc0fa 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -3365,13 +3365,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }
fbind :: { forall b. DisambECP b => PV (Fbind b) }
: qvar '=' texp { unECP $3 >>= \ $3 ->
- fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsRecField (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1N $1 $ mkFieldOcc $1) $3 False) }
+ fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1N $1 $ mkFieldOcc $1) $3 False) }
-- RHS is a 'texp', allowing view patterns (#6038)
-- and, incidentally, sections. Eg
-- f (R { x = show -> s }) = ...
| qvar { placeHolderPunRhs >>= \rhs ->
- fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsRecField (EpAnn (glNR $1) [] cs) (sL1N $1 $ mkFieldOcc $1) rhs True) }
+ fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1N $1 $ mkFieldOcc $1) rhs True) }
-- In the punning case, use a place-holder
-- The renamer fills in the final value
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index c6ad4db6d1..2eba1fa9e2 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1158,8 +1158,8 @@ pun_RDR = mkUnqual varName (fsLit "pun-right-hand-side")
checkPatField :: LHsRecField GhcPs (LocatedA (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
-checkPatField (L l fld) = do p <- checkLPat (hsRecFieldArg fld)
- return (L l (fld { hsRecFieldArg = p }))
+checkPatField (L l fld) = do p <- checkLPat (hfbRHS fld)
+ return (L l (fld { hfbRHS = p }))
patFail :: SrcSpan -> SDoc -> PV a
patFail loc e = addFatalError $ PsError (PsErrParseErrorInPat e) [] loc
@@ -2411,7 +2411,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
, rupd_flds = Left fs' }
True -> do
let qualifiedFields =
- [ L l lbl | L _ (HsRecField _ (L l lbl) _ _) <- fs'
+ [ L l lbl | L _ (HsFieldBind _ (L l lbl) _ _) <- fs'
, isQual . rdrNameAmbiguousFieldOcc $ lbl
]
if not $ null qualifiedFields
@@ -2429,7 +2429,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
-- Convert a top-level field update like {foo=2} or {bar} (punned)
-- to a projection update.
recFieldToProjUpdate :: LHsRecField GhcPs (LHsExpr GhcPs) -> LHsRecUpdProj GhcPs
- recFieldToProjUpdate (L l (HsRecField anns (L _ (FieldOcc _ (L loc rdr))) arg pun)) =
+ recFieldToProjUpdate (L l (HsFieldBind anns (L _ (FieldOcc _ (L loc rdr))) arg pun)) =
-- The idea here is to convert the label to a singleton [FastString].
let f = occNameFS . rdrNameOcc $ rdr
fl = HsFieldLabel noAnn (L lf f) -- AZ: what about the ann?
@@ -2454,8 +2454,8 @@ mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs
, rec_dotdot = Just (L s (length fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
-mk_rec_upd_field (HsRecField noAnn (L loc (FieldOcc _ rdr)) arg pun)
- = HsRecField noAnn (L loc (Unambiguous noExtField rdr)) arg pun
+mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun)
+ = HsFieldBind noAnn (L loc (Unambiguous noExtField rdr)) arg pun
mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
-> InlinePragma
@@ -2972,9 +2972,9 @@ mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (HsFieldLabel GhcPs)]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate loc (L l flds) arg isPun anns =
- L loc HsRecField {
- hsRecFieldAnn = anns
- , hsRecFieldLbl = L l (FieldLabelStrings flds)
- , hsRecFieldArg = arg
- , hsRecPun = isPun
+ L loc HsFieldBind {
+ hfbAnn = anns
+ , hfbLHS = L l (FieldLabelStrings flds)
+ , hfbRHS = arg
+ , hfbPun = isPun
}
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index e4b4b10363..d97266d7f2 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -424,8 +424,8 @@ rnExpr (RecordCon { rcon_con = con_id
, fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
where
mk_hs_var l n = HsVar noExtField (L (noAnnSrcSpan l) n)
- rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
- ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
+ rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hfbRHS fld)
+ ; return (L l (fld { hfbRHS = arg' }), fvs) }
rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
= case rbinds of
@@ -437,7 +437,7 @@ rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
Right flds -> -- 'OverloadedRecordUpdate' is in effect. Record dot update desugaring.
do { ; unlessXOptM LangExt.RebindableSyntax $
addErr $ text "RebindableSyntax is required if OverloadedRecordUpdate is enabled."
- ; let punnedFields = [fld | (L _ fld) <- flds, hsRecPun fld]
+ ; let punnedFields = [fld | (L _ fld) <- flds, hfbPun fld]
; punsEnabled <-xoptM LangExt.RecordPuns
; unless (null punnedFields || punsEnabled) $
addErr $ text "For this to work enable NamedFieldPuns."
@@ -2618,7 +2618,7 @@ mkProjection _ _ [] = panic "mkProjection: The impossible happened"
-- e.g. Suppose an update like foo.bar = 1.
-- We calculate the function \a -> setField @"foo" a (setField @"bar" (getField @"foo" a) 1).
mkProjUpdateSetField :: Name -> Name -> LHsRecProj GhcRn (LHsExpr GhcRn) -> (LHsExpr GhcRn -> LHsExpr GhcRn)
-mkProjUpdateSetField get_field set_field (L _ (HsRecField { hsRecFieldLbl = (L _ (FieldLabelStrings flds')), hsRecFieldArg = arg } ))
+mkProjUpdateSetField get_field set_field (L _ (HsFieldBind { hfbLHS = (L _ (FieldLabelStrings flds')), hfbRHS = arg } ))
= let {
; flds = map (fmap (unLoc . hflLabel)) flds'
; final = last flds -- quux
@@ -2643,9 +2643,11 @@ rnHsUpdProjs us = do
pure (u, plusFVs fvs)
where
rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
- rnRecUpdProj (L l (HsRecField _ fs arg pun))
+ rnRecUpdProj (L l (HsFieldBind _ fs arg pun))
= do { (arg, fv) <- rnLExpr arg
- ; return $ (L l (HsRecField { hsRecFieldAnn = noAnn
- , hsRecFieldLbl = fmap rnFieldLabelStrings fs
- , hsRecFieldArg = arg
- , hsRecPun = pun}), fv) }
+ ; return $
+ (L l (HsFieldBind {
+ hfbAnn = noAnn
+ , hfbLHS = fmap rnFieldLabelStrings fs
+ , hfbRHS = arg
+ , hfbPun = pun}), fv ) }
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index c86e3f6ec2..8681903590 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -590,15 +590,15 @@ rnHsRecPatsAndThen mk (L _ con)
where
mkVarPat l n = VarPat noExtField (L (noAnnSrcSpan l) n)
rn_field (L l fld, n') =
- do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld)
- ; return (L l (fld { hsRecFieldArg = arg' })) }
+ do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hfbRHS fld)
+ ; return (L l (fld { hfbRHS = arg' })) }
loc = maybe noSrcSpan getLoc dd
-- Get the arguments of the implicit binders
implicit_binders fs (unLoc -> n) = collectPatsBinders CollNoDictBinders implicit_pats
where
- implicit_pats = map (hsRecFieldArg . unLoc) (drop n fs)
+ implicit_pats = map (hfbRHS . unLoc) (drop n fs)
-- Don't warn for let P{..} = ... in ...
check_unused_wildcard = case mk of
@@ -659,11 +659,11 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg)
-> RnM (LHsRecField GhcRn (LocatedA arg))
rn_fld pun_ok parent (L l
- (HsRecField
- { hsRecFieldLbl =
+ (HsFieldBind
+ { hfbLHS =
(L loc (FieldOcc _ (L ll lbl)))
- , hsRecFieldArg = arg
- , hsRecPun = pun }))
+ , hfbRHS = arg
+ , hfbPun = pun }))
= do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent lbl
; arg' <- if pun
then do { checkErr pun_ok (badPun (L loc lbl))
@@ -671,11 +671,11 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
; return (L (noAnnSrcSpan loc) (mk_arg loc arg_rdr)) }
else return arg
- ; return (L l (HsRecField
- { hsRecFieldAnn = noAnn
- , hsRecFieldLbl = (L loc (FieldOcc sel (L ll lbl)))
- , hsRecFieldArg = arg'
- , hsRecPun = pun })) }
+ ; return (L l (HsFieldBind
+ { hfbAnn = noAnn
+ , hfbLHS = (L loc (FieldOcc sel (L ll lbl)))
+ , hfbRHS = arg'
+ , hfbPun = pun })) }
rn_dotdot :: Maybe (Located Int) -- See Note [DotDot fields] in GHC.Hs.Pat
@@ -716,12 +716,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
; addUsedGREs dot_dot_gres
; let locn = noAnnSrcSpan loc
- ; return [ L (noAnnSrcSpan loc) (HsRecField
- { hsRecFieldAnn = noAnn
- , hsRecFieldLbl
+ ; return [ L (noAnnSrcSpan loc) (HsFieldBind
+ { hfbAnn = noAnn
+ , hfbLHS
= L loc (FieldOcc sel (L (noAnnSrcSpan loc) arg_rdr))
- , hsRecFieldArg = L locn (mk_arg loc arg_rdr)
- , hsRecPun = False })
+ , hfbRHS = L locn (mk_arg loc arg_rdr)
+ , hfbPun = False })
| fl <- dot_dot_fields
, let sel = flSelector fl
, let arg_rdr = mkVarUnqual (flLabel fl) ] }
@@ -763,9 +763,9 @@ rnHsRecUpdFields flds
where
rn_fld :: Bool -> DuplicateRecordFields -> LHsRecUpdField GhcPs
-> RnM (LHsRecUpdField GhcRn, FreeVars)
- rn_fld pun_ok dup_fields_ok (L l (HsRecField { hsRecFieldLbl = L loc f
- , hsRecFieldArg = arg
- , hsRecPun = pun }))
+ rn_fld pun_ok dup_fields_ok (L l (HsFieldBind { hfbLHS = L loc f
+ , hfbRHS = arg
+ , hfbPun = pun }))
= do { let lbl = rdrNameAmbiguousFieldOcc f
; mb_sel <- setSrcSpan loc $
-- Defer renaming of overloaded fields to the typechecker
@@ -785,10 +785,10 @@ rnHsRecUpdFields flds
in (Unambiguous sel_name (L (noAnnSrcSpan loc) lbl), fvs `addOneFV` sel_name)
AmbiguousFields -> (Ambiguous noExtField (L (noAnnSrcSpan loc) lbl), fvs)
- ; return (L l (HsRecField { hsRecFieldAnn = noAnn
- , hsRecFieldLbl = L loc lbl'
- , hsRecFieldArg = arg''
- , hsRecPun = pun }), fvs') }
+ ; return (L l (HsFieldBind { hfbAnn = noAnn
+ , hfbLHS = L loc lbl'
+ , hfbRHS = arg''
+ , hfbPun = pun }), fvs') }
dup_flds :: [NE.NonEmpty RdrName]
-- Each list represents a RdrName that occurred more than once
@@ -799,14 +799,14 @@ rnHsRecUpdFields flds
getFieldIds :: [LHsRecField GhcRn arg] -> [Name]
-getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds
+getFieldIds flds = map (hsRecFieldSel . unLoc) flds
getFieldLbls :: forall p arg . UnXRec p => [LHsRecField p arg] -> [RdrName]
getFieldLbls flds
- = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unXRec @p) flds
+ = map (unLoc . rdrNameFieldOcc . unXRec @p . hfbLHS . unXRec @p) flds
getFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]
-getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) flds
needFlagDotDot :: HsRecFieldContext -> SDoc
needFlagDotDot ctxt = vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 5bbf35d462..e9fbad3807 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -661,7 +661,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
-- STEP -1 See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
-- After this we know that rbinds is unambiguous
; rbinds <- disambiguateRecordBinds record_expr record_rho rbnds res_ty
- ; let upd_flds = map (unLoc . hsRecFieldLbl . unLoc) rbinds
+ ; let upd_flds = map (unLoc . hfbLHS . unLoc) rbinds
upd_fld_occs = map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) upd_flds
sel_ids = map selectorAmbiguousFieldOcc upd_flds
-- STEP 0
@@ -1184,7 +1184,7 @@ getFixedTyVars upd_fld_occs univ_tvs cons
-- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType
-> [LHsRecUpdField GhcRn] -> ExpRhoType
- -> TcM [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+ -> TcM [LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
disambiguateRecordBinds record_expr record_rho rbnds res_ty
-- Are all the fields unambiguous?
= case mapM isUnambiguous rbnds of
@@ -1203,7 +1203,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
where
-- Extract the selector name of a field update if it is unambiguous
isUnambiguous :: LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn,Name)
- isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of
+ isUnambiguous x = case unLoc (hfbLHS (unLoc x)) of
Unambiguous sel_name _ -> Just (x, sel_name)
Ambiguous{} -> Nothing
@@ -1249,7 +1249,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
-- where T does not have field x.
pickParent :: RecSelParent
-> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
- -> TcM (LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
+ -> TcM (LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
pickParent p (upd, xs)
= case lookup p xs of
-- Phew! The parent is valid for this field.
@@ -1258,7 +1258,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
-- unambiguous ones shouldn't be recorded again
-- (giving duplicate deprecation warnings).
Just gre -> do { unless (null (tail xs)) $ do
- let L loc _ = hsRecFieldLbl (unLoc upd)
+ let L loc _ = hfbLHS (unLoc upd)
setSrcSpan loc $ addUsedGRE True gre
; lookupSelector (upd, greMangledName gre) }
-- The field doesn't belong to this parent, so report
@@ -1270,19 +1270,19 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
-- Given a (field update, selector name) pair, look up the
-- selector to give a field update with an unambiguous Id
lookupSelector :: (LHsRecUpdField GhcRn, Name)
- -> TcM (LHsRecField' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
+ -> TcM (LHsFieldBind GhcRn (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
lookupSelector (L l upd, n)
= do { i <- tcLookupId n
- ; let L loc af = hsRecFieldLbl upd
+ ; let L loc af = hfbLHS upd
lbl = rdrNameAmbiguousFieldOcc af
- -- ; return $ L l upd { hsRecFieldLbl
+ -- ; return $ L l upd { hfbLHS
-- = L loc (Unambiguous i (L (noAnnSrcSpan loc) lbl)) }
- ; return $ L l HsRecField
- { hsRecFieldAnn = hsRecFieldAnn upd
- , hsRecFieldLbl
+ ; return $ L l HsFieldBind
+ { hfbAnn = hfbAnn upd
+ , hfbLHS
= L loc (Unambiguous i (L (noAnnSrcSpan loc) lbl))
- , hsRecFieldArg = hsRecFieldArg upd
- , hsRecPun = hsRecPun upd
+ , hfbRHS = hfbRHS upd
+ , hfbPun = hfbPun upd
}
}
@@ -1332,24 +1332,24 @@ tcRecordBinds con_like arg_tys (HsRecFields rbinds dd)
do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)
-> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
- do_bind (L l fld@(HsRecField { hsRecFieldLbl = f
- , hsRecFieldArg = rhs }))
+ do_bind (L l fld@(HsFieldBind { hfbLHS = f
+ , hfbRHS = rhs }))
= do { mb <- tcRecordField con_like flds_w_tys f rhs
; case mb of
Nothing -> return Nothing
- -- Just (f', rhs') -> return (Just (L l (fld { hsRecFieldLbl = f'
- -- , hsRecFieldArg = rhs' }))) }
- Just (f', rhs') -> return (Just (L l (HsRecField
- { hsRecFieldAnn = hsRecFieldAnn fld
- , hsRecFieldLbl = f'
- , hsRecFieldArg = rhs'
- , hsRecPun = hsRecPun fld}))) }
+ -- Just (f', rhs') -> return (Just (L l (fld { hfbLHS = f'
+ -- , hfbRHS = rhs' }))) }
+ Just (f', rhs') -> return (Just (L l (HsFieldBind
+ { hfbAnn = hfbAnn fld
+ , hfbLHS = f'
+ , hfbRHS = rhs'
+ , hfbPun = hfbPun fld}))) }
tcRecordUpd
:: ConLike
-> [TcType] -- Expected type for each field
- -> [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+ -> [LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
-> TcM [LHsRecUpdField GhcTc]
tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
@@ -1357,10 +1357,10 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
fields = map flSelector $ conLikeFieldLabels con_like
flds_w_tys = zipEqual "tcRecordUpd" fields arg_tys
- do_bind :: LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
+ do_bind :: LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
-> TcM (Maybe (LHsRecUpdField GhcTc))
- do_bind (L l fld@(HsRecField { hsRecFieldLbl = L loc af
- , hsRecFieldArg = rhs }))
+ do_bind (L l fld@(HsFieldBind { hfbLHS = L loc af
+ , hfbRHS = rhs }))
= do { let lbl = rdrNameAmbiguousFieldOcc af
sel_id = selectorAmbiguousFieldOcc af
f = L loc (FieldOcc (idName sel_id) (L (noAnnSrcSpan loc) lbl))
@@ -1369,11 +1369,11 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
Nothing -> return Nothing
Just (f', rhs') ->
return (Just
- (L l (fld { hsRecFieldLbl
+ (L l (fld { hfbLHS
= L loc (Unambiguous
(extFieldOcc (unLoc f'))
(L (noAnnSrcSpan loc) lbl))
- , hsRecFieldArg = rhs' }))) }
+ , hfbRHS = rhs' }))) }
tcRecordField :: ConLike -> Assoc Name Type
-> LFieldOcc GhcRn -> LHsExpr GhcRn
@@ -1471,7 +1471,7 @@ badFieldTypes prs
2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
badFieldsUpd
- :: [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+ :: [LHsFieldBind GhcTc (LAmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
-- Field names that don't belong to a single datacon
-> [ConLike] -- Data cons of the type which the first field name belongs to
-> SDoc
@@ -1507,7 +1507,7 @@ badFieldsUpd rbinds data_cons
membership :: [(FieldLabelString, [Bool])]
membership = sortMembership $
map (\fld -> (fld, map (fld `elementOfUniqSet`) fieldLabelSets)) $
- map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) rbinds
+ map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) rbinds
fieldLabelSets :: [UniqSet FieldLabelString]
fieldLabelSets = map (mkUniqSet . map flLabel . conLikeFieldLabels) data_cons
@@ -1594,7 +1594,7 @@ noPossibleParents rbinds
= hang (text "No type has all these fields:")
2 (pprQuotedList fields)
where
- fields = map (hsRecFieldLbl . unLoc) rbinds
+ fields = map (hfbLHS . unLoc) rbinds
badOverloadedUpdate :: SDoc
badOverloadedUpdate = text "Record update is ambiguous, and requires a type signature"
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index f836d809f3..536baa278f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -1245,13 +1245,13 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn))
(LHsRecField GhcTc (LPat GhcTc))
tc_field penv
- (L l (HsRecField ann (L loc (FieldOcc sel (L lr rdr))) pat pun))
+ (L l (HsFieldBind ann (L loc (FieldOcc sel (L lr rdr))) pat pun))
thing_inside
= do { sel' <- tcLookupId sel
; pat_ty <- setSrcSpan loc $ find_field_ty sel
(occNameFS $ rdrNameOcc rdr)
; (pat', res) <- tcConArg penv (pat, pat_ty) thing_inside
- ; return (L l (HsRecField ann (L loc (FieldOcc sel' (L lr rdr))) pat'
+ ; return (L l (HsFieldBind ann (L loc (FieldOcc sel' (L lr rdr))) pat'
pun), res) }
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 400a4d770a..d659b4e8d9 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -1223,7 +1223,7 @@ tcCollectEx pat = go pat
= mergeMany . map goRecFd $ flds
goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([TyVar], [EvVar])
- goRecFd (L _ HsRecField{ hsRecFieldArg = p }) = go p
+ goRecFd (L _ HsFieldBind{ hfbRHS = p }) = go p
merge (vs1, evs1) (vs2, evs2) = (vs1 ++ vs2, evs1 ++ evs2)
mergeMany = foldr merge empty
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 79ed91ba30..9e13a632ae 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -920,14 +920,14 @@ mkOneRecordSelector all_cons idDetails fl has_sel
(L loc' (HsVar noExtField (L locn field_var)))
mk_sel_pat con = ConPat NoExtField (L locn (getName con)) (RecCon rec_fields)
rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
- rec_field = noLocA (HsRecField
- { hsRecFieldAnn = noAnn
- , hsRecFieldLbl
+ rec_field = noLocA (HsFieldBind
+ { hfbAnn = noAnn
+ , hfbLHS
= L loc (FieldOcc sel_name
(L locn $ mkVarUnqual lbl))
- , hsRecFieldArg
+ , hfbRHS
= L loc' (VarPat noExtField (L locn field_var))
- , hsRecPun = False })
+ , hfbPun = False })
sel_lname = L locn sel_name
field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 7215e09d96..c20bb08aac 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -1377,10 +1377,10 @@ zonkRecFields env (HsRecFields flds dd)
; return (HsRecFields flds' dd) }
where
zonk_rbind (L l fld)
- = do { new_id <- wrapLocM (zonkFieldOcc env) (hsRecFieldLbl fld)
- ; new_expr <- zonkLExpr env (hsRecFieldArg fld)
- ; return (L l (fld { hsRecFieldLbl = new_id
- , hsRecFieldArg = new_expr })) }
+ = do { new_id <- wrapLocM (zonkFieldOcc env) (hfbLHS fld)
+ ; new_expr <- zonkLExpr env (hfbRHS fld)
+ ; return (L l (fld { hfbLHS = new_id
+ , hfbRHS = new_expr })) }
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc]
-> TcM [LHsRecUpdField GhcTc]
@@ -1388,9 +1388,9 @@ zonkRecUpdFields env = mapM zonk_rbind
where
zonk_rbind (L l fld)
= do { new_id <- wrapLocM (zonkFieldOcc env) (hsRecUpdFieldOcc fld)
- ; new_expr <- zonkLExpr env (hsRecFieldArg fld)
- ; return (L l (fld { hsRecFieldLbl = fmap ambiguousFieldOcc new_id
- , hsRecFieldArg = new_expr })) }
+ ; new_expr <- zonkLExpr env (hfbRHS fld)
+ ; return (L l (fld { hfbLHS = fmap ambiguousFieldOcc new_id
+ , hfbRHS = new_expr })) }
-------------------------------------------------------------------------
mapIPNameTc :: (a -> TcM b) -> Either (Located HsIPName) a
@@ -1563,9 +1563,9 @@ zonkConStuff env (InfixCon p1 p2)
; return (env', InfixCon p1' p2') }
zonkConStuff env (RecCon (HsRecFields rpats dd))
- = do { (env', pats') <- zonkPats env (map (hsRecFieldArg . unLoc) rpats)
+ = do { (env', pats') <- zonkPats env (map (hfbRHS . unLoc) rpats)
; let rpats' = zipWith (\(L l rp) p' ->
- L l (rp { hsRecFieldArg = p' }))
+ L l (rp { hfbRHS = p' }))
rpats pats'
; return (env', RecCon (HsRecFields rpats' dd)) }
-- Field selectors have declared types; hence no zonking
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 02b93c5803..f8efa8f28d 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1082,13 +1082,13 @@ which we don't want.
-}
cvtFld :: (RdrName -> t) -> (TH.Name, TH.Exp)
- -> CvtM (LHsRecField' GhcPs t (LHsExpr GhcPs))
+ -> CvtM (LHsFieldBind GhcPs (Located t) (LHsExpr GhcPs))
cvtFld f (v,e)
= do { v' <- vNameL v; e' <- cvtl e
- ; return (noLocA $ HsRecField { hsRecFieldAnn = noAnn
- , hsRecFieldLbl = reLoc $ fmap f v'
- , hsRecFieldArg = e'
- , hsRecPun = False}) }
+ ; return (noLocA $ HsFieldBind { hfbAnn = noAnn
+ , hfbLHS = reLoc $ fmap f v'
+ , hfbRHS = e'
+ , hfbPun = False}) }
cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
cvtDD (FromR x) = do { x' <- cvtl x; return $ From x' }
@@ -1361,11 +1361,11 @@ cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (s,p)
= do { L ls s' <- vNameN s
; p' <- cvtPat p
- ; return (noLocA $ HsRecField { hsRecFieldAnn = noAnn
- , hsRecFieldLbl
- = L (locA ls) $ mkFieldOcc (L ls s')
- , hsRecFieldArg = p'
- , hsRecPun = False}) }
+ ; return (noLocA $ HsFieldBind { hfbAnn = noAnn
+ , hfbLHS
+ = L (locA ls) $ mkFieldOcc (L ls s')
+ , hfbRHS = p'
+ , hfbPun = False}) }
{- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
The produced tree of infix patterns will be left-biased, provided @x@ is.
View Lorry Controller Status