{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns #-}
{-# OPTIONS_GHC -fno-cse #-}
module DriverPipeline (
oneShot, compileFile,
linkBinary,
preprocess,
compileOne, compileOne',
link,
PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,
hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
runPhase, exeFileName,
maybeCreateManifest,
linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
) where
#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 Config
import Panic
import Util
import StringBuffer ( hGetStringBuffer, hPutStringBuffer )
import BasicTypes ( SuccessFlag(..) )
import Maybes ( expectJust )
import SrcLoc
import LlvmCodeGen ( LlvmVersion (..), llvmFixupAsm )
import MonadUtils
import Platform
import TcRnTypes
import Hooks
import qualified GHC.LanguageExtensions as LangExt
import FileCleanup
import Ar
import Bag ( unitBag )
import FastString ( mkFastString )
import Exception
import System.Directory
import System.FilePath
import System.IO
import Control.Monad
import Data.List ( isInfixOf, isSuffixOf, 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 hsc_env :: HscEnv
hsc_env input_fn :: FilePath
input_fn mb_input_buf :: Maybe InputFileBuffer
mb_input_buf mb_phase :: 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 (\err :: 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
$
ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)
Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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
[]
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) 1 1
handler :: GhcException -> IO (Either ErrorMessages b)
handler (ProgramError msg :: 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 ex :: 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' m_tc_result :: Maybe TcGblEnv
m_tc_result mHscMessage :: Maybe Messager
mHscMessage
hsc_env0 :: HscEnv
hsc_env0 summary :: ModSummary
summary mod_index :: Int
mod_index nmods :: Int
nmods mb_old_iface :: Maybe ModIface
mb_old_iface maybe_old_linkable :: Maybe Linkable
maybe_old_linkable
source_modified0 :: SourceModified
source_modified0
= do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags1 2 (FilePath -> SDoc
text "compile: input file" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
input_fnpp)
(status :: HscStatus
status, hmi0 :: HomeModInfo
hmi0) <- Bool
-> Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO (HscStatus, HomeModInfo)
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]
case (HscStatus
status, HscTarget
hsc_lang) of
(HscUpToDate, _) ->
HomeModInfo -> IO HomeModInfo
forall (m :: * -> *) a. Monad m => a -> m a
return HomeModInfo
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = Maybe Linkable
maybe_old_linkable }
(HscNotGeneratingCode, 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
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = Maybe Linkable
mb_linkable }
(HscNotGeneratingCode, _) -> FilePath -> IO HomeModInfo
forall a. FilePath -> a
panic "compileOne HscNotGeneratingCode"
(_, HscNothing) -> FilePath -> IO HomeModInfo
forall a. FilePath -> a
panic "compileOne HscNothing"
(HscUpdateBoot, HscInterpreted) -> do
HomeModInfo -> IO HomeModInfo
forall (m :: * -> *) a. Monad m => a -> m a
return HomeModInfo
hmi0
(HscUpdateBoot, _) -> do
DynFlags -> FilePath -> IO ()
touchObjectFile DynFlags
dflags FilePath
object_filename
HomeModInfo -> IO HomeModInfo
forall (m :: * -> *) a. Monad m => a -> m a
return HomeModInfo
hmi0
(HscUpdateSig, HscInterpreted) ->
let linkable :: Linkable
linkable = 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
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable }
(HscUpdateSig, _) -> 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)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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
HscUpdateSig))
(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
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable }
(HscRecomp cgguts :: CgGuts
cgguts summary :: ModSummary
summary, HscInterpreted) -> do
(hasStub :: Maybe FilePath
hasStub, comp_bc :: CompiledByteCode
comp_bc, spt_entries :: [SptEntry]
spt_entries) <-
HscEnv
-> CgGuts
-> ModSummary
-> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
hscInteractive HscEnv
hsc_env CgGuts
cgguts ModSummary
summary
[Unlinked]
stub_o <- case Maybe FilePath
hasStub of
Nothing -> [Unlinked] -> IO [Unlinked]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just stub_c :: 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
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable }
(HscRecomp cgguts :: CgGuts
cgguts summary :: ModSummary
summary, _) -> 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)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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 (CgGuts -> ModSummary -> HscStatus
HscRecomp CgGuts
cgguts ModSummary
summary)))
(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
hmi0 { hm_linkable :: Maybe Linkable
hm_linkable = 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 "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 = DynFlags -> HscSource -> HscTarget -> Phase
hscPostBackendPhase DynFlags
dflags 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
HscInterpreted -> Bool
True
_ -> Bool
False
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign _ RawObject object_file :: FilePath
object_file = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
object_file
compileForeign hsc_env :: HscEnv
hsc_env lang :: ForeignSrcLang
lang stub_c :: FilePath
stub_c = do
let phase :: Phase
phase = case ForeignSrcLang
lang of
LangC -> Phase
Cc
LangCxx -> Phase
Ccxx
LangObjc -> Phase
Cobjc
LangObjcxx -> Phase
Cobjcxx
LangAsm -> Bool -> Phase
As Bool
True
RawObject -> FilePath -> Phase
forall a. FilePath -> a
panic "compileForeign: should be unreachable"
(_, stub_o :: FilePath
stub_o) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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 hsc_env :: HscEnv
hsc_env stub_c :: 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 dflags :: DynFlags
dflags hsc_env :: HscEnv
hsc_env basename :: FilePath
basename location :: ModLocation
location mod_name :: ModuleName
mod_name = do
FilePath
empty_stub <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule "c"
let src :: SDoc
src = FilePath -> SDoc
text "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 "= 0;"
FilePath -> FilePath -> IO ()
writeFile FilePath
empty_stub (DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags (CodeStyle -> SDoc -> SDoc
pprCode CodeStyle
CStyle SDoc
src))
(DynFlags, FilePath)
_ <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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
ghcLink dflags :: 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 LinkInMemory _ _ _
= if FilePath
cGhcWithInterpreter FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "YES"
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 NoLink _ _ _
= SuccessFlag -> IO SuccessFlag
forall (m :: * -> *) a. Monad m => a -> m a
return SuccessFlag
Succeeded
l LinkBinary dflags :: DynFlags
dflags batch_attempt_linking :: Bool
batch_attempt_linking hpt :: HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
l LinkStaticLib dflags :: DynFlags
dflags batch_attempt_linking :: Bool
batch_attempt_linking hpt :: HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
l LinkDynLib dflags :: DynFlags
dflags batch_attempt_linking :: Bool
batch_attempt_linking hpt :: HomePackageTable
hpt
= DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag
link' DynFlags
dflags Bool
batch_attempt_linking HomePackageTable
hpt
panicBadLink :: GhcLink -> a
panicBadLink :: GhcLink -> a
panicBadLink other :: GhcLink
other = FilePath -> a
forall a. FilePath -> a
panic ("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' dflags :: DynFlags
dflags batch_attempt_linking :: Bool
batch_attempt_linking hpt :: HomePackageTable
hpt
| Bool
batch_attempt_linking
= do
let
staticLink :: Bool
staticLink = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
LinkStaticLib -> Bool
True
_ -> 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
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 "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 3 (FilePath -> SDoc
text "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 3 (FilePath -> SDoc
text "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 _ _ us :: [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 2 (FilePath -> SDoc
text FilePath
exe_file SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text "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 ("Linking " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exe_file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " ...")
let link :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
link = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
LinkBinary -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary
LinkStaticLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkStaticLib
LinkDynLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLibCheck
other :: 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 3 (FilePath -> SDoc
text "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 3 (FilePath -> SDoc
text "link(batch): upsweep (partially) failed OR" SDoc -> SDoc -> SDoc
$$
FilePath -> SDoc
text " 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 dflags :: DynFlags
dflags staticLink :: Bool
staticLink linkables :: [Linkable]
linkables pkg_deps :: [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 _ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Right t :: UTCTime
t -> do
let extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption _ f :: 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 (errs :: [IOException]
errs,extra_times :: [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 c :: 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 (lib_errs :: [IOException]
lib_errs,lib_times :: [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 dflags :: DynFlags
dflags dirs :: [FilePath]
dirs lib :: 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 "lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib 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
(x :: FilePath
x:_) -> 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 hsc_env :: HscEnv
hsc_env stop_phase :: Phase
stop_phase srcs :: [(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 hsc_env :: HscEnv
hsc_env stop_phase :: Phase
stop_phase (src :: FilePath
src, mb_phase :: 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 ("does not exist: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src))
let
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
split :: Bool
split = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SplitObjs DynFlags
dflags
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
stop_phase' :: Phase
stop_phase' = case Phase
stop_phase of
As _ | Bool
split -> Phase
SplitAs
_ -> Phase
stop_phase
( _, out_file :: FilePath
out_file) <- Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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 dflags :: DynFlags
dflags stop_phase :: Phase
stop_phase o_files :: [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
NoLink -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
LinkBinary -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary DynFlags
dflags [FilePath]
o_files []
LinkStaticLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkStaticLib DynFlags
dflags [FilePath]
o_files []
LinkDynLib -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkDynLibCheck DynFlags
dflags [FilePath]
o_files []
other :: 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)
runPipeline :: Phase
-> HscEnv
-> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
-> Maybe FilePath
-> PipelineOutput
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
runPipeline stop_phase :: Phase
stop_phase hsc_env0 :: HscEnv
hsc_env0 (input_fn :: FilePath
input_fn, mb_input_buf :: Maybe InputFileBuffer
mb_input_buf, mb_phase :: Maybe PhasePlus
mb_phase)
mb_basename :: Maybe FilePath
mb_basename output :: PipelineOutput
output maybe_loc :: Maybe ModLocation
maybe_loc foreign_os :: [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]
++ ".") }
hsc_env :: HscEnv
hsc_env = HscEnv
hsc_env0 {hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dflags}
(input_basename :: FilePath
input_basename, suffix :: FilePath
suffix) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
input_fn
suffix' :: FilePath
suffix' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 FilePath
suffix
basename :: FilePath
basename | Just b :: 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 _)) = Bool
True
isHaskell (RealPhase (Cpp _)) = Bool
True
isHaskell (RealPhase (HsPp _)) = Bool
True
isHaskell (RealPhase (Hsc _)) = Bool
True
isHaskell (HscOut {}) = Bool
True
isHaskell _ = 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
("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 start_phase' :: 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
("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 real_start_phase :: Phase
real_start_phase, Just input_buf :: 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
$ "{-# LINE 1 \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\"#-}"
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
(_, _) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 4 (FilePath -> SDoc
text "Running the pipeline")
(DynFlags, FilePath)
r <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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 4
(FilePath -> SDoc
text "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)
_ <- PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
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) -> IO (DynFlags, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags, FilePath)
r
runPipeline'
:: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
runPipeline' :: PhasePlus
-> HscEnv
-> PipeEnv
-> FilePath
-> Maybe ModLocation
-> [FilePath]
-> IO (DynFlags, FilePath)
runPipeline' start_phase :: PhasePlus
start_phase hsc_env :: HscEnv
hsc_env env :: PipeEnv
env input_fn :: FilePath
input_fn
maybe_loc :: Maybe ModLocation
maybe_loc foreign_os :: [FilePath]
foreign_os
= do
let state :: PipeState
state = PipeState :: HscEnv -> Maybe ModLocation -> [FilePath] -> 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 }
CompPipeline (DynFlags, FilePath)
-> PipeEnv -> PipeState -> IO (DynFlags, FilePath)
forall a. CompPipeline a -> PipeEnv -> PipeState -> IO a
evalP (PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop PhasePlus
start_phase FilePath
input_fn) PipeEnv
env PipeState
state
pipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop phase :: PhasePlus
phase input_fn :: 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 realPhase :: Phase
realPhase | Phase
realPhase Phase -> Phase -> Bool
`eqPhase` Phase
stopPhase
->
case PipeEnv -> PipelineOutput
output_spec PipeEnv
env of
Temporary _ ->
(DynFlags, FilePath) -> CompPipeline (DynFlags, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
dflags, FilePath
input_fn)
output :: 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 = ("Copying `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++"' to `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
final_fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'")
line_prag :: Maybe FilePath
line_prag = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just ("{-# LINE 1 \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PipeEnv -> FilePath
src_filename PipeEnv
env FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\" #-}\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
(DynFlags, FilePath) -> CompPipeline (DynFlags, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
dflags, FilePath
final_fn)
| Bool -> Bool
not (Phase
realPhase Phase -> Phase -> Bool
`happensBefore'` Phase
stopPhase)
-> FilePath -> CompPipeline (DynFlags, FilePath)
forall a. FilePath -> a
panic ("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]
++
" 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)
_
-> 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 4
(FilePath -> SDoc
text "Running phase" SDoc -> SDoc -> SDoc
<+> PhasePlus -> SDoc
forall a. Outputable a => a -> SDoc
ppr PhasePlus
phase)
(next_phase :: PhasePlus
next_phase, output_fn :: FilePath
output_fn) <- PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runHookedPhase PhasePlus
phase FilePath
input_fn DynFlags
dflags
(DynFlags, FilePath)
r <- PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop PhasePlus
next_phase FilePath
output_fn
case PhasePlus
phase of
HscOut {} ->
DynFlags -> CompPipeline () -> CompPipeline ()
forall (m :: * -> *). MonadIO m => DynFlags -> m () -> m ()
whenGeneratingDynamicToo DynFlags
dflags (CompPipeline () -> CompPipeline ())
-> CompPipeline () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ do
DynFlags -> CompPipeline ()
setDynFlags (DynFlags -> CompPipeline ()) -> DynFlags -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
dynamicTooMkDynamicDynFlags DynFlags
dflags
(DynFlags, FilePath)
_ <- PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop PhasePlus
phase FilePath
input_fn
() -> CompPipeline ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ ->
() -> CompPipeline ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(DynFlags, FilePath) -> CompPipeline (DynFlags, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags, FilePath)
r
runHookedPhase :: PhasePlus -> FilePath -> DynFlags
-> CompPipeline (PhasePlus, FilePath)
runHookedPhase :: PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runHookedPhase pp :: PhasePlus
pp input :: FilePath
input dflags :: 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 next_phase :: 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 stop_phase :: Phase
stop_phase output :: PipelineOutput
output basename :: FilePath
basename dflags :: DynFlags
dflags next_phase :: Phase
next_phase maybe_location :: 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 f :: FilePath
f -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
f
Nothing ->
FilePath -> IO FilePath
forall a. FilePath -> a
panic "SpecificFile: No filename"
| Bool
keep_this_output = IO FilePath
persistent_fn
| Temporary lifetime :: 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 HCc = FilePath
hcsuf
myPhaseInputExt MergeForeign = FilePath
osuf
myPhaseInputExt StopLn = FilePath
osuf
myPhaseInputExt other :: 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
keep_s -> Bool
True
LlvmOpt | Bool
keep_bc -> Bool
True
HCc | Bool
keep_hc -> Bool
True
HsPp _ | Bool
keep_hscpp -> Bool
True
_other :: 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 loc :: ModLocation
loc <- Maybe ModLocation
maybe_location = ModLocation -> FilePath
ml_obj_file ModLocation
loc
| Just d :: FilePath
d <- Maybe FilePath
odir = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
persistent
| Bool
otherwise = FilePath
persistent
fastLlvmPipeline :: DynFlags -> Bool
fastLlvmPipeline :: DynFlags -> Bool
fastLlvmPipeline dflags :: 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 dflags :: DynFlags
dflags =
[("-enable-tbaa -tbaa", "-enable-tbaa") | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LlvmTBAA DynFlags
dflags ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [("-relocation-model=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rmodel
,"-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]
++ [("-stack-alignment=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
align)
,"-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
> 0 ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [("", "-filetype=obj") | DynFlags -> Bool
fastLlvmPipeline DynFlags
dflags ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [("", "-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 "-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]
++ [("", "-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 = LLVM_TARGET
Just (LlvmTarget _ mcpu :: FilePath
mcpu mattr :: [FilePath]
mattr) = FilePath -> [(FilePath, LlvmTarget)] -> Maybe LlvmTarget
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
target (DynFlags -> [(FilePath, LlvmTarget)]
llvmTargets DynFlags
dflags)
rmodel :: FilePath
rmodel | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags = "pic"
| DynFlags -> Bool
positionIndependent DynFlags
dflags = "pic"
| Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags = "dynamic-no-pic"
| Bool
otherwise = "static"
align :: Int
align :: Int
align = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
ArchX86_64 | DynFlags -> Bool
isAvxEnabled DynFlags
dflags -> 32
_ -> 0
attrs :: String
attrs :: FilePath
attrs = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "," ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
mattr
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+sse42" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+sse2" | DynFlags -> Bool
isSse2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+sse" | DynFlags -> Bool
isSseEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx512f" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx2" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx512cd"| DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx512er"| DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+avx512pf"| DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+bmi" | DynFlags -> Bool
isBmiEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["+bmi2" | DynFlags -> Bool
isBmi2Enabled DynFlags
dflags ]
runPhase :: PhasePlus
-> FilePath
-> DynFlags
-> CompPipeline (PhasePlus,
FilePath)
runPhase :: PhasePlus
-> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)
runPhase (RealPhase (Unlit sf :: HscSource
sf)) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename (HscSource -> Phase
Cpp HscSource
sf)
let flags :: [Option]
flags = [
FilePath -> Option
SysTools.Option "-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
input_fn
, FilePath -> FilePath -> Option
SysTools.FileOption "" 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 ('\\':cs :: FilePath
cs) = '\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape ('\"':cs :: FilePath
cs) = '\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:'\"'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape ('\'':cs :: FilePath
cs) = '\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:'\''Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (c :: Char
c:cs :: FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape [] = []
runPhase (RealPhase (Cpp sf :: HscSource
sf)) input_fn :: FilePath
input_fn dflags0 :: 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
(dflags1 :: DynFlags
dflags1, unhandled_flags :: [Located FilePath]
unhandled_flags, warns :: [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
(dflags2 :: DynFlags
dflags2, unhandled_flags :: [Located FilePath]
unhandled_flags, warns :: [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 sf :: HscSource
sf)) input_fn :: FilePath
input_fn dflags :: 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
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
(dflags1 :: DynFlags
dflags1, unhandled_flags :: [Located FilePath]
unhandled_flags, warns :: [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 src_flavour :: HscSource
src_flavour)) input_fn :: FilePath
input_fn dflags0 :: 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
(hspp_buf :: Maybe InputFileBuffer
hspp_buf,mod_name :: ModuleName
mod_name,imps :: [(Maybe FastString, Located ModuleName)]
imps,src_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 errs :: 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 (src_imps :: [(Maybe FastString, Located ModuleName)]
src_imps,imps :: [(Maybe FastString, Located ModuleName)]
imps,L _ mod_name :: 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 hsc_env :: HscEnv
hsc_env _ what :: RecompileRequired
what _ = HscEnv -> RecompileRequired -> IO ()
oneShotMsg HscEnv
hsc_env RecompileRequired
what
(result :: HscStatus
result, _) <- IO (HscStatus, HomeModInfo)
-> CompPipeline (HscStatus, HomeModInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HscStatus, HomeModInfo)
-> CompPipeline (HscStatus, HomeModInfo))
-> IO (HscStatus, HomeModInfo)
-> CompPipeline (HscStatus, HomeModInfo)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe TcGblEnv
-> Maybe Messager
-> HscEnv
-> ModSummary
-> SourceModified
-> Maybe ModIface
-> (Int, Int)
-> IO (HscStatus, HomeModInfo)
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 (1,1)
(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 "HscOut doesn't have an input filename")
runPhase (HscOut src_flavour :: HscSource
src_flavour mod_name :: ModuleName
mod_name result :: HscStatus
result) _ dflags :: 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 = DynFlags -> HscSource -> HscTarget -> Phase
hscPostBackendPhase DynFlags
dflags HscSource
src_flavour HscTarget
hsc_lang
case HscStatus
result of
HscNotGeneratingCode ->
(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 "No output filename from Hsc when no-code")
HscUpToDate ->
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 ->
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 ->
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 "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 cgguts :: CgGuts
cgguts mod_summary :: ModSummary
mod_summary
-> do FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
PipeState{hsc_env :: PipeState -> HscEnv
hsc_env=HscEnv
hsc_env'} <- CompPipeline PipeState
getPipeState
(outputFilename :: FilePath
outputFilename, mStub :: Maybe FilePath
mStub, foreign_files :: [(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
-> ModSummary
-> FilePath
-> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
hscGenHardCode HscEnv
hsc_env' CgGuts
cgguts ModSummary
mod_summary FilePath
output_fn
Maybe FilePath
stub_o <- IO (Maybe FilePath) -> CompPipeline (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO FilePath) -> Maybe FilePath -> IO (Maybe FilePath)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env') Maybe FilePath
mStub)
[FilePath]
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 CmmCpp) input_fn :: FilePath
input_fn dflags :: 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 Cmm) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
let hsc_lang :: HscTarget
hsc_lang = DynFlags -> HscTarget
hscTarget DynFlags
dflags
let next_phase :: Phase
next_phase = DynFlags -> HscSource -> HscTarget -> Phase
hscPostBackendPhase DynFlags
dflags 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 cc_phase :: Phase
cc_phase) input_fn :: FilePath
input_fn dflags :: 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 (\ x :: FilePath
x xs :: [FilePath]
xs -> ("-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 (\ x :: FilePath
x xs :: [FilePath]
xs -> ("-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
[ ["-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 ("-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
>= 2 = [ "-O2" ]
| DynFlags -> Int
optLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = [ "-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 [ "-ffloat-store" ]
else []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
["-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
let gcc_lang_opt :: FilePath
gcc_lang_opt | Phase
cc_phase Phase -> Phase -> Bool
`eqPhase` Phase
Ccxx = "c++"
| Phase
cc_phase Phase -> Phase -> Bool
`eqPhase` Phase
Cobjc = "objective-c"
| Phase
cc_phase Phase -> Phase -> Bool
`eqPhase` Phase
Cobjcxx = "objective-c++"
| Bool
otherwise = "c"
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.runCc DynFlags
dflags (
[ FilePath -> Option
SysTools.Option "-x", FilePath -> Option
SysTools.Option FilePath
gcc_lang_opt
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
input_fn
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" 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 [ "-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 ["-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 ["-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]
++ [ "-S" ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cc_opt
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ "-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 Splitter) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
FilePath
split_s_prefix <-
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 -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule "split"
let n_files_fn :: FilePath
n_files_fn = FilePath
split_s_prefix
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.runSplit DynFlags
dflags
[ FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
input_fn
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
split_s_prefix
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
n_files_fn
]
FilePath
s <- 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
$ FilePath -> IO FilePath
readFile FilePath
n_files_fn
let n_files :: Int
n_files = FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
s :: Int
dflags' :: DynFlags
dflags' = DynFlags
dflags { splitInfo :: Maybe (FilePath, Int)
splitInfo = (FilePath, Int) -> Maybe (FilePath, Int)
forall a. a -> Maybe a
Just (FilePath
split_s_prefix, Int
n_files) }
DynFlags -> CompPipeline ()
setDynFlags 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
$ DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
addFilesToClean DynFlags
dflags' TempFileLifetime
TFL_CurrentModule ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ FilePath
split_s_prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "__" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ".s"
| Int
n <- [1..Int
n_files]]
(PhasePlus, FilePath) -> CompPipeline (PhasePlus, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Phase -> PhasePlus
RealPhase Phase
SplitAs,
"**splitter**")
runPhase (RealPhase (As with_cpp :: Bool
with_cpp)) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
let whichAsProg :: CompPipeline (DynFlags -> [Option] -> IO ())
whichAsProg | 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 ())
-> CompPipeline (DynFlags -> [Option] -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags -> [Option] -> IO ()
SysTools.runClang
| Bool
otherwise = (DynFlags -> [Option] -> IO ())
-> CompPipeline (DynFlags -> [Option] -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags -> [Option] -> IO ()
SysTools.runAs
DynFlags -> [Option] -> IO ()
as_prog <- CompPipeline (DynFlags -> [Option] -> IO ())
whichAsProg
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 ("-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 ("-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 inputFilename :: FilePath
inputFilename outputFilename :: 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
$ 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 "-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 "-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 "-Qunused-arguments"]
else [])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
SysTools.Option "-x"
, if Bool
with_cpp
then FilePath -> Option
SysTools.Option "assembler-with-cpp"
else FilePath -> Option
SysTools.Option "assembler"
, FilePath -> Option
SysTools.Option "-c"
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
inputFilename
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
outputFilename
])
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 4 (FilePath -> SDoc
text "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 SplitAs) _input_fn :: FilePath
_input_fn dflags :: DynFlags
dflags
= do
let next_phase :: Phase
next_phase = Phase
StopLn
FilePath
output_fn <- Phase -> CompPipeline FilePath
phaseOutputFilename Phase
next_phase
let base_o :: FilePath
base_o = FilePath -> FilePath
dropExtension FilePath
output_fn
osuf :: FilePath
osuf = DynFlags -> FilePath
objectSuf DynFlags
dflags
split_odir :: FilePath
split_odir = FilePath
base_o FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
osuf FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_split"
let pic_c_flags :: [FilePath]
pic_c_flags = DynFlags -> [FilePath]
picCCOpts 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
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
split_odir
[FilePath]
fs <- 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
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
split_odir
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
split_odir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
osuf FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [FilePath]
fs
let (split_s_prefix :: FilePath
split_s_prefix, n :: Int
n) = case DynFlags -> Maybe (FilePath, Int)
splitInfo DynFlags
dflags of
Nothing -> FilePath -> (FilePath, Int)
forall a. FilePath -> a
panic "No split info"
Just x :: (FilePath, Int)
x -> (FilePath, Int)
x
let split_s :: a -> FilePath
split_s n :: a
n = FilePath
split_s_prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "__" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
n FilePath -> FilePath -> FilePath
<.> "s"
split_obj :: Int -> FilePath
split_obj :: Int -> FilePath
split_obj n :: Int
n = FilePath
split_odir FilePath -> FilePath -> FilePath
</>
FilePath -> FilePath
takeFileName FilePath
base_o FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "__" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
<.> FilePath
osuf
let assemble_file :: Int -> IO ()
assemble_file n :: Int
n
= DynFlags -> [Option] -> IO ()
SysTools.runAs DynFlags
dflags (
(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 "-mcpu=v9"]
else []) [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 "-c"
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" (Int -> FilePath
split_obj Int
n)
, FilePath -> FilePath -> Option
SysTools.FileOption "" (Int -> FilePath
forall a. Show a => a -> FilePath
split_s Int
n)
])
IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> IO ()
assemble_file [1..Int
n]
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 () -> CompPipeline ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else IO () -> CompPipeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CompPipeline ()) -> IO () -> CompPipeline ()
forall a b. (a -> b) -> a -> b
$ do
FilePath
tmp_split_1 <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
osuf
let split_1 :: FilePath
split_1 = Int -> FilePath
split_obj 1
FilePath -> FilePath -> IO ()
copyFile FilePath
split_1 FilePath
tmp_split_1
FilePath -> IO ()
removeFile FilePath
split_1
DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles DynFlags
dflags (FilePath
tmp_split_1 FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
foreign_os) FilePath
split_1
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 ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
split_obj [1..Int
n]) 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 LlvmOpt) input_fn :: FilePath
input_fn dflags :: 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
input_fn
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" 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 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 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
$ DynFlags -> [(Int, FilePath)]
llvmPasses DynFlags
dflags of
Just passes :: FilePath
passes -> FilePath
passes
Nothing -> FilePath -> FilePath
forall a. FilePath -> a
panic ("runPhase LlvmOpt: llvm-passes file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "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 LlvmLlc) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
Phase
next_phase <- if DynFlags -> Bool
fastLlvmPipeline DynFlags
dflags
then CompPipeline Phase
maybeMergeForeign
else case GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_NoLlvmMangler DynFlags
dflags of
False -> Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
LlvmMangle
True | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SplitObjs DynFlags
dflags -> Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
Splitter
True -> Phase -> CompPipeline Phase
forall (m :: * -> *) a. Monad m => a -> m a
return (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 -> [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
input_fn
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" 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
0 -> "-O1"
1 -> "-O1"
_ -> "-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 LlvmMangle) input_fn :: FilePath
input_fn dflags :: DynFlags
dflags
= do
let next_phase :: Phase
next_phase = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SplitObjs DynFlags
dflags then Phase
Splitter else 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 MergeForeign) input_fn :: FilePath
input_fn dflags :: 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 "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 other :: Phase
other) _input_fn :: FilePath
_input_fn _dflags :: DynFlags
_dflags =
FilePath -> CompPipeline (PhasePlus, FilePath)
forall a. FilePath -> a
panic ("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 src_flavour :: HscSource
src_flavour mod_name :: 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 l :: 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
}
_ -> 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 fn :: 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 ofile :: 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 filename :: 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
$ \h :: Handle
h -> do
FilePath
l <- Handle -> IO FilePath
hGetLine Handle
h
case FilePath
l of
'/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest :: 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))
_other :: 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' staticLink :: Bool
staticLink dflags :: DynFlags
dflags o_files :: [FilePath]
o_files dep_packages :: [InstalledUnitId]
dep_packages = do
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
mySettings :: Settings
mySettings = DynFlags -> Settings
settings 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 l :: 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 "$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 ["-Xlinker", "-rpath", "-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 ["-Xlinker", "-rpath-link", "-Xlinker", FilePath
l]
in ["-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 "@loader_path" FilePath -> FilePath -> FilePath
</>
(FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
else FilePath
l
in ["-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["-Xlinker", "-rpath", "-Xlinker", FilePath
libpath]
| Bool
otherwise = ["-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)
| (lib :: FilePath
lib, basename :: FilePath
basename) <- [(FilePath, FilePath)]
libs]
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ "-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 ["-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 ("-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
(pre_hs_libs :: [FilePath]
pre_hs_libs, post_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 (["-Wl,-all_load"], [])
else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
| Bool
otherwise
= ([],[])
[FilePath]
pkg_link_opts <- do
(package_hs_libs :: [FilePath]
package_hs_libs, extra_libs :: [FilePath]
extra_libs, other_flags :: [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
let debug_opts :: [a]
debug_opts | Way
WayDebug Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags = [
#if defined(HAVE_LIBBFD)
"-lbfd", "-liberty"
#endif
]
| Bool
otherwise = []
thread_opts :: [FilePath]
thread_opts | Way
WayThreaded Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags = [
#if NEED_PTHREAD_LIB
"-lpthread"
#endif
]
| Bool
otherwise = []
[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 "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" 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 ["-Wl,--enable-auto-import"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Settings -> Bool
sLdSupportsCompactUnwind Settings
mySettings 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
ArchX86 -> Bool
True
ArchX86_64 -> Bool
True
ArchARM {} -> Bool
True
ArchARM64 -> Bool
True
_ -> Bool
False
then ["-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 ["-Wl,-read_only_relocs,suppress"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Settings -> Bool
sLdIsGnuLd Settings
mySettings Bool -> Bool -> Bool
&&
Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags)
then ["-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]
++ [FilePath]
forall a. [a]
debug_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
thread_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 [ "-Wl,-dead_strip_dylibs" ]
else [])
))
exeFileName :: Bool -> DynFlags -> FilePath
exeFileName :: Bool -> DynFlags -> FilePath
exeFileName staticLink :: Bool
staticLink dflags :: DynFlags
dflags
| Just s :: FilePath
s <- DynFlags -> Maybe FilePath
outputFile DynFlags
dflags =
case Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
OSMinGW32 -> FilePath
s FilePath -> FilePath -> FilePath
<?.> "exe"
_ -> if Bool
staticLink
then FilePath
s 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 "main.exe"
else if Bool
staticLink
then "liba.a"
else "a.out"
where s :: FilePath
s <?.> :: FilePath -> FilePath -> FilePath
<?.> ext :: 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 dflags :: DynFlags
dflags exe_filename :: 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
<.> "manifest"
FilePath -> FilePath -> IO ()
writeFile FilePath
manifest_filename (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <assemblyIdentity version=\"1.0.0.0\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" processorArchitecture=\"X86\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" name=\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
dropExtension FilePath
exe_filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\"\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" type=\"win32\"/>\n\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <security>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <requestedPrivileges>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" </requestedPrivileges>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" </security>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
" </trustInfo>\n"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
"</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 "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
$
"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]
++ "\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
$
["--input="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_filename,
"--output="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_obj_filename,
"--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 dflags :: DynFlags
dflags o_files :: [FilePath]
o_files dep_packages :: [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 "Warning: -rtsopts and -with-rtsopts have no effect with -shared." SDoc -> SDoc -> SDoc
$$
FilePath -> SDoc
text " 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 dflags :: DynFlags
dflags o_files :: [FilePath]
o_files dep_packages :: [InstalledUnitId]
dep_packages = do
let extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption _ f :: 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 Settings -> Bool
sLdIsGnuLd (DynFlags -> Settings
settings 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
output_fn]
doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
doCpp dflags :: DynFlags
dflags raw :: Bool
raw input_fn :: FilePath
input_fn output_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 (\ x :: FilePath
x xs :: [FilePath]
xs -> ("-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 (\ x :: FilePath
x xs :: [FilePath]
xs -> ("-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 args :: [Option]
args | Bool
raw = DynFlags -> [Option] -> IO ()
SysTools.runCpp DynFlags
dflags [Option]
args
| Bool
otherwise = DynFlags -> [Option] -> IO ()
SysTools.runCc DynFlags
dflags (FilePath -> Option
SysTools.Option "-E" Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args)
let target_defs :: [FilePath]
target_defs =
[ "-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HOST_OS FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "_BUILD_OS",
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HOST_ARCH ++ "_BUILD_ARCH",
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TARGET_OS ++ "_HOST_OS",
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TARGET_ARCH ++ "_HOST_ARCH" ]
let sse_defs :: [FilePath]
sse_defs =
[ "-D__SSE__" | DynFlags -> Bool
isSseEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__SSE2__" | DynFlags -> Bool
isSse2Enabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__SSE4_2__" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
let avx_defs :: [FilePath]
avx_defs =
[ "-D__AVX__" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__AVX2__" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__AVX512CD__" | DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__AVX512ER__" | DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__AVX512F__" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ "-D__AVX512PF__" | DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath]
backend_defs <- DynFlags -> IO [FilePath]
getBackendDefs DynFlags
dflags
let th_defs :: [FilePath]
th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
FilePath
ghcVersionH <- DynFlags -> IO FilePath
getGhcVersionPathName DynFlags
dflags
let hsSourceCppOpts :: [FilePath]
hsSourceCppOpts = [ "-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 "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 "-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 "-x"
, FilePath -> Option
SysTools.Option "assembler-with-cpp"
, FilePath -> Option
SysTools.Option FilePath
input_fn
, FilePath -> Option
SysTools.Option "-o"
, FilePath -> FilePath -> Option
SysTools.FileOption "" FilePath
output_fn
])
getBackendDefs :: DynFlags -> IO [String