summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdward Z. Yang <ezyang@cs.stanford.edu>2015-06-11 15:33:59 -0700
committerEdward Z. Yang <ezyang@cs.stanford.edu>2015-06-11 16:18:18 -0700
commitc60704fc405149407c155e297433f1cc299ae58a (patch)
tree9d3450457e5b849fb72697402b3eed3fe4ed62d4
parentbac927b9770ff769128b66d13a3e72bf5a9bc514 (diff)
downloadhaskell-c60704fc405149407c155e297433f1cc299ae58a.tar.gz
Revert "Change loadSrcInterface to return a list of ModIface"
As it turns out, in our new design these changes are no longer needed. The code is simpler without returning a list of ModIface, so let's do it! This reverts commit 8c7d20d8c7e63a1123755aae69cfa825c749e9e8.
-rw-r--r--compiler/iface/LoadIface.hs50
-rw-r--r--compiler/rename/RnEnv.hs5
-rw-r--r--compiler/rename/RnNames.hs74
-rw-r--r--compiler/typecheck/TcRnDriver.hs5
4 files changed, 38 insertions, 96 deletions
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index c88ad143d4..60feb04a4f 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -234,61 +234,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
-- 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
-> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ?
-> Maybe FastString -- "package", if any
- -> RnM [ModIface]
+ -> RnM ModIface
loadSrcInterface doc mod want_boot maybe_pkg
= do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
; case res of
- Failed err -> failWithTc err
- Succeeded ifaces -> return ifaces }
+ Failed err -> failWithTc err
+ Succeeded iface -> return iface }
--- | Like 'loadSrcInterface', but returns a 'MaybeErr'. See also
--- Note [Un-ambiguous multiple interfaces]
+-- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ?
-> Maybe FastString -- "package", if any
- -> RnM (MaybeErr MsgDoc [ModIface])
+ -> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- We must first find which Module this import refers to. This involves
@@ -297,12 +262,9 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
= do { hsc_env <- getTopEnv
- -- ToDo: findImportedModule should return a list of interfaces
; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
; case res of
- Found _ mod -> fmap (fmap (:[]))
- . initIfaceTcRn
- $ loadInterface doc mod (ImportByUser want_boot)
+ Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
-- | Load interface directly for a fully qualified 'Module'. (This is a fairly
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 2d6cadf99e..4ca3e5acd4 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1008,10 +1008,9 @@ lookupQualifiedNameGHCi rdr_name
, not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi]
= do { res <- loadSrcInterface_maybe doc mod False Nothing
; case res of
- Succeeded ifaces
+ Succeeded iface
-> return [ name
- | iface <- ifaces
- , avail <- mi_exports iface
+ | avail <- mi_exports iface
, name <- availNames avail
, nameOccName name == occ ]
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 872f4ffa7c..d7c3d39aa8 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -229,15 +229,11 @@ rnImportDecl this_mod
| otherwise -> whenWOptM Opt_WarnMissingImportList $
addWarn (missingImportListWarn imp_mod_name)
- ifaces <- loadSrcInterface doc imp_mod_name want_boot (fmap snd mb_pkg)
+ iface <- loadSrcInterface doc imp_mod_name want_boot (fmap snd mb_pkg)
-- Compiler sanity check: if the import didn't say
-- {-# SOURCE #-} we should not get a hi-boot file
- WARN( not want_boot && any mi_boot ifaces, 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
+ WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
-- Issue a user warning for a redundant {- SOURCE -} import
-- NB that we arrange to read all the ordinary imports before
@@ -248,7 +244,7 @@ rnImportDecl this_mod
-- the non-boot module depends on the compilation order, which
-- is not deterministic. The hs-boot test can show this up.
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)
when (mod_safe && not (safeImportsOn dflags)) $
addErr (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
@@ -261,7 +257,7 @@ rnImportDecl this_mod
is_dloc = loc, is_as = qual_mod_name }
-- 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
@@ -276,17 +272,13 @@ rnImportDecl this_mod
|| (implicit && safeImplicitImpsReq dflags)
let imports
- = foldr plusImportAvails emptyImportAvails (map
- (\iface ->
- (calculateAvails dflags iface mod_safe' want_boot) {
+ = (calculateAvails dflags iface mod_safe' want_boot) {
imp_mods = unitModuleEnv (mi_module iface)
- [(qual_mod_name, import_all, loc, mod_safe')] })
- ifaces)
+ [(qual_mod_name, import_all, loc, mod_safe')] }
-- Complain if we import a deprecated module
whenWOptM Opt_WarnWarningsDeprecations (
- forM_ ifaces $ \iface ->
- case mi_warns iface of
+ case (mi_warns iface) of
WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
_ -> return ()
)
@@ -294,7 +286,7 @@ rnImportDecl this_mod
let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
, 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
-- interface, but without 'imp_mods'.
@@ -662,18 +654,18 @@ although we never look up data constructors.
-}
filterImports
- :: [ModIface]
+ :: ModIface
-> ImpDeclSpec -- The span for the entire import decl
-> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding
-> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
[GlobalRdrElt]) -- Same again, but in GRE form
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
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
items1 <- mapM lookup_lie 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)
where
- all_avails = concatMap mi_exports ifaces
+ all_avails = mi_exports iface
-- See Note [Dealing with imports]
imp_occ_env :: OccEnv (Name, -- the name
@@ -741,8 +733,7 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items))
Succeeded a -> return (Just a)
lookup_err_msg err = case err of
- BadImport -> badImportItemErr (any mi_boot ifaces) decl_spec
- ieRdr all_avails
+ BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
IllegalImport -> illegalImportItemErr
QualImportError rdr -> qualImportItemErr rdr
@@ -1581,13 +1572,13 @@ printMinimalImports imports_w_usage
= do { let ImportDecl { ideclName = L _ mod_name
, ideclSource = is_boot
, ideclPkgQual = mb_pkg } = decl
- ; ifaces <- loadSrcInterface doc mod_name is_boot (fmap snd mb_pkg)
- ; let lies = map (L l) (concatMap (to_ie ifaces) used)
+ ; iface <- loadSrcInterface doc mod_name is_boot (fmap snd mb_pkg)
+ ; let lies = map (L l) (concatMap (to_ie iface) used)
; return (L l (decl { ideclHiding = Just (False, L l lies) })) }
where
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
-- 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.
@@ -1595,9 +1586,8 @@ printMinimalImports imports_w_usage
= [IEVar (noLoc n)]
to_ie _ (AvailTC n [m])
| n==m = [IEThingAbs (noLoc n)]
- to_ie ifaces (AvailTC n ns)
- = case [xs | iface <- ifaces
- , AvailTC x xs <- mi_exports iface
+ to_ie iface (AvailTC n ns)
+ = case [xs | AvailTC x xs <- mi_exports iface
, x == n
, x `elem` xs -- Note [Partial export]
] of
@@ -1641,20 +1631,16 @@ qualImportItemErr rdr
= hang (ptext (sLit "Illegal qualified name in import item:"))
2 (ppr rdr)
-badImportItemErrStd :: IsBootInterface -> ImpDeclSpec -> IE RdrName -> SDoc
-badImportItemErrStd is_boot decl_spec ie
+badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrStd iface decl_spec ie
= sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext (sLit "does not export"), quotes (ppr ie)]
where
- source_import | is_boot = ptext (sLit "(hi-boot interface)")
+ source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = Outputable.empty
-badImportItemErrDataCon :: OccName
- -> IsBootInterface
- -> ImpDeclSpec
- -> IE RdrName
- -> SDoc
-badImportItemErrDataCon dataType is_boot decl_spec ie
+badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrDataCon dataType iface decl_spec ie
= vcat [ ptext (sLit "In module")
<+> quotes (ppr (is_mod decl_spec))
<+> source_import <> colon
@@ -1673,19 +1659,15 @@ badImportItemErrDataCon dataType is_boot decl_spec ie
where
datacon_occ = rdrNameOcc $ ieName ie
datacon = parenSymOcc datacon_occ (ppr datacon_occ)
- source_import | is_boot = ptext (sLit "(hi-boot interface)")
+ source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = Outputable.empty
parens_sp d = parens (space <> d <> space) -- T( f,g )
-badImportItemErr :: IsBootInterface
- -> ImpDeclSpec
- -> IE RdrName
- -> [AvailInfo]
- -> SDoc
-badImportItemErr is_boot decl_spec ie avails
+badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
+badImportItemErr iface decl_spec ie avails
= case find checkIfDataCon avails of
- Just con -> badImportItemErrDataCon (availOccName con) is_boot decl_spec ie
- Nothing -> badImportItemErrStd is_boot decl_spec ie
+ Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
+ Nothing -> badImportItemErrStd iface decl_spec ie
where
checkIfDataCon (AvailTC _ ns) =
case find (\n -> importedFS == nameOccNameFS n) ns of
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 585d3b3309..b2604189ae 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1402,9 +1402,8 @@ runTcInteractive hsc_env thing_inside
vcat (map ppr [ local_gres | gres <- occEnvElts (ic_rn_gbl_env icxt)
, let local_gres = filter isLocalGRE gres
, not (null local_gres) ]) ]
-
- ; let getOrphans m = fmap (concatMap (\iface -> mi_module iface
- : dep_orphs (mi_deps iface)))
+ ; let getOrphans m = fmap (\iface -> mi_module iface
+ : dep_orphs (mi_deps iface))
(loadSrcInterface (text "runTcInteractive") m
False Nothing)
; orphs <- fmap concat . forM (ic_imports icxt) $ \i ->