{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Driver.Pipeline (
oneShot, compileFile,
preprocess,
compileOne, compileOne',
compileForeign, compileEmptyStub,
link, linkingNeeded, checkLinkInfo,
PipeEnv(..), mkPipeEnv, phaseOutputFilenameNew,
TPhase(..), runPhase,
hscPostBackendPhase,
TPipelineClass, MonadUse(..),
preprocessPipeline, fullPipeline, hscPipeline, hscBackendPipeline, hscPostBackendPipeline,
hscGenBackendPipeline, asPipeline, viaCPipeline, cmmCppPipeline, cmmPipeline, jsPipeline,
llvmPipeline, llvmLlcPipeline, llvmManglePipeline, pipelineStart,
runPipeline
) where
import GHC.Prelude
import GHC.Platform
import GHC.Utils.Monad ( MonadIO(liftIO), mapMaybeM )
import GHC.Driver.Main
import GHC.Driver.Env hiding ( Hsc )
import GHC.Driver.Errors
import GHC.Driver.Errors.Types
import GHC.Driver.Pipeline.Monad
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.StgToJS
import GHC.Driver.Phases
import GHC.Driver.Pipeline.Execute
import GHC.Driver.Pipeline.Phases
import GHC.Driver.Session
import GHC.Driver.Backend
import GHC.Driver.Ppr
import GHC.Driver.Hooks
import GHC.Platform.Ways
import GHC.SysTools
import GHC.SysTools.Cpp
import GHC.Utils.TmpFs
import GHC.Linker.ExtraObj
import GHC.Linker.Static
import GHC.Linker.Static.Utils
import GHC.Linker.Types
import GHC.StgToJS.Linker.Linker
import GHC.Utils.Outputable
import GHC.Utils.Error
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Utils.Exception as Exception
import GHC.Utils.Logger
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.FastString ( mkFastString )
import GHC.Data.StringBuffer ( hPutStringBuffer )
import GHC.Data.Maybe ( expectJust )
import GHC.Iface.Make ( mkFullIface )
import GHC.Runtime.Loader ( initializePlugins )
import GHC.Types.Basic ( SuccessFlag(..), ForeignSrcLang(..) )
import GHC.Types.Error ( singleMessage, getMessages, mkSimpleUnknownDiagnostic, defaultDiagnosticOpts )
import GHC.Types.ForeignStubs (ForeignStubs (NoStubs))
import GHC.Types.Target
import GHC.Types.SrcLoc
import GHC.Types.SourceFile
import GHC.Types.SourceError
import GHC.Unit
import GHC.Unit.Env
import GHC.Unit.Finder
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Deps
import GHC.Unit.Home.ModInfo
import System.Directory
import System.FilePath
import System.IO
import Control.Monad
import qualified Control.Monad.Catch as MC (handle)
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time ( getCurrentTime )
import GHC.Iface.Recomp
import GHC.Types.Unique.DSet
type P m = TPipelineClass TPhase m
preprocess :: HscEnv
-> FilePath
-> Maybe InputFileBuffer
-> Maybe Phase
-> IO (Either DriverMessages (DynFlags, FilePath))
preprocess :: HscEnv
-> FilePath
-> Maybe InputFileBuffer
-> Maybe Phase
-> IO (Either DriverMessages (DynFlags, FilePath))
preprocess HscEnv
hsc_env FilePath
input_fn Maybe InputFileBuffer
mb_input_buf Maybe Phase
mb_phase =
(SourceError -> IO (Either DriverMessages (DynFlags, FilePath)))
-> IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath))
forall (m :: * -> *) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (\SourceError
err -> Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath)))
-> Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$ DriverMessages -> Either DriverMessages (DynFlags, FilePath)
forall a b. a -> Either a b
Left (DriverMessages -> Either DriverMessages (DynFlags, FilePath))
-> DriverMessages -> Either DriverMessages (DynFlags, FilePath)
forall a b. (a -> b) -> a -> b
$ Messages GhcMessage -> DriverMessages
to_driver_messages (Messages GhcMessage -> DriverMessages)
-> Messages GhcMessage -> DriverMessages
forall a b. (a -> b) -> a -> b
$ SourceError -> Messages GhcMessage
srcErrorMessages SourceError
err) (IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath)))
-> IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$
(GhcException -> IO (Either DriverMessages (DynFlags, FilePath)))
-> IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath))
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
MC.handle GhcException -> IO (Either DriverMessages (DynFlags, FilePath))
handler (IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath)))
-> IO (Either DriverMessages (DynFlags, FilePath))
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$
((DynFlags, FilePath)
-> Either DriverMessages (DynFlags, FilePath))
-> IO (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags, FilePath) -> Either DriverMessages (DynFlags, FilePath)
forall a b. b -> Either a b
Right (IO (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath)))
-> IO (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$ do
Bool -> SDoc -> IO ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Maybe Phase -> Bool
forall a. Maybe a -> Bool
isJust Maybe Phase
mb_phase Bool -> Bool -> Bool
|| FilePath -> Bool
isHaskellSrcFilename FilePath
input_fn) (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
input_fn)
input_fn_final <- IO FilePath
mkInputFn
let preprocess_pipeline = PipeEnv -> HscEnv -> FilePath -> HookedUse (DynFlags, FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
preprocessPipeline PipeEnv
pipe_env (PipeEnv -> HscEnv -> HscEnv
setDumpPrefix PipeEnv
pipe_env HscEnv
hsc_env) FilePath
input_fn_final
runPipeline (hsc_hooks hsc_env) preprocess_pipeline
where
srcspan :: SrcSpan
srcspan = SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> SrcLoc -> SrcSpan
forall a b. (a -> b) -> a -> b
$ FastString -> Int -> Int -> SrcLoc
mkSrcLoc (FilePath -> FastString
mkFastString FilePath
input_fn) Int
1 Int
1
handler :: GhcException -> IO (Either DriverMessages (DynFlags, FilePath))
handler (ProgramError FilePath
msg) =
Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath)))
-> Either DriverMessages (DynFlags, FilePath)
-> IO (Either DriverMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$ DriverMessages -> Either DriverMessages (DynFlags, FilePath)
forall a b. a -> Either a b
Left (DriverMessages -> Either DriverMessages (DynFlags, FilePath))
-> DriverMessages -> Either DriverMessages (DynFlags, FilePath)
forall a b. (a -> b) -> a -> b
$ MsgEnvelope DriverMessage -> DriverMessages
forall e. MsgEnvelope e -> Messages e
singleMessage (MsgEnvelope DriverMessage -> DriverMessages)
-> MsgEnvelope DriverMessage -> DriverMessages
forall a b. (a -> b) -> a -> b
$
SrcSpan -> DriverMessage -> MsgEnvelope DriverMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
mkPlainErrorMsgEnvelope SrcSpan
srcspan (DriverMessage -> MsgEnvelope DriverMessage)
-> DriverMessage -> MsgEnvelope DriverMessage
forall a b. (a -> b) -> a -> b
$
UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage
DriverUnknownMessage (UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage)
-> UnknownDiagnostic (DiagnosticOpts DriverMessage)
-> DriverMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage
-> UnknownDiagnostic (DiagnosticOpts DriverMessage)
forall a b.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> UnknownDiagnostic b
mkSimpleUnknownDiagnostic (DiagnosticMessage
-> UnknownDiagnostic (DiagnosticOpts DriverMessage))
-> DiagnosticMessage
-> UnknownDiagnostic (DiagnosticOpts DriverMessage)
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
msg
handler GhcException
ex = GhcException -> IO (Either DriverMessages (DynFlags, FilePath))
forall a. GhcException -> IO a
throwGhcExceptionIO GhcException
ex
to_driver_messages :: Messages GhcMessage -> Messages DriverMessage
to_driver_messages :: Messages GhcMessage -> DriverMessages
to_driver_messages Messages GhcMessage
msgs = case (GhcMessage -> Maybe DriverMessage)
-> Messages GhcMessage -> Maybe DriverMessages
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Messages a -> f (Messages b)
traverse GhcMessage -> Maybe DriverMessage
to_driver_message Messages GhcMessage
msgs of
Maybe DriverMessages
Nothing -> FilePath -> SDoc -> DriverMessages
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"non-driver message in preprocess"
([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ DiagnosticOpts GhcMessage -> Bag (MsgEnvelope GhcMessage) -> [SDoc]
forall e.
Diagnostic e =>
DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc]
pprMsgEnvelopeBagWithLoc (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @GhcMessage) (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages Messages GhcMessage
msgs))
Just DriverMessages
msgs' -> DriverMessages
msgs'
to_driver_message :: GhcMessage -> Maybe DriverMessage
to_driver_message = \case
GhcDriverMessage DriverMessage
msg
-> DriverMessage -> Maybe DriverMessage
forall a. a -> Maybe a
Just DriverMessage
msg
GhcPsMessage (PsHeaderMessage PsHeaderMessage
msg)
-> DriverMessage -> Maybe DriverMessage
forall a. a -> Maybe a
Just (PsMessage -> DriverMessage
DriverPsHeaderMessage (PsHeaderMessage -> PsMessage
PsHeaderMessage PsHeaderMessage
msg))
GhcMessage
_ -> Maybe DriverMessage
forall a. Maybe a
Nothing
pipe_env :: PipeEnv
pipe_env = StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
StopPreprocess FilePath
input_fn Maybe Phase
mb_phase (TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_GhcSession)
mkInputFn :: IO FilePath
mkInputFn =
case Maybe InputFileBuffer
mb_input_buf of
Just InputFileBuffer
input_buf -> do
fn <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName (HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(DynFlags -> TempDir
tmpDir (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))
TempFileLifetime
TFL_CurrentModule
(FilePath
"buf_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PipeEnv -> FilePath
src_suffix PipeEnv
pipe_env)
hdl <- openBinaryFile fn WriteMode
hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}"
hPutStringBuffer hdl input_buf
hClose hdl
return fn
Maybe InputFileBuffer
Nothing -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
compileOne :: HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> HomeModLinkable
-> IO HomeModInfo
compileOne :: HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> HomeModLinkable
-> IO HomeModInfo
compileOne = Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> HomeModLinkable
-> IO HomeModInfo
compileOne' (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
batchMsg)
compileOne' :: Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> HomeModLinkable
-> IO HomeModInfo
compileOne' :: Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> HomeModLinkable
-> IO HomeModInfo
compileOne' Maybe Messager
mHscMessage
HscEnv
hsc_env0 ModSummary
summary Int
mod_index Int
nmods Maybe ModIface
mb_old_iface HomeModLinkable
mb_old_linkable
= do
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
2 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"compile: input file" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
input_fnpp)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHiFiles DynFlags
lcl_dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
addFilesToClean TmpFs
tmpfs TempFileLifetime
TFL_CurrentModule ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ModLocation -> FilePath
ml_hi_file (ModLocation -> FilePath) -> ModLocation -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
summary]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepOFiles DynFlags
lcl_dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
addFilesToClean TmpFs
tmpfs TempFileLifetime
TFL_GhcSession ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ModLocation -> FilePath
ml_obj_file (ModLocation -> FilePath) -> ModLocation -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
summary]
plugin_hsc_env <- HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env
let pipe_env = StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
NoStop FilePath
input_fn Maybe Phase
forall a. Maybe a
Nothing PipelineOutput
pipelineOutput
status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary
mb_old_iface mb_old_linkable (mod_index, nmods)
let pipeline = PipeEnv
-> (HscEnv, ModSummary, HscRecompStatus)
-> HookedUse (ModIface, HomeModLinkable)
forall (m :: * -> *).
P m =>
PipeEnv
-> (HscEnv, ModSummary, HscRecompStatus)
-> m (ModIface, HomeModLinkable)
hscPipeline PipeEnv
pipe_env (PipeEnv -> HscEnv -> HscEnv
setDumpPrefix PipeEnv
pipe_env HscEnv
plugin_hsc_env, ModSummary
upd_summary, HscRecompStatus
status)
(iface, linkable) <- runPipeline (hsc_hooks plugin_hsc_env) pipeline
details <- initModDetails plugin_hsc_env iface
linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable)
return $! HomeModInfo iface details (linkable { homeMod_bytecode = linkable' })
where lcl_dflags :: DynFlags
lcl_dflags = ModSummary -> DynFlags
ms_hspp_opts ModSummary
summary
location :: ModLocation
location = ModSummary -> ModLocation
ms_location ModSummary
summary
input_fn :: FilePath
input_fn = FilePath -> Maybe FilePath -> FilePath
forall a. HasDebugCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"compile:hs" (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location)
input_fnpp :: FilePath
input_fnpp = ModSummary -> FilePath
ms_hspp_file ModSummary
summary
pipelineOutput :: PipelineOutput
pipelineOutput = Backend -> PipelineOutput
backendPipelineOutput Backend
bcknd
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env0
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env0
basename :: FilePath
basename = FilePath -> FilePath
dropExtension FilePath
input_fn
current_dir :: FilePath
current_dir = FilePath -> FilePath
takeDirectory FilePath
basename
old_paths :: IncludeSpecs
old_paths = DynFlags -> IncludeSpecs
includePaths DynFlags
lcl_dflags
loadAsByteCode :: Bool
loadAsByteCode
| Just Target { targetAllowObjCode :: Target -> Bool
targetAllowObjCode = Bool
obj } <- ModSummary -> [Target] -> Maybe Target
findTarget ModSummary
summary (HscEnv -> [Target]
hsc_targets HscEnv
hsc_env0)
, Bool -> Bool
not Bool
obj
= Bool
True
| Bool
otherwise = Bool
False
(Backend
bcknd, DynFlags
dflags3)
| Bool
loadAsByteCode
= ( Backend
interpreterBackend
, DynFlags -> GeneralFlag -> DynFlags
gopt_set (DynFlags
lcl_dflags { backend = interpreterBackend }) GeneralFlag
Opt_ForceRecomp
)
| Bool
otherwise
= (DynFlags -> Backend
backend DynFlags
dflags, DynFlags
lcl_dflags)
dflags :: DynFlags
dflags = DynFlags
dflags3 { includePaths = offsetIncludePaths dflags3 $ addImplicitQuoteInclude old_paths [current_dir] }
upd_summary :: ModSummary
upd_summary = ModSummary
summary { ms_hspp_opts = dflags }
hsc_env :: HscEnv
hsc_env = HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags HscEnv
hsc_env0
link :: GhcLink
-> Logger
-> TmpFs
-> FinderCache
-> Hooks
-> DynFlags
-> UnitEnv
-> Bool
-> Maybe (RecompileRequired -> IO ())
-> HomePackageTable
-> IO SuccessFlag
link :: GhcLink
-> Logger
-> TmpFs
-> FinderCache
-> Hooks
-> DynFlags
-> UnitEnv
-> Bool
-> Maybe (RecompileRequired -> IO ())
-> HomePackageTable
-> IO SuccessFlag
link GhcLink
ghcLink Logger
logger TmpFs
tmpfs FinderCache
fc Hooks
hooks DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking Maybe (RecompileRequired -> IO ())
mHscMessage HomePackageTable
hpt =
case Hooks
-> Maybe
(GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook Hooks
hooks of
Maybe
(GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
Nothing -> case GhcLink
ghcLink of
GhcLink
NoLink -> SuccessFlag -> IO SuccessFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
GhcLink
LinkBinary -> IO SuccessFlag
normal_link
GhcLink
LinkStaticLib -> IO SuccessFlag
normal_link
GhcLink
LinkDynLib -> IO SuccessFlag
normal_link
GhcLink
LinkMergedObj -> IO SuccessFlag
normal_link
GhcLink
LinkInMemory
| PlatformMisc -> Bool
platformMisc_ghcWithInterpreter (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dflags
-> SuccessFlag -> IO SuccessFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
| Bool
otherwise
-> GhcLink -> IO SuccessFlag
forall a. GhcLink -> a
panicBadLink GhcLink
LinkInMemory
Just GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
h -> GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
h GhcLink
ghcLink DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
where
normal_link :: IO SuccessFlag
normal_link = Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> Bool
-> Maybe (RecompileRequired -> IO ())
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs FinderCache
fc DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking Maybe (RecompileRequired -> IO ())
mHscMessage HomePackageTable
hpt
panicBadLink :: GhcLink -> a
panicBadLink :: forall a. GhcLink -> a
panicBadLink GhcLink
other = FilePath -> a
forall a. HasCallStack => FilePath -> a
panic (FilePath
"link: GHC not built to link this way: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
GhcLink -> FilePath
forall a. Show a => a -> FilePath
show GhcLink
other)
link' :: Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> Bool
-> Maybe (RecompileRequired -> IO ())
-> HomePackageTable
-> IO SuccessFlag
link' :: Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> Bool
-> Maybe (RecompileRequired -> IO ())
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs FinderCache
fc DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking Maybe (RecompileRequired -> IO ())
mHscMessager HomePackageTable
hpt
| Bool
batch_attempt_linking
= do
let
staticLink :: Bool
staticLink = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
LinkStaticLib -> Bool
True
GhcLink
_ -> Bool
False
home_mod_infos :: [HomeModInfo]
home_mod_infos = HomePackageTable -> [HomeModInfo]
eltsHpt HomePackageTable
hpt
pkg_deps :: [UnitId]
pkg_deps = Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toList
(Set UnitId -> [UnitId]) -> Set UnitId -> [UnitId]
forall a b. (a -> b) -> a -> b
$ [Set UnitId] -> Set UnitId
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
([Set UnitId] -> Set UnitId) -> [Set UnitId] -> Set UnitId
forall a b. (a -> b) -> a -> b
$ (HomeModInfo -> Set UnitId) -> [HomeModInfo] -> [Set UnitId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dependencies -> Set UnitId
dep_direct_pkgs (Dependencies -> Set UnitId)
-> (HomeModInfo -> Dependencies) -> HomeModInfo -> Set UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps (ModIface -> Dependencies)
-> (HomeModInfo -> ModIface) -> HomeModInfo -> Dependencies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface)
([HomeModInfo] -> [Set UnitId]) -> [HomeModInfo] -> [Set UnitId]
forall a b. (a -> b) -> a -> b
$ [HomeModInfo]
home_mod_infos
linkables :: [Linkable]
linkables = (HomeModInfo -> Linkable) -> [HomeModInfo] -> [Linkable]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe Linkable -> Linkable
forall a. HasDebugCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"link"(Maybe Linkable -> Linkable)
-> (HomeModInfo -> Maybe Linkable) -> HomeModInfo -> Linkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> Maybe Linkable
homeModInfoObject) [HomeModInfo]
home_mod_infos
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"link: hmi ..." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((HomeModInfo -> SDoc) -> [HomeModInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> SDoc) -> (HomeModInfo -> Module) -> HomeModInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (ModIface -> Module)
-> (HomeModInfo -> ModIface) -> HomeModInfo -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface) [HomeModInfo]
home_mod_infos))
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"link: linkables are ..." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Linkable -> SDoc) -> [Linkable] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Linkable]
linkables))
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"link: pkg deps are ..." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((UnitId -> SDoc) -> [UnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [UnitId]
pkg_deps))
if GhcLink -> Bool
isNoLink (DynFlags -> GhcLink
ghcLink DynFlags
dflags)
then do Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"link(batch): linking omitted (-c flag given).")
SuccessFlag -> IO SuccessFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
else do
let obj_files :: [FilePath]
obj_files = (Linkable -> [FilePath]) -> [Linkable] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Linkable -> [FilePath]
linkableObjs [Linkable]
linkables
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
arch_os :: ArchOS
arch_os = Platform -> ArchOS
platformArchOS Platform
platform
exe_file :: FilePath
exe_file = ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName ArchOS
arch_os Bool
staticLink (DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags)
linking_needed <- Logger
-> DynFlags
-> UnitEnv
-> Bool
-> [Linkable]
-> [UnitId]
-> IO RecompileRequired
linkingNeeded Logger
logger DynFlags
dflags UnitEnv
unit_env Bool
staticLink [Linkable]
linkables [UnitId]
pkg_deps
forM_ mHscMessager $ \RecompileRequired -> IO ()
hscMessage -> RecompileRequired -> IO ()
hscMessage RecompileRequired
linking_needed
if not (gopt Opt_ForceRecomp dflags) && (linking_needed == UpToDate)
then do debugTraceMsg logger 2 (text exe_file <+> text "is up to date, linking not required.")
return Succeeded
else do
case ghcLink dflags of
GhcLink
LinkBinary
| Backend -> Bool
backendUseJSLinker (DynFlags -> Backend
backend DynFlags
dflags) -> Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkJSBinary Logger
logger TmpFs
tmpfs FinderCache
fc DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
| Bool
otherwise -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
GhcLink
LinkStaticLib -> Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkStaticLib Logger
logger DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
GhcLink
LinkDynLib -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLibCheck Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
GhcLink
other -> GhcLink -> IO ()
forall a. GhcLink -> a
panicBadLink GhcLink
other
debugTraceMsg logger 3 (text "link: done")
return Succeeded
| Bool
otherwise
= do Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"link(batch): upsweep (partially) failed OR" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
" Main.main not exported; not linking.")
SuccessFlag -> IO SuccessFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
linkJSBinary :: Logger -> TmpFs -> FinderCache -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkJSBinary :: Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkJSBinary Logger
logger TmpFs
tmpfs FinderCache
fc DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps = do
let lc_cfg :: JSLinkConfig
lc_cfg = DynFlags -> JSLinkConfig
initJSLinkConfig DynFlags
dflags
let cfg :: StgToJSConfig
cfg = DynFlags -> StgToJSConfig
initStgToJSConfig DynFlags
dflags
FinderCache
-> JSLinkConfig
-> StgToJSConfig
-> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
jsLinkBinary FinderCache
fc JSLinkConfig
lc_cfg StgToJSConfig
cfg Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO RecompileRequired
linkingNeeded :: Logger
-> DynFlags
-> UnitEnv
-> Bool
-> [Linkable]
-> [UnitId]
-> IO RecompileRequired
linkingNeeded Logger
logger DynFlags
dflags UnitEnv
unit_env Bool
staticLink [Linkable]
linkables [UnitId]
pkg_deps = do
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
unit_state :: UnitState
unit_state = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
arch_os :: ArchOS
arch_os = Platform -> ArchOS
platformArchOS Platform
platform
exe_file :: FilePath
exe_file = ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName ArchOS
arch_os Bool
staticLink (DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags)
e_exe_time <- IO UTCTime -> IO (Either IOException UTCTime)
forall a. IO a -> IO (Either IOException a)
tryIO (IO UTCTime -> IO (Either IOException UTCTime))
-> IO UTCTime -> IO (Either IOException UTCTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO UTCTime
getModificationUTCTime FilePath
exe_file
case e_exe_time of
Left IOException
_ -> RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ CompileReason -> RecompileRequired
NeedsRecompile CompileReason
MustCompile
Right UTCTime
t -> do
let extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
(errs,extra_times) <- (FilePath -> IO (Either IOException UTCTime))
-> [FilePath] -> IO ([IOException], [UTCTime])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m (Either b c)) -> [a] -> m ([b], [c])
partitionWithM (IO UTCTime -> IO (Either IOException UTCTime)
forall a. IO a -> IO (Either IOException a)
tryIO (IO UTCTime -> IO (Either IOException UTCTime))
-> (FilePath -> IO UTCTime)
-> FilePath
-> IO (Either IOException UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO UTCTime
getModificationUTCTime) [FilePath]
extra_ld_inputs
let obj_times = (Linkable -> UTCTime) -> [Linkable] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Linkable -> UTCTime
linkableTime [Linkable]
linkables [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. [a] -> [a] -> [a]
++ [UTCTime]
extra_times
if not (null errs) || any (t <) obj_times
then return $ needsRecompileBecause ObjectsChanged
else do
let pkg_hslibs UniqDSet UnitId
acc UnitId
uid
| UnitId
uid UnitId -> UniqDSet UnitId -> Bool
forall a. Uniquable a => a -> UniqDSet a -> Bool
`elementOfUniqDSet` UniqDSet UnitId
acc = UniqDSet UnitId
acc
| Just UnitInfo
c <- UnitState -> UnitId -> Maybe UnitInfo
lookupUnitId UnitState
unit_state UnitId
uid =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' @[] UniqDSet UnitId -> UnitId -> UniqDSet UnitId
pkg_hslibs (UniqDSet UnitId -> UnitId -> UniqDSet UnitId
forall a. Uniquable a => UniqDSet a -> a -> UniqDSet a
addOneToUniqDSet UniqDSet UnitId
acc UnitId
uid) (UnitInfo -> [UnitId]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
unitDepends UnitInfo
c)
| Bool
otherwise = UniqDSet UnitId
acc
all_pkg_deps = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' @[] UniqDSet UnitId -> UnitId -> UniqDSet UnitId
pkg_hslibs UniqDSet UnitId
forall a. UniqDSet a
emptyUniqDSet [UnitId]
pkg_deps
let pkg_hslibs = [ (Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo
c], FilePath
lib)
| Just UnitInfo
c <- (UnitId -> Maybe UnitInfo) -> [UnitId] -> [Maybe UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> UnitId -> Maybe UnitInfo
lookupUnitId UnitState
unit_state) (UniqDSet UnitId -> [UnitId]
forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet UnitId
all_pkg_deps),
FilePath
lib <- GhcNameVersion -> Ways -> UnitInfo -> [FilePath]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags) UnitInfo
c ]
pkg_libfiles <- mapM (uncurry (findHSLib platform (ways dflags))) pkg_hslibs
if any isNothing pkg_libfiles then return $ needsRecompileBecause LibraryChanged else do
(lib_errs,lib_times) <- partitionWithM (tryIO . getModificationUTCTime) (catMaybes pkg_libfiles)
if not (null lib_errs) || any (t <) lib_times
then return $ needsRecompileBecause LibraryChanged
else do
res <- checkLinkInfo logger dflags unit_env pkg_deps exe_file
if res
then return $ needsRecompileBecause FlagsChanged
else return UpToDate
findHSLib :: Platform -> Ways -> [String] -> String -> IO (Maybe FilePath)
findHSLib :: Platform -> Ways -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findHSLib Platform
platform Ways
ws [FilePath]
dirs FilePath
lib = do
let batch_lib_file :: FilePath
batch_lib_file = if Ways
ws Ways -> Way -> Bool
`hasNotWay` Way
WayDyn
then FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib FilePath -> FilePath -> FilePath
<.> FilePath
"a"
else Platform -> FilePath -> FilePath
platformSOName Platform
platform FilePath
lib
found <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
batch_lib_file) [FilePath]
dirs)
case found of
[] -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
(FilePath
x:[FilePath]
_) -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x)
oneShot :: HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()
oneShot :: HscEnv -> StopPhase -> [(FilePath, Maybe Phase)] -> IO ()
oneShot HscEnv
orig_hsc_env StopPhase
stop_phase [(FilePath, Maybe Phase)]
srcs = do
hsc_env <- HscEnv -> IO HscEnv
initializePlugins HscEnv
orig_hsc_env
o_files <- mapMaybeM (compileFile hsc_env stop_phase) srcs
case stop_phase of
StopPhase
StopPreprocess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
StopPhase
StopC -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
StopPhase
StopAs -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
StopPhase
NoStop -> HscEnv -> [FilePath] -> IO ()
doLink HscEnv
hsc_env [FilePath]
o_files
compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath)
compileFile :: HscEnv
-> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath)
compileFile HscEnv
hsc_env StopPhase
stop_phase (FilePath
src, Maybe Phase
mb_phase) = do
let offset_file :: FilePath
offset_file = DynFlags -> FilePath -> FilePath
augmentByWorkingDirectory DynFlags
dflags FilePath
src
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
mb_o_file :: Maybe FilePath
mb_o_file = DynFlags -> Maybe FilePath
outputFile DynFlags
dflags
ghc_link :: GhcLink
ghc_link = DynFlags -> GhcLink
ghcLink DynFlags
dflags
notStopPreprocess :: Bool
notStopPreprocess | StopPhase
StopPreprocess <- StopPhase
stop_phase = Bool
False
| StopPhase
_ <- StopPhase
stop_phase = Bool
True
output :: PipelineOutput
output
| Bool -> Bool
not (Backend -> Bool
backendGeneratesCode (DynFlags -> Backend
backend DynFlags
dflags)), Bool
notStopPreprocess = PipelineOutput
NoOutputFile
| StopPhase
NoStop <- StopPhase
stop_phase, Bool -> Bool
not (GhcLink -> Bool
isNoLink GhcLink
ghc_link) = PipelineOutput
Persistent
| Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
mb_o_file = PipelineOutput
SpecificFile
| Bool
otherwise = PipelineOutput
Persistent
pipe_env :: PipeEnv
pipe_env = StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
stop_phase FilePath
offset_file Maybe Phase
mb_phase PipelineOutput
output
pipeline :: HookedUse (Maybe FilePath)
pipeline = PipeEnv
-> HscEnv -> FilePath -> Maybe Phase -> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath)
pipelineStart PipeEnv
pipe_env (PipeEnv -> HscEnv -> HscEnv
setDumpPrefix PipeEnv
pipe_env HscEnv
hsc_env) FilePath
offset_file Maybe Phase
mb_phase
exists <- FilePath -> IO Bool
doesFileExist FilePath
offset_file
when (not exists) $
throwGhcExceptionIO (CmdLineError ("does not exist: " ++ offset_file))
runPipeline (hsc_hooks hsc_env) pipeline
doLink :: HscEnv -> [FilePath] -> IO ()
doLink :: HscEnv -> [FilePath] -> IO ()
doLink HscEnv
hsc_env [FilePath]
o_files = do
let
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
NoLink -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GhcLink
LinkBinary
| Backend -> Bool
backendUseJSLinker (DynFlags -> Backend
backend DynFlags
dflags)
-> Logger
-> TmpFs
-> FinderCache
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkJSBinary Logger
logger TmpFs
tmpfs FinderCache
fc DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files []
| Bool
otherwise -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files []
GhcLink
LinkStaticLib -> Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkStaticLib Logger
logger DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files []
GhcLink
LinkDynLib -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLibCheck Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files []
GhcLink
LinkMergedObj
| Just FilePath
out <- DynFlags -> Maybe FilePath
outputFile DynFlags
dflags
, let objs :: [FilePath]
objs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
-> HscEnv -> [FilePath] -> FilePath -> IO ()
joinObjectFiles HscEnv
hsc_env ([FilePath]
o_files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
objs) FilePath
out
| Bool
otherwise -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
panic FilePath
"Output path must be specified for LinkMergedObj"
GhcLink
other -> GhcLink -> IO ()
forall a. GhcLink -> a
panicBadLink GhcLink
other
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign HscEnv
_ ForeignSrcLang
RawObject FilePath
object_file = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
object_file
compileForeign HscEnv
hsc_env ForeignSrcLang
lang FilePath
stub_c = do
let pipeline :: PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
pipeline = case ForeignSrcLang
lang of
ForeignSrcLang
LangC -> Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
Cc
ForeignSrcLang
LangCxx -> Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
Ccxx
ForeignSrcLang
LangObjc -> Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
Cobjc
ForeignSrcLang
LangObjcxx -> Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
Cobjcxx
ForeignSrcLang
LangAsm -> \PipeEnv
pe HscEnv
hsc_env Maybe ModLocation
ml FilePath
fp -> Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
asPipeline Bool
True PipeEnv
pe HscEnv
hsc_env Maybe ModLocation
ml FilePath
fp
ForeignSrcLang
LangJs -> \PipeEnv
pe HscEnv
hsc_env Maybe ModLocation
ml FilePath
fp -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> HookedUse FilePath -> HookedUse (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> HookedUse FilePath
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
foreignJsPipeline PipeEnv
pe HscEnv
hsc_env Maybe ModLocation
ml FilePath
fp
pipe_env :: PipeEnv
pipe_env = StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
NoStop FilePath
stub_c Maybe Phase
forall a. Maybe a
Nothing (TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_GhcSession)
res <- Hooks -> HookedUse (Maybe FilePath) -> IO (Maybe FilePath)
forall a. Hooks -> HookedUse a -> IO a
runPipeline (HscEnv -> Hooks
hsc_hooks HscEnv
hsc_env) (PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
pipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
stub_c)
case res of
Maybe FilePath
Nothing -> FilePath -> SDoc -> IO FilePath
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"compileForeign" (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
stub_c)
Just FilePath
fp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
compileEmptyStub :: DynFlags
-> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
compileEmptyStub DynFlags
dflags HscEnv
hsc_env FilePath
basename ModLocation
location ModuleName
mod_name = do
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
case Backend -> DefunctionalizedCodeOutput
backendCodeOutput (DynFlags -> Backend
backend DynFlags
dflags) of
DefunctionalizedCodeOutput
JSCodeOutput -> do
empty_stub <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule FilePath
"js"
let src = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"= 0;"
writeFile empty_stub (showSDoc dflags (pprCode src))
let pipe_env = (StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
NoStop FilePath
empty_stub Maybe Phase
forall a. Maybe a
Nothing PipelineOutput
Persistent) { src_basename = basename}
pipeline = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> HookedUse FilePath -> HookedUse (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> HookedUse FilePath
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
foreignJsPipeline PipeEnv
pipe_env HscEnv
hsc_env (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location) FilePath
empty_stub
_ <- runPipeline (hsc_hooks hsc_env) pipeline
pure ()
DefunctionalizedCodeOutput
_ -> do
empty_stub <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule FilePath
"c"
let src = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"int" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"= 0;"
writeFile empty_stub (showSDoc dflags (pprCode src))
let pipe_env = (StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
NoStop FilePath
empty_stub Maybe Phase
forall a. Maybe a
Nothing PipelineOutput
Persistent) { src_basename = basename}
pipeline = Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> HookedUse (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
HCc PipeEnv
pipe_env HscEnv
hsc_env (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location) FilePath
empty_stub
_ <- runPipeline (hsc_hooks hsc_env) pipeline
pure ()
mkPipeEnv :: StopPhase
-> FilePath
-> Maybe Phase
-> PipelineOutput
-> PipeEnv
mkPipeEnv :: StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
mkPipeEnv StopPhase
stop_phase FilePath
input_fn Maybe Phase
start_phase PipelineOutput
output =
let (FilePath
basename, FilePath
suffix) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
input_fn
suffix' :: FilePath
suffix' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
suffix
env :: PipeEnv
env = PipeEnv{ StopPhase
stop_phase :: StopPhase
stop_phase :: StopPhase
stop_phase,
src_filename :: FilePath
src_filename = FilePath
input_fn,
src_basename :: FilePath
src_basename = FilePath
basename,
src_suffix :: FilePath
src_suffix = FilePath
suffix',
start_phase :: Phase
start_phase = Phase -> Maybe Phase -> Phase
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Phase
startPhase FilePath
suffix') Maybe Phase
start_phase,
output_spec :: PipelineOutput
output_spec = PipelineOutput
output }
in PipeEnv
env
setDumpPrefix :: PipeEnv -> HscEnv -> HscEnv
setDumpPrefix :: PipeEnv -> HscEnv -> HscEnv
setDumpPrefix PipeEnv
pipe_env HscEnv
hsc_env =
(DynFlags -> DynFlags) -> HscEnv -> HscEnv
hscUpdateFlags (\DynFlags
dflags -> DynFlags
dflags { dumpPrefix = src_basename pipe_env ++ "."}) HscEnv
hsc_env
phaseIfFlag :: Monad m
=> HscEnv
-> (DynFlags -> Bool)
-> a
-> m a
-> m a
phaseIfFlag :: forall (m :: * -> *) a.
Monad m =>
HscEnv -> (DynFlags -> Bool) -> a -> m a -> m a
phaseIfFlag HscEnv
hsc_env DynFlags -> Bool
flag a
def m a
action =
if DynFlags -> Bool
flag (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
then m a
action
else a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def
phaseIfAfter :: P m => Platform -> Phase -> Phase -> a -> m a -> m a
phaseIfAfter :: forall (m :: * -> *) a.
P m =>
Platform -> Phase -> Phase -> a -> m a -> m a
phaseIfAfter Platform
platform Phase
start_phase Phase
cur_phase a
def m a
action =
if Phase
start_phase Phase -> Phase -> Bool
`eqPhase` Phase
cur_phase
Bool -> Bool -> Bool
|| Platform -> Phase -> Phase -> Bool
happensBefore Platform
platform Phase
start_phase Phase
cur_phase
then m a
action
else a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def
preprocessPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
preprocessPipeline :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
preprocessPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
unlit_fn <-
Phase -> FilePath -> m FilePath -> m FilePath
forall (p :: * -> *) a. P p => Phase -> a -> p a -> p a
runAfter (HscSource -> Phase
Unlit HscSource
HsSrcFile) FilePath
input_fn (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_Unlit PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn)
(dflags1, p_warns1, warns1) <- use (T_FileArgs hsc_env unlit_fn)
let hsc_env1 = HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags1 HscEnv
hsc_env
(cpp_fn, hsc_env2)
<- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do
cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn)
(dflags2, _, _) <- use (T_FileArgs hsc_env1 cpp_fn)
let hsc_env2 = HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags2 HscEnv
hsc_env1
return (cpp_fn, hsc_env2)
pp_fn <- runAfterFlag hsc_env2 (HsPp HsSrcFile) (gopt Opt_Pp) cpp_fn $
use (T_HsPp pipe_env hsc_env2 input_fn cpp_fn)
(dflags3, p_warns3, warns3)
<- if pp_fn == unlit_fn
then return (dflags1, p_warns1, warns1)
else do
use (T_FileArgs hsc_env pp_fn)
let print_config = DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags3
liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) print_config (initDiagOpts dflags3) (GhcPsMessage <$> p_warns3))
liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) print_config (initDiagOpts dflags3) (GhcDriverMessage <$> warns3))
return (dflags3, pp_fn)
where platform :: Platform
platform = DynFlags -> Platform
targetPlatform (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
runAfter :: P p => Phase
-> a -> p a -> p a
runAfter :: forall (p :: * -> *) a. P p => Phase -> a -> p a -> p a
runAfter = Platform -> Phase -> Phase -> a -> p a -> p a
forall (m :: * -> *) a.
P m =>
Platform -> Phase -> Phase -> a -> m a -> m a
phaseIfAfter Platform
platform (PipeEnv -> Phase
start_phase PipeEnv
pipe_env)
runAfterFlag :: P p
=> HscEnv
-> Phase
-> (DynFlags -> Bool)
-> a
-> p a
-> p a
runAfterFlag :: forall (p :: * -> *) a.
P p =>
HscEnv -> Phase -> (DynFlags -> Bool) -> a -> p a -> p a
runAfterFlag HscEnv
hsc_env Phase
phase DynFlags -> Bool
flag a
def p a
action =
Phase -> a -> p a -> p a
forall (p :: * -> *) a. P p => Phase -> a -> p a -> p a
runAfter Phase
phase a
def
(p a -> p a) -> p a -> p a
forall a b. (a -> b) -> a -> b
$ HscEnv -> (DynFlags -> Bool) -> a -> p a -> p a
forall (m :: * -> *) a.
Monad m =>
HscEnv -> (DynFlags -> Bool) -> a -> m a -> m a
phaseIfFlag HscEnv
hsc_env DynFlags -> Bool
flag a
def p a
action
fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, HomeModLinkable)
fullPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> FilePath -> HscSource -> m (ModIface, HomeModLinkable)
fullPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
pp_fn HscSource
src_flavour = do
(dflags, input_fn) <- PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
preprocessPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
pp_fn
let hsc_env' = HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags HscEnv
hsc_env
(hsc_env_with_plugins, mod_sum, hsc_recomp_status)
<- use (T_HscRecomp pipe_env hsc_env' input_fn src_flavour)
hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status)
hscPipeline :: P m => PipeEnv -> ((HscEnv, ModSummary, HscRecompStatus)) -> m (ModIface, HomeModLinkable)
hscPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> (HscEnv, ModSummary, HscRecompStatus)
-> m (ModIface, HomeModLinkable)
hscPipeline PipeEnv
pipe_env (HscEnv
hsc_env_with_plugins, ModSummary
mod_sum, HscRecompStatus
hsc_recomp_status) = do
case HscRecompStatus
hsc_recomp_status of
HscUpToDate ModIface
iface HomeModLinkable
mb_linkable -> (ModIface, HomeModLinkable) -> m (ModIface, HomeModLinkable)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface
iface, HomeModLinkable
mb_linkable)
HscRecompNeeded Maybe Fingerprint
mb_old_hash -> do
(tc_result, warnings) <- TPhase (FrontendResult, Messages GhcMessage)
-> m (FrontendResult, Messages GhcMessage)
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (HscEnv
-> ModSummary -> TPhase (FrontendResult, Messages GhcMessage)
T_Hsc HscEnv
hsc_env_with_plugins ModSummary
mod_sum)
hscBackendAction <- use (T_HscPostTc hsc_env_with_plugins mod_sum tc_result warnings mb_old_hash )
hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction
hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, HomeModLinkable)
hscBackendPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv
-> ModSummary
-> HscBackendAction
-> m (ModIface, HomeModLinkable)
hscBackendPipeline PipeEnv
pipe_env HscEnv
hsc_env ModSummary
mod_sum HscBackendAction
result =
if Backend -> Bool
backendGeneratesCode (DynFlags -> Backend
backend (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)) then
do
res <- PipeEnv
-> HscEnv
-> ModSummary
-> HscBackendAction
-> m (ModIface, HomeModLinkable)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv
-> ModSummary
-> HscBackendAction
-> m (ModIface, HomeModLinkable)
hscGenBackendPipeline PipeEnv
pipe_env HscEnv
hsc_env ModSummary
mod_sum HscBackendAction
result
when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env) && backendWritesFiles (backend (hsc_dflags hsc_env)) ) $ do
let dflags' = DynFlags -> DynFlags
setDynamicNow (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
() <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result
return res
else
case HscBackendAction
result of
HscUpdate ModIface
iface -> (ModIface, HomeModLinkable) -> m (ModIface, HomeModLinkable)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface
iface, HomeModLinkable
emptyHomeModInfoLinkable)
HscRecomp {} -> (,) (ModIface -> HomeModLinkable -> (ModIface, HomeModLinkable))
-> m ModIface -> m (HomeModLinkable -> (ModIface, HomeModLinkable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ModIface -> m ModIface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv
-> PartialModIface
-> Maybe StgCgInfos
-> Maybe CmmCgInfos
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-> IO ModIface
mkFullIface HscEnv
hsc_env (HscBackendAction -> PartialModIface
hscs_partial_iface HscBackendAction
result) Maybe StgCgInfos
forall a. Maybe a
Nothing Maybe CmmCgInfos
forall a. Maybe a
Nothing ForeignStubs
NoStubs []) m (HomeModLinkable -> (ModIface, HomeModLinkable))
-> m HomeModLinkable -> m (ModIface, HomeModLinkable)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HomeModLinkable -> m HomeModLinkable
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HomeModLinkable
emptyHomeModInfoLinkable
hscGenBackendPipeline :: P m
=> PipeEnv
-> HscEnv
-> ModSummary
-> HscBackendAction
-> m (ModIface, HomeModLinkable)
hscGenBackendPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv
-> ModSummary
-> HscBackendAction
-> m (ModIface, HomeModLinkable)
hscGenBackendPipeline PipeEnv
pipe_env HscEnv
hsc_env ModSummary
mod_sum HscBackendAction
result = do
let mod_name :: ModuleName
mod_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
mod_sum)
src_flavour :: HscSource
src_flavour = (ModSummary -> HscSource
ms_hsc_src ModSummary
mod_sum)
let location :: ModLocation
location = ModSummary -> ModLocation
ms_location ModSummary
mod_sum
(fos, miface, mlinkable, o_file) <- TPhase ([FilePath], ModIface, HomeModLinkable, FilePath)
-> m ([FilePath], ModIface, HomeModLinkable, FilePath)
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv
-> HscEnv
-> ModuleName
-> HscSource
-> ModLocation
-> HscBackendAction
-> TPhase ([FilePath], ModIface, HomeModLinkable, FilePath)
T_HscBackend PipeEnv
pipe_env HscEnv
hsc_env ModuleName
mod_name HscSource
src_flavour ModLocation
location HscBackendAction
result)
final_fp <- hscPostBackendPipeline pipe_env hsc_env (ms_hsc_src mod_sum) (backend (hsc_dflags hsc_env)) (Just location) o_file
final_linkable <-
case final_fp of
Maybe FilePath
Nothing -> HomeModLinkable -> m HomeModLinkable
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return HomeModLinkable
mlinkable
Just FilePath
o_fp -> do
part_time <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
final_object <- use (T_MergeForeign pipe_env hsc_env o_fp fos)
let !linkable = UTCTime -> Module -> NonEmpty LinkablePart -> Linkable
Linkable UTCTime
part_time (ModSummary -> Module
ms_mod ModSummary
mod_sum) (LinkablePart -> NonEmpty LinkablePart
forall a. a -> NonEmpty a
NE.singleton (FilePath -> LinkableObjectSort -> LinkablePart
DotO FilePath
final_object LinkableObjectSort
ModuleObject))
return (mlinkable { homeMod_object = Just linkable })
return (miface, final_linkable)
asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
asPipeline :: forall (m :: * -> *).
P m =>
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
asPipeline Bool
use_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn =
case PipeEnv -> StopPhase
stop_phase PipeEnv
pipe_env of
StopPhase
StopAs -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
StopPhase
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> TPhase FilePath
T_As Bool
use_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn)
lasPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
lasPipeline :: forall (m :: * -> *).
P m =>
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
lasPipeline Bool
use_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn =
case PipeEnv -> StopPhase
stop_phase PipeEnv
pipe_env of
StopPhase
StopAs -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
StopPhase
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> TPhase FilePath
T_LlvmAs Bool
use_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn)
viaCPipeline :: P m => Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
viaCPipeline :: forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
c_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn = do
out_fn <- TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> TPhase FilePath
T_Cc Phase
c_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn)
case stop_phase pipe_env of
StopPhase
StopC -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
StopPhase
_ -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> m (Maybe FilePath))
-> Maybe FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
out_fn
llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
fp = do
opt_fn <- TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmOpt PipeEnv
pipe_env HscEnv
hsc_env FilePath
fp)
llvmLlcPipeline pipe_env hsc_env location opt_fn
llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmLlcPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmLlcPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
opt_fn = do
llc_fn <- TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmLlc PipeEnv
pipe_env HscEnv
hsc_env FilePath
opt_fn)
llvmManglePipeline pipe_env hsc_env location llc_fn
llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmManglePipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmManglePipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
llc_fn = do
mangled_fn <-
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_NoLlvmMangler (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
then FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
llc_fn
else TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmMangle PipeEnv
pipe_env HscEnv
hsc_env FilePath
llc_fn)
lasPipeline False pipe_env hsc_env location mangled_fn
cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmCppPipeline :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmCppPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
output_fn <- TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_CmmCpp PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn)
cmmPipeline pipe_env hsc_env output_fn
cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmPipeline :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
(fos, output_fn) <- TPhase ([FilePath], FilePath) -> m ([FilePath], FilePath)
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> TPhase ([FilePath], FilePath)
T_Cmm PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn)
mo_fn <- hscPostBackendPipeline pipe_env hsc_env HsSrcFile (backend (hsc_dflags hsc_env)) Nothing output_fn
case mo_fn of
Maybe FilePath
Nothing -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
Just FilePath
mo_fn -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv -> HscEnv -> FilePath -> [FilePath] -> TPhase FilePath
T_MergeForeign PipeEnv
pipe_env HscEnv
hsc_env FilePath
mo_fn [FilePath]
fos)
jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
jsPipeline :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
jsPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn = do
TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_Js PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn)
foreignJsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
foreignJsPipeline :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
foreignJsPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn = do
TPhase FilePath -> m FilePath
forall a. TPhase a -> m a
forall {k} (f :: k -> *) (m :: k -> *) (a :: k).
MonadUse f m =>
f a -> m a
use (PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_ForeignJs PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn)
hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
hscPostBackendPipeline :: forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv
-> HscSource
-> Backend
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
hscPostBackendPipeline PipeEnv
_ HscEnv
_ (HsBootOrSig HsBootOrSig
_) Backend
_ Maybe ModLocation
_ FilePath
_ = Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
hscPostBackendPipeline PipeEnv
pipe_env HscEnv
hsc_env HscSource
HsSrcFile Backend
bcknd Maybe ModLocation
ml FilePath
input_fn =
DefunctionalizedPostHscPipeline
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
forall (m :: * -> *).
TPipelineClass TPhase m =>
DefunctionalizedPostHscPipeline
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
applyPostHscPipeline (Backend -> DefunctionalizedPostHscPipeline
backendPostHscPipeline Backend
bcknd) PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
ml FilePath
input_fn
applyPostHscPipeline
:: TPipelineClass TPhase m
=> DefunctionalizedPostHscPipeline
-> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
applyPostHscPipeline :: forall (m :: * -> *).
TPipelineClass TPhase m =>
DefunctionalizedPostHscPipeline
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
applyPostHscPipeline DefunctionalizedPostHscPipeline
NcgPostHscPipeline =
\PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp -> Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
asPipeline Bool
False PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp
applyPostHscPipeline DefunctionalizedPostHscPipeline
ViaCPostHscPipeline = Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
HCc
applyPostHscPipeline DefunctionalizedPostHscPipeline
LlvmPostHscPipeline =
\PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp -> PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmPipeline PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp
applyPostHscPipeline DefunctionalizedPostHscPipeline
JSPostHscPipeline =
\PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
jsPipeline PipeEnv
pe HscEnv
he Maybe ModLocation
ml FilePath
fp
applyPostHscPipeline DefunctionalizedPostHscPipeline
NoPostHscPipeline = \PipeEnv
_ HscEnv
_ Maybe ModLocation
_ FilePath
_ -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath)
pipelineStart :: forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath)
pipelineStart PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn Maybe Phase
mb_phase =
Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
fromPhase (Phase -> Maybe Phase -> Phase
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Phase
startPhase (FilePath -> Phase) -> FilePath -> Phase
forall a b. (a -> b) -> a -> b
$ PipeEnv -> FilePath
src_suffix PipeEnv
pipe_env) Maybe Phase
mb_phase)
where
stop_after :: StopPhase
stop_after = PipeEnv -> StopPhase
stop_phase PipeEnv
pipe_env
frontend :: P m => HscSource -> m (Maybe FilePath)
frontend :: forall (m :: * -> *). P m => HscSource -> m (Maybe FilePath)
frontend HscSource
sf = case StopPhase
stop_after of
StopPhase
StopPreprocess -> do
(_, out_fn) <- PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)
preprocessPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
let logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
final_fn <- liftIO $ phaseOutputFilenameNew (Hsc HsSrcFile) pipe_env hsc_env Nothing
when (final_fn /= out_fn) $ do
let msg = FilePath
"Copying `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
out_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"' to `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
final_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
line_prag = FilePath
"{-# LINE 1 \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PipeEnv -> FilePath
src_filename PipeEnv
pipe_env FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" #-}\n"
liftIO (showPass logger msg)
liftIO (copyWithHeader line_prag out_fn final_fn)
return Nothing
StopPhase
_ -> (ModIface, HomeModLinkable) -> Maybe FilePath
forall {a}. (a, HomeModLinkable) -> Maybe FilePath
objFromLinkable ((ModIface, HomeModLinkable) -> Maybe FilePath)
-> m (ModIface, HomeModLinkable) -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipeEnv
-> HscEnv -> FilePath -> HscSource -> m (ModIface, HomeModLinkable)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> FilePath -> HscSource -> m (ModIface, HomeModLinkable)
fullPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn HscSource
sf
c :: P m => Phase -> m (Maybe FilePath)
c :: forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
phase = Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
viaCPipeline Phase
phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
as :: P m => Bool -> m (Maybe FilePath)
as :: forall (m :: * -> *). P m => Bool -> m (Maybe FilePath)
as Bool
use_cpp = Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> m (Maybe FilePath)
asPipeline Bool
use_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
objFromLinkable :: (a, HomeModLinkable) -> Maybe FilePath
objFromLinkable (a
_, HomeModLinkable -> Maybe Linkable
homeMod_object -> Just (Linkable UTCTime
_ Module
_ (DotO FilePath
lnk LinkableObjectSort
_ :| []))) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
lnk
objFromLinkable (a, HomeModLinkable)
_ = Maybe FilePath
forall a. Maybe a
Nothing
fromPhase :: P m => Phase -> m (Maybe FilePath)
fromPhase :: forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
fromPhase (Unlit HscSource
p) = HscSource -> m (Maybe FilePath)
forall (m :: * -> *). P m => HscSource -> m (Maybe FilePath)
frontend HscSource
p
fromPhase (Cpp HscSource
p) = HscSource -> m (Maybe FilePath)
forall (m :: * -> *). P m => HscSource -> m (Maybe FilePath)
frontend HscSource
p
fromPhase (HsPp HscSource
p) = HscSource -> m (Maybe FilePath)
forall (m :: * -> *). P m => HscSource -> m (Maybe FilePath)
frontend HscSource
p
fromPhase (Hsc HscSource
p) = HscSource -> m (Maybe FilePath)
forall (m :: * -> *). P m => HscSource -> m (Maybe FilePath)
frontend HscSource
p
fromPhase Phase
HCc = Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
HCc
fromPhase Phase
Cc = Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
Cc
fromPhase Phase
Ccxx = Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
Ccxx
fromPhase Phase
Cobjc = Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
Cobjc
fromPhase Phase
Cobjcxx = Phase -> m (Maybe FilePath)
forall (m :: * -> *). P m => Phase -> m (Maybe FilePath)
c Phase
Cobjcxx
fromPhase (As Bool
p) = Bool -> m (Maybe FilePath)
forall (m :: * -> *). P m => Bool -> m (Maybe FilePath)
as Bool
p
fromPhase Phase
LlvmOpt = PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
fromPhase Phase
LlvmLlc = PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmLlcPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
fromPhase Phase
LlvmMangle = PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv
-> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
llvmManglePipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
fromPhase Phase
StopLn = Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
input_fn)
fromPhase Phase
CmmCpp = PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmCppPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
fromPhase Phase
Cmm = PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
cmmPipeline PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
fromPhase Phase
Js = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
forall (m :: * -> *).
P m =>
PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
foreignJsPipeline PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing FilePath
input_fn
fromPhase Phase
MergeForeign = FilePath -> m (Maybe FilePath)
forall a. HasCallStack => FilePath -> a
panic FilePath
"fromPhase: MergeForeign"