{-# 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
  , load'
  , homeUnitId_
  , getDynFlags
  ) 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', getDynFlags)
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
#if __GLASGOW_HASKELL__ >= 900
import GHC.Unit.Types (UnitId)
#endif

#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Driver.Main as G
import qualified GHC.Driver.Make as G
#else
import qualified HscMain as G
import qualified GhcMake as G
#endif

ghcVersion :: String
ghcVersion :: String
ghcVersion = VERSION_ghc

#if __GLASGOW_HASKELL__ <= 810
homeUnitId_ :: a -> ()
homeUnitId_ = const ()
#elif __GLASGOW_HASKELL__ <= 901
homeUnitId_ :: DynFlags -> UnitId
homeUnitId_ = homeUnitId
#endif

#if __GLASGOW_HASKELL__ >= 904
load' :: GhcMonad m => Maybe G.ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
load' :: forall (m :: * -> *).
GhcMonad m =>
Maybe ModIfaceCache
-> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
load' = Maybe ModIfaceCache
-> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
forall (m :: * -> *).
GhcMonad m =>
Maybe ModIfaceCache
-> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
G.load'
#else
load' :: GhcMonad m => a -> LoadHowMuch -> Maybe G.Messager -> ModuleGraph -> m SuccessFlag
load' _ a b c = G.load' a b c
#endif

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

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

#if __GLASGOW_HASKELL__ >= 810
catch :: (E.MonadCatch m, E.Exception e) => m a -> (e -> m a) -> m a
catch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch =
  m a -> (e -> m a) -> m a
