diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-04-15 20:57:54 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-19 15:41:00 -0400 |
commit | 0619fb0fb14a98f04aac5f031f6566419fd27495 (patch) | |
tree | 912a13457224565a3e5d98ccb2fce33eacdec0b7 /compiler/GHC/Parser | |
parent | 8b5e5b0524f614679a20ffaebab731c54dc6dee9 (diff) | |
download | haskell-0619fb0fb14a98f04aac5f031f6566419fd27495.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.
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 194 | ||||
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 8 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 92 | ||||
-rw-r--r-- | compiler/GHC/Parser/Types.hs | 6 |
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 fef3b8b8c3..c813ab33e2 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -2935,15 +2935,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 @@ -3438,7 +3438,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 2686bc151b..1de9f0cd53 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) |