DynFlags.hs

-- |
-- Dynamic flags
--
--
-- (c) The University of Glasgow 2005
--

-- Most flags are dynamic flags, which means they can change from
-- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a
-- multi-session GHC each session can be using different dynamic
-- flags.  Dynamic flags can also be set at the prompt in GHCi.
module DynFlags (
        -- * Dynamic flags and associated configuration types
        DOpt(..),
        DynFlag(..),
        ExtensionFlag(..),
        flattenExtensionFlags,
        ensureFlattenedExtensionFlags,
        lopt_set_flattened,
        lopt_unset_flattened,
        DynFlags(..),
        HscTarget(..), isObjectTarget, defaultObjectTarget,
        GhcMode(..), isOneShot,
        GhcLink(..), isNoLink,
        PackageFlag(..),
        Option(..), showOpt,
        DynLibLoader(..),
        fFlags, fLangFlags, xFlags,
        dphPackage,
        wayNames,

        -- ** Manipulating DynFlags
        defaultDynFlags,                -- DynFlags
        initDynFlags,                   -- DynFlags -> IO DynFlags

        getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
        getVerbFlag,
        updOptLevel,
        setTmpDir,
        setPackageName,
        doingTickyProfiling,

        -- ** Parsing DynFlags
        parseDynamicFlags,
        parseDynamicNoPackageFlags,
        allFlags,

        supportedExtensions, extensionOptions,

        -- ** DynFlag C compiler options
        machdepCCOpts, picCCOpts,

        -- * Configuration of the stg-to-stg passes
        StgToDo(..),
        getStgToDo,

        -- * Compiler configuration suitable for display to the user
        Printable(..),
        compilerInfo
  ) where

#include "HsVersions.h"

#ifndef OMIT_NATIVE_CODEGEN
import Platform
#endif
import Module
import PackageConfig
import PrelNames        ( mAIN )
import StaticFlags
import {-# SOURCE #-} Packages (PackageState)
import DriverPhases     ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic
import Util
import Maybes           ( orElse )
import SrcLoc
import FastString
import FiniteMap
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )

import Data.IORef
import Control.Monad    ( when )

import Data.Char
import Data.List
import System.FilePath
import System.IO        ( stderr, hPutChar )

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

