Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-24 at Glasgow Haskell Compiler / GHC Commits: 184d4c54 by Alan Zimmerman at 2026-09-12T16:50:25+01:00 EPA: More targeted HsDo exact print annotation HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of these are in a layout context (DoExpr, MDoExpr), others are not (ListComp, MonadComp). We are moving towards using AnnList only in layout contexts, so we switch the HsDo TTG annotation from holding an AnnList for this, to holding Either (EpToken "[", EpToken "]") AnnList This also allows us to trim down AnnListBrackets to only have braces or None, thereby opening the door for unification with the existing layout context data type EpLayout. - - - - - 10 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test20297.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -290,10 +290,12 @@ type instance XLet GhcPs = (EpToken "let", EpToken "in") type instance XLet GhcRn = NoExtField type instance XLet GhcTc = NoExtField -type instance XDo GhcPs = (AnnList, EpaLocation) +type instance XDo GhcPs = DoAnn type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type +type DoAnn = (Either (EpToken "[", EpToken "]") AnnList, EpaLocation) + type instance XExplicitList GhcPs = (EpToken "[", EpToken "]") type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type @@ -1467,7 +1469,7 @@ type instance XCmdLet GhcPs = (EpToken "let", EpToken "in") type instance XCmdLet GhcRn = NoExtField type instance XCmdLet GhcTc = NoExtField -type instance XCmdDo GhcPs = (AnnList, EpaLocation) +type instance XCmdDo GhcPs = DoAnn type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -335,11 +335,10 @@ mkHsIntegral :: IntegralLit GhcPs -> HsOverLit GhcPs mkHsFractional :: FractionalLit GhcPs -> HsOverLit GhcPs mkHsIsString :: SourceText -> HText -> HsOverLit GhcPs mkHsDo :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> HsExpr GhcPs -mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> (AnnList, EpaLocation) -> HsExpr GhcPs +mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> DoAnn -> HsExpr GhcPs mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs - -> (AnnList, EpaLocation) +mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> DoAnn -> HsExpr GhcPs mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-" ===================================== compiler/GHC/Parser.y ===================================== @@ -3152,19 +3152,15 @@ aexp :: { ECP } return $ ECP $ $2 >>= \ $2 -> mkHsDoPV (comb2 $1 $2) - (stmtlistAnns $2) + (Right $ stmtlistAnns $2, glR $1) (fmap mkModuleNameFS (getDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2) } + (stmtlistStmts $2) } | MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 -> fmap ecpFromExp $ amsA' (L (comb2 $1 $2) - (mkMDo (stmtlistAnns $2) - (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2))) } + (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) + (stmtlistStmts $2) + (Right $ stmtlistAnns $2, glR $1))) } | 'proc' aexp '->' exp {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4@cmd -> @@ -3440,7 +3436,7 @@ list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV ( { \loc (ao,ac) -> checkMonadComp >>= \ ctxt -> unECP $1 >>= \ $1 -> do { t <- addTrailingVbarA $1 (epTok $2) - ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [], noAnn)) + ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (Left $ (EpTok ao, EpTok ac), noAnn)) >>= ecpFromExp' } } lexps :: { forall b. DisambECP b => PV [LocatedA b] } @@ -3658,11 +3654,13 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) } ----------------------------------------------------------------------------- -- Statement sequences -stmtlist :: { forall b. DisambECP b => PV (LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), Located [LocatedA (Stmt GhcPs (LocatedA b))])) } +stmtlist :: { forall b. DisambECP b => PV (LocatedA (AnnList, Located [LocatedA (Stmt GhcPs (LocatedA b))])) } : '{' stmts '}' { $2 >>= \ $2 -> - amsA' (sLL $1 $> ((epTok $1, fromOL $ fst $ unLoc $2, epTok $3), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (sLL $1 $> (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} | vocurly stmts close { $2 >>= \ $2 -> - amsA' (L (stmtsLoc $2) ((noEpTok, fromOL $ fst $ unLoc $2, noEpTok), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (L (stmtsLoc $2) (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} -- do { ;; s ; s ; ; s ;; } -- The last Stmt should be an expression, but that's hard to enforce @@ -3704,7 +3702,7 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) (stmtlistAnns $2) $2) + amsA' (sLL $1 $> $ mkRecStmt (stmtlistAnns $2, epTok $1) (stmtlistStmts $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } @@ -4724,10 +4722,6 @@ commentsPA la@(L l a) = do !cs <- getPriorCommentsFor (getLocA la) return (L (addCommentsToEpAnn l cs) a) -hsDoAnn :: EpToken "rec" -> (EpToken "{", [EpToken ";"], EpToken "}") -> LocatedAn t b -> (AnnList, EpToken "rec") -hsDoAnn rec (ob, semis, cb) (L ll _) - = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis, rec) - listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation listAsAnchorM [] = Nothing listAsAnchorM (L l _:_) = @@ -4757,8 +4751,7 @@ stmtlistStmts :: LocatedA (a, Located [LocatedA (Stmt GhcPs (LocatedA b))]) stmtlistStmts (L la (_,L l stmts)) = L ((noAnnSrcSpan l) {comments = comments la}) stmts -stmtlistAnns :: LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), a) - -> (EpToken "{", [EpToken ";"], EpToken "}") +stmtlistAnns :: LocatedA (AnnList, a) -> AnnList stmtlistAnns (L _ (an,_)) = an -- ------------------------------------- ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -519,8 +519,7 @@ data AnnList } deriving (Data,Eq) data AnnListBrackets - = ListBraces (EpToken "{") (EpToken "}") - | ListSquare (EpToken "[") (EpToken "]") + = ListBraces (EpToken "{") (EpToken "}") | ListNone deriving (Data,Eq) @@ -1093,7 +1092,6 @@ instance Outputable AnnList where instance Outputable AnnListBrackets where ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c - ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" instance Outputable AnnCType where ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Parser.PostProcess ( mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, - mkHsDo, mkMDo, mkSpliceDecl, + mkHsDo, mkSpliceDecl, mkRoleAnnotDecl, mkClassDecl, mkTyData, mkDataFamInst, @@ -435,10 +435,6 @@ mkRoleAnnotDecl loc tycon roles anns addFatalError $ mkPlainErrorMsgEnvelope loc_role $ (PsErrIllegalRoleName role nearby) -mkMDo :: (EpToken "{", [EpToken ";"], EpToken "}") -> HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs -mkMDo (ob, semis, cb) ctxt stmts tok loc - = mkHsDoAnns ctxt stmts (AnnList (Just loc) (ListBraces ob cb) semis, tok) - -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to -- binders without annotations. Only accepts specified variables, and errors if -- any of the provided binders has an 'InferredSpec' annotation. @@ -1804,12 +1800,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> PV (LocatedA b) -- | Disambiguate "do { ... }" (do notation) mkHsDoPV :: - SrcSpan -> - (EpToken "{", [EpToken ";"], EpToken "}") -> - Maybe ModuleName -> - LocatedA [LStmt GhcPs (LocatedA b)] -> - EpaLocation -> -- Token - EpaLocation -> -- Anchor + SrcSpan -> DoAnn -> Maybe ModuleName -> LocatedA [LStmt GhcPs (LocatedA b)] -> PV (LocatedA b) -- | Disambiguate "( ... )" (parentheses) mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b) @@ -1959,10 +1950,10 @@ instance DisambECP (HsCmd GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns) - mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do + mkHsDoPV l ann Nothing stmts = do !cs <- getCommentsFor l - return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis, tok_loc) stmts) - mkHsDoPV l _ (Just m) _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m + return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo ann stmts) + mkHsDoPV l _ (Just m) _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m mkHsParPV l lpar c rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c) @@ -2058,9 +2049,9 @@ instance DisambECP (HsExpr GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns) - mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do + mkHsDoPV l ann mod stmts = do !cs <- getCommentsFor l - return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) (ListBraces ob cb) semis, loc_tok) (DoExpr mod) stmts) + return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo ann (DoExpr mod) stmts) mkHsParPV l lpar e rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e) @@ -2156,7 +2147,7 @@ instance DisambECP (PatBuilder GhcPs) where !cs <- getCommentsFor (locA l) return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t)) mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat - mkHsDoPV l _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat + mkHsDoPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat mkHsParPV l lpar p rpar = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar) mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v) mkHsLitPV lit@(L l a) = do ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -289,13 +289,12 @@ { DumpParsedAstComments.hs:14:7-8 }))])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpParsedAstComments.hs:16:3 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpParsedAstComments.hs:16:3 })) + (ListNone) + [])) (EpaSpan { DumpParsedAstComments.hs:14:7-8 })) (DoExpr (Nothing)) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -331,13 +331,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) + (ListNone) + [])) (EpaSpan { DumpSemis.hs:10:7-8 })) (DoExpr (Nothing)) @@ -363,20 +362,21 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:11:6-15 })) - (ListBraces - (EpTok (EpaSpan { DumpSemis.hs:11:6 })) - (EpTok (EpaSpan { DumpSemis.hs:11:15 }))) - [(EpTok - (EpaSpan { DumpSemis.hs:11:8 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:11:9 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:11:10 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:11:11 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:11:8-13 })) + (ListBraces + (EpTok (EpaSpan { DumpSemis.hs:11:6 })) + (EpTok (EpaSpan { DumpSemis.hs:11:15 }))) + [(EpTok + (EpaSpan { DumpSemis.hs:11:8 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:11:9 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:11:10 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:11:11 }))])) (EpaSpan { DumpSemis.hs:11:3-4 })) (DoExpr (Nothing)) @@ -625,16 +625,17 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:(16,3)-(19,3) })) - (ListBraces - (EpTok (EpaSpan { DumpSemis.hs:16:3 })) - (EpTok (EpaSpan { DumpSemis.hs:19:3 }))) - [(EpTok - (EpaSpan { DumpSemis.hs:16:5 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:16:8 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(16,5)-(18,5) })) + (ListBraces + (EpTok (EpaSpan { DumpSemis.hs:16:3 })) + (EpTok (EpaSpan { DumpSemis.hs:19:3 }))) + [(EpTok + (EpaSpan { DumpSemis.hs:16:5 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:16:8 }))])) (EpaSpan { DumpSemis.hs:15:7-8 })) (DoExpr (Nothing)) @@ -877,16 +878,17 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:22:10-30 })) - (ListBraces - (EpTok (EpaSpan { DumpSemis.hs:22:10 })) - (EpTok (EpaSpan { DumpSemis.hs:22:30 }))) - [(EpTok - (EpaSpan { DumpSemis.hs:22:12 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:22:13 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:22:12-28 })) + (ListBraces + (EpTok (EpaSpan { DumpSemis.hs:22:10 })) + (EpTok (EpaSpan { DumpSemis.hs:22:30 }))) + [(EpTok + (EpaSpan { DumpSemis.hs:22:12 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:22:13 }))])) (EpaSpan { DumpSemis.hs:22:7-8 })) (DoExpr (Nothing)) ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -394,13 +394,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.hs:11:22-26 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.hs:11:22-26 })) + (ListNone) + [])) (EpaSpan { Test20297.hs:11:19-20 })) (DoExpr (Nothing)) @@ -820,13 +819,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:9:20-24 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:9:20-24 })) + (ListNone) + [])) (EpaSpan { Test20297.ppr.hs:9:17-18 })) (DoExpr (Nothing)) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -980,9 +980,6 @@ markLensBracketsO' a l = ListBraces o c -> do o' <- markEpToken o return (set l (ListBraces o' c) a) - ListSquare o c -> do - o' <- markEpToken o - return (set l (ListSquare o' c) a) ListNone -> return (set l ListNone a) markLensBracketsC :: (Monad m, Monoid w) @@ -996,9 +993,6 @@ markLensBracketsC' a l = ListBraces o c -> do c' <- markEpToken c return (set l (ListBraces o c') a) - ListSquare o c -> do - c' <- markEpToken c - return (set l (ListSquare o c') a) ListNone -> return (set l ListNone a) -- ------------------------------------- @@ -1468,6 +1462,19 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok -- --------------------------------------------------------------------- +markAnnListD :: (Monad m, Monoid w) + => Either (EpToken "[", EpToken "]") AnnList + -> EP w m a + -> EP w m (Either (EpToken "[", EpToken "]") AnnList, a) +markAnnListD (Left (o,c)) action = do + o' <- markEpToken o + r <- action + c' <- markEpToken c + return (Left (o',c'), r) +markAnnListD (Right ann) action = do + (ann',r) <- markAnnList' ann action + return (Right ann',r) + markAnnList :: (Monad m, Monoid w) => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) markAnnList ann action = do @@ -3115,10 +3122,10 @@ instance ExactPrint (HsExpr GhcPs) where e' <- markAnnotated e return (HsLet (tkLet',tkIn') binds' e') - exact (HsDo (an,l) do_or_list_comp stmts) = do + exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts - return (HsDo (an',l') do_or_list_comp stmts') + (an',stmts') <- exactDo an do_or_list_comp stmts + return (HsDo an' do_or_list_comp stmts') exact (ExplicitList (o,c) es) = do debugM $ "ExplicitList start" @@ -3290,8 +3297,8 @@ instance ExactPrint (HsExpr GhcPs) where -- --------------------------------------------------------------------- exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a)) - => (AnnList, EpaLocation) -> HsDoFlavour -> LocatedAn an a - -> EP w m (AnnList, EpaLocation, LocatedAn an a) + => DoAnn -> HsDoFlavour -> LocatedAn an a + -> EP w m (DoAnn, LocatedAn an a) exactDo (an,l) (DoExpr m) stmts = exactMdo l m "do" >>= \l0 -> markMaybeDodgyStmts (an,l0) stmts exactDo (an,l) GhciStmtCtxt stmts = printStringAtAA l "do" >>= @@ -3310,15 +3317,23 @@ exactMdo l (Just module_name) kw = printStringAtAA l n n = (moduleNameString module_name) ++ "." ++ kw markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a)) - => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a) + => DoAnn -> LocatedAn an a -> EP w m (DoAnn, LocatedAn an a) markMaybeDodgyStmts (an,l) stmts = if notDodgy stmts then do - (an0,stmts') <- markAnnListA' an $ \a -> do - r <- markAnnotatedWithLayout stmts - return (a, r) - return (an0, l, stmts') - else return (an, l, stmts) + (an0,stmts') <- case an of + Left (o,c) -> do + o' <- markEpToken o + r <- markAnnotated stmts + c' <- markEpToken c + return (Left (o',c'), r) + Right an' -> do + (an'',r') <- markAnnListA' an' $ \a -> do + r <- markAnnotatedWithLayout stmts + return (a, r) + return (Right an'',r') + return ((an0, l), stmts') + else return ((an, l), stmts) notDodgy :: GenLocated (EpAnn ann) a -> Bool notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc @@ -3601,9 +3616,7 @@ instance ExactPrint (HsCmd GhcPs) where exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" - (an1,es') <- markAnnList' an0 $ do - ee <- markAnnotated es - return ee + (an1,es') <- markAnnListD an0 $ do markAnnotated es return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- ===================================== utils/check-exact/Utils.hs ===================================== @@ -343,7 +343,6 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation) annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c) -annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) data SplitWhere = Before | After View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184d4c547e5864b17add6a31ad39e293... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184d4c547e5864b17add6a31ad39e293... 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
participants (1)
-
Alan Zimmerman (＠alanz)