{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
#include <ghcplatform.h>
module GHC.Driver.Pipeline.Execute where
import GHC.Prelude
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Catch
import GHC.Driver.Hooks
import Control.Monad.Trans.Reader
import GHC.Driver.Pipeline.Monad
import GHC.Driver.Pipeline.Phases
import GHC.Driver.Env hiding (Hsc)
import GHC.Unit.Module.Location
import GHC.Driver.Phases
import GHC.Unit.Module.Name ( ModuleName )
import GHC.Unit.Types
import GHC.Types.SourceFile
import GHC.Unit.Module.Status
import GHC.Unit.Module.ModIface
import GHC.Linker.Types
import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Driver.CmdLine
import GHC.Unit.Module.ModSummary
import qualified GHC.LanguageExtensions as LangExt
import GHC.Types.SrcLoc
import GHC.Driver.Main
import GHC.Tc.Types
import GHC.Types.Error
import GHC.Driver.Errors.Types
import GHC.Fingerprint
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Platform
import Data.List (intercalate, isInfixOf)
import GHC.Unit.Env
import GHC.SysTools.Info
import GHC.Utils.Error
import Data.Maybe
import GHC.CmmToLlvm.Mangler
import GHC.SysTools
import GHC.Utils.Panic.Plain
import System.Directory
import System.FilePath
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Unit.Info
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Data.Maybe
import GHC.Iface.Make
import Data.Time
import GHC.Driver.Config.Parser
import GHC.Parser.Header
import GHC.Data.StringBuffer
import GHC.Types.SourceError
import GHC.Unit.Finder
import GHC.Runtime.Loader
import Data.IORef
import GHC.Types.Name.Env
import GHC.Platform.Ways
import GHC.Platform.ArchOS
import GHC.CmmToLlvm.Base ( llvmVersionList )
import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub)
import GHC.Settings
import System.IO
import GHC.Linker.ExtraObj
import GHC.Linker.Dynamic
import Data.Version
import GHC.Utils.Panic
import GHC.Unit.Module.Env
import GHC.Driver.Env.KnotVars
import GHC.Driver.Config.Finder
import GHC.Rename.Names
newtype HookedUse a = HookedUse { HookedUse a -> (Hooks, PhaseHook) -> IO a
runHookedUse :: (Hooks, PhaseHook) -> IO a }
deriving (a -> HookedUse b -> HookedUse a
(a -> b) -> HookedUse a -> HookedUse b
(forall a b. (a -> b) -> HookedUse a -> HookedUse b)
-> (forall a b. a -> HookedUse b -> HookedUse a)
-> Functor HookedUse
forall a b. a -> HookedUse b -> HookedUse a
forall a b. (a -> b) -> HookedUse a -> HookedUse b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HookedUse b -> HookedUse a
$c<$ :: forall a b. a -> HookedUse b -> HookedUse a
fmap :: (a -> b) -> HookedUse a -> HookedUse b
$cfmap :: forall a b. (a -> b) -> HookedUse a -> HookedUse b
Functor, Functor HookedUse
a -> HookedUse a
Functor HookedUse
-> (forall a. a -> HookedUse a)
-> (forall a b. HookedUse (a -> b) -> HookedUse a -> HookedUse b)
-> (forall a b c.
(a -> b -> c) -> HookedUse a -> HookedUse b -> HookedUse c)
-> (forall a b. HookedUse a -> HookedUse b -> HookedUse b)
-> (forall a b. HookedUse a -> HookedUse b -> HookedUse a)
-> Applicative HookedUse
HookedUse a -> HookedUse b -> HookedUse b
HookedUse a -> HookedUse b -> HookedUse a
HookedUse (a -> b) -> HookedUse a -> HookedUse b
(a -> b -> c) -> HookedUse a -> HookedUse b -> HookedUse c
forall a. a -> HookedUse a
forall a b. HookedUse a -> HookedUse b -> HookedUse a
forall a b. HookedUse a -> HookedUse b -> HookedUse b
forall a b. HookedUse (a -> b) -> HookedUse a -> HookedUse b
forall a b c.
(a -> b -> c) -> HookedUse a -> HookedUse b -> HookedUse c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: HookedUse a -> HookedUse b -> HookedUse a
$c<* :: forall a b. HookedUse a -> HookedUse b -> HookedUse a
*> :: HookedUse a -> HookedUse b -> HookedUse b
$c*> :: forall a b. HookedUse a -> HookedUse b -> HookedUse b
liftA2 :: (a -> b -> c) -> HookedUse a -> HookedUse b -> HookedUse c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HookedUse a -> HookedUse b -> HookedUse c
<*> :: HookedUse (a -> b) -> HookedUse a -> HookedUse b
$c<*> :: forall a b. HookedUse (a -> b) -> HookedUse a -> HookedUse b
pure :: a -> HookedUse a
$cpure :: forall a. a -> HookedUse a
$cp1Applicative :: Functor HookedUse
Applicative, Applicative HookedUse
a -> HookedUse a
Applicative HookedUse
-> (forall a b. HookedUse a -> (a -> HookedUse b) -> HookedUse b)
-> (forall a b. HookedUse a -> HookedUse b -> HookedUse b)
-> (forall a. a -> HookedUse a)
-> Monad HookedUse
HookedUse a -> (a -> HookedUse b) -> HookedUse b
HookedUse a -> HookedUse b -> HookedUse b
forall a. a -> HookedUse a
forall a b. HookedUse a -> HookedUse b -> HookedUse b
forall a b. HookedUse a -> (a -> HookedUse b) -> HookedUse b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HookedUse a
$creturn :: forall a. a -> HookedUse a
>> :: HookedUse a -> HookedUse b -> HookedUse b
$c>> :: forall a b. HookedUse a -> HookedUse b -> HookedUse b
>>= :: HookedUse a -> (a -> HookedUse b) -> HookedUse b
$c>>= :: forall a b. HookedUse a -> (a -> HookedUse b) -> HookedUse b
$cp1Monad :: Applicative HookedUse
Monad, Monad HookedUse
Monad HookedUse
-> (forall a. IO a -> HookedUse a) -> MonadIO HookedUse
IO a -> HookedUse a
forall a. IO a -> HookedUse a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> HookedUse a
$cliftIO :: forall a. IO a -> HookedUse a
$cp1MonadIO :: Monad HookedUse
MonadIO, Monad HookedUse
e -> HookedUse a
Monad HookedUse
-> (forall e a. Exception e => e -> HookedUse a)
-> MonadThrow HookedUse
forall e a. Exception e => e -> HookedUse a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> HookedUse a
$cthrowM :: forall e a. Exception e => e -> HookedUse a
$cp1MonadThrow :: Monad HookedUse
MonadThrow, MonadThrow HookedUse
MonadThrow HookedUse
-> (forall e a.
Exception e =>
HookedUse a -> (e -> HookedUse a) -> HookedUse a)
-> MonadCatch HookedUse
HookedUse a -> (e -> HookedUse a) -> HookedUse a
forall e a.
Exception e =>
HookedUse a -> (e -> HookedUse a) -> HookedUse a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: HookedUse a -> (e -> HookedUse a) -> HookedUse a
$ccatch :: forall e a.
Exception e =>
HookedUse a -> (e -> HookedUse a) -> HookedUse a
$cp1MonadCatch :: MonadThrow HookedUse
MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)
instance MonadUse TPhase HookedUse where
use :: TPhase a -> HookedUse a
use TPhase a
fa = ((Hooks, PhaseHook) -> IO a) -> HookedUse a
forall a. ((Hooks, PhaseHook) -> IO a) -> HookedUse a
HookedUse (((Hooks, PhaseHook) -> IO a) -> HookedUse a)
-> ((Hooks, PhaseHook) -> IO a) -> HookedUse a
forall a b. (a -> b) -> a -> b
$ \(Hooks
hooks, (PhaseHook forall a. TPhase a -> IO a
k)) ->
case Hooks -> Maybe PhaseHook
runPhaseHook Hooks
hooks of
Maybe PhaseHook
Nothing -> TPhase a -> IO a
forall a. TPhase a -> IO a
k TPhase a
fa
Just (PhaseHook forall a. TPhase a -> IO a
h) -> TPhase a -> IO a
forall a. TPhase a -> IO a
h TPhase a
fa
runPipeline :: Hooks -> HookedUse a -> IO a
runPipeline :: Hooks -> HookedUse a -> IO a
runPipeline Hooks
hooks HookedUse a
pipeline = HookedUse a -> (Hooks, PhaseHook) -> IO a
forall a. HookedUse a -> (Hooks, PhaseHook) -> IO a
runHookedUse HookedUse a
pipeline (Hooks
hooks, (forall a. TPhase a -> IO a) -> PhaseHook
PhaseHook forall a. TPhase a -> IO a
runPhase)
runPhase :: TPhase out -> IO out
runPhase :: TPhase out -> IO out
runPhase (T_Unlit PipeEnv
pipe_env HscEnv
hsc_env FilePath
inp_path) = do
FilePath
out_path <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew (HscSource -> Phase
Cpp HscSource
HsSrcFile) PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
HscEnv -> FilePath -> FilePath -> IO FilePath
runUnlitPhase HscEnv
hsc_env FilePath
inp_path FilePath
out_path
runPhase (T_FileArgs HscEnv
hsc_env FilePath
inp_path) = HscEnv -> FilePath -> IO (DynFlags, [Warn])
getFileArgs HscEnv
hsc_env FilePath
inp_path
runPhase (T_Cpp PipeEnv
pipe_env HscEnv
hsc_env FilePath
inp_path) = do
FilePath
out_path <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew (HscSource -> Phase
HsPp HscSource
HsSrcFile) PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
HscEnv -> FilePath -> FilePath -> IO FilePath
runCppPhase HscEnv
hsc_env FilePath
inp_path FilePath
out_path
runPhase (T_HsPp PipeEnv
pipe_env HscEnv
hsc_env FilePath
origin_path FilePath
inp_path) = do
FilePath
out_path <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew (HscSource -> Phase
Hsc HscSource
HsSrcFile) PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
HscEnv -> FilePath -> FilePath -> FilePath -> IO FilePath
runHsPpPhase HscEnv
hsc_env FilePath
origin_path FilePath
inp_path FilePath
out_path
runPhase (T_HscRecomp PipeEnv
pipe_env HscEnv
hsc_env FilePath
fp HscSource
hsc_src) = do
PipeEnv
-> HscEnv
-> FilePath
-> HscSource
-> IO (HscEnv, ModSummary, HscRecompStatus)
runHscPhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
fp HscSource
hsc_src
runPhase (T_Hsc HscEnv
hsc_env ModSummary
mod_sum) = HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
runHscTcPhase HscEnv
hsc_env ModSummary
mod_sum
runPhase (T_HscPostTc HscEnv
hsc_env ModSummary
ms FrontendResult
fer Messages GhcMessage
m Maybe Fingerprint
mfi) =
HscEnv
-> ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> IO HscBackendAction
runHscPostTcPhase HscEnv
hsc_env ModSummary
ms FrontendResult
fer Messages GhcMessage
m Maybe Fingerprint
mfi
runPhase (T_HscBackend PipeEnv
pipe_env HscEnv
hsc_env ModuleName
mod_name HscSource
hsc_src ModLocation
location HscBackendAction
x) = do
PipeEnv
-> HscEnv
-> ModuleName
-> HscSource
-> ModLocation
-> HscBackendAction
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
runHscBackendPhase PipeEnv
pipe_env HscEnv
hsc_env ModuleName
mod_name HscSource
hsc_src ModLocation
location HscBackendAction
x
runPhase (T_CmmCpp PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) = do
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
Cmm PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp (HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
(HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
Bool
False
FilePath
input_fn FilePath
output_fn
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runPhase (T_Cmm PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let next_phase :: Phase
next_phase = HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
HsSrcFile (DynFlags -> Backend
backend DynFlags
dflags)
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
Maybe FilePath
mstub <- HscEnv -> FilePath -> FilePath -> IO (Maybe FilePath)
hscCompileCmmFile HscEnv
hsc_env FilePath
input_fn FilePath
output_fn
Maybe FilePath
stub_o <- (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
let foreign_os :: [FilePath]
foreign_os = (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
stub_o)
([FilePath], FilePath) -> IO ([FilePath], FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
foreign_os, FilePath
output_fn)
runPhase (T_Cc Phase
phase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) = Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath
runCcPhase Phase
phase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
runPhase (T_As Bool
cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn) = do
Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> IO FilePath
runAsPhase Bool
cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn
runPhase (T_LlvmOpt PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) =
PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmOptPhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
runPhase (T_LlvmLlc PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) =
PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmLlcPhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
runPhase (T_LlvmMangle PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn) =
PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmManglePhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn
runPhase (T_MergeForeign PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn [FilePath]
fos) =
PipeEnv -> HscEnv -> FilePath -> [FilePath] -> IO FilePath
runMergeForeign PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn [FilePath]
fos
runLlvmManglePhase :: PipeEnv -> HscEnv -> FilePath -> IO [Char]
runLlvmManglePhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmManglePhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
let next_phase :: Phase
next_phase = Bool -> Phase
As Bool
False
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
Platform -> FilePath -> FilePath -> IO ()
llvmFixupAsm (DynFlags -> Platform
targetPlatform DynFlags
dflags) FilePath
input_fn FilePath
output_fn
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runMergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> IO FilePath
runMergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> IO FilePath
runMergeForeign PipeEnv
_pipe_env HscEnv
hsc_env FilePath
input_fn [FilePath]
foreign_os = do
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
foreign_os
then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
else do
FilePath
new_o <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName (HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(DynFlags -> TempDir
tmpDir (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))
TempFileLifetime
TFL_CurrentModule FilePath
"o"
FilePath -> FilePath -> IO ()
copyFile FilePath
input_fn FilePath
new_o
HscEnv -> [FilePath] -> FilePath -> IO ()
joinObjectFiles HscEnv
hsc_env (FilePath
new_o FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
foreign_os) FilePath
input_fn
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
input_fn
runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmLlcPhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
llvmOpts :: FilePath
llvmOpts = case DynFlags -> Int
llvmOptLevel DynFlags
dflags of
Int
0 -> FilePath
"-O1"
Int
1 -> FilePath
"-O1"
Int
_ -> FilePath
"-O2"
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
words ([FilePath] -> [FilePath])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd
(([FilePath], [FilePath]) -> [Option])
-> ([FilePath], [FilePath]) -> [Option]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip (DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags)
optFlag :: [Option]
optFlag = if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lc)
then (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
Phase
next_phase <- if
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_NoLlvmMangler DynFlags
dflags -> Phase -> IO Phase
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Phase
As Bool
False)
| Bool
otherwise -> Phase -> IO Phase
forall (m :: * -> *) a. Monad m => a -> m a
return Phase
LlvmMangle
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLlvmLlc Logger
logger DynFlags
dflags
( [Option]
optFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
defaultOptions
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
)
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runLlvmOptPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmOptPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runLlvmOptPhase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let
optIdx :: Int
optIdx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> Int
llvmOptLevel DynFlags
dflags
llvmOpts :: FilePath
llvmOpts = case Int -> [(Int, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
optIdx ([(Int, FilePath)] -> Maybe FilePath)
-> [(Int, FilePath)] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ LlvmConfig -> [(Int, FilePath)]
llvmPasses (LlvmConfig -> [(Int, FilePath)])
-> LlvmConfig -> [(Int, FilePath)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> LlvmConfig
llvmConfig DynFlags
dflags of
Just FilePath
passes -> FilePath
passes
Maybe FilePath
Nothing -> FilePath -> FilePath
forall a. FilePath -> a
panic (FilePath
"runPhase LlvmOpt: llvm-passes file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"is missing passes for level "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
optIdx)
defaultOptions :: [Option]
defaultOptions = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> (([FilePath], [FilePath]) -> [[FilePath]])
-> ([FilePath], [FilePath])
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
words ([FilePath] -> [[FilePath]])
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst
(([FilePath], [FilePath]) -> [Option])
-> ([FilePath], [FilePath]) -> [Option]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip (DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags)
optFlag :: [Option]
optFlag = if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lo)
then (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
llvmOpts
else []
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
LlvmLlc PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLlvmOpt Logger
logger DynFlags
dflags
( [Option]
optFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
defaultOptions [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++
[ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn]
)
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
runAsPhase :: Bool
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> FilePath
-> IO FilePath
runAsPhase Bool
with_cpp PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location FilePath
input_fn = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
let (Logger -> DynFlags -> [Option] -> IO ()
as_prog, IO CompilerInfo
get_asm_info) | DynFlags -> Backend
backend DynFlags
dflags Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
LLVM
, Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
= (Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runClang, CompilerInfo -> IO CompilerInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerInfo
Clang)
| Bool
otherwise
= (Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runAs, Logger -> DynFlags -> IO CompilerInfo
getAssemblerInfo Logger
logger DynFlags
dflags)
CompilerInfo
asmInfo <- IO CompilerInfo
get_asm_info
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags
let pic_c_flags :: [FilePath]
pic_c_flags = DynFlags -> [FilePath]
picCCOpts DynFlags
dflags
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
StopLn PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
location
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
output_fn)
let global_includes :: [Option]
global_includes = [ FilePath -> Option
GHC.SysTools.Option (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
| FilePath
p <- IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths ]
let local_includes :: [Option]
local_includes = [ FilePath -> Option
GHC.SysTools.Option (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
| FilePath
p <- IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths]
let runAssembler :: FilePath -> FilePath -> IO ()
runAssembler FilePath
inputFilename FilePath
outputFilename
= FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m a
withAtomicRename FilePath
outputFilename ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
temp_outputFilename ->
Logger -> DynFlags -> [Option] -> IO ()
as_prog
Logger
logger DynFlags
dflags
([Option]
local_includes [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
global_includes
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
pic_c_flags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-Wa,-mbig-obj"
| Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit (DynFlags -> Platform
targetPlatform DynFlags
dflags)
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if (CompilerInfo -> Bool) -> [CompilerInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CompilerInfo
asmInfo CompilerInfo -> CompilerInfo -> Bool
forall a. Eq a => a -> a -> Bool
==) [CompilerInfo
Clang, CompilerInfo
AppleClang, CompilerInfo
AppleClang51]
then [FilePath -> Option
GHC.SysTools.Option FilePath
"-Qunused-arguments"]
else [])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-x"
, if Bool
with_cpp
then FilePath -> Option
GHC.SysTools.Option FilePath
"assembler-with-cpp"
else FilePath -> Option
GHC.SysTools.Option FilePath
"assembler"
, FilePath -> Option
GHC.SysTools.Option FilePath
"-c"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
inputFilename
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
temp_outputFilename
])
Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
4 (FilePath -> SDoc
text FilePath
"Running the assembler")
FilePath -> FilePath -> IO ()
runAssembler FilePath
input_fn FilePath
output_fn
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runCcPhase :: Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath
runCcPhase :: Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath
runCcPhase Phase
cc_phase PipeEnv
pipe_env HscEnv
hsc_env FilePath
input_fn = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
let hcc :: Bool
hcc = Phase
cc_phase Phase -> Phase -> Bool
`eqPhase` Phase
HCc
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs -> IncludeSpecs
offsetIncludePaths DynFlags
dflags (DynFlags -> IncludeSpecs
includePaths DynFlags
dflags)
[UnitId]
pkgs <- if Bool
hcc then FilePath -> IO [UnitId]
getHCFilePackages FilePath
input_fn else [UnitId] -> IO [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[UnitInfo]
ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs)
let pkg_include_dirs :: [FilePath]
pkg_include_dirs = [UnitInfo] -> [FilePath]
collectIncludeDirs [UnitInfo]
ps
let include_paths_global :: [FilePath]
include_paths_global = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_include_dirs)
let include_paths_quote :: [FilePath]
include_paths_quote = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths)
let include_paths :: [FilePath]
include_paths = [FilePath]
include_paths_quote [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths_global
let opts :: [FilePath]
opts = DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_P
aug_imports :: [FilePath]
aug_imports = DynFlags -> [FilePath] -> [FilePath]
augmentImports DynFlags
dflags [FilePath]
opts
more_preprocessor_opts :: [FilePath]
more_preprocessor_opts = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [FilePath
"-Xpreprocessor", FilePath
i]
| Bool -> Bool
not Bool
hcc
, FilePath
i <- [FilePath]
aug_imports
]
let gcc_extra_viac_flags :: [FilePath]
gcc_extra_viac_flags = DynFlags -> [FilePath]
extraGccViaCFlags DynFlags
dflags
let pic_c_flags :: [FilePath]
pic_c_flags = DynFlags -> [FilePath]
picCCOpts DynFlags
dflags
let verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
let pkg_extra_cc_opts :: [FilePath]
pkg_extra_cc_opts
| Bool
hcc = []
| Bool
otherwise = [UnitInfo] -> [FilePath]
collectExtraCcOpts [UnitInfo]
ps
let framework_paths :: [FilePath]
framework_paths
| Platform -> Bool
platformUsesFrameworks Platform
platform
= let pkgFrameworkPaths :: [FilePath]
pkgFrameworkPaths = [UnitInfo] -> [FilePath]
collectFrameworksDirs [UnitInfo]
ps
cmdlineFrameworkPaths :: [FilePath]
cmdlineFrameworkPaths = DynFlags -> [FilePath]
frameworkPaths DynFlags
dflags
in (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-F"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath]
cmdlineFrameworkPaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgFrameworkPaths)
| Bool
otherwise
= []
let cc_opt :: [FilePath]
cc_opt | DynFlags -> Int
llvmOptLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = [ FilePath
"-O2" ]
| DynFlags -> Int
llvmOptLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = [ FilePath
"-O" ]
| Bool
otherwise = []
let next_phase :: Phase
next_phase = Bool -> Phase
As Bool
False
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
forall a. Maybe a
Nothing
let
more_hcc_opts :: [FilePath]
more_hcc_opts =
(if Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
&&
Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExcessPrecision DynFlags
dflags)
then [ FilePath
"-ffloat-store" ]
else []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"-fno-strict-aliasing"]
FilePath
ghcVersionH <- DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env
Maybe ForeignSrcLang
-> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCc (Phase -> Maybe ForeignSrcLang
phaseForeignLanguage Phase
cc_phase) Logger
logger TmpFs
tmpfs DynFlags
dflags (
[ FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option (
[FilePath]
pic_c_flags
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 Bool -> Bool -> Bool
&&
HomeUnit -> UnitId -> Bool
forall u. GenHomeUnit u -> UnitId -> Bool
isHomeUnitId HomeUnit
home_unit UnitId
baseUnitId
then [ FilePath
"-DCOMPILING_BASE_PACKAGE" ]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if (Phase
cc_phase Phase -> Phase -> Bool
forall a. Eq a => a -> a -> Bool
/= Phase
Ccxx Bool -> Bool -> Bool
&& Phase
cc_phase Phase -> Phase -> Bool
forall a. Eq a => a -> a -> Bool
/= Phase
Cobjcxx)
then [FilePath
"-Wimplicit"]
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
hcc
then [FilePath]
gcc_extra_viac_flags [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
more_hcc_opts
else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verbFlags
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-S" ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cc_opt
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"-include", FilePath
ghcVersionH ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
framework_paths
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
more_preprocessor_opts
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_extra_cc_opts
))
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runHscBackendPhase :: PipeEnv
-> HscEnv
-> ModuleName
-> HscSource
-> ModLocation
-> HscBackendAction
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
runHscBackendPhase :: PipeEnv
-> HscEnv
-> ModuleName
-> HscSource
-> ModLocation
-> HscBackendAction
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
runHscBackendPhase PipeEnv
pipe_env HscEnv
hsc_env ModuleName
mod_name HscSource
src_flavour ModLocation
location HscBackendAction
result = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
o_file :: FilePath
o_file = if DynFlags -> Bool
dynamicNow DynFlags
dflags then ModLocation -> FilePath
ml_dyn_obj_file ModLocation
location else ModLocation -> FilePath
ml_obj_file ModLocation
location
next_phase :: Phase
next_phase = HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
src_flavour (DynFlags -> Backend
backend DynFlags
dflags)
case HscBackendAction
result of
HscUpdate ModIface
iface ->
do
case HscSource
src_flavour of
HscSource
HsigFile -> do
let input_fn :: FilePath
input_fn = FilePath -> Maybe FilePath -> FilePath
forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"runPhase" (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location)
basename :: FilePath
basename = FilePath -> FilePath
dropExtension FilePath
input_fn
DynFlags
-> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
compileEmptyStub DynFlags
dflags HscEnv
hsc_env FilePath
basename ModLocation
location ModuleName
mod_name
HscSource
HsBootFile -> Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile Logger
logger DynFlags
dflags FilePath
o_file
HscSource
HsSrcFile -> FilePath -> IO ()
forall a. FilePath -> a
panic FilePath
"HscUpdate not relevant for HscSrcFile"
([FilePath], ModIface, Maybe Linkable, FilePath)
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], ModIface
iface, Maybe Linkable
forall a. Maybe a
Nothing, FilePath
o_file)
HscRecomp { hscs_guts :: HscBackendAction -> CgGuts
hscs_guts = CgGuts
cgguts,
hscs_mod_location :: HscBackendAction -> ModLocation
hscs_mod_location = ModLocation
mod_location,
hscs_partial_iface :: HscBackendAction -> PartialModIface
hscs_partial_iface = PartialModIface
partial_iface,
hscs_old_iface_hash :: HscBackendAction -> Maybe Fingerprint
hscs_old_iface_hash = Maybe Fingerprint
mb_old_iface_hash
}
-> case DynFlags -> Backend
backend DynFlags
dflags of
Backend
NoBackend -> FilePath -> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
forall a. FilePath -> a
panic FilePath
"HscRecomp not relevant for NoBackend"
Backend
Interpreter -> do
ModIface
final_iface <- HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe CgInfos
forall a. Maybe a
Nothing
Logger
-> DynFlags
-> Bool
-> ModIface
-> Maybe Fingerprint
-> ModLocation
-> IO ()
hscMaybeWriteIface Logger
logger DynFlags
dflags Bool
True ModIface
final_iface Maybe Fingerprint
mb_old_iface_hash ModLocation
location
(Maybe FilePath
hasStub, CompiledByteCode
comp_bc, [SptEntry]
spt_entries) <- HscEnv
-> CgGuts
-> ModLocation
-> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
hscInteractive HscEnv
hsc_env CgGuts
cgguts ModLocation
mod_location
[Unlinked]
stub_o <- case Maybe FilePath
hasStub of
Maybe FilePath
Nothing -> [Unlinked] -> IO [Unlinked]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just FilePath
stub_c -> do
FilePath
stub_o <- HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env FilePath
stub_c
[Unlinked] -> IO [Unlinked]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> Unlinked
DotO FilePath
stub_o]
let hs_unlinked :: [Unlinked]
hs_unlinked = [CompiledByteCode -> [SptEntry] -> Unlinked
BCOs CompiledByteCode
comp_bc [SptEntry]
spt_entries]
UTCTime
unlinked_time <- IO UTCTime
getCurrentTime
let !linkable :: Linkable
linkable = UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
unlinked_time (HomeUnit -> ModuleName -> Module
mkHomeModule (HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env) ModuleName
mod_name)
([Unlinked]
hs_unlinked [Unlinked] -> [Unlinked] -> [Unlinked]
forall a. [a] -> [a] -> [a]
++ [Unlinked]
stub_o)
([FilePath], ModIface, Maybe Linkable, FilePath)
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], ModIface
final_iface, Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
linkable, FilePath -> FilePath
forall a. FilePath -> a
panic FilePath
"interpreter")
Backend
_ -> do
FilePath
output_fn <- Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
location)
(FilePath
outputFilename, Maybe FilePath
mStub, [(ForeignSrcLang, FilePath)]
foreign_files, Maybe CgInfos
mb_cg_infos) <-
HscEnv
-> CgGuts
-> ModLocation
-> FilePath
-> IO
(FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)],
Maybe CgInfos)
hscGenHardCode HscEnv
hsc_env CgGuts
cgguts ModLocation
mod_location FilePath
output_fn
ModIface
final_iface <- HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe CgInfos
mb_cg_infos
Logger
-> DynFlags
-> Bool
-> ModIface
-> Maybe Fingerprint
-> ModLocation
-> IO ()
hscMaybeWriteIface Logger
logger DynFlags
dflags Bool
False ModIface
final_iface Maybe Fingerprint
mb_old_iface_hash ModLocation
mod_location
Maybe FilePath
stub_o <- (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 <-
((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
let fos :: [FilePath]
fos = ([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)
([FilePath], ModIface, Maybe Linkable, FilePath)
-> IO ([FilePath], ModIface, Maybe Linkable, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
fos, ModIface
final_iface, Maybe Linkable
forall a. Maybe a
Nothing, FilePath
outputFilename)
runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
runUnlitPhase HscEnv
hsc_env FilePath
input_fn FilePath
output_fn = do
let
escape :: FilePath -> FilePath
escape (Char
'\\':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
'\"':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\"'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
'\'':FilePath
cs) = Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\''Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape (Char
c:FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escape FilePath
cs
escape [] = []
let flags :: [Option]
flags = [
FilePath -> Option
GHC.SysTools.Option FilePath
"-h"
, FilePath -> Option
GHC.SysTools.Option (FilePath -> Option) -> FilePath -> Option
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
escape FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
]
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runUnlit Logger
logger DynFlags
dflags [Option]
flags
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [Warn]))
getFileArgs :: HscEnv -> FilePath -> IO (DynFlags, [Warn])
getFileArgs HscEnv
hsc_env FilePath
input_fn = do
let dflags0 :: DynFlags
dflags0 = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
parser_opts :: ParserOpts
parser_opts = DynFlags -> ParserOpts
initParserOpts DynFlags
dflags0
[Located FilePath]
src_opts <- ParserOpts -> FilePath -> IO [Located FilePath]
getOptionsFromFile ParserOpts
parser_opts FilePath
input_fn
(DynFlags
dflags1, [Located FilePath]
unhandled_flags, [Warn]
warns)
<- 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
[Located FilePath] -> IO ()
forall (m :: * -> *). MonadIO m => [Located FilePath] -> m ()
checkProcessArgsResult [Located FilePath]
unhandled_flags
(DynFlags, [Warn]) -> IO (DynFlags, [Warn])
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
dflags1, [Warn]
warns)
runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
runCppPhase HscEnv
hsc_env FilePath
input_fn FilePath
output_fn = do
Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp (HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
(HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env)
(HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
(HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
Bool
True
FilePath
input_fn FilePath
output_fn
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
runHscPhase :: PipeEnv
-> HscEnv
-> FilePath
-> HscSource
-> IO (HscEnv, ModSummary, HscRecompStatus)
runHscPhase :: PipeEnv
-> HscEnv
-> FilePath
-> HscSource
-> IO (HscEnv, ModSummary, HscRecompStatus)
runHscPhase PipeEnv
pipe_env HscEnv
hsc_env0 FilePath
input_fn HscSource
src_flavour = do
let dflags0 :: DynFlags
dflags0 = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env0
PipeEnv{ src_basename :: PipeEnv -> FilePath
src_basename=FilePath
basename,
src_suffix :: PipeEnv -> FilePath
src_suffix=FilePath
suff } = PipeEnv
pipe_env
let current_dir :: FilePath
current_dir = FilePath -> FilePath
takeDirectory FilePath
basename
new_includes :: IncludeSpecs
new_includes = IncludeSpecs -> [FilePath] -> IncludeSpecs
addImplicitQuoteInclude IncludeSpecs
paths [FilePath
current_dir]
paths :: IncludeSpecs
paths = DynFlags -> IncludeSpecs
includePaths DynFlags
dflags0
dflags :: DynFlags
dflags = DynFlags
dflags0 { includePaths :: IncludeSpecs
includePaths = IncludeSpecs
new_includes }
hsc_env :: HscEnv
hsc_env = HasDebugCallStack => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags HscEnv
hsc_env0
(Maybe StringBuffer
hspp_buf,ModuleName
mod_name,[(PkgQual, GenLocated SrcSpan ModuleName)]
imps,[(PkgQual, GenLocated SrcSpan ModuleName)]
src_imps, Bool
ghc_prim_imp) <- do
StringBuffer
buf <- FilePath -> IO StringBuffer
hGetStringBuffer FilePath
input_fn
let imp_prelude :: Bool
imp_prelude = Extension -> DynFlags -> Bool
xopt Extension
LangExt.ImplicitPrelude DynFlags
dflags
popts :: ParserOpts
popts = DynFlags -> ParserOpts
initParserOpts DynFlags
dflags
rn_pkg_qual :: ModuleName -> RawPkgQual -> PkgQual
rn_pkg_qual = UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual (HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
rn_imps :: [(RawPkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
rn_imps = ((RawPkgQual, GenLocated SrcSpan ModuleName)
-> (PkgQual, GenLocated SrcSpan ModuleName))
-> [(RawPkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(RawPkgQual
rpk, lmn :: GenLocated SrcSpan ModuleName
lmn@(L SrcSpan
_ ModuleName
mn)) -> (ModuleName -> RawPkgQual -> PkgQual
rn_pkg_qual ModuleName
mn RawPkgQual
rpk, GenLocated SrcSpan ModuleName
lmn))
Either
(Messages PsMessage)
([(RawPkgQual, GenLocated SrcSpan ModuleName)],
[(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
GenLocated SrcSpan ModuleName)
eimps <- ParserOpts
-> Bool
-> StringBuffer
-> FilePath
-> FilePath
-> IO
(Either
(Messages PsMessage)
([(RawPkgQual, GenLocated SrcSpan ModuleName)],
[(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
GenLocated SrcSpan ModuleName))
getImports ParserOpts
popts Bool
imp_prelude StringBuffer
buf FilePath
input_fn (FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff)
case Either
(Messages PsMessage)
([(RawPkgQual, GenLocated SrcSpan ModuleName)],
[(RawPkgQual, GenLocated SrcSpan ModuleName)], Bool,
GenLocated SrcSpan ModuleName)
eimps of
Left Messages PsMessage
errs -> Messages GhcMessage
-> IO
(Maybe StringBuffer, ModuleName,
[(PkgQual, GenLocated SrcSpan ModuleName)],
[(PkgQual, GenLocated SrcSpan ModuleName)], Bool)
forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
throwErrors (PsMessage -> GhcMessage
GhcPsMessage (PsMessage -> GhcMessage)
-> Messages PsMessage -> Messages GhcMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages PsMessage
errs)
Right ([(RawPkgQual, GenLocated SrcSpan ModuleName)]
src_imps,[(RawPkgQual, GenLocated SrcSpan ModuleName)]
imps, Bool
ghc_prim_imp, L SrcSpan
_ ModuleName
mod_name) -> (Maybe StringBuffer, ModuleName,
[(PkgQual, GenLocated SrcSpan ModuleName)],
[(PkgQual, GenLocated SrcSpan ModuleName)], Bool)
-> IO
(Maybe StringBuffer, ModuleName,
[(PkgQual, GenLocated SrcSpan ModuleName)],
[(PkgQual, GenLocated SrcSpan ModuleName)], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return
(StringBuffer -> Maybe StringBuffer
forall a. a -> Maybe a
Just StringBuffer
buf, ModuleName
mod_name, [(RawPkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
rn_imps [(RawPkgQual, GenLocated SrcSpan ModuleName)]
imps, [(RawPkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
rn_imps [(RawPkgQual, GenLocated SrcSpan ModuleName)]
src_imps, Bool
ghc_prim_imp)
ModLocation
location <- PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation
mkOneShotModLocation PipeEnv
pipe_env DynFlags
dflags 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
dyn_o_file :: FilePath
dyn_o_file = ModLocation -> FilePath
ml_dyn_obj_file ModLocation
location
Fingerprint
src_hash <- FilePath -> IO Fingerprint
getFileHash (FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suff)
Maybe UTCTime
hi_date <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
hi_file
Maybe UTCTime
hie_date <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
hie_file
Maybe UTCTime
o_mod <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
o_file
Maybe UTCTime
dyn_o_mod <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
dyn_o_file
Module
mod <- do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder FinderCache
fc HomeUnit
home_unit ModuleName
mod_name ModLocation
location
let
mod_summary :: ModSummary
mod_summary = ModSummary :: Module
-> HscSource
-> ModLocation
-> Fingerprint
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
-> Bool
-> Maybe HsParsedModule
-> FilePath
-> DynFlags
-> Maybe StringBuffer
-> 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 StringBuffer
ms_hspp_buf = Maybe StringBuffer
hspp_buf,
ms_location :: ModLocation
ms_location = ModLocation
location,
ms_hs_hash :: Fingerprint
ms_hs_hash = Fingerprint
src_hash,
ms_obj_date :: Maybe UTCTime
ms_obj_date = Maybe UTCTime
o_mod,
ms_dyn_obj_date :: Maybe UTCTime
ms_dyn_obj_date = Maybe UTCTime
dyn_o_mod,
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
hi_date,
ms_hie_date :: Maybe UTCTime
ms_hie_date = Maybe UTCTime
hie_date,
ms_ghc_prim_import :: Bool
ms_ghc_prim_import = Bool
ghc_prim_imp,
ms_textual_imps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
ms_textual_imps = [(PkgQual, GenLocated SrcSpan ModuleName)]
imps,
ms_srcimps :: [(PkgQual, GenLocated SrcSpan ModuleName)]
ms_srcimps = [(PkgQual, GenLocated SrcSpan ModuleName)]
src_imps }
let msg :: Messager
msg :: Messager
msg HscEnv
hsc_env (Int, Int)
_ RecompileRequired
what ModuleGraphNode
_ = Logger -> RecompileRequired -> IO ()
oneShotMsg (HscEnv -> Logger
hsc_logger HscEnv
hsc_env) RecompileRequired
what
HscEnv
plugin_hsc_env' <- HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env
IORef (NameEnv TyThing)
type_env_var <- NameEnv TyThing -> IO (IORef (NameEnv TyThing))
forall a. a -> IO (IORef a)
newIORef NameEnv TyThing
forall a. NameEnv a
emptyNameEnv
let plugin_hsc_env :: HscEnv
plugin_hsc_env = HscEnv
plugin_hsc_env' { hsc_type_env_vars :: KnotVars (IORef (NameEnv TyThing))
hsc_type_env_vars = ModuleEnv (IORef (NameEnv TyThing))
-> KnotVars (IORef (NameEnv TyThing))
forall a. ModuleEnv a -> KnotVars a
knotVarsFromModuleEnv ([(Module, IORef (NameEnv TyThing))]
-> ModuleEnv (IORef (NameEnv TyThing))
forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv [(Module
mod, IORef (NameEnv TyThing)
type_env_var)]) }
HscRecompStatus
status <- Maybe Messager
-> HscEnv
-> ModSummary
-> Maybe ModIface
-> Maybe Linkable
-> (Int, Int)
-> IO HscRecompStatus
hscRecompStatus (Messager -> Maybe Messager
forall a. a -> Maybe a
Just Messager
msg) HscEnv
plugin_hsc_env ModSummary
mod_summary
Maybe ModIface
forall a. Maybe a
Nothing Maybe Linkable
forall a. Maybe a
Nothing (Int
1, Int
1)
(HscEnv, ModSummary, HscRecompStatus)
-> IO (HscEnv, ModSummary, HscRecompStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv
plugin_hsc_env, ModSummary
mod_summary, HscRecompStatus
status)
mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation
mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation
mkOneShotModLocation PipeEnv
pipe_env DynFlags
dflags HscSource
src_flavour ModuleName
mod_name = do
let PipeEnv{ src_basename :: PipeEnv -> FilePath
src_basename=FilePath
basename,
src_suffix :: PipeEnv -> FilePath
src_suffix=FilePath
suff } = PipeEnv
pipe_env
let location1 :: ModLocation
location1 = FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod_name FilePath
basename FilePath
suff
let location2 :: ModLocation
location2
| HscSource
HsBootFile <- HscSource
src_flavour = ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
location1
| Bool
otherwise = ModLocation
location1
let ohi :: Maybe FilePath
ohi = DynFlags -> Maybe FilePath
outputHi DynFlags
dflags
location3 :: ModLocation
location3 | Just FilePath
fn <- Maybe FilePath
ohi = ModLocation
location2{ ml_hi_file :: FilePath
ml_hi_file = FilePath
fn }
| Bool
otherwise = ModLocation
location2
let dynohi :: Maybe FilePath
dynohi = DynFlags -> Maybe FilePath
dynOutputHi DynFlags
dflags
location4 :: ModLocation
location4 | Just FilePath
fn <- Maybe FilePath
dynohi = ModLocation
location3{ ml_dyn_hi_file :: FilePath
ml_dyn_hi_file = FilePath
fn }
| Bool
otherwise = ModLocation
location3
let expl_o_file :: Maybe FilePath
expl_o_file = DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags
expl_dyn_o_file :: Maybe FilePath
expl_dyn_o_file = DynFlags -> Maybe FilePath
dynOutputFile_ DynFlags
dflags
location5 :: ModLocation
location5 | Just FilePath
ofile <- Maybe FilePath
expl_o_file
, let dyn_ofile :: FilePath
dyn_ofile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
ofile FilePath -> FilePath -> FilePath
-<.> DynFlags -> FilePath
dynObjectSuf_ DynFlags
dflags) Maybe FilePath
expl_dyn_o_file
, GhcLink -> Bool
isNoLink (DynFlags -> GhcLink
ghcLink DynFlags
dflags)
= ModLocation
location4 { ml_obj_file :: FilePath
ml_obj_file = FilePath
ofile
, ml_dyn_obj_file :: FilePath
ml_dyn_obj_file = FilePath
dyn_ofile }
| Just FilePath
dyn_ofile <- Maybe FilePath
expl_dyn_o_file
= ModLocation
location4 { ml_dyn_obj_file :: FilePath
ml_dyn_obj_file = FilePath
dyn_ofile }
| Bool
otherwise = ModLocation
location4
ModLocation -> IO ModLocation
forall (m :: * -> *) a. Monad m => a -> m a
return ModLocation
location5
where
fopts :: FinderOpts
fopts = DynFlags -> FinderOpts
initFinderOpts DynFlags
dflags
runHscTcPhase :: HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
runHscTcPhase :: HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
runHscTcPhase = HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
hscTypecheckAndGetWarnings
runHscPostTcPhase ::
HscEnv
-> ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> IO HscBackendAction
runHscPostTcPhase :: HscEnv
-> ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> IO HscBackendAction
runHscPostTcPhase HscEnv
hsc_env ModSummary
mod_summary FrontendResult
tc_result Messages GhcMessage
tc_warnings Maybe Fingerprint
mb_old_hash = do
HscEnv -> Hsc HscBackendAction -> IO HscBackendAction
forall a. HscEnv -> Hsc a -> IO a
runHsc HscEnv
hsc_env (Hsc HscBackendAction -> IO HscBackendAction)
-> Hsc HscBackendAction -> IO HscBackendAction
forall a b. (a -> b) -> a -> b
$ do
ModSummary
-> FrontendResult
-> Messages GhcMessage
-> Maybe Fingerprint
-> Hsc HscBackendAction
hscDesugarAndSimplify ModSummary
mod_summary FrontendResult
tc_result Messages GhcMessage
tc_warnings Maybe Fingerprint
mb_old_hash
runHsPpPhase :: HscEnv -> FilePath -> FilePath -> FilePath -> IO FilePath
runHsPpPhase :: HscEnv -> FilePath -> FilePath -> FilePath -> IO FilePath
runHsPpPhase HscEnv
hsc_env FilePath
orig_fn FilePath
input_fn FilePath
output_fn = do
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runPp Logger
logger DynFlags
dflags
( [ FilePath -> Option
GHC.SysTools.Option FilePath
orig_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
input_fn
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
] )
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
phaseOutputFilenameNew :: Phase
-> PipeEnv
-> HscEnv
-> Maybe ModLocation
-> IO FilePath
phaseOutputFilenameNew :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
phaseOutputFilenameNew Phase
next_phase PipeEnv
pipe_env HscEnv
hsc_env Maybe ModLocation
maybe_loc = do
let PipeEnv{StopPhase
stop_phase :: PipeEnv -> StopPhase
stop_phase :: StopPhase
stop_phase, FilePath
src_basename :: FilePath
src_basename :: PipeEnv -> FilePath
src_basename, PipelineOutput
output_spec :: PipeEnv -> PipelineOutput
output_spec :: PipelineOutput
output_spec} = PipeEnv
pipe_env
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs (StopPhase -> Phase
stopPhaseToPhase StopPhase
stop_phase) PipelineOutput
output_spec
FilePath
src_basename DynFlags
dflags Phase
next_phase Maybe ModLocation
maybe_loc
getOutputFilename
:: Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> String
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename :: Logger
-> TmpFs
-> Phase
-> PipelineOutput
-> FilePath
-> DynFlags
-> Phase
-> Maybe ModLocation
-> IO FilePath
getOutputFilename Logger
logger TmpFs
tmpfs Phase
stop_phase PipelineOutput
output FilePath
basename DynFlags
dflags Phase
next_phase Maybe ModLocation
maybe_location
| Phase
StopLn <- Phase
next_phase, Just ModLocation
loc <- Maybe ModLocation
maybe_location =
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 DynFlags -> Bool
dynamicNow DynFlags
dflags then ModLocation -> FilePath
ml_dyn_obj_file ModLocation
loc
else ModLocation -> FilePath
ml_obj_file ModLocation
loc
| Bool
is_last_phase, PipelineOutput
Persistent <- PipelineOutput
output = IO FilePath
persistent_fn
| Bool
is_last_phase, PipelineOutput
SpecificFile <- PipelineOutput
output =
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 DynFlags -> Bool
dynamicNow DynFlags
dflags
then case DynFlags -> Maybe FilePath
dynOutputFile_ DynFlags
dflags of
Maybe FilePath
Nothing -> let ofile :: FilePath
ofile = DynFlags -> FilePath
getOutputFile_ DynFlags
dflags
new_ext :: FilePath
new_ext = case FilePath -> FilePath
takeExtension FilePath
ofile of
FilePath
"" -> FilePath
"dyn"
FilePath
ext -> FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
ext
in FilePath -> FilePath -> FilePath
replaceExtension FilePath
ofile FilePath
new_ext
Just FilePath
fn -> FilePath
fn
else DynFlags -> FilePath
getOutputFile_ DynFlags
dflags
| Bool
keep_this_output = IO FilePath
persistent_fn
| Temporary TempFileLifetime
lifetime <- PipelineOutput
output = Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
lifetime FilePath
suffix
| Bool
otherwise = Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule
FilePath
suffix
where
getOutputFile_ :: DynFlags -> FilePath
getOutputFile_ DynFlags
dflags = case DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags of
Maybe FilePath
Nothing -> FilePath -> SDoc -> FilePath
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"SpecificFile: No filename" ((Bool, Maybe FilePath, Maybe FilePath) -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((Bool, Maybe FilePath, Maybe FilePath) -> SDoc)
-> (Bool, Maybe FilePath, Maybe FilePath) -> SDoc
forall a b. (a -> b) -> a -> b
$ (DynFlags -> Bool
dynamicNow DynFlags
dflags, DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags, DynFlags -> Maybe FilePath
dynOutputFile_ DynFlags
dflags))
Just FilePath
fn -> FilePath
fn
hcsuf :: FilePath
hcsuf = DynFlags -> FilePath
hcSuf DynFlags
dflags
odir :: Maybe FilePath
odir = DynFlags -> Maybe FilePath
objectDir DynFlags
dflags
osuf :: FilePath
osuf = DynFlags -> FilePath
objectSuf DynFlags
dflags
keep_hc :: Bool
keep_hc = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHcFiles DynFlags
dflags
keep_hscpp :: Bool
keep_hscpp = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepHscppFiles DynFlags
dflags
keep_s :: Bool
keep_s = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepSFiles DynFlags
dflags
keep_bc :: Bool
keep_bc = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepLlvmFiles DynFlags
dflags
myPhaseInputExt :: Phase -> FilePath
myPhaseInputExt Phase
HCc = FilePath
hcsuf
myPhaseInputExt Phase
MergeForeign = FilePath
osuf
myPhaseInputExt Phase
StopLn = FilePath
osuf
myPhaseInputExt Phase
other = Phase -> FilePath
phaseInputExt Phase
other
is_last_phase :: Bool
is_last_phase = Phase
next_phase Phase -> Phase -> Bool
`eqPhase` Phase
stop_phase
keep_this_output :: Bool
keep_this_output =
case Phase
next_phase of
As Bool
_ | Bool
keep_s -> Bool
True
Phase
LlvmOpt | Bool
keep_bc -> Bool
True
Phase
HCc | Bool
keep_hc -> Bool
True
HsPp HscSource
_ | Bool
keep_hscpp -> Bool
True
Phase
_other -> Bool
False
suffix :: FilePath
suffix = Phase -> FilePath
myPhaseInputExt Phase
next_phase
persistent_fn :: IO FilePath
persistent_fn
| Phase
StopLn <- Phase
next_phase = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
odir_persistent
| Bool
otherwise = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
persistent
persistent :: FilePath
persistent = FilePath
basename FilePath -> FilePath -> FilePath
<.> FilePath
suffix
odir_persistent :: FilePath
odir_persistent
| Just FilePath
d <- Maybe FilePath
odir = (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
persistent)
| Bool
otherwise = FilePath
persistent
llvmOptions :: DynFlags
-> [(String, String)]
llvmOptions :: DynFlags -> [(FilePath, FilePath)]
llvmOptions DynFlags
dflags =
[(FilePath
"-enable-tbaa -tbaa", FilePath
"-enable-tbaa") | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LlvmTBAA DynFlags
dflags ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"-relocation-model=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rmodel
,FilePath
"-relocation-model=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rmodel) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
rmodel)]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"-stack-alignment=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
align)
,FilePath
"-stack-alignment=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
align)) | Int
align Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-mcpu=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mcpu) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
mcpu)
, Bool -> Bool
not ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"-mcpu") (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lc)) ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-mattr=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
attrs) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
attrs) ]
[(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"", FilePath
"-target-abi=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
abi) | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
abi) ]
where target :: FilePath
target = PlatformMisc -> FilePath
platformMisc_llvmTarget (PlatformMisc -> FilePath) -> PlatformMisc -> FilePath
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dflags
Just (LlvmTarget FilePath
_ FilePath
mcpu [FilePath]
mattr) = FilePath -> [(FilePath, LlvmTarget)] -> Maybe LlvmTarget
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
target (LlvmConfig -> [(FilePath, LlvmTarget)]
llvmTargets (LlvmConfig -> [(FilePath, LlvmTarget)])
-> LlvmConfig -> [(FilePath, LlvmTarget)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> LlvmConfig
llvmConfig DynFlags
dflags)
rmodel :: FilePath
rmodel | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags = FilePath
"pic"
| DynFlags -> Bool
positionIndependent DynFlags
dflags = FilePath
"pic"
| DynFlags -> Ways
ways DynFlags
dflags Ways -> Way -> Bool
`hasWay` Way
WayDyn = FilePath
"dynamic-no-pic"
| Bool
otherwise = FilePath
"static"
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
align :: Int
align :: Int
align = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86_64 | DynFlags -> Bool
isAvxEnabled DynFlags
dflags -> Int
32
Arch
_ -> Int
0
attrs :: String
attrs :: FilePath
attrs = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
mattr
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse42" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse2" | Platform -> Bool
isSse2Enabled Platform
platform ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+sse" | Platform -> Bool
isSseEnabled Platform
platform ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512f" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx2" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512cd"| DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512er"| DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+avx512pf"| DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+bmi" | DynFlags -> Bool
isBmiEnabled DynFlags
dflags ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"+bmi2" | DynFlags -> Bool
isBmi2Enabled DynFlags
dflags ]
abi :: String
abi :: FilePath
abi = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
Arch
ArchRISCV64 -> FilePath
"lp64d"
Arch
_ -> FilePath
""
offsetIncludePaths :: DynFlags -> IncludeSpecs -> IncludeSpecs
offsetIncludePaths :: DynFlags -> IncludeSpecs -> IncludeSpecs
offsetIncludePaths DynFlags
dflags (IncludeSpecs [FilePath]
incs [FilePath]
quotes [FilePath]
impl) =
let go :: [FilePath] -> [FilePath]
go = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> FilePath -> FilePath
augmentByWorkingDirectory DynFlags
dflags)
in [FilePath] -> [FilePath] -> [FilePath] -> IncludeSpecs
IncludeSpecs ([FilePath] -> [FilePath]
go [FilePath]
incs) ([FilePath] -> [FilePath]
go [FilePath]
quotes) ([FilePath] -> [FilePath]
go [FilePath]
impl)
doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()
doCpp :: Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> Bool
-> FilePath
-> FilePath
-> IO ()
doCpp Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env Bool
raw FilePath
input_fn FilePath
output_fn = do
let hscpp_opts :: [FilePath]
hscpp_opts = DynFlags -> [FilePath]
picPOpts DynFlags
dflags
let cmdline_include_paths :: IncludeSpecs
cmdline_include_paths = DynFlags -> IncludeSpecs -> IncludeSpecs
offsetIncludePaths DynFlags
dflags (DynFlags -> IncludeSpecs
includePaths DynFlags
dflags)
let unit_state :: UnitState
unit_state = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
[FilePath]
pkg_include_dirs <- MaybeErr UnitErr [FilePath] -> IO [FilePath]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr
([UnitInfo] -> [FilePath]
collectIncludeDirs ([UnitInfo] -> [FilePath])
-> MaybeErr UnitErr [UnitInfo] -> MaybeErr UnitErr [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitEnv -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo UnitEnv
unit_env)
let home_pkg_deps :: [DynFlags]
home_pkg_deps =
[HomeUnitEnv -> DynFlags
homeUnitEnv_dflags (HomeUnitEnv -> DynFlags)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid (UnitEnv -> DynFlags) -> UnitEnv -> DynFlags
forall a b. (a -> b) -> a -> b
$ UnitEnv
unit_env | UnitId
uid <- UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps (UnitEnv -> UnitId
ue_currentUnit UnitEnv
unit_env) UnitEnv
unit_env]
dep_pkg_extra_inputs :: [IncludeSpecs]
dep_pkg_extra_inputs = [DynFlags -> IncludeSpecs -> IncludeSpecs
offsetIncludePaths DynFlags
fs (DynFlags -> IncludeSpecs
includePaths DynFlags
fs) | DynFlags
fs <- [DynFlags]
home_pkg_deps]
let include_paths_global :: [FilePath]
include_paths_global = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsGlobal IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_include_dirs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (IncludeSpecs -> [FilePath]) -> [IncludeSpecs] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IncludeSpecs -> [FilePath]
includePathsGlobal [IncludeSpecs]
dep_pkg_extra_inputs)
let include_paths_quote :: [FilePath]
include_paths_quote = (FilePath -> [FilePath] -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ FilePath
x [FilePath]
xs -> (FilePath
"-iquote" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs) []
(IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
cmdline_include_paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
IncludeSpecs -> [FilePath]
includePathsQuoteImplicit IncludeSpecs
cmdline_include_paths)
let include_paths :: [FilePath]
include_paths = [FilePath]
include_paths_quote [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
include_paths_global
let verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
let cpp_prog :: [Option] -> IO ()
cpp_prog [Option]
args | Bool
raw = Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCpp Logger
logger DynFlags
dflags [Option]
args
| Bool
otherwise = Maybe ForeignSrcLang
-> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runCc Maybe ForeignSrcLang
forall a. Maybe a
Nothing Logger
logger TmpFs
tmpfs DynFlags
dflags
(FilePath -> Option
GHC.SysTools.Option FilePath
"-E" Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args)
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
targetArch :: FilePath
targetArch = Arch -> FilePath
stringEncodeArch (Arch -> FilePath) -> Arch -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> Arch
platformArch Platform
platform
targetOS :: FilePath
targetOS = OS -> FilePath
stringEncodeOS (OS -> FilePath) -> OS -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> OS
platformOS Platform
platform
isWindows :: Bool
isWindows = Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
let target_defs :: [FilePath]
target_defs =
[ FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
HOST_OS FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_BUILD_OS",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HOST_ARCH ++ "_BUILD_ARCH",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetOS FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_HOST_OS",
FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetArch FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_HOST_ARCH" ]
let io_manager_defs :: [FilePath]
io_manager_defs =
[ FilePath
"-D__IO_MANAGER_WINIO__=1" | Bool
isWindows ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__IO_MANAGER_MIO__=1" ]
let sse_defs :: [FilePath]
sse_defs =
[ FilePath
"-D__SSE__" | Platform -> Bool
isSseEnabled Platform
platform ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__SSE2__" | Platform -> Bool
isSse2Enabled Platform
platform ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__SSE4_2__" | DynFlags -> Bool
isSse4_2Enabled DynFlags
dflags ]
let avx_defs :: [FilePath]
avx_defs =
[ FilePath
"-D__AVX__" | DynFlags -> Bool
isAvxEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX2__" | DynFlags -> Bool
isAvx2Enabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512CD__" | DynFlags -> Bool
isAvx512cdEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512ER__" | DynFlags -> Bool
isAvx512erEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512F__" | DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-D__AVX512PF__" | DynFlags -> Bool
isAvx512pfEnabled DynFlags
dflags ]
[FilePath]
backend_defs <- Logger -> DynFlags -> IO [FilePath]
getBackendDefs Logger
logger DynFlags
dflags
let th_defs :: [FilePath]
th_defs = [ FilePath
"-D__GLASGOW_HASKELL_TH__" ]
FilePath
ghcVersionH <- DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env
let hsSourceCppOpts :: [FilePath]
hsSourceCppOpts = [ FilePath
"-include", FilePath
ghcVersionH ]
let uids :: [Unit]
uids = UnitState -> [Unit]
explicitUnits UnitState
unit_state
pkgs :: [UnitInfo]
pkgs = [Maybe UnitInfo] -> [UnitInfo]
forall a. [Maybe a] -> [a]
catMaybes ((Unit -> Maybe UnitInfo) -> [Unit] -> [Maybe UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> Unit -> Maybe UnitInfo
lookupUnit UnitState
unit_state) [Unit]
uids)
[Option]
mb_macro_include <-
if Bool -> Bool
not ([UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
pkgs) Bool -> Bool -> Bool
&& GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_VersionMacros DynFlags
dflags
then do FilePath
macro_stub <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule FilePath
"h"
FilePath -> FilePath -> IO ()
writeFile FilePath
macro_stub ([UnitInfo] -> FilePath
generatePackageVersionMacros [UnitInfo]
pkgs)
[Option] -> IO [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"-include" FilePath
macro_stub]
else [Option] -> IO [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Option] -> IO ()
cpp_prog ( (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
include_paths
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
hsSourceCppOpts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
target_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
backend_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
th_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
hscpp_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
sse_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
avx_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
io_manager_defs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
mb_macro_include
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-x"
, FilePath -> Option
GHC.SysTools.Option FilePath
"assembler-with-cpp"
, FilePath -> Option
GHC.SysTools.Option FilePath
input_fn
, FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
, FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
])
getBackendDefs :: Logger -> DynFlags -> IO [String]
getBackendDefs :: Logger -> DynFlags -> IO [FilePath]
getBackendDefs Logger
logger DynFlags
dflags | DynFlags -> Backend
backend DynFlags
dflags Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
LLVM = do
Maybe LlvmVersion
llvmVer <- Logger -> DynFlags -> IO (Maybe LlvmVersion)
figureLlvmVersion Logger
logger DynFlags
dflags
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ case (LlvmVersion -> [Int]) -> Maybe LlvmVersion -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LlvmVersion -> [Int]
llvmVersionList Maybe LlvmVersion
llvmVer of
Just [Int
m] -> [ FilePath
"-D__GLASGOW_HASKELL_LLVM__=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> FilePath
format (Int
m,Int
0) ]
Just (Int
m:Int
n:[Int]
_) -> [ FilePath
"-D__GLASGOW_HASKELL_LLVM__=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> FilePath
format (Int
m,Int
n) ]
Maybe [Int]
_ -> []
where
format :: (Int, Int) -> FilePath
format (Int
major, Int
minor)
| Int
minor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"getBackendDefs: Unsupported minor version"
| Bool
otherwise = Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
major Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minor :: Int)
getBackendDefs Logger
_ DynFlags
_ =
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
hscPostBackendPhase :: HscSource -> Backend -> Phase
hscPostBackendPhase :: HscSource -> Backend -> Phase
hscPostBackendPhase HscSource
HsBootFile Backend
_ = Phase
StopLn
hscPostBackendPhase HscSource
HsigFile Backend
_ = Phase
StopLn
hscPostBackendPhase HscSource
_ Backend
bcknd =
case Backend
bcknd of
Backend
ViaC -> Phase
HCc
Backend
NCG -> Bool -> Phase
As Bool
False
Backend
LLVM -> Phase
LlvmOpt
Backend
NoBackend -> Phase
StopLn
Backend
Interpreter -> Phase
StopLn
compileStub :: HscEnv -> FilePath -> IO FilePath
compileStub :: HscEnv -> FilePath -> IO FilePath
compileStub HscEnv
hsc_env FilePath
stub_c = HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
compileForeign HscEnv
hsc_env ForeignSrcLang
LangC FilePath
stub_c
joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO ()
joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO ()
joinObjectFiles HscEnv
hsc_env [FilePath]
o_files FilePath
output_fn = do
let toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
ldIsGnuLd :: Bool
ldIsGnuLd = ToolSettings -> Bool
toolSettings_ldIsGnuLd ToolSettings
toolSettings'
ld_r :: [Option] -> IO ()
ld_r [Option]
args = Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runMergeObjects (HscEnv -> Logger
hsc_logger HscEnv
hsc_env) (HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env) (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) (
(FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
ld_build_id
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-o",
FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args)
ld_build_id :: [FilePath]
ld_build_id | ToolSettings -> Bool
toolSettings_ldSupportsBuildId ToolSettings
toolSettings' = [FilePath
"--build-id=none"]
| Bool
otherwise = []
if Bool
ldIsGnuLd
then do
FilePath
script <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule FilePath
"ldscript"
FilePath
cwd <- IO FilePath
getCurrentDirectory
let o_files_abs :: [FilePath]
o_files_abs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
x) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"") [FilePath]
o_files
FilePath -> FilePath -> IO ()
writeFile FilePath
script (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"INPUT(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
o_files_abs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
[Option] -> IO ()
ld_r [FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
script]
else if ToolSettings -> Bool
toolSettings_ldSupportsFilelist ToolSettings
toolSettings'
then do
FilePath
filelist <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs (DynFlags -> TempDir
tmpDir DynFlags
dflags) TempFileLifetime
TFL_CurrentModule FilePath
"filelist"
FilePath -> FilePath -> IO ()
writeFile FilePath
filelist (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
o_files
[Option] -> IO ()
ld_r [FilePath -> Option
GHC.SysTools.Option FilePath
"-filelist",
FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
filelist]
else
[Option] -> IO ()
ld_r ((FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"") [FilePath]
o_files)
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
tmpfs :: TmpFs
tmpfs = HscEnv -> TmpFs
hsc_tmpfs HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
getHCFilePackages :: FilePath -> IO [UnitId]
getHCFilePackages :: FilePath -> IO [UnitId]
getHCFilePackages FilePath
filename =
FilePath -> IOMode -> (Handle -> IO [UnitId]) -> IO [UnitId]
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
filename IOMode
ReadMode ((Handle -> IO [UnitId]) -> IO [UnitId])
-> (Handle -> IO [UnitId]) -> IO [UnitId]
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
FilePath
l <- Handle -> IO FilePath
hGetLine Handle
h
case FilePath
l of
Char
'/':Char
'*':Char
' ':Char
'G':Char
'H':Char
'C':Char
'_':Char
'P':Char
'A':Char
'C':Char
'K':Char
'A':Char
'G':Char
'E':Char
'S':FilePath
rest ->
[UnitId] -> IO [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> UnitId) -> [FilePath] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> UnitId
stringToUnitId (FilePath -> [FilePath]
words FilePath
rest))
FilePath
_other ->
[UnitId] -> IO [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkDynLibCheck :: Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLibCheck Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Bool
haveRtsOptsFlags DynFlags
dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg Logger
logger MessageClass
MCInfo SrcSpan
noSrcSpan
(SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultUserStyle
(FilePath -> SDoc
text FilePath
"Warning: -rtsopts and -with-rtsopts have no effect with -shared." SDoc -> SDoc -> SDoc
$$
FilePath -> SDoc
text FilePath
" Call hs_init_ghc() from your main() function to set these options.")
Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkDynLib Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units
generatePackageVersionMacros :: [UnitInfo] -> String
generatePackageVersionMacros :: [UnitInfo] -> FilePath
generatePackageVersionMacros [UnitInfo]
pkgs = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath -> FilePath -> Version -> FilePath
generateMacros FilePath
"" FilePath
pkgname Version
version
| UnitInfo
pkg <- [UnitInfo]
pkgs
, let version :: Version
version = UnitInfo -> Version
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
unitPackageVersion UnitInfo
pkg
pkgname :: FilePath
pkgname = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (UnitInfo -> FilePath
forall u. GenUnitInfo u -> FilePath
unitPackageNameString UnitInfo
pkg)
]
fixchar :: Char -> Char
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c = Char
c
generateMacros :: String -> String -> Version -> String
generateMacros :: FilePath -> FilePath -> Version -> FilePath
generateMacros FilePath
prefix FilePath
name Version
version =
[FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[FilePath
"#define ", FilePath
prefix, FilePath
"VERSION_",FilePath
name,FilePath
" ",FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Version -> FilePath
showVersion Version
version),FilePath
"\n"
,FilePath
"#define MIN_", FilePath
prefix, FilePath
"VERSION_",FilePath
name,FilePath
"(major1,major2,minor) (\\\n"
,FilePath
" (major1) < ",FilePath
major1,FilePath
" || \\\n"
,FilePath
" (major1) == ",FilePath
major1,FilePath
" && (major2) < ",FilePath
major2,FilePath
" || \\\n"
,FilePath
" (major1) == ",FilePath
major1,FilePath
" && (major2) == ",FilePath
major2,FilePath
" && (minor) <= ",FilePath
minor,FilePath
")"
,FilePath
"\n\n"
]
where
(FilePath
major1:FilePath
major2:FilePath
minor:[FilePath]
_) = (Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show (Version -> [Int]
versionBranch Version
version [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
touchObjectFile Logger
logger DynFlags
dflags FilePath
path = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
path
Logger -> DynFlags -> FilePath -> FilePath -> IO ()
GHC.SysTools.touch Logger
logger DynFlags
dflags FilePath
"Touching object file" FilePath
path
getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath
getGhcVersionPathName DynFlags
dflags UnitEnv
unit_env = do
[FilePath]
candidates <- case DynFlags -> Maybe FilePath
ghcVersionFile DynFlags
dflags of
Just FilePath
path -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
Maybe FilePath
Nothing -> do
[UnitInfo]
ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId
rtsUnitId])
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> FilePath -> FilePath
</> FilePath
"ghcversion.h") (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnitInfo] -> [FilePath]
collectIncludeDirs [UnitInfo]
ps)
[FilePath]
found <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
candidates
case [FilePath]
found of
[] -> GhcException -> IO FilePath
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
InstallationError
(FilePath
"ghcversion.h missing; tried: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
candidates))
(FilePath
x:[FilePath]
_) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x