Commit 427f8a15 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Deduplicate one-shot/make compile paths.



Summary:
We had a duplicate copy of the code for --make and for -c
which was a pain.  The call graph looked something like this:

    compileOne -> genericHscCompileGetFrontendResult -> genericHscFrontend
                                   hscCompileOneShot ---^

with genericHscCompileGetFrontendResult and hscCompileOneShot
duplicating logic for deciding whether or not recompilation
was needed.

This patchset fixes it, so now everything goes through this call-chain:

    compileOne (--make entry point)
        Calls hscIncrementCompile, invokes the pipeline to do codegen
        and sets up linkables.
    hscIncrementalCompile (-c entry point)
        Calls hscIncrementalFrontend, and then simplifying,
        desugaring, and writing out the interface.
    hscIncrementalFrontend
        Performs recompilation avoidance, if recompilation needed,
        does parses typechecking.

I also cleaned up some of the MergeBoot nonsense by introducing
a FrontendResult type.

NB: this BREAKS #8101 again, because I can't unconditionally desugar
due to Haddock barfing on lint, see #10600
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, simonmar, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1302
parent 5ca1d312
...@@ -64,7 +64,6 @@ import MonadUtils ...@@ -64,7 +64,6 @@ import MonadUtils
import Platform import Platform
import TcRnTypes import TcRnTypes
import Hooks import Hooks
import MkIface
import Exception import Exception
import Data.IORef ( readIORef ) import Data.IORef ( readIORef )
...@@ -133,173 +132,90 @@ compileOne' :: Maybe TcGblEnv ...@@ -133,173 +132,90 @@ compileOne' :: Maybe TcGblEnv
compileOne' m_tc_result mHscMessage 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 maybe_old_linkable
source_modified0 source_modified0
| HsBootMerge <- ms_hsc_src summary
= do -- Do a boot merge instead! For now, something very simple
output_fn <- getOutputFilename next_phase
Temporary basename dflags next_phase (Just location)
e <- genericHscMergeRequirement mHscMessage
hsc_env summary mb_old_iface (mod_index, nmods)
case e of
-- TODO: dedup
Left iface ->
do details <- genModDetails hsc_env iface
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = maybe_old_linkable })
Right (iface0, mb_old_hash) ->
case hsc_lang of
HscInterpreted ->
do (iface, _no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
details <- genModDetails hsc_env iface
-- Merges don't need to link in any bytecode, unlike
-- HsSrcFiles.
let linkable = LM (ms_hs_date summary) this_mod []
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = Just linkable })
HscNothing ->
do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
details <- genModDetails hsc_env iface
when (gopt Opt_WriteInterface dflags) $
hscWriteIface dflags iface no_change summary
let linkable = LM (ms_hs_date summary) this_mod []
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = Just linkable })
_ ->
do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0
hscWriteIface dflags iface no_change summary
-- #10660: Use the pipeline instead of calling
-- compileEmptyStub directly, so -dynamic-too gets
-- handled properly
let mod_name = ms_mod_name summary
_ <- runPipeline StopLn hsc_env
(output_fn,
Just (HscOut src_flavour
mod_name HscUpdateBootMerge))
(Just basename)
Persistent
(Just location)
Nothing
details <- genModDetails hsc_env iface
o_time <- getModificationUTCTime object_filename
let linkable =
LM o_time this_mod [DotO object_filename]
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = Just linkable })
| otherwise
= do = do
debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp) debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
-- What file to generate the output into?
output_fn <- getOutputFilename next_phase
Temporary basename dflags next_phase (Just location)
e <- genericHscCompileGetFrontendResult
always_do_basic_recompilation_check
m_tc_result mHscMessage
hsc_env summary source_modified mb_old_iface (mod_index, nmods)
case e of
Left iface ->
do details <- genModDetails hsc_env iface
MASSERT(isJust maybe_old_linkable || isNoLink (ghcLink dflags))
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = maybe_old_linkable })
Right (tc_result, mb_old_hash) ->
-- run the compiler
case hsc_lang of
HscInterpreted ->
case ms_hsc_src summary of
HsBootFile ->
do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = Nothing })
_ -> do guts0 <- hscDesugar hsc_env summary tc_result
guts <- hscSimplify hsc_env guts0
(iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
(hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
stub_o <- case hasStub of
Nothing -> return []
Just stub_c -> do
stub_o <- compileStub hsc_env stub_c
return [DotO stub_o]
let hs_unlinked = [BCOs comp_bc modBreaks]
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
-- with the filesystem's clock. It's just as accurate:
-- if the source is modified, then the linkable will
-- be out of date.
let linkable = LM unlinked_time this_mod
(hs_unlinked ++ stub_o)
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = Just linkable })
HscNothing ->
do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
when (gopt Opt_WriteInterface dflags) $
hscWriteIface dflags iface changed summary
let linkable = if isHsBoot src_flavour
then Nothing
else Just (LM (ms_hs_date summary) this_mod [])
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
hm_linkable = linkable })
_ -> (status, hmi0) <- hscIncrementalCompile
case ms_hsc_src summary of always_do_basic_recompilation_check
HsBootMerge -> panic "This driver can't handle it" m_tc_result mHscMessage
HsBootFile -> hsc_env summary source_modified mb_old_iface (mod_index, nmods)
do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
hscWriteIface dflags iface changed summary case (status, hsc_lang) of
(HscUpToDate, _) ->
touchObjectFile dflags object_filename ASSERT( isJust maybe_old_linkable || isNoLink (ghcLink dflags) )
return hmi0 { hm_linkable = maybe_old_linkable }
return (HomeModInfo{ (HscNotGeneratingCode, HscNothing) ->
hm_details = details, let mb_linkable = if isHsBoot src_flavour
hm_iface = iface, then Nothing
hm_linkable = Nothing }) -- TODO: Questionable.
else Just (LM (ms_hs_date summary) this_mod [])
HsSrcFile -> in return hmi0 { hm_linkable = mb_linkable }
do guts0 <- hscDesugar hsc_env summary tc_result (HscNotGeneratingCode, _) -> panic "compileOne HscNotGeneratingCode"
guts <- hscSimplify hsc_env guts0 (_, HscNothing) -> panic "compileOne HscNothing"
(iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash (HscUpdateBoot, HscInterpreted) -> do
hscWriteIface dflags iface changed summary return hmi0
(HscUpdateBoot, _) -> do
-- We're in --make mode: finish the compilation pipeline. touchObjectFile dflags object_filename
let mod_name = ms_mod_name summary return hmi0
_ <- runPipeline StopLn hsc_env (HscUpdateBootMerge, HscInterpreted) ->
(output_fn, let linkable = LM (ms_hs_date summary) this_mod []
Just (HscOut src_flavour mod_name (HscRecomp cgguts summary))) in return hmi0 { hm_linkable = Just linkable }
(Just basename) (HscUpdateBootMerge, _) -> do
Persistent output_fn <- getOutputFilename next_phase
(Just location) Temporary basename dflags next_phase (Just location)
Nothing
-- The object filename comes from the ModLocation -- #10660: Use the pipeline instead of calling
o_time <- getModificationUTCTime object_filename -- compileEmptyStub directly, so -dynamic-too gets
let linkable = LM o_time this_mod [DotO object_filename] -- handled properly
_ <- runPipeline StopLn hsc_env
return (HomeModInfo{ hm_details = details, (output_fn,
hm_iface = iface, Just (HscOut src_flavour
hm_linkable = Just linkable }) mod_name HscUpdateBootMerge))
(Just basename)
Persistent
(Just location)
Nothing
o_time <- getModificationUTCTime object_filename
let linkable = LM o_time this_mod [DotO object_filename]
return hmi0 { hm_linkable = Just linkable }
(HscRecomp cgguts summary, HscInterpreted) -> do
(hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
stub_o <- case hasStub of
Nothing -> return []
Just stub_c -> do
stub_o <- compileStub hsc_env stub_c
return [DotO stub_o]
let hs_unlinked = [BCOs comp_bc modBreaks]
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
-- with the filesystem's clock. It's just as accurate:
-- if the source is modified, then the linkable will
-- be out of date.
let linkable = LM unlinked_time (ms_mod summary)
(hs_unlinked ++ stub_o)
return hmi0 { hm_linkable = Just linkable }
(HscRecomp cgguts summary, _) -> do
output_fn <- getOutputFilename next_phase
Temporary basename dflags next_phase (Just location)
-- We're in --make mode: finish the compilation pipeline.
_ <- runPipeline StopLn hsc_env
(output_fn,
Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
(Just basename)
Persistent
(Just location)
Nothing
-- The object filename comes from the ModLocation
o_time <- getModificationUTCTime object_filename
let linkable = LM o_time this_mod [DotO object_filename]
return hmi0 { hm_linkable = Just linkable }
where dflags0 = ms_hspp_opts summary where dflags0 = ms_hspp_opts summary
this_mod = ms_mod summary
src_flavour = ms_hsc_src summary
location = ms_location summary location = ms_location summary
input_fn = expectJust "compile:hs" (ml_hs_file location) input_fn = expectJust "compile:hs" (ml_hs_file location)
input_fnpp = ms_hspp_file summary input_fnpp = ms_hspp_file summary
...@@ -310,6 +226,13 @@ compileOne' m_tc_result mHscMessage ...@@ -310,6 +226,13 @@ compileOne' m_tc_result mHscMessage
isDynWay = any (== WayDyn) (ways dflags0) isDynWay = any (== WayDyn) (ways dflags0)
isProfWay = any (== WayProf) (ways dflags0) isProfWay = any (== WayProf) (ways dflags0)
src_flavour = ms_hsc_src summary
this_mod = ms_mod summary
mod_name = ms_mod_name summary
next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
object_filename = ml_obj_file location
-- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
-- the linker can correctly load the object files. -- the linker can correctly load the object files.
...@@ -329,15 +252,12 @@ compileOne' m_tc_result mHscMessage ...@@ -329,15 +252,12 @@ compileOne' m_tc_result mHscMessage
-- Figure out what lang we're generating -- Figure out what lang we're generating
hsc_lang = hscTarget dflags hsc_lang = hscTarget dflags
-- ... and what the next phase should be
next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
-- -fforce-recomp should also work with --make -- -fforce-recomp should also work with --make
force_recomp = gopt Opt_ForceRecomp dflags force_recomp = gopt Opt_ForceRecomp dflags
source_modified source_modified
| force_recomp = SourceModified | force_recomp = SourceModified
| otherwise = source_modified0 | otherwise = source_modified0
object_filename = ml_obj_file location
always_do_basic_recompilation_check = case hsc_lang of always_do_basic_recompilation_check = case hsc_lang of
HscInterpreted -> True HscInterpreted -> True
...@@ -1087,8 +1007,9 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 ...@@ -1087,8 +1007,9 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
ms_merge_imps = (False, []) } ms_merge_imps = (False, []) }
-- run the compiler! -- run the compiler!
result <- liftIO $ hscCompileOneShot hsc_env' let msg hsc_env _ what _ = oneShotMsg hsc_env what
mod_summary source_unchanged (result, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
mod_summary source_unchanged Nothing (1,1)
return (HscOut src_flavour mod_name result, return (HscOut src_flavour mod_name result,
panic "HscOut doesn't have an input filename") panic "HscOut doesn't have an input filename")
......
...@@ -14,7 +14,6 @@ module Hooks ( Hooks ...@@ -14,7 +14,6 @@ module Hooks ( Hooks
, tcForeignImportsHook , tcForeignImportsHook
, tcForeignExportsHook , tcForeignExportsHook
, hscFrontendHook , hscFrontendHook
, hscCompileOneShotHook
, hscCompileCoreExprHook , hscCompileCoreExprHook
, ghcPrimIfaceHook , ghcPrimIfaceHook
, runPhaseHook , runPhaseHook
...@@ -58,14 +57,12 @@ import Data.Maybe ...@@ -58,14 +57,12 @@ import Data.Maybe
emptyHooks :: Hooks emptyHooks :: Hooks
emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
Nothing
data Hooks = Hooks data Hooks = Hooks
{ dsForeignsHook :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr))) { dsForeignsHook :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
, tcForeignImportsHook :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt)) , tcForeignImportsHook :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
, tcForeignExportsHook :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt)) , tcForeignExportsHook :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
, hscFrontendHook :: Maybe (ModSummary -> Hsc TcGblEnv) , hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
, hscCompileOneShotHook :: Maybe (HscEnv -> ModSummary -> SourceModified -> IO HscStatus)
, hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue) , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue)
, ghcPrimIfaceHook :: Maybe ModIface , ghcPrimIfaceHook :: Maybe ModIface
, runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)) , runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
......
...@@ -19,10 +19,11 @@ ...@@ -19,10 +19,11 @@
-- from here on in (although it has mutable components, for the -- from here on in (although it has mutable components, for the
-- caches). -- caches).
-- --
-- Warning messages are dealt with consistently throughout this API: -- We use the Hsc monad to deal with warning messages consistently:
-- during compilation warnings are collected, and before any function -- specifically, while executing within an Hsc monad, warnings are
-- in @HscMain@ returns, the warnings are either printed, or turned -- collected. When a Hsc monad returns to an IO monad, the
-- into a real compialtion error if the @-Werror@ flag is enabled. -- warnings are printed, or compilation aborts if the @-Werror@
-- flag is enabled.
-- --
-- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000 -- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
-- --
...@@ -36,12 +37,11 @@ module HscMain ...@@ -36,12 +37,11 @@ module HscMain
-- * Compiling complete source files -- * Compiling complete source files
, Messager, batchMsg , Messager, batchMsg
, HscStatus (..) , HscStatus (..)
, hscCompileOneShot , hscIncrementalCompile
, hscCompileCmmFile , hscCompileCmmFile
, hscCompileCore , hscCompileCore
, genericHscCompileGetFrontendResult , hscIncrementalFrontend
, genericHscMergeRequirement
, genModDetails , genModDetails
, hscSimpleIface , hscSimpleIface
...@@ -58,12 +58,14 @@ module HscMain ...@@ -58,12 +58,14 @@ module HscMain
, makeSimpleDetails , makeSimpleDetails
, hscSimplify -- ToDo, shouldn't really export this , hscSimplify -- ToDo, shouldn't really export this
-- * Safe Haskell
, hscCheckSafe
, hscGetSafe
-- * Support for interactive evaluation -- * Support for interactive evaluation
, hscParseIdentifier , hscParseIdentifier
, hscTcRcLookupName , hscTcRcLookupName
, hscTcRnGetInfo , hscTcRnGetInfo
, hscCheckSafe
, hscGetSafe
#ifdef GHCI #ifdef GHCI
, hscIsGHCiMonad , hscIsGHCiMonad
, hscGetModuleInterface , hscGetModuleInterface
...@@ -513,73 +515,38 @@ This is the only thing that isn't caught by the type-system. ...@@ -513,73 +515,38 @@ This is the only thing that isn't caught by the type-system.
type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO () type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO ()
-- | Analogous to 'genericHscCompileGetFrontendResult', this function -- | This function runs GHC's frontend with recompilation
-- calls 'hscMergeFrontEnd' if recompilation is necessary. It does -- avoidance. Specifically, it checks if recompilation is needed,
-- not write out the resulting 'ModIface' (see 'compileOne'). -- and if it is, it parses and typechecks the input module.
-- TODO: maybe fold this 'genericHscCompileGetFrontendResult' into -- It does not write out the results of typechecking (See
-- some higher-order function -- compileOne and hscIncrementalCompile).
genericHscMergeRequirement :: hscIncrementalFrontend :: Bool -- always do basic recompilation check?
Maybe Messager -> Maybe TcGblEnv
-> HscEnv -> Maybe Messager
-> ModSummary -> ModSummary
-> Maybe ModIface -- Old interface, if available -> SourceModified
-> (Int,Int) -- (i,n) = module i of n (for msgs) -> Maybe ModIface -- Old interface, if available
-> IO (Either ModIface (ModIface, Maybe Fingerprint)) -> (Int,Int) -- (i,n) = module i of n (for msgs)
genericHscMergeRequirement mHscMessage -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
hsc_env mod_summary mb_old_iface mod_index = do
let msg what = case mHscMessage of hscIncrementalFrontend
Just hscMessage ->
hscMessage hsc_env mod_index what mod_summary
Nothing -> return ()
skip iface = do
msg UpToDate
return (Left iface)
-- TODO: hook this
compile mb_old_hash reason = do
msg reason
r <- hscMergeFrontEnd hsc_env mod_summary
return $ Right (r, mb_old_hash)
(recomp_reqd, mb_checked_iface)
<- {-# SCC "checkOldIface" #-}
checkOldIface hsc_env mod_summary
SourceUnmodified mb_old_iface
case mb_checked_iface of
Just iface | not (recompileRequired recomp_reqd) -> skip iface
_ -> compile (fmap mi_iface_hash mb_checked_iface) recomp_reqd
-- | This function runs 'genericHscFrontend' if recompilation is necessary.
-- It does not write out the results of typechecking (see 'compileOne').
genericHscCompileGetFrontendResult ::
Bool -- always do basic recompilation check?
-> Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface -- Old interface, if available
-> (Int,Int) -- (i,n) = module i of n (for msgs)
-> IO (Either ModIface (TcGblEnv, Maybe Fingerprint))
genericHscCompileGetFrontendResult
always_do_basic_recompilation_check m_tc_result always_do_basic_recompilation_check m_tc_result
mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index mHscMessage mod_summary source_modified mb_old_iface mod_index
= do = do
hsc_env <- getHscEnv
let msg what = case mHscMessage of let msg what = case mHscMessage of
Just hscMessage -> hscMessage hsc_env mod_index what mod_summary Just hscMessage -> hscMessage hsc_env mod_index what mod_summary
Nothing -> return () Nothing -> return ()
skip iface = do skip iface = do
msg UpToDate liftIO $ msg UpToDate
return $ Left iface return $ Left iface
compile mb_old_hash reason = do compile mb_old_hash reason = do
msg reason liftIO $ msg reason
tc_result <- runHsc hsc_env $ genericHscFrontend mod_summary result <- genericHscFrontend mod_summary
return $ Right (tc_result, mb_old_hash) return $ Right (result, mb_old_hash)
stable = case source_modified of stable = case source_modified of
SourceUnmodifiedAndStable -> True SourceUnmodifiedAndStable -> True
...@@ -588,11 +555,11 @@ genericHscCompileGetFrontendResult ...@@ -588,11 +555,11 @@ genericHscCompileGetFrontendResult
case m_tc_result of case m_tc_result of
Just tc_result Just tc_result
| not always_do_basic_recompilation_check -> | not always_do_basic_recompilation_check ->
return $ Right (tc_result, Nothing) return $ Right (FrontendTypecheck tc_result, Nothing)
_ -> do _ -> do
(recomp_reqd, mb_checked_iface) (recomp_reqd, mb_checked_iface)
<- {-# SCC "checkOldIface" #-} <- {-# SCC "checkOldIface" #-}
checkOldIface hsc_env mod_summary liftIO $ checkOldIface hsc_env mod_summary
source_modified mb_old_iface source_modified mb_old_iface
-- save the interface that comes back from checkOldIface. -- save the interface that comes back from checkOldIface.
-- In one-shot mode we don't have the old iface until this -- In one-shot mode we don't have the old iface until this
...@@ -624,101 +591,149 @@ genericHscCompileGetFrontendResult ...@@ -624,101 +591,149 @@ genericHscCompileGetFrontendResult
case m_tc_result of case m_tc_result of
Nothing -> compile mb_old_hash recomp_reqd Nothing -> compile mb_old_hash recomp_reqd
Just tc_result -> Just tc_result ->
return $ Right (tc_result, mb_old_hash) return $ Right (FrontendTypecheck tc_result, mb_old_hash)
genericHscFrontend :: ModSummary -> Hsc TcGblEnv genericHscFrontend :: ModSummary -> Hsc FrontendResult
genericHscFrontend mod_summary = genericHscFrontend mod_summary =
getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary) getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary)
genericHscFrontend' :: ModSummary -> Hsc TcGblEnv genericHscFrontend' :: ModSummary -> Hsc FrontendResult
genericHscFrontend' mod_summary = hscFileFrontEnd mod_summary genericHscFrontend' mod_summary
| ms_hsc_src mod_summary == HsBootMerge
= FrontendMerge `fmap` hscMergeFrontEnd mod_summary
| otherwise
= FrontendTypecheck `fmap` hscFileFrontEnd mod_summary
-------------------------------------------------------------- --------------------------------------------------------------
-- Compilers -- Compilers
-------------------------------------------------------------- --------------------------------------------------------------
hscCompileOneShot :: HscEnv
-> ModSummary
-> SourceModified
-> IO HscStatus
hscCompileOneShot env =
lookupHook hscCompileOneShotHook hscCompileOneShot' (hsc_dflags env) env
-- Compile Haskell/boot in OneShot mode. -- Compile Haskell/boot in OneShot mode.
hscCompileOneShot' :: HscEnv hscIncrementalCompile :: Bool
-> ModSummary -> Maybe TcGblEnv
-> SourceModified -> Maybe Messager
-> IO HscStatus -> HscEnv
hscCompileOneShot' hsc_env mod_summary src_changed -> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int,Int)
-- HomeModInfo does not contain linkable, since we haven't