-- | Enumerates the simple on-or-off dynamic flags
data DynFlag

   -- debugging flags
   = Opt_D_dump_cmm
   | Opt_D_dump_cmmz
   | Opt_D_dump_cmmz_pretty
   | Opt_D_dump_cps_cmm
   | Opt_D_dump_cvt_cmm
   | Opt_D_dump_asm
   | Opt_D_dump_asm_native
   | Opt_D_dump_asm_liveness
   | Opt_D_dump_asm_coalesce
   | Opt_D_dump_asm_regalloc
   | Opt_D_dump_asm_regalloc_stages
   | Opt_D_dump_asm_conflicts
   | Opt_D_dump_asm_stats
   | Opt_D_dump_asm_expanded
   | Opt_D_dump_llvm
   | Opt_D_dump_cpranal
   | Opt_D_dump_deriv
   | Opt_D_dump_ds
   | Opt_D_dump_flatC
   | Opt_D_dump_foreign
   | Opt_D_dump_inlinings
   | Opt_D_dump_rule_firings
   | Opt_D_dump_occur_anal
   | Opt_D_dump_parsed
   | Opt_D_dump_rn
   | Opt_D_dump_simpl
   | Opt_D_dump_simpl_iterations
   | Opt_D_dump_simpl_phases
   | Opt_D_dump_spec
   | Opt_D_dump_prep
   | Opt_D_dump_stg
   | Opt_D_dump_stranal
   | Opt_D_dump_tc
   | Opt_D_dump_types
   | Opt_D_dump_rules
   | Opt_D_dump_cse
   | Opt_D_dump_worker_wrapper
   | Opt_D_dump_rn_trace
   | Opt_D_dump_rn_stats
   | Opt_D_dump_opt_cmm
   | Opt_D_dump_simpl_stats
   | Opt_D_dump_tc_trace
   | Opt_D_dump_if_trace
   | Opt_D_dump_splices
   | Opt_D_dump_BCOs
   | Opt_D_dump_vect
   | Opt_D_dump_hpc
   | Opt_D_dump_rtti
   | Opt_D_source_stats
   | Opt_D_verbose_core2core
   | Opt_D_verbose_stg2stg
   | Opt_D_dump_hi
   | Opt_D_dump_hi_diffs
   | Opt_D_dump_minimal_imports
   | Opt_D_dump_mod_cycles
   | Opt_D_dump_view_pattern_commoning
   | Opt_D_faststring_stats
   | Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.
   | Opt_D_no_debug_output
   | Opt_DoCoreLinting
   | Opt_DoStgLinting
   | Opt_DoCmmLinting
   | Opt_DoAsmLinting

   | Opt_WarnIsError                    -- -Werror; makes warnings fatal
   | Opt_WarnDuplicateExports
   | Opt_WarnHiShadows
   | Opt_WarnImplicitPrelude
   | Opt_WarnIncompletePatterns
   | Opt_WarnIncompletePatternsRecUpd
   | Opt_WarnMissingFields
   | Opt_WarnMissingImportList
   | Opt_WarnMissingMethods
   | Opt_WarnMissingSigs
   | Opt_WarnNameShadowing
   | Opt_WarnOverlappingPatterns
   | Opt_WarnSimplePatterns
   | Opt_WarnTypeDefaults
   | Opt_WarnMonomorphism
   | Opt_WarnUnusedBinds
   | Opt_WarnUnusedImports
   | Opt_WarnUnusedMatches
   | Opt_WarnWarningsDeprecations
   | Opt_WarnDeprecatedFlags
   | Opt_WarnDodgyExports
   | Opt_WarnDodgyImports
   | Opt_WarnOrphans
   | Opt_WarnTabs
   | Opt_WarnUnrecognisedPragmas
   | Opt_WarnDodgyForeignImports
   | Opt_WarnLazyUnliftedBindings
   | Opt_WarnUnusedDoBind
   | Opt_WarnWrongDoBind
   | Opt_WarnAlternativeLayoutRuleTransitional

   | Opt_PrintExplicitForalls

   -- optimisation opts
   | Opt_Strictness
   | Opt_FullLaziness
   | Opt_FloatIn
   | Opt_Specialise
   | Opt_StaticArgumentTransformation
   | Opt_CSE
   | Opt_LiberateCase
   | Opt_SpecConstr
   | Opt_DoLambdaEtaExpansion
   | Opt_IgnoreAsserts
   | Opt_DoEtaReduction
   | Opt_CaseMerge
   | Opt_UnboxStrictFields
   | Opt_MethodSharing
   | Opt_DictsCheap
   | Opt_EnableRewriteRules		-- Apply rewrite rules during simplification
   | Opt_Vectorise
   | Opt_RegsGraph                      -- do graph coloring register allocation
   | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation

   -- Interface files
   | Opt_IgnoreInterfacePragmas
   | Opt_OmitInterfacePragmas
   | Opt_ExposeAllUnfoldings

   -- profiling opts
   | Opt_AutoSccsOnAllToplevs
   | Opt_AutoSccsOnExportedToplevs
   | Opt_AutoSccsOnIndividualCafs

   -- misc opts
   | Opt_Pp
   | Opt_ForceRecomp
   | Opt_DryRun
   | Opt_DoAsmMangling
   | Opt_ExcessPrecision
   | Opt_EagerBlackHoling
   | Opt_ReadUserPackageConf
   | Opt_NoHsMain
   | Opt_RtsOptsEnabled
   | Opt_SplitObjs
   | Opt_StgStats
   | Opt_HideAllPackages
   | Opt_PrintBindResult
   | Opt_Haddock
   | Opt_HaddockOptions
   | Opt_Hpc_No_Auto
   | Opt_BreakOnException
   | Opt_BreakOnError
   | Opt_PrintEvldWithShow
   | Opt_PrintBindContents
   | Opt_GenManifest
   | Opt_EmbedManifest
   | Opt_EmitExternalCore
   | Opt_SharedImplib
   | Opt_BuildingCabalPackage
   | Opt_SSE2

	-- temporary flags
   | Opt_RunCPS
   | Opt_RunCPSZ
   | Opt_ConvertToZipCfgAndBack
   | Opt_AutoLinkPackages
   | Opt_ImplicitImportQualified
   | Opt_TryNewCodeGen

   -- keeping stuff
   | Opt_KeepHiDiffs
   | Opt_KeepHcFiles
   | Opt_KeepSFiles
   | Opt_KeepRawSFiles
   | Opt_KeepTmpFiles
   | Opt_KeepRawTokenStream
   | Opt_KeepLlvmFiles

   deriving (Eq, Show)

