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