Commit 09d214dc authored by Edward Z. Yang's avatar Edward Z. Yang

Revert "Revert "Revert "Change loadSrcInterface to return a list of ModIface"""

This reverts commit 0c6c015d.
parent 3f13c20e
...@@ -235,61 +235,26 @@ needWiredInHomeIface _ = False ...@@ -235,61 +235,26 @@ needWiredInHomeIface _ = False
************************************************************************ ************************************************************************
-} -}
-- Note [Un-ambiguous multiple interfaces]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- When a user writes an import statement, this usually causes a *single*
-- interface file to be loaded. However, the game is different when
-- signatures are being imported. Suppose in packages p and q we have
-- signatures:
--
-- module A where
-- foo :: Int
--
-- module A where
-- bar :: Int
--
-- If both packages are exposed and I am importing A, I should see a
-- "unified" signature:
--
-- module A where
-- foo :: Int
-- bar :: Int
--
-- The way we achieve this is having the module lookup for A load and return
-- multiple interface files, which we will then process as if there were
-- "multiple" imports:
--
-- import "p" A
-- import "q" A
--
-- Doing so does not cause any ambiguity, because any overlapping identifiers
-- are guaranteed to have the same name if the backing implementations of the
-- two signatures are the same (a condition which is checked by 'Packages'.)
-- | Load the interface corresponding to an @import@ directive in -- | Load the interface corresponding to an @import@ directive in
-- source code. On a failure, fail in the monad with an error message. -- source code. On a failure, fail in the monad with an error message.
-- See Note [Un-ambiguous multiple interfaces] for why the return type
-- is @[ModIface]@
loadSrcInterface :: SDoc loadSrcInterface :: SDoc
-> ModuleName -> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ? -> IsBootInterface -- {-# SOURCE #-} ?
-> Maybe FastString -- "package", if any -> Maybe FastString -- "package", if any
-> RnM [ModIface] -> RnM ModIface
loadSrcInterface doc mod want_boot maybe_pkg loadSrcInterface doc mod want_boot maybe_pkg
= do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
; case res of ; case res of
Failed err -> failWithTc err Failed err -> failWithTc err
Succeeded ifaces -> return ifaces } Succeeded iface -> return iface }
-- | Like 'loadSrcInterface', but returns a 'MaybeErr'. See also -- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
-- Note [Un-ambiguous multiple interfaces]
loadSrcInterface_maybe :: SDoc loadSrcInterface_maybe :: SDoc
-> ModuleName -> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ? -> IsBootInterface -- {-# SOURCE #-} ?
-> Maybe FastString -- "package", if any -> Maybe FastString -- "package", if any
-> RnM (MaybeErr MsgDoc [ModIface]) -> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe doc mod want_boot maybe_pkg loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- We must first find which Module this import refers to. This involves -- We must first find which Module this import refers to. This involves
...@@ -298,12 +263,9 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg ...@@ -298,12 +263,9 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be -- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search. -- cached from the first search.
= do { hsc_env <- getTopEnv = do { hsc_env <- getTopEnv
-- ToDo: findImportedModule should return a list of interfaces
; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
; case res of ; case res of
Found _ mod -> fmap (fmap (:[])) Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
. initIfaceTcRn
$ loadInterface doc mod (ImportByUser want_boot)
err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) } err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
-- | Load interface directly for a fully qualified 'Module'. (This is a fairly -- | Load interface directly for a fully qualified 'Module'. (This is a fairly
......
...@@ -1015,10 +1015,9 @@ lookupQualifiedNameGHCi rdr_name ...@@ -1015,10 +1015,9 @@ lookupQualifiedNameGHCi rdr_name
, not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi] , not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi]
= do { res <- loadSrcInterface_maybe doc mod False Nothing = do { res <- loadSrcInterface_maybe doc mod False Nothing
; case res of ; case res of
Succeeded ifaces Succeeded iface
-> return [ name -> return [ name
| iface <- ifaces | avail <- mi_exports iface
, avail <- mi_exports iface
, name <- availNames avail , name <- availNames avail
, nameOccName name == occ ] , nameOccName name == occ ]
......
...@@ -229,15 +229,11 @@ rnImportDecl this_mod ...@@ -229,15 +229,11 @@ rnImportDecl this_mod
| otherwise -> whenWOptM Opt_WarnMissingImportList $ | otherwise -> whenWOptM Opt_WarnMissingImportList $
addWarn (missingImportListWarn imp_mod_name) addWarn (missingImportListWarn imp_mod_name)
ifaces <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg) iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
-- Compiler sanity check: if the import didn't say -- Compiler sanity check: if the import didn't say
-- {-# SOURCE #-} we should not get a hi-boot file -- {-# SOURCE #-} we should not get a hi-boot file
WARN( not want_boot && any mi_boot ifaces, ppr imp_mod_name ) do WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
-- Another sanity check: we should not get multiple interfaces
-- if we're looking for an hi-boot file
WARN( want_boot && length ifaces /= 1, ppr imp_mod_name ) do
-- Issue a user warning for a redundant {- SOURCE -} import -- Issue a user warning for a redundant {- SOURCE -} import
-- NB that we arrange to read all the ordinary imports before -- NB that we arrange to read all the ordinary imports before
...@@ -248,7 +244,7 @@ rnImportDecl this_mod ...@@ -248,7 +244,7 @@ rnImportDecl this_mod
-- the non-boot module depends on the compilation order, which -- the non-boot module depends on the compilation order, which
-- is not deterministic. The hs-boot test can show this up. -- is not deterministic. The hs-boot test can show this up.
dflags <- getDynFlags dflags <- getDynFlags
warnIf (want_boot && any (not.mi_boot) ifaces && isOneShot (ghcMode dflags)) warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
(warnRedundantSourceImport imp_mod_name) (warnRedundantSourceImport imp_mod_name)
when (mod_safe && not (safeImportsOn dflags)) $ when (mod_safe && not (safeImportsOn dflags)) $
addErr (ptext (sLit "safe import can't be used as Safe Haskell isn't on!") addErr (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
...@@ -261,7 +257,7 @@ rnImportDecl this_mod ...@@ -261,7 +257,7 @@ rnImportDecl this_mod
is_dloc = loc, is_as = qual_mod_name } is_dloc = loc, is_as = qual_mod_name }
-- filter the imports according to the import declaration -- filter the imports according to the import declaration
(new_imp_details, gres) <- filterImports ifaces imp_spec imp_details (new_imp_details, gres) <- filterImports iface imp_spec imp_details
let gbl_env = mkGlobalRdrEnv gres let gbl_env = mkGlobalRdrEnv gres
...@@ -276,17 +272,13 @@ rnImportDecl this_mod ...@@ -276,17 +272,13 @@ rnImportDecl this_mod
|| (implicit && safeImplicitImpsReq dflags) || (implicit && safeImplicitImpsReq dflags)
let imports let imports
= foldr plusImportAvails emptyImportAvails (map = (calculateAvails dflags iface mod_safe' want_boot) {
(\iface ->
(calculateAvails dflags iface mod_safe' want_boot) {
imp_mods = unitModuleEnv (mi_module iface) imp_mods = unitModuleEnv (mi_module iface)
[(qual_mod_name, import_all, loc, mod_safe')] }) [(qual_mod_name, import_all, loc, mod_safe')] }
ifaces)
-- Complain if we import a deprecated module -- Complain if we import a deprecated module
whenWOptM Opt_WarnWarningsDeprecations ( whenWOptM Opt_WarnWarningsDeprecations (
forM_ ifaces $ \iface -> case (mi_warns iface) of
case mi_warns iface of
WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
_ -> return () _ -> return ()
) )
...@@ -294,7 +286,7 @@ rnImportDecl this_mod ...@@ -294,7 +286,7 @@ rnImportDecl this_mod
let new_imp_decl = L loc (decl { ideclSafe = mod_safe' let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
, ideclHiding = new_imp_details }) , ideclHiding = new_imp_details })
return (new_imp_decl, gbl_env, imports, any mi_hpc ifaces) return (new_imp_decl, gbl_env, imports, mi_hpc iface)
-- | Calculate the 'ImportAvails' induced by an import of a particular -- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'. -- interface, but without 'imp_mods'.
...@@ -662,18 +654,18 @@ although we never look up data constructors. ...@@ -662,18 +654,18 @@ although we never look up data constructors.
-} -}
filterImports filterImports
:: [ModIface] :: ModIface
-> ImpDeclSpec -- The span for the entire import decl -> ImpDeclSpec -- The span for the entire import decl
-> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding -> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding
-> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
[GlobalRdrElt]) -- Same again, but in GRE form [GlobalRdrElt]) -- Same again, but in GRE form
filterImports iface decl_spec Nothing filterImports iface decl_spec Nothing
= return (Nothing, gresFromAvails (Just imp_spec) (concatMap mi_exports iface)) = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
where where
imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
filterImports ifaces decl_spec (Just (want_hiding, L l import_items)) filterImports iface decl_spec (Just (want_hiding, L l import_items))
= do -- check for errors, convert RdrNames to Names = do -- check for errors, convert RdrNames to Names
items1 <- mapM lookup_lie import_items items1 <- mapM lookup_lie import_items
...@@ -692,7 +684,7 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items)) ...@@ -692,7 +684,7 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items))
return (Just (want_hiding, L l (map fst items2)), gres) return (Just (want_hiding, L l (map fst items2)), gres)
where where
all_avails = concatMap mi_exports ifaces all_avails = mi_exports iface
-- See Note [Dealing with imports] -- See Note [Dealing with imports]
imp_occ_env :: OccEnv (Name, -- the name imp_occ_env :: OccEnv (Name, -- the name
...@@ -741,8 +733,7 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items)) ...@@ -741,8 +733,7 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items))
Succeeded a -> return (Just a) Succeeded a -> return (Just a)
lookup_err_msg err = case err of lookup_err_msg err = case err of
BadImport -> badImportItemErr (any mi_boot ifaces) decl_spec BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
ieRdr all_avails
IllegalImport -> illegalImportItemErr IllegalImport -> illegalImportItemErr
QualImportError rdr -> qualImportItemErr rdr QualImportError rdr -> qualImportItemErr rdr
...@@ -1581,14 +1572,13 @@ printMinimalImports imports_w_usage ...@@ -1581,14 +1572,13 @@ printMinimalImports imports_w_usage
= do { let ImportDecl { ideclName = L _ mod_name = do { let ImportDecl { ideclName = L _ mod_name
, ideclSource = is_boot , ideclSource = is_boot
, ideclPkgQual = mb_pkg } = decl , ideclPkgQual = mb_pkg } = decl
; ifaces <- loadSrcInterface doc mod_name is_boot ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg)
(fmap sl_fs mb_pkg) ; let lies = map (L l) (concatMap (to_ie iface) used)
; let lies = map (L l) (concatMap (to_ie ifaces) used)
; return (L l (decl { ideclHiding = Just (False, L l lies) })) } ; return (L l (decl { ideclHiding = Just (False, L l lies) })) }
where where
doc = text "Compute minimal imports for" <+> ppr decl doc = text "Compute minimal imports for" <+> ppr decl
to_ie :: [ModIface] -> AvailInfo -> [IE Name] to_ie :: ModIface -> AvailInfo -> [IE Name]
-- The main trick here is that if we're importing all the constructors -- The main trick here is that if we're importing all the constructors
-- we want to say "T(..)", but if we're importing only a subset we want -- we want to say "T(..)", but if we're importing only a subset we want
-- to say "T(A,B,C)". So we have to find out what the module exports. -- to say "T(A,B,C)". So we have to find out what the module exports.
...@@ -1596,9 +1586,8 @@ printMinimalImports imports_w_usage ...@@ -1596,9 +1586,8 @@ printMinimalImports imports_w_usage
= [IEVar (noLoc n)] = [IEVar (noLoc n)]
to_ie _ (AvailTC n [m]) to_ie _ (AvailTC n [m])
| n==m = [IEThingAbs (noLoc n)] | n==m = [IEThingAbs (noLoc n)]
to_ie ifaces (AvailTC n ns) to_ie iface (AvailTC n ns)
= case [xs | iface <- ifaces = case [xs | AvailTC x xs <- mi_exports iface
, AvailTC x xs <- mi_exports iface
, x == n , x == n
, x `elem` xs -- Note [Partial export] , x `elem` xs -- Note [Partial export]
] of ] of
...@@ -1642,20 +1631,16 @@ qualImportItemErr rdr ...@@ -1642,20 +1631,16 @@ qualImportItemErr rdr
= hang (ptext (sLit "Illegal qualified name in import item:")) = hang (ptext (sLit "Illegal qualified name in import item:"))
2 (ppr rdr) 2 (ppr rdr)
badImportItemErrStd :: IsBootInterface -> ImpDeclSpec -> IE RdrName -> SDoc badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
badImportItemErrStd is_boot decl_spec ie badImportItemErrStd iface decl_spec ie
= sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import, = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext (sLit "does not export"), quotes (ppr ie)] ptext (sLit "does not export"), quotes (ppr ie)]
where where
source_import | is_boot = ptext (sLit "(hi-boot interface)") source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = Outputable.empty | otherwise = Outputable.empty
badImportItemErrDataCon :: OccName badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
-> IsBootInterface badImportItemErrDataCon dataType_occ iface decl_spec ie
-> ImpDeclSpec
-> IE RdrName
-> SDoc
badImportItemErrDataCon dataType_occ is_boot decl_spec ie
= vcat [ ptext (sLit "In module") = vcat [ ptext (sLit "In module")
<+> quotes (ppr (is_mod decl_spec)) <+> quotes (ppr (is_mod decl_spec))
<+> source_import <> colon <+> source_import <> colon
...@@ -1675,19 +1660,15 @@ badImportItemErrDataCon dataType_occ is_boot decl_spec ie ...@@ -1675,19 +1660,15 @@ badImportItemErrDataCon dataType_occ is_boot decl_spec ie
datacon_occ = rdrNameOcc $ ieName ie datacon_occ = rdrNameOcc $ ieName ie
datacon = parenSymOcc datacon_occ (ppr datacon_occ) datacon = parenSymOcc datacon_occ (ppr datacon_occ)
dataType = parenSymOcc dataType_occ (ppr dataType_occ) dataType = parenSymOcc dataType_occ (ppr dataType_occ)
source_import | is_boot = ptext (sLit "(hi-boot interface)") source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = Outputable.empty | otherwise = Outputable.empty
parens_sp d = parens (space <> d <> space) -- T( f,g ) parens_sp d = parens (space <> d <> space) -- T( f,g )
badImportItemErr :: IsBootInterface badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
-> ImpDeclSpec badImportItemErr iface decl_spec ie avails
-> IE RdrName
-> [AvailInfo]
-> SDoc
badImportItemErr is_boot decl_spec ie avails
= case find checkIfDataCon avails of = case find checkIfDataCon avails of
Just con -> badImportItemErrDataCon (availOccName con) is_boot decl_spec ie Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
Nothing -> badImportItemErrStd is_boot decl_spec ie Nothing -> badImportItemErrStd iface decl_spec ie
where where
checkIfDataCon (AvailTC _ ns) = checkIfDataCon (AvailTC _ ns) =
case find (\n -> importedFS == nameOccNameFS n) ns of case find (\n -> importedFS == nameOccNameFS n) ns of
......
...@@ -1406,9 +1406,8 @@ runTcInteractive hsc_env thing_inside ...@@ -1406,9 +1406,8 @@ runTcInteractive hsc_env thing_inside
vcat (map ppr [ local_gres | gres <- occEnvElts (ic_rn_gbl_env icxt) vcat (map ppr [ local_gres | gres <- occEnvElts (ic_rn_gbl_env icxt)
, let local_gres = filter isLocalGRE gres , let local_gres = filter isLocalGRE gres
, not (null local_gres) ]) ] , not (null local_gres) ]) ]
; let getOrphans m = fmap (\iface -> mi_module iface
; let getOrphans m = fmap (concatMap (\iface -> mi_module iface : dep_orphs (mi_deps iface))
: dep_orphs (mi_deps iface)))
(loadSrcInterface (text "runTcInteractive") m (loadSrcInterface (text "runTcInteractive") m
False Nothing) False Nothing)
; orphs <- fmap concat . forM (ic_imports icxt) $ \i -> ; orphs <- fmap concat . forM (ic_imports icxt) $ \i ->
......
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