summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Hs/Expr.hs7
-rw-r--r--compiler/GHC/Hs/Instances.hs6
-rw-r--r--compiler/GHC/Parser.y28
-rw-r--r--compiler/GHC/Parser/PostProcess.hs10
-rw-r--r--compiler/GHC/Rename/Expr.hs16
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
6 files changed, 36 insertions, 33 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 89292b59c3..006c8a2e8e 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -44,6 +44,7 @@ import GHC.Parser.Annotation
-- others:
import GHC.Tc.Types.Evidence
+import GHC.Core.DataCon (FieldLabelString)
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Basic
@@ -406,8 +407,8 @@ data AnnsIf
type instance XSCC (GhcPass _) = EpAnn AnnPragma
type instance XXPragE (GhcPass _) = NoExtCon
-type instance XCHsFieldLabel (GhcPass _) = EpAnn AnnFieldLabel
-type instance XXHsFieldLabel (GhcPass _) = NoExtCon
+type instance XCDotFieldOcc (GhcPass _) = EpAnn AnnFieldLabel
+type instance XXDotFieldOcc (GhcPass _) = NoExtCon
type instance XPresent (GhcPass _) = EpAnn [AddEpAnn]
@@ -1902,6 +1903,8 @@ type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr
type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnL
type instance Anno (FieldLabelStrings (GhcPass p)) = SrcSpan
+type instance Anno (FieldLabelString) = SrcSpan
+type instance Anno (DotFieldOcc (GhcPass p)) = SrcSpan
instance (Anno a ~ SrcSpanAnn' (EpAnn an))
=> WrapXRec (GhcPass p) a where
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index db7af75d9b..363b890d59 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -278,9 +278,9 @@ deriving instance Data (FieldLabelStrings GhcPs)
deriving instance Data (FieldLabelStrings GhcRn)
deriving instance Data (FieldLabelStrings GhcTc)
-deriving instance Data (HsFieldLabel GhcPs)
-deriving instance Data (HsFieldLabel GhcRn)
-deriving instance Data (HsFieldLabel GhcTc)
+deriving instance Data (DotFieldOcc GhcPs)
+deriving instance Data (DotFieldOcc GhcRn)
+deriving instance Data (DotFieldOcc GhcTc)
-- deriving instance (DataIdLR p p) => Data (HsPragE p)
deriving instance Data (HsPragE GhcPs)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index c89079ca70..b3fc11c4c9 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2854,7 +2854,7 @@ aexp1 :: { ECP }
| aexp1 TIGHT_INFIX_PROJ field
{% runPV (unECP $1) >>= \ $1 ->
fmap ecpFromExp $ acsa (\cs ->
- let fl = sLL $2 $> (HsFieldLabel ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in
+ let fl = sLL $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in
mkRdrGetField (noAnnSrcSpan $ comb2 (reLoc $1) $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) }
@@ -2936,12 +2936,12 @@ aexp2 :: { ECP }
acsA (\cs -> sLL $1 $> $ HsCmdArrForm (EpAnn (glR $1) (AnnList (Just $ glR $1) (Just $ mu AnnOpenB $1) (Just $ mu AnnCloseB $4) [] []) cs) $2 Prefix
Nothing (reverse $3)) }
-projection :: { Located [Located (HsFieldLabel GhcPs)] }
+projection :: { Located [Located (DotFieldOcc GhcPs)] }
projection
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer
: projection TIGHT_INFIX_PROJ field
- {% acs (\cs -> sLL $1 $> ((sLL $2 $> $ HsFieldLabel (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) : unLoc $1)) }
- | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> [sLL $1 $> $ HsFieldLabel (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2]) }
+ {% acs (\cs -> sLL $1 $> ((sLL $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) : unLoc $1)) }
+ | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> [sLL $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2]) }
splice_exp :: { LHsExpr GhcPs }
: splice_untyped { mapLoc (HsSpliceE noAnn) (reLocA $1) }
@@ -3381,10 +3381,10 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
-- AZ: need to pull out the let block into a helper
| field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
{ do
- let top = sL1 $1 $ HsFieldLabel noAnn $1
- ((L lf (HsFieldLabel _ f)):t) = reverse (unLoc $3)
+ let top = sL1 $1 $ DotFieldOcc noAnn $1
+ ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)
lf' = comb2 $2 (L lf ())
- fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
+ fields = top : L lf' (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
final = last fields
l = comb2 $1 $3
isPun = False
@@ -3397,24 +3397,24 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
-- AZ: need to pull out the let block into a helper
| field TIGHT_INFIX_PROJ fieldToUpdate
{ do
- let top = sL1 $1 $ HsFieldLabel noAnn $1
- ((L lf (HsFieldLabel _ f)):t) = reverse (unLoc $3)
+ let top = sL1 $1 $ DotFieldOcc noAnn $1
+ ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)
lf' = comb2 $2 (L lf ())
- fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
+ fields = top : L lf' (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
final = last fields
l = comb2 $1 $3
isPun = True
- var <- mkHsVarPV (L (noAnnSrcSpan $ getLoc final) (mkRdrUnqual . mkVarOcc . unpackFS . unLoc . hflLabel . unLoc $ final))
+ var <- mkHsVarPV (L (noAnnSrcSpan $ getLoc final) (mkRdrUnqual . mkVarOcc . unpackFS . unLoc . dfoLabel . unLoc $ final))
fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun []
}
-fieldToUpdate :: { Located [Located (HsFieldLabel GhcPs)] }
+fieldToUpdate :: { Located [Located (DotFieldOcc GhcPs)] }
fieldToUpdate
-- See Note [Whitespace-sensitive operator parsing] in Lexer.x
: fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLoc $3) >>= \cs ->
- return (sLL $1 $> ((sLL $2 $> (HsFieldLabel (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) }
+ return (sLL $1 $> ((sLL $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) }
| field {% getCommentsFor (getLoc $1) >>= \cs ->
- return (sL1 $1 [sL1 $1 (HsFieldLabel (EpAnn (glR $1) (AnnFieldLabel Nothing) cs) $1)]) }
+ return (sL1 $1 [sL1 $1 (DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel Nothing) cs) $1)]) }
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 261967be85..bc73a424a8 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1411,7 +1411,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA b)
-- | Return an expression without ambiguity, or fail in a non-expression context.
ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)
- mkHsProjUpdatePV :: SrcSpan -> Located [Located (HsFieldLabel GhcPs)]
+ mkHsProjUpdatePV :: SrcSpan -> Located [Located (DotFieldOcc GhcPs)]
-> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
-- | Disambiguate "\... -> ..." (lambda)
mkHsLamPV
@@ -2438,7 +2438,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
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?
+ fl = DotFieldOcc noAnn (L lf f) -- AZ: what about the ann?
lf = locA loc
in mkRdrProjUpdate l (L lf [L lf fl]) (punnedVar f) pun anns
where
@@ -2956,7 +2956,7 @@ starSym False = "*"
-----------------------------------------
-- Bits and pieces for RecordDotSyntax.
-mkRdrGetField :: SrcSpanAnnA -> LHsExpr GhcPs -> Located (HsFieldLabel GhcPs)
+mkRdrGetField :: SrcSpanAnnA -> LHsExpr GhcPs -> Located (DotFieldOcc GhcPs)
-> EpAnnCO -> LHsExpr GhcPs
mkRdrGetField loc arg field anns =
L loc HsGetField {
@@ -2965,7 +2965,7 @@ mkRdrGetField loc arg field anns =
, gf_field = field
}
-mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn AnnProjection -> HsExpr GhcPs
+mkRdrProjection :: [Located (DotFieldOcc GhcPs)] -> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection [] _ = panic "mkRdrProjection: The impossible has happened!"
mkRdrProjection flds anns =
HsProjection {
@@ -2973,7 +2973,7 @@ mkRdrProjection flds anns =
, proj_flds = flds
}
-mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (HsFieldLabel GhcPs)]
+mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (DotFieldOcc GhcPs)]
-> LHsExpr GhcPs -> Bool -> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!"
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 564eabb601..aff3ce3dbd 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -309,19 +309,19 @@ rnExpr (NegApp _ e _)
rnExpr (HsGetField _ e f)
= do { (getField, fv_getField) <- lookupSyntaxName getFieldName
; (e, fv_e) <- rnLExpr e
- ; let f' = rnHsFieldLabel f
+ ; let f' = rnDotFieldOcc f
; return ( mkExpandedExpr
(HsGetField noExtField e f')
- (mkGetField getField e (fmap (unLoc . hflLabel) f'))
+ (mkGetField getField e (fmap (unLoc . dfoLabel) f'))
, fv_e `plusFV` fv_getField ) }
rnExpr (HsProjection _ fs)
= do { (getField, fv_getField) <- lookupSyntaxName getFieldName
; circ <- lookupOccRn compose_RDR
- ; let fs' = fmap rnHsFieldLabel fs
+ ; let fs' = fmap rnDotFieldOcc fs
; return ( mkExpandedExpr
(HsProjection noExtField fs')
- (mkProjection getField circ (map (fmap (unLoc . hflLabel)) fs'))
+ (mkProjection getField circ (map (fmap (unLoc . dfoLabel)) fs'))
, unitFV circ `plusFV` fv_getField) }
------------------------------------------
@@ -702,11 +702,11 @@ See #18151.
************************************************************************
-}
-rnHsFieldLabel :: Located (HsFieldLabel GhcPs) -> Located (HsFieldLabel GhcRn)
-rnHsFieldLabel (L l (HsFieldLabel x label)) = L l (HsFieldLabel x label)
+rnDotFieldOcc :: Located (DotFieldOcc GhcPs) -> Located (DotFieldOcc GhcRn)
+rnDotFieldOcc (L l (DotFieldOcc x label)) = L l (DotFieldOcc x label)
rnFieldLabelStrings :: FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn
-rnFieldLabelStrings (FieldLabelStrings fls) = FieldLabelStrings (map rnHsFieldLabel fls)
+rnFieldLabelStrings (FieldLabelStrings fls) = FieldLabelStrings (map rnDotFieldOcc fls)
{-
************************************************************************
@@ -2618,7 +2618,7 @@ mkProjection _ _ [] = panic "mkProjection: The impossible happened"
mkProjUpdateSetField :: Name -> Name -> LHsRecProj GhcRn (LHsExpr GhcRn) -> (LHsExpr GhcRn -> LHsExpr GhcRn)
mkProjUpdateSetField get_field set_field (L _ (HsFieldBind { hfbLHS = (L _ (FieldLabelStrings flds')), hfbRHS = arg } ))
= let {
- ; flds = map (fmap (unLoc . hflLabel)) flds'
+ ; flds = map (fmap (unLoc . dfoLabel)) flds'
; final = last flds -- quux
; fields = init flds -- [foo, bar, baz]
; getters = \a -> foldl' (mkGet get_field) [a] fields -- Ordered from deep to shallow.
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 6a67a33e5b..02c5c351e7 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -495,7 +495,7 @@ lexprCtOrigin (L _ e) = exprCtOrigin e
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
-exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (unLoc $ hflLabel f)
+exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (unLoc $ dfoLabel f)
exprCtOrigin (HsUnboundVar {}) = Shouldn'tHappenOrigin "unbound variable"
exprCtOrigin (HsRecSel _ f) = OccurrenceOfRecSel (unLoc $ foLabel f)
exprCtOrigin (HsOverLabel _ l) = OverLabelOrigin l
View Lorry Controller Status