[commit: ghc] master: A couple more small refactorings (0358066)
Ian Lynagh
igloo at earth.li
Sat Mar 9 21:02:37 CET 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0358066f91473e04b2e09e853492ba4f8bc98e9b
>---------------------------------------------------------------
commit 0358066f91473e04b2e09e853492ba4f8bc98e9b
Author: Ian Lynagh <ian at well-typed.com>
Date: Thu Mar 7 20:21:09 2013 +0000
A couple more small refactorings
>---------------------------------------------------------------
compiler/main/DriverPipeline.hs | 50 ++++++++++++++++++++---------------------
compiler/main/HscMain.hs | 25 ++++++++++++---------
2 files changed, 38 insertions(+), 37 deletions(-)
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index f2fba96..5bd0694 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -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)
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 83be1c0..975ff9d 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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
More information about the ghc-commits
mailing list