{-# LANGUAGE LambdaCase #-}
module GHC.Driver.DynFlags (
        -- * Dynamic flags and associated configuration types
        DumpFlag(..),
        GeneralFlag(..),
        WarningFlag(..), DiagnosticReason(..),
        Language(..),
        FatalMessager, FlushOut(..),
        ProfAuto(..),
        hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion,
        dopt, dopt_set, dopt_unset,
        gopt, gopt_set, gopt_unset,
        wopt, wopt_set, wopt_unset,
        wopt_fatal, wopt_set_fatal, wopt_unset_fatal,
        wopt_set_all_custom, wopt_unset_all_custom,
        wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom,
        wopt_set_custom, wopt_unset_custom,
        wopt_set_fatal_custom, wopt_unset_fatal_custom,
        wopt_any_custom,
        xopt, xopt_set, xopt_unset,
        xopt_set_unlessExplSpec,
        xopt_DuplicateRecordFields,
        xopt_FieldSelectors,
        lang_set,
        DynamicTooState(..), dynamicTooState, setDynamicNow,
        OnOff(..),
        DynFlags(..),
        ParMakeCount(..),
        ways,
        HasDynFlags(..), ContainsDynFlags(..),
        RtsOptsEnabled(..),
        GhcMode(..), isOneShot,
        GhcLink(..), isNoLink,
        PackageFlag(..), PackageArg(..), ModRenaming(..),
        packageFlagsChanged,
        IgnorePackageFlag(..), TrustFlag(..),
        PackageDBFlag(..), PkgDbRef(..),
        Option(..), showOpt,
        DynLibLoader(..),
        positionIndependent,
        optimisationFlags,

        targetProfile,

        -- ** Manipulating DynFlags
        defaultDynFlags,                -- Settings -> DynFlags
        initDynFlags,                   -- DynFlags -> IO DynFlags
        defaultFatalMessager,
        defaultFlushOut,
        optLevelFlags,
        languageExtensions,

        TurnOnFlag,
        turnOn,
        turnOff,

        -- ** System tool settings and locations
        programName, projectVersion,
        ghcUsagePath, ghciUsagePath, topDir, toolDir,
        versionedAppDir, versionedFilePath,
        extraGccViaCFlags, globalPackageDatabasePath,

        -- * Linker/compiler information
        LinkerInfo(..),
        CompilerInfo(..),

        -- * Include specifications
        IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
        addImplicitQuoteInclude,

        -- * SDoc
        initSDocContext, initDefaultSDocContext,
        initPromotionTickContext,
) where

import GHC.Prelude

import GHC.Platform
import GHC.Platform.Ways
import GHC.Platform.Profile

import GHC.CmmToAsm.CFG.Weight
import GHC.Core.Unfold
import GHC.Data.Bool
import GHC.Data.EnumSet (EnumSet)
import GHC.Data.Maybe
import GHC.Builtin.Names ( mAIN_NAME )
import GHC.Driver.Backend
import GHC.Driver.Flags
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Plugins.External
import GHC.Settings
import GHC.Settings.Constants
import GHC.Types.Basic ( IntWithInf, treatZeroAsInf )
import GHC.Types.Error (DiagnosticReason(..))
import GHC.Types.ProfAuto
import GHC.Types.SafeHaskell
import GHC.Types.SrcLoc
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Utils.CliOption
import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
import GHC.UniqueSubdir (uniqueSubdir)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.TmpFs

import qualified GHC.Types.FieldLabel as FieldLabel
import qualified GHC.Utils.Ppr.Colour as Col
import qualified GHC.Data.EnumSet as EnumSet

import GHC.Core.Opt.CallerCC.Types

import Control.Monad (msum, (<=<))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Writer (WriterT)
import Data.IORef
import System.IO
import System.IO.Error (catchIOError)
import System.Environment (lookupEnv)
import System.FilePath (normalise, (</>))
import System.Directory
import GHC.Foreign (withCString, peekCString)

import qualified Data.Set as Set

import qualified GHC.LanguageExtensions as LangExt

-- -----------------------------------------------------------------------------
-- DynFlags

-- | Contains not only a collection of 'GeneralFlag's but also a plethora of
-- information relating to the compilation of a single file or GHC session
data DynFlags = DynFlags {
  DynFlags -> GhcMode
ghcMode               :: GhcMode,
  DynFlags -> GhcLink
ghcLink               :: GhcLink,
  DynFlags -> Backend
backend               :: !Backend,
   -- ^ The backend to use (if any).
   --
   -- Whenever you change the backend, also make sure to set 'ghcLink' to
   -- something sensible.
   --
   -- 'NoBackend' can be used to avoid generating any output, however, note that:
   --
   --  * If a program uses Template Haskell the typechecker may need to run code
   --    from an imported module.  To facilitate this, code generation is enabled
   --    for modules imported by modules that use template haskell, using the
   --    default backend for the platform.
   --    See Note [-fno-code mode].


  -- formerly Settings
  DynFlags -> GhcNameVersion
ghcNameVersion    :: {-# UNPACK #-} !GhcNameVersion,
  DynFlags -> FileSettings
fileSettings      :: {-# UNPACK #-} !FileSettings,
  DynFlags -> Platform
targetPlatform    :: Platform,       -- Filled in by SysTools
  DynFlags -> ToolSettings
toolSettings      :: {-# UNPACK #-} !ToolSettings,
  DynFlags -> PlatformMisc
platformMisc      :: {-# UNPACK #-} !PlatformMisc,
  DynFlags -> [(String, String)]
rawSettings       :: [(String, String)],
  DynFlags -> TempDir
tmpDir            :: TempDir,

  DynFlags -> Int
llvmOptLevel          :: Int,         -- ^ LLVM optimisation level
  DynFlags -> Int
verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
  DynFlags -> Int
debugLevel            :: Int,         -- ^ How much debug information to produce
  DynFlags -> Int
simplPhases           :: Int,         -- ^ Number of simplifier phases
  DynFlags -> Int
maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
  DynFlags -> Maybe String
ruleCheck             :: Maybe String,
  DynFlags -> [Int]
strictnessBefore      :: [Int],       -- ^ Additional demand analysis

  DynFlags -> Maybe ParMakeCount
parMakeCount          :: Maybe ParMakeCount,
    -- ^ The number of modules to compile in parallel
    --   If unspecified, compile with a single job.

  DynFlags -> Bool
enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?
  DynFlags -> Maybe Int
ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.

  DynFlags -> Maybe Int
maxRelevantBinds      :: Maybe Int,   -- ^ Maximum number of bindings from the type envt
                                        --   to show in type error messages
  DynFlags -> Maybe Int
maxValidHoleFits      :: Maybe Int,   -- ^ Maximum number of hole fits to show
                                        --   in typed hole error messages
  DynFlags -> Maybe Int
maxRefHoleFits        :: Maybe Int,   -- ^ Maximum number of refinement hole
                                        --   fits to show in typed hole error
                                        --   messages
  DynFlags -> Maybe Int
refLevelHoleFits      :: Maybe Int,   -- ^ Maximum level of refinement for
                                        --   refinement hole fits in typed hole
                                        --   error messages
  DynFlags -> Int
maxUncoveredPatterns  :: Int,         -- ^ Maximum number of unmatched patterns to show
                                        --   in non-exhaustiveness warnings
  DynFlags -> Int
maxPmCheckModels      :: Int,         -- ^ Soft limit on the number of models
                                        --   the pattern match checker checks
                                        --   a pattern against. A safe guard
                                        --   against exponential blow-up.
  DynFlags -> Int
simplTickFactor       :: Int,         -- ^ Multiplier for simplifier ticks
  DynFlags -> Int
dmdUnboxWidth         :: !Int,        -- ^ Whether DmdAnal should optimistically put an
                                        --   Unboxed demand on returned products with at most
                                        --   this number of fields
  DynFlags -> Maybe Int
specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
  DynFlags -> Maybe Int
specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
  DynFlags -> Int
specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types
                                        --   Not optional; otherwise ForceSpecConstr can diverge.
  DynFlags -> Maybe Word
binBlobThreshold      :: Maybe Word,  -- ^ Binary literals (e.g. strings) whose size is above
                                        --   this threshold will be dumped in a binary file
                                        --   by the assembler code generator. 0 and Nothing disables
                                        --   this feature. See 'GHC.StgToCmm.Config'.
  DynFlags -> Maybe Int
liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
  DynFlags -> Maybe Int
floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating
                                        --   See 'GHC.Core.Opt.Monad.FloatOutSwitches'

  DynFlags -> Maybe Int
liftLamsRecArgs       :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a
                                        --   recursive function.
  DynFlags -> Maybe Int
liftLamsNonRecArgs    :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a
                                        --   non-recursive function.
  DynFlags -> Bool
liftLamsKnown         :: Bool,        -- ^ Lambda lift even when this turns a known call
                                        --   into an unknown call.

  DynFlags -> Maybe Int
cmmProcAlignment      :: Maybe Int,   -- ^ Align Cmm functions at this boundary or use default.

  DynFlags -> Int
historySize           :: Int,         -- ^ Simplification history size

  DynFlags -> [String]
importPaths           :: [FilePath],
  DynFlags -> ModuleName
mainModuleNameIs      :: ModuleName,
  DynFlags -> Maybe String
mainFunIs             :: Maybe String,
  DynFlags -> IntWithInf
reductionDepth        :: IntWithInf,   -- ^ Typechecker maximum stack depth
  DynFlags -> IntWithInf
solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver
                                         --   Typically only 1 is needed
  DynFlags -> Int
givensFuel            :: Int,          -- ^ Number of layers of superclass expansion for givens
                                         --   Should be < solverIterations
                                         --   See Note [Expanding Recursive Superclasses and ExpansionFuel]
  DynFlags -> Int
wantedsFuel           :: Int,          -- ^ Number of layers of superclass expansion for wanteds
                                         --   Should be < givensFuel
                                         --   See Note [Expanding Recursive Superclasses and ExpansionFuel]
  DynFlags -> Int
qcsFuel                :: Int,          -- ^ Number of layers of superclass expansion for quantified constraints
                                         --   Should be < givensFuel
                                         --   See Note [Expanding Recursive Superclasses and ExpansionFuel]
  DynFlags -> UnitId
homeUnitId_             :: UnitId,                 -- ^ Target home unit-id
  DynFlags -> Maybe UnitId
homeUnitInstanceOf_     :: Maybe UnitId,           -- ^ Id of the unit to instantiate
  DynFlags -> [(ModuleName, Module)]
homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations

  -- Note [Filepaths and Multiple Home Units]
  DynFlags -> Maybe String
workingDirectory      :: Maybe FilePath,
  DynFlags -> Maybe String
thisPackageName       :: Maybe String, -- ^ What the package is called, use with multiple home units
  DynFlags -> Set ModuleName
hiddenModules         :: Set.Set ModuleName,
  DynFlags -> Set ModuleName
reexportedModules     :: Set.Set ModuleName,

  -- ways
  DynFlags -> Ways
targetWays_           :: Ways,         -- ^ Target way flags from the command line

  -- For object splitting
  DynFlags -> Maybe (String, Int)
splitInfo             :: Maybe (String,Int),

  -- paths etc.
  DynFlags -> Maybe String
objectDir             :: Maybe String,
  DynFlags -> Maybe String
dylibInstallName      :: Maybe String,
  DynFlags -> Maybe String
hiDir                 :: Maybe String,
  DynFlags -> Maybe String
hieDir                :: Maybe String,
  DynFlags -> Maybe String
stubDir               :: Maybe String,
  DynFlags -> Maybe String
dumpDir               :: Maybe String,

  DynFlags -> String
objectSuf_            :: String,
  DynFlags -> String
hcSuf                 :: String,
  DynFlags -> String
hiSuf_                :: String,
  DynFlags -> String
hieSuf                :: String,

  DynFlags -> String
dynObjectSuf_         :: String,
  DynFlags -> String
dynHiSuf_             :: String,

  DynFlags -> Maybe String
outputFile_           :: Maybe String,
  DynFlags -> Maybe String
dynOutputFile_        :: Maybe String,
  DynFlags -> Maybe String
outputHi              :: Maybe String,
  DynFlags -> Maybe String
dynOutputHi           :: Maybe String,
  DynFlags -> DynLibLoader
dynLibLoader          :: DynLibLoader,

  DynFlags -> Bool
dynamicNow            :: !Bool, -- ^ Indicate if we are now generating dynamic output
                                  -- because of -dynamic-too. This predicate is
                                  -- used to query the appropriate fields
                                  -- (outputFile/dynOutputFile, ways, etc.)

  -- | This defaults to 'non-module'. It can be set by
  -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on
  -- where its output is going.
  DynFlags -> String
dumpPrefix            :: FilePath,

  -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix'
  --    or 'ghc.GHCi.UI.runStmt'.
  --    Set by @-ddump-file-prefix@
  DynFlags -> Maybe String
dumpPrefixForce       :: Maybe FilePath,

  DynFlags -> [Option]
ldInputs              :: [Option],

  DynFlags -> IncludeSpecs
includePaths          :: IncludeSpecs,
  DynFlags -> [String]
libraryPaths          :: [String],
  DynFlags -> [String]
frameworkPaths        :: [String],    -- used on darwin only
  DynFlags -> [String]
cmdlineFrameworks     :: [String],    -- ditto

  DynFlags -> Maybe String
rtsOpts               :: Maybe String,
  DynFlags -> RtsOptsEnabled
rtsOptsEnabled        :: RtsOptsEnabled,
  DynFlags -> Bool
rtsOptsSuggestions    :: Bool,

  DynFlags -> String
hpcDir                :: String,      -- ^ Path to store the .mix files

  -- Plugins
  DynFlags -> [ModuleName]
pluginModNames        :: [ModuleName],
    -- ^ the @-fplugin@ flags given on the command line, in *reverse*
    -- order that they're specified on the command line.
  DynFlags -> [(ModuleName, String)]
pluginModNameOpts     :: [(ModuleName,String)],
  DynFlags -> [String]
frontendPluginOpts    :: [String],
    -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*
    -- order that they're specified on the command line.

  DynFlags -> [ExternalPluginSpec]
externalPluginSpecs   :: [ExternalPluginSpec],
    -- ^ External plugins loaded from shared libraries

  --  For ghc -M
  DynFlags -> String
depMakefile           :: FilePath,
  DynFlags -> Bool
depIncludePkgDeps     :: Bool,
  DynFlags -> Bool
depIncludeCppDeps     :: Bool,
  DynFlags -> [ModuleName]
depExcludeMods        :: [ModuleName],
  DynFlags -> [String]
depSuffixes           :: [String],

  --  Package flags
  DynFlags -> [PackageDBFlag]
packageDBFlags        :: [PackageDBFlag],
        -- ^ The @-package-db@ flags given on the command line, In
        -- *reverse* order that they're specified on the command line.
        -- This is intended to be applied with the list of "initial"
        -- package databases derived from @GHC_PACKAGE_PATH@; see
        -- 'getUnitDbRefs'.

  DynFlags -> [IgnorePackageFlag]
ignorePackageFlags    :: [IgnorePackageFlag],
        -- ^ The @-ignore-package@ flags from the command line.
        -- In *reverse* order that they're specified on the command line.
  DynFlags -> [PackageFlag]
packageFlags          :: [PackageFlag],
        -- ^ The @-package@ and @-hide-package@ flags from the command-line.
        -- In *reverse* order that they're specified on the command line.
  DynFlags -> [PackageFlag]
pluginPackageFlags    :: [PackageFlag],
        -- ^ The @-plugin-package-id@ flags from command line.
        -- In *reverse* order that they're specified on the command line.
  DynFlags -> [TrustFlag]
trustFlags            :: [TrustFlag],
        -- ^ The @-trust@ and @-distrust@ flags.
        -- In *reverse* order that they're specified on the command line.
  DynFlags -> Maybe String
packageEnv            :: Maybe FilePath,
        -- ^ Filepath to the package environment file (if overriding default)


  -- hsc dynamic flags
  DynFlags -> EnumSet DumpFlag
dumpFlags             :: EnumSet DumpFlag,
  DynFlags -> EnumSet GeneralFlag
generalFlags          :: EnumSet GeneralFlag,
  DynFlags -> EnumSet WarningFlag
warningFlags          :: EnumSet WarningFlag,
  DynFlags -> EnumSet WarningFlag
fatalWarningFlags     :: EnumSet WarningFlag,
  DynFlags -> WarningCategorySet
customWarningCategories      :: WarningCategorySet, -- See Note [Warning categories]
  DynFlags -> WarningCategorySet
fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings
  -- Don't change this without updating extensionFlags:
  DynFlags -> Maybe Language
language              :: Maybe Language,
  -- | Safe Haskell mode
  DynFlags -> SafeHaskellMode
safeHaskell           :: SafeHaskellMode,
  DynFlags -> Bool
safeInfer             :: Bool,
  DynFlags -> Bool
safeInferred          :: Bool,
  -- We store the location of where some extension and flags were turned on so
  -- we can produce accurate error messages when Safe Haskell fails due to
  -- them.
  DynFlags -> SrcSpan
thOnLoc               :: SrcSpan,
  DynFlags -> SrcSpan
newDerivOnLoc         :: SrcSpan,
  DynFlags -> SrcSpan
deriveViaOnLoc        :: SrcSpan,
  DynFlags -> SrcSpan
overlapInstLoc        :: SrcSpan,
  DynFlags -> SrcSpan
incoherentOnLoc       :: SrcSpan,
  DynFlags -> SrcSpan
pkgTrustOnLoc         :: SrcSpan,
  DynFlags -> SrcSpan
warnSafeOnLoc         :: SrcSpan,
  DynFlags -> SrcSpan
warnUnsafeOnLoc       :: SrcSpan,
  DynFlags -> SrcSpan
trustworthyOnLoc      :: SrcSpan,
  -- Don't change this without updating extensionFlags:
  -- Here we collect the settings of the language extensions
  -- from the command line, the ghci config file and
  -- from interactive :set / :seti commands.
  DynFlags -> [OnOff Extension]
extensions            :: [OnOff LangExt.Extension],
  -- extensionFlags should always be equal to
  --     flattenExtensionFlags language extensions
  -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used
  -- by template-haskell
  DynFlags -> EnumSet Extension
extensionFlags        :: EnumSet LangExt.Extension,

  -- | Unfolding control
  -- See Note [Discounts and thresholds] in GHC.Core.Unfold
  DynFlags -> UnfoldingOpts
unfoldingOpts         :: !UnfoldingOpts,

  DynFlags -> Int
maxWorkerArgs         :: Int,

  DynFlags -> Int
ghciHistSize          :: Int,

  DynFlags -> FlushOut
flushOut              :: FlushOut,

  DynFlags -> Maybe String
ghcVersionFile        :: Maybe FilePath,
  DynFlags -> Maybe String
haddockOptions        :: Maybe String,

  -- | GHCi scripts specified by -ghci-script, in reverse order
  DynFlags -> [String]
ghciScripts           :: [String],

  -- Output style options
  DynFlags -> Int
pprUserLength         :: Int,
  DynFlags -> Int
pprCols               :: Int,

  DynFlags -> Bool
useUnicode            :: Bool,
  DynFlags -> OverridingBool
useColor              :: OverridingBool,
  DynFlags -> Bool
canUseColor           :: Bool,
  DynFlags -> Scheme
colScheme             :: Col.Scheme,

  -- | what kind of {-# SCC #-} to add automatically
  DynFlags -> ProfAuto
profAuto              :: ProfAuto,
  DynFlags -> [CallerCcFilter]
callerCcFilters       :: [CallerCcFilter],

  DynFlags -> Maybe String
interactivePrint      :: Maybe String,

  -- | Machine dependent flags (-m\<blah> stuff)
  DynFlags -> Maybe SseVersion
sseVersion            :: Maybe SseVersion,
  DynFlags -> Maybe BmiVersion
bmiVersion            :: Maybe BmiVersion,
  DynFlags -> Bool
avx                   :: Bool,
  DynFlags -> Bool
avx2                  :: Bool,
  DynFlags -> Bool
avx512cd              :: Bool, -- Enable AVX-512 Conflict Detection Instructions.
  DynFlags -> Bool
avx512er              :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.
  DynFlags -> Bool
avx512f               :: Bool, -- Enable AVX-512 instructions.
  DynFlags -> Bool
avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.
  DynFlags -> Bool
fma                   :: Bool, -- ^ Enable FMA instructions.

  -- | Run-time linker information (what options we need, etc.)
  DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo              :: IORef (Maybe LinkerInfo),

  -- | Run-time C compiler information
  DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo              :: IORef (Maybe CompilerInfo),

  -- | Run-time assembler information
  DynFlags -> IORef (Maybe CompilerInfo)
rtasmInfo              :: IORef (Maybe CompilerInfo),

  -- Constants used to control the amount of optimization done.

  -- | Max size, in bytes, of inline array allocations.
  DynFlags -> Int
maxInlineAllocSize    :: Int,

  -- | Only inline memcpy if it generates no more than this many
  -- pseudo (roughly: Cmm) instructions.
  DynFlags -> Int
maxInlineMemcpyInsns  :: Int,

  -- | Only inline memset if it generates no more than this many
  -- pseudo (roughly: Cmm) instructions.
  DynFlags -> Int
maxInlineMemsetInsns  :: Int,

  -- | Reverse the order of error messages in GHC/GHCi
  DynFlags -> Bool
reverseErrors         :: Bool,

  -- | Limit the maximum number of errors to show
  DynFlags -> Maybe Int
maxErrors             :: Maybe Int,

  -- | Unique supply configuration for testing build determinism
  DynFlags -> Word
initialUnique         :: Word,
  DynFlags -> Int
uniqueIncrement       :: Int,
    -- 'Int' because it can be used to test uniques in decreasing order.

  -- | Temporary: CFG Edge weights for fast iterations
  DynFlags -> Weights
cfgWeights            :: Weights
}

class HasDynFlags m where
    getDynFlags :: m DynFlags

{- It would be desirable to have the more generalised

  instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where
      getDynFlags = lift getDynFlags

instance definition. However, that definition would overlap with the
`HasDynFlags (GhcT m)` instance. Instead we define instances for a
couple of common Monad transformers explicitly. -}

instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where
    getDynFlags :: WriterT a m DynFlags
getDynFlags = m DynFlags -> WriterT a m DynFlags
forall (m :: * -> *) a. Monad m => m a -> WriterT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where
    getDynFlags :: ReaderT a m DynFlags
getDynFlags = m DynFlags -> ReaderT a m DynFlags
forall (m :: * -> *) a. Monad m => m a -> ReaderT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where
    getDynFlags :: MaybeT m DynFlags
getDynFlags = m DynFlags -> MaybeT m DynFlags
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
    getDynFlags :: ExceptT e m DynFlags
getDynFlags = m DynFlags -> ExceptT e m DynFlags
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

class ContainsDynFlags t where
    extractDynFlags :: t -> DynFlags

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

-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags DynFlags
dflags = do
 let
 IORef (Maybe LinkerInfo)
refRtldInfo <- Maybe LinkerInfo -> IO (IORef (Maybe LinkerInfo))
forall a. a -> IO (IORef a)
newIORef Maybe LinkerInfo
forall a. Maybe a
Nothing
 IORef (Maybe CompilerInfo)
refRtccInfo <- Maybe CompilerInfo -> IO (IORef (Maybe CompilerInfo))
forall a. a -> IO (IORef a)
newIORef Maybe CompilerInfo
forall a. Maybe a
Nothing
 IORef (Maybe CompilerInfo)
refRtasmInfo <- Maybe CompilerInfo -> IO (IORef (Maybe CompilerInfo))
forall a. a -> IO (IORef a)
newIORef Maybe CompilerInfo
forall a. Maybe a
Nothing
 Bool
canUseUnicode <- do let enc :: TextEncoding
enc = TextEncoding
localeEncoding
                         str :: String
str = String
"‘’"
                     (TextEncoding -> String -> (CString -> IO Bool) -> IO Bool
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
withCString TextEncoding
enc String
str ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
                          do String
str' <- TextEncoding -> CString -> IO String
peekCString TextEncoding
enc CString
cstr
                             Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str'))
                         IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
 Maybe String
ghcNoUnicodeEnv <- String -> IO (Maybe String)
lookupEnv String
"GHC_NO_UNICODE"
 let useUnicode' :: Bool
useUnicode' = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
ghcNoUnicodeEnv Bool -> Bool -> Bool
&& Bool
canUseUnicode
 Maybe String
maybeGhcColorsEnv  <- String -> IO (Maybe String)
lookupEnv String
"GHC_COLORS"
 Maybe String
maybeGhcColoursEnv <- String -> IO (Maybe String)
lookupEnv String
"GHC_COLOURS"
 let adjustCols :: Maybe String
-> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
adjustCols (Just String
env) = String -> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
Col.parseScheme String
env
     adjustCols Maybe String
Nothing    = (OverridingBool, Scheme) -> (OverridingBool, Scheme)
forall a. a -> a
id
 let (OverridingBool
useColor', Scheme
colScheme') =
       (Maybe String
-> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
adjustCols Maybe String
maybeGhcColoursEnv ((OverridingBool, Scheme) -> (OverridingBool, Scheme))
-> ((OverridingBool, Scheme) -> (OverridingBool, Scheme))
-> (OverridingBool, Scheme)
-> (OverridingBool, Scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
adjustCols Maybe String
maybeGhcColorsEnv)
       (DynFlags -> OverridingBool
useColor DynFlags
dflags, DynFlags -> Scheme
colScheme DynFlags
dflags)
 String
tmp_dir <- String -> String
normalise (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory
 DynFlags -> IO DynFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflags{
        useUnicode    = useUnicode',
        useColor      = useColor',
        canUseColor   = stderrSupportsAnsiColors,
        colScheme     = colScheme',
        rtldInfo      = refRtldInfo,
        rtccInfo      = refRtccInfo,
        rtasmInfo     = refRtasmInfo,
        tmpDir        = TempDir tmp_dir
        }

-- | The normal 'DynFlags'. Note that they are not suitable for use in this form
-- and must be fully initialized by 'GHC.runGhc' first.
defaultDynFlags :: Settings -> DynFlags
defaultDynFlags :: Settings -> DynFlags
defaultDynFlags Settings
mySettings =
-- See Note [Updating flag description in the User's Guide]
     DynFlags {
        ghcMode :: GhcMode
ghcMode                 = GhcMode
CompManager,
        ghcLink :: GhcLink
ghcLink                 = GhcLink
LinkBinary,
        backend :: Backend
backend                 = Platform -> Backend
platformDefaultBackend (Settings -> Platform
sTargetPlatform Settings
mySettings),
        verbosity :: Int
verbosity               = Int
0,
        debugLevel :: Int
debugLevel              = Int
0,
        simplPhases :: Int
simplPhases             = Int
2,
        maxSimplIterations :: Int
maxSimplIterations      = Int
4,
        ruleCheck :: Maybe String
ruleCheck               = Maybe String
forall a. Maybe a
Nothing,
        binBlobThreshold :: Maybe Word
binBlobThreshold        = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
500000, -- 500K is a good default (see #16190)
        maxRelevantBinds :: Maybe Int
maxRelevantBinds        = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6,
        maxValidHoleFits :: Maybe Int
maxValidHoleFits   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6,
        maxRefHoleFits :: Maybe Int
maxRefHoleFits     = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6,
        refLevelHoleFits :: Maybe Int
refLevelHoleFits   = Maybe Int
forall a. Maybe a
Nothing,
        maxUncoveredPatterns :: Int
maxUncoveredPatterns    = Int
4,
        maxPmCheckModels :: Int
maxPmCheckModels        = Int
30,
        simplTickFactor :: Int
simplTickFactor         = Int
100,
        dmdUnboxWidth :: Int
dmdUnboxWidth           = Int
3,      -- Default: Assume an unboxed demand on function bodies returning a triple
        specConstrThreshold :: Maybe Int
specConstrThreshold     = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2000,
        specConstrCount :: Maybe Int
specConstrCount         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3,
        specConstrRecursive :: Int
specConstrRecursive     = Int
3,
        liberateCaseThreshold :: Maybe Int
liberateCaseThreshold   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2000,
        floatLamArgs :: Maybe Int
floatLamArgs            = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, -- Default: float only if no fvs
        liftLamsRecArgs :: Maybe Int
liftLamsRecArgs         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5, -- Default: the number of available argument hardware registers on x86_64
        liftLamsNonRecArgs :: Maybe Int
liftLamsNonRecArgs      = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5, -- Default: the number of available argument hardware registers on x86_64
        liftLamsKnown :: Bool
liftLamsKnown           = Bool
False,  -- Default: don't turn known calls into unknown ones
        cmmProcAlignment :: Maybe Int
cmmProcAlignment        = Maybe Int
forall a. Maybe a
Nothing,

        historySize :: Int
historySize             = Int
20,
        strictnessBefore :: [Int]
strictnessBefore        = [],

        parMakeCount :: Maybe ParMakeCount
parMakeCount            = Maybe ParMakeCount
forall a. Maybe a
Nothing,

        enableTimeStats :: Bool
enableTimeStats         = Bool
False,
        ghcHeapSize :: Maybe Int
ghcHeapSize             = Maybe Int
forall a. Maybe a
Nothing,

        importPaths :: [String]
importPaths             = [String
"."],
        mainModuleNameIs :: ModuleName
mainModuleNameIs        = ModuleName
mAIN_NAME,
        mainFunIs :: Maybe String
mainFunIs               = Maybe String
forall a. Maybe a
Nothing,
        reductionDepth :: IntWithInf
reductionDepth          = Int -> IntWithInf
treatZeroAsInf Int
mAX_REDUCTION_DEPTH,
        solverIterations :: IntWithInf
solverIterations        = Int -> IntWithInf
treatZeroAsInf Int
mAX_SOLVER_ITERATIONS,
        givensFuel :: Int
givensFuel              = Int
mAX_GIVENS_FUEL,
        wantedsFuel :: Int
wantedsFuel             = Int
mAX_WANTEDS_FUEL,
        qcsFuel :: Int
qcsFuel                 = Int
mAX_QC_FUEL,

        homeUnitId_ :: UnitId
homeUnitId_             = UnitId
mainUnitId,
        homeUnitInstanceOf_ :: Maybe UnitId
homeUnitInstanceOf_     = Maybe UnitId
forall a. Maybe a
Nothing,
        homeUnitInstantiations_ :: [(ModuleName, Module)]
homeUnitInstantiations_ = [],

        workingDirectory :: Maybe String
workingDirectory        = Maybe String
forall a. Maybe a
Nothing,
        thisPackageName :: Maybe String
thisPackageName         = Maybe String
forall a. Maybe a
Nothing,
        hiddenModules :: Set ModuleName
hiddenModules           = Set ModuleName
forall a. Set a
Set.empty,
        reexportedModules :: Set ModuleName
reexportedModules       = Set ModuleName
forall a. Set a
Set.empty,

        objectDir :: Maybe String
objectDir               = Maybe String
forall a. Maybe a
Nothing,
        dylibInstallName :: Maybe String
dylibInstallName        = Maybe String
forall a. Maybe a
Nothing,
        hiDir :: Maybe String
hiDir                   = Maybe String
forall a. Maybe a
Nothing,
        hieDir :: Maybe String
hieDir                  = Maybe String
forall a. Maybe a
Nothing,
        stubDir :: Maybe String
stubDir                 = Maybe String
forall a. Maybe a
Nothing,
        dumpDir :: Maybe String
dumpDir                 = Maybe String
forall a. Maybe a
Nothing,

        objectSuf_ :: String
objectSuf_              = Phase -> String
phaseInputExt Phase
StopLn,
        hcSuf :: String
hcSuf                   = Phase -> String
phaseInputExt Phase
HCc,
        hiSuf_ :: String
hiSuf_                  = String
"hi",
        hieSuf :: String
hieSuf                  = String
"hie",

        dynObjectSuf_ :: String
dynObjectSuf_           = String
"dyn_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Phase -> String
phaseInputExt Phase
StopLn,
        dynHiSuf_ :: String
dynHiSuf_               = String
"dyn_hi",
        dynamicNow :: Bool
dynamicNow              = Bool
False,

        pluginModNames :: [ModuleName]
pluginModNames          = [],
        pluginModNameOpts :: [(ModuleName, String)]
pluginModNameOpts       = [],
        frontendPluginOpts :: [String]
frontendPluginOpts      = [],

        externalPluginSpecs :: [ExternalPluginSpec]
externalPluginSpecs     = [],

        outputFile_ :: Maybe String
outputFile_             = Maybe String
forall a. Maybe a
Nothing,
        dynOutputFile_ :: Maybe String
dynOutputFile_          = Maybe String
forall a. Maybe a
Nothing,
        outputHi :: Maybe String
outputHi                = Maybe String
forall a. Maybe a
Nothing,
        dynOutputHi :: Maybe String
dynOutputHi             = Maybe String
forall a. Maybe a
Nothing,
        dynLibLoader :: DynLibLoader
dynLibLoader            = DynLibLoader
SystemDependent,
        dumpPrefix :: String
dumpPrefix              = String
"non-module.",
        dumpPrefixForce :: Maybe String
dumpPrefixForce         = Maybe String
forall a. Maybe a
Nothing,
        ldInputs :: [Option]
ldInputs                = [],
        includePaths :: IncludeSpecs
includePaths            = [String] -> [String] -> [String] -> IncludeSpecs
IncludeSpecs [] [] [],
        libraryPaths :: [String]
libraryPaths            = [],
        frameworkPaths :: [String]
frameworkPaths          = [],
        cmdlineFrameworks :: [String]
cmdlineFrameworks       = [],
        rtsOpts :: Maybe String
rtsOpts                 = Maybe String
forall a. Maybe a
Nothing,
        rtsOptsEnabled :: RtsOptsEnabled
rtsOptsEnabled          = RtsOptsEnabled
RtsOptsSafeOnly,
        rtsOptsSuggestions :: Bool
rtsOptsSuggestions      = Bool
True,

        hpcDir :: String
hpcDir                  = String
".hpc",

        packageDBFlags :: [PackageDBFlag]
packageDBFlags          = [],
        packageFlags :: [PackageFlag]
packageFlags            = [],
        pluginPackageFlags :: [PackageFlag]
pluginPackageFlags      = [],
        ignorePackageFlags :: [IgnorePackageFlag]
ignorePackageFlags      = [],
        trustFlags :: [TrustFlag]
trustFlags              = [],
        packageEnv :: Maybe String
packageEnv              = Maybe String
forall a. Maybe a
Nothing,
        targetWays_ :: Ways
targetWays_             = Ways
forall a. Set a
Set.empty,
        splitInfo :: Maybe (String, Int)
splitInfo               = Maybe (String, Int)
forall a. Maybe a
Nothing,

        ghcNameVersion :: GhcNameVersion
ghcNameVersion = Settings -> GhcNameVersion
sGhcNameVersion Settings
mySettings,
        fileSettings :: FileSettings
fileSettings = Settings -> FileSettings
sFileSettings Settings
mySettings,
        toolSettings :: ToolSettings
toolSettings = Settings -> ToolSettings
sToolSettings Settings
mySettings,
        targetPlatform :: Platform
targetPlatform = Settings -> Platform
sTargetPlatform Settings
mySettings,
        platformMisc :: PlatformMisc
platformMisc = Settings -> PlatformMisc
sPlatformMisc Settings
mySettings,
        rawSettings :: [(String, String)]
rawSettings = Settings -> [(String, String)]
sRawSettings Settings
mySettings,

        tmpDir :: TempDir
tmpDir                  = String -> TempDir
forall a. HasCallStack => String -> a
panic String
"defaultDynFlags: uninitialized tmpDir",

        llvmOptLevel :: Int
llvmOptLevel            = Int
0,

        -- ghc -M values
        depMakefile :: String
depMakefile       = String
"Makefile",
        depIncludePkgDeps :: Bool
depIncludePkgDeps = Bool
False,
        depIncludeCppDeps :: Bool
depIncludeCppDeps = Bool
False,
        depExcludeMods :: [ModuleName]
depExcludeMods    = [],
        depSuffixes :: [String]
depSuffixes       = [],
        -- end of ghc -M values
        ghcVersionFile :: Maybe String
ghcVersionFile = Maybe String
forall a. Maybe a
Nothing,
        haddockOptions :: Maybe String
haddockOptions = Maybe String
forall a. Maybe a
Nothing,
        dumpFlags :: EnumSet DumpFlag
dumpFlags = EnumSet DumpFlag
forall a. EnumSet a
EnumSet.empty,
        generalFlags :: EnumSet GeneralFlag
generalFlags = [GeneralFlag] -> EnumSet GeneralFlag
forall a. Enum a => [a] -> EnumSet a
EnumSet.fromList (Settings -> [GeneralFlag]
defaultFlags Settings
mySettings),
        warningFlags :: EnumSet WarningFlag
warningFlags = [WarningFlag] -> EnumSet WarningFlag
forall a. Enum a => [a] -> EnumSet a
EnumSet.fromList [WarningFlag]
standardWarnings,
        fatalWarningFlags :: EnumSet WarningFlag
fatalWarningFlags = EnumSet WarningFlag
forall a. EnumSet a
EnumSet.empty,
        customWarningCategories :: WarningCategorySet
customWarningCategories = WarningCategorySet
completeWarningCategorySet,
        fatalCustomWarningCategories :: WarningCategorySet
fatalCustomWarningCategories = WarningCategorySet
emptyWarningCategorySet,
        ghciScripts :: [String]
ghciScripts = [],
        language :: Maybe Language
language = Maybe Language
forall a. Maybe a
Nothing,
        safeHaskell :: SafeHaskellMode
safeHaskell = SafeHaskellMode
Sf_None,
        safeInfer :: Bool
safeInfer   = Bool
True,
        safeInferred :: Bool
safeInferred = Bool
True,
        thOnLoc :: SrcSpan
thOnLoc = SrcSpan
noSrcSpan,
        newDerivOnLoc :: SrcSpan
newDerivOnLoc = SrcSpan
noSrcSpan,
        deriveViaOnLoc :: SrcSpan
deriveViaOnLoc = SrcSpan
noSrcSpan,
        overlapInstLoc :: SrcSpan
overlapInstLoc = SrcSpan
noSrcSpan,
        incoherentOnLoc :: SrcSpan
incoherentOnLoc = SrcSpan
noSrcSpan,
        pkgTrustOnLoc :: SrcSpan
pkgTrustOnLoc = SrcSpan
noSrcSpan,
        warnSafeOnLoc :: SrcSpan
warnSafeOnLoc = SrcSpan
noSrcSpan,
        warnUnsafeOnLoc :: SrcSpan
warnUnsafeOnLoc = SrcSpan
noSrcSpan,
        trustworthyOnLoc :: SrcSpan
trustworthyOnLoc = SrcSpan
noSrcSpan,
        extensions :: [OnOff Extension]
extensions = [],
        extensionFlags :: EnumSet Extension
extensionFlags = Maybe Language -> [OnOff Extension] -> EnumSet Extension
flattenExtensionFlags Maybe Language
forall a. Maybe a
Nothing [],

        unfoldingOpts :: UnfoldingOpts
unfoldingOpts = UnfoldingOpts
defaultUnfoldingOpts,
        maxWorkerArgs :: Int
maxWorkerArgs = Int
10,

        ghciHistSize :: Int
ghciHistSize = Int
50, -- keep a log of length 50 by default

        flushOut :: FlushOut
flushOut = FlushOut
defaultFlushOut,
        pprUserLength :: Int
pprUserLength = Int
5,
        pprCols :: Int
pprCols = Int
100,
        useUnicode :: Bool
useUnicode = Bool
False,
        useColor :: OverridingBool
useColor = OverridingBool
Auto,
        canUseColor :: Bool
canUseColor = Bool
False,
        colScheme :: Scheme
colScheme = Scheme
Col.defaultScheme,
        profAuto :: ProfAuto
profAuto = ProfAuto
NoProfAuto,
        callerCcFilters :: [CallerCcFilter]
callerCcFilters = [],
        interactivePrint :: Maybe String
interactivePrint = Maybe String
forall a. Maybe a
Nothing,
        sseVersion :: Maybe SseVersion
sseVersion = Maybe SseVersion
forall a. Maybe a
Nothing,
        bmiVersion :: Maybe BmiVersion
bmiVersion = Maybe BmiVersion
forall a. Maybe a
Nothing,
        avx :: Bool
avx = Bool
False,
        avx2 :: Bool
avx2 = Bool
False,
        avx512cd :: Bool
avx512cd = Bool
False,
        avx512er :: Bool
avx512er = Bool
False,
        avx512f :: Bool
avx512f = Bool
False,
        avx512pf :: Bool
avx512pf = Bool
False,
        fma :: Bool
fma = Bool
False,
        rtldInfo :: IORef (Maybe LinkerInfo)
rtldInfo = String -> IORef (Maybe LinkerInfo)
forall a. HasCallStack => String -> a
panic String
"defaultDynFlags: no rtldInfo",
        rtccInfo :: IORef (Maybe CompilerInfo)
rtccInfo = String -> IORef (Maybe CompilerInfo)
forall a. HasCallStack => String -> a
panic String
"defaultDynFlags: no rtccInfo",
        rtasmInfo :: IORef (Maybe CompilerInfo)
rtasmInfo = String -> IORef (Maybe CompilerInfo)
forall a. HasCallStack => String -> a
panic String
"defaultDynFlags: no rtasmInfo",

        maxInlineAllocSize :: Int
maxInlineAllocSize = Int
128,
        maxInlineMemcpyInsns :: Int
maxInlineMemcpyInsns = Int
32,
        maxInlineMemsetInsns :: Int
maxInlineMemsetInsns = Int
32,

        initialUnique :: Word
initialUnique = Word
0,
        uniqueIncrement :: Int
uniqueIncrement = Int
1,

        reverseErrors :: Bool
reverseErrors = Bool
False,
        maxErrors :: Maybe Int
maxErrors     = Maybe Int
forall a. Maybe a
Nothing,
        cfgWeights :: Weights
cfgWeights    = Weights
defaultWeights
      }

type FatalMessager = String -> IO ()

defaultFatalMessager :: FatalMessager
defaultFatalMessager :: FatalMessager
defaultFatalMessager = Handle -> FatalMessager
hPutStrLn Handle
stderr


newtype FlushOut = FlushOut (IO ())

defaultFlushOut :: FlushOut
defaultFlushOut :: FlushOut
defaultFlushOut = IO () -> FlushOut
FlushOut (IO () -> FlushOut) -> IO () -> FlushOut
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout



data OnOff a = On a
             | Off a
  deriving (OnOff a -> OnOff a -> Bool
(OnOff a -> OnOff a -> Bool)
-> (OnOff a -> OnOff a -> Bool) -> Eq (OnOff a)
forall a. Eq a => OnOff a -> OnOff a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => OnOff a -> OnOff a -> Bool
== :: OnOff a -> OnOff a -> Bool
$c/= :: forall a. Eq a => OnOff a -> OnOff a -> Bool
/= :: OnOff a -> OnOff a -> Bool
Eq, Int -> OnOff a -> String -> String
[OnOff a] -> String -> String
OnOff a -> String
(Int -> OnOff a -> String -> String)
-> (OnOff a -> String)
-> ([OnOff a] -> String -> String)
-> Show (OnOff a)
forall a. Show a => Int -> OnOff a -> String -> String
forall a. Show a => [OnOff a] -> String -> String
forall a. Show a => OnOff a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OnOff a -> String -> String
showsPrec :: Int -> OnOff a -> String -> String
$cshow :: forall a. Show a => OnOff a -> String
show :: OnOff a -> String
$cshowList :: forall a. Show a => [OnOff a] -> String -> String
showList :: [OnOff a] -> String -> String
Show)

instance Outputable a => Outputable (OnOff a) where
  ppr :: OnOff a -> SDoc
ppr (On a
x)  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"On" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x
  ppr (Off a
x) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Off" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x

-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension
flattenExtensionFlags :: Maybe Language -> [OnOff Extension] -> EnumSet Extension
flattenExtensionFlags Maybe Language
ml = (OnOff Extension -> EnumSet Extension -> EnumSet Extension)
-> EnumSet Extension -> [OnOff Extension] -> EnumSet Extension
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OnOff Extension -> EnumSet Extension -> EnumSet Extension
forall {a}. Enum a => OnOff a -> EnumSet a -> EnumSet a
g EnumSet Extension
defaultExtensionFlags
    where g :: OnOff a -> EnumSet a -> EnumSet a
g (On a
f)  EnumSet a
flags = a -> EnumSet a -> EnumSet a
forall a. Enum a => a -> EnumSet a -> EnumSet a
EnumSet.insert a
f EnumSet a
flags
          g (Off a
f) EnumSet a
flags = a -> EnumSet a -> EnumSet a
forall a. Enum a => a -> EnumSet a -> EnumSet a
EnumSet.delete a
f EnumSet a
flags
          defaultExtensionFlags :: EnumSet Extension
defaultExtensionFlags = [Extension] -> EnumSet Extension
forall a. Enum a => [a] -> EnumSet a
EnumSet.fromList (Maybe Language -> [Extension]
languageExtensions Maybe Language
ml)

-- -----------------------------------------------------------------------------
-- -jN

-- | The type for the -jN argument, specifying that -j on its own represents
-- using the number of machine processors.
data ParMakeCount
  -- | Use this many processors (@-j<n>@ flag).
  = ParMakeThisMany Int
  -- | Use parallelism with as many processors as possible (@-j@ flag without an argument).
  | ParMakeNumProcessors
  -- | Use the specific semaphore @<sem>@ to control parallelism (@-jsem <sem>@ flag).
  | ParMakeSemaphore FilePath

-- -----------------------------------------------------------------------------
-- Linker/compiler information

-- LinkerInfo contains any extra options needed by the system linker.
data LinkerInfo
  = GnuLD    [Option]
  | Mold     [Option]
  | GnuGold  [Option]
  | LlvmLLD  [Option]
  | DarwinLD [Option]
  | SolarisLD [Option]
  | AixLD    [Option]
  | UnknownLD
  deriving LinkerInfo -> LinkerInfo -> Bool
(LinkerInfo -> LinkerInfo -> Bool)
-> (LinkerInfo -> LinkerInfo -> Bool) -> Eq LinkerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkerInfo -> LinkerInfo -> Bool
== :: LinkerInfo -> LinkerInfo -> Bool
$c/= :: LinkerInfo -> LinkerInfo -> Bool
/= :: LinkerInfo -> LinkerInfo -> Bool
Eq

-- CompilerInfo tells us which C compiler we're using
data CompilerInfo
   = GCC
   | Clang
   | AppleClang
   | AppleClang51
   | Emscripten
   | UnknownCC
   deriving CompilerInfo -> CompilerInfo -> Bool
(CompilerInfo -> CompilerInfo -> Bool)
-> (CompilerInfo -> CompilerInfo -> Bool) -> Eq CompilerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerInfo -> CompilerInfo -> Bool
== :: CompilerInfo -> CompilerInfo -> Bool
$c/= :: CompilerInfo -> CompilerInfo -> Bool
/= :: CompilerInfo -> CompilerInfo -> Bool
Eq

-- | The 'GhcMode' tells us whether we're doing multi-module
-- compilation (controlled via the "GHC" API) or one-shot
-- (single-module) compilation.  This makes a difference primarily to
-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for
-- imported modules, but in multi-module mode we look for source files
-- in order to check whether they need to be recompiled.
data GhcMode
  = CompManager         -- ^ @\-\-make@, GHCi, etc.
  | OneShot             -- ^ @ghc -c Foo.hs@
  | MkDepend            -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this
  deriving GhcMode -> GhcMode -> Bool
(GhcMode -> GhcMode -> Bool)
-> (GhcMode -> GhcMode -> Bool) -> Eq GhcMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcMode -> GhcMode -> Bool
== :: GhcMode -> GhcMode -> Bool
$c/= :: GhcMode -> GhcMode -> Bool
/= :: GhcMode -> GhcMode -> Bool
Eq

instance Outputable GhcMode where
  ppr :: GhcMode -> SDoc
ppr GhcMode
CompManager = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CompManager"
  ppr GhcMode
OneShot     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OneShot"
  ppr GhcMode
MkDepend    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MkDepend"

isOneShot :: GhcMode -> Bool
isOneShot :: GhcMode -> Bool
isOneShot GhcMode
OneShot = Bool
True
isOneShot GhcMode
_other  = Bool
False

-- | What to do in the link step, if there is one.
data GhcLink
  = NoLink              -- ^ Don't link at all
  | LinkBinary          -- ^ Link object code into a binary
  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both
                        --   bytecode and object code).
  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
  | LinkStaticLib       -- ^ Link objects into a static lib
  | LinkMergedObj       -- ^ Link objects into a merged "GHCi object"
  deriving (GhcLink -> GhcLink -> Bool
(GhcLink -> GhcLink -> Bool)
-> (GhcLink -> GhcLink -> Bool) -> Eq GhcLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcLink -> GhcLink -> Bool
== :: GhcLink -> GhcLink -> Bool
$c/= :: GhcLink -> GhcLink -> Bool
/= :: GhcLink -> GhcLink -> Bool
Eq, Int -> GhcLink -> String -> String
[GhcLink] -> String -> String
GhcLink -> String
(Int -> GhcLink -> String -> String)
-> (GhcLink -> String)
-> ([GhcLink] -> String -> String)
-> Show GhcLink
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcLink -> String -> String
showsPrec :: Int -> GhcLink -> String -> String
$cshow :: GhcLink -> String
show :: GhcLink -> String
$cshowList :: [GhcLink] -> String -> String
showList :: [GhcLink] -> String -> String
Show)

isNoLink :: GhcLink -> Bool
isNoLink :: GhcLink -> Bool
isNoLink GhcLink
NoLink = Bool
True
isNoLink GhcLink
_      = Bool
False

-- | We accept flags which make packages visible, but how they select
-- the package varies; this data type reflects what selection criterion
-- is used.
data PackageArg =
      PackageArg String    -- ^ @-package@, by 'PackageName'
    | UnitIdArg Unit       -- ^ @-package-id@, by 'Unit'
  deriving (PackageArg -> PackageArg -> Bool
(PackageArg -> PackageArg -> Bool)
-> (PackageArg -> PackageArg -> Bool) -> Eq PackageArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageArg -> PackageArg -> Bool
== :: PackageArg -> PackageArg -> Bool
$c/= :: PackageArg -> PackageArg -> Bool
/= :: PackageArg -> PackageArg -> Bool
Eq, Int -> PackageArg -> String -> String
[PackageArg] -> String -> String
PackageArg -> String
(Int -> PackageArg -> String -> String)
-> (PackageArg -> String)
-> ([PackageArg] -> String -> String)
-> Show PackageArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PackageArg -> String -> String
showsPrec :: Int -> PackageArg -> String -> String
$cshow :: PackageArg -> String
show :: PackageArg -> String
$cshowList :: [PackageArg] -> String -> String
showList :: [PackageArg] -> String -> String
Show)

instance Outputable PackageArg where
    ppr :: PackageArg -> SDoc
ppr (PackageArg String
pn) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
pn
    ppr (UnitIdArg Unit
uid) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
uid

-- | Represents the renaming that may be associated with an exposed
-- package, e.g. the @rns@ part of @-package "foo (rns)"@.
--
-- Here are some example parsings of the package flags (where
-- a string literal is punned to be a 'ModuleName':
--
--      * @-package foo@ is @ModRenaming True []@
--      * @-package foo ()@ is @ModRenaming False []@
--      * @-package foo (A)@ is @ModRenaming False [("A", "A")]@
--      * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@
--      * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@
data ModRenaming = ModRenaming {
    ModRenaming -> Bool
modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
    ModRenaming -> [(ModuleName, ModuleName)]
modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
                                               --   under name @n@.
  } deriving (ModRenaming -> ModRenaming -> Bool
(ModRenaming -> ModRenaming -> Bool)
-> (ModRenaming -> ModRenaming -> Bool) -> Eq ModRenaming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModRenaming -> ModRenaming -> Bool
== :: ModRenaming -> ModRenaming -> Bool
$c/= :: ModRenaming -> ModRenaming -> Bool
/= :: ModRenaming -> ModRenaming -> Bool
Eq)
instance Outputable ModRenaming where
    ppr :: ModRenaming -> SDoc
ppr (ModRenaming Bool
b [(ModuleName, ModuleName)]
rns) = Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([(ModuleName, ModuleName)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(ModuleName, ModuleName)]
rns)

-- | Flags for manipulating the set of non-broken packages.
newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@
  deriving (IgnorePackageFlag -> IgnorePackageFlag -> Bool
(IgnorePackageFlag -> IgnorePackageFlag -> Bool)
-> (IgnorePackageFlag -> IgnorePackageFlag -> Bool)
-> Eq IgnorePackageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnorePackageFlag -> IgnorePackageFlag -> Bool
== :: IgnorePackageFlag -> IgnorePackageFlag -> Bool
$c/= :: IgnorePackageFlag -> IgnorePackageFlag -> Bool
/= :: IgnorePackageFlag -> IgnorePackageFlag -> Bool
Eq)

-- | Flags for manipulating package trust.
data TrustFlag
  = TrustPackage    String -- ^ @-trust@
  | DistrustPackage String -- ^ @-distrust@
  deriving (TrustFlag -> TrustFlag -> Bool
(TrustFlag -> TrustFlag -> Bool)
-> (TrustFlag -> TrustFlag -> Bool) -> Eq TrustFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TrustFlag -> TrustFlag -> Bool
== :: TrustFlag -> TrustFlag -> Bool
$c/= :: TrustFlag -> TrustFlag -> Bool
/= :: TrustFlag -> TrustFlag -> Bool
Eq)

-- | Flags for manipulating packages visibility.
data PackageFlag
  = ExposePackage   String PackageArg ModRenaming -- ^ @-package@, @-package-id@
  | HidePackage     String -- ^ @-hide-package@
  deriving (PackageFlag -> PackageFlag -> Bool
(PackageFlag -> PackageFlag -> Bool)
-> (PackageFlag -> PackageFlag -> Bool) -> Eq PackageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageFlag -> PackageFlag -> Bool
== :: PackageFlag -> PackageFlag -> Bool
$c/= :: PackageFlag -> PackageFlag -> Bool
/= :: PackageFlag -> PackageFlag -> Bool
Eq) -- NB: equality instance is used by packageFlagsChanged

data PackageDBFlag
  = PackageDB PkgDbRef
  | NoUserPackageDB
  | NoGlobalPackageDB
  | ClearPackageDBs
  deriving (PackageDBFlag -> PackageDBFlag -> Bool
(PackageDBFlag -> PackageDBFlag -> Bool)
-> (PackageDBFlag -> PackageDBFlag -> Bool) -> Eq PackageDBFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDBFlag -> PackageDBFlag -> Bool
== :: PackageDBFlag -> PackageDBFlag -> Bool
$c/= :: PackageDBFlag -> PackageDBFlag -> Bool
/= :: PackageDBFlag -> PackageDBFlag -> Bool
Eq)

packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged DynFlags
idflags1 DynFlags
idflags0 =
  DynFlags -> [PackageFlag]
packageFlags DynFlags
idflags1 [PackageFlag] -> [PackageFlag] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [PackageFlag]
packageFlags DynFlags
idflags0 Bool -> Bool -> Bool
||
  DynFlags -> [IgnorePackageFlag]
ignorePackageFlags DynFlags
idflags1 [IgnorePackageFlag] -> [IgnorePackageFlag] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [IgnorePackageFlag]
ignorePackageFlags DynFlags
idflags0 Bool -> Bool -> Bool
||
  DynFlags -> [PackageFlag]
pluginPackageFlags DynFlags
idflags1 [PackageFlag] -> [PackageFlag] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [PackageFlag]
pluginPackageFlags DynFlags
idflags0 Bool -> Bool -> Bool
||
  DynFlags -> [TrustFlag]
trustFlags DynFlags
idflags1 [TrustFlag] -> [TrustFlag] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [TrustFlag]
trustFlags DynFlags
idflags0 Bool -> Bool -> Bool
||
  DynFlags -> [PackageDBFlag]
packageDBFlags DynFlags
idflags1 [PackageDBFlag] -> [PackageDBFlag] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [PackageDBFlag]
packageDBFlags DynFlags
idflags0 Bool -> Bool -> Bool
||
  DynFlags -> [Bool]
packageGFlags DynFlags
idflags1 [Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> [Bool]
packageGFlags DynFlags
idflags0
 where
   packageGFlags :: DynFlags -> [Bool]
packageGFlags DynFlags
dflags = (GeneralFlag -> Bool) -> [GeneralFlag] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (GeneralFlag -> DynFlags -> Bool
`gopt` DynFlags
dflags)
     [ GeneralFlag
Opt_HideAllPackages
     , GeneralFlag
Opt_HideAllPluginPackages
     , GeneralFlag
Opt_AutoLinkPackages ]

instance Outputable PackageFlag where
    ppr :: PackageFlag -> SDoc
ppr (ExposePackage String
n PackageArg
arg ModRenaming
rn) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (PackageArg -> SDoc
forall a. Outputable a => a -> SDoc
ppr PackageArg
arg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModRenaming -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModRenaming
rn)
    ppr (HidePackage String
str) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-hide-package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
str

data DynLibLoader
  = Deployable
  | SystemDependent
  deriving DynLibLoader -> DynLibLoader -> Bool
(DynLibLoader -> DynLibLoader -> Bool)
-> (DynLibLoader -> DynLibLoader -> Bool) -> Eq DynLibLoader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynLibLoader -> DynLibLoader -> Bool
== :: DynLibLoader -> DynLibLoader -> Bool
$c/= :: DynLibLoader -> DynLibLoader -> Bool
/= :: DynLibLoader -> DynLibLoader -> Bool
Eq

data RtsOptsEnabled
  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
  | RtsOptsAll
  deriving (Int -> RtsOptsEnabled -> String -> String
[RtsOptsEnabled] -> String -> String
RtsOptsEnabled -> String
(Int -> RtsOptsEnabled -> String -> String)
-> (RtsOptsEnabled -> String)
-> ([RtsOptsEnabled] -> String -> String)
-> Show RtsOptsEnabled
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RtsOptsEnabled -> String -> String
showsPrec :: Int -> RtsOptsEnabled -> String -> String
$cshow :: RtsOptsEnabled -> String
show :: RtsOptsEnabled -> String
$cshowList :: [RtsOptsEnabled] -> String -> String
showList :: [RtsOptsEnabled] -> String -> String
Show)

-- | Are we building with @-fPIE@ or @-fPIC@ enabled?
positionIndependent :: DynFlags -> Bool
positionIndependent :: DynFlags -> Bool
positionIndependent DynFlags
dflags = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIE DynFlags
dflags

-- Note [-dynamic-too business]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic
-- objects in a single run of the compiler: the pipeline is the same down to
-- Core optimisation, then the backend (from Core to object code) is executed
-- twice.
--
-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic
-- and dynamic loaded interfaces (#9176).
--
-- To make matters worse, we automatically enable -dynamic-too when some modules
-- need Template-Haskell and GHC is dynamically linked (cf
-- GHC.Driver.Pipeline.compileOne').
--
-- We used to try and fall back from a dynamic-too failure but this feature
-- didn't work as expected (#20446) so it was removed to simplify the
-- implementation and not obscure latent bugs.

data DynamicTooState
   = DT_Dont    -- ^ Don't try to build dynamic objects too
   | DT_OK      -- ^ Will still try to generate dynamic objects
   | DT_Dyn     -- ^ Currently generating dynamic objects (in the backend)
   deriving (DynamicTooState -> DynamicTooState -> Bool
(DynamicTooState -> DynamicTooState -> Bool)
-> (DynamicTooState -> DynamicTooState -> Bool)
-> Eq DynamicTooState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynamicTooState -> DynamicTooState -> Bool
== :: DynamicTooState -> DynamicTooState -> Bool
$c/= :: DynamicTooState -> DynamicTooState -> Bool
/= :: DynamicTooState -> DynamicTooState -> Bool
Eq,Int -> DynamicTooState -> String -> String
[DynamicTooState] -> String -> String
DynamicTooState -> String
(Int -> DynamicTooState -> String -> String)
-> (DynamicTooState -> String)
-> ([DynamicTooState] -> String -> String)
-> Show DynamicTooState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DynamicTooState -> String -> String
showsPrec :: Int -> DynamicTooState -> String -> String
$cshow :: DynamicTooState -> String
show :: DynamicTooState -> String
$cshowList :: [DynamicTooState] -> String -> String
showList :: [DynamicTooState] -> String -> String
Show,Eq DynamicTooState
Eq DynamicTooState =>
(DynamicTooState -> DynamicTooState -> Ordering)
-> (DynamicTooState -> DynamicTooState -> Bool)
-> (DynamicTooState -> DynamicTooState -> Bool)
-> (DynamicTooState -> DynamicTooState -> Bool)
-> (DynamicTooState -> DynamicTooState -> Bool)
-> (DynamicTooState -> DynamicTooState -> DynamicTooState)
-> (DynamicTooState -> DynamicTooState -> DynamicTooState)
-> Ord DynamicTooState
DynamicTooState -> DynamicTooState -> Bool
DynamicTooState -> DynamicTooState -> Ordering
DynamicTooState -> DynamicTooState -> DynamicTooState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DynamicTooState -> DynamicTooState -> Ordering
compare :: DynamicTooState -> DynamicTooState -> Ordering
$c< :: DynamicTooState -> DynamicTooState -> Bool
< :: DynamicTooState -> DynamicTooState -> Bool
$c<= :: DynamicTooState -> DynamicTooState -> Bool
<= :: DynamicTooState -> DynamicTooState -> Bool
$c> :: DynamicTooState -> DynamicTooState -> Bool
> :: DynamicTooState -> DynamicTooState -> Bool
$c>= :: DynamicTooState -> DynamicTooState -> Bool
>= :: DynamicTooState -> DynamicTooState -> Bool
$cmax :: DynamicTooState -> DynamicTooState -> DynamicTooState
max :: DynamicTooState -> DynamicTooState -> DynamicTooState
$cmin :: DynamicTooState -> DynamicTooState -> DynamicTooState
min :: DynamicTooState -> DynamicTooState -> DynamicTooState
Ord)

dynamicTooState :: DynFlags -> DynamicTooState
dynamicTooState :: DynFlags -> DynamicTooState
dynamicTooState DynFlags
dflags
   | Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildDynamicToo DynFlags
dflags) = DynamicTooState
DT_Dont
   | DynFlags -> Bool
dynamicNow DynFlags
dflags = DynamicTooState
DT_Dyn
   | Bool
otherwise = DynamicTooState
DT_OK

setDynamicNow :: DynFlags -> DynFlags
setDynamicNow :: DynFlags -> DynFlags
setDynamicNow DynFlags
dflags0 =
   DynFlags
dflags0
      { dynamicNow = True
      }

data PkgDbRef
  = GlobalPkgDb
  | UserPkgDb
  | PkgDbPath FilePath
  deriving PkgDbRef -> PkgDbRef -> Bool
(PkgDbRef -> PkgDbRef -> Bool)
-> (PkgDbRef -> PkgDbRef -> Bool) -> Eq PkgDbRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgDbRef -> PkgDbRef -> Bool
== :: PkgDbRef -> PkgDbRef -> Bool
$c/= :: PkgDbRef -> PkgDbRef -> Bool
/= :: PkgDbRef -> PkgDbRef -> Bool
Eq

-- | Used to differentiate the scope an include needs to apply to.
-- We have to split the include paths to avoid accidentally forcing recursive
-- includes since -I overrides the system search paths. See #14312.
data IncludeSpecs
  = IncludeSpecs { IncludeSpecs -> [String]
includePathsQuote  :: [String]
                 , IncludeSpecs -> [String]
includePathsGlobal :: [String]
                 -- | See Note [Implicit include paths]
                 , IncludeSpecs -> [String]
includePathsQuoteImplicit :: [String]
                 }
  deriving Int -> IncludeSpecs -> String -> String
[IncludeSpecs] -> String -> String
IncludeSpecs -> String
(Int -> IncludeSpecs -> String -> String)
-> (IncludeSpecs -> String)
-> ([IncludeSpecs] -> String -> String)
-> Show IncludeSpecs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> IncludeSpecs -> String -> String
showsPrec :: Int -> IncludeSpecs -> String -> String
$cshow :: IncludeSpecs -> String
show :: IncludeSpecs -> String
$cshowList :: [IncludeSpecs] -> String -> String
showList :: [IncludeSpecs] -> String -> String
Show

-- | Append to the list of includes a path that shall be included using `-I`
-- when the C compiler is called. These paths override system search paths.
addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addGlobalInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsGlobal IncludeSpecs
spec
                               in IncludeSpecs
spec { includePathsGlobal = f ++ paths }

-- | Append to the list of includes a path that shall be included using
-- `-iquote` when the C compiler is called. These paths only apply when quoted
-- includes are used. e.g. #include "foo.h"
addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addQuoteInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsQuote IncludeSpecs
spec
                              in IncludeSpecs
spec { includePathsQuote = f ++ paths }

-- | These includes are not considered while fingerprinting the flags for iface
-- | See Note [Implicit include paths]
addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addImplicitQuoteInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsQuoteImplicit IncludeSpecs
spec
                              in IncludeSpecs
spec { includePathsQuoteImplicit = f ++ paths }


-- | Concatenate and flatten the list of global and quoted includes returning
-- just a flat list of paths.
flattenIncludes :: IncludeSpecs -> [String]
flattenIncludes :: IncludeSpecs -> [String]
flattenIncludes IncludeSpecs
specs =
    IncludeSpecs -> [String]
includePathsQuote IncludeSpecs
specs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    IncludeSpecs -> [String]
includePathsQuoteImplicit IncludeSpecs
specs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    IncludeSpecs -> [String]
includePathsGlobal IncludeSpecs
specs

{- Note [Implicit include paths]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  The compile driver adds the path to the folder containing the source file being
  compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags'
  that are used later to compute the interface file. Because of this,
  the flags fingerprint derived from these 'DynFlags' and recorded in the
  interface file will end up containing the absolute path to the source folder.

  Build systems with a remote cache like Bazel or Buck (or Shake, see #16956)
  store the build artifacts produced by a build BA for reuse in subsequent builds.

  Embedding source paths in interface fingerprints will thwart these attempts and
  lead to unnecessary recompilations when the source paths in BA differ from the
  source paths in subsequent builds.
 -}

hasPprDebug :: DynFlags -> Bool
hasPprDebug :: DynFlags -> Bool
hasPprDebug = DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_ppr_debug

hasNoDebugOutput :: DynFlags -> Bool
hasNoDebugOutput :: DynFlags -> Bool
hasNoDebugOutput = DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_no_debug_output

hasNoStateHack :: DynFlags -> Bool
hasNoStateHack :: DynFlags -> Bool
hasNoStateHack = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_G_NoStateHack

hasNoOptCoercion :: DynFlags -> Bool
hasNoOptCoercion :: DynFlags -> Bool
hasNoOptCoercion = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_G_NoOptCoercion

-- | Test whether a 'DumpFlag' is set
dopt :: DumpFlag -> DynFlags -> Bool
dopt :: DumpFlag -> DynFlags -> Bool
dopt = (DynFlags -> Int)
-> (DynFlags -> EnumSet DumpFlag) -> DumpFlag -> DynFlags -> Bool
forall a.
(a -> Int) -> (a -> EnumSet DumpFlag) -> DumpFlag -> a -> Bool
getDumpFlagFrom DynFlags -> Int
verbosity DynFlags -> EnumSet DumpFlag
dumpFlags

-- | Set a 'DumpFlag'
dopt_set :: DynFlags -> DumpFlag -> DynFlags
dopt_set :: DynFlags -> DumpFlag -> DynFlags
dopt_set DynFlags
dfs DumpFlag
f = DynFlags
dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }

-- | Unset a 'DumpFlag'
dopt_unset :: DynFlags -> DumpFlag -> DynFlags
dopt_unset :: DynFlags -> DumpFlag -> DynFlags
dopt_unset DynFlags
dfs DumpFlag
f = DynFlags
dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }

-- | Test whether a 'GeneralFlag' is set
--
-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`)
-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables
-- Opt_SplitSections.
--
gopt :: GeneralFlag -> DynFlags -> Bool
gopt :: GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags
   | DynFlags -> Bool
dynamicNow DynFlags
dflags = Bool
True
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags
   | DynFlags -> Bool
dynamicNow DynFlags
dflags = Bool
True
gopt GeneralFlag
Opt_SplitSections DynFlags
dflags
   | DynFlags -> Bool
dynamicNow DynFlags
dflags = Bool
False
gopt GeneralFlag
f DynFlags
dflags = GeneralFlag
f GeneralFlag -> EnumSet GeneralFlag -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
`EnumSet.member` DynFlags -> EnumSet GeneralFlag
generalFlags DynFlags
dflags

-- | Set a 'GeneralFlag'
gopt_set :: DynFlags -> GeneralFlag -> DynFlags
gopt_set :: DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dfs GeneralFlag
f = DynFlags
dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }

-- | Unset a 'GeneralFlag'
gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dfs GeneralFlag
f = DynFlags
dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }

-- | Test whether a 'WarningFlag' is set
wopt :: WarningFlag -> DynFlags -> Bool
wopt :: WarningFlag -> DynFlags -> Bool
wopt WarningFlag
f DynFlags
dflags  = WarningFlag
f WarningFlag -> EnumSet WarningFlag -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
`EnumSet.member` DynFlags -> EnumSet WarningFlag
warningFlags DynFlags
dflags

-- | Set a 'WarningFlag'
wopt_set :: DynFlags -> WarningFlag -> DynFlags
wopt_set :: DynFlags -> WarningFlag -> DynFlags
wopt_set DynFlags
dfs WarningFlag
f = DynFlags
dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }

-- | Unset a 'WarningFlag'
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset DynFlags
dfs WarningFlag
f = DynFlags
dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }

-- | Test whether a 'WarningFlag' is set as fatal
wopt_fatal :: WarningFlag -> DynFlags -> Bool
wopt_fatal :: WarningFlag -> DynFlags -> Bool
wopt_fatal WarningFlag
f DynFlags
dflags = WarningFlag
f WarningFlag -> EnumSet WarningFlag -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
`EnumSet.member` DynFlags -> EnumSet WarningFlag
fatalWarningFlags DynFlags
dflags

-- | Mark a 'WarningFlag' as fatal (do not set the flag)
wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_set_fatal DynFlags
dfs WarningFlag
f
    = DynFlags
dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }

-- | Mark a 'WarningFlag' as not fatal
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal DynFlags
dfs WarningFlag
f
    = DynFlags
dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }


-- | Enable all custom warning categories.
wopt_set_all_custom :: DynFlags -> DynFlags
wopt_set_all_custom :: DynFlags -> DynFlags
wopt_set_all_custom DynFlags
dfs
    = DynFlags
dfs{ customWarningCategories = completeWarningCategorySet }

-- | Disable all custom warning categories.
wopt_unset_all_custom :: DynFlags -> DynFlags
wopt_unset_all_custom :: DynFlags -> DynFlags
wopt_unset_all_custom DynFlags
dfs
    = DynFlags
dfs{ customWarningCategories = emptyWarningCategorySet }

-- | Mark all custom warning categories as fatal (do not set the flags).
wopt_set_all_fatal_custom :: DynFlags -> DynFlags
wopt_set_all_fatal_custom :: DynFlags -> DynFlags
wopt_set_all_fatal_custom DynFlags
dfs
    = DynFlags
dfs { fatalCustomWarningCategories = completeWarningCategorySet }

-- | Mark all custom warning categories as non-fatal.
wopt_unset_all_fatal_custom :: DynFlags -> DynFlags
wopt_unset_all_fatal_custom :: DynFlags -> DynFlags
wopt_unset_all_fatal_custom DynFlags
dfs
    = DynFlags
dfs { fatalCustomWarningCategories = emptyWarningCategorySet }

-- | Set a custom 'WarningCategory'
wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_set_custom DynFlags
dfs WarningCategory
f = DynFlags
dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) }

-- | Unset a custom 'WarningCategory'
wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_unset_custom DynFlags
dfs WarningCategory
f = DynFlags
dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) }

-- | Mark a custom 'WarningCategory' as fatal (do not set the flag)
wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_set_fatal_custom DynFlags
dfs WarningCategory
f
    = DynFlags
dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) }

-- | Mark a custom 'WarningCategory' as not fatal
wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
wopt_unset_fatal_custom DynFlags
dfs WarningCategory
f
    = DynFlags
dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) }

-- | Are there any custom warning categories enabled?
wopt_any_custom :: DynFlags -> Bool
wopt_any_custom :: DynFlags -> Bool
wopt_any_custom DynFlags
dfs = Bool -> Bool
not (WarningCategorySet -> Bool
nullWarningCategorySet (DynFlags -> WarningCategorySet
customWarningCategories DynFlags
dfs))


-- | Test whether a 'LangExt.Extension' is set
xopt :: LangExt.Extension -> DynFlags -> Bool
xopt :: Extension -> DynFlags -> Bool
xopt Extension
f DynFlags
dflags = Extension
f Extension -> EnumSet Extension -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
`EnumSet.member` DynFlags -> EnumSet Extension
extensionFlags DynFlags
dflags

-- | Set a 'LangExt.Extension'
xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
xopt_set :: DynFlags -> Extension -> DynFlags
xopt_set DynFlags
dfs Extension
f
    = let onoffs :: [OnOff Extension]
onoffs = Extension -> OnOff Extension
forall a. a -> OnOff a
On Extension
f OnOff Extension -> [OnOff Extension] -> [OnOff Extension]
forall a. a -> [a] -> [a]
: DynFlags -> [OnOff Extension]
extensions DynFlags
dfs
      in DynFlags
dfs { extensions = onoffs,
               extensionFlags = flattenExtensionFlags (language dfs) onoffs }

-- | Unset a 'LangExt.Extension'
xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags
xopt_unset :: DynFlags -> Extension -> DynFlags
xopt_unset DynFlags
dfs Extension
f
    = let onoffs :: [OnOff Extension]
onoffs = Extension -> OnOff Extension
forall a. a -> OnOff a
Off Extension
f OnOff Extension -> [OnOff Extension] -> [OnOff Extension]
forall a. a -> [a] -> [a]
: DynFlags -> [OnOff Extension]
extensions DynFlags
dfs
      in DynFlags
dfs { extensions = onoffs,
               extensionFlags = flattenExtensionFlags (language dfs) onoffs }

-- | Set or unset a 'LangExt.Extension', unless it has been explicitly
--   set or unset before.
xopt_set_unlessExplSpec
        :: LangExt.Extension
        -> (DynFlags -> LangExt.Extension -> DynFlags)
        -> DynFlags -> DynFlags
xopt_set_unlessExplSpec :: Extension
-> (DynFlags -> Extension -> DynFlags) -> DynFlags -> DynFlags
xopt_set_unlessExplSpec Extension
ext DynFlags -> Extension -> DynFlags
setUnset DynFlags
dflags =
    let referedExts :: [Extension]
referedExts = OnOff Extension -> Extension
forall {a}. OnOff a -> a
stripOnOff (OnOff Extension -> Extension) -> [OnOff Extension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> [OnOff Extension]
extensions DynFlags
dflags
        stripOnOff :: OnOff a -> a
stripOnOff (On a
x)  = a
x
        stripOnOff (Off a
x) = a
x
    in
        if Extension
ext Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
referedExts then DynFlags
dflags else DynFlags -> Extension -> DynFlags
setUnset DynFlags
dflags Extension
ext

xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields
xopt_DuplicateRecordFields :: DynFlags -> DuplicateRecordFields
xopt_DuplicateRecordFields DynFlags
dfs
  | Extension -> DynFlags -> Bool
xopt Extension
LangExt.DuplicateRecordFields DynFlags
dfs = DuplicateRecordFields
FieldLabel.DuplicateRecordFields
  | Bool
otherwise                              = DuplicateRecordFields
FieldLabel.NoDuplicateRecordFields

xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors
xopt_FieldSelectors :: DynFlags -> FieldSelectors
xopt_FieldSelectors DynFlags
dfs
  | Extension -> DynFlags -> Bool
xopt Extension
LangExt.FieldSelectors DynFlags
dfs = FieldSelectors
FieldLabel.FieldSelectors
  | Bool
otherwise                       = FieldSelectors
FieldLabel.NoFieldSelectors

lang_set :: DynFlags -> Maybe Language -> DynFlags
lang_set :: DynFlags -> Maybe Language -> DynFlags
lang_set DynFlags
dflags Maybe Language
lang =
   DynFlags
dflags {
            language = lang,
            extensionFlags = flattenExtensionFlags lang (extensions dflags)
          }

defaultFlags :: Settings -> [GeneralFlag]
defaultFlags :: Settings -> [GeneralFlag]
defaultFlags Settings
settings
-- See Note [Updating flag description in the User's Guide]
  = [ GeneralFlag
Opt_AutoLinkPackages,
      GeneralFlag
Opt_DiagnosticsShowCaret,
      GeneralFlag
Opt_EmbedManifest,
      GeneralFlag
Opt_FamAppCache,
      GeneralFlag
Opt_GenManifest,
      GeneralFlag
Opt_GhciHistory,
      GeneralFlag
Opt_GhciSandbox,
      GeneralFlag
Opt_HelpfulErrors,
      GeneralFlag
Opt_KeepHiFiles,
      GeneralFlag
Opt_KeepOFiles,
      GeneralFlag
Opt_OmitYields,
      GeneralFlag
Opt_PrintBindContents,
      GeneralFlag
Opt_ProfCountEntries,
      GeneralFlag
Opt_SharedImplib,
      GeneralFlag
Opt_SimplPreInlining,
      GeneralFlag
Opt_VersionMacros,
      GeneralFlag
Opt_RPath,
      GeneralFlag
Opt_DumpWithWays,
      GeneralFlag
Opt_CompactUnwind,
      GeneralFlag
Opt_ShowErrorContext,
      GeneralFlag
Opt_SuppressStgReps,
      GeneralFlag
Opt_UnoptimizedCoreForInterpreter,
      GeneralFlag
Opt_SpecialiseIncoherents
    ]

    [GeneralFlag] -> [GeneralFlag] -> [GeneralFlag]
forall a. [a] -> [a] -> [a]
++ [GeneralFlag
f | ([Int]
ns,GeneralFlag
f) <- [([Int], GeneralFlag)]
optLevelFlags, Int
0 Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
ns]
             -- The default -O0 options

    -- Default floating flags (see Note [RHS Floating])
    [GeneralFlag] -> [GeneralFlag] -> [GeneralFlag]
forall a. [a] -> [a] -> [a]
++ [ GeneralFlag
Opt_LocalFloatOut, GeneralFlag
Opt_LocalFloatOutTopLevel ]


    [GeneralFlag] -> [GeneralFlag] -> [GeneralFlag]
forall a. [a] -> [a] -> [a]
++ Platform -> [GeneralFlag]
default_PIC Platform
platform

    [GeneralFlag] -> [GeneralFlag] -> [GeneralFlag]
forall a. [a] -> [a] -> [a]
++ [GeneralFlag]
validHoleFitDefaults


    where platform :: Platform
platform = Settings -> Platform
sTargetPlatform Settings
settings

-- | These are the default settings for the display and sorting of valid hole
--  fits in typed-hole error messages. See Note [Valid hole fits include ...]
 -- in the "GHC.Tc.Errors.Hole" module.
validHoleFitDefaults :: [GeneralFlag]
validHoleFitDefaults :: [GeneralFlag]
validHoleFitDefaults
  =  [ GeneralFlag
Opt_ShowTypeAppOfHoleFits
     , GeneralFlag
Opt_ShowTypeOfHoleFits
     , GeneralFlag
Opt_ShowProvOfHoleFits
     , GeneralFlag
Opt_ShowMatchesOfHoleFits
     , GeneralFlag
Opt_ShowValidHoleFits
     , GeneralFlag
Opt_SortValidHoleFits
     , GeneralFlag
Opt_SortBySizeHoleFits
     , GeneralFlag
Opt_ShowHoleConstraints ]

-- Note [When is StarIsType enabled]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The StarIsType extension determines whether to treat '*' as a regular type
-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType
-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is
-- enabled.
--
-- Programs that use TypeOperators might expect to repurpose '*' for
-- multiplication or another binary operation, but making TypeOperators imply
-- NoStarIsType caused too much breakage on Hackage.
--

--
-- Note [Documenting optimisation flags]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- If you change the list of flags enabled for particular optimisation levels
-- please remember to update the User's Guide. The relevant file is:
--
--   docs/users_guide/using-optimisation.rst
--
-- Make sure to note whether a flag is implied by -O0, -O or -O2.

optLevelFlags :: [([Int], GeneralFlag)]
-- Default settings of flags, before any command-line overrides
optLevelFlags :: [([Int], GeneralFlag)]
optLevelFlags -- see Note [Documenting optimisation flags]
  = [ ([Int
0,Int
1,Int
2], GeneralFlag
Opt_DoLambdaEtaExpansion)
    , ([Int
0,Int
1,Int
2], GeneralFlag
Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]
    , ([Int
0,Int
1,Int
2], GeneralFlag
Opt_LlvmTBAA)
    , ([Int
0,Int
1,Int
2], GeneralFlag
Opt_ProfManualCcs )
    , ([Int
2], GeneralFlag
Opt_DictsStrict)

    , ([Int
0],     GeneralFlag
Opt_IgnoreInterfacePragmas)
    , ([Int
0],     GeneralFlag
Opt_OmitInterfacePragmas)

    , ([Int
1,Int
2],   GeneralFlag
Opt_CoreConstantFolding)

    , ([Int
1,Int
2],   GeneralFlag
Opt_CallArity)
    , ([Int
1,Int
2],   GeneralFlag
Opt_Exitification)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CaseMerge)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CaseFolding)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CmmElimCommonBlocks)
    , ([Int
2],     GeneralFlag
Opt_AsmShortcutting)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CmmSink)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CmmStaticPred)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CSE)
    , ([Int
1,Int
2],   GeneralFlag
Opt_StgCSE)
    , ([Int
2],     GeneralFlag
Opt_StgLiftLams)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CmmControlFlow)

    , ([Int
1,Int
2],   GeneralFlag
Opt_EnableRewriteRules)
          -- Off for -O0.   Otherwise we desugar list literals
          -- to 'build' but don't run the simplifier passes that
          -- would rewrite them back to cons cells!  This seems
          -- silly, and matters for the GHCi debugger.

    , ([Int
1,Int
2],   GeneralFlag
Opt_FloatIn)
    , ([Int
1,Int
2],   GeneralFlag
Opt_FullLaziness)
    , ([Int
1,Int
2],   GeneralFlag
Opt_IgnoreAsserts)
    , ([Int
1,Int
2],   GeneralFlag
Opt_Loopification)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CfgBlocklayout)      -- Experimental

    , ([Int
1,Int
2],   GeneralFlag
Opt_Specialise)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CrossModuleSpecialise)
    , ([Int
1,Int
2],   GeneralFlag
Opt_InlineGenerics)
    , ([Int
1,Int
2],   GeneralFlag
Opt_Strictness)
    , ([Int
1,Int
2],   GeneralFlag
Opt_UnboxSmallStrictFields)
    , ([Int
1,Int
2],   GeneralFlag
Opt_CprAnal)
    , ([Int
1,Int
2],   GeneralFlag
Opt_WorkerWrapper)
    , ([Int
1,Int
2],   GeneralFlag
Opt_SolveConstantDicts)
    , ([Int
1,Int
2],   GeneralFlag
Opt_NumConstantFolding)

    , ([Int
2],     GeneralFlag
Opt_LiberateCase)
    , ([Int
2],     GeneralFlag
Opt_SpecConstr)
    , ([Int
2],     GeneralFlag
Opt_FastPAPCalls)
--  , ([2],     Opt_RegsGraph)
--   RegsGraph suffers performance regression. See #7679
--  , ([2],     Opt_StaticArgumentTransformation)
--   Static Argument Transformation needs investigation. See #9374
    ]

type TurnOnFlag = Bool   -- True  <=> we are turning the flag on
                         -- False <=> we are turning the flag off
turnOn  :: TurnOnFlag; turnOn :: Bool
turnOn  = Bool
True
turnOff :: TurnOnFlag; turnOff :: Bool
turnOff = Bool
False

default_PIC :: Platform -> [GeneralFlag]
default_PIC :: Platform -> [GeneralFlag]
default_PIC Platform
platform =
  case (Platform -> OS
platformOS Platform
platform, Platform -> Arch
platformArch Platform
platform) of
    -- Darwin always requires PIC.  Especially on more recent macOS releases
    -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses
    -- while we could work around this on x86_64 (like WINE does), we won't be
    -- able on aarch64, where this is enforced.
    (OS
OSDarwin,  Arch
ArchX86_64)  -> [GeneralFlag
Opt_PIC]
    -- For AArch64, we need to always have PIC enabled.  The relocation model
    -- on AArch64 does not permit arbitrary relocations.  Under ASLR, we can't
    -- control much how far apart symbols are in memory for our in-memory static
    -- linker;  and thus need to ensure we get sufficiently capable relocations.
    -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top
    -- of that.  Subsequently we expect all code on aarch64/linux (and macOS) to
    -- be built with -fPIC.
    (OS
OSDarwin,  Arch
ArchAArch64) -> [GeneralFlag
Opt_PIC]
    (OS
OSLinux,   Arch
ArchAArch64) -> [GeneralFlag
Opt_PIC, GeneralFlag
Opt_ExternalDynamicRefs]
    (OS
OSLinux,   ArchARM {})  -> [GeneralFlag
Opt_PIC, GeneralFlag
Opt_ExternalDynamicRefs]
    (OS
OSOpenBSD, Arch
ArchX86_64)  -> [GeneralFlag
Opt_PIC] -- Due to PIE support in
                                         -- OpenBSD since 5.3 release
                                         -- (1 May 2013) we need to
                                         -- always generate PIC. See
                                         -- #10597 for more
                                         -- information.
    (OS, Arch)
_                      -> []

-- | The language extensions implied by the various language variants.
-- When updating this be sure to update the flag documentation in
-- @docs/users_guide/exts@.
languageExtensions :: Maybe Language -> [LangExt.Extension]

-- Nothing: the default case
languageExtensions :: Maybe Language -> [Extension]
languageExtensions Maybe Language
Nothing = Maybe Language -> [Extension]
languageExtensions (Language -> Maybe Language
forall a. a -> Maybe a
Just Language
GHC2021)

languageExtensions (Just Language
Haskell98)
    = [Extension
LangExt.ImplicitPrelude,
       -- See Note [When is StarIsType enabled]
       Extension
LangExt.StarIsType,
       Extension
LangExt.CUSKs,
       Extension
LangExt.MonomorphismRestriction,
       Extension
LangExt.NPlusKPatterns,
       Extension
LangExt.DatatypeContexts,
       Extension
LangExt.TraditionalRecordSyntax,
       Extension
LangExt.FieldSelectors,
       Extension
LangExt.NondecreasingIndentation,
           -- strictly speaking non-standard, but we always had this
           -- on implicitly before the option was added in 7.1, and
           -- turning it off breaks code, so we're keeping it on for
           -- backwards compatibility.  Cabal uses -XHaskell98 by
           -- default unless you specify another language.
       Extension
LangExt.DeepSubsumption
       -- Non-standard but enabled for backwards compatability (see GHC proposal #511)
      ]

languageExtensions (Just Language
Haskell2010)
    = [Extension
LangExt.ImplicitPrelude,
       -- See Note [When is StarIsType enabled]
       Extension
LangExt.StarIsType,
       Extension
LangExt.CUSKs,
       Extension
LangExt.MonomorphismRestriction,
       Extension
LangExt.DatatypeContexts,
       Extension
LangExt.TraditionalRecordSyntax,
       Extension
LangExt.EmptyDataDecls,
       Extension
LangExt.ForeignFunctionInterface,
       Extension
LangExt.PatternGuards,
       Extension
LangExt.DoAndIfThenElse,
       Extension
LangExt.FieldSelectors,
       Extension
LangExt.RelaxedPolyRec,
       Extension
LangExt.DeepSubsumption ]

languageExtensions (Just Language
GHC2021)
    = [Extension
LangExt.ImplicitPrelude,
       -- See Note [When is StarIsType enabled]
       Extension
LangExt.StarIsType,
       Extension
LangExt.MonomorphismRestriction,
       Extension
LangExt.TraditionalRecordSyntax,
       Extension
LangExt.EmptyDataDecls,
       Extension
LangExt.ForeignFunctionInterface,
       Extension
LangExt.PatternGuards,
       Extension
LangExt.DoAndIfThenElse,
       Extension
LangExt.FieldSelectors,
       Extension
LangExt.RelaxedPolyRec,
       -- Now the new extensions (not in Haskell2010)
       Extension
LangExt.BangPatterns,
       Extension
LangExt.BinaryLiterals,
       Extension
LangExt.ConstrainedClassMethods,
       Extension
LangExt.ConstraintKinds,
       Extension
LangExt.DeriveDataTypeable,
       Extension
LangExt.DeriveFoldable,
       Extension
LangExt.DeriveFunctor,
       Extension
LangExt.DeriveGeneric,
       Extension
LangExt.DeriveLift,
       Extension
LangExt.DeriveTraversable,
       Extension
LangExt.EmptyCase,
       Extension
LangExt.EmptyDataDeriving,
       Extension
LangExt.ExistentialQuantification,
       Extension
LangExt.ExplicitForAll,
       Extension
LangExt.FlexibleContexts,
       Extension
LangExt.FlexibleInstances,
       Extension
LangExt.GADTSyntax,
       Extension
LangExt.GeneralizedNewtypeDeriving,
       Extension
LangExt.HexFloatLiterals,
       Extension
LangExt.ImportQualifiedPost,
       Extension
LangExt.InstanceSigs,
       Extension
LangExt.KindSignatures,
       Extension
LangExt.MultiParamTypeClasses,
       Extension
LangExt.NamedFieldPuns,
       Extension
LangExt.NamedWildCards,
       Extension
LangExt.NumericUnderscores,
       Extension
LangExt.PolyKinds,
       Extension
LangExt.PostfixOperators,
       Extension
LangExt.RankNTypes,
       Extension
LangExt.ScopedTypeVariables,
       Extension
LangExt.StandaloneDeriving,
       Extension
LangExt.StandaloneKindSignatures,
       Extension
LangExt.TupleSections,
       Extension
LangExt.TypeApplications,
       Extension
LangExt.TypeOperators,
       Extension
LangExt.TypeSynonymInstances]


ways :: DynFlags -> Ways
ways :: DynFlags -> Ways
ways DynFlags
dflags
   | DynFlags -> Bool
dynamicNow DynFlags
dflags = Way -> Ways -> Ways
addWay Way
WayDyn (DynFlags -> Ways
targetWays_ DynFlags
dflags)
   | Bool
otherwise         = DynFlags -> Ways
targetWays_ DynFlags
dflags

-- | Get target profile
targetProfile :: DynFlags -> Profile
targetProfile :: DynFlags -> Profile
targetProfile DynFlags
dflags = Platform -> Ways -> Profile
Profile (DynFlags -> Platform
targetPlatform DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags)

--
-- System tool settings and locations

programName :: DynFlags -> String
programName :: DynFlags -> String
programName DynFlags
dflags = GhcNameVersion -> String
ghcNameVersion_programName (GhcNameVersion -> String) -> GhcNameVersion -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
projectVersion :: DynFlags -> String
projectVersion :: DynFlags -> String
projectVersion DynFlags
dflags = GhcNameVersion -> String
ghcNameVersion_projectVersion (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags)
ghcUsagePath          :: DynFlags -> FilePath
ghcUsagePath :: DynFlags -> String
ghcUsagePath DynFlags
dflags = FileSettings -> String
fileSettings_ghcUsagePath (FileSettings -> String) -> FileSettings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> FileSettings
fileSettings DynFlags
dflags
ghciUsagePath         :: DynFlags -> FilePath
ghciUsagePath :: DynFlags -> String
ghciUsagePath DynFlags
dflags = FileSettings -> String
fileSettings_ghciUsagePath (FileSettings -> String) -> FileSettings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> FileSettings
fileSettings DynFlags
dflags
topDir                :: DynFlags -> FilePath
topDir :: DynFlags -> String
topDir DynFlags
dflags = FileSettings -> String
fileSettings_topDir (FileSettings -> String) -> FileSettings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> FileSettings
fileSettings DynFlags
dflags
toolDir               :: DynFlags -> Maybe FilePath
toolDir :: DynFlags -> Maybe String
toolDir DynFlags
dflags = FileSettings -> Maybe String
fileSettings_toolDir (FileSettings -> Maybe String) -> FileSettings -> Maybe String
forall a b. (a -> b) -> a -> b
$ DynFlags -> FileSettings
fileSettings DynFlags
dflags
extraGccViaCFlags     :: DynFlags -> [String]
extraGccViaCFlags :: DynFlags -> [String]
extraGccViaCFlags DynFlags
dflags = ToolSettings -> [String]
toolSettings_extraGccViaCFlags (ToolSettings -> [String]) -> ToolSettings -> [String]
forall a b. (a -> b) -> a -> b
$ DynFlags -> ToolSettings
toolSettings DynFlags
dflags
globalPackageDatabasePath   :: DynFlags -> FilePath
globalPackageDatabasePath :: DynFlags -> String
globalPackageDatabasePath DynFlags
dflags = FileSettings -> String
fileSettings_globalPackageDatabase (FileSettings -> String) -> FileSettings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> FileSettings
fileSettings DynFlags
dflags

-- | The directory for this version of ghc in the user's app directory
-- The appdir used to be in ~/.ghc but to respect the XDG specification
-- we want to move it under $XDG_DATA_HOME/
-- However, old tooling (like cabal) might still write package environments
-- to the old directory, so we prefer that if a subdirectory of ~/.ghc
-- with the correct target and GHC version suffix exists.
--
-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that
-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR
--
-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version
versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath
versionedAppDir :: String -> ArchOS -> MaybeT IO String
versionedAppDir String
appname ArchOS
platform = do
  -- Make sure we handle the case the HOME isn't set (see #11678)
  -- We need to fallback to the old scheme if the subdirectory exists.
  [MaybeT IO String] -> MaybeT IO String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO String] -> MaybeT IO String)
-> [MaybeT IO String] -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ (MaybeT IO String -> MaybeT IO String)
-> [MaybeT IO String] -> [MaybeT IO String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> MaybeT IO String
checkIfExists (String -> MaybeT IO String)
-> (MaybeT IO String -> MaybeT IO String)
-> MaybeT IO String
-> MaybeT IO String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (String -> String) -> MaybeT IO String -> MaybeT IO String
forall a b. (a -> b) -> MaybeT IO a -> MaybeT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> ArchOS -> String
versionedFilePath ArchOS
platform))
       [ IO String -> MaybeT IO String
forall a. IO a -> MaybeT IO a
tryMaybeT (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getAppUserDataDirectory String
appname  -- this is ~/.ghc/
       , IO String -> MaybeT IO String
forall a. IO a -> MaybeT IO a
tryMaybeT (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
appname -- this is $XDG_DATA_HOME/
       ]
  where
    checkIfExists :: String -> MaybeT IO String
checkIfExists String
dir = IO Bool -> MaybeT IO Bool
forall a. IO a -> MaybeT IO a
tryMaybeT (String -> IO Bool
doesDirectoryExist String
dir) MaybeT IO Bool -> (Bool -> MaybeT IO String) -> MaybeT IO String
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> String -> MaybeT IO String
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
dir
      Bool
False -> IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)

versionedFilePath :: ArchOS -> FilePath
versionedFilePath :: ArchOS -> String
versionedFilePath ArchOS
platform = ArchOS -> String
uniqueSubdir ArchOS
platform

-- SDoc
-------------------------------------------

-- | Initialize the pretty-printing options
initSDocContext :: DynFlags -> PprStyle -> SDocContext
initSDocContext :: DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
style = SDC
  { sdocStyle :: PprStyle
sdocStyle                       = PprStyle
style
  , sdocColScheme :: Scheme
sdocColScheme                   = DynFlags -> Scheme
colScheme DynFlags
dflags
  , sdocLastColour :: PprColour
sdocLastColour                  = PprColour
Col.colReset
  , sdocShouldUseColor :: Bool
sdocShouldUseColor              = Bool -> OverridingBool -> Bool
overrideWith (DynFlags -> Bool
canUseColor DynFlags
dflags) (DynFlags -> OverridingBool
useColor DynFlags
dflags)
  , sdocDefaultDepth :: Int
sdocDefaultDepth                = DynFlags -> Int
pprUserLength DynFlags
dflags
  , sdocLineLength :: Int
sdocLineLength                  = DynFlags -> Int
pprCols DynFlags
dflags
  , sdocCanUseUnicode :: Bool
sdocCanUseUnicode               = DynFlags -> Bool
useUnicode DynFlags
dflags
  , sdocHexWordLiterals :: Bool
sdocHexWordLiterals             = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HexWordLiterals DynFlags
dflags
  , sdocPprDebug :: Bool
sdocPprDebug                    = DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_ppr_debug DynFlags
dflags
  , sdocPrintUnicodeSyntax :: Bool
sdocPrintUnicodeSyntax          = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintUnicodeSyntax DynFlags
dflags
  , sdocPrintCaseAsLet :: Bool
sdocPrintCaseAsLet              = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PprCaseAsLet DynFlags
dflags
  , sdocPrintTypecheckerElaboration :: Bool
sdocPrintTypecheckerElaboration = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintTypecheckerElaboration DynFlags
dflags
  , sdocPrintAxiomIncomps :: Bool
sdocPrintAxiomIncomps           = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintAxiomIncomps DynFlags
dflags
  , sdocPrintExplicitKinds :: Bool
sdocPrintExplicitKinds          = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
  , sdocPrintExplicitCoercions :: Bool
sdocPrintExplicitCoercions      = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitCoercions DynFlags
dflags
  , sdocPrintExplicitRuntimeReps :: Bool
sdocPrintExplicitRuntimeReps    = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitRuntimeReps DynFlags
dflags
  , sdocPrintExplicitForalls :: Bool
sdocPrintExplicitForalls        = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags
  , sdocPrintPotentialInstances :: Bool
sdocPrintPotentialInstances     = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintPotentialInstances DynFlags
dflags
  , sdocPrintEqualityRelations :: Bool
sdocPrintEqualityRelations      = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintEqualityRelations DynFlags
dflags
  , sdocSuppressTicks :: Bool
sdocSuppressTicks               = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressTicks DynFlags
dflags
  , sdocSuppressTypeSignatures :: Bool
sdocSuppressTypeSignatures      = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressTypeSignatures DynFlags
dflags
  , sdocSuppressTypeApplications :: Bool
sdocSuppressTypeApplications    = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressTypeApplications DynFlags
dflags
  , sdocSuppressIdInfo :: Bool
sdocSuppressIdInfo              = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressIdInfo DynFlags
dflags
  , sdocSuppressCoercions :: Bool
sdocSuppressCoercions           = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressCoercions DynFlags
dflags
  , sdocSuppressCoercionTypes :: Bool
sdocSuppressCoercionTypes       = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressCoercionTypes DynFlags
dflags
  , sdocSuppressUnfoldings :: Bool
sdocSuppressUnfoldings          = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUnfoldings DynFlags
dflags
  , sdocSuppressVarKinds :: Bool
sdocSuppressVarKinds            = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressVarKinds DynFlags
dflags
  , sdocSuppressUniques :: Bool
sdocSuppressUniques             = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags
  , sdocSuppressModulePrefixes :: Bool
sdocSuppressModulePrefixes      = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressModulePrefixes DynFlags
dflags
  , sdocSuppressStgExts :: Bool
sdocSuppressStgExts             = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressStgExts DynFlags
dflags
  , sdocSuppressStgReps :: Bool
sdocSuppressStgReps             = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressStgReps DynFlags
dflags
  , sdocErrorSpans :: Bool
sdocErrorSpans                  = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ErrorSpans DynFlags
dflags
  , sdocStarIsType :: Bool
sdocStarIsType                  = Extension -> DynFlags -> Bool
xopt Extension
LangExt.StarIsType DynFlags
dflags
  , sdocLinearTypes :: Bool
sdocLinearTypes                 = Extension -> DynFlags -> Bool
xopt Extension
LangExt.LinearTypes DynFlags
dflags
  , sdocListTuplePuns :: Bool
sdocListTuplePuns               = Bool
True
  , sdocPrintTypeAbbreviations :: Bool
sdocPrintTypeAbbreviations      = Bool
True
  , sdocUnitIdForUser :: FastString -> SDoc
sdocUnitIdForUser               = FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext
  }

-- | Initialize the pretty-printing options using the default user style
initDefaultSDocContext :: DynFlags -> SDocContext
initDefaultSDocContext :: DynFlags -> SDocContext
initDefaultSDocContext DynFlags
dflags = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultUserStyle

initPromotionTickContext :: DynFlags -> PromotionTickContext
initPromotionTickContext :: DynFlags -> PromotionTickContext
initPromotionTickContext DynFlags
dflags =
  PromTickCtx {
    ptcListTuplePuns :: Bool
ptcListTuplePuns = Bool
True,
    ptcPrintRedundantPromTicks :: Bool
ptcPrintRedundantPromTicks = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintRedundantPromotionTicks DynFlags
dflags
  }