Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fbaac93d by Andreas Klebinger at 2026-08-25T10:15:41-04:00 rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64 We accidentally operated over `uint64_t*` when we should use `uint8_t`. Fixes #27569 - - - - - b8729895 by Zubin Duggal at 2026-08-25T10:15:43-04:00 ghc-internal: annotateSTM should use catchSTM# rather than catch# A catch# frame inside a transaction breaks retry and async exception delivery. Fixes #27657 - - - - - dddcdee3 by Alan Zimmerman at 2026-08-25T10:15:43-04:00 EPA: Uses Parsers.parseModule for exactprint tests Parsers.parseModule is the advertised way to parse for use for exact printing in the ghc-exactprint library. This commit updates the GHC exact print testing to use it. This requires moving the comment balancing that was occurring only in the test path into the advertising parser path, so it moves from Transforms.hs to Utils.hs. Also update the comment adding to honour trailing annotations - - - - - 13 changed files: - + changelog.d/T27657 - libraries/ghc-internal/src/GHC/Internal/STM.hs - rts/linker/elf_reloc_riscv64.c - + testsuite/tests/concurrent/should_run/T27657a.hs - + testsuite/tests/concurrent/should_run/T27657a.stdout - + testsuite/tests/concurrent/should_run/T27657b.hs - + testsuite/tests/concurrent/should_run/T27657b.stdout - testsuite/tests/concurrent/should_run/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== changelog.d/T27657 ===================================== @@ -0,0 +1,9 @@ +section: base +issues: #27657 +mrs: !16508 +synopsis: + Fix ``retry`` and async exception delivery inside a ``catchSTM`` handler +description: + ``catchSTM``\'s ``WhileHandling`` annotation used ``catch#``, leaving an IO + ``CATCH_FRAME`` inside the transaction. Use ``catchSTM#``, which is the + correct way to catch exceptions inside STM. ===================================== libraries/ghc-internal/src/GHC/Internal/STM.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Internal.Exception.Context (ExceptionAnnotation) import GHC.Internal.Exception.Type (WhileHandling(..)) import GHC.Internal.Maybe (Maybe(..)) import GHC.Internal.Prim ( - RealWorld, State#, TVar#, atomically#, catch#, catchRetry#, catchSTM#, + RealWorld, State#, TVar#, atomically#, catchRetry#, catchSTM#, newTVar#, raiseIO#, readTVar#, readTVarIO#, retry#, writeTVar#, ) import GHC.Internal.Prim.PtrEq (sameTVar#) @@ -213,7 +213,7 @@ catchSTM (STM m) handler = STM $ catchSTM# m handler' -- | Execute an 'STM' action, adding the given 'ExceptionContext' -- to any thrown synchronous exceptions. annotateSTM :: forall e a. ExceptionAnnotation e => e -> STM a -> STM a -annotateSTM ann (STM io) = STM (catch# io handler) +annotateSTM ann (STM io) = STM (catchSTM# io handler) -- not catch#, see #27657 where handler se = raiseIO# (addExceptionContext ann se) ===================================== rts/linker/elf_reloc_riscv64.c ===================================== @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) { /* The main object code */ void *codeBegin = oc->image + oc->misalignment; - __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize)); + __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize)); /* Jump Islands */ __builtin___clear_cache((void *)oc->symbol_extras, ===================================== testsuite/tests/concurrent/should_run/T27657a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- A retry escaping a catchSTM handler must reach the enclosing orElse. An IO +-- CATCH_FRAME in the way trips an assertion in findRetryFrameHelper. + +import Control.Exception +import GHC.Conc + +main :: IO () +main = do + r <- atomically $ + catchSTM (throwSTM (ErrorCall "boom")) + (\(_ :: SomeException) -> retry) + `orElse` pure "T27657a: completed" + putStrLn r ===================================== testsuite/tests/concurrent/should_run/T27657a.stdout ===================================== @@ -0,0 +1 @@ +T27657a: completed ===================================== testsuite/tests/concurrent/should_run/T27657b.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- An async exception delivered while a catchSTM handler runs must abort the +-- transaction, not be swallowed by a restart of the invalidated one. + +import Control.Concurrent.MVar +import Control.Exception +import GHC.Conc + +waitParked :: ThreadId -> IO () +waitParked t = do + s <- threadStatus t + case s of + ThreadBlocked BlockedOnMVar -> pure () + _ -> threadDelay 1000 >> waitParked t + +main :: IO () +main = do + tv <- newTVarIO (0 :: Int) + park <- newEmptyMVar + result <- newEmptyMVar + t <- forkIO $ do + r <- try $ atomically $ do + v <- readTVar tv + catchSTM (throwSTM (ErrorCall "boom")) + (\(_ :: SomeException) -> + if v == 0 + then do unsafeIOToSTM (takeMVar park) + pure "handler resumed" + else pure "transaction restarted, exception dropped") + putMVar result (r :: Either SomeException String) + -- parked in the handler, so t cannot revalidate its trec before delivery + waitParked t + atomically (writeTVar tv 1) + killThread t + r <- takeMVar result + putStrLn $ case r of + Left e | Just ThreadKilled <- fromException e -> "T27657b: killThread delivered" + | otherwise -> "T27657b: unexpected exception: " ++ displayException e + Right s -> "T27657b: FAILED, " ++ s ===================================== testsuite/tests/concurrent/should_run/T27657b.stdout ===================================== @@ -0,0 +1 @@ +T27657b: killThread delivered ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -340,3 +340,6 @@ test('T27105_fail', extra_run_opts('+RTS -C0.2 -RTS'), expect_fail, run_timeout_multiplier(0.05)], multimod_compile_and_run, ['T27105.hs', '']) + +test('T27657a', normal, compile_and_run, ['']) +test('T27657b', normal, compile_and_run, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1465,7 +1465,7 @@ instance ExactPrint (HsModule GhcPs) where Just exps -> do let (op,cp,tcs) = am_exports $ anns an0 op' <- markEpToken op - exps' <- mapM markAnnotated exps + exps' <- mapM markAnnotated (filter notIEDoc exps) tcs' <- mapM markEpToken tcs cp' <- markEpToken cp return (Just exps', an0 { anns = (anns an0) { am_exports = (op',cp',tcs')}}) ===================================== utils/check-exact/Main.hs ===================================== @@ -183,7 +183,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test17519.hs" Nothing -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/printer/Test19798.hs" Nothing - "../../testsuite/tests/printer/Test10309.hs" Nothing + -- "../../testsuite/tests/printer/Test10309.hs" Nothing + "../../testsuite/tests/printer/Haddock1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -304,7 +305,7 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO () testOneFile _ libdir fileName mchanger = do - (p,_toks) <- parseOneFile libdir fileName + p <- parseOneFile libdir fileName let origAst = ppAst p pped = exactPrint p @@ -333,7 +334,7 @@ testOneFile _ libdir fileName mchanger = do changedSource <- readFile newFile return (expectedSource == changedSource, expectedSource, changedSource) - (p',_) <- parseOneFile libdir newFile + p' <- parseOneFile libdir newFile let newAstStr :: String newAstStr = ppAst p' writeBinFile newAstFile newAstStr @@ -364,15 +365,12 @@ testOneFile _ libdir fileName mchanger = do ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast - -parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) +parseOneFile :: FilePath -> FilePath -> IO ParsedSource parseOneFile libdir fileName = do - res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName + res <- Parsers.parseModule libdir fileName case res of Left m -> error (internalDebugShowMessages m) - Right (injectedComments, _dflags, pmod) -> do - let !pmodWithComments = insertCppComments pmod injectedComments - return (pmodWithComments, []) + Right pmod -> return pmod -- --------------------------------------------------------------------- @@ -519,8 +517,7 @@ changeLocalDecls libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do - let (oldDecls) = map unWrapValBind bs - -- let decls = s:d:oldDecls + let oldDecls = map unWrapValBind bs let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) ===================================== utils/check-exact/Parsers.hs ===================================== @@ -46,6 +46,7 @@ module Parsers ( ) where import Preprocess +import Utils import Data.Functor (void) @@ -270,7 +271,10 @@ postParseTransform -> Either a (GHC.ParsedSource) postParseTransform parseRes = fmap mkAnns parseRes where - mkAnns (_cs, _, m) = fixModuleComments m + mkAnns (cs, _, m) = fixModuleComments (insertCppComments (noIEDoc m) cs) + noIEDoc (GHC.L l m) = case GHC.hsmodExports m of + Nothing -> GHC.L l m + Just exps -> GHC.L l m { GHC.hsmodExports = Just $ filter notIEDoc exps } fixModuleComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleComments p = fixModuleHeaderComments $ fixModuleTrailingComments p ===================================== utils/check-exact/Transform.hs ===================================== @@ -93,7 +93,6 @@ import qualified Control.Monad.Fail as Fail import GHC hiding (parseModule, parsedSource) import GHC.Parser.PostProcess ( wrapValBind ) import GHC.Data.FastString -import GHC.Types.SrcLoc import Data.Data import Data.List (unsnoc) @@ -402,6 +401,14 @@ balanceCommentsList' (a:b:ls) = (a':r) (a',b') = balanceComments a b r = balanceCommentsList' (b':ls) +balanceCommentsListA :: [LocatedA a ] -> [LocatedA a] +balanceCommentsListA [] = [] +balanceCommentsListA [x] = [x] +balanceCommentsListA (a:b:ls) = (a':r) + where + (a',b') = balanceCommentsA a b + r = balanceCommentsListA (b':ls) + -- |The GHC parser puts all comments appearing between the end of one AST -- item and the beginning of the next as 'annPriorComments' for the second one. -- This function takes two adjacent AST items and moves any 'annPriorComments' @@ -507,15 +514,6 @@ pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) (HsValBinds _ vb') -> vb' _ -> ValBinds noExtField [] - -balanceCommentsListA :: [LocatedA a] -> [LocatedA a] -balanceCommentsListA [] = [] -balanceCommentsListA [x] = [x] -balanceCommentsListA (a:b:ls) = (a':r) - where - (a',b') = balanceCommentsA a b - r = balanceCommentsListA (b':ls) - -- |Prior to moving an AST element, make sure any trailing comments belonging to -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided @@ -591,59 +589,6 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs) -- --------------------------------------------------------------------- --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) -splitComments p cs = (before, middle, after) - where - cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmpe (L _ _) = True - - cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p - cmpb (L _ _) = True - - (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) - (before, middle) = break cmpb beforeEnd - - --- | Split comments into ones occurring before the end of the reference --- span, and those after it. -splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsEnd p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - --- | Split comments into ones occurring before the start of the reference --- span, and those after it. -splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments -splitCommentsStart p (EpaComments cs) = cs' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = case after of - [] -> EpaComments cs - _ -> epaCommentsBalanced before after -splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' - where - cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p - cmp (L _ _) = True - (before, after) = break cmp cs - cs' = before - ts' = after <> ts - moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u) => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb') @@ -680,19 +625,6 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) anchorFromLocatedA :: LocatedA a -> RealSrcSpan anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc --- | Get the full span of interest for comments from a LocatedA. --- This extends up to the last TrailingAnn -fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan -fullSpanFromLocatedA (L (EpAnn anc tas _) _) = rr - where - r = epaLocationRealSrcSpan anc - trailing_loc ta = case ta_location ta of - EpaSpan (RealSrcSpan s _) -> [s] - _ -> [] - rr = case reverse (concatMap trailing_loc tas) of - [] -> r - (s:_) -> combineRealSrcSpans r s - -- --------------------------------------------------------------------- balanceSameLineComments :: LMatch GhcPs (LHsExpr GhcPs) -> (LMatch GhcPs (LHsExpr GhcPs)) ===================================== utils/check-exact/Utils.hs ===================================== @@ -228,7 +228,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining (p2, remaining) = insertTopLevelCppComments p1 toplevel addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) - addCommentsListItem = addComments + addCommentsListItem = addCommentsA addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments @@ -249,6 +249,20 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining _ -> return $ EpAnn anc an ocs + addCommentsA :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) + addCommentsA ann@(EpAnn anc an ocs) = do + case anc of + EpaSpan (RealSrcSpan s _) -> do + unAllocated <- get + let + (rest, these) = GHC.Parser.Lexer.allocateComments (fullSpanFromEpAnnA ann) unAllocated + balanced = splitCommentsEnd s (EpaComments these) + cs' = sortEpAnnComments (ocs <> balanced) + put rest + return $ EpAnn anc an cs' + + _ -> return $ EpAnn anc an ocs + workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments workInComments ocs [] = ocs workInComments ocs new = cs' @@ -264,9 +278,14 @@ workInComments ocs new = cs' = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new +sortEpAnnComments :: EpAnnComments -> EpAnnComments +sortEpAnnComments (EpaComments cs) = EpaComments (sortEpaComments cs) +sortEpAnnComments (EpaCommentsBalanced pc fc) + = EpaCommentsBalanced (sortEpaComments pc) (sortEpaComments fc) + insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment]) insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs - = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3) + = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports imports' decls', cs3) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs)) -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs)) where @@ -297,24 +316,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs' = workInComments (comments an1) stay _ -> (an1,cs0a) - (mexports', an3, cs1) = - case mexports of - Nothing -> (Nothing, an2, cs0b) - Just exports -> (Just exports', an3', cse) - where - (csh', cs0b') = case am_exports $ anns an2 of - (tokOP, _tokCP, _tokCommas) -> - case tokOP of - (EpTok (EpaSpan (RealSrcSpan s _))) -> (h, n) - where - (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) ) - cs0b - - _ -> ([], cs0b) - hc1' = workInComments (comments an2) csh' - an3' = an2 { comments = hc1' } - (exports', cse) = allocPreceding exports cs0b' - (imports0, cs2) = allocPreceding imports cs1 + (imports0, cs2) = allocPreceding imports cs0b (imports', hc0i) = balanceFirstLocatedAComments imports0 (decls0, cs3) = allocPreceding decls cs2 @@ -323,9 +325,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports -- Either hc0i or hc0d should have comments. Combine them hc0 = hc0i ++ hc0d - (hc1,hc_cs) = splitOnWhere After (am_where $ anns an3) hc0 - hc2 = workInComments (comments an3) hc1 - an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } + (hc1,hc_cs) = splitOnWhere After (am_where $ anns an2) hc0 + hc2 = workInComments (comments an2) hc1 + an4 = an2 { anns = (anns an2) {am_cs = hc_cs}, comments = hc2 } allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment]) allocPreceding [] cs' = ([], cs') @@ -346,7 +348,6 @@ annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) - data SplitWhere = Before | After splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) @@ -430,6 +431,79 @@ insertRemainingCppComments (L l p) cs = L l p' -- --------------------------------------------------------------------- +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan +fullSpanFromLocatedA (L ann _) = fullSpanFromEpAnnA ann + +-- | Get the full span of interest for comments from a LocatedA. +-- This extends up to the last TrailingAnn +fullSpanFromEpAnnA :: EpAnn [TrailingAnn] -> RealSrcSpan +fullSpanFromEpAnnA (EpAnn anc tas _) = rr + where + r = epaLocationRealSrcSpan anc + trailing_loc ta = case ta_location ta of + EpaSpan (RealSrcSpan s _) -> [s] + _ -> [] + rr = case reverse (concatMap trailing_loc tas) of + [] -> r + (s:_) -> combineRealSrcSpans r s + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment]) +splitComments p cs = (before, middle, after) + where + cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmpe (L _ _) = True + + cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p + cmpb (L _ _) = True + + (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs)) + (before, middle) = break cmpb beforeEnd + + +-- | Split comments into ones occurring before the end of the reference +-- span, and those after it. +splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsEnd p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- | Split comments into ones occurring before the start of the reference +-- span, and those after it. +splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments +splitCommentsStart p (EpaComments cs) = cs' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = case after of + [] -> EpaComments cs + _ -> epaCommentsBalanced before after +splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts' + where + cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p + cmp (L _ _) = True + (before, after) = break cmp cs + cs' = before + ts' = after <> ts + +-- --------------------------------------------------------------------- + ghcCommentText :: LEpaComment -> String ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _)) = exactPrintHsDocString s ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _)) = s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e885a4e595f03aa11669eef7e4520c5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e885a4e595f03aa11669eef7e4520c5... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help