{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}
module DriverPipeline (
oneShot, compileFile,
linkBinary,
preprocess,
compileOne, compileOne',
link,
PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,
hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
runPhase, exeFileName,
maybeCreateManifest,
doCpp,
linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
) where
#include <ghcplatform.h>
#include "HsVersions.h"
import GhcPrelude
import PipelineMonad
import Packages
import HeaderInfo
import DriverPhases
import SysTools
import SysTools.ExtraObj
import HscMain
import Finder
import HscTypes hiding ( Hsc )
import Outputable
import Module
import ErrUtils
import DynFlags
import Panic
import Util
import StringBuffer ( hGetStringBuffer, hPutStringBuffer )
import BasicTypes ( SuccessFlag(..) )
import Maybes ( expectJust )
import SrcLoc
import LlvmCodeGen ( llvmFixupAsm, llvmVersionList )
import MonadUtils
import GHC.Platform
import TcRnTypes
import ToolSettings
import Hooks
import qualified GHC.LanguageExtensions as LangExt
import FileCleanup
import Ar
import Bag ( unitBag )
import FastString ( mkFastString )
import MkIface ( mkFullIface )
import Exception
import System.Directory
import System.FilePath
import System.IO
import Control.Monad
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 ErrorMessages (DynFlags, FilePath))
preprocess :: HscEnv
-> FilePath
-> Maybe InputFileBuffer
-> Maybe Phase
-> IO (Either ErrorMessages (DynFlags, FilePath))
preprocess HscEnv
hsc_env FilePath
input_fn Maybe InputFileBuffer
mb_input_buf Maybe Phase
mb_phase =
(SourceError -> IO (Either ErrorMessages (DynFlags, FilePath)))
-> IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall (m :: * -> *) a.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (\SourceError
err -> Either ErrorMessages (DynFlags, FilePath)
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrorMessages -> Either ErrorMessages (DynFlags, FilePath)
forall a b. a -> Either a b
Left (SourceError -> ErrorMessages
srcErrorMessages SourceError
err))) (IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath)))
-> IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$
(GhcException -> IO (Either ErrorMessages (DynFlags, FilePath)))
-> IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
(e -> m a) -> m a -> m a
ghandle GhcException -> IO (Either ErrorMessages (DynFlags, FilePath))
forall b. GhcException -> IO (Either ErrorMessages b)
handler (IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath)))
-> IO (Either ErrorMessages (DynFlags, FilePath))
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$
((DynFlags, FilePath) -> Either ErrorMessages (DynFlags, FilePath))
-> IO (DynFlags, FilePath)
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags, FilePath) -> Either ErrorMessages (DynFlags, FilePath)
forall a b. b -> Either a b
Right (IO (DynFlags, FilePath)
-> IO (Either ErrorMessages (DynFlags, FilePath)))
-> IO (DynFlags, FilePath)
-> IO (Either ErrorMessages (DynFlags, FilePath))
forall a b. (a -> b) -> a -> b
$ do
MASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)
(DynFlags
dflags, FilePath
fp, Maybe ModIface
mb_iface) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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
[]
MASSERT(isNothing mb_iface)
(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 ErrorMessages b)
handler (ProgramError FilePath
msg) = Either ErrorMessages b -> IO (Either ErrorMessages b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorMessages b -> IO (Either ErrorMessages b))
-> Either ErrorMessages b -> IO (Either ErrorMessages b)
forall a b. (a -> b) -> a -> b
$ ErrorMessages -> Either ErrorMessages b
forall a b. a -> Either a b
Left (ErrorMessages -> Either ErrorMessages b)
-> ErrorMessages -> Either ErrorMessages b
forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrorMessages
forall a. a -> Bag a
unitBag (ErrMsg -> ErrorMessages) -> ErrMsg -> ErrorMessages
forall a b. (a -> b) -> a -> b
$
DynFlags -> SrcSpan -> SDoc -> ErrMsg
mkPlainErrMsg (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) SrcSpan
srcspan (SDoc -> ErrMsg) -> SDoc -> ErrMsg
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
text FilePath
msg
handler GhcException
ex = GhcException -> IO (Either ErrorMessages b)
forall a. GhcException -> IO a
throwGhcExceptionIO GhcException
ex
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
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags1 Int
2 (FilePath -> SDoc
text FilePath
"compile: input file" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
input_fnpp)
(HscStatus
status, ModDetails
hmi_details, DynFlags
plugin_dflags) <- Bool
-> Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO (HscStatus, ModDetails, DynFlags)
hscIncrementalCompile
Bool
always_do_basic_recompilation_check
Maybe TcGblEnv
m_tc_result Maybe Messager
mHscMessage
HscEnv
hsc_env ModSummary
summary SourceModified
source_modified Maybe ModIface
mb_old_iface (Int
mod_index, Int
nmods)
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
$
DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
addFilesToClean DynFlags
flags 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
$
DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
addFilesToClean DynFlags
flags 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]
let hsc_env' :: HscEnv
hsc_env' = HscEnv
hsc_env{ hsc_dflags :: DynFlags
hsc_dflags = DynFlags
plugin_dflags }
case (HscStatus
status, HscTarget
hsc_lang) of
(HscUpToDate ModIface
iface, HscTarget
_) ->
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
hmi_details Maybe Linkable
mb_old_linkable
(HscNotGeneratingCode ModIface
iface, HscTarget
HscNothing) ->
let mb_linkable :: Maybe Linkable
mb_linkable = if HscSource -> Bool
isHsBootOrSig HscSource
src_flavour
then Maybe Linkable
forall a. Maybe a
Nothing
else Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just (UTCTime -> Module -> [Unlinked] -> Linkable
LM (ModSummary -> UTCTime
ms_hs_date ModSummary
summary) Module
this_mod [])
in 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
hmi_details Maybe Linkable
mb_linkable
(HscNotGeneratingCode ModIface
_, HscTarget
_) -> FilePath -> IO HomeModInfo
forall a. FilePath -> a
panic FilePath
"compileOne HscNotGeneratingCode"
(HscStatus
_, HscTarget
HscNothing) -> FilePath -> IO HomeModInfo
forall a. FilePath -> a
panic FilePath
"compileOne HscNothing"
(HscUpdateBoot ModIface
iface, HscTarget
HscInterpreted) -> do
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
hmi_details Maybe Linkable
forall a. Maybe a
Nothing
(HscUpdateBoot ModIface
iface, HscTarget
_) -> do
DynFlags -> FilePath -> IO ()
touchObjectFile DynFlags
dflags FilePath
object_filename
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
hmi_details Maybe Linkable
forall a. Maybe a
Nothing
(HscUpdateSig ModIface
iface, HscTarget
HscInterpreted) -> do
let !linkable :: Linkable
linkable = UTCTime -> Module -> [Unlinked] -> Linkable
LM (ModSummary -> UTCTime
ms_hs_date ModSummary
summary) Module
this_mod []
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
hmi_details (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable)
(HscUpdateSig ModIface
iface, HscTarget
_) -> do
FilePath
output_fn <- Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename 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, Maybe ModIface)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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 (HscSource -> ModuleName -> HscStatus -> PhasePlus
HscOut HscSource
src_flavour
ModuleName
mod_name (ModIface -> HscStatus
HscUpdateSig ModIface
iface)))
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
basename)
PipelineOutput
Persistent
(ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
[]
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]
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
hmi_details (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable)
(HscRecomp { hscs_guts :: HscStatus -> CgGuts
hscs_guts = CgGuts
cgguts,
hscs_mod_location :: HscStatus -> ModLocation
hscs_mod_location = ModLocation
mod_location,
hscs_partial_iface :: HscStatus -> PartialModIface
hscs_partial_iface = PartialModIface
partial_iface,
hscs_old_iface_hash :: HscStatus -> Maybe Fingerprint
hscs_old_iface_hash = Maybe Fingerprint
mb_old_iface_hash,
hscs_iface_dflags :: HscStatus -> DynFlags
hscs_iface_dflags = DynFlags
iface_dflags }, HscTarget
HscInterpreted) -> do
ModIface
final_iface <- HscEnv -> PartialModIface -> IO ModIface
mkFullIface HscEnv
hsc_env'{hsc_dflags :: DynFlags
hsc_dflags=DynFlags
iface_dflags} PartialModIface
partial_iface
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModIface -> Maybe Fingerprint -> ModLocation -> IO ()
hscMaybeWriteIface DynFlags
dflags ModIface
final_iface Maybe Fingerprint
mb_old_iface_hash ModLocation
mod_location
(Maybe FilePath
hasStub, CompiledByteCode
comp_bc, [SptEntry]
spt_entries) <- HscEnv
-> CgGuts
-> ModLocation
-> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
hscInteractive HscEnv
hsc_env' CgGuts
cgguts ModLocation
mod_location
[Unlinked]
stub_o <- 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
summary
let !linkable :: Linkable
linkable = UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
unlinked_time (ModSummary -> Module
ms_mod ModSummary
summary)
([Unlinked]
hs_unlinked [Unlinked] -> [Unlinked] -> [Unlinked]
forall a. [a] -> [a] -> [a]
++ [Unlinked]
stub_o)
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
final_iface ModDetails
hmi_details (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable)
(HscRecomp{}, HscTarget
_) -> do
FilePath
output_fn <- Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename 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) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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 (HscSource -> ModuleName -> HscStatus -> PhasePlus
HscOut HscSource
src_flavour ModuleName
mod_name HscStatus
status))
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
basename)
PipelineOutput
Persistent
(ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
[]
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]
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
hmi_details (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable)
where dflags0 :: DynFlags
dflags0 = ModSummary -> DynFlags
ms_hspp_opts ModSummary
summary
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)
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) -> [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 -> [Way]
ways DynFlags
dflags0)
isProfWay :: Bool
isProfWay = (Way -> Bool) -> [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 -> [Way]
ways DynFlags
dflags0)
internalInterpreter :: Bool
internalInterpreter = Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalInterpreter DynFlags
dflags0)
src_flavour :: HscSource
src_flavour = ModSummary -> HscSource
ms_hsc_src ModSummary
summary
mod_name :: ModuleName
mod_name = ModSummary -> ModuleName
ms_mod_name ModSummary
summary
next_phase :: Phase
next_phase = HscSource -> HscTarget -> Phase
hscPostBackendPhase HscSource
src_flavour HscTarget
hsc_lang
object_filename :: FilePath
object_filename = ModLocation -> FilePath
ml_obj_file ModLocation
location
dflags1 :: DynFlags
dflags1 = if Bool
dynamicGhc 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
!prevailing_dflags :: DynFlags
prevailing_dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env0
dflags :: DynFlags
dflags =
DynFlags
dflags2 { includePaths :: IncludeSpecs
includePaths = IncludeSpecs -> [FilePath] -> IncludeSpecs
addQuoteInclude IncludeSpecs
old_paths [FilePath
current_dir]
, log_action :: LogAction
log_action = DynFlags -> LogAction
log_action DynFlags
prevailing_dflags }
hsc_env :: HscEnv
hsc_env = HscEnv
hsc_env0 {hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags}
hsc_lang :: HscTarget
hsc_lang = DynFlags -> HscTarget
hscTarget DynFlags
dflags
force_recomp :: Bool
force_recomp = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ForceRecomp DynFlags
dflags
source_modified :: SourceModified
source_modified
| Bool
force_recomp = SourceModified
SourceModified
| Bool
otherwise = SourceModified
source_modified0
always_do_basic_recompilation_check :: Bool
always_do_basic_recompilation_check = case HscTarget
hsc_lang of
HscTarget
HscInterpreted -> Bool
True
HscTarget
_ -> Bool
False
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
ForeignSrcLang
RawObject -> FilePath -> Phase
forall a. FilePath -> a
panic FilePath
"compileForeign: should be unreachable"
(DynFlags
_, FilePath
stub_o, Maybe ModIface
_) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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
FilePath
empty_stub <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"c"
let src :: SDoc
src = FilePath -> SDoc
text FilePath
"int" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> ModuleName -> Module
mkModule (DynFlags -> UnitId
thisPackage DynFlags
dflags) ModuleName
mod_name) SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
"= 0;"
FilePath -> FilePath -> IO ()
writeFile FilePath
empty_stub (DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags (CodeStyle -> SDoc -> SDoc
pprCode CodeStyle
CStyle SDoc
src))
(DynFlags, FilePath, Maybe ModIface)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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
-> DynFlags
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link :: GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link GhcLink
ghcLink DynFlags
dflags
= (Hooks
-> Maybe
(GhcLink
-> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag))
-> (GhcLink
-> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
-> DynFlags
-> GhcLink
-> DynFlags
-> Bool
-> HomePackageTable
-> IO SuccessFlag
forall a. (Hooks -> Maybe a) -> a -> DynFlags -> a
lookupHook Hooks
-> Maybe
(GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
l DynFlags
dflags GhcLink
ghcLink DynFlags
dflags
where
l :: GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
l GhcLink
LinkInMemory DynFlags
_ Bool
_ HomePackageTable
_
= if PlatformMisc -> Bool
platformMisc_ghcWithInterpreter (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dflags
then
SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
else GhcLink -> IO SuccessFlag
forall a. GhcLink -> a
panicBadLink GhcLink
LinkInMemory
l GhcLink
NoLink DynFlags
_ Bool
_ HomePackageTable
_
= SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
l GhcLink
LinkBinary DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
l GhcLink
LinkStaticLib DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
l GhcLink
LinkDynLib DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' 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' :: DynFlags
-> Bool
-> HomePackageTable
-> IO SuccessFlag
link' :: DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags 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 :: [InstalledUnitId]
pkg_deps = (HomeModInfo -> [InstalledUnitId])
-> [HomeModInfo] -> [InstalledUnitId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((InstalledUnitId, Bool) -> InstalledUnitId)
-> [(InstalledUnitId, Bool)] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (InstalledUnitId, Bool) -> InstalledUnitId
forall a b. (a, b) -> a
fst ([(InstalledUnitId, Bool)] -> [InstalledUnitId])
-> (HomeModInfo -> [(InstalledUnitId, Bool)])
-> HomeModInfo
-> [InstalledUnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> [(InstalledUnitId, Bool)]
dep_pkgs (Dependencies -> [(InstalledUnitId, Bool)])
-> (HomeModInfo -> Dependencies)
-> HomeModInfo
-> [(InstalledUnitId, Bool)]
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
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg 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 DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg 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
exe_file :: FilePath
exe_file = Bool -> DynFlags -> FilePath
exeFileName Bool
staticLink DynFlags
dflags
Bool
linking_needed <- DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
linkingNeeded DynFlags
dflags Bool
staticLink [Linkable]
linkables [InstalledUnitId]
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 DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg 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
DynFlags -> FilePath -> IO ()
compilationProgressMsg DynFlags
dflags (FilePath
"Linking " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exe_file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ...")
let link :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
link = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
LinkBinary -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary
GhcLink
LinkStaticLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkStaticLib
GhcLink
LinkDynLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLibCheck
GhcLink
other -> GhcLink -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
forall a. GhcLink -> a
panicBadLink GhcLink
other
DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
link DynFlags
dflags [FilePath]
obj_files [InstalledUnitId]
pkg_deps
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg 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 DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg 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 :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
linkingNeeded DynFlags
dflags Bool
staticLink [Linkable]
linkables [InstalledUnitId]
pkg_deps = do
let exe_file :: FilePath
exe_file = Bool -> DynFlags -> FilePath
exeFileName Bool
staticLink 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 = [ (DynFlags -> [PackageConfig] -> [FilePath]
collectLibraryPaths DynFlags
dflags [PackageConfig
c], FilePath
lib)
| Just PackageConfig
c <- (InstalledUnitId -> Maybe PackageConfig)
-> [InstalledUnitId] -> [Maybe PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags) [InstalledUnitId]
pkg_deps,
FilePath
lib <- DynFlags -> PackageConfig -> [FilePath]
packageHsLibs DynFlags
dflags PackageConfig
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 (DynFlags -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findHSLib 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 DynFlags -> [InstalledUnitId] -> FilePath -> IO Bool
checkLinkInfo DynFlags
dflags [InstalledUnitId]
pkg_deps FilePath
exe_file
findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)
findHSLib :: DynFlags -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findHSLib DynFlags
dflags [FilePath]
dirs FilePath
lib = do
let batch_lib_file :: FilePath
batch_lib_file = if Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` DynFlags -> [Way]
ways DynFlags
dflags
then FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib FilePath -> FilePath -> FilePath
<.> FilePath
"a"
else Platform -> FilePath -> FilePath
mkSOName (DynFlags -> Platform
targetPlatform DynFlags
dflags) 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
DynFlags -> Phase -> [FilePath] -> IO ()
doLink (HscEnv -> DynFlags
hsc_dflags 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
| HscTarget
HscNothing <- DynFlags -> HscTarget
hscTarget DynFlags
dflags = TempFileLifetime -> PipelineOutput
Temporary TempFileLifetime
TFL_CurrentModule
| 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
_) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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 :: DynFlags -> Phase -> [FilePath] -> IO ()
doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
doLink DynFlags
dflags 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
= case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
GhcLink
NoLink -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GhcLink
LinkBinary -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary DynFlags
dflags [FilePath]
o_files []
GhcLink
LinkStaticLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkStaticLib DynFlags
dflags [FilePath]
o_files []
GhcLink
LinkDynLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLibCheck DynFlags
dflags [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)
runPipeline :: Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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}
(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 (HscOut {}) = 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' = DynFlags -> Phase -> Phase -> Bool
happensBefore 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))
HscOut {} -> () -> 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 <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName 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
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
4 (FilePath -> SDoc
text FilePath
"Running the pipeline")
(DynFlags, FilePath, Maybe ModIface)
r <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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 -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
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 () -> IO ()
forall (m :: * -> *). MonadIO m => DynFlags -> m () -> m ()
whenCannotGenerateDynamicToo DynFlags
dflags (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
4
(FilePath -> SDoc
text FilePath
"Running the pipeline again for -dynamic-too")
let dflags' :: DynFlags
dflags' = DynFlags -> DynFlags
dynamicTooMkDynamicDynFlags DynFlags
dflags
HscEnv
hsc_env' <- DynFlags -> IO HscEnv
newHscEnv DynFlags
dflags'
(DynFlags, FilePath, Maybe ModIface)
_ <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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)
-> IO (DynFlags, FilePath, Maybe ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags, FilePath, Maybe ModIface)
r
runPipeline'
:: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
runPipeline' :: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath, Maybe ModIface)
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 -> 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 }
(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)
-> IO (DynFlags, FilePath, Maybe ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (PipeState -> DynFlags
pipeStateDynFlags PipeState
pipe_state, FilePath
fp, PipeState -> Maybe ModIface
pipeStateModIface 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
let happensBefore' :: Phase -> Phase -> Bool
happensBefore' = DynFlags -> Phase -> Phase -> Bool
happensBefore 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
output ->
do PipeState
pst <- CompPipeline PipeState
getPipeState
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
$ Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename
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 :: Maybe FilePath
line_prag = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (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
$ DynFlags
-> FilePath -> Maybe FilePath -> FilePath -> FilePath -> IO ()
copyWithHeader DynFlags
dflags FilePath
msg Maybe 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
$ DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
4
(FilePath -> SDoc
text FilePath
"Running phase" SDoc -> SDoc -> SDoc
<+> PhasePlus -> SDoc
forall a. Outputable a => a -> SDoc
ppr PhasePlus
phase)
(PhasePlus
next_phase, FilePath
output_fn) <- PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
phase FilePath
input_fn DynFlags
dflags
case PhasePlus
phase of
HscOut {} -> do
let noDynToo :: CompPipeline FilePath
noDynToo = PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
let dynToo :: CompPipeline FilePath
dynToo = do
DynFlags -> CompPipeline ()
setDynFlags (DynFlags -> CompPipeline ()) -> DynFlags -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags GeneralFlag
Opt_BuildDynamicToo
FilePath
r <- PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
DynFlags -> CompPipeline ()
setDynFlags (DynFlags -> CompPipeline ()) -> DynFlags -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
dynamicTooMkDynamicDynFlags DynFlags
dflags
FilePath
_ <- PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
phase FilePath
input_fn
FilePath -> CompPipeline FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
r
DynFlags
-> CompPipeline FilePath
-> CompPipeline FilePath
-> CompPipeline FilePath
forall (m :: * -> *) a. MonadIO m => DynFlags -> m a -> m a -> m a
ifGeneratingDynamicToo DynFlags
dflags CompPipeline FilePath
dynToo CompPipeline FilePath
noDynToo
PhasePlus
_ -> PhasePlus -> FilePath -> CompPipeline FilePath
pipeLoop PhasePlus
next_phase FilePath
output_fn
runHookedPhase :: PhasePlus -> FilePath -> DynFlags
-> CompPipeline (PhasePlus, FilePath)
runHookedPhase :: PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
pp FilePath
input DynFlags
dflags =
(Hooks
-> Maybe
(PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)))
-> (PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
-> DynFlags
-> PhasePlus
-> FilePath
-> DynFlags
-> CompPipeline (PhasePlus, FilePath)
forall a. (Hooks -> Maybe a) -> a -> DynFlags -> a
lookupHook Hooks
-> Maybe
(PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
runPhaseHook PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runPhase DynFlags
dflags PhasePlus
pp FilePath
input DynFlags
dflags
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
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags 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
$ Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Phase
stop_phase PipelineOutput
output_spec
FilePath
src_basename DynFlags
dflags Phase
next_phase Maybe ModLocation
maybe_loc
getOutputFilename
:: Phase -> PipelineOutput -> String
-> DynFlags -> Phase -> Maybe ModLocation -> IO FilePath
getOutputFilename :: Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename 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 = DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
lifetime FilePath
suffix
| Bool
otherwise = DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName 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
fastLlvmPipeline :: DynFlags -> Bool
fastLlvmPipeline :: DynFlags -> Bool
fastLlvmPipeline DynFlags
dflags
= Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepSFiles DynFlags
dflags) Bool -> Bool -> Bool
&& GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_FastLlvm DynFlags
dflags
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
"-filetype=obj") | DynFlags -> Bool
fastLlvmPipeline DynFlags
dflags ]
[(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) ]
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 -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags = FilePath
"dynamic-no-pic"
| Bool
otherwise = FilePath
"static"
align :: Int
align :: Int
align = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) 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" | DynFlags -> Bool
isSse2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse" | DynFlags -> Bool
isSseEnabled DynFlags
dflags ]
[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 ]
runPhase :: PhasePlus
-> FilePath
-> DynFlags
-> CompPipeline (PhasePlus,
FilePath)
runPhase :: PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runPhase (RealPhase (Unlit HscSource
sf)) FilePath
input_fn DynFlags
dflags
= do
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename (HscSource -> Phase
Cpp HscSource
sf)
let flags :: [Option]
flags = [
FilePath -> Option
SysTools.Option FilePath
"-h"
, FilePath -> Option
SysTools.Option (FilePath -> Option) -> FilePath -> Option
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
escape FilePath
input_fn
, FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
output_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 -> [Option] -> IO ()
SysTools.runUnlit 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)
where
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 [] = []
runPhase (RealPhase (Cpp HscSource
sf)) FilePath
input_fn DynFlags
dflags0
= do
[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
$ DynFlags -> [Located FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> [Located FilePath] -> m ()
checkProcessArgsResult DynFlags
dflags1 [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
$ DynFlags -> [Warn] -> IO ()
handleFlagWarnings 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)
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp DynFlags
dflags1 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
$ DynFlags -> [Located FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> [Located FilePath] -> m ()
checkProcessArgsResult DynFlags
dflags2 [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
$ DynFlags -> [Warn] -> IO ()
handleFlagWarnings 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 DynFlags
dflags
= do
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
$ DynFlags -> [Option] -> IO ()
SysTools.runPp DynFlags
dflags
( [ FilePath -> Option
SysTools.Option FilePath
orig_fn
, FilePath -> Option
SysTools.Option FilePath
input_fn
, FilePath -> FilePath -> Option
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
$ DynFlags -> [Located FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> [Located FilePath] -> m ()
checkProcessArgsResult DynFlags
dflags1 [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
$ DynFlags -> [Warn] -> IO ()
handleFlagWarnings 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 DynFlags
dflags0
= do
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
addQuoteInclude 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
do
InputFileBuffer
buf <- FilePath -> IO InputFileBuffer
hGetStringBuffer FilePath
input_fn
Either
ErrorMessages
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName)
eimps <- DynFlags
-> InputFileBuffer
-> FilePath
-> FilePath
-> IO
(Either
ErrorMessages
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName))
getImports DynFlags
dflags InputFileBuffer
buf FilePath
input_fn (FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff)
case Either
ErrorMessages
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName)
eimps of
Left ErrorMessages
errs -> ErrorMessages
-> IO
(Maybe InputFileBuffer, ModuleName,
[(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)])
forall (io :: * -> *) a. MonadIO io => ErrorMessages -> io a
throwErrors ErrorMessages
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
let o_file :: FilePath
o_file = ModLocation -> FilePath
ml_obj_file ModLocation
location
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
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
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
$ HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder HscEnv
hsc_env' 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
(HscStatus
result, ModDetails
_mod_details, DynFlags
plugin_dflags) <-
IO (HscStatus, ModDetails, DynFlags)
-> CompPipeline (HscStatus, ModDetails, DynFlags)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HscStatus, ModDetails, DynFlags)
-> CompPipeline (HscStatus, ModDetails, DynFlags))
-> IO (HscStatus, ModDetails, DynFlags)
-> CompPipeline (HscStatus, ModDetails, DynFlags)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO (HscStatus, ModDetails, DynFlags)
hscIncrementalCompile Bool
True Maybe TcGblEnv
forall a. Maybe a
Nothing (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
forall p p. HscEnv -> p -> RecompileRequired -> p -> IO ()
msg) HscEnv
hsc_env'
ModSummary
mod_summary SourceModified
source_unchanged Maybe ModIface
forall a. Maybe a
Nothing (Int
1,Int
1)
DynFlags -> CompPipeline ()
setDynFlags DynFlags
plugin_dflags
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (HscSource -> ModuleName -> HscStatus -> PhasePlus
HscOut HscSource
src_flavour ModuleName
mod_name HscStatus
result,
FilePath -> FilePath
forall a. FilePath -> a
panic FilePath
"HscOut doesn't have an input filename")
runPhase (HscOut HscSource
src_flavour ModuleName
mod_name HscStatus
result) FilePath
_ DynFlags
dflags = do
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
hsc_lang :: HscTarget
hsc_lang = DynFlags -> HscTarget
hscTarget DynFlags
dflags
next_phase :: Phase
next_phase = HscSource -> HscTarget -> Phase
hscPostBackendPhase HscSource
src_flavour HscTarget
hsc_lang
case HscStatus
result of
HscNotGeneratingCode ModIface
_ ->
(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
"No output filename from Hsc when no-code")
HscUpToDate ModIface
_ ->
do IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO ()
touchObjectFile DynFlags
dflags FilePath
o_file
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn, FilePath
o_file)
HscUpdateBoot ModIface
_ ->
do
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO ()
touchObjectFile DynFlags
dflags FilePath
o_file
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
StopLn, FilePath
o_file)
HscUpdateSig ModIface
_ ->
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
(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 :: HscStatus -> CgGuts
hscs_guts = CgGuts
cgguts,
hscs_mod_location :: HscStatus -> ModLocation
hscs_mod_location = ModLocation
mod_location,
hscs_partial_iface :: HscStatus -> PartialModIface
hscs_partial_iface = PartialModIface
partial_iface,
hscs_old_iface_hash :: HscStatus -> Maybe Fingerprint
hscs_old_iface_hash = Maybe Fingerprint
mb_old_iface_hash,
hscs_iface_dflags :: HscStatus -> DynFlags
hscs_iface_dflags = DynFlags
iface_dflags }
-> 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) <- IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)]))
-> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
-> CompPipeline
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
forall a b. (a -> b) -> a -> b
$
HscEnv
-> CgGuts
-> ModLocation
-> FilePath
-> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
hscGenHardCode HscEnv
hsc_env' CgGuts
cgguts ModLocation
mod_location FilePath
output_fn
ModIface
final_iface <- IO ModIface -> CompPipeline ModIface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> PartialModIface -> IO ModIface
mkFullIface HscEnv
hsc_env'{hsc_dflags :: DynFlags
hsc_dflags=DynFlags
iface_dflags} PartialModIface
partial_iface)
ModIface -> CompPipeline ()
setIface ModIface
final_iface
let if_dflags :: DynFlags
if_dflags = DynFlags
dflags DynFlags -> GeneralFlag -> DynFlags
`gopt_unset` GeneralFlag
Opt_BuildDynamicToo
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModIface -> Maybe Fingerprint -> ModLocation -> IO ()
hscMaybeWriteIface DynFlags
if_dflags 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 DynFlags
dflags
= do 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
$ DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp DynFlags
dflags 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 DynFlags
dflags
= do let hsc_lang :: HscTarget
hsc_lang = DynFlags -> HscTarget
hscTarget DynFlags
dflags
let next_phase :: Phase
next_phase = HscSource -> HscTarget -> Phase
hscPostBackendPhase HscSource
HsSrcFile HscTarget
hsc_lang
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
PipeState{HscEnv
hsc_env :: HscEnv
hsc_env :: PipeState -> HscEnv
hsc_env} <- CompPipeline PipeState
getPipeState
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> FilePath -> FilePath -> IO ()
hscCompileCmmFile HscEnv
hsc_env 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
cc_phase) FilePath
input_fn DynFlags
dflags
| (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
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
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
[InstalledUnitId]
pkgs <- if Bool
hcc then IO [InstalledUnitId] -> CompPipeline [InstalledUnitId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InstalledUnitId] -> CompPipeline [InstalledUnitId])
-> IO [InstalledUnitId] -> CompPipeline [InstalledUnitId]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [InstalledUnitId]
getHCFilePackages FilePath
input_fn else [InstalledUnitId] -> CompPipeline [InstalledUnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[FilePath]
pkg_include_dirs <- 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 -> [InstalledUnitId] -> IO [FilePath]
getPackageIncludePath DynFlags
dflags [InstalledUnitId]
pkgs
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)
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
[FilePath]
pkg_extra_cc_opts <- 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
$
if Bool
hcc
then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else DynFlags -> [InstalledUnitId] -> IO [FilePath]
getPackageExtraCcOpts DynFlags
dflags [InstalledUnitId]
pkgs
[FilePath]
framework_paths <-
if Platform -> Bool
platformUsesFrameworks Platform
platform
then do [FilePath]
pkgFrameworkPaths <- 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 -> [InstalledUnitId] -> IO [FilePath]
getPackageFrameworkPath DynFlags
dflags [InstalledUnitId]
pkgs
let cmdlineFrameworkPaths :: [FilePath]
cmdlineFrameworkPaths = DynFlags -> [FilePath]
frameworkPaths DynFlags
dflags
[FilePath] -> CompPipeline [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> CompPipeline [FilePath])
-> [FilePath] -> CompPipeline [FilePath]
forall a b. (a -> b) -> a -> b
$ (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)
else [FilePath] -> CompPipeline [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
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 -> IO FilePath
getGhcVersionPathName DynFlags
dflags
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 -> DynFlags -> [Option] -> IO ()
SysTools.runCc (Phase -> Maybe ForeignSrcLang
phaseForeignLanguage Phase
cc_phase) DynFlags
dflags (
[ FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
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
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
&&
DynFlags -> UnitId
thisPackage DynFlags
dflags UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== 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 DynFlags
dflags
= do
let as_prog :: DynFlags -> [Option] -> IO ()
as_prog | DynFlags -> HscTarget
hscTarget DynFlags
dflags HscTarget -> HscTarget -> Bool
forall a. Eq a => a -> a -> Bool
== HscTarget
HscLlvm Bool -> Bool -> Bool
&&
Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
= DynFlags -> [Option] -> IO ()
SysTools.runClang
| Bool
otherwise = DynFlags -> [Option] -> IO ()
SysTools.runAs
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)
CompilerInfo
ccInfo <- 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
$ DynFlags -> IO CompilerInfo
getCompilerInfo DynFlags
dflags
let global_includes :: [Option]
global_includes = [ FilePath -> Option
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
SysTools.Option (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
| FilePath
p <- IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths ]
let runAssembler :: FilePath -> FilePath -> m ()
runAssembler FilePath
inputFilename FilePath
outputFilename
= IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
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 -> do
DynFlags -> [Option] -> IO ()
as_prog
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
SysTools.Option [FilePath]
pic_c_flags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
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
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
ccInfo CompilerInfo -> CompilerInfo -> Bool
forall a. Eq a => a -> a -> Bool
==) [CompilerInfo
Clang, CompilerInfo
AppleClang, CompilerInfo
AppleClang51]
then [FilePath -> Option
SysTools.Option FilePath
"-Qunused-arguments"]
else [])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
SysTools.Option FilePath
"-x"
, if Bool
with_cpp
then FilePath -> Option
SysTools.Option FilePath
"assembler-with-cpp"
else FilePath -> Option
SysTools.Option FilePath
"assembler"
, FilePath -> Option
SysTools.Option FilePath
"-c"
, FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
inputFilename
, FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
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
$ DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
4 (FilePath -> SDoc
text FilePath
"Running the assembler")
FilePath -> FilePath -> CompPipeline ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
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 DynFlags
dflags
= do
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
$ DynFlags -> [Option] -> IO ()
SysTools.runLlvmOpt 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
SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
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)
where
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)
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
SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
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)
runPhase (RealPhase Phase
LlvmLlc) FilePath
input_fn DynFlags
dflags
= do
Phase
next_phase <- if | DynFlags -> Bool
fastLlvmPipeline DynFlags
dflags -> CompPipeline Phase
maybeMergeForeign
| 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
$ DynFlags -> [Option] -> IO ()
SysTools.runLlvmLlc 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
SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
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)
where
llvmOpts :: FilePath
llvmOpts = case DynFlags -> Int
optLevel DynFlags
dflags of
Int
0 -> FilePath
"-O1"
Int
1 -> FilePath
"-O1"
Int
_ -> FilePath
"-O2"
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
SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
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) -> 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)
runPhase (RealPhase Phase
LlvmMangle) FilePath
input_fn DynFlags
dflags
= do
let next_phase :: Phase
next_phase = Bool -> Phase
As Bool
False
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
$ DynFlags -> FilePath -> FilePath -> IO ()
llvmFixupAsm 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 DynFlags
dflags
= do
PipeState{[FilePath]
foreign_os :: [FilePath]
foreign_os :: PipeState -> [FilePath]
foreign_os} <- 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
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles 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 DynFlags
_dflags =
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
PipeState { maybe_loc :: PipeState -> Maybe ModLocation
maybe_loc=Maybe ModLocation
maybe_loc} <- CompPipeline PipeState
getPipeState
case Maybe ModLocation
maybe_loc of
Just ModLocation
l -> ModLocation -> CompPipeline ModLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> CompPipeline ModLocation)
-> ModLocation -> CompPipeline ModLocation
forall a b. (a -> b) -> a -> b
$ ModLocation
l
{ ml_hs_file :: Maybe FilePath
ml_hs_file = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff
, ml_hi_file :: FilePath
ml_hi_file = ModLocation -> FilePath
ml_hi_file ModLocation
l FilePath -> FilePath -> FilePath
-<.> DynFlags -> FilePath
hiSuf DynFlags
dflags
, ml_obj_file :: FilePath
ml_obj_file = ModLocation -> FilePath
ml_obj_file ModLocation
l FilePath -> FilePath -> FilePath
-<.> DynFlags -> FilePath
objectSuf DynFlags
dflags
}
Maybe ModLocation
_ -> do
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 [InstalledUnitId]
getHCFilePackages :: FilePath -> IO [InstalledUnitId]
getHCFilePackages FilePath
filename =
IO Handle
-> (Handle -> IO ())
-> (Handle -> IO [InstalledUnitId])
-> IO [InstalledUnitId]
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 [InstalledUnitId]) -> IO [InstalledUnitId])
-> (Handle -> IO [InstalledUnitId]) -> IO [InstalledUnitId]
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 ->
[InstalledUnitId] -> IO [InstalledUnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> InstalledUnitId) -> [FilePath] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> InstalledUnitId
stringToInstalledUnitId (FilePath -> [FilePath]
words FilePath
rest))
FilePath
_other ->
[InstalledUnitId] -> IO [InstalledUnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
linkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary = Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary' Bool
False
linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary' Bool
staticLink DynFlags
dflags [FilePath]
o_files [InstalledUnitId]
dep_packages = do
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
output_fn :: FilePath
output_fn = Bool -> DynFlags -> FilePath
exeFileName Bool
staticLink DynFlags
dflags
FilePath
full_output_fn <- if FilePath -> Bool
isAbsolute FilePath
output_fn
then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
else do FilePath
d <- IO FilePath
getCurrentDirectory
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
$ FilePath -> FilePath
normalise (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
output_fn)
[FilePath]
pkg_lib_paths <- DynFlags -> [InstalledUnitId] -> IO [FilePath]
getPackageLibraryPath DynFlags
dflags [InstalledUnitId]
dep_packages
let pkg_lib_path_opts :: [FilePath]
pkg_lib_path_opts = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
get_pkg_lib_path_opts [FilePath]
pkg_lib_paths
get_pkg_lib_path_opts :: FilePath -> [FilePath]
get_pkg_lib_path_opts FilePath
l
| OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags
= let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
then FilePath
"$ORIGIN" FilePath -> FilePath -> FilePath
</>
(FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
else FilePath
l
rpath :: [FilePath]
rpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RPath DynFlags
dflags
then [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
else []
rpathlink :: [FilePath]
rpathlink = if (Platform -> OS
platformOS Platform
platform) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSSolaris2
then []
else [FilePath
"-Xlinker", FilePath
"-rpath-link", FilePath
"-Xlinker", FilePath
l]
in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpathlink [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpath
| OS -> Bool
osMachOTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags Bool -> Bool -> Bool
&&
GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RPath DynFlags
dflags
= let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
then FilePath
"@loader_path" FilePath -> FilePath -> FilePath
</>
(FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
else FilePath
l
in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
| Bool
otherwise = [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l]
[FilePath]
pkg_lib_path_opts <-
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SingleLibFolder DynFlags
dflags
then do
[(FilePath, FilePath)]
libs <- DynFlags -> [InstalledUnitId] -> IO [(FilePath, FilePath)]
getLibs DynFlags
dflags [InstalledUnitId]
dep_packages
FilePath
tmpDir <- DynFlags -> IO FilePath
newTempDir DynFlags
dflags
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> IO ()
copyFile FilePath
lib (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
basename)
| (FilePath
lib, FilePath
basename) <- [(FilePath, FilePath)]
libs]
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tmpDir ]
else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
pkg_lib_path_opts
let
dead_strip :: [FilePath]
dead_strip
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags = []
| Bool
otherwise = if OS -> Bool
osSubsectionsViaSymbols (Platform -> OS
platformOS Platform
platform)
then [FilePath
"-Wl,-dead_strip"]
else []
let lib_paths :: [FilePath]
lib_paths = DynFlags -> [FilePath]
libraryPaths DynFlags
dflags
let lib_path_opts :: [FilePath]
lib_path_opts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-L"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
lib_paths
FilePath
extraLinkObj <- DynFlags -> IO FilePath
mkExtraObjToLinkIntoBinary DynFlags
dflags
[FilePath]
noteLinkObjs <- DynFlags -> [InstalledUnitId] -> IO [FilePath]
mkNoteObjsToLinkIntoBinary DynFlags
dflags [InstalledUnitId]
dep_packages
let
([FilePath]
pre_hs_libs, [FilePath]
post_hs_libs)
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags
= if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
then ([FilePath
"-Wl,-all_load"], [])
else ([FilePath
"-Wl,--whole-archive"], [FilePath
"-Wl,--no-whole-archive"])
| Bool
otherwise
= ([],[])
[FilePath]
pkg_link_opts <- do
([FilePath]
package_hs_libs, [FilePath]
extra_libs, [FilePath]
other_flags) <- DynFlags
-> [InstalledUnitId] -> IO ([FilePath], [FilePath], [FilePath])
getPackageLinkOpts DynFlags
dflags [InstalledUnitId]
dep_packages
[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
$ if Bool
staticLink
then [FilePath]
package_hs_libs
else [FilePath]
other_flags [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dead_strip
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pre_hs_libs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
package_hs_libs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
post_hs_libs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_libs
[FilePath]
pkg_framework_opts <- DynFlags -> Platform -> [InstalledUnitId] -> IO [FilePath]
getPkgFrameworkOpts DynFlags
dflags Platform
platform [InstalledUnitId]
dep_packages
let framework_opts :: [FilePath]
framework_opts = DynFlags -> Platform -> [FilePath]
getFrameworkOpts DynFlags
dflags Platform
platform
let extra_ld_inputs :: [Option]
extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags
[FilePath]
rc_objs <- DynFlags -> FilePath -> IO [FilePath]
maybeCreateManifest DynFlags
dflags FilePath
output_fn
let link :: DynFlags -> [Option] -> IO ()
link = if Bool
staticLink
then DynFlags -> [Option] -> IO ()
SysTools.runLibtool
else DynFlags -> [Option] -> IO ()
SysTools.runLink
DynFlags -> [Option] -> IO ()
link DynFlags
dflags (
(FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
SysTools.Option [FilePath]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
libmLinkOpts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
SysTools.Option (
[]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [FilePath]
picCCOpts DynFlags
dflags
[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
then [FilePath
"-Wl,--enable-auto-import"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if ToolSettings -> Bool
toolSettings_ldSupportsCompactUnwind ToolSettings
toolSettings' Bool -> Bool -> Bool
&&
Bool -> Bool
not Bool
staticLink Bool -> Bool -> Bool
&&
(Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin) Bool -> Bool -> Bool
&&
case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Bool
True
Arch
ArchX86_64 -> Bool
True
ArchARM {} -> Bool
True
Arch
ArchARM64 -> Bool
True
Arch
_ -> Bool
False
then [FilePath
"-Wl,-no_compact_unwind"]
else [])
[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
OSDarwin Bool -> Bool -> Bool
&&
Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
&&
Bool -> Bool
not Bool
staticLink
then [FilePath
"-Wl,-read_only_relocs,suppress"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if ToolSettings -> Bool
toolSettings_ldIsGnuLd ToolSettings
toolSettings' Bool -> Bool -> Bool
&&
Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags)
then [FilePath
"-Wl,--gc-sections"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
o_files
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
lib_path_opts)
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
SysTools.Option (
[FilePath]
rc_objs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
framework_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_lib_path_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath
extraLinkObjFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
noteLinkObjs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_link_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_framework_opts
[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
OSDarwin
then [ FilePath
"-Wl,-dead_strip_dylibs" ]
else [])
))
exeFileName :: Bool -> DynFlags -> FilePath
exeFileName :: Bool -> DynFlags -> FilePath
exeFileName Bool
staticLink DynFlags
dflags
| Just FilePath
s <- DynFlags -> Maybe FilePath
outputFile DynFlags
dflags =
case Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
OS
OSMinGW32 -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"exe"
OS
_ -> if Bool
staticLink
then FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"a"
else FilePath
s
| Bool
otherwise =
if Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
then FilePath
"main.exe"
else if Bool
staticLink
then FilePath
"liba.a"
else FilePath
"a.out"
where FilePath
s <?.> :: FilePath -> FilePath -> FilePath
<?.> FilePath
ext | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
takeExtension FilePath
s) = FilePath
s FilePath -> FilePath -> FilePath
<.> FilePath
ext
| Bool
otherwise = FilePath
s
maybeCreateManifest
:: DynFlags
-> FilePath
-> IO [FilePath]
maybeCreateManifest :: DynFlags -> FilePath -> IO [FilePath]
maybeCreateManifest DynFlags
dflags FilePath
exe_filename
| Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 Bool -> Bool -> Bool
&&
GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GenManifest DynFlags
dflags
= do let manifest_filename :: FilePath
manifest_filename = FilePath
exe_filename FilePath -> FilePath -> FilePath
<.> FilePath
"manifest"
FilePath -> FilePath -> IO ()
writeFile FilePath
manifest_filename (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <assemblyIdentity version=\"1.0.0.0\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" processorArchitecture=\"X86\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" name=\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
dropExtension FilePath
exe_filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" type=\"win32\"/>\n\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <security>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <requestedPrivileges>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" </requestedPrivileges>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" </security>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" </trustInfo>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"</assembly>\n"
if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_EmbedManifest DynFlags
dflags) then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
FilePath
rc_filename <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"rc"
FilePath
rc_obj_filename <-
DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_GhcSession (DynFlags -> FilePath
objectSuf DynFlags
dflags)
FilePath -> FilePath -> IO ()
writeFile FilePath
rc_filename (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"1 24 MOVEABLE PURE " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
manifest_filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
DynFlags -> [Option] -> IO ()
runWindres DynFlags
dflags ([Option] -> IO ()) -> [Option] -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$
[FilePath
"--input="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_filename,
FilePath
"--output="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_obj_filename,
FilePath
"--output-format=coff"]
FilePath -> IO ()
removeFile FilePath
manifest_filename
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
rc_obj_filename]
| Bool
otherwise = [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
linkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
linkDynLibCheck :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLibCheck DynFlags
dflags [FilePath]
o_files [InstalledUnitId]
dep_packages
= 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
$ do
LogAction
putLogMsg DynFlags
dflags WarnReason
NoReason Severity
SevInfo SrcSpan
noSrcSpan
(DynFlags -> PprStyle
defaultUserStyle DynFlags
dflags)
(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.")
DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLib DynFlags
dflags [FilePath]
o_files [InstalledUnitId]
dep_packages
linkStaticLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
linkStaticLib :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkStaticLib DynFlags
dflags [FilePath]
o_files [InstalledUnitId]
dep_packages = do
let extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
modules :: [FilePath]
modules = [FilePath]
o_files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_ld_inputs
output_fn :: FilePath
output_fn = Bool -> DynFlags -> FilePath
exeFileName Bool
True DynFlags
dflags
FilePath
full_output_fn <- if FilePath -> Bool
isAbsolute FilePath
output_fn
then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
else do FilePath
d <- IO FilePath
getCurrentDirectory
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
$ FilePath -> FilePath
normalise (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
output_fn)
Bool
output_exists <- FilePath -> IO Bool
doesFileExist FilePath
full_output_fn
(Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
output_exists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
full_output_fn
[PackageConfig]
pkg_cfgs <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
dep_packages
[FilePath]
archives <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PackageConfig -> IO [FilePath])
-> [PackageConfig] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DynFlags -> PackageConfig -> IO [FilePath]
collectArchives DynFlags
dflags) [PackageConfig]
pkg_cfgs
Archive
ar <- (Archive -> Archive -> Archive) -> Archive -> [Archive] -> Archive
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Archive -> Archive -> Archive
forall a. Monoid a => a -> a -> a
mappend
(Archive -> [Archive] -> Archive)
-> IO Archive -> IO ([Archive] -> Archive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ArchiveEntry] -> Archive
Archive ([ArchiveEntry] -> Archive) -> IO [ArchiveEntry] -> IO Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO ArchiveEntry) -> [FilePath] -> IO [ArchiveEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO ArchiveEntry
loadObj [FilePath]
modules)
IO ([Archive] -> Archive) -> IO [Archive] -> IO Archive
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> IO Archive) -> [FilePath] -> IO [Archive]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Archive
loadAr [FilePath]
archives
if ToolSettings -> Bool
toolSettings_ldIsGnuLd (DynFlags -> ToolSettings
toolSettings DynFlags
dflags)
then FilePath -> Archive -> IO ()
writeGNUAr FilePath
output_fn (Archive -> IO ()) -> Archive -> IO ()
forall a b. (a -> b) -> a -> b
$ (ArchiveEntry -> Bool) -> Archive -> Archive
afilter (Bool -> Bool
not (Bool -> Bool) -> (ArchiveEntry -> Bool) -> ArchiveEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveEntry -> Bool
isGNUSymdef) Archive
ar
else FilePath -> Archive -> IO ()
writeBSDAr FilePath
output_fn (Archive -> IO ()) -> Archive -> IO ()
forall a b. (a -> b) -> a -> b
$ (ArchiveEntry -> Bool) -> Archive -> Archive
afilter (Bool -> Bool
not (Bool -> Bool) -> (ArchiveEntry -> Bool) -> ArchiveEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveEntry -> Bool
isBSDSymdef) Archive
ar
DynFlags -> [Option] -> IO ()
runRanlib DynFlags
dflags [FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
output_fn]
doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp DynFlags
dflags 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
[FilePath]
pkg_include_dirs <- DynFlags -> [InstalledUnitId] -> IO [FilePath]
getPackageIncludePath DynFlags
dflags []
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)
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 = DynFlags -> [Option] -> IO ()
SysTools.runCpp DynFlags
dflags [Option]
args
| Bool
otherwise = Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
SysTools.runCc Maybe ForeignSrcLang
forall a. Maybe a
Nothing DynFlags
dflags (FilePath -> Option
SysTools.Option FilePath
"-E" Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args)
let targetArch :: FilePath
targetArch = Arch -> FilePath
stringEncodeArch (Arch -> FilePath) -> Arch -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> Arch
platformArch (Platform -> Arch) -> Platform -> Arch
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
targetOS :: FilePath
targetOS = OS -> FilePath
stringEncodeOS (OS -> FilePath) -> OS -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> OS
platformOS (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
let target_defs :: [FilePath]
target_defs =
[ FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
HOST_OS FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_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 sse_defs :: [FilePath]
sse_defs =
[ FilePath
"-D__SSE__" | DynFlags -> Bool
isSseEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__SSE2__" | DynFlags -> Bool
isSse2Enabled DynFlags
dflags ] [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 <- DynFlags -> IO [FilePath]
getBackendDefs DynFlags
dflags
let th_defs :: [FilePath]
th_defs = [ FilePath
"-D__GLASGOW_HASKELL_TH__" ]
FilePath
ghcVersionH <- DynFlags -> IO FilePath
getGhcVersionPathName DynFlags
dflags
let hsSourceCppOpts :: [FilePath]
hsSourceCppOpts = [ FilePath
"-include", FilePath
ghcVersionH ]
let uids :: [UnitId]
uids = PackageState -> [UnitId]
explicitPackages (DynFlags -> PackageState
pkgState DynFlags
dflags)
pkgs :: [PackageConfig]
pkgs = [Maybe PackageConfig] -> [PackageConfig]
forall a. [Maybe a] -> [a]
catMaybes ((UnitId -> Maybe PackageConfig)
-> [UnitId] -> [Maybe PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags) [UnitId]
uids)
[Option]
mb_macro_include <-
if Bool -> Bool
not ([PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
pkgs) Bool -> Bool -> Bool
&& GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_VersionMacros DynFlags
dflags
then do FilePath
macro_stub <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"h"
FilePath -> FilePath -> IO ()
writeFile FilePath
macro_stub ([PackageConfig] -> FilePath
generatePackageVersionMacros [PackageConfig]
pkgs)
[Option] -> IO [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> FilePath -> Option
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
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
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
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
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
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
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
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
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
SysTools.Option [FilePath]
avx_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
mb_macro_include
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
SysTools.Option FilePath
"-x"
, FilePath -> Option
SysTools.Option FilePath
"assembler-with-cpp"
, FilePath -> Option
SysTools.Option FilePath
input_fn
, FilePath -> Option
SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
SysTools.FileOption FilePath
"" FilePath
output_fn
])
getBackendDefs :: DynFlags -> IO [String]
getBackendDefs :: DynFlags -> IO [FilePath]
getBackendDefs DynFlags
dflags | DynFlags -> HscTarget
hscTarget DynFlags
dflags HscTarget -> HscTarget -> Bool
forall a. Eq a => a -> a -> Bool
== HscTarget
HscLlvm = do
Maybe LlvmVersion
llvmVer <- DynFlags -> IO (Maybe LlvmVersion)
figureLlvmVersion 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 DynFlags
_ =
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
generatePackageVersionMacros :: [PackageConfig] -> String
generatePackageVersionMacros :: [PackageConfig] -> FilePath
generatePackageVersionMacros [PackageConfig]
pkgs = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath -> FilePath -> Version -> FilePath
generateMacros FilePath
"" FilePath
pkgname Version
version
| PackageConfig
pkg <- [PackageConfig]
pkgs
, let version :: Version
version = PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion PackageConfig
pkg
pkgname :: FilePath
pkgname = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (PackageConfig -> FilePath
packageNameString PackageConfig
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