Remove LazyUniqFM; fixes trac #3880

[ghc-hetmet.git] / compiler / main / GHC.hs

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 5289f71..b713bc8 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -254,8 +254,8 @@ import NameSet
 import RdrName
 import qualified HsSyn -- hack as we want to reexport the whole module
 import HsSyn hiding ((<.>))
-import Type             hiding (typeKind)
-import TcType           hiding (typeKind)
+import Type
+import TcType          hiding( typeKind )
 import Id
 import Var
 import TysPrim         ( alphaTyVars )
@@ -284,8 +284,7 @@ import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import Annotations
 import Module
-import LazyUniqFM
-import qualified UniqFM as UFM
+import UniqFM
 import FiniteMap
 import Panic
 import Digraph
@@ -300,7 +299,6 @@ import Maybes               ( expectJust, mapCatMaybes )
 import FastString
 import Lexer
 
-import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist,
                           getCurrentDirectory )
 import Data.Maybe
@@ -353,6 +351,7 @@ defaultErrorHandler dflags inner =
                case ge of
                     PhaseFailed _ code -> exitWith code
                     Interrupted -> exitWith (ExitFailure 1)
+                    Signal _ -> exitWith (ExitFailure 1)
                     _ -> do fatalErrorMsg dflags (text (show ge))
                             exitWith (ExitFailure 1)
            ) $
@@ -454,8 +453,6 @@ runGhcT mb_top_dir ghct = do
 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 initGhcMonad mb_top_dir = do
   -- catch ^C
-  main_thread <- liftIO $ myThreadId
-  liftIO $ modifyMVar_ interruptTargetThread (return . (main_thread :))
   liftIO $ installSignalHandlers
 
   liftIO $ StaticFlags.initStaticOpts
@@ -1115,25 +1112,35 @@ loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
 loadModule tcm = do
    let ms = modSummary tcm
    let mod = ms_mod_name ms
+   let loc = ms_location ms
    let (tcg, _details) = tm_internals tcm
    hpt_new <-
        withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
 
          let compilerBackend comp env ms' _ _mb_old_iface _ =
                withTempSession (\_ -> env) $
-                 hscBackend comp tcg ms'
-                            Nothing
+                 hscBackend comp tcg ms' Nothing
+
          hsc_env <- getSession
-         mod_info
-             <- compile' (compilerBackend hscNothingCompiler
-                         ,compilerBackend hscInteractiveCompiler
-                         ,compilerBackend hscBatchCompiler)
-                         hsc_env ms 1 1 Nothing Nothing
+         mod_info <- do
+             mb_linkable <- 
+                  case ms_obj_date ms of
+                     Just t | t > ms_hs_date ms  -> do
+                         l <- liftIO $ findObjectLinkable (ms_mod ms) 
+                                                  (ml_obj_file loc) t
+                         return (Just l)
+                     _otherwise -> return Nothing
+                                                
+             compile' (compilerBackend hscNothingCompiler
+                      ,compilerBackend hscInteractiveCompiler
+                      ,hscCheckRecompBackend hscBatchCompiler tcg)
+                      hsc_env ms 1 1 Nothing mb_linkable
          -- compile' shouldn't change the environment
          return $ addToUFM (hsc_HPT hsc_env) mod mod_info
    modifySession $ \e -> e{ hsc_HPT = hpt_new }
    return tcm
 
+
 -- | This is the way to get access to the Core bindings corresponding
 -- to a module. 'compileToCore' parses, typechecks, and
 -- desugars the module, then returns the resulting Core module (consisting of
@@ -2525,7 +2532,7 @@ packageDbModules :: GhcMonad m =>
                  -> m [Module]
 packageDbModules only_exposed = do
    dflags <- getSessionDynFlags
-   let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
+   let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
    return $
      [ mkModule pid modname | p <- pkgs
                             , not only_exposed || exposed p