Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: a8a869da by Alan Zimmerman at 2026-05-28T23:41:26+01:00 EPA: remove LocatedLI / SrcSpanAnnLI WIP. Compiles, next step is exact printing update. - - - - - 8 changed files: - compiler/GHC/Hs.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs Changes: ===================================== compiler/GHC/Hs.hs ===================================== @@ -82,17 +82,18 @@ deriving instance Data (HsModule GhcPs) data AnnsModule = AnnsModule { - am_sig :: EpToken "signature", - am_mod :: EpToken "module", - am_where :: EpToken "where", - am_decls :: [TrailingAnn], -- ^ Semis before the start of top decls - am_cs :: [LEpaComment], -- ^ Comments before start of top decl, + am_sig :: EpToken "signature", + am_mod :: EpToken "module", + am_where :: EpToken "where", + am_exports :: Maybe (EpToken "(", EpToken ")", [EpToken ","]), + am_decls :: [TrailingAnn], -- ^ Semis before the start of top decls + am_cs :: [LEpaComment], -- ^ Comments before start of top decl, -- used in exact printing only am_eof :: Maybe (RealSrcSpan, RealSrcSpan) -- ^ End of file and end of prior token } deriving (Data, Eq) instance NoAnn AnnsModule where - noAnn = AnnsModule NoEpTok NoEpTok NoEpTok [] [] Nothing + noAnn = AnnsModule NoEpTok NoEpTok NoEpTok Nothing [] [] Nothing instance Outputable (HsModule GhcPs) where ppr (HsModule { hsmodExt = XModulePs { hsmodHaddockModHeader = mbDoc } ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -74,7 +74,7 @@ type instance XCImportDecl GhcRn = XImportDeclPass type instance XCImportDecl GhcTc = DataConCantHappen data XImportDeclPass = XImportDeclPass - { ideclAnn :: EpAnn EpAnnImportDecl + { ideclAnn :: EpAnnImportDecl , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText" , ideclGenerated :: Bool -- ^ See Note [Generated imports] } @@ -93,7 +93,8 @@ Plugins may also introduce generated imports. type instance XXImportDecl (GhcPass _) = DataConCantHappen type instance Anno ModuleName = SrcSpanAnnA -type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnLI +-- type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnLI +type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnA deriving instance Data (IEWrappedName GhcPs) deriving instance Data (IEWrappedName GhcRn) @@ -115,6 +116,8 @@ deriving instance Eq (NamespaceSpecifier GhcTc) -- API Annotations types +type AnnListImportDecl = AnnList (EpToken "hiding", [EpToken ","]) + data EpAnnImportDecl = EpAnnImportDecl { importDeclAnnImport :: EpToken "import" -- ^ The location of the @import@ keyword , importDeclAnnPragma :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively @@ -123,11 +126,12 @@ data EpAnnImportDecl = EpAnnImportDecl , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword , importDeclAnnPackage :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@) , importDeclAnnAs :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword + , importDeclImportList :: Maybe AnnListImportDecl } deriving (Data) instance NoAnn EpAnnImportDecl where - noAnn = EpAnnImportDecl noAnn Nothing Nothing noAnn Nothing Nothing Nothing + noAnn = EpAnnImportDecl noAnn Nothing Nothing noAnn Nothing Nothing Nothing Nothing data EpAnnLevel = EpAnnLevelSplice (EpToken "splice") | EpAnnLevelQuote (EpToken "quote") ===================================== compiler/GHC/Parser.y ===================================== @@ -879,12 +879,12 @@ unitdecl :: { LHsUnitDecl PackageName } NotBoot -> HsSrcFile IsBoot -> HsBootFile) (reLoc $3) - (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7))) } + (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) (snd $5) (fst $ sndOf3 $7) (snd $ sndOf3 $7))) } | 'signature' modid maybe_warning_pragma maybeexports 'where' body { sL1 $1 $ DeclD HsigFile (reLoc $2) - (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6))) } + (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) (snd $4) (fst $ sndOf3 $6) (snd $ sndOf3 $6))) } | 'dependency' unitid mayberns { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2 , idModRenaming = $3 @@ -908,9 +908,9 @@ signature :: { Located (HsModule GhcPs) } : 'signature' modid maybe_warning_pragma maybeexports 'where' body {% fileSrcSpan >>= \ loc -> acs loc (\loc cs-> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fstOf3 $6) [] Nothing) cs) + (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fst $4) (fstOf3 $6) [] Nothing) cs) (thdOf3 $6) $3 Nothing) - (Just $2) $4 (fst $ sndOf3 $6) + (Just $2) (snd $4) (fst $ sndOf3 $6) (snd $ sndOf3 $6))) ) } @@ -918,15 +918,15 @@ module :: { Located (HsModule GhcPs) } : 'module' modid maybe_warning_pragma maybeexports 'where' body {% fileSrcSpan >>= \ loc -> acsFinal (\cs eof -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fstOf3 $6) [] eof) cs) + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fst $4) (fstOf3 $6) [] eof) cs) (thdOf3 $6) $3 Nothing) - (Just $2) $4 (fst $ sndOf3 $6) + (Just $2) (snd $4) (fst $ sndOf3 $6) (snd $ sndOf3 $6)) )) } | body2 {% fileSrcSpan >>= \ loc -> acsFinal (\cs eof -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 $1) [] eof) cs) + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok Nothing (fstOf3 $1) [] eof) cs) (thdOf3 $1) Nothing Nothing) Nothing Nothing (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) } @@ -966,16 +966,16 @@ header :: { Located (HsModule GhcPs) } : 'module' modid maybe_warning_pragma maybeexports 'where' header_body {% fileSrcSpan >>= \ loc -> acs loc (\loc cs -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs) + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fst $4) [] [] Nothing) cs) EpNoLayout $3 Nothing) - (Just $2) $4 $6 [] + (Just $2) (snd $4) $6 [] ))) } | 'signature' modid maybe_warning_pragma maybeexports 'where' header_body {% fileSrcSpan >>= \ loc -> acs loc (\loc cs -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs) + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fst $4) [] [] Nothing) cs) EpNoLayout $3 Nothing) - (Just $2) $4 $6 [] + (Just $2) (snd $4) $6 [] ))) } | header_body2 {% fileSrcSpan >>= \ loc -> @@ -999,10 +999,10 @@ header_top_importdecls :: { [LImportDecl GhcPs] } ----------------------------------------------------------------------------- -- The Export List -maybeexports :: { (Maybe (LocatedLI [LIE GhcPs])) } - : '(' exportlist ')' {% fmap Just $ amsr (sLL $1 $> (fromOL $ snd $2)) - (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) []) } - | {- empty -} { Nothing } +maybeexports :: { (Maybe (EpToken "(", EpToken ")", [EpToken ","]), Maybe (LocatedA [LIE GhcPs])) } + : '(' exportlist ')' { (Just ((epTok $1),(epTok $3) ,fst $2) + , Just (sLLa $1 $> (fromOL $ snd $2))) } + | {- empty -} { (Nothing, Nothing) } exportlist :: { ([EpToken ","], OrdList (LIE GhcPs)) } : exportlist1 { ([], $1) } @@ -1149,17 +1149,18 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnQualified = fst $ qualSpec , importDeclAnnPackage = fst $6 , importDeclAnnAs = fst $10 + , importDeclImportList = fst $ unLoc $11 } ; let loc = (comb6 $1 $7 $8 $9 (snd $10) $11); - ; fmap reLoc $ acs loc (\loc cs -> L loc $ - ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False + ; amsA' $ L loc $ + ImportDecl { ideclExt = XImportDeclPass anns (snd $ fst $2) False , ideclName = $7, ideclPkgQual = snd $6 , ideclSource = snd $2 , ideclLevelSpec = snd $ levelSpec , ideclSafe = snd $4 , ideclQualified = snd $ qualSpec , ideclAs = unLoc (snd $10) - , ideclImportList = unLoc $11 }) + , ideclImportList = snd $ unLoc $11 } } } @@ -1195,17 +1196,19 @@ maybeas :: { (Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName))) } ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } -maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs])) } - : impspec { fmap Just $1 } - | {- empty -} { noLoc Nothing } - -impspec :: { Located (ImportListInterpretation, LocatedLI [LIE GhcPs]) } - : '(' importlist ')' {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $2) - (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) []) - ; return $ sLL $1 $> (Exactly, es)} } - | 'hiding' '(' importlist ')' {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $3) - (AnnList Nothing (ListParens (epTok $2) (epTok $4)) [] (epTok $1,fst $3) []) - ; return $ sLL $1 $> (EverythingBut, es)} } +maybeimpspec :: { Located (Maybe AnnListImportDecl, Maybe (ImportListInterpretation, LocatedA [LIE GhcPs])) } + : impspec { sL1 $1 (Just (fst $ unLoc $1), Just (snd $ unLoc $1)) } + | {- empty -} { noLoc (Nothing, Nothing) } + +impspec :: { Located (AnnListImportDecl, (ImportListInterpretation, LocatedA [LIE GhcPs])) } + : '(' importlist ')' {% do { es <- amsA' (sLL $1 $> $ fromOL $ snd $2) + ; return $ sLL $1 $> + (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) [], + (Exactly , es))} } + | 'hiding' '(' importlist ')' {% do { es <- amsA' (sLL $1 $> $ fromOL $ snd $3) + ; return $ sLL $1 $> + (AnnList Nothing (ListParens (epTok $2) (epTok $4)) [] (epTok $1,fst $3) [], + (EverythingBut , es))} } importlist :: { ([EpToken ","], OrdList (LIE GhcPs)) } : importlist1 { ([], $1) } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -28,9 +28,9 @@ module GHC.Parser.Annotation ( -- ** Annotations in 'GenLocated' LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP, - LocatedLC, LocatedLS, LocatedLW, LocatedLI, + LocatedLC, LocatedLS, LocatedLW, SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, - SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS, SrcSpanAnnLI, + SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS, LocatedE, -- ** Annotation data types used in 'GenLocated' @@ -433,7 +433,7 @@ type LocatedL = GenLocated SrcSpanAnnL type LocatedLC = GenLocated SrcSpanAnnLC type LocatedLS = GenLocated SrcSpanAnnLS type LocatedLW = GenLocated SrcSpanAnnLW -type LocatedLI = GenLocated SrcSpanAnnLI +-- type LocatedLI = GenLocated SrcSpanAnnLI type LocatedP = GenLocated SrcSpanAnnP type LocatedC = GenLocated SrcSpanAnnC @@ -444,7 +444,7 @@ type SrcSpanAnnL = EpAnn (AnnList ()) type SrcSpanAnnLC = EpAnn (AnnList [EpToken ","]) type SrcSpanAnnLS = EpAnn (AnnList ()) type SrcSpanAnnLW = EpAnn (AnnList (EpToken "where")) -type SrcSpanAnnLI = EpAnn (AnnList (EpToken "hiding", [EpToken ","])) +-- type SrcSpanAnnLI = EpAnn (AnnList (EpToken "hiding", [EpToken ","])) type SrcSpanAnnP = EpAnn AnnPragma type SrcSpanAnnC = EpAnn AnnContext ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -303,7 +303,7 @@ lexLHsDocString = fmap lexHsDocString -- import I (a, b, c) -- do not use here! -- -- Imports cannot have documentation comments anyway. -instance HasHaddock (LocatedLI [LocatedA (IE GhcPs)]) where +instance HasHaddock (LocatedA [LocatedA (IE GhcPs)]) where addHaddock (L l_exports exports) = extendHdkA (locA l_exports) $ do exports' <- addHaddockInterleaveItems EpNoLayout mkDocIE exports ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1188,9 +1188,9 @@ filterImports -> ModIface -> ImpDeclSpec -- ^ Import spec - -> Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs]) + -> Maybe (ImportListInterpretation, LocatedA [LIE GhcPs]) -- ^ Whether this is a "hiding" import list - -> RnM (Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]), -- Import spec w/ Names + -> RnM (Maybe (ImportListInterpretation, LocatedA [LIE GhcRn]), -- Import spec w/ Names ImpUserList, -- same, but designed for storage in interfaces GlobalRdrEnv) -- Same again, but in GRE form filterImports hsc_env iface decl_spec Nothing ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -193,7 +193,7 @@ type ExportOccMap = OccEnv (Name, IE GhcPs) -- that have the same occurrence name rnExports :: Bool -- False => no 'module M(..) where' header at all - -> Maybe (LocatedLI [LIE GhcPs]) -- Nothing => no explicit export list + -> Maybe (LocatedA [LIE GhcPs]) -- Nothing => no explicit export list -> RnM TcGblEnv -- Complains if two distinct exports have same OccName @@ -302,7 +302,7 @@ the default export. In the latter case the warning text is stored in the of a user-defined warning on default. -} -exports_from_avail :: Maybe (LocatedLI [LIE GhcPs]) +exports_from_avail :: Maybe (LocatedA [LIE GhcPs]) -- ^ 'Nothing' means no explicit export list -> GlobalRdrEnv -> ImportAvails ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -559,7 +559,7 @@ tcRnImports hsc_env import_decls -} tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all - -> Maybe (LocatedLI [LIE GhcPs]) + -> Maybe (LocatedA [LIE GhcPs]) -> [LHsDecl GhcPs] -- Declarations -> TcM TcGblEnv tcRnSrcDecls explicit_mod_hdr export_ies decls @@ -1885,7 +1885,7 @@ checkMainType tcg_env ; return lie } } } } checkMain :: Bool -- False => no 'module M(..) where' header at all - -> Maybe (LocatedLI [LIE GhcPs]) -- Export specs of Main module + -> Maybe (LocatedA [LIE GhcPs]) -- Export specs of Main module -> TcM TcGblEnv -- If we are in module Main, check that 'main' is exported, -- and generate the runMainIO binding that calls it View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a869da4677588fdb808ee85dc2318b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a869da4677588fdb808ee85dc2318b... You're receiving this email because of your account on gitlab.haskell.org.