Commit b8d263dc authored by Joachim Breitner's avatar Joachim Breitner
Browse files

Turn ImportedModsVal into a data type

it was a 4-tuple before my patch, and a 6-tuple afterwards. Clearly a
record type is in order here!
parent e66f79df
...@@ -1031,9 +1031,9 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names ...@@ -1031,9 +1031,9 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
(is_direct_import, imp_safe) (is_direct_import, imp_safe)
= case lookupModuleEnv direct_imports mod of = case lookupModuleEnv direct_imports mod of
Just ((_,_,_,safe,_,_):_xs) -> (True, safe) Just (imv : _xs) -> (True, imv_is_safe imv)
Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty
Nothing -> (False, safeImplicitImpsReq dflags) Nothing -> (False, safeImplicitImpsReq dflags)
-- Nothing case is for implicit imports like 'System.IO' when 'putStrLn' -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-- is used in the source code. We require them to be safe in Safe Haskell -- is used in the source code. We require them to be safe in Safe Haskell
......
...@@ -978,15 +978,15 @@ checkSafeImports dflags tcg_env ...@@ -978,15 +978,15 @@ checkSafeImports dflags tcg_env
condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport) condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
condense (_, []) = panic "HscMain.condense: Pattern match failure!" condense (_, []) = panic "HscMain.condense: Pattern match failure!"
condense (m, x:xs) = do (_,_,l,s,_,_) <- foldlM cond' x xs condense (m, x:xs) = do imv <- foldlM cond' x xs
return (m, l, s) return (m, imv_span imv, imv_is_safe imv)
-- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport) -- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
cond' v1@(m1,_,l1,s1,_,_) (_,_,_,s2,_,_) cond' v1 v2
| s1 /= s2 | imv_is_safe v1 /= imv_is_safe v2
= throwErrors $ unitBag $ mkPlainErrMsg dflags l1 = throwErrors $ unitBag $ mkPlainErrMsg dflags (imv_span v1)
(text "Module" <+> ppr m1 <+> (text "Module" <+> ppr (imv_name v1) <+>
(text $ "is imported both as a safe and unsafe import!")) (text $ "is imported both as a safe and unsafe import!"))
| otherwise | otherwise
= return v1 = return v1
......
...@@ -21,7 +21,7 @@ module HscTypes ( ...@@ -21,7 +21,7 @@ module HscTypes (
-- * Information about modules -- * Information about modules
ModDetails(..), emptyModDetails, ModDetails(..), emptyModDetails,
ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC, ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods, ImportedModsVal, ImportedMods, ImportedModsVal(..),
ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary, ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath, msHsFilePath, msHiFilePath, msObjFilePath,
...@@ -1027,9 +1027,18 @@ emptyModDetails ...@@ -1027,9 +1027,18 @@ emptyModDetails
md_anns = [], md_anns = [],
md_vect_info = noVectInfo } md_vect_info = noVectInfo }
-- | Records the modules directly imported by a module for extracting e.g. usage information -- | Records the modules directly imported by a module for extracting e.g.
-- usage information, and also to give better error message
type ImportedMods = ModuleEnv [ImportedModsVal] type ImportedMods = ModuleEnv [ImportedModsVal]
type ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport, Bool, GlobalRdrEnv) data ImportedModsVal
= ImportedModsVal {
imv_name :: ModuleName, -- ^ The name the module is imported with
imv_empty :: Bool, -- ^ whether it is an "import Foo ()" import
imv_span :: SrcSpan, -- ^ the source span of the whole import
imv_is_safe :: IsSafeImport, -- ^ whether this is a safe import
imv_is_hiding :: Bool, -- ^ whether this is an "hiding" import
imv_all_exports :: GlobalRdrEnv -- ^ all the things the module could provide
}
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- | A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module -- There is only one ModGuts at any time, the one for the module
......
...@@ -1682,14 +1682,14 @@ importSuggestions _dflags imports rdr_name ...@@ -1682,14 +1682,14 @@ importSuggestions _dflags imports rdr_name
, ptext (sLit "exports") , ptext (sLit "exports")
, quotes (ppr occ_name) <> dot , quotes (ppr occ_name) <> dot
] ]
| [(mod,(_,_,loc,_,_,_))] <- helpful_imports_non_hiding | [(mod,imv)] <- helpful_imports_non_hiding
= fsep = fsep
[ ptext (sLit "Perhaps you want to add") [ ptext (sLit "Perhaps you want to add")
, quotes (ppr occ_name) , quotes (ppr occ_name)
, ptext (sLit "to the import list") , ptext (sLit "to the import list")
, ptext (sLit "in the import of") , ptext (sLit "in the import of")
, quotes (ppr mod) , quotes (ppr mod)
, parens (ppr loc) <> dot , parens (ppr (imv_span imv)) <> dot
] ]
| not (null helpful_imports_non_hiding) | not (null helpful_imports_non_hiding)
= fsep = fsep
...@@ -1699,17 +1699,17 @@ importSuggestions _dflags imports rdr_name ...@@ -1699,17 +1699,17 @@ importSuggestions _dflags imports rdr_name
] ]
$$ $$
nest 2 (vcat nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr loc) [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,(_,_,loc,_,_,_)) <- helpful_imports_non_hiding | (mod,imv) <- helpful_imports_non_hiding
]) ])
| [(mod,(_,_,loc,_,_,_))] <- helpful_imports_hiding | [(mod,imv)] <- helpful_imports_hiding
= fsep = fsep
[ ptext (sLit "Perhaps you want to remove") [ ptext (sLit "Perhaps you want to remove")
, quotes (ppr occ_name) , quotes (ppr occ_name)
, ptext (sLit "from the explicit hiding list") , ptext (sLit "from the explicit hiding list")
, ptext (sLit "in the import of") , ptext (sLit "in the import of")
, quotes (ppr mod) , quotes (ppr mod)
, parens (ppr loc) <> dot , parens (ppr (imv_span imv)) <> dot
] ]
| not (null helpful_imports_hiding) | not (null helpful_imports_hiding)
= fsep = fsep
...@@ -1720,8 +1720,8 @@ importSuggestions _dflags imports rdr_name ...@@ -1720,8 +1720,8 @@ importSuggestions _dflags imports rdr_name
] ]
$$ $$
nest 2 (vcat nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr loc) [ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,(_,_,loc,_,_,_)) <- helpful_imports_hiding | (mod,imv) <- helpful_imports_hiding
]) ])
| otherwise | otherwise
= Outputable.empty = Outputable.empty
...@@ -1738,26 +1738,20 @@ importSuggestions _dflags imports rdr_name ...@@ -1738,26 +1738,20 @@ importSuggestions _dflags imports rdr_name
-- explicit import list (for no particularly good reason) -- explicit import list (for no particularly good reason)
pick :: [ImportedModsVal] -> Maybe ImportedModsVal pick :: [ImportedModsVal] -> Maybe ImportedModsVal
pick = listToMaybe . sortBy (compare `on` prefer) . filter select pick = listToMaybe . sortBy (compare `on` prefer) . filter select
where select (name, _,_,_,_,_) = name == mod_name where select imv = imv_name imv == mod_name
prefer (_, _, loc, _, hiding, _) = (hiding, loc) prefer imv = (imv_is_hiding imv, imv_span imv)
-- Which of these would export a 'foo' -- Which of these would export a 'foo'
-- (all of these are restricted imports, because if they were not, we -- (all of these are restricted imports, because if they were not, we
-- wouldn't have an out-of-scope error in the first place) -- wouldn't have an out-of-scope error in the first place)
helpful_imports = [ (mod, imp) helpful_imports = filter helpful interesting_imports
| (mod, imp@(_, _, _, _, _, all_exports)) <- interesting_imports where helpful (_,imv)
, not . null $ lookupGlobalRdrEnv all_exports occ_name = not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name
]
-- Which of these do that because of an explicit hiding list resp. an
-- Which of these do that because of an explicit import list -- explicit import list
helpful_imports_non_hiding = [ (mod, imp) (helpful_imports_hiding, helpful_imports_non_hiding)
| (mod, imp@(_, _ , _, _, False, _)) <- helpful_imports = partition (imv_is_hiding . snd) helpful_imports
]
-- Which of these do that because of an explicit hiding list
helpful_imports_hiding = [ (mod, imp)
| (mod, imp@(_, _ , _, _, True, _)) <- helpful_imports
]
-- | Called from the typechecker (TcErrors) when we find an unbound variable -- | Called from the typechecker (TcErrors) when we find an unbound variable
unknownNameSuggestions :: DynFlags unknownNameSuggestions :: DynFlags
......
...@@ -280,10 +280,17 @@ rnImportDecl this_mod ...@@ -280,10 +280,17 @@ rnImportDecl this_mod
|| (not implicit && safeDirectImpsReq dflags) || (not implicit && safeDirectImpsReq dflags)
|| (implicit && safeImplicitImpsReq dflags) || (implicit && safeImplicitImpsReq dflags)
let imv = ImportedModsVal
{ imv_name = qual_mod_name
, imv_empty = import_all
, imv_span = loc
, imv_is_safe = mod_safe'
, imv_is_hiding = is_hiding
, imv_all_exports = potential_gres
}
let imports let imports
= (calculateAvails dflags iface mod_safe' want_boot) { = (calculateAvails dflags iface mod_safe' want_boot)
imp_mods = unitModuleEnv (mi_module iface) { imp_mods = unitModuleEnv (mi_module iface) [imv] }
[(qual_mod_name, import_all, loc, mod_safe', is_hiding, potential_gres)] }
-- Complain if we import a deprecated module -- Complain if we import a deprecated module
whenWOptM Opt_WarnWarningsDeprecations ( whenWOptM Opt_WarnWarningsDeprecations (
...@@ -1218,10 +1225,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ...@@ -1218,10 +1225,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
pat_syns :: [GlobalRdrElt] pat_syns :: [GlobalRdrElt]
pat_syns = findPatSyns (globalRdrEnvElts rdr_env) pat_syns = findPatSyns (globalRdrEnvElts rdr_env)
imported_modules = [ imv_name imv
imported_modules = [ qual_name | xs <- moduleEnvElts $ imp_mods imports, imv <- xs ]
| xs <- moduleEnvElts $ imp_mods imports,
(qual_name, _, _, _, _, _) <- xs ]
exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
exports_from_item acc@(ie_names, occs, exports) exports_from_item acc@(ie_names, occs, exports)
......
...@@ -966,9 +966,10 @@ type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc)) ...@@ -966,9 +966,10 @@ type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
data ImportAvails data ImportAvails
= ImportAvails { = ImportAvails {
imp_mods :: ImportedMods, imp_mods :: ImportedMods,
-- = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)], -- = ModuleEnv [ImportedModsVal],
-- ^ Domain is all directly-imported modules -- ^ Domain is all directly-imported modules
-- The 'ModuleName' is what the module was imported as, e.g. in --
-- 'imv_name' is what the module was imported as, e.g. in
-- @ -- @
-- import Foo as Bar -- import Foo as Bar
-- @ -- @
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment