diff options
author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-06-11 15:33:59 -0700 |
---|---|---|
committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-06-11 16:18:18 -0700 |
commit | c60704fc405149407c155e297433f1cc299ae58a (patch) | |
tree | 9d3450457e5b849fb72697402b3eed3fe4ed62d4 | |
parent | bac927b9770ff769128b66d13a3e72bf5a9bc514 (diff) | |
download | haskell-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.hs | 50 | ||||
-rw-r--r-- | compiler/rename/RnEnv.hs | 5 | ||||
-rw-r--r-- | compiler/rename/RnNames.hs | 74 | ||||
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 5 |
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 -> |