{-# LANGUAGE FlexibleInstances, CPP, PatternSynonyms #-}
-- | All the CPP for GHC version compability should live in this module.
module HIE.Bios.Ghc.Gap (
  ghcVersion
  -- * Warnings, Doc Compat
  , WarnFlags
  , emptyWarnFlags
  , makeUserStyle
  , PprStyle
  -- * Argument parsing
  , HIE.Bios.Ghc.Gap.parseTargetFiles
  -- * Ghc Monad
  , G.modifySession
  , G.reflectGhc
  , G.Session(..)
  -- * Hsc Monad
  , getHscEnv
  -- * Driver compat
  , batchMsg
  -- * HscEnv Compat
  , set_hsc_dflags
  , overPkgDbRef
  , HIE.Bios.Ghc.Gap.guessTarget
  , setNoCode
  , getModSummaries
  , mapOverIncludePaths
  , HIE.Bios.Ghc.Gap.getLogger
  -- * AST compat
  , pattern HIE.Bios.Ghc.Gap.RealSrcSpan
  , LExpression
  , LBinding
  , LPattern
  , inTypes
  , outType
  -- * Exceptions
  , catch
  , bracket
  , handle
  -- * Doc Gap functions
  , pageMode
  , oneLineMode
  -- * DynFlags compat
  , initializePluginsForModSummary
  , setFrontEndHooks
  , updOptLevel
  , setWayDynamicIfHostIsDynamic
  , HIE.Bios.Ghc.Gap.gopt_set
  , HIE.Bios.Ghc.Gap.parseDynamicFlags
  -- * Platform constants
  , hostIsDynamic
  -- * misc
  , getModuleName
  , getTyThing
  , fixInfo
  , Tc.FrontendResult(..)
  , Hsc
  , mapMG
  , mgModSummaries
  , unsetLogAction
  ) where

import Control.Monad.IO.Class
import qualified Control.Monad.Catch as E

import GHC
import qualified GHC as G

#if __GLASGOW_HASKELL__ >= 804 && __GLASGOW_HASKELL__ < 900
import Data.List
import System.FilePath

import DynFlags (LogAction, WarningFlag, updOptLevel, Way(WayDyn), updateWays, addWay')
import qualified DynFlags as G
import qualified Exception as G

import Outputable (PprStyle, Depth(AllTheWay), mkUserStyle)
import HscMain (getHscEnv, batchMsg)
import HscTypes (Hsc, HscEnv(..))
import qualified HscTypes as G
import qualified EnumSet as E (EnumSet, empty)
import qualified Pretty as Ppr
import qualified TcRnTypes as Tc
import Hooks (Hooks(hscFrontendHook))
import qualified CmdLineParser as CmdLine
import DriverPhases as G
import Util as G
import qualified GhcMonad as G

#if __GLASGOW_HASKELL__ >= 808
import qualified DynamicLoading (initializePlugins)
import qualified Plugins (plugins)
#endif

#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 810
import HsExtension (GhcTc)
import HsExpr (MatchGroup, MatchGroupTc(..))
#elif __GLASGOW_HASKELL__ >= 804 && __GLASGOW_HASKELL__ < 810
import HsExtension (GhcTc)
import HsExpr (MatchGroup)
#endif
#endif
----------------------------------------------------------------
----------------------------------------------------------------

#if __GLASGOW_HASKELL__ >= 902
import GHC.Core.Multiplicity (irrelevantMult)
import GHC.Data.EnumSet as E
import GHC.Driver.CmdLine as CmdLine
import GHC.Driver.Env as G
import GHC.Driver.Session as G
import GHC.Driver.Hooks
import GHC.Driver.Main
import GHC.Driver.Monad as G
import qualified GHC.Driver.Plugins as Plugins
import GHC.Platform.Ways (Way(WayDyn))
import qualified GHC.Platform.Ways as Platform
import qualified GHC.Runtime.Loader as DynamicLoading (initializePlugins)
import qualified GHC.Tc.Types as Tc

import GHC.Utils.Logger
import GHC.Utils.Outputable
import qualified GHC.Utils.Ppr as Ppr
#elif __GLASGOW_HASKELL__ >= 900
import Data.List
import System.FilePath

import GHC.Core.Multiplicity (irrelevantMult)
import GHC.Data.EnumSet as E
import GHC.Driver.CmdLine as CmdLine
import GHC.Driver.Types as G
import GHC.Driver.Session as G
import GHC.Driver.Hooks
import GHC.Driver.Main
import GHC.Driver.Monad as G
import GHC.Driver.Phases as G
import GHC.Utils.Misc as G
import qualified GHC.Driver.Plugins as Plugins
import GHC.Driver.Ways (Way(WayDyn))
import qualified GHC.Driver.Ways as Platform
import qualified GHC.Runtime.Loader as DynamicLoading (initializePlugins)
import qualified GHC.Tc.Types as Tc

import GHC.Utils.Outputable
import qualified GHC.Utils.Ppr as Ppr
#endif

ghcVersion :: String
ghcVersion :: String
ghcVersion = VERSION_ghc

#if __GLASGOW_HASKELL__ >= 900
bracket :: E.MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b
bracket =
  E.bracket
#else
bracket :: G.ExceptionMonad m => m a -> (a -> m c) -> (a -> m b) -> m b
bracket :: m a -> (a -> m c) -> (a -> m b) -> m b
bracket =
  m a -> (a -> m c) -> (a -> m b) -> m b
forall (m :: * -> *) a b c.
ExceptionMonad m =>
m a -> (a -> m b) -> (a -> m c) -> m c
G.gbracket
#endif

#if __GLASGOW_HASKELL__ >= 900
handle :: (E.MonadCatch m, E.Exception e) => (e -> m a) -> m a -> m a
handle = E.handle
#else
handle :: (G.ExceptionMonad m, E.Exception e) => (e -> m a) -> m a -> m a
handle :: (e -> m a) -> m a -> m a
handle = (e -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
(e -> m a) -> m a -> m a
G.ghandle
#endif

#if __GLASGOW_HASKELL__ >= 810
catch :: (E.MonadCatch m, E.Exception e) => m a -> (e -> m a) -> m a
catch :: m a -> (e -> m a) -> m a
catch =
  m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch
#else
catch :: (G.ExceptionMonad m, E.Exception e) => m a -> (e -> m a) -> m a
catch =
  G.gcatch
#endif

----------------------------------------------------------------

pattern RealSrcSpan :: G.RealSrcSpan -> G.SrcSpan
#if __GLASGOW_HASKELL__ >= 900
pattern RealSrcSpan t <- G.RealSrcSpan t _
#else
pattern $mRealSrcSpan :: forall r. SrcSpan -> (RealSrcSpan -> r) -> (Void# -> r) -> r
RealSrcSpan t <- G.RealSrcSpan t
#endif

----------------------------------------------------------------

setNoCode :: DynFlags -> DynFlags
#if __GLASGOW_HASKELL__ >= 901
setNoCode d = d { G.backend = G.NoBackend }
#else
setNoCode :: DynFlags -> DynFlags
setNoCode DynFlags
d = DynFlags
d { hscTarget :: HscTarget
G.hscTarget = HscTarget
G.HscNothing }
#endif

----------------------------------------------------------------

set_hsc_dflags :: DynFlags -> HscEnv -> HscEnv
set_hsc_dflags :: DynFlags -> HscEnv -> HscEnv
set_hsc_dflags DynFlags
dflags HscEnv
hsc_env = HscEnv
hsc_env { hsc_dflags :: DynFlags
G.hsc_dflags = DynFlags
dflags }

overPkgDbRef :: (FilePath -> FilePath) -> G.PackageDBFlag -> G.PackageDBFlag
overPkgDbRef :: (String -> String) -> PackageDBFlag -> PackageDBFlag
overPkgDbRef String -> String
f (G.PackageDB PkgConfRef
pkgConfRef) = PkgConfRef -> PackageDBFlag
G.PackageDB
              (PkgConfRef -> PackageDBFlag) -> PkgConfRef -> PackageDBFlag
forall a b. (a -> b) -> a -> b
$ case PkgConfRef
pkgConfRef of
#if __GLASGOW_HASKELL__ >= 900
                G.PkgDbPath fp -> G.PkgDbPath (f fp)
#else
                G.PkgConfFile String
fp -> String -> PkgConfRef
G.PkgConfFile (String -> String
f String
fp)
#endif
                PkgConfRef
conf -> PkgConfRef
conf
overPkgDbRef String -> String
_f PackageDBFlag
db = PackageDBFlag
db

----------------------------------------------------------------

guessTarget :: GhcMonad m => String -> Maybe G.Phase -> m G.Target
#if __GLASGOW_HASKELL__ >= 901
guessTarget a b = G.guessTarget a b
#else
guessTarget :: String -> Maybe Phase -> m Target
guessTarget String
a Maybe Phase
b = String -> Maybe Phase -> m Target
forall (m :: * -> *).
GhcMonad m =>
String -> Maybe Phase -> m Target
G.guessTarget String
a Maybe Phase
b
#endif

----------------------------------------------------------------

makeUserStyle :: DynFlags -> PrintUnqualified -> PprStyle
#if __GLASGOW_HASKELL__ >= 900
makeUserStyle _dflags style = mkUserStyle style AllTheWay
#elif __GLASGOW_HASKELL__ >= 804
makeUserStyle :: DynFlags -> PrintUnqualified -> PprStyle
makeUserStyle DynFlags
dflags PrintUnqualified
style = DynFlags -> PrintUnqualified -> Depth -> PprStyle
mkUserStyle DynFlags
dflags PrintUnqualified
style Depth
AllTheWay
#endif

#if __GLASGOW_HASKELL__ >= 804
getModuleName :: (a, b) -> a
getModuleName :: (a, b) -> a
getModuleName = (a, b) -> a
forall a b. (a, b) -> a
fst
#endif

----------------------------------------------------------------

#if __GLASGOW_HASKELL__ >= 804
type WarnFlags = E.EnumSet WarningFlag
emptyWarnFlags :: WarnFlags
emptyWarnFlags :: WarnFlags
emptyWarnFlags = WarnFlags
forall a. EnumSet a
E.empty
#endif

#if __GLASGOW_HASKELL__ >= 804
getModSummaries :: ModuleGraph -> [ModSummary]
getModSummaries :: ModuleGraph -> [ModSummary]
getModSummaries = ModuleGraph -> [ModSummary]
mgModSummaries

getTyThing :: (a, b, c, d, e) -> a
getTyThing :: (a, b, c, d, e) -> a
getTyThing (a
t,b
_,c
_,d
_,e
_) = a
t

fixInfo :: (a, b, c, d, e) -> (a, b, c, d)
fixInfo :: (a, b, c, d, e) -> (a, b, c, d)
fixInfo (a
t,b
f,c
cs,d
fs,e
_) = (a
t,b
f,c
cs,d
fs)
#endif

----------------------------------------------------------------

mapOverIncludePaths :: (FilePath -> FilePath) -> DynFlags -> DynFlags
mapOverIncludePaths :: (String -> String) -> DynFlags -> DynFlags
mapOverIncludePaths String -> String
f DynFlags
df = DynFlags
df
  { includePaths :: IncludeSpecs
includePaths =
#if __GLASGOW_HASKELL__ > 804
      [String] -> [String] -> IncludeSpecs
G.IncludeSpecs
          ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ IncludeSpecs -> [String]
G.includePathsQuote  (DynFlags -> IncludeSpecs
includePaths DynFlags
df))
          ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ IncludeSpecs -> [String]
G.includePathsGlobal (DynFlags -> IncludeSpecs
includePaths DynFlags
df))
#if __GLASGOW_HASKELL__ >= 902
          (map f $ G.includePathsQuoteImplicit (includePaths df))
#endif
#else
      map f (includePaths df)
#endif
  }

----------------------------------------------------------------

#if __GLASGOW_HASKELL__ >= 806
type LExpression = LHsExpr GhcTc
type LBinding    = LHsBind GhcTc
type LPattern    = LPat    GhcTc

inTypes :: MatchGroup GhcTc LExpression -> [Type]
#if __GLASGOW_HASKELL__ >= 900
inTypes = map irrelevantMult . mg_arg_tys . mg_ext
#else
inTypes :: MatchGroup GhcTc LExpression -> [Type]
inTypes = MatchGroupTc -> [Type]
mg_arg_tys (MatchGroupTc -> [Type])
-> (MatchGroup GhcTc LExpression -> MatchGroupTc)
-> MatchGroup GhcTc LExpression
-> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroup GhcTc LExpression -> MatchGroupTc
forall p body. MatchGroup p body -> XMG p body
mg_ext
#endif
outType :: MatchGroup GhcTc LExpression -> Type
outType :: MatchGroup GhcTc LExpression -> Type
outType = MatchGroupTc -> Type
mg_res_ty (MatchGroupTc -> Type)
-> (MatchGroup GhcTc LExpression -> MatchGroupTc)
-> MatchGroup GhcTc LExpression
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroup GhcTc LExpression -> MatchGroupTc
forall p body. MatchGroup p body -> XMG p body
mg_ext
#elif __GLASGOW_HASKELL__ >= 804
type LExpression = LHsExpr GhcTc
type LBinding    = LHsBind GhcTc
type LPattern    = LPat    GhcTc

inTypes :: MatchGroup GhcTc LExpression -> [Type]
inTypes = mg_arg_tys
outType :: MatchGroup GhcTc LExpression -> Type
outType = mg_res_ty
#endif

unsetLogAction :: GhcMonad m => m ()
unsetLogAction :: m ()
unsetLogAction = do
#if __GLASGOW_HASKELL__ >= 902
    hsc_env <- getSession
    logger <- liftIO $ initLogger
    let env = hsc_env { hsc_logger = pushLogHook (const noopLogger) logger }
    setSession env
#else
    LogAction -> m ()
forall (m :: * -> *). GhcMonad m => LogAction -> m ()
setLogAction LogAction
noopLogger
#if __GLASGOW_HASKELL__ < 806
        (\_df -> return ())
#endif
#endif

noopLogger :: LogAction
#if __GLASGOW_HASKELL__ >= 900
noopLogger = (\_df _wr _s _ss _m -> return ())
#else
noopLogger :: LogAction
noopLogger = (\DynFlags
_df WarnReason
_wr Severity
_s SrcSpan
_ss PprStyle
_pp MsgDoc
_m -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#endif

-- --------------------------------------------------------
-- Doc Compat functions
-- --------------------------------------------------------

pageMode :: Ppr.Mode
pageMode :: Mode
pageMode =
#if __GLASGOW_HASKELL__ >= 902
  Ppr.PageMode True
#else
  Mode
Ppr.PageMode
#endif

oneLineMode :: Ppr.Mode
oneLineMode :: Mode
oneLineMode = Mode
Ppr.OneLineMode

-- --------------------------------------------------------
-- DynFlags Compat functions
-- --------------------------------------------------------

numLoadedPlugins :: HscEnv -> Int
#if __GLASGOW_HASKELL__ >= 902
numLoadedPlugins = length . Plugins.plugins
#elif __GLASGOW_HASKELL__ >= 808
numLoadedPlugins :: HscEnv -> Int
numLoadedPlugins = [PluginWithArgs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PluginWithArgs] -> Int)
-> (HscEnv -> [PluginWithArgs]) -> HscEnv -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> [PluginWithArgs]
Plugins.plugins (DynFlags -> [PluginWithArgs])
-> (HscEnv -> DynFlags) -> HscEnv -> [PluginWithArgs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags
#else
-- Plugins are loaded just as they are used
numLoadedPlugins _ = 0
#endif

initializePluginsForModSummary :: HscEnv -> ModSummary -> IO (Int, [G.ModuleName], ModSummary)
initializePluginsForModSummary :: HscEnv -> ModSummary -> IO (Int, [ModuleName], ModSummary)
initializePluginsForModSummary HscEnv
hsc_env' ModSummary
mod_summary = do
#if __GLASGOW_HASKELL__ >= 902
  hsc_env <- DynamicLoading.initializePlugins hsc_env'
  pure ( numLoadedPlugins hsc_env
       , pluginModNames $ hsc_dflags hsc_env
       , mod_summary
       )
#elif __GLASGOW_HASKELL__ >= 808
  let dynFlags' :: DynFlags
dynFlags' = ModSummary -> DynFlags
G.ms_hspp_opts ModSummary
mod_summary
  DynFlags
dynFlags <- HscEnv -> DynFlags -> IO DynFlags
DynamicLoading.initializePlugins HscEnv
hsc_env' DynFlags
dynFlags'
  (Int, [ModuleName], ModSummary)
-> IO (Int, [ModuleName], ModSummary)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( HscEnv -> Int
numLoadedPlugins (HscEnv -> Int) -> HscEnv -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> HscEnv -> HscEnv
set_hsc_dflags DynFlags
dynFlags HscEnv
hsc_env'
       , DynFlags -> [ModuleName]
G.pluginModNames DynFlags
dynFlags
       , ModSummary
mod_summary { ms_hspp_opts :: DynFlags
G.ms_hspp_opts = DynFlags
dynFlags }
       )
#else
  -- In earlier versions of GHC plugins are just loaded before they are used.
  return (numLoadedPlugins hsc_env', G.pluginModNames $ hsc_dflags hsc_env', mod_summary)
#endif


setFrontEndHooks :: Maybe (ModSummary -> G.Hsc Tc.FrontendResult) -> HscEnv -> HscEnv
setFrontEndHooks :: Maybe (ModSummary -> Hsc FrontendResult) -> HscEnv -> HscEnv
setFrontEndHooks Maybe (ModSummary -> Hsc FrontendResult)
frontendHook HscEnv
env =
#if __GLASGOW_HASKELL__ >= 902
  env
    { hsc_hooks = hooks
        { hscFrontendHook = frontendHook
        }
    }
  where
    hooks = hsc_hooks env
#else
  HscEnv
env
    { hsc_dflags :: DynFlags
G.hsc_dflags = DynFlags
flags
        { hooks :: Hooks
G.hooks = Hooks
oldhooks
            { hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook = Maybe (ModSummary -> Hsc FrontendResult)
frontendHook
            }
        }
    }
  where
    flags :: DynFlags
flags = HscEnv -> DynFlags
hsc_dflags HscEnv
env
    oldhooks :: Hooks
oldhooks = DynFlags -> Hooks
G.hooks DynFlags
flags
#endif

#if __GLASGOW_HASKELL__ < 902
type Logger = ()
#endif

getLogger :: HscEnv -> Logger
getLogger :: HscEnv -> ()
getLogger =
#if __GLASGOW_HASKELL__ >= 902
    hsc_logger
#else
    () -> HscEnv -> ()
forall a b. a -> b -> a
const ()
#endif

gopt_set :: DynFlags -> G.GeneralFlag -> DynFlags
gopt_set :: DynFlags -> GeneralFlag -> DynFlags
gopt_set = DynFlags -> GeneralFlag -> DynFlags
G.gopt_set

setWayDynamicIfHostIsDynamic :: DynFlags -> DynFlags
setWayDynamicIfHostIsDynamic :: DynFlags -> DynFlags
setWayDynamicIfHostIsDynamic =
  if Bool
hostIsDynamic
    then
      DynFlags -> DynFlags
updateWays (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Way -> DynFlags -> DynFlags
addWay' Way
WayDyn
    else
      DynFlags -> DynFlags
forall a. a -> a
id

#if __GLASGOW_HASKELL__ >= 900
updateWays :: DynFlags -> DynFlags
updateWays = id

#if __GLASGOW_HASKELL__ >= 902
-- Copied from GHC, do we need that?
addWay' :: Way -> DynFlags -> DynFlags
addWay' w dflags0 =
   let platform = targetPlatform dflags0
       dflags1 = dflags0 { targetWays_ = Platform.addWay w (targetWays_ dflags0) }
       dflags2 = foldr setGeneralFlag' dflags1
                       (Platform.wayGeneralFlags platform w)
       dflags3 = foldr unSetGeneralFlag' dflags2
                       (Platform.wayUnsetGeneralFlags platform w)
   in dflags3
#endif
#endif

parseDynamicFlags :: MonadIO m
    => Logger
    -> DynFlags
    -> [G.Located String]
    -> m (DynFlags, [G.Located String], [CmdLine.Warn])
#if __GLASGOW_HASKELL__ >= 902
parseDynamicFlags = G.parseDynamicFlags
#else
parseDynamicFlags :: ()
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlags ()
_ = DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
G.parseDynamicFlags
#endif

parseTargetFiles :: DynFlags -> [String] -> (DynFlags, [(String, Maybe G.Phase)], [String])
#if __GLASGOW_HASKELL__ >= 902
parseTargetFiles = G.parseTargetFiles
#else
parseTargetFiles :: DynFlags
-> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
parseTargetFiles DynFlags
dflags0 [String]
fileish_args =
  let
     -- To simplify the handling of filepaths, we normalise all filepaths right
     -- away. Note the asymmetry of FilePath.normalise:
     --    Linux:   p/q -> p/q; p\q -> p\q
     --    Windows: p/q -> p\q; p\q -> p\q
     -- #12674: Filenames starting with a hypen get normalised from ./-foo.hs
     -- to -foo.hs. We have to re-prepend the current directory.
    normalise_hyp :: String -> String
normalise_hyp String
fp
        | Bool
strt_dot_sl Bool -> Bool -> Bool
&& String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
nfp = String
cur_dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nfp
        | Bool
otherwise                           = String
nfp
        where
#if defined(mingw32_HOST_OS)
          strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp
#else
          strt_dot_sl :: Bool
strt_dot_sl = String
"./" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
fp
#endif
          cur_dir :: String
cur_dir = Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
pathSeparator]
          nfp :: String
nfp = String -> String
normalise String
fp
    normal_fileish_paths :: [String]
normal_fileish_paths = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
normalise_hyp [String]
fileish_args

    ([(String, Maybe Phase)]
srcs, [String]
objs) = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
normal_fileish_paths [] []
    df1 :: DynFlags
df1 = DynFlags
dflags0 { ldInputs :: [Option]
G.ldInputs = (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Option
G.FileOption String
"") [String]
objs [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [Option]
G.ldInputs DynFlags
dflags0 }
  in
    (DynFlags
df1, [(String, Maybe Phase)]
srcs, [String]
objs)
#endif


#if __GLASGOW_HASKELL__ < 902
partition_args :: [String] -> [(String, Maybe G.Phase)] -> [String]
               -> ([(String, Maybe G.Phase)], [String])
-- partition_args, along with some of the other code in this file,
-- was copied from ghc/Main.hs
-- -----------------------------------------------------------------------------
-- Splitting arguments into source files and object files.  This is where we
-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
-- file indicating the phase specified by the -x option in force, if any.
partition_args :: [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [] [(String, Maybe Phase)]
srcs [String]
objs = ([(String, Maybe Phase)] -> [(String, Maybe Phase)]
forall a. [a] -> [a]
reverse [(String, Maybe Phase)]
srcs, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
objs)
partition_args (String
"-x":String
suff:[String]
args) [(String, Maybe Phase)]
srcs [String]
objs
  | String
"none" <- String
suff      = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
args [(String, Maybe Phase)]
srcs [String]
objs
  | Phase
G.StopLn <- Phase
phase     = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
args [(String, Maybe Phase)]
srcs ([String]
slurp [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
objs)
  | Bool
otherwise           = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
rest ([(String, Maybe Phase)]
these_srcs [(String, Maybe Phase)]
-> [(String, Maybe Phase)] -> [(String, Maybe Phase)]
forall a. [a] -> [a] -> [a]
++ [(String, Maybe Phase)]
srcs) [String]
objs
        where phase :: Phase
phase = String -> Phase
G.startPhase String
suff
              ([String]
slurp,[String]
rest) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-x") [String]
args
              these_srcs :: [(String, Maybe Phase)]
these_srcs = [String] -> [Maybe Phase] -> [(String, Maybe Phase)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
slurp (Maybe Phase -> [Maybe Phase]
forall a. a -> [a]
repeat (Phase -> Maybe Phase
forall a. a -> Maybe a
Just Phase
phase))
partition_args (String
arg:[String]
args) [(String, Maybe Phase)]
srcs [String]
objs
  | String -> Bool
looks_like_an_input String
arg = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
args ((String
arg,Maybe Phase
forall a. Maybe a
Nothing)(String, Maybe Phase)
-> [(String, Maybe Phase)] -> [(String, Maybe Phase)]
forall a. a -> [a] -> [a]
:[(String, Maybe Phase)]
srcs) [String]
objs
  | Bool
otherwise               = [String]
-> [(String, Maybe Phase)]
-> [String]
-> ([(String, Maybe Phase)], [String])
partition_args [String]
args [(String, Maybe Phase)]
srcs (String
argString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
objs)

    {-
      We split out the object files (.o, .dll) and add them
      to ldInputs for use by the linker.
      The following things should be considered compilation manager inputs:
       - haskell source files (strings ending in .hs, .lhs or other
         haskellish extension),
       - module names (not forgetting hierarchical module names),
       - things beginning with '-' are flags that were not recognised by
         the flag parser, and we want them to generate errors later in
         checkOptions, so we class them as source files (#5921)
       - and finally we consider everything without an extension to be
         a comp manager input, as shorthand for a .hs or .lhs filename.
      Everything else is considered to be a linker object, and passed
      straight through to the linker.
    -}
looks_like_an_input :: String -> Bool
looks_like_an_input :: String -> Bool
looks_like_an_input String
m =  String -> Bool
G.isSourceFilename String
m
                      Bool -> Bool -> Bool
|| String -> Bool
G.looksLikeModuleName String
m
                      Bool -> Bool -> Bool
|| String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
m
                      Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
hasExtension String
m)
#endif

-- --------------------------------------------------------
-- Platform constants
-- --------------------------------------------------------

hostIsDynamic :: Bool
#if __GLASGOW_HASKELL__ >= 900
hostIsDynamic = Platform.hostIsDynamic
#else
hostIsDynamic :: Bool
hostIsDynamic = Bool
G.dynamicGhc
#endif