Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7f75c588 by Alan Zimmerman at 2026-08-10T14:29:11-04:00 EPA: Remove type parameter from AnnList This is a step towards cutting AnnList down to its core for formatting lists only - - - - - 26 changed files: - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/ghc-api/T25121_status.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 - utils/check-exact/Utils.hs Changes: ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -72,8 +72,8 @@ Global bindings (where clauses) -- the ...LR datatypes are parameterized by two id types, -- one for the left and one for the right. -type instance XHsValBinds (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where")) -type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where")) +type instance XHsValBinds (GhcPass pL) (GhcPass pR) = (EpAnn AnnList, EpToken "where") +type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = (EpAnn AnnList, EpToken "where") type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = DataConCantHappen ===================================== compiler/GHC/Hs/Dump.hs ===================================== @@ -67,11 +67,8 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan `extQ` annotationModule `extQ` annotationGrhsAnn + `extQ` annotationAnnListEpAnn `extQ` annotationAnnList - `extQ` annotationEpAnnListWhere - `extQ` annotationAnnListUnit - `extQ` annotationAnnListCommas - `extQ` annotationAnnListEpaLocation `extQ` annotationNoEpAnns `extQ` annotationExprBracket `extQ` annotationTypedBracket @@ -372,27 +369,15 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn") - annotationAnnList :: EpAnn (AnnList ()) -> SDoc - annotationAnnList = annotation' (text "EpAnn (AnnList ())") + annotationAnnListEpAnn :: EpAnn AnnList -> SDoc + annotationAnnListEpAnn = annotation' (text "EpAnn AnnList") - annotationEpAnnListWhere :: EpAnn (AnnList (EpToken "where")) -> SDoc - annotationEpAnnListWhere = annotation' (text "EpAnn (AnnList (EpToken \"where\"))") - - annotationAnnListCommas :: EpAnn (AnnList [EpToken ","]) -> SDoc - annotationAnnListCommas = annotation' (text "EpAnn (AnnList [EpToken \",\"])") - - annotationAnnListUnit :: AnnList () -> SDoc - annotationAnnListUnit anns = case ba of + annotationAnnList :: AnnList -> SDoc + annotationAnnList anns = case ba of BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList ()") NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns)) $$ vcat (gmapQ showAstData' anns) - annotationAnnListEpaLocation :: AnnList EpaLocation -> SDoc - annotationAnnListEpaLocation anns = case ba of - BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList EpaLocation") - NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns)) - $$ vcat (gmapQ showAstData' anns) - annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns") ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -289,11 +289,11 @@ 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 = (AnnList, EpaLocation) type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type -type instance XExplicitList GhcPs = AnnList () +type instance XExplicitList GhcPs = AnnList type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type -- GhcPs: ExplicitList includes all source-level @@ -1437,7 +1437,7 @@ type instance XCmdArrApp GhcPs = (IsUnicodeSyntax, EpaLocation) type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type -type instance XCmdArrForm GhcPs = AnnList () +type instance XCmdArrForm GhcPs = AnnList -- | fixity (filled in by the renamer), for forms that were converted from -- OpApp's by the renamer type instance XCmdArrForm GhcRn = Maybe Fixity @@ -1464,7 +1464,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 = (AnnList, EpaLocation) type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type @@ -1657,7 +1657,7 @@ type instance XMG GhcRn b = (Origin, -- See Note [Generated code and pat MatchGroupAnn) type instance XMG GhcTc b = MatchGroupTc -type MatchGroupAnn = AnnList () +type MatchGroupAnn = AnnList data MatchGroupTc = MatchGroupTc @@ -1892,7 +1892,7 @@ type instance XTransStmt (GhcPass _) GhcPs b = AnnTransStmt type instance XTransStmt (GhcPass _) GhcRn b = NoExtField type instance XTransStmt (GhcPass _) GhcTc b = Type -type instance XRecStmt (GhcPass _) GhcPs b = AnnList (EpToken "rec") +type instance XRecStmt (GhcPass _) GhcPs b = (AnnList, EpToken "rec") type instance XRecStmt (GhcPass _) GhcRn b = NoExtField type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -104,7 +104,7 @@ type instance XBangPat GhcPs = EpToken "!" type instance XBangPat GhcRn = NoExtField type instance XBangPat GhcTc = NoExtField -type instance XListPat GhcPs = AnnList () +type instance XListPat GhcPs = AnnList -- After parsing, ListPat can refer to a built-in Haskell list pattern -- or an overloaded list pattern. type instance XListPat GhcRn = NoExtField ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -326,11 +326,11 @@ 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] -> (AnnList, EpaLocation) -> HsExpr GhcPs mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs - -> AnnList EpaLocation + -> (AnnList, EpaLocation) -> HsExpr GhcPs mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-" @@ -368,7 +368,7 @@ mkRecStmt :: forall (idL :: Pass) bodyR. (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnA) - => AnnList (EpToken "rec") + => (AnnList, EpToken "rec") -> LocatedA [LStmtLR (GhcPass idL) GhcPs bodyR] -> StmtLR (GhcPass idL) GhcPs bodyR mkRecStmt anns stmts = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR) ===================================== compiler/GHC/Parser.y ===================================== @@ -1791,13 +1791,13 @@ cvars1 :: { [RecordPatSynField GhcPs] } | var ',' cvars1 {% do { h <- addTrailingCommaN $1 (gl $2) ; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}} -where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ()) } +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 @@ -1932,10 +1932,10 @@ decls :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) } | decl { sL1 $1 (glR $1, [], unitOL $1) } | {- 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) noAnn [] +decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } + : '{' 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) noAnn [] + | 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 @@ -1943,16 +1943,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 t, decls) = unLoc $1 } ; val_binds <- cvBindGroup (unLoc $ decls) ; !cs <- getCommentsFor (gl $1) - ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s noAnn t) cs) val_binds)} } + ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s t) 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)) [] noAnn []) cs) (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 [] noAnn []) cs) (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 )) } @@ -3280,7 +3280,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)) [] noAnn []) $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))) } @@ -3412,9 +3412,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)) [] noAnn []) } + 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)) [] noAnn []) } + 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' } @@ -3438,7 +3438,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] } @@ -3541,14 +3541,14 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } ----------------------------------------------------------------------------- -- Case alternatives -altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())) } +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) noAnn []))) } + (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) noAnn []))) } - | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) [] noAnn []))) } + (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)])) } @@ -4723,9 +4723,9 @@ 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 :: 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 ===================================== @@ -515,12 +515,11 @@ instance Outputable TrailingAnn where -- keywords such as 'where'. -- AZ: goal: only used when there is layout, so vertical alignment matters -data AnnList a +data AnnList = AnnList { al_anchor :: !(Maybe EpaLocation), -- ^ start point of a list having layout al_brackets :: !AnnListBrackets, al_semis :: [EpToken ";"], -- decls - al_rest :: !a, al_trailing :: ![TrailingAnn] -- ^ items appearing after the -- list, such as '=>' for a -- context @@ -666,7 +665,7 @@ data AnnPragSCC -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. addTrailingAnnToL :: TrailingAnn -> EpAnnComments - -> EpAnn (AnnList a) -> EpAnn (AnnList a) + -> EpAnn AnnList -> EpAnn AnnList addTrailingAnnToL t cs n = n { anns = addTrailing (anns n) , comments = comments n <> cs } where @@ -1037,8 +1036,8 @@ instance NoAnn NoEpAnns where instance NoAnn AnnBooleanFormula where noAnn = AnnBooleanFormula noAnn noAnn [] -instance NoAnn a => NoAnn (AnnList a) where - noAnn = AnnList Nothing ListNone noAnn noAnn [] +instance NoAnn AnnList where + noAnn = AnnList Nothing ListNone noAnn [] instance NoAnn NameAnn where noAnn = NameAnnTrailing [] @@ -1131,9 +1130,9 @@ instance Outputable NameAnn where ppr (NameAnnTrailing t) = text "NameAnnTrailing" <+> ppr t -instance (Outputable a) => Outputable (AnnList a) where - ppr (AnnList anc p s a t) - = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr a <+> ppr t +instance Outputable AnnList where + ppr (AnnList anc p s t) + = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr t 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 @@ -459,19 +459,19 @@ fromSpecTyVarBndr (L loc (HsTvb xtv flag idp k)) = do -- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@ annBinds :: EpToken "where" -> EpAnnComments -> HsLocalBinds GhcPs -> (HsLocalBinds GhcPs, Maybe EpAnnComments) -annBinds w cs (HsValBinds an bs) = (HsValBinds (add_where w an cs) bs, Nothing) -annBinds w cs (HsIPBinds an bs) = (HsIPBinds (add_where w an cs) bs, Nothing) +annBinds w cs (HsValBinds an bs) = (HsValBinds (add_where w (fst an) cs) bs, Nothing) +annBinds w cs (HsIPBinds an bs) = (HsIPBinds (add_where w (fst an) cs) bs, Nothing) annBinds _ cs (EmptyLocalBinds x) = (EmptyLocalBinds x, Just cs) -add_where :: EpToken "where" -> EpAnn (AnnList (EpToken "where")) -> EpAnnComments -> EpAnn (AnnList (EpToken "where")) +add_where :: EpToken "where" -> EpAnn AnnList -> EpAnnComments + -> (EpAnn AnnList, EpToken "where") add_where w@(EpTok (EpaSpan (RealSrcSpan rs _))) (EpAnn a al cs) cs2 | valid_anchor a - = EpAnn (widenAnchorT a w) (al { al_rest = w}) (cs Semi.<> cs2) + = (EpAnn (widenAnchorT a w) al (cs Semi.<> cs2), w) | otherwise - = EpAnn (patch_anchor rs a) - (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al)) - , al_rest = w}) - (cs Semi.<> cs2) + = (EpAnn (patch_anchor rs a) + (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al))}) + (cs Semi.<> cs2), w) add_where _ _ _ = panic "add_where" -- EpaDelta should only be used for transformations @@ -728,7 +728,7 @@ tyConToDataCon (L loc tc) occ = rdrNameOcc tc mkPatSynMatchGroup :: LocatedN RdrName - -> LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ()) + -> LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList) -> P (MatchGroup GhcPs (LHsExpr GhcPs)) mkPatSynMatchGroup (L loc patsyn_name) (L ld (decls, _, ann)) = do { matches <- mapM fromDecl (fromOL decls) @@ -1777,11 +1777,11 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> PV (LocatedA b) -- | Disambiguate "case ... of ..." mkHsCasePV :: SrcSpan -> LHsExpr GhcPs - -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ()) + -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList) -> EpAnnHsCase -> PV (LocatedA b) -- | Disambiguate "\... -> ..." (lambda), "\case" and "\cases" mkHsLamPV :: SrcSpan -> HsLamVariant - -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ()) + -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList) -> EpAnnLam -> PV (LocatedA b) -- | Function argument representation @@ -1827,7 +1827,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where mkHsTySigPV :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b) -- | Disambiguate "[a,b,c]" (list syntax) - mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList () -> PV (LocatedA b) + mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b) -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices) mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b) -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates) @@ -1961,7 +1961,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 @@ -2060,7 +2060,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/ghc-api/T25121_status.stdout ===================================== @@ -15,7 +15,7 @@ X(FunArr) match = NoExtField X(ExprWithTySig) match = EpUniToken "::" "\8759" X(UntypedSplice) match = NoExtField X(ExplicitList) mismatch - >>> AnnList () + >>> AnnList <<< ((EpToken "'"),(EpToken "["),(EpToken "]")) X(ExplicitTuple) mismatch
AnnParen
===================================== testsuite/tests/ghc-api/exactprint/T22919.stderr ===================================== @@ -72,7 +72,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -84,7 +84,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -96,7 +96,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -2124,7 +2124,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -92,7 +92,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -216,7 +215,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -289,15 +287,16 @@ "-- normal comment") { DumpParsedAstComments.hs:14:7-8 }))])) (HsDo - (AnnList - (Just - (EpaSpan { DumpParsedAstComments.hs:16:3 })) - (ListBraces - (NoEpTok) - (NoEpTok)) - [] - (EpaSpan { DumpParsedAstComments.hs:14:7-8 }) - []) + ((,) + (AnnList + (Just + (EpaSpan { DumpParsedAstComments.hs:16:3 })) + (ListBraces + (NoEpTok) + (NoEpTok)) + [] + []) + (EpaSpan { DumpParsedAstComments.hs:14:7-8 })) (DoExpr (Nothing)) (L @@ -366,7 +365,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -33,7 +33,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -260,7 +260,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -327,15 +326,16 @@ (EpaComments [])) (HsDo - (AnnList - (Just - (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) - (ListBraces - (NoEpTok) - (NoEpTok)) - [] - (EpaSpan { DumpSemis.hs:10:7-8 }) - []) + ((,) + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) + (ListBraces + (NoEpTok) + (NoEpTok)) + [] + []) + (EpaSpan { DumpSemis.hs:10:7-8 })) (DoExpr (Nothing)) (L @@ -359,22 +359,23 @@ (EpaComments [])) (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 }))] - (EpaSpan { DumpSemis.hs:11:3-4 }) - []) + ((,) + (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 }))] + []) + (EpaSpan { DumpSemis.hs:11:3-4 })) (DoExpr (Nothing)) (L @@ -554,7 +555,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -621,18 +621,19 @@ (EpaComments [])) (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 }))] - (EpaSpan { DumpSemis.hs:15:7-8 }) - []) + ((,) + (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 }))] + []) + (EpaSpan { DumpSemis.hs:15:7-8 })) (DoExpr (Nothing)) (L @@ -806,7 +807,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -873,18 +873,19 @@ (EpaComments [])) (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 }))] - (EpaSpan { DumpSemis.hs:22:7-8 }) - []) + ((,) + (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 }))] + []) + (EpaSpan { DumpSemis.hs:22:7-8 })) (DoExpr (Nothing)) (L @@ -1015,7 +1016,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1121,7 +1121,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1229,7 +1228,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1721,7 +1719,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1848,7 +1845,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1921,28 +1917,29 @@ (EpTok (EpaSpan { DumpSemis.hs:34:32-33 }))) (HsValBinds - (EpAnn - (EpaSpan { DumpSemis.hs:34:13-31 }) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:34:18-30 })) - (ListBraces - (EpTok (EpaSpan { DumpSemis.hs:34:13 })) - (EpTok (EpaSpan { DumpSemis.hs:34:31 }))) - [(EpTok - (EpaSpan { DumpSemis.hs:34:14 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:34:15 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:34:16 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:34:17 })) - ,(EpTok - (EpaSpan { DumpSemis.hs:34:18 }))] - (NoEpTok) - []) - (EpaComments - [])) + ((,) + (EpAnn + (EpaSpan { DumpSemis.hs:34:13-31 }) + (AnnList + (Just + (EpaSpan { DumpSemis.hs:34:18-30 })) + (ListBraces + (EpTok (EpaSpan { DumpSemis.hs:34:13 })) + (EpTok (EpaSpan { DumpSemis.hs:34:31 }))) + [(EpTok + (EpaSpan { DumpSemis.hs:34:14 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:34:15 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:34:16 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:34:17 })) + ,(EpTok + (EpaSpan { DumpSemis.hs:34:18 }))] + []) + (EpaComments + [])) + (NoEpTok)) (ValBinds (NoExtField) [(VbBind @@ -1975,7 +1972,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -2089,7 +2085,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -2215,7 +2210,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -2335,7 +2329,6 @@ (EpaSpan { DumpSemis.hs:38:7 })) ,(EpTok (EpaSpan { DumpSemis.hs:38:8 }))] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -965,7 +965,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1665,7 +1664,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/T15279.stderr ===================================== @@ -34,8 +34,7 @@ (L (EpAnn (EpaSpan { T15279.hs:3:8-13 }) - (AnnListItem - []) + [] (EpaComments [])) {ModuleName: T15279})) @@ -44,8 +43,7 @@ [(L (EpAnn (EpaSpan { T15279.hs:5:1-19 }) - (AnnListItem - []) + [] (EpaComments [])) (SigD @@ -72,8 +70,7 @@ (L (EpAnn (EpaSpan { T15279.hs:5:8-19 }) - (AnnListItem - []) + [] (EpaComments [])) (HsSig @@ -83,8 +80,7 @@ (L (EpAnn (EpaSpan { T15279.hs:5:8-19 }) - (AnnListItem - []) + [] (EpaComments [])) (HsFunTy @@ -100,8 +96,7 @@ (L (EpAnn (EpaSpan { T15279.hs:5:8-11 }) - (AnnListItem - []) + [] (EpaComments [])) (HsTyVar @@ -119,8 +114,7 @@ (L (EpAnn (EpaSpan { T15279.hs:5:16-19 }) - (AnnListItem - []) + [] (EpaComments [])) (HsTyVar @@ -138,8 +132,7 @@ ,(L (EpAnn (EpaSpan { <combineSrcSpans: files differ> }) - (AnnListItem - []) + [] (EpaComments [])) (ValD @@ -162,20 +155,17 @@ (Nothing) (ListNone) [] - (NoEpTok) [])) (L (EpAnn (EpaSpan { <combineSrcSpans: files differ> }) - (AnnListItem - []) + [] (EpaComments [])) [(L (EpAnn (EpaSpan { T15279.hs-incl:1:1-13 }) - (AnnListItem - []) + [] (EpaComments [])) (Match @@ -197,12 +187,15 @@ [] [])) (L - (EpaSpan { T15279.hs-incl:1:5-7 }) + (EpAnn + (EpaSpan { T15279.hs-incl:1:5-7 }) + [] + (EpaComments + [])) [(L (EpAnn (EpaSpan { T15279.hs-incl:1:5-7 }) - (AnnListItem - []) + [] (EpaComments [])) (LitPat @@ -234,8 +227,7 @@ (L (EpAnn (EpaSpan { T15279.hs-incl:1:11-13 }) - (AnnListItem - []) + [] (EpaComments [])) (HsLit @@ -249,8 +241,7 @@ ,(L (EpAnn (EpaSpan { T15279.hs-incl:2:1-13 }) - (AnnListItem - []) + [] (EpaComments [])) (Match @@ -272,12 +263,15 @@ [] [])) (L - (EpaSpan { T15279.hs-incl:2:5-7 }) + (EpAnn + (EpaSpan { T15279.hs-incl:2:5-7 }) + [] + (EpaComments + [])) [(L (EpAnn (EpaSpan { T15279.hs-incl:2:5-7 }) - (AnnListItem - []) + [] (EpaComments [])) (LitPat @@ -309,8 +303,7 @@ (L (EpAnn (EpaSpan { T15279.hs-incl:2:11-13 }) - (AnnListItem - []) + [] (EpaComments [])) (HsLit @@ -324,8 +317,7 @@ ,(L (EpAnn (EpaSpan { T15279.hs:7:1-11 }) - (AnnListItem - []) + [] (EpaComments [])) (Match @@ -347,12 +339,15 @@ [] [])) (L - (EpaSpan { T15279.hs:7:5 }) + (EpAnn + (EpaSpan { T15279.hs:7:5 }) + [] + (EpaComments + [])) [(L (EpAnn (EpaSpan { T15279.hs:7:5 }) - (AnnListItem - []) + [] (EpaComments [])) (WildPat @@ -381,8 +376,7 @@ (L (EpAnn (EpaSpan { T15279.hs:7:9-11 }) - (AnnListItem - []) + [] (EpaComments [])) (HsLit ===================================== testsuite/tests/parser/should_compile/T20718.stderr ===================================== @@ -106,7 +106,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/parser/should_compile/T20846.stderr ===================================== @@ -96,7 +96,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -72,7 +72,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -157,18 +156,19 @@ {OccName: x})))))) []) (HsValBinds - (EpAnn - (EpaSpan { <no location info> }) - (AnnList - (Just - (EpaSpan { Test20297.hs:7:3-7 })) - (ListNone) - [] - (EpTok - (EpaSpan { Test20297.hs:7:3-7 })) - []) - (EpaComments - [])) + ((,) + (EpAnn + (EpaSpan { <no location info> }) + (AnnList + (Just + (EpaSpan { Test20297.hs:7:3-7 })) + (ListNone) + [] + []) + (EpaComments + [])) + (EpTok + (EpaSpan { Test20297.hs:7:3-7 }))) (ValBinds (NoExtField) [])))))]))))) @@ -204,7 +204,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -283,24 +282,25 @@ {OccName: x})))))) []) (HsValBinds - (EpAnn - (EpaSpan { Test20297.hs:(10,3)-(11,26) }) - (AnnList - (Just - (EpaSpan { Test20297.hs:11:9-26 })) - (ListNone) - [] - (EpTok - (EpaSpan { Test20297.hs:10:3-7 })) - []) - (EpaComments - [(L - (EpaSpan - { Test20297.hs:10:9-19 }) - (EpaComment - (EpaLineComment - "-- comment2") - { Test20297.hs:10:3-7 }))])) + ((,) + (EpAnn + (EpaSpan { Test20297.hs:(10,3)-(11,26) }) + (AnnList + (Just + (EpaSpan { Test20297.hs:11:9-26 })) + (ListNone) + [] + []) + (EpaComments + [(L + (EpaSpan + { Test20297.hs:10:9-19 }) + (EpaComment + (EpaLineComment + "-- comment2") + { Test20297.hs:10:3-7 }))])) + (EpTok + (EpaSpan { Test20297.hs:10:3-7 }))) (ValBinds (NoExtField) [(VbBind @@ -328,7 +328,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -395,15 +394,16 @@ (EpaComments [])) (HsDo - (AnnList - (Just - (EpaSpan { Test20297.hs:11:22-26 })) - (ListBraces - (NoEpTok) - (NoEpTok)) - [] - (EpaSpan { Test20297.hs:11:19-20 }) - []) + ((,) + (AnnList + (Just + (EpaSpan { Test20297.hs:11:22-26 })) + (ListBraces + (NoEpTok) + (NoEpTok)) + [] + []) + (EpaSpan { Test20297.hs:11:19-20 })) (DoExpr (Nothing)) (L @@ -518,7 +518,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -597,18 +596,19 @@ {OccName: x})))))) []) (HsValBinds - (EpAnn - (EpaSpan { <no location info> }) - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:5:3-7 })) - (ListNone) - [] - (EpTok - (EpaSpan { Test20297.ppr.hs:5:3-7 })) - []) - (EpaComments - [])) + ((,) + (EpAnn + (EpaSpan { <no location info> }) + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:5:3-7 })) + (ListNone) + [] + []) + (EpaComments + [])) + (EpTok + (EpaSpan { Test20297.ppr.hs:5:3-7 }))) (ValBinds (NoExtField) [])))))]))))) @@ -638,7 +638,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -717,18 +716,19 @@ {OccName: x})))))) []) (HsValBinds - (EpAnn - (EpaSpan { Test20297.ppr.hs:(8,3)-(9,24) }) - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:9:7-24 })) - (ListNone) - [] - (EpTok - (EpaSpan { Test20297.ppr.hs:8:3-7 })) - []) - (EpaComments - [])) + ((,) + (EpAnn + (EpaSpan { Test20297.ppr.hs:(8,3)-(9,24) }) + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:9:7-24 })) + (ListNone) + [] + []) + (EpaComments + [])) + (EpTok + (EpaSpan { Test20297.ppr.hs:8:3-7 }))) (ValBinds (NoExtField) [(VbBind @@ -756,7 +756,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -823,15 +822,16 @@ (EpaComments [])) (HsDo - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:9:20-24 })) - (ListBraces - (NoEpTok) - (NoEpTok)) - [] - (EpaSpan { Test20297.ppr.hs:9:17-18 }) - []) + ((,) + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:9:20-24 })) + (ListBraces + (NoEpTok) + (NoEpTok)) + [] + []) + (EpaSpan { Test20297.ppr.hs:9:17-18 })) (DoExpr (Nothing)) (L ===================================== testsuite/tests/printer/Test24533.stdout ===================================== @@ -522,7 +522,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn @@ -1095,7 +1094,6 @@ (Nothing) (ListNone) [] - (()) [])) (L (EpAnn ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -231,7 +231,7 @@ setAnchorAn :: (HasTrailing an) setAnchorAn (L (EpAnn _ an _) a) anc ts cs = (L (EpAnn anc (setTrailing an ts) cs) a) -- `debug` ("setAnchorAn: anc=" ++ showAst anc) -setAnchorEpaL :: EpAnn (AnnList l) -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn (AnnList l) +setAnchorEpaL :: EpAnn AnnList -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = Nothing}) ts) cs -- --------------------------------------------------------------------- @@ -280,7 +280,7 @@ instance HasTrailing EpAnnSumPat where trailing _ = [] setTrailing a _ = a -instance HasTrailing (AnnList a) where +instance HasTrailing AnnList where trailing a = al_trailing a setTrailing a ts = a { al_trailing = ts } @@ -976,24 +976,19 @@ limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = n -- al_anchor :: Maybe Anchor, -- ^ start point of a list having layout -- al_brackets :: !AnnListBrackets, -- al_semis :: [EpToken ";"], -- decls --- al_rest :: !a, -- al_trailing :: [TrailingAnn] -- ^ items appearing after the -- -- list, such as '=>' for a -- -- context -- } deriving (Data,Eq) -lal_brackets :: Lens (AnnList l) AnnListBrackets +lal_brackets :: Lens AnnList AnnListBrackets lal_brackets k parent = fmap (\new -> parent { al_brackets = new }) (k (al_brackets parent)) -lal_semis :: Lens (AnnList l) [EpToken ";"] +lal_semis :: Lens AnnList [EpToken ";"] lal_semis k parent = fmap (\new -> parent { al_semis = new }) (k (al_semis parent)) -lal_rest :: Lens (AnnList l) l -lal_rest k parent = fmap (\new -> parent { al_rest = new }) - (k (al_rest parent)) - -- ------------------------------------- lfst :: Lens (a,b) a @@ -1281,23 +1276,23 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok -- --------------------------------------------------------------------- markAnnList :: (Monad m, Monoid w) - => EpAnn (AnnList l) -> EP w m a -> EP w m (EpAnn (AnnList l), a) + => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) markAnnList ann action = do markAnnListA ann $ \a -> do r <- action return (a,r) markAnnList' :: (Monad m, Monoid w) - => AnnList l -> EP w m a -> EP w m (AnnList l, a) + => AnnList -> EP w m a -> EP w m (AnnList, a) markAnnList' ann action = do markAnnListA' ann $ \a -> do r <- action return (a,r) markAnnListA :: (Monad m, Monoid w) - => EpAnn (AnnList l) - -> (EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a)) - -> EP w m (EpAnn (AnnList l), a) + => EpAnn AnnList + -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a)) + -> EP w m (EpAnn AnnList, a) markAnnListA an action = do an0 <- markLensBracketsO an lal_brackets an1 <- markEpAnnAllLT an0 lal_semis @@ -1306,9 +1301,9 @@ markAnnListA an action = do return (an3, r) markAnnListA' :: (Monad m, Monoid w) - => AnnList l - -> (AnnList l -> EP w m (AnnList l, a)) - -> EP w m (AnnList l , a) + => AnnList + -> (AnnList -> EP w m (AnnList, a)) + -> EP w m (AnnList, a) markAnnListA' an action = do an0 <- markLensBracketsO' an lal_brackets an1 <- markEpAnnAllLT' an0 lal_semis @@ -2467,17 +2462,17 @@ instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where -- --------------------------------------------------------------------- instance ExactPrint (HsLocalBinds GhcPs) where - getAnnotationEntry (HsValBinds an _) = fromAnn an + getAnnotationEntry (HsValBinds (an,_) _) = fromAnn an getAnnotationEntry (HsIPBinds{}) = NoEntryVal getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal - setAnnotationAnchor (HsValBinds an a) anc ts cs = HsValBinds (setAnchorEpaL an anc ts cs) a + setAnnotationAnchor (HsValBinds (an,w) a) anc ts cs = HsValBinds (setAnchorEpaL an anc ts cs, w) a setAnnotationAnchor a _ _ _ = a - exact (HsValBinds an valbinds) = do - an0 <- markLensFun' an lal_rest markEpToken -- 'where' + exact (HsValBinds (an0, w) valbinds) = do + w' <- markEpToken w -- 'where' - case al_anchor $ anns an of + case al_anchor $ anns an0 of Just anc -> do when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc) _ -> return () @@ -2490,14 +2485,14 @@ instance ExactPrint (HsLocalBinds GhcPs) where Just (ss,dp) -> do setExtraDPReturn Nothing return $ an1 { anns = (anns an1) { al_anchor = Just (EpaDelta ss dp []) }} - return (HsValBinds an2 valbinds') + return (HsValBinds (an2, w') valbinds') - exact (HsIPBinds an bs) = do + exact (HsIPBinds (an,w) bs) = do + w' <- markEpToken w (an2,bs') <- markAnnListA an $ \an0 -> do - an1 <- markLensFun' an0 lal_rest markEpToken bs' <- markAnnotated bs - return (an1, bs') - return (HsIPBinds an2 bs') + return (an0, bs') + return (HsIPBinds (an2,w') bs') exact b@(EmptyLocalBinds _) = return b @@ -2925,10 +2920,10 @@ instance ExactPrint (HsExpr GhcPs) where e' <- markAnnotated e return (HsLet (tkLet',tkIn') binds' e') - exact (HsDo an do_or_list_comp stmts) = do + exact (HsDo (an,l) do_or_list_comp stmts) = do debugM $ "HsDo" - (an',stmts') <- exactDo an do_or_list_comp stmts - return (HsDo an' do_or_list_comp stmts') + (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts + return (HsDo (an',l') do_or_list_comp stmts') exact (ExplicitList an es) = do debugM $ "ExplicitList start" @@ -3100,33 +3095,35 @@ 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) -exactDo an (DoExpr m) stmts = exactMdo an m "do" >>= - \an0 -> markMaybeDodgyStmts an0 stmts -exactDo an GhciStmtCtxt stmts = markLensFun an lal_rest (\l -> printStringAtAA l "do") >>= - \an0 -> markMaybeDodgyStmts an0 stmts -exactDo an (MDoExpr m) stmts = exactMdo an m "mdo" >>= - \an0 -> markMaybeDodgyStmts an0 stmts -exactDo an ListComp stmts = markMaybeDodgyStmts an stmts -exactDo an MonadComp stmts = markMaybeDodgyStmts an stmts + => (AnnList, EpaLocation) -> HsDoFlavour -> LocatedAn an a + -> EP w m (AnnList, EpaLocation, 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" >>= + \l0 -> markMaybeDodgyStmts (an,l0) stmts +exactDo (an,l) (MDoExpr m) stmts = exactMdo l m "mdo" >>= + \l0 -> markMaybeDodgyStmts (an,l0) stmts +exactDo (an,l) ListComp stmts = markMaybeDodgyStmts (an,l) stmts +exactDo (an,l) MonadComp stmts = markMaybeDodgyStmts (an,l) stmts exactMdo :: (Monad m, Monoid w) - => AnnList EpaLocation -> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation) -exactMdo an Nothing kw = markLensFun an lal_rest (\l -> printStringAtAA l kw) -exactMdo an (Just module_name) kw = markLensFun an lal_rest (\l -> printStringAtAA l n) + => EpaLocation -> Maybe ModuleName -> String -> EP w m EpaLocation +-- exactMdo an Nothing kw = markLensFun an lal_rest (\l -> printStringAtAA l kw) +exactMdo l Nothing kw = printStringAtAA l kw +exactMdo l (Just module_name) kw = printStringAtAA l n where n = (moduleNameString module_name) ++ "." ++ kw markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a)) - => AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a) -markMaybeDodgyStmts an stmts = + => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a) +markMaybeDodgyStmts (an,l) stmts = if notDodgy stmts then do - markAnnListA' an $ \a -> do + (an0,stmts') <- markAnnListA' an $ \a -> do r <- markAnnotatedWithLayout stmts return (a, r) - else return (an, stmts) + return (an0, l, stmts') + else return (an, l, stmts) notDodgy :: GenLocated (EpAnn ann) a -> Bool notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc @@ -3406,13 +3403,13 @@ instance ExactPrint (HsCmd GhcPs) where e' <- markAnnotated e return (HsCmdLet (tkLet', tkIn') binds' e') - exact (HsCmdDo an (L l es)) = do + exact (HsCmdDo (an0,loc) (L l es)) = do debugM $ "HsCmdDo" - an0 <- markLensFun an lal_rest (\ll -> printStringAtAA ll "do") + loc' <- printStringAtAA loc "do" (an1,es') <- markAnnList' an0 $ do ee <- mapM markAnnotated es return ee - return (HsCmdDo an1 (L l es')) + return (HsCmdDo (an1,loc') (L l es')) -- --------------------------------------------------------------------- @@ -3459,11 +3456,11 @@ instance ( (an', by', using') <- exactTransStmt an by using form return (TransStmt an' form stmts' b using' by' c d e) - exact (RecStmt an stmts a b c d e) = do + exact (RecStmt (an,r) stmts a b c d e) = do debugM $ "RecStmt" - an0 <- markLensFun an lal_rest markEpToken - (an1, stmts') <- markAnnList' an0 (markAnnotated stmts) - return (RecStmt an1 stmts' a b c d e) + r' <- markEpToken r + (an1, stmts') <- markAnnList' an (markAnnotated stmts) + return (RecStmt (an1,r') stmts' a b c d e) -- --------------------------------------------------------------------- ===================================== utils/check-exact/Main.hs ===================================== @@ -518,15 +518,15 @@ changeLocalDecls libdir (L l p) = do doAddLocal = everywhereM (mkM replaceLocalBinds) p replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) - replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ bs))))) = do + 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' = captureLineSpacing oldDecls let (VbSig o:oldBinds) = map wrapValBind oldDecls' o' = setEntryDP o (DifferentLine 2 0) - let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van - let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b c dd) cs) - let binds' = (HsValBinds van' + 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 binds' = (HsValBinds (van',w) (ValBinds noExtField (VbSig sig':VbBind decl':VbSig o':oldBinds))) return (L lm (Match an mln pats (GRHSs emptyComments rhs binds'))) `debug` ("oldDecls=" ++ showAst oldDecls) @@ -550,12 +550,11 @@ changeLocalDecls2 libdir (L l p) = do replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do let anc = (EpaDelta noSrcSpan (DifferentLine 1 2) []) let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) []) - let an = EpAnn anc + let an = (EpAnn anc (AnnList (Just anc2) ListNone [] - (EpTok (EpaDelta noSrcSpan (SameLine 0) [])) []) - emptyComments + emptyComments, EpTok (EpaDelta noSrcSpan (SameLine 0) [])) let decls = [VbSig sig', VbBind decl'] let binds = (HsValBinds an (ValBinds noExtField decls)) return (L lm (Match ma mln pats (GRHSs emptyComments rhs binds))) ===================================== utils/check-exact/Transform.hs ===================================== @@ -499,7 +499,7 @@ balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) pushTrailingComments :: WithWhere -> EpAnnComments -> HsLocalBinds GhcPs -> (Bool, HsLocalBinds GhcPs) pushTrailingComments _ _cs b@EmptyLocalBinds{} = (False, b) pushTrailingComments _ _cs (HsIPBinds _ _) = error "TODO: pushTrailingComments:HsIPBinds" -pushTrailingComments w cs lb@(HsValBinds an _) = (True, HsValBinds an' vb) +pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) vb) where decls = hsDeclsLocalBinds lb (an', decls') = case reverse decls of @@ -1090,13 +1090,13 @@ replaceDeclsValbinds w (EmptyLocalBinds _) new = let an = newWhereAnnotation w in (HsValBinds an (ValBinds noExtField (map wrapValBind new))) -oldWhereAnnotation :: EpAnn (AnnList (EpToken "where")) - -> WithWhere -> RealSrcSpan -> (EpAnn (AnnList (EpToken "where"))) -oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = an' +oldWhereAnnotation :: (EpAnn AnnList, EpToken "where") + -> WithWhere -> RealSrcSpan -> (EpAnn AnnList, EpToken "where") +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 _r t) = an + (AnnList ancl p s t) = an w = case ww of WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> NoEpTok @@ -1104,12 +1104,12 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = an' case ww of WithWhere -> (anc, ancl) WithoutWhere -> (anc, ancl) - an' = EpAnn anc' - (AnnList ancl' p s w t) - cs + an' = (EpAnn anc' + (AnnList ancl' p s t) + cs, w) -newWhereAnnotation :: WithWhere -> (EpAnn (AnnList (EpToken "where"))) -newWhereAnnotation ww = an +newWhereAnnotation :: WithWhere -> (EpAnn AnnList, EpToken "where") +newWhereAnnotation ww = (an, w) where anc = EpaDelta noSrcSpan (DifferentLine 1 2) [] anc2 = EpaDelta noSrcSpan (DifferentLine 1 4) [] @@ -1117,7 +1117,7 @@ newWhereAnnotation ww = an WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> NoEpTok an = EpAnn anc - (AnnList (Just anc2) ListNone [] w []) + (AnnList (Just anc2) ListNone [] []) emptyComments -- --------------------------------------------------------------------- ===================================== utils/check-exact/Utils.hs ===================================== @@ -230,7 +230,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn]) addCommentsListItem = addComments - addCommentsList :: EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ())) + addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList) addCommentsList = addComments addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f75c58844bbcff94e386c24012130d7... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f75c58844bbcff94e386c24012130d7... 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