X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=8ca0bfc289f7104893b0afcdc5eca7f844016178;hb=d436c70d43fb905c63220040168295e473f4b90a;hp=5d01b9a71fb2164facbfa3ba249aa2b2d7445649;hpb=b9110541efb85f9489b1f9a0c95445419e61d86d;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 5d01b9a..8ca0bfc 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -78,7 +78,6 @@ import System.Directory
 import Distribution.Package hiding (depends, PackageId)
 
 import Exception
-import Data.Maybe
 \end{code}
 
 
@@ -289,16 +288,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 +306,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 +413,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)
@@ -637,8 +637,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...
@@ -745,7 +744,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