+ | HscRecomp
+ Bool -- Has stub files. This is a hack. We can't compile C files here
+ -- since it's done in DriverPipeline. For now we just return True
+ -- if we want the caller to compile them for us.
+ a
+
+-- This is a bit ugly. Since we use a typeclass below and would like to avoid
+-- functional dependencies, we have to parameterise the typeclass over the
+-- result type. Therefore we need to artificially distinguish some types. We
+-- do this by adding type tags which will simply be ignored by the caller.
+type HscStatus = HscStatus' ()
+type InteractiveStatus = HscStatus' (Maybe (CompiledByteCode, ModBreaks))
+ -- INVARIANT: result is @Nothing@ <=> input was a boot file
+
+type OneShotResult = HscStatus
+type BatchResult = (HscStatus, ModIface, ModDetails)
+type NothingResult = (HscStatus, ModIface, ModDetails)
+type InteractiveResult = (InteractiveStatus, ModIface, ModDetails)
+
+-- FIXME: The old interface and module index are only using in 'batch' and
+-- 'interactive' mode. They should be removed from 'oneshot' mode.
+type Compiler result = GhcMonad m =>
+ HscEnv
+ -> ModSummary
+ -> Bool -- True <=> source unchanged
+ -> Maybe ModIface -- Old interface, if available
+ -> Maybe (Int,Int) -- Just (i,n) <=> module i of n (for msgs)
+ -> m result
+
+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