[Git][ghc/ghc][master] EPA: Bring back SrcSpan in EpaDelta
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jul 12 15:46:07 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
cb83c347 by Alan Zimmerman at 2024-07-12T11:44:35-04:00
EPA: Bring back SrcSpan in EpaDelta
When processing files in ghc-exactprint, the usual workflow is to
first normalise it with makeDeltaAst, and then operate on it.
But we need the original locations to operate on it, in terms of
finding things.
So restore the original SrcSpan for reference in EpaDelta
- - - - -
12 changed files:
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Types/SrcLoc.hs
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -147,9 +147,9 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s
- epaAnchor (EpaDelta d cs) = case ba of
- NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> showAstData' cs
- BlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> text "blanked"
+ epaAnchor (EpaDelta s d cs) = case ba of
+ NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> showAstData' cs
+ BlankEpAnnotations -> parens $ text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> text "blanked"
deltaPos :: DeltaPos -> SDoc
deltaPos (SameLine c) = parens $ text "SameLine" <+> ppr c
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -459,12 +459,12 @@ type EpaLocation = EpaLocation' [LEpaComment]
epaToNoCommentsLocation :: EpaLocation -> NoCommentsLocation
epaToNoCommentsLocation (EpaSpan ss) = EpaSpan ss
-epaToNoCommentsLocation (EpaDelta dp []) = EpaDelta dp NoComments
-epaToNoCommentsLocation (EpaDelta _ _ ) = panic "epaToNoCommentsLocation"
+epaToNoCommentsLocation (EpaDelta ss dp []) = EpaDelta ss dp NoComments
+epaToNoCommentsLocation (EpaDelta _ _ _ ) = panic "epaToNoCommentsLocation"
noCommentsToEpaLocation :: NoCommentsLocation -> EpaLocation
noCommentsToEpaLocation (EpaSpan ss) = EpaSpan ss
-noCommentsToEpaLocation (EpaDelta dp NoComments) = EpaDelta dp []
+noCommentsToEpaLocation (EpaDelta ss dp NoComments) = EpaDelta ss dp []
-- | Tokens embedded in the AST have an EpaLocation, unless they come from
-- generated code (e.g. by TH).
@@ -550,8 +550,8 @@ spanAsAnchor ss = EpaSpan ss
realSpanAsAnchor :: RealSrcSpan -> (EpaLocation' a)
realSpanAsAnchor s = EpaSpan (RealSrcSpan s Strict.Nothing)
-noSpanAnchor :: (NoAnn a) => (EpaLocation' a)
-noSpanAnchor = EpaDelta (SameLine 0) noAnn
+noSpanAnchor :: (NoAnn a) => EpaLocation' a
+noSpanAnchor = EpaDelta noSrcSpan (SameLine 0) noAnn
-- ---------------------------------------------------------------------
@@ -1044,7 +1044,7 @@ instance HasLoc (EpAnn a) where
instance HasLoc EpaLocation where
getHasLoc (EpaSpan l) = l
- getHasLoc (EpaDelta _ _) = noSrcSpan
+ getHasLoc (EpaDelta l _ _) = l
getHasLocList :: HasLoc a => [a] -> SrcSpan
getHasLocList [] = noSrcSpan
@@ -1088,7 +1088,7 @@ widenSpan s as = foldl combineSrcSpans s (go as)
go [] = []
go (AddEpAnn _ (EpaSpan (RealSrcSpan s mb)):rest) = RealSrcSpan s mb : go rest
go (AddEpAnn _ (EpaSpan _):rest) = go rest
- go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
+ go (AddEpAnn _ (EpaDelta _ _ _):rest) = go rest
-- | The annotations need to all come after the anchor. Make sure
-- this is the case.
@@ -1132,7 +1132,7 @@ widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
widenAnchor (EpaSpan (RealSrcSpan s mb)) as
= EpaSpan (RealSrcSpan (widenRealSpan s as) (liftA2 combineBufSpans mb (bufSpanFromAnns as)))
widenAnchor (EpaSpan us) _ = EpaSpan us
-widenAnchor a@(EpaDelta _ _) as = case (realSpanFromAnns as) of
+widenAnchor a at EpaDelta{} as = case (realSpanFromAnns as) of
Strict.Nothing -> a
Strict.Just r -> EpaSpan (RealSrcSpan r Strict.Nothing)
@@ -1140,7 +1140,7 @@ widenAnchorS :: Anchor -> SrcSpan -> Anchor
widenAnchorS (EpaSpan (RealSrcSpan s mbe)) (RealSrcSpan r mbr)
= EpaSpan (RealSrcSpan (combineRealSrcSpans s r) (liftA2 combineBufSpans mbe mbr))
widenAnchorS (EpaSpan us) _ = EpaSpan us
-widenAnchorS (EpaDelta _ _) (RealSrcSpan r mb) = EpaSpan (RealSrcSpan r mb)
+widenAnchorS EpaDelta{} (RealSrcSpan r mb) = EpaSpan (RealSrcSpan r mb)
widenAnchorS anc _ = anc
widenLocatedAn :: EpAnn an -> [AddEpAnn] -> EpAnn an
@@ -1290,7 +1290,7 @@ instance Semigroup EpaLocation where
EpaSpan s1 <> EpaSpan s2 = EpaSpan (combineSrcSpans s1 s2)
EpaSpan s1 <> _ = EpaSpan s1
_ <> EpaSpan s2 = EpaSpan s2
- EpaDelta dp1 cs1 <> EpaDelta _dp2 cs2 = EpaDelta dp1 (cs1<>cs2)
+ EpaDelta s1 dp1 cs1 <> EpaDelta s2 _dp2 cs2 = EpaDelta (combineSrcSpans s1 s2) dp1 (cs1<>cs2)
instance Semigroup EpAnnComments where
EpaComments cs1 <> EpaComments cs2 = EpaComments (cs1 ++ cs2)
@@ -1314,7 +1314,7 @@ instance Monoid (AnnSortKey tag) where
-- ---------------------------------------------------------------------
instance NoAnn EpaLocation where
- noAnn = EpaDelta (SameLine 0) []
+ noAnn = EpaDelta noSrcSpan (SameLine 0) []
instance NoAnn AnnKeywordId where
noAnn = Annlarrowtail {- gotta pick one -}
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -482,7 +482,7 @@ valid_anchor _ = False
-- If the decl list for where binds is empty, the anchor ends up
-- invalid. In this case, use the parent one
patch_anchor :: RealSrcSpan -> Anchor -> Anchor
-patch_anchor r (EpaDelta _ _) = EpaSpan (RealSrcSpan r Strict.Nothing)
+patch_anchor r EpaDelta{} = EpaSpan (RealSrcSpan r Strict.Nothing)
patch_anchor r1 (EpaSpan (RealSrcSpan r0 mb)) = EpaSpan (RealSrcSpan r mb)
where
r = if srcSpanStartLine r0 < 0 then r1 else r0
@@ -976,7 +976,7 @@ checkTyVars pp_what equals_or_where tc tparms
-- Return an AddEpAnn for use in widenLocatedAn. The AnnKeywordId is not used.
for_widening :: HsBndrVis GhcPs -> AddEpAnn
for_widening (HsBndrInvisible (EpTok loc)) = AddEpAnn AnnAnyclass loc
- for_widening _ = AddEpAnn AnnAnyclass (EpaDelta (SameLine 0) [])
+ for_widening _ = AddEpAnn AnnAnyclass noAnn
whereDots, equalsDots :: SDoc
@@ -3277,7 +3277,7 @@ epTokenWidenR :: EpToken tok -> SrcSpan -> EpToken tok'
epTokenWidenR NoEpTok _ = NoEpTok
epTokenWidenR (EpTok l) (UnhelpfulSpan _) = EpTok l
epTokenWidenR (EpTok (EpaSpan s1)) s2 = EpTok (EpaSpan (combineSrcSpans s1 s2))
-epTokenWidenR (EpTok (EpaDelta _ _)) _ =
+epTokenWidenR (EpTok EpaDelta{}) _ =
-- Never happens because the parser does not produce EpaDelta.
panic "epTokenWidenR: EpaDelta"
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -914,9 +914,12 @@ mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
-- 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.
+-- The EpaDelta also contains the original @'SrcSpan'@ for use by
+-- tools wanting to manipulate the AST after converting it using
+-- ghc-exactprint' @'makeDeltaAst'@.
data EpaLocation' a = EpaSpan !SrcSpan
- | EpaDelta !DeltaPos !a
+ | EpaDelta !SrcSpan !DeltaPos !a
deriving (Data,Eq,Show)
type NoCommentsLocation = EpaLocation' NoComments
@@ -957,7 +960,7 @@ instance Outputable NoComments where
instance (Outputable a) => Outputable (EpaLocation' a) where
ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
- ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
+ ppr (EpaDelta s d cs) = text "EpaDelta" <+> ppr s <+> ppr d <+> ppr cs
instance Outputable DeltaPos where
ppr (SameLine c) = text "SameLine" <+> ppr c
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -74,10 +74,10 @@
[]))
(GRHS
(EpAnn
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(GrhsAnn
(Nothing)
- (AddEpAnn Annlarrowtail (EpaDelta (SameLine 0) [])))
+ (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) [])))
(EpaComments
[]))
[]
@@ -276,8 +276,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:11-16 })
@@ -370,8 +370,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:27-35 })
@@ -796,8 +796,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:23-36 })
@@ -899,8 +899,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:43-51 })
@@ -1012,8 +1012,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:11-33 })
@@ -1025,10 +1025,10 @@
(NoExtField)
(HsForAllInvis
(EpAnn
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
((,)
- (AddEpAnn Annlarrowtail (EpaDelta (SameLine 0) []))
- (AddEpAnn Annlarrowtail (EpaDelta (SameLine 0) [])))
+ (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) []))
+ (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) [])))
(EpaComments
[]))
[(L
@@ -1350,8 +1350,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:26-28 })
@@ -1822,8 +1822,8 @@
(HsParTy
(AnnParen
AnnParens
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
+ (EpaDelta { <no location info> } (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:18-26 })
@@ -2256,9 +2256,9 @@
(ImportDecl
(XImportDeclPass
(EpAnn
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(EpAnnImportDecl
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
=====================================
@@ -1975,10 +1975,10 @@
[]))
(GRHS
(EpAnn
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(GrhsAnn
(Nothing)
- (AddEpAnn Annlarrowtail (EpaDelta (SameLine 0) [])))
+ (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) [])))
(EpaComments
[]))
[]
=====================================
testsuite/tests/parser/should_compile/T14189.stderr
=====================================
@@ -217,9 +217,9 @@
(ImportDecl
(XImportDeclPass
(EpAnn
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(EpAnnImportDecl
- (EpaDelta (SameLine 0) [])
+ (EpaDelta { <no location info> } (SameLine 0) [])
(Nothing)
(Nothing)
(Nothing)
@@ -318,11 +318,13 @@
,{Name: T14189.NT}])])])
(Nothing)
(Just
- (L
+ (L
(EpAnn
- (EpaSpan { T14189.hs:1:8-13 })
- (AnnListItem
+ (EpaSpan { T14189.hs:1:8-13 })
+ (AnnListItem
[])
- (EpaComments
+ (EpaComments
[]))
{ModuleName: T14189}))))
+
+
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -406,8 +406,8 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
acceptSpan <- getAcceptSpan
setAcceptSpan False
case anchor' of
- EpaDelta _ _ -> setAcceptSpan True
- _ -> return ()
+ EpaDelta _ _ _ -> setAcceptSpan True
+ _ -> return ()
p <- getPosP
pe0 <- getPriorEndD
debugM $ "enterAnn:starting:(anchor',p,pe,a) =" ++ show (showAst anchor', p, pe0, astId a)
@@ -420,7 +420,7 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
CanUpdateAnchor -> pushAppliedComments
_ -> return ()
case anchor' of
- EpaDelta _ dcs -> do
+ EpaDelta _ _ dcs -> do
debugM $ "enterAnn:Printing comments:" ++ showGhc (priorComments cs)
mapM_ printOneComment (concatMap tokComment $ priorComments cs)
debugM $ "enterAnn:Printing EpaDelta comments:" ++ showGhc dcs
@@ -433,7 +433,7 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
priorCs <- cua canUpdateAnchor takeAppliedComments -- no pop
-- -------------------------
case anchor' of
- EpaDelta dp _ -> do
+ EpaDelta _ dp _ -> do
debugM $ "enterAnn: EpaDelta:" ++ show dp
-- Set the original anchor as prior end, so the rest of this AST
-- fragment has a reference
@@ -475,14 +475,14 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
off (ss2delta priorEndAfterComments curAnchor)
debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)
let edp'' = case anchor' of
- EpaDelta dp _ -> dp
+ EpaDelta _ dp _ -> dp
_ -> edp'
-- ---------------------------------------------
med <- getExtraDP
setExtraDP Nothing
let edp = case med of
Nothing -> edp''
- Just (EpaDelta dp _) -> dp
+ Just (EpaDelta _ dp _) -> dp
-- Replace original with desired one. Allows all
-- list entry values to be DP (1,0)
Just (EpaSpan (RealSrcSpan r _)) -> dp
@@ -536,7 +536,7 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
debugM $ "enterAnn:done:(anchor,p,pe,a) =" ++ show (showAst anchor', p1, pe1, astId a')
case anchor' of
- EpaDelta _ _ -> return ()
+ EpaDelta _ _ _ -> return ()
EpaSpan (RealSrcSpan rss _) -> do
setAcceptSpan False
setPriorEndD (snd $ rs2range rss)
@@ -554,7 +554,8 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
trailing' <- markTrailing trailing_anns
-- Update original anchor, comments based on the printing process
- let newAchor = EpaDelta edp []
+ -- TODO:AZ: probably need to put something appropriate in instead of noSrcSpan
+ let newAchor = EpaDelta noSrcSpan edp []
let r = case canUpdateAnchor of
CanUpdateAnchor -> setAnnotationAnchor a' newAchor trailing' (mkEpaComments (priorCs ++ postCs) [])
CanUpdateAnchorOnly -> setAnnotationAnchor a' newAchor [] emptyComments
@@ -653,8 +654,8 @@ printSourceText (NoSourceText) txt = printStringAdvance txt >> return ()
printSourceText (SourceText txt) _ = printStringAdvance (unpackFS txt) >> return ()
printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()
-printSourceTextAA (NoSourceText) txt = printStringAtAA (EpaDelta (SameLine 0) []) txt >> return ()
-printSourceTextAA (SourceText txt) _ = printStringAtAA (EpaDelta (SameLine 0) []) (unpackFS txt) >> return ()
+printSourceTextAA (NoSourceText) txt = printStringAtAA noAnn txt >> return ()
+printSourceTextAA (SourceText txt) _ = printStringAtAA noAnn (unpackFS txt) >> return ()
-- ---------------------------------------------------------------------
@@ -681,9 +682,9 @@ printStringAtRsC capture pa str = do
NoCaptureComments -> return []
debugM $ "printStringAtRsC:cs'=" ++ show cs'
debugM $ "printStringAtRsC:p'=" ++ showAst p'
- debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' NoComments)
- debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))
- return (EpaDelta p' (map comment2LEpaComment cs'))
+ debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta noSrcSpan p' NoComments)
+ debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta noSrcSpan p' (map comment2LEpaComment cs'))
+ return (EpaDelta noSrcSpan p' (map comment2LEpaComment cs'))
printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()
printStringAtRs' pa str = printStringAtRsC NoCaptureComments pa str >> return ()
@@ -695,7 +696,7 @@ printStringAtMLoc' :: (Monad m, Monoid w)
printStringAtMLoc' (Just aa) s = Just <$> printStringAtAA aa s
printStringAtMLoc' Nothing s = do
printStringAtLsDelta (SameLine 1) s
- return (Just (EpaDelta (SameLine 1) []))
+ return (Just (EpaDelta noSrcSpan (SameLine 1) []))
printStringAtMLocL :: (Monad m, Monoid w)
=> EpAnn a -> Lens a (Maybe EpaLocation) -> String -> EP w m (EpAnn a)
@@ -706,7 +707,7 @@ printStringAtMLocL (EpAnn anc an cs) l s = do
go (Just aa) str = Just <$> printStringAtAA aa str
go Nothing str = do
printStringAtLsDelta (SameLine 1) str
- return (Just (EpaDelta (SameLine 1) []))
+ return (Just (EpaDelta noSrcSpan (SameLine 1) []))
printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation
printStringAtAA el str = printStringAtAAC CaptureComments el str
@@ -726,7 +727,7 @@ printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s
printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss
-printStringAtAAC capture (EpaDelta d cs) s = do
+printStringAtAAC capture (EpaDelta ss d cs) s = do
mapM_ printOneComment $ concatMap tokComment cs
pe1 <- getPriorEndD
p1 <- getPosP
@@ -739,7 +740,7 @@ printStringAtAAC capture (EpaDelta d cs) s = do
CaptureComments -> takeAppliedComments
NoCaptureComments -> return []
debugM $ "printStringAtAA:(pe1,pe2,p1,p2,cs')=" ++ show (pe1,pe2,p1,p2,cs')
- return (EpaDelta d (map comment2LEpaComment cs'))
+ return (EpaDelta ss d (map comment2LEpaComment cs'))
-- ---------------------------------------------------------------------
@@ -1486,7 +1487,7 @@ printOneComment :: (Monad m, Monoid w) => Comment -> EP w m ()
printOneComment c@(Comment _str loc _r _mo) = do
debugM $ "printOneComment:c=" ++ showGhc c
dp <-case loc of
- EpaDelta dp _ -> return dp
+ EpaDelta _ dp _ -> return dp
EpaSpan (RealSrcSpan r _) -> do
pe <- getPriorEndD
debugM $ "printOneComment:pe=" ++ showGhc pe
@@ -1496,7 +1497,7 @@ printOneComment c@(Comment _str loc _r _mo) = do
EpaSpan (UnhelpfulSpan _) -> return (SameLine 0)
mep <- getExtraDP
dp' <- case mep of
- Just (EpaDelta edp _) -> do
+ Just (EpaDelta _ edp _) -> do
debugM $ "printOneComment:edp=" ++ show edp
adjustDeltaForOffsetM edp
_ -> return dp
@@ -1513,7 +1514,7 @@ updateAndApplyComment (Comment str anc pp mo) dp = do
where
(r,c) = ss2posEnd pp
dp'' = case anc of
- EpaDelta dp1 _ -> dp1
+ EpaDelta _ dp1 _ -> dp1
EpaSpan (RealSrcSpan la _) ->
if r == 0
then (ss2delta (r,c+0) la)
@@ -1527,12 +1528,12 @@ updateAndApplyComment (Comment str anc pp mo) dp = do
_ -> dp''
op' = case dp' of
SameLine n -> if n >= 0
- then EpaDelta dp' NoComments
- else EpaDelta dp NoComments
- _ -> EpaDelta dp' NoComments
- anc' = if str == "" && op' == EpaDelta (SameLine 0) NoComments -- EOF comment
- then EpaDelta dp NoComments
- else EpaDelta dp NoComments
+ then EpaDelta noSrcSpan dp' NoComments
+ else EpaDelta noSrcSpan dp NoComments
+ _ -> EpaDelta noSrcSpan dp' NoComments
+ anc' = if str == "" && op' == EpaDelta noSrcSpan (SameLine 0) NoComments -- EOF comment
+ then EpaDelta noSrcSpan dp NoComments
+ else EpaDelta noSrcSpan dp NoComments
-- ---------------------------------------------------------------------
@@ -4265,11 +4266,11 @@ printUnicode anc n = do
-- TODO: unicode support?
"forall" -> if spanLength (anchor anc) == 1 then "∀" else "forall"
s -> s
- loc <- printStringAtAAC NoCaptureComments (EpaDelta (SameLine 0) []) str
+ loc <- printStringAtAAC NoCaptureComments (EpaDelta noSrcSpan (SameLine 0) []) str
case loc of
EpaSpan _ -> return anc
- EpaDelta dp [] -> return $ EpaDelta dp []
- EpaDelta _ _cs -> error "printUnicode should not capture comments"
+ EpaDelta ss dp [] -> return $ EpaDelta ss dp []
+ EpaDelta _ _ _cs -> error "printUnicode should not capture comments"
markName :: (Monad m, Monoid w)
=====================================
utils/check-exact/Main.hs
=====================================
@@ -451,9 +451,9 @@ changeLetIn1 _libdir parsed
[l2,_l1] = map wrapDecl decls
decls' = concatMap decl2Bind [l2]
(L _ e) = expr
- a = EpAnn (EpaDelta (SameLine 1) []) noAnn emptyComments
+ a = EpAnn (EpaDelta noSrcSpan (SameLine 1) []) noAnn emptyComments
expr' = L a e
- tkIn' = EpTok (EpaDelta (DifferentLine 1 0) [])
+ tkIn' = EpTok (EpaDelta noSrcSpan (DifferentLine 1 0) [])
in (HsLet (tkLet, tkIn')
(HsValBinds x (ValBinds xv decls' sigs)) expr')
@@ -525,7 +525,7 @@ changeLocalDecls libdir (L l p) = do
os' = setEntryDP os (DifferentLine 2 0)
let sortKey = captureOrderBinds decls
let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van
- let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs)
+ let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 5) [])) a b c dd) cs)
-- let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van
-- let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs)
let binds' = (HsValBinds van'
@@ -551,11 +551,11 @@ changeLocalDecls2 libdir (L l p) = do
replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
-> Transform (LMatch GhcPs (LHsExpr GhcPs))
replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do
- let anc = (EpaDelta (DifferentLine 1 3) [])
- let anc2 = (EpaDelta (DifferentLine 1 5) [])
+ let anc = (EpaDelta noSrcSpan (DifferentLine 1 3) [])
+ let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 5) [])
let an = EpAnn anc
(AnnList (Just anc2) Nothing Nothing
- [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])] [])
+ [AddEpAnn AnnWhere (EpaDelta noSrcSpan (SameLine 0) [])] [])
emptyComments
let decls = [s,d]
let sortKey = captureOrderBinds decls
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -218,8 +218,8 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig dc rs') ns (HsWC xw ty))))
rd = case last ns of
L (EpAnn anc' _ _) _ -> anchor anc' -- TODO MovedAnchor?
dc' = case dca of
- EpaSpan (RealSrcSpan r _) -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])
- _ -> AddEpAnn kw dca
+ EpaSpan ss@(RealSrcSpan r _) -> AddEpAnn kw (EpaDelta ss (ss2delta (ss2posEnd rd) r) [])
+ _ -> AddEpAnn kw dca
-- ---------------------------------
@@ -228,10 +228,10 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig dc rs') ns (HsWC xw ty))))
(L (EpAnn anc0 a c) b)
-> let
anc' = case anc0 of
- EpaDelta _ _ -> anc0
+ EpaDelta _ _ _ -> anc0
_ -> case dca of
- EpaSpan _ -> EpaDelta (SameLine 1) []
- EpaDelta _ cs0 -> EpaDelta (SameLine 1) cs0
+ EpaSpan ss -> EpaDelta ss (SameLine 1) []
+ EpaDelta ss _ cs0 -> EpaDelta ss (SameLine 1) cs0
in (L (EpAnn anc' a c) b)
captureTypeSigSpacing s = s
@@ -254,12 +254,12 @@ setEntryDPDecl d dp = setEntryDP d dp
-- |Set the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
setEntryDP :: NoAnn t => LocatedAn t a -> DeltaPos -> LocatedAn t a
-setEntryDP (L (EpAnn (EpaSpan (UnhelpfulSpan _)) an cs) a) dp
- = L (EpAnn (EpaDelta dp []) an cs) a
-setEntryDP (L (EpAnn (EpaSpan _) an (EpaComments [])) a) dp
- = L (EpAnn (EpaDelta dp []) an (EpaComments [])) a
-setEntryDP (L (EpAnn (EpaDelta d csd) an cs) a) dp
- = L (EpAnn (EpaDelta d' csd') an cs') a
+setEntryDP (L (EpAnn (EpaSpan ss@(UnhelpfulSpan _)) an cs) a) dp
+ = L (EpAnn (EpaDelta ss dp []) an cs) a
+setEntryDP (L (EpAnn (EpaSpan ss) an (EpaComments [])) a) dp
+ = L (EpAnn (EpaDelta ss dp []) an (EpaComments [])) a
+setEntryDP (L (EpAnn (EpaDelta ss d csd) an cs) a) dp
+ = L (EpAnn (EpaDelta ss d' csd') an cs') a
where
(d', csd', cs') = case cs of
EpaComments (h:t) ->
@@ -283,22 +283,22 @@ setEntryDP (L (EpAnn (EpaDelta d csd) an cs) a) dp
in
(dp0, c':t, EpaCommentsBalanced [] ts)
go :: GenLocated NoCommentsLocation e -> (DeltaPos, GenLocated NoCommentsLocation e)
- go (L (EpaDelta _ c0) c) = (d, L (EpaDelta dp c0) c)
- go (L (EpaSpan _) c) = (d, L (EpaDelta dp NoComments) c)
-setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) a) dp
+ go (L (EpaDelta ss0 _ c0) c) = (d, L (EpaDelta ss0 dp c0) c)
+ go (L (EpaSpan ss0) c) = (d, L (EpaDelta ss0 dp NoComments) c)
+setEntryDP (L (EpAnn (EpaSpan ss@(RealSrcSpan r _)) an cs) a) dp
= case sortEpaComments (priorComments cs) of
[] ->
- L (EpAnn (EpaDelta dp []) an cs) a
+ L (EpAnn (EpaDelta ss dp []) an cs) a
(L ca c:cs') ->
- L (EpAnn (EpaDelta edp csd) an cs'') a
+ L (EpAnn (EpaDelta ss edp csd) an cs'') a
where
cs'' = setPriorComments cs []
- csd = L (EpaDelta dp NoComments) c:cs'
+ csd = L (EpaDelta ss dp NoComments) c:cs'
lc = last $ (L ca c:cs')
delta = case getLoc lc of
EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r
EpaSpan _ -> (SameLine 0)
- EpaDelta _dp _ -> DifferentLine 1 0
+ EpaDelta _ _dp _ -> DifferentLine 1 0
line = getDeltaLine delta
col = deltaColumn delta
edp' = if line == 0 then SameLine col
@@ -309,27 +309,27 @@ setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) a) dp
-- ---------------------------------------------------------------------
getEntryDP :: LocatedAn t a -> DeltaPos
-getEntryDP (L (EpAnn (EpaDelta dp _) _ _) _) = dp
+getEntryDP (L (EpAnn (EpaDelta _ dp _) _ _) _) = dp
getEntryDP _ = SameLine 1
-- ---------------------------------------------------------------------
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
-addEpaLocationDelta _off _anc (EpaDelta d cs) = EpaDelta d cs
-addEpaLocationDelta _off _anc (EpaSpan (UnhelpfulSpan _)) = EpaDelta (SameLine 0) []
-addEpaLocationDelta off anc (EpaSpan (RealSrcSpan r _))
- = EpaDelta (adjustDeltaForOffset off (ss2deltaEnd anc r)) []
+addEpaLocationDelta _off _anc (EpaDelta ss d cs) = EpaDelta ss d cs
+addEpaLocationDelta _off _anc (EpaSpan ss@(UnhelpfulSpan _)) = EpaDelta ss (SameLine 0) []
+addEpaLocationDelta off anc (EpaSpan ss@(RealSrcSpan r _))
+ = EpaDelta ss (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 (EpaDelta _ _ _) (L la a) = L la a
setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a
setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp'
where
dp' = case la of
(EpAnn (EpaSpan (RealSrcSpan r' _)) _ _) -> adjustDeltaForOffset off (ss2deltaEnd anc r')
(EpAnn (EpaSpan _) _ _) -> adjustDeltaForOffset off (SameLine 0)
- (EpAnn (EpaDelta dp _) _ _) -> adjustDeltaForOffset off dp
+ (EpAnn (EpaDelta _ dp _) _ _) -> adjustDeltaForOffset off dp
-- ---------------------------------------------------------------------
@@ -559,7 +559,7 @@ balanceComments' la1 la2 = do
trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment]
-> [(Int, LEpaComment)]
trailingCommentsDeltas _ [] = []
-trailingCommentsDeltas r (la@(L (EpaDelta dp _) _):las)
+trailingCommentsDeltas r (la@(L (EpaDelta _ dp _) _):las)
= (getDeltaLine dp, la): trailingCommentsDeltas r las
trailingCommentsDeltas r (la@(L l _):las)
= deltaComment r la : trailingCommentsDeltas (anchor l) las
@@ -576,7 +576,7 @@ priorCommentsDeltas r cs = go r (reverse $ sortEpaComments cs)
where
go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go _ [] = []
- go _ (la@(L l@(EpaDelta dp _) _):las) = (deltaLine dp, la) : go (anchor l) las
+ go _ (la@(L l@(EpaDelta _ dp _) _):las) = (deltaLine dp, la) : go (anchor l) las
go rs' (la@(L l _):las) = deltaComment rs' la : go (anchor l) las
deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
@@ -705,7 +705,7 @@ anchorEof (L l m@(HsModule (XModulePs an _lo _ _) _mn _exps _imps _decls)) = L l
-- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the
-- given @DeltaPos at .
noAnnSrcSpanDP :: (NoAnn ann) => DeltaPos -> EpAnn ann
-noAnnSrcSpanDP dp = EpAnn (EpaDelta dp []) noAnn emptyComments
+noAnnSrcSpanDP dp = EpAnn (EpaDelta noSrcSpan dp []) noAnn emptyComments
noAnnSrcSpanDP0 :: (NoAnn ann) => EpAnn ann
noAnnSrcSpanDP0 = noAnnSrcSpanDP (SameLine 0)
@@ -717,13 +717,13 @@ noAnnSrcSpanDPn :: (NoAnn ann) => Int -> EpAnn ann
noAnnSrcSpanDPn s = noAnnSrcSpanDP (SameLine s)
d0 :: EpaLocation
-d0 = EpaDelta (SameLine 0) []
+d0 = EpaDelta noSrcSpan (SameLine 0) []
d1 :: EpaLocation
-d1 = EpaDelta (SameLine 1) []
+d1 = EpaDelta noSrcSpan (SameLine 1) []
dn :: Int -> EpaLocation
-dn n = EpaDelta (SameLine n) []
+dn n = EpaDelta noSrcSpan (SameLine n) []
addComma :: SrcSpanAnnA -> SrcSpanAnnA
addComma (EpAnn anc (AnnListItem as) cs)
@@ -888,8 +888,8 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
off = case l of
(EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r
(EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0
- (EpaDelta (SameLine _) _) -> LayoutStartCol 0
- (EpaDelta (DifferentLine _ c) _) -> LayoutStartCol c
+ (EpaDelta _ (SameLine _) _) -> LayoutStartCol 0
+ (EpaDelta _ (DifferentLine _ c) _) -> LayoutStartCol c
ex'' = setEntryDPFromAnchor off i ex
newDecls'' = case newDecls of
[] -> newDecls
@@ -1095,7 +1095,7 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do
-- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, change the AnnList anchor to have the correct DP too
let (AnnList ancl o c _r t) = an
let w = case ww of
- WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]
+ WithWhere -> [AddEpAnn AnnWhere (EpaDelta noSrcSpan (SameLine 0) [])]
WithoutWhere -> []
(anc', ancl') <- do
case ww of
@@ -1108,10 +1108,10 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do
newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList)
newWhereAnnotation ww = do
- let anc = EpaDelta (DifferentLine 1 3) []
- let anc2 = EpaDelta (DifferentLine 1 5) []
+ let anc = EpaDelta noSrcSpan (DifferentLine 1 3) []
+ let anc2 = EpaDelta noSrcSpan (DifferentLine 1 5) []
let w = case ww of
- WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]
+ WithWhere -> [AddEpAnn AnnWhere (EpaDelta noSrcSpan (SameLine 0) [])]
WithoutWhere -> []
let an = EpAnn anc
(AnnList (Just anc2) Nothing Nothing w [])
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -184,8 +184,8 @@ isPointSrcSpan ss = spanLength ss == 0
-- `MovedAnchor` operation based on the original location, only if it
-- does not already have one.
commentOrigDelta :: LEpaComment -> LEpaComment
-commentOrigDelta (L (EpaSpan (RealSrcSpan la _)) (GHC.EpaComment t pp))
- = (L (EpaDelta dp NoComments) (GHC.EpaComment t pp))
+commentOrigDelta (L (EpaSpan ss@(RealSrcSpan la _)) (GHC.EpaComment t pp))
+ = (L (EpaDelta ss dp NoComments) (GHC.EpaComment t pp))
`debug` ("commentOrigDelta: (la, pp, r,c, dp)=" ++ showAst (la, pp, r,c, dp))
where
(r,c) = ss2posEnd pp
@@ -330,10 +330,10 @@ sortEpaComments cs = sortBy cmp cs
mkKWComment :: AnnKeywordId -> NoCommentsLocation -> Comment
mkKWComment kw (EpaSpan (RealSrcSpan ss mb))
= Comment (keywordToString kw) (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
-mkKWComment kw (EpaSpan (UnhelpfulSpan _))
- = Comment (keywordToString kw) (EpaDelta (SameLine 0) NoComments) placeholderRealSpan (Just kw)
-mkKWComment kw (EpaDelta dp cs)
- = Comment (keywordToString kw) (EpaDelta dp cs) placeholderRealSpan (Just kw)
+mkKWComment kw (EpaSpan ss@(UnhelpfulSpan _))
+ = Comment (keywordToString kw) (EpaDelta ss (SameLine 0) NoComments) placeholderRealSpan (Just kw)
+mkKWComment kw (EpaDelta ss dp cs)
+ = Comment (keywordToString kw) (EpaDelta ss dp cs) placeholderRealSpan (Just kw)
-- | Detects a comment which originates from a specific keyword.
isKWComment :: Comment -> Bool
@@ -434,11 +434,11 @@ To be absolutely sure, we make the delta versions use -ve values.
hackSrcSpanToAnchor :: SrcSpan -> Anchor
hackSrcSpanToAnchor (UnhelpfulSpan s) = error $ "hackSrcSpanToAnchor : UnhelpfulSpan:" ++ show s
-hackSrcSpanToAnchor (RealSrcSpan r mb)
+hackSrcSpanToAnchor ss@(RealSrcSpan r mb)
= case mb of
(Strict.Just (BufSpan (BufPos s) (BufPos e))) ->
if s <= 0 && e <= 0
- then EpaDelta (deltaPos (-s) (-e)) []
+ then EpaDelta ss (deltaPos (-s) (-e)) []
`debug` ("hackSrcSpanToAnchor: (r,s,e)=" ++ showAst (r,s,e) )
else EpaSpan (RealSrcSpan r mb)
_ -> EpaSpan (RealSrcSpan r mb)
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -1046,7 +1046,7 @@ instance NFData NoComments where
instance NFData a => NFData (EpaLocation' a) where
rnf (EpaSpan ss) = rnf ss
- rnf (EpaDelta dp lc) = dp `seq` lc `deepseq` ()
+ rnf (EpaDelta ss dp lc) = ss `seq` dp `seq` lc `deepseq` ()
instance NFData EpAnnComments where
rnf (EpaComments cs) = rnf cs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb83c3479aaf17023faacbbca706e5de78f3277f
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb83c3479aaf17023faacbbca706e5de78f3277f
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/20240712/c4e7595e/attachment-0001.html>
More information about the ghc-commits
mailing list