Commit 3bd3456f authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

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.
parent ebee0d6b
......@@ -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
......
......@@ -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
......
......@@ -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
......
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