summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOleg Grenrus <oleg.grenrus@iki.fi>2023-05-13 12:50:25 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-05-15 14:50:43 -0400
commit86aae5702d09db2f50c42a3f43ef72df1e3a710b (patch)
treee0b660bcb474ecd036d5cacfccf78f9621021b70
parent2f571afe1c2aeb3f4dfca2012bc6b713144fd234 (diff)
downloadhaskell-86aae5702d09db2f50c42a3f43ef72df1e3a710b.tar.gz
Split DynFlags structure into own module
This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags)
-rw-r--r--compiler/GHC/Core/Opt/CallerCC.hs2
-rw-r--r--compiler/GHC/Core/Opt/Monad.hs2
-rw-r--r--compiler/GHC/Core/Rules.hs2
-rw-r--r--compiler/GHC/Data/IOEnv.hs2
-rw-r--r--compiler/GHC/Driver/Config/Diagnostic.hs2
-rw-r--r--compiler/GHC/Driver/Config/Logger.hs2
-rw-r--r--compiler/GHC/Driver/DynFlags.hs1531
-rw-r--r--compiler/GHC/Driver/Env.hs2
-rw-r--r--compiler/GHC/Driver/Env/Types.hs2
-rw-r--r--compiler/GHC/Driver/Errors/Ppr.hs2
-rw-r--r--compiler/GHC/Driver/Errors/Types.hs4
-rw-r--r--compiler/GHC/Driver/Hooks.hs2
-rw-r--r--compiler/GHC/Driver/Ppr.hs2
-rw-r--r--compiler/GHC/Driver/Session.hs1412
-rw-r--r--compiler/GHC/Hs/Pat.hs2
-rw-r--r--compiler/GHC/HsToCore/Errors/Types.hs2
-rw-r--r--compiler/GHC/Runtime/Context.hs2
-rw-r--r--compiler/GHC/Tc/Types/Constraint.hs2
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs2
-rw-r--r--compiler/GHC/Unit/Env.hs2
-rw-r--r--compiler/GHC/Unit/Module/Graph.hs2
-rw-r--r--compiler/GHC/Unit/Module/ModSummary.hs2
-rw-r--r--compiler/GHC/Unit/State.hs2
-rw-r--r--compiler/ghc.cabal.in1
-rw-r--r--testsuite/tests/count-deps/CountDepsAst.stdout1
-rw-r--r--testsuite/tests/count-deps/CountDepsParser.stdout1
-rw-r--r--testsuite/tests/linters/notes.stdout26
27 files changed, 1572 insertions, 1444 deletions
diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
index 4218ebbac9..dcf4df10bf 100644
--- a/compiler/GHC/Core/Opt/CallerCC.hs
+++ b/compiler/GHC/Core/Opt/CallerCC.hs
@@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P
import GHC.Prelude
import GHC.Utils.Outputable as Outputable
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Types.CostCentre
import GHC.Types.CostCentre.State
import GHC.Types.Name hiding (varName)
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index d38f3e6c59..6199472897 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad (
import GHC.Prelude hiding ( read )
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Driver.Env
import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv )
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 67f47e9d9c..9e88ab1bd8 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -41,7 +41,7 @@ import GHC.Unit.Module.Env
import GHC.Unit.Module.ModGuts( ModGuts(..) )
import GHC.Unit.Module.Deps( Dependencies(..) )
-import GHC.Driver.Session( DynFlags )
+import GHC.Driver.DynFlags( DynFlags )
import GHC.Driver.Ppr( showSDoc )
import GHC.Core -- All of it
diff --git a/compiler/GHC/Data/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs
index 836ca856d0..2e713e40ec 100644
--- a/compiler/GHC/Data/IOEnv.hs
+++ b/compiler/GHC/Data/IOEnv.hs
@@ -34,7 +34,7 @@ module GHC.Data.IOEnv (
import GHC.Prelude
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.IO (catchException)
import GHC.Utils.Exception
diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs
index 1e8b5a1e67..fdeff0e568 100644
--- a/compiler/GHC/Driver/Config/Diagnostic.hs
+++ b/compiler/GHC/Driver/Config/Diagnostic.hs
@@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic
where
import GHC.Driver.Flags
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Prelude
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Driver/Config/Logger.hs b/compiler/GHC/Driver/Config/Logger.hs
index 1bffa5f368..e5303826a5 100644
--- a/compiler/GHC/Driver/Config/Logger.hs
+++ b/compiler/GHC/Driver/Config/Logger.hs
@@ -5,7 +5,7 @@ where
import GHC.Prelude
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Utils.Logger (LogFlags (..))
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs
new file mode 100644
index 0000000000..01aa518452
--- /dev/null
+++ b/compiler/GHC/Driver/DynFlags.hs
@@ -0,0 +1,1531 @@
+{-# 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,
+
+ -- ** 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.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 {-# SOURCE #-} GHC.Core.Opt.CallerCC
+
+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 {
+ ghcMode :: GhcMode,
+ ghcLink :: GhcLink,
+ 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
+ ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion,
+ fileSettings :: {-# UNPACK #-} !FileSettings,
+ targetPlatform :: Platform, -- Filled in by SysTools
+ toolSettings :: {-# UNPACK #-} !ToolSettings,
+ platformMisc :: {-# UNPACK #-} !PlatformMisc,
+ rawSettings :: [(String, String)],
+ tmpDir :: TempDir,
+
+ llvmOptLevel :: Int, -- ^ LLVM optimisation level
+ verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
+ debugLevel :: Int, -- ^ How much debug information to produce
+ simplPhases :: Int, -- ^ Number of simplifier phases
+ maxSimplIterations :: Int, -- ^ Max simplifier iterations
+ ruleCheck :: Maybe String,
+ strictnessBefore :: [Int], -- ^ Additional demand analysis
+
+ parMakeCount :: Maybe ParMakeCount,
+ -- ^ The number of modules to compile in parallel
+ -- If unspecified, compile with a single job.
+
+ enableTimeStats :: Bool, -- ^ Enable RTS timing statistics?
+ ghcHeapSize :: Maybe Int, -- ^ The heap size to set.
+
+ maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt
+ -- to show in type error messages
+ maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show
+ -- in typed hole error messages
+ maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole
+ -- fits to show in typed hole error
+ -- messages
+ refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for
+ -- refinement hole fits in typed hole
+ -- error messages
+ maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show
+ -- in non-exhaustiveness warnings
+ maxPmCheckModels :: Int, -- ^ Soft limit on the number of models
+ -- the pattern match checker checks
+ -- a pattern against. A safe guard
+ -- against exponential blow-up.
+ simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks
+ dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an
+ -- Unboxed demand on returned products with at most
+ -- this number of fields
+ specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
+ specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
+ specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types
+ -- Not optional; otherwise ForceSpecConstr can diverge.
+ 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'.
+ liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase
+ floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating
+ -- See 'GHC.Core.Opt.Monad.FloatOutSwitches'
+
+ liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a
+ -- recursive function.
+ liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a
+ -- non-recursive function.
+ liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call
+ -- into an unknown call.
+
+ cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default.
+
+ historySize :: Int, -- ^ Simplification history size
+
+ importPaths :: [FilePath],
+ mainModuleNameIs :: ModuleName,
+ mainFunIs :: Maybe String,
+ reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth
+ solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver
+ -- Typically only 1 is needed
+ givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens
+ -- Should be < solverIterations
+ -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
+ wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds
+ -- Should be < givensFuel
+ -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
+ qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints
+ -- Should be < givensFuel
+ -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
+ homeUnitId_ :: UnitId, -- ^ Target home unit-id
+ homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate
+ homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations
+
+ -- Note [Filepaths and Multiple Home Units]
+ workingDirectory :: Maybe FilePath,
+ thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units
+ hiddenModules :: Set.Set ModuleName,
+ reexportedModules :: Set.Set ModuleName,
+
+ -- ways
+ targetWays_ :: Ways, -- ^ Target way flags from the command line
+
+ -- For object splitting
+ splitInfo :: Maybe (String,Int),
+
+ -- paths etc.
+ objectDir :: Maybe String,
+ dylibInstallName :: Maybe String,
+ hiDir :: Maybe String,
+ hieDir :: Maybe String,
+ stubDir :: Maybe String,
+ dumpDir :: Maybe String,
+
+ objectSuf_ :: String,
+ hcSuf :: String,
+ hiSuf_ :: String,
+ hieSuf :: String,
+
+ dynObjectSuf_ :: String,
+ dynHiSuf_ :: String,
+
+ outputFile_ :: Maybe String,
+ dynOutputFile_ :: Maybe String,
+ outputHi :: Maybe String,
+ dynOutputHi :: Maybe String,
+ dynLibLoader :: DynLibLoader,
+
+ 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.
+ dumpPrefix :: FilePath,
+
+ -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix'
+ -- or 'ghc.GHCi.UI.runStmt'.
+ -- Set by @-ddump-file-prefix@
+ dumpPrefixForce :: Maybe FilePath,
+
+ ldInputs :: [Option],
+
+ includePaths :: IncludeSpecs,
+ libraryPaths :: [String],
+ frameworkPaths :: [String], -- used on darwin only
+ cmdlineFrameworks :: [String], -- ditto
+
+ rtsOpts :: Maybe String,
+ rtsOptsEnabled :: RtsOptsEnabled,
+ rtsOptsSuggestions :: Bool,
+
+ hpcDir :: String, -- ^ Path to store the .mix files
+
+ -- Plugins
+ pluginModNames :: [ModuleName],
+ -- ^ the @-fplugin@ flags given on the command line, in *reverse*
+ -- order that they're specified on the command line.
+ pluginModNameOpts :: [(ModuleName,String)],
+ frontendPluginOpts :: [String],
+ -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*
+ -- order that they're specified on the command line.
+
+ externalPluginSpecs :: [ExternalPluginSpec],
+ -- ^ External plugins loaded from shared libraries
+
+ -- For ghc -M
+ depMakefile :: FilePath,
+ depIncludePkgDeps :: Bool,
+ depIncludeCppDeps :: Bool,
+ depExcludeMods :: [ModuleName],
+ depSuffixes :: [String],
+
+ -- Package flags
+ 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'.
+
+ ignorePackageFlags :: [IgnorePackageFlag],
+ -- ^ The @-ignore-package@ flags from the command line.
+ -- In *reverse* order that they're specified on the command line.
+ packageFlags :: [PackageFlag],
+ -- ^ The @-package@ and @-hide-package@ flags from the command-line.
+ -- In *reverse* order that they're specified on the command line.
+ pluginPackageFlags :: [PackageFlag],
+ -- ^ The @-plugin-package-id@ flags from command line.
+ -- In *reverse* order that they're specified on the command line.
+ trustFlags :: [TrustFlag],
+ -- ^ The @-trust@ and @-distrust@ flags.
+ -- In *reverse* order that they're specified on the command line.
+ packageEnv :: Maybe FilePath,
+ -- ^ Filepath to the package environment file (if overriding default)
+
+
+ -- hsc dynamic flags
+ dumpFlags :: EnumSet DumpFlag,
+ generalFlags :: EnumSet GeneralFlag,
+ warningFlags :: EnumSet WarningFlag,
+ fatalWarningFlags :: EnumSet WarningFlag,
+ customWarningCategories :: WarningCategorySet, -- See Note [Warning categories]
+ fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings
+ -- Don't change this without updating extensionFlags:
+ language :: Maybe Language,
+ -- | Safe Haskell mode
+ safeHaskell :: SafeHaskellMode,
+ safeInfer :: 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.
+ thOnLoc :: SrcSpan,
+ newDerivOnLoc :: SrcSpan,
+ deriveViaOnLoc :: SrcSpan,
+ overlapInstLoc :: SrcSpan,
+ incoherentOnLoc :: SrcSpan,
+ pkgTrustOnLoc :: SrcSpan,
+ warnSafeOnLoc :: SrcSpan,
+ warnUnsafeOnLoc :: 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.
+ 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
+ extensionFlags :: EnumSet LangExt.Extension,
+
+ -- | Unfolding control
+ -- See Note [Discounts and thresholds] in GHC.Core.Unfold
+ unfoldingOpts :: !UnfoldingOpts,
+
+ maxWorkerArgs :: Int,
+
+ ghciHistSize :: Int,
+
+ flushOut :: FlushOut,
+
+ ghcVersionFile :: Maybe FilePath,
+ haddockOptions :: Maybe String,
+
+ -- | GHCi scripts specified by -ghci-script, in reverse order
+ ghciScripts :: [String],
+
+ -- Output style options
+ pprUserLength :: Int,
+ pprCols :: Int,
+
+ useUnicode :: Bool,
+ useColor :: OverridingBool,
+ canUseColor :: Bool,
+ colScheme :: Col.Scheme,
+
+ -- | what kind of {-# SCC #-} to add automatically
+ profAuto :: ProfAuto,
+ callerCcFilters :: [CallerCcFilter],
+
+ interactivePrint :: Maybe String,
+
+ -- | Machine dependent flags (-m\<blah> stuff)
+ sseVersion :: Maybe SseVersion,
+ bmiVersion :: Maybe BmiVersion,
+ avx :: Bool,
+ avx2 :: Bool,
+ avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions.
+ avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.
+ avx512f :: Bool, -- Enable AVX-512 instructions.
+ avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions.
+ fma :: Bool, -- ^ Enable FMA instructions.
+
+ -- | Run-time linker information (what options we need, etc.)
+ rtldInfo :: IORef (Maybe LinkerInfo),
+
+ -- | Run-time C compiler information
+ rtccInfo :: IORef (Maybe CompilerInfo),
+
+ -- | Run-time assembler information
+ rtasmInfo :: IORef (Maybe CompilerInfo),
+
+ -- Constants used to control the amount of optimization done.
+
+ -- | Max size, in bytes, of inline array allocations.
+ maxInlineAllocSize :: Int,
+
+ -- | Only inline memcpy if it generates no more than this many
+ -- pseudo (roughly: Cmm) instructions.
+ maxInlineMemcpyInsns :: Int,
+
+ -- | Only inline memset if it generates no more than this many
+ -- pseudo (roughly: Cmm) instructions.
+ maxInlineMemsetInsns :: Int,
+
+ -- | Reverse the order of error messages in GHC/GHCi
+ reverseErrors :: Bool,
+
+ -- | Limit the maximum number of errors to show
+ maxErrors :: Maybe Int,
+
+ -- | Unique supply configuration for testing build determinism
+ initialUnique :: Word,
+ uniqueIncrement :: Int,
+ -- 'Int' because it can be used to test uniques in decreasing order.
+
+ -- | Temporary: CFG Edge weights for fast iterations
+ 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 = lift getDynFlags
+
+instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where
+ getDynFlags = lift getDynFlags
+
+instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where
+ getDynFlags = lift getDynFlags
+
+instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
+ getDynFlags = lift getDynFlags
+
+class ContainsDynFlags t where
+ extractDynFlags :: t -> DynFlags
+
+-----------------------------------------------------------------------------
+
+-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
+initDynFlags :: DynFlags -> IO DynFlags
+initDynFlags dflags = do
+ let
+ refRtldInfo <- newIORef Nothing
+ refRtccInfo <- newIORef Nothing
+ refRtasmInfo <- newIORef Nothing
+ canUseUnicode <- do let enc = localeEncoding
+ str = "‘’"
+ (withCString enc str $ \cstr ->
+ do str' <- peekCString enc cstr
+ return (str == str'))
+ `catchIOError` \_ -> return False
+ ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
+ let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
+ maybeGhcColorsEnv <- lookupEnv "GHC_COLORS"
+ maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
+ let adjustCols (Just env) = Col.parseScheme env
+ adjustCols Nothing = id
+ let (useColor', colScheme') =
+ (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)
+ (useColor dflags, colScheme dflags)
+ tmp_dir <- normalise <$> getTemporaryDirectory
+ return 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 mySettings =
+-- See Note [Updating flag description in the User's Guide]
+ DynFlags {
+ ghcMode = CompManager,
+ ghcLink = LinkBinary,
+ backend = platformDefaultBackend (sTargetPlatform mySettings),
+ verbosity = 0,
+ debugLevel = 0,
+ simplPhases = 2,
+ maxSimplIterations = 4,
+ ruleCheck = Nothing,
+ binBlobThreshold = Just 500000, -- 500K is a good default (see #16190)
+ maxRelevantBinds = Just 6,
+ maxValidHoleFits = Just 6,
+ maxRefHoleFits = Just 6,
+ refLevelHoleFits = Nothing,
+ maxUncoveredPatterns = 4,
+ maxPmCheckModels = 30,
+ simplTickFactor = 100,
+ dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple
+ specConstrThreshold = Just 2000,
+ specConstrCount = Just 3,
+ specConstrRecursive = 3,
+ liberateCaseThreshold = Just 2000,
+ floatLamArgs = Just 0, -- Default: float only if no fvs
+ liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64
+ liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64
+ liftLamsKnown = False, -- Default: don't turn known calls into unknown ones
+ cmmProcAlignment = Nothing,
+
+ historySize = 20,
+ strictnessBefore = [],
+
+ parMakeCount = Nothing,
+
+ enableTimeStats = False,
+ ghcHeapSize = Nothing,
+
+ importPaths = ["."],
+ mainModuleNameIs = mAIN_NAME,
+ mainFunIs = Nothing,
+ reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
+ solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
+ givensFuel = mAX_GIVENS_FUEL,
+ wantedsFuel = mAX_WANTEDS_FUEL,
+ qcsFuel = mAX_QC_FUEL,
+
+ homeUnitId_ = mainUnitId,
+ homeUnitInstanceOf_ = Nothing,
+ homeUnitInstantiations_ = [],
+
+ workingDirectory = Nothing,
+ thisPackageName = Nothing,
+ hiddenModules = Set.empty,
+ reexportedModules = Set.empty,
+
+ objectDir = Nothing,
+ dylibInstallName = Nothing,
+ hiDir = Nothing,
+ hieDir = Nothing,
+ stubDir = Nothing,
+ dumpDir = Nothing,
+
+ objectSuf_ = phaseInputExt StopLn,
+ hcSuf = phaseInputExt HCc,
+ hiSuf_ = "hi",
+ hieSuf = "hie",
+
+ dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn,
+ dynHiSuf_ = "dyn_hi",
+ dynamicNow = False,
+
+ pluginModNames = [],
+ pluginModNameOpts = [],
+ frontendPluginOpts = [],
+
+ externalPluginSpecs = [],
+
+ outputFile_ = Nothing,
+ dynOutputFile_ = Nothing,
+ outputHi = Nothing,
+ dynOutputHi = Nothing,
+ dynLibLoader = SystemDependent,
+ dumpPrefix = "non-module.",
+ dumpPrefixForce = Nothing,
+ ldInputs = [],
+ includePaths = IncludeSpecs [] [] [],
+ libraryPaths = [],
+ frameworkPaths = [],
+ cmdlineFrameworks = [],
+ rtsOpts = Nothing,
+ rtsOptsEnabled = RtsOptsSafeOnly,
+ rtsOptsSuggestions = True,
+
+ hpcDir = ".hpc",
+
+ packageDBFlags = [],
+ packageFlags = [],
+ pluginPackageFlags = [],
+ ignorePackageFlags = [],
+ trustFlags = [],
+ packageEnv = Nothing,
+ targetWays_ = Set.empty,
+ splitInfo = Nothing,
+
+ ghcNameVersion = sGhcNameVersion mySettings,
+ fileSettings = sFileSettings mySettings,
+ toolSettings = sToolSettings mySettings,
+ targetPlatform = sTargetPlatform mySettings,
+ platformMisc = sPlatformMisc mySettings,
+ rawSettings = sRawSettings mySettings,
+
+ tmpDir = panic "defaultDynFlags: uninitialized tmpDir",
+
+ llvmOptLevel = 0,
+
+ -- ghc -M values
+ depMakefile = "Makefile",
+ depIncludePkgDeps = False,
+ depIncludeCppDeps = False,
+ depExcludeMods = [],
+ depSuffixes = [],
+ -- end of ghc -M values
+ ghcVersionFile = Nothing,
+ haddockOptions = Nothing,
+ dumpFlags = EnumSet.empty,
+ generalFlags = EnumSet.fromList (defaultFlags mySettings),
+ warningFlags = EnumSet.fromList standardWarnings,
+ fatalWarningFlags = EnumSet.empty,
+ customWarningCategories = completeWarningCategorySet,
+ fatalCustomWarningCategories = emptyWarningCategorySet,
+ ghciScripts = [],
+ language = Nothing,
+ safeHaskell = Sf_None,
+ safeInfer = True,
+ safeInferred = True,
+ thOnLoc = noSrcSpan,
+ newDerivOnLoc = noSrcSpan,
+ deriveViaOnLoc = noSrcSpan,
+ overlapInstLoc = noSrcSpan,
+ incoherentOnLoc = noSrcSpan,
+ pkgTrustOnLoc = noSrcSpan,
+ warnSafeOnLoc = noSrcSpan,
+ warnUnsafeOnLoc = noSrcSpan,
+ trustworthyOnLoc = noSrcSpan,
+ extensions = [],
+ extensionFlags = flattenExtensionFlags Nothing [],
+
+ unfoldingOpts = defaultUnfoldingOpts,
+ maxWorkerArgs = 10,
+
+ ghciHistSize = 50, -- keep a log of length 50 by default
+
+ flushOut = defaultFlushOut,
+ pprUserLength = 5,
+ pprCols = 100,
+ useUnicode = False,
+ useColor = Auto,
+ canUseColor = False,
+ colScheme = Col.defaultScheme,
+ profAuto = NoProfAuto,
+ callerCcFilters = [],
+ interactivePrint = Nothing,
+ sseVersion = Nothing,
+ bmiVersion = Nothing,
+ avx = False,
+ avx2 = False,
+ avx512cd = False,
+ avx512er = False,
+ avx512f = False,
+ avx512pf = False,
+ fma = False,
+ rtldInfo = panic "defaultDynFlags: no rtldInfo",
+ rtccInfo = panic "defaultDynFlags: no rtccInfo",
+ rtasmInfo = panic "defaultDynFlags: no rtasmInfo",
+
+ maxInlineAllocSize = 128,
+ maxInlineMemcpyInsns = 32,
+ maxInlineMemsetInsns = 32,
+
+ initialUnique = 0,
+ uniqueIncrement = 1,
+
+ reverseErrors = False,
+ maxErrors = Nothing,
+ cfgWeights = defaultWeights
+ }
+
+type FatalMessager = String -> IO ()
+
+defaultFatalMessager :: FatalMessager
+defaultFatalMessager = hPutStrLn stderr
+
+
+newtype FlushOut = FlushOut (IO ())
+
+defaultFlushOut :: FlushOut
+defaultFlushOut = FlushOut $ hFlush stdout
+
+
+
+data OnOff a = On a
+ | Off a
+ deriving (Eq, Show)
+
+instance Outputable a => Outputable (OnOff a) where
+ ppr (On x) = text "On" <+> ppr x
+ ppr (Off x) = text "Off" <+> ppr 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 ml = foldr g defaultExtensionFlags
+ where g (On f) flags = EnumSet.insert f flags
+ g (Off f) flags = EnumSet.delete f flags
+ defaultExtensionFlags = EnumSet.fromList (languageExtensions 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 Eq
+
+-- CompilerInfo tells us which C compiler we're using
+data CompilerInfo
+ = GCC
+ | Clang
+ | AppleClang
+ | AppleClang51
+ | Emscripten
+ | UnknownCC
+ deriving 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 Eq
+
+instance Outputable GhcMode where
+ ppr CompManager = text "CompManager"
+ ppr OneShot = text "OneShot"
+ ppr MkDepend = text "MkDepend"
+
+isOneShot :: GhcMode -> Bool
+isOneShot OneShot = True
+isOneShot _other = 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 (Eq, Show)
+
+isNoLink :: GhcLink -> Bool
+isNoLink NoLink = True
+isNoLink _ = 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 (Eq, Show)
+
+instance Outputable PackageArg where
+ ppr (PackageArg pn) = text "package" <+> text pn
+ ppr (UnitIdArg uid) = text "unit" <+> ppr 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 {
+ modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
+ modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
+ -- under name @n@.
+ } deriving (Eq)
+instance Outputable ModRenaming where
+ ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
+
+-- | Flags for manipulating the set of non-broken packages.
+newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@
+ deriving (Eq)
+
+-- | Flags for manipulating package trust.
+data TrustFlag
+ = TrustPackage String -- ^ @-trust@
+ | DistrustPackage String -- ^ @-distrust@
+ deriving (Eq)
+
+-- | Flags for manipulating packages visibility.
+data PackageFlag
+ = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@
+ | HidePackage String -- ^ @-hide-package@
+ deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
+
+data PackageDBFlag
+ = PackageDB PkgDbRef
+ | NoUserPackageDB
+ | NoGlobalPackageDB
+ | ClearPackageDBs
+ deriving (Eq)
+
+packageFlagsChanged :: DynFlags -> DynFlags -> Bool
+packageFlagsChanged idflags1 idflags0 =
+ packageFlags idflags1 /= packageFlags idflags0 ||
+ ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||
+ pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||
+ trustFlags idflags1 /= trustFlags idflags0 ||
+ packageDBFlags idflags1 /= packageDBFlags idflags0 ||
+ packageGFlags idflags1 /= packageGFlags idflags0
+ where
+ packageGFlags dflags = map (`gopt` dflags)
+ [ Opt_HideAllPackages
+ , Opt_HideAllPluginPackages
+ , Opt_AutoLinkPackages ]
+
+instance Outputable PackageFlag where
+ ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
+ ppr (HidePackage str) = text "-hide-package" <+> text str
+
+data DynLibLoader
+ = Deployable
+ | SystemDependent
+ deriving Eq
+
+data RtsOptsEnabled
+ = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
+ | RtsOptsAll
+ deriving (Show)
+
+-- | Are we building with @-fPIE@ or @-fPIC@ enabled?
+positionIndependent :: DynFlags -> Bool
+positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE 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 (Eq,Show,Ord)
+
+dynamicTooState :: DynFlags -> DynamicTooState
+dynamicTooState dflags
+ | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont
+ | dynamicNow dflags = DT_Dyn
+ | otherwise = DT_OK
+
+setDynamicNow :: DynFlags -> DynFlags
+setDynamicNow dflags0 =
+ dflags0
+ { dynamicNow = True
+ }
+
+data PkgDbRef
+ = GlobalPkgDb
+ | UserPkgDb
+ | PkgDbPath FilePath
+ deriving 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 { includePathsQuote :: [String]
+ , includePathsGlobal :: [String]
+ -- | See Note [Implicit include paths]
+ , includePathsQuoteImplicit :: [String]
+ }
+ deriving 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 spec paths = let f = includePathsGlobal spec
+ in 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 spec paths = let f = includePathsQuote spec
+ in 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 spec paths = let f = includePathsQuoteImplicit spec
+ in 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 specs =
+ includePathsQuote specs ++
+ includePathsQuoteImplicit specs ++
+ includePathsGlobal 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 = dopt Opt_D_ppr_debug
+
+hasNoDebugOutput :: DynFlags -> Bool
+hasNoDebugOutput = dopt Opt_D_no_debug_output
+
+hasNoStateHack :: DynFlags -> Bool
+hasNoStateHack = gopt Opt_G_NoStateHack
+
+hasNoOptCoercion :: DynFlags -> Bool
+hasNoOptCoercion = gopt Opt_G_NoOptCoercion
+
+-- | Test whether a 'DumpFlag' is set
+dopt :: DumpFlag -> DynFlags -> Bool
+dopt = getDumpFlagFrom verbosity dumpFlags
+
+-- | Set a 'DumpFlag'
+dopt_set :: DynFlags -> DumpFlag -> DynFlags
+dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }
+
+-- | Unset a 'DumpFlag'
+dopt_unset :: DynFlags -> DumpFlag -> DynFlags
+dopt_unset dfs f = 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 Opt_PIC dflags
+ | dynamicNow dflags = True
+gopt Opt_ExternalDynamicRefs dflags
+ | dynamicNow dflags = True
+gopt Opt_SplitSections dflags
+ | dynamicNow dflags = False
+gopt f dflags = f `EnumSet.member` generalFlags dflags
+
+-- | Set a 'GeneralFlag'
+gopt_set :: DynFlags -> GeneralFlag -> DynFlags
+gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }
+
+-- | Unset a 'GeneralFlag'
+gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
+gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }
+
+-- | Test whether a 'WarningFlag' is set
+wopt :: WarningFlag -> DynFlags -> Bool
+wopt f dflags = f `EnumSet.member` warningFlags dflags
+
+-- | Set a 'WarningFlag'
+wopt_set :: DynFlags -> WarningFlag -> DynFlags
+wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }
+
+-- | Unset a 'WarningFlag'
+wopt_unset :: DynFlags -> WarningFlag -> DynFlags
+wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }
+
+-- | Test whether a 'WarningFlag' is set as fatal
+wopt_fatal :: WarningFlag -> DynFlags -> Bool
+wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags
+
+-- | Mark a 'WarningFlag' as fatal (do not set the flag)
+wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
+wopt_set_fatal dfs f
+ = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }
+
+-- | Mark a 'WarningFlag' as not fatal
+wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
+wopt_unset_fatal dfs f
+ = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
+
+
+-- | Enable all custom warning categories.
+wopt_set_all_custom :: DynFlags -> DynFlags
+wopt_set_all_custom dfs
+ = dfs{ customWarningCategories = completeWarningCategorySet }
+
+-- | Disable all custom warning categories.
+wopt_unset_all_custom :: DynFlags -> DynFlags
+wopt_unset_all_custom dfs
+ = 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 dfs
+ = dfs { fatalCustomWarningCategories = completeWarningCategorySet }
+
+-- | Mark all custom warning categories as non-fatal.
+wopt_unset_all_fatal_custom :: DynFlags -> DynFlags
+wopt_unset_all_fatal_custom dfs
+ = dfs { fatalCustomWarningCategories = emptyWarningCategorySet }
+
+-- | Set a custom 'WarningCategory'
+wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags
+wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) }
+
+-- | Unset a custom 'WarningCategory'
+wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags
+wopt_unset_custom dfs f = 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 dfs f
+ = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) }
+
+-- | Mark a custom 'WarningCategory' as not fatal
+wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
+wopt_unset_fatal_custom dfs f
+ = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) }
+
+-- | Are there any custom warning categories enabled?
+wopt_any_custom :: DynFlags -> Bool
+wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs))
+
+
+-- | Test whether a 'LangExt.Extension' is set
+xopt :: LangExt.Extension -> DynFlags -> Bool
+xopt f dflags = f `EnumSet.member` extensionFlags dflags
+
+-- | Set a 'LangExt.Extension'
+xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
+xopt_set dfs f
+ = let onoffs = On f : extensions dfs
+ in dfs { extensions = onoffs,
+ extensionFlags = flattenExtensionFlags (language dfs) onoffs }
+
+-- | Unset a 'LangExt.Extension'
+xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags
+xopt_unset dfs f
+ = let onoffs = Off f : extensions dfs
+ in 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 ext setUnset dflags =
+ let referedExts = stripOnOff <$> extensions dflags
+ stripOnOff (On x) = x
+ stripOnOff (Off x) = x
+ in
+ if ext `elem` referedExts then dflags else setUnset dflags ext
+
+xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields
+xopt_DuplicateRecordFields dfs
+ | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields
+ | otherwise = FieldLabel.NoDuplicateRecordFields
+
+xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors
+xopt_FieldSelectors dfs
+ | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors
+ | otherwise = FieldLabel.NoFieldSelectors
+
+lang_set :: DynFlags -> Maybe Language -> DynFlags
+lang_set dflags lang =
+ dflags {
+ language = lang,
+ extensionFlags = flattenExtensionFlags lang (extensions dflags)
+ }
+
+defaultFlags :: Settings -> [GeneralFlag]
+defaultFlags settings
+-- See Note [Updating flag description in the User's Guide]
+ = [ Opt_AutoLinkPackages,
+ Opt_DiagnosticsShowCaret,
+ Opt_EmbedManifest,
+ Opt_FamAppCache,
+ Opt_GenManifest,
+ Opt_GhciHistory,
+ Opt_GhciSandbox,
+ Opt_HelpfulErrors,
+ Opt_KeepHiFiles,
+ Opt_KeepOFiles,
+ Opt_OmitYields,
+ Opt_PrintBindContents,
+ Opt_ProfCountEntries,
+ Opt_SharedImplib,
+ Opt_SimplPreInlining,
+ Opt_VersionMacros,
+ Opt_RPath,
+ Opt_DumpWithWays,
+ Opt_CompactUnwind,
+ Opt_ShowErrorContext,
+ Opt_SuppressStgReps,
+ Opt_UnoptimizedCoreForInterpreter
+ ]
+
+ ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+ -- The default -O0 options
+
+ -- Default floating flags (see Note [RHS Floating])
+ ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ]
+
+
+ ++ default_PIC platform
+
+ ++ validHoleFitDefaults
+
+
+ where platform = sTargetPlatform 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
+ = [ Opt_ShowTypeAppOfHoleFits
+ , Opt_ShowTypeOfHoleFits
+ , Opt_ShowProvOfHoleFits
+ , Opt_ShowMatchesOfHoleFits
+ , Opt_ShowValidHoleFits
+ , Opt_SortValidHoleFits
+ , Opt_SortBySizeHoleFits
+ , 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 -- see Note [Documenting optimisation flags]
+ = [ ([0,1,2], Opt_DoLambdaEtaExpansion)
+ , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0]
+ , ([0,1,2], Opt_LlvmTBAA)
+ , ([0,1,2], Opt_ProfManualCcs )
+ , ([2], Opt_DictsStrict)
+
+ , ([0], Opt_IgnoreInterfacePragmas)
+ , ([0], Opt_OmitInterfacePragmas)
+
+ , ([1,2], Opt_CoreConstantFolding)
+
+ , ([1,2], Opt_CallArity)
+ , ([1,2], Opt_Exitification)
+ , ([1,2], Opt_CaseMerge)
+ , ([1,2], Opt_CaseFolding)
+ , ([1,2], Opt_CmmElimCommonBlocks)
+ , ([2], Opt_AsmShortcutting)
+ , ([1,2], Opt_CmmSink)
+ , ([1,2], Opt_CmmStaticPred)
+ , ([1,2], Opt_CSE)
+ , ([1,2], Opt_StgCSE)
+ , ([2], Opt_StgLiftLams)
+ , ([1,2], Opt_CmmControlFlow)
+
+ , ([1,2], 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.
+
+ , ([1,2], Opt_FloatIn)
+ , ([1,2], Opt_FullLaziness)
+ , ([1,2], Opt_IgnoreAsserts)
+ , ([1,2], Opt_Loopification)
+ , ([1,2], Opt_CfgBlocklayout) -- Experimental
+
+ , ([1,2], Opt_Specialise)
+ , ([1,2], Opt_CrossModuleSpecialise)
+ , ([1,2], Opt_InlineGenerics)
+ , ([1,2], Opt_Strictness)
+ , ([1,2], Opt_UnboxSmallStrictFields)
+ , ([1,2], Opt_CprAnal)
+ , ([1,2], Opt_WorkerWrapper)
+ , ([1,2], Opt_SolveConstantDicts)
+ , ([1,2], Opt_NumConstantFolding)
+
+ , ([2], Opt_LiberateCase)
+ , ([2], Opt_SpecConstr)
+ , ([2], 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 = True
+turnOff :: TurnOnFlag; turnOff = False
+
+default_PIC :: Platform -> [GeneralFlag]
+default_PIC platform =
+ case (platformOS platform, platformArch 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.
+ (OSDarwin, ArchX86_64) -> [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.
+ (OSDarwin, ArchAArch64) -> [Opt_PIC]
+ (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
+ (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs]
+ (OSOpenBSD, ArchX86_64) -> [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.
+ _ -> []
+
+-- | 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 Nothing = languageExtensions (Just GHC2021)
+
+languageExtensions (Just Haskell98)
+ = [LangExt.ImplicitPrelude,
+ -- See Note [When is StarIsType enabled]
+ LangExt.StarIsType,
+ LangExt.CUSKs,
+ LangExt.MonomorphismRestriction,
+ LangExt.NPlusKPatterns,
+ LangExt.DatatypeContexts,
+ LangExt.TraditionalRecordSyntax,
+ LangExt.FieldSelectors,
+ 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.
+ LangExt.DeepSubsumption
+ -- Non-standard but enabled for backwards compatability (see GHC proposal #511)
+ ]
+
+languageExtensions (Just Haskell2010)
+ = [LangExt.ImplicitPrelude,
+ -- See Note [When is StarIsType enabled]
+ LangExt.StarIsType,
+ LangExt.CUSKs,
+ LangExt.MonomorphismRestriction,
+ LangExt.DatatypeContexts,
+ LangExt.TraditionalRecordSyntax,
+ LangExt.EmptyDataDecls,
+ LangExt.ForeignFunctionInterface,
+ LangExt.PatternGuards,
+ LangExt.DoAndIfThenElse,
+ LangExt.FieldSelectors,
+ LangExt.RelaxedPolyRec,
+ LangExt.DeepSubsumption ]
+
+languageExtensions (Just GHC2021)
+ = [LangExt.ImplicitPrelude,
+ -- See Note [When is StarIsType enabled]
+ LangExt.StarIsType,
+ LangExt.MonomorphismRestriction,
+ LangExt.TraditionalRecordSyntax,
+ LangExt.EmptyDataDecls,
+ LangExt.ForeignFunctionInterface,
+ LangExt.PatternGuards,
+ LangExt.DoAndIfThenElse,
+ LangExt.FieldSelectors,
+ LangExt.RelaxedPolyRec,
+ -- Now the new extensions (not in Haskell2010)
+ LangExt.BangPatterns,
+ LangExt.BinaryLiterals,
+ LangExt.ConstrainedClassMethods,
+ LangExt.ConstraintKinds,
+ LangExt.DeriveDataTypeable,
+ LangExt.DeriveFoldable,
+ LangExt.DeriveFunctor,
+ LangExt.DeriveGeneric,
+ LangExt.DeriveLift,
+ LangExt.DeriveTraversable,
+ LangExt.EmptyCase,
+ LangExt.EmptyDataDeriving,
+ LangExt.ExistentialQuantification,
+ LangExt.ExplicitForAll,
+ LangExt.FlexibleContexts,
+ LangExt.FlexibleInstances,
+ LangExt.GADTSyntax,
+ LangExt.GeneralizedNewtypeDeriving,
+ LangExt.HexFloatLiterals,
+ LangExt.ImportQualifiedPost,
+ LangExt.InstanceSigs,
+ LangExt.KindSignatures,
+ LangExt.MultiParamTypeClasses,
+ LangExt.NamedFieldPuns,
+ LangExt.NamedWildCards,
+ LangExt.NumericUnderscores,
+ LangExt.PolyKinds,
+ LangExt.PostfixOperators,
+ LangExt.RankNTypes,
+ LangExt.ScopedTypeVariables,
+ LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables"
+ LangExt.StandaloneDeriving,
+ LangExt.StandaloneKindSignatures,
+ LangExt.TupleSections,
+ LangExt.TypeApplications,
+ LangExt.TypeOperators,
+ LangExt.TypeSynonymInstances]
+
+
+ways :: DynFlags -> Ways
+ways dflags
+ | dynamicNow dflags = addWay WayDyn (targetWays_ dflags)
+ | otherwise = targetWays_ dflags
+--
+-- System tool settings and locations
+
+programName :: DynFlags -> String
+programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags
+projectVersion :: DynFlags -> String
+projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags)
+ghcUsagePath :: DynFlags -> FilePath
+ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags
+ghciUsagePath :: DynFlags -> FilePath
+ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
+topDir :: DynFlags -> FilePath
+topDir dflags = fileSettings_topDir $ fileSettings dflags
+toolDir :: DynFlags -> Maybe FilePath
+toolDir dflags = fileSettings_toolDir $ fileSettings dflags
+extraGccViaCFlags :: DynFlags -> [String]
+extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
+globalPackageDatabasePath :: DynFlags -> FilePath
+globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings 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 appname 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.
+ msum $ map (checkIfExists <=< fmap (</> versionedFilePath platform))
+ [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/
+ , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/
+ ]
+ where
+ checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case
+ True -> pure dir
+ False -> MaybeT (pure Nothing)
+
+versionedFilePath :: ArchOS -> FilePath
+versionedFilePath platform = uniqueSubdir platform
+
+-- SDoc
+-------------------------------------------
+
+-- | Initialize the pretty-printing options
+initSDocContext :: DynFlags -> PprStyle -> SDocContext
+initSDocContext dflags style = SDC
+ { sdocStyle = style
+ , sdocColScheme = colScheme dflags
+ , sdocLastColour = Col.colReset
+ , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags)
+ , sdocDefaultDepth = pprUserLength dflags
+ , sdocLineLength = pprCols dflags
+ , sdocCanUseUnicode = useUnicode dflags
+ , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags
+ , sdocPprDebug = dopt Opt_D_ppr_debug dflags
+ , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags
+ , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags
+ , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags
+ , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags
+ , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags
+ , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags
+ , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags
+ , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags
+ , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags
+ , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags
+ , sdocSuppressTicks = gopt Opt_SuppressTicks dflags
+ , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags
+ , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags
+ , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags
+ , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags
+ , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags
+ , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags
+ , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags
+ , sdocSuppressUniques = gopt Opt_SuppressUniques dflags
+ , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags
+ , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags
+ , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags
+ , sdocErrorSpans = gopt Opt_ErrorSpans dflags
+ , sdocStarIsType = xopt LangExt.StarIsType dflags
+ , sdocLinearTypes = xopt LangExt.LinearTypes dflags
+ , sdocListTuplePuns = True
+ , sdocPrintTypeAbbreviations = True
+ , sdocUnitIdForUser = ftext
+ }
+
+-- | Initialize the pretty-printing options using the default user style
+initDefaultSDocContext :: DynFlags -> SDocContext
+initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle
+
+initPromotionTickContext :: DynFlags -> PromotionTickContext
+initPromotionTickContext dflags =
+ PromTickCtx {
+ ptcListTuplePuns = True,
+ ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags
+ }
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index c9967c7120..7f239a8aa6 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -41,7 +41,7 @@ where
import GHC.Prelude
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Driver.Errors ( printOrThrowDiagnostics )
import GHC.Driver.Errors.Types ( GhcMessage )
import GHC.Driver.Config.Logger (initLogFlags)
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index 63a5eb86cb..97339e05dd 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -7,7 +7,7 @@ module GHC.Driver.Env.Types
import GHC.Driver.Errors.Types ( GhcMessage )
import {-# SOURCE #-} GHC.Driver.Hooks
-import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags )
+import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags )
import GHC.Driver.LlvmConfigCache (LlvmConfigCache)
import GHC.Prelude
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index a89e7992b1..a7a3135b13 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -13,7 +13,7 @@ import GHC.Prelude
import GHC.Driver.Errors.Types
import GHC.Driver.Flags
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.HsToCore.Errors.Ppr ()
import GHC.Parser.Errors.Ppr ()
import GHC.Types.Error
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index cbf0622025..2e116bd8b6 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -24,7 +24,7 @@ import GHC.Prelude
import Data.Bifunctor
import Data.Typeable
-import GHC.Driver.Session (DynFlags, PackageArg, gopt)
+import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt)
import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage))
import GHC.Types.Error
import GHC.Unit.Module
@@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage
checkBuildingCabalPackage dflags =
if gopt Opt_BuildingCabalPackage dflags
then YesBuildingCabalPackage
- else NoBuildingCabalPackage \ No newline at end of file
+ else NoBuildingCabalPackage
diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs
index 7608890ce7..08aa2a1299 100644
--- a/compiler/GHC/Driver/Hooks.hs
+++ b/compiler/GHC/Driver/Hooks.hs
@@ -32,7 +32,7 @@ where
import GHC.Prelude
import GHC.Driver.Env
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Driver.Pipeline.Phases
import GHC.Hs.Decls
diff --git a/compiler/GHC/Driver/Ppr.hs b/compiler/GHC/Driver/Ppr.hs
index 291be49065..a169c2d7a1 100644
--- a/compiler/GHC/Driver/Ppr.hs
+++ b/compiler/GHC/Driver/Ppr.hs
@@ -11,7 +11,7 @@ where
import GHC.Prelude
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Unit.State
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 84962f7868..d7fd2f3249 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -230,53 +230,40 @@ import GHC.Platform
import GHC.Platform.Ways
import GHC.Platform.Profile
-import GHC.UniqueSubdir (uniqueSubdir)
import GHC.Unit.Types
import GHC.Unit.Parser
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
-import GHC.Builtin.Names ( mAIN_NAME )
-import GHC.Driver.Phases ( Phase(..), phaseInputExt )
+import GHC.Driver.DynFlags
import GHC.Driver.Flags
import GHC.Driver.Backend
import GHC.Driver.Plugins.External
import GHC.Settings.Config
-import GHC.Utils.CliOption
import GHC.Core.Unfold
import GHC.Driver.CmdLine
-import GHC.Settings.Constants
import GHC.Utils.Panic
-import qualified GHC.Utils.Ppr.Colour as Col
import GHC.Utils.Misc
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.GlobalVars
import GHC.Data.Maybe
import GHC.Data.Bool
import GHC.Utils.Monad
-import GHC.Types.Error (DiagnosticReason(..))
import GHC.Types.SrcLoc
import GHC.Types.SafeHaskell
-import GHC.Types.Basic ( IntWithInf, treatZeroAsInf )
-import GHC.Types.ProfAuto
-import qualified GHC.Types.FieldLabel as FieldLabel
+import GHC.Types.Basic ( treatZeroAsInf )
import GHC.Data.FastString
import GHC.Utils.TmpFs
import GHC.Utils.Fingerprint
import GHC.Utils.Outputable
import GHC.Settings
import GHC.CmmToAsm.CFG.Weight
-import {-# SOURCE #-} GHC.Core.Opt.CallerCC
+import GHC.Core.Opt.CallerCC
-import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
import Data.IORef
import Control.Arrow ((&&&))
import Control.Monad
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Writer
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Except
import Control.Monad.Trans.State as State
import Data.Functor.Identity
@@ -287,17 +274,11 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.FilePath
-import System.Directory
-import System.Environment (lookupEnv)
-import System.IO
-import System.IO.Error
import Text.ParserCombinators.ReadP hiding (char)
import Text.ParserCombinators.ReadP as R
-import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
-import GHC.Foreign (withCString, peekCString)
import qualified GHC.LanguageExtensions as LangExt
-- Note [Updating flag description in the User's Guide]
@@ -376,387 +357,6 @@ import qualified GHC.LanguageExtensions as LangExt
-- -----------------------------------------------------------------------------
-- DynFlags
--- | 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 { includePathsQuote :: [String]
- , includePathsGlobal :: [String]
- -- | See Note [Implicit include paths]
- , includePathsQuoteImplicit :: [String]
- }
- deriving 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 spec paths = let f = includePathsGlobal spec
- in 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 spec paths = let f = includePathsQuote spec
- in 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 spec paths = let f = includePathsQuoteImplicit spec
- in 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 specs =
- includePathsQuote specs ++
- includePathsQuoteImplicit specs ++
- includePathsGlobal 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.
- -}
-
-
--- | 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 {
- ghcMode :: GhcMode,
- ghcLink :: GhcLink,
- 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
- ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion,
- fileSettings :: {-# UNPACK #-} !FileSettings,
- targetPlatform :: Platform, -- Filled in by SysTools
- toolSettings :: {-# UNPACK #-} !ToolSettings,
- platformMisc :: {-# UNPACK #-} !PlatformMisc,
- rawSettings :: [(String, String)],
- tmpDir :: TempDir,
-
- llvmOptLevel :: Int, -- ^ LLVM optimisation level
- verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
- debugLevel :: Int, -- ^ How much debug information to produce
- simplPhases :: Int, -- ^ Number of simplifier phases
- maxSimplIterations :: Int, -- ^ Max simplifier iterations
- ruleCheck :: Maybe String,
- strictnessBefore :: [Int], -- ^ Additional demand analysis
-
- parMakeCount :: Maybe ParMakeCount,
- -- ^ The number of modules to compile in parallel
- -- If unspecified, compile with a single job.
-
- enableTimeStats :: Bool, -- ^ Enable RTS timing statistics?
- ghcHeapSize :: Maybe Int, -- ^ The heap size to set.
-
- maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt
- -- to show in type error messages
- maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show
- -- in typed hole error messages
- maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole
- -- fits to show in typed hole error
- -- messages
- refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for
- -- refinement hole fits in typed hole
- -- error messages
- maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show
- -- in non-exhaustiveness warnings
- maxPmCheckModels :: Int, -- ^ Soft limit on the number of models
- -- the pattern match checker checks
- -- a pattern against. A safe guard
- -- against exponential blow-up.
- simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks
- dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an
- -- Unboxed demand on returned products with at most
- -- this number of fields
- specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
- specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
- specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types
- -- Not optional; otherwise ForceSpecConstr can diverge.
- 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'.
- liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase
- floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating
- -- See 'GHC.Core.Opt.Monad.FloatOutSwitches'
-
- liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a
- -- recursive function.
- liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a
- -- non-recursive function.
- liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call
- -- into an unknown call.
-
- cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default.
-
- historySize :: Int, -- ^ Simplification history size
-
- importPaths :: [FilePath],
- mainModuleNameIs :: ModuleName,
- mainFunIs :: Maybe String,
- reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth
- solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver
- -- Typically only 1 is needed
- givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens
- -- Should be < solverIterations
- -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
- wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds
- -- Should be < givensFuel
- -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
- qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints
- -- Should be < givensFuel
- -- See Note [Expanding Recursive Superclasses and ExpansionFuel]
- homeUnitId_ :: UnitId, -- ^ Target home unit-id
- homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate
- homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations
-
- -- Note [Filepaths and Multiple Home Units]
- workingDirectory :: Maybe FilePath,
- thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units
- hiddenModules :: Set.Set ModuleName,
- reexportedModules :: Set.Set ModuleName,
-
- -- ways
- targetWays_ :: Ways, -- ^ Target way flags from the command line
-
- -- For object splitting
- splitInfo :: Maybe (String,Int),
-
- -- paths etc.
- objectDir :: Maybe String,
- dylibInstallName :: Maybe String,
- hiDir :: Maybe String,
- hieDir :: Maybe String,
- stubDir :: Maybe String,
- dumpDir :: Maybe String,
-
- objectSuf_ :: String,
- hcSuf :: String,
- hiSuf_ :: String,
- hieSuf :: String,
-
- dynObjectSuf_ :: String,
- dynHiSuf_ :: String,
-
- outputFile_ :: Maybe String,
- dynOutputFile_ :: Maybe String,
- outputHi :: Maybe String,
- dynOutputHi :: Maybe String,
- dynLibLoader :: DynLibLoader,
-
- 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.
- dumpPrefix :: FilePath,
-
- -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix'
- -- or 'ghc.GHCi.UI.runStmt'.
- -- Set by @-ddump-file-prefix@
- dumpPrefixForce :: Maybe FilePath,
-
- ldInputs :: [Option],
-
- includePaths :: IncludeSpecs,
- libraryPaths :: [String],
- frameworkPaths :: [String], -- used on darwin only
- cmdlineFrameworks :: [String], -- ditto
-
- rtsOpts :: Maybe String,
- rtsOptsEnabled :: RtsOptsEnabled,
- rtsOptsSuggestions :: Bool,
-
- hpcDir :: String, -- ^ Path to store the .mix files
-
- -- Plugins
- pluginModNames :: [ModuleName],
- -- ^ the @-fplugin@ flags given on the command line, in *reverse*
- -- order that they're specified on the command line.
- pluginModNameOpts :: [(ModuleName,String)],
- frontendPluginOpts :: [String],
- -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*
- -- order that they're specified on the command line.
-
- externalPluginSpecs :: [ExternalPluginSpec],
- -- ^ External plugins loaded from shared libraries
-
- -- For ghc -M
- depMakefile :: FilePath,
- depIncludePkgDeps :: Bool,
- depIncludeCppDeps :: Bool,
- depExcludeMods :: [ModuleName],
- depSuffixes :: [String],
-
- -- Package flags
- 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'.
-
- ignorePackageFlags :: [IgnorePackageFlag],
- -- ^ The @-ignore-package@ flags from the command line.
- -- In *reverse* order that they're specified on the command line.
- packageFlags :: [PackageFlag],
- -- ^ The @-package@ and @-hide-package@ flags from the command-line.
- -- In *reverse* order that they're specified on the command line.
- pluginPackageFlags :: [PackageFlag],
- -- ^ The @-plugin-package-id@ flags from command line.
- -- In *reverse* order that they're specified on the command line.
- trustFlags :: [TrustFlag],
- -- ^ The @-trust@ and @-distrust@ flags.
- -- In *reverse* order that they're specified on the command line.
- packageEnv :: Maybe FilePath,
- -- ^ Filepath to the package environment file (if overriding default)
-
-
- -- hsc dynamic flags
- dumpFlags :: EnumSet DumpFlag,
- generalFlags :: EnumSet GeneralFlag,
- warningFlags :: EnumSet WarningFlag,
- fatalWarningFlags :: EnumSet WarningFlag,
- customWarningCategories :: WarningCategorySet, -- See Note [Warning categories]
- fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings
- -- Don't change this without updating extensionFlags:
- language :: Maybe Language,
- -- | Safe Haskell mode
- safeHaskell :: SafeHaskellMode,
- safeInfer :: 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.
- thOnLoc :: SrcSpan,
- newDerivOnLoc :: SrcSpan,
- deriveViaOnLoc :: SrcSpan,
- overlapInstLoc :: SrcSpan,
- incoherentOnLoc :: SrcSpan,
- pkgTrustOnLoc :: SrcSpan,
- warnSafeOnLoc :: SrcSpan,
- warnUnsafeOnLoc :: 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.
- 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
- extensionFlags :: EnumSet LangExt.Extension,
-
- -- | Unfolding control
- -- See Note [Discounts and thresholds] in GHC.Core.Unfold
- unfoldingOpts :: !UnfoldingOpts,
-
- maxWorkerArgs :: Int,
-
- ghciHistSize :: Int,
-
- flushOut :: FlushOut,
-
- ghcVersionFile :: Maybe FilePath,
- haddockOptions :: Maybe String,
-
- -- | GHCi scripts specified by -ghci-script, in reverse order
- ghciScripts :: [String],
-
- -- Output style options
- pprUserLength :: Int,
- pprCols :: Int,
-
- useUnicode :: Bool,
- useColor :: OverridingBool,
- canUseColor :: Bool,
- colScheme :: Col.Scheme,
-
- -- | what kind of {-# SCC #-} to add automatically
- profAuto :: ProfAuto,
- callerCcFilters :: [CallerCcFilter],
-
- interactivePrint :: Maybe String,
-
- -- | Machine dependent flags (-m\<blah> stuff)
- sseVersion :: Maybe SseVersion,
- bmiVersion :: Maybe BmiVersion,
- avx :: Bool,
- avx2 :: Bool,
- avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions.
- avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.
- avx512f :: Bool, -- Enable AVX-512 instructions.
- avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions.
- fma :: Bool, -- ^ Enable FMA instructions.
-
- -- | Run-time linker information (what options we need, etc.)
- rtldInfo :: IORef (Maybe LinkerInfo),
-
- -- | Run-time C compiler information
- rtccInfo :: IORef (Maybe CompilerInfo),
-
- -- | Run-time assembler information
- rtasmInfo :: IORef (Maybe CompilerInfo),
-
- -- Constants used to control the amount of optimization done.
-
- -- | Max size, in bytes, of inline array allocations.
- maxInlineAllocSize :: Int,
-
- -- | Only inline memcpy if it generates no more than this many
- -- pseudo (roughly: Cmm) instructions.
- maxInlineMemcpyInsns :: Int,
-
- -- | Only inline memset if it generates no more than this many
- -- pseudo (roughly: Cmm) instructions.
- maxInlineMemsetInsns :: Int,
-
- -- | Reverse the order of error messages in GHC/GHCi
- reverseErrors :: Bool,
-
- -- | Limit the maximum number of errors to show
- maxErrors :: Maybe Int,
-
- -- | Unique supply configuration for testing build determinism
- initialUnique :: Word,
- uniqueIncrement :: Int,
- -- 'Int' because it can be used to test uniques in decreasing order.
-
- -- | Temporary: CFG Edge weights for fast iterations
- cfgWeights :: Weights
-}
{- Note [RHS Floating]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -767,43 +367,6 @@ data DynFlags = DynFlags {
allows for experimentation.
-}
-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 = lift getDynFlags
-
-instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where
- getDynFlags = lift getDynFlags
-
-instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where
- getDynFlags = lift getDynFlags
-
-instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
- getDynFlags = lift getDynFlags
-
-class ContainsDynFlags t where
- extractDynFlags :: t -> DynFlags
-
--- | 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
-
-----------------------------------------------------------------------------
-- Accessors from 'DynFlags'
@@ -820,22 +383,6 @@ settings dflags = Settings
, sRawSettings = rawSettings dflags
}
-programName :: DynFlags -> String
-programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags
-projectVersion :: DynFlags -> String
-projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags)
-ghcUsagePath :: DynFlags -> FilePath
-ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags
-ghciUsagePath :: DynFlags -> FilePath
-ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
-toolDir :: DynFlags -> Maybe FilePath
-toolDir dflags = fileSettings_toolDir $ fileSettings dflags
-topDir :: DynFlags -> FilePath
-topDir dflags = fileSettings_topDir $ fileSettings dflags
-extraGccViaCFlags :: DynFlags -> [String]
-extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
-globalPackageDatabasePath :: DynFlags -> FilePath
-globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags
pgm_L :: DynFlags -> String
pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags
pgm_P :: DynFlags -> (String,[Option])
@@ -909,430 +456,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
opt_i :: DynFlags -> [String]
opt_i dflags= toolSettings_opt_i $ toolSettings 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 appname 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.
- msum $ map (checkIfExists <=< fmap (</> versionedFilePath platform))
- [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/
- , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/
- ]
- where
- checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case
- True -> pure dir
- False -> MaybeT (pure Nothing)
-
-versionedFilePath :: ArchOS -> FilePath
-versionedFilePath platform = uniqueSubdir platform
-
--- | 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 Eq
-
-instance Outputable GhcMode where
- ppr CompManager = text "CompManager"
- ppr OneShot = text "OneShot"
- ppr MkDepend = text "MkDepend"
-
-isOneShot :: GhcMode -> Bool
-isOneShot OneShot = True
-isOneShot _other = 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 (Eq, Show)
-
-isNoLink :: GhcLink -> Bool
-isNoLink NoLink = True
-isNoLink _ = 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 (Eq, Show)
-
-instance Outputable PackageArg where
- ppr (PackageArg pn) = text "package" <+> text pn
- ppr (UnitIdArg uid) = text "unit" <+> ppr 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 {
- modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
- modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
- -- under name @n@.
- } deriving (Eq)
-instance Outputable ModRenaming where
- ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
-
--- | Flags for manipulating the set of non-broken packages.
-newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@
- deriving (Eq)
-
--- | Flags for manipulating package trust.
-data TrustFlag
- = TrustPackage String -- ^ @-trust@
- | DistrustPackage String -- ^ @-distrust@
- deriving (Eq)
-
--- | Flags for manipulating packages visibility.
-data PackageFlag
- = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@
- | HidePackage String -- ^ @-hide-package@
- deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
-
-data PackageDBFlag
- = PackageDB PkgDbRef
- | NoUserPackageDB
- | NoGlobalPackageDB
- | ClearPackageDBs
- deriving (Eq)
-
-packageFlagsChanged :: DynFlags -> DynFlags -> Bool
-packageFlagsChanged idflags1 idflags0 =
- packageFlags idflags1 /= packageFlags idflags0 ||
- ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||
- pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||
- trustFlags idflags1 /= trustFlags idflags0 ||
- packageDBFlags idflags1 /= packageDBFlags idflags0 ||
- packageGFlags idflags1 /= packageGFlags idflags0
- where
- packageGFlags dflags = map (`gopt` dflags)
- [ Opt_HideAllPackages
- , Opt_HideAllPluginPackages
- , Opt_AutoLinkPackages ]
-
-instance Outputable PackageFlag where
- ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
- ppr (HidePackage str) = text "-hide-package" <+> text str
-
-data DynLibLoader
- = Deployable
- | SystemDependent
- deriving Eq
-
-data RtsOptsEnabled
- = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
- | RtsOptsAll
- deriving (Show)
-
--- | Are we building with @-fPIE@ or @-fPIC@ enabled?
-positionIndependent :: DynFlags -> Bool
-positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE 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 (Eq,Show,Ord)
-
-dynamicTooState :: DynFlags -> DynamicTooState
-dynamicTooState dflags
- | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont
- | dynamicNow dflags = DT_Dyn
- | otherwise = DT_OK
-
-setDynamicNow :: DynFlags -> DynFlags
-setDynamicNow dflags0 =
- dflags0
- { dynamicNow = True
- }
-
-----------------------------------------------------------------------------
--- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
-initDynFlags :: DynFlags -> IO DynFlags
-initDynFlags dflags = do
- let
- refRtldInfo <- newIORef Nothing
- refRtccInfo <- newIORef Nothing
- refRtasmInfo <- newIORef Nothing
- canUseUnicode <- do let enc = localeEncoding
- str = "‘’"
- (withCString enc str $ \cstr ->
- do str' <- peekCString enc cstr
- return (str == str'))
- `catchIOError` \_ -> return False
- ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
- let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
- maybeGhcColorsEnv <- lookupEnv "GHC_COLORS"
- maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
- let adjustCols (Just env) = Col.parseScheme env
- adjustCols Nothing = id
- let (useColor', colScheme') =
- (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)
- (useColor dflags, colScheme dflags)
- tmp_dir <- normalise <$> getTemporaryDirectory
- return 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 mySettings =
--- See Note [Updating flag description in the User's Guide]
- DynFlags {
- ghcMode = CompManager,
- ghcLink = LinkBinary,
- backend = platformDefaultBackend (sTargetPlatform mySettings),
- verbosity = 0,
- debugLevel = 0,
- simplPhases = 2,
- maxSimplIterations = 4,
- ruleCheck = Nothing,
- binBlobThreshold = Just 500000, -- 500K is a good default (see #16190)
- maxRelevantBinds = Just 6,
- maxValidHoleFits = Just 6,
- maxRefHoleFits = Just 6,
- refLevelHoleFits = Nothing,
- maxUncoveredPatterns = 4,
- maxPmCheckModels = 30,
- simplTickFactor = 100,
- dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple
- specConstrThreshold = Just 2000,
- specConstrCount = Just 3,
- specConstrRecursive = 3,
- liberateCaseThreshold = Just 2000,
- floatLamArgs = Just 0, -- Default: float only if no fvs
- liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64
- liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64
- liftLamsKnown = False, -- Default: don't turn known calls into unknown ones
- cmmProcAlignment = Nothing,
-
- historySize = 20,
- strictnessBefore = [],
-
- parMakeCount = Nothing,
-
- enableTimeStats = False,
- ghcHeapSize = Nothing,
-
- importPaths = ["."],
- mainModuleNameIs = mAIN_NAME,
- mainFunIs = Nothing,
- reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
- solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
- givensFuel = mAX_GIVENS_FUEL,
- wantedsFuel = mAX_WANTEDS_FUEL,
- qcsFuel = mAX_QC_FUEL,
-
- homeUnitId_ = mainUnitId,
- homeUnitInstanceOf_ = Nothing,
- homeUnitInstantiations_ = [],
-
- workingDirectory = Nothing,
- thisPackageName = Nothing,
- hiddenModules = Set.empty,
- reexportedModules = Set.empty,
-
- objectDir = Nothing,
- dylibInstallName = Nothing,
- hiDir = Nothing,
- hieDir = Nothing,
- stubDir = Nothing,
- dumpDir = Nothing,
-
- objectSuf_ = phaseInputExt StopLn,
- hcSuf = phaseInputExt HCc,
- hiSuf_ = "hi",
- hieSuf = "hie",
-
- dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn,
- dynHiSuf_ = "dyn_hi",
- dynamicNow = False,
-
- pluginModNames = [],
- pluginModNameOpts = [],
- frontendPluginOpts = [],
-
- externalPluginSpecs = [],
-
- outputFile_ = Nothing,
- dynOutputFile_ = Nothing,
- outputHi = Nothing,
- dynOutputHi = Nothing,
- dynLibLoader = SystemDependent,
- dumpPrefix = "non-module.",
- dumpPrefixForce = Nothing,
- ldInputs = [],
- includePaths = IncludeSpecs [] [] [],
- libraryPaths = [],
- frameworkPaths = [],
- cmdlineFrameworks = [],
- rtsOpts = Nothing,
- rtsOptsEnabled = RtsOptsSafeOnly,
- rtsOptsSuggestions = True,
-
- hpcDir = ".hpc",
-
- packageDBFlags = [],
- packageFlags = [],
- pluginPackageFlags = [],
- ignorePackageFlags = [],
- trustFlags = [],
- packageEnv = Nothing,
- targetWays_ = Set.empty,
- splitInfo = Nothing,
-
- ghcNameVersion = sGhcNameVersion mySettings,
- fileSettings = sFileSettings mySettings,
- toolSettings = sToolSettings mySettings,
- targetPlatform = sTargetPlatform mySettings,
- platformMisc = sPlatformMisc mySettings,
- rawSettings = sRawSettings mySettings,
-
- tmpDir = panic "defaultDynFlags: uninitialized tmpDir",
-
- llvmOptLevel = 0,
-
- -- ghc -M values
- depMakefile = "Makefile",
- depIncludePkgDeps = False,
- depIncludeCppDeps = False,
- depExcludeMods = [],
- depSuffixes = [],
- -- end of ghc -M values
- ghcVersionFile = Nothing,
- haddockOptions = Nothing,
- dumpFlags = EnumSet.empty,
- generalFlags = EnumSet.fromList (defaultFlags mySettings),
- warningFlags = EnumSet.fromList standardWarnings,
- fatalWarningFlags = EnumSet.empty,
- customWarningCategories = completeWarningCategorySet,
- fatalCustomWarningCategories = emptyWarningCategorySet,
- ghciScripts = [],
- language = Nothing,
- safeHaskell = Sf_None,
- safeInfer = True,
- safeInferred = True,
- thOnLoc = noSrcSpan,
- newDerivOnLoc = noSrcSpan,
- deriveViaOnLoc = noSrcSpan,
- overlapInstLoc = noSrcSpan,
- incoherentOnLoc = noSrcSpan,
- pkgTrustOnLoc = noSrcSpan,
- warnSafeOnLoc = noSrcSpan,
- warnUnsafeOnLoc = noSrcSpan,
- trustworthyOnLoc = noSrcSpan,
- extensions = [],
- extensionFlags = flattenExtensionFlags Nothing [],
-
- unfoldingOpts = defaultUnfoldingOpts,
- maxWorkerArgs = 10,
-
- ghciHistSize = 50, -- keep a log of length 50 by default
-
- flushOut = defaultFlushOut,
- pprUserLength = 5,
- pprCols = 100,
- useUnicode = False,
- useColor = Auto,
- canUseColor = False,
- colScheme = Col.defaultScheme,
- profAuto = NoProfAuto,
- callerCcFilters = [],
- interactivePrint = Nothing,
- sseVersion = Nothing,
- bmiVersion = Nothing,
- avx = False,
- avx2 = False,
- avx512cd = False,
- avx512er = False,
- avx512f = False,
- avx512pf = False,
- fma = False,
- rtldInfo = panic "defaultDynFlags: no rtldInfo",
- rtccInfo = panic "defaultDynFlags: no rtccInfo",
- rtasmInfo = panic "defaultDynFlags: no rtasmInfo",
-
- maxInlineAllocSize = 128,
- maxInlineMemcpyInsns = 32,
- maxInlineMemsetInsns = 32,
-
- initialUnique = 0,
- uniqueIncrement = 1,
-
- reverseErrors = False,
- maxErrors = Nothing,
- cfgWeights = defaultWeights
- }
-
-type FatalMessager = String -> IO ()
-
-defaultFatalMessager :: FatalMessager
-defaultFatalMessager = hPutStrLn stderr
-
-
-newtype FlushOut = FlushOut (IO ())
-
-defaultFlushOut :: FlushOut
-defaultFlushOut = FlushOut $ hFlush stdout
-
{-
Note [Verbosity levels]
~~~~~~~~~~~~~~~~~~~~~~~
@@ -1344,283 +469,6 @@ Note [Verbosity levels]
5 | "ghc -v -ddump-all"
-}
-data OnOff a = On a
- | Off a
- deriving (Eq, Show)
-
-instance Outputable a => Outputable (OnOff a) where
- ppr (On x) = text "On" <+> ppr x
- ppr (Off x) = text "Off" <+> ppr 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 ml = foldr f defaultExtensionFlags
- where f (On f) flags = EnumSet.insert f flags
- f (Off f) flags = EnumSet.delete f flags
- defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)
-
--- | 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 Nothing = languageExtensions (Just GHC2021)
-
-languageExtensions (Just Haskell98)
- = [LangExt.ImplicitPrelude,
- -- See Note [When is StarIsType enabled]
- LangExt.StarIsType,
- LangExt.CUSKs,
- LangExt.MonomorphismRestriction,
- LangExt.NPlusKPatterns,
- LangExt.DatatypeContexts,
- LangExt.TraditionalRecordSyntax,
- LangExt.FieldSelectors,
- 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.
- LangExt.DeepSubsumption
- -- Non-standard but enabled for backwards compatability (see GHC proposal #511)
- ]
-
-languageExtensions (Just Haskell2010)
- = [LangExt.ImplicitPrelude,
- -- See Note [When is StarIsType enabled]
- LangExt.StarIsType,
- LangExt.CUSKs,
- LangExt.MonomorphismRestriction,
- LangExt.DatatypeContexts,
- LangExt.TraditionalRecordSyntax,
- LangExt.EmptyDataDecls,
- LangExt.ForeignFunctionInterface,
- LangExt.PatternGuards,
- LangExt.DoAndIfThenElse,
- LangExt.FieldSelectors,
- LangExt.RelaxedPolyRec,
- LangExt.DeepSubsumption ]
-
-languageExtensions (Just GHC2021)
- = [LangExt.ImplicitPrelude,
- -- See Note [When is StarIsType enabled]
- LangExt.StarIsType,
- LangExt.MonomorphismRestriction,
- LangExt.TraditionalRecordSyntax,
- LangExt.EmptyDataDecls,
- LangExt.ForeignFunctionInterface,
- LangExt.PatternGuards,
- LangExt.DoAndIfThenElse,
- LangExt.FieldSelectors,
- LangExt.RelaxedPolyRec,
- -- Now the new extensions (not in Haskell2010)
- LangExt.BangPatterns,
- LangExt.BinaryLiterals,
- LangExt.ConstrainedClassMethods,
- LangExt.ConstraintKinds,
- LangExt.DeriveDataTypeable,
- LangExt.DeriveFoldable,
- LangExt.DeriveFunctor,
- LangExt.DeriveGeneric,
- LangExt.DeriveLift,
- LangExt.DeriveTraversable,
- LangExt.EmptyCase,
- LangExt.EmptyDataDeriving,
- LangExt.ExistentialQuantification,
- LangExt.ExplicitForAll,
- LangExt.FlexibleContexts,
- LangExt.FlexibleInstances,
- LangExt.GADTSyntax,
- LangExt.GeneralizedNewtypeDeriving,
- LangExt.HexFloatLiterals,
- LangExt.ImportQualifiedPost,
- LangExt.InstanceSigs,
- LangExt.KindSignatures,
- LangExt.MultiParamTypeClasses,
- LangExt.NamedFieldPuns,
- LangExt.NamedWildCards,
- LangExt.NumericUnderscores,
- LangExt.PolyKinds,
- LangExt.PostfixOperators,
- LangExt.RankNTypes,
- LangExt.ScopedTypeVariables,
- LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables"
- LangExt.StandaloneDeriving,
- LangExt.StandaloneKindSignatures,
- LangExt.TupleSections,
- LangExt.TypeApplications,
- LangExt.TypeOperators,
- LangExt.TypeSynonymInstances]
-
-hasPprDebug :: DynFlags -> Bool
-hasPprDebug = dopt Opt_D_ppr_debug
-
-hasNoDebugOutput :: DynFlags -> Bool
-hasNoDebugOutput = dopt Opt_D_no_debug_output
-
-hasNoStateHack :: DynFlags -> Bool
-hasNoStateHack = gopt Opt_G_NoStateHack
-
-hasNoOptCoercion :: DynFlags -> Bool
-hasNoOptCoercion = gopt Opt_G_NoOptCoercion
-
-
--- | Test whether a 'DumpFlag' is set
-dopt :: DumpFlag -> DynFlags -> Bool
-dopt = getDumpFlagFrom verbosity dumpFlags
-
--- | Set a 'DumpFlag'
-dopt_set :: DynFlags -> DumpFlag -> DynFlags
-dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }
-
--- | Unset a 'DumpFlag'
-dopt_unset :: DynFlags -> DumpFlag -> DynFlags
-dopt_unset dfs f = 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 Opt_PIC dflags
- | dynamicNow dflags = True
-gopt Opt_ExternalDynamicRefs dflags
- | dynamicNow dflags = True
-gopt Opt_SplitSections dflags
- | dynamicNow dflags = False
-gopt f dflags = f `EnumSet.member` generalFlags dflags
-
--- | Set a 'GeneralFlag'
-gopt_set :: DynFlags -> GeneralFlag -> DynFlags
-gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }
-
--- | Unset a 'GeneralFlag'
-gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
-gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }
-
--- | Test whether a 'WarningFlag' is set
-wopt :: WarningFlag -> DynFlags -> Bool
-wopt f dflags = f `EnumSet.member` warningFlags dflags
-
--- | Set a 'WarningFlag'
-wopt_set :: DynFlags -> WarningFlag -> DynFlags
-wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }
-
--- | Unset a 'WarningFlag'
-wopt_unset :: DynFlags -> WarningFlag -> DynFlags
-wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }
-
--- | Test whether a 'WarningFlag' is set as fatal
-wopt_fatal :: WarningFlag -> DynFlags -> Bool
-wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags
-
--- | Mark a 'WarningFlag' as fatal (do not set the flag)
-wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
-wopt_set_fatal dfs f
- = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }
-
--- | Mark a 'WarningFlag' as not fatal
-wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
-wopt_unset_fatal dfs f
- = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
-
-
--- | Enable all custom warning categories.
-wopt_set_all_custom :: DynFlags -> DynFlags
-wopt_set_all_custom dfs
- = dfs{ customWarningCategories = completeWarningCategorySet }
-
--- | Disable all custom warning categories.
-wopt_unset_all_custom :: DynFlags -> DynFlags
-wopt_unset_all_custom dfs
- = 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 dfs
- = dfs { fatalCustomWarningCategories = completeWarningCategorySet }
-
--- | Mark all custom warning categories as non-fatal.
-wopt_unset_all_fatal_custom :: DynFlags -> DynFlags
-wopt_unset_all_fatal_custom dfs
- = dfs { fatalCustomWarningCategories = emptyWarningCategorySet }
-
--- | Set a custom 'WarningCategory'
-wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags
-wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) }
-
--- | Unset a custom 'WarningCategory'
-wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags
-wopt_unset_custom dfs f = 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 dfs f
- = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) }
-
--- | Mark a custom 'WarningCategory' as not fatal
-wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags
-wopt_unset_fatal_custom dfs f
- = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) }
-
--- | Are there any custom warning categories enabled?
-wopt_any_custom :: DynFlags -> Bool
-wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs))
-
-
--- | Test whether a 'LangExt.Extension' is set
-xopt :: LangExt.Extension -> DynFlags -> Bool
-xopt f dflags = f `EnumSet.member` extensionFlags dflags
-
--- | Set a 'LangExt.Extension'
-xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
-xopt_set dfs f
- = let onoffs = On f : extensions dfs
- in dfs { extensions = onoffs,
- extensionFlags = flattenExtensionFlags (language dfs) onoffs }
-
--- | Unset a 'LangExt.Extension'
-xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags
-xopt_unset dfs f
- = let onoffs = Off f : extensions dfs
- in 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 ext setUnset dflags =
- let referedExts = stripOnOff <$> extensions dflags
- stripOnOff (On x) = x
- stripOnOff (Off x) = x
- in
- if ext `elem` referedExts then dflags else setUnset dflags ext
-
-xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields
-xopt_DuplicateRecordFields dfs
- | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields
- | otherwise = FieldLabel.NoDuplicateRecordFields
-
-xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors
-xopt_FieldSelectors dfs
- | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors
- | otherwise = FieldLabel.NoFieldSelectors
-
-lang_set :: DynFlags -> Maybe Language -> DynFlags
-lang_set dflags lang =
- dflags {
- language = lang,
- extensionFlags = flattenExtensionFlags lang (extensions dflags)
- }
-
-- | Set the Haskell language standard to use
setLanguage :: Language -> DynP ()
setLanguage l = upd (`lang_set` Just l)
@@ -3119,11 +1967,6 @@ flagsForCompletion isInteractive
modeFilter OnlyGhc = not isInteractive
modeFilter HiddenFlag = False
-type TurnOnFlag = Bool -- True <=> we are turning the flag on
- -- False <=> we are turning the flag off
-turnOn :: TurnOnFlag; turnOn = True
-turnOff :: TurnOnFlag; turnOff = False
-
data FlagSpec flag
= FlagSpec
{ flagSpecName :: String -- ^ Flag in string form
@@ -3874,62 +2717,6 @@ xFlagsDeps = [
flagSpec "ViewPatterns" LangExt.ViewPatterns
]
-defaultFlags :: Settings -> [GeneralFlag]
-defaultFlags settings
--- See Note [Updating flag description in the User's Guide]
- = [ Opt_AutoLinkPackages,
- Opt_DiagnosticsShowCaret,
- Opt_EmbedManifest,
- Opt_FamAppCache,
- Opt_GenManifest,
- Opt_GhciHistory,
- Opt_GhciSandbox,
- Opt_HelpfulErrors,
- Opt_KeepHiFiles,
- Opt_KeepOFiles,
- Opt_OmitYields,
- Opt_PrintBindContents,
- Opt_ProfCountEntries,
- Opt_SharedImplib,
- Opt_SimplPreInlining,
- Opt_VersionMacros,
- Opt_RPath,
- Opt_DumpWithWays,
- Opt_CompactUnwind,
- Opt_ShowErrorContext,
- Opt_SuppressStgReps,
- Opt_UnoptimizedCoreForInterpreter
- ]
-
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
-
- -- Default floating flags (see Note [RHS Floating])
- ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ]
-
-
- ++ default_PIC platform
-
- ++ validHoleFitDefaults
-
-
- where platform = sTargetPlatform 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
- = [ Opt_ShowTypeAppOfHoleFits
- , Opt_ShowTypeOfHoleFits
- , Opt_ShowProvOfHoleFits
- , Opt_ShowMatchesOfHoleFits
- , Opt_ShowValidHoleFits
- , Opt_SortValidHoleFits
- , Opt_SortBySizeHoleFits
- , Opt_ShowHoleConstraints ]
-
-
validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
validHoleFitsImpliedGFlags
= [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
@@ -3938,32 +2725,6 @@ validHoleFitsImpliedGFlags
, (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
, (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]
-default_PIC :: Platform -> [GeneralFlag]
-default_PIC platform =
- case (platformOS platform, platformArch 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.
- (OSDarwin, ArchX86_64) -> [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.
- (OSDarwin, ArchAArch64) -> [Opt_PIC]
- (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
- (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs]
- (OSOpenBSD, ArchX86_64) -> [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.
- _ -> []
-
-- General flags that are switched on/off when other general flags are switched
-- on
impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
@@ -4053,85 +2814,6 @@ impliedXFlags
, (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures)
]
--- 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 -- see Note [Documenting optimisation flags]
- = [ ([0,1,2], Opt_DoLambdaEtaExpansion)
- , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0]
- , ([0,1,2], Opt_LlvmTBAA)
- , ([0,1,2], Opt_ProfManualCcs )
- , ([2], Opt_DictsStrict)
-
- , ([0], Opt_IgnoreInterfacePragmas)
- , ([0], Opt_OmitInterfacePragmas)
-
- , ([1,2], Opt_CoreConstantFolding)
-
- , ([1,2], Opt_CallArity)
- , ([1,2], Opt_Exitification)
- , ([1,2], Opt_CaseMerge)
- , ([1,2], Opt_CaseFolding)
- , ([1,2], Opt_CmmElimCommonBlocks)
- , ([2], Opt_AsmShortcutting)
- , ([1,2], Opt_CmmSink)
- , ([1,2], Opt_CmmStaticPred)
- , ([1,2], Opt_CSE)
- , ([1,2], Opt_StgCSE)
- , ([2], Opt_StgLiftLams)
- , ([1,2], Opt_CmmControlFlow)
-
- , ([1,2], 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.
-
- , ([1,2], Opt_FloatIn)
- , ([1,2], Opt_FullLaziness)
- , ([1,2], Opt_IgnoreAsserts)
- , ([1,2], Opt_Loopification)
- , ([1,2], Opt_CfgBlocklayout) -- Experimental
-
- , ([1,2], Opt_Specialise)
- , ([1,2], Opt_CrossModuleSpecialise)
- , ([1,2], Opt_InlineGenerics)
- , ([1,2], Opt_Strictness)
- , ([1,2], Opt_UnboxSmallStrictFields)
- , ([1,2], Opt_CprAnal)
- , ([1,2], Opt_WorkerWrapper)
- , ([1,2], Opt_SolveConstantDicts)
- , ([1,2], Opt_NumConstantFolding)
-
- , ([2], Opt_LiberateCase)
- , ([2], Opt_SpecConstr)
- , ([2], Opt_FastPAPCalls)
--- , ([2], Opt_RegsGraph)
--- RegsGraph suffers performance regression. See #7679
--- , ([2], Opt_StaticArgumentTransformation)
--- Static Argument Transformation needs investigation. See #9374
- ]
-- | Things you get with `-dlint`.
@@ -4439,12 +3121,6 @@ setDebugLevel mb_n =
| n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols
| otherwise = id
-data PkgDbRef
- = GlobalPkgDb
- | UserPkgDb
- | PkgDbPath FilePath
- deriving Eq
-
addPkgDbRef :: PkgDbRef -> DynP ()
addPkgDbRef p = upd $ \s ->
s { packageDBFlags = PackageDB p : packageDBFlags s }
@@ -5070,29 +3746,6 @@ needSourceNotes dflags = debugLevel dflags > 0
-- -----------------------------------------------------------------------------
-- 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 Eq
-
--- CompilerInfo tells us which C compiler we're using
-data CompilerInfo
- = GCC
- | Clang
- | AppleClang
- | AppleClang51
- | Emscripten
- | UnknownCC
- deriving Eq
-
-
-- | Should we use `-XLinker -rpath` when linking or not?
-- See Note [-fno-use-rpaths]
useXLinkerRPath :: DynFlags -> OS -> Bool
@@ -5144,60 +3797,6 @@ decodeSize str
foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO ()
foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-
--- | Initialize the pretty-printing options
-initSDocContext :: DynFlags -> PprStyle -> SDocContext
-initSDocContext dflags style = SDC
- { sdocStyle = style
- , sdocColScheme = colScheme dflags
- , sdocLastColour = Col.colReset
- , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags)
- , sdocDefaultDepth = pprUserLength dflags
- , sdocLineLength = pprCols dflags
- , sdocCanUseUnicode = useUnicode dflags
- , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags
- , sdocPprDebug = dopt Opt_D_ppr_debug dflags
- , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags
- , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags
- , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags
- , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags
- , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags
- , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags
- , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags
- , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags
- , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags
- , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags
- , sdocSuppressTicks = gopt Opt_SuppressTicks dflags
- , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags
- , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags
- , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags
- , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags
- , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags
- , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags
- , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags
- , sdocSuppressUniques = gopt Opt_SuppressUniques dflags
- , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags
- , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags
- , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags
- , sdocErrorSpans = gopt Opt_ErrorSpans dflags
- , sdocStarIsType = xopt LangExt.StarIsType dflags
- , sdocLinearTypes = xopt LangExt.LinearTypes dflags
- , sdocListTuplePuns = True
- , sdocPrintTypeAbbreviations = True
- , sdocUnitIdForUser = ftext
- }
-
--- | Initialize the pretty-printing options using the default user style
-initDefaultSDocContext :: DynFlags -> SDocContext
-initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle
-
-initPromotionTickContext :: DynFlags -> PromotionTickContext
-initPromotionTickContext dflags =
- PromTickCtx {
- ptcListTuplePuns = True,
- ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags
- }
-
outputFile :: DynFlags -> Maybe String
outputFile dflags
| dynamicNow dflags = dynOutputFile_ dflags
@@ -5208,11 +3807,6 @@ objectSuf dflags
| dynamicNow dflags = dynObjectSuf_ dflags
| otherwise = objectSuf_ dflags
-ways :: DynFlags -> Ways
-ways dflags
- | dynamicNow dflags = addWay WayDyn (targetWays_ dflags)
- | otherwise = targetWays_ dflags
-
-- | Pretty-print the difference between 2 DynFlags.
--
-- For now only their general flags but it could be extended.
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 3a40d15514..09f849c494 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -82,7 +82,7 @@ import GHC.Types.SrcLoc
import GHC.Data.Bag -- collect ev vars from pats
import GHC.Data.Maybe
import GHC.Types.Name (Name, dataName)
-import GHC.Driver.Session (DynFlags, xopt)
+import GHC.Driver.DynFlags (DynFlags, xopt)
import qualified GHC.LanguageExtensions as LangExt
import Data.Data
diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs
index b91a60e437..22eba51b80 100644
--- a/compiler/GHC/HsToCore/Errors/Types.hs
+++ b/compiler/GHC/HsToCore/Errors/Types.hs
@@ -9,7 +9,7 @@ import GHC.Prelude
import GHC.Core (CoreRule, CoreExpr, RuleName)
import GHC.Core.DataCon
import GHC.Core.Type
-import GHC.Driver.Session (DynFlags, xopt)
+import GHC.Driver.DynFlags (DynFlags, xopt)
import GHC.Driver.Flags (WarningFlag)
import GHC.Hs
import GHC.HsToCore.Pmc.Solver.Types
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index 5f60abf896..caa61755d7 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -19,7 +19,7 @@ import GHC.Prelude
import GHC.Hs
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import {-# SOURCE #-} GHC.Driver.Plugins
import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume )
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 78c1134475..1c6a31987a 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -119,7 +119,7 @@ import GHC.Core
import GHC.Core.TyCo.Ppr
import GHC.Utils.FV
import GHC.Types.Var.Set
-import GHC.Driver.Session (DynFlags(reductionDepth))
+import GHC.Driver.DynFlags (DynFlags(reductionDepth))
import GHC.Builtin.Names
import GHC.Types.Basic
import GHC.Types.Unique.Set
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index ae25678600..481fa15570 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin
, FixedRuntimeRepOrigin, FixedRuntimeRepContext )
-- others:
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Types.Name as Name
-- We use this to make dictionaries for type literals.
-- Perhaps there's a better way to do this?
diff --git a/compiler/GHC/Unit/Env.hs b/compiler/GHC/Unit/Env.hs
index a34ae550e0..e5fbc36e0c 100644
--- a/compiler/GHC/Unit/Env.hs
+++ b/compiler/GHC/Unit/Env.hs
@@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Utils.Misc (HasDebugCallStack)
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Utils.Outputable
import GHC.Utils.Panic (pprPanic)
import GHC.Unit.Module.ModIface
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index aa700b4b2d..f138c40f8d 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -51,7 +51,7 @@ import GHC.Data.Maybe
import GHC.Data.Graph.Directed
import GHC.Driver.Backend
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Types.SourceFile ( hscSourceString )
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index 35f52a5a3e..46468c0b54 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -27,7 +27,7 @@ import GHC.Prelude
import GHC.Hs
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Unit.Types
import GHC.Unit.Module
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index f5aeb65216..0d406d407c 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -75,7 +75,7 @@ where
import GHC.Prelude
-import GHC.Driver.Session
+import GHC.Driver.DynFlags
import GHC.Platform
import GHC.Platform.Ways
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index fc2151f547..15c3b39550 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -434,6 +434,7 @@ Library
GHC.Driver.Config.StgToCmm
GHC.Driver.Config.Tidy
GHC.Driver.Config.StgToJS
+ GHC.Driver.DynFlags
GHC.Driver.Env
GHC.Driver.Env.KnotVars
GHC.Driver.Env.Types
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index beb1e54f23..2493a0a9b1 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -106,6 +106,7 @@ GHC.Driver.CmdLine
GHC.Driver.Config.Core.Lint
GHC.Driver.Config.Diagnostic
GHC.Driver.Config.Logger
+GHC.Driver.DynFlags
GHC.Driver.Env
GHC.Driver.Env.KnotVars
GHC.Driver.Env.Types
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 44fc982440..2b74bda834 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -107,6 +107,7 @@ GHC.Driver.CmdLine
GHC.Driver.Config.Core.Lint
GHC.Driver.Config.Diagnostic
GHC.Driver.Config.Logger
+GHC.Driver.DynFlags
GHC.Driver.Env
GHC.Driver.Env.KnotVars
GHC.Driver.Env.Types
diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout
index aed259caf9..0e82fe5214 100644
--- a/testsuite/tests/linters/notes.stdout
+++ b/testsuite/tests/linters/notes.stdout
@@ -1,21 +1,21 @@
ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty]
ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking]
ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope]
-ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next]
-ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings]
+ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next]
+ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings]
ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode]
-ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease]
-ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating]
+ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease]
+ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating]
+ref compiler/GHC/Driver/DynFlags.hs:1245:49: Note [Eta-reduction in -O0]
ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc]
-ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0]
ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices]
-ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice]
-ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices]
+ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice]
+ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices]
ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints]
ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice]
ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families]
ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled]
-ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations]
+ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations]
ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation]
ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init]
ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init]
@@ -32,12 +32,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp
ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled]
ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances]
ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files]
-ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting]
-ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names]
+ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting]
+ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names]
ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files]
ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports]
-ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics]
-ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win]
+ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics]
+ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win]
ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods]
ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO]
ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match]
@@ -46,7 +46,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders]
ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS]
ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "]
ref linters/lint-notes/Notes.hs:69:22: Note [...]
-ref testsuite/config/ghc:272:10: Note [WayFlags]
+ref testsuite/config/ghc:276:10: Note [WayFlags]
ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?]
ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?]
ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags]