From 18d4ec2a1c1abc7f3708a3cccf4fbdc64ba14760 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 21 Sep 2024 12:46:36 +0100 Subject: [PATCH] Match master at 35eb4f428ab72b712ea78d6ef86b956e321c3bb2 --- configure.sh | 4 ++- .../Haskell/GHC/ExactPrint/ExactPrint.hs | 28 +++++++++---------- src/Language/Haskell/GHC/ExactPrint/Utils.hs | 4 +-- tests/Test/Transform.hs | 1 - 4 files changed, 19 insertions(+), 18 deletions(-) diff --git a/configure.sh b/configure.sh index 523d86dc..1cc76130 100755 --- a/configure.sh +++ b/configure.sh @@ -249,4 +249,6 @@ cabal configure -froundtrip --enable-tests --with-compiler=ghc-9.10.1 # cabal configure -fdev -froundtrip --enable-tests --with-compiler=/opt/ghc/9.11.20240908/bin/ghc --allow-newer # cabal configure -fdev -froundtrip --enable-tests --with-compiler=/opt/ghc/9.11.20240908/bin/ghc --allow-newer -cabal configure -fdev --enable-tests --with-compiler=/opt/ghc/9.11.20240908/bin/ghc --allow-newer +# cabal configure -fdev --enable-tests --with-compiler=/opt/ghc/9.11.20240908/bin/ghc --allow-newer + +cabal configure -fdev --enable-tests --with-compiler=/opt/ghc/9.11.20240921/bin/ghc --allow-newer diff --git a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs index b62857de..f693b448 100644 --- a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +++ b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs @@ -164,8 +164,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 , uExtraDPReturn :: !(Maybe DeltaPos) -- ^ Used to return Delta version of uExtraDP , pAcceptSpan :: Bool -- ^ When we have processed an @@ -205,21 +205,21 @@ class HasTrailing a where setTrailing :: a -> [TrailingAnn] -> a setAnchorEpa :: (HasTrailing 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) - => 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 -- --------------------------------------------------------------------- @@ -241,14 +241,14 @@ data CanUpdateAnchor = CanUpdateAnchor | NoCanUpdateAnchor deriving (Eq, Show, Data) -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 @@ -673,7 +673,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 -- --------------------------------------------------------------------- @@ -985,7 +985,7 @@ You can think of the function composition operator as having this type: -- Lenses -- data EpAnn ann --- = EpAnn { entry :: !Anchor +-- = EpAnn { entry :: !EpaLocation -- , anns :: !ann -- , comments :: !EpAnnComments -- } @@ -1048,7 +1048,7 @@ limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = n -- 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 @@ -4373,7 +4373,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? @@ -5075,10 +5075,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}) diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs index 56605580..5e1b781b 100644 --- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs @@ -479,7 +479,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 @@ -564,7 +564,7 @@ mkKWComment kw (EpaSpan (UnhelpfulSpan _)) mkKWComment kw (EpaDelta ss dp cs) = Comment (keywordToString kw) (EpaDelta ss dp cs) placeholderRealSpan (Just kw) -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 diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index abab286d..46b44214 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -505,7 +505,6 @@ rmDecl5 _libdir lp = do go :: HsExpr GhcPs -> Transform (HsExpr GhcPs) go (HsLet (tkLet, tkIn) lb expr) = do let decs = hsDeclsLocalBinds lb - let hdecs : _ = decs let dec = last decs let lb' = replaceDeclsValbinds WithoutWhere lb [dec] return (HsLet (tkLet, tkIn) lb' expr)