1{-# OPTIONS_GHC -O0 #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE RankNTypes #-}
5
6-------------------------------------------------------------------------------
7--
8-- | Dynamic flags
9--
10-- Most flags are dynamic flags, which means they can change from compilation
11-- to compilation using @OPTIONS_GHC@ pragmas, and in a multi-session GHC each
12-- session can be using different dynamic flags. Dynamic flags can also be set
13-- at the prompt in GHCi.
14--
15-- (c) The University of Glasgow 2005
16--
17-------------------------------------------------------------------------------
18
19{-# OPTIONS_GHC -fno-cse #-}
20-- -fno-cse is needed for GLOBAL_VAR's to behave properly
21{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
22
23module GHC.Driver.Session (
24        -- * Dynamic flags and associated configuration types
25        DumpFlag(..),
26        GeneralFlag(..),
27        WarningFlag(..), WarnReason(..),
28        Language(..),
29        PlatformConstants(..),
30        FatalMessager, LogAction, FlushOut(..), FlushErr(..),
31        ProfAuto(..),
32        glasgowExtsFlags,
33        warningGroups, warningHierarchies,
34        hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion,
35        dopt, dopt_set, dopt_unset,
36        gopt, gopt_set, gopt_unset, setGeneralFlag', unSetGeneralFlag',
37        wopt, wopt_set, wopt_unset,
38        wopt_fatal, wopt_set_fatal, wopt_unset_fatal,
39        xopt, xopt_set, xopt_unset,
40        xopt_set_unlessExplSpec,
41        lang_set,
42        whenGeneratingDynamicToo, ifGeneratingDynamicToo,
43        whenCannotGenerateDynamicToo,
44        dynamicTooMkDynamicDynFlags,
45        dynamicOutputFile,
46        sccProfilingEnabled,
47        DynFlags(..),
48        FlagSpec(..),
49        HasDynFlags(..), ContainsDynFlags(..),
50        RtsOptsEnabled(..),
51        HscTarget(..), isObjectTarget, defaultObjectTarget,
52        targetRetainsAllBindings,
53        GhcMode(..), isOneShot,
54        GhcLink(..), isNoLink,
55        PackageFlag(..), PackageArg(..), ModRenaming(..),
56        packageFlagsChanged,
57        IgnorePackageFlag(..), TrustFlag(..),
58        PackageDBFlag(..), PkgDbRef(..),
59        Option(..), showOpt,
60        DynLibLoader(..),
61        fFlags, fLangFlags, xFlags,
62        wWarningFlags,
63        dynFlagDependencies,
64        makeDynFlagsConsistent,
65        positionIndependent,
66        optimisationFlags,
67        setFlagsFromEnvFile,
68
69        addWay',
70
71        homeUnit, mkHomeModule, isHomeModule,
72
73        -- ** Log output
74        putLogMsg,
75
76        -- ** Safe Haskell
77        SafeHaskellMode(..),
78        safeHaskellOn, safeHaskellModeEnabled,
79        safeImportsOn, safeLanguageOn, safeInferOn,
80        packageTrustOn,
81        safeDirectImpsReq, safeImplicitImpsReq,
82        unsafeFlags, unsafeFlagsForInfer,
83
84        -- ** LLVM Targets
85        LlvmTarget(..), LlvmConfig(..),
86
87        -- ** System tool settings and locations
88        Settings(..),
89        sProgramName,
90        sProjectVersion,
91        sGhcUsagePath,
92        sGhciUsagePath,
93        sToolDir,
94        sTopDir,
95        sTmpDir,
96        sGlobalPackageDatabasePath,
97        sLdSupportsCompactUnwind,
98        sLdSupportsBuildId,
99        sLdSupportsFilelist,
100        sLdIsGnuLd,
101        sGccSupportsNoPie,
102        sPgm_L,
103        sPgm_P,
104        sPgm_F,
105        sPgm_c,
106        sPgm_a,
107        sPgm_l,
108        sPgm_lm,
109        sPgm_dll,
110        sPgm_T,
111        sPgm_windres,
112        sPgm_libtool,
113        sPgm_ar,
114        sPgm_ranlib,
115        sPgm_lo,
116        sPgm_lc,
117        sPgm_lcc,
118        sPgm_i,
119        sOpt_L,
120        sOpt_P,
121        sOpt_P_fingerprint,
122        sOpt_F,
123        sOpt_c,
124        sOpt_cxx,
125        sOpt_a,
126        sOpt_l,
127        sOpt_lm,
128        sOpt_windres,
129        sOpt_lo,
130        sOpt_lc,
131        sOpt_lcc,
132        sOpt_i,
133        sExtraGccViaCFlags,
134        sTargetPlatformString,
135        sGhcWithInterpreter,
136        sGhcWithSMP,
137        sGhcRTSWays,
138        sLibFFI,
139        sGhcThreaded,
140        sGhcDebugged,
141        sGhcRtsWithLibdw,
142        GhcNameVersion(..),
143        FileSettings(..),
144        PlatformMisc(..),
145        settings,
146        programName, projectVersion,
147        ghcUsagePath, ghciUsagePath, topDir, tmpDir,
148        versionedAppDir, versionedFilePath,
149        extraGccViaCFlags, globalPackageDatabasePath,
150        pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T,
151        pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool,
152        pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i,
153        opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
154        opt_P_signature,
155        opt_windres, opt_lo, opt_lc, opt_lcc,
156
157        -- ** Manipulating DynFlags
158        addPluginModuleName,
159        defaultDynFlags,                -- Settings -> DynFlags
160        defaultWays,
161        initDynFlags,                   -- DynFlags -> IO DynFlags
162        defaultFatalMessager,
163        defaultLogAction,
164        defaultLogActionHPrintDoc,
165        defaultLogActionHPutStrDoc,
166        defaultFlushOut,
167        defaultFlushErr,
168
169        getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
170        getVerbFlags,
171        updOptLevel,
172        setTmpDir,
173        setUnitId,
174        canonicalizeHomeModule,
175        canonicalizeModuleIfHome,
176
177        TurnOnFlag,
178        turnOn,
179        turnOff,
180        impliedGFlags,
181        impliedOffGFlags,
182        impliedXFlags,
183
184        -- ** Parsing DynFlags
185        parseDynamicFlagsCmdLine,
186        parseDynamicFilePragma,
187        parseDynamicFlagsFull,
188
189        -- ** Available DynFlags
190        allNonDeprecatedFlags,
191        flagsAll,
192        flagsDynamic,
193        flagsPackage,
194        flagsForCompletion,
195
196        supportedLanguagesAndExtensions,
197        languageExtensions,
198
199        -- ** DynFlags C compiler options
200        picCCOpts, picPOpts,
201
202        -- * Compiler configuration suitable for display to the user
203        compilerInfo,
204
205#include "GHCConstantsHaskellExports.hs"
206        bLOCK_SIZE_W,
207        wordAlignment,
208        tAG_MASK,
209        mAX_PTR_TAG,
210
211        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
212
213        -- * SSE and AVX
214        isSseEnabled,
215        isSse2Enabled,
216        isSse4_2Enabled,
217        isBmiEnabled,
218        isBmi2Enabled,
219        isAvxEnabled,
220        isAvx2Enabled,
221        isAvx512cdEnabled,
222        isAvx512erEnabled,
223        isAvx512fEnabled,
224        isAvx512pfEnabled,
225
226        -- * Linker/compiler information
227        LinkerInfo(..),
228        CompilerInfo(..),
229
230        -- * File cleanup
231        FilesToClean(..), emptyFilesToClean,
232
233        -- * Include specifications
234        IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
235
236        -- * SDoc
237        initSDocContext, initDefaultSDocContext,
238
239        -- * Make use of the Cmm CFG
240        CfgWeights(..)
241  ) where
242
243#include "GhclibHsVersions.h"
244
245import GHC.Prelude
246
247import GHC.Platform
248import GHC.UniqueSubdir (uniqueSubdir)
249import GHC.Unit.Types
250import GHC.Unit.Parser
251import GHC.Unit.Module
252import {-# SOURCE #-} GHC.Driver.Plugins
253import {-# SOURCE #-} GHC.Driver.Hooks
254import GHC.Builtin.Names ( mAIN )
255import {-# SOURCE #-} GHC.Unit.State (UnitState, emptyUnitState, UnitDatabase, updateIndefUnitId)
256import GHC.Driver.Phases ( Phase(..), phaseInputExt )
257import GHC.Driver.Flags
258import GHC.Driver.Ways
259import GHC.Driver.Backend
260import GHC.Settings.Config
261import GHC.Utils.CliOption
262import GHC.Driver.CmdLine hiding (WarnReason(..))
263import qualified GHC.Driver.CmdLine as Cmd
264import GHC.Settings.Constants
265import GHC.Utils.Panic
266import qualified GHC.Utils.Ppr.Colour as Col
267import GHC.Utils.Misc
268import GHC.Data.Maybe
269import GHC.Utils.Monad
270import qualified GHC.Utils.Ppr as Pretty
271import GHC.Types.SrcLoc
272import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
273import GHC.Data.FastString
274import GHC.Utils.Fingerprint
275import GHC.Utils.Outputable
276import GHC.Settings
277
278import {-# SOURCE #-} GHC.Utils.Error
279                               ( Severity(..), MsgDoc, mkLocMessageAnn
280                               , getCaretDiagnostic, DumpAction, TraceAction
281                               , defaultDumpAction, defaultTraceAction )
282import GHC.Utils.Json
283import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
284import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
285
286import System.IO.Unsafe ( unsafePerformIO )
287import Data.IORef
288import Control.Arrow ((&&&))
289import Control.Monad
290import Control.Monad.Trans.Class
291import Control.Monad.Trans.Writer
292import Control.Monad.Trans.Reader
293import Control.Monad.Trans.Except
294
295import Data.Ord
296import Data.Bits
297import Data.Char
298import Data.List
299import Data.Map (Map)
300import qualified Data.Map as Map
301import Data.Set (Set)
302import qualified Data.Set as Set
303import System.FilePath
304import System.Directory
305import System.Environment (lookupEnv)
306import System.IO
307import System.IO.Error
308import Text.ParserCombinators.ReadP hiding (char)
309import Text.ParserCombinators.ReadP as R
310
311import GHC.Data.EnumSet (EnumSet)
312import qualified GHC.Data.EnumSet as EnumSet
313
314import GHC.Foreign (withCString, peekCString)
315import qualified GHC.LanguageExtensions as LangExt
316
317#if GHC_STAGE >= 2
318-- used by SHARED_GLOBAL_VAR
319import Foreign (Ptr)
320#endif
321
322-- Note [Updating flag description in the User's Guide]
323-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
324--
325-- If you modify anything in this file please make sure that your changes are
326-- described in the User's Guide. Please update the flag description in the
327-- users guide (docs/users_guide) whenever you add or change a flag.
328
329-- Note [Supporting CLI completion]
330-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
331--
332-- The command line interface completion (in for example bash) is an easy way
333-- for the developer to learn what flags are available from GHC.
334-- GHC helps by separating which flags are available when compiling with GHC,
335-- and which flags are available when using GHCi.
336-- A flag is assumed to either work in both these modes, or only in one of them.
337-- When adding or changing a flag, please consider for which mode the flag will
338-- have effect, and annotate it accordingly. For Flags use defFlag, defGhcFlag,
339-- defGhciFlag, and for FlagSpec use flagSpec or flagGhciSpec.
340
341-- Note [Adding a language extension]
342-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
343--
344-- There are a few steps to adding (or removing) a language extension,
345--
346--  * Adding the extension to GHC.LanguageExtensions
347--
348--    The Extension type in libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
349--    is the canonical list of language extensions known by GHC.
350--
351--  * Adding a flag to DynFlags.xFlags
352--
353--    This is fairly self-explanatory. The name should be concise, memorable,
354--    and consistent with any previous implementations of the similar idea in
355--    other Haskell compilers.
356--
357--  * Adding the flag to the documentation
358--
359--    This is the same as any other flag. See
360--    Note [Updating flag description in the User's Guide]
361--
362--  * Adding the flag to Cabal
363--
364--    The Cabal library has its own list of all language extensions supported
365--    by all major compilers. This is the list that user code being uploaded
366--    to Hackage is checked against to ensure language extension validity.
367--    Consequently, it is very important that this list remains up-to-date.
368--
369--    To this end, there is a testsuite test (testsuite/tests/driver/T4437.hs)
370--    whose job it is to ensure these GHC's extensions are consistent with
371--    Cabal.
372--
373--    The recommended workflow is,
374--
375--     1. Temporarily add your new language extension to the
376--        expectedGhcOnlyExtensions list in T4437 to ensure the test doesn't
377--        break while Cabal is updated.
378--
379--     2. After your GHC change is accepted, submit a Cabal pull request adding
380--        your new extension to Cabal's list (found in
381--        Cabal/Language/Haskell/Extension.hs).
382--
383--     3. After your Cabal change is accepted, let the GHC developers know so
384--        they can update the Cabal submodule and remove the extensions from
385--        expectedGhcOnlyExtensions.
386--
387--  * Adding the flag to the GHC Wiki
388--
389--    There is a change log tracking language extension additions and removals
390--    on the GHC wiki:  https://gitlab.haskell.org/ghc/ghc/wikis/language-pragma-history
391--
392--  See #4437 and #8176.
393
394-- -----------------------------------------------------------------------------
395-- DynFlags
396
397
398-- | Used to differentiate the scope an include needs to apply to.
399-- We have to split the include paths to avoid accidentally forcing recursive
400-- includes since -I overrides the system search paths. See #14312.
401data IncludeSpecs
402  = IncludeSpecs { includePathsQuote  :: [String]
403                 , includePathsGlobal :: [String]
404                 }
405  deriving Show
406
407-- | Append to the list of includes a path that shall be included using `-I`
408-- when the C compiler is called. These paths override system search paths.
409addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
410addGlobalInclude spec paths  = let f = includePathsGlobal spec
411                               in spec { includePathsGlobal = f ++ paths }
412
413-- | Append to the list of includes a path that shall be included using
414-- `-iquote` when the C compiler is called. These paths only apply when quoted
415-- includes are used. e.g. #include "foo.h"
416addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
417addQuoteInclude spec paths  = let f = includePathsQuote spec
418                              in spec { includePathsQuote = f ++ paths }
419
420-- | Concatenate and flatten the list of global and quoted includes returning
421-- just a flat list of paths.
422flattenIncludes :: IncludeSpecs -> [String]
423flattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs
424
425-- | The various Safe Haskell modes
426data SafeHaskellMode
427   = Sf_None          -- ^ inferred unsafe
428   | Sf_Unsafe        -- ^ declared and checked
429   | Sf_Trustworthy   -- ^ declared and checked
430   | Sf_Safe          -- ^ declared and checked
431   | Sf_SafeInferred  -- ^ inferred as safe
432   | Sf_Ignore        -- ^ @-fno-safe-haskell@ state
433   deriving (Eq)
434
435instance Show SafeHaskellMode where
436    show Sf_None         = "None"
437    show Sf_Unsafe       = "Unsafe"
438    show Sf_Trustworthy  = "Trustworthy"
439    show Sf_Safe         = "Safe"
440    show Sf_SafeInferred = "Safe-Inferred"
441    show Sf_Ignore       = "Ignore"
442
443instance Outputable SafeHaskellMode where
444    ppr = text . show
445
446-- | Contains not only a collection of 'GeneralFlag's but also a plethora of
447-- information relating to the compilation of a single file or GHC session
448data DynFlags = DynFlags {
449  ghcMode               :: GhcMode,
450  ghcLink               :: GhcLink,
451  hscTarget             :: HscTarget,
452
453  -- formerly Settings
454  ghcNameVersion    :: {-# UNPACK #-} !GhcNameVersion,
455  fileSettings      :: {-# UNPACK #-} !FileSettings,
456  targetPlatform    :: Platform,       -- Filled in by SysTools
457  toolSettings      :: {-# UNPACK #-} !ToolSettings,
458  platformMisc      :: {-# UNPACK #-} !PlatformMisc,
459  platformConstants :: PlatformConstants,
460  rawSettings       :: [(String, String)],
461
462  llvmConfig            :: LlvmConfig,
463    -- ^ N.B. It's important that this field is lazy since we load the LLVM
464    -- configuration lazily. See Note [LLVM Configuration] in "GHC.SysTools".
465  verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
466  optLevel              :: Int,         -- ^ Optimisation level
467  debugLevel            :: Int,         -- ^ How much debug information to produce
468  simplPhases           :: Int,         -- ^ Number of simplifier phases
469  maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
470  ruleCheck             :: Maybe String,
471  inlineCheck           :: Maybe String, -- ^ A prefix to report inlining decisions about
472  strictnessBefore      :: [Int],       -- ^ Additional demand analysis
473
474  parMakeCount          :: Maybe Int,   -- ^ The number of modules to compile in parallel
475                                        --   in --make mode, where Nothing ==> compile as
476                                        --   many in parallel as there are CPUs.
477
478  enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?
479  ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.
480
481  maxRelevantBinds      :: Maybe Int,   -- ^ Maximum number of bindings from the type envt
482                                        --   to show in type error messages
483  maxValidHoleFits      :: Maybe Int,   -- ^ Maximum number of hole fits to show
484                                        --   in typed hole error messages
485  maxRefHoleFits        :: Maybe Int,   -- ^ Maximum number of refinement hole
486                                        --   fits to show in typed hole error
487                                        --   messages
488  refLevelHoleFits      :: Maybe Int,   -- ^ Maximum level of refinement for
489                                        --   refinement hole fits in typed hole
490                                        --   error messages
491  maxUncoveredPatterns  :: Int,         -- ^ Maximum number of unmatched patterns to show
492                                        --   in non-exhaustiveness warnings
493  maxPmCheckModels      :: Int,         -- ^ Soft limit on the number of models
494                                        --   the pattern match checker checks
495                                        --   a pattern against. A safe guard
496                                        --   against exponential blow-up.
497  simplTickFactor       :: Int,         -- ^ Multiplier for simplifier ticks
498  specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
499  specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
500  specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types
501                                        --   Not optional; otherwise ForceSpecConstr can diverge.
502  binBlobThreshold      :: Word,        -- ^ Binary literals (e.g. strings) whose size is above
503                                        --   this threshold will be dumped in a binary file
504                                        --   by the assembler code generator (0 to disable)
505  liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
506  floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating
507                                        --   See 'GHC.Core.Opt.Monad.FloatOutSwitches'
508
509  liftLamsRecArgs       :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a
510                                        --   recursive function.
511  liftLamsNonRecArgs    :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a
512                                        --   non-recursive function.
513  liftLamsKnown         :: Bool,        -- ^ Lambda lift even when this turns a known call
514                                        --   into an unknown call.
515
516  cmmProcAlignment      :: Maybe Int,   -- ^ Align Cmm functions at this boundary or use default.
517
518  historySize           :: Int,         -- ^ Simplification history size
519
520  importPaths           :: [FilePath],
521  mainModIs             :: Module,
522  mainFunIs             :: Maybe String,
523  reductionDepth        :: IntWithInf,   -- ^ Typechecker maximum stack depth
524  solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver
525                                         --   Typically only 1 is needed
526
527  homeUnitId            :: UnitId,                 -- ^ Target home unit-id
528  homeUnitInstanceOfId  :: Maybe IndefUnitId,      -- ^ Unit-id to instantiate
529  homeUnitInstantiations:: [(ModuleName, Module)], -- ^ How to instantiate `homeUnitInstanceOfId` unit
530
531  -- ways
532  ways                  :: Set Way,     -- ^ Way flags from the command line
533
534  -- For object splitting
535  splitInfo             :: Maybe (String,Int),
536
537  -- paths etc.
538  objectDir             :: Maybe String,
539  dylibInstallName      :: Maybe String,
540  hiDir                 :: Maybe String,
541  hieDir                :: Maybe String,
542  stubDir               :: Maybe String,
543  dumpDir               :: Maybe String,
544
545  objectSuf             :: String,
546  hcSuf                 :: String,
547  hiSuf                 :: String,
548  hieSuf                :: String,
549
550  canGenerateDynamicToo :: IORef Bool,
551  dynObjectSuf          :: String,
552  dynHiSuf              :: String,
553
554  outputFile            :: Maybe String,
555  dynOutputFile         :: Maybe String,
556  outputHi              :: Maybe String,
557  dynLibLoader          :: DynLibLoader,
558
559  -- | This is set by 'GHC.Driver.Pipeline.runPipeline' based on where
560  --    its output is going.
561  dumpPrefix            :: Maybe FilePath,
562
563  -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.runPipeline'.
564  --    Set by @-ddump-file-prefix@
565  dumpPrefixForce       :: Maybe FilePath,
566
567  ldInputs              :: [Option],
568
569  includePaths          :: IncludeSpecs,
570  libraryPaths          :: [String],
571  frameworkPaths        :: [String],    -- used on darwin only
572  cmdlineFrameworks     :: [String],    -- ditto
573
574  rtsOpts               :: Maybe String,
575  rtsOptsEnabled        :: RtsOptsEnabled,
576  rtsOptsSuggestions    :: Bool,
577
578  hpcDir                :: String,      -- ^ Path to store the .mix files
579
580  -- Plugins
581  pluginModNames        :: [ModuleName],
582  pluginModNameOpts     :: [(ModuleName,String)],
583  frontendPluginOpts    :: [String],
584    -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*
585    -- order that they're specified on the command line.
586  cachedPlugins         :: [LoadedPlugin],
587    -- ^ plugins dynamically loaded after processing arguments. What will be
588    -- loaded here is directed by pluginModNames. Arguments are loaded from
589    -- pluginModNameOpts. The purpose of this field is to cache the plugins so
590    -- they don't have to be loaded each time they are needed.  See
591    -- 'GHC.Runtime.Loader.initializePlugins'.
592  staticPlugins            :: [StaticPlugin],
593    -- ^ static plugins which do not need dynamic loading. These plugins are
594    -- intended to be added by GHC API users directly to this list.
595    --
596    -- To add dynamically loaded plugins through the GHC API see
597    -- 'addPluginModuleName' instead.
598
599  -- GHC API hooks
600  hooks                 :: Hooks,
601
602  --  For ghc -M
603  depMakefile           :: FilePath,
604  depIncludePkgDeps     :: Bool,
605  depIncludeCppDeps     :: Bool,
606  depExcludeMods        :: [ModuleName],
607  depSuffixes           :: [String],
608
609  --  Package flags
610  packageDBFlags        :: [PackageDBFlag],
611        -- ^ The @-package-db@ flags given on the command line, In
612        -- *reverse* order that they're specified on the command line.
613        -- This is intended to be applied with the list of "initial"
614        -- package databases derived from @GHC_PACKAGE_PATH@; see
615        -- 'getUnitDbRefs'.
616
617  ignorePackageFlags    :: [IgnorePackageFlag],
618        -- ^ The @-ignore-package@ flags from the command line.
619        -- In *reverse* order that they're specified on the command line.
620  packageFlags          :: [PackageFlag],
621        -- ^ The @-package@ and @-hide-package@ flags from the command-line.
622        -- In *reverse* order that they're specified on the command line.
623  pluginPackageFlags    :: [PackageFlag],
624        -- ^ The @-plugin-package-id@ flags from command line.
625        -- In *reverse* order that they're specified on the command line.
626  trustFlags            :: [TrustFlag],
627        -- ^ The @-trust@ and @-distrust@ flags.
628        -- In *reverse* order that they're specified on the command line.
629  packageEnv            :: Maybe FilePath,
630        -- ^ Filepath to the package environment file (if overriding default)
631
632  unitDatabases         :: Maybe [UnitDatabase UnitId],
633        -- ^ Stack of unit databases for the target platform.
634        --
635        -- This field is populated by `initUnits`.
636        --
637        -- 'Nothing' means the databases have never been read from disk. If
638        -- `initUnits` is called again, it doesn't reload the databases from
639        -- disk.
640
641  unitState             :: UnitState,
642        -- ^ Consolidated unit database built by 'initUnits' from the unit
643        -- databases in 'unitDatabases' and flags ('-ignore-package', etc.).
644        --
645        -- It also contains mapping from module names to actual Modules.
646
647  -- Temporary files
648  -- These have to be IORefs, because the defaultCleanupHandler needs to
649  -- know what to clean when an exception happens
650  filesToClean          :: IORef FilesToClean,
651  dirsToClean           :: IORef (Map FilePath FilePath),
652  -- The next available suffix to uniquely name a temp file, updated atomically
653  nextTempSuffix        :: IORef Int,
654
655  -- Names of files which were generated from -ddump-to-file; used to
656  -- track which ones we need to truncate because it's our first run
657  -- through
658  generatedDumps        :: IORef (Set FilePath),
659
660  -- hsc dynamic flags
661  dumpFlags             :: EnumSet DumpFlag,
662  generalFlags          :: EnumSet GeneralFlag,
663  warningFlags          :: EnumSet WarningFlag,
664  fatalWarningFlags     :: EnumSet WarningFlag,
665  -- Don't change this without updating extensionFlags:
666  language              :: Maybe Language,
667  -- | Safe Haskell mode
668  safeHaskell           :: SafeHaskellMode,
669  safeInfer             :: Bool,
670  safeInferred          :: Bool,
671  -- We store the location of where some extension and flags were turned on so
672  -- we can produce accurate error messages when Safe Haskell fails due to
673  -- them.
674  thOnLoc               :: SrcSpan,
675  newDerivOnLoc         :: SrcSpan,
676  overlapInstLoc        :: SrcSpan,
677  incoherentOnLoc       :: SrcSpan,
678  pkgTrustOnLoc         :: SrcSpan,
679  warnSafeOnLoc         :: SrcSpan,
680  warnUnsafeOnLoc       :: SrcSpan,
681  trustworthyOnLoc      :: SrcSpan,
682  -- Don't change this without updating extensionFlags:
683  -- Here we collect the settings of the language extensions
684  -- from the command line, the ghci config file and
685  -- from interactive :set / :seti commands.
686  extensions            :: [OnOff LangExt.Extension],
687  -- extensionFlags should always be equal to
688  --     flattenExtensionFlags language extensions
689  -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used
690  -- by template-haskell
691  extensionFlags        :: EnumSet LangExt.Extension,
692
693  -- Unfolding control
694  -- See Note [Discounts and thresholds] in GHC.Core.Unfold
695  ufCreationThreshold   :: Int,
696  ufUseThreshold        :: Int,
697  ufFunAppDiscount      :: Int,
698  ufDictDiscount        :: Int,
699  ufDearOp              :: Int,
700  ufVeryAggressive      :: Bool,
701
702  maxWorkerArgs         :: Int,
703
704  ghciHistSize          :: Int,
705
706  -- | MsgDoc output action: use "GHC.Utils.Error" instead of this if you can
707  log_action            :: LogAction,
708  dump_action           :: DumpAction,
709  trace_action          :: TraceAction,
710  flushOut              :: FlushOut,
711  flushErr              :: FlushErr,
712
713  ghcVersionFile        :: Maybe FilePath,
714  haddockOptions        :: Maybe String,
715
716  -- | GHCi scripts specified by -ghci-script, in reverse order
717  ghciScripts           :: [String],
718
719  -- Output style options
720  pprUserLength         :: Int,
721  pprCols               :: Int,
722
723  useUnicode            :: Bool,
724  useColor              :: OverridingBool,
725  canUseColor           :: Bool,
726  colScheme             :: Col.Scheme,
727
728  -- | what kind of {-# SCC #-} to add automatically
729  profAuto              :: ProfAuto,
730
731  interactivePrint      :: Maybe String,
732
733  nextWrapperNum        :: IORef (ModuleEnv Int),
734
735  -- | Machine dependent flags (-m\<blah> stuff)
736  sseVersion            :: Maybe SseVersion,
737  bmiVersion            :: Maybe BmiVersion,
738  avx                   :: Bool,
739  avx2                  :: Bool,
740  avx512cd              :: Bool, -- Enable AVX-512 Conflict Detection Instructions.
741  avx512er              :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.
742  avx512f               :: Bool, -- Enable AVX-512 instructions.
743  avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.
744
745  -- | Run-time linker information (what options we need, etc.)
746  rtldInfo              :: IORef (Maybe LinkerInfo),
747
748  -- | Run-time compiler information
749  rtccInfo              :: IORef (Maybe CompilerInfo),
750
751  -- Constants used to control the amount of optimization done.
752
753  -- | Max size, in bytes, of inline array allocations.
754  maxInlineAllocSize    :: Int,
755
756  -- | Only inline memcpy if it generates no more than this many
757  -- pseudo (roughly: Cmm) instructions.
758  maxInlineMemcpyInsns  :: Int,
759
760  -- | Only inline memset if it generates no more than this many
761  -- pseudo (roughly: Cmm) instructions.
762  maxInlineMemsetInsns  :: Int,
763
764  -- | Reverse the order of error messages in GHC/GHCi
765  reverseErrors         :: Bool,
766
767  -- | Limit the maximum number of errors to show
768  maxErrors             :: Maybe Int,
769
770  -- | Unique supply configuration for testing build determinism
771  initialUnique         :: Int,
772  uniqueIncrement       :: Int,
773
774  -- | Temporary: CFG Edge weights for fast iterations
775  cfgWeightInfo         :: CfgWeights
776}
777
778-- | Edge weights to use when generating a CFG from CMM
779data CfgWeights
780    = CFGWeights
781    { uncondWeight :: Int
782    , condBranchWeight :: Int
783    , switchWeight :: Int
784    , callWeight :: Int
785    , likelyCondWeight :: Int
786    , unlikelyCondWeight :: Int
787    , infoTablePenalty :: Int
788    , backEdgeBonus :: Int
789    }
790
791defaultCfgWeights :: CfgWeights
792defaultCfgWeights
793    = CFGWeights
794    { uncondWeight = 1000
795    , condBranchWeight = 800
796    , switchWeight = 1
797    , callWeight = -10
798    , likelyCondWeight = 900
799    , unlikelyCondWeight = 300
800    , infoTablePenalty = 300
801    , backEdgeBonus = 400
802    }
803
804parseCfgWeights :: String -> CfgWeights -> CfgWeights
805parseCfgWeights s oldWeights =
806        foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments
807    where
808        assignments = map assignment $ settings s
809        update "uncondWeight" n w =
810            w {uncondWeight = n}
811        update "condBranchWeight" n w =
812            w {condBranchWeight = n}
813        update "switchWeight" n w =
814            w {switchWeight = n}
815        update "callWeight" n w =
816            w {callWeight = n}
817        update "likelyCondWeight" n w =
818            w {likelyCondWeight = n}
819        update "unlikelyCondWeight" n w =
820            w {unlikelyCondWeight = n}
821        update "infoTablePenalty" n w =
822            w {infoTablePenalty = n}
823        update "backEdgeBonus" n w =
824            w {backEdgeBonus = n}
825        update other _ _
826            = panic $ other ++
827                      " is not a cfg weight parameter. " ++
828                      exampleString
829        settings s
830            | (s1,rest) <- break (== ',') s
831            , null rest
832            = [s1]
833            | (s1,rest) <- break (== ',') s
834            = s1 : settings (drop 1 rest)
835
836        assignment as
837            | (name, _:val) <- break (== '=') as
838            = (name,read val)
839            | otherwise
840            = panic $ "Invalid cfg parameters." ++ exampleString
841
842        exampleString = "Example parameters: uncondWeight=1000," ++
843            "condBranchWeight=800,switchWeight=0,callWeight=300" ++
844            ",likelyCondWeight=900,unlikelyCondWeight=300" ++
845            ",infoTablePenalty=300,backEdgeBonus=400"
846
847class HasDynFlags m where
848    getDynFlags :: m DynFlags
849
850{- It would be desirable to have the more generalised
851
852  instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where
853      getDynFlags = lift getDynFlags
854
855instance definition. However, that definition would overlap with the
856`HasDynFlags (GhcT m)` instance. Instead we define instances for a
857couple of common Monad transformers explicitly. -}
858
859instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where
860    getDynFlags = lift getDynFlags
861
862instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where
863    getDynFlags = lift getDynFlags
864
865instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where
866    getDynFlags = lift getDynFlags
867
868instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
869    getDynFlags = lift getDynFlags
870
871class ContainsDynFlags t where
872    extractDynFlags :: t -> DynFlags
873
874data ProfAuto
875  = NoProfAuto         -- ^ no SCC annotations added
876  | ProfAutoAll        -- ^ top-level and nested functions are annotated
877  | ProfAutoTop        -- ^ top-level functions annotated only
878  | ProfAutoExports    -- ^ exported functions annotated only
879  | ProfAutoCalls      -- ^ annotate call-sites
880  deriving (Eq,Enum)
881
882data LlvmTarget = LlvmTarget
883  { lDataLayout :: String
884  , lCPU        :: String
885  , lAttributes :: [String]
886  }
887
888-- | See Note [LLVM Configuration] in "GHC.SysTools".
889data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
890                             , llvmPasses  :: [(Int, String)]
891                             }
892
893-----------------------------------------------------------------------------
894-- Accessessors from 'DynFlags'
895
896-- | "unbuild" a 'Settings' from a 'DynFlags'. This shouldn't be needed in the
897-- vast majority of code. But GHCi questionably uses this to produce a default
898-- 'DynFlags' from which to compute a flags diff for printing.
899settings :: DynFlags -> Settings
900settings dflags = Settings
901  { sGhcNameVersion = ghcNameVersion dflags
902  , sFileSettings = fileSettings dflags
903  , sTargetPlatform = targetPlatform dflags
904  , sToolSettings = toolSettings dflags
905  , sPlatformMisc = platformMisc dflags
906  , sPlatformConstants = platformConstants dflags
907  , sRawSettings = rawSettings dflags
908  }
909
910programName :: DynFlags -> String
911programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags
912projectVersion :: DynFlags -> String
913projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags)
914ghcUsagePath          :: DynFlags -> FilePath
915ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags
916ghciUsagePath         :: DynFlags -> FilePath
917ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
918toolDir               :: DynFlags -> Maybe FilePath
919toolDir dflags = fileSettings_toolDir $ fileSettings dflags
920topDir                :: DynFlags -> FilePath
921topDir dflags = fileSettings_topDir $ fileSettings dflags
922tmpDir                :: DynFlags -> String
923tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags
924extraGccViaCFlags     :: DynFlags -> [String]
925extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
926globalPackageDatabasePath   :: DynFlags -> FilePath
927globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags
928pgm_L                 :: DynFlags -> String
929pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags
930pgm_P                 :: DynFlags -> (String,[Option])
931pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags
932pgm_F                 :: DynFlags -> String
933pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags
934pgm_c                 :: DynFlags -> String
935pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags
936pgm_a                 :: DynFlags -> (String,[Option])
937pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags
938pgm_l                 :: DynFlags -> (String,[Option])
939pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags
940pgm_lm                 :: DynFlags -> (String,[Option])
941pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags
942pgm_dll               :: DynFlags -> (String,[Option])
943pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
944pgm_T                 :: DynFlags -> String
945pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags
946pgm_windres           :: DynFlags -> String
947pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags
948pgm_libtool           :: DynFlags -> String
949pgm_libtool dflags = toolSettings_pgm_libtool $ toolSettings dflags
950pgm_lcc               :: DynFlags -> (String,[Option])
951pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags
952pgm_ar                :: DynFlags -> String
953pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags
954pgm_otool             :: DynFlags -> String
955pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags
956pgm_install_name_tool :: DynFlags -> String
957pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags
958pgm_ranlib            :: DynFlags -> String
959pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags
960pgm_lo                :: DynFlags -> (String,[Option])
961pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags
962pgm_lc                :: DynFlags -> (String,[Option])
963pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags
964pgm_i                 :: DynFlags -> String
965pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags
966opt_L                 :: DynFlags -> [String]
967opt_L dflags = toolSettings_opt_L $ toolSettings dflags
968opt_P                 :: DynFlags -> [String]
969opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
970            ++ toolSettings_opt_P (toolSettings dflags)
971
972-- This function packages everything that's needed to fingerprint opt_P
973-- flags. See Note [Repeated -optP hashing].
974opt_P_signature       :: DynFlags -> ([String], Fingerprint)
975opt_P_signature dflags =
976  ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
977  , toolSettings_opt_P_fingerprint $ toolSettings dflags
978  )
979
980opt_F                 :: DynFlags -> [String]
981opt_F dflags= toolSettings_opt_F $ toolSettings dflags
982opt_c                 :: DynFlags -> [String]
983opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
984            ++ toolSettings_opt_c (toolSettings dflags)
985opt_cxx               :: DynFlags -> [String]
986opt_cxx dflags= toolSettings_opt_cxx $ toolSettings dflags
987opt_a                 :: DynFlags -> [String]
988opt_a dflags= toolSettings_opt_a $ toolSettings dflags
989opt_l                 :: DynFlags -> [String]
990opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
991            ++ toolSettings_opt_l (toolSettings dflags)
992opt_lm                :: DynFlags -> [String]
993opt_lm dflags= toolSettings_opt_lm $ toolSettings dflags
994opt_windres           :: DynFlags -> [String]
995opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags
996opt_lcc                :: DynFlags -> [String]
997opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags
998opt_lo                :: DynFlags -> [String]
999opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags
1000opt_lc                :: DynFlags -> [String]
1001opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
1002opt_i                 :: DynFlags -> [String]
1003opt_i dflags= toolSettings_opt_i $ toolSettings dflags
1004
1005-- | The directory for this version of ghc in the user's app directory
1006-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
1007--
1008versionedAppDir :: String -> PlatformMini -> MaybeT IO FilePath
1009versionedAppDir appname platform = do
1010  -- Make sure we handle the case the HOME isn't set (see #11678)
1011  appdir <- tryMaybeT $ getAppUserDataDirectory appname
1012  return $ appdir </> versionedFilePath platform
1013
1014versionedFilePath :: PlatformMini -> FilePath
1015versionedFilePath platform = uniqueSubdir platform
1016
1017-- | The target code type of the compilation (if any).
1018--
1019-- Whenever you change the target, also make sure to set 'ghcLink' to
1020-- something sensible.
1021--
1022-- 'HscNothing' can be used to avoid generating any output, however, note
1023-- that:
1024--
1025--  * If a program uses Template Haskell the typechecker may need to run code
1026--    from an imported module.  To facilitate this, code generation is enabled
1027--    for modules imported by modules that use template haskell.
1028--    See Note [-fno-code mode].
1029--
1030data HscTarget
1031  = HscC           -- ^ Generate C code.
1032  | HscAsm         -- ^ Generate assembly using the native code generator.
1033  | HscLlvm        -- ^ Generate assembly using the llvm code generator.
1034  | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')
1035  | HscNothing     -- ^ Don't generate any code.  See notes above.
1036  deriving (Eq, Show)
1037
1038-- | Will this target result in an object file on the disk?
1039isObjectTarget :: HscTarget -> Bool
1040isObjectTarget HscC     = True
1041isObjectTarget HscAsm   = True
1042isObjectTarget HscLlvm  = True
1043isObjectTarget _        = False
1044
1045-- | Does this target retain *all* top-level bindings for a module,
1046-- rather than just the exported bindings, in the TypeEnv and compiled
1047-- code (if any)?  In interpreted mode we do this, so that GHCi can
1048-- call functions inside a module.  In HscNothing mode we also do it,
1049-- so that Haddock can get access to the GlobalRdrEnv for a module
1050-- after typechecking it.
1051targetRetainsAllBindings :: HscTarget -> Bool
1052targetRetainsAllBindings HscInterpreted = True
1053targetRetainsAllBindings HscNothing     = True
1054targetRetainsAllBindings _              = False
1055
1056-- | The 'GhcMode' tells us whether we're doing multi-module
1057-- compilation (controlled via the "GHC" API) or one-shot
1058-- (single-module) compilation.  This makes a difference primarily to
1059-- the "GHC.Driver.Finder": in one-shot mode we look for interface files for
1060-- imported modules, but in multi-module mode we look for source files
1061-- in order to check whether they need to be recompiled.
1062data GhcMode
1063  = CompManager         -- ^ @\-\-make@, GHCi, etc.
1064  | OneShot             -- ^ @ghc -c Foo.hs@
1065  | MkDepend            -- ^ @ghc -M@, see "GHC.Driver.Finder" for why we need this
1066  deriving Eq
1067
1068instance Outputable GhcMode where
1069  ppr CompManager = text "CompManager"
1070  ppr OneShot     = text "OneShot"
1071  ppr MkDepend    = text "MkDepend"
1072
1073isOneShot :: GhcMode -> Bool
1074isOneShot OneShot = True
1075isOneShot _other  = False
1076
1077-- | What to do in the link step, if there is one.
1078data GhcLink
1079  = NoLink              -- ^ Don't link at all
1080  | LinkBinary          -- ^ Link object code into a binary
1081  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both
1082                        --   bytecode and object code).
1083  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
1084  | LinkStaticLib       -- ^ Link objects into a static lib
1085  deriving (Eq, Show)
1086
1087isNoLink :: GhcLink -> Bool
1088isNoLink NoLink = True
1089isNoLink _      = False
1090
1091-- | We accept flags which make packages visible, but how they select
1092-- the package varies; this data type reflects what selection criterion
1093-- is used.
1094data PackageArg =
1095      PackageArg String    -- ^ @-package@, by 'PackageName'
1096    | UnitIdArg Unit       -- ^ @-package-id@, by 'Unit'
1097  deriving (Eq, Show)
1098
1099instance Outputable PackageArg where
1100    ppr (PackageArg pn) = text "package" <+> text pn
1101    ppr (UnitIdArg uid) = text "unit" <+> ppr uid
1102
1103-- | Represents the renaming that may be associated with an exposed
1104-- package, e.g. the @rns@ part of @-package "foo (rns)"@.
1105--
1106-- Here are some example parsings of the package flags (where
1107-- a string literal is punned to be a 'ModuleName':
1108--
1109--      * @-package foo@ is @ModRenaming True []@
1110--      * @-package foo ()@ is @ModRenaming False []@
1111--      * @-package foo (A)@ is @ModRenaming False [("A", "A")]@
1112--      * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@
1113--      * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@
1114data ModRenaming = ModRenaming {
1115    modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
1116    modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
1117                                               --   under name @n@.
1118  } deriving (Eq)
1119instance Outputable ModRenaming where
1120    ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
1121
1122-- | Flags for manipulating the set of non-broken packages.
1123newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@
1124  deriving (Eq)
1125
1126-- | Flags for manipulating package trust.
1127data TrustFlag
1128  = TrustPackage    String -- ^ @-trust@
1129  | DistrustPackage String -- ^ @-distrust@
1130  deriving (Eq)
1131
1132-- | Flags for manipulating packages visibility.
1133data PackageFlag
1134  = ExposePackage   String PackageArg ModRenaming -- ^ @-package@, @-package-id@
1135  | HidePackage     String -- ^ @-hide-package@
1136  deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
1137
1138data PackageDBFlag
1139  = PackageDB PkgDbRef
1140  | NoUserPackageDB
1141  | NoGlobalPackageDB
1142  | ClearPackageDBs
1143  deriving (Eq)
1144
1145packageFlagsChanged :: DynFlags -> DynFlags -> Bool
1146packageFlagsChanged idflags1 idflags0 =
1147  packageFlags idflags1 /= packageFlags idflags0 ||
1148  ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||
1149  pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||
1150  trustFlags idflags1 /= trustFlags idflags0 ||
1151  packageDBFlags idflags1 /= packageDBFlags idflags0 ||
1152  packageGFlags idflags1 /= packageGFlags idflags0
1153 where
1154   packageGFlags dflags = map (`gopt` dflags)
1155     [ Opt_HideAllPackages
1156     , Opt_HideAllPluginPackages
1157     , Opt_AutoLinkPackages ]
1158
1159instance Outputable PackageFlag where
1160    ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
1161    ppr (HidePackage str) = text "-hide-package" <+> text str
1162
1163-- | The 'HscTarget' value corresponding to the default way to create
1164-- object files on the current platform.
1165
1166defaultHscTarget :: Platform -> HscTarget
1167defaultHscTarget platform
1168  | platformUnregisterised platform        = HscC
1169  | NCG <- platformDefaultBackend platform = HscAsm
1170  | otherwise = HscLlvm
1171
1172defaultObjectTarget :: DynFlags -> HscTarget
1173defaultObjectTarget dflags = defaultHscTarget
1174  (targetPlatform dflags)
1175
1176data DynLibLoader
1177  = Deployable
1178  | SystemDependent
1179  deriving Eq
1180
1181data RtsOptsEnabled
1182  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
1183  | RtsOptsAll
1184  deriving (Show)
1185
1186-- | Are we building with @-fPIE@ or @-fPIC@ enabled?
1187positionIndependent :: DynFlags -> Bool
1188positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
1189
1190whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
1191whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())
1192
1193ifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
1194ifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g
1195
1196whenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
1197whenCannotGenerateDynamicToo dflags f
1198    = ifCannotGenerateDynamicToo dflags f (return ())
1199
1200ifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
1201ifCannotGenerateDynamicToo dflags f g
1202    = generateDynamicTooConditional dflags g f g
1203
1204generateDynamicTooConditional :: MonadIO m
1205                              => DynFlags -> m a -> m a -> m a -> m a
1206generateDynamicTooConditional dflags canGen cannotGen notTryingToGen
1207    = if gopt Opt_BuildDynamicToo dflags
1208      then do let ref = canGenerateDynamicToo dflags
1209              b <- liftIO $ readIORef ref
1210              if b then canGen else cannotGen
1211      else notTryingToGen
1212
1213dynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags
1214dynamicTooMkDynamicDynFlags dflags0
1215    = let dflags1 = addWay' WayDyn dflags0
1216          dflags2 = dflags1 {
1217                        outputFile = dynOutputFile dflags1,
1218                        hiSuf = dynHiSuf dflags1,
1219                        objectSuf = dynObjectSuf dflags1
1220                    }
1221          dflags3 = gopt_unset dflags2 Opt_BuildDynamicToo
1222      in dflags3
1223
1224-- | Compute the path of the dynamic object corresponding to an object file.
1225dynamicOutputFile :: DynFlags -> FilePath -> FilePath
1226dynamicOutputFile dflags outputFile = dynOut outputFile
1227  where
1228    dynOut = flip addExtension (dynObjectSuf dflags) . dropExtension
1229
1230-----------------------------------------------------------------------------
1231
1232-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
1233initDynFlags :: DynFlags -> IO DynFlags
1234initDynFlags dflags = do
1235 let -- We can't build with dynamic-too on Windows, as labels before
1236     -- the fork point are different depending on whether we are
1237     -- building dynamically or not.
1238     platformCanGenerateDynamicToo
1239         = platformOS (targetPlatform dflags) /= OSMinGW32
1240 refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo
1241 refNextTempSuffix <- newIORef 0
1242 refFilesToClean <- newIORef emptyFilesToClean
1243 refDirsToClean <- newIORef Map.empty
1244 refGeneratedDumps <- newIORef Set.empty
1245 refRtldInfo <- newIORef Nothing
1246 refRtccInfo <- newIORef Nothing
1247 wrapperNum <- newIORef emptyModuleEnv
1248 canUseUnicode <- do let enc = localeEncoding
1249                         str = "‘’"
1250                     (withCString enc str $ \cstr ->
1251                          do str' <- peekCString enc cstr
1252                             return (str == str'))
1253                         `catchIOError` \_ -> return False
1254 ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
1255 let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
1256 maybeGhcColorsEnv  <- lookupEnv "GHC_COLORS"
1257 maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
1258 let adjustCols (Just env) = Col.parseScheme env
1259     adjustCols Nothing    = id
1260 let (useColor', colScheme') =
1261       (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)
1262       (useColor dflags, colScheme dflags)
1263 return dflags{
1264        canGenerateDynamicToo = refCanGenerateDynamicToo,
1265        nextTempSuffix = refNextTempSuffix,
1266        filesToClean   = refFilesToClean,
1267        dirsToClean    = refDirsToClean,
1268        generatedDumps = refGeneratedDumps,
1269        nextWrapperNum = wrapperNum,
1270        useUnicode    = useUnicode',
1271        useColor      = useColor',
1272        canUseColor   = stderrSupportsAnsiColors,
1273        colScheme     = colScheme',
1274        rtldInfo      = refRtldInfo,
1275        rtccInfo      = refRtccInfo
1276        }
1277
1278-- | The normal 'DynFlags'. Note that they are not suitable for use in this form
1279-- and must be fully initialized by 'GHC.runGhc' first.
1280defaultDynFlags :: Settings -> LlvmConfig -> DynFlags
1281defaultDynFlags mySettings llvmConfig =
1282-- See Note [Updating flag description in the User's Guide]
1283     DynFlags {
1284        ghcMode                 = CompManager,
1285        ghcLink                 = LinkBinary,
1286        hscTarget               = defaultHscTarget (sTargetPlatform mySettings),
1287        verbosity               = 0,
1288        optLevel                = 0,
1289        debugLevel              = 0,
1290        simplPhases             = 2,
1291        maxSimplIterations      = 4,
1292        ruleCheck               = Nothing,
1293        inlineCheck             = Nothing,
1294        binBlobThreshold        = 500000, -- 500K is a good default (see #16190)
1295        maxRelevantBinds        = Just 6,
1296        maxValidHoleFits   = Just 6,
1297        maxRefHoleFits     = Just 6,
1298        refLevelHoleFits   = Nothing,
1299        maxUncoveredPatterns    = 4,
1300        maxPmCheckModels        = 30,
1301        simplTickFactor         = 100,
1302        specConstrThreshold     = Just 2000,
1303        specConstrCount         = Just 3,
1304        specConstrRecursive     = 3,
1305        liberateCaseThreshold   = Just 2000,
1306        floatLamArgs            = Just 0, -- Default: float only if no fvs
1307        liftLamsRecArgs         = Just 5, -- Default: the number of available argument hardware registers on x86_64
1308        liftLamsNonRecArgs      = Just 5, -- Default: the number of available argument hardware registers on x86_64
1309        liftLamsKnown           = False,  -- Default: don't turn known calls into unknown ones
1310        cmmProcAlignment        = Nothing,
1311
1312        historySize             = 20,
1313        strictnessBefore        = [],
1314
1315        parMakeCount            = Just 1,
1316
1317        enableTimeStats         = False,
1318        ghcHeapSize             = Nothing,
1319
1320        importPaths             = ["."],
1321        mainModIs               = mAIN,
1322        mainFunIs               = Nothing,
1323        reductionDepth          = treatZeroAsInf mAX_REDUCTION_DEPTH,
1324        solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,
1325
1326        homeUnitId              = mainUnitId,
1327        homeUnitInstanceOfId    = Nothing,
1328        homeUnitInstantiations  = [],
1329
1330        objectDir               = Nothing,
1331        dylibInstallName        = Nothing,
1332        hiDir                   = Nothing,
1333        hieDir                  = Nothing,
1334        stubDir                 = Nothing,
1335        dumpDir                 = Nothing,
1336
1337        objectSuf               = phaseInputExt StopLn,
1338        hcSuf                   = phaseInputExt HCc,
1339        hiSuf                   = "hi",
1340        hieSuf                  = "hie",
1341
1342        canGenerateDynamicToo   = panic "defaultDynFlags: No canGenerateDynamicToo",
1343        dynObjectSuf            = "dyn_" ++ phaseInputExt StopLn,
1344        dynHiSuf                = "dyn_hi",
1345
1346        pluginModNames          = [],
1347        pluginModNameOpts       = [],
1348        frontendPluginOpts      = [],
1349        cachedPlugins           = [],
1350        staticPlugins           = [],
1351        hooks                   = emptyHooks,
1352
1353        outputFile              = Nothing,
1354        dynOutputFile           = Nothing,
1355        outputHi                = Nothing,
1356        dynLibLoader            = SystemDependent,
1357        dumpPrefix              = Nothing,
1358        dumpPrefixForce         = Nothing,
1359        ldInputs                = [],
1360        includePaths            = IncludeSpecs [] [],
1361        libraryPaths            = [],
1362        frameworkPaths          = [],
1363        cmdlineFrameworks       = [],
1364        rtsOpts                 = Nothing,
1365        rtsOptsEnabled          = RtsOptsSafeOnly,
1366        rtsOptsSuggestions      = True,
1367
1368        hpcDir                  = ".hpc",
1369
1370        packageDBFlags          = [],
1371        packageFlags            = [],
1372        pluginPackageFlags      = [],
1373        ignorePackageFlags      = [],
1374        trustFlags              = [],
1375        packageEnv              = Nothing,
1376        unitDatabases           = Nothing,
1377        unitState               = emptyUnitState,
1378        ways                    = defaultWays mySettings,
1379        splitInfo               = Nothing,
1380
1381        ghcNameVersion = sGhcNameVersion mySettings,
1382        fileSettings = sFileSettings mySettings,
1383        toolSettings = sToolSettings mySettings,
1384        targetPlatform = sTargetPlatform mySettings,
1385        platformMisc = sPlatformMisc mySettings,
1386        platformConstants = sPlatformConstants mySettings,
1387        rawSettings = sRawSettings mySettings,
1388
1389        -- See Note [LLVM configuration].
1390        llvmConfig              = llvmConfig,
1391
1392        -- ghc -M values
1393        depMakefile       = "Makefile",
1394        depIncludePkgDeps = False,
1395        depIncludeCppDeps = False,
1396        depExcludeMods    = [],
1397        depSuffixes       = [],
1398        -- end of ghc -M values
1399        nextTempSuffix = panic "defaultDynFlags: No nextTempSuffix",
1400        filesToClean   = panic "defaultDynFlags: No filesToClean",
1401        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
1402        generatedDumps = panic "defaultDynFlags: No generatedDumps",
1403        ghcVersionFile = Nothing,
1404        haddockOptions = Nothing,
1405        dumpFlags = EnumSet.empty,
1406        generalFlags = EnumSet.fromList (defaultFlags mySettings),
1407        warningFlags = EnumSet.fromList standardWarnings,
1408        fatalWarningFlags = EnumSet.empty,
1409        ghciScripts = [],
1410        language = Nothing,
1411        safeHaskell = Sf_None,
1412        safeInfer   = True,
1413        safeInferred = True,
1414        thOnLoc = noSrcSpan,
1415        newDerivOnLoc = noSrcSpan,
1416        overlapInstLoc = noSrcSpan,
1417        incoherentOnLoc = noSrcSpan,
1418        pkgTrustOnLoc = noSrcSpan,
1419        warnSafeOnLoc = noSrcSpan,
1420        warnUnsafeOnLoc = noSrcSpan,
1421        trustworthyOnLoc = noSrcSpan,
1422        extensions = [],
1423        extensionFlags = flattenExtensionFlags Nothing [],
1424
1425        ufCreationThreshold = 750,
1426           -- The ufCreationThreshold threshold must be reasonably high
1427           -- to take account of possible discounts.
1428           -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to
1429           -- inline into Csg.calc (The unfolding for sqr never makes it
1430           -- into the interface file.)
1431
1432        ufUseThreshold = 90,
1433           -- Last adjusted upwards in #18282, when I reduced
1434           -- the result discount for constructors.
1435
1436        ufFunAppDiscount = 60,
1437           -- Be fairly keen to inline a function if that means
1438           -- we'll be able to pick the right method from a dictionary
1439
1440        ufDictDiscount      = 30,
1441        ufDearOp            = 40,
1442        ufVeryAggressive    = False,
1443
1444        maxWorkerArgs = 10,
1445
1446        ghciHistSize = 50, -- keep a log of length 50 by default
1447
1448        -- Logging
1449
1450        log_action   = defaultLogAction,
1451        dump_action  = defaultDumpAction,
1452        trace_action = defaultTraceAction,
1453
1454        flushOut = defaultFlushOut,
1455        flushErr = defaultFlushErr,
1456        pprUserLength = 5,
1457        pprCols = 100,
1458        useUnicode = False,
1459        useColor = Auto,
1460        canUseColor = False,
1461        colScheme = Col.defaultScheme,
1462        profAuto = NoProfAuto,
1463        interactivePrint = Nothing,
1464        nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
1465        sseVersion = Nothing,
1466        bmiVersion = Nothing,
1467        avx = False,
1468        avx2 = False,
1469        avx512cd = False,
1470        avx512er = False,
1471        avx512f = False,
1472        avx512pf = False,
1473        rtldInfo = panic "defaultDynFlags: no rtldInfo",
1474        rtccInfo = panic "defaultDynFlags: no rtccInfo",
1475
1476        maxInlineAllocSize = 128,
1477        maxInlineMemcpyInsns = 32,
1478        maxInlineMemsetInsns = 32,
1479
1480        initialUnique = 0,
1481        uniqueIncrement = 1,
1482
1483        reverseErrors = False,
1484        maxErrors     = Nothing,
1485        cfgWeightInfo = defaultCfgWeights
1486      }
1487
1488defaultWays :: Settings -> Set Way
1489defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
1490                       then Set.singleton WayDyn
1491                       else Set.empty
1492
1493--------------------------------------------------------------------------
1494--
1495-- Note [JSON Error Messages]
1496--
1497-- When the user requests the compiler output to be dumped as json
1498-- we used to collect them all in an IORef and then print them at the end.
1499-- This doesn't work very well with GHCi. (See #14078) So instead we now
1500-- use the simpler method of just outputting a JSON document inplace to
1501-- stdout.
1502--
1503-- Before the compiler calls log_action, it has already turned the `ErrMsg`
1504-- into a formatted message. This means that we lose some possible
1505-- information to provide to the user but refactoring log_action is quite
1506-- invasive as it is called in many places. So, for now I left it alone
1507-- and we can refine its behaviour as users request different output.
1508
1509type FatalMessager = String -> IO ()
1510
1511type LogAction = DynFlags
1512              -> WarnReason
1513              -> Severity
1514              -> SrcSpan
1515              -> MsgDoc
1516              -> IO ()
1517
1518defaultFatalMessager :: FatalMessager
1519defaultFatalMessager = hPutStrLn stderr
1520
1521
1522-- See Note [JSON Error Messages]
1523--
1524jsonLogAction :: LogAction
1525jsonLogAction dflags reason severity srcSpan msg
1526  = do
1527    defaultLogActionHPutStrDoc dflags stdout
1528      (withPprStyle (mkCodeStyle CStyle) (doc $$ text ""))
1529    where
1530      doc = renderJSON $
1531              JSObject [ ( "span", json srcSpan )
1532                       , ( "doc" , JSString (showSDoc dflags msg) )
1533                       , ( "severity", json severity )
1534                       , ( "reason" ,   json reason )
1535                       ]
1536
1537
1538defaultLogAction :: LogAction
1539defaultLogAction dflags reason severity srcSpan msg
1540    = case severity of
1541      SevOutput      -> printOut msg
1542      SevDump        -> printOut (msg $$ blankLine)
1543      SevInteractive -> putStrSDoc msg
1544      SevInfo        -> printErrs msg
1545      SevFatal       -> printErrs msg
1546      SevWarning     -> printWarns
1547      SevError       -> printWarns
1548    where
1549      printOut   = defaultLogActionHPrintDoc  dflags stdout
1550      printErrs  = defaultLogActionHPrintDoc  dflags stderr
1551      putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
1552      -- Pretty print the warning flag, if any (#10752)
1553      message = mkLocMessageAnn flagMsg severity srcSpan msg
1554
1555      printWarns = do
1556        hPutChar stderr '\n'
1557        caretDiagnostic <-
1558            if gopt Opt_DiagnosticsShowCaret dflags
1559            then getCaretDiagnostic severity srcSpan
1560            else pure empty
1561        printErrs $ getPprStyle $ \style ->
1562          withPprStyle (setStyleColoured True style)
1563            (message $+$ caretDiagnostic)
1564        -- careful (#2302): printErrs prints in UTF-8,
1565        -- whereas converting to string first and using
1566        -- hPutStr would just emit the low 8 bits of
1567        -- each unicode char.
1568
1569      flagMsg =
1570        case reason of
1571          NoReason -> Nothing
1572          Reason wflag -> do
1573            spec <- flagSpecOf wflag
1574            return ("-W" ++ flagSpecName spec ++ warnFlagGrp wflag)
1575          ErrReason Nothing ->
1576            return "-Werror"
1577          ErrReason (Just wflag) -> do
1578            spec <- flagSpecOf wflag
1579            return $
1580              "-W" ++ flagSpecName spec ++ warnFlagGrp wflag ++
1581              ", -Werror=" ++ flagSpecName spec
1582
1583      warnFlagGrp flag
1584          | gopt Opt_ShowWarnGroups dflags =
1585                case smallestGroups flag of
1586                    [] -> ""
1587                    groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"
1588          | otherwise = ""
1589
1590-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
1591defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> IO ()
1592defaultLogActionHPrintDoc dflags h d
1593 = defaultLogActionHPutStrDoc dflags h (d $$ text "")
1594
1595defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> IO ()
1596defaultLogActionHPutStrDoc dflags h d
1597  -- Don't add a newline at the end, so that successive
1598  -- calls to this log-action can output all on the same line
1599  = printSDoc ctx Pretty.PageMode h d
1600    where ctx = initSDocContext dflags defaultUserStyle
1601
1602newtype FlushOut = FlushOut (IO ())
1603
1604defaultFlushOut :: FlushOut
1605defaultFlushOut = FlushOut $ hFlush stdout
1606
1607newtype FlushErr = FlushErr (IO ())
1608
1609defaultFlushErr :: FlushErr
1610defaultFlushErr = FlushErr $ hFlush stderr
1611
1612{-
1613Note [Verbosity levels]
1614~~~~~~~~~~~~~~~~~~~~~~~
1615    0   |   print errors & warnings only
1616    1   |   minimal verbosity: print "compiling M ... done." for each module.
1617    2   |   equivalent to -dshow-passes
1618    3   |   equivalent to existing "ghc -v"
1619    4   |   "ghc -v -ddump-most"
1620    5   |   "ghc -v -ddump-all"
1621-}
1622
1623data OnOff a = On a
1624             | Off a
1625  deriving (Eq, Show)
1626
1627instance Outputable a => Outputable (OnOff a) where
1628  ppr (On x)  = text "On" <+> ppr x
1629  ppr (Off x) = text "Off" <+> ppr x
1630
1631-- OnOffs accumulate in reverse order, so we use foldr in order to
1632-- process them in the right order
1633flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension
1634flattenExtensionFlags ml = foldr f defaultExtensionFlags
1635    where f (On f)  flags = EnumSet.insert f flags
1636          f (Off f) flags = EnumSet.delete f flags
1637          defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)
1638
1639-- | The language extensions implied by the various language variants.
1640-- When updating this be sure to update the flag documentation in
1641-- @docs/users_guide/exts@.
1642languageExtensions :: Maybe Language -> [LangExt.Extension]
1643
1644languageExtensions Nothing
1645    -- Nothing => the default case
1646    = LangExt.NondecreasingIndentation -- This has been on by default for some time
1647    : delete LangExt.DatatypeContexts  -- The Haskell' committee decided to
1648                                       -- remove datatype contexts from the
1649                                       -- language:
1650   -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html
1651      (languageExtensions (Just Haskell2010))
1652
1653   -- NB: MonoPatBinds is no longer the default
1654
1655languageExtensions (Just Haskell98)
1656    = [LangExt.ImplicitPrelude,
1657       -- See Note [When is StarIsType enabled]
1658       LangExt.StarIsType,
1659       LangExt.CUSKs,
1660       LangExt.MonomorphismRestriction,
1661       LangExt.NPlusKPatterns,
1662       LangExt.DatatypeContexts,
1663       LangExt.TraditionalRecordSyntax,
1664       LangExt.NondecreasingIndentation
1665           -- strictly speaking non-standard, but we always had this
1666           -- on implicitly before the option was added in 7.1, and
1667           -- turning it off breaks code, so we're keeping it on for
1668           -- backwards compatibility.  Cabal uses -XHaskell98 by
1669           -- default unless you specify another language.
1670      ]
1671
1672languageExtensions (Just Haskell2010)
1673    = [LangExt.ImplicitPrelude,
1674       -- See Note [When is StarIsType enabled]
1675       LangExt.StarIsType,
1676       LangExt.CUSKs,
1677       LangExt.MonomorphismRestriction,
1678       LangExt.DatatypeContexts,
1679       LangExt.TraditionalRecordSyntax,
1680       LangExt.EmptyDataDecls,
1681       LangExt.ForeignFunctionInterface,
1682       LangExt.PatternGuards,
1683       LangExt.DoAndIfThenElse,
1684       LangExt.RelaxedPolyRec]
1685
1686hasPprDebug :: DynFlags -> Bool
1687hasPprDebug = dopt Opt_D_ppr_debug
1688
1689hasNoDebugOutput :: DynFlags -> Bool
1690hasNoDebugOutput = dopt Opt_D_no_debug_output
1691
1692hasNoStateHack :: DynFlags -> Bool
1693hasNoStateHack = gopt Opt_G_NoStateHack
1694
1695hasNoOptCoercion :: DynFlags -> Bool
1696hasNoOptCoercion = gopt Opt_G_NoOptCoercion
1697
1698
1699-- | Test whether a 'DumpFlag' is set
1700dopt :: DumpFlag -> DynFlags -> Bool
1701dopt f dflags = (f `EnumSet.member` dumpFlags dflags)
1702             || (verbosity dflags >= 4 && enableIfVerbose f)
1703    where enableIfVerbose Opt_D_dump_tc_trace               = False
1704          enableIfVerbose Opt_D_dump_rn_trace               = False
1705          enableIfVerbose Opt_D_dump_cs_trace               = False
1706          enableIfVerbose Opt_D_dump_if_trace               = False
1707          enableIfVerbose Opt_D_dump_vt_trace               = False
1708          enableIfVerbose Opt_D_dump_tc                     = False
1709          enableIfVerbose Opt_D_dump_rn                     = False
1710          enableIfVerbose Opt_D_dump_rn_stats               = False
1711          enableIfVerbose Opt_D_dump_hi_diffs               = False
1712          enableIfVerbose Opt_D_verbose_core2core           = False
1713          enableIfVerbose Opt_D_verbose_stg2stg             = False
1714          enableIfVerbose Opt_D_dump_splices                = False
1715          enableIfVerbose Opt_D_th_dec_file                 = False
1716          enableIfVerbose Opt_D_dump_rule_firings           = False
1717          enableIfVerbose Opt_D_dump_rule_rewrites          = False
1718          enableIfVerbose Opt_D_dump_simpl_trace            = False
1719          enableIfVerbose Opt_D_dump_rtti                   = False
1720          enableIfVerbose Opt_D_dump_inlinings              = False
1721          enableIfVerbose Opt_D_dump_core_stats             = False
1722          enableIfVerbose Opt_D_dump_asm_stats              = False
1723          enableIfVerbose Opt_D_dump_types                  = False
1724          enableIfVerbose Opt_D_dump_simpl_iterations       = False
1725          enableIfVerbose Opt_D_dump_ticked                 = False
1726          enableIfVerbose Opt_D_dump_view_pattern_commoning = False
1727          enableIfVerbose Opt_D_dump_mod_cycles             = False
1728          enableIfVerbose Opt_D_dump_mod_map                = False
1729          enableIfVerbose Opt_D_dump_ec_trace               = False
1730          enableIfVerbose _                                 = True
1731
1732-- | Set a 'DumpFlag'
1733dopt_set :: DynFlags -> DumpFlag -> DynFlags
1734dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }
1735
1736-- | Unset a 'DumpFlag'
1737dopt_unset :: DynFlags -> DumpFlag -> DynFlags
1738dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }
1739
1740-- | Test whether a 'GeneralFlag' is set
1741gopt :: GeneralFlag -> DynFlags -> Bool
1742gopt f dflags  = f `EnumSet.member` generalFlags dflags
1743
1744-- | Set a 'GeneralFlag'
1745gopt_set :: DynFlags -> GeneralFlag -> DynFlags
1746gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }
1747
1748-- | Unset a 'GeneralFlag'
1749gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
1750gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }
1751
1752-- | Test whether a 'WarningFlag' is set
1753wopt :: WarningFlag -> DynFlags -> Bool
1754wopt f dflags  = f `EnumSet.member` warningFlags dflags
1755
1756-- | Set a 'WarningFlag'
1757wopt_set :: DynFlags -> WarningFlag -> DynFlags
1758wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }
1759
1760-- | Unset a 'WarningFlag'
1761wopt_unset :: DynFlags -> WarningFlag -> DynFlags
1762wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }
1763
1764-- | Test whether a 'WarningFlag' is set as fatal
1765wopt_fatal :: WarningFlag -> DynFlags -> Bool
1766wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags
1767
1768-- | Mark a 'WarningFlag' as fatal (do not set the flag)
1769wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
1770wopt_set_fatal dfs f
1771    = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }
1772
1773-- | Mark a 'WarningFlag' as not fatal
1774wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
1775wopt_unset_fatal dfs f
1776    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
1777
1778-- | Test whether a 'LangExt.Extension' is set
1779xopt :: LangExt.Extension -> DynFlags -> Bool
1780xopt f dflags = f `EnumSet.member` extensionFlags dflags
1781
1782-- | Set a 'LangExt.Extension'
1783xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
1784xopt_set dfs f
1785    = let onoffs = On f : extensions dfs
1786      in dfs { extensions = onoffs,
1787               extensionFlags = flattenExtensionFlags (language dfs) onoffs }
1788
1789-- | Unset a 'LangExt.Extension'
1790xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags
1791xopt_unset dfs f
1792    = let onoffs = Off f : extensions dfs
1793      in dfs { extensions = onoffs,
1794               extensionFlags = flattenExtensionFlags (language dfs) onoffs }
1795
1796-- | Set or unset a 'LangExt.Extension', unless it has been explicitly
1797--   set or unset before.
1798xopt_set_unlessExplSpec
1799        :: LangExt.Extension
1800        -> (DynFlags -> LangExt.Extension -> DynFlags)
1801        -> DynFlags -> DynFlags
1802xopt_set_unlessExplSpec ext setUnset dflags =
1803    let referedExts = stripOnOff <$> extensions dflags
1804        stripOnOff (On x)  = x
1805        stripOnOff (Off x) = x
1806    in
1807        if ext `elem` referedExts then dflags else setUnset dflags ext
1808
1809lang_set :: DynFlags -> Maybe Language -> DynFlags
1810lang_set dflags lang =
1811   dflags {
1812            language = lang,
1813            extensionFlags = flattenExtensionFlags lang (extensions dflags)
1814          }
1815
1816-- | Set the Haskell language standard to use
1817setLanguage :: Language -> DynP ()
1818setLanguage l = upd (`lang_set` Just l)
1819
1820-- | Some modules have dependencies on others through the DynFlags rather than textual imports
1821dynFlagDependencies :: DynFlags -> [ModuleName]
1822dynFlagDependencies = pluginModNames
1823
1824-- | Is the -fpackage-trust mode on
1825packageTrustOn :: DynFlags -> Bool
1826packageTrustOn = gopt Opt_PackageTrust
1827
1828-- | Is Safe Haskell on in some way (including inference mode)
1829safeHaskellOn :: DynFlags -> Bool
1830safeHaskellOn dflags = safeHaskellModeEnabled dflags || safeInferOn dflags
1831
1832safeHaskellModeEnabled :: DynFlags -> Bool
1833safeHaskellModeEnabled dflags = safeHaskell dflags `elem` [Sf_Unsafe, Sf_Trustworthy
1834                                                   , Sf_Safe ]
1835
1836
1837-- | Is the Safe Haskell safe language in use
1838safeLanguageOn :: DynFlags -> Bool
1839safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
1840
1841-- | Is the Safe Haskell safe inference mode active
1842safeInferOn :: DynFlags -> Bool
1843safeInferOn = safeInfer
1844
1845-- | Test if Safe Imports are on in some form
1846safeImportsOn :: DynFlags -> Bool
1847safeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||
1848                       safeHaskell dflags == Sf_Trustworthy ||
1849                       safeHaskell dflags == Sf_Safe
1850
1851-- | Set a 'Safe Haskell' flag
1852setSafeHaskell :: SafeHaskellMode -> DynP ()
1853setSafeHaskell s = updM f
1854    where f dfs = do
1855              let sf = safeHaskell dfs
1856              safeM <- combineSafeFlags sf s
1857              case s of
1858                Sf_Safe -> return $ dfs { safeHaskell = safeM, safeInfer = False }
1859                -- leave safe inferrence on in Trustworthy mode so we can warn
1860                -- if it could have been inferred safe.
1861                Sf_Trustworthy -> do
1862                  l <- getCurLoc
1863                  return $ dfs { safeHaskell = safeM, trustworthyOnLoc = l }
1864                -- leave safe inference on in Unsafe mode as well.
1865                _ -> return $ dfs { safeHaskell = safeM }
1866
1867-- | Are all direct imports required to be safe for this Safe Haskell mode?
1868-- Direct imports are when the code explicitly imports a module
1869safeDirectImpsReq :: DynFlags -> Bool
1870safeDirectImpsReq d = safeLanguageOn d
1871
1872-- | Are all implicit imports required to be safe for this Safe Haskell mode?
1873-- Implicit imports are things in the prelude. e.g System.IO when print is used.
1874safeImplicitImpsReq :: DynFlags -> Bool
1875safeImplicitImpsReq d = safeLanguageOn d
1876
1877-- | Combine two Safe Haskell modes correctly. Used for dealing with multiple flags.
1878-- This makes Safe Haskell very much a monoid but for now I prefer this as I don't
1879-- want to export this functionality from the module but do want to export the
1880-- type constructors.
1881combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
1882combineSafeFlags a b | a == Sf_None         = return b
1883                     | b == Sf_None         = return a
1884                     | a == Sf_Ignore || b == Sf_Ignore = return Sf_Ignore
1885                     | a == b               = return a
1886                     | otherwise            = addErr errm >> pure a
1887    where errm = "Incompatible Safe Haskell flags! ("
1888                    ++ show a ++ ", " ++ show b ++ ")"
1889
1890-- | A list of unsafe flags under Safe Haskell. Tuple elements are:
1891--     * name of the flag
1892--     * function to get srcspan that enabled the flag
1893--     * function to test if the flag is on
1894--     * function to turn the flag off
1895unsafeFlags, unsafeFlagsForInfer
1896  :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
1897unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
1898                    xopt LangExt.GeneralizedNewtypeDeriving,
1899                    flip xopt_unset LangExt.GeneralizedNewtypeDeriving)
1900              , ("-XTemplateHaskell", thOnLoc,
1901                    xopt LangExt.TemplateHaskell,
1902                    flip xopt_unset LangExt.TemplateHaskell)
1903              ]
1904unsafeFlagsForInfer = unsafeFlags
1905
1906
1907-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
1908getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
1909        -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
1910        -> [a]                  -- ^ Correctly ordered extracted options
1911getOpts dflags opts = reverse (opts dflags)
1912        -- We add to the options from the front, so we need to reverse the list
1913
1914-- | Gets the verbosity flag for the current verbosity level. This is fed to
1915-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
1916getVerbFlags :: DynFlags -> [String]
1917getVerbFlags dflags
1918  | verbosity dflags >= 4 = ["-v"]
1919  | otherwise             = []
1920
1921setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,
1922         setDynObjectSuf, setDynHiSuf,
1923         setDylibInstallName,
1924         setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,
1925         setPgmP, addOptl, addOptc, addOptcxx, addOptP,
1926         addCmdlineFramework, addHaddockOpts, addGhciScript,
1927         setInteractivePrint
1928   :: String -> DynFlags -> DynFlags
1929setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
1930   :: Maybe String -> DynFlags -> DynFlags
1931
1932setObjectDir  f d = d { objectDir  = Just f}
1933setHiDir      f d = d { hiDir      = Just f}
1934setHieDir     f d = d { hieDir     = Just f}
1935setStubDir    f d = d { stubDir    = Just f
1936                      , includePaths = addGlobalInclude (includePaths d) [f] }
1937  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
1938  -- \#included from the .hc file when compiling via C (i.e. unregisterised
1939  -- builds).
1940setDumpDir    f d = d { dumpDir    = Just f}
1941setOutputDir  f = setObjectDir f
1942                . setHieDir f
1943                . setHiDir f
1944                . setStubDir f
1945                . setDumpDir f
1946setDylibInstallName  f d = d { dylibInstallName = Just f}
1947
1948setObjectSuf    f d = d { objectSuf    = f}
1949setDynObjectSuf f d = d { dynObjectSuf = f}
1950setHiSuf        f d = d { hiSuf        = f}
1951setHieSuf       f d = d { hieSuf       = f}
1952setDynHiSuf     f d = d { dynHiSuf     = f}
1953setHcSuf        f d = d { hcSuf        = f}
1954
1955setOutputFile f d = d { outputFile = f}
1956setDynOutputFile f d = d { dynOutputFile = f}
1957setOutputHi   f d = d { outputHi   = f}
1958
1959setJsonLogAction :: DynFlags -> DynFlags
1960setJsonLogAction d = d { log_action = jsonLogAction }
1961
1962-- | Make a module in home unit
1963mkHomeModule :: DynFlags -> ModuleName -> Module
1964mkHomeModule dflags = mkModule (homeUnit dflags)
1965
1966-- | Test if the module comes from the home unit
1967isHomeModule :: DynFlags -> Module -> Bool
1968isHomeModule dflags m = moduleUnit m == homeUnit dflags
1969
1970-- | Get home unit
1971homeUnit :: DynFlags -> Unit
1972homeUnit dflags =
1973   case (homeUnitInstanceOfId dflags, homeUnitInstantiations dflags) of
1974      (Nothing,[]) -> RealUnit (Definite (homeUnitId dflags))
1975      (Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
1976      (Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with")
1977      (Just u, is)
1978         -- detect fully indefinite units: all their instantiations are hole
1979         -- modules and the home unit id is the same as the instantiating unit
1980         -- id (see Note [About units] in GHC.Unit)
1981         | all (isHoleModule . snd) is && indefUnit u == homeUnitId dflags
1982         -> mkVirtUnit (updateIndefUnitId (unitState dflags) u) is
1983         -- otherwise it must be that we compile a fully definite units
1984         -- TODO: error when the unit is partially instantiated??
1985         | otherwise
1986         -> RealUnit (Definite (homeUnitId dflags))
1987
1988parseUnitInsts :: String -> Instantiations
1989parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
1990    [(r, "")] -> r
1991    _ -> throwGhcException $ CmdLineError ("Can't parse -instantiated-with: " ++ str)
1992  where parse = sepBy parseEntry (R.char ',')
1993        parseEntry = do
1994            n <- parseModuleName
1995            _ <- R.char '='
1996            m <- parseHoleyModule
1997            return (n, m)
1998
1999setUnitInstantiations :: String -> DynFlags -> DynFlags
2000setUnitInstantiations s d =
2001    d { homeUnitInstantiations = parseUnitInsts s }
2002
2003setUnitInstanceOf :: String -> DynFlags -> DynFlags
2004setUnitInstanceOf s d =
2005    d { homeUnitInstanceOfId = Just (Indefinite (UnitId (fsLit s)) Nothing) }
2006
2007addPluginModuleName :: String -> DynFlags -> DynFlags
2008addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
2009
2010clearPluginModuleNames :: DynFlags -> DynFlags
2011clearPluginModuleNames d =
2012    d { pluginModNames = []
2013      , pluginModNameOpts = []
2014      , cachedPlugins = [] }
2015
2016addPluginModuleNameOption :: String -> DynFlags -> DynFlags
2017addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
2018  where (m, rest) = break (== ':') optflag
2019        option = case rest of
2020          [] -> "" -- should probably signal an error
2021          (_:plug_opt) -> plug_opt -- ignore the ':' from break
2022
2023addFrontendPluginOption :: String -> DynFlags -> DynFlags
2024addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d }
2025
2026parseDynLibLoaderMode f d =
2027 case splitAt 8 f of
2028   ("deploy", "")       -> d { dynLibLoader = Deployable }
2029   ("sysdep", "")       -> d { dynLibLoader = SystemDependent }
2030   _                    -> throwGhcException (CmdLineError ("Unknown dynlib loader: " ++ f))
2031
2032setDumpPrefixForce f d = d { dumpPrefixForce = f}
2033
2034-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
2035-- Config.hs should really use Option.
2036setPgmP   f = alterToolSettings (\s -> s { toolSettings_pgm_P   = (pgm, map Option args)})
2037  where (pgm:args) = words f
2038addOptl   f = alterToolSettings (\s -> s { toolSettings_opt_l   = f : toolSettings_opt_l s})
2039addOptc   f = alterToolSettings (\s -> s { toolSettings_opt_c   = f : toolSettings_opt_c s})
2040addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s})
2041addOptP   f = alterToolSettings $ \s -> s
2042          { toolSettings_opt_P   = f : toolSettings_opt_P s
2043          , toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s)
2044          }
2045          -- See Note [Repeated -optP hashing]
2046  where
2047  fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss
2048
2049
2050setDepMakefile :: FilePath -> DynFlags -> DynFlags
2051setDepMakefile f d = d { depMakefile = f }
2052
2053setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
2054setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
2055
2056setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
2057setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
2058
2059addDepExcludeMod :: String -> DynFlags -> DynFlags
2060addDepExcludeMod m d
2061    = d { depExcludeMods = mkModuleName m : depExcludeMods d }
2062
2063addDepSuffix :: FilePath -> DynFlags -> DynFlags
2064addDepSuffix s d = d { depSuffixes = s : depSuffixes d }
2065
2066addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}
2067
2068addGhcVersionFile :: FilePath -> DynFlags -> DynFlags
2069addGhcVersionFile f d = d { ghcVersionFile = Just f }
2070
2071addHaddockOpts f d = d { haddockOptions = Just f}
2072
2073addGhciScript f d = d { ghciScripts = f : ghciScripts d}
2074
2075setInteractivePrint f d = d { interactivePrint = Just f}
2076
2077-----------------------------------------------------------------------------
2078-- Setting the optimisation level
2079
2080updOptLevel :: Int -> DynFlags -> DynFlags
2081-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
2082updOptLevel n dfs
2083  = dfs2{ optLevel = final_n }
2084  where
2085   final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2
2086   dfs1 = foldr (flip gopt_unset) dfs  remove_gopts
2087   dfs2 = foldr (flip gopt_set)   dfs1 extra_gopts
2088
2089   extra_gopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
2090   remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
2091
2092{- **********************************************************************
2093%*                                                                      *
2094                DynFlags parser
2095%*                                                                      *
2096%********************************************************************* -}
2097
2098-- -----------------------------------------------------------------------------
2099-- Parsing the dynamic flags.
2100
2101
2102-- | Parse dynamic flags from a list of command line arguments.  Returns
2103-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
2104-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
2105-- flags or missing arguments).
2106parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String]
2107                         -> m (DynFlags, [Located String], [Warn])
2108                            -- ^ Updated 'DynFlags', left-over arguments, and
2109                            -- list of warnings.
2110parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True
2111
2112
2113-- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags
2114-- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db).
2115-- Used to parse flags set in a modules pragma.
2116parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String]
2117                       -> m (DynFlags, [Located String], [Warn])
2118                          -- ^ Updated 'DynFlags', left-over arguments, and
2119                          -- list of warnings.
2120parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False
2121
2122
2123-- | Parses the dynamically set flags for GHC. This is the most general form of
2124-- the dynamic flag parser that the other methods simply wrap. It allows
2125-- saying which flags are valid flags and indicating if we are parsing
2126-- arguments from the command line or from a file pragma.
2127parseDynamicFlagsFull :: MonadIO m
2128                  => [Flag (CmdLineP DynFlags)]    -- ^ valid flags to match against
2129                  -> Bool                          -- ^ are the arguments from the command line?
2130                  -> DynFlags                      -- ^ current dynamic flags
2131                  -> [Located String]              -- ^ arguments to parse
2132                  -> m (DynFlags, [Located String], [Warn])
2133parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
2134  let ((leftover, errs, warns), dflags1)
2135          = runCmdLine (processArgs activeFlags args) dflags0
2136
2137  -- See Note [Handling errors when parsing commandline flags]
2138  unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $
2139    map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs
2140
2141  -- check for disabled flags in safe haskell
2142  let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
2143      theWays = ways dflags2
2144
2145  unless (allowed_combination theWays) $ liftIO $
2146      throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
2147                               intercalate "/" (map wayDesc (Set.toAscList theWays))))
2148
2149  let chooseOutput
2150        | isJust (outputFile dflags2)          -- Only iff user specified -o ...
2151        , not (isJust (dynOutputFile dflags2)) -- but not -dyno
2152        = return $ dflags2 { dynOutputFile = Just $ dynamicOutputFile dflags2 outFile }
2153        | otherwise
2154        = return dflags2
2155        where
2156          outFile = fromJust $ outputFile dflags2
2157  dflags3 <- ifGeneratingDynamicToo dflags2 chooseOutput (return dflags2)
2158
2159  let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
2160
2161  -- Set timer stats & heap size
2162  when (enableTimeStats dflags4) $ liftIO enableTimingStats
2163  case (ghcHeapSize dflags4) of
2164    Just x -> liftIO (setHeapSize x)
2165    _      -> return ()
2166
2167  liftIO $ setUnsafeGlobalDynFlags dflags4
2168
2169  let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)
2170
2171  return (dflags4, leftover, warns' ++ warns)
2172
2173-- | Write an error or warning to the 'LogOutput'.
2174putLogMsg :: DynFlags -> WarnReason -> Severity -> SrcSpan -> MsgDoc -> IO ()
2175putLogMsg dflags = log_action dflags dflags
2176
2177-- | Check (and potentially disable) any extensions that aren't allowed
2178-- in safe mode.
2179--
2180-- The bool is to indicate if we are parsing command line flags (false means
2181-- file pragma). This allows us to generate better warnings.
2182safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])
2183safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns)
2184  where
2185    -- Handle illegal flags under safe language.
2186    (dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags
2187
2188    check_method (df, warns) (str,loc,test,fix)
2189        | test df   = (fix df, warns ++ safeFailure (loc df) str)
2190        | otherwise = (df, warns)
2191
2192    safeFailure loc str
2193       = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring "
2194           ++ str]
2195
2196safeFlagCheck cmdl dflags =
2197  case (safeInferOn dflags) of
2198    True | safeFlags -> (dflags', warn)
2199    True             -> (dflags' { safeInferred = False }, warn)
2200    False            -> (dflags', warn)
2201
2202  where
2203    -- dynflags and warn for when -fpackage-trust by itself with no safe
2204    -- haskell flag
2205    (dflags', warn)
2206      | not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags
2207      = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)
2208      | otherwise = (dflags, [])
2209
2210    pkgWarnMsg = [L (pkgTrustOnLoc dflags') $
2211                    "-fpackage-trust ignored;" ++
2212                    " must be specified with a Safe Haskell flag"]
2213
2214    -- Have we inferred Unsafe? See Note [GHC.Driver.Main . Safe Haskell Inference]
2215    safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer
2216
2217
2218{- **********************************************************************
2219%*                                                                      *
2220                DynFlags specifications
2221%*                                                                      *
2222%********************************************************************* -}
2223
2224-- | All dynamic flags option strings without the deprecated ones.
2225-- These are the user facing strings for enabling and disabling options.
2226allNonDeprecatedFlags :: [String]
2227allNonDeprecatedFlags = allFlagsDeps False
2228
2229-- | All flags with possibility to filter deprecated ones
2230allFlagsDeps :: Bool -> [String]
2231allFlagsDeps keepDeprecated = [ '-':flagName flag
2232                              | (deprecated, flag) <- flagsAllDeps
2233                              , keepDeprecated || not (isDeprecated deprecated)]
2234  where isDeprecated Deprecated = True
2235        isDeprecated _ = False
2236
2237{-
2238 - Below we export user facing symbols for GHC dynamic flags for use with the
2239 - GHC API.
2240 -}
2241
2242-- All dynamic flags present in GHC.
2243flagsAll :: [Flag (CmdLineP DynFlags)]
2244flagsAll = map snd flagsAllDeps
2245
2246-- All dynamic flags present in GHC with deprecation information.
2247flagsAllDeps :: [(Deprecation, Flag (CmdLineP DynFlags))]
2248flagsAllDeps =  package_flags_deps ++ dynamic_flags_deps
2249
2250
2251-- All dynamic flags, minus package flags, present in GHC.
2252flagsDynamic :: [Flag (CmdLineP DynFlags)]
2253flagsDynamic = map snd dynamic_flags_deps
2254
2255-- ALl package flags present in GHC.
2256flagsPackage :: [Flag (CmdLineP DynFlags)]
2257flagsPackage = map snd package_flags_deps
2258
2259----------------Helpers to make flags and keep deprecation information----------
2260
2261type FlagMaker m = String -> OptKind m -> Flag m
2262type DynFlagMaker = FlagMaker (CmdLineP DynFlags)
2263data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)
2264
2265-- Make a non-deprecated flag
2266make_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags)
2267              -> (Deprecation, Flag (CmdLineP DynFlags))
2268make_ord_flag fm name kind = (NotDeprecated, fm name kind)
2269
2270-- Make a deprecated flag
2271make_dep_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags) -> String
2272                 -> (Deprecation, Flag (CmdLineP DynFlags))
2273make_dep_flag fm name kind message = (Deprecated,
2274                                      fm name $ add_dep_message kind message)
2275
2276add_dep_message :: OptKind (CmdLineP DynFlags) -> String
2277                -> OptKind (CmdLineP DynFlags)
2278add_dep_message (NoArg f) message = NoArg $ f >> deprecate message
2279add_dep_message (HasArg f) message = HasArg $ \s -> f s >> deprecate message
2280add_dep_message (SepArg f) message = SepArg $ \s -> f s >> deprecate message
2281add_dep_message (Prefix f) message = Prefix $ \s -> f s >> deprecate message
2282add_dep_message (OptPrefix f) message =
2283                                  OptPrefix $ \s -> f s >> deprecate message
2284add_dep_message (OptIntSuffix f) message =
2285                               OptIntSuffix $ \oi -> f oi >> deprecate message
2286add_dep_message (IntSuffix f) message =
2287                                  IntSuffix $ \i -> f i >> deprecate message
2288add_dep_message (FloatSuffix f) message =
2289                                FloatSuffix $ \fl -> f fl >> deprecate message
2290add_dep_message (PassFlag f) message =
2291                                   PassFlag $ \s -> f s >> deprecate message
2292add_dep_message (AnySuffix f) message =
2293                                  AnySuffix $ \s -> f s >> deprecate message
2294
2295----------------------- The main flags themselves ------------------------------
2296-- See Note [Updating flag description in the User's Guide]
2297-- See Note [Supporting CLI completion]
2298dynamic_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]
2299dynamic_flags_deps = [
2300    make_dep_flag defFlag "n" (NoArg $ return ())
2301        "The -n flag is deprecated and no longer has any effect"
2302  , make_ord_flag defFlag "cpp"      (NoArg (setExtensionFlag LangExt.Cpp))
2303  , make_ord_flag defFlag "F"        (NoArg (setGeneralFlag Opt_Pp))
2304  , (Deprecated, defFlag "#include"
2305      (HasArg (\_s ->
2306         deprecate ("-#include and INCLUDE pragmas are " ++
2307                    "deprecated: They no longer have any effect"))))
2308  , make_ord_flag defFlag "v"        (OptIntSuffix setVerbosity)
2309
2310  , make_ord_flag defGhcFlag "j"     (OptIntSuffix
2311        (\n -> case n of
2312                 Just n
2313                     | n > 0     -> upd (\d -> d { parMakeCount = Just n })
2314                     | otherwise -> addErr "Syntax: -j[n] where n > 0"
2315                 Nothing -> upd (\d -> d { parMakeCount = Nothing })))
2316                 -- When the number of parallel builds
2317                 -- is omitted, it is the same
2318                 -- as specifying that the number of
2319                 -- parallel builds is equal to the
2320                 -- result of getNumProcessors
2321  , make_ord_flag defFlag "instantiated-with"   (sepArg setUnitInstantiations)
2322  , make_ord_flag defFlag "this-component-id"   (sepArg setUnitInstanceOf)
2323
2324    -- RTS options -------------------------------------------------------------
2325  , make_ord_flag defFlag "H"           (HasArg (\s -> upd (\d ->
2326          d { ghcHeapSize = Just $ fromIntegral (decodeSize s)})))
2327
2328  , make_ord_flag defFlag "Rghc-timing" (NoArg (upd (\d ->
2329                                               d { enableTimeStats = True })))
2330
2331    ------- ways ---------------------------------------------------------------
2332  , make_ord_flag defGhcFlag "prof"           (NoArg (addWay WayProf))
2333  , make_ord_flag defGhcFlag "eventlog"       (NoArg (addWay WayEventLog))
2334  , make_ord_flag defGhcFlag "debug"          (NoArg (addWay WayDebug))
2335  , make_ord_flag defGhcFlag "threaded"       (NoArg (addWay WayThreaded))
2336
2337  , make_ord_flag defGhcFlag "ticky"
2338      (NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug))
2339
2340    -- -ticky enables ticky-ticky code generation, and also implies -debug which
2341    -- is required to get the RTS ticky support.
2342
2343        ----- Linker --------------------------------------------------------
2344  , make_ord_flag defGhcFlag "static"         (NoArg removeWayDyn)
2345  , make_ord_flag defGhcFlag "dynamic"        (NoArg (addWay WayDyn))
2346  , make_ord_flag defGhcFlag "rdynamic" $ noArg $
2347#if defined(linux_HOST_OS)
2348                              addOptl "-rdynamic"
2349#elif defined(mingw32_HOST_OS)
2350                              addOptl "-Wl,--export-all-symbols"
2351#else
2352    -- ignored for compat w/ gcc:
2353                              id
2354#endif
2355  , make_ord_flag defGhcFlag "relative-dynlib-paths"
2356      (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
2357  , make_ord_flag defGhcFlag "copy-libs-when-linking"
2358      (NoArg (setGeneralFlag Opt_SingleLibFolder))
2359  , make_ord_flag defGhcFlag "pie"            (NoArg (setGeneralFlag Opt_PICExecutable))
2360  , make_ord_flag defGhcFlag "no-pie"         (NoArg (unSetGeneralFlag Opt_PICExecutable))
2361
2362        ------- Specific phases  --------------------------------------------
2363    -- need to appear before -pgmL to be parsed as LLVM flags.
2364  , make_ord_flag defFlag "pgmlo"
2365      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo  = (f,[]) }
2366  , make_ord_flag defFlag "pgmlc"
2367      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc  = (f,[]) }
2368  , make_ord_flag defFlag "pgmlm"
2369      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm  = (f,[]) }
2370  , make_ord_flag defFlag "pgmi"
2371      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i   =  f }
2372  , make_ord_flag defFlag "pgmL"
2373      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_L   = f }
2374  , make_ord_flag defFlag "pgmP"
2375      (hasArg setPgmP)
2376  , make_ord_flag defFlag "pgmF"
2377      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F   = f }
2378  , make_ord_flag defFlag "pgmc"
2379      $ hasArg $ \f -> alterToolSettings $ \s -> s
2380         { toolSettings_pgm_c   = f
2381         , -- Don't pass -no-pie with -pgmc
2382           -- (see #15319)
2383           toolSettings_ccSupportsNoPie = False
2384         }
2385  , make_ord_flag defFlag "pgmc-supports-no-pie"
2386      $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True }
2387  , make_ord_flag defFlag "pgms"
2388      (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8"))
2389  , make_ord_flag defFlag "pgma"
2390      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a   = (f,[]) }
2391  , make_ord_flag defFlag "pgml"
2392      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_l   = (f,[]) }
2393  , make_ord_flag defFlag "pgmdll"
2394      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) }
2395  , make_ord_flag defFlag "pgmwindres"
2396      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f }
2397  , make_ord_flag defFlag "pgmlibtool"
2398      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f }
2399  , make_ord_flag defFlag "pgmar"
2400      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f }
2401  , make_ord_flag defFlag "pgmotool"
2402      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f}
2403  , make_ord_flag defFlag "pgminstall_name_tool"
2404      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f}
2405  , make_ord_flag defFlag "pgmranlib"
2406      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f }
2407
2408
2409    -- need to appear before -optl/-opta to be parsed as LLVM flags.
2410  , make_ord_flag defFlag "optlm"
2411      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lm  = f : toolSettings_opt_lm s }
2412  , make_ord_flag defFlag "optlo"
2413      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo  = f : toolSettings_opt_lo s }
2414  , make_ord_flag defFlag "optlc"
2415      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc  = f : toolSettings_opt_lc s }
2416  , make_ord_flag defFlag "opti"
2417      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i   = f : toolSettings_opt_i s }
2418  , make_ord_flag defFlag "optL"
2419      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_L   = f : toolSettings_opt_L s }
2420  , make_ord_flag defFlag "optP"
2421      (hasArg addOptP)
2422  , make_ord_flag defFlag "optF"
2423      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_F   = f : toolSettings_opt_F s }
2424  , make_ord_flag defFlag "optc"
2425      (hasArg addOptc)
2426  , make_ord_flag defFlag "optcxx"
2427      (hasArg addOptcxx)
2428  , make_ord_flag defFlag "opta"
2429      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_a   = f : toolSettings_opt_a s }
2430  , make_ord_flag defFlag "optl"
2431      (hasArg addOptl)
2432  , make_ord_flag defFlag "optwindres"
2433      $ hasArg $ \f ->
2434        alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s }
2435
2436  , make_ord_flag defGhcFlag "split-objs"
2437      (NoArg $ addWarn "ignoring -split-objs")
2438
2439  , make_ord_flag defGhcFlag "split-sections"
2440      (noArgM (\dflags -> do
2441        if platformHasSubsectionsViaSymbols (targetPlatform dflags)
2442          then do addWarn $
2443                    "-split-sections is not useful on this platform " ++
2444                    "since it always uses subsections via symbols. Ignoring."
2445                  return dflags
2446          else return (gopt_set dflags Opt_SplitSections)))
2447
2448        -------- ghc -M -----------------------------------------------------
2449  , make_ord_flag defGhcFlag "dep-suffix"              (hasArg addDepSuffix)
2450  , make_ord_flag defGhcFlag "dep-makefile"            (hasArg setDepMakefile)
2451  , make_ord_flag defGhcFlag "include-cpp-deps"
2452        (noArg (setDepIncludeCppDeps True))
2453  , make_ord_flag defGhcFlag "include-pkg-deps"
2454        (noArg (setDepIncludePkgDeps True))
2455  , make_ord_flag defGhcFlag "exclude-module"          (hasArg addDepExcludeMod)
2456
2457        -------- Linking ----------------------------------------------------
2458  , make_ord_flag defGhcFlag "no-link"
2459        (noArg (\d -> d { ghcLink=NoLink }))
2460  , make_ord_flag defGhcFlag "shared"
2461        (noArg (\d -> d { ghcLink=LinkDynLib }))
2462  , make_ord_flag defGhcFlag "staticlib"
2463        (noArg (\d -> setGeneralFlag' Opt_LinkRts (d { ghcLink=LinkStaticLib })))
2464  , make_ord_flag defGhcFlag "dynload"            (hasArg parseDynLibLoaderMode)
2465  , make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName)
2466
2467        ------- Libraries ---------------------------------------------------
2468  , make_ord_flag defFlag "L"   (Prefix addLibraryPath)
2469  , make_ord_flag defFlag "l"   (hasArg (addLdInputs . Option . ("-l" ++)))
2470
2471        ------- Frameworks --------------------------------------------------
2472        -- -framework-path should really be -F ...
2473  , make_ord_flag defFlag "framework-path" (HasArg addFrameworkPath)
2474  , make_ord_flag defFlag "framework"      (hasArg addCmdlineFramework)
2475
2476        ------- Output Redirection ------------------------------------------
2477  , make_ord_flag defGhcFlag "odir"              (hasArg setObjectDir)
2478  , make_ord_flag defGhcFlag "o"                 (sepArg (setOutputFile . Just))
2479  , make_ord_flag defGhcFlag "dyno"
2480        (sepArg (setDynOutputFile . Just))
2481  , make_ord_flag defGhcFlag "ohi"
2482        (hasArg (setOutputHi . Just ))
2483  , make_ord_flag defGhcFlag "osuf"              (hasArg setObjectSuf)
2484  , make_ord_flag defGhcFlag "dynosuf"           (hasArg setDynObjectSuf)
2485  , make_ord_flag defGhcFlag "hcsuf"             (hasArg setHcSuf)
2486  , make_ord_flag defGhcFlag "hisuf"             (hasArg setHiSuf)
2487  , make_ord_flag defGhcFlag "hiesuf"            (hasArg setHieSuf)
2488  , make_ord_flag defGhcFlag "dynhisuf"          (hasArg setDynHiSuf)
2489  , make_ord_flag defGhcFlag "hidir"             (hasArg setHiDir)
2490  , make_ord_flag defGhcFlag "hiedir"            (hasArg setHieDir)
2491  , make_ord_flag defGhcFlag "tmpdir"            (hasArg setTmpDir)
2492  , make_ord_flag defGhcFlag "stubdir"           (hasArg setStubDir)
2493  , make_ord_flag defGhcFlag "dumpdir"           (hasArg setDumpDir)
2494  , make_ord_flag defGhcFlag "outputdir"         (hasArg setOutputDir)
2495  , make_ord_flag defGhcFlag "ddump-file-prefix"
2496        (hasArg (setDumpPrefixForce . Just))
2497
2498  , make_ord_flag defGhcFlag "dynamic-too"
2499        (NoArg (setGeneralFlag Opt_BuildDynamicToo))
2500
2501        ------- Keeping temporary files -------------------------------------
2502     -- These can be singular (think ghc -c) or plural (think ghc --make)
2503  , make_ord_flag defGhcFlag "keep-hc-file"
2504        (NoArg (setGeneralFlag Opt_KeepHcFiles))
2505  , make_ord_flag defGhcFlag "keep-hc-files"
2506        (NoArg (setGeneralFlag Opt_KeepHcFiles))
2507  , make_ord_flag defGhcFlag "keep-hscpp-file"
2508        (NoArg (setGeneralFlag Opt_KeepHscppFiles))
2509  , make_ord_flag defGhcFlag "keep-hscpp-files"
2510        (NoArg (setGeneralFlag Opt_KeepHscppFiles))
2511  , make_ord_flag defGhcFlag "keep-s-file"
2512        (NoArg (setGeneralFlag Opt_KeepSFiles))
2513  , make_ord_flag defGhcFlag "keep-s-files"
2514        (NoArg (setGeneralFlag Opt_KeepSFiles))
2515  , make_ord_flag defGhcFlag "keep-llvm-file"
2516        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)
2517  , make_ord_flag defGhcFlag "keep-llvm-files"
2518        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)
2519     -- This only makes sense as plural
2520  , make_ord_flag defGhcFlag "keep-tmp-files"
2521        (NoArg (setGeneralFlag Opt_KeepTmpFiles))
2522  , make_ord_flag defGhcFlag "keep-hi-file"
2523        (NoArg (setGeneralFlag Opt_KeepHiFiles))
2524  , make_ord_flag defGhcFlag "no-keep-hi-file"
2525        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))
2526  , make_ord_flag defGhcFlag "keep-hi-files"
2527        (NoArg (setGeneralFlag Opt_KeepHiFiles))
2528  , make_ord_flag defGhcFlag "no-keep-hi-files"
2529        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))
2530  , make_ord_flag defGhcFlag "keep-o-file"
2531        (NoArg (setGeneralFlag Opt_KeepOFiles))
2532  , make_ord_flag defGhcFlag "no-keep-o-file"
2533        (NoArg (unSetGeneralFlag Opt_KeepOFiles))
2534  , make_ord_flag defGhcFlag "keep-o-files"
2535        (NoArg (setGeneralFlag Opt_KeepOFiles))
2536  , make_ord_flag defGhcFlag "no-keep-o-files"
2537        (NoArg (unSetGeneralFlag Opt_KeepOFiles))
2538
2539        ------- Miscellaneous ----------------------------------------------
2540  , make_ord_flag defGhcFlag "no-auto-link-packages"
2541        (NoArg (unSetGeneralFlag Opt_AutoLinkPackages))
2542  , make_ord_flag defGhcFlag "no-hs-main"
2543        (NoArg (setGeneralFlag Opt_NoHsMain))
2544  , make_ord_flag defGhcFlag "fno-state-hack"
2545        (NoArg (setGeneralFlag Opt_G_NoStateHack))
2546  , make_ord_flag defGhcFlag "fno-opt-coercion"
2547        (NoArg (setGeneralFlag Opt_G_NoOptCoercion))
2548  , make_ord_flag defGhcFlag "with-rtsopts"
2549        (HasArg setRtsOpts)
2550  , make_ord_flag defGhcFlag "rtsopts"
2551        (NoArg (setRtsOptsEnabled RtsOptsAll))
2552  , make_ord_flag defGhcFlag "rtsopts=all"
2553        (NoArg (setRtsOptsEnabled RtsOptsAll))
2554  , make_ord_flag defGhcFlag "rtsopts=some"
2555        (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
2556  , make_ord_flag defGhcFlag "rtsopts=none"
2557        (NoArg (setRtsOptsEnabled RtsOptsNone))
2558  , make_ord_flag defGhcFlag "rtsopts=ignore"
2559        (NoArg (setRtsOptsEnabled RtsOptsIgnore))
2560  , make_ord_flag defGhcFlag "rtsopts=ignoreAll"
2561        (NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))
2562  , make_ord_flag defGhcFlag "no-rtsopts"
2563        (NoArg (setRtsOptsEnabled RtsOptsNone))
2564  , make_ord_flag defGhcFlag "no-rtsopts-suggestions"
2565      (noArg (\d -> d {rtsOptsSuggestions = False}))
2566  , make_ord_flag defGhcFlag "dhex-word-literals"
2567        (NoArg (setGeneralFlag Opt_HexWordLiterals))
2568
2569  , make_ord_flag defGhcFlag "ghcversion-file"      (hasArg addGhcVersionFile)
2570  , make_ord_flag defGhcFlag "main-is"              (SepArg setMainIs)
2571  , make_ord_flag defGhcFlag "haddock"              (NoArg (setGeneralFlag Opt_Haddock))
2572  , make_ord_flag defGhcFlag "no-haddock"           (NoArg (unSetGeneralFlag Opt_Haddock))
2573  , make_ord_flag defGhcFlag "haddock-opts"         (hasArg addHaddockOpts)
2574  , make_ord_flag defGhcFlag "hpcdir"               (SepArg setOptHpcDir)
2575  , make_ord_flag defGhciFlag "ghci-script"         (hasArg addGhciScript)
2576  , make_ord_flag defGhciFlag "interactive-print"   (hasArg setInteractivePrint)
2577  , make_ord_flag defGhcFlag "ticky-allocd"
2578        (NoArg (setGeneralFlag Opt_Ticky_Allocd))
2579  , make_ord_flag defGhcFlag "ticky-LNE"
2580        (NoArg (setGeneralFlag Opt_Ticky_LNE))
2581  , make_ord_flag defGhcFlag "ticky-dyn-thunk"
2582        (NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))
2583        ------- recompilation checker --------------------------------------
2584  , make_dep_flag defGhcFlag "recomp"
2585        (NoArg $ unSetGeneralFlag Opt_ForceRecomp)
2586             "Use -fno-force-recomp instead"
2587  , make_dep_flag defGhcFlag "no-recomp"
2588        (NoArg $ setGeneralFlag Opt_ForceRecomp) "Use -fforce-recomp instead"
2589  , make_ord_flag defFlag "fmax-errors"
2590      (intSuffix (\n d -> d { maxErrors = Just (max 1 n) }))
2591  , make_ord_flag defFlag "fno-max-errors"
2592      (noArg (\d -> d { maxErrors = Nothing }))
2593  , make_ord_flag defFlag "freverse-errors"
2594        (noArg (\d -> d {reverseErrors = True} ))
2595  , make_ord_flag defFlag "fno-reverse-errors"
2596        (noArg (\d -> d {reverseErrors = False} ))
2597
2598        ------ HsCpp opts ---------------------------------------------------
2599  , make_ord_flag defFlag "D"              (AnySuffix (upd . addOptP))
2600  , make_ord_flag defFlag "U"              (AnySuffix (upd . addOptP))
2601
2602        ------- Include/Import Paths ----------------------------------------
2603  , make_ord_flag defFlag "I"              (Prefix    addIncludePath)
2604  , make_ord_flag defFlag "i"              (OptPrefix addImportPath)
2605
2606        ------ Output style options -----------------------------------------
2607  , make_ord_flag defFlag "dppr-user-length" (intSuffix (\n d ->
2608                                                       d { pprUserLength = n }))
2609  , make_ord_flag defFlag "dppr-cols"        (intSuffix (\n d ->
2610                                                             d { pprCols = n }))
2611  , make_ord_flag defFlag "fdiagnostics-color=auto"
2612      (NoArg (upd (\d -> d { useColor = Auto })))
2613  , make_ord_flag defFlag "fdiagnostics-color=always"
2614      (NoArg (upd (\d -> d { useColor = Always })))
2615  , make_ord_flag defFlag "fdiagnostics-color=never"
2616      (NoArg (upd (\d -> d { useColor = Never })))
2617
2618  -- Suppress all that is suppressable in core dumps.
2619  -- Except for uniques, as some simplifier phases introduce new variables that
2620  -- have otherwise identical names.
2621  , make_ord_flag defGhcFlag "dsuppress-all"
2622      (NoArg $ do setGeneralFlag Opt_SuppressCoercions
2623                  setGeneralFlag Opt_SuppressVarKinds
2624                  setGeneralFlag Opt_SuppressModulePrefixes
2625                  setGeneralFlag Opt_SuppressTypeApplications
2626                  setGeneralFlag Opt_SuppressIdInfo
2627                  setGeneralFlag Opt_SuppressTicks
2628                  setGeneralFlag Opt_SuppressStgExts
2629                  setGeneralFlag Opt_SuppressTypeSignatures
2630                  setGeneralFlag Opt_SuppressTimestamps)
2631
2632        ------ Debugging ----------------------------------------------------
2633  , make_ord_flag defGhcFlag "dstg-stats"
2634        (NoArg (setGeneralFlag Opt_StgStats))
2635
2636  , make_ord_flag defGhcFlag "ddump-cmm"
2637        (setDumpFlag Opt_D_dump_cmm)
2638  , make_ord_flag defGhcFlag "ddump-cmm-from-stg"
2639        (setDumpFlag Opt_D_dump_cmm_from_stg)
2640  , make_ord_flag defGhcFlag "ddump-cmm-raw"
2641        (setDumpFlag Opt_D_dump_cmm_raw)
2642  , make_ord_flag defGhcFlag "ddump-cmm-verbose"
2643        (setDumpFlag Opt_D_dump_cmm_verbose)
2644  , make_ord_flag defGhcFlag "ddump-cmm-verbose-by-proc"
2645        (setDumpFlag Opt_D_dump_cmm_verbose_by_proc)
2646  , make_ord_flag defGhcFlag "ddump-cmm-cfg"
2647        (setDumpFlag Opt_D_dump_cmm_cfg)
2648  , make_ord_flag defGhcFlag "ddump-cmm-cbe"
2649        (setDumpFlag Opt_D_dump_cmm_cbe)
2650  , make_ord_flag defGhcFlag "ddump-cmm-switch"
2651        (setDumpFlag Opt_D_dump_cmm_switch)
2652  , make_ord_flag defGhcFlag "ddump-cmm-proc"
2653        (setDumpFlag Opt_D_dump_cmm_proc)
2654  , make_ord_flag defGhcFlag "ddump-cmm-sp"
2655        (setDumpFlag Opt_D_dump_cmm_sp)
2656  , make_ord_flag defGhcFlag "ddump-cmm-sink"
2657        (setDumpFlag Opt_D_dump_cmm_sink)
2658  , make_ord_flag defGhcFlag "ddump-cmm-caf"
2659        (setDumpFlag Opt_D_dump_cmm_caf)
2660  , make_ord_flag defGhcFlag "ddump-cmm-procmap"
2661        (setDumpFlag Opt_D_dump_cmm_procmap)
2662  , make_ord_flag defGhcFlag "ddump-cmm-split"
2663        (setDumpFlag Opt_D_dump_cmm_split)
2664  , make_ord_flag defGhcFlag "ddump-cmm-info"
2665        (setDumpFlag Opt_D_dump_cmm_info)
2666  , make_ord_flag defGhcFlag "ddump-cmm-cps"
2667        (setDumpFlag Opt_D_dump_cmm_cps)
2668  , make_ord_flag defGhcFlag "ddump-cmm-opt"
2669        (setDumpFlag Opt_D_dump_opt_cmm)
2670  , make_ord_flag defGhcFlag "ddump-cfg-weights"
2671        (setDumpFlag Opt_D_dump_cfg_weights)
2672  , make_ord_flag defGhcFlag "ddump-core-stats"
2673        (setDumpFlag Opt_D_dump_core_stats)
2674  , make_ord_flag defGhcFlag "ddump-asm"
2675        (setDumpFlag Opt_D_dump_asm)
2676  , make_ord_flag defGhcFlag "ddump-asm-native"
2677        (setDumpFlag Opt_D_dump_asm_native)
2678  , make_ord_flag defGhcFlag "ddump-asm-liveness"
2679        (setDumpFlag Opt_D_dump_asm_liveness)
2680  , make_ord_flag defGhcFlag "ddump-asm-regalloc"
2681        (setDumpFlag Opt_D_dump_asm_regalloc)
2682  , make_ord_flag defGhcFlag "ddump-asm-conflicts"
2683        (setDumpFlag Opt_D_dump_asm_conflicts)
2684  , make_ord_flag defGhcFlag "ddump-asm-regalloc-stages"
2685        (setDumpFlag Opt_D_dump_asm_regalloc_stages)
2686  , make_ord_flag defGhcFlag "ddump-asm-stats"
2687        (setDumpFlag Opt_D_dump_asm_stats)
2688  , make_ord_flag defGhcFlag "ddump-asm-expanded"
2689        (setDumpFlag Opt_D_dump_asm_expanded)
2690  , make_ord_flag defGhcFlag "ddump-llvm"
2691        (NoArg $ setObjTarget HscLlvm >> setDumpFlag' Opt_D_dump_llvm)
2692  , make_ord_flag defGhcFlag "ddump-deriv"
2693        (setDumpFlag Opt_D_dump_deriv)
2694  , make_ord_flag defGhcFlag "ddump-ds"
2695        (setDumpFlag Opt_D_dump_ds)
2696  , make_ord_flag defGhcFlag "ddump-ds-preopt"
2697        (setDumpFlag Opt_D_dump_ds_preopt)
2698  , make_ord_flag defGhcFlag "ddump-foreign"
2699        (setDumpFlag Opt_D_dump_foreign)
2700  , make_ord_flag defGhcFlag "ddump-inlinings"
2701        (setDumpFlag Opt_D_dump_inlinings)
2702  , make_ord_flag defGhcFlag "ddump-rule-firings"
2703        (setDumpFlag Opt_D_dump_rule_firings)
2704  , make_ord_flag defGhcFlag "ddump-rule-rewrites"
2705        (setDumpFlag Opt_D_dump_rule_rewrites)
2706  , make_ord_flag defGhcFlag "ddump-simpl-trace"
2707        (setDumpFlag Opt_D_dump_simpl_trace)
2708  , make_ord_flag defGhcFlag "ddump-occur-anal"
2709        (setDumpFlag Opt_D_dump_occur_anal)
2710  , make_ord_flag defGhcFlag "ddump-parsed"
2711        (setDumpFlag Opt_D_dump_parsed)
2712  , make_ord_flag defGhcFlag "ddump-parsed-ast"
2713        (setDumpFlag Opt_D_dump_parsed_ast)
2714  , make_ord_flag defGhcFlag "ddump-rn"
2715        (setDumpFlag Opt_D_dump_rn)
2716  , make_ord_flag defGhcFlag "ddump-rn-ast"
2717        (setDumpFlag Opt_D_dump_rn_ast)
2718  , make_ord_flag defGhcFlag "ddump-simpl"
2719        (setDumpFlag Opt_D_dump_simpl)
2720  , make_ord_flag defGhcFlag "ddump-simpl-iterations"
2721      (setDumpFlag Opt_D_dump_simpl_iterations)
2722  , make_ord_flag defGhcFlag "ddump-spec"
2723        (setDumpFlag Opt_D_dump_spec)
2724  , make_ord_flag defGhcFlag "ddump-prep"
2725        (setDumpFlag Opt_D_dump_prep)
2726  , make_ord_flag defGhcFlag "ddump-stg"
2727        (setDumpFlag Opt_D_dump_stg)
2728  , make_ord_flag defGhcFlag "ddump-stg-unarised"
2729        (setDumpFlag Opt_D_dump_stg_unarised)
2730  , make_ord_flag defGhcFlag "ddump-stg-final"
2731        (setDumpFlag Opt_D_dump_stg_final)
2732  , make_ord_flag defGhcFlag "ddump-call-arity"
2733        (setDumpFlag Opt_D_dump_call_arity)
2734  , make_ord_flag defGhcFlag "ddump-exitify"
2735        (setDumpFlag Opt_D_dump_exitify)
2736  , make_ord_flag defGhcFlag "ddump-stranal"
2737        (setDumpFlag Opt_D_dump_stranal)
2738  , make_ord_flag defGhcFlag "ddump-str-signatures"
2739        (setDumpFlag Opt_D_dump_str_signatures)
2740  , make_ord_flag defGhcFlag "ddump-cpranal"
2741        (setDumpFlag Opt_D_dump_cpranal)
2742  , make_ord_flag defGhcFlag "ddump-cpr-signatures"
2743        (setDumpFlag Opt_D_dump_cpr_signatures)
2744  , make_ord_flag defGhcFlag "ddump-tc"
2745        (setDumpFlag Opt_D_dump_tc)
2746  , make_ord_flag defGhcFlag "ddump-tc-ast"
2747        (setDumpFlag Opt_D_dump_tc_ast)
2748  , make_ord_flag defGhcFlag "ddump-hie"
2749        (setDumpFlag Opt_D_dump_hie)
2750  , make_ord_flag defGhcFlag "ddump-types"
2751        (setDumpFlag Opt_D_dump_types)
2752  , make_ord_flag defGhcFlag "ddump-rules"
2753        (setDumpFlag Opt_D_dump_rules)
2754  , make_ord_flag defGhcFlag "ddump-cse"
2755        (setDumpFlag Opt_D_dump_cse)
2756  , make_ord_flag defGhcFlag "ddump-worker-wrapper"
2757        (setDumpFlag Opt_D_dump_worker_wrapper)
2758  , make_ord_flag defGhcFlag "ddump-rn-trace"
2759        (setDumpFlag Opt_D_dump_rn_trace)
2760  , make_ord_flag defGhcFlag "ddump-if-trace"
2761        (setDumpFlag Opt_D_dump_if_trace)
2762  , make_ord_flag defGhcFlag "ddump-cs-trace"
2763        (setDumpFlag Opt_D_dump_cs_trace)
2764  , make_ord_flag defGhcFlag "ddump-tc-trace"
2765        (NoArg (do setDumpFlag' Opt_D_dump_tc_trace
2766                   setDumpFlag' Opt_D_dump_cs_trace))
2767  , make_ord_flag defGhcFlag "ddump-ec-trace"
2768        (setDumpFlag Opt_D_dump_ec_trace)
2769  , make_ord_flag defGhcFlag "ddump-vt-trace"
2770        (setDumpFlag Opt_D_dump_vt_trace)
2771  , make_ord_flag defGhcFlag "ddump-splices"
2772        (setDumpFlag Opt_D_dump_splices)
2773  , make_ord_flag defGhcFlag "dth-dec-file"
2774        (setDumpFlag Opt_D_th_dec_file)
2775
2776  , make_ord_flag defGhcFlag "ddump-rn-stats"
2777        (setDumpFlag Opt_D_dump_rn_stats)
2778  , make_ord_flag defGhcFlag "ddump-opt-cmm" --old alias for cmm-opt
2779        (setDumpFlag Opt_D_dump_opt_cmm)
2780  , make_ord_flag defGhcFlag "ddump-simpl-stats"
2781        (setDumpFlag Opt_D_dump_simpl_stats)
2782  , make_ord_flag defGhcFlag "ddump-bcos"
2783        (setDumpFlag Opt_D_dump_BCOs)
2784  , make_ord_flag defGhcFlag "dsource-stats"
2785        (setDumpFlag Opt_D_source_stats)
2786  , make_ord_flag defGhcFlag "dverbose-core2core"
2787        (NoArg $ setVerbosity (Just 2) >> setVerboseCore2Core)
2788  , make_ord_flag defGhcFlag "dverbose-stg2stg"
2789        (setDumpFlag Opt_D_verbose_stg2stg)
2790  , make_ord_flag defGhcFlag "ddump-hi"
2791        (setDumpFlag Opt_D_dump_hi)
2792  , make_ord_flag defGhcFlag "ddump-minimal-imports"
2793        (NoArg (setGeneralFlag Opt_D_dump_minimal_imports))
2794  , make_ord_flag defGhcFlag "ddump-hpc"
2795        (setDumpFlag Opt_D_dump_ticked) -- back compat
2796  , make_ord_flag defGhcFlag "ddump-ticked"
2797        (setDumpFlag Opt_D_dump_ticked)
2798  , make_ord_flag defGhcFlag "ddump-mod-cycles"
2799        (setDumpFlag Opt_D_dump_mod_cycles)
2800  , make_ord_flag defGhcFlag "ddump-mod-map"
2801        (setDumpFlag Opt_D_dump_mod_map)
2802  , make_ord_flag defGhcFlag "ddump-timings"
2803        (setDumpFlag Opt_D_dump_timings)
2804  , make_ord_flag defGhcFlag "ddump-view-pattern-commoning"
2805        (setDumpFlag Opt_D_dump_view_pattern_commoning)
2806  , make_ord_flag defGhcFlag "ddump-to-file"
2807        (NoArg (setGeneralFlag Opt_DumpToFile))
2808  , make_ord_flag defGhcFlag "ddump-hi-diffs"
2809        (setDumpFlag Opt_D_dump_hi_diffs)
2810  , make_ord_flag defGhcFlag "ddump-rtti"
2811        (setDumpFlag Opt_D_dump_rtti)
2812  , make_ord_flag defGhcFlag "dcore-lint"
2813        (NoArg (setGeneralFlag Opt_DoCoreLinting))
2814  , make_ord_flag defGhcFlag "dlinear-core-lint"
2815        (NoArg (setGeneralFlag Opt_DoLinearCoreLinting))
2816  , make_ord_flag defGhcFlag "dstg-lint"
2817        (NoArg (setGeneralFlag Opt_DoStgLinting))
2818  , make_ord_flag defGhcFlag "dcmm-lint"
2819        (NoArg (setGeneralFlag Opt_DoCmmLinting))
2820  , make_ord_flag defGhcFlag "dasm-lint"
2821        (NoArg (setGeneralFlag Opt_DoAsmLinting))
2822  , make_ord_flag defGhcFlag "dannot-lint"
2823        (NoArg (setGeneralFlag Opt_DoAnnotationLinting))
2824  , make_ord_flag defGhcFlag "dshow-passes"
2825        (NoArg $ forceRecompile >> (setVerbosity $ Just 2))
2826  , make_ord_flag defGhcFlag "dfaststring-stats"
2827        (NoArg (setGeneralFlag Opt_D_faststring_stats))
2828  , make_ord_flag defGhcFlag "dno-llvm-mangler"
2829        (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag
2830  , make_ord_flag defGhcFlag "dno-typeable-binds"
2831        (NoArg (setGeneralFlag Opt_NoTypeableBinds))
2832  , make_ord_flag defGhcFlag "ddump-debug"
2833        (setDumpFlag Opt_D_dump_debug)
2834  , make_ord_flag defGhcFlag "ddump-json"
2835        (noArg (flip dopt_set Opt_D_dump_json . setJsonLogAction ) )
2836  , make_ord_flag defGhcFlag "dppr-debug"
2837        (setDumpFlag Opt_D_ppr_debug)
2838  , make_ord_flag defGhcFlag "ddebug-output"
2839        (noArg (flip dopt_unset Opt_D_no_debug_output))
2840  , make_ord_flag defGhcFlag "dno-debug-output"
2841        (setDumpFlag Opt_D_no_debug_output)
2842
2843        ------ Machine dependent (-m<blah>) stuff ---------------------------
2844
2845  , make_ord_flag defGhcFlag "msse"         (noArg (\d ->
2846                                                  d { sseVersion = Just SSE1 }))
2847  , make_ord_flag defGhcFlag "msse2"        (noArg (\d ->
2848                                                  d { sseVersion = Just SSE2 }))
2849  , make_ord_flag defGhcFlag "msse3"        (noArg (\d ->
2850                                                  d { sseVersion = Just SSE3 }))
2851  , make_ord_flag defGhcFlag "msse4"        (noArg (\d ->
2852                                                  d { sseVersion = Just SSE4 }))
2853  , make_ord_flag defGhcFlag "msse4.2"      (noArg (\d ->
2854                                                 d { sseVersion = Just SSE42 }))
2855  , make_ord_flag defGhcFlag "mbmi"         (noArg (\d ->
2856                                                 d { bmiVersion = Just BMI1 }))
2857  , make_ord_flag defGhcFlag "mbmi2"        (noArg (\d ->
2858                                                 d { bmiVersion = Just BMI2 }))
2859  , make_ord_flag defGhcFlag "mavx"         (noArg (\d -> d { avx = True }))
2860  , make_ord_flag defGhcFlag "mavx2"        (noArg (\d -> d { avx2 = True }))
2861  , make_ord_flag defGhcFlag "mavx512cd"    (noArg (\d ->
2862                                                         d { avx512cd = True }))
2863  , make_ord_flag defGhcFlag "mavx512er"    (noArg (\d ->
2864                                                         d { avx512er = True }))
2865  , make_ord_flag defGhcFlag "mavx512f"     (noArg (\d -> d { avx512f = True }))
2866  , make_ord_flag defGhcFlag "mavx512pf"    (noArg (\d ->
2867                                                         d { avx512pf = True }))
2868
2869     ------ Warning opts -------------------------------------------------
2870  , make_ord_flag defFlag "W"       (NoArg (mapM_ setWarningFlag minusWOpts))
2871  , make_ord_flag defFlag "Werror"
2872               (NoArg (do { setGeneralFlag Opt_WarnIsError
2873                          ; mapM_ setFatalWarningFlag minusWeverythingOpts   }))
2874  , make_ord_flag defFlag "Wwarn"
2875               (NoArg (do { unSetGeneralFlag Opt_WarnIsError
2876                          ; mapM_ unSetFatalWarningFlag minusWeverythingOpts }))
2877                          -- Opt_WarnIsError is still needed to pass -Werror
2878                          -- to CPP; see runCpp in SysTools
2879  , make_dep_flag defFlag "Wnot"    (NoArg (upd (\d ->
2880                                              d {warningFlags = EnumSet.empty})))
2881                                             "Use -w or -Wno-everything instead"
2882  , make_ord_flag defFlag "w"       (NoArg (upd (\d ->
2883                                              d {warningFlags = EnumSet.empty})))
2884
2885     -- New-style uniform warning sets
2886     --
2887     -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything
2888  , make_ord_flag defFlag "Weverything"    (NoArg (mapM_
2889                                           setWarningFlag minusWeverythingOpts))
2890  , make_ord_flag defFlag "Wno-everything"
2891                           (NoArg (upd (\d -> d {warningFlags = EnumSet.empty})))
2892
2893  , make_ord_flag defFlag "Wall"           (NoArg (mapM_
2894                                                  setWarningFlag minusWallOpts))
2895  , make_ord_flag defFlag "Wno-all"        (NoArg (mapM_
2896                                                unSetWarningFlag minusWallOpts))
2897
2898  , make_ord_flag defFlag "Wextra"         (NoArg (mapM_
2899                                                     setWarningFlag minusWOpts))
2900  , make_ord_flag defFlag "Wno-extra"      (NoArg (mapM_
2901                                                   unSetWarningFlag minusWOpts))
2902
2903  , make_ord_flag defFlag "Wdefault"       (NoArg (mapM_
2904                                               setWarningFlag standardWarnings))
2905  , make_ord_flag defFlag "Wno-default"    (NoArg (mapM_
2906                                             unSetWarningFlag standardWarnings))
2907
2908  , make_ord_flag defFlag "Wcompat"        (NoArg (mapM_
2909                                               setWarningFlag minusWcompatOpts))
2910  , make_ord_flag defFlag "Wno-compat"     (NoArg (mapM_
2911                                             unSetWarningFlag minusWcompatOpts))
2912
2913        ------ Plugin flags ------------------------------------------------
2914  , make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)
2915  , make_ord_flag defGhcFlag "fplugin-trustworthy"
2916      (NoArg (setGeneralFlag Opt_PluginTrustworthy))
2917  , make_ord_flag defGhcFlag "fplugin"     (hasArg addPluginModuleName)
2918  , make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames)
2919  , make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption)
2920
2921        ------ Optimisation flags ------------------------------------------
2922  , make_dep_flag defGhcFlag "Onot"   (noArgM $ setOptLevel 0 )
2923                                                            "Use -O0 instead"
2924  , make_ord_flag defGhcFlag "O"      (optIntSuffixM (\mb_n ->
2925                                                setOptLevel (mb_n `orElse` 1)))
2926                -- If the number is missing, use 1
2927
2928  , make_ord_flag defFlag "fbinary-blob-threshold"
2929      (intSuffix (\n d -> d { binBlobThreshold = fromIntegral n }))
2930
2931  , make_ord_flag defFlag "fmax-relevant-binds"
2932      (intSuffix (\n d -> d { maxRelevantBinds = Just n }))
2933  , make_ord_flag defFlag "fno-max-relevant-binds"
2934      (noArg (\d -> d { maxRelevantBinds = Nothing }))
2935
2936  , make_ord_flag defFlag "fmax-valid-hole-fits"
2937      (intSuffix (\n d -> d { maxValidHoleFits = Just n }))
2938  , make_ord_flag defFlag "fno-max-valid-hole-fits"
2939      (noArg (\d -> d { maxValidHoleFits = Nothing }))
2940  , make_ord_flag defFlag "fmax-refinement-hole-fits"
2941      (intSuffix (\n d -> d { maxRefHoleFits = Just n }))
2942  , make_ord_flag defFlag "fno-max-refinement-hole-fits"
2943      (noArg (\d -> d { maxRefHoleFits = Nothing }))
2944  , make_ord_flag defFlag "frefinement-level-hole-fits"
2945      (intSuffix (\n d -> d { refLevelHoleFits = Just n }))
2946  , make_ord_flag defFlag "fno-refinement-level-hole-fits"
2947      (noArg (\d -> d { refLevelHoleFits = Nothing }))
2948
2949  , make_dep_flag defGhcFlag "fllvm-pass-vectors-in-regs"
2950            (noArg id)
2951            "vectors registers are now passed in registers by default."
2952  , make_ord_flag defFlag "fmax-uncovered-patterns"
2953      (intSuffix (\n d -> d { maxUncoveredPatterns = n }))
2954  , make_ord_flag defFlag "fmax-pmcheck-models"
2955      (intSuffix (\n d -> d { maxPmCheckModels = n }))
2956  , make_ord_flag defFlag "fsimplifier-phases"
2957      (intSuffix (\n d -> d { simplPhases = n }))
2958  , make_ord_flag defFlag "fmax-simplifier-iterations"
2959      (intSuffix (\n d -> d { maxSimplIterations = n }))
2960  , (Deprecated, defFlag "fmax-pmcheck-iterations"
2961      (intSuffixM (\_ d ->
2962       do { deprecate $ "use -fmax-pmcheck-models instead"
2963          ; return d })))
2964  , make_ord_flag defFlag "fsimpl-tick-factor"
2965      (intSuffix (\n d -> d { simplTickFactor = n }))
2966  , make_ord_flag defFlag "fspec-constr-threshold"
2967      (intSuffix (\n d -> d { specConstrThreshold = Just n }))
2968  , make_ord_flag defFlag "fno-spec-constr-threshold"
2969      (noArg (\d -> d { specConstrThreshold = Nothing }))
2970  , make_ord_flag defFlag "fspec-constr-count"
2971      (intSuffix (\n d -> d { specConstrCount = Just n }))
2972  , make_ord_flag defFlag "fno-spec-constr-count"
2973      (noArg (\d -> d { specConstrCount = Nothing }))
2974  , make_ord_flag defFlag "fspec-constr-recursive"
2975      (intSuffix (\n d -> d { specConstrRecursive = n }))
2976  , make_ord_flag defFlag "fliberate-case-threshold"
2977      (intSuffix (\n d -> d { liberateCaseThreshold = Just n }))
2978  , make_ord_flag defFlag "fno-liberate-case-threshold"
2979      (noArg (\d -> d { liberateCaseThreshold = Nothing }))
2980  , make_ord_flag defFlag "drule-check"
2981      (sepArg (\s d -> d { ruleCheck = Just s }))
2982  , make_ord_flag defFlag "dinline-check"
2983      (sepArg (\s d -> d { inlineCheck = Just s }))
2984  , make_ord_flag defFlag "freduction-depth"
2985      (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n }))
2986  , make_ord_flag defFlag "fconstraint-solver-iterations"
2987      (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n }))
2988  , (Deprecated, defFlag "fcontext-stack"
2989      (intSuffixM (\n d ->
2990       do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"
2991          ; return $ d { reductionDepth = treatZeroAsInf n } })))
2992  , (Deprecated, defFlag "ftype-function-depth"
2993      (intSuffixM (\n d ->
2994       do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"
2995          ; return $ d { reductionDepth = treatZeroAsInf n } })))
2996  , make_ord_flag defFlag "fstrictness-before"
2997      (intSuffix (\n d -> d { strictnessBefore = n : strictnessBefore d }))
2998  , make_ord_flag defFlag "ffloat-lam-args"
2999      (intSuffix (\n d -> d { floatLamArgs = Just n }))
3000  , make_ord_flag defFlag "ffloat-all-lams"
3001      (noArg (\d -> d { floatLamArgs = Nothing }))
3002  , make_ord_flag defFlag "fstg-lift-lams-rec-args"
3003      (intSuffix (\n d -> d { liftLamsRecArgs = Just n }))
3004  , make_ord_flag defFlag "fstg-lift-lams-rec-args-any"
3005      (noArg (\d -> d { liftLamsRecArgs = Nothing }))
3006  , make_ord_flag defFlag "fstg-lift-lams-non-rec-args"
3007      (intSuffix (\n d -> d { liftLamsRecArgs = Just n }))
3008  , make_ord_flag defFlag "fstg-lift-lams-non-rec-args-any"
3009      (noArg (\d -> d { liftLamsRecArgs = Nothing }))
3010  , make_ord_flag defFlag "fstg-lift-lams-known"
3011      (noArg (\d -> d { liftLamsKnown = True }))
3012  , make_ord_flag defFlag "fno-stg-lift-lams-known"
3013      (noArg (\d -> d { liftLamsKnown = False }))
3014  , make_ord_flag defFlag "fproc-alignment"
3015      (intSuffix (\n d -> d { cmmProcAlignment = Just n }))
3016  , make_ord_flag defFlag "fblock-layout-weights"
3017        (HasArg (\s ->
3018            upd (\d -> d { cfgWeightInfo =
3019                parseCfgWeights s (cfgWeightInfo d)})))
3020  , make_ord_flag defFlag "fhistory-size"
3021      (intSuffix (\n d -> d { historySize = n }))
3022  , make_ord_flag defFlag "funfolding-creation-threshold"
3023      (intSuffix   (\n d -> d {ufCreationThreshold = n}))
3024  , make_ord_flag defFlag "funfolding-use-threshold"
3025      (intSuffix   (\n d -> d {ufUseThreshold = n}))
3026  , make_ord_flag defFlag "funfolding-fun-discount"
3027      (intSuffix   (\n d -> d {ufFunAppDiscount = n}))
3028  , make_ord_flag defFlag "funfolding-dict-discount"
3029      (intSuffix   (\n d -> d {ufDictDiscount = n}))
3030  , make_dep_flag defFlag "funfolding-keeness-factor"
3031      (floatSuffix (\_ d -> d))
3032      "-funfolding-keeness-factor is no longer respected as of GHC 8.12"
3033  , make_ord_flag defFlag "fmax-worker-args"
3034      (intSuffix (\n d -> d {maxWorkerArgs = n}))
3035  , make_ord_flag defGhciFlag "fghci-hist-size"
3036      (intSuffix (\n d -> d {ghciHistSize = n}))
3037  , make_ord_flag defGhcFlag "fmax-inline-alloc-size"
3038      (intSuffix (\n d -> d { maxInlineAllocSize = n }))
3039  , make_ord_flag defGhcFlag "fmax-inline-memcpy-insns"
3040      (intSuffix (\n d -> d { maxInlineMemcpyInsns = n }))
3041  , make_ord_flag defGhcFlag "fmax-inline-memset-insns"
3042      (intSuffix (\n d -> d { maxInlineMemsetInsns = n }))
3043  , make_ord_flag defGhcFlag "dinitial-unique"
3044      (intSuffix (\n d -> d { initialUnique = n }))
3045  , make_ord_flag defGhcFlag "dunique-increment"
3046      (intSuffix (\n d -> d { uniqueIncrement = n }))
3047
3048        ------ Profiling ----------------------------------------------------
3049
3050        -- OLD profiling flags
3051  , make_dep_flag defGhcFlag "auto-all"
3052                    (noArg (\d -> d { profAuto = ProfAutoAll } ))
3053                    "Use -fprof-auto instead"
3054  , make_dep_flag defGhcFlag "no-auto-all"
3055                    (noArg (\d -> d { profAuto = NoProfAuto } ))
3056                    "Use -fno-prof-auto instead"
3057  , make_dep_flag defGhcFlag "auto"
3058                    (noArg (\d -> d { profAuto = ProfAutoExports } ))
3059                    "Use -fprof-auto-exported instead"
3060  , make_dep_flag defGhcFlag "no-auto"
3061            (noArg (\d -> d { profAuto = NoProfAuto } ))
3062                    "Use -fno-prof-auto instead"
3063  , make_dep_flag defGhcFlag "caf-all"
3064            (NoArg (setGeneralFlag Opt_AutoSccsOnIndividualCafs))
3065                    "Use -fprof-cafs instead"
3066  , make_dep_flag defGhcFlag "no-caf-all"
3067            (NoArg (unSetGeneralFlag Opt_AutoSccsOnIndividualCafs))
3068                    "Use -fno-prof-cafs instead"
3069
3070        -- NEW profiling flags
3071  , make_ord_flag defGhcFlag "fprof-auto"
3072      (noArg (\d -> d { profAuto = ProfAutoAll } ))
3073  , make_ord_flag defGhcFlag "fprof-auto-top"
3074      (noArg (\d -> d { profAuto = ProfAutoTop } ))
3075  , make_ord_flag defGhcFlag "fprof-auto-exported"
3076      (noArg (\d -> d { profAuto = ProfAutoExports } ))
3077  , make_ord_flag defGhcFlag "fprof-auto-calls"
3078      (noArg (\d -> d { profAuto = ProfAutoCalls } ))
3079  , make_ord_flag defGhcFlag "fno-prof-auto"
3080      (noArg (\d -> d { profAuto = NoProfAuto } ))
3081
3082        ------ Compiler flags -----------------------------------------------
3083
3084  , make_ord_flag defGhcFlag "fasm"             (NoArg (setObjTarget HscAsm))
3085  , make_ord_flag defGhcFlag "fvia-c"           (NoArg
3086         (deprecate $ "The -fvia-c flag does nothing; " ++
3087                      "it will be removed in a future GHC release"))
3088  , make_ord_flag defGhcFlag "fvia-C"           (NoArg
3089         (deprecate $ "The -fvia-C flag does nothing; " ++
3090                      "it will be removed in a future GHC release"))
3091  , make_ord_flag defGhcFlag "fllvm"            (NoArg (setObjTarget HscLlvm))
3092
3093  , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->
3094                  d { ghcLink=NoLink }) >> setTarget HscNothing))
3095  , make_ord_flag defFlag "fbyte-code"       (NoArg ((upd $ \d ->
3096      -- Enabling Opt_ByteCodeIfUnboxed is a workaround for #18955.
3097      -- See the comments for resetOptByteCodeIfUnboxed for more details.
3098      gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted))
3099  , make_ord_flag defFlag "fobject-code"     $ NoArg $ do
3100      dflags <- liftEwM getCmdLineState
3101      setTarget $ defaultObjectTarget dflags
3102
3103  , make_dep_flag defFlag "fglasgow-exts"
3104      (NoArg enableGlasgowExts) "Use individual extensions instead"
3105  , make_dep_flag defFlag "fno-glasgow-exts"
3106      (NoArg disableGlasgowExts) "Use individual extensions instead"
3107  , make_ord_flag defFlag "Wunused-binds" (NoArg enableUnusedBinds)
3108  , make_ord_flag defFlag "Wno-unused-binds" (NoArg disableUnusedBinds)
3109  , make_ord_flag defHiddenFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)
3110  , make_ord_flag defHiddenFlag "fno-warn-unused-binds" (NoArg
3111                                                            disableUnusedBinds)
3112
3113        ------ Safe Haskell flags -------------------------------------------
3114  , make_ord_flag defFlag "fpackage-trust"   (NoArg setPackageTrust)
3115  , make_ord_flag defFlag "fno-safe-infer"   (noArg (\d ->
3116                                                    d { safeInfer = False }))
3117  , make_ord_flag defFlag "fno-safe-haskell" (NoArg (setSafeHaskell Sf_Ignore))
3118
3119        ------ position independent flags  ----------------------------------
3120  , make_ord_flag defGhcFlag "fPIC"          (NoArg (setGeneralFlag Opt_PIC))
3121  , make_ord_flag defGhcFlag "fno-PIC"       (NoArg (unSetGeneralFlag Opt_PIC))
3122  , make_ord_flag defGhcFlag "fPIE"          (NoArg (setGeneralFlag Opt_PIE))
3123  , make_ord_flag defGhcFlag "fno-PIE"       (NoArg (unSetGeneralFlag Opt_PIE))
3124
3125         ------ Debugging flags ----------------------------------------------
3126  , make_ord_flag defGhcFlag "g"             (OptIntSuffix setDebugLevel)
3127 ]
3128 ++ map (mkFlag turnOn  ""          setGeneralFlag    ) negatableFlagsDeps
3129 ++ map (mkFlag turnOff "no-"       unSetGeneralFlag  ) negatableFlagsDeps
3130 ++ map (mkFlag turnOn  "d"         setGeneralFlag    ) dFlagsDeps
3131 ++ map (mkFlag turnOff "dno-"      unSetGeneralFlag  ) dFlagsDeps
3132 ++ map (mkFlag turnOn  "f"         setGeneralFlag    ) fFlagsDeps
3133 ++ map (mkFlag turnOff "fno-"      unSetGeneralFlag  ) fFlagsDeps
3134 ++ map (mkFlag turnOn  "W"         setWarningFlag    ) wWarningFlagsDeps
3135 ++ map (mkFlag turnOff "Wno-"      unSetWarningFlag  ) wWarningFlagsDeps
3136 ++ map (mkFlag turnOn  "Werror="   setWErrorFlag )     wWarningFlagsDeps
3137 ++ map (mkFlag turnOn  "Wwarn="     unSetFatalWarningFlag )
3138                                                        wWarningFlagsDeps
3139 ++ map (mkFlag turnOn  "Wno-error=" unSetFatalWarningFlag )
3140                                                        wWarningFlagsDeps
3141 ++ map (mkFlag turnOn  "fwarn-"    setWarningFlag   . hideFlag)
3142    wWarningFlagsDeps
3143 ++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag)
3144    wWarningFlagsDeps
3145 ++ [ (NotDeprecated, unrecognisedWarning "W"),
3146      (Deprecated,    unrecognisedWarning "fwarn-"),
3147      (Deprecated,    unrecognisedWarning "fno-warn-") ]
3148 ++ [ make_ord_flag defFlag "Werror=compat"
3149        (NoArg (mapM_ setWErrorFlag minusWcompatOpts))
3150    , make_ord_flag defFlag "Wno-error=compat"
3151        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts))
3152    , make_ord_flag defFlag "Wwarn=compat"
3153        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ]
3154 ++ map (mkFlag turnOn  "f"         setExtensionFlag  ) fLangFlagsDeps
3155 ++ map (mkFlag turnOff "fno-"      unSetExtensionFlag) fLangFlagsDeps
3156 ++ map (mkFlag turnOn  "X"         setExtensionFlag  ) xFlagsDeps
3157 ++ map (mkFlag turnOff "XNo"       unSetExtensionFlag) xFlagsDeps
3158 ++ map (mkFlag turnOn  "X"         setLanguage       ) languageFlagsDeps
3159 ++ map (mkFlag turnOn  "X"         setSafeHaskell    ) safeHaskellFlagsDeps
3160 ++ [ make_dep_flag defFlag "XGenerics"
3161        (NoArg $ return ())
3162                  ("it does nothing; look into -XDefaultSignatures " ++
3163                   "and -XDeriveGeneric for generic programming support.")
3164    , make_dep_flag defFlag "XNoGenerics"
3165        (NoArg $ return ())
3166               ("it does nothing; look into -XDefaultSignatures and " ++
3167                  "-XDeriveGeneric for generic programming support.") ]
3168
3169-- | This is where we handle unrecognised warning flags. We only issue a warning
3170-- if -Wunrecognised-warning-flags is set. See #11429 for context.
3171unrecognisedWarning :: String -> Flag (CmdLineP DynFlags)
3172unrecognisedWarning prefix = defHiddenFlag prefix (Prefix action)
3173  where
3174    action :: String -> EwM (CmdLineP DynFlags) ()
3175    action flag = do
3176      f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState
3177      when f $ addFlagWarn Cmd.ReasonUnrecognisedFlag $
3178        "unrecognised warning flag: -" ++ prefix ++ flag
3179
3180-- See Note [Supporting CLI completion]
3181package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]
3182package_flags_deps = [
3183        ------- Packages ----------------------------------------------------
3184    make_ord_flag defFlag "package-db"
3185      (HasArg (addPkgDbRef . PkgDbPath))
3186  , make_ord_flag defFlag "clear-package-db"      (NoArg clearPkgDb)
3187  , make_ord_flag defFlag "no-global-package-db"  (NoArg removeGlobalPkgDb)
3188  , make_ord_flag defFlag "no-user-package-db"    (NoArg removeUserPkgDb)
3189  , make_ord_flag defFlag "global-package-db"
3190      (NoArg (addPkgDbRef GlobalPkgDb))
3191  , make_ord_flag defFlag "user-package-db"
3192      (NoArg (addPkgDbRef UserPkgDb))
3193    -- backwards compat with GHC<=7.4 :
3194  , make_dep_flag defFlag "package-conf"
3195      (HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead"
3196  , make_dep_flag defFlag "no-user-package-conf"
3197      (NoArg removeUserPkgDb)              "Use -no-user-package-db instead"
3198  , make_ord_flag defGhcFlag "package-name"       (HasArg $ \name -> do
3199                                      upd (setUnitId name))
3200  , make_ord_flag defGhcFlag "this-unit-id"       (hasArg setUnitId)
3201  , make_ord_flag defFlag "package"               (HasArg exposePackage)
3202  , make_ord_flag defFlag "plugin-package-id"     (HasArg exposePluginPackageId)
3203  , make_ord_flag defFlag "plugin-package"        (HasArg exposePluginPackage)
3204  , make_ord_flag defFlag "package-id"            (HasArg exposePackageId)
3205  , make_ord_flag defFlag "hide-package"          (HasArg hidePackage)
3206  , make_ord_flag defFlag "hide-all-packages"
3207      (NoArg (setGeneralFlag Opt_HideAllPackages))
3208  , make_ord_flag defFlag "hide-all-plugin-packages"
3209      (NoArg (setGeneralFlag Opt_HideAllPluginPackages))
3210  , make_ord_flag defFlag "package-env"           (HasArg setPackageEnv)
3211  , make_ord_flag defFlag "ignore-package"        (HasArg ignorePackage)
3212  , make_dep_flag defFlag "syslib" (HasArg exposePackage) "Use -package instead"
3213  , make_ord_flag defFlag "distrust-all-packages"
3214      (NoArg (setGeneralFlag Opt_DistrustAllPackages))
3215  , make_ord_flag defFlag "trust"                 (HasArg trustPackage)
3216  , make_ord_flag defFlag "distrust"              (HasArg distrustPackage)
3217  ]
3218  where
3219    setPackageEnv env = upd $ \s -> s { packageEnv = Just env }
3220
3221-- | Make a list of flags for shell completion.
3222-- Filter all available flags into two groups, for interactive GHC vs all other.
3223flagsForCompletion :: Bool -> [String]
3224flagsForCompletion isInteractive
3225    = [ '-':flagName flag
3226      | flag <- flagsAll
3227      , modeFilter (flagGhcMode flag)
3228      ]
3229    where
3230      modeFilter AllModes = True
3231      modeFilter OnlyGhci = isInteractive
3232      modeFilter OnlyGhc = not isInteractive
3233      modeFilter HiddenFlag = False
3234
3235type TurnOnFlag = Bool   -- True  <=> we are turning the flag on
3236                         -- False <=> we are turning the flag off
3237turnOn  :: TurnOnFlag; turnOn  = True
3238turnOff :: TurnOnFlag; turnOff = False
3239
3240data FlagSpec flag
3241   = FlagSpec
3242       { flagSpecName :: String   -- ^ Flag in string form
3243       , flagSpecFlag :: flag     -- ^ Flag in internal form
3244       , flagSpecAction :: (TurnOnFlag -> DynP ())
3245           -- ^ Extra action to run when the flag is found
3246           -- Typically, emit a warning or error
3247       , flagSpecGhcMode :: GhcFlagMode
3248           -- ^ In which ghc mode the flag has effect
3249       }
3250
3251-- | Define a new flag.
3252flagSpec :: String -> flag -> (Deprecation, FlagSpec flag)
3253flagSpec name flag = flagSpec' name flag nop
3254
3255-- | Define a new flag with an effect.
3256flagSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
3257          -> (Deprecation, FlagSpec flag)
3258flagSpec' name flag act = (NotDeprecated, FlagSpec name flag act AllModes)
3259
3260-- | Define a new deprecated flag with an effect.
3261depFlagSpecOp :: String -> flag -> (TurnOnFlag -> DynP ()) -> String
3262            -> (Deprecation, FlagSpec flag)
3263depFlagSpecOp name flag act dep =
3264    (Deprecated, snd (flagSpec' name flag (\f -> act f >> deprecate dep)))
3265
3266-- | Define a new deprecated flag.
3267depFlagSpec :: String -> flag -> String
3268            -> (Deprecation, FlagSpec flag)
3269depFlagSpec name flag dep = depFlagSpecOp name flag nop dep
3270
3271-- | Define a new deprecated flag with an effect where the deprecation message
3272-- depends on the flag value
3273depFlagSpecOp' :: String
3274             -> flag
3275             -> (TurnOnFlag -> DynP ())
3276             -> (TurnOnFlag -> String)
3277             -> (Deprecation, FlagSpec flag)
3278depFlagSpecOp' name flag act dep =
3279    (Deprecated, FlagSpec name flag (\f -> act f >> (deprecate $ dep f))
3280                                                                       AllModes)
3281
3282-- | Define a new deprecated flag where the deprecation message
3283-- depends on the flag value
3284depFlagSpec' :: String
3285             -> flag
3286             -> (TurnOnFlag -> String)
3287             -> (Deprecation, FlagSpec flag)
3288depFlagSpec' name flag dep = depFlagSpecOp' name flag nop dep
3289
3290
3291-- | Define a new deprecated flag where the deprecation message
3292-- is shown depending on the flag value
3293depFlagSpecCond :: String
3294                -> flag
3295                -> (TurnOnFlag -> Bool)
3296                -> String
3297                -> (Deprecation, FlagSpec flag)
3298depFlagSpecCond name flag cond dep =
3299    (Deprecated, FlagSpec name flag (\f -> when (cond f) $ deprecate dep)
3300                                                                       AllModes)
3301
3302-- | Define a new flag for GHCi.
3303flagGhciSpec :: String -> flag -> (Deprecation, FlagSpec flag)
3304flagGhciSpec name flag = flagGhciSpec' name flag nop
3305
3306-- | Define a new flag for GHCi with an effect.
3307flagGhciSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
3308              -> (Deprecation, FlagSpec flag)
3309flagGhciSpec' name flag act = (NotDeprecated, FlagSpec name flag act OnlyGhci)
3310
3311-- | Define a new flag invisible to CLI completion.
3312flagHiddenSpec :: String -> flag -> (Deprecation, FlagSpec flag)
3313flagHiddenSpec name flag = flagHiddenSpec' name flag nop
3314
3315-- | Define a new flag invisible to CLI completion with an effect.
3316flagHiddenSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
3317                -> (Deprecation, FlagSpec flag)
3318flagHiddenSpec' name flag act = (NotDeprecated, FlagSpec name flag act
3319                                                                     HiddenFlag)
3320
3321-- | Hide a 'FlagSpec' from being displayed in @--show-options@.
3322--
3323-- This is for example useful for flags that are obsolete, but should not
3324-- (yet) be deprecated for compatibility reasons.
3325hideFlag :: (Deprecation, FlagSpec a) -> (Deprecation, FlagSpec a)
3326hideFlag (dep, fs) = (dep, fs { flagSpecGhcMode = HiddenFlag })
3327
3328mkFlag :: TurnOnFlag            -- ^ True <=> it should be turned on
3329       -> String                -- ^ The flag prefix
3330       -> (flag -> DynP ())     -- ^ What to do when the flag is found
3331       -> (Deprecation, FlagSpec flag)  -- ^ Specification of
3332                                        -- this particular flag
3333       -> (Deprecation, Flag (CmdLineP DynFlags))
3334mkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode))
3335    = (dep,
3336       Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode)
3337
3338deprecatedForExtension :: String -> TurnOnFlag -> String
3339deprecatedForExtension lang turn_on
3340    = "use -X" ++ flag ++
3341      " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead"
3342    where
3343      flag | turn_on   = lang
3344           | otherwise = "No" ++ lang
3345
3346useInstead :: String -> String -> TurnOnFlag -> String
3347useInstead prefix flag turn_on
3348  = "Use " ++ prefix ++ no ++ flag ++ " instead"
3349  where
3350    no = if turn_on then "" else "no-"
3351
3352nop :: TurnOnFlag -> DynP ()
3353nop _ = return ()
3354
3355-- | Find the 'FlagSpec' for a 'WarningFlag'.
3356flagSpecOf :: WarningFlag -> Maybe (FlagSpec WarningFlag)
3357flagSpecOf flag = listToMaybe $ filter check wWarningFlags
3358  where
3359    check fs = flagSpecFlag fs == flag
3360
3361-- | These @-W\<blah\>@ flags can all be reversed with @-Wno-\<blah\>@
3362wWarningFlags :: [FlagSpec WarningFlag]
3363wWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps)
3364
3365wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)]
3366wWarningFlagsDeps = [
3367-- See Note [Updating flag description in the User's Guide]
3368-- See Note [Supporting CLI completion]
3369-- Please keep the list of flags below sorted alphabetically
3370  flagSpec "alternative-layout-rule-transitional"
3371                                      Opt_WarnAlternativeLayoutRuleTransitional,
3372  depFlagSpec "auto-orphans"             Opt_WarnAutoOrphans
3373    "it has no effect",
3374  flagSpec "cpp-undef"                   Opt_WarnCPPUndef,
3375  flagSpec "unbanged-strict-patterns"    Opt_WarnUnbangedStrictPatterns,
3376  flagSpec "deferred-type-errors"        Opt_WarnDeferredTypeErrors,
3377  flagSpec "deferred-out-of-scope-variables"
3378                                         Opt_WarnDeferredOutOfScopeVariables,
3379  flagSpec "deprecations"                Opt_WarnWarningsDeprecations,
3380  flagSpec "deprecated-flags"            Opt_WarnDeprecatedFlags,
3381  flagSpec "deriving-defaults"           Opt_WarnDerivingDefaults,
3382  flagSpec "deriving-typeable"           Opt_WarnDerivingTypeable,
3383  flagSpec "dodgy-exports"               Opt_WarnDodgyExports,
3384  flagSpec "dodgy-foreign-imports"       Opt_WarnDodgyForeignImports,
3385  flagSpec "dodgy-imports"               Opt_WarnDodgyImports,
3386  flagSpec "empty-enumerations"          Opt_WarnEmptyEnumerations,
3387  depFlagSpec "duplicate-constraints"    Opt_WarnDuplicateConstraints
3388    "it is subsumed by -Wredundant-constraints",
3389  flagSpec "redundant-constraints"       Opt_WarnRedundantConstraints,
3390  flagSpec "duplicate-exports"           Opt_WarnDuplicateExports,
3391  depFlagSpec "hi-shadowing"                Opt_WarnHiShadows
3392    "it is not used, and was never implemented",
3393  flagSpec "inaccessible-code"           Opt_WarnInaccessibleCode,
3394  flagSpec "implicit-prelude"            Opt_WarnImplicitPrelude,
3395  depFlagSpec "implicit-kind-vars"       Opt_WarnImplicitKindVars
3396    "it is now an error",
3397  flagSpec "incomplete-patterns"         Opt_WarnIncompletePatterns,
3398  flagSpec "incomplete-record-updates"   Opt_WarnIncompletePatternsRecUpd,
3399  flagSpec "incomplete-uni-patterns"     Opt_WarnIncompleteUniPatterns,
3400  flagSpec "inline-rule-shadowing"       Opt_WarnInlineRuleShadowing,
3401  flagSpec "identities"                  Opt_WarnIdentities,
3402  flagSpec "missing-fields"              Opt_WarnMissingFields,
3403  flagSpec "missing-import-lists"        Opt_WarnMissingImportList,
3404  flagSpec "missing-export-lists"        Opt_WarnMissingExportList,
3405  depFlagSpec "missing-local-sigs"       Opt_WarnMissingLocalSignatures
3406    "it is replaced by -Wmissing-local-signatures",
3407  flagSpec "missing-local-signatures"    Opt_WarnMissingLocalSignatures,
3408  flagSpec "missing-methods"             Opt_WarnMissingMethods,
3409  flagSpec "missing-monadfail-instances" Opt_WarnMissingMonadFailInstances,
3410  flagSpec "semigroup"                   Opt_WarnSemigroup,
3411  flagSpec "missing-signatures"          Opt_WarnMissingSignatures,
3412  depFlagSpec "missing-exported-sigs"    Opt_WarnMissingExportedSignatures
3413    "it is replaced by -Wmissing-exported-signatures",
3414  flagSpec "missing-exported-signatures" Opt_WarnMissingExportedSignatures,
3415  flagSpec "monomorphism-restriction"    Opt_WarnMonomorphism,
3416  flagSpec "name-shadowing"              Opt_WarnNameShadowing,
3417  flagSpec "noncanonical-monad-instances"
3418                                         Opt_WarnNonCanonicalMonadInstances,
3419  depFlagSpec "noncanonical-monadfail-instances"
3420                                         Opt_WarnNonCanonicalMonadInstances
3421    "fail is no longer a method of Monad",
3422  flagSpec "noncanonical-monoid-instances"
3423                                         Opt_WarnNonCanonicalMonoidInstances,
3424  flagSpec "orphans"                     Opt_WarnOrphans,
3425  flagSpec "overflowed-literals"         Opt_WarnOverflowedLiterals,
3426  flagSpec "overlapping-patterns"        Opt_WarnOverlappingPatterns,
3427  flagSpec "missed-specialisations"      Opt_WarnMissedSpecs,
3428  flagSpec "missed-specializations"      Opt_WarnMissedSpecs,
3429  flagSpec "all-missed-specialisations"  Opt_WarnAllMissedSpecs,
3430  flagSpec "all-missed-specializations"  Opt_WarnAllMissedSpecs,
3431  flagSpec' "safe"                       Opt_WarnSafe setWarnSafe,
3432  flagSpec "trustworthy-safe"            Opt_WarnTrustworthySafe,
3433  flagSpec "inferred-safe-imports"       Opt_WarnInferredSafeImports,
3434  flagSpec "missing-safe-haskell-mode"   Opt_WarnMissingSafeHaskellMode,
3435  flagSpec "tabs"                        Opt_WarnTabs,
3436  flagSpec "type-defaults"               Opt_WarnTypeDefaults,
3437  flagSpec "typed-holes"                 Opt_WarnTypedHoles,
3438  flagSpec "partial-type-signatures"     Opt_WarnPartialTypeSignatures,
3439  flagSpec "unrecognised-pragmas"        Opt_WarnUnrecognisedPragmas,
3440  flagSpec' "unsafe"                     Opt_WarnUnsafe setWarnUnsafe,
3441  flagSpec "unsupported-calling-conventions"
3442                                         Opt_WarnUnsupportedCallingConventions,
3443  flagSpec "unsupported-llvm-version"    Opt_WarnUnsupportedLlvmVersion,
3444  flagSpec "missed-extra-shared-lib"     Opt_WarnMissedExtraSharedLib,
3445  flagSpec "unticked-promoted-constructors"
3446                                         Opt_WarnUntickedPromotedConstructors,
3447  flagSpec "unused-do-bind"              Opt_WarnUnusedDoBind,
3448  flagSpec "unused-foralls"              Opt_WarnUnusedForalls,
3449  flagSpec "unused-imports"              Opt_WarnUnusedImports,
3450  flagSpec "unused-local-binds"          Opt_WarnUnusedLocalBinds,
3451  flagSpec "unused-matches"              Opt_WarnUnusedMatches,
3452  flagSpec "unused-pattern-binds"        Opt_WarnUnusedPatternBinds,
3453  flagSpec "unused-top-binds"            Opt_WarnUnusedTopBinds,
3454  flagSpec "unused-type-patterns"        Opt_WarnUnusedTypePatterns,
3455  flagSpec "unused-record-wildcards"     Opt_WarnUnusedRecordWildcards,
3456  flagSpec "redundant-record-wildcards"  Opt_WarnRedundantRecordWildcards,
3457  flagSpec "warnings-deprecations"       Opt_WarnWarningsDeprecations,
3458  flagSpec "wrong-do-bind"               Opt_WarnWrongDoBind,
3459  flagSpec "missing-pattern-synonym-signatures"
3460                                    Opt_WarnMissingPatternSynonymSignatures,
3461  flagSpec "missing-deriving-strategies" Opt_WarnMissingDerivingStrategies,
3462  flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
3463  flagSpec "missing-home-modules"        Opt_WarnMissingHomeModules,
3464  flagSpec "unrecognised-warning-flags"  Opt_WarnUnrecognisedWarningFlags,
3465  flagSpec "star-binder"                 Opt_WarnStarBinder,
3466  flagSpec "star-is-type"                Opt_WarnStarIsType,
3467  depFlagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang
3468    "bang patterns can no longer be written with a space",
3469  flagSpec "partial-fields"              Opt_WarnPartialFields,
3470  flagSpec "prepositive-qualified-module"
3471                                         Opt_WarnPrepositiveQualifiedModule,
3472  flagSpec "unused-packages"             Opt_WarnUnusedPackages,
3473  flagSpec "compat-unqualified-imports"  Opt_WarnCompatUnqualifiedImports,
3474  flagSpec "invalid-haddock"             Opt_WarnInvalidHaddock
3475 ]
3476
3477-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
3478negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
3479negatableFlagsDeps = [
3480  flagGhciSpec "ignore-dot-ghci"         Opt_IgnoreDotGhci ]
3481
3482-- | These @-d\<blah\>@ flags can all be reversed with @-dno-\<blah\>@
3483dFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
3484dFlagsDeps = [
3485-- See Note [Updating flag description in the User's Guide]
3486-- See Note [Supporting CLI completion]
3487-- Please keep the list of flags below sorted alphabetically
3488  flagSpec "ppr-case-as-let"            Opt_PprCaseAsLet,
3489  depFlagSpec' "ppr-ticks"              Opt_PprShowTicks
3490     (\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)),
3491  flagSpec "suppress-ticks"             Opt_SuppressTicks,
3492  depFlagSpec' "suppress-stg-free-vars" Opt_SuppressStgExts
3493     (useInstead "-d" "suppress-stg-exts"),
3494  flagSpec "suppress-stg-exts"          Opt_SuppressStgExts,
3495  flagSpec "suppress-coercions"         Opt_SuppressCoercions,
3496  flagSpec "suppress-idinfo"            Opt_SuppressIdInfo,
3497  flagSpec "suppress-unfoldings"        Opt_SuppressUnfoldings,
3498  flagSpec "suppress-module-prefixes"   Opt_SuppressModulePrefixes,
3499  flagSpec "suppress-timestamps"        Opt_SuppressTimestamps,
3500  flagSpec "suppress-type-applications" Opt_SuppressTypeApplications,
3501  flagSpec "suppress-type-signatures"   Opt_SuppressTypeSignatures,
3502  flagSpec "suppress-uniques"           Opt_SuppressUniques,
3503  flagSpec "suppress-var-kinds"         Opt_SuppressVarKinds
3504  ]
3505
3506-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
3507fFlags :: [FlagSpec GeneralFlag]
3508fFlags = map snd fFlagsDeps
3509
3510fFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
3511fFlagsDeps = [
3512-- See Note [Updating flag description in the User's Guide]
3513-- See Note [Supporting CLI completion]
3514-- Please keep the list of flags below sorted alphabetically
3515  flagSpec "asm-shortcutting"                 Opt_AsmShortcutting,
3516  flagGhciSpec "break-on-error"               Opt_BreakOnError,
3517  flagGhciSpec "break-on-exception"           Opt_BreakOnException,
3518  flagSpec "building-cabal-package"           Opt_BuildingCabalPackage,
3519  flagSpec "call-arity"                       Opt_CallArity,
3520  flagSpec "exitification"                    Opt_Exitification,
3521  flagSpec "case-merge"                       Opt_CaseMerge,
3522  flagSpec "case-folding"                     Opt_CaseFolding,
3523  flagSpec "cmm-elim-common-blocks"           Opt_CmmElimCommonBlocks,
3524  flagSpec "cmm-sink"                         Opt_CmmSink,
3525  flagSpec "cmm-static-pred"                  Opt_CmmStaticPred,
3526  flagSpec "cse"                              Opt_CSE,
3527  flagSpec "stg-cse"                          Opt_StgCSE,
3528  flagSpec "stg-lift-lams"                    Opt_StgLiftLams,
3529  flagSpec "cpr-anal"                         Opt_CprAnal,
3530  flagSpec "defer-diagnostics"                Opt_DeferDiagnostics,
3531  flagSpec "defer-type-errors"                Opt_DeferTypeErrors,
3532  flagSpec "defer-typed-holes"                Opt_DeferTypedHoles,
3533  flagSpec "defer-out-of-scope-variables"     Opt_DeferOutOfScopeVariables,
3534  flagSpec "diagnostics-show-caret"           Opt_DiagnosticsShowCaret,
3535  flagSpec "dicts-cheap"                      Opt_DictsCheap,
3536  flagSpec "dicts-strict"                     Opt_DictsStrict,
3537  flagSpec "dmd-tx-dict-sel"                  Opt_DmdTxDictSel,
3538  flagSpec "do-eta-reduction"                 Opt_DoEtaReduction,
3539  flagSpec "do-lambda-eta-expansion"          Opt_DoLambdaEtaExpansion,
3540  flagSpec "eager-blackholing"                Opt_EagerBlackHoling,
3541  flagSpec "embed-manifest"                   Opt_EmbedManifest,
3542  flagSpec "enable-rewrite-rules"             Opt_EnableRewriteRules,
3543  flagSpec "enable-th-splice-warnings"        Opt_EnableThSpliceWarnings,
3544  flagSpec "error-spans"                      Opt_ErrorSpans,
3545  flagSpec "excess-precision"                 Opt_ExcessPrecision,
3546  flagSpec "expose-all-unfoldings"            Opt_ExposeAllUnfoldings,
3547  flagSpec "external-dynamic-refs"            Opt_ExternalDynamicRefs,
3548  flagSpec "external-interpreter"             Opt_ExternalInterpreter,
3549  flagSpec "flat-cache"                       Opt_FlatCache,
3550  flagSpec "float-in"                         Opt_FloatIn,
3551  flagSpec "force-recomp"                     Opt_ForceRecomp,
3552  flagSpec "ignore-optim-changes"             Opt_IgnoreOptimChanges,
3553  flagSpec "ignore-hpc-changes"               Opt_IgnoreHpcChanges,
3554  flagSpec "full-laziness"                    Opt_FullLaziness,
3555  flagSpec "fun-to-thunk"                     Opt_FunToThunk,
3556  flagSpec "gen-manifest"                     Opt_GenManifest,
3557  flagSpec "ghci-history"                     Opt_GhciHistory,
3558  flagSpec "ghci-leak-check"                  Opt_GhciLeakCheck,
3559  flagSpec "validate-ide-info"                Opt_ValidateHie,
3560  flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,
3561  flagGhciSpec "no-it"                        Opt_NoIt,
3562  flagSpec "ghci-sandbox"                     Opt_GhciSandbox,
3563  flagSpec "helpful-errors"                   Opt_HelpfulErrors,
3564  flagSpec "hpc"                              Opt_Hpc,
3565  flagSpec "ignore-asserts"                   Opt_IgnoreAsserts,
3566  flagSpec "ignore-interface-pragmas"         Opt_IgnoreInterfacePragmas,
3567  flagGhciSpec "implicit-import-qualified"    Opt_ImplicitImportQualified,
3568  flagSpec "irrefutable-tuples"               Opt_IrrefutableTuples,
3569  flagSpec "keep-going"                       Opt_KeepGoing,
3570  flagSpec "late-dmd-anal"                    Opt_LateDmdAnal,
3571  flagSpec "late-specialise"                  Opt_LateSpecialise,
3572  flagSpec "liberate-case"                    Opt_LiberateCase,
3573  flagHiddenSpec "llvm-tbaa"                  Opt_LlvmTBAA,
3574  flagHiddenSpec "llvm-fill-undef-with-garbage" Opt_LlvmFillUndefWithGarbage,
3575  flagSpec "loopification"                    Opt_Loopification,
3576  flagSpec "block-layout-cfg"                 Opt_CfgBlocklayout,
3577  flagSpec "block-layout-weightless"          Opt_WeightlessBlocklayout,
3578  flagSpec "omit-interface-pragmas"           Opt_OmitInterfacePragmas,
3579  flagSpec "omit-yields"                      Opt_OmitYields,
3580  flagSpec "optimal-applicative-do"           Opt_OptimalApplicativeDo,
3581  flagSpec "pedantic-bottoms"                 Opt_PedanticBottoms,
3582  flagSpec "pre-inlining"                     Opt_SimplPreInlining,
3583  flagGhciSpec "print-bind-contents"          Opt_PrintBindContents,
3584  flagGhciSpec "print-bind-result"            Opt_PrintBindResult,
3585  flagGhciSpec "print-evld-with-show"         Opt_PrintEvldWithShow,
3586  flagSpec "print-explicit-foralls"           Opt_PrintExplicitForalls,
3587  flagSpec "print-explicit-kinds"             Opt_PrintExplicitKinds,
3588  flagSpec "print-explicit-coercions"         Opt_PrintExplicitCoercions,
3589  flagSpec "print-explicit-runtime-reps"      Opt_PrintExplicitRuntimeReps,
3590  flagSpec "print-equality-relations"         Opt_PrintEqualityRelations,
3591  flagSpec "print-axiom-incomps"              Opt_PrintAxiomIncomps,
3592  flagSpec "print-unicode-syntax"             Opt_PrintUnicodeSyntax,
3593  flagSpec "print-expanded-synonyms"          Opt_PrintExpandedSynonyms,
3594  flagSpec "print-potential-instances"        Opt_PrintPotentialInstances,
3595  flagSpec "print-typechecker-elaboration"    Opt_PrintTypecheckerElaboration,
3596  flagSpec "prof-cafs"                        Opt_AutoSccsOnIndividualCafs,
3597  flagSpec "prof-count-entries"               Opt_ProfCountEntries,
3598  flagSpec "regs-graph"                       Opt_RegsGraph,
3599  flagSpec "regs-iterative"                   Opt_RegsIterative,
3600  depFlagSpec' "rewrite-rules"                Opt_EnableRewriteRules
3601   (useInstead "-f" "enable-rewrite-rules"),
3602  flagSpec "shared-implib"                    Opt_SharedImplib,
3603  flagSpec "spec-constr"                      Opt_SpecConstr,
3604  flagSpec "spec-constr-keen"                 Opt_SpecConstrKeen,
3605  flagSpec "specialise"                       Opt_Specialise,
3606  flagSpec "specialize"                       Opt_Specialise,
3607  flagSpec "specialise-aggressively"          Opt_SpecialiseAggressively,
3608  flagSpec "specialize-aggressively"          Opt_SpecialiseAggressively,
3609  flagSpec "cross-module-specialise"          Opt_CrossModuleSpecialise,
3610  flagSpec "cross-module-specialize"          Opt_CrossModuleSpecialise,
3611  flagSpec "static-argument-transformation"   Opt_StaticArgumentTransformation,
3612  flagSpec "strictness"                       Opt_Strictness,
3613  flagSpec "use-rpaths"                       Opt_RPath,
3614  flagSpec "write-interface"                  Opt_WriteInterface,
3615  flagSpec "write-ide-info"                   Opt_WriteHie,
3616  flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,
3617  flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,
3618  flagSpec "version-macros"                   Opt_VersionMacros,
3619  flagSpec "worker-wrapper"                   Opt_WorkerWrapper,
3620  flagSpec "solve-constant-dicts"             Opt_SolveConstantDicts,
3621  flagSpec "catch-bottoms"                    Opt_CatchBottoms,
3622  flagSpec "alignment-sanitisation"           Opt_AlignmentSanitisation,
3623  flagSpec "num-constant-folding"             Opt_NumConstantFolding,
3624  flagSpec "show-warning-groups"              Opt_ShowWarnGroups,
3625  flagSpec "hide-source-paths"                Opt_HideSourcePaths,
3626  flagSpec "show-loaded-modules"              Opt_ShowLoadedModules,
3627  flagSpec "whole-archive-hs-libs"            Opt_WholeArchiveHsLibs,
3628  flagSpec "keep-cafs"                        Opt_KeepCAFs,
3629  flagSpec "link-rts"                         Opt_LinkRts
3630  ]
3631  ++ fHoleFlags
3632
3633-- | These @-f\<blah\>@ flags have to do with the typed-hole error message or
3634-- the valid hole fits in that message. See Note [Valid hole fits include ...]
3635-- in the "GHC.Tc.Errors.Hole" module. These flags can all be reversed with
3636-- @-fno-\<blah\>@
3637fHoleFlags :: [(Deprecation, FlagSpec GeneralFlag)]
3638fHoleFlags = [
3639  flagSpec "show-hole-constraints"            Opt_ShowHoleConstraints,
3640  depFlagSpec' "show-valid-substitutions"     Opt_ShowValidHoleFits
3641   (useInstead "-f" "show-valid-hole-fits"),
3642  flagSpec "show-valid-hole-fits"             Opt_ShowValidHoleFits,
3643  -- Sorting settings
3644  flagSpec "sort-valid-hole-fits"             Opt_SortValidHoleFits,
3645  flagSpec "sort-by-size-hole-fits"           Opt_SortBySizeHoleFits,
3646  flagSpec "sort-by-subsumption-hole-fits"    Opt_SortBySubsumHoleFits,
3647  flagSpec "abstract-refinement-hole-fits"    Opt_AbstractRefHoleFits,
3648  -- Output format settings
3649  flagSpec "show-hole-matches-of-hole-fits"   Opt_ShowMatchesOfHoleFits,
3650  flagSpec "show-provenance-of-hole-fits"     Opt_ShowProvOfHoleFits,
3651  flagSpec "show-type-of-hole-fits"           Opt_ShowTypeOfHoleFits,
3652  flagSpec "show-type-app-of-hole-fits"       Opt_ShowTypeAppOfHoleFits,
3653  flagSpec "show-type-app-vars-of-hole-fits"  Opt_ShowTypeAppVarsOfHoleFits,
3654  flagSpec "show-docs-of-hole-fits"           Opt_ShowDocsOfHoleFits,
3655  flagSpec "unclutter-valid-hole-fits"        Opt_UnclutterValidHoleFits
3656  ]
3657
3658-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
3659fLangFlags :: [FlagSpec LangExt.Extension]
3660fLangFlags = map snd fLangFlagsDeps
3661
3662fLangFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]
3663fLangFlagsDeps = [
3664-- See Note [Updating flag description in the User's Guide]
3665-- See Note [Supporting CLI completion]
3666  depFlagSpecOp' "th"                           LangExt.TemplateHaskell
3667    checkTemplateHaskellOk
3668    (deprecatedForExtension "TemplateHaskell"),
3669  depFlagSpec' "fi"                             LangExt.ForeignFunctionInterface
3670    (deprecatedForExtension "ForeignFunctionInterface"),
3671  depFlagSpec' "ffi"                            LangExt.ForeignFunctionInterface
3672    (deprecatedForExtension "ForeignFunctionInterface"),
3673  depFlagSpec' "arrows"                         LangExt.Arrows
3674    (deprecatedForExtension "Arrows"),
3675  depFlagSpec' "implicit-prelude"               LangExt.ImplicitPrelude
3676    (deprecatedForExtension "ImplicitPrelude"),
3677  depFlagSpec' "bang-patterns"                  LangExt.BangPatterns
3678    (deprecatedForExtension "BangPatterns"),
3679  depFlagSpec' "monomorphism-restriction"       LangExt.MonomorphismRestriction
3680    (deprecatedForExtension "MonomorphismRestriction"),
3681  depFlagSpec' "mono-pat-binds"                 LangExt.MonoPatBinds
3682    (deprecatedForExtension "MonoPatBinds"),
3683  depFlagSpec' "extended-default-rules"         LangExt.ExtendedDefaultRules
3684    (deprecatedForExtension "ExtendedDefaultRules"),
3685  depFlagSpec' "implicit-params"                LangExt.ImplicitParams
3686    (deprecatedForExtension "ImplicitParams"),
3687  depFlagSpec' "scoped-type-variables"          LangExt.ScopedTypeVariables
3688    (deprecatedForExtension "ScopedTypeVariables"),
3689  depFlagSpec' "allow-overlapping-instances"    LangExt.OverlappingInstances
3690    (deprecatedForExtension "OverlappingInstances"),
3691  depFlagSpec' "allow-undecidable-instances"    LangExt.UndecidableInstances
3692    (deprecatedForExtension "UndecidableInstances"),
3693  depFlagSpec' "allow-incoherent-instances"     LangExt.IncoherentInstances
3694    (deprecatedForExtension "IncoherentInstances")
3695  ]
3696
3697supportedLanguages :: [String]
3698supportedLanguages = map (flagSpecName . snd) languageFlagsDeps
3699
3700supportedLanguageOverlays :: [String]
3701supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps
3702
3703supportedExtensions :: PlatformMini -> [String]
3704supportedExtensions targetPlatformMini = concatMap toFlagSpecNamePair xFlags
3705  where
3706    toFlagSpecNamePair flg
3707      -- IMPORTANT! Make sure that `ghc --supported-extensions` omits
3708      -- "TemplateHaskell"/"QuasiQuotes" when it's known not to work out of the
3709      -- box. See also GHC #11102 and #16331 for more details about
3710      -- the rationale
3711      | isAIX, flagSpecFlag flg == LangExt.TemplateHaskell  = [noName]
3712      | isAIX, flagSpecFlag flg == LangExt.QuasiQuotes      = [noName]
3713      | otherwise = [name, noName]
3714      where
3715        isAIX = platformMini_os targetPlatformMini == OSAIX
3716        noName = "No" ++ name
3717        name = flagSpecName flg
3718
3719supportedLanguagesAndExtensions :: PlatformMini -> [String]
3720supportedLanguagesAndExtensions targetPlatformMini =
3721    supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions targetPlatformMini
3722
3723-- | These -X<blah> flags cannot be reversed with -XNo<blah>
3724languageFlagsDeps :: [(Deprecation, FlagSpec Language)]
3725languageFlagsDeps = [
3726  flagSpec "Haskell98"   Haskell98,
3727  flagSpec "Haskell2010" Haskell2010
3728  ]
3729
3730-- | These -X<blah> flags cannot be reversed with -XNo<blah>
3731-- They are used to place hard requirements on what GHC Haskell language
3732-- features can be used.
3733safeHaskellFlagsDeps :: [(Deprecation, FlagSpec SafeHaskellMode)]
3734safeHaskellFlagsDeps = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]
3735    where mkF flag = flagSpec (show flag) flag
3736
3737-- | These -X<blah> flags can all be reversed with -XNo<blah>
3738xFlags :: [FlagSpec LangExt.Extension]
3739xFlags = map snd xFlagsDeps
3740
3741xFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]
3742xFlagsDeps = [
3743-- See Note [Updating flag description in the User's Guide]
3744-- See Note [Supporting CLI completion]
3745-- See Note [Adding a language extension]
3746-- Please keep the list of flags below sorted alphabetically
3747  flagSpec "AllowAmbiguousTypes"              LangExt.AllowAmbiguousTypes,
3748  flagSpec "AlternativeLayoutRule"            LangExt.AlternativeLayoutRule,
3749  flagSpec "AlternativeLayoutRuleTransitional"
3750                                              LangExt.AlternativeLayoutRuleTransitional,
3751  flagSpec "Arrows"                           LangExt.Arrows,
3752  depFlagSpecCond "AutoDeriveTypeable"        LangExt.AutoDeriveTypeable
3753    id
3754         ("Typeable instances are created automatically " ++
3755                     "for all types since GHC 8.2."),
3756  flagSpec "BangPatterns"                     LangExt.BangPatterns,
3757  flagSpec "BinaryLiterals"                   LangExt.BinaryLiterals,
3758  flagSpec "CApiFFI"                          LangExt.CApiFFI,
3759  flagSpec "CPP"                              LangExt.Cpp,
3760  flagSpec "CUSKs"                            LangExt.CUSKs,
3761  flagSpec "ConstrainedClassMethods"          LangExt.ConstrainedClassMethods,
3762  flagSpec "ConstraintKinds"                  LangExt.ConstraintKinds,
3763  flagSpec "DataKinds"                        LangExt.DataKinds,
3764  depFlagSpecCond "DatatypeContexts"          LangExt.DatatypeContexts
3765    id
3766         ("It was widely considered a misfeature, " ++
3767                     "and has been removed from the Haskell language."),
3768  flagSpec "DefaultSignatures"                LangExt.DefaultSignatures,
3769  flagSpec "DeriveAnyClass"                   LangExt.DeriveAnyClass,
3770  flagSpec "DeriveDataTypeable"               LangExt.DeriveDataTypeable,
3771  flagSpec "DeriveFoldable"                   LangExt.DeriveFoldable,
3772  flagSpec "DeriveFunctor"                    LangExt.DeriveFunctor,
3773  flagSpec "DeriveGeneric"                    LangExt.DeriveGeneric,
3774  flagSpec "DeriveLift"                       LangExt.DeriveLift,
3775  flagSpec "DeriveTraversable"                LangExt.DeriveTraversable,
3776  flagSpec "DerivingStrategies"               LangExt.DerivingStrategies,
3777  flagSpec "DerivingVia"                      LangExt.DerivingVia,
3778  flagSpec "DisambiguateRecordFields"         LangExt.DisambiguateRecordFields,
3779  flagSpec "DoAndIfThenElse"                  LangExt.DoAndIfThenElse,
3780  flagSpec "BlockArguments"                   LangExt.BlockArguments,
3781  depFlagSpec' "DoRec"                        LangExt.RecursiveDo
3782    (deprecatedForExtension "RecursiveDo"),
3783  flagSpec "DuplicateRecordFields"            LangExt.DuplicateRecordFields,
3784  flagSpec "EmptyCase"                        LangExt.EmptyCase,
3785  flagSpec "EmptyDataDecls"                   LangExt.EmptyDataDecls,
3786  flagSpec "EmptyDataDeriving"                LangExt.EmptyDataDeriving,
3787  flagSpec "ExistentialQuantification"        LangExt.ExistentialQuantification,
3788  flagSpec "ExplicitForAll"                   LangExt.ExplicitForAll,
3789  flagSpec "ExplicitNamespaces"               LangExt.ExplicitNamespaces,
3790  flagSpec "ExtendedDefaultRules"             LangExt.ExtendedDefaultRules,
3791  flagSpec "FlexibleContexts"                 LangExt.FlexibleContexts,
3792  flagSpec "FlexibleInstances"                LangExt.FlexibleInstances,
3793  flagSpec "ForeignFunctionInterface"         LangExt.ForeignFunctionInterface,
3794  flagSpec "FunctionalDependencies"           LangExt.FunctionalDependencies,
3795  flagSpec "GADTSyntax"                       LangExt.GADTSyntax,
3796  flagSpec "GADTs"                            LangExt.GADTs,
3797  flagSpec "GHCForeignImportPrim"             LangExt.GHCForeignImportPrim,
3798  flagSpec' "GeneralizedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving
3799                                              setGenDeriving,
3800  flagSpec' "GeneralisedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving
3801                                              setGenDeriving,
3802  flagSpec "ImplicitParams"                   LangExt.ImplicitParams,
3803  flagSpec "ImplicitPrelude"                  LangExt.ImplicitPrelude,
3804  flagSpec "ImportQualifiedPost"              LangExt.ImportQualifiedPost,
3805  flagSpec "ImpredicativeTypes"               LangExt.ImpredicativeTypes,
3806  flagSpec' "IncoherentInstances"             LangExt.IncoherentInstances
3807                                              setIncoherentInsts,
3808  flagSpec "TypeFamilyDependencies"           LangExt.TypeFamilyDependencies,
3809  flagSpec "InstanceSigs"                     LangExt.InstanceSigs,
3810  flagSpec "ApplicativeDo"                    LangExt.ApplicativeDo,
3811  flagSpec "InterruptibleFFI"                 LangExt.InterruptibleFFI,
3812  flagSpec "JavaScriptFFI"                    LangExt.JavaScriptFFI,
3813  flagSpec "KindSignatures"                   LangExt.KindSignatures,
3814  flagSpec "LambdaCase"                       LangExt.LambdaCase,
3815  flagSpec "LexicalNegation"                  LangExt.LexicalNegation,
3816  flagSpec "LiberalTypeSynonyms"              LangExt.LiberalTypeSynonyms,
3817  flagSpec "LinearTypes"                      LangExt.LinearTypes,
3818  flagSpec "MagicHash"                        LangExt.MagicHash,
3819  flagSpec "MonadComprehensions"              LangExt.MonadComprehensions,
3820  depFlagSpec "MonadFailDesugaring"           LangExt.MonadFailDesugaring
3821    "MonadFailDesugaring is now the default behavior",
3822  flagSpec "MonoLocalBinds"                   LangExt.MonoLocalBinds,
3823  depFlagSpecCond "MonoPatBinds"              LangExt.MonoPatBinds
3824    id
3825         "Experimental feature now removed; has no effect",
3826  flagSpec "MonomorphismRestriction"          LangExt.MonomorphismRestriction,
3827  flagSpec "MultiParamTypeClasses"            LangExt.MultiParamTypeClasses,
3828  flagSpec "MultiWayIf"                       LangExt.MultiWayIf,
3829  flagSpec "NumericUnderscores"               LangExt.NumericUnderscores,
3830  flagSpec "NPlusKPatterns"                   LangExt.NPlusKPatterns,
3831  flagSpec "NamedFieldPuns"                   LangExt.RecordPuns,
3832  flagSpec "NamedWildCards"                   LangExt.NamedWildCards,
3833  flagSpec "NegativeLiterals"                 LangExt.NegativeLiterals,
3834  flagSpec "HexFloatLiterals"                 LangExt.HexFloatLiterals,
3835  flagSpec "NondecreasingIndentation"         LangExt.NondecreasingIndentation,
3836  depFlagSpec' "NullaryTypeClasses"           LangExt.NullaryTypeClasses
3837    (deprecatedForExtension "MultiParamTypeClasses"),
3838  flagSpec "NumDecimals"                      LangExt.NumDecimals,
3839  depFlagSpecOp "OverlappingInstances"        LangExt.OverlappingInstances
3840    setOverlappingInsts
3841    "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS",
3842  flagSpec "OverloadedLabels"                 LangExt.OverloadedLabels,
3843  flagSpec "OverloadedLists"                  LangExt.OverloadedLists,
3844  flagSpec "OverloadedStrings"                LangExt.OverloadedStrings,
3845  flagSpec "PackageImports"                   LangExt.PackageImports,
3846  flagSpec "ParallelArrays"                   LangExt.ParallelArrays,
3847  flagSpec "ParallelListComp"                 LangExt.ParallelListComp,
3848  flagSpec "PartialTypeSignatures"            LangExt.PartialTypeSignatures,
3849  flagSpec "PatternGuards"                    LangExt.PatternGuards,
3850  depFlagSpec' "PatternSignatures"            LangExt.ScopedTypeVariables
3851    (deprecatedForExtension "ScopedTypeVariables"),
3852  flagSpec "PatternSynonyms"                  LangExt.PatternSynonyms,
3853  flagSpec "PolyKinds"                        LangExt.PolyKinds,
3854  flagSpec "PolymorphicComponents"            LangExt.RankNTypes,
3855  flagSpec "QuantifiedConstraints"            LangExt.QuantifiedConstraints,
3856  flagSpec "PostfixOperators"                 LangExt.PostfixOperators,
3857  flagSpec "QuasiQuotes"                      LangExt.QuasiQuotes,
3858  flagSpec "QualifiedDo"                      LangExt.QualifiedDo,
3859  flagSpec "Rank2Types"                       LangExt.RankNTypes,
3860  flagSpec "RankNTypes"                       LangExt.RankNTypes,
3861  flagSpec "RebindableSyntax"                 LangExt.RebindableSyntax,
3862  depFlagSpec' "RecordPuns"                   LangExt.RecordPuns
3863    (deprecatedForExtension "NamedFieldPuns"),
3864  flagSpec "RecordWildCards"                  LangExt.RecordWildCards,
3865  flagSpec "RecursiveDo"                      LangExt.RecursiveDo,
3866  flagSpec "RelaxedLayout"                    LangExt.RelaxedLayout,
3867  depFlagSpecCond "RelaxedPolyRec"            LangExt.RelaxedPolyRec
3868    not
3869         "You can't turn off RelaxedPolyRec any more",
3870  flagSpec "RoleAnnotations"                  LangExt.RoleAnnotations,
3871  flagSpec "ScopedTypeVariables"              LangExt.ScopedTypeVariables,
3872  flagSpec "StandaloneDeriving"               LangExt.StandaloneDeriving,
3873  flagSpec "StarIsType"                       LangExt.StarIsType,
3874  flagSpec "StaticPointers"                   LangExt.StaticPointers,
3875  flagSpec "Strict"                           LangExt.Strict,
3876  flagSpec "StrictData"                       LangExt.StrictData,
3877  flagSpec' "TemplateHaskell"                 LangExt.TemplateHaskell
3878                                              checkTemplateHaskellOk,
3879  flagSpec "TemplateHaskellQuotes"            LangExt.TemplateHaskellQuotes,
3880  flagSpec "StandaloneKindSignatures"         LangExt.StandaloneKindSignatures,
3881  flagSpec "TraditionalRecordSyntax"          LangExt.TraditionalRecordSyntax,
3882  flagSpec "TransformListComp"                LangExt.TransformListComp,
3883  flagSpec "TupleSections"                    LangExt.TupleSections,
3884  flagSpec "TypeApplications"                 LangExt.TypeApplications,
3885  flagSpec "TypeInType"                       LangExt.TypeInType,
3886  flagSpec "TypeFamilies"                     LangExt.TypeFamilies,
3887  flagSpec "TypeOperators"                    LangExt.TypeOperators,
3888  flagSpec "TypeSynonymInstances"             LangExt.TypeSynonymInstances,
3889  flagSpec "UnboxedTuples"                    LangExt.UnboxedTuples,
3890  flagSpec "UnboxedSums"                      LangExt.UnboxedSums,
3891  flagSpec "UndecidableInstances"             LangExt.UndecidableInstances,
3892  flagSpec "UndecidableSuperClasses"          LangExt.UndecidableSuperClasses,
3893  flagSpec "UnicodeSyntax"                    LangExt.UnicodeSyntax,
3894  flagSpec "UnliftedFFITypes"                 LangExt.UnliftedFFITypes,
3895  flagSpec "UnliftedNewtypes"                 LangExt.UnliftedNewtypes,
3896  flagSpec "ViewPatterns"                     LangExt.ViewPatterns
3897  ]
3898
3899defaultFlags :: Settings -> [GeneralFlag]
3900defaultFlags settings
3901-- See Note [Updating flag description in the User's Guide]
3902  = [ Opt_AutoLinkPackages,
3903      Opt_DiagnosticsShowCaret,
3904      Opt_EmbedManifest,
3905      Opt_FlatCache,
3906      Opt_GenManifest,
3907      Opt_GhciHistory,
3908      Opt_GhciSandbox,
3909      Opt_HelpfulErrors,
3910      Opt_KeepHiFiles,
3911      Opt_KeepOFiles,
3912      Opt_OmitYields,
3913      Opt_PrintBindContents,
3914      Opt_ProfCountEntries,
3915      Opt_SharedImplib,
3916      Opt_SimplPreInlining,
3917      Opt_VersionMacros
3918    ]
3919
3920    ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
3921             -- The default -O0 options
3922
3923    ++ default_PIC platform
3924
3925    ++ default_RPath platform
3926
3927    ++ concatMap (wayGeneralFlags platform) (defaultWays settings)
3928    ++ validHoleFitDefaults
3929
3930    where platform = sTargetPlatform settings
3931
3932-- | These are the default settings for the display and sorting of valid hole
3933--  fits in typed-hole error messages. See Note [Valid hole fits include ...]
3934 -- in the "GHC.Tc.Errors.Hole" module.
3935validHoleFitDefaults :: [GeneralFlag]
3936validHoleFitDefaults
3937  =  [ Opt_ShowTypeAppOfHoleFits
3938     , Opt_ShowTypeOfHoleFits
3939     , Opt_ShowProvOfHoleFits
3940     , Opt_ShowMatchesOfHoleFits
3941     , Opt_ShowValidHoleFits
3942     , Opt_SortValidHoleFits
3943     , Opt_SortBySizeHoleFits
3944     , Opt_ShowHoleConstraints ]
3945
3946
3947validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
3948validHoleFitsImpliedGFlags
3949  = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
3950    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)
3951    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)
3952    , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
3953    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]
3954
3955default_PIC :: Platform -> [GeneralFlag]
3956default_PIC platform =
3957  case (platformOS platform, platformArch platform) of
3958    -- For AArch64, we need to always have PIC enabled.  The relocation model
3959    -- on AArch64 does not permit arbitrary relocations.  Under ASLR, we can't
3960    -- control much how far apart symbols are in memory for our in-memory static
3961    -- linker;  and thus need to ensure we get sufficiently capable relocations.
3962    -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top
3963    -- of that.  Subsequently we expect all code on aarch64/linux (and macOS) to
3964    -- be built with -fPIC.
3965    (OSDarwin,  ArchAArch64) -> [Opt_PIC]
3966    (OSLinux,   ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
3967    (OSDarwin, ArchX86_64) -> [Opt_PIC]
3968    (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in
3969                                         -- OpenBSD since 5.3 release
3970                                         -- (1 May 2013) we need to
3971                                         -- always generate PIC. See
3972                                         -- #10597 for more
3973                                         -- information.
3974    _                      -> []
3975
3976
3977-- We usually want to use RPath, except on macOS (OSDarwin).  On recent macOS
3978-- versions the number of load commands we can embed in a dynamic library is
3979-- restricted.  Hence since b592bd98ff2 we rely on -dead_strip_dylib to only
3980-- link the needed dylibs instead of linking the full dependency closure.
3981--
3982-- If we split the library linking into injecting -rpath and -l @rpath/...
3983-- components, we will reduce the number of libraries we link, however we will
3984-- still inject one -rpath entry for each library, independent of their use.
3985-- That is, we even inject -rpath values for libraries that we dead_strip in
3986-- the end. As such we can run afoul of the load command size limit simply
3987-- by polluting the load commands with RPATH entries.
3988--
3989-- Thus, we disable Opt_RPath by default on OSDarwin.  The savvy user can always
3990-- enable it with -use-rpath if they so wish.
3991--
3992-- See Note [Dynamic linking on macOS]
3993
3994default_RPath :: Platform -> [GeneralFlag]
3995default_RPath platform | platformOS platform == OSDarwin = []
3996default_RPath _                                          = [Opt_RPath]
3997
3998
3999-- General flags that are switched on/off when other general flags are switched
4000-- on
4001impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
4002impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)
4003                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)
4004                ,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting)
4005                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)
4006                ] ++ validHoleFitsImpliedGFlags
4007
4008-- General flags that are switched on/off when other general flags are switched
4009-- off
4010impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
4011impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]
4012
4013impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]
4014impliedXFlags
4015-- See Note [Updating flag description in the User's Guide]
4016  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)
4017    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)
4018    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)
4019    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)
4020    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)
4021    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)
4022    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)
4023    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. #7854
4024    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)
4025
4026    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!
4027
4028    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)
4029
4030    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)
4031    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)
4032    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)
4033
4034    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures
4035    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds
4036
4037    -- TypeInType is now just a synonym for a couple of other extensions.
4038    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)
4039    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)
4040    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)
4041
4042    -- Standalone kind signatures are a replacement for CUSKs.
4043    , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)
4044
4045    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable
4046    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)
4047
4048    -- We turn this on so that we can export associated type
4049    -- type synonyms in subordinates (e.g. MyClass(type AssocType))
4050    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)
4051    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)
4052
4053    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)
4054
4055        -- Record wild-cards implies field disambiguation
4056        -- Otherwise if you write (C {..}) you may well get
4057        -- stuff like " 'a' not in scope ", which is a bit silly
4058        -- if the compiler has just filled in field 'a' of constructor 'C'
4059    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)
4060
4061    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)
4062
4063    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)
4064
4065    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)
4066    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)
4067
4068    -- Duplicate record fields require field disambiguation
4069    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)
4070
4071    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)
4072    , (LangExt.Strict, turnOn, LangExt.StrictData)
4073  ]
4074
4075-- Note [When is StarIsType enabled]
4076-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4077-- The StarIsType extension determines whether to treat '*' as a regular type
4078-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType
4079-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is
4080-- enabled.
4081--
4082-- Programs that use TypeOperators might expect to repurpose '*' for
4083-- multiplication or another binary operation, but making TypeOperators imply
4084-- NoStarIsType caused too much breakage on Hackage.
4085--
4086
4087-- Note [Documenting optimisation flags]
4088-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4089--
4090-- If you change the list of flags enabled for particular optimisation levels
4091-- please remember to update the User's Guide. The relevant file is:
4092--
4093--   docs/users_guide/using-optimisation.rst
4094--
4095-- Make sure to note whether a flag is implied by -O0, -O or -O2.
4096
4097optLevelFlags :: [([Int], GeneralFlag)]
4098-- Default settings of flags, before any command-line overrides
4099optLevelFlags -- see Note [Documenting optimisation flags]
4100  = [ ([0,1,2], Opt_DoLambdaEtaExpansion)
4101    , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]
4102    , ([0,1,2], Opt_DmdTxDictSel)
4103    , ([0,1,2], Opt_LlvmTBAA)
4104
4105    , ([0],     Opt_IgnoreInterfacePragmas)
4106    , ([0],     Opt_OmitInterfacePragmas)
4107
4108    , ([1,2],   Opt_CallArity)
4109    , ([1,2],   Opt_Exitification)
4110    , ([1,2],   Opt_CaseMerge)
4111    , ([1,2],   Opt_CaseFolding)
4112    , ([1,2],   Opt_CmmElimCommonBlocks)
4113    , ([2],     Opt_AsmShortcutting)
4114    , ([1,2],   Opt_CmmSink)
4115    , ([1,2],   Opt_CmmStaticPred)
4116    , ([1,2],   Opt_CSE)
4117    , ([1,2],   Opt_StgCSE)
4118    , ([2],     Opt_StgLiftLams)
4119
4120    , ([1,2],   Opt_EnableRewriteRules)
4121          -- Off for -O0.   Otherwise we desugar list literals
4122          -- to 'build' but don't run the simplifier passes that
4123          -- would rewrite them back to cons cells!  This seems
4124          -- silly, and matters for the GHCi debugger.
4125
4126    , ([1,2],   Opt_FloatIn)
4127    , ([1,2],   Opt_FullLaziness)
4128    , ([1,2],   Opt_IgnoreAsserts)
4129    , ([1,2],   Opt_Loopification)
4130    , ([1,2],   Opt_CfgBlocklayout)      -- Experimental
4131
4132    , ([1,2],   Opt_Specialise)
4133    , ([1,2],   Opt_CrossModuleSpecialise)
4134    , ([1,2],   Opt_Strictness)
4135    , ([1,2],   Opt_UnboxSmallStrictFields)
4136    , ([1,2],   Opt_CprAnal)
4137    , ([1,2],   Opt_WorkerWrapper)
4138    , ([1,2],   Opt_SolveConstantDicts)
4139    , ([1,2],   Opt_NumConstantFolding)
4140
4141    , ([2],     Opt_LiberateCase)
4142    , ([2],     Opt_SpecConstr)
4143--  , ([2],     Opt_RegsGraph)
4144--   RegsGraph suffers performance regression. See #7679
4145--  , ([2],     Opt_StaticArgumentTransformation)
4146--   Static Argument Transformation needs investigation. See #9374
4147    ]
4148
4149
4150-- -----------------------------------------------------------------------------
4151-- Standard sets of warning options
4152
4153-- Note [Documenting warning flags]
4154-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4155--
4156-- If you change the list of warning enabled by default
4157-- please remember to update the User's Guide. The relevant file is:
4158--
4159--  docs/users_guide/using-warnings.rst
4160
4161-- | Warning groups.
4162--
4163-- As all warnings are in the Weverything set, it is ignored when
4164-- displaying to the user which group a warning is in.
4165warningGroups :: [(String, [WarningFlag])]
4166warningGroups =
4167    [ ("compat",       minusWcompatOpts)
4168    , ("unused-binds", unusedBindsFlags)
4169    , ("default",      standardWarnings)
4170    , ("extra",        minusWOpts)
4171    , ("all",          minusWallOpts)
4172    , ("everything",   minusWeverythingOpts)
4173    ]
4174
4175-- | Warning group hierarchies, where there is an explicit inclusion
4176-- relation.
4177--
4178-- Each inner list is a hierarchy of warning groups, ordered from
4179-- smallest to largest, where each group is a superset of the one
4180-- before it.
4181--
4182-- Separating this from 'warningGroups' allows for multiple
4183-- hierarchies with no inherent relation to be defined.
4184--
4185-- The special-case Weverything group is not included.
4186warningHierarchies :: [[String]]
4187warningHierarchies = hierarchies ++ map (:[]) rest
4188  where
4189    hierarchies = [["default", "extra", "all"]]
4190    rest = filter (`notElem` "everything" : concat hierarchies) $
4191           map fst warningGroups
4192
4193-- | Find the smallest group in every hierarchy which a warning
4194-- belongs to, excluding Weverything.
4195smallestGroups :: WarningFlag -> [String]
4196smallestGroups flag = mapMaybe go warningHierarchies where
4197    -- Because each hierarchy is arranged from smallest to largest,
4198    -- the first group we find in a hierarchy which contains the flag
4199    -- is the smallest.
4200    go (group:rest) = fromMaybe (go rest) $ do
4201        flags <- lookup group warningGroups
4202        guard (flag `elem` flags)
4203        pure (Just group)
4204    go [] = Nothing
4205
4206-- | Warnings enabled unless specified otherwise
4207standardWarnings :: [WarningFlag]
4208standardWarnings -- see Note [Documenting warning flags]
4209    = [ Opt_WarnOverlappingPatterns,
4210        Opt_WarnWarningsDeprecations,
4211        Opt_WarnDeprecatedFlags,
4212        Opt_WarnDeferredTypeErrors,
4213        Opt_WarnTypedHoles,
4214        Opt_WarnDeferredOutOfScopeVariables,
4215        Opt_WarnPartialTypeSignatures,
4216        Opt_WarnUnrecognisedPragmas,
4217        Opt_WarnDuplicateExports,
4218        Opt_WarnDerivingDefaults,
4219        Opt_WarnOverflowedLiterals,
4220        Opt_WarnEmptyEnumerations,
4221        Opt_WarnMissingFields,
4222        Opt_WarnMissingMethods,
4223        Opt_WarnWrongDoBind,
4224        Opt_WarnUnsupportedCallingConventions,
4225        Opt_WarnDodgyForeignImports,
4226        Opt_WarnInlineRuleShadowing,
4227        Opt_WarnAlternativeLayoutRuleTransitional,
4228        Opt_WarnUnsupportedLlvmVersion,
4229        Opt_WarnMissedExtraSharedLib,
4230        Opt_WarnTabs,
4231        Opt_WarnUnrecognisedWarningFlags,
4232        Opt_WarnSimplifiableClassConstraints,
4233        Opt_WarnStarBinder,
4234        Opt_WarnInaccessibleCode,
4235        Opt_WarnSpaceAfterBang
4236      ]
4237
4238-- | Things you get with -W
4239minusWOpts :: [WarningFlag]
4240minusWOpts
4241    = standardWarnings ++
4242      [ Opt_WarnUnusedTopBinds,
4243        Opt_WarnUnusedLocalBinds,
4244        Opt_WarnUnusedPatternBinds,
4245        Opt_WarnUnusedMatches,
4246        Opt_WarnUnusedForalls,
4247        Opt_WarnUnusedImports,
4248        Opt_WarnIncompletePatterns,
4249        Opt_WarnDodgyExports,
4250        Opt_WarnDodgyImports,
4251        Opt_WarnUnbangedStrictPatterns
4252      ]
4253
4254-- | Things you get with -Wall
4255minusWallOpts :: [WarningFlag]
4256minusWallOpts
4257    = minusWOpts ++
4258      [ Opt_WarnTypeDefaults,
4259        Opt_WarnNameShadowing,
4260        Opt_WarnMissingSignatures,
4261        Opt_WarnHiShadows,
4262        Opt_WarnOrphans,
4263        Opt_WarnUnusedDoBind,
4264        Opt_WarnTrustworthySafe,
4265        Opt_WarnUntickedPromotedConstructors,
4266        Opt_WarnMissingPatternSynonymSignatures,
4267        Opt_WarnUnusedRecordWildcards,
4268        Opt_WarnRedundantRecordWildcards,
4269        Opt_WarnStarIsType
4270      ]
4271
4272-- | Things you get with -Weverything, i.e. *all* known warnings flags
4273minusWeverythingOpts :: [WarningFlag]
4274minusWeverythingOpts = [ toEnum 0 .. ]
4275
4276-- | Things you get with -Wcompat.
4277--
4278-- This is intended to group together warnings that will be enabled by default
4279-- at some point in the future, so that library authors eager to make their
4280-- code future compatible to fix issues before they even generate warnings.
4281minusWcompatOpts :: [WarningFlag]
4282minusWcompatOpts
4283    = [ Opt_WarnSemigroup
4284      , Opt_WarnNonCanonicalMonoidInstances
4285      , Opt_WarnStarIsType
4286      , Opt_WarnCompatUnqualifiedImports
4287      ]
4288
4289enableUnusedBinds :: DynP ()
4290enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags
4291
4292disableUnusedBinds :: DynP ()
4293disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags
4294
4295-- Things you get with -Wunused-binds
4296unusedBindsFlags :: [WarningFlag]
4297unusedBindsFlags = [ Opt_WarnUnusedTopBinds
4298                   , Opt_WarnUnusedLocalBinds
4299                   , Opt_WarnUnusedPatternBinds
4300                   ]
4301
4302enableGlasgowExts :: DynP ()
4303enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls
4304                       mapM_ setExtensionFlag glasgowExtsFlags
4305
4306disableGlasgowExts :: DynP ()
4307disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls
4308                        mapM_ unSetExtensionFlag glasgowExtsFlags
4309
4310-- Please keep what_glasgow_exts_does.rst up to date with this list
4311glasgowExtsFlags :: [LangExt.Extension]
4312glasgowExtsFlags = [
4313             LangExt.ConstrainedClassMethods
4314           , LangExt.DeriveDataTypeable
4315           , LangExt.DeriveFoldable
4316           , LangExt.DeriveFunctor
4317           , LangExt.DeriveGeneric
4318           , LangExt.DeriveTraversable
4319           , LangExt.EmptyDataDecls
4320           , LangExt.ExistentialQuantification
4321           , LangExt.ExplicitNamespaces
4322           , LangExt.FlexibleContexts
4323           , LangExt.FlexibleInstances
4324           , LangExt.ForeignFunctionInterface
4325           , LangExt.FunctionalDependencies
4326           , LangExt.GeneralizedNewtypeDeriving
4327           , LangExt.ImplicitParams
4328           , LangExt.KindSignatures
4329           , LangExt.LiberalTypeSynonyms
4330           , LangExt.MagicHash
4331           , LangExt.MultiParamTypeClasses
4332           , LangExt.ParallelListComp
4333           , LangExt.PatternGuards
4334           , LangExt.PostfixOperators
4335           , LangExt.RankNTypes
4336           , LangExt.RecursiveDo
4337           , LangExt.ScopedTypeVariables
4338           , LangExt.StandaloneDeriving
4339           , LangExt.TypeOperators
4340           , LangExt.TypeSynonymInstances
4341           , LangExt.UnboxedTuples
4342           , LangExt.UnicodeSyntax
4343           , LangExt.UnliftedFFITypes ]
4344
4345setWarnSafe :: Bool -> DynP ()
4346setWarnSafe True  = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })
4347setWarnSafe False = return ()
4348
4349setWarnUnsafe :: Bool -> DynP ()
4350setWarnUnsafe True  = getCurLoc >>= \l -> upd (\d -> d { warnUnsafeOnLoc = l })
4351setWarnUnsafe False = return ()
4352
4353setPackageTrust :: DynP ()
4354setPackageTrust = do
4355    setGeneralFlag Opt_PackageTrust
4356    l <- getCurLoc
4357    upd $ \d -> d { pkgTrustOnLoc = l }
4358
4359setGenDeriving :: TurnOnFlag -> DynP ()
4360setGenDeriving True  = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })
4361setGenDeriving False = return ()
4362
4363setOverlappingInsts :: TurnOnFlag -> DynP ()
4364setOverlappingInsts False = return ()
4365setOverlappingInsts True = do
4366  l <- getCurLoc
4367  upd (\d -> d { overlapInstLoc = l })
4368
4369setIncoherentInsts :: TurnOnFlag -> DynP ()
4370setIncoherentInsts False = return ()
4371setIncoherentInsts True = do
4372  l <- getCurLoc
4373  upd (\d -> d { incoherentOnLoc = l })
4374
4375checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
4376checkTemplateHaskellOk _turn_on
4377  = getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l })
4378
4379{- **********************************************************************
4380%*                                                                      *
4381                DynFlags constructors
4382%*                                                                      *
4383%********************************************************************* -}
4384
4385type DynP = EwM (CmdLineP DynFlags)
4386
4387upd :: (DynFlags -> DynFlags) -> DynP ()
4388upd f = liftEwM (do dflags <- getCmdLineState
4389                    putCmdLineState $! f dflags)
4390
4391updM :: (DynFlags -> DynP DynFlags) -> DynP ()
4392updM f = do dflags <- liftEwM getCmdLineState
4393            dflags' <- f dflags
4394            liftEwM $ putCmdLineState $! dflags'
4395
4396--------------- Constructor functions for OptKind -----------------
4397noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
4398noArg fn = NoArg (upd fn)
4399
4400noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
4401noArgM fn = NoArg (updM fn)
4402
4403hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
4404hasArg fn = HasArg (upd . fn)
4405
4406sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
4407sepArg fn = SepArg (upd . fn)
4408
4409intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
4410intSuffix fn = IntSuffix (\n -> upd (fn n))
4411
4412intSuffixM :: (Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
4413intSuffixM fn = IntSuffix (\n -> updM (fn n))
4414
4415floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
4416floatSuffix fn = FloatSuffix (\n -> upd (fn n))
4417
4418optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
4419              -> OptKind (CmdLineP DynFlags)
4420optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
4421
4422setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
4423setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
4424
4425--------------------------
4426addWay :: Way -> DynP ()
4427addWay w = upd (addWay' w)
4428
4429addWay' :: Way -> DynFlags -> DynFlags
4430addWay' w dflags0 = let platform = targetPlatform dflags0
4431                        dflags1 = dflags0 { ways = Set.insert w (ways dflags0) }
4432                        dflags2 = foldr setGeneralFlag' dflags1
4433                                        (wayGeneralFlags platform w)
4434                        dflags3 = foldr unSetGeneralFlag' dflags2
4435                                        (wayUnsetGeneralFlags platform w)
4436                    in dflags3
4437
4438removeWayDyn :: DynP ()
4439removeWayDyn = upd (\dfs -> dfs { ways = Set.filter (WayDyn /=) (ways dfs) })
4440
4441--------------------------
4442setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
4443setGeneralFlag   f = upd (setGeneralFlag' f)
4444unSetGeneralFlag f = upd (unSetGeneralFlag' f)
4445
4446setGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
4447setGeneralFlag' f dflags = foldr ($) (gopt_set dflags f) deps
4448  where
4449    deps = [ if turn_on then setGeneralFlag'   d
4450                        else unSetGeneralFlag' d
4451           | (f', turn_on, d) <- impliedGFlags, f' == f ]
4452        -- When you set f, set the ones it implies
4453        -- NB: use setGeneralFlag recursively, in case the implied flags
4454        --     implies further flags
4455
4456unSetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
4457unSetGeneralFlag' f dflags = foldr ($) (gopt_unset dflags f) deps
4458  where
4459    deps = [ if turn_on then setGeneralFlag' d
4460                        else unSetGeneralFlag' d
4461           | (f', turn_on, d) <- impliedOffGFlags, f' == f ]
4462   -- In general, when you un-set f, we don't un-set the things it implies.
4463   -- There are however some exceptions, e.g., -fno-strictness implies
4464   -- -fno-worker-wrapper.
4465   --
4466   -- NB: use unSetGeneralFlag' recursively, in case the implied off flags
4467   --     imply further flags.
4468
4469--------------------------
4470setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
4471setWarningFlag   f = upd (\dfs -> wopt_set dfs f)
4472unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
4473
4474setFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP ()
4475setFatalWarningFlag   f = upd (\dfs -> wopt_set_fatal dfs f)
4476unSetFatalWarningFlag f = upd (\dfs -> wopt_unset_fatal dfs f)
4477
4478setWErrorFlag :: WarningFlag -> DynP ()
4479setWErrorFlag flag =
4480  do { setWarningFlag flag
4481     ; setFatalWarningFlag flag }
4482
4483--------------------------
4484setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP ()
4485setExtensionFlag f = upd (setExtensionFlag' f)
4486unSetExtensionFlag f = upd (unSetExtensionFlag' f)
4487
4488setExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags
4489setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps
4490  where
4491    deps = [ if turn_on then setExtensionFlag'   d
4492                        else unSetExtensionFlag' d
4493           | (f', turn_on, d) <- impliedXFlags, f' == f ]
4494        -- When you set f, set the ones it implies
4495        -- NB: use setExtensionFlag recursively, in case the implied flags
4496        --     implies further flags
4497
4498unSetExtensionFlag' f dflags = xopt_unset dflags f
4499   -- When you un-set f, however, we don't un-set the things it implies
4500   --      (except for -fno-glasgow-exts, which is treated specially)
4501
4502--------------------------
4503alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags
4504alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) }
4505
4506alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
4507alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) }
4508
4509--------------------------
4510setDumpFlag' :: DumpFlag -> DynP ()
4511setDumpFlag' dump_flag
4512  = do upd (\dfs -> dopt_set dfs dump_flag)
4513       when want_recomp forceRecompile
4514    where -- Certain dumpy-things are really interested in what's going
4515          -- on during recompilation checking, so in those cases we
4516          -- don't want to turn it off.
4517          want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
4518                                             Opt_D_dump_hi_diffs,
4519                                             Opt_D_no_debug_output]
4520
4521forceRecompile :: DynP ()
4522-- Whenever we -ddump, force recompilation (by switching off the
4523-- recompilation checker), else you don't see the dump! However,
4524-- don't switch it off in --make mode, else *everything* gets
4525-- recompiled which probably isn't what you want
4526forceRecompile = do dfs <- liftEwM getCmdLineState
4527                    when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp)
4528        where
4529          force_recomp dfs = isOneShot (ghcMode dfs)
4530
4531
4532setVerboseCore2Core :: DynP ()
4533setVerboseCore2Core = setDumpFlag' Opt_D_verbose_core2core
4534
4535setVerbosity :: Maybe Int -> DynP ()
4536setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
4537
4538setDebugLevel :: Maybe Int -> DynP ()
4539setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 })
4540
4541data PkgDbRef
4542  = GlobalPkgDb
4543  | UserPkgDb
4544  | PkgDbPath FilePath
4545  deriving Eq
4546
4547addPkgDbRef :: PkgDbRef -> DynP ()
4548addPkgDbRef p = upd $ \s ->
4549  s { packageDBFlags = PackageDB p : packageDBFlags s }
4550
4551removeUserPkgDb :: DynP ()
4552removeUserPkgDb = upd $ \s ->
4553  s { packageDBFlags = NoUserPackageDB : packageDBFlags s }
4554
4555removeGlobalPkgDb :: DynP ()
4556removeGlobalPkgDb = upd $ \s ->
4557 s { packageDBFlags = NoGlobalPackageDB : packageDBFlags s }
4558
4559clearPkgDb :: DynP ()
4560clearPkgDb = upd $ \s ->
4561  s { packageDBFlags = ClearPackageDBs : packageDBFlags s }
4562
4563parsePackageFlag :: String                 -- the flag
4564                 -> ReadP PackageArg       -- type of argument
4565                 -> String                 -- string to parse
4566                 -> PackageFlag
4567parsePackageFlag flag arg_parse str
4568 = case filter ((=="").snd) (readP_to_S parse str) of
4569    [(r, "")] -> r
4570    _ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str)
4571  where doc = flag ++ " " ++ str
4572        parse = do
4573            pkg_arg <- tok arg_parse
4574            let mk_expose = ExposePackage doc pkg_arg
4575            ( do _ <- tok $ string "with"
4576                 fmap (mk_expose . ModRenaming True) parseRns
4577             <++ fmap (mk_expose . ModRenaming False) parseRns
4578             <++ return (mk_expose (ModRenaming True [])))
4579        parseRns = do _ <- tok $ R.char '('
4580                      rns <- tok $ sepBy parseItem (tok $ R.char ',')
4581                      _ <- tok $ R.char ')'
4582                      return rns
4583        parseItem = do
4584            orig <- tok $ parseModuleName
4585            (do _ <- tok $ string "as"
4586                new <- tok $ parseModuleName
4587                return (orig, new)
4588              +++
4589             return (orig, orig))
4590        tok m = m >>= \x -> skipSpaces >> return x
4591
4592exposePackage, exposePackageId, hidePackage,
4593        exposePluginPackage, exposePluginPackageId,
4594        ignorePackage,
4595        trustPackage, distrustPackage :: String -> DynP ()
4596exposePackage p = upd (exposePackage' p)
4597exposePackageId p =
4598  upd (\s -> s{ packageFlags =
4599    parsePackageFlag "-package-id" parseUnitArg p : packageFlags s })
4600exposePluginPackage p =
4601  upd (\s -> s{ pluginPackageFlags =
4602    parsePackageFlag "-plugin-package" parsePackageArg p : pluginPackageFlags s })
4603exposePluginPackageId p =
4604  upd (\s -> s{ pluginPackageFlags =
4605    parsePackageFlag "-plugin-package-id" parseUnitArg p : pluginPackageFlags s })
4606hidePackage p =
4607  upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
4608ignorePackage p =
4609  upd (\s -> s{ ignorePackageFlags = IgnorePackage p : ignorePackageFlags s })
4610
4611trustPackage p = exposePackage p >> -- both trust and distrust also expose a package
4612  upd (\s -> s{ trustFlags = TrustPackage p : trustFlags s })
4613distrustPackage p = exposePackage p >>
4614  upd (\s -> s{ trustFlags = DistrustPackage p : trustFlags s })
4615
4616exposePackage' :: String -> DynFlags -> DynFlags
4617exposePackage' p dflags
4618    = dflags { packageFlags =
4619            parsePackageFlag "-package" parsePackageArg p : packageFlags dflags }
4620
4621parsePackageArg :: ReadP PackageArg
4622parsePackageArg =
4623    fmap PackageArg (munch1 (\c -> isAlphaNum c || c `elem` ":-_."))
4624
4625parseUnitArg :: ReadP PackageArg
4626parseUnitArg =
4627    fmap UnitIdArg parseUnit
4628
4629setUnitId :: String -> DynFlags -> DynFlags
4630setUnitId p d = d { homeUnitId = stringToUnitId p }
4631
4632-- | Given a 'ModuleName' of a signature in the home library, find
4633-- out how it is instantiated.  E.g., the canonical form of
4634-- A in @p[A=q[]:A]@ is @q[]:A@.
4635canonicalizeHomeModule :: DynFlags -> ModuleName -> Module
4636canonicalizeHomeModule dflags mod_name =
4637    case lookup mod_name (homeUnitInstantiations dflags) of
4638        Nothing  -> mkHomeModule dflags mod_name
4639        Just mod -> mod
4640
4641canonicalizeModuleIfHome :: DynFlags -> Module -> Module
4642canonicalizeModuleIfHome dflags mod
4643    = if homeUnit dflags == moduleUnit mod
4644                      then canonicalizeHomeModule dflags (moduleName mod)
4645                      else mod
4646
4647-- If we're linking a binary, then only targets that produce object
4648-- code are allowed (requests for other target types are ignored).
4649setTarget :: HscTarget -> DynP ()
4650setTarget l = upd $ \ dfs ->
4651  if ghcLink dfs /= LinkBinary || isObjectTarget l
4652  then dfs{ hscTarget = l }
4653  else dfs
4654
4655-- Changes the target only if we're compiling object code.  This is
4656-- used by -fasm and -fllvm, which switch from one to the other, but
4657-- not from bytecode to object-code.  The idea is that -fasm/-fllvm
4658-- can be safely used in an OPTIONS_GHC pragma.
4659setObjTarget :: HscTarget -> DynP ()
4660setObjTarget l = updM set
4661  where
4662   set dflags
4663     | isObjectTarget (hscTarget dflags)
4664       = return $ dflags { hscTarget = l }
4665     | otherwise = return dflags
4666
4667setOptLevel :: Int -> DynFlags -> DynP DynFlags
4668setOptLevel n dflags = return (updOptLevel n dflags)
4669
4670checkOptLevel :: Int -> DynFlags -> Either String DynFlags
4671checkOptLevel n dflags
4672   | hscTarget dflags == HscInterpreted && n > 0
4673     = Left "-O conflicts with --interactive; -O ignored."
4674   | otherwise
4675     = Right dflags
4676
4677setMainIs :: String -> DynP ()
4678setMainIs arg
4679  | not (null main_fn) && isLower (head main_fn)
4680     -- The arg looked like "Foo.Bar.baz"
4681  = upd $ \d -> d { mainFunIs = Just main_fn,
4682                   mainModIs = mkModule mainUnit (mkModuleName main_mod) }
4683
4684  | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
4685  = upd $ \d -> d { mainModIs = mkModule mainUnit (mkModuleName arg) }
4686
4687  | otherwise                   -- The arg looked like "baz"
4688  = upd $ \d -> d { mainFunIs = Just arg }
4689  where
4690    (main_mod, main_fn) = splitLongestPrefix arg (== '.')
4691
4692addLdInputs :: Option -> DynFlags -> DynFlags
4693addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}
4694
4695-- -----------------------------------------------------------------------------
4696-- Load dynflags from environment files.
4697
4698setFlagsFromEnvFile :: FilePath -> String -> DynP ()
4699setFlagsFromEnvFile envfile content = do
4700  setGeneralFlag Opt_HideAllPackages
4701  parseEnvFile envfile content
4702
4703parseEnvFile :: FilePath -> String -> DynP ()
4704parseEnvFile envfile = mapM_ parseEntry . lines
4705  where
4706    parseEntry str = case words str of
4707      ("package-db": _)     -> addPkgDbRef (PkgDbPath (envdir </> db))
4708        -- relative package dbs are interpreted relative to the env file
4709        where envdir = takeDirectory envfile
4710              db     = drop 11 str
4711      ["clear-package-db"]  -> clearPkgDb
4712      ["global-package-db"] -> addPkgDbRef GlobalPkgDb
4713      ["user-package-db"]   -> addPkgDbRef UserPkgDb
4714      ["package-id", pkgid] -> exposePackageId pkgid
4715      (('-':'-':_):_)       -> return () -- comments
4716      -- and the original syntax introduced in 7.10:
4717      [pkgid]               -> exposePackageId pkgid
4718      []                    -> return ()
4719      _                     -> throwGhcException $ CmdLineError $
4720                                    "Can't parse environment file entry: "
4721                                 ++ envfile ++ ": " ++ str
4722
4723
4724-----------------------------------------------------------------------------
4725-- Paths & Libraries
4726
4727addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
4728
4729-- -i on its own deletes the import paths
4730addImportPath "" = upd (\s -> s{importPaths = []})
4731addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
4732
4733addLibraryPath p =
4734  upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
4735
4736addIncludePath p =
4737  upd (\s -> s{includePaths =
4738                  addGlobalInclude (includePaths s) (splitPathList p)})
4739
4740addFrameworkPath p =
4741  upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
4742
4743#if !defined(mingw32_HOST_OS)
4744split_marker :: Char
4745split_marker = ':'   -- not configurable (ToDo)
4746#endif
4747
4748splitPathList :: String -> [String]
4749splitPathList s = filter notNull (splitUp s)
4750                -- empty paths are ignored: there might be a trailing
4751                -- ':' in the initial list, for example.  Empty paths can
4752                -- cause confusion when they are translated into -I options
4753                -- for passing to gcc.
4754  where
4755#if !defined(mingw32_HOST_OS)
4756    splitUp xs = split split_marker xs
4757#else
4758     -- Windows: 'hybrid' support for DOS-style paths in directory lists.
4759     --
4760     -- That is, if "foo:bar:baz" is used, this interpreted as
4761     -- consisting of three entries, 'foo', 'bar', 'baz'.
4762     -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
4763     -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
4764     --
4765     -- Notice that no attempt is made to fully replace the 'standard'
4766     -- split marker ':' with the Windows / DOS one, ';'. The reason being
4767     -- that this will cause too much breakage for users & ':' will
4768     -- work fine even with DOS paths, if you're not insisting on being silly.
4769     -- So, use either.
4770    splitUp []             = []
4771    splitUp (x:':':div:xs) | div `elem` dir_markers
4772                           = ((x:':':div:p): splitUp rs)
4773                           where
4774                              (p,rs) = findNextPath xs
4775          -- we used to check for existence of the path here, but that
4776          -- required the IO monad to be threaded through the command-line
4777          -- parser which is quite inconvenient.  The
4778    splitUp xs = cons p (splitUp rs)
4779               where
4780                 (p,rs) = findNextPath xs
4781
4782                 cons "" xs = xs
4783                 cons x  xs = x:xs
4784
4785    -- will be called either when we've consumed nought or the
4786    -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
4787    -- finding the next split marker.
4788    findNextPath xs =
4789        case break (`elem` split_markers) xs of
4790           (p, _:ds) -> (p, ds)
4791           (p, xs)   -> (p, xs)
4792
4793    split_markers :: [Char]
4794    split_markers = [':', ';']
4795
4796    dir_markers :: [Char]
4797    dir_markers = ['/', '\\']
4798#endif
4799
4800-- -----------------------------------------------------------------------------
4801-- tmpDir, where we store temporary files.
4802
4803setTmpDir :: FilePath -> DynFlags -> DynFlags
4804setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir }
4805  -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
4806  -- seem necessary now --SDM 7/2/2008
4807
4808-----------------------------------------------------------------------------
4809-- RTS opts
4810
4811setRtsOpts :: String -> DynP ()
4812setRtsOpts arg  = upd $ \ d -> d {rtsOpts = Just arg}
4813
4814setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
4815setRtsOptsEnabled arg  = upd $ \ d -> d {rtsOptsEnabled = arg}
4816
4817-----------------------------------------------------------------------------
4818-- Hpc stuff
4819
4820setOptHpcDir :: String -> DynP ()
4821setOptHpcDir arg  = upd $ \ d -> d {hpcDir = arg}
4822
4823-----------------------------------------------------------------------------
4824-- Via-C compilation stuff
4825
4826-- There are some options that we need to pass to gcc when compiling
4827-- Haskell code via C, but are only supported by recent versions of
4828-- gcc.  The configure script decides which of these options we need,
4829-- and puts them in the "settings" file in $topdir. The advantage of
4830-- having these in a separate file is that the file can be created at
4831-- install-time depending on the available gcc version, and even
4832-- re-generated later if gcc is upgraded.
4833--
4834-- The options below are not dependent on the version of gcc, only the
4835-- platform.
4836
4837picCCOpts :: DynFlags -> [String]
4838picCCOpts dflags = pieOpts ++ picOpts
4839  where
4840    picOpts =
4841      case platformOS (targetPlatform dflags) of
4842      OSDarwin
4843          -- Apple prefers to do things the other way round.
4844          -- PIC is on by default.
4845          -- -mdynamic-no-pic:
4846          --     Turn off PIC code generation.
4847          -- -fno-common:
4848          --     Don't generate "common" symbols - these are unwanted
4849          --     in dynamic libraries.
4850
4851       | gopt Opt_PIC dflags -> ["-fno-common", "-U__PIC__", "-D__PIC__"]
4852       | otherwise           -> ["-mdynamic-no-pic"]
4853      OSMinGW32 -- no -fPIC for Windows
4854       | gopt Opt_PIC dflags -> ["-U__PIC__", "-D__PIC__"]
4855       | otherwise           -> []
4856      _
4857      -- we need -fPIC for C files when we are compiling with -dynamic,
4858      -- otherwise things like stub.c files don't get compiled
4859      -- correctly.  They need to reference data in the Haskell
4860      -- objects, but can't without -fPIC.  See
4861      -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code
4862       | gopt Opt_PIC dflags || WayDyn `Set.member` ways dflags ->
4863          ["-fPIC", "-U__PIC__", "-D__PIC__"]
4864      -- gcc may be configured to have PIC on by default, let's be
4865      -- explicit here, see #15847
4866       | otherwise -> ["-fno-PIC"]
4867
4868    pieOpts
4869      | gopt Opt_PICExecutable dflags       = ["-pie"]
4870        -- See Note [No PIE when linking]
4871      | toolSettings_ccSupportsNoPie (toolSettings dflags) = ["-no-pie"]
4872      | otherwise                           = []
4873
4874
4875{-
4876Note [No PIE while linking]
4877~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4878As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
4879default in their gcc builds. This is incompatible with -r as it implies that we
4880are producing an executable. Consequently, we must manually pass -no-pie to gcc
4881when joining object files or linking dynamic libraries. Unless, of course, the
4882user has explicitly requested a PIE executable with -pie. See #12759.
4883-}
4884
4885picPOpts :: DynFlags -> [String]
4886picPOpts dflags
4887 | gopt Opt_PIC dflags = ["-U__PIC__", "-D__PIC__"]
4888 | otherwise           = []
4889
4890-- -----------------------------------------------------------------------------
4891-- Compiler Info
4892
4893compilerInfo :: DynFlags -> [(String, String)]
4894compilerInfo dflags
4895    = -- We always make "Project name" be first to keep parsing in
4896      -- other languages simple, i.e. when looking for other fields,
4897      -- you don't have to worry whether there is a leading '[' or not
4898      ("Project name",                 cProjectName)
4899      -- Next come the settings, so anything else can be overridden
4900      -- in the settings file (as "lookup" uses the first match for the
4901      -- key)
4902    : map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))
4903          (rawSettings dflags)
4904   ++ [("Project version",             projectVersion dflags),
4905       ("Project Git commit id",       cProjectGitCommitId),
4906       ("Booter version",              cBooterVersion),
4907       ("Stage",                       cStage),
4908       ("Build platform",              cBuildPlatformString),
4909       ("Host platform",               cHostPlatformString),
4910       ("Target platform",             platformMisc_targetPlatformString $ platformMisc dflags),
4911       ("Have interpreter",            showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
4912       ("Object splitting supported",  showBool False),
4913       ("Have native code generator",  showBool $ platformNcgSupported (targetPlatform dflags)),
4914       ("Target default backend",      show $ platformDefaultBackend (targetPlatform dflags)),
4915       -- Whether or not we support @-dynamic-too@
4916       ("Support dynamic-too",         showBool $ not isWindows),
4917       -- Whether or not we support the @-j@ flag with @--make@.
4918       ("Support parallel --make",     "YES"),
4919       -- Whether or not we support "Foo from foo-0.1-XXX:Foo" syntax in
4920       -- installed package info.
4921       ("Support reexported-modules",  "YES"),
4922       -- Whether or not we support extended @-package foo (Foo)@ syntax.
4923       ("Support thinning and renaming package flags", "YES"),
4924       -- Whether or not we support Backpack.
4925       ("Support Backpack", "YES"),
4926       -- If true, we require that the 'id' field in installed package info
4927       -- match what is passed to the @-this-unit-id@ flag for modules
4928       -- built in it
4929       ("Requires unified installed package IDs", "YES"),
4930       -- Whether or not we support the @-this-package-key@ flag.  Prefer
4931       -- "Uses unit IDs" over it. We still say yes even if @-this-package-key@
4932       -- flag has been removed, otherwise it breaks Cabal...
4933       ("Uses package keys",           "YES"),
4934       -- Whether or not we support the @-this-unit-id@ flag
4935       ("Uses unit IDs",               "YES"),
4936       -- Whether or not GHC compiles libraries as dynamic by default
4937       ("Dynamic by default",          showBool $ dYNAMIC_BY_DEFAULT dflags),
4938       -- Whether or not GHC was compiled using -dynamic
4939       ("GHC Dynamic",                 showBool hostIsDynamic),
4940       -- Whether or not GHC was compiled using -prof
4941       ("GHC Profiled",                showBool hostIsProfiled),
4942       ("Debug on",                    showBool debugIsOn),
4943       ("LibDir",                      topDir dflags),
4944       -- The path of the global package database used by GHC
4945       ("Global Package DB",           globalPackageDatabasePath dflags)
4946      ]
4947  where
4948    showBool True  = "YES"
4949    showBool False = "NO"
4950    isWindows = platformOS (targetPlatform dflags) == OSMinGW32
4951    expandDirectories :: FilePath -> Maybe FilePath -> String -> String
4952    expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd
4953
4954-- Produced by deriveConstants
4955#include "GHCConstantsHaskellWrappers.hs"
4956
4957bLOCK_SIZE_W :: DynFlags -> Int
4958bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` platformWordSizeInBytes platform
4959   where platform = targetPlatform dflags
4960
4961wordAlignment :: Platform -> Alignment
4962wordAlignment platform = alignmentOf (platformWordSizeInBytes platform)
4963
4964tAG_MASK :: DynFlags -> Int
4965tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1
4966
4967mAX_PTR_TAG :: DynFlags -> Int
4968mAX_PTR_TAG = tAG_MASK
4969
4970{- -----------------------------------------------------------------------------
4971Note [DynFlags consistency]
4972~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4973
4974There are a number of number of DynFlags configurations which either
4975do not make sense or lead to unimplemented or buggy codepaths in the
4976compiler. makeDynFlagsConsistent is responsible for verifying the validity
4977of a set of DynFlags, fixing any issues, and reporting them back to the
4978caller.
4979
4980GHCi and -O
4981---------------
4982
4983When using optimization, the compiler can introduce several things
4984(such as unboxed tuples) into the intermediate code, which GHCi later
4985chokes on since the bytecode interpreter can't handle this (and while
4986this is arguably a bug these aren't handled, there are no plans to fix
4987it.)
4988
4989While the driver pipeline always checks for this particular erroneous
4990combination when parsing flags, we also need to check when we update
4991the flags; this is because API clients may parse flags but update the
4992DynFlags afterwords, before finally running code inside a session (see
4993T10052 and #10052).
4994-}
4995
4996-- | Resolve any internal inconsistencies in a set of 'DynFlags'.
4997-- Returns the consistent 'DynFlags' as well as a list of warnings
4998-- to report to the user.
4999makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
5000-- Whenever makeDynFlagsConsistent does anything, it starts over, to
5001-- ensure that a later change doesn't invalidate an earlier check.
5002-- Be careful not to introduce potential loops!
5003makeDynFlagsConsistent dflags
5004 -- Disable -dynamic-too on Windows (#8228, #7134, #5987)
5005 | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags
5006    = let dflags' = gopt_unset dflags Opt_BuildDynamicToo
5007          warn    = "-dynamic-too is not supported on Windows"
5008      in loop dflags' warn
5009
5010   -- Via-C backend only supports unregisterised convention. Switch to a backend
5011   -- supporting it if possible.
5012 | hscTarget dflags == HscC &&
5013   not (platformUnregisterised (targetPlatform dflags))
5014    = case platformDefaultBackend (targetPlatform dflags) of
5015         NCG  -> let dflags' = dflags { hscTarget = HscAsm }
5016                     warn = "Target platform doesn't use unregisterised ABI, so using native code generator rather than compiling via C"
5017                 in loop dflags' warn
5018         LLVM -> let dflags' = dflags { hscTarget = HscLlvm }
5019                     warn = "Target platform doesn't use unregisterised ABI, so using LLVM rather than compiling via C"
5020                 in loop dflags' warn
5021         _    -> pgmError "Compiling via C is only supported with unregisterised ABI but target platform doesn't use it."
5022 | gopt Opt_Hpc dflags && hscTarget dflags == HscInterpreted
5023    = let dflags' = gopt_unset dflags Opt_Hpc
5024          warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc."
5025      in loop dflags' warn
5026
5027 | hscTarget dflags `elem` [HscAsm, HscLlvm] &&
5028   platformUnregisterised (targetPlatform dflags)
5029    = loop (dflags { hscTarget = HscC })
5030           "Target platform uses unregisterised ABI, so compiling via C"
5031
5032 | hscTarget dflags == HscAsm &&
5033   not (platformNcgSupported $ targetPlatform dflags)
5034      = let dflags' = dflags { hscTarget = HscLlvm }
5035            warn = "Native code generator doesn't support target platform, so using LLVM"
5036        in loop dflags' warn
5037
5038 | not (osElfTarget os) && gopt Opt_PIE dflags
5039    = loop (gopt_unset dflags Opt_PIE)
5040           "Position-independent only supported on ELF platforms"
5041 | os == OSDarwin &&
5042   arch == ArchX86_64 &&
5043   not (gopt Opt_PIC dflags)
5044    = loop (gopt_set dflags Opt_PIC)
5045           "Enabling -fPIC as it is always on for this platform"
5046 | Left err <- checkOptLevel (optLevel dflags) dflags
5047    = loop (updOptLevel 0 dflags) err
5048
5049 | LinkInMemory <- ghcLink dflags
5050 , not (gopt Opt_ExternalInterpreter dflags)
5051 , hostIsProfiled
5052 , isObjectTarget (hscTarget dflags)
5053 , WayProf `Set.notMember` ways dflags
5054    = loop dflags{ways = Set.insert WayProf (ways dflags)}
5055         "Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
5056
5057 | otherwise = (dflags, [])
5058    where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
5059          loop updated_dflags warning
5060              = case makeDynFlagsConsistent updated_dflags of
5061                (dflags', ws) -> (dflags', L loc warning : ws)
5062          platform = targetPlatform dflags
5063          arch = platformArch platform
5064          os   = platformOS   platform
5065
5066
5067--------------------------------------------------------------------------
5068-- Do not use unsafeGlobalDynFlags!
5069--
5070-- unsafeGlobalDynFlags is a hack, necessary because we need to be able
5071-- to show SDocs when tracing, but we don't always have DynFlags
5072-- available.
5073--
5074-- Do not use it if you can help it. You may get the wrong value, or this
5075-- panic!
5076
5077-- | This is the value that 'unsafeGlobalDynFlags' takes before it is
5078-- initialized.
5079defaultGlobalDynFlags :: DynFlags
5080defaultGlobalDynFlags =
5081    (defaultDynFlags settings llvmConfig) { verbosity = 2 }
5082  where
5083    settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
5084    llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
5085
5086#if GHC_STAGE < 2
5087GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
5088#else
5089SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags
5090                 , getOrSetLibHSghcGlobalDynFlags
5091                 , "getOrSetLibHSghcGlobalDynFlags"
5092                 , defaultGlobalDynFlags
5093                 , DynFlags )
5094#endif
5095
5096unsafeGlobalDynFlags :: DynFlags
5097unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
5098
5099setUnsafeGlobalDynFlags :: DynFlags -> IO ()
5100setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
5101
5102-- -----------------------------------------------------------------------------
5103-- SSE and AVX
5104
5105-- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to
5106-- check if SSE is enabled, we might have x86-64 imply the -msse2
5107-- flag.
5108
5109isSseEnabled :: DynFlags -> Bool
5110isSseEnabled dflags = case platformArch (targetPlatform dflags) of
5111    ArchX86_64 -> True
5112    ArchX86    -> True
5113    _          -> False
5114
5115isSse2Enabled :: DynFlags -> Bool
5116isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
5117  -- We Assume  SSE1 and SSE2 operations are available on both
5118  -- x86 and x86_64. Historically we didn't default to SSE2 and
5119  -- SSE1 on x86, which results in defacto nondeterminism for how
5120  -- rounding behaves in the associated x87 floating point instructions
5121  -- because variations in the spill/fpu stack placement of arguments for
5122  -- operations would change the precision and final result of what
5123  -- would otherwise be the same expressions with respect to single or
5124  -- double precision IEEE floating point computations.
5125    ArchX86_64 -> True
5126    ArchX86    -> True
5127    _          -> False
5128
5129
5130isSse4_2Enabled :: DynFlags -> Bool
5131isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
5132
5133isAvxEnabled :: DynFlags -> Bool
5134isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags
5135
5136isAvx2Enabled :: DynFlags -> Bool
5137isAvx2Enabled dflags = avx2 dflags || avx512f dflags
5138
5139isAvx512cdEnabled :: DynFlags -> Bool
5140isAvx512cdEnabled dflags = avx512cd dflags
5141
5142isAvx512erEnabled :: DynFlags -> Bool
5143isAvx512erEnabled dflags = avx512er dflags
5144
5145isAvx512fEnabled :: DynFlags -> Bool
5146isAvx512fEnabled dflags = avx512f dflags
5147
5148isAvx512pfEnabled :: DynFlags -> Bool
5149isAvx512pfEnabled dflags = avx512pf dflags
5150
5151-- -----------------------------------------------------------------------------
5152-- BMI2
5153
5154isBmiEnabled :: DynFlags -> Bool
5155isBmiEnabled dflags = case platformArch (targetPlatform dflags) of
5156    ArchX86_64 -> bmiVersion dflags >= Just BMI1
5157    ArchX86    -> bmiVersion dflags >= Just BMI1
5158    _          -> False
5159
5160isBmi2Enabled :: DynFlags -> Bool
5161isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
5162    ArchX86_64 -> bmiVersion dflags >= Just BMI2
5163    ArchX86    -> bmiVersion dflags >= Just BMI2
5164    _          -> False
5165
5166-- | Indicate if cost-centre profiling is enabled
5167sccProfilingEnabled :: DynFlags -> Bool
5168sccProfilingEnabled dflags = ways dflags `hasWay` WayProf
5169
5170-- -----------------------------------------------------------------------------
5171-- Linker/compiler information
5172
5173-- LinkerInfo contains any extra options needed by the system linker.
5174data LinkerInfo
5175  = GnuLD    [Option]
5176  | GnuGold  [Option]
5177  | LlvmLLD  [Option]
5178  | DarwinLD [Option]
5179  | SolarisLD [Option]
5180  | AixLD    [Option]
5181  | UnknownLD
5182  deriving Eq
5183
5184-- CompilerInfo tells us which C compiler we're using
5185data CompilerInfo
5186   = GCC
5187   | Clang
5188   | AppleClang
5189   | AppleClang51
5190   | UnknownCC
5191   deriving Eq
5192
5193-- -----------------------------------------------------------------------------
5194-- RTS hooks
5195
5196-- Convert sizes like "3.5M" into integers
5197decodeSize :: String -> Integer
5198decodeSize str
5199  | c == ""      = truncate n
5200  | c == "K" || c == "k" = truncate (n * 1000)
5201  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
5202  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
5203  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
5204  where (m, c) = span pred str
5205        n      = readRational m
5206        pred c = isDigit c || c == '.'
5207
5208foreign import ccall unsafe "ghc_lib_parser_setHeapSize"       setHeapSize       :: Int -> IO ()
5209foreign import ccall unsafe "ghc_lib_parser_enableTimingStats" enableTimingStats :: IO ()
5210
5211-- -----------------------------------------------------------------------------
5212-- Types for managing temporary files.
5213--
5214-- these are here because FilesToClean is used in DynFlags
5215
5216-- | A collection of files that must be deleted before ghc exits.
5217-- The current collection
5218-- is stored in an IORef in DynFlags, 'filesToClean'.
5219data FilesToClean = FilesToClean {
5220  ftcGhcSession :: !(Set FilePath),
5221  -- ^ Files that will be deleted at the end of runGhc(T)
5222  ftcCurrentModule :: !(Set FilePath)
5223  -- ^ Files that will be deleted the next time
5224  -- 'FileCleanup.cleanCurrentModuleTempFiles' is called, or otherwise at the
5225  -- end of the session.
5226  }
5227
5228-- | An empty FilesToClean
5229emptyFilesToClean :: FilesToClean
5230emptyFilesToClean = FilesToClean Set.empty Set.empty
5231
5232
5233-- | Initialize the pretty-printing options
5234initSDocContext :: DynFlags -> PprStyle -> SDocContext
5235initSDocContext dflags style = SDC
5236  { sdocStyle                       = style
5237  , sdocColScheme                   = colScheme dflags
5238  , sdocLastColour                  = Col.colReset
5239  , sdocShouldUseColor              = overrideWith (canUseColor dflags) (useColor dflags)
5240  , sdocDefaultDepth                = pprUserLength dflags
5241  , sdocLineLength                  = pprCols dflags
5242  , sdocCanUseUnicode               = useUnicode dflags
5243  , sdocHexWordLiterals             = gopt Opt_HexWordLiterals dflags
5244  , sdocPprDebug                    = dopt Opt_D_ppr_debug dflags
5245  , sdocPrintUnicodeSyntax          = gopt Opt_PrintUnicodeSyntax dflags
5246  , sdocPrintCaseAsLet              = gopt Opt_PprCaseAsLet dflags
5247  , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags
5248  , sdocPrintAxiomIncomps           = gopt Opt_PrintAxiomIncomps dflags
5249  , sdocPrintExplicitKinds          = gopt Opt_PrintExplicitKinds dflags
5250  , sdocPrintExplicitCoercions      = gopt Opt_PrintExplicitCoercions dflags
5251  , sdocPrintExplicitRuntimeReps    = gopt Opt_PrintExplicitRuntimeReps dflags
5252  , sdocPrintExplicitForalls        = gopt Opt_PrintExplicitForalls dflags
5253  , sdocPrintPotentialInstances     = gopt Opt_PrintPotentialInstances dflags
5254  , sdocPrintEqualityRelations      = gopt Opt_PrintEqualityRelations dflags
5255  , sdocSuppressTicks               = gopt Opt_SuppressTicks dflags
5256  , sdocSuppressTypeSignatures      = gopt Opt_SuppressTypeSignatures dflags
5257  , sdocSuppressTypeApplications    = gopt Opt_SuppressTypeApplications dflags
5258  , sdocSuppressIdInfo              = gopt Opt_SuppressIdInfo dflags
5259  , sdocSuppressCoercions           = gopt Opt_SuppressCoercions dflags
5260  , sdocSuppressUnfoldings          = gopt Opt_SuppressUnfoldings dflags
5261  , sdocSuppressVarKinds            = gopt Opt_SuppressVarKinds dflags
5262  , sdocSuppressUniques             = gopt Opt_SuppressUniques dflags
5263  , sdocSuppressModulePrefixes      = gopt Opt_SuppressModulePrefixes dflags
5264  , sdocSuppressStgExts             = gopt Opt_SuppressStgExts dflags
5265  , sdocErrorSpans                  = gopt Opt_ErrorSpans dflags
5266  , sdocStarIsType                  = xopt LangExt.StarIsType dflags
5267  , sdocImpredicativeTypes          = xopt LangExt.ImpredicativeTypes dflags
5268  , sdocLinearTypes                 = xopt LangExt.LinearTypes dflags
5269  , sdocPrintTypeAbbreviations      = True
5270  , sdocDynFlags                    = dflags
5271  }
5272
5273-- | Initialize the pretty-printing options using the default user style
5274initDefaultSDocContext :: DynFlags -> SDocContext
5275initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle
5276