summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2019-11-26 10:45:45 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-11-29 08:25:28 -0500
commit7f695a20f5f9fe4952ca8cde45d73f3604a7cc29 (patch)
tree057027123853d3ff52c771c1671f8f150e18cd74 /compiler
parent6985e0fc4f6fb30c1effd356d87c1a0629aa9cd0 (diff)
downloadhaskell-7f695a20f5f9fe4952ca8cde45d73f3604a7cc29.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/DriverPipeline.hs44
-rw-r--r--compiler/main/HscMain.hs36
-rw-r--r--compiler/main/HscTypes.hs9
-rw-r--r--compiler/main/PipelineMonad.hs8
4 files changed, 51 insertions, 46 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index ff0186a56b..62a4826edb 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -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
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 3d2ac983a4..9daecdb550 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, 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
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 6bc090499f..3a5a0bbee1 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -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)
diff --git a/compiler/main/PipelineMonad.hs b/compiler/main/PipelineMonad.hs
index bdda19ceac..a3608ac4cd 100644
--- a/compiler/main/PipelineMonad.hs
+++ b/compiler/main/PipelineMonad.hs
@@ -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) }, ())