Commit 0358066f authored by ian@well-typed.com's avatar ian@well-typed.com

A couple more small refactorings

parent de3a50bd
......@@ -189,7 +189,7 @@ compileOne' m_tc_result mHscMessage
_ -> do guts0 <- hscDesugar hsc_env' summary tc_result
guts <- hscSimplify hsc_env' guts0
(iface, _changed, details, cgguts) <- hscNormalIface hsc_env' guts mb_old_hash
HscRecomp hasStub (comp_bc, modBreaks) <- hscInteractive hsc_env' cgguts summary
(hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env' cgguts summary
stub_o <- case hasStub of
Nothing -> return []
......@@ -1027,31 +1027,29 @@ runPhase (Hsc src_flavour) input_fn dflags0
mod_summary source_unchanged
case result of
Nothing
-> do liftIO $ touchObjectFile dflags' o_file
-- The .o file must have a later modification date
-- than the source file (else we wouldn't get Nothing)
-- but we touch it anyway, to keep 'make' happy (we think).
return (StopLn, o_file)
(Just (HscRecomp hasStub mOutputFilename))
-> do case hasStub of
Nothing -> return ()
Just stub_c ->
do stub_o <- liftIO $ compileStub hsc_env' stub_c
setStubO stub_o
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
outputFilename <-
case mOutputFilename of
Just x -> return x
Nothing ->
if isHsBoot src_flavour
then do liftIO $ touchObjectFile dflags' o_file
whenGeneratingDynamicToo dflags' $ do
let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
liftIO $ touchObjectFile dflags' dyn_o_file
return o_file
else return $ panic "runPhase Hsc: No output filename"
HscNotGeneratingCode ->
return (next_phase,
panic "No output filename from Hsc when no-code")
HscUpToDate ->
do liftIO $ touchObjectFile dflags' o_file
-- The .o file must have a later modification date
-- than the source file (else we wouldn't get Nothing)
-- but we touch it anyway, to keep 'make' happy (we think).
return (StopLn, o_file)
HscUpdateBoot ->
do -- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
liftIO $ touchObjectFile dflags' o_file
whenGeneratingDynamicToo dflags' $ do
let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
liftIO $ touchObjectFile dflags' dyn_o_file
return (next_phase, o_file)
HscRecomp outputFilename mStub
-> do case mStub of
Nothing -> return ()
Just stub_c ->
do stub_o <- liftIO $ compileStub hsc_env' stub_c
setStubO stub_o
return (next_phase, outputFilename)
......
......@@ -525,13 +525,16 @@ This is the only thing that isn't caught by the type-system.
-- | Status of a compilation to hard-code
data HscStatus a
= HscRecomp
data HscStatus
= HscNotGeneratingCode
| HscUpToDate
| HscUpdateBoot
| HscRecomp
FilePath
(Maybe FilePath) -- 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
type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO ()
......@@ -620,7 +623,7 @@ genericHscFrontend mod_summary
hscCompileOneShot :: HscEnv
-> ModSummary
-> SourceModified
-> IO (Maybe (HscStatus (Maybe FilePath)))
-> IO HscStatus
hscCompileOneShot hsc_env mod_summary src_changed
= do
-- One-shot mode needs a knot-tying mutable variable for interface
......@@ -633,27 +636,27 @@ hscCompileOneShot hsc_env mod_summary src_changed
skip = do msg UpToDate
dumpIfaceStats hsc_env'
return Nothing
return HscUpToDate
compile mb_old_hash reason = runHsc hsc_env' $ do
liftIO $ msg reason
tc_result <- genericHscFrontend mod_summary
dflags <- getDynFlags
case hscTarget dflags of
HscNothing -> return (Just (HscRecomp Nothing Nothing))
HscNothing -> 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 (Just (HscRecomp Nothing Nothing))
return HscUpdateBoot
_ ->
do guts0 <- hscDesugar' (ms_location mod_summary) tc_result
guts <- hscSimplify' guts0
(iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash
liftIO $ hscWriteIface dflags iface changed mod_summary
(outputFilename, hasStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary
return (Just (HscRecomp hasStub (Just outputFilename)))
(outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary
return $ HscRecomp outputFilename mStub
stable = case src_changed of
SourceUnmodifiedAndStable -> True
......@@ -1194,7 +1197,7 @@ hscGenHardCode hsc_env cgguts mod_summary = do
hscInteractive :: HscEnv
-> CgGuts
-> ModSummary
-> IO (HscStatus (CompiledByteCode, ModBreaks))
-> IO (Maybe FilePath, CompiledByteCode, ModBreaks)
#ifdef GHCI
hscInteractive hsc_env cgguts mod_summary = do
let dflags = hsc_dflags hsc_env
......@@ -1221,7 +1224,7 @@ hscInteractive hsc_env cgguts mod_summary = do
------------------ 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))
return (istub_c_exists, comp_bc, mod_breaks)
#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