data ExtensionFlag
   = Opt_Cpp
   | Opt_OverlappingInstances
   | Opt_UndecidableInstances
   | Opt_IncoherentInstances
   | Opt_MonomorphismRestriction
   | Opt_MonoPatBinds
   | Opt_MonoLocalBinds
   | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
   | Opt_ForeignFunctionInterface
   | Opt_UnliftedFFITypes
   | Opt_GHCForeignImportPrim
   | Opt_PArr                           -- Syntactic support for parallel arrays
   | Opt_Arrows                         -- Arrow-notation syntax
   | Opt_TemplateHaskell
   | Opt_QuasiQuotes
   | Opt_ImplicitParams
   | Opt_Generics			-- "Derivable type classes"
   | Opt_ImplicitPrelude
   | Opt_ScopedTypeVariables
   | Opt_UnboxedTuples
   | Opt_BangPatterns
   | Opt_TypeFamilies
   | Opt_OverloadedStrings
   | Opt_DisambiguateRecordFields
   | Opt_RecordWildCards
   | Opt_RecordPuns
   | Opt_ViewPatterns
   | Opt_GADTs
   | Opt_RelaxedPolyRec
   | Opt_NPlusKPatterns

   | Opt_StandaloneDeriving
   | Opt_DeriveDataTypeable
   | Opt_DeriveFunctor
   | Opt_DeriveTraversable
   | Opt_DeriveFoldable

   | Opt_TypeSynonymInstances
   | Opt_FlexibleContexts
   | Opt_FlexibleInstances
   | Opt_ConstrainedClassMethods
   | Opt_MultiParamTypeClasses
   | Opt_FunctionalDependencies
   | Opt_UnicodeSyntax
   | Opt_PolymorphicComponents
   | Opt_ExistentialQuantification
   | Opt_MagicHash
   | Opt_EmptyDataDecls
   | Opt_KindSignatures
   | Opt_ParallelListComp
   | Opt_TransformListComp
   | Opt_GeneralizedNewtypeDeriving
   | Opt_RecursiveDo
   | Opt_DoRec
   | Opt_PostfixOperators
   | Opt_TupleSections
   | Opt_PatternGuards
   | Opt_LiberalTypeSynonyms
   | Opt_Rank2Types
   | Opt_RankNTypes
   | Opt_ImpredicativeTypes
   | Opt_TypeOperators
   | Opt_PackageImports
   | Opt_NewQualifiedOperators
   | Opt_ExplicitForAll
   | Opt_AlternativeLayoutRule
   | Opt_AlternativeLayoutRuleTransitional
   | Opt_DatatypeContexts
   deriving (Eq, Show)

