Commit 7f695a20 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

Pass ModDetails with (partial) ModIface in HscStatus

(Partial) ModIface and ModDetails are generated at the same time, but
they're passed differently: ModIface is passed in HscStatus consturctors
while ModDetails is returned in a tuple. This refactors ModDetails
passing so that it's passed around with ModIface in HscStatus
constructors. This makes the code more consistent and hopefully easier
to understand: ModIface and ModDetails are really very closely related.
It makes sense to treat them the same way.
parent 6985e0fc
......@@ -160,7 +160,7 @@ compileOne' m_tc_result mHscMessage
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, plugin_dflags) <- hscIncrementalCompile
(status, plugin_dflags) <- hscIncrementalCompile
always_do_basic_recompilation_check
m_tc_result mHscMessage
hsc_env summary source_modified mb_old_iface (mod_index, nmods)
......@@ -178,27 +178,27 @@ compileOne' m_tc_result mHscMessage
let hsc_env' = hsc_env{ hsc_dflags = plugin_dflags }
case (status, hsc_lang) of
(HscUpToDate iface, _) ->
(HscUpToDate iface hmi_details, _) ->
-- TODO recomp014 triggers this assert. What's going on?!
-- ASSERT( isJust mb_old_linkable || isNoLink (ghcLink dflags) )
return $! HomeModInfo iface hmi_details mb_old_linkable
(HscNotGeneratingCode iface, HscNothing) ->
(HscNotGeneratingCode iface hmi_details, HscNothing) ->
let mb_linkable = if isHsBootOrSig src_flavour
then Nothing
-- TODO: Questionable.
else Just (LM (ms_hs_date summary) this_mod [])
in return $! HomeModInfo iface hmi_details mb_linkable
(HscNotGeneratingCode _, _) -> panic "compileOne HscNotGeneratingCode"
(HscNotGeneratingCode _ _, _) -> panic "compileOne HscNotGeneratingCode"
(_, HscNothing) -> panic "compileOne HscNothing"
(HscUpdateBoot iface, HscInterpreted) -> do
(HscUpdateBoot iface hmi_details, HscInterpreted) -> do
return $! HomeModInfo iface hmi_details Nothing
(HscUpdateBoot iface, _) -> do
(HscUpdateBoot iface hmi_details, _) -> do
touchObjectFile dflags object_filename
return $! HomeModInfo iface hmi_details Nothing
(HscUpdateSig iface, HscInterpreted) -> do
(HscUpdateSig iface hmi_details, HscInterpreted) -> do
let !linkable = LM (ms_hs_date summary) this_mod []
return $! HomeModInfo iface hmi_details (Just linkable)
(HscUpdateSig iface, _) -> do
(HscUpdateSig iface hmi_details, _) -> do
output_fn <- getOutputFilename next_phase
(Temporary TFL_CurrentModule) basename dflags
next_phase (Just location)
......@@ -210,7 +210,7 @@ compileOne' m_tc_result mHscMessage
(output_fn,
Nothing,
Just (HscOut src_flavour
mod_name (HscUpdateSig iface)))
mod_name (HscUpdateSig iface hmi_details)))
(Just basename)
Persistent
(Just location)
......@@ -220,6 +220,7 @@ compileOne' m_tc_result mHscMessage
return $! HomeModInfo iface hmi_details (Just linkable)
(HscRecomp { hscs_guts = cgguts,
hscs_mod_location = mod_location,
hscs_mod_details = hmi_details,
hscs_partial_iface = partial_iface,
hscs_old_iface_hash = mb_old_iface_hash,
hscs_iface_dflags = iface_dflags }, HscInterpreted) -> do
......@@ -252,7 +253,7 @@ compileOne' m_tc_result mHscMessage
(Temporary TFL_CurrentModule)
basename dflags next_phase (Just location)
-- We're in --make mode: finish the compilation pipeline.
(_, _, Just iface) <- runPipeline StopLn hsc_env'
(_, _, Just (iface, details)) <- runPipeline StopLn hsc_env'
(output_fn,
Nothing,
Just (HscOut src_flavour mod_name status))
......@@ -263,7 +264,7 @@ compileOne' m_tc_result mHscMessage
-- The object filename comes from the ModLocation
o_time <- getModificationUTCTime object_filename
let !linkable = LM o_time this_mod [DotO object_filename]
return $! HomeModInfo iface hmi_details (Just linkable)
return $! HomeModInfo iface details (Just linkable)
where dflags0 = ms_hspp_opts summary
this_mod = ms_mod summary
......@@ -602,7 +603,7 @@ runPipeline
-> PipelineOutput -- ^ Output filename
-> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
-> [FilePath] -- ^ foreign objects
-> IO (DynFlags, FilePath, Maybe ModIface)
-> IO (DynFlags, FilePath, Maybe (ModIface, ModDetails))
-- ^ (final flags, output filename, interface)
runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
mb_basename output maybe_loc foreign_os
......@@ -697,7 +698,7 @@ runPipeline'
-> FilePath -- ^ Input filename
-> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
-> [FilePath] -- ^ foreign objects, if we have one
-> IO (DynFlags, FilePath, Maybe ModIface)
-> IO (DynFlags, FilePath, Maybe (ModIface, ModDetails))
-- ^ (final flags, output filename, interface)
runPipeline' start_phase hsc_env env input_fn
maybe_loc foreign_os
......@@ -1134,7 +1135,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
-- run the compiler!
let msg hsc_env _ what _ = oneShotMsg hsc_env what
(result, _mod_details, plugin_dflags) <-
(result, plugin_dflags) <-
liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
mod_summary source_unchanged Nothing (1,1)
......@@ -1153,21 +1154,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
......@@ -1177,6 +1178,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
return (RealPhase StopLn, o_file)
HscRecomp { hscs_guts = cgguts,
hscs_mod_location = mod_location,
hscs_mod_details = mod_details,
hscs_partial_iface = partial_iface,
hscs_old_iface_hash = mb_old_iface_hash,
hscs_iface_dflags = iface_dflags }
......@@ -1188,7 +1190,11 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
hscGenHardCode hsc_env' cgguts mod_location output_fn
final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface)
setIface final_iface
-- TODO(osa): ModIface and ModDetails need to be in sync,
-- but we only generate ModIface with the backend info. See
-- !2100 for more discussion on this. This will be fixed
-- with !1304 or !2100.
setIface final_iface mod_details
-- See Note [Writing interface files]
let if_dflags = dflags `gopt_unset` Opt_BuildDynamicToo
......
......@@ -727,7 +727,7 @@ hscIncrementalCompile :: Bool
-> SourceModified
-> Maybe ModIface
-> (Int,Int)
-> IO (HscStatus, ModDetails, DynFlags)
-> IO (HscStatus, DynFlags)
hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index
= do
......@@ -768,14 +768,14 @@ 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 iface, details, dflags)
return (HscUpToDate iface details, dflags)
-- 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
-- the same.)
Right (FrontendTypecheck tc_result, mb_old_hash) -> do
(status, mb_old_hash) <- finish mod_summary tc_result mb_old_hash
return (status, mb_old_hash, dflags)
status <- finish mod_summary tc_result mb_old_hash
return (status, dflags)
-- Runs the post-typechecking frontend (desugar and simplify). We want to
-- generate most of the interface as late as possible. This gets us up-to-date
......@@ -792,7 +792,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
finish :: ModSummary
-> TcGblEnv
-> Maybe Fingerprint
-> Hsc (HscStatus, ModDetails)
-> Hsc HscStatus
finish summary tc_result mb_old_hash = do
hsc_env <- getHscEnv
let dflags = hsc_dflags hsc_env
......@@ -800,20 +800,18 @@ 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)
mk_simple_iface :: Hsc HscStatus
mk_simple_iface = do
(iface, mb_old_iface_hash, details) <- liftIO $
hscSimpleIface hsc_env tc_result mb_old_hash
liftIO $ hscMaybeWriteIface dflags iface mb_old_iface_hash (ms_location summary)
let hsc_status =
case (target, hsc_src) of
(HscNothing, _) -> HscNotGeneratingCode iface
(_, HsBootFile) -> HscUpdateBoot iface
(_, HsigFile) -> HscUpdateSig iface
_ -> panic "finish"
return (hsc_status, details)
return $ case (target, hsc_src) of
(HscNothing, _) -> HscNotGeneratingCode iface details
(_, HsBootFile) -> HscUpdateBoot iface details
(_, HsigFile) -> HscUpdateSig iface details
_ -> panic "finish"
if should_desugar
then do
......@@ -839,12 +837,12 @@ finish summary tc_result mb_old_hash = do
-- See Note [Avoiding space leaks in toIface*] for details.
force (mkPartialIface hsc_env details desugared_guts)
return ( HscRecomp { hscs_guts = cg_guts,
hscs_mod_location = ms_location summary,
hscs_partial_iface = partial_iface,
hscs_old_iface_hash = mb_old_hash,
hscs_iface_dflags = dflags },
details )
return HscRecomp { hscs_guts = cg_guts,
hscs_mod_location = ms_location summary,
hscs_mod_details = details,
hscs_partial_iface = partial_iface,
hscs_old_iface_hash = mb_old_hash,
hscs_iface_dflags = dflags }
else mk_simple_iface
......
......@@ -232,19 +232,20 @@ import Control.DeepSeq
-- | Status of a compilation to hard-code
data HscStatus
-- | Nothing to do.
= HscNotGeneratingCode ModIface
= HscNotGeneratingCode ModIface ModDetails
-- | Nothing to do because code already exists.
| HscUpToDate ModIface
| HscUpToDate ModIface ModDetails
-- | Update boot file result.
| HscUpdateBoot ModIface
| HscUpdateBoot ModIface ModDetails
-- | Generate signature file (backpack)
| HscUpdateSig ModIface
| HscUpdateSig ModIface ModDetails
-- | Recompile this module.
| HscRecomp
{ hscs_guts :: CgGuts
-- ^ Information for the code generator.
, hscs_mod_location :: !ModLocation
-- ^ Module info
, hscs_mod_details :: !ModDetails
, hscs_partial_iface :: !PartialModIface
-- ^ Partial interface
, hscs_old_iface_hash :: !(Maybe Fingerprint)
......
......@@ -72,7 +72,7 @@ data PipeState = PipeState {
-- ^ additional object files resulting from compiling foreign
-- code. They come from two sources: foreign stubs, and
-- add{C,Cxx,Objc,Objcxx}File from template haskell
iface :: Maybe ModIface
iface :: Maybe (ModIface, ModDetails)
-- ^ Interface generated by HscOut phase. Only available after the
-- phase runs.
}
......@@ -80,7 +80,7 @@ data PipeState = PipeState {
pipeStateDynFlags :: PipeState -> DynFlags
pipeStateDynFlags = hsc_dflags . hsc_env
pipeStateModIface :: PipeState -> Maybe ModIface
pipeStateModIface :: PipeState -> Maybe (ModIface, ModDetails)
pipeStateModIface = iface
data PipelineOutput
......@@ -118,5 +118,5 @@ setForeignOs :: [FilePath] -> CompPipeline ()
setForeignOs os = P $ \_env state ->
return (state{ foreign_os = os }, ())
setIface :: ModIface -> CompPipeline ()
setIface iface = P $ \_env state -> return (state{ iface = Just iface }, ())
setIface :: ModIface -> ModDetails -> CompPipeline ()
setIface iface details = P $ \_env state -> return (state{ iface = Just (iface, details) }, ())
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