Deduplicate one-shot/make compile paths.

Summary:
We had a duplicate copy of the code for --make and for -c
which was a pain.  The call graph looked something like this:

    compileOne -> genericHscCompileGetFrontendResult -> genericHscFrontend
                                   hscCompileOneShot ---^

with genericHscCompileGetFrontendResult and hscCompileOneShot
duplicating logic for deciding whether or not recompilation
was needed.

This patchset fixes it, so now everything goes through this call-chain:

    compileOne (--make entry point)
        Calls hscIncrementCompile, invokes the pipeline to do codegen
        and sets up linkables.
    hscIncrementalCompile (-c entry point)
        Calls hscIncrementalFrontend, and then simplifying,
        desugaring, and writing out the interface.
    hscIncrementalFrontend
        Performs recompilation avoidance, if recompilation needed,
        does parses typechecking.

I also cleaned up some of the MergeBoot nonsense by introducing
a FrontendResult type.

NB: this BREAKS #8101 again, because I can't unconditionally desugar
due to Haddock barfing on lint, see #10600

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, simonmar, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1302

5 files changed, 261 insertions, 320 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 9523e87942..02f3caf5c9 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -64,7 +64,6 @@ import MonadUtils
 import Platform
 import TcRnTypes
 import Hooks
-import MkIface
 
 import Exception
 import Data.IORef       ( readIORef )
@@ -133,173 +132,90 @@ compileOne' :: Maybe TcGblEnv
 compileOne' m_tc_result mHscMessage
             hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
             source_modified0
