{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Driver.Pipeline (
oneShot, compileFile,
preprocess,
compileOne, compileOne',
link,
PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,
hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
runPhase,
doCpp,
linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
) where
#include "ghcplatform.h"
import GHC.Prelude
import GHC.Platform
import GHC.Tc.Types
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
import GHC.Driver.Phases
import GHC.Driver.Session
import GHC.Driver.Backend
import GHC.Driver.Ppr
import GHC.Driver.Hooks
import GHC.Platform.Ways
import GHC.Platform.ArchOS
import GHC.Parser.Header
import GHC.SysTools
import GHC.Utils.TmpFs
import GHC.Linker.ExtraObj
import GHC.Linker.Dynamic
import GHC.Linker.Static
import GHC.Linker.Types
import GHC.Utils.Outputable
import GHC.Utils.Error
import GHC.Utils.Fingerprint
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import GHC.Utils.Monad
import GHC.Utils.Exception as Exception
import GHC.Utils.Logger
import GHC.CmmToLlvm ( llvmFixupAsm, llvmVersionList )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Settings
import GHC.Data.FastString ( mkFastString )
import GHC.Data.StringBuffer ( hGetStringBuffer, hPutStringBuffer )
import GHC.Data.Maybe ( expectJust )
import GHC.Iface.Make ( mkFullIface )
import GHC.Runtime.Loader ( initializePlugins )
import GHC.Types.Basic ( SuccessFlag(..) )
import GHC.Types.Error ( singleMessage, getMessages )
import GHC.Types.Name.Env
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.State
import GHC.Unit.Finder
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Graph (needsTemplateHaskellOrQQ)
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.IORef
import Data.List ( isInfixOf, intercalate )
import Data.Maybe
import Data.Version
import Data.Either ( partitionEithers )
import Data.Time ( UTCTime )
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 (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.
(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 (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
text FilePath
input_fn)
(DynFlags
dflags, FilePath
fp, Maybe ModIface
mb_iface, Maybe Linkable
mb_linkable) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
anyHsc HscEnv
hsc_env (FilePath
input_fn, Maybe InputFileBuffer
mb_input_buf, (Phase -> PhasePlus) -> Maybe Phase -> Maybe PhasePlus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Phase -> PhasePlus
RealPhase Maybe Phase
mb_phase)
Maybe FilePath
forall a. Maybe a
Nothing
(TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_GhcSession)
Maybe ModLocation
forall a. Maybe a
Nothing
[]
Bool -> IO ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Maybe ModIface -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModIface
mb_iface)
Bool -> IO ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Maybe Linkable -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Linkable
mb_linkable)
(DynFlags, FilePath) -> IO (DynFlags, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
dflags, FilePath
fp)
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 (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
$
DiagnosticMessage -> DriverMessage
forall a. (Diagnostic a, Typeable a) => a -> DriverMessage
DriverUnknownMessage (DiagnosticMessage -> DriverMessage)
-> DiagnosticMessage -> 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
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)
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
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ Bag (MsgEnvelope GhcMessage) -> [SDoc]
forall e. Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
pprMsgEnvelopeBagWithLoc (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 (GhcDriverMessage DriverMessage
msg) = DriverMessage -> Maybe DriverMessage
forall a. a -> Maybe a
Just DriverMessage
msg
to_driver_message GhcMessage
_other = Maybe DriverMessage
forall a. Maybe a
Nothing
compileOne :: HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> Maybe Linkable
-> SourceModified
-> IO HomeModInfo
compileOne :: HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> Maybe Linkable
-> SourceModified
-> IO HomeModInfo
compileOne = Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> Maybe Linkable
-> SourceModified
-> IO HomeModInfo
compileOne' Maybe TcGblEnv
forall a. Maybe a
Nothing (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
batchMsg)
compileOne' :: Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> Maybe Linkable
-> SourceModified
-> IO HomeModInfo
compileOne' :: Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> Int
-> Int
-> Maybe ModIface
-> Maybe Linkable
-> SourceModified
-> IO HomeModInfo
compileOne' Maybe TcGblEnv
m_tc_result Maybe Messager
mHscMessage
HscEnv
hsc_env0 ModSummary
summary Int
mod_index Int
nmods Maybe ModIface
mb_old_iface Maybe Linkable
mb_old_linkable
SourceModified
source_modified0
= do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags1 Int
2 (FilePath -> SDoc
text FilePath
"compile: input file" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
input_fnpp)
let flags :: DynFlags
flags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env0
in do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHiFiles DynFlags
flags) (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
flags) (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]
HscEnv
plugin_hsc_env <- HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env
let runPostTc :: FrontendResult
-> Messages GhcMessage -> Maybe Fingerprint -> IO HomeModInfo
runPostTc = HscEnv
-> ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> IO HomeModInfo
compileOnePostTc HscEnv
plugin_hsc_env ModSummary
summary
case Maybe TcGblEnv
m_tc_result of
Just TcGblEnv
tc_result
| Bool -> Bool
not Bool
always_do_basic_recompilation_check -> do
FrontendResult
-> Messages GhcMessage -> Maybe Fingerprint -> IO HomeModInfo
runPostTc (TcGblEnv -> FrontendResult
FrontendTypecheck TcGblEnv
tc_result) Messages GhcMessage
forall e. Messages e
emptyMessages Maybe Fingerprint
forall a. Maybe a
Nothing
Maybe TcGblEnv
_ -> do
HscRecompStatus
status <- Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO HscRecompStatus
hscRecompStatus Maybe Messager
mHscMessage HscEnv
plugin_hsc_env ModSummary
summary
SourceModified
source_modified Maybe ModIface
mb_old_iface (Int
mod_index, Int
nmods)
case HscRecompStatus
status of
HscUpToDate ModIface
iface -> do
Bool -> IO ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ( Maybe Linkable -> Bool
forall a. Maybe a -> Bool
isJust Maybe Linkable
mb_old_linkable Bool -> Bool -> Bool
|| GhcLink -> Bool
isNoLink (DynFlags -> GhcLink
ghcLink DynFlags
dflags) )
ModDetails
details <- HscEnv -> ModSummary -> ModIface -> IO ModDetails
initModDetails HscEnv
plugin_hsc_env ModSummary
summary ModIface
iface
HomeModInfo -> IO HomeModInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (HomeModInfo -> IO HomeModInfo) -> HomeModInfo -> IO HomeModInfo
forall a b. (a -> b) -> a -> b
$! ModIface -> ModDetails -> Maybe Linkable -> HomeModInfo
HomeModInfo ModIface
iface ModDetails
details Maybe Linkable
mb_old_linkable
HscRecompNeeded Maybe Fingerprint
mb_old_hash -> do
(FrontendResult
tc_result, Messages GhcMessage
warnings) <- HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
hscTypecheckAndGetWarnings HscEnv
plugin_hsc_env ModSummary
summary
FrontendResult
-> Messages GhcMessage -> Maybe Fingerprint -> IO HomeModInfo
runPostTc FrontendResult
tc_result Messages GhcMessage
warnings Maybe Fingerprint
mb_old_hash
where dflags0 :: DynFlags
dflags0 = 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. HasCallStack => 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
mod_graph :: ModuleGraph
mod_graph = HscEnv -> ModuleGraph
hsc_mod_graph HscEnv
hsc_env0
needsLinker :: Bool
needsLinker = ModuleGraph -> Bool
needsTemplateHaskellOrQQ ModuleGraph
mod_graph
isDynWay :: Bool
isDynWay = (Way -> Bool) -> Set Way -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
== Way
WayDyn) (DynFlags -> Set Way
ways DynFlags
dflags0)
isProfWay :: Bool
isProfWay = (Way -> Bool) -> Set Way -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
== Way
WayProf) (DynFlags -> Set Way
ways DynFlags
dflags0)
internalInterpreter :: Bool
internalInterpreter = Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalInterpreter DynFlags
dflags0)
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env0
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env0
dflags1 :: DynFlags
dflags1 = if Bool
hostIsDynamic Bool -> Bool -> Bool
&& Bool
internalInterpreter Bool -> Bool -> Bool
&&
Bool -> Bool
not Bool
isDynWay Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isProfWay Bool -> Bool -> Bool
&& Bool
needsLinker
then DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags0 GeneralFlag
Opt_BuildDynamicToo
else DynFlags
dflags0
dflags2 :: DynFlags
dflags2 = if Bool -> Bool
not Bool
internalInterpreter Bool -> Bool -> Bool
&& Bool
needsLinker
then DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags1 GeneralFlag
Opt_ExternalInterpreter
else DynFlags
dflags1
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
dflags2
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
Interpreter, DynFlags
dflags2 { backend :: Backend
backend = Backend
Interpreter })
| Bool
otherwise
= (DynFlags -> Backend
backend DynFlags
dflags, DynFlags
dflags2)
dflags :: DynFlags
dflags = DynFlags
dflags3 { includePaths :: IncludeSpecs
includePaths = IncludeSpecs -> [FilePath] -> IncludeSpecs
addImplicitQuoteInclude IncludeSpecs
old_paths [FilePath
current_dir] }
hsc_env :: HscEnv
hsc_env = HscEnv
hsc_env0 {hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags}
force_recomp :: Bool
force_recomp = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ForceRecomp DynFlags
dflags
source_modified :: SourceModified
source_modified
| Bool
force_recomp Bool -> Bool -> Bool
|| Bool
loadAsByteCode = SourceModified
SourceModified
| Bool
otherwise = SourceModified
source_modified0
always_do_basic_recompilation_check :: Bool
always_do_basic_recompilation_check = case Backend
bcknd of
Backend
Interpreter -> Bool
True
Backend
_ -> Bool
False
compileOnePostTc
:: HscEnv
-> ModSummary
-> FrontendResult
-> WarningMessages
-> Maybe Fingerprint
-> IO HomeModInfo
compileOnePostTc :: HscEnv
-> ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> IO HomeModInfo
compileOnePostTc HscEnv
hsc_env ModSummary
summary FrontendResult
tc_result Messages GhcMessage
warnings Maybe Fingerprint
mb_old_hash = do
FilePath
output_fn <- Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs Phase
next_phase
(TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_CurrentModule)
FilePath
basename DynFlags
dflags Phase
next_phase (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
(DynFlags
_, FilePath
_, Just ModIface
iface, Maybe Linkable
mb_linkable) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
StopLn HscEnv
hsc_env
(FilePath
output_fn,
Maybe InputFileBuffer
forall a. Maybe a
Nothing,
PhasePlus -> Maybe PhasePlus
forall a. a -> Maybe a
Just (ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> PhasePlus
HscPostTc ModSummary
summary FrontendResult
tc_result Messages GhcMessage
warnings Maybe Fingerprint
mb_old_hash))
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
basename)
PipelineOutput
pipelineOutput
(ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
[]
Maybe Linkable
mLinkable <- case () of
()
_ | Just Linkable
l <- Maybe Linkable
mb_linkable -> Maybe Linkable -> IO (Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Linkable -> IO (Maybe Linkable))
-> Maybe Linkable -> IO (Maybe Linkable)
forall a b. (a -> b) -> a -> b
$ Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
l
| Backend
bcknd Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
NoBackend -> Maybe Linkable -> IO (Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Linkable
forall a. Maybe a
Nothing
| HscSource
src_flavour HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsSrcFile -> do
UTCTime
o_time <- FilePath -> IO UTCTime
getModificationUTCTime FilePath
object_filename
let !linkable :: Linkable
linkable = UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
o_time Module
this_mod [FilePath -> Unlinked
DotO FilePath
object_filename]
Maybe Linkable -> IO (Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Linkable -> IO (Maybe Linkable))
-> Maybe Linkable -> IO (Maybe Linkable)
forall a b. (a -> b) -> a -> b
$ Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable
| Bool
otherwise -> Maybe Linkable -> IO (Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Linkable
forall a. Maybe a
Nothing
ModDetails
details <- HscEnv -> ModSummary -> ModIface -> IO ModDetails
initModDetails HscEnv
hsc_env ModSummary
summary ModIface
iface
HomeModInfo -> IO HomeModInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (HomeModInfo -> IO HomeModInfo) -> HomeModInfo -> IO HomeModInfo
forall a b. (a -> b) -> a -> b
$! ModIface -> ModDetails -> Maybe Linkable -> HomeModInfo
HomeModInfo ModIface
iface ModDetails
details Maybe Linkable
mLinkable
where dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
this_mod :: Module
this_mod = ModSummary -> Module
ms_mod ModSummary
summary
location :: ModLocation
location = ModSummary -> ModLocation
ms_location ModSummary
summary
input_fn :: FilePath
input_fn = FilePath -> Maybe FilePath -> FilePath
forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"compile:hs" (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location)
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
src_flavour :: HscSource
src_flavour = ModSummary -> HscSource
ms_hsc_src ModSummary
summary
next_phase :: Phase
next_phase = HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
src_flavour Backend
bcknd
bcknd :: Backend
bcknd = DynFlags -> Backend
backend DynFlags
dflags
object_filename :: FilePath
object_filename = ModLocation -> FilePath
ml_obj_file ModLocation
location
basename :: FilePath
basename = FilePath -> FilePath
dropExtension FilePath
input_fn
pipelineOutput :: PipelineOutput
pipelineOutput = case Backend
bcknd of
Backend
Interpreter -> PipelineOutput
NoOutputFile
Backend
NoBackend -> PipelineOutput
NoOutputFile
Backend
_ -> PipelineOutput
Persistent
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign HscEnv
_ ForeignSrcLang
RawObject FilePath
object_file = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
object_file
compileForeign HscEnv
hsc_env ForeignSrcLang
lang FilePath
stub_c = do
let phase :: Phase
phase = case ForeignSrcLang
lang of
ForeignSrcLang
LangC -> Phase
Cc
ForeignSrcLang
LangCxx -> Phase
Ccxx
ForeignSrcLang
LangObjc -> Phase
Cobjc
ForeignSrcLang
LangObjcxx -> Phase
Cobjcxx
ForeignSrcLang
LangAsm -> Bool -> Phase
As Bool
True
#if __GLASGOW_HASKELL__ < 811
ForeignSrcLang
RawObject -> FilePath -> Phase
forall a. FilePath -> a
panic FilePath
"compileForeign: should be unreachable"
#endif
(DynFlags
_, FilePath
stub_o, Maybe ModIface
_, Maybe Linkable
_) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
StopLn HscEnv
hsc_env
(FilePath
stub_c, Maybe InputFileBuffer
forall a. Maybe a
Nothing, PhasePlus -> Maybe PhasePlus
forall a. a -> Maybe a
Just (Phase -> PhasePlus
RealPhase Phase
phase))
Maybe FilePath
forall a. Maybe a
Nothing (TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_GhcSession)
Maybe ModLocation
forall a. Maybe a
Nothing
[]
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
stub_o
compileStub :: HscEnv -> FilePath -> IO FilePath
compileStub :: HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env FilePath
stub_c = HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign HscEnv
hsc_env ForeignSrcLang
LangC FilePath
stub_c
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
FilePath
empty_stub <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"c"
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
src :: SDoc
src = FilePath -> SDoc
text FilePath
"int" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name) SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
"= 0;"
FilePath -> FilePath -> IO ()
writeFile FilePath
empty_stub (DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags (LabelStyle -> SDoc -> SDoc
pprCode LabelStyle
CStyle SDoc
src))
(DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
StopLn HscEnv
hsc_env
(FilePath
empty_stub, Maybe InputFileBuffer
forall a. Maybe a
Nothing, Maybe PhasePlus
forall a. Maybe a
Nothing)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
basename)
PipelineOutput
Persistent
(ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
[]
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
link :: GhcLink
-> Logger
-> TmpFs
-> Hooks
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link :: GhcLink
-> Logger
-> TmpFs
-> Hooks
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link GhcLink
ghcLink Logger
logger TmpFs
tmpfs Hooks
hooks DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking 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 (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
GhcLink
LinkBinary -> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking HomePackageTable
hpt
GhcLink
LinkStaticLib -> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking HomePackageTable
hpt
GhcLink
LinkDynLib -> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking HomePackageTable
hpt
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 (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
panicBadLink :: GhcLink -> a
panicBadLink :: GhcLink -> a
panicBadLink GhcLink
other = FilePath -> a
forall a. 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
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' :: Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
batch_attempt_linking 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 = (HomeModInfo -> [UnitId]) -> [HomeModInfo] -> [UnitId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dependencies -> [UnitId]
dep_direct_pkgs (Dependencies -> [UnitId])
-> (HomeModInfo -> Dependencies) -> HomeModInfo -> [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]
home_mod_infos
linkables :: [Linkable]
linkables = (HomeModInfo -> Linkable) -> [HomeModInfo] -> [Linkable]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe Linkable -> Linkable
forall a. HasCallStack => 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
hm_linkable) [HomeModInfo]
home_mod_infos
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (FilePath -> SDoc
text FilePath
"link: linkables are ..." SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((Linkable -> SDoc) -> [Linkable] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Linkable]
linkables))
if GhcLink -> Bool
isNoLink (DynFlags -> GhcLink
ghcLink DynFlags
dflags)
then do Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (FilePath -> SDoc
text FilePath
"link(batch): linking omitted (-c flag given).")
SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
else do
let getOfiles :: Linkable -> [FilePath]
getOfiles (LM UTCTime
_ Module
_ [Unlinked]
us) = (Unlinked -> FilePath) -> [Unlinked] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Unlinked -> FilePath
nameOfObject ((Unlinked -> Bool) -> [Unlinked] -> [Unlinked]
forall a. (a -> Bool) -> [a] -> [a]
filter Unlinked -> Bool
isObject [Unlinked]
us)
obj_files :: [FilePath]
obj_files = (Linkable -> [FilePath]) -> [Linkable] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Linkable -> [FilePath]
getOfiles [Linkable]
linkables
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
exe_file :: FilePath
exe_file = Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName Platform
platform Bool
staticLink (DynFlags -> Maybe FilePath
outputFile DynFlags
dflags)
Bool
linking_needed <- Logger
-> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO Bool
linkingNeeded Logger
logger DynFlags
dflags UnitEnv
unit_env Bool
staticLink [Linkable]
linkables [UnitId]
pkg_deps
if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ForceRecomp DynFlags
dflags) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
linking_needed
then do Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
2 (FilePath -> SDoc
text FilePath
exe_file SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
"is up to date, linking not required.")
SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
else do
Logger -> DynFlags -> SDoc -> IO ()
compilationProgressMsg Logger
logger DynFlags
dflags (FilePath -> SDoc
text FilePath
"Linking " SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
exe_file SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
" ...")
let link :: DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
link = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
LinkBinary -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary Logger
logger TmpFs
tmpfs
GhcLink
LinkStaticLib -> Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkStaticLib Logger
logger
GhcLink
LinkDynLib -> Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLibCheck Logger
logger TmpFs
tmpfs
GhcLink
other -> GhcLink -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
forall a. GhcLink -> a
panicBadLink GhcLink
other
DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
link DynFlags
dflags UnitEnv
unit_env [FilePath]
obj_files [UnitId]
pkg_deps
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (FilePath -> SDoc
text FilePath
"link: done")
SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
| Bool
otherwise
= do Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (FilePath -> SDoc
text FilePath
"link(batch): upsweep (partially) failed OR" SDoc -> SDoc -> SDoc
$$
FilePath -> SDoc
text FilePath
" Main.main not exported; not linking.")
SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO Bool
linkingNeeded :: Logger
-> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO Bool
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 = UnitEnv -> UnitState
ue_units UnitEnv
unit_env
exe_file :: FilePath
exe_file = Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName Platform
platform Bool
staticLink (DynFlags -> Maybe FilePath
outputFile DynFlags
dflags)
Either IOException UTCTime
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 Either IOException UTCTime
e_exe_time of
Left IOException
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Right UTCTime
t -> do
let extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
[Either IOException UTCTime]
e_extra_times <- (FilePath -> IO (Either IOException UTCTime))
-> [FilePath] -> IO [Either IOException UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 ([IOException]
errs,[UTCTime]
extra_times) = [Either IOException UTCTime] -> ([IOException], [UTCTime])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either IOException UTCTime]
e_extra_times
let obj_times :: [UTCTime]
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 Bool -> Bool
not ([IOException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IOException]
errs) Bool -> Bool -> Bool
|| (UTCTime -> Bool) -> [UTCTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) [UTCTime]
obj_times
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
let pkg_hslibs :: [([FilePath], FilePath)]
pkg_hslibs = [ (Set Way -> [UnitInfo] -> [FilePath]
collectLibraryDirs (DynFlags -> Set Way
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) [UnitId]
pkg_deps,
FilePath
lib <- GhcNameVersion -> Set Way -> UnitInfo -> [FilePath]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Set Way
ways DynFlags
dflags) UnitInfo
c ]
[Maybe FilePath]
pkg_libfiles <- (([FilePath], FilePath) -> IO (Maybe FilePath))
-> [([FilePath], FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([FilePath] -> FilePath -> IO (Maybe FilePath))
-> ([FilePath], FilePath) -> IO (Maybe FilePath)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Platform
-> Set Way -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findHSLib Platform
platform (DynFlags -> Set Way
ways DynFlags
dflags))) [([FilePath], FilePath)]
pkg_hslibs
if (Maybe FilePath -> Bool) -> [Maybe FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe FilePath]
pkg_libfiles then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do
[Either IOException UTCTime]
e_lib_times <- (FilePath -> IO (Either IOException UTCTime))
-> [FilePath] -> IO [Either IOException UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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)
([Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
pkg_libfiles)
let ([IOException]
lib_errs,[UTCTime]
lib_times) = [Either IOException UTCTime] -> ([IOException], [UTCTime])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either IOException UTCTime]
e_lib_times
if Bool -> Bool
not ([IOException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IOException]
lib_errs) Bool -> Bool -> Bool
|| (UTCTime -> Bool) -> [UTCTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) [UTCTime]
lib_times
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Logger -> DynFlags -> UnitEnv -> [UnitId] -> FilePath -> IO Bool
checkLinkInfo Logger
logger DynFlags
dflags UnitEnv
unit_env [UnitId]
pkg_deps FilePath
exe_file
findHSLib :: Platform -> Ways -> [String] -> String -> IO (Maybe FilePath)
findHSLib :: Platform
-> Set Way -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findHSLib Platform
platform Set Way
ws [FilePath]
dirs FilePath
lib = do
let batch_lib_file :: FilePath
batch_lib_file = if Way
WayDyn Way -> Set Way -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Way
ws
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
[FilePath]
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 [FilePath]
found of
[] -> Maybe FilePath -> IO (Maybe FilePath)
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 (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x)
oneShot :: HscEnv -> Phase -> [(String, Maybe Phase)] -> IO ()
oneShot :: HscEnv -> Phase -> [(FilePath, Maybe Phase)] -> IO ()
oneShot HscEnv
hsc_env Phase
stop_phase [(FilePath, Maybe Phase)]
srcs = do
[FilePath]
o_files <- ((FilePath, Maybe Phase) -> IO FilePath)
-> [(FilePath, Maybe Phase)] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
compileFile HscEnv
hsc_env Phase
stop_phase) [(FilePath, Maybe Phase)]
srcs
HscEnv -> Phase -> [FilePath] -> IO ()
doLink HscEnv
hsc_env Phase
stop_phase [FilePath]
o_files
compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
compileFile HscEnv
hsc_env Phase
stop_phase (FilePath
src, Maybe Phase
mb_phase) = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
src
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
exists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
CmdLineError (FilePath
"does not exist: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src))
let
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
output :: PipelineOutput
output
| Backend
NoBackend <- DynFlags -> Backend
backend DynFlags
dflags = PipelineOutput
NoOutputFile
| Phase
StopLn <- Phase
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
( DynFlags
_, FilePath
out_file, Maybe ModIface
_, Maybe Linkable
_) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
stop_phase HscEnv
hsc_env
(FilePath
src, Maybe InputFileBuffer
forall a. Maybe a
Nothing, (Phase -> PhasePlus) -> Maybe Phase -> Maybe PhasePlus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Phase -> PhasePlus
RealPhase Maybe Phase
mb_phase)
Maybe FilePath
forall a. Maybe a
Nothing
PipelineOutput
output
Maybe ModLocation
forall a. Maybe a
Nothing []
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
out_file
doLink :: HscEnv -> Phase -> [FilePath] -> IO ()
doLink :: HscEnv -> Phase -> [FilePath] -> IO ()
doLink HscEnv
hsc_env Phase
stop_phase [FilePath]
o_files
| Bool -> Bool
not (Phase -> Bool
isStopLn Phase
stop_phase)
= () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= 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
in case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
NoLink -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GhcLink
LinkBinary -> 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
other -> GhcLink -> IO ()
forall a. GhcLink -> a
panicBadLink GhcLink
other
runPipeline
:: Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline :: Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline Phase
stop_phase HscEnv
hsc_env0 (FilePath
input_fn, Maybe InputFileBuffer
mb_input_buf, Maybe PhasePlus
mb_phase)
Maybe FilePath
mb_basename PipelineOutput
output Maybe ModLocation
maybe_loc [FilePath]
foreign_os
= do let
dflags0 :: DynFlags
dflags0 = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env0
dflags :: DynFlags
dflags = DynFlags
dflags0 { dumpPrefix :: Maybe FilePath
dumpPrefix = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
basename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".") }
hsc_env :: HscEnv
hsc_env = HscEnv
hsc_env0 {hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags}
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
(FilePath
input_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
basename :: FilePath
basename | Just FilePath
b <- Maybe FilePath
mb_basename = FilePath
b
| Bool
otherwise = FilePath
input_basename
start_phase :: PhasePlus
start_phase = PhasePlus -> Maybe PhasePlus -> PhasePlus
forall a. a -> Maybe a -> a
fromMaybe (Phase -> PhasePlus
RealPhase (FilePath -> Phase
startPhase FilePath
suffix')) Maybe PhasePlus
mb_phase
isHaskell :: PhasePlus -> Bool
isHaskell (RealPhase (Unlit HscSource
_)) = Bool
True
isHaskell (RealPhase (Cpp HscSource
_)) = Bool
True
isHaskell (RealPhase (HsPp HscSource
_)) = Bool
True
isHaskell (RealPhase (Hsc HscSource
_)) = Bool
True
isHaskell (HscPostTc {}) = Bool
True
isHaskell (HscBackend {}) = Bool
True
isHaskell PhasePlus
_ = Bool
False
isHaskellishFile :: Bool
isHaskellishFile = PhasePlus -> Bool
isHaskell PhasePlus
start_phase
env :: PipeEnv
env = PipeEnv :: Phase
-> FilePath -> FilePath -> FilePath -> PipelineOutput -> PipeEnv
PipeEnv{ Phase
stop_phase :: Phase
stop_phase :: Phase
stop_phase,
src_filename :: FilePath
src_filename = FilePath
input_fn,
src_basename :: FilePath
src_basename = FilePath
basename,
src_suffix :: FilePath
src_suffix = FilePath
suffix',
output_spec :: PipelineOutput
output_spec = PipelineOutput
output }
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Bool
isBackpackishSuffix FilePath
suffix') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
UsageError
(FilePath
"use --backpack to process " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_fn))
let happensBefore' :: Phase -> Phase -> Bool
happensBefore' = Platform -> Phase -> Phase -> Bool
happensBefore (DynFlags -> Platform
targetPlatform DynFlags
dflags)
case PhasePlus
start_phase of
RealPhase Phase
start_phase' ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Phase
start_phase' Phase -> Phase -> Bool
`happensBefore'` Phase
stop_phase Bool -> Bool -> Bool
||
Phase
start_phase' Phase -> Phase -> Bool
`eqPhase` Phase
stop_phase)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
UsageError
(FilePath
"cannot compile this file to desired target: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_fn))
HscPostTc {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
HscBackend {} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FilePath
input_fn' <- case (PhasePlus
start_phase, Maybe InputFileBuffer
mb_input_buf) of
(RealPhase Phase
real_start_phase, Just InputFileBuffer
input_buf) -> do
let suffix :: FilePath
suffix = Phase -> FilePath
phaseInputExt Phase
real_start_phase
FilePath
fn <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
suffix
Handle
hdl <- FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fn IOMode
WriteMode
Handle -> FilePath -> IO ()
hPutStrLn Handle
hdl (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"{-# LINE 1 \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"#-}"
Handle -> InputFileBuffer -> IO ()
hPutStringBuffer Handle
hdl InputFileBuffer
input_buf
Handle -> IO ()
hClose Handle
hdl
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fn
(PhasePlus
_, Maybe InputFileBuffer
_) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
4 (FilePath -> SDoc
text FilePath
"Running the pipeline")
(DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
r <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline' PhasePlus
start_phase HscEnv
hsc_env PipeEnv
env FilePath
input_fn'
Maybe ModLocation
maybe_loc [FilePath]
foreign_os
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isHaskellishFile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
DynFlags -> IO DynamicTooState
forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
dynamicTooState DynFlags
dflags IO DynamicTooState -> (DynamicTooState -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DynamicTooState
DT_Dont -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DynamicTooState
DT_Dyn -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DynamicTooState
DT_OK -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DynamicTooState
DT_Failed
| OS
OSMinGW32 <- Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
4
(FilePath -> SDoc
text FilePath
"Running the full pipeline again for -dynamic-too")
let dflags0 :: DynFlags
dflags0 = (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_BuildDynamicToo
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
setDynamicNow
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
dflags
HscEnv
hsc_env' <- DynFlags -> IO HscEnv
newHscEnv DynFlags
dflags0
([UnitDatabase UnitId]
dbs,UnitState
unit_state,HomeUnit
home_unit,Maybe PlatformConstants
mconstants) <- Logger
-> DynFlags
-> Maybe [UnitDatabase UnitId]
-> IO
([UnitDatabase UnitId], UnitState, HomeUnit,
Maybe PlatformConstants)
initUnits Logger
logger DynFlags
dflags0 Maybe [UnitDatabase UnitId]
forall a. Maybe a
Nothing
DynFlags
dflags1 <- DynFlags -> Maybe PlatformConstants -> IO DynFlags
updatePlatformConstants DynFlags
dflags0 Maybe PlatformConstants
mconstants
UnitEnv
unit_env0 <- GhcNameVersion -> Platform -> IO UnitEnv
initUnitEnv (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags1) (DynFlags -> Platform
targetPlatform DynFlags
dflags1)
let unit_env :: UnitEnv
unit_env = UnitEnv
unit_env0
{ ue_home_unit :: Maybe HomeUnit
ue_home_unit = HomeUnit -> Maybe HomeUnit
forall a. a -> Maybe a
Just HomeUnit
home_unit
, ue_units :: UnitState
ue_units = UnitState
unit_state
, ue_unit_dbs :: Maybe [UnitDatabase UnitId]
ue_unit_dbs = [UnitDatabase UnitId] -> Maybe [UnitDatabase UnitId]
forall a. a -> Maybe a
Just [UnitDatabase UnitId]
dbs
}
let hsc_env'' :: HscEnv
hsc_env'' = HscEnv
hsc_env'
{ hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags1
, hsc_unit_env :: UnitEnv
hsc_unit_env = UnitEnv
unit_env
}
(DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
_ <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline' PhasePlus
start_phase HscEnv
hsc_env'' PipeEnv
env FilePath
input_fn'
Maybe ModLocation
maybe_loc [FilePath]
foreign_os
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
r
runPipeline'
:: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline' :: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
runPipeline' PhasePlus
start_phase HscEnv
hsc_env PipeEnv
env FilePath
input_fn
Maybe ModLocation
maybe_loc [FilePath]
foreign_os
= do
let state :: PipeState
state = PipeState :: HscEnv
-> Maybe ModLocation
-> [FilePath]
-> Maybe ModIface
-> Maybe Linkable
-> PipeState
PipeState{ HscEnv
hsc_env :: HscEnv
hsc_env :: HscEnv
hsc_env, Maybe ModLocation
maybe_loc :: Maybe ModLocation
maybe_loc :: Maybe ModLocation
maybe_loc, foreign_os :: [FilePath]
foreign_os = [FilePath]
foreign_os, iface :: Maybe ModIface
iface = Maybe ModIface
forall a. Maybe a
Nothing
, maybe_linkable :: Maybe Linkable
maybe_linkable = Maybe Linkable
forall a. Maybe a
Nothing }
(PipeState
pipe_state, FilePath
fp) <- CompPipeline FilePath
-> PipeEnv -> PipeState -> IO (PipeState, FilePath)
forall a.
CompPipeline a -> PipeEnv -> PipeState -> IO (PipeState, a)
evalP (PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
start_phase FilePath
input_fn) PipeEnv
env PipeState
state
(DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
-> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)
forall (m :: * -> *) a. Monad m => a -> m a
return (PipeState -> DynFlags
pipeStateDynFlags PipeState
pipe_state, FilePath
fp, PipeState -> Maybe ModIface
pipeStateModIface PipeState
pipe_state
, PipeState -> Maybe Linkable
pipeStateLinkable PipeState
pipe_state )
pipeLoop :: PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop :: PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
phase FilePath
input_fn = do
PipeEnv
env <- CompPipeline PipeEnv
getPipeEnv
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let happensBefore' :: Phase -> Phase -> Bool
happensBefore' = Platform -> Phase -> Phase -> Bool
happensBefore (DynFlags -> Platform
targetPlatform DynFlags
dflags)
stopPhase :: Phase
stopPhase = PipeEnv -> Phase
stop_phase PipeEnv
env
case PhasePlus
phase of
RealPhase Phase
realPhase | Phase
realPhase Phase -> Phase -> Bool
`eqPhase` Phase
stopPhase
->
case PipeEnv -> PipelineOutput
output_spec PipeEnv
env of
Temporary TempFileLifetime
_ ->
FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
PipelineOutput
NoOutputFile -> FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
PipelineOutput
output ->
do PipeState
pst <- CompPipeline PipeState
getPipeState
TmpFs
tmpfs <- HscEnv -> TmpFs
hsc_tmpfs (HscEnv -> TmpFs) -> CompPipeline HscEnv -> CompPipeline TmpFs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompPipeline HscEnv
getPipeSession
FilePath
final_fn <- IO FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> CompPipeline FilePath)
-> IO FilePath -> CompPipeline FilePath
forall a b. (a -> b) -> a -> b
$ Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs
Phase
stopPhase PipelineOutput
output (PipeEnv -> FilePath
src_basename PipeEnv
env)
DynFlags
dflags Phase
stopPhase (PipeState -> Maybe ModLocation
maybe_loc PipeState
pst)
Bool -> CompPipeline () -> CompPipeline ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
final_fn FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
input_fn) (CompPipeline () -> CompPipeline ())
-> CompPipeline () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: FilePath
msg = FilePath
"Copying `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_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_prag = FilePath
"{-# LINE 1 \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PipeEnv -> FilePath
src_filename PipeEnv
env FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" #-}\n"
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> FilePath -> IO ()
showPass Logger
logger DynFlags
dflags FilePath
msg
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
copyWithHeader FilePath
line_prag FilePath
input_fn FilePath
final_fn
FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
final_fn
| Bool -> Bool
not (Phase
realPhase Phase -> Phase -> Bool
`happensBefore'` Phase
stopPhase)
-> FilePath -> CompPipeline FilePath
forall a. FilePath -> a
panic (FilePath
"pipeLoop: at phase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Phase -> FilePath
forall a. Show a => a -> FilePath
show Phase
realPhase FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" but I wanted to stop at phase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Phase -> FilePath
forall a. Show a => a -> FilePath
show Phase
stopPhase)
PhasePlus
_
-> do IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
4
(FilePath -> SDoc
text FilePath
"Running phase" SDoc -> SDoc -> SDoc
<+> PhasePlus -> SDoc
forall a. Outputable a => a -> SDoc
ppr PhasePlus
phase)
case PhasePlus
phase of
HscBackend {} -> do
let noDynToo :: CompPipeline FilePath
noDynToo = do
(PhasePlus
next_phase, FilePath
output_fn) <- PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
phase FilePath
input_fn
PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
let dynToo :: CompPipeline FilePath
dynToo = do
FilePath
r <- CompPipeline FilePath
noDynToo
DynFlags -> CompPipeline DynamicTooState
forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
dynamicTooState DynFlags
dflags CompPipeline DynamicTooState
-> (DynamicTooState -> CompPipeline FilePath)
-> CompPipeline FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DynamicTooState
DT_OK -> do
let dflags' :: DynFlags
dflags' = DynFlags -> DynFlags
setDynamicNow DynFlags
dflags
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags'
(PhasePlus
next_phase, FilePath
output_fn) <- PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
phase FilePath
input_fn
FilePath
_ <- PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags
FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
r
DynamicTooState
_ -> FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
r
DynFlags -> CompPipeline DynamicTooState
forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
dynamicTooState DynFlags
dflags CompPipeline DynamicTooState
-> (DynamicTooState -> CompPipeline FilePath)
-> CompPipeline FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DynamicTooState
DT_Dont -> CompPipeline FilePath
noDynToo
DynamicTooState
DT_Failed -> CompPipeline FilePath
noDynToo
DynamicTooState
DT_OK -> CompPipeline FilePath
dynToo
DynamicTooState
DT_Dyn -> CompPipeline FilePath
noDynToo
PhasePlus
_ -> do
(PhasePlus
next_phase, FilePath
output_fn) <- PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
phase FilePath
input_fn
PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
runHookedPhase :: PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runHookedPhase :: PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
pp FilePath
input = do
Hooks
hooks <- HscEnv -> Hooks
hsc_hooks (HscEnv -> Hooks) -> CompPipeline HscEnv -> CompPipeline Hooks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompPipeline HscEnv
getPipeSession
case Hooks
-> Maybe
(PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath))
runPhaseHook Hooks
hooks of
Maybe (PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath))
Nothing -> PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runPhase PhasePlus
pp FilePath
input
Just PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
h -> PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
h PhasePlus
pp FilePath
input
phaseOutputFilename :: Phase -> CompPipeline FilePath
phaseOutputFilename :: Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase = do
PipeEnv{Phase
stop_phase :: Phase
stop_phase :: PipeEnv -> Phase
stop_phase, FilePath
src_basename :: FilePath
src_basename :: PipeEnv -> FilePath
src_basename, PipelineOutput
output_spec :: PipelineOutput
output_spec :: PipeEnv -> PipelineOutput
output_spec} <- CompPipeline PipeEnv
getPipeEnv
PipeState{Maybe ModLocation
maybe_loc :: Maybe ModLocation
maybe_loc :: PipeState -> Maybe ModLocation
maybe_loc,HscEnv
hsc_env :: HscEnv
hsc_env :: PipeState -> HscEnv
hsc_env} <- CompPipeline PipeState
getPipeState
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
IO FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> CompPipeline FilePath)
-> IO FilePath -> CompPipeline FilePath
forall a b. (a -> b) -> a -> b
$ Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs Phase
stop_phase PipelineOutput
output_spec
FilePath
src_basename DynFlags
dflags Phase
next_phase Maybe ModLocation
maybe_loc
getOutputFilename
:: Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> String
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename :: Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs Phase
stop_phase PipelineOutput
output FilePath
basename DynFlags
dflags Phase
next_phase Maybe ModLocation
maybe_location
| Bool
is_last_phase, PipelineOutput
Persistent <- PipelineOutput
output = IO FilePath
persistent_fn
| Bool
is_last_phase, PipelineOutput
SpecificFile <- PipelineOutput
output = case DynFlags -> Maybe FilePath
outputFile DynFlags
dflags of
Just FilePath
f -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
f
Maybe FilePath
Nothing ->
FilePath -> IO FilePath
forall a. FilePath -> a
panic FilePath
"SpecificFile: No filename"
| Bool
keep_this_output = IO FilePath
persistent_fn
| Temporary TempFileLifetime
lifetime <- PipelineOutput
output = Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
lifetime FilePath
suffix
| Bool
otherwise = Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule
FilePath
suffix
where
hcsuf :: FilePath
hcsuf = DynFlags -> FilePath
hcSuf DynFlags
dflags
odir :: Maybe FilePath
odir = DynFlags -> Maybe FilePath
objectDir DynFlags
dflags
osuf :: FilePath
osuf = DynFlags -> FilePath
objectSuf DynFlags
dflags
keep_hc :: Bool
keep_hc = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHcFiles DynFlags
dflags
keep_hscpp :: Bool
keep_hscpp = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHscppFiles DynFlags
dflags
keep_s :: Bool
keep_s = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepSFiles DynFlags
dflags
keep_bc :: Bool
keep_bc = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepLlvmFiles DynFlags
dflags
myPhaseInputExt :: Phase -> FilePath
myPhaseInputExt Phase
HCc = FilePath
hcsuf
myPhaseInputExt Phase
MergeForeign = FilePath
osuf
myPhaseInputExt Phase
StopLn = FilePath
osuf
myPhaseInputExt Phase
other = Phase -> FilePath
phaseInputExt Phase
other
is_last_phase :: Bool
is_last_phase = Phase
next_phase Phase -> Phase -> Bool
`eqPhase` Phase
stop_phase
keep_this_output :: Bool
keep_this_output =
case Phase
next_phase of
As Bool
_ | Bool
keep_s -> Bool
True
Phase
LlvmOpt | Bool
keep_bc -> Bool
True
Phase
HCc | Bool
keep_hc -> Bool
True
HsPp HscSource
_ | Bool
keep_hscpp -> Bool
True
Phase
_other -> Bool
False
suffix :: FilePath
suffix = Phase -> FilePath
myPhaseInputExt Phase
next_phase
persistent_fn :: IO FilePath
persistent_fn
| Phase
StopLn <- Phase
next_phase = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
odir_persistent
| Bool
otherwise = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
persistent
persistent :: FilePath
persistent = FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suffix
odir_persistent :: FilePath
odir_persistent
| Just ModLocation
loc <- Maybe ModLocation
maybe_location = ModLocation -> FilePath
ml_obj_file ModLocation
loc
| Just FilePath
d <- Maybe FilePath
odir = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
persistent
| Bool
otherwise = FilePath
persistent
llvmOptions :: DynFlags
-> [(String, String)]
llvmOptions :: DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags =
[(FilePath
"-enable-tbaa -tbaa", FilePath
"-enable-tbaa") | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LlvmTBAA DynFlags
dflags ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"-relocation-model=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rmodel
,FilePath
"-relocation-model=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rmodel) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
rmodel)]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"-stack-alignment=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
align)
,FilePath
"-stack-alignment=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
align)) | Int
align Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-mcpu=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mcpu) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
mcpu)
, Bool -> Bool
not ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"-mcpu") (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lc)) ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-mattr=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
attrs) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
attrs) ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-target-abi=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
abi) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
abi) ]
where target :: FilePath
target = PlatformMisc -> FilePath
platformMisc_llvmTarget (PlatformMisc -> FilePath) -> PlatformMisc -> FilePath
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dflags
Just (LlvmTarget FilePath
_ FilePath
mcpu [FilePath]
mattr) = FilePath -> [(FilePath, LlvmTarget)] -> Maybe LlvmTarget
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
target (LlvmConfig -> [(FilePath, LlvmTarget)]
llvmTargets (LlvmConfig -> [(FilePath, LlvmTarget)])
-> LlvmConfig -> [(FilePath, LlvmTarget)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> LlvmConfig
llvmConfig DynFlags
dflags)
rmodel :: FilePath
rmodel | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags = FilePath
"pic"
| DynFlags -> Bool
positionIndependent DynFlags
dflags = FilePath
"pic"
| Way
WayDyn Way -> Set Way -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> Set Way
ways DynFlags
dflags = FilePath
"dynamic-no-pic"
| Bool
otherwise = FilePath
"static"
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
align :: Int
align :: Int
align = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86_64 | DynFlags -> Bool
isAvxEnabled DynFlags
dflags -> Int
32
Arch
_ -> Int
0
attrs :: String
attrs :: FilePath
attrs = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
mattr
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse42" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse2" | Platform -> Bool
isSse2Enabled Platform
platform ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse" | Platform -> Bool
isSseEnabled Platform
platform ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512f" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx2" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512cd"| DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512er"| DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512pf"| DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+bmi" | DynFlags -> Bool
isBmiEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+bmi2" | DynFlags -> Bool
isBmi2Enabled DynFlags
dflags ]
abi :: String
abi :: FilePath
abi = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
Arch
ArchRISCV64 -> FilePath
"lp64d"
Arch
_ -> FilePath
""
runPhase :: PhasePlus
-> FilePath
-> CompPipeline (PhasePlus,
FilePath)
runPhase :: PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)
runPhase (RealPhase (Unlit HscSource
sf)) FilePath
input_fn = do
let
escape :: FilePath -> FilePath
escape (Char
'\\':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
'\"':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\"'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
'\'':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\''Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
c:FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape [] = []
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename (HscSource -> Phase
Cpp HscSource
sf)
let flags :: [Option]
flags = [
FilePath -> Option
GHC.SysTools.Option FilePath
"-h"
, FilePath -> Option
GHC.SysTools.Option (FilePath -> Option) -> FilePath -> Option
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
escape FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runUnlit Logger
logger DynFlags
dflags [Option]
flags
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase (HscSource -> Phase
Cpp HscSource
sf), FilePath
output_fn)
runPhase (RealPhase (Cpp HscSource
sf)) FilePath
input_fn
= do
DynFlags
dflags0 <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
[Located FilePath]
src_opts <- IO [Located FilePath] -> CompPipeline [Located FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Located FilePath] -> CompPipeline [Located FilePath])
-> IO [Located FilePath] -> CompPipeline [Located FilePath]
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO [Located FilePath]
getOptionsFromFile DynFlags
dflags0 FilePath
input_fn
(DynFlags
dflags1, [Located FilePath]
unhandled_flags, [Warn]
warns)
<- IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn]))
-> IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall a b. (a -> b) -> a -> b
$ DynFlags
-> [Located FilePath] -> IO (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
parseDynamicFilePragma DynFlags
dflags0 [Located FilePath]
src_opts
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags1
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ [Located FilePath] -> IO ()
forall (m :: * -> *). MonadIO m => [Located FilePath] -> m ()
checkProcessArgsResult [Located FilePath]
unhandled_flags
if Bool -> Bool
not (Extension -> DynFlags -> Bool
xopt Extension
LangExt.Cpp DynFlags
dflags1) then do
Bool -> CompPipeline () -> CompPipeline ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Pp DynFlags
dflags1) (CompPipeline () -> CompPipeline ())
-> CompPipeline () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Warn] -> IO ()
handleFlagWarnings Logger
logger DynFlags
dflags1 [Warn]
warns
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase (HscSource -> Phase
HsPp HscSource
sf), FilePath
input_fn)
else do
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename (HscSource -> Phase
HsPp HscSource
sf)
HscEnv
hsc_env <- CompPipeline HscEnv
getPipeSession
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp Logger
logger
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
(HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
Bool
True
FilePath
input_fn FilePath
output_fn
[Located FilePath]
src_opts <- IO [Located FilePath] -> CompPipeline [Located FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Located FilePath] -> CompPipeline [Located FilePath])
-> IO [Located FilePath] -> CompPipeline [Located FilePath]
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO [Located FilePath]
getOptionsFromFile DynFlags
dflags0 FilePath
output_fn
(DynFlags
dflags2, [Located FilePath]
unhandled_flags, [Warn]
warns)
<- IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn]))
-> IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall a b. (a -> b) -> a -> b
$ DynFlags
-> [Located FilePath] -> IO (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
parseDynamicFilePragma DynFlags
dflags0 [Located FilePath]
src_opts
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ [Located FilePath] -> IO ()
forall (m :: * -> *). MonadIO m => [Located FilePath] -> m ()
checkProcessArgsResult [Located FilePath]
unhandled_flags
Bool -> CompPipeline () -> CompPipeline ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Pp DynFlags
dflags2) (CompPipeline () -> CompPipeline ())
-> CompPipeline () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Warn] -> IO ()
handleFlagWarnings Logger
logger DynFlags
dflags2 [Warn]
warns
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags2
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase (HscSource -> Phase
HsPp HscSource
sf), FilePath
output_fn)
runPhase (RealPhase (HsPp HscSource
sf)) FilePath
input_fn = do
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Pp DynFlags
dflags) then
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase (HscSource -> Phase
Hsc HscSource
sf), FilePath
input_fn)
else do
PipeEnv{FilePath
src_basename :: FilePath
src_basename :: PipeEnv -> FilePath
src_basename, FilePath
src_suffix :: FilePath
src_suffix :: PipeEnv -> FilePath
src_suffix} <- CompPipeline PipeEnv
getPipeEnv
let orig_fn :: FilePath
orig_fn = FilePath
src_basename FilePath -> FilePath -> FilePath
<.> FilePath
src_suffix
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename (HscSource -> Phase
Hsc HscSource
sf)
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runPp Logger
logger DynFlags
dflags
( [ FilePath -> Option
GHC.SysTools.Option FilePath
orig_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
)
[Located FilePath]
src_opts <- IO [Located FilePath] -> CompPipeline [Located FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Located FilePath] -> CompPipeline [Located FilePath])
-> IO [Located FilePath] -> CompPipeline [Located FilePath]
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO [Located FilePath]
getOptionsFromFile DynFlags
dflags FilePath
output_fn
(DynFlags
dflags1, [Located FilePath]
unhandled_flags, [Warn]
warns)
<- IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn]))
-> IO (DynFlags, [Located FilePath], [Warn])
-> CompPipeline (DynFlags, [Located FilePath], [Warn])
forall a b. (a -> b) -> a -> b
$ DynFlags
-> [Located FilePath] -> IO (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
parseDynamicFilePragma DynFlags
dflags [Located FilePath]
src_opts
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags1
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ [Located FilePath] -> IO ()
forall (m :: * -> *). MonadIO m => [Located FilePath] -> m ()
checkProcessArgsResult [Located FilePath]
unhandled_flags
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Warn] -> IO ()
handleFlagWarnings Logger
logger DynFlags
dflags1 [Warn]
warns
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase (HscSource -> Phase
Hsc HscSource
sf), FilePath
output_fn)
runPhase (RealPhase (Hsc HscSource
src_flavour)) FilePath
input_fn
= do
DynFlags
dflags0 <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
PipeEnv{ stop_phase :: PipeEnv -> Phase
stop_phase=Phase
stop,
src_basename :: PipeEnv -> FilePath
src_basename=FilePath
basename,
src_suffix :: PipeEnv -> FilePath
src_suffix=FilePath
suff } <- CompPipeline PipeEnv
getPipeEnv
let current_dir :: FilePath
current_dir = FilePath -> FilePath
takeDirectory FilePath
basename
new_includes :: IncludeSpecs
new_includes = IncludeSpecs -> [FilePath] -> IncludeSpecs
addImplicitQuoteInclude IncludeSpecs
paths [FilePath
current_dir]
paths :: IncludeSpecs
paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags0
dflags :: DynFlags
dflags = DynFlags
dflags0 { includePaths :: IncludeSpecs
includePaths = IncludeSpecs
new_includes }
DynFlags -> CompPipeline ()
setDynFlags DynFlags
dflags
(Maybe InputFileBuffer
hspp_buf,ModuleName
mod_name,[(Maybe FastString, Located ModuleName)]
imps,[(Maybe FastString, Located ModuleName)]
src_imps) <- IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
-> CompPipeline
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
-> CompPipeline
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)]))
-> IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
-> CompPipeline
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
forall a b. (a -> b) -> a -> b
$ do
InputFileBuffer
buf <- FilePath -> IO InputFileBuffer
hGetStringBuffer FilePath
input_fn
let imp_prelude :: Bool
imp_prelude = Extension -> DynFlags -> Bool
xopt Extension
LangExt.ImplicitPrelude DynFlags
dflags
popts :: ParserOpts
popts = DynFlags -> ParserOpts
initParserOpts DynFlags
dflags
Either
(Messages PsMessage)
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName)
eimps <- ParserOpts
-> Bool
-> InputFileBuffer
-> FilePath
-> FilePath
-> IO
(Either
(Messages PsMessage)
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName))
getImports ParserOpts
popts Bool
imp_prelude InputFileBuffer
buf FilePath
input_fn (FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff)
case Either
(Messages PsMessage)
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName)
eimps of
Left Messages PsMessage
errs -> Messages GhcMessage
-> IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
throwErrors (PsMessage -> GhcMessage
GhcPsMessage (PsMessage -> GhcMessage)
-> Messages PsMessage -> Messages GhcMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages PsMessage
errs)
Right ([(Maybe FastString, Located ModuleName)]
src_imps,[(Maybe FastString, Located ModuleName)]
imps,L SrcSpan
_ ModuleName
mod_name) -> (Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
-> IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
forall (m :: * -> *) a. Monad m => a -> m a
return
(InputFileBuffer -> Maybe InputFileBuffer
forall a. a -> Maybe a
Just InputFileBuffer
buf, ModuleName
mod_name, [(Maybe FastString, Located ModuleName)]
imps, [(Maybe FastString, Located ModuleName)]
src_imps)
ModLocation
location <- HscSource -> ModuleName -> CompPipeline ModLocation
getLocation HscSource
src_flavour ModuleName
mod_name
DynamicTooState
dt_state <- DynFlags -> CompPipeline DynamicTooState
forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
dynamicTooState DynFlags
dflags
let o_file :: FilePath
o_file = ModLocation -> FilePath
ml_obj_file ModLocation
location
dyn_o_file :: Maybe FilePath
dyn_o_file = case DynamicTooState
dt_state of
DynamicTooState
DT_OK
| Bool -> Bool
not (DynFlags -> Bool
writeInterfaceOnlyMode DynFlags
dflags)
-> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (DynFlags -> FilePath -> FilePath
dynamicOutputFile DynFlags
dflags FilePath
o_file)
DynamicTooState
_ -> Maybe FilePath
forall a. Maybe a
Nothing
hi_file :: FilePath
hi_file = ModLocation -> FilePath
ml_hi_file ModLocation
location
hie_file :: FilePath
hie_file = ModLocation -> FilePath
ml_hie_file ModLocation
location
dest_file :: FilePath
dest_file | DynFlags -> Bool
writeInterfaceOnlyMode DynFlags
dflags
= FilePath
hi_file
| Bool
otherwise
= FilePath
o_file
UTCTime
src_timestamp <- IO UTCTime -> CompPipeline UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> CompPipeline UTCTime)
-> IO UTCTime -> CompPipeline UTCTime
forall a b. (a -> b) -> a -> b
$ FilePath -> IO UTCTime
getModificationUTCTime (FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff)
SourceModified
source_unchanged <- IO SourceModified -> CompPipeline SourceModified
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SourceModified -> CompPipeline SourceModified)
-> IO SourceModified -> CompPipeline SourceModified
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not (Phase -> Bool
isStopLn Phase
stop)
then SourceModified -> IO SourceModified
forall (m :: * -> *) a. Monad m => a -> m a
return SourceModified
SourceModified
else do Bool
dest_file_mod <- FilePath -> UTCTime -> IO Bool
sourceModified FilePath
dest_file UTCTime
src_timestamp
Maybe Bool
dyn_file_mod <- (FilePath -> IO Bool) -> Maybe FilePath -> IO (Maybe Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FilePath -> UTCTime -> IO Bool) -> UTCTime -> FilePath -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> UTCTime -> IO Bool
sourceModified UTCTime
src_timestamp) Maybe FilePath
dyn_o_file
Bool
hie_file_mod <- if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WriteHie DynFlags
dflags
then FilePath -> UTCTime -> IO Bool
sourceModified FilePath
hie_file
UTCTime
src_timestamp
else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
if Bool
dest_file_mod Bool -> Bool -> Bool
|| Bool
hie_file_mod Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
dyn_file_mod
then SourceModified -> IO SourceModified
forall (m :: * -> *) a. Monad m => a -> m a
return SourceModified
SourceModified
else SourceModified -> IO SourceModified
forall (m :: * -> *) a. Monad m => a -> m a
return SourceModified
SourceUnmodified
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
Module
mod <- IO Module -> CompPipeline Module
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Module -> CompPipeline Module)
-> IO Module -> CompPipeline Module
forall a b. (a -> b) -> a -> b
$ do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env'
let fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env'
FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder FinderCache
fc HomeUnit
home_unit ModuleName
mod_name ModLocation
location
let
mod_summary :: ModSummary
mod_summary = ModSummary :: Module
-> HscSource
-> ModLocation
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> [(Maybe FastString, Located ModuleName)]
-> [(Maybe FastString, Located ModuleName)]
-> Maybe HsParsedModule
-> FilePath
-> DynFlags
-> Maybe InputFileBuffer
-> ModSummary
ModSummary { ms_mod :: Module
ms_mod = Module
mod,
ms_hsc_src :: HscSource
ms_hsc_src = HscSource
src_flavour,
ms_hspp_file :: FilePath
ms_hspp_file = FilePath
input_fn,
ms_hspp_opts :: DynFlags
ms_hspp_opts = DynFlags
dflags,
ms_hspp_buf :: Maybe InputFileBuffer
ms_hspp_buf = Maybe InputFileBuffer
hspp_buf,
ms_location :: ModLocation
ms_location = ModLocation
location,
ms_hs_date :: UTCTime
ms_hs_date = UTCTime
src_timestamp,
ms_obj_date :: Maybe UTCTime
ms_obj_date = Maybe UTCTime
forall a. Maybe a
Nothing,
ms_parsed_mod :: Maybe HsParsedModule
ms_parsed_mod = Maybe HsParsedModule
forall a. Maybe a
Nothing,
ms_iface_date :: Maybe UTCTime
ms_iface_date = Maybe UTCTime
forall a. Maybe a
Nothing,
ms_hie_date :: Maybe UTCTime
ms_hie_date = Maybe UTCTime
forall a. Maybe a
Nothing,
ms_textual_imps :: [(Maybe FastString, Located ModuleName)]
ms_textual_imps = [(Maybe FastString, Located ModuleName)]
imps,
ms_srcimps :: [(Maybe FastString, Located ModuleName)]
ms_srcimps = [(Maybe FastString, Located ModuleName)]
src_imps }
let msg :: HscEnv -> p -> RecompileRequired -> p -> IO ()
msg HscEnv
hsc_env p
_ RecompileRequired
what p
_ = HscEnv -> RecompileRequired -> IO ()
oneShotMsg HscEnv
hsc_env RecompileRequired
what
HscEnv
plugin_hsc_env' <- IO HscEnv -> CompPipeline HscEnv
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> CompPipeline HscEnv)
-> IO HscEnv -> CompPipeline HscEnv
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env'
IORef (NameEnv TyThing)
type_env_var <- IO (IORef (NameEnv TyThing))
-> CompPipeline (IORef (NameEnv TyThing))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (NameEnv TyThing))
-> CompPipeline (IORef (NameEnv TyThing)))
-> IO (IORef (NameEnv TyThing))
-> CompPipeline (IORef (NameEnv TyThing))
forall a b. (a -> b) -> a -> b
$ NameEnv TyThing -> IO (IORef (NameEnv TyThing))
forall a. a -> IO (IORef a)
newIORef NameEnv TyThing
forall a. NameEnv a
emptyNameEnv
let plugin_hsc_env :: HscEnv
plugin_hsc_env = HscEnv
plugin_hsc_env' { hsc_type_env_var :: Maybe (Module, IORef (NameEnv TyThing))
hsc_type_env_var = (Module, IORef (NameEnv TyThing))
-> Maybe (Module, IORef (NameEnv TyThing))
forall a. a -> Maybe a
Just (Module
mod, IORef (NameEnv TyThing)
type_env_var) }
HscRecompStatus
status <- IO HscRecompStatus -> CompPipeline HscRecompStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscRecompStatus -> CompPipeline HscRecompStatus)
-> IO HscRecompStatus -> CompPipeline HscRecompStatus
forall a b. (a -> b) -> a -> b
$ Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO HscRecompStatus
hscRecompStatus (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
forall p p. HscEnv -> p -> RecompileRequired -> p -> IO ()
msg) HscEnv
plugin_hsc_env ModSummary
mod_summary
SourceModified
source_unchanged Maybe ModIface
forall a. Maybe a
Nothing (Int
1, Int
1)
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
case HscRecompStatus
status of
HscUpToDate ModIface
iface ->
do IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile Logger
logger DynFlags
dflags FilePath
o_file
ModIface -> CompPipeline ()
setIface ModIface
iface
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn, FilePath
o_file)
HscRecompNeeded Maybe Fingerprint
mb_old_hash -> do
(FrontendResult
tc_result, Messages GhcMessage
warnings) <- IO (FrontendResult, Messages GhcMessage)
-> CompPipeline (FrontendResult, Messages GhcMessage)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FrontendResult, Messages GhcMessage)
-> CompPipeline (FrontendResult, Messages GhcMessage))
-> IO (FrontendResult, Messages GhcMessage)
-> CompPipeline (FrontendResult, Messages GhcMessage)
forall a b. (a -> b) -> a -> b
$
HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
hscTypecheckAndGetWarnings HscEnv
plugin_hsc_env ModSummary
mod_summary
[LoadedPlugin] -> [StaticPlugin] -> CompPipeline ()
setPlugins (HscEnv -> [LoadedPlugin]
hsc_plugins HscEnv
plugin_hsc_env)
(HscEnv -> [StaticPlugin]
hsc_static_plugins HscEnv
plugin_hsc_env)
DynFlags -> CompPipeline ()
setDynFlags (HscEnv -> DynFlags
hsc_dflags HscEnv
plugin_hsc_env)
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> PhasePlus
HscPostTc ModSummary
mod_summary FrontendResult
tc_result Messages GhcMessage
warnings Maybe Fingerprint
mb_old_hash,
FilePath -> FilePath
forall a. FilePath -> a
panic FilePath
"HscPostTc doesn't have an input filename")
runPhase (HscPostTc ModSummary
mod_summary FrontendResult
tc_result Messages GhcMessage
tc_warnings Maybe Fingerprint
mb_old_hash) FilePath
_ = do
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
HscBackendAction
hscBackendAction <- IO HscBackendAction -> CompPipeline HscBackendAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscBackendAction -> CompPipeline HscBackendAction)
-> IO HscBackendAction -> CompPipeline HscBackendAction
forall a b. (a -> b) -> a -> b
$ HscEnv -> Hsc HscBackendAction -> IO HscBackendAction
forall a. HscEnv -> Hsc a -> IO a
runHsc HscEnv
hsc_env' (Hsc HscBackendAction -> IO HscBackendAction)
-> Hsc HscBackendAction -> IO HscBackendAction
forall a b. (a -> b) -> a -> b
$ do
ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> Hsc HscBackendAction
hscDesugarAndSimplify ModSummary
mod_summary FrontendResult
tc_result Messages GhcMessage
tc_warnings Maybe Fingerprint
mb_old_hash
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let hscBackendPhase :: PhasePlus
hscBackendPhase = ModSummary -> HscBackendAction -> PhasePlus
HscBackend ModSummary
mod_summary HscBackendAction
hscBackendAction
PhasePlus
next_phase <- case HscBackendAction
hscBackendAction of
HscUpdate ModIface
iface -> do
ModIface -> CompPipeline ()
setIface ModIface
iface
let setLinkableAndStop :: CompPipeline PhasePlus
setLinkableAndStop = do
Bool -> CompPipeline () -> CompPipeline ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HscSource -> Bool
isHsBootOrSig (HscSource -> Bool) -> HscSource -> Bool
forall a b. (a -> b) -> a -> b
$ ModSummary -> HscSource
ms_hsc_src ModSummary
mod_summary) (CompPipeline () -> CompPipeline ())
-> CompPipeline () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$
Linkable -> CompPipeline ()
setLinkable (UTCTime -> Module -> [Unlinked] -> Linkable
LM (ModSummary -> UTCTime
ms_hs_date ModSummary
mod_summary) (ModSummary -> Module
ms_mod ModSummary
mod_summary) [])
PhasePlus -> CompPipeline PhasePlus
forall (m :: * -> *) a. Monad m => a -> m a
return (PhasePlus -> CompPipeline PhasePlus)
-> PhasePlus -> CompPipeline PhasePlus
forall a b. (a -> b) -> a -> b
$ Phase -> PhasePlus
RealPhase Phase
StopLn
case DynFlags -> Backend
backend DynFlags
dflags of
Backend
NoBackend -> CompPipeline PhasePlus
setLinkableAndStop
Backend
Interpreter -> CompPipeline PhasePlus
setLinkableAndStop
Backend
_ -> PhasePlus -> CompPipeline PhasePlus
forall (m :: * -> *) a. Monad m => a -> m a
return PhasePlus
hscBackendPhase
HscBackendAction
_ -> PhasePlus -> CompPipeline PhasePlus
forall (m :: * -> *) a. Monad m => a -> m a
return PhasePlus
hscBackendPhase
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (PhasePlus
next_phase,
FilePath -> FilePath
forall a. FilePath -> a
panic FilePath
"HscBackend doesn't have an input filename")
runPhase (HscBackend ModSummary
mod_summary HscBackendAction
result) FilePath
_ = do
let mod_name :: ModuleName
mod_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
mod_summary)
src_flavour :: HscSource
src_flavour = (ModSummary -> HscSource
ms_hsc_src ModSummary
mod_summary)
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
ModLocation
location <- HscSource -> ModuleName -> CompPipeline ModLocation
getLocation HscSource
src_flavour ModuleName
mod_name
ModLocation -> CompPipeline ()
setModLocation ModLocation
location
let o_file :: FilePath
o_file = ModLocation -> FilePath
ml_obj_file ModLocation
location
next_phase :: Phase
next_phase = HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
src_flavour (DynFlags -> Backend
backend DynFlags
dflags)
case HscBackendAction
result of
HscUpdate ModIface
iface ->
do
case HscSource
src_flavour of
HscSource
HsigFile -> do
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
let input_fn :: FilePath
input_fn = FilePath -> Maybe FilePath -> FilePath
forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"runPhase" (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location)
basename :: FilePath
basename = FilePath -> FilePath
dropExtension FilePath
input_fn
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags
-> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
compileEmptyStub DynFlags
dflags HscEnv
hsc_env' FilePath
basename ModLocation
location ModuleName
mod_name
HscSource
HsBootFile -> IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile Logger
logger DynFlags
dflags FilePath
o_file
HscSource
HsSrcFile -> FilePath -> CompPipeline ()
forall a. FilePath -> a
panic FilePath
"HscUpdate not relevant for HscSrcFile"
ModIface -> CompPipeline ()
setIface ModIface
iface
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn, FilePath
o_file)
HscRecomp { hscs_guts :: HscBackendAction -> CgGuts
hscs_guts = CgGuts
cgguts,
hscs_mod_location :: HscBackendAction -> ModLocation
hscs_mod_location = ModLocation
mod_location,
hscs_partial_iface :: HscBackendAction -> PartialModIface
hscs_partial_iface = PartialModIface
partial_iface,
hscs_old_iface_hash :: HscBackendAction -> Maybe Fingerprint
hscs_old_iface_hash = Maybe Fingerprint
mb_old_iface_hash
}
-> case DynFlags -> Backend
backend DynFlags
dflags of
Backend
NoBackend -> FilePath -> CompPipeline (PhasePlus, FilePath)
forall a. FilePath -> a
panic FilePath
"HscRecomp not relevant for NoBackend"
Backend
Interpreter -> do
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
ModIface
final_iface <- IO ModIface -> CompPipeline ModIface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModIface -> CompPipeline ModIface)
-> IO ModIface -> CompPipeline ModIface
forall a b. (a -> b) -> a -> b
$ HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env' PartialModIface
partial_iface Maybe CgInfos
forall a. Maybe a
Nothing
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Bool
-> ModIface
-> Maybe Fingerprint
-> ModLocation
-> IO ()
hscMaybeWriteIface Logger
logger DynFlags
dflags Bool
True ModIface
final_iface Maybe Fingerprint
mb_old_iface_hash ModLocation
location
(Maybe FilePath
hasStub, CompiledByteCode
comp_bc, [SptEntry]
spt_entries) <- IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-> CompPipeline (Maybe FilePath, CompiledByteCode, [SptEntry])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-> CompPipeline (Maybe FilePath, CompiledByteCode, [SptEntry]))
-> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-> CompPipeline (Maybe FilePath, CompiledByteCode, [SptEntry])
forall a b. (a -> b) -> a -> b
$ HscEnv
-> CgGuts
-> ModLocation
-> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
hscInteractive HscEnv
hsc_env' CgGuts
cgguts ModLocation
mod_location
[Unlinked]
stub_o <- IO [Unlinked] -> CompPipeline [Unlinked]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Unlinked] -> CompPipeline [Unlinked])
-> IO [Unlinked] -> CompPipeline [Unlinked]
forall a b. (a -> b) -> a -> b
$ case Maybe FilePath
hasStub of
Maybe FilePath
Nothing -> [Unlinked] -> IO [Unlinked]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just FilePath
stub_c -> do
FilePath
stub_o <- HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env' FilePath
stub_c
[Unlinked] -> IO [Unlinked]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> Unlinked
DotO FilePath
stub_o]
let hs_unlinked :: [Unlinked]
hs_unlinked = [CompiledByteCode -> [SptEntry] -> Unlinked
BCOs CompiledByteCode
comp_bc [SptEntry]
spt_entries]
unlinked_time :: UTCTime
unlinked_time = ModSummary -> UTCTime
ms_hs_date ModSummary
mod_summary
let !linkable :: Linkable
linkable = UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
unlinked_time (ModSummary -> Module
ms_mod ModSummary
mod_summary)
([Unlinked]
hs_unlinked [Unlinked] -> [Unlinked] -> [Unlinked]
forall a. [a] -> [a] -> [a]
++ [Unlinked]
stub_o)
ModIface -> CompPipeline ()
setIface ModIface
final_iface
Linkable -> CompPipeline ()
setLinkable Linkable
linkable
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn,
FilePath -> FilePath
forall a. FilePath -> a
panic FilePath
"Interpreter backend doesn't have an output file")
Backend
_ -> do
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
(FilePath
outputFilename, Maybe FilePath
mStub, [(ForeignSrcLang, FilePath)]
foreign_files, CgInfos
cg_infos) <- IO
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos))
-> IO
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
forall a b. (a -> b) -> a -> b
$
HscEnv
-> CgGuts
-> ModLocation
-> FilePath
-> IO
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
hscGenHardCode HscEnv
hsc_env' CgGuts
cgguts ModLocation
mod_location FilePath
output_fn
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env'
ModIface
final_iface <- IO ModIface -> CompPipeline ModIface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env' PartialModIface
partial_iface (CgInfos -> Maybe CgInfos
forall a. a -> Maybe a
Just CgInfos
cg_infos))
ModIface -> CompPipeline ()
setIface ModIface
final_iface
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Bool
-> ModIface
-> Maybe Fingerprint
-> ModLocation
-> IO ()
hscMaybeWriteIface Logger
logger DynFlags
dflags Bool
False ModIface
final_iface Maybe Fingerprint
mb_old_iface_hash ModLocation
mod_location
Maybe FilePath
stub_o <- IO (Maybe FilePath) -> CompPipeline (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO FilePath) -> Maybe FilePath -> IO (Maybe FilePath)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env') Maybe FilePath
mStub)
[FilePath]
foreign_os <- IO [FilePath] -> CompPipeline [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> CompPipeline [FilePath])
-> IO [FilePath] -> CompPipeline [FilePath]
forall a b. (a -> b) -> a -> b
$
((ForeignSrcLang, FilePath) -> IO FilePath)
-> [(ForeignSrcLang, FilePath)] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ForeignSrcLang -> FilePath -> IO FilePath)
-> (ForeignSrcLang, FilePath) -> IO FilePath
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign HscEnv
hsc_env')) [(ForeignSrcLang, FilePath)]
foreign_files
[FilePath] -> CompPipeline ()
setForeignOs ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] FilePath -> [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
stub_o [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
foreign_os)
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
outputFilename)
runPhase (RealPhase Phase
CmmCpp) FilePath
input_fn = do
HscEnv
hsc_env <- CompPipeline HscEnv
getPipeSession
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
Cmm
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp Logger
logger
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
(HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
Bool
False
FilePath
input_fn FilePath
output_fn
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
Cmm, FilePath
output_fn)
runPhase (RealPhase Phase
Cmm) FilePath
input_fn = do
HscEnv
hsc_env <- CompPipeline HscEnv
getPipeSession
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let next_phase :: Phase
next_phase = HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
HsSrcFile (DynFlags -> Backend
backend DynFlags
dflags)
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
PipeState{HscEnv
hsc_env :: HscEnv
hsc_env :: PipeState -> HscEnv
hsc_env} <- CompPipeline PipeState
getPipeState
Maybe FilePath
mstub <- IO (Maybe FilePath) -> CompPipeline (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> CompPipeline (Maybe FilePath))
-> IO (Maybe FilePath) -> CompPipeline (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ HscEnv -> FilePath -> FilePath -> IO (Maybe FilePath)
hscCompileCmmFile HscEnv
hsc_env FilePath
input_fn FilePath
output_fn
Maybe FilePath
stub_o <- IO (Maybe FilePath) -> CompPipeline (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO FilePath) -> Maybe FilePath -> IO (Maybe FilePath)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env) Maybe FilePath
mstub)
[FilePath] -> CompPipeline ()
setForeignOs (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
stub_o)
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
output_fn)
runPhase (RealPhase Phase
cc_phase) FilePath
input_fn
| (Phase -> Bool) -> [Phase] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Phase
cc_phase Phase -> Phase -> Bool
`eqPhase`) [Phase
Cc, Phase
Ccxx, Phase
HCc, Phase
Cobjc, Phase
Cobjcxx]
= do
HscEnv
hsc_env <- CompPipeline HscEnv
getPipeSession
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
let hcc :: Bool
hcc = Phase
cc_phase Phase -> Phase -> Bool
`eqPhase` Phase
HCc
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags
[UnitId]
pkgs <- if Bool
hcc then IO [UnitId] -> CompPipeline [UnitId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UnitId] -> CompPipeline [UnitId])
-> IO [UnitId] -> CompPipeline [UnitId]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [UnitId]
getHCFilePackages FilePath
input_fn else [UnitId] -> CompPipeline [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[UnitInfo]
ps <- IO [UnitInfo] -> CompPipeline [UnitInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UnitInfo] -> CompPipeline [UnitInfo])
-> IO [UnitInfo] -> CompPipeline [UnitInfo]
forall a b. (a -> b) -> a -> b
$ MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs)
let pkg_include_dirs :: [FilePath]
pkg_include_dirs = [UnitInfo] -> [FilePath]
collectIncludeDirs [UnitInfo]
ps
let include_paths_global :: [FilePath]
include_paths_global = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_include_dirs)
let include_paths_quote :: [FilePath]
include_paths_quote = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths)
let include_paths :: [FilePath]
include_paths = [FilePath]
include_paths_quote [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths_global
let more_preprocessor_opts :: [FilePath]
more_preprocessor_opts = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [FilePath
"-Xpreprocessor", FilePath
i]
| Bool -> Bool
not Bool
hcc
, FilePath
i <- DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_P
]
let gcc_extra_viac_flags :: [FilePath]
gcc_extra_viac_flags = DynFlags -> [FilePath]
extraGccViaCFlags DynFlags
dflags
let pic_c_flags :: [FilePath]
pic_c_flags = DynFlags -> [FilePath]
picCCOpts DynFlags
dflags
let verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
let pkg_extra_cc_opts :: [FilePath]
pkg_extra_cc_opts
| Bool
hcc = []
| Bool
otherwise = [UnitInfo] -> [FilePath]
collectExtraCcOpts [UnitInfo]
ps
let framework_paths :: [FilePath]
framework_paths
| Platform -> Bool
platformUsesFrameworks Platform
platform
= let pkgFrameworkPaths :: [FilePath]
pkgFrameworkPaths = [UnitInfo] -> [FilePath]
collectFrameworksDirs [UnitInfo]
ps
cmdlineFrameworkPaths :: [FilePath]
cmdlineFrameworkPaths = DynFlags -> [FilePath]
frameworkPaths DynFlags
dflags
in (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-F"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath]
cmdlineFrameworkPaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgFrameworkPaths)
| Bool
otherwise
= []
let cc_opt :: [FilePath]
cc_opt | DynFlags -> Int
optLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = [ FilePath
"-O2" ]
| DynFlags -> Int
optLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = [ FilePath
"-O" ]
| Bool
otherwise = []
let next_phase :: Phase
next_phase = Bool -> Phase
As Bool
False
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
let
more_hcc_opts :: [FilePath]
more_hcc_opts =
(if Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
&&
Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExcessPrecision DynFlags
dflags)
then [ FilePath
"-ffloat-store" ]
else []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"-fno-strict-aliasing"]
FilePath
ghcVersionH <- IO FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> CompPipeline FilePath)
-> IO FilePath -> CompPipeline FilePath
forall a b. (a -> b) -> a -> b
$ DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Maybe ForeignSrcLang
-> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCc (Phase -> Maybe ForeignSrcLang
phaseForeignLanguage Phase
cc_phase) Logger
logger TmpFs
tmpfs DynFlags
dflags (
[ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option (
[FilePath]
pic_c_flags
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 Bool -> Bool -> Bool
&&
HomeUnit -> UnitId -> Bool
forall u. GenHomeUnit u -> UnitId -> Bool
isHomeUnitId HomeUnit
home_unit UnitId
baseUnitId
then [ FilePath
"-DCOMPILING_BASE_PACKAGE" ]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchSPARC
then [FilePath
"-mcpu=v9"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if (Phase
cc_phase Phase -> Phase -> Bool
forall a. Eq a => a -> a -> Bool
/= Phase
Ccxx Bool -> Bool -> Bool
&& Phase
cc_phase Phase -> Phase -> Bool
forall a. Eq a => a -> a -> Bool
/= Phase
Cobjcxx)
then [FilePath
"-Wimplicit"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
hcc
then [FilePath]
gcc_extra_viac_flags [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
more_hcc_opts
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verbFlags
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-S" ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cc_opt
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-include", FilePath
ghcVersionH ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
framework_paths
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
more_preprocessor_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_extra_cc_opts
))
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
output_fn)
runPhase (RealPhase (As Bool
with_cpp)) FilePath
input_fn
= do
HscEnv
hsc_env <- CompPipeline HscEnv
getPipeSession
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
let (Logger -> DynFlags -> [Option] -> IO ()
as_prog, CompPipeline CompilerInfo
get_asm_info) | DynFlags -> Backend
backend DynFlags
dflags Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
LLVM
, Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
= (Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runClang, CompilerInfo -> CompPipeline CompilerInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerInfo
Clang)
| Bool
otherwise
= (Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runAs, IO CompilerInfo -> CompPipeline CompilerInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompilerInfo -> CompPipeline CompilerInfo)
-> IO CompilerInfo -> CompPipeline CompilerInfo
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> IO CompilerInfo
getAssemblerInfo Logger
logger DynFlags
dflags)
CompilerInfo
asmInfo <- CompPipeline CompilerInfo
get_asm_info
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags
let pic_c_flags :: [FilePath]
pic_c_flags = DynFlags -> [FilePath]
picCCOpts DynFlags
dflags
Phase
next_phase <- CompPipeline Phase
maybeMergeForeign
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
output_fn)
let global_includes :: [Option]
global_includes = [ FilePath -> Option
GHC.SysTools.Option (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
| FilePath
p <- IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths ]
let local_includes :: [Option]
local_includes = [ FilePath -> Option
GHC.SysTools.Option (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
| FilePath
p <- IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths]
let runAssembler :: FilePath -> FilePath -> CompPipeline ()
runAssembler FilePath
inputFilename FilePath
outputFilename
= IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$
FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m a
withAtomicRename FilePath
outputFilename ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
temp_outputFilename ->
Logger -> DynFlags -> [Option] -> IO ()
as_prog
Logger
logger DynFlags
dflags
([Option]
local_includes [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
global_includes
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
pic_c_flags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-Wa,-mbig-obj"
| Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit (DynFlags -> Platform
targetPlatform DynFlags
dflags)
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchSPARC
then [FilePath -> Option
GHC.SysTools.Option FilePath
"-mcpu=v9"]
else [])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if (CompilerInfo -> Bool) -> [CompilerInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CompilerInfo
asmInfo CompilerInfo -> CompilerInfo -> Bool
forall a. Eq a => a -> a -> Bool
==) [CompilerInfo
Clang, CompilerInfo
AppleClang, CompilerInfo
AppleClang51]
then [FilePath -> Option
GHC.SysTools.Option FilePath
"-Qunused-arguments"]
else [])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-x"
, if Bool
with_cpp
then FilePath -> Option
GHC.SysTools.Option FilePath
"assembler-with-cpp"
else FilePath -> Option
GHC.SysTools.Option FilePath
"assembler"
, FilePath -> Option
GHC.SysTools.Option FilePath
"-c"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
inputFilename
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
temp_outputFilename
])
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
4 (FilePath -> SDoc
text FilePath
"Running the assembler")
FilePath -> FilePath -> CompPipeline ()
runAssembler FilePath
input_fn FilePath
output_fn
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
output_fn)
runPhase (RealPhase Phase
LlvmOpt) FilePath
input_fn = do
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let
optIdx :: Int
optIdx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> Int
optLevel DynFlags
dflags
llvmOpts :: FilePath
llvmOpts = case Int -> [(Int, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
optIdx ([(Int, FilePath)] -> Maybe FilePath)
-> [(Int, FilePath)] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ LlvmConfig -> [(Int, FilePath)]
llvmPasses (LlvmConfig -> [(Int, FilePath)])
-> LlvmConfig -> [(Int, FilePath)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> LlvmConfig
llvmConfig DynFlags
dflags of
Just FilePath
passes -> FilePath
passes
Maybe FilePath
Nothing -> FilePath -> FilePath
forall a. FilePath -> a
panic (FilePath
"runPhase LlvmOpt: llvm-passes file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"is missing passes for level "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
optIdx)
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> (([FilePath], [FilePath]) -> [[FilePath]])
-> ([FilePath], [FilePath])
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
words ([FilePath] -> [[FilePath]])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst
(([FilePath], [FilePath]) -> [Option])
-> ([FilePath], [FilePath]) -> [Option]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip (DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags)
optFlag :: [Option]
optFlag = if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lo)
then (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
LlvmLlc
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLlvmOpt Logger
logger DynFlags
dflags
( [Option]
optFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
defaultOptions [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++
[ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn]
)
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
LlvmLlc, FilePath
output_fn)
runPhase (RealPhase Phase
LlvmLlc) FilePath
input_fn = do
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let
llvmOpts :: FilePath
llvmOpts = case DynFlags -> Int
optLevel DynFlags
dflags of
Int
0 -> FilePath
"-O1"
Int
1 -> FilePath
"-O1"
Int
_ -> FilePath
"-O2"
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
words ([FilePath] -> [FilePath])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd
(([FilePath], [FilePath]) -> [Option])
-> ([FilePath], [FilePath]) -> [Option]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip (DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags)
optFlag :: [Option]
optFlag = if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lc)
then (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
Phase
next_phase <- if
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_NoLlvmMangler DynFlags
dflags -> Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Phase
As Bool
False)
| Bool
otherwise -> Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
LlvmMangle
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLlvmLlc Logger
logger DynFlags
dflags
( [Option]
optFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
defaultOptions
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
)
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
output_fn)
runPhase (RealPhase Phase
LlvmMangle) FilePath
input_fn = do
let next_phase :: Phase
next_phase = Bool -> Phase
As Bool
False
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> FilePath -> FilePath -> IO ()
llvmFixupAsm Logger
logger DynFlags
dflags FilePath
input_fn FilePath
output_fn
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
next_phase, FilePath
output_fn)
runPhase (RealPhase Phase
MergeForeign) FilePath
input_fn = do
PipeState{[FilePath]
foreign_os :: [FilePath]
foreign_os :: PipeState -> [FilePath]
foreign_os,HscEnv
hsc_env :: HscEnv
hsc_env :: PipeState -> HscEnv
hsc_env} <- CompPipeline PipeState
getPipeState
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
StopLn
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
output_fn)
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
foreign_os
then FilePath -> CompPipeline (PhasePlus, FilePath)
forall a. FilePath -> a
panic FilePath
"runPhase(MergeForeign): no foreign objects"
else do
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- CompPipeline Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles Logger
logger TmpFs
tmpfs DynFlags
dflags (FilePath
input_fn FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
foreign_os) FilePath
output_fn
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn, FilePath
output_fn)
runPhase (RealPhase Phase
other) FilePath
_input_fn =
FilePath -> CompPipeline (PhasePlus, FilePath)
forall a. FilePath -> a
panic (FilePath
"runPhase: don't know how to run phase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Phase -> FilePath
forall a. Show a => a -> FilePath
show Phase
other)
maybeMergeForeign :: CompPipeline Phase
maybeMergeForeign :: CompPipeline Phase
maybeMergeForeign
= do
PipeState{[FilePath]
foreign_os :: [FilePath]
foreign_os :: PipeState -> [FilePath]
foreign_os} <- CompPipeline PipeState
getPipeState
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
foreign_os then Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
StopLn else Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
MergeForeign
getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation
getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation
getLocation HscSource
src_flavour ModuleName
mod_name = do
DynFlags
dflags <- CompPipeline DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
PipeEnv{ src_basename :: PipeEnv -> FilePath
src_basename=FilePath
basename,
src_suffix :: PipeEnv -> FilePath
src_suffix=FilePath
suff } <- CompPipeline PipeEnv
getPipeEnv
ModLocation
location1 <- IO ModLocation -> CompPipeline ModLocation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModLocation -> CompPipeline ModLocation)
-> IO ModLocation -> CompPipeline ModLocation
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocation2 DynFlags
dflags ModuleName
mod_name FilePath
basename FilePath
suff
let location2 :: ModLocation
location2
| HscSource
HsBootFile <- HscSource
src_flavour = ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
location1
| Bool
otherwise = ModLocation
location1
let ohi :: Maybe FilePath
ohi = DynFlags -> Maybe FilePath
outputHi DynFlags
dflags
location3 :: ModLocation
location3 | Just FilePath
fn <- Maybe FilePath
ohi = ModLocation
location2{ ml_hi_file :: FilePath
ml_hi_file = FilePath
fn }
| Bool
otherwise = ModLocation
location2
let expl_o_file :: Maybe FilePath
expl_o_file = DynFlags -> Maybe FilePath
outputFile DynFlags
dflags
location4 :: ModLocation
location4 | Just FilePath
ofile <- Maybe FilePath
expl_o_file
, GhcLink -> Bool
isNoLink (DynFlags -> GhcLink
ghcLink DynFlags
dflags)
= ModLocation
location3 { ml_obj_file :: FilePath
ml_obj_file = FilePath
ofile }
| Bool
otherwise = ModLocation
location3
ModLocation -> CompPipeline ModLocation
forall (m :: * -> *) a. Monad m => a -> m a
return ModLocation
location4
getHCFilePackages :: FilePath -> IO [UnitId]
getHCFilePackages :: FilePath -> IO [UnitId]
getHCFilePackages FilePath
filename =
IO Handle
-> (Handle -> IO ()) -> (Handle -> IO [UnitId]) -> IO [UnitId]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (FilePath -> IOMode -> IO Handle
openFile FilePath
filename IOMode
ReadMode) Handle -> IO ()
hClose ((Handle -> IO [UnitId]) -> IO [UnitId])
-> (Handle -> IO [UnitId]) -> IO [UnitId]
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
FilePath
l <- Handle -> IO FilePath
hGetLine Handle
h
case FilePath
l of
Char
'/':Char
'*':Char
' ':Char
'G':Char
'H':Char
'C':Char
'_':Char
'P':Char
'A':Char
'C':Char
'K':Char
'A':Char
'G':Char
'E':Char
'S':FilePath
rest ->
[UnitId] -> IO [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> UnitId) -> [FilePath] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> UnitId
stringToUnitId (FilePath -> [FilePath]
words FilePath
rest))
FilePath
_other ->
[UnitId] -> IO [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkDynLibCheck :: Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLibCheck Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Bool
haveRtsOptsFlags DynFlags
dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> LogAction
putLogMsg Logger
logger DynFlags
dflags MessageClass
MCInfo SrcSpan
noSrcSpan
(SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultUserStyle
(FilePath -> SDoc
text FilePath
"Warning: -rtsopts and -with-rtsopts have no effect with -shared." SDoc -> SDoc -> SDoc
$$
FilePath -> SDoc
text FilePath
" Call hs_init_ghc() from your main() function to set these options.")
Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLib Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units
doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()
doCpp :: Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
raw FilePath
input_fn FilePath
output_fn = do
let hscpp_opts :: [FilePath]
hscpp_opts = DynFlags -> [FilePath]
picPOpts DynFlags
dflags
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags
let unit_state :: UnitState
unit_state = UnitEnv -> UnitState
ue_units UnitEnv
unit_env
[FilePath]
pkg_include_dirs <- MaybeErr UnitErr [FilePath] -> IO [FilePath]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr
([UnitInfo] -> [FilePath]
collectIncludeDirs ([UnitInfo] -> [FilePath])
-> MaybeErr UnitErr [UnitInfo] -> MaybeErr UnitErr [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitEnv -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo UnitEnv
unit_env)
let include_paths_global :: [FilePath]
include_paths_global = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_include_dirs)
let include_paths_quote :: [FilePath]
include_paths_quote = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths)
let include_paths :: [FilePath]
include_paths = [FilePath]
include_paths_quote [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths_global
let verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
let cpp_prog :: [Option] -> IO ()
cpp_prog [Option]
args | Bool
raw = Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCpp Logger
logger DynFlags
dflags [Option]
args
| Bool
otherwise = Maybe ForeignSrcLang
-> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCc Maybe ForeignSrcLang
forall a. Maybe a
Nothing Logger
logger TmpFs
tmpfs DynFlags
dflags
(FilePath -> Option
GHC.SysTools.Option FilePath
"-E" Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args)
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
targetArch :: FilePath
targetArch = Arch -> FilePath
stringEncodeArch (Arch -> FilePath) -> Arch -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> Arch
platformArch Platform
platform
targetOS :: FilePath
targetOS = OS -> FilePath
stringEncodeOS (OS -> FilePath) -> OS -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> OS
platformOS Platform
platform
isWindows :: Bool
isWindows = Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
let target_defs :: [FilePath]
target_defs =
[ FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HOST_OS ++ "_BUILD_OS",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HOST_ARCH ++ "_BUILD_ARCH",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetOS FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_HOST_OS",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetArch FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_HOST_ARCH" ]
let io_manager_defs :: [FilePath]
io_manager_defs =
[ FilePath
"-D__IO_MANAGER_WINIO__=1" | Bool
isWindows ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__IO_MANAGER_MIO__=1" ]
let sse_defs :: [FilePath]
sse_defs =
[ FilePath
"-D__SSE__" | Platform -> Bool
isSseEnabled Platform
platform ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__SSE2__" | Platform -> Bool
isSse2Enabled Platform
platform ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__SSE4_2__" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
let avx_defs :: [FilePath]
avx_defs =
[ FilePath
"-D__AVX__" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX2__" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512CD__" | DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512ER__" | DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512F__" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512PF__" | DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath]
backend_defs <- Logger -> DynFlags -> IO [FilePath]
getBackendDefs Logger
logger DynFlags
dflags
let th_defs :: [FilePath]
th_defs = [ FilePath
"-D__GLASGOW_HASKELL_TH__" ]
FilePath
ghcVersionH <- DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env
let hsSourceCppOpts :: [FilePath]
hsSourceCppOpts = [ FilePath
"-include", FilePath
ghcVersionH ]
let uids :: [Unit]
uids = UnitState -> [Unit]
explicitUnits UnitState
unit_state
pkgs :: [UnitInfo]
pkgs = [Maybe UnitInfo] -> [UnitInfo]
forall a. [Maybe a] -> [a]
catMaybes ((Unit -> Maybe UnitInfo) -> [Unit] -> [Maybe UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> Unit -> Maybe UnitInfo
lookupUnit UnitState
unit_state) [Unit]
uids)
[Option]
mb_macro_include <-
if Bool -> Bool
not ([UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
pkgs) Bool -> Bool -> Bool
&& GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_VersionMacros DynFlags
dflags
then do FilePath
macro_stub <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"h"
FilePath -> FilePath -> IO ()
writeFile FilePath
macro_stub ([UnitInfo] -> FilePath
generatePackageVersionMacros [UnitInfo]
pkgs)
[Option] -> IO [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"-include" FilePath
macro_stub]
else [Option] -> IO [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Option] -> IO ()
cpp_prog ( (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
include_paths
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
hsSourceCppOpts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
target_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
backend_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
th_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
hscpp_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
sse_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
avx_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
io_manager_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
mb_macro_include
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-x"
, FilePath -> Option
GHC.SysTools.Option FilePath
"assembler-with-cpp"
, FilePath -> Option
GHC.SysTools.Option FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
])
getBackendDefs :: Logger -> DynFlags -> IO [String]
getBackendDefs :: Logger -> DynFlags -> IO [FilePath]
getBackendDefs Logger
logger DynFlags
dflags | DynFlags -> Backend
backend DynFlags
dflags Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
LLVM = do
Maybe LlvmVersion
llvmVer <- Logger -> DynFlags -> IO (Maybe LlvmVersion)
figureLlvmVersion Logger
logger DynFlags
dflags
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ case (LlvmVersion -> [Int]) -> Maybe LlvmVersion -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LlvmVersion -> [Int]
llvmVersionList Maybe LlvmVersion
llvmVer of
Just [Int
m] -> [ FilePath
"-D__GLASGOW_HASKELL_LLVM__=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> FilePath
format (Int
m,Int
0) ]
Just (Int
m:Int
n:[Int]
_) -> [ FilePath
"-D__GLASGOW_HASKELL_LLVM__=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> FilePath
format (Int
m,Int
n) ]
Maybe [Int]
_ -> []
where
format :: (Int, Int) -> FilePath
format (Int
major, Int
minor)
| Int
minor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"getBackendDefs: Unsupported minor version"
| Bool
otherwise = Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
major Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minor :: Int)
getBackendDefs Logger
_ DynFlags
_ =
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
generatePackageVersionMacros :: [UnitInfo] -> String
generatePackageVersionMacros :: [UnitInfo] -> FilePath
generatePackageVersionMacros [UnitInfo]
pkgs = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath -> FilePath -> Version -> FilePath
generateMacros FilePath
"" FilePath
pkgname Version
version
| UnitInfo
pkg <- [UnitInfo]
pkgs
, let version :: Version
version = UnitInfo -> Version
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitPackageVersion UnitInfo
pkg
pkgname :: FilePath
pkgname = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (UnitInfo -> FilePath
forall u. GenUnitInfo u -> FilePath
unitPackageNameString UnitInfo
pkg)
]
fixchar :: Char -> Char
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c = Char
c
generateMacros :: String -> String -> Version -> String
generateMacros :: FilePath -> FilePath -> Version -> FilePath
generateMacros FilePath
prefix FilePath
name Version
version =
[FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[FilePath
"#define ", FilePath
prefix, FilePath
"VERSION_",FilePath
name,FilePath
" ",FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Version -> FilePath
showVersion Version
version),FilePath
"\n"
,FilePath
"#define MIN_", FilePath
prefix, FilePath
"VERSION_",FilePath
name,FilePath
"(major1,major2,minor) (\\\n"
,FilePath
" (major1) < ",FilePath
major1,FilePath
" || \\\n"
,FilePath
" (major1) == ",FilePath
major1,FilePath
" && (major2) < ",FilePath
major2,FilePath
" || \\\n"
,FilePath
" (major1) == ",FilePath
major1,FilePath
" && (major2) == ",FilePath
major2,FilePath
" && (minor) <= ",FilePath
minor,FilePath
")"
,FilePath
"\n\n"
]
where
(FilePath
major1:FilePath
major2:FilePath
minor:[FilePath]
_) = (Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show (Version -> [Int]
versionBranch Version
version [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles Logger
logger TmpFs
tmpfs DynFlags
dflags [FilePath]
o_files FilePath
output_fn = do
let toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
ldIsGnuLd :: Bool
ldIsGnuLd = ToolSettings -> Bool
toolSettings_ldIsGnuLd ToolSettings
toolSettings'
osInfo :: OS
osInfo = Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)
ld_r :: [Option] -> IO ()
ld_r [Option]
args = Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runMergeObjects Logger
logger TmpFs
tmpfs DynFlags
dflags (
[[Option]] -> [Option]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [FilePath -> Option
GHC.SysTools.Option FilePath
"--oformat", FilePath -> Option
GHC.SysTools.Option FilePath
"pe-bigobj-x86-64"]
| OS
OSMinGW32 OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
osInfo
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit (DynFlags -> Platform
targetPlatform DynFlags
dflags)
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
ld_build_id
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-o",
FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args)
ld_build_id :: [FilePath]
ld_build_id | ToolSettings -> Bool
toolSettings_ldSupportsBuildId ToolSettings
toolSettings' = [FilePath
"--build-id=none"]
| Bool
otherwise = []
if Bool
ldIsGnuLd
then do
FilePath
script <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"ldscript"
FilePath
cwd <- IO FilePath
getCurrentDirectory
let o_files_abs :: [FilePath]
o_files_abs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
x) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"") [FilePath]
o_files
FilePath -> FilePath -> IO ()
writeFile FilePath
script (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"INPUT(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
o_files_abs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
[Option] -> IO ()
ld_r [FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
script]
else if ToolSettings -> Bool
toolSettings_ldSupportsFilelist ToolSettings
toolSettings'
then do
FilePath
filelist <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"filelist"
FilePath -> FilePath -> IO ()
writeFile FilePath
filelist (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
o_files
[Option] -> IO ()
ld_r [FilePath -> Option
GHC.SysTools.Option FilePath
"-filelist",
FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
filelist]
else
[Option] -> IO ()
ld_r ((FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"") [FilePath]
o_files)
writeInterfaceOnlyMode :: DynFlags -> Bool
writeInterfaceOnlyMode :: DynFlags -> Bool
writeInterfaceOnlyMode DynFlags
dflags =
GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WriteInterface DynFlags
dflags Bool -> Bool -> Bool
&&
Backend
NoBackend Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== DynFlags -> Backend
backend DynFlags
dflags
sourceModified :: FilePath
-> UTCTime
-> IO Bool
sourceModified :: FilePath -> UTCTime -> IO Bool
sourceModified FilePath
dest_file UTCTime
src_timestamp = do
Bool
dest_file_exists <- FilePath -> IO Bool
doesFileExist FilePath
dest_file
if Bool -> Bool
not Bool
dest_file_exists
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do UTCTime
t2 <- FilePath -> IO UTCTime
getModificationUTCTime FilePath
dest_file
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
t2 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
src_timestamp)
hscPostBackendPhase :: HscSource -> Backend -> Phase
hscPostBackendPhase :: HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
HsBootFile Backend
_ = Phase
StopLn
hscPostBackendPhase HscSource
HsigFile Backend
_ = Phase
StopLn
hscPostBackendPhase HscSource
_ Backend
bcknd =
case Backend
bcknd of
Backend
ViaC -> Phase
HCc
Backend
NCG -> Bool -> Phase
As Bool
False
Backend
LLVM -> Phase
LlvmOpt
Backend
NoBackend -> Phase
StopLn
Backend
Interpreter -> Phase
StopLn
touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile Logger
logger DynFlags
dflags FilePath
path = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
path
Logger -> DynFlags -> FilePath -> FilePath -> IO ()
GHC.SysTools.touch Logger
logger DynFlags
dflags FilePath
"Touching object file" FilePath
path
getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env = do
[FilePath]
candidates <- case DynFlags -> Maybe FilePath
ghcVersionFile DynFlags
dflags of
Just FilePath
path -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
Maybe FilePath
Nothing -> do
[UnitInfo]
ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId
rtsUnitId])
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> FilePath -> FilePath
</> FilePath
"ghcversion.h") (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnitInfo] -> [FilePath]
collectIncludeDirs [UnitInfo]
ps)
[FilePath]
found <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
candidates
case [FilePath]
found of
[] -> GhcException -> IO FilePath
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
InstallationError
(FilePath
"ghcversion.h missing; tried: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
candidates))
(FilePath
x:[FilePath]
_) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x