Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: 030cd0f1 by Alan Zimmerman at 2026-07-04T14:53:06+01:00 EPA: Remove LocatedE from WarningCategory - - - - - e05bcb77 by Alan Zimmerman at 2026-07-04T15:59:29+01:00 EPA: Remove LocateE from XCImport and XCExport - - - - - 982953c9 by Alan Zimmerman at 2026-07-05T09:52:40+01:00 EPA: Remove LocatedE from HsRecFields dot - - - - - 9 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Unit/Module/Warnings.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1472,10 +1472,10 @@ type instance XForeignExport GhcTc = Coercion type instance XXForeignDecl (GhcPass _) = DataConCantHappen -type instance XCImport (GhcPass _) = LocatedE SourceText -- original source text for the C entity +type instance XCImport (GhcPass _) = LocatedA SourceText -- original source text for the C entity type instance XXForeignImport (GhcPass _) = DataConCantHappen -type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity +type instance XCExport (GhcPass _) = LocatedA SourceText -- original source text for the C entity type instance XXForeignExport (GhcPass _) = DataConCantHappen @@ -1729,6 +1729,6 @@ type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (Maybe Role) = EpAnnCO -type instance Anno CCallConv = EpaLocation -type instance Anno Safety = EpaLocation -type instance Anno CExportSpec = EpaLocation +type instance Anno CCallConv = SrcSpanAnnA +type instance Anno Safety = SrcSpanAnnA +type instance Anno CExportSpec = SrcSpanAnnA ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -353,7 +353,7 @@ hsRecFieldId = hsRecFieldSel ************************************************************************ -} -instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) +instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedA RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) = braces (fsep (punctuate comma (map ppr flds))) @@ -1178,4 +1178,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO type instance Anno ConLike = SrcSpanAnnN type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA -type instance Anno RecFieldsDotDot = EpaLocation +type instance Anno RecFieldsDotDot = SrcSpanAnnA ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2210,15 +2210,15 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where instance ToHie (ForeignImport GhcRn) where toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $ - [ locOnlyE a - , locOnlyE b - , locOnlyE c + [ locOnlyE (entry a) + , locOnlyE (entry b) + , locOnlyE (entry c) ] instance ToHie (ForeignExport GhcRn) where toHie (CExport (L b _) (L a _)) = concatM $ - [ locOnlyE a - , locOnlyE b + [ locOnlyE (entry a) + , locOnlyE (entry b) ] instance ToHie (LocatedA (WarnDecls GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -2084,7 +2084,7 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) } $2 (snd $ unLoc $3))} | {- empty -} { Nothing } -warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) } +warning_category :: { Maybe (LocatedA (InWarningCategory GhcPs)) } : 'in' STRING { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1, getSTRINGs $2) (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) } | {- empty -} { Nothing } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -3214,7 +3214,7 @@ mkImport cconv safety (L loc sLit, v, ty) (timport, td) = -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick -- that one. -parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String +parseCImport :: LocatedA CCallConv -> LocatedA Safety -> FastString -> String -> Located SourceText -> Maybe (ForeignImport GhcPs) parseCImport cconv safety nm str sourceText = ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -859,7 +859,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) , hfbRHS = arg' , hfbPun = pun } } - rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat + rn_dotdot :: Maybe (LocatedA RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat -> Maybe (WithUserRdr Name) -- The constructor (Nothing for an out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -166,8 +166,8 @@ type instance XInWarningCategory (GhcPass _) = (EpToken "in", SourceText) type instance XXInWarningCategory (GhcPass _) = DataConCantHappen type instance Anno (WithHsDocIdentifiers (StringLiteral pass) pass) = SrcSpanAnnA -type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation -type instance Anno (WarningCategory) = EpaLocation +type instance Anno (InWarningCategory (GhcPass pass)) = SrcSpanAnnA +type instance Anno (WarningCategory) = SrcSpanAnnA type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnA deriving stock instance Eq (WarningTxt GhcPs) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -726,6 +726,11 @@ printStringAtMLocL an l s = do printStringAdvanceA :: (Monad m, Monoid w) => String -> EP w m () printStringAdvanceA str = printStringAtAA (EpaDelta noSrcSpan (SameLine 0) []) str >> return () +printStringAtA :: (Monad m, Monoid w) => EpAnn a -> String -> EP w m (EpAnn a) +printStringAtA ann s = do + l' <- printStringAtAA (entry ann) s + return ann { entry = l' } + printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation printStringAtAA el str = printStringAtAAC CaptureComments el str @@ -750,9 +755,13 @@ printStringAtAAC capture (EpaDelta ss d cs) s = do -- --------------------------------------------------------------------- -markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation -markExternalSourceTextE l NoSourceText txt = printStringAtAA l txt -markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt) +markExternalSourceTextA :: (Monad m, Monoid w) => EpAnn a -> SourceText -> String -> EP w m (EpAnn a) +markExternalSourceTextA ann src txt = do + l' <- mark_source_text ann src txt + return (ann { entry = l'}) + where + mark_source_text l NoSourceText txt' = printStringAtAA (entry l) txt' + mark_source_text l (SourceText txt') _ = printStringAtAA (entry l) (unpackFS txt') -- --------------------------------------------------------------------- @@ -1868,11 +1877,11 @@ instance ExactPrint (ForeignImport GhcPs) where setAnnotationAnchor a _ _ _ = a exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do cconv' <- markAnnotated cconv - safety' <- if notDodgyE l + safety' <- if notDodgyE (entry l) then markAnnotated safety else return safety - ls' <- if notDodgyE ls - then markExternalSourceTextE ls src "" + ls' <- if notDodgyE (entry ls) + then markExternalSourceTextA ls src "" else return ls return (CImport (L ls' src) cconv' safety' mh imp) @@ -1884,8 +1893,8 @@ instance ExactPrint (ForeignExport GhcPs) where exact (CExport (L ls src) spec) = do debugM $ "CExport starting" spec' <- markAnnotated spec - ls' <- if notDodgyE ls - then markExternalSourceTextE ls src "" + ls' <- if notDodgyE (entry ls) + then markExternalSourceTextA ls src "" else return ls return (CExport (L ls' src) spec') @@ -3215,7 +3224,7 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where mdot' <- case mdot of Nothing -> return Nothing Just (L ss d) -> do - ss' <- printStringAtAA ss ".." + ss' <- printStringAtA ss ".." return $ Just (L ss' d) -- Note: mdot contains the SrcSpan where the ".." appears, if present cc' <- markEpToken cc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cbcb2b2c83f34d4e55224b829ce4d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cbcb2b2c83f34d4e55224b829ce4d... You're receiving this email because of your account on gitlab.haskell.org.