Remove unused imports
[ghc-hetmet.git] / compiler / ghci / Linker.lhs
index 459fbd9..21a2064 100644 (file)
@@ -50,12 +50,10 @@ import ListSetOps
 import DynFlags
 import BasicTypes
 import Outputable
-import PackageConfig
 import Panic
 import Util
 import StaticFlags
 import ErrUtils
-import DriverPhases
 import SrcLoc
 import qualified Maybes
 import UniqSet
@@ -78,7 +76,6 @@ import System.Directory
 import Distribution.Package hiding (depends, PackageId)
 
 import Exception
-import Data.Maybe
 \end{code}
 
 
@@ -289,16 +286,17 @@ linkDependencies hsc_env span needed_mods = do
 
 -- | Temporarily extend the linker state.
 
-withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
+withExtendedLinkEnv :: (MonadIO m, ExceptionMonad m) =>
+                       [(Name,HValue)] -> m a -> m a
 withExtendedLinkEnv new_env action
-    = bracket_ set_new_env
-               reset_old_env
-               action
+    = gbracket set_new_env
+               (\_ -> reset_old_env)
+               (\_ -> action)
     where set_new_env = do 
-            pls <- readIORef v_PersistentLinkerState
+            pls <- liftIO $ readIORef v_PersistentLinkerState
             let new_closure_env = extendClosureEnv (closure_env pls) new_env
                 new_pls = pls { closure_env = new_closure_env }
-            writeIORef v_PersistentLinkerState new_pls
+            liftIO $ writeIORef v_PersistentLinkerState new_pls
             return ()
 
         -- Remember that the linker state might be side-effected
@@ -306,7 +304,7 @@ withExtendedLinkEnv new_env action
         -- lose those changes (we might have linked a new module or
         -- package), so the reset action only removes the names we
         -- added earlier.
-          reset_old_env = do
+          reset_old_env = liftIO $ do
             modifyIORef v_PersistentLinkerState $ \pls ->
                 let cur = closure_env pls
                     new = delListFromNameEnv cur (map fst new_env)
@@ -413,7 +411,7 @@ reallyInitDynLinker dflags
        ; ok <- resolveObjs
 
        ; if succeeded ok then maybePutStrLn dflags "done"
-         else ghcError (InstallationError "linking extra libraries/objects failed")
+         else ghcError (ProgramError "linking extra libraries/objects failed")
        }}
 
 classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
@@ -456,21 +454,20 @@ preloadLib dflags lib_paths framework_paths lib_spec
   where
     preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
     preloadFailed sys_errmsg paths spec
-       = do maybePutStr dflags
-              ("failed.\nDynamic linker error message was:\n   " 
-                    ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
-                    ++ showLS spec ++ "\nDirectories to search are:\n"
-                    ++ unlines (map ("   "++) paths) )
-            give_up
+       = do maybePutStr dflags "failed.\n"
+            ghcError $
+             CmdLineError (
+                    "user specified .o/.so/.DLL could not be loaded ("
+                    ++ sys_errmsg ++ ")\nWhilst trying to load:  "
+                    ++ showLS spec ++ "\nAdditional directories searched:"
+                    ++ (if null paths then " (none)" else
+                        (concat (intersperse "\n" (map ("   "++) paths)))))
     
     -- Not interested in the paths in the static case.
     preload_static _paths name
        = do b <- doesFileExist name
             if not b then return False
                      else loadObj name >> return True
-    
-    give_up = ghcError $ 
-             CmdLineError "user specified .o/.so/.DLL could not be loaded."
 \end{code}
 
 
@@ -638,8 +635,7 @@ getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
 
     get_linkable maybe_normal_osuf mod_name    -- A home-package module
        | Just mod_info <- lookupUFM hpt mod_name 
-       = ASSERT(isJust (hm_linkable mod_info))
-         adjust_linkable (fromJust (hm_linkable mod_info))
+       = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
        | otherwise     
        = do    -- It's not in the HPT because we are in one shot mode, 
                -- so use the Finder to get a ModLocation...
@@ -746,7 +742,7 @@ dynLinkObjs dflags objs
            pls1                     = pls { objs_loaded = objs_loaded' }
            unlinkeds                = concatMap linkableUnlinked new_objs
 
-       mapM loadObj (map nameOfObject unlinkeds)
+       mapM_ loadObj (map nameOfObject unlinkeds)
 
        -- Link the all together
        ok <- resolveObjs