-- Interfaces for the compilation manager (interpreted/batch-mode)
preprocess,
- compile, CompResult(..),
+ compile,
link,
) where
-- 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)
= 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)
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
-- 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)
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
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
projects / ghc-hetmet.git / commitdiff