-- | Contains not only a collection of 'DynFlag's but also a plethora of
-- information relating to the compilation of a single file or GHC session
data DynFlags = DynFlags {
  ghcMode               :: GhcMode,
  ghcLink               :: GhcLink,
  hscTarget             :: HscTarget,
  hscOutName            :: String,      -- ^ Name of the output file
  extCoreName           :: String,      -- ^ Name of the .hcr output file
  verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
  optLevel              :: Int,         -- ^ Optimisation level
  simplPhases           :: Int,         -- ^ Number of simplifier phases
  maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
  shouldDumpSimplPhase  :: Maybe String,
  ruleCheck             :: Maybe String,
  strictnessBefore      :: [Int],       -- ^ Additional demand analysis

  specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
  specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
  liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase

#ifndef OMIT_NATIVE_CODEGEN
  targetPlatform	:: Platform,	-- ^ The platform we're compiling for. Used by the NCG.
#endif
  stolen_x86_regs       :: Int,
  cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
  importPaths           :: [FilePath],
  mainModIs             :: Module,
  mainFunIs             :: Maybe String,
  ctxtStkDepth          :: Int,         -- ^ Typechecker context stack depth

  dphBackend            :: DPHBackend,

  thisPackage           :: PackageId,   -- ^ name of package currently being compiled

  -- ways
  ways                  :: [Way],       -- ^ Way flags from the command line
  buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
  rtsBuildTag           :: String,      -- ^ The RTS \"way\"

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

  -- paths etc.
  objectDir             :: Maybe String,
  dylibInstallName      :: Maybe String,
  hiDir                 :: Maybe String,
  stubDir               :: Maybe String,

  objectSuf             :: String,
  hcSuf                 :: String,
  hiSuf                 :: String,

  outputFile            :: Maybe String,
  outputHi              :: Maybe String,
  dynLibLoader          :: DynLibLoader,

  -- | This is set by 'DriverPipeline.runPipeline' based on where
  --    its output is going.
  dumpPrefix            :: Maybe FilePath,

  -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
  --    Set by @-ddump-file-prefix@
  dumpPrefixForce       :: Maybe FilePath,

  includePaths          :: [String],
  libraryPaths          :: [String],
  frameworkPaths        :: [String],    -- used on darwin only
  cmdlineFrameworks     :: [String],    -- ditto
  tmpDir                :: String,      -- no trailing '/'

  ghcUsagePath          :: FilePath,    -- Filled in by SysTools
  ghciUsagePath         :: FilePath,    -- ditto
  rtsOpts               :: Maybe String,

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

  -- options for particular phases
  opt_L                 :: [String],
  opt_P                 :: [String],
  opt_F                 :: [String],
  opt_c                 :: [String],
  opt_m                 :: [String],
  opt_a                 :: [String],
  opt_l                 :: [String],
  opt_windres           :: [String],
  opt_lo                :: [String], -- LLVM: llvm optimiser
  opt_lc                :: [String], -- LLVM: llc static compiler

  -- commands for particular phases
  pgm_L                 :: String,
  pgm_P                 :: (String,[Option]),
  pgm_F                 :: String,
  pgm_c                 :: (String,[Option]),
  pgm_m                 :: (String,[Option]),
  pgm_s                 :: (String,[Option]),
  pgm_a                 :: (String,[Option]),
  pgm_l                 :: (String,[Option]),
  pgm_dll               :: (String,[Option]),
  pgm_T                 :: String,
  pgm_sysman            :: String,
  pgm_windres           :: String,
  pgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser
  pgm_lc                :: (String,[Option]), -- LLVM: llc static compiler

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

  --  Package flags
  extraPkgConfs         :: [FilePath],
  topDir                :: FilePath,    -- filled in by SysTools
  systemPackageConfig   :: FilePath,    -- ditto
        -- ^ The @-package-conf@ flags given on the command line, in the order
        -- they appeared.

  packageFlags          :: [PackageFlag],
        -- ^ The @-package@ and @-hide-package@ flags from the command-line

  -- Package state
  -- NB. do not modify this field, it is calculated by
  -- Packages.initPackages and Packages.updatePackages.
  pkgDatabase           :: Maybe [PackageConfig],
  pkgState              :: PackageState,

  -- Temporary files
  -- These have to be IORefs, because the defaultCleanupHandler needs to
  -- know what to clean when an exception happens
  filesToClean          :: IORef [FilePath],
  dirsToClean           :: IORef (FiniteMap FilePath FilePath),

  -- hsc dynamic flags
  flags                 :: [DynFlag],
  extensionFlags        :: Either [OnOff ExtensionFlag]
                                  [ExtensionFlag],

  -- | Message output action: use "ErrUtils" instead of this if you can
  log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),

  haddockOptions :: Maybe String
 }

