Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f679a868 by sheaf at 2026-08-15T21:36:46-04:00 Avoid wasteful allocations in mkTyConAppCo The idiom "traverse isReflCo_maybe" followed by "map fst" used in 'GHC.Core.Coercion.mkTyConAppCo' was allocating a lot of waste. This commit uses 'GHC.Data.Unboxed.traverseMaybeUB' to avoid all these unnecessary intermediate allocations. In a quick microbenchmark for 'mkTyConAppCo', this change resulted in: - refl case (all argument coercions are reflexive): - -60% runtime - -80% allocations - non-refl case: - from 0% to -12% runtime (depending on which argument is non-refl) - from 0% to -70% allocations ( -- '' -- ) Fixes #27648 ------------------------- Metric Decrease: FamAppCachePerf SimplCastPerf T12425 T15703 T26426 T3064 T9872a T9872b T9872b_defer T9872c T9872d T5321Fun T9020 T9630 TcPlugin_RewritePerf Metric Increase: LinkableUsage02 ------------------------- - - - - - 71e97271 by Alan Zimmerman at 2026-08-15T21:36:47-04:00 EPA: Remove al_trailing from AnnList It was not being used - - - - - 22 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Data/Unboxed.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -147,6 +147,7 @@ import GHC.Types.Basic import GHC.Types.Unique import GHC.Data.FastString import GHC.Data.Pair +import GHC.Data.Unboxed (traverseMaybeUB) import GHC.Types.SrcLoc import GHC.Builtin.KnownKeys import GHC.Builtin.WiredIn.Prim @@ -166,6 +167,7 @@ import Data.Char( isDigit ) import qualified Data.Monoid as Monoid import Data.List.NonEmpty ( NonEmpty (..) ) import Control.DeepSeq +import GHC.Exts (inline) {- %************************************************************************ @@ -722,6 +724,19 @@ isReflexiveCo_maybe co = Nothing where (Pair ty1 ty2, r) = coercionKindRole co +-- | Like @\\ cos -> map fst <$> traverse isReflCo_maybe cos@, +-- but avoiding wasteful allocations (see #27648). +reflCos_maybe :: [Coercion] -> Maybe [Type] +reflCos_maybe = + traverseMaybeUB + ( fmap fst + . inline isReflCo_maybe + -- isReflCo_maybe must inline so that 'fmap fst' fuses and the whole + -- function inlines into 'traverseMaybeUB' + ) +{-# INLINE reflCos_maybe #-} + -- to avoid allocating the result's 'Just' constructor application + forAllCoKindCo :: TyCoVar -> KindMCoercion -> KindCoercion -- Get the kind coercion from a ForAllCo forAllCoKindCo _ (MCo co) = co @@ -811,8 +826,8 @@ mkTyConAppCo r tc cos | ExpandsSyn tv_co_prs rhs_ty leftover_cos <- expandSynTyCon_maybe tc cos = mkAppCos (liftCoSubst r (mkLiftingContext tv_co_prs) rhs_ty) leftover_cos - | Just tys_roles <- traverse isReflCo_maybe cos - = mkReflCo r (mkTyConApp tc (map fst tys_roles)) + | Just tys <- reflCos_maybe cos + = mkReflCo r $! mkTyConApp tc tys -- See Note [Refl invariant] | otherwise = TyConAppCo r tc cos ===================================== compiler/GHC/Data/Unboxed.hs ===================================== @@ -13,10 +13,11 @@ module GHC.Data.Unboxed ( MaybeUB(JustUB, NothingUB), - fmapMaybeUB, fromMaybeUB, apMaybeUB, maybeUB + fmapMaybeUB, fromMaybeUB, apMaybeUB, maybeUB, + traverseMaybeUB ) where -import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Prelude -- | Like Maybe, but using unboxed sums. -- @@ -54,3 +55,28 @@ fmapMaybeUB f (JustUB x) = JustUB $ f x maybeUB :: b -> (a -> b) -> MaybeUB a -> b maybeUB _def f (JustUB x) = f x maybeUB def _f NothingUB = def + +toMaybe :: MaybeUB a -> Maybe a +toMaybe NothingUB = Nothing +toMaybe (JustUB a) = Just a + +-- | Like 'traverse' for the 'Maybe' applicative, but avoiding intermediate +-- allocations. +-- +-- The passed-in function must inline for this to help at all. +traverseMaybeUB + :: forall a b + . (a -> Maybe b) -- ^ @INLINE@ function to map over the list + -> [a] -> Maybe [b] +{-# INLINE traverseMaybeUB #-} + -- 'traverseMaybeUB' must inline so that the function it is passed can inline +traverseMaybeUB f = \ xs -> toMaybe $ go xs + where + go :: [a] -> MaybeUB [b] + go [] = JustUB [] + go (a:as) + | Just b <- f a -- f is assumed to inline + , JustUB bs <- go as + = JustUB (b:bs) + | otherwise + = NothingUB ===================================== compiler/GHC/Parser.y ===================================== @@ -1796,10 +1796,10 @@ cvars1 :: { [RecordPatSynField GhcPs] } where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList) } : 'where' '{' decls '}' {% amsA' (sLL $1 $> (thdOf3 $ unLoc $3, epTok $1, - AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) [])) } + AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3))) } | 'where' vocurly decls close {% amsA' (sLL $1 $3 (thdOf3 $ unLoc $3, epTok $1, - AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) [])) } + AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3))) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype @@ -1935,9 +1935,9 @@ decls :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) } | {- empty -} { noLoc (noAnn, [],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } - : '{' decls '}' { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) [] + : '{' decls '}' { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) ,sL1 $2 $ thdOf3 $ unLoc $2) } - | vocurly decls close { sL1 $2 (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) [] + | vocurly decls close { sL1 $2 (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) ,sL1 $2 $ thdOf3 $ unLoc $2) } -- Binding groups other than those of class and instance declarations @@ -1945,16 +1945,16 @@ decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } binds :: { Located (HsLocalBinds GhcPs) } -- May have implicit parameters -- No type declarations - : decllist {% do { let { (AnnList anc p s t, decls) = unLoc $1 } + : decllist {% do { let { (AnnList anc p s, decls) = unLoc $1 } ; val_binds <- cvBindGroup (unLoc $ decls) ; !cs <- getCommentsFor (gl $1) - ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s t) cs, NoEpTok) val_binds)} } + ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s) cs, NoEpTok) val_binds)} } | '{' dbinds '}' {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) [] []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } + $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } | vocurly dbinds close {% acs (gl $2) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone [] []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } + $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) } wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) } @@ -3282,7 +3282,7 @@ aexp2 :: { ECP } -- arrow notation extension | '(|' aexp cmdargs '|)' {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromCmd $ - amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) [] []) $2 Prefix + amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) []) $2 Prefix (reverse $3)) } projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } @@ -3414,9 +3414,9 @@ tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] } -- Never empty. list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b) } : texp { \loc (ao,ac) -> unECP $1 >>= \ $1 -> - mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] []) } + mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } | lexps { \loc (ao,ac) -> $1 >>= \ $1 -> - mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] []) } + mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } | texp '..' { \loc (ao,ac) -> unECP $1 >>= \ $1 -> amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (From $1)) >>= ecpFromExp' } @@ -3440,7 +3440,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 (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [], noAnn)) >>= ecpFromExp' } } lexps :: { forall b. DisambECP b => PV [LocatedA b] } @@ -3546,11 +3546,11 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList)) } : '{' alts(PATS) '}' { $2 >>= \ $2 -> amsA' (sLL $1 $> (reverse (snd $ unLoc $2), - (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2) []))) } + (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2)))) } | vocurly alts(PATS) close { $2 >>= \ $2 -> amsA' (L (getLoc $2) (reverse (snd $ unLoc $2), - (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2) []))) } - | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) [] []))) } + (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2)))) } + | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) []))) } | vocurly close { return $ noLocA ([], noAnn) } alts(PATS) :: { forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)])) } @@ -4727,7 +4727,7 @@ commentsPA la@(L l a) = do 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) + = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis, rec) listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation listAsAnchorM [] = Nothing ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Parser.Annotation ( -- ** Trailing annotations in lists TrailingAnn(..), ta_location, - addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN, + addTrailingAnnToA, addTrailingCommaToN, addTrailingAnnToBF, noTrailingN, @@ -529,10 +529,7 @@ data AnnList = AnnList { al_anchor :: !(Maybe EpaLocation), -- ^ start point of a list having layout al_brackets :: !AnnListBrackets, - al_semis :: [EpToken ";"], -- decls - al_trailing :: ![TrailingAnn] -- ^ items appearing after the - -- list, such as '=>' for a - -- context + al_semis :: [EpToken ";"] -- decls } deriving (Data,Eq) data AnnListBrackets @@ -672,16 +669,6 @@ data AnnPragSCC -- --------------------------------------------------------------------- --- | Helper function used in the parser to add a 'TrailingAnn' items --- to an existing annotation. -addTrailingAnnToL :: TrailingAnn -> EpAnnComments - -> EpAnn AnnList -> EpAnn AnnList -addTrailingAnnToL t cs n = n { anns = addTrailing (anns n) - , comments = comments n <> cs } - where - -- See Note [list append in addTrailing*] - addTrailing n = n { al_trailing = al_trailing n ++ [t]} - addTrailingAnnToBF :: TrailingAnn -> EpAnnComments -> EpAnn AnnBooleanFormula -> EpAnn AnnBooleanFormula addTrailingAnnToBF t cs n = n { anns = addTrailing (anns n) @@ -714,7 +701,7 @@ noTrailingN s = s { anns = (anns s) { nann_trailing = [] } } {- Note [list append in addTrailing*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The addTrailingAnnToL, addTrailingAnnToA and addTrailingCommaToN +The addTrailingAnnToA and addTrailingCommaToN functions are used to add a separator for an item when it occurs in a list. So they are used to capture a comma, vbar, semicolon and similar. @@ -1047,7 +1034,7 @@ instance NoAnn AnnBooleanFormula where noAnn = AnnBooleanFormula noAnn noAnn [] instance NoAnn AnnList where - noAnn = AnnList Nothing ListNone noAnn [] + noAnn = AnnList Nothing ListNone noAnn instance NoAnn NameAnn where noAnn = NameAnnTrailing [] @@ -1141,8 +1128,8 @@ instance Outputable NameAnn where = text "NameAnnTrailing" <+> ppr t instance Outputable AnnList where - ppr (AnnList anc p s t) - = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr t + ppr (AnnList l p s) + = text "AnnList" <+> ppr l <+> ppr p <+> ppr s instance Outputable AnnListBrackets where ppr (ListParens o c) = text "ListParens" <+> ppr o <+> ppr c ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -437,7 +437,7 @@ mkRoleAnnotDecl loc tycon roles anns 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) + = 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 @@ -1963,7 +1963,7 @@ instance DisambECP (HsCmd GhcPs) where return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns) mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do !cs <- getCommentsFor l - return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis [], tok_loc) stmts) + 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 mkHsParPV l lpar c rpar = do !cs <- getCommentsFor l @@ -2062,7 +2062,7 @@ instance DisambECP (HsExpr GhcPs) where return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns) mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = 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 (AnnList (Just anc) (ListBraces ob cb) semis, loc_tok) (DoExpr mod) stmts) mkHsParPV l lpar e rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e) ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -86,6 +86,7 @@ GHC.Data.Pair GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap +GHC.Data.Unboxed GHC.Data.Word64Map GHC.Data.Word64Map.Internal GHC.Data.Word64Map.Lazy ===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -71,7 +71,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -83,7 +83,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -95,7 +95,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -2124,7 +2124,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -91,7 +91,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -214,7 +213,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -294,7 +292,6 @@ (ListBraces (NoEpTok) (NoEpTok)) - [] []) (EpaSpan { DumpParsedAstComments.hs:14:7-8 })) (DoExpr @@ -364,7 +361,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -32,7 +32,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -259,7 +259,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -333,7 +332,6 @@ (ListBraces (NoEpTok) (NoEpTok)) - [] []) (EpaSpan { DumpSemis.hs:10:7-8 })) (DoExpr @@ -373,8 +371,7 @@ ,(EpTok (EpaSpan { DumpSemis.hs:11:10 })) ,(EpTok - (EpaSpan { DumpSemis.hs:11:11 }))] - []) + (EpaSpan { DumpSemis.hs:11:11 }))]) (EpaSpan { DumpSemis.hs:11:3-4 })) (DoExpr (Nothing)) @@ -554,7 +551,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -631,8 +627,7 @@ [(EpTok (EpaSpan { DumpSemis.hs:16:5 })) ,(EpTok - (EpaSpan { DumpSemis.hs:16:8 }))] - []) + (EpaSpan { DumpSemis.hs:16:8 }))]) (EpaSpan { DumpSemis.hs:15:7-8 })) (DoExpr (Nothing)) @@ -806,7 +801,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -883,8 +877,7 @@ [(EpTok (EpaSpan { DumpSemis.hs:22:12 })) ,(EpTok - (EpaSpan { DumpSemis.hs:22:13 }))] - []) + (EpaSpan { DumpSemis.hs:22:13 }))]) (EpaSpan { DumpSemis.hs:22:7-8 })) (DoExpr (Nothing)) @@ -1015,7 +1008,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1120,7 +1112,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1227,7 +1218,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1718,7 +1708,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1844,7 +1833,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1935,8 +1923,7 @@ ,(EpTok (EpaSpan { DumpSemis.hs:34:17 })) ,(EpTok - (EpaSpan { DumpSemis.hs:34:18 }))] - []) + (EpaSpan { DumpSemis.hs:34:18 }))]) (EpaComments [])) (NoEpTok)) @@ -1971,7 +1958,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -2084,7 +2070,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -2209,7 +2194,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -2328,8 +2312,7 @@ ,(EpTok (EpaSpan { DumpSemis.hs:38:7 })) ,(EpTok - (EpaSpan { DumpSemis.hs:38:8 }))] - [])) + (EpaSpan { DumpSemis.hs:38:8 }))])) (L (EpAnn (EpaSpan { DumpSemis.hs:(38,4)-(44,4) }) ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -964,7 +964,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1664,7 +1663,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/T15279.stderr ===================================== @@ -154,7 +154,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/T20718.stderr ===================================== @@ -105,7 +105,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/T20846.stderr ===================================== @@ -95,7 +95,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -71,7 +71,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -163,7 +162,6 @@ (Just (EpaSpan { Test20297.hs:7:3-7 })) (ListNone) - [] []) (EpaComments [])) @@ -203,7 +201,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -289,7 +286,6 @@ (Just (EpaSpan { Test20297.hs:11:9-26 })) (ListNone) - [] []) (EpaComments [(L @@ -327,7 +323,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -401,7 +396,6 @@ (ListBraces (NoEpTok) (NoEpTok)) - [] []) (EpaSpan { Test20297.hs:11:19-20 })) (DoExpr @@ -517,7 +511,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -603,7 +596,6 @@ (Just (EpaSpan { Test20297.ppr.hs:5:3-7 })) (ListNone) - [] []) (EpaComments [])) @@ -637,7 +629,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -723,7 +714,6 @@ (Just (EpaSpan { Test20297.ppr.hs:9:7-24 })) (ListNone) - [] []) (EpaComments [])) @@ -755,7 +745,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -829,7 +818,6 @@ (ListBraces (NoEpTok) (NoEpTok)) - [] []) (EpaSpan { Test20297.ppr.hs:9:17-18 })) (DoExpr ===================================== testsuite/tests/printer/Test24533.stdout ===================================== @@ -521,7 +521,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn @@ -1093,7 +1092,6 @@ (AnnList (Nothing) (ListNone) - [] [])) (L (EpAnn ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -281,8 +281,8 @@ instance HasTrailing EpAnnSumPat where setTrailing a _ = a instance HasTrailing AnnList where - trailing a = al_trailing a - setTrailing a ts = a { al_trailing = ts } + trailing _ = [] + setTrailing a _ = a instance HasTrailing [TrailingAnn] where trailing a = a ===================================== utils/check-exact/Main.hs ===================================== @@ -524,8 +524,8 @@ changeLocalDecls libdir (L l p) = do let oldDecls' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) - let (EpAnn anc (AnnList (Just _) a b dd) cs) = van - let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b dd) cs) + let (EpAnn anc (AnnList (Just _) a b) cs) = van + let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b) cs) let binds' = (HsValBinds (van',w) (ValBinds noExtField (VbSig sig':VbBind decl':VbSig o':oldBinds))) return (L lm (Match an mln pats (GRHSs emptyComments rhs binds'))) @@ -552,7 +552,6 @@ changeLocalDecls2 libdir (L l p) = do let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) []) let an = (EpAnn anc (AnnList (Just anc2) ListNone - [] []) emptyComments, EpTok (EpaDelta noSrcSpan (SameLine 0) [])) let decls = [VbSig sig', VbBind decl'] ===================================== utils/check-exact/Transform.hs ===================================== @@ -1096,7 +1096,7 @@ oldWhereAnnotation (EpAnn anc an cs, _w) ww _oldSpan = an' -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, -- change the AnnList anchor to have the correct DP too where - (AnnList ancl p s t) = an + (AnnList ancl p s) = an w = case ww of WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> NoEpTok @@ -1105,7 +1105,7 @@ oldWhereAnnotation (EpAnn anc an cs, _w) ww _oldSpan = an' WithWhere -> (anc, ancl) WithoutWhere -> (anc, ancl) an' = (EpAnn anc' - (AnnList ancl' p s t) + (AnnList ancl' p s) cs, w) newWhereAnnotation :: WithWhere -> (EpAnn AnnList, EpToken "where") @@ -1117,7 +1117,7 @@ newWhereAnnotation ww = (an, w) WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> NoEpTok an = EpAnn anc - (AnnList (Just anc2) ListNone [] []) + (AnnList (Just anc2) ListNone []) emptyComments -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8dd064952ab724bd57b82d9258b4df0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8dd064952ab724bd57b82d9258b4df0... 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