Commit 8d48737f authored by Thomas Schilling's avatar Thomas Schilling

Expose a separate 'hscBackend' phase for 'HsCompiler' and change

parameter to 'InteractiveStatus' to a 'Maybe'.
parent f74cf811
......@@ -19,7 +19,7 @@ module DriverPipeline (
-- Interfaces for the compilation manager (interpreted/batch-mode)
preprocess,
compile,
compile, compile',
link,
) where
......@@ -182,7 +182,10 @@ compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
handleInterpreted HscNoRecomp
= ASSERT (isJust maybe_old_linkable)
return maybe_old_linkable
handleInterpreted (HscRecomp hasStub (comp_bc, modBreaks))
handleInterpreted (HscRecomp _hasStub Nothing)
= ASSERT (isHsBoot src_flavour)
return maybe_old_linkable
handleInterpreted (HscRecomp hasStub (Just (comp_bc, modBreaks)))
= do stub_unlinked <- getStubLinkable hasStub
let hs_unlinked = [BCOs comp_bc modBreaks]
unlinked_time = ms_hs_date summary
......
......@@ -17,6 +17,9 @@ module HscMain
, hscStmt, hscTcExpr, hscKcType
, compileExpr
#endif
, HsCompiler(..)
, hscOneShotCompiler, hscNothingCompiler
, hscInteractiveCompiler, hscBatchCompiler
, hscCompileOneShot -- :: Compiler HscStatus
, hscCompileBatch -- :: Compiler (HscStatus, ModIface, ModDetails)
, hscCompileNothing -- :: Compiler (HscStatus, ModIface, ModDetails)
......@@ -313,7 +316,8 @@ data HscStatus' a
-- 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' (CompiledByteCode, ModBreaks)
type InteractiveStatus = HscStatus' (Maybe (CompiledByteCode, ModBreaks))
-- INVARIANT: result is @Nothing@ <=> input was a boot file
type OneShotResult = HscStatus
type BatchResult = (HscStatus, ModIface, ModDetails)
......@@ -346,6 +350,9 @@ data HsCompiler a
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,
......@@ -390,12 +397,18 @@ genericHscRecompile compiler mod_summary mb_old_hash
panic "GHC does not currently support reading External Core files"
| otherwise = do
tc_result <- hscFileFrontEnd mod_summary
case ms_hsc_src mod_summary of
HsBootFile ->
hscGenBootOutput compiler tc_result mod_summary mb_old_hash
_other -> do
guts <- hscDesugar mod_summary tc_result
hscGenOutput compiler guts mod_summary mb_old_hash
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
--------------------------------------------------------------
-- Compilers
......@@ -423,6 +436,8 @@ hscOneShotCompiler =
, hscRecompile = genericHscRecompile hscOneShotCompiler
, hscBackend = genericHscBackend hscOneShotCompiler
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
hscWriteIface iface changed mod_summary
......@@ -455,6 +470,8 @@ hscBatchCompiler =
, hscRecompile = genericHscRecompile hscBatchCompiler
, hscBackend = genericHscBackend hscBatchCompiler
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, details)
<- hscSimpleIface tc_result mb_old_iface
......@@ -487,7 +504,11 @@ hscInteractiveCompiler =
, hscRecompile = genericHscRecompile hscInteractiveCompiler
, hscGenBootOutput = \_ _ _ -> panic "hscCompileInteractive: HsBootFile"
, hscBackend = genericHscBackend hscInteractiveCompiler
, hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
(iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
return (HscRecomp False Nothing, iface, details)
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify guts0
......@@ -517,12 +538,15 @@ hscNothingCompiler =
panic "hscCompileNothing: cannot do external core"
_otherwise -> do
tc_result <- hscFileFrontEnd mod_summary
hscGenBootOutput hscNothingCompiler tc_result mod_summary mb_old_hash
hscBackend hscNothingCompiler tc_result mod_summary mb_old_hash
, hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
, hscBackend = \tc_result _mod_summary mb_old_iface -> do
(iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
return (HscRecomp False (), iface, details)
, hscGenBootOutput = \_ _ _ ->
panic "hscCompileNothing: hscGenBootOutput should not be called"
, hscGenOutput = \_ _ _ ->
panic "hscCompileNothing: hscGenOutput should not be called"
}
......@@ -733,7 +757,8 @@ hscInteractive (iface, details, cgguts) mod_summary
------------------ Create f-x-dynamic C-side stuff ---
(_istub_h_exists, istub_c_exists)
<- outputForeignStubs dflags this_mod location foreign_stubs
return (HscRecomp istub_c_exists (comp_bc, mod_breaks), iface, details)
return (HscRecomp istub_c_exists (Just (comp_bc, mod_breaks))
, iface, details)
#else
hscInteractive _ _ = panic "GHC not compiled with interpreter"
#endif
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment