Brandon Chinn pushed to branch wip/T21730-import at Glasgow Haskell Compiler / GHC
Commits:
-
4ac945d9
by Brandon Chinn at 2025-08-15T20:25:18-07:00
-
17b879b3
by Brandon Chinn at 2025-08-15T20:52:09-07:00
8 changed files:
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Types/Name/Reader.hs
- ghc/GHCi/UI.hs
- testsuite/tests/parser/should_compile/T7476/T7476.stdout
Changes:
... | ... | @@ -878,14 +878,14 @@ hsModuleToModSummary home_keys pn hsc_src modname |
878 | 878 | let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps
|
879 | 879 | |
880 | 880 | implicit_prelude = xopt LangExt.ImplicitPrelude dflags
|
881 | - implicit_imports = mkPrelImports modname implicit_prelude imps
|
|
881 | + generated_imports = mkPrelImports modname implicit_prelude imps
|
|
882 | 882 | |
883 | 883 | rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) modname
|
884 | 884 | convImport (L _ i) = (convImportLevel (ideclLevelSpec i), rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i)
|
885 | 885 | |
886 | 886 | extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
|
887 | 887 | |
888 | - let normal_imports = map convImport (implicit_imports ++ ord_idecls)
|
|
888 | + let normal_imports = map convImport (generated_imports ++ ord_idecls)
|
|
889 | 889 | (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env normal_imports
|
890 | 890 | |
891 | 891 | -- So that Finder can find it, even though it doesn't exist...
|
... | ... | @@ -80,16 +80,18 @@ type instance XCImportDecl GhcTc = DataConCantHappen |
80 | 80 | data XImportDeclPass = XImportDeclPass
|
81 | 81 | { ideclAnn :: EpAnn EpAnnImportDecl
|
82 | 82 | , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
|
83 | - , ideclImplicit :: Bool -- ^ See Note [Implicit imports]
|
|
83 | + , ideclGenerated :: Bool -- ^ See Note [Generated imports]
|
|
84 | 84 | }
|
85 | 85 | deriving (Data)
|
86 | 86 | |
87 | -{- Note [Implicit imports]
|
|
88 | -~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
87 | +{- Note [Generated imports]
|
|
88 | +~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
89 | 89 | GHC generates an `ImportDecl` to represent the invisible `import Prelude`
|
90 | 90 | that appears in any file that omits `import Prelude`, setting
|
91 | 91 | this field to indicate that the import doesn't appear in the
|
92 | -original source. True => implicit import (of Prelude)
|
|
92 | +original source.
|
|
93 | + |
|
94 | +Plugins may also introduce generated imports.
|
|
93 | 95 | -}
|
94 | 96 | |
95 | 97 | type instance XXImportDecl (GhcPass _) = DataConCantHappen
|
... | ... | @@ -165,8 +167,8 @@ instance (OutputableBndrId p |
165 | 167 | where
|
166 | 168 | pp_implicit ext =
|
167 | 169 | let implicit = case ghcPass @p of
|
168 | - GhcPs | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit
|
|
169 | - GhcRn | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit
|
|
170 | + GhcPs | XImportDeclPass { ideclGenerated = implicit } <- ext -> implicit
|
|
171 | + GhcRn | XImportDeclPass { ideclGenerated = implicit } <- ext -> implicit
|
|
170 | 172 | GhcTc -> dataConCantHappen ext
|
171 | 173 | in if implicit then text "(implicit)"
|
172 | 174 | else empty
|
... | ... | @@ -348,7 +348,7 @@ enrichHie ts (hsGrp, imports, exports, docs, modName) ev_bs insts tcs tte = |
348 | 348 | modName <- toHie (IEC Export <$> modName)
|
349 | 349 | tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
|
350 | 350 | rasts <- processGrp hsGrp
|
351 | - imps <- toHie $ filter (not . ideclImplicit . ideclExt . unLoc) imports
|
|
351 | + imps <- toHie $ filter (not . ideclGenerated . ideclExt . unLoc) imports
|
|
352 | 352 | exps <- toHie $ fmap (map $ IEC Export . fst) exports
|
353 | 353 | docs <- toHie docs
|
354 | 354 | -- Add Instance bindings
|
... | ... | @@ -100,12 +100,12 @@ getImports popts implicit_prelude buf filename source_filename = do |
100 | 100 | mod = mb_mod `orElse` L (noAnnSrcSpan main_loc) mAIN_NAME
|
101 | 101 | (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps
|
102 | 102 | |
103 | - implicit_imports = mkPrelImports (unLoc mod) implicit_prelude imps
|
|
103 | + generated_imports = mkPrelImports (unLoc mod) implicit_prelude imps
|
|
104 | 104 | convImport (L _ (i :: ImportDecl GhcPs)) = (convImportLevel (ideclLevelSpec i), ideclPkgQual i, reLoc $ ideclName i)
|
105 | 105 | convImport_src (L _ (i :: ImportDecl GhcPs)) = (reLoc $ ideclName i)
|
106 | 106 | in
|
107 | 107 | return (map convImport_src src_idecls
|
108 | - , map convImport (implicit_imports ++ ord_idecls)
|
|
108 | + , map convImport (generated_imports ++ ord_idecls)
|
|
109 | 109 | , reLoc mod)
|
110 | 110 | |
111 | 111 | |
... | ... | @@ -146,7 +146,7 @@ mkPrelImports this_mod implicit_prelude import_decls |
146 | 146 | = L loc $ ImportDecl { ideclExt = XImportDeclPass
|
147 | 147 | { ideclAnn = noAnn
|
148 | 148 | , ideclSourceText = NoSourceText
|
149 | - , ideclImplicit = True -- Implicit!
|
|
149 | + , ideclGenerated = True -- Generated!
|
|
150 | 150 | },
|
151 | 151 | ideclName = L loc pRELUDE_NAME,
|
152 | 152 | ideclPkgQual = NoRawPkgQual,
|
... | ... | @@ -317,7 +317,7 @@ rnImportDecl this_mod |
317 | 317 | , ideclSafe = mod_safe
|
318 | 318 | , ideclLevelSpec = import_level
|
319 | 319 | , ideclQualified = qual_style
|
320 | - , ideclExt = XImportDeclPass { ideclImplicit = implicit }
|
|
320 | + , ideclExt = XImportDeclPass { ideclGenerated = implicit }
|
|
321 | 321 | , ideclAs = as_mod, ideclImportList = imp_details }), import_reason)
|
322 | 322 | = setSrcSpanA loc $ do
|
323 | 323 | |
... | ... | @@ -1922,25 +1922,27 @@ type ImportDeclUsage |
1922 | 1922 | warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
|
1923 | 1923 | warnUnusedImportDecls gbl_env hsc_src
|
1924 | 1924 | = do { uses <- readMutVar (tcg_used_gres gbl_env)
|
1925 | - ; let user_imports = filterOut
|
|
1926 | - (ideclImplicit . ideclExt . unLoc)
|
|
1927 | - (tcg_rn_imports gbl_env)
|
|
1928 | - -- This whole function deals only with *user* imports
|
|
1929 | - -- both for warning about unnecessary ones, and for
|
|
1930 | - -- deciding the minimal ones
|
|
1925 | + ; let imports = tcg_rn_imports gbl_env
|
|
1931 | 1926 | rdr_env = tcg_rdr_env gbl_env
|
1932 | 1927 | |
1933 | - ; let usage :: [ImportDeclUsage]
|
|
1934 | - usage = findImportUsage user_imports uses
|
|
1928 | + -- We should only warn for unnecessary *user* imports, but deciding
|
|
1929 | + -- minimal imports should take generated imports into account
|
|
1930 | + ; let usageUserImports = findImportUsage (excludeGenerated imports) uses
|
|
1931 | + usageAllImports = findImportUsage imports uses
|
|
1935 | 1932 | |
1936 | 1933 | ; traceRn "warnUnusedImportDecls" $
|
1937 | 1934 | (vcat [ text "Uses:" <+> ppr uses
|
1938 | - , text "Import usage" <+> ppr usage])
|
|
1935 | + , text "Usage all user imports: " <+> ppr usageUserImports
|
|
1936 | + , text "Usage all imports: " <+> ppr usageAllImports])
|
|
1939 | 1937 | |
1940 | - ; mapM_ (warnUnusedImport rdr_env) usage
|
|
1938 | + ; mapM_ (warnUnusedImport rdr_env) usageUserImports
|
|
1941 | 1939 | |
1942 | 1940 | ; whenGOptM Opt_D_dump_minimal_imports $
|
1943 | - printMinimalImports hsc_src usage }
|
|
1941 | + printMinimalImports hsc_src usageAllImports }
|
|
1942 | + |
|
1943 | +-- | Exclude generated imports
|
|
1944 | +excludeGenerated :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
|
|
1945 | +excludeGenerated = filterOut (ideclGenerated . ideclExt . unLoc)
|
|
1944 | 1946 | |
1945 | 1947 | findImportUsage :: [LImportDecl GhcRn]
|
1946 | 1948 | -> [GlobalRdrElt]
|
... | ... | @@ -2208,8 +2210,10 @@ x,y to avoid name-shadowing warnings. Example (#9061) |
2208 | 2210 | |
2209 | 2211 | Note [Printing minimal imports]
|
2210 | 2212 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
2211 | -To print the minimal imports we walk over the user-supplied import
|
|
2212 | -decls, and simply trim their import lists. NB that
|
|
2213 | +To print the minimal imports we walk over all import decls (both user-supplied
|
|
2214 | +and generated), trim their import lists, then filter out generated decls.
|
|
2215 | + |
|
2216 | +NB that
|
|
2213 | 2217 | |
2214 | 2218 | * We do *not* change the 'qualified' or 'as' parts!
|
2215 | 2219 | |
... | ... | @@ -2301,7 +2305,7 @@ classifyGREs = partition (not . isRecFldGRE) |
2301 | 2305 | printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
|
2302 | 2306 | -- See Note [Printing minimal imports]
|
2303 | 2307 | printMinimalImports hsc_src imports_w_usage
|
2304 | - = do { imports' <- getMinimalImports imports_w_usage
|
|
2308 | + = do { imports' <- excludeGenerated <$> getMinimalImports imports_w_usage
|
|
2305 | 2309 | ; this_mod <- getModule
|
2306 | 2310 | ; dflags <- getDynFlags
|
2307 | 2311 | ; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
|
... | ... | @@ -2041,10 +2041,13 @@ bestImport iss = NE.head $ NE.sortBy best iss |
2041 | 2041 | -- Less means better
|
2042 | 2042 | -- Unqualified always wins over qualified; then
|
2043 | 2043 | -- import-all wins over import-some; then
|
2044 | + -- generated wins over user-specified; then
|
|
2044 | 2045 | -- earlier declaration wins over later
|
2045 | 2046 | best (ImpSpec { is_item = item1, is_decl = d1 })
|
2046 | 2047 | (ImpSpec { is_item = item2, is_decl = d2 })
|
2047 | - = (is_qual d1 `compare` is_qual d2) S.<> best_item item1 item2 S.<>
|
|
2048 | + = (is_qual d1 `compare` is_qual d2) S.<>
|
|
2049 | + best_item item1 item2 S.<>
|
|
2050 | + compareGenerated (is_dloc d1) (is_dloc d2) S.<>
|
|
2048 | 2051 | SrcLoc.leftmost_smallest (is_dloc d1) (is_dloc d2)
|
2049 | 2052 | |
2050 | 2053 | best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
|
... | ... | @@ -2055,6 +2058,11 @@ bestImport iss = NE.head $ NE.sortBy best iss |
2055 | 2058 | (ImpSome { is_explicit = e2 }) = e1 `compare` e2
|
2056 | 2059 | -- False < True, so if e1 is explicit and e2 is not, we get GT
|
2057 | 2060 | |
2061 | + compareGenerated UnhelpfulSpan{} UnhelpfulSpan{} = EQ
|
|
2062 | + compareGenerated UnhelpfulSpan{} RealSrcSpan{} = LT
|
|
2063 | + compareGenerated RealSrcSpan{} UnhelpfulSpan{} = GT
|
|
2064 | + compareGenerated RealSrcSpan{} RealSrcSpan{} = EQ
|
|
2065 | + |
|
2058 | 2066 | {- Note [Choosing the best import declaration]
|
2059 | 2067 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
2060 | 2068 | When reporting unused import declarations we use the following rules.
|
... | ... | @@ -527,7 +527,7 @@ interactiveUI config srcs maybe_exprs = do |
527 | 527 | let prelude_import =
|
528 | 528 | case simpleImportDecl preludeModuleName of
|
529 | 529 | -- Set to True because Prelude is implicitly imported.
|
530 | - impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
|
|
530 | + impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclGenerated=True}}
|
|
531 | 531 | empty_cache <- liftIO newIfaceCache
|
532 | 532 | startGHCi (runGHCi srcs maybe_exprs)
|
533 | 533 | GHCiState{ progname = default_progname,
|
1 | -import Control.Applicative ( Applicative(pure), (<**>) ) |
|
1 | +import Control.Applicative ( (<**>) ) |