Skip to content

GitLab

Commit 099b2606 authored by Simon Marlow's avatar Simon Marlow
Browse files

refactoring: eliminate DriverPipeline.CompResult and GHC.upsweep_compile

parent e89cbb88
Hide whitespace changes
Inline Side-by-side
compiler/main/DriverPipeline.hs
View file @ 099b2606
......@@ -23,7 +23,7 @@ module DriverPipeline (
-- Interfaces for the compilation manager (interpreted/batch-mode)
preprocess,
compile, CompResult(..),
compile,
link,
) where
......@@ -93,36 +93,25 @@ preprocess dflags (filename, mb_phase) =
-- NB. No old interface can also mean that the source has changed.
compile :: HscEnv
-> ModSummary
-> Maybe Linkable -- Just linkable <=> source unchanged
-> Maybe ModIface -- Old interface, if available
-> Int -> Int
-> IO CompResult
data CompResult
= CompOK ModDetails -- New details
ModIface -- New iface
(Maybe Linkable) -- a Maybe, for the same reasons as hm_linkable
| CompErrs
compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
let dflags0 = ms_hspp_opts mod_summary
this_mod = ms_mod mod_summary
src_flavour = ms_hsc_src mod_summary
-> ModSummary -- summary for module being compiled
-> Int -> Int -- module N of M
-> Maybe ModIface -- old interface, if we have one
-> Maybe Linkable -- old linkable, if we have one
-> IO (Maybe HomeModInfo) -- the complete HomeModInfo, if successful
compile hsc_env summary mod_index nmods mb_old_iface maybe_old_linkable
= do
let dflags0 = ms_hspp_opts summary
this_mod = ms_mod summary
src_flavour = ms_hsc_src summary
have_object
| Just l <- maybe_old_linkable, isObjectLinkable l = True
| otherwise = False
-- FIXME: We need to know whether or not we're recompiling the file. Move this to HscMain?
--showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary)
let location = ms_location mod_summary
let location = ms_location summary
let input_fn = expectJust "compile:hs" (ml_hs_file location)
let input_fnpp = ms_hspp_file mod_summary
let input_fnpp = ms_hspp_file summary
debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
......@@ -158,21 +147,23 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
= do stub_o <- compileStub dflags' this_mod location
return [ DotO stub_o ]
handleBatch (HscNoRecomp, iface, details)
handleBatch HscNoRecomp
= ASSERT (isJust maybe_old_linkable)
return (CompOK details iface maybe_old_linkable)
handleBatch (HscRecomp hasStub, iface, details)
return maybe_old_linkable
handleBatch (HscRecomp hasStub)
| isHsBoot src_flavour
= do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
SysTools.touch dflags' "Touching object file"
object_filename
return (CompOK details iface Nothing)
return maybe_old_linkable
| otherwise
= do stub_unlinked <- getStubLinkable hasStub
(hs_unlinked, unlinked_time) <-
case hsc_lang of
HscNothing
-> return ([], ms_hs_date mod_summary)
-> return ([], ms_hs_date summary)
-- We're in --make mode: finish the compilation pipeline.
_other
-> do runPipeline StopLn dflags (output_fn,Nothing)
......@@ -184,15 +175,15 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
return ([DotO object_filename], o_time)
let linkable = LM unlinked_time this_mod
(hs_unlinked ++ stub_unlinked)
return (CompOK details iface (Just linkable))
return (Just linkable)
handleInterpreted (InteractiveNoRecomp, iface, details)
handleInterpreted InteractiveNoRecomp
= ASSERT (isJust maybe_old_linkable)
return (CompOK details iface maybe_old_linkable)
handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks, iface, details)
return maybe_old_linkable
handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks)
= do stub_unlinked <- getStubLinkable hasStub
let hs_unlinked = [BCOs comp_bc modBreaks]
unlinked_time = ms_hs_date mod_summary
unlinked_time = ms_hs_date summary
-- Why do we use the timestamp of the source file here,
-- rather than the current time? This works better in
-- the case where the local clock is out of sync
......@@ -201,22 +192,31 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
-- be out of date.
let linkable = LM unlinked_time this_mod
(hs_unlinked ++ stub_unlinked)
return (CompOK details iface (Just linkable))
return (Just linkable)
let runCompiler compiler handle
= do mbResult <- compiler hsc_env' mod_summary
source_unchanged old_iface
let -- runCompiler :: Compiler result -> (result -> Maybe Linkable)
-- -> IO (Maybe HomeModInfo)
runCompiler compiler handle
= do mbResult <- compiler hsc_env' summary source_unchanged mb_old_iface
(Just (mod_index, nmods))
case mbResult of
Nothing -> return CompErrs
Just result -> handle result
Nothing -> return Nothing
Just (result, iface, details) -> do
linkable <- handle result
return (Just HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = linkable })
-- run the compiler
case hsc_lang of
HscInterpreted
| isHsBoot src_flavour -> runCompiler hscCompileNothing handleBatch
| otherwise -> runCompiler hscCompileInteractive handleInterpreted
HscNothing -> runCompiler hscCompileNothing handleBatch
_other -> runCompiler hscCompileBatch handleBatch
HscInterpreted
| isHsBoot src_flavour ->
runCompiler hscCompileNothing handleBatch
| otherwise ->
runCompiler hscCompileInteractive handleInterpreted
HscNothing ->
runCompiler hscCompileNothing handleBatch
_other ->
runCompiler hscCompileBatch handleBatch
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
......
compiler/main/GHC.hs
View file @ 099b2606
......@@ -1181,12 +1181,10 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
iface = hm_iface hm_info
compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
compile_it = upsweep_compile hsc_env
summary' mod_index nmods mb_old_iface
compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
compile_it_discard_iface
= upsweep_compile hsc_env
summary' mod_index nmods Nothing
= compile hsc_env summary' mod_index nmods Nothing
in
case target of
......@@ -1248,27 +1246,6 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
compile_it Nothing
-- Run hsc to compile a module
upsweep_compile :: HscEnv -> ModSummary -> Int -> Int
-> Maybe ModIface -> Maybe Linkable -> IO (Maybe HomeModInfo)
upsweep_compile hsc_env summary mod_index nmods mb_old_iface mb_old_linkable
= do
compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
mod_index nmods
case compresult of
-- Compilation failed. Compile may still have updated the PCS, tho.
CompErrs -> return Nothing
-- Compilation "succeeded", and may or may not have returned a new
-- linkable (depending on whether compilation was actually performed
-- or not).
CompOK new_details new_iface new_linkable
-> do let new_info = HomeModInfo { hm_iface = new_iface,
hm_details = new_details,
hm_linkable = new_linkable }
return (Just new_info)
-- Filter modules in the HPT
retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
......
Supports Markdown
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