[Git][ghc/ghc][wip/az/epa-remove-anchor-alias] EPA: Remove Anchor = EpaLocation synonym
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Mon Sep 9 21:48:47 UTC 2024
Alan Zimmerman pushed to branch wip/az/epa-remove-anchor-alias at Glasgow Haskell Compiler / GHC
Commits:
9788163f by Alan Zimmerman at 2024-09-09T22:48:32+01:00
EPA: Remove Anchor = EpaLocation synonym
This just causes confusion.
- - - - -
5 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -4483,13 +4483,13 @@ gl = getLoc
glA :: HasLoc a => a -> SrcSpan
glA = getHasLoc
-glR :: HasLoc a => a -> Anchor
+glR :: HasLoc a => a -> EpaLocation
glR !la = EpaSpan (getHasLoc la)
-glEE :: (HasLoc a, HasLoc b) => a -> b -> Anchor
+glEE :: (HasLoc a, HasLoc b) => a -> b -> EpaLocation
glEE !x !y = spanAsAnchor $ comb2 x y
-glRM :: Located a -> Maybe Anchor
+glRM :: Located a -> Maybe EpaLocation
glRM (L !l _) = Just $ spanAsAnchor l
glAA :: HasLoc a => a -> EpaLocation
@@ -4609,11 +4609,11 @@ hsDoAnn :: Located a -> LocatedAn t b -> AnnKeywordId -> AnnList
hsDoAnn (L l _) (L ll _) kw
= AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (srcSpan2e l)] []
-listAsAnchor :: [LocatedAn t a] -> Located b -> Anchor
+listAsAnchor :: [LocatedAn t a] -> Located b -> EpaLocation
listAsAnchor [] (L l _) = spanAsAnchor l
listAsAnchor (h:_) s = spanAsAnchor (comb2 h s)
-listAsAnchorM :: [LocatedAn t a] -> Maybe Anchor
+listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation
listAsAnchorM [] = Nothing
listAsAnchorM (L l _:_) =
case locA l of
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -23,7 +23,7 @@ module GHC.Parser.Annotation (
TokenLocation(..),
DeltaPos(..), deltaPos, getDeltaLine,
- EpAnn(..), Anchor,
+ EpAnn(..),
anchor,
spanAsAnchor, realSpanAsAnchor,
noSpanAnchor,
@@ -528,7 +528,7 @@ instance Outputable AddEpAnn where
-- new AST fragments out of old ones, and have them still printed out
-- in a precise way.
data EpAnn ann
- = EpAnn { entry :: !Anchor
+ = EpAnn { entry :: !EpaLocation
-- ^ Base location for the start of the syntactic element
-- holding the annotations.
, anns :: !ann -- ^ Annotations added by the Parser
@@ -539,15 +539,6 @@ data EpAnn ann
deriving (Data, Eq, Functor)
-- See Note [XRec and Anno in the AST]
--- | An 'Anchor' records the base location for the start of the
--- syntactic element holding the annotations, and is used as the point
--- of reference for calculating delta positions for contained
--- annotations.
--- It is also normally used as the reference point for the spacing of
--- the element relative to its container. If the AST element is moved,
--- that relationship is tracked using the 'EpaDelta' constructor instead.
-type Anchor = EpaLocation -- Transitional
-
anchor :: (EpaLocation' a) -> RealSrcSpan
anchor (EpaSpan (RealSrcSpan r _)) = r
anchor _ = panic "anchor"
@@ -676,7 +667,7 @@ data AnnListItem
-- keywords such as 'where'.
data AnnList
= AnnList {
- al_anchor :: Maybe Anchor, -- ^ start point of a list having layout
+ al_anchor :: Maybe EpaLocation, -- ^ start point of a list having layout
al_open :: Maybe AddEpAnn,
al_close :: Maybe AddEpAnn,
al_rest :: [AddEpAnn], -- ^ context, such as 'where' keyword
@@ -1143,7 +1134,7 @@ listLocation as = EpaSpan (go noSrcSpan as)
go acc (L (EpAnn (EpaSpan s) _ _) _:rest) = go (combine acc s) rest
go acc (_:rest) = go acc rest
-widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
+widenAnchor :: EpaLocation -> [AddEpAnn] -> EpaLocation
widenAnchor (EpaSpan (RealSrcSpan s mb)) as
= EpaSpan (RealSrcSpan (widenRealSpan s as) (liftA2 combineBufSpans mb (bufSpanFromAnns as)))
widenAnchor (EpaSpan us) _ = EpaSpan us
@@ -1151,7 +1142,7 @@ widenAnchor a at EpaDelta{} as = case (realSpanFromAnns as) of
Strict.Nothing -> a
Strict.Just r -> EpaSpan (RealSrcSpan r Strict.Nothing)
-widenAnchorS :: Anchor -> SrcSpan -> Anchor
+widenAnchorS :: EpaLocation -> SrcSpan -> EpaLocation
widenAnchorS (EpaSpan (RealSrcSpan s mbe)) (RealSrcSpan r mbr)
= EpaSpan (RealSrcSpan (combineRealSrcSpans s r) (liftA2 combineBufSpans mbe mbr))
widenAnchorS (EpaSpan us) _ = EpaSpan us
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -478,13 +478,13 @@ add_where an@(AddEpAnn _ (EpaSpan (RealSrcSpan rs _))) (EpAnn a (AnnList anc o c
add_where (AddEpAnn _ _) _ _ = panic "add_where"
-- EpaDelta should only be used for transformations
-valid_anchor :: Anchor -> Bool
+valid_anchor :: EpaLocation -> Bool
valid_anchor (EpaSpan (RealSrcSpan r _)) = srcSpanStartLine r >= 0
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 :: RealSrcSpan -> EpaLocation -> EpaLocation
patch_anchor r EpaDelta{} = EpaSpan (RealSrcSpan r Strict.Nothing)
patch_anchor r1 (EpaSpan (RealSrcSpan r0 mb)) = EpaSpan (RealSrcSpan r mb)
where
@@ -495,9 +495,9 @@ fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)
= (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)
--- | The 'Anchor' for a stmtlist is based on either the location or
+-- | The anchor for a stmtlist is based on either the location or
-- the first semicolon annotion.
-stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Maybe Anchor
+stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Maybe EpaLocation
stmtsAnchor (L (RealSrcSpan l mb) ((ConsOL (AddEpAnn _ (EpaSpan (RealSrcSpan r rb))) _), _))
= Just $ widenAnchorS (EpaSpan (RealSrcSpan l mb)) (RealSrcSpan r rb)
stmtsAnchor (L (RealSrcSpan l mb) _) = Just $ EpaSpan (RealSrcSpan l mb)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -175,8 +175,8 @@ data EPState = EPState
{ uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST
-- reference frame, from
-- Annotation
- , uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a
- -- list
+ , uExtraDP :: !(Maybe EpaLocation) -- ^ Used to anchor a
+ -- list
, pAcceptSpan :: Bool -- ^ When we have processed an
-- entry of EpaDelta, accept the
-- next `EpaSpan` start as the
@@ -214,21 +214,21 @@ class HasTrailing a where
setTrailing :: a -> [TrailingAnn] -> a
setAnchorEpa :: (HasTrailing an, NoAnn an)
- => EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an
+ => EpAnn an -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn an
setAnchorEpa (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing an ts) cs
-setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
+setAnchorHsModule :: HsModule GhcPs -> EpaLocation -> EpAnnComments -> HsModule GhcPs
setAnchorHsModule hsmod anc cs = hsmod { hsmodExt = (hsmodExt hsmod) {hsmodAnn = an'} }
where
anc' = anc
an' = setAnchorEpa (hsmodAnn $ hsmodExt hsmod) anc' [] cs
setAnchorAn :: (HasTrailing an, NoAnn an)
- => LocatedAn an a -> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
+ => LocatedAn an a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a
setAnchorAn (L (EpAnn _ an _) a) anc ts cs = (L (EpAnn anc (setTrailing an ts) cs) a)
-- `debug` ("setAnchorAn: anc=" ++ showAst anc)
-setAnchorEpaL :: EpAnn AnnList -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
+setAnchorEpaL :: EpAnn AnnList -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = Nothing}) ts) cs
-- ---------------------------------------------------------------------
@@ -250,14 +250,14 @@ data CanUpdateAnchor = CanUpdateAnchor
| NoCanUpdateAnchor
deriving (Eq, Show)
-data Entry = Entry Anchor [TrailingAnn] EpAnnComments FlushComments CanUpdateAnchor
+data Entry = Entry EpaLocation [TrailingAnn] EpAnnComments FlushComments CanUpdateAnchor
| NoEntryVal
-- | For flagging whether to capture comments in an EpaDelta or not
data CaptureComments = CaptureComments
| NoCaptureComments
-mkEntry :: Anchor -> [TrailingAnn] -> EpAnnComments -> Entry
+mkEntry :: EpaLocation -> [TrailingAnn] -> EpAnnComments -> Entry
mkEntry anc ts cs = Entry anc ts cs NoFlushComments CanUpdateAnchor
instance (HasTrailing a) => HasEntry (EpAnn a) where
@@ -642,7 +642,7 @@ withPpr a = do
-- 'ppr'.
class (Typeable a) => ExactPrint a where
getAnnotationEntry :: a -> Entry
- setAnnotationAnchor :: a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
+ setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a
exact :: (Monad m, Monoid w) => a -> EP w m a
-- ---------------------------------------------------------------------
@@ -4277,7 +4277,7 @@ instance ExactPrint (LocatedN RdrName) where
locFromAdd :: AddEpAnn -> EpaLocation
locFromAdd (AddEpAnn _ loc) = loc
-printUnicode :: (Monad m, Monoid w) => Anchor -> RdrName -> EP w m Anchor
+printUnicode :: (Monad m, Monoid w) => EpaLocation -> RdrName -> EP w m EpaLocation
printUnicode anc n = do
let str = case (showPprUnsafe n) of
-- TODO: unicode support?
@@ -4977,10 +4977,10 @@ setPosP l = do
debugM $ "setPosP:" ++ show l
modify (\s -> s {epPos = l})
-getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)
+getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe EpaLocation)
getExtraDP = gets uExtraDP
-setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()
+setExtraDP :: (Monad m, Monoid w) => Maybe EpaLocation -> EP w m ()
setExtraDP md = do
debugM $ "setExtraDP:" ++ show md
modify (\s -> s {uExtraDP = md})
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -255,7 +255,7 @@ tokComment t@(L lt c) =
(GHC.EpaComment (EpaDocComment dc) pt) -> hsDocStringComments (noCommentsToEpaLocation lt) pt dc
_ -> [mkComment (normaliseCommentText (ghcCommentText t)) lt (ac_prior_tok c)]
-hsDocStringComments :: Anchor -> RealSrcSpan -> GHC.HsDocString -> [Comment]
+hsDocStringComments :: EpaLocation -> RealSrcSpan -> GHC.HsDocString -> [Comment]
hsDocStringComments _ pt (MultiLineDocString dec (x :| xs)) =
let
decStr = printDecorator dec
@@ -342,7 +342,7 @@ isKWComment c = isJust (commentOrigin c)
noKWComments :: [Comment] -> [Comment]
noKWComments = filter (\c -> not (isKWComment c))
-sortAnchorLocated :: [GenLocated Anchor a] -> [GenLocated Anchor a]
+sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
sortAnchorLocated = sortBy (compare `on` (anchor . getLoc))
-- | Calculates the distance from the start of a string to the end of
@@ -401,12 +401,6 @@ setTrailingAnnLoc (AddDarrowUAnn _) ss = (AddDarrowUAnn ss)
addEpAnnLoc :: AddEpAnn -> EpaLocation
addEpAnnLoc (AddEpAnn _ l) = l
--- ---------------------------------------------------------------------
-
--- TODO: get rid of this identity function
-anchorToEpaLocation :: Anchor -> EpaLocation
-anchorToEpaLocation a = a
-
-- ---------------------------------------------------------------------
-- Horrible hack for dealing with some things still having a SrcSpan,
-- not an Anchor.
@@ -432,7 +426,7 @@ To be absolutely sure, we make the delta versions use -ve values.
-}
-hackSrcSpanToAnchor :: SrcSpan -> Anchor
+hackSrcSpanToAnchor :: SrcSpan -> EpaLocation
hackSrcSpanToAnchor (UnhelpfulSpan s) = error $ "hackSrcSpanToAnchor : UnhelpfulSpan:" ++ show s
hackSrcSpanToAnchor ss@(RealSrcSpan r mb)
= case mb of
@@ -443,7 +437,7 @@ hackSrcSpanToAnchor ss@(RealSrcSpan r mb)
else EpaSpan (RealSrcSpan r mb)
_ -> EpaSpan (RealSrcSpan r mb)
-hackAnchorToSrcSpan :: Anchor -> SrcSpan
+hackAnchorToSrcSpan :: EpaLocation -> SrcSpan
hackAnchorToSrcSpan (EpaSpan s) = s
hackAnchorToSrcSpan _ = error $ "hackAnchorToSrcSpan"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9788163f832c5bc73939b9d8463f891369b4ec22
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9788163f832c5bc73939b9d8463f891369b4ec22
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/20240909/f914e7e3/attachment-0001.html>
More information about the ghc-commits
mailing list