Commit b8d263dc authored by Joachim Breitner's avatar Joachim Breitner

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
(is_direct_import, imp_safe)
= case lookupModuleEnv direct_imports mod of
Just ((_,_,_,safe,_,_):_xs) -> (True, safe)
Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty
Nothing -> (False, safeImplicitImpsReq dflags)
Just (imv : _xs) -> (True, imv_is_safe imv)
Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty
Nothing -> (False, safeImplicitImpsReq dflags)
-- 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
......
......@@ -978,15 +978,15 @@ checkSafeImports dflags tcg_env
condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
condense (_, []) = panic "HscMain.condense: Pattern match failure!"
condense (m, x:xs) = do (_,_,l,s,_,_) <- foldlM cond' x xs
return (m, l, s)
condense (m, x:xs) = do imv <- foldlM cond' x xs
return (m, imv_span imv, imv_is_safe imv)
-- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
cond' v1@(m1,_,l1,s1,_,_) (_,_,_,s2,_,_)
| s1 /= s2
= throwErrors $ unitBag $ mkPlainErrMsg dflags l1
(text "Module" <+> ppr m1 <+>
cond' v1 v2
| imv_is_safe v1 /= imv_is_safe v2
= throwErrors $ unitBag $ mkPlainErrMsg dflags (imv_span v1)
(text "Module" <+> ppr (imv_name v1) <+>
(text $ "is imported both as a safe and unsafe import!"))
| otherwise
= return v1
......
......@@ -21,7 +21,7 @@ module HscTypes (
-- * Information about modules
ModDetails(..), emptyModDetails,
ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods, ImportedModsVal,
ImportedMods, ImportedModsVal(..),
ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
......@@ -1027,9 +1027,18 @@ emptyModDetails
md_anns = [],
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 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
-- There is only one ModGuts at any time, the one for the module
......
......@@ -1682,14 +1682,14 @@ importSuggestions _dflags imports rdr_name
, ptext (sLit "exports")
, quotes (ppr occ_name) <> dot
]
| [(mod,(_,_,loc,_,_,_))] <- helpful_imports_non_hiding
| [(mod,imv)] <- helpful_imports_non_hiding
= fsep
[ ptext (sLit "Perhaps you want to add")
, quotes (ppr occ_name)
, ptext (sLit "to the import list")
, ptext (sLit "in the import of")
, quotes (ppr mod)
, parens (ppr loc) <> dot
, parens (ppr (imv_span imv)) <> dot
]
| not (null helpful_imports_non_hiding)
= fsep
......@@ -1699,17 +1699,17 @@ importSuggestions _dflags imports rdr_name
]
$$
nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr loc)
| (mod,(_,_,loc,_,_,_)) <- helpful_imports_non_hiding
[ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,imv) <- helpful_imports_non_hiding
])
| [(mod,(_,_,loc,_,_,_))] <- helpful_imports_hiding
| [(mod,imv)] <- helpful_imports_hiding
= fsep
[ ptext (sLit "Perhaps you want to remove")
, quotes (ppr occ_name)
, ptext (sLit "from the explicit hiding list")
, ptext (sLit "in the import of")
, quotes (ppr mod)
, parens (ppr loc) <> dot
, parens (ppr (imv_span imv)) <> dot
]
| not (null helpful_imports_hiding)
= fsep
......@@ -1720,8 +1720,8 @@ importSuggestions _dflags imports rdr_name
]
$$
nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr loc)
| (mod,(_,_,loc,_,_,_)) <- helpful_imports_hiding
[ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,imv) <- helpful_imports_hiding
])
| otherwise
= Outputable.empty
......@@ -1738,26 +1738,20 @@ importSuggestions _dflags imports rdr_name
-- explicit import list (for no particularly good reason)
pick :: [ImportedModsVal] -> Maybe ImportedModsVal
pick = listToMaybe . sortBy (compare `on` prefer) . filter select
where select (name, _,_,_,_,_) = name == mod_name
prefer (_, _, loc, _, hiding, _) = (hiding, loc)
where select imv = imv_name imv == mod_name
prefer imv = (imv_is_hiding imv, imv_span imv)
-- Which of these would export a 'foo'
-- (all of these are restricted imports, because if they were not, we
-- wouldn't have an out-of-scope error in the first place)
helpful_imports = [ (mod, imp)
| (mod, imp@(_, _, _, _, _, all_exports)) <- interesting_imports
, not . null $ lookupGlobalRdrEnv all_exports occ_name
]
-- Which of these do that because of an explicit import list
helpful_imports_non_hiding = [ (mod, imp)
| (mod, imp@(_, _ , _, _, False, _)) <- helpful_imports
]
-- Which of these do that because of an explicit hiding list
helpful_imports_hiding = [ (mod, imp)
| (mod, imp@(_, _ , _, _, True, _)) <- helpful_imports
]
helpful_imports = filter helpful interesting_imports
where helpful (_,imv)
= not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name
-- Which of these do that because of an explicit hiding list resp. an
-- explicit import list
(helpful_imports_hiding, helpful_imports_non_hiding)
= partition (imv_is_hiding . snd) helpful_imports
-- | Called from the typechecker (TcErrors) when we find an unbound variable
unknownNameSuggestions :: DynFlags
......
......@@ -280,10 +280,17 @@ rnImportDecl this_mod
|| (not implicit && safeDirectImpsReq 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
= (calculateAvails dflags iface mod_safe' want_boot) {
imp_mods = unitModuleEnv (mi_module iface)
[(qual_mod_name, import_all, loc, mod_safe', is_hiding, potential_gres)] }
= (calculateAvails dflags iface mod_safe' want_boot)
{ imp_mods = unitModuleEnv (mi_module iface) [imv] }
-- Complain if we import a deprecated module
whenWOptM Opt_WarnWarningsDeprecations (
......@@ -1218,10 +1225,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
pat_syns :: [GlobalRdrElt]
pat_syns = findPatSyns (globalRdrEnvElts rdr_env)
imported_modules = [ qual_name
| xs <- moduleEnvElts $ imp_mods imports,
(qual_name, _, _, _, _, _) <- xs ]
imported_modules = [ imv_name imv
| xs <- moduleEnvElts $ imp_mods imports, imv <- xs ]
exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
exports_from_item acc@(ie_names, occs, exports)
......
......@@ -966,9 +966,10 @@ type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
data ImportAvails
= ImportAvails {
imp_mods :: ImportedMods,
-- = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)],
-- = ModuleEnv [ImportedModsVal],
-- ^ 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
-- @
......
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