forall e a. Exception e => 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 $mRealSrcSpan :: forall {r}. SrcSpan -> (RealSrcSpan -> r) -> ((# #) -> r) -> r
RealSrcSpan t <- G.RealSrcSpan t _
#else
pattern RealSrcSpan t <- G.RealSrcSpan t
#endif

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

setNoCode :: DynFlags -> DynFlags
#if __GLASGOW_HASKELL__ >= 905
setNoCode d = d { G.backend = G.noBackend }
#elif __GLASGOW_HASKELL__ >= 901
setNoCode :: DynFlags -> DynFlags
setNoCode DynFlags
d = DynFlags
d { backend :: Backend
G.backend = Backend
G.NoBackend }
#else
setNoCode d = d { G.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 PkgDbRef
pkgConfRef) = PkgDbRef -> PackageDBFlag
G.PackageDB
              (PkgDbRef -> PackageDBFlag) -> PkgDbRef -> PackageDBFlag
forall a b. (a -> b) -> a -> b
$ case PkgDbRef
pkgConfRef of
#if __GLASGOW_HASKELL__ >= 900
                G.PkgDbPath String
fp -> String -> PkgDbRef
G.PkgDbPath (String -> String
f String
fp)
#else
                G.PkgConfFile fp -> G.PkgConfFile (f fp)
#endif
                PkgDbRef
conf -> PkgDbRef
conf
overPkgDbRef String -> String
_f PackageDBFlag
db = PackageDBFlag
db

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

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

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

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

#if __GLASGOW_HASKELL__ >= 804
getModuleName :: (a, b) -> a
getModuleName :: forall a b. (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 :: forall a b c d e. (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 :: forall a b c d e. (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] -> [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 MIN_VERSION_GLASGOW_HASKELL(9,0,2,0)
          ((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.includePathsQuoteImplicit (DynFlags -> IncludeSpecs
includePaths DynFlags
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 :: MatchGroup GhcTc LExpression -> [Type]
inTypes = (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
irrelevantMult ([Scaled Type] -> [Type])
-> (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [Scaled Type])
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroupTc -> [Scaled Type]
mg_arg_tys (MatchGroupTc -> [Scaled Type])
-> (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> MatchGroupTc)
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> [Scaled Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> XMG GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> MatchGroupTc
forall p body. MatchGroup p body -> XMG p body
mg_ext
#else
inTypes = mg_arg_tys . mg_ext
#endif
outType :: MatchGroup GhcTc LExpression -> Type
outType :: MatchGroup GhcTc LExpression -> Type
outType = MatchGroupTc -> Type
mg_res_ty (MatchGroupTc -> Type)
-> (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> MatchGroupTc)
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> XMG GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> 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 :: forall (m :: * -> *). GhcMonad m => m ()
unsetLogAction = do
#if __GLASGOW_HASKELL__ >= 902
    HscEnv
hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
    Logger
logger <- IO Logger -> m Logger
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Logger -> m Logger) -> IO Logger -> m Logger
forall a b. (a -> b) -> a -> b
$ IO Logger
initLogger
    let env :: HscEnv
env = HscEnv
hsc_env { hsc_logger :: Logger
hsc_logger = (LogAction -> LogAction) -> Logger -> Logger
pushLogHook (LogAction -> LogAction -> LogAction
forall a b. a -> b -> a
const LogAction
noopLogger) Logger
logger }
    HscEnv -> m ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
env
#else
    setLogAction noopLogger
#if __GLASGOW_HASKELL__ < 806
        (\_df -> return ())
#endif
#endif

noopLogger :: LogAction
#if __GLASGOW_HASKELL__ >= 903
noopLogger :: LogAction
noopLogger = (\LogFlags
_wr MessageClass
_s SrcSpan
_ss SDoc
_m -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#elif __GLASGOW_HASKELL__ >= 900
noopLogger = (\_df _wr _s _ss _m -> return ())
#else
noopLogger = (\_df _wr _s _ss _pp _m -> return ())
#endif

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

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

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

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

numLoadedPlugins :: HscEnv -> Int
#if __GLASGOW_HASKELL__ >= 903
numLoadedPlugins :: HscEnv -> Int
numLoadedPlugins = [PluginWithArgs] -> Int
forall a. [a] -> 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
. Plugins -> [PluginWithArgs]
Plugins.pluginsWithArgs (Plugins -> [PluginWithArgs])
-> (HscEnv -> Plugins) -> HscEnv -> [PluginWithArgs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> Plugins
hsc_plugins
#elif __GLASGOW_HASKELL__ >= 902
numLoadedPlugins = length . Plugins.plugins
#elif __GLASGOW_HASKELL__ >= 808
numLoadedPlugins = length . Plugins.plugins . 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
  HscEnv
hsc_env <- HscEnv -> IO HscEnv
DynamicLoading.initializePlugins HscEnv
hsc_env'
  (Int, [ModuleName], ModSummary)
-> IO (Int, [ModuleName], ModSummary)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( HscEnv -> Int
numLoadedPlugins HscEnv
hsc_env
       , DynFlags -> [ModuleName]
pluginModNames (DynFlags -> [ModuleName]) -> DynFlags -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
       , ModSummary
mod_summary
       )
#elif __GLASGOW_HASKELL__ >= 808
  let dynFlags' = G.ms_hspp_opts mod_summary
  dynFlags <- DynamicLoading.initializePlugins hsc_env' dynFlags'
  pure ( numLoadedPlugins $ set_hsc_dflags dynFlags hsc_env'
       , G.pluginModNames dynFlags
       , mod_summary { G.ms_hspp_opts = 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
  HscEnv
env
    { hsc_hooks :: Hooks
hsc_hooks = Hooks
hooks
        { hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook = Maybe (ModSummary -> Hsc FrontendResult)
frontendHook
        }
    }
  where
    hooks :: Hooks
hooks = HscEnv -> Hooks
hsc_hooks HscEnv
env
#else
  env
    { G.hsc_dflags = flags
        { G.hooks = oldhooks
            { hscFrontendHook = frontendHook
            }
        }
    }
  where
    flags = hsc_dflags env
    oldhooks = G.hooks flags
#endif

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

getLogger :: HscEnv -> Logger
getLogger :: HscEnv -> Logger
getLogger =
#if __GLASGOW_HASKELL__ >= 902
    HscEnv -> Logger
hsc_logger
#else
    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 :: DynFlags -> DynFlags
updateWays = DynFlags -> DynFlags
forall a. a -> a
id

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

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

parseTargetFiles :: DynFlags -> [String] -> (DynFlags, [(String, Maybe G.Phase)], [String])
#if __GLASGOW_HASKELL__ >= 902
parseTargetFiles :: DynFlags
-> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
parseTargetFiles = DynFlags
-> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
G.parseTargetFiles
#else
parseTargetFiles dflags0 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 fp
        | strt_dot_sl && "-" `isPrefixOf` nfp = cur_dir ++ nfp
        | otherwise                           = nfp
        where
#if defined(mingw32_HOST_OS)
          strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp
#else
          strt_dot_sl = "./" `isPrefixOf` fp
#endif
          cur_dir = '.' : [pathSeparator]
          nfp = normalise fp
    normal_fileish_paths = map normalise_hyp fileish_args

    (srcs, objs) = partition_args normal_fileish_paths [] []
    df1 = dflags0 { G.ldInputs = map (G.FileOption "") objs ++ G.ldInputs dflags0 }
  in
    (df1, srcs, 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 [] srcs objs = (reverse srcs, reverse objs)
partition_args ("-x":suff:args) srcs objs
  | "none" <- suff      = partition_args args srcs objs
  | G.StopLn <- phase     = partition_args args srcs (slurp ++ objs)
  | otherwise           = partition_args rest (these_srcs ++ srcs) objs
        where phase = G.startPhase suff
              (slurp,rest) = break (== "-x") args
              these_srcs = zip slurp (repeat (Just phase))
partition_args (arg:args) srcs objs
  | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
  | otherwise               = partition_args args srcs (arg: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 m =  G.isSourceFilename m
                      || G.looksLikeModuleName m
                      || "-" `isPrefixOf` m
                      || not (hasExtension m)
#endif

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

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