summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2021-04-15 20:57:54 +0100
committerBen Gamari <ben@smart-cactus.org>2021-04-21 23:36:24 -0400
commit00f0cce2ec65df8dd0ef3d6fda0d0fe864e186c8 (patch)
treecbcff0ad162bbb2e776dd23bffb428ec7851d65e /compiler/GHC/Parser
parent1b65aa9f174501ae03bef1ef13f276267c60af9b (diff)
downloadhaskell-00f0cce2ec65df8dd0ef3d6fda0d0fe864e186c8.tar.gz
EPA: cleanups after the merge
Remove EpaAnn type synonym, rename EpaAnn' to EpaAnn. Closes #19705 Updates haddock submodule -- Change data EpaAnchor = AR RealSrcSpan | AD DeltaPos To instead be data EpaAnchor = AnchorReal RealSrcSpan | AnchorDelta DeltaPos Closes #19699 -- Change data DeltaPos = DP { deltaLine :: !Int, deltaColumn :: !Int } To instead be data DeltaPos = SameLine { deltaColumn :: !Int } | DifferentLine { deltaLine :: !Int, startColumn :: !Int } Closes #19698 -- Also some clean-ups of unused parts of check-exact. (cherry picked from commit 0619fb0fb14a98f04aac5f031f6566419fd27495)
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r--compiler/GHC/Parser/Annotation.hs194
-rw-r--r--compiler/GHC/Parser/Lexer.x8
-rw-r--r--compiler/GHC/Parser/PostProcess.hs92
-rw-r--r--compiler/GHC/Parser/Types.hs6
4 files changed, 155 insertions, 145 deletions
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index c62bdce65e..f234c7c789 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -13,16 +13,16 @@ module GHC.Parser.Annotation (
-- * In-tree Exact Print Annotations
AddEpAnn(..),
- EpaAnchor(..), epaAnchorRealSrcSpan,
- DeltaPos(..),
+ EpaLocation(..), epaLocationRealSrcSpan,
+ DeltaPos(..), deltaPos, getDeltaLine,
- EpAnn, EpAnn'(..), Anchor(..), AnchorOperation(..),
+ EpAnn(..), Anchor(..), AnchorOperation(..),
spanAsAnchor, realSpanAsAnchor,
noAnn,
-- ** Comments in Annotations
- EpAnnComments(..), LEpaComment, com, noCom,
+ EpAnnComments(..), LEpaComment, emptyComments,
getFollowingComments, setFollowingComments, setPriorComments,
EpAnnCO,
@@ -316,8 +316,11 @@ data EpaComment =
EpaComment
{ ac_tok :: EpaCommentTok
, ac_prior_tok :: RealSrcSpan
- -- ^ The location of the prior
- -- token, used for exact printing
+ -- ^ The location of the prior token, used in exact printing. The
+ -- 'EpaComment' appears as an 'LEpaComment' containing its
+ -- location. The difference between the end of the prior token
+ -- and the start of this location is used for the spacing when
+ -- exact printing the comment.
}
deriving (Eq, Ord, Data, Show)
@@ -332,6 +335,11 @@ data EpaCommentTok =
| EpaBlockComment String -- ^ comment in {- -}
| EpaEofComment -- ^ empty comment, capturing
-- location of EOF
+
+ -- See #19697 for a discussion of its use and how it should be
+ -- removed in favour of capturing it in the location for
+ -- 'Located HsModule' in the parser.
+
deriving (Eq, Ord, Data, Show)
-- Note: these are based on the Token versions, but the Token type is
-- defined in GHC.Parser.Lexer and bringing it in here would create a loop
@@ -383,24 +391,24 @@ data HasE = HasE | NoE
-- ---------------------------------------------------------------------
-- | Captures an annotation, storing the @'AnnKeywordId'@ and its
--- location. The parser only ever inserts @'EpaAnchor'@ fields with a
+-- location. The parser only ever inserts @'EpaLocation'@ fields with a
-- RealSrcSpan being the original location of the annotation in the
-- source file.
--- The @'EpaAnchor'@ can also store a delta position if the AST has been
+-- The @'EpaLocation'@ can also store a delta position if the AST has been
-- modified and needs to be pretty printed again.
-- The usual way an 'AddEpAnn' is created is using the 'mj' ("make
-- jump") function, and then it can be inserted into the appropriate
-- annotation.
-data AddEpAnn = AddEpAnn AnnKeywordId EpaAnchor deriving (Data,Show,Eq,Ord)
+data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Show,Eq,Ord)
--- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'AR'@
+-- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'EpaSpan'@
-- variant, giving the exact location of the original item in the
--- parsed source. This can be replace by the @'AD'@ version, to
+-- parsed source. This can be replaced by the @'EpaDelta'@ version, to
-- provide a position for the item relative to the end of the previous
-- item in the source. This is useful when editing an AST prior to
-- exact printing the changed one.
-data EpaAnchor = AR RealSrcSpan
- | AD DeltaPos
+data EpaLocation = EpaSpan RealSrcSpan
+ | EpaDelta DeltaPos
deriving (Data,Show,Eq,Ord)
-- | Relative position, line then column. If 'deltaLine' is zero then
@@ -409,20 +417,32 @@ data EpaAnchor = AR RealSrcSpan
-- to, on the same line. If 'deltaLine' is > 0, then it is the number
-- of lines to advance, and 'deltaColumn' is the start column on the
-- new line.
-data DeltaPos =
- DP
- { deltaLine :: !Int,
- deltaColumn :: !Int
- } deriving (Show,Eq,Ord,Data)
-
-
-epaAnchorRealSrcSpan :: EpaAnchor -> RealSrcSpan
-epaAnchorRealSrcSpan (AR r) = r
-epaAnchorRealSrcSpan (AD _) = placeholderRealSpan
-
-instance Outputable EpaAnchor where
- ppr (AR r) = text "AR" <+> ppr r
- ppr (AD d) = text "AD" <+> ppr d
+data DeltaPos
+ = SameLine { deltaColumn :: !Int }
+ | DifferentLine
+ { deltaLine :: !Int, -- ^ deltaLine should always be > 0
+ deltaColumn :: !Int
+ } deriving (Show,Eq,Ord,Data)
+
+deltaPos :: Int -> Int -> DeltaPos
+deltaPos l c = case l of
+ 0 -> SameLine c
+ _ -> DifferentLine l c
+
+getDeltaLine :: DeltaPos -> Int
+getDeltaLine (SameLine _) = 0
+getDeltaLine (DifferentLine r _) = r
+
+-- | Used in the parser only, extract the 'RealSrcSpan' from an
+-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
+-- partial function is safe.
+epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
+epaLocationRealSrcSpan (EpaSpan r) = r
+epaLocationRealSrcSpan (EpaDelta _) = panic "epaLocationRealSrcSpan"
+
+instance Outputable EpaLocation where
+ ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
+ ppr (EpaDelta d) = text "EpaDelta" <+> ppr d
instance Outputable AddEpAnn where
ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
@@ -478,27 +498,27 @@ See Note [XRec and Anno in the AST] for details of how this is done.
-- specialised to the specific set of locations of original API
-- Annotation elements. So for 'HsLet' we have
--
--- type instance XLet GhcPs = EpAnn' AnnsLet
+-- type instance XLet GhcPs = EpAnn AnnsLet
-- data AnnsLet
-- = AnnsLet {
--- alLet :: EpaAnchor,
--- alIn :: EpaAnchor
+-- alLet :: EpaLocation,
+-- alIn :: EpaLocation
-- } deriving Data
--
--- The spacing between the items under the scope of a given EpAnn' is
+-- The spacing between the items under the scope of a given EpAnn is
-- derived from the original 'Anchor'. But there is no requirement
-- that the items included in the sub-element have a "matching"
-- location in their relative anchors. This allows us to freely move
-- elements around, and stitch together new AST fragments out of old
-- ones, and have them still printed out in a reasonable way.
-data EpAnn' ann
+data EpAnn ann
= EpAnn { entry :: Anchor
-- ^ Base location for the start of the syntactic element
-- holding the annotations.
, anns :: ann -- ^ Annotations added by the Parser
, comments :: EpAnnComments
-- ^ Comments enclosed in the SrcSpan of the element
- -- this `EpAnn'` is attached to
+ -- this `EpAnn` is attached to
}
| EpAnnNotUsed -- ^ No Annotation for generated code,
-- e.g. from TH, deriving, etc.
@@ -550,19 +570,8 @@ data EpAnnComments = EpaComments
type LEpaComment = GenLocated Anchor EpaComment
-noCom :: EpAnnComments
-noCom = EpaComments []
-
-com :: [LEpaComment] -> EpAnnComments
-com cs = EpaComments cs
-
--- ---------------------------------------------------------------------
-
--- | This type is the "vanilla" Exact Print Annotation. It captures
--- the containing `SrcSpan' in its `entry` `Anchor`, has a list of
--- `AddEpAnn`, and keeps track of the comments associated with the
--- anchor.
-type EpAnn = EpAnn' [AddEpAnn]
+emptyComments :: EpAnnComments
+emptyComments = EpaComments []
-- ---------------------------------------------------------------------
-- Annotations attached to a 'SrcSpan'.
@@ -576,7 +585,7 @@ data SrcSpanAnn' a = SrcSpanAnn { ann :: a, locA :: SrcSpan }
-- See Note [XRec and Anno in the AST]
-- | We mostly use 'SrcSpanAnn\'' with an 'EpAnn\''
-type SrcAnn ann = SrcSpanAnn' (EpAnn' ann)
+type SrcAnn ann = SrcSpanAnn' (EpAnn ann)
-- AZ: is SrcAnn the right abbreviation here? Any better suggestions?
-- AZ: should we rename LocatedA to LocatedL? The name comes from
@@ -642,11 +651,11 @@ meaning we can have type LocatedN RdrName
-- | Captures the location of punctuation occuring between items,
-- normally in a list. It is captured as a trailing annotation.
data TrailingAnn
- = AddSemiAnn EpaAnchor -- ^ Trailing ';'
- | AddCommaAnn EpaAnchor -- ^ Trailing ','
- | AddVbarAnn EpaAnchor -- ^ Trailing '|'
- | AddRarrowAnn EpaAnchor -- ^ Trailing '->'
- | AddRarrowAnnU EpaAnchor -- ^ Trailing '->', unicode variant
+ = AddSemiAnn EpaLocation -- ^ Trailing ';'
+ | AddCommaAnn EpaLocation -- ^ Trailing ','
+ | AddVbarAnn EpaLocation -- ^ Trailing '|'
+ | AddRarrowAnn EpaLocation -- ^ Trailing '->'
+ | AddRarrowAnnU EpaLocation -- ^ Trailing '->', unicode variant
deriving (Data,Show,Eq, Ord)
instance Outputable TrailingAnn where
@@ -691,8 +700,8 @@ data AnnList
data AnnParen
= AnnParen {
ap_adornment :: ParenType,
- ap_open :: EpaAnchor,
- ap_close :: EpaAnchor
+ ap_open :: EpaLocation,
+ ap_close :: EpaLocation
} deriving (Data)
-- | Detail of the "brackets" used in an 'AnnParen' API Annotation.
@@ -714,10 +723,10 @@ parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS)
-- | API Annotation for the 'Context' data type.
data AnnContext
= AnnContext {
- ac_darrow :: Maybe (IsUnicodeSyntax, EpaAnchor),
+ ac_darrow :: Maybe (IsUnicodeSyntax, EpaLocation),
-- ^ location and encoding of the '=>', if present.
- ac_open :: [EpaAnchor], -- ^ zero or more opening parentheses.
- ac_close :: [EpaAnchor] -- ^ zero or more closing parentheses.
+ ac_open :: [EpaLocation], -- ^ zero or more opening parentheses.
+ ac_close :: [EpaLocation] -- ^ zero or more closing parentheses.
} deriving (Data)
@@ -732,35 +741,35 @@ data NameAnn
-- | Used for a name with an adornment, so '`foo`', '(bar)'
= NameAnn {
nann_adornment :: NameAdornment,
- nann_open :: EpaAnchor,
- nann_name :: EpaAnchor,
- nann_close :: EpaAnchor,
+ nann_open :: EpaLocation,
+ nann_name :: EpaLocation,
+ nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @(,,,)@, or @(#,,,#)#
| NameAnnCommas {
nann_adornment :: NameAdornment,
- nann_open :: EpaAnchor,
- nann_commas :: [EpaAnchor],
- nann_close :: EpaAnchor,
+ nann_open :: EpaLocation,
+ nann_commas :: [EpaLocation],
+ nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @()@, @(##)@, @[]@
| NameAnnOnly {
nann_adornment :: NameAdornment,
- nann_open :: EpaAnchor,
- nann_close :: EpaAnchor,
+ nann_open :: EpaLocation,
+ nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @->@, as an identifier
| NameAnnRArrow {
- nann_name :: EpaAnchor,
+ nann_name :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for an item with a leading @'@. The annotation for
-- unquoted item is stored in 'nann_quoted'.
| NameAnnQuote {
- nann_quote :: EpaAnchor,
+ nann_quote :: EpaLocation,
nann_quoted :: SrcSpanAnnN,
nann_trailing :: [TrailingAnn]
}
@@ -811,7 +820,7 @@ data AnnSortKey
-- | Helper function used in the parser to add a 'TrailingAnn' items
-- to an existing annotation.
addTrailingAnnToL :: SrcSpan -> TrailingAnn -> EpAnnComments
- -> EpAnn' AnnList -> EpAnn' AnnList
+ -> EpAnn AnnList -> EpAnn AnnList
addTrailingAnnToL s t cs EpAnnNotUsed
= EpAnn (spanAsAnchor s) (AnnList (Just $ spanAsAnchor s) Nothing Nothing [] [t]) cs
addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n)
@@ -822,7 +831,7 @@ addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n)
-- | Helper function used in the parser to add a 'TrailingAnn' items
-- to an existing annotation.
addTrailingAnnToA :: SrcSpan -> TrailingAnn -> EpAnnComments
- -> EpAnn' AnnListItem -> EpAnn' AnnListItem
+ -> EpAnn AnnListItem -> EpAnn AnnListItem
addTrailingAnnToA s t cs EpAnnNotUsed
= EpAnn (spanAsAnchor s) (AnnListItem [t]) cs
addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n)
@@ -832,12 +841,12 @@ addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n)
-- | Helper function used in the parser to add a comma location to an
-- existing annotation.
-addTrailingCommaToN :: SrcSpan -> EpAnn' NameAnn -> EpaAnchor -> EpAnn' NameAnn
+addTrailingCommaToN :: SrcSpan -> EpAnn NameAnn -> EpaLocation -> EpAnn NameAnn
addTrailingCommaToN s EpAnnNotUsed l
- = EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) noCom
+ = EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) emptyComments
addTrailingCommaToN _ n l = n { anns = addTrailing (anns n) l }
where
- addTrailing :: NameAnn -> EpaAnchor -> NameAnn
+ addTrailing :: NameAnn -> EpaLocation -> NameAnn
addTrailing n l = n { nann_trailing = AddCommaAnn l : nann_trailing n }
-- ---------------------------------------------------------------------
@@ -923,11 +932,11 @@ noSrcSpanA :: SrcAnn ann
noSrcSpanA = noAnnSrcSpan noSrcSpan
-- | Short form for 'EpAnnNotUsed'
-noAnn :: EpAnn' a
+noAnn :: EpAnn a
noAnn = EpAnnNotUsed
-addAnns :: EpAnn -> [AddEpAnn] -> EpAnnComments -> EpAnn
+addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (EpAnn l as1 cs) as2 cs2
= EpAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2)
addAnns EpAnnNotUsed [] (EpaComments []) = EpAnnNotUsed
@@ -951,8 +960,8 @@ widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan s as = foldl combineSrcSpans s (go as)
where
go [] = []
- go (AddEpAnn _ (AR s):rest) = RealSrcSpan s Nothing : go rest
- go (AddEpAnn _ (AD _):rest) = go rest
+ go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Nothing : go rest
+ go (AddEpAnn _ (EpaDelta _):rest) = go rest
-- | The annotations need to all come after the anchor. Make sure
-- this is the case.
@@ -960,8 +969,8 @@ widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan
widenRealSpan s as = foldl combineRealSrcSpans s (go as)
where
go [] = []
- go (AddEpAnn _ (AR s):rest) = s : go rest
- go (AddEpAnn _ (AD _):rest) = go rest
+ go (AddEpAnn _ (EpaSpan s):rest) = s : go rest
+ go (AddEpAnn _ (EpaDelta _):rest) = go rest
widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op
@@ -972,22 +981,22 @@ widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op
widenLocatedAn :: SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as)
-epAnnAnnsL :: EpAnn' a -> [a]
+epAnnAnnsL :: EpAnn a -> [a]
epAnnAnnsL EpAnnNotUsed = []
epAnnAnnsL (EpAnn _ anns _) = [anns]
-epAnnAnns :: EpAnn -> [AddEpAnn]
+epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnnNotUsed = []
epAnnAnns (EpAnn _ anns _) = anns
-annParen2AddEpAnn :: EpAnn' AnnParen -> [AddEpAnn]
+annParen2AddEpAnn :: EpAnn AnnParen -> [AddEpAnn]
annParen2AddEpAnn EpAnnNotUsed = []
annParen2AddEpAnn (EpAnn _ (AnnParen pt o c) _)
= [AddEpAnn ai o, AddEpAnn ac c]
where
(ai,ac) = parenTypeKws pt
-epAnnComments :: EpAnn' an -> EpAnnComments
+epAnnComments :: EpAnn an -> EpAnnComments
epAnnComments EpAnnNotUsed = EpaComments []
epAnnComments (EpAnn _ _ cs) = cs
@@ -1036,13 +1045,13 @@ setPriorComments (EpaCommentsBalanced _ ts) cs = EpaCommentsBalanced cs ts
-- ---------------------------------------------------------------------
-- TODO:AZ I think EpAnnCO is not needed
-type EpAnnCO = EpAnn' NoEpAnns -- ^ Api Annotations for comments only
+type EpAnnCO = EpAnn NoEpAnns -- ^ Api Annotations for comments only
data NoEpAnns = NoEpAnns
deriving (Data,Eq,Ord)
noComments ::EpAnnCO
-noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns noCom
+noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns emptyComments
-- TODO:AZ get rid of this
placeholderRealSpan :: RealSrcSpan
@@ -1052,7 +1061,7 @@ comment :: RealSrcSpan -> EpAnnComments -> EpAnnCO
comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs
-- ---------------------------------------------------------------------
--- Utilities for managing comments in an `EpAnn' a` structure.
+-- Utilities for managing comments in an `EpAnn a` structure.
-- ---------------------------------------------------------------------
-- | Add additional comments to a 'SrcAnn', used for manipulating the
@@ -1074,7 +1083,7 @@ setCommentsSrcAnn (SrcSpanAnn (EpAnn a an _) loc) cs
-- | Add additional comments, used for manipulating the
-- AST prior to exact printing the changed one.
addCommentsToEpAnn :: (Monoid a)
- => SrcSpan -> EpAnn' a -> EpAnnComments -> EpAnn' a
+ => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
addCommentsToEpAnn loc EpAnnNotUsed cs
= EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs)
@@ -1082,7 +1091,7 @@ addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs)
-- | Replace any existing comments, used for manipulating the
-- AST prior to exact printing the changed one.
setCommentsEpAnn :: (Monoid a)
- => SrcSpan -> EpAnn' a -> EpAnnComments -> EpAnn' a
+ => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
setCommentsEpAnn loc EpAnnNotUsed cs
= EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs
@@ -1094,7 +1103,7 @@ transferComments :: (Monoid ann)
=> SrcAnn ann -> SrcAnn ann -> (SrcAnn ann, SrcAnn ann)
transferComments from@(SrcSpanAnn EpAnnNotUsed _) to = (from, to)
transferComments (SrcSpanAnn (EpAnn a an cs) l) to
- = ((SrcSpanAnn (EpAnn a an noCom) l), addCommentsToSrcAnn to cs)
+ = ((SrcSpanAnn (EpAnn a an emptyComments) l), addCommentsToSrcAnn to cs)
-- ---------------------------------------------------------------------
-- Semigroup instances, to allow easy combination of annotaion elements
@@ -1106,7 +1115,7 @@ instance (Semigroup an) => Semigroup (SrcSpanAnn' an) where
-- annotations must follow it. So we combine them which yields the
-- largest span
-instance (Semigroup a) => Semigroup (EpAnn' a) where
+instance (Semigroup a) => Semigroup (EpAnn a) where
EpAnnNotUsed <> x = x
x <> EpAnnNotUsed = x
(EpAnn l1 a1 b1) <> (EpAnn l2 a2 b2) = EpAnn (l1 <> l2) (a1 <> a2) (b1 <> b2)
@@ -1127,7 +1136,7 @@ instance Semigroup EpAnnComments where
EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2)
-instance (Monoid a) => Monoid (EpAnn' a) where
+instance (Monoid a) => Monoid (EpAnn a) where
mempty = EpAnnNotUsed
instance Semigroup AnnListItem where
@@ -1164,7 +1173,7 @@ instance Semigroup AnnSortKey where
instance Monoid AnnSortKey where
mempty = NoAnnSortKey
-instance (Outputable a) => Outputable (EpAnn' a) where
+instance (Outputable a) => Outputable (EpAnn a) where
ppr (EpAnn l a c) = text "EpAnn" <+> ppr l <+> ppr a <+> ppr c
ppr EpAnnNotUsed = text "EpAnnNotUsed"
@@ -1176,7 +1185,8 @@ instance Outputable AnchorOperation where
ppr (MovedAnchor d) = text "MovedAnchor" <+> ppr d
instance Outputable DeltaPos where
- ppr (DP l c) = text "DP" <+> ppr l <+> ppr c
+ ppr (SameLine c) = text "SameLine" <+> ppr c
+ ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
instance Outputable (GenLocated Anchor EpaComment) where
ppr (L l c) = text "L" <+> ppr l <+> ppr c
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index eec5171eb8..628ef817e4 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -2936,15 +2936,15 @@ instance MonadP P where
getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
getCommentsFor (RealSrcSpan l _) = allocateCommentsP l
-getCommentsFor _ = return noCom
+getCommentsFor _ = return emptyComments
getPriorCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
getPriorCommentsFor (RealSrcSpan l _) = allocatePriorCommentsP l
-getPriorCommentsFor _ = return noCom
+getPriorCommentsFor _ = return emptyComments
getFinalCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments
getFinalCommentsFor (RealSrcSpan l _) = allocateFinalCommentsP l
-getFinalCommentsFor _ = return noCom
+getFinalCommentsFor _ = return emptyComments
getEofPos :: P (Maybe (RealSrcSpan, RealSrcSpan))
getEofPos = P $ \s@(PState { eof_pos = pos }) -> POk s pos
@@ -3439,7 +3439,7 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag))
-- and end of the span
mkParensEpAnn :: SrcSpan -> [AddEpAnn]
mkParensEpAnn (UnhelpfulSpan _) = []
-mkParensEpAnn (RealSrcSpan ss _) = [AddEpAnn AnnOpenP (AR lo),AddEpAnn AnnCloseP (AR lc)]
+mkParensEpAnn (RealSrcSpan ss _) = [AddEpAnn AnnOpenP (EpaSpan lo),AddEpAnn AnnCloseP (EpaSpan lc)]
where
f = srcSpanFile ss
sl = srcSpanStartLine ss
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 6c07ad1b71..298645d63a 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -189,7 +189,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn
; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams
; cs <- getCommentsFor (locA loc) -- Get any remaining comments
- ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn noCom) (ann++annst) cs
+ ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) (ann++annst) cs
; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey, layoutInfo)
, tcdCtxt = mcxt
, tcdLName = cls, tcdTyVars = tyvars
@@ -215,7 +215,7 @@ mkTyData loc' new_or_data cType (L _ (mcxt, tycl_hdr))
; (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams
; cs <- getCommentsFor (locA loc) -- Get any remaining comments
- ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn noCom) (ann ++ anns) cs
+ ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) (ann ++ anns) cs
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv anns'
; return (L loc (DataDecl { tcdDExt = anns', -- AZ: do we need these?
tcdLName = tc, tcdTyVars = tyvars,
@@ -228,7 +228,7 @@ mkDataDefn :: NewOrData
-> Maybe (LHsKind GhcPs)
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
- -> EpAnn
+ -> EpAnn [AddEpAnn]
-> P (HsDataDefn GhcPs)
mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv ann
= do { checkDatatypeContext mcxt
@@ -250,7 +250,7 @@ mkTySynonym loc lhs rhs annsIn
; cs1 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams
; cs2 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
- ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn noCom) (ann ++ anns) (cs1 Semi.<> cs2)
+ ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn emptyComments) (ann ++ anns) (cs1 Semi.<> cs2)
; return (L (noAnnSrcSpan loc) (SynDecl
{ tcdSExt = anns'
, tcdLName = tc, tcdTyVars = tyvars
@@ -312,7 +312,7 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; -- AZ:TODO: deal with these comments
; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
- ; let anns' = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns noCom
+ ; let anns' = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv anns'
; return (L (noAnnSrcSpan loc) (DataFamInstD anns' (DataFamInstDecl
(FamEqn { feqn_ext = noAnn -- AZ: get anns
@@ -344,7 +344,7 @@ mkFamDecl loc info topLevel lhs ksig injAnn annsIn
; cs1 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams
; cs2 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
- ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn noCom) (ann++anns) (cs1 Semi.<> cs2)
+ ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn emptyComments) (ann++anns) (cs1 Semi.<> cs2)
; return (L (noAnnSrcSpan loc) (FamDecl noExtField
(FamilyDecl
{ fdExt = anns'
@@ -436,17 +436,17 @@ annBinds a (HsValBinds an bs) = (HsValBinds (add_where a an) bs)
annBinds a (HsIPBinds an bs) = (HsIPBinds (add_where a an) bs)
annBinds _ (EmptyLocalBinds x) = (EmptyLocalBinds x)
-add_where :: AddEpAnn -> EpAnn' AnnList -> EpAnn' AnnList
-add_where an@(AddEpAnn _ (AR rs)) (EpAnn a (AnnList anc o c r t) cs)
+add_where :: AddEpAnn -> EpAnn AnnList -> EpAnn AnnList
+add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs)
| valid_anchor (anchor a)
= EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) cs
| otherwise
= EpAnn (patch_anchor rs a) (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) cs
-add_where an@(AddEpAnn _ (AR rs)) EpAnnNotUsed
+add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed
= EpAnn (Anchor rs UnchangedAnchor)
- (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) noCom
-add_where (AddEpAnn _ (AD _)) _ = panic "add_where"
- -- AD should only be used for transformations
+ (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) emptyComments
+add_where (AddEpAnn _ (EpaDelta _)) _ = panic "add_where"
+ -- EpaDelta should only be used for transformations
valid_anchor :: RealSrcSpan -> Bool
valid_anchor r = srcSpanStartLine r >= 0
@@ -679,7 +679,7 @@ recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr loc pat =
addFatalError $ PsError (PsErrRecordSyntaxInPatSynDecl pat) [] loc
-mkConDeclH98 :: EpAnn -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
+mkConDeclH98 :: EpAnn [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
@@ -833,7 +833,7 @@ checkTyVars pp_what equals_or_where tc tparms
; return (mkHsQTvs tvs, concat anns) }
where
check (HsTypeArg _ ki@(L loc _)) = addFatalError $ PsError (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] (locA loc)
- check (HsValArg ty) = chkParens [] noCom ty
+ check (HsValArg ty) = chkParens [] emptyComments ty
check (HsArgPar sp) = addFatalError $ PsError (PsErrMalformedDecl pp_what (unLoc tc)) [] sp
-- Keep around an action for adjusting the annotations of extra parens
chkParens :: [AddEpAnn] -> EpAnnComments -> LHsType GhcPs
@@ -869,7 +869,7 @@ checkDatatypeContext (Just c)
unless allowed $ addError $ PsError (PsErrIllegalDataTypeContext c) [] (getLocA c)
type LRuleTyTmVar = Located RuleTyTmVar
-data RuleTyTmVar = RuleTyTmVar EpAnn (LocatedN RdrName) (Maybe (LHsType GhcPs))
+data RuleTyTmVar = RuleTyTmVar (EpAnn [AddEpAnn]) (LocatedN RdrName) (Maybe (LHsType GhcPs))
-- ^ Essentially a wrapper for a @RuleBndr GhcPs@
-- turns RuleTyTmVars into RuleBnrs - this is straightforward
@@ -960,18 +960,18 @@ checkTyClHdr is_cls ty
-- Combine the annotations from the HsParTy and HsStarTy into a
-- new one for the LocatedN RdrName
- newAnns :: SrcSpanAnnA -> EpAnn' AnnParen -> SrcSpanAnnN
+ newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
newAnns (SrcSpanAnn EpAnnNotUsed l) (EpAnn as (AnnParen _ o c) cs) =
let
lr = combineRealSrcSpans (realSrcSpan l) (anchor as)
-- lr = widenAnchorR as (realSrcSpan l)
- an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (AR $ realSrcSpan l) c []) cs)
+ an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs)
in SrcSpanAnn an (RealSrcSpan lr Nothing)
newAnns _ EpAnnNotUsed = panic "missing AnnParen"
newAnns (SrcSpanAnn (EpAnn ap (AnnListItem ta) csp) l) (EpAnn as (AnnParen _ o c) cs) =
let
lr = combineRealSrcSpans (anchor ap) (anchor as)
- an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (AR $ realSrcSpan l) c ta) (csp Semi.<> cs))
+ an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c ta) (csp Semi.<> cs))
in SrcSpanAnn an (RealSrcSpan lr Nothing)
-- | Yield a parse error if we have a function applied directly to a do block
@@ -1017,9 +1017,9 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
-- @
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) =
- check ([],[],noCom) orig_t
+ check ([],[],emptyComments) orig_t
where
- check :: ([EpaAnchor],[EpaAnchor],EpAnnComments)
+ check :: ([EpaLocation],[EpaLocation],EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
check (oparens,cparens,cs) (L _l (HsTupleTy ann' HsBoxedOrConstraintTuple ts))
-- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
@@ -1027,7 +1027,7 @@ checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) =
-- Ditto ()
= do
let (op,cp,cs') = case ann' of
- EpAnnNotUsed -> ([],[],noCom)
+ EpAnnNotUsed -> ([],[],emptyComments)
EpAnn _ (AnnParen _ o c) cs -> ([o],[c],cs)
return (L (SrcSpanAnn (EpAnn (spanAsAnchor l)
(AnnContext Nothing (op Semi.<> oparens) (cp Semi.<> cparens)) (cs Semi.<> cs')) l) ts)
@@ -1036,16 +1036,16 @@ checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) =
-- to be sure HsParTy doesn't get into the way
= do
let (op,cp,cs') = case ann' of
- EpAnnNotUsed -> ([],[],noCom)
+ EpAnnNotUsed -> ([],[],emptyComments)
EpAnn _ (AnnParen _ open close ) cs -> ([open],[close],cs)
check (op++opi,cp++cpi,cs' Semi.<> csi) ty
-- No need for anns, returning original
check (_opi,_cpi,_csi) _t =
- return (L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnContext Nothing [] []) noCom) l) [orig_t])
+ return (L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnContext Nothing [] []) emptyComments) l) [orig_t])
-checkImportDecl :: Maybe EpaAnchor
- -> Maybe EpaAnchor
+checkImportDecl :: Maybe EpaLocation
+ -> Maybe EpaLocation
-> P ()
checkImportDecl mPre mPost = do
let whenJust mg f = maybe (pure ()) f mg
@@ -1056,18 +1056,18 @@ checkImportDecl mPre mPost = do
-- 'ImportQualifiedPost' is not in effect.
whenJust mPost $ \post ->
when (not importQualifiedPostEnabled) $
- failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaAnchorRealSrcSpan post) Nothing)
+ failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Nothing)
-- Error if 'qualified' occurs in both pre and postpositive
-- positions.
whenJust mPost $ \post ->
when (isJust mPre) $
- failOpImportQualifiedTwice (RealSrcSpan (epaAnchorRealSrcSpan post) Nothing)
+ failOpImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Nothing)
-- Warn if 'qualified' found in prepositive position and
-- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
whenJust mPre $ \pre ->
- warnPrepositiveQualifiedModule (RealSrcSpan (epaAnchorRealSrcSpan pre) Nothing)
+ warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Nothing)
-- -------------------------------------------------------------------------
-- Checking Patterns.
@@ -1148,7 +1148,7 @@ checkAPat loc e0 = do
(L l p) <- checkLPat e
let aa = [AddEpAnn ai o, AddEpAnn ac c]
(ai,ac) = parenTypeKws pt
- return (ParPat (EpAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an noCom) (L l p))
+ return (ParPat (EpAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an emptyComments) (L l p))
_ -> patFail (locA loc) (ppr e0)
placeHolderPunRhs :: DisambECP b => PV (LocatedA b)
@@ -1306,7 +1306,7 @@ isFunLhs e = go e [] []
_ -> return Nothing }
go _ _ _ = return Nothing
-mkBangTy :: EpAnn -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
+mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy anns strictness =
HsBangTy anns (HsSrcBang NoSourceText NoSrcUnpack strictness)
@@ -1381,7 +1381,7 @@ type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (Locate
class DisambInfixOp b where
mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b)
mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b)
- mkHsInfixHolePV :: SrcSpan -> (EpAnnComments -> EpAnn' EpAnnUnboundVar) -> PV (Located b)
+ mkHsInfixHolePV :: SrcSpan -> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located b)
instance DisambInfixOp (HsExpr GhcPs) where
mkHsVarOpPV v = return $ L (getLoc v) (HsVar noExtField v)
@@ -1719,7 +1719,7 @@ instance DisambECP (HsExpr GhcPs) where
rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ PsError (PsErrUnallowedPragma prag) [] (locA l)
rejectPragmaPV _ = return ()
-hsHoleExpr :: EpAnn' EpAnnUnboundVar -> HsExpr GhcPs
+hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
hsHoleExpr anns = HsUnboundVar anns (mkVarOcc "_")
type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpan
@@ -1811,7 +1811,7 @@ checkUnboxedStringLitPat (L loc lit) =
mkPatRec ::
LocatedA (PatBuilder GhcPs) ->
HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
- EpAnn ->
+ EpAnn [AddEpAnn] ->
PV (PatBuilder GhcPs)
mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) anns
| isRdrDataCon (unLoc c)
@@ -2377,7 +2377,7 @@ mkRecConstrOrUpdate
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
- -> EpAnn
+ -> EpAnn [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate _ (L _ (HsVar _ (L l c))) _lrec (fbinds,dd) anns
| isRdrDataCon c
@@ -2390,7 +2390,7 @@ mkRecConstrOrUpdate overloaded_update exp _ (fs,dd) anns
| Just dd_loc <- dd = addFatalError $ PsError PsErrDotsInRecordUpdate [] dd_loc
| otherwise = mkRdrRecordUpd overloaded_update exp fs anns
-mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn -> PV (HsExpr GhcPs)
+mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
-- We do not need to know if OverloadedRecordDot is in effect. We do
-- however need to know if OverloadedRecordUpdate (passed in
@@ -2443,7 +2443,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
punnedVar f = if not pun then arg else noLocA . HsVar noExtField . noLocA . mkRdrUnqual . mkVarOccFS $ f
mkRdrRecordCon
- :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn -> HsExpr GhcPs
+ :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon con flds anns
= RecordCon { rcon_ext = anns, rcon_con = con, rcon_flds = flds }
@@ -2482,7 +2482,7 @@ mkInlinePragma src (inl, match_info) mb_act
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
- -> P (EpAnn -> HsDecl GhcPs)
+ -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =
case unLoc cconv of
CCallConv -> mkCImport
@@ -2583,7 +2583,7 @@ parseCImport cconv safety nm str sourceText =
--
mkExport :: Located CCallConv
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
- -> P (EpAnn -> HsDecl GhcPs)
+ -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty)
= return $ \ann -> ForD noExtField $
ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty
@@ -2611,7 +2611,7 @@ data ImpExpSubSpec = ImpExpAbs
| ImpExpAllWith [LocatedA ImpExpQcSpec]
data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
- | ImpExpQcType EpaAnchor (LocatedN RdrName)
+ | ImpExpQcType EpaLocation (LocatedN RdrName)
| ImpExpQcWildcard
mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
@@ -2677,7 +2677,7 @@ checkImportSpec ie@(L _ specs) =
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec [] = return ([], ImpExpList [])
mkImpExpSubSpec [L la ImpExpQcWildcard] =
- return ([AddEpAnn AnnDotdot (AR $ la2r la)], ImpExpAll)
+ return ([AddEpAnn AnnDotdot (EpaSpan $ la2r la)], ImpExpAll)
mkImpExpSubSpec xs =
if (any (isImpExpQcWildcard . unLoc) xs)
then return $ ([], ImpExpAllWith xs)
@@ -2885,7 +2885,7 @@ mkSumOrTupleExpr l boxity (Tuple es) anns = do
cs <- getCommentsFor (locA l)
return $ L l (ExplicitTuple (EpAnn (spanAsAnchor $ locA l) anns cs) (map toTupArg es) boxity)
where
- toTupArg :: Either (EpAnn' EpaAnchor) (LHsExpr GhcPs) -> HsTupArg GhcPs
+ toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left ann) = missingTupArg ann
toTupArg (Right a) = Present noAnn a
@@ -2912,7 +2912,7 @@ mkSumOrTuplePat l boxity (Tuple ps) anns = do
cs <- getCommentsFor (locA l)
return $ L l (PatBuilderPat (TuplePat (EpAnn (spanAsAnchor $ locA l) anns cs) ps' boxity))
where
- toTupPat :: Either (EpAnn' EpaAnchor) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
+ toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
-- Ignore the element location so that the error message refers to the
-- entire tuple. See #19504 (and the discussion) for details.
toTupPat p = case p of
@@ -2936,8 +2936,8 @@ mkLHsOpTy x op y =
mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs
mkMultTy u tok t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1)))
-- See #18888 for the use of (SourceText "1") above
- = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (AR $ realSrcSpan $ combineLocs tok (reLoc t)))
-mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (AR $ realSrcSpan $ getLoc tok)) t
+ = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (EpaSpan $ realSrcSpan $ combineLocs tok (reLoc t)))
+mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (EpaSpan $ realSrcSpan $ getLoc tok)) t
-----------------------------------------------------------------------------
-- Token symbols
@@ -2958,7 +2958,7 @@ mkRdrGetField loc arg field anns =
, gf_field = field
}
-mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn' AnnProjection -> HsExpr GhcPs
+mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn AnnProjection -> HsExpr GhcPs
mkRdrProjection [] _ = panic "mkRdrProjection: The impossible has happened!"
mkRdrProjection flds anns =
HsProjection {
@@ -2967,7 +2967,7 @@ mkRdrProjection flds anns =
}
mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (HsFieldLabel GhcPs)]
- -> LHsExpr GhcPs -> Bool -> EpAnn
+ -> LHsExpr GhcPs -> Bool -> EpAnn [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate loc (L l flds) arg isPun anns =
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index 2f5f304009..5369367ed2 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -26,9 +26,9 @@ import GHC.Parser.Annotation
import Language.Haskell.Syntax
data SumOrTuple b
- = Sum ConTag Arity (LocatedA b) [EpaAnchor] [EpaAnchor]
+ = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
-- ^ Last two are the locations of the '|' before and after the payload
- | Tuple [Either (EpAnn' EpaAnchor) (LocatedA b)]
+ | Tuple [Either (EpAnn EpaLocation) (LocatedA b)]
pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple boxity = \case
@@ -56,7 +56,7 @@ data PatBuilder p
| PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
| PatBuilderAppType (LocatedA (PatBuilder p)) SrcSpan (HsPatSigType GhcPs)
| PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
- (LocatedA (PatBuilder p)) EpAnn
+ (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
| PatBuilderVar (LocatedN RdrName)
| PatBuilderOverLit (HsOverLit GhcPs)