- | HsBootMerge <- ms_hsc_src summary
- = do -- Do a boot merge instead!  For now, something very simple
-      output_fn <- getOutputFilename next_phase
-                        Temporary basename dflags next_phase (Just location)
-      e <- genericHscMergeRequirement mHscMessage
-                hsc_env summary mb_old_iface (mod_index, nmods)
-
-      case e of
-       -- TODO: dedup
-       Left iface ->
-           do details <- genModDetails hsc_env iface
-              return (HomeModInfo{ hm_details  = details,
-                                   hm_iface    = iface,
-                                   hm_linkable = maybe_old_linkable })
-       Right (iface0, mb_old_hash) ->
-        case hsc_lang of
-          HscInterpreted ->
-           do (iface, _no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
-              details <- genModDetails hsc_env iface
-              -- Merges don't need to link in any bytecode, unlike
-              -- HsSrcFiles.
-              let linkable = LM (ms_hs_date summary) this_mod []
-              return (HomeModInfo{ hm_details  = details,
-                                   hm_iface    = iface,
-                                   hm_linkable = Just linkable })
-
-          HscNothing ->
-           do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
-              details <- genModDetails hsc_env iface
-              when (gopt Opt_WriteInterface dflags) $
-                 hscWriteIface dflags iface no_change summary
-              let linkable = LM (ms_hs_date summary) this_mod []
-              return (HomeModInfo{ hm_details  = details,
-                                   hm_iface    = iface,
-                                   hm_linkable = Just linkable })
-          _ ->
-           do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
-              hscWriteIface dflags iface no_change summary
-
-              -- #10660: Use the pipeline instead of calling
-              -- compileEmptyStub directly, so -dynamic-too gets
-              -- handled properly
-              let mod_name = ms_mod_name summary
-              _ <- runPipeline StopLn hsc_env
-                                (output_fn,
-                                 Just (HscOut src_flavour
-                                              mod_name HscUpdateBootMerge))
-                                (Just basename)
-                                Persistent
-                                (Just location)
-                                Nothing
-
-              details <- genModDetails hsc_env iface
-
-              o_time <- getModificationUTCTime object_filename
-              let linkable =
-                      LM o_time this_mod [DotO object_filename]
-              return (HomeModInfo{ hm_details  = details,
-                                   hm_iface    = iface,
-                                   hm_linkable = Just linkable })
-
- | otherwise
  = do
 
    debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
-   -- What file to generate the output into?
-   output_fn <- getOutputFilename next_phase
-                        Temporary basename dflags next_phase (Just location)
-
-   e <- genericHscCompileGetFrontendResult
-            always_do_basic_recompilation_check
-            m_tc_result mHscMessage
-            hsc_env summary source_modified mb_old_iface (mod_index, nmods)
-
-   case e of
-       Left iface ->
-           do details <- genModDetails hsc_env iface
-              MASSERT(isJust maybe_old_linkable || isNoLink (ghcLink dflags))
-              return (HomeModInfo{ hm_details  = details,
-                                   hm_iface    = iface,
-                                   hm_linkable = maybe_old_linkable })
-
-       Right (tc_result, mb_old_hash) ->
-           -- run the compiler
-           case hsc_lang of
-               HscInterpreted ->
-                   case ms_hsc_src summary of
-                   HsBootFile ->
-                       do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
-                          return (HomeModInfo{ hm_details  = details,
-                                               hm_iface    = iface,
-                                               hm_linkable = Nothing })
-                   _ -> do guts0 <- hscDesugar hsc_env summary tc_result
-                           guts <- hscSimplify hsc_env guts0
-                           (iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
-                           (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
-
-                           stub_o <- case hasStub of
-                                     Nothing -> return []
-                                     Just stub_c -> do
-                                         stub_o <- compileStub hsc_env stub_c
-                                         return [DotO stub_o]
-
-                           let hs_unlinked = [BCOs comp_bc modBreaks]
-                               unlinked_time = ms_hs_date summary
-                             -- Why do we use the timestamp of the source file here,
-                             -- rather than the current time?  This works better in
-                             -- the case where the local clock is out of sync
-                             -- with the filesystem's clock.  It's just as accurate:
-                             -- if the source is modified, then the linkable will
-                             -- be out of date.
-                           let linkable = LM unlinked_time this_mod
-                                          (hs_unlinked ++ stub_o)
-
-                           return (HomeModInfo{ hm_details  = details,
-                                                hm_iface    = iface,
-                                                hm_linkable = Just linkable })
-               HscNothing ->
-                   do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
-                      when (gopt Opt_WriteInterface dflags) $
-                         hscWriteIface dflags iface changed summary
-                      let linkable = if isHsBoot src_flavour
-                                     then Nothing
-                                     else Just (LM (ms_hs_date summary) this_mod [])
-                      return (HomeModInfo{ hm_details  = details,
-                                           hm_iface    = iface,
-                                           hm_linkable = linkable })
 
-               _ ->
-                   case ms_hsc_src summary of
-                   HsBootMerge -> panic "This driver can't handle it"
-                   HsBootFile ->
-                       do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
-                          hscWriteIface dflags iface changed summary
-
-                          touchObjectFile dflags object_filename
-
-                          return (HomeModInfo{
-                                    hm_details  = details,
-                                    hm_iface    = iface,
-                                    hm_linkable = Nothing })
-
-                   HsSrcFile ->
-                        do guts0 <- hscDesugar hsc_env summary tc_result
-                           guts <- hscSimplify hsc_env guts0
-                           (iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
-                           hscWriteIface dflags iface changed summary
-
-                           -- We're in --make mode: finish the compilation pipeline.
-                           let mod_name = ms_mod_name summary
-                           _ <- runPipeline StopLn hsc_env
-                                             (output_fn,
-                                              Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
-                                             (Just basename)
-                                             Persistent
-                                             (Just location)
-                                             Nothing
-                                 -- The object filename comes from the ModLocation
-                           o_time <- getModificationUTCTime object_filename
-                           let linkable = LM o_time this_mod [DotO object_filename]
-
-                           return (HomeModInfo{ hm_details  = details,
-                                                hm_iface    = iface,
-                                                hm_linkable = Just linkable })
+   (status, hmi0) <- hscIncrementalCompile
+                        always_do_basic_recompilation_check
+                        m_tc_result mHscMessage
+                        hsc_env summary source_modified mb_old_iface (mod_index, nmods)
+
+   case (status, hsc_lang) of
+        (HscUpToDate, _) ->
+            ASSERT( isJust maybe_old_linkable || isNoLink (ghcLink dflags) )
+            return hmi0 { hm_linkable = maybe_old_linkable }
+        (HscNotGeneratingCode, HscNothing) ->
+            let mb_linkable = if isHsBoot src_flavour
+                                then Nothing
+                                -- TODO: Questionable.
+                                else Just (LM (ms_hs_date summary) this_mod [])
+            in return hmi0 { hm_linkable = mb_linkable }
+        (HscNotGeneratingCode, _) -> panic "compileOne HscNotGeneratingCode"
+        (_, HscNothing) -> panic "compileOne HscNothing"
+        (HscUpdateBoot, HscInterpreted) -> do
+            return hmi0
+        (HscUpdateBoot, _) -> do
+            touchObjectFile dflags object_filename
+            return hmi0
+        (HscUpdateBootMerge, HscInterpreted) ->
+            let linkable = LM (ms_hs_date summary) this_mod []
+            in return hmi0 { hm_linkable = Just linkable }
+        (HscUpdateBootMerge, _) -> do
+            output_fn <- getOutputFilename next_phase
+                            Temporary basename dflags next_phase (Just location)
+
+            -- #10660: Use the pipeline instead of calling
+            -- compileEmptyStub directly, so -dynamic-too gets
+            -- handled properly
+            _ <- runPipeline StopLn hsc_env
+                              (output_fn,
+                               Just (HscOut src_flavour
+                                            mod_name HscUpdateBootMerge))
+                              (Just basename)
+                              Persistent
+                              (Just location)
+                              Nothing
+            o_time <- getModificationUTCTime object_filename
+            let linkable = LM o_time this_mod [DotO object_filename]
+            return hmi0 { hm_linkable = Just linkable }
+        (HscRecomp cgguts summary, HscInterpreted) -> do
+            (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
+
+            stub_o <- case hasStub of
+                      Nothing -> return []
+                      Just stub_c -> do
+                          stub_o <- compileStub hsc_env stub_c
+                          return [DotO stub_o]
+
+            let hs_unlinked = [BCOs comp_bc modBreaks]
+                unlinked_time = ms_hs_date summary
+              -- Why do we use the timestamp of the source file here,
+              -- rather than the current time?  This works better in
+              -- the case where the local clock is out of sync
+              -- with the filesystem's clock.  It's just as accurate:
+              -- if the source is modified, then the linkable will
+              -- be out of date.
+            let linkable = LM unlinked_time (ms_mod summary)
+                           (hs_unlinked ++ stub_o)
+            return hmi0 { hm_linkable = Just linkable }
+        (HscRecomp cgguts summary, _) -> do
+            output_fn <- getOutputFilename next_phase
+                            Temporary basename dflags next_phase (Just location)
+            -- We're in --make mode: finish the compilation pipeline.
+            _ <- runPipeline StopLn hsc_env
+                              (output_fn,
+                               Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
+                              (Just basename)
+                              Persistent
+                              (Just location)
+                              Nothing
+                  -- The object filename comes from the ModLocation
+            o_time <- getModificationUTCTime object_filename
+            let linkable = LM o_time this_mod [DotO object_filename]
+            return hmi0 { hm_linkable = Just linkable }
+
  where dflags0     = ms_hspp_opts summary
-       this_mod    = ms_mod summary
-       src_flavour = ms_hsc_src summary
        location    = ms_location summary
        input_fn    = expectJust "compile:hs" (ml_hs_file location)
        input_fnpp  = ms_hspp_file summary
@@ -310,6 +226,13 @@ compileOne' m_tc_result mHscMessage
        isDynWay    = any (== WayDyn) (ways dflags0)
        isProfWay   = any (== WayProf) (ways dflags0)
 
+
+       src_flavour = ms_hsc_src summary
+       this_mod = ms_mod summary
+       mod_name = ms_mod_name summary
+       next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
+       object_filename = ml_obj_file location
+
        -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
        -- the linker can correctly load the object files.
 
@@ -329,15 +252,12 @@ compileOne' m_tc_result mHscMessage
 
        -- Figure out what lang we're generating
        hsc_lang = hscTarget dflags
-       -- ... and what the next phase should be
-       next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
 
        -- -fforce-recomp should also work with --make
        force_recomp = gopt Opt_ForceRecomp dflags
        source_modified
          | force_recomp = SourceModified
          | otherwise = source_modified0
-       object_filename = ml_obj_file location
 
        always_do_basic_recompilation_check = case hsc_lang of
                                              HscInterpreted -> True
@@ -1087,8 +1007,9 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                                         ms_merge_imps = (False, []) }
 
   -- run the compiler!
-        result <- liftIO $ hscCompileOneShot hsc_env'
-                               mod_summary source_unchanged
+        let msg hsc_env _ what _ = oneShotMsg hsc_env what
+        (result, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
+                            mod_summary source_unchanged Nothing (1,1)
 
         return (HscOut src_flavour mod_name result,
                 panic "HscOut doesn't have an input filename")
diff --git a/compiler/main/Hooks.hs b/compiler/main/Hooks.hs
index f9339b1cef..f75214b4f4 100644
--- a/compiler/main/Hooks.hs
+++ b/compiler/main/Hooks.hs
@@ -14,7 +14,6 @@ module Hooks ( Hooks
              , tcForeignImportsHook
              , tcForeignExportsHook
              , hscFrontendHook
-             , hscCompileOneShotHook
              , hscCompileCoreExprHook
              , ghcPrimIfaceHook
              , runPhaseHook
@@ -58,14 +57,12 @@ import Data.Maybe
 emptyHooks :: Hooks
 emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing
                    Nothing Nothing Nothing Nothing Nothing Nothing
-                   Nothing
 
 data Hooks = Hooks
   { dsForeignsHook         :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
   , tcForeignImportsHook   :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
   , tcForeignExportsHook   :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
-  , hscFrontendHook        :: Maybe (ModSummary -> Hsc TcGblEnv)
-  , hscCompileOneShotHook  :: Maybe (HscEnv -> ModSummary -> SourceModified -> IO HscStatus)
+  , hscFrontendHook        :: Maybe (ModSummary -> Hsc FrontendResult)
   , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue)
   , ghcPrimIfaceHook       :: Maybe ModIface
   , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index e5c6ce14ec..f783a9a9bc 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -19,10 +19,11 @@
 -- from here on in (although it has mutable components, for the
 -- caches).
 --
--- Warning messages are dealt with consistently throughout this API:
--- during compilation warnings are collected, and before any function
--- in @HscMain@ returns, the warnings are either printed, or turned
--- into a real compialtion error if the @-Werror@ flag is enabled.
+-- We use the Hsc monad to deal with warning messages consistently:
+-- specifically, while executing within an Hsc monad, warnings are
+-- collected. When a Hsc monad returns to an IO monad, the
+-- warnings are printed, or compilation aborts if the @-Werror@
+-- flag is enabled.
 --
 -- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
 --
@@ -36,12 +37,11 @@ module HscMain
     -- * Compiling complete source files
     , Messager, batchMsg
     , HscStatus (..)
-    , hscCompileOneShot
+    , hscIncrementalCompile
     , hscCompileCmmFile
     , hscCompileCore
 
-    , genericHscCompileGetFrontendResult
-    , genericHscMergeRequirement
+    , hscIncrementalFrontend
 
     , genModDetails
     , hscSimpleIface
@@ -58,12 +58,14 @@ module HscMain
     , makeSimpleDetails
     , hscSimplify -- ToDo, shouldn't really export this
 
+    -- * Safe Haskell
+    , hscCheckSafe
+    , hscGetSafe
+
     -- * Support for interactive evaluation
     , hscParseIdentifier
     , hscTcRcLookupName
     , hscTcRnGetInfo
-    , hscCheckSafe
-    , hscGetSafe
 #ifdef GHCI
     , hscIsGHCiMonad
     , hscGetModuleInterface
@@ -513,73 +515,38 @@ This is the only thing that isn't caught by the type-system.
 
 type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO ()
 
--- | Analogous to 'genericHscCompileGetFrontendResult', this function
--- calls 'hscMergeFrontEnd' if recompilation is necessary.  It does
--- not write out the resulting 'ModIface' (see 'compileOne').
--- TODO: maybe fold this 'genericHscCompileGetFrontendResult' into
--- some higher-order function
-genericHscMergeRequirement ::
-                     Maybe Messager
-                  -> HscEnv
-                  -> ModSummary
-                  -> Maybe ModIface  -- Old interface, if available
-                  -> (Int,Int)       -- (i,n) = module i of n (for msgs)
-                  -> IO (Either ModIface (ModIface, Maybe Fingerprint))
-genericHscMergeRequirement mHscMessage
-  hsc_env mod_summary mb_old_iface mod_index = do
-    let msg what = case mHscMessage of
-                   Just hscMessage ->
-                    hscMessage hsc_env mod_index what mod_summary
-                   Nothing -> return ()
-
-        skip iface = do
-            msg UpToDate
-            return (Left iface)
-
-        -- TODO: hook this
-        compile mb_old_hash reason = do
-            msg reason
-            r <- hscMergeFrontEnd hsc_env mod_summary
-            return $ Right (r, mb_old_hash)
-
-    (recomp_reqd, mb_checked_iface)
-                <- {-# SCC "checkOldIface" #-}
-                   checkOldIface hsc_env mod_summary
-                                SourceUnmodified mb_old_iface
-    case mb_checked_iface of
-        Just iface | not (recompileRequired recomp_reqd) -> skip iface
-        _ -> compile (fmap mi_iface_hash mb_checked_iface) recomp_reqd
-
--- | This function runs 'genericHscFrontend' if recompilation is necessary.
--- It does not write out the results of typechecking (see 'compileOne').
-genericHscCompileGetFrontendResult ::
-                     Bool -- always do basic recompilation check?
-                  -> Maybe TcGblEnv
-                  -> Maybe Messager
-                  -> HscEnv
-                  -> ModSummary
-                  -> SourceModified
-                  -> Maybe ModIface  -- Old interface, if available
-                  -> (Int,Int)       -- (i,n) = module i of n (for msgs)
-                  -> IO (Either ModIface (TcGblEnv, Maybe Fingerprint))
-
-genericHscCompileGetFrontendResult
+-- | This function runs GHC's frontend with recompilation
+-- avoidance. Specifically, it checks if recompilation is needed,
+-- and if it is, it parses and typechecks the input module.
+-- It does not write out the results of typechecking (See
+-- compileOne and hscIncrementalCompile).
+hscIncrementalFrontend :: Bool -- always do basic recompilation check?
+                       -> Maybe TcGblEnv
+                       -> Maybe Messager
+                       -> ModSummary
+                       -> SourceModified
+                       -> Maybe ModIface  -- Old interface, if available
+                       -> (Int,Int)       -- (i,n) = module i of n (for msgs)
+                       -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
+
+hscIncrementalFrontend
   always_do_basic_recompilation_check m_tc_result
-  mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index
+  mHscMessage mod_summary source_modified mb_old_iface mod_index
     = do
+    hsc_env <- getHscEnv
 
     let msg what = case mHscMessage of
                    Just hscMessage -> hscMessage hsc_env mod_index what mod_summary
                    Nothing -> return ()
 
         skip iface = do
-            msg UpToDate
+            liftIO $ msg UpToDate
             return $ Left iface
 
         compile mb_old_hash reason = do
-            msg reason
-            tc_result <- runHsc hsc_env $ genericHscFrontend mod_summary
-            return $ Right (tc_result, mb_old_hash)
+            liftIO $ msg reason
+            result <- genericHscFrontend mod_summary
+            return $ Right (result, mb_old_hash)
 
         stable = case source_modified of
                      SourceUnmodifiedAndStable -> True
@@ -588,11 +555,11 @@ genericHscCompileGetFrontendResult
     case m_tc_result of
          Just tc_result
           | not always_do_basic_recompilation_check ->
-             return $ Right (tc_result, Nothing)
+             return $ Right (FrontendTypecheck tc_result, Nothing)
          _ -> do
             (recomp_reqd, mb_checked_iface)
                 <- {-# SCC "checkOldIface" #-}
-                   checkOldIface hsc_env mod_summary
+                   liftIO $ checkOldIface hsc_env mod_summary
                                 source_modified mb_old_iface
             -- save the interface that comes back from checkOldIface.
             -- In one-shot mode we don't have the old iface until this
@@ -624,101 +591,149 @@ genericHscCompileGetFrontendResult
                     case m_tc_result of
                     Nothing -> compile mb_old_hash recomp_reqd
                     Just tc_result ->
-                        return $ Right (tc_result, mb_old_hash)
+                        return $ Right (FrontendTypecheck tc_result, mb_old_hash)
 
-genericHscFrontend :: ModSummary -> Hsc TcGblEnv
+genericHscFrontend :: ModSummary -> Hsc FrontendResult
 genericHscFrontend mod_summary =
   getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary)
 
-genericHscFrontend' :: ModSummary -> Hsc TcGblEnv
-genericHscFrontend' mod_summary = hscFileFrontEnd mod_summary
+genericHscFrontend' :: ModSummary -> Hsc FrontendResult
+genericHscFrontend' mod_summary
+    | ms_hsc_src mod_summary == HsBootMerge
+    = FrontendMerge `fmap` hscMergeFrontEnd mod_summary
+    | otherwise
+    = FrontendTypecheck `fmap` hscFileFrontEnd mod_summary
 
 --------------------------------------------------------------
 -- Compilers
 --------------------------------------------------------------
 
-hscCompileOneShot :: HscEnv
-                  -> ModSummary
-                  -> SourceModified
-                  -> IO HscStatus
-hscCompileOneShot env =
-  lookupHook hscCompileOneShotHook hscCompileOneShot' (hsc_dflags env) env
-
 -- Compile Haskell/boot in OneShot mode.
-hscCompileOneShot' :: HscEnv
-                   -> ModSummary
-                   -> SourceModified
-                   -> IO HscStatus
-hscCompileOneShot' hsc_env mod_summary src_changed
+hscIncrementalCompile :: Bool
+                      -> Maybe TcGblEnv
+                      -> Maybe Messager
+                      -> HscEnv
+                      -> ModSummary
+                      -> SourceModified
+                      -> Maybe ModIface
+                      -> (Int,Int)
+                      -- HomeModInfo does not contain linkable, since we haven't
+                      -- code-genned yet
+                      -> IO (HscStatus, HomeModInfo)
+hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
+    mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index
   = do
     -- One-shot mode needs a knot-tying mutable variable for interface
     -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var.
     type_env_var <- newIORef emptyNameEnv
     let mod = ms_mod mod_summary
-        hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
+        hsc_env = hsc_env'{ hsc_type_env_var = Just (mod, type_env_var) }
 
-        msg what = oneShotMsg hsc_env' what
-
-        skip = do msg UpToDate
-                  dumpIfaceStats hsc_env'
-                  return HscUpToDate
+    -- NB: enter Hsc monad here so that we don't bail out early with
+    -- -Werror on typechecker warnings; we also want to run the desugarer
+    -- to get those warnings too. (But we'll always exit at that point
+    -- because the desugarer runs ioMsgMaybe.)
+    runHsc hsc_env $ do
+    let dflags = hsc_dflags hsc_env
 
-        compile mb_old_hash reason = runHsc hsc_env' $ do
-            liftIO $ msg reason
-            tc_result <- genericHscFrontend mod_summary
-            guts0 <- hscDesugar' (ms_location mod_summary) tc_result
-            dflags <- getDynFlags
+    e <- hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result mHscMessage
+            mod_summary source_modified mb_old_iface mod_index
+    case e of
+        Left iface -> do
+            details <- liftIO $ genModDetails hsc_env iface
+            return (HscUpToDate, HomeModInfo{
+                hm_details = details,
+                hm_iface = iface,
+                hm_linkable = Nothing
+            })
+        Right (result, mb_old_hash) -> do
+            (status, hmi, no_change) <- case result of
+                FrontendTypecheck tc_result ->
+                    if hscTarget dflags /= HscNothing &&
+                       ms_hsc_src mod_summary == HsSrcFile
+                       then finish              hsc_env mod_summary tc_result mb_old_hash
+                       else finishTypecheckOnly hsc_env mod_summary tc_result mb_old_hash
+                FrontendMerge raw_iface ->
+                            finishMerge         hsc_env mod_summary raw_iface mb_old_hash
+            liftIO $ hscMaybeWriteIface dflags (hm_iface hmi) no_change mod_summary
+            return (status, hmi)
+
+-- Generates and writes out the final interface for an hs-boot merge.
+finishMerge :: HscEnv
+            -> ModSummary
+            -> ModIface
+            -> Maybe Fingerprint
+            -> Hsc (HscStatus, HomeModInfo, Bool)
+finishMerge hsc_env summary iface0 mb_old_hash = do
+    MASSERT( ms_hsc_src summary == HsBootMerge )
+    (iface, changed) <- liftIO $ mkIfaceDirect hsc_env mb_old_hash iface0
+    details <- liftIO $ genModDetails hsc_env iface
+    let dflags = hsc_dflags hsc_env
+        hsc_status =
             case hscTarget dflags of
-                HscNothing -> do
-                    when (gopt Opt_WriteInterface dflags) $ liftIO $ do
-                        (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash
-                        hscWriteIface dflags iface changed mod_summary
-                    return HscNotGeneratingCode
-                _ ->
-                    case ms_hsc_src mod_summary of
-                    HsBootFile ->
-                        do (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash
-                           liftIO $ hscWriteIface dflags iface changed mod_summary
-                           return HscUpdateBoot
-                    HsSrcFile ->
-                        do guts <- hscSimplify' guts0
-                           (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash
-                           liftIO $ hscWriteIface dflags iface changed mod_summary
-                           return $ HscRecomp cgguts mod_summary
-                    HsBootMerge -> panic "hscCompileOneShot HsBootMerge"
-
-        -- XXX This is always False, because in one-shot mode the
-        -- concept of stability does not exist.  The driver never
-        -- passes SourceUnmodifiedAndStable in here.
-        stable = case src_changed of
-                     SourceUnmodifiedAndStable -> True
-                     _                         -> False
-
-    (recomp_reqd, mb_checked_iface)
-        <- {-# SCC "checkOldIface" #-}
-           checkOldIface hsc_env' mod_summary src_changed Nothing
-    -- save the interface that comes back from checkOldIface.
-    -- In one-shot mode we don't have the old iface until this
-    -- point, when checkOldIface reads it from the disk.
-    let mb_old_hash = fmap mi_iface_hash mb_checked_iface
-
-    case mb_checked_iface of
-        Just iface | not (recompileRequired recomp_reqd) ->
-            -- If the module used TH splices when it was last compiled,
-            -- then the recompilation check is not accurate enough (#481)
-            -- and we must ignore it. However, if the module is stable
-            -- (none of the modules it depends on, directly or indirectly,
-            -- changed), then we *can* skip recompilation. This is why
-            -- the SourceModified type contains SourceUnmodifiedAndStable,
-            -- and it's pretty important: otherwise ghc --make would
-            -- always recompile TH modules, even if nothing at all has
-            -- changed. Stability is just the same check that make is
-            -- doing for us in one-shot mode.
-            if mi_used_th iface && not stable
-            then compile mb_old_hash (RecompBecause "TH")
-            else skip
-        _ ->
-            compile mb_old_hash recomp_reqd
+                HscNothing -> HscNotGeneratingCode
+                _ -> HscUpdateBootMerge
+    return (hsc_status,
+            HomeModInfo{ hm_details  = details,
+                         hm_iface    = iface,
+                         hm_linkable = Nothing },
+            changed)
+
+-- Generates and writes out the final interface for a typecheck.
+finishTypecheckOnly :: HscEnv
+              -> ModSummary
+              -> TcGblEnv
+              -> Maybe Fingerprint
+              -> Hsc (HscStatus, HomeModInfo, Bool)
+finishTypecheckOnly hsc_env summary tc_result mb_old_hash = do
+    let dflags = hsc_dflags hsc_env
+    MASSERT( hscTarget dflags == HscNothing || ms_hsc_src summary == HsBootFile )
+    (iface, changed, details) <- liftIO $ hscSimpleIface hsc_env tc_result mb_old_hash
+    let hsc_status =
+          case (hscTarget dflags, ms_hsc_src summary) of
+            (HscNothing, _) -> HscNotGeneratingCode
+            (_, HsBootFile) -> HscUpdateBoot
+            _ -> panic "finishTypecheckOnly"
+    return (hsc_status,
+            HomeModInfo{ hm_details  = details,
+                         hm_iface    = iface,
+                         hm_linkable = Nothing },
+            changed)
+
+-- Runs the post-typechecking frontend (desugar and simplify),
+-- and then generates and writes out the final interface. We want
+-- to write the interface AFTER simplification so we can get
+-- as up-to-date and good unfoldings and other info as possible
+-- in the interface file.  This is only ever run for HsSrcFile,
+-- and NOT for HscNothing.
+finish :: HscEnv
+       -> ModSummary
+       -> TcGblEnv
+       -> Maybe Fingerprint
+       -> Hsc (HscStatus, HomeModInfo, Bool)
+finish hsc_env summary tc_result mb_old_hash = do
+    let dflags = hsc_dflags hsc_env
+    MASSERT( ms_hsc_src summary == HsSrcFile )
+    MASSERT( hscTarget dflags /= HscNothing )
+    guts0 <- hscDesugar' (ms_location summary) tc_result
+    guts <- hscSimplify' guts0
+    (iface, changed, details, cgguts) <- liftIO $ hscNormalIface hsc_env guts mb_old_hash
+
+    return (HscRecomp cgguts summary,
+            HomeModInfo{ hm_details  = details,
+                         hm_iface    = iface,
+                         hm_linkable = Nothing },
+            changed)
+
+hscMaybeWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO ()
+hscMaybeWriteIface dflags iface changed summary =
+    let force_write_interface = gopt Opt_WriteInterface dflags
+        write_interface = case hscTarget dflags of
+                            HscNothing      -> False
+                            HscInterpreted  -> False
+                            _               -> True
+    in when (write_interface || force_write_interface) $
+            hscWriteIface dflags iface changed summary
 
 --------------------------------------------------------------
 -- NoRecomp handlers
@@ -768,8 +783,9 @@ batchMsg hsc_env mod_index recomp mod_summary =
 
 -- | Given an 'HsBootMerge' 'ModSummary', merges all @hs-boot@ files
 -- under this module name into a composite, publically visible 'ModIface'.
-hscMergeFrontEnd :: HscEnv -> ModSummary -> IO ModIface
-hscMergeFrontEnd hsc_env mod_summary = do
+hscMergeFrontEnd :: ModSummary -> Hsc ModIface
+hscMergeFrontEnd mod_summary = do
+    hsc_env <- getHscEnv
     MASSERT( ms_hsc_src mod_summary == HsBootMerge )
     let dflags = hsc_dflags hsc_env
     -- TODO: actually merge in signatures from external packages.
@@ -783,7 +799,7 @@ hscMergeFrontEnd hsc_env mod_summary = do
     iface0 <- case lookupHptByModule hpt mod of
         Just hm -> return (hm_iface hm)
         Nothing -> do
-            mb_iface0 <- initIfaceCheck hsc_env
+            mb_iface0 <- liftIO . initIfaceCheck hsc_env
                     $ findAndReadIface (text "merge-requirements")
                                        mod is_boot
             case mb_iface0 of
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index c4de91de24..7f51c332da 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -28,6 +28,9 @@ module TcRnTypes(
         IfGblEnv(..), IfLclEnv(..),
         tcVisibleOrphanMods,
 
+        -- Frontend types (shouldn't really be here)
+        FrontendResult(..),
+
         -- Renamer types
         ErrCtxt, RecFieldEnv(..),
         ImportAvails(..), emptyImportAvails, plusImportAvails,
@@ -326,6 +329,10 @@ data DsMetaVal
 ************************************************************************
 -}
 
+data FrontendResult
+        = FrontendTypecheck TcGblEnv
+        | FrontendMerge     ModIface
+
 -- | 'TcGblEnv' describes the top-level of the module at the
 -- point at which the typechecker is finished work.
 -- It is this structure that is handed on to the desugarer
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index cbfbd02a4c..17e0784cbc 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -400,7 +400,7 @@ test('T8959a',
 
 test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703'])
 test('T2182', normal, run_command, ['$MAKE -s --no-print-directory T2182'])
-test('T8101', normal, compile, ['-Wall -fno-code'])
+test('T8101', expect_broken(10600), compile, ['-Wall -fno-code'])
 test('T8101b', expect_broken(10600), multimod_compile,
      ['T8101b', '-Wall -fno-code'])