X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=e402d895212b20e9fceba57170dbb8e7a643cabc;hb=0a5613f40b0e32cf59966e6b56b807cdbe80aa7b;hp=c01a43304f22663330fd9b587835fff344b5d55b;hpb=b06d623b2e367a572de5daf06d6a0b12c2740471;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c01a433..e402d89 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -300,7 +300,6 @@ import Maybes		( expectJust, mapCatMaybes )
 import FastString
 import Lexer
 
-import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist,
                           getCurrentDirectory )
 import Data.Maybe
@@ -353,6 +352,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 +454,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 +1113,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