[Git][ghc/ghc][wip/int-index/epa-bufspan] Add BufSpan to EpaLocation (#22319, #22558)
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Mon Dec 5 04:52:29 UTC 2022
Vladislav Zavialov pushed to branch wip/int-index/epa-bufspan at Glasgow Haskell Compiler / GHC
Commits:
e1fa730d by Vladislav Zavialov at 2022-12-05T07:49:51+03:00
Add BufSpan to EpaLocation (#22319, #22558)
The key part of this patch is the change to mkTokenLocation:
- mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r)
+ mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb)
mkTokenLocation used to discard the BufSpan, but now it is saved and can
be retrieved from LHsToken or LHsUniToken.
This is made possible by the following change to EpaLocation:
- data EpaLocation = EpaSpan !RealSrcSpan
+ data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan)
| ...
The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock.
- - - - -
11 changed files:
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Types/SrcLoc.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -144,7 +144,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
_ -> parens $ text "SourceText" <+> text "blanked"
epaAnchor :: EpaLocation -> SDoc
- epaAnchor (EpaSpan r) = parens $ text "EpaSpan" <+> realSrcSpan r
+ epaAnchor (EpaSpan r _) = parens $ text "EpaSpan" <+> realSrcSpan r
epaAnchor (EpaDelta d cs) = case ba of
NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> showAstData' cs
BlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> text "blanked"
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3058,34 +3058,34 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
: texp commas_tup_tail
{ unECP $1 >>= \ $1 ->
$2 >>= \ $2 ->
- do { t <- amsA $1 [AddCommaAnn (EpaSpan $ rs $ fst $2)]
+ do { t <- amsA $1 [AddCommaAnn (srcSpan2e $ fst $2)]
; return (Tuple (Right t : snd $2)) } }
| commas tup_tail
{ $2 >>= \ $2 ->
- do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) (EpaSpan $ rs ll) emptyComments))) (fst $1) }
+ do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) (srcSpan2e ll) emptyComments))) (fst $1) }
; return (Tuple (cos ++ $2)) } }
| texp bars { unECP $1 >>= \ $1 -> return $
- (Sum 1 (snd $2 + 1) $1 [] (map (EpaSpan . realSrcSpan) $ fst $2)) }
+ (Sum 1 (snd $2 + 1) $1 [] (map srcSpan2e $ fst $2)) }
| bars texp bars0
{ unECP $2 >>= \ $2 -> return $
(Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2
- (map (EpaSpan . realSrcSpan) $ fst $1)
- (map (EpaSpan . realSrcSpan) $ fst $3)) }
+ (map srcSpan2e $ fst $1)
+ (map srcSpan2e $ fst $3)) }
-- Always starts with commas; always follows an expr
commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn EpaLocation) (LocatedA b)]) }
commas_tup_tail : commas tup_tail
{ $2 >>= \ $2 ->
- do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) (EpaSpan $ rs l) emptyComments))) (tail $ fst $1) }
+ do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) (srcSpan2e l) emptyComments))) (tail $ fst $1) }
; return ((head $ fst $1, cos ++ $2)) } }
-- Always follows a comma
tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn EpaLocation) (LocatedA b)] }
: texp commas_tup_tail { unECP $1 >>= \ $1 ->
$2 >>= \ $2 ->
- do { t <- amsA $1 [AddCommaAnn (EpaSpan $ rs $ fst $2)]
+ do { t <- amsA $1 [AddCommaAnn (srcSpan2e $ fst $2)]
; return (Right t : snd $2) } }
| texp { unECP $1 >>= \ $1 ->
return [Right $1] }
@@ -3564,10 +3564,10 @@ qcon_list : qcon { sL1N $1 [$1] }
sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors
: '(' ')' {% amsrn (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }
| '(' commas ')' {% amsrn (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
- (NameAnnCommas NameParens (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
+ (NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
| '(#' '#)' {% amsrn (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }
| '(#' commas '#)' {% amsrn (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
- (NameAnnCommas NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
+ (NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
-- See Note [Empty lists] in GHC.Hs.Expr
sysdcon :: { LocatedN DataCon }
@@ -3601,12 +3601,12 @@ ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit
: oqtycon { $1 }
| '(' commas ')' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Boxed
(snd $2 + 1)))
- (NameAnnCommas NameParens (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
+ (NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
| '(#' commas '#)' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
(snd $2 + 1)))
- (NameAnnCommas NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
+ (NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
| '(#' bars '#)' {% amsrn (sLL $1 $> $ getRdrName (sumTyCon (snd $2 + 1)))
- (NameAnnBars NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
+ (NameAnnBars NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
| '(' '->' ')' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
| '[' ']' {% amsrn (sLL $1 $> $ listTyCon_RDR)
@@ -4210,27 +4210,27 @@ in GHC.Parser.Annotation
-- |Construct an AddEpAnn from the annotation keyword and the location
-- of the keyword itself
mj :: AnnKeywordId -> Located e -> AddEpAnn
-mj a l = AddEpAnn a (EpaSpan $ rs $ gl l)
+mj a l = AddEpAnn a (srcSpan2e $ gl l)
mjN :: AnnKeywordId -> LocatedN e -> AddEpAnn
-mjN a l = AddEpAnn a (EpaSpan $ rs $ glN l)
+mjN a l = AddEpAnn a (srcSpan2e $ glN l)
-- |Construct an AddEpAnn from the annotation keyword and the location
-- of the keyword itself, provided the span is not zero width
mz :: AnnKeywordId -> Located e -> [AddEpAnn]
-mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (EpaSpan $ rs $ gl l)]
+mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]
msemi :: Located e -> [TrailingAnn]
-msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (EpaSpan $ rs $ gl l)]
+msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]
msemim :: Located e -> Maybe EpaLocation
-msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (EpaSpan $ rs $ gl l)
+msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)
-- |Construct an AddEpAnn from the annotation keyword and the Located Token. If
-- the token has a unicode equivalent and this has been used, provide the
-- unicode variant of the annotation.
mu :: AnnKeywordId -> Located Token -> AddEpAnn
-mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (EpaSpan $ rs l)
+mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (srcSpan2e l)
-- | If the 'Token' is using its unicode variant return the unicode variant of
-- the annotation
@@ -4253,7 +4253,7 @@ glR :: Located a -> Anchor
glR la = Anchor (realSrcSpan $ getLoc la) UnchangedAnchor
glAA :: Located a -> EpaLocation
-glAA = EpaSpan <$> realSrcSpan . getLoc
+glAA = srcSpan2e . getLoc
glRR :: Located a -> RealSrcSpan
glRR = realSrcSpan . getLoc
@@ -4265,7 +4265,7 @@ glNR :: LocatedN a -> Anchor
glNR ln = Anchor (realSrcSpan $ getLocA ln) UnchangedAnchor
glNRR :: LocatedN a -> EpaLocation
-glNRR = EpaSpan <$> realSrcSpan . getLocA
+glNRR = srcSpan2e . getLocA
anc :: RealSrcSpan -> Anchor
anc r = Anchor r UnchangedAnchor
@@ -4395,7 +4395,7 @@ rs _ = panic "Parser should only have RealSrcSpan"
hsDoAnn :: Located a -> LocatedAn t b -> AnnKeywordId -> AnnList
hsDoAnn (L l _) (L ll _) kw
- = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (EpaSpan $ rs l)] []
+ = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (srcSpan2e l)] []
listAsAnchor :: [LocatedAn t a] -> Anchor
listAsAnchor [] = spanAsAnchor noSrcSpan
@@ -4435,16 +4435,16 @@ addTrailingAnnA (L (SrcSpanAnn anns l) a) ss ta = do
let
anns' = if isZeroWidthSpan ss
then anns
- else addTrailingAnnToA l (ta (EpaSpan $ rs ss)) cs anns
+ else addTrailingAnnToA l (ta (srcSpan2e ss)) cs anns
return (L (SrcSpanAnn anns' l) a)
-- -------------------------------------
addTrailingVbarL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a)
-addTrailingVbarL la span = addTrailingAnnL la (AddVbarAnn (EpaSpan $ rs span))
+addTrailingVbarL la span = addTrailingAnnL la (AddVbarAnn (srcSpan2e span))
addTrailingCommaL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a)
-addTrailingCommaL la span = addTrailingAnnL la (AddCommaAnn (EpaSpan $ rs span))
+addTrailingCommaL la span = addTrailingAnnL la (AddCommaAnn (srcSpan2e span))
addTrailingAnnL :: MonadP m => LocatedL a -> TrailingAnn -> m (LocatedL a)
addTrailingAnnL (L (SrcSpanAnn anns l) a) ta = do
@@ -4462,7 +4462,7 @@ addTrailingCommaN (L (SrcSpanAnn anns l) a) span = do
-- AZ:TODO: generalise updating comments into an annotation
let anns' = if isZeroWidthSpan span
then anns
- else addTrailingCommaToN l anns (EpaSpan $ rs span)
+ else addTrailingCommaToN l anns (srcSpan2e span)
return (L (SrcSpanAnn anns' l) a)
addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -51,7 +51,7 @@ module GHC.Parser.Annotation (
la2na, na2la, n2l, l2n, l2l, la2la,
reLoc, reLocA, reLocL, reLocC, reLocN,
- la2r, realSrcSpan,
+ srcSpan2e, la2e, realSrcSpan,
-- ** Building up annotations
extraToAnnList, reAnn,
@@ -403,7 +403,7 @@ data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
-- in the @'EpaDelta'@ variant captures any comments between the prior
-- output and the thing being marked here, since we cannot otherwise
-- sort the relative order.
-data EpaLocation = EpaSpan !RealSrcSpan
+data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan)
| EpaDelta !DeltaPos ![LEpaComment]
deriving (Data,Eq)
@@ -447,15 +447,15 @@ getDeltaLine (DifferentLine r _) = r
-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
-- partial function is safe.
epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
-epaLocationRealSrcSpan (EpaSpan r) = r
+epaLocationRealSrcSpan (EpaSpan r _) = r
epaLocationRealSrcSpan (EpaDelta _ _) = panic "epaLocationRealSrcSpan"
epaLocationFromSrcAnn :: SrcAnn ann -> EpaLocation
-epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l)
-epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc)
+epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l) Strict.Nothing
+epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc) Strict.Nothing
instance Outputable EpaLocation where
- ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
+ ppr (EpaSpan r _) = text "EpaSpan" <+> ppr r
ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
instance Outputable AddEpAnn where
@@ -916,8 +916,12 @@ realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary
where
l = mkRealSrcLoc (fsLit "foo") (-1) (-1)
-la2r :: SrcSpanAnn' a -> RealSrcSpan
-la2r l = realSrcSpan (locA l)
+srcSpan2e :: SrcSpan -> EpaLocation
+srcSpan2e (RealSrcSpan s mb) = EpaSpan s mb
+srcSpan2e span = EpaSpan (realSrcSpan span) Strict.Nothing
+
+la2e :: SrcSpanAnn' a -> EpaLocation
+la2e = srcSpan2e . locA
extraToAnnList :: AnnList -> [AddEpAnn] -> AnnList
extraToAnnList (AnnList a o c e t) as = AnnList a o c (e++as) t
@@ -976,7 +980,7 @@ widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan s as = foldl combineSrcSpans s (go as)
where
go [] = []
- go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Strict.Nothing : go rest
+ go (AddEpAnn _ (EpaSpan s mb):rest) = RealSrcSpan s mb : go rest
go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
-- | The annotations need to all come after the anchor. Make sure
@@ -985,7 +989,7 @@ widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan
widenRealSpan s as = foldl combineRealSrcSpans s (go as)
where
go [] = []
- go (AddEpAnn _ (EpaSpan s):rest) = s : go rest
+ go (AddEpAnn _ (EpaSpan s _):rest) = s : go rest
go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3646,7 +3646,7 @@ warn_unknown_prag prags span buf len buf2 = do
-- 'AddEpAnn' values for the opening and closing bordering on the start
-- and end of the span
mkParensEpAnn :: RealSrcSpan -> (AddEpAnn, AddEpAnn)
-mkParensEpAnn ss = (AddEpAnn AnnOpenP (EpaSpan lo),AddEpAnn AnnCloseP (EpaSpan lc))
+mkParensEpAnn ss = (AddEpAnn AnnOpenP (EpaSpan lo Strict.Nothing),AddEpAnn AnnCloseP (EpaSpan lc Strict.Nothing))
where
f = srcSpanFile ss
sl = srcSpanStartLine ss
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -471,13 +471,13 @@ annBinds a cs (HsIPBinds an bs) = (HsIPBinds (add_where a an cs) bs, Nothing)
annBinds _ cs (EmptyLocalBinds x) = (EmptyLocalBinds x, Just cs)
add_where :: AddEpAnn -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList
-add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs) cs2
+add_where an@(AddEpAnn _ (EpaSpan rs _)) (EpAnn a (AnnList anc o c r t) cs) cs2
| valid_anchor (anchor a)
= EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) (cs Semi.<> cs2)
| otherwise
= EpAnn (patch_anchor rs a)
(AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) (cs Semi.<> cs2)
-add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed cs
+add_where an@(AddEpAnn _ (EpaSpan rs _)) EpAnnNotUsed cs
= EpAnn (Anchor rs UnchangedAnchor)
(AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) cs
add_where (AddEpAnn _ (EpaDelta _ _)) _ _ = panic "add_where"
@@ -501,7 +501,7 @@ fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)
-- | The 'Anchor' for a stmtlist is based on either the location or
-- the first semicolon annotion.
stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Anchor
-stmtsAnchor (L l ((ConsOL (AddEpAnn _ (EpaSpan r)) _), _))
+stmtsAnchor (L l ((ConsOL (AddEpAnn _ (EpaSpan r _)) _), _))
= widenAnchorR (Anchor (realSrcSpan l) UnchangedAnchor) r
stmtsAnchor (L l _) = Anchor (realSrcSpan l) UnchangedAnchor
@@ -1039,13 +1039,13 @@ checkTyClHdr is_cls ty
newAnns (SrcSpanAnn EpAnnNotUsed l) (EpAnn as (AnnParen _ o c) cs) =
let
lr = combineRealSrcSpans (realSrcSpan l) (anchor as)
- an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs)
+ an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (srcSpan2e l) c []) cs)
in SrcSpanAnn an (RealSrcSpan lr Strict.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 (EpaSpan $ realSrcSpan l) c ta) (csp Semi.<> cs))
+ an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (srcSpan2e l) c ta) (csp Semi.<> cs))
in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing)
-- | Yield a parse error if we have a function applied directly to a do block
@@ -2855,7 +2855,7 @@ checkImportSpec ie@(L _ specs) =
mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
mkImpExpSubSpec [] = return ([], ImpExpList [])
mkImpExpSubSpec [L la ImpExpQcWildcard] =
- return ([AddEpAnn AnnDotdot (EpaSpan $ la2r la)], ImpExpAll)
+ return ([AddEpAnn AnnDotdot (la2e la)], ImpExpAll)
mkImpExpSubSpec xs =
if (any (isImpExpQcWildcard . unLoc) xs)
then return $ ([], ImpExpAllWith xs)
@@ -3124,14 +3124,14 @@ mkMultTy pct t arr = HsExplicitMult pct t arr
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc
-mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r)
+mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb)
-- Precondition: the TokenLocation has EpaSpan, never EpaDelta.
token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation
token_location_widenR NoTokenLoc _ = NoTokenLoc
token_location_widenR tl (UnhelpfulSpan _) = tl
-token_location_widenR (TokenLoc (EpaSpan r1)) (RealSrcSpan r2 _) =
- (TokenLoc (EpaSpan (combineRealSrcSpans r1 r2)))
+token_location_widenR (TokenLoc (EpaSpan r1 mb1)) (RealSrcSpan r2 mb2) =
+ (TokenLoc (EpaSpan (combineRealSrcSpans r1 r2) (liftA2 combineBufSpans mb1 mb2)))
token_location_widenR (TokenLoc (EpaDelta _ _)) _ =
-- Never happens because the parser does not produce EpaDelta.
panic "token_location_widenR: EpaDelta"
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -2011,14 +2011,14 @@ printMinimalImports hsc_src imports_w_usage
to_ie_post_rn_var :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn_var (L l n)
- | isDataOcc $ occName n = L l (IEPattern (EpaSpan $ la2r l) (L (la2na l) n))
- | otherwise = L l (IEName noExtField (L (la2na l) n))
+ | isDataOcc $ occName n = L l (IEPattern (la2e l) (L (la2na l) n))
+ | otherwise = L l (IEName noExtField (L (la2na l) n))
to_ie_post_rn :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (L l n)
- | isTcOcc occ && isSymOcc occ = L l (IEType (EpaSpan $ la2r l) (L (la2na l) n))
- | otherwise = L l (IEName noExtField (L (la2na l) n))
+ | isTcOcc occ && isSymOcc occ = L l (IEType (la2e l) (L (la2na l) n))
+ | otherwise = L l (IEName noExtField (L (la2na l) n))
where occ = occName n
{-
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -70,6 +70,7 @@ module GHC.Types.SrcLoc (
BufSpan(..),
getBufSpan,
removeBufSpan,
+ combineBufSpans,
-- * Located
Located,
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -543,7 +543,7 @@ printStringAtAAL (EpAnn anc an cs) l str = do
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
-printStringAtAAC capture (EpaSpan r) s = printStringAtRsC capture r s
+printStringAtAAC capture (EpaSpan r _) s = printStringAtRsC capture r s
printStringAtAAC capture (EpaDelta d cs) s = do
mapM_ (printOneComment . tokComment) cs
pe1 <- getPriorEndD
@@ -4108,7 +4108,7 @@ printUnicode anc n = do
s -> s
loc <- printStringAtAAC NoCaptureComments (EpaDelta (SameLine 0) []) str
case loc of
- EpaSpan _ -> return anc
+ EpaSpan _ _ -> return anc
EpaDelta dp [] -> return anc { anchor_op = MovedAnchor dp }
EpaDelta _ _cs -> error "printUnicode should not capture comments"
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -285,7 +285,7 @@ fixModuleTrailingComments (GHC.L l p) = GHC.L l p'
rebalance al cs = cs'
where
cs' = case GHC.al_close al of
- Just (GHC.AddEpAnn _ (GHC.EpaSpan ss)) ->
+ Just (GHC.AddEpAnn _ (GHC.EpaSpan ss _)) ->
let
pc = GHC.priorComments cs
fc = GHC.getFollowingComments cs
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -213,7 +213,7 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H
L (SrcSpanAnn EpAnnNotUsed ll) _ -> realSrcSpan ll
L (SrcSpanAnn (EpAnn anc' _ _) _) _ -> anchor anc' -- TODO MovedAnchor?
dc' = case dca of
- EpaSpan r -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])
+ EpaSpan r _ -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])
EpaDelta _ _ -> AddEpAnn kw dca
-- ---------------------------------
@@ -223,7 +223,7 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H
(L (SrcSpanAnn EpAnnNotUsed ll) b)
-> let
op = case dca of
- EpaSpan r -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll))
+ EpaSpan r _ -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll))
EpaDelta _ _ -> MovedAnchor (SameLine 1)
in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) mempty emptyComments) ll) b)
(L (SrcSpanAnn (EpAnn (Anchor r op) a c) ll) b)
@@ -231,7 +231,7 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H
op' = case op of
MovedAnchor _ -> op
_ -> case dca of
- EpaSpan dcr -> MovedAnchor (ss2delta (ss2posEnd dcr) r)
+ EpaSpan dcr _ -> MovedAnchor (ss2delta (ss2posEnd dcr) r)
EpaDelta _ _ -> MovedAnchor (SameLine 1)
in (L (SrcSpanAnn (EpAnn (Anchor r op') a c) ll) b)
@@ -341,13 +341,13 @@ getEntryDP _ = SameLine 1
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta _off _anc (EpaDelta d cs) = EpaDelta d cs
-addEpaLocationDelta off anc (EpaSpan r)
+addEpaLocationDelta off anc (EpaSpan r _)
= EpaDelta (adjustDeltaForOffset off (ss2deltaEnd anc r)) []
-- Set the entry DP for an element coming after an existing keyword annotation
setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
setEntryDPFromAnchor _off (EpaDelta _ _) (L la a) = L la a
-setEntryDPFromAnchor off (EpaSpan anc) ll@(L la _) = setEntryDP ll dp'
+setEntryDPFromAnchor off (EpaSpan anc _) ll@(L la _) = setEntryDP ll dp'
where
r = case la of
(SrcSpanAnn EpAnnNotUsed l) -> realSrcSpan l
@@ -944,7 +944,7 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
(L (TokenLoc l) ls, L (TokenLoc i) is) ->
let
off = case l of
- (EpaSpan r) -> LayoutStartCol $ snd $ ss2pos r
+ (EpaSpan r _) -> LayoutStartCol $ snd $ ss2pos r
(EpaDelta (SameLine _) _) -> LayoutStartCol 0
(EpaDelta (DifferentLine _ c) _) -> LayoutStartCol c
ex'' = setEntryDPFromAnchor off i ex
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -119,7 +119,7 @@ undelta (l,_) (DifferentLine dl dc) (LayoutStartCol co) = (fl,fc)
fc = co + dc
undeltaSpan :: RealSrcSpan -> AnnKeywordId -> DeltaPos -> AddEpAnn
-undeltaSpan anchor kw dp = AddEpAnn kw (EpaSpan sp)
+undeltaSpan anchor kw dp = AddEpAnn kw (EpaSpan sp Strict.Nothing)
where
(l,c) = undelta (ss2pos anchor) dp (LayoutStartCol 0)
len = length (keywordToString kw)
@@ -256,7 +256,7 @@ sortEpaComments cs = sortBy cmp cs
-- | Makes a comment which originates from a specific keyword.
mkKWComment :: AnnKeywordId -> EpaLocation -> Comment
-mkKWComment kw (EpaSpan ss)
+mkKWComment kw (EpaSpan ss _)
= Comment (keywordToString kw) (Anchor ss UnchangedAnchor) ss (Just kw)
mkKWComment kw (EpaDelta dp _)
= Comment (keywordToString kw) (Anchor placeholderRealSpan (MovedAnchor dp)) placeholderRealSpan (Just kw)
@@ -373,7 +373,7 @@ addEpAnnLoc (AddEpAnn _ l) = l
-- TODO: move this to GHC
anchorToEpaLocation :: Anchor -> EpaLocation
-anchorToEpaLocation (Anchor r UnchangedAnchor) = EpaSpan r
+anchorToEpaLocation (Anchor r UnchangedAnchor) = EpaSpan r Strict.Nothing
anchorToEpaLocation (Anchor _ (MovedAnchor dp)) = EpaDelta dp []
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1fa730d319fa475b4eab79d95bcbe213ff43a48
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1fa730d319fa475b4eab79d95bcbe213ff43a48
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221204/2a110d0e/attachment-0001.html>
More information about the ghc-commits
mailing list