[Git][ghc/ghc][wip/unbound-name-qualified] warnings: Find out if a qualified name is in the interactive scope directly
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Dec 20 15:52:10 UTC 2024
Matthew Pickering pushed to branch wip/unbound-name-qualified at Glasgow Haskell Compiler / GHC
Commits:
cc4b6a8b by Matthew Pickering at 2024-12-20T15:51:49+00:00
warnings: Find out if a qualified name is in the interactive scope directly
There were two ad-hoc mechanisms used to determine which modules were in
the interactive scope.
1. Look at everything in the GRE, to see what is imported qualified.
2. Look at the last loaded module in the HPT.
(1) Is very inefficient, GlobalRdrEnvs can be very big.
(2) is incorrect, there is no reason to assume the "last" thing added to
the HPT has any relevance to module loading order.
Happily, the same checks can be implemented directly by looking at the
interactive imports from the interactive context. This mirrors what
happens for normal imports.
Arguably, the error reporting code shouldn't be doing this kind of
processing and it should be an option is set when rendering the error
message. However, this just improves the situation and doesn't block
progress on that front in future.
See #14225 and #15611
Fixes #25600
- - - - -
1 changed file:
- compiler/GHC/Rename/Unbound.hs
Changes:
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -34,10 +34,11 @@ import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Ppr
+import GHC.Driver.Env.Types
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
-import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
+import GHC.Builtin.Names ( mkUnboundName, isUnboundName )
import GHC.Utils.Misc
import GHC.Utils.Panic (panic)
@@ -53,16 +54,16 @@ import GHC.Types.Hint
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Reader
-import GHC.Types.Unique.DFM (udfmToList)
import GHC.Unit.Module
import GHC.Unit.Module.Imported
-import GHC.Unit.Home.ModInfo
+import GHC.Utils.Outputable
+import GHC.Runtime.Context
import GHC.Data.Bag
-import GHC.Utils.Outputable (empty)
+import Language.Haskell.Syntax.ImpExp
-import Data.List (sortBy, partition, nub)
+import Data.List (sortBy, partition)
import Data.List.NonEmpty ( pattern (:|), NonEmpty )
import Data.Function ( on )
import qualified Data.Semigroup as S
@@ -146,10 +147,10 @@ unboundNameOrTermInType if_term_in_type looking_for rdr_name hints
; global_env <- getGlobalRdrEnv
; impInfo <- getImports
; currmod <- getModule
- ; hpt <- getHpt
+ ; ic <- hsc_IC <$> getTopEnv
; let (imp_errs, suggs) =
unknownNameSuggestions_ looking_for
- dflags hpt currmod global_env local_env impInfo
+ dflags ic currmod global_env local_env impInfo
rdr_name
; addErr $
make_error imp_errs (hints ++ suggs) }
@@ -179,17 +180,17 @@ notInScopeErr where_look rdr_name
unknownNameSuggestions :: LocalRdrEnv -> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint])
unknownNameSuggestions lcl_env what_look tried_rdr_name =
do { dflags <- getDynFlags
- ; hpt <- getHpt
; rdr_env <- getGlobalRdrEnv
; imp_info <- getImports
; curr_mod <- getModule
+ ; interactive_context <- hsc_IC <$> getTopEnv
; return $
unknownNameSuggestions_
(LF what_look WL_Anywhere)
- dflags hpt curr_mod rdr_env lcl_env imp_info tried_rdr_name }
+ dflags interactive_context curr_mod rdr_env lcl_env imp_info tried_rdr_name }
-unknownNameSuggestions_ :: LookingFor -> DynFlags
- -> HomePackageTable -> Module
+unknownNameSuggestions_ :: LookingFor -> DynFlags -> InteractiveContext
+ -> Module
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
-> RdrName -> ([ImportError], [GhcHint])
unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env
@@ -201,7 +202,7 @@ unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env
, map (ImportSuggestion $ rdrNameOcc tried_rdr_name) imp_suggs
, extensionSuggestions tried_rdr_name
, fieldSelectorSuggestions global_env tried_rdr_name ]
- (imp_errs, imp_suggs) = importSuggestions looking_for global_env hpt curr_mod imports tried_rdr_name
+ (imp_errs, imp_suggs) = importSuggestions looking_for hpt curr_mod imports tried_rdr_name
if_ne :: (NonEmpty a -> b) -> [a] -> [b]
if_ne _ [] = []
@@ -308,15 +309,13 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
-- | Generate errors and helpful suggestions if a qualified name Mod.foo is not in scope.
importSuggestions :: LookingFor
- -> GlobalRdrEnv
- -> HomePackageTable -> Module
+ -> InteractiveContext -> Module
-> ImportAvails -> RdrName -> ([ImportError], [ImportSuggestion])
-importSuggestions looking_for global_env hpt currMod imports rdr_name
+importSuggestions looking_for ic currMod imports rdr_name
| WL_LocalOnly <- lf_where looking_for = ([], [])
| WL_LocalTop <- lf_where looking_for = ([], [])
| not (isQual rdr_name || isUnqual rdr_name) = ([], [])
- | null interesting_imports
- , Just name <- mod_name
+ | Just name <- mod_name
, show_not_imported_line name
= ([MissingModule name], [])
| is_qualified
@@ -344,6 +343,17 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
, Just imp <- return $ pick (importedByUser mod_imports)
]
+ -- Choose the imports from the interactive context which might have provided
+ -- a module.
+ interactive_imports =
+ filter pick_interactive (ic_imports ic)
+
+ pick_interactive :: InteractiveImport -> Bool
+ pick_interactive (IIDecl d) | mod_name == Just (unLoc (ideclName d)) = True
+ | mod_name == fmap unLoc (ideclAs d) = True
+ pick_interactive (IIModule m) | mod_name == Just m = True
+ pick_interactive _ = False
+
-- We want to keep only one for each original module; preferably one with an
-- explicit import list (for no particularly good reason)
pick :: [ImportedModsVal] -> Maybe ImportedModsVal
@@ -369,17 +379,10 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
-- See Note [When to show/hide the module-not-imported line]
show_not_imported_line :: ModuleName -> Bool -- #15611
show_not_imported_line modnam
- | modnam `elem` glob_mods = False -- #14225 -- 1
- | moduleName currMod == modnam = False -- 2.1
- | is_last_loaded_mod modnam hpt_uniques = False -- 2.2
+ | not (null interactive_imports) = False -- 1 (interactive context)
+ | not (null interesting_imports) = False -- 1 (normal module import)
+ | moduleName currMod == modnam = False -- 2
| otherwise = True
- where
- hpt_uniques = map fst (udfmToList hpt)
- is_last_loaded_mod modnam uniqs = lastMaybe uniqs == Just (getUnique modnam)
- glob_mods = nub [ mod
- | gre <- globalRdrEnvElts global_env
- , (mod, _) <- qualsInScope gre
- ]
extensionSuggestions :: RdrName -> [GhcHint]
extensionSuggestions rdrName
@@ -478,13 +481,8 @@ For the error message:
Module X does not export Y
No module named ‘X’ is imported:
there are 2 cases, where we hide the last "no module is imported" line:
-1. If the module X has been imported.
-2. If the module X is the current module. There are 2 subcases:
- 2.1 If the unknown module name is in a input source file,
- then we can use the getModule function to get the current module name.
- (See test T15611a)
- 2.2 If the unknown module name has been entered by the user in GHCi,
- then the getModule function returns something like "interactive:Ghci1",
- and we have to check the current module in the last added entry of
- the HomePackageTable. (See test T15611b)
+1. If the module X has been imported (normally or via interactive context).
+2. It is the current module we are trying to compile
+ then we can use the getModule function to get the current module name.
+ (See test T15611a)
-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc4b6a8b8228460a82391867caf9c2958dbc4ce6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc4b6a8b8228460a82391867caf9c2958dbc4ce6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241220/b218471f/attachment-0001.html>
More information about the ghc-commits
mailing list