X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=d5ad093bc9d3ef10f5cfa92ebd48e166e65a68d0;hb=0a5613f40b0e32cf59966e6b56b807cdbe80aa7b;hp=9c21d0a52a0d3e19440728fffd2213b822fdcde1;hpb=2fe38b5fb0957f9428864afd69ad3ccd82fae3d0;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 9c21d0a..d5ad093 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -24,6 +24,7 @@ module HscMain
     , hscCompileBatch       -- :: Compiler (HscStatus, ModIface, ModDetails)
     , hscCompileNothing     -- :: Compiler (HscStatus, ModIface, ModDetails)
     , hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
+    , hscCheckRecompBackend
     , HscStatus' (..)
     , InteractiveStatus, HscStatus
 
@@ -336,12 +337,6 @@ type Compiler result =  GhcMonad m =>
 
 data HsCompiler a
   = HsCompiler {
-    -- | The main interface.
-    hscCompile :: GhcMonad m =>
-                  HscEnv -> ModSummary -> Bool
-               -> Maybe ModIface -> Maybe (Int, Int)
-               -> m a,
-
     -- | Called when no recompilation is necessary.
     hscNoRecomp :: GhcMonad m =>
                    ModIface -> m a,
@@ -388,6 +383,22 @@ genericHscCompile compiler hscMessage
            -> do hscMessage mb_mod_index True mod_summary
                  hscRecompile compiler mod_summary mb_old_hash
 
+hscCheckRecompBackend :: HsCompiler a -> TcGblEnv -> Compiler a
+hscCheckRecompBackend compiler tc_result 
+                   hsc_env mod_summary source_unchanged mb_old_iface _m_of_n =
+   withTempSession (\_ -> hsc_env) $ do
+     (recomp_reqd, mb_checked_iface)
+         <- {-# SCC "checkOldIface" #-}
+            liftIO $ checkOldIface hsc_env mod_summary
+                                   source_unchanged mb_old_iface
+
+     let mb_old_hash = fmap mi_iface_hash mb_checked_iface
+     case mb_checked_iface of
+       Just iface | not recomp_reqd
+           -> hscNoRecomp compiler iface{ mi_globals = Just (tcg_rdr_env tc_result) }
+       _otherwise
+           -> hscBackend compiler tc_result mod_summary mb_old_hash
+
 genericHscRecompile :: GhcMonad m =>
                        HsCompiler a
                     -> ModSummary -> Maybe Fingerprint
@@ -418,19 +429,7 @@ hscOneShotCompiler :: HsCompiler OneShotResult
 hscOneShotCompiler =
   HsCompiler {
 
-    hscCompile = \hsc_env mod_summary src_changed mb_old_iface mb_i_of_n -> do
-       -- One-shot mode needs a knot-tying mutable variable for interface
-       -- files.  See TcRnTypes.TcGblEnv.tcg_type_env_var.
-      type_env_var <- liftIO $ newIORef emptyNameEnv
-      let
-         mod = ms_mod mod_summary
-         hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
-      ---
-      genericHscCompile hscOneShotCompiler
-                        oneShotMsg hsc_env' mod_summary src_changed
-                        mb_old_iface mb_i_of_n
-
-  , hscNoRecomp = \_old_iface -> do
+    hscNoRecomp = \_old_iface -> do
       withSession (liftIO . dumpIfaceStats)
       return HscNoRecomp
 
@@ -454,7 +453,18 @@ hscOneShotCompiler =
 
 -- Compile Haskell, boot and extCore in OneShot mode.
 hscCompileOneShot :: Compiler OneShotResult
-hscCompileOneShot = hscCompile hscOneShotCompiler
+hscCompileOneShot hsc_env mod_summary src_changed mb_old_iface mb_i_of_n = do
+       -- One-shot mode needs a knot-tying mutable variable for interface
+       -- files.  See TcRnTypes.TcGblEnv.tcg_type_env_var.
+      type_env_var <- liftIO $ newIORef emptyNameEnv
+      let
+         mod = ms_mod mod_summary
+         hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
+      ---
+      genericHscCompile hscOneShotCompiler
+                        oneShotMsg hsc_env' mod_summary src_changed
+                        mb_old_iface mb_i_of_n
+
 
 --------------------------------------------------------------
 
@@ -462,9 +472,7 @@ hscBatchCompiler :: HsCompiler BatchResult
 hscBatchCompiler =
   HsCompiler {
 
-    hscCompile = genericHscCompile hscBatchCompiler batchMsg
-
-  , hscNoRecomp = \iface -> do
+    hscNoRecomp = \iface -> do
        details <- genModDetails iface
        return (HscNoRecomp, iface, details)
 
@@ -489,16 +497,14 @@ hscBatchCompiler =
 
 -- Compile Haskell, boot and extCore in batch mode.
 hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileBatch = hscCompile hscBatchCompiler
+hscCompileBatch = genericHscCompile hscBatchCompiler batchMsg
 
 --------------------------------------------------------------
 
 hscInteractiveCompiler :: HsCompiler InteractiveResult
 hscInteractiveCompiler =
   HsCompiler {
-    hscCompile = genericHscCompile hscInteractiveCompiler batchMsg
-
-  , hscNoRecomp = \iface -> do
+    hscNoRecomp = \iface -> do
        details <- genModDetails iface
        return (HscNoRecomp, iface, details)
 
@@ -519,16 +525,14 @@ hscInteractiveCompiler =
 
 -- Compile Haskell, extCore to bytecode.
 hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
-hscCompileInteractive = hscCompile hscInteractiveCompiler
+hscCompileInteractive = genericHscCompile hscInteractiveCompiler batchMsg
 
 --------------------------------------------------------------
 
 hscNothingCompiler :: HsCompiler NothingResult
 hscNothingCompiler =
   HsCompiler {
-    hscCompile = genericHscCompile hscNothingCompiler batchMsg
-
-  , hscNoRecomp = \iface -> do
+    hscNoRecomp = \iface -> do
        details <- genModDetails iface
        return (HscNoRecomp, iface, details)
 
@@ -550,9 +554,10 @@ hscNothingCompiler =
   , hscGenOutput = \_ _ _ ->
         panic "hscCompileNothing: hscGenOutput should not be called"
   }
+
 -- Type-check Haskell and .hs-boot only (no external core)
 hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileNothing = hscCompile hscNothingCompiler
+hscCompileNothing = genericHscCompile hscNothingCompiler batchMsg
 
 --------------------------------------------------------------
 -- NoRecomp handlers