diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/ghci/Linker.lhs | 49 | ||||
| -rw-r--r-- | compiler/main/HscMain.lhs | 7 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 7 |
3 files changed, 31 insertions, 32 deletions
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 2f8943ef24..e0a11ddcd3 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -440,10 +440,10 @@ dieWith :: SrcSpan -> Message -> IO a dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg))) -checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String) +checkNonStdWay :: DynFlags -> SrcSpan -> IO Bool checkNonStdWay dflags srcspan = do let tag = buildTag dflags - if null tag {- || tag == "dyn" -} then return Nothing else do + if null tag {- || tag == "dyn" -} then return False else do -- see #3604: object files compiled for way "dyn" need to link to the -- dynamic packages, so we can't load them into a statically-linked GHCi. -- we have to treat "dyn" in the same way as "prof". @@ -453,12 +453,14 @@ checkNonStdWay dflags srcspan = do -- .o files or -dynamic .o files into GHCi (currently that's not possible -- because the dynamic objects contain refs to e.g. __stginit_base_Prelude_dyn -- whereas we have __stginit_base_Prelude_. - let default_osuf = phaseInputExt StopLn - if objectSuf dflags == default_osuf - then failNonStd srcspan - else return (Just default_osuf) + if (objectSuf dflags == normalObjectSuffix) + then failNonStd srcspan + else return True -failNonStd :: SrcSpan -> IO (Maybe String) +normalObjectSuffix :: String +normalObjectSuffix = phaseInputExt StopLn + +failNonStd :: SrcSpan -> IO Bool failNonStd srcspan = dieWith srcspan $ ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$ ptext (sLit "You need to build the program twice: once the normal way, and then") $$ @@ -467,13 +469,13 @@ failNonStd srcspan = dieWith srcspan $ getLinkDeps :: HscEnv -> HomePackageTable -> PersistentLinkerState - -> Maybe String -- the "normal" object suffix + -> Bool -- replace object suffices? -> SrcSpan -- for error messages -> [Module] -- If you need these -> IO ([Linkable], [PackageId]) -- ... then link these first -- Fails with an IO exception if it can't find enough files -getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods +getLinkDeps hsc_env hpt pls replace_osuf span mods -- Find all the packages and linkables that a set of modules depends on = do { -- 1. Find the dependent home-pkg-modules/packages from each iface @@ -494,7 +496,8 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods -- 3. For each dependent module, find its linkable -- This will either be in the HPT or (in the case of one-shot -- compilation) we may need to use maybe_getFileLinkable - lnks_needed <- mapM (get_linkable maybe_normal_osuf) mods_needed ; + let { osuf = objectSuf dflags } ; + lnks_needed <- mapM (get_linkable osuf replace_osuf) mods_needed ; return (lnks_needed, pkgs_needed) } where @@ -559,7 +562,7 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods -- This one is a build-system bug - get_linkable maybe_normal_osuf mod_name -- A home-package module + get_linkable osuf replace_osuf mod_name -- A home-package module | Just mod_info <- lookupUFM hpt mod_name = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info)) | otherwise @@ -578,22 +581,24 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods Just lnk -> adjust_linkable lnk }} - adjust_linkable lnk - | Just osuf <- maybe_normal_osuf = do - new_uls <- mapM (adjust_ul osuf) (linkableUnlinked lnk) - return lnk{ linkableUnlinked=new_uls } - | otherwise = - return lnk - - adjust_ul osuf (DotO file) = do - let new_file = replaceExtension file osuf - ok <- doesFileExist new_file + adjust_linkable lnk + | replace_osuf = do + new_uls <- mapM adjust_ul (linkableUnlinked lnk) + return lnk{ linkableUnlinked=new_uls } + | otherwise = + return lnk + + adjust_ul (DotO file) = do + MASSERT (osuf `isSuffixOf` file) + let new_file = reverse (drop (length osuf + 1) (reverse file)) + <.> normalObjectSuffix + ok <- doesFileExist new_file if (not ok) then dieWith span $ ptext (sLit "cannot find normal object file ") <> quotes (text new_file) $$ while_linking_expr else return (DotO new_file) - adjust_ul _ _ = panic "adjust_ul" + adjust_ul _ = panic "adjust_ul" \end{code} diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index b8874b1a9f..46a46a7b41 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -300,18 +300,17 @@ hscGetModuleInterface hsc_env mod -- | Rename some import declarations hscRnImportDecls :: HscEnv - -> Module -> [LImportDecl RdrName] -> IO GlobalRdrEnv -- It is important that we use tcRnImports instead of calling rnImports directly -- because tcRnImports will force-load any orphan modules necessary, making extra -- instances/family instances visible (GHC #4832) -hscRnImportDecls hsc_env this_mod import_decls +hscRnImportDecls hsc_env import_decls = runHsc hsc_env $ ioMsgMaybe $ - initTc hsc_env HsSrcFile False this_mod $ + initTc hsc_env HsSrcFile False iNTERACTIVE $ -- iNTERACTIVE, see #5545 fmap tcg_rdr_env $ - tcRnImports hsc_env this_mod import_decls + tcRnImports hsc_env iNTERACTIVE import_decls #endif -- ----------------------------------------------------------------------------- diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index b10f8e70d6..4e100db485 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -51,7 +51,6 @@ import Name hiding ( varName ) import NameSet import Avail import RdrName -import PrelNames (pRELUDE) import VarSet import VarEnv import ByteCodeInstr @@ -814,7 +813,7 @@ setContext imports findGlobalRdrEnv :: HscEnv -> [InteractiveImport] -> IO GlobalRdrEnv -- Compute the GlobalRdrEnv for the interactive context findGlobalRdrEnv hsc_env imports - = do { idecls_env <- hscRnImportDecls hsc_env this_mod idecls + = do { idecls_env <- hscRnImportDecls hsc_env idecls -- This call also loads any orphan modules ; imods_env <- mapM (mkTopLevEnv (hsc_HPT hsc_env)) imods ; return (foldr plusGlobalRdrEnv idecls_env imods_env) } @@ -825,10 +824,6 @@ findGlobalRdrEnv hsc_env imports imods :: [Module] imods = [m | IIModule m <- imports] - this_mod = case imods of - [] -> pRELUDE - (m:_) -> m - availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv availsToGlobalRdrEnv mod_name avails = mkGlobalRdrEnv (gresFromAvails imp_prov avails) |