diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index c4c49bedd68e40a558f4e0963eecea21f7ebb2f9..5253a2aa4f4d9223459447ef4e262ac755ce84dc 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -103,7 +103,26 @@ compile :: GhcMonad m => -> Maybe Linkable -- ^ old linkable, if we have one -> m HomeModInfo -- ^ the complete HomeModInfo, if successful -compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable +compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch) + +type Compiler m a = HscEnv -> ModSummary -> Bool + -> Maybe ModIface -> Maybe (Int, Int) + -> m a + +compile' :: GhcMonad m => + (Compiler m (HscStatus, ModIface, ModDetails), + Compiler m (InteractiveStatus, ModIface, ModDetails), + Compiler m (HscStatus, ModIface, ModDetails)) + -> HscEnv + -> ModSummary -- ^ summary for module being compiled + -> Int -- ^ module N ... + -> Int -- ^ ... of M + -> Maybe ModIface -- ^ old interface, if we have one + -> Maybe Linkable -- ^ old linkable, if we have one + -> m HomeModInfo -- ^ the complete HomeModInfo, if successful + +compile' (nothingCompiler, interactiveCompiler, batchCompiler) + hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable = do let dflags0 = ms_hspp_opts summary this_mod = ms_mod summary @@ -211,15 +230,13 @@ compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable hm_linkable = linkable }) -- run the compiler case hsc_lang of - HscInterpreted - | isHsBoot src_flavour -> - runCompiler hscCompileNothing handleBatch - | otherwise -> - runCompiler hscCompileInteractive handleInterpreted + HscInterpreted -> + runCompiler interactiveCompiler handleInterpreted HscNothing -> - runCompiler hscCompileNothing handleBatch + runCompiler nothingCompiler handleBatch _other -> - runCompiler hscCompileBatch handleBatch + runCompiler batchCompiler handleBatch + ----------------------------------------------------------------------------- -- stub .h and .c files (for foreign export support) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index df415b6e60d6d38be01dd72b60c1753c18adb915..3f72101bad7653049c87ce5dd0799136da854ca1 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1100,17 +1100,21 @@ loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod loadModule tcm = do let ms = modSummary tcm let mod = ms_mod_name ms - let (tcg, details) = tm_internals tcm + let (tcg, _details) = tm_internals tcm hpt_new <- withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do - (iface, _) <- makeSimpleIface Nothing tcg details - let mod_info = HomeModInfo { - hm_iface = iface, - hm_details = details, - hm_linkable = Just (LM (ms_hs_date ms) - (ms_mod ms) - []) } + + let compilerBackend comp env ms' _ _mb_old_iface _ = + withTempSession (\_ -> env) $ + hscBackend comp tcg ms' + Nothing hsc_env <- getSession + mod_info + <- compile' (compilerBackend hscNothingCompiler + ,compilerBackend hscInteractiveCompiler + ,compilerBackend hscBatchCompiler) + hsc_env ms 1 1 Nothing Nothing + -- compile' shouldn't change the environment return $ addToUFM (hsc_HPT hsc_env) mod mod_info modifySession $ \e -> e{ hsc_HPT = hpt_new } return tcm