summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2019-10-16 12:42:12 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-10-29 03:47:44 -0400
commit3bd3456f144fa801a409147a80673f88360c16a2 (patch)
treee0e790f4e5953a6b9daba83a5e96a4f212b629d0
parentebee0d6b902ee50467e8471a3676ba652679b27d (diff)
downloadhaskell-3bd3456f144fa801a409147a80673f88360c16a2.tar.gz
Refactor HscRecomp constructors:
Make it evident in the constructors that the final interface is only available when HscStatus is not HscRecomp. (When HscStatus == HscRecomp we need to finish the compilation to get the final interface) `Maybe ModIface` return value of hscIncrementalCompile and the partial `expectIface` function are removed.
-rw-r--r--compiler/main/DriverPipeline.hs51
-rw-r--r--compiler/main/HscMain.hs26
-rw-r--r--compiler/main/HscTypes.hs15
3 files changed, 45 insertions, 47 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 1a3ced0fd9..18f22d6d78 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -150,21 +150,18 @@ compileOne' :: Maybe TcGblEnv
-> IO HomeModInfo -- ^ the complete HomeModInfo, if successful
compileOne' m_tc_result mHscMessage
- hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+ hsc_env0 summary mod_index nmods mb_old_iface mb_old_linkable
source_modified0
= do
debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
-- Run the pipeline up to codeGen (so everything up to, but not including, STG)
- (status, hmi_details, m_iface) <- hscIncrementalCompile
+ (status, hmi_details) <- hscIncrementalCompile
always_do_basic_recompilation_check
m_tc_result mHscMessage
hsc_env summary source_modified mb_old_iface (mod_index, nmods)
- -- Build HMI from the results of the Core pipeline.
- let coreHmi m_linkable = HomeModInfo (expectIface m_iface) hmi_details m_linkable
-
let flags = hsc_dflags hsc_env0
in do unless (gopt Opt_KeepHiFiles flags) $
addFilesToClean flags TFL_CurrentModule $
@@ -174,27 +171,27 @@ compileOne' m_tc_result mHscMessage
[ml_obj_file $ ms_location summary]
case (status, hsc_lang) of
- (HscUpToDate, _) ->
+ (HscUpToDate iface, _) ->
-- TODO recomp014 triggers this assert. What's going on?!
- -- ASSERT( isJust maybe_old_linkable || isNoLink (ghcLink dflags) )
- return $! coreHmi maybe_old_linkable
- (HscNotGeneratingCode, HscNothing) ->
+ -- ASSERT( isJust mb_old_linkable || isNoLink (ghcLink dflags) )
+ return $! HomeModInfo iface hmi_details mb_old_linkable
+ (HscNotGeneratingCode iface, HscNothing) ->
let mb_linkable = if isHsBootOrSig src_flavour
then Nothing
-- TODO: Questionable.
else Just (LM (ms_hs_date summary) this_mod [])
- in return $! coreHmi mb_linkable
- (HscNotGeneratingCode, _) -> panic "compileOne HscNotGeneratingCode"
+ in return $! HomeModInfo iface hmi_details mb_linkable
+ (HscNotGeneratingCode _, _) -> panic "compileOne HscNotGeneratingCode"
(_, HscNothing) -> panic "compileOne HscNothing"
- (HscUpdateBoot, HscInterpreted) -> do
- return $! coreHmi Nothing
- (HscUpdateBoot, _) -> do
+ (HscUpdateBoot iface, HscInterpreted) -> do
+ return $! HomeModInfo iface hmi_details Nothing
+ (HscUpdateBoot iface, _) -> do
touchObjectFile dflags object_filename
- return $! coreHmi Nothing
- (HscUpdateSig, HscInterpreted) ->
+ return $! HomeModInfo iface hmi_details Nothing
+ (HscUpdateSig iface, HscInterpreted) -> do
let !linkable = LM (ms_hs_date summary) this_mod []
- in return $! coreHmi (Just linkable)
- (HscUpdateSig, _) -> do
+ return $! HomeModInfo iface hmi_details (Just linkable)
+ (HscUpdateSig iface, _) -> do
output_fn <- getOutputFilename next_phase
(Temporary TFL_CurrentModule) basename dflags
next_phase (Just location)
@@ -206,14 +203,14 @@ compileOne' m_tc_result mHscMessage
(output_fn,
Nothing,
Just (HscOut src_flavour
- mod_name HscUpdateSig))
+ mod_name (HscUpdateSig iface)))
(Just basename)
Persistent
(Just location)
[]
o_time <- getModificationUTCTime object_filename
let !linkable = LM o_time this_mod [DotO object_filename]
- return $! coreHmi $ Just linkable
+ return $! HomeModInfo iface hmi_details (Just linkable)
(HscRecomp cgguts summary iface_gen, HscInterpreted) -> do
-- In interpreted mode the regular codeGen backend is not run
-- so we generate a interface without codeGen info.
@@ -273,10 +270,6 @@ compileOne' m_tc_result mHscMessage
return $! HomeModInfo iface hmi_details (Just linkable)
where dflags0 = ms_hspp_opts summary
-
- expectIface :: Maybe ModIface -> ModIface
- expectIface = expectJust "compileOne': Interface expected "
-
this_mod = ms_mod summary
location = ms_location summary
input_fn = expectJust "compile:hs" (ml_hs_file location)
@@ -1143,7 +1136,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
-- run the compiler!
let msg hsc_env _ what _ = oneShotMsg hsc_env what
- (result, _, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
+ (result, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
mod_summary source_unchanged Nothing (1,1)
return (HscOut src_flavour mod_name result,
@@ -1158,21 +1151,21 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
next_phase = hscPostBackendPhase src_flavour hsc_lang
case result of
- HscNotGeneratingCode ->
+ HscNotGeneratingCode _ ->
return (RealPhase StopLn,
panic "No output filename from Hsc when no-code")
- HscUpToDate ->
+ 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 (RealPhase StopLn, o_file)
- HscUpdateBoot ->
+ 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
return (RealPhase StopLn, o_file)
- HscUpdateSig ->
+ HscUpdateSig _ ->
do -- We need to create a REAL but empty .o file
-- because we are going to attempt to put it in a library
PipeState{hsc_env=hsc_env'} <- getPipeState
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 83aa4264f1..9ed2710ee8 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -727,7 +727,7 @@ hscIncrementalCompile :: Bool
-> SourceModified
-> Maybe ModIface
-> (Int,Int)
- -> IO (HscStatus, ModDetails, Maybe ModIface)
+ -> IO (HscStatus, ModDetails)
hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index
= do
@@ -768,7 +768,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
-- in make mode, since this HMI will go into the HPT.
details <- genModDetails hsc_env' iface
return details
- return (HscUpToDate, details, Just iface)
+ return (HscUpToDate iface, details)
-- We finished type checking. (mb_old_hash is the hash of
-- the interface that existed on disk; it's possible we had
-- to retypecheck but the resulting interface is exactly
@@ -791,7 +791,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
finish :: ModSummary
-> TcGblEnv
-> Maybe Fingerprint
- -> Hsc (HscStatus, ModDetails, Maybe ModIface)
+ -> Hsc (HscStatus, ModDetails)
finish summary tc_result mb_old_hash = do
hsc_env <- getHscEnv
let dflags = hsc_dflags hsc_env
@@ -799,19 +799,20 @@ finish summary tc_result mb_old_hash = do
hsc_src = ms_hsc_src summary
should_desugar =
ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile
- mk_simple_iface :: Hsc (HscStatus, ModDetails, Maybe ModIface)
+ mk_simple_iface :: Hsc (HscStatus, ModDetails)
mk_simple_iface = do
- let hsc_status =
- case (target, hsc_src) of
- (HscNothing, _) -> HscNotGeneratingCode
- (_, HsBootFile) -> HscUpdateBoot
- (_, HsigFile) -> HscUpdateSig
- _ -> panic "finish"
(iface, no_change, details) <- liftIO $
hscSimpleIface hsc_env tc_result mb_old_hash
liftIO $ hscMaybeWriteIface dflags iface no_change (ms_location summary)
- return (hsc_status, details, Just iface)
+
+ let hsc_status =
+ case (target, hsc_src) of
+ (HscNothing, _) -> HscNotGeneratingCode iface
+ (_, HsBootFile) -> HscUpdateBoot iface
+ (_, HsigFile) -> HscUpdateSig iface
+ _ -> panic "finish"
+ return (hsc_status, details)
-- we usually desugar even when we are not generating code, otherwise
-- we would miss errors thrown by the desugaring (see #10600). The only
@@ -849,8 +850,7 @@ finish summary tc_result mb_old_hash = do
let no_change = mb_old_hash == Just (mi_iface_hash (mi_final_exts final_iface))
return (final_iface, no_change)
- return ( HscRecomp cg_guts summary iface_gen
- , details, Nothing )
+ return ( HscRecomp cg_guts summary iface_gen, details )
else mk_simple_iface
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index eeaa2c2f1d..4b251af436 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -231,11 +231,16 @@ import Control.DeepSeq
-- | Status of a compilation to hard-code
data HscStatus
- = HscNotGeneratingCode -- ^ Nothing to do.
- | HscUpToDate -- ^ Nothing to do because code already exists.
- | HscUpdateBoot -- ^ Update boot file result.
- | HscUpdateSig -- ^ Generate signature file (backpack)
- | HscRecomp -- ^ Recompile this module.
+ -- | Nothing to do.
+ = HscNotGeneratingCode ModIface
+ -- | Nothing to do because code already exists.
+ | HscUpToDate ModIface
+ -- | Update boot file result.
+ | HscUpdateBoot ModIface
+ -- | Generate signature file (backpack)
+ | HscUpdateSig ModIface
+ -- | Recompile this module.
+ | HscRecomp
{ hscs_guts :: CgGuts
-- ^ Information for the code generator.
, hscs_summary :: ModSummary