+data HsCompiler a
+ = HsCompiler {
+ -- | Called when no recompilation is necessary.
+ hscNoRecomp :: GhcMonad m =>
+ ModIface -> m a,
+
+ -- | Called to recompile the module.
+ hscRecompile :: GhcMonad m =>
+ ModSummary -> Maybe Fingerprint -> m a,
+
+ hscBackend :: GhcMonad m =>
+ TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
+
+ -- | Code generation for Boot modules.
+ hscGenBootOutput :: GhcMonad m =>
+ TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
+
+ -- | Code generation for normal modules.
+ hscGenOutput :: GhcMonad m =>
+ ModGuts -> ModSummary -> Maybe Fingerprint -> m a
+ }
+
+genericHscCompile :: GhcMonad m =>
+ HsCompiler a
+ -> (Maybe (Int,Int) -> Bool -> ModSummary -> m ())
+ -> HscEnv -> ModSummary -> Bool
+ -> Maybe ModIface -> Maybe (Int, Int)
+ -> m a
+genericHscCompile compiler hscMessage
+ hsc_env mod_summary source_unchanged
+ mb_old_iface0 mb_mod_index =
+ withTempSession (\_ -> hsc_env) $ do
+ (recomp_reqd, mb_checked_iface)
+ <- {-# SCC "checkOldIface" #-}
+ liftIO $ checkOldIface hsc_env mod_summary
+ source_unchanged mb_old_iface0
+ -- 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 recomp_reqd
+ -> do hscMessage mb_mod_index False mod_summary
+ hscNoRecomp compiler iface
+ _otherwise
+ -> 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
+ -> m a
+genericHscRecompile compiler mod_summary mb_old_hash
+ | ExtCoreFile <- ms_hsc_src mod_summary =
+ panic "GHC does not currently support reading External Core files"
+ | otherwise = do
+ tc_result <- hscFileFrontEnd mod_summary
+ hscBackend compiler tc_result mod_summary mb_old_hash
+
+genericHscBackend :: GhcMonad m =>
+ HsCompiler a
+ -> TcGblEnv -> ModSummary -> Maybe Fingerprint
+ -> m a
+genericHscBackend compiler tc_result mod_summary mb_old_hash
+ | HsBootFile <- ms_hsc_src mod_summary =
+ hscGenBootOutput compiler tc_result mod_summary mb_old_hash
+ | otherwise = do
+ guts <- hscDesugar mod_summary tc_result
+ hscGenOutput compiler guts mod_summary mb_old_hash
+