wayNames :: DynFlags -> [WayName]
wayNames = map wayName . ways

-- | The target code type of the compilation (if any).
--
-- Whenever you change the target, also make sure to set 'ghcLink' to
-- something sensible.
--
-- 'HscNothing' can be used to avoid generating any output, however, note
-- that:
--
--  * This will not run the desugaring step, thus no warnings generated in
--    this step will be output.  In particular, this includes warnings related
--    to pattern matching.  You can run the desugarer manually using
--    'GHC.desugarModule'.
--
--  * If a program uses Template Haskell the typechecker may try to run code
--    from an imported module.  This will fail if no code has been generated
--    for this module.  You can use 'GHC.needsTemplateHaskell' to detect
--    whether this might be the case and choose to either switch to a
--    different target or avoid typechecking such modules.  (The latter may
--    preferable for security reasons.)
--
data HscTarget
  = HscC           -- ^ Generate C code.
  | HscAsm         -- ^ Generate assembly using the native code generator.
  | HscLlvm        -- ^ Generate assembly using the llvm code generator.
  | HscJava        -- ^ Generate Java bytecode.
  | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')
  | HscNothing     -- ^ Don't generate any code.  See notes above.
  deriving (Eq, Show)

-- | Will this target result in an object file on the disk?
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC     = True
isObjectTarget HscAsm   = True
isObjectTarget HscLlvm  = True
isObjectTarget _        = False

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

instance Outputable GhcMode where
  ppr CompManager = ptext (sLit "CompManager")
  ppr OneShot     = ptext (sLit "OneShot")
  ppr MkDepend    = ptext (sLit "MkDepend")

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

-- | What to do in the link step, if there is one.
data GhcLink
  = NoLink              -- ^ Don't link at all
  | LinkBinary          -- ^ Link object code into a binary
  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both
                        --   bytecode and object code).
  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
  deriving (Eq, Show)

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

-- Is it worth evaluating this Bool and caching it in the DynFlags value
-- during initDynFlags?
doingTickyProfiling :: DynFlags -> Bool
doingTickyProfiling _ = opt_Ticky
  -- XXX -ticky is a static flag, because it implies -debug which is also
  -- static.  If the way flags were made dynamic, we could fix this.

data PackageFlag
  = ExposePackage  String
  | ExposePackageId String
  | HidePackage    String
  | IgnorePackage  String
  deriving Eq

defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget

-- | The 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
defaultObjectTarget :: HscTarget
defaultObjectTarget
  | cGhcWithNativeCodeGen == "YES"      =  HscAsm
  | otherwise                           =  HscC

data DynLibLoader
  = Deployable
  | Wrapped (Maybe String)
  | SystemDependent
  deriving Eq

-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
 -- someday these will be dynamic flags
 ways <- readIORef v_Ways
 refFilesToClean <- newIORef []
 refDirsToClean <- newIORef emptyFM
 return dflags{
        ways            = ways,
        buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
        rtsBuildTag     = mkBuildTag ways,
        filesToClean    = refFilesToClean,
        dirsToClean     = refDirsToClean
        }

-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
-- and must be fully initialized by 'GHC.newSession' first.
defaultDynFlags :: DynFlags
defaultDynFlags =
     DynFlags {
        ghcMode                 = CompManager,
        ghcLink                 = LinkBinary,
        hscTarget               = defaultHscTarget,
        hscOutName              = "",
        extCoreName             = "",
        verbosity               = 0,
        optLevel                = 0,
        simplPhases             = 2,
        maxSimplIterations      = 4,
        shouldDumpSimplPhase    = Nothing,
        ruleCheck               = Nothing,
        specConstrThreshold     = Just 200,
        specConstrCount         = Just 3,
        liberateCaseThreshold   = Just 200,
        strictnessBefore        = [],

#ifndef OMIT_NATIVE_CODEGEN
        targetPlatform          = defaultTargetPlatform,
#endif
        stolen_x86_regs         = 4,
        cmdlineHcIncludes       = [],
        importPaths             = ["."],
        mainModIs               = mAIN,
        mainFunIs               = Nothing,
        ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,

        dphBackend              = DPHPar,

        thisPackage             = mainPackageId,

        objectDir               = Nothing,
        dylibInstallName        = Nothing,
        hiDir                   = Nothing,
        stubDir                 = Nothing,

        objectSuf               = phaseInputExt StopLn,
        hcSuf                   = phaseInputExt HCc,
        hiSuf                   = "hi",

        outputFile              = Nothing,
        outputHi                = Nothing,
        dynLibLoader            = SystemDependent,
        dumpPrefix              = Nothing,
        dumpPrefixForce         = Nothing,
        includePaths            = [],
        libraryPaths            = [],
        frameworkPaths          = [],
        cmdlineFrameworks       = [],
        tmpDir                  = cDEFAULT_TMPDIR,
        rtsOpts                 = Nothing,

        hpcDir                  = ".hpc",

        opt_L                   = [],
        opt_P                   = (if opt_PIC
                                   then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
                                   else []),
        opt_F                   = [],
        opt_c                   = [],
        opt_a                   = [],
        opt_m                   = [],
        opt_l                   = [],
        opt_windres             = [],
        opt_lo                  = [],
        opt_lc                  = [],

        extraPkgConfs           = [],
        packageFlags            = [],
        pkgDatabase             = Nothing,
        pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
        ways                    = panic "defaultDynFlags: No ways",
        buildTag                = panic "defaultDynFlags: No buildTag",
        rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
        splitInfo               = Nothing,
        -- initSysTools fills all these in
        ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
        ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
        topDir                  = panic "defaultDynFlags: No topDir",
        systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
        pgm_L                   = panic "defaultDynFlags: No pgm_L",
        pgm_P                   = panic "defaultDynFlags: No pgm_P",
        pgm_F                   = panic "defaultDynFlags: No pgm_F",
        pgm_c                   = panic "defaultDynFlags: No pgm_c",
        pgm_m                   = panic "defaultDynFlags: No pgm_m",
        pgm_s                   = panic "defaultDynFlags: No pgm_s",
        pgm_a                   = panic "defaultDynFlags: No pgm_a",
        pgm_l                   = panic "defaultDynFlags: No pgm_l",
        pgm_dll                 = panic "defaultDynFlags: No pgm_dll",
        pgm_T                   = panic "defaultDynFlags: No pgm_T",
        pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
        pgm_windres             = panic "defaultDynFlags: No pgm_windres",
        pgm_lo                  = panic "defaultDynFlags: No pgm_lo",
        pgm_lc                  = panic "defaultDynFlags: No pgm_lc",
        -- end of initSysTools values
        -- ghc -M values
        depMakefile       = "Makefile",
        depIncludePkgDeps = False,
        depExcludeMods    = [],
        depSuffixes       = [],
        -- end of ghc -M values
        filesToClean   = panic "defaultDynFlags: No filesToClean",
        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
        haddockOptions = Nothing,
        flags = [
            Opt_AutoLinkPackages,
            Opt_ReadUserPackageConf,

            Opt_MethodSharing,

            Opt_DoAsmMangling,

            Opt_SharedImplib,

            Opt_GenManifest,
            Opt_EmbedManifest,
            Opt_PrintBindContents
            ]
            ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
                    -- The default -O0 options
            ++ standardWarnings,

        extensionFlags = Left [],

        log_action = \severity srcSpan style msg ->
                        case severity of
                          SevInfo  -> printErrs (msg style)
                          SevFatal -> printErrs (msg style)
                          _        -> do 
                                hPutChar stderr '\n'
                                printErrs ((mkLocMessage srcSpan msg) style)
                     -- careful (#2302): printErrs prints in UTF-8, whereas
                     -- converting to string first and using hPutStr would
                     -- just emit the low 8 bits of each unicode char.
      }

{-
Note [Verbosity levels]
~~~~~~~~~~~~~~~~~~~~~~~
    0   |   print errors & warnings only
    1   |   minimal verbosity: print "compiling M ... done." for each module.
    2   |   equivalent to -dshow-passes
    3   |   equivalent to existing "ghc -v"
    4   |   "ghc -v -ddump-most"
    5   |   "ghc -v -ddump-all"
-}

data OnOff a = On a
             | Off a

flattenExtensionFlags :: DynFlags -> DynFlags
flattenExtensionFlags dflags
    = case extensionFlags dflags of
      Left onoffs ->
          dflags {
              extensionFlags = Right $ flattenExtensionFlags' onoffs
          }
      Right _ ->
          panic "Flattening already-flattened extension flags"

ensureFlattenedExtensionFlags :: DynFlags -> DynFlags
ensureFlattenedExtensionFlags dflags
    = case extensionFlags dflags of
      Left onoffs ->
          dflags {
              extensionFlags = Right $ flattenExtensionFlags' onoffs
          }
      Right _ ->
          dflags

-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flattenExtensionFlags' :: [OnOff ExtensionFlag] -> [ExtensionFlag]
flattenExtensionFlags' = foldr f defaultExtensionFlags
    where f (On f)  flags = f : delete f flags
          f (Off f) flags =     delete f flags
          defaultExtensionFlags = [
            Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
                                -- behaviour the default, to see if anyone notices
                                -- SLPJ July 06

            Opt_ImplicitPrelude,
            Opt_MonomorphismRestriction,
            Opt_NPlusKPatterns,
            Opt_DatatypeContexts
            ]

-- The DOpt class is a temporary workaround, to avoid having to do
-- a mass-renaming dopt->lopt at the moment
class DOpt a where
    dopt :: a -> DynFlags -> Bool
    dopt_set :: DynFlags -> a -> DynFlags
    dopt_unset :: DynFlags -> a -> DynFlags

instance DOpt DynFlag where
    dopt = dopt'
    dopt_set = dopt_set'
    dopt_unset = dopt_unset'

instance DOpt ExtensionFlag where
    dopt = lopt
    dopt_set = lopt_set
    dopt_unset = lopt_unset

-- | Test whether a 'DynFlag' is set
dopt' :: DynFlag -> DynFlags -> Bool
dopt' f dflags  = f `elem` (flags dflags)

-- | Set a 'DynFlag'
dopt_set' :: DynFlags -> DynFlag -> DynFlags
dopt_set' dfs f = dfs{ flags = f : flags dfs }

-- | Unset a 'DynFlag'
dopt_unset' :: DynFlags -> DynFlag -> DynFlags
dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }

-- | Test whether a 'ExtensionFlag' is set
lopt :: ExtensionFlag -> DynFlags -> Bool
lopt f dflags = case extensionFlags dflags of
                Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
                Right flags -> f `elem` flags

-- | Set a 'ExtensionFlag'
lopt_set :: DynFlags -> ExtensionFlag -> DynFlags
lopt_set dfs f = case extensionFlags dfs of
                 Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
                 Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")

-- | Set a 'ExtensionFlag'
lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
lopt_set_flattened dfs f = case extensionFlags dfs of
                           Left _ ->
                               panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
                           Right flags ->
                               dfs { extensionFlags = Right (f : delete f flags) }

-- | Unset a 'ExtensionFlag'
lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
lopt_unset dfs f = case extensionFlags dfs of
                   Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
                   Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")

-- | Unset a 'ExtensionFlag'
lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
lopt_unset_flattened dfs f = case extensionFlags dfs of
                             Left _ ->
                                 panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
                             Right flags ->
                                 dfs { extensionFlags = Right (delete f flags) }

-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
        -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
        -> [a]                  -- ^ Correctly ordered extracted options
getOpts dflags opts = reverse (opts dflags)
        -- We add to the options from the front, so we need to reverse the list

-- | Gets the verbosity flag for the current verbosity level. This is fed to
-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
getVerbFlag :: DynFlags -> String
getVerbFlag dflags
  | verbosity dflags >= 3  = "-v"
  | otherwise =  ""

setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
         setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
         setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
         setPgmlo, setPgmlc,
         addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc,
         addCmdlineFramework, addHaddockOpts
   :: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
   :: Maybe String -> DynFlags -> DynFlags

setObjectDir  f d = d{ objectDir  = Just f}
setHiDir      f d = d{ hiDir      = Just f}
setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
  -- \#included from the .hc file when compiling with -fvia-C.
setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
setDylibInstallName  f d = d{ dylibInstallName = Just f}

setObjectSuf  f d = d{ objectSuf  = f}
setHiSuf      f d = d{ hiSuf      = f}
setHcSuf      f d = d{ hcSuf      = f}

setOutputFile f d = d{ outputFile = f}
setOutputHi   f d = d{ outputHi   = f}

parseDynLibLoaderMode f d =
 case splitAt 8 f of
   ("deploy", "")       -> d{ dynLibLoader = Deployable }
   ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
   ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
   ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
   ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
   _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))

setDumpPrefixForce f d = d { dumpPrefixForce = f}

-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option.
setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}

setPgmL   f d = d{ pgm_L   = f}
setPgmF   f d = d{ pgm_F   = f}
setPgmc   f d = d{ pgm_c   = (f,[])}
setPgmm   f d = d{ pgm_m   = (f,[])}
setPgms   f d = d{ pgm_s   = (f,[])}
setPgma   f d = d{ pgm_a   = (f,[])}
setPgml   f d = d{ pgm_l   = (f,[])}
setPgmdll f d = d{ pgm_dll = (f,[])}
setPgmwindres f d = d{ pgm_windres = f}
setPgmlo  f d = d{ pgm_lo  = (f,[])}
setPgmlc  f d = d{ pgm_lc  = (f,[])}

addOptL   f d = d{ opt_L   = f : opt_L d}
addOptP   f d = d{ opt_P   = f : opt_P d}
addOptF   f d = d{ opt_F   = f : opt_F d}
addOptc   f d = d{ opt_c   = f : opt_c d}
addOptm   f d = d{ opt_m   = f : opt_m d}
addOpta   f d = d{ opt_a   = f : opt_a d}
addOptl   f d = d{ opt_l   = f : opt_l d}
addOptwindres f d = d{ opt_windres = f : opt_windres d}
addOptlo  f d = d{ opt_lo  = f : opt_lo d}
addOptlc  f d = d{ opt_lc  = f : opt_lc d}

setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = deOptDep f }

setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }

addDepExcludeMod :: String -> DynFlags -> DynFlags
addDepExcludeMod m d
    = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }

addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }

-- XXX Legacy code:
-- We used to use "-optdep-flag -optdeparg", so for legacy applications
-- we need to strip the "-optdep" off of the arg
deOptDep :: String -> String
deOptDep x = case stripPrefix "-optdep" x of
             Just rest -> rest
             Nothing -> x

addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}

addHaddockOpts f d = d{ haddockOptions = Just f}

-- -----------------------------------------------------------------------------
-- Command-line options

-- | When invoking external tools as part of the compilation pipeline, we
-- pass these a sequence of options on the command-line. Rather than
-- just using a list of Strings, we use a type that allows us to distinguish
-- between filepaths and 'other stuff'. The reason for this is that
-- this type gives us a handle on transforming filenames, and filenames only,
-- to whatever format they're expected to be on a particular platform.
data Option
 = FileOption -- an entry that _contains_ filename(s) / filepaths.
              String  -- a non-filepath prefix that shouldn't be
                      -- transformed (e.g., "/out=")
              String  -- the filepath/filename portion
 | Option     String

showOpt :: Option -> String
showOpt (FileOption pre f) = pre ++ f
showOpt (Option s)  = s

-----------------------------------------------------------------------------
-- Setting the optimisation level

updOptLevel :: Int -> DynFlags -> DynFlags
-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
updOptLevel n dfs
  = dfs2{ optLevel = final_n }
  where
   final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2
   dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
   dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts

   extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
   remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]

optLevelFlags :: [([Int], DynFlag)]
optLevelFlags
  = [ ([0],     Opt_IgnoreInterfacePragmas)
    , ([0],     Opt_OmitInterfacePragmas)