module GHC.Driver.Session (
DumpFlag(..),
GeneralFlag(..),
WarningFlag(..), WarnReason(..),
Language(..),
PlatformConstants(..),
FatalMessager, LogAction, FlushOut(..), FlushErr(..),
ProfAuto(..),
glasgowExtsFlags,
warningGroups, warningHierarchies,
hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion,
dopt, dopt_set, dopt_unset,
gopt, gopt_set, gopt_unset, setGeneralFlag', unSetGeneralFlag',
wopt, wopt_set, wopt_unset,
wopt_fatal, wopt_set_fatal, wopt_unset_fatal,
xopt, xopt_set, xopt_unset,
xopt_set_unlessExplSpec,
lang_set,
whenGeneratingDynamicToo, ifGeneratingDynamicToo,
whenCannotGenerateDynamicToo,
dynamicTooMkDynamicDynFlags,
dynamicOutputFile,
sccProfilingEnabled,
DynFlags(..),
FlagSpec(..),
HasDynFlags(..), ContainsDynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
targetRetainsAllBindings,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..), PackageArg(..), ModRenaming(..),
packageFlagsChanged,
IgnorePackageFlag(..), TrustFlag(..),
PackageDBFlag(..), PkgDbRef(..),
Option(..), showOpt,
DynLibLoader(..),
fFlags, fLangFlags, xFlags,
wWarningFlags,
dynFlagDependencies,
makeDynFlagsConsistent,
positionIndependent,
optimisationFlags,
setFlagsFromEnvFile,
addWay',
homeUnit, mkHomeModule, isHomeModule,
putLogMsg,
SafeHaskellMode(..),
safeHaskellOn, safeHaskellModeEnabled,
safeImportsOn, safeLanguageOn, safeInferOn,
packageTrustOn,
safeDirectImpsReq, safeImplicitImpsReq,
unsafeFlags, unsafeFlagsForInfer,
LlvmTarget(..), LlvmConfig(..),
Settings(..),
sProgramName,
sProjectVersion,
sGhcUsagePath,
sGhciUsagePath,
sToolDir,
sTopDir,
sTmpDir,
sGlobalPackageDatabasePath,
sLdSupportsCompactUnwind,
sLdSupportsBuildId,
sLdSupportsFilelist,
sLdIsGnuLd,
sGccSupportsNoPie,
sPgm_L,
sPgm_P,
sPgm_F,
sPgm_c,
sPgm_a,
sPgm_l,
sPgm_lm,
sPgm_dll,
sPgm_T,
sPgm_windres,
sPgm_libtool,
sPgm_ar,
sPgm_ranlib,
sPgm_lo,
sPgm_lc,
sPgm_lcc,
sPgm_i,
sOpt_L,
sOpt_P,
sOpt_P_fingerprint,
sOpt_F,
sOpt_c,
sOpt_cxx,
sOpt_a,
sOpt_l,
sOpt_lm,
sOpt_windres,
sOpt_lo,
sOpt_lc,
sOpt_lcc,
sOpt_i,
sExtraGccViaCFlags,
sTargetPlatformString,
sGhcWithInterpreter,
sGhcWithSMP,
sGhcRTSWays,
sLibFFI,
sGhcThreaded,
sGhcDebugged,
sGhcRtsWithLibdw,
GhcNameVersion(..),
FileSettings(..),
PlatformMisc(..),
settings,
programName, projectVersion,
ghcUsagePath, ghciUsagePath, topDir, tmpDir,
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T,
pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool,
pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i,
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
opt_P_signature,
opt_windres, opt_lo, opt_lc, opt_lcc,
addPluginModuleName,
defaultDynFlags,
defaultWays,
initDynFlags,
defaultFatalMessager,
defaultLogAction,
defaultLogActionHPrintDoc,
defaultLogActionHPutStrDoc,
defaultFlushOut,
defaultFlushErr,
getOpts,
getVerbFlags,
updOptLevel,
setTmpDir,
setUnitId,
canonicalizeHomeModule,
canonicalizeModuleIfHome,
TurnOnFlag,
turnOn,
turnOff,
impliedGFlags,
impliedOffGFlags,
impliedXFlags,
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
parseDynamicFlagsFull,
allNonDeprecatedFlags,
flagsAll,
flagsDynamic,
flagsPackage,
flagsForCompletion,
supportedLanguagesAndExtensions,
languageExtensions,
picCCOpts, picPOpts,
compilerInfo,
#include "GHCConstantsHaskellExports.hs"
bLOCK_SIZE_W,
wordAlignment,
tAG_MASK,
mAX_PTR_TAG,
unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
isSseEnabled,
isSse2Enabled,
isSse4_2Enabled,
isBmiEnabled,
isBmi2Enabled,
isAvxEnabled,
isAvx2Enabled,
isAvx512cdEnabled,
isAvx512erEnabled,
isAvx512fEnabled,
isAvx512pfEnabled,
LinkerInfo(..),
CompilerInfo(..),
FilesToClean(..), emptyFilesToClean,
IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
initSDocContext, initDefaultSDocContext,
CfgWeights(..)
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform
import GHC.UniqueSubdir (uniqueSubdir)
import GHC.Unit.Types
import GHC.Unit.Parser
import GHC.Unit.Module
import GHC.Driver.Plugins
import GHC.Driver.Hooks
import GHC.Builtin.Names ( mAIN )
import GHC.Unit.State (UnitState, emptyUnitState, UnitDatabase, updateIndefUnitId)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
import GHC.Driver.Ways
import GHC.Driver.Backend
import GHC.Settings.Config
import GHC.Utils.CliOption
import GHC.Driver.CmdLine hiding (WarnReason(..))
import qualified GHC.Driver.CmdLine as Cmd
import GHC.Settings.Constants
import GHC.Utils.Panic
import qualified GHC.Utils.Ppr.Colour as Col
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Utils.Monad
import qualified GHC.Utils.Ppr as Pretty
import GHC.Types.SrcLoc
import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import GHC.Data.FastString
import GHC.Utils.Fingerprint
import GHC.Utils.Outputable
import GHC.Settings
import GHC.Utils.Error
( Severity(..), MsgDoc, mkLocMessageAnn
, getCaretDiagnostic, DumpAction, TraceAction
, defaultDumpAction, defaultTraceAction )
import GHC.Utils.Json
import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef
import Control.Arrow ((&&&))
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Writer
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Except
import Data.Ord
import Data.Bits
import Data.Char
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.FilePath
import System.Directory
import System.Environment (lookupEnv)
import System.IO
import System.IO.Error
import Text.ParserCombinators.ReadP hiding (char)
import Text.ParserCombinators.ReadP as R
import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
import GHC.Foreign (withCString, peekCString)
import qualified GHC.LanguageExtensions as LangExt
#if GHC_STAGE >= 2
import Foreign (Ptr)
#endif
data IncludeSpecs
= IncludeSpecs { includePathsQuote :: [String]
, includePathsGlobal :: [String]
}
deriving Show
addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addGlobalInclude spec paths = let f = includePathsGlobal spec
in spec { includePathsGlobal = f ++ paths }
addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addQuoteInclude spec paths = let f = includePathsQuote spec
in spec { includePathsQuote = f ++ paths }
flattenIncludes :: IncludeSpecs -> [String]
flattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs
data SafeHaskellMode
= Sf_None
| Sf_Unsafe
| Sf_Trustworthy
| Sf_Safe
| Sf_SafeInferred
| Sf_Ignore
deriving (Eq)
instance Show SafeHaskellMode where
show Sf_None = "None"
show Sf_Unsafe = "Unsafe"
show Sf_Trustworthy = "Trustworthy"
show Sf_Safe = "Safe"
show Sf_SafeInferred = "Safe-Inferred"
show Sf_Ignore = "Ignore"
instance Outputable SafeHaskellMode where
ppr = text . show
data DynFlags = DynFlags {
ghcMode :: GhcMode,
ghcLink :: GhcLink,
hscTarget :: HscTarget,
ghcNameVersion :: !GhcNameVersion,
fileSettings :: !FileSettings,
targetPlatform :: Platform,
toolSettings :: !ToolSettings,
platformMisc :: !PlatformMisc,
platformConstants :: PlatformConstants,
rawSettings :: [(String, String)],
llvmConfig :: LlvmConfig,
verbosity :: Int,
optLevel :: Int,
debugLevel :: Int,
simplPhases :: Int,
maxSimplIterations :: Int,
ruleCheck :: Maybe String,
inlineCheck :: Maybe String,
strictnessBefore :: [Int],
parMakeCount :: Maybe Int,
enableTimeStats :: Bool,
ghcHeapSize :: Maybe Int,
maxRelevantBinds :: Maybe Int,
maxValidHoleFits :: Maybe Int,
maxRefHoleFits :: Maybe Int,
refLevelHoleFits :: Maybe Int,
maxUncoveredPatterns :: Int,
maxPmCheckModels :: Int,
simplTickFactor :: Int,
specConstrThreshold :: Maybe Int,
specConstrCount :: Maybe Int,
specConstrRecursive :: Int,
binBlobThreshold :: Word,
liberateCaseThreshold :: Maybe Int,
floatLamArgs :: Maybe Int,
liftLamsRecArgs :: Maybe Int,
liftLamsNonRecArgs :: Maybe Int,
liftLamsKnown :: Bool,
cmmProcAlignment :: Maybe Int,
historySize :: Int,
importPaths :: [FilePath],
mainModIs :: Module,
mainFunIs :: Maybe String,
reductionDepth :: IntWithInf,
solverIterations :: IntWithInf,
homeUnitId :: UnitId,
homeUnitInstanceOfId :: Maybe IndefUnitId,
homeUnitInstantiations:: [(ModuleName, Module)],
ways :: Set Way,
splitInfo :: Maybe (String,Int),
objectDir :: Maybe String,
dylibInstallName :: Maybe String,
hiDir :: Maybe String,
hieDir :: Maybe String,
stubDir :: Maybe String,
dumpDir :: Maybe String,
objectSuf :: String,
hcSuf :: String,
hiSuf :: String,
hieSuf :: String,
canGenerateDynamicToo :: IORef Bool,
dynObjectSuf :: String,
dynHiSuf :: String,
outputFile :: Maybe String,
dynOutputFile :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
dumpPrefix :: Maybe FilePath,
dumpPrefixForce :: Maybe FilePath,
ldInputs :: [Option],
includePaths :: IncludeSpecs,
libraryPaths :: [String],
frameworkPaths :: [String],
cmdlineFrameworks :: [String],
rtsOpts :: Maybe String,
rtsOptsEnabled :: RtsOptsEnabled,
rtsOptsSuggestions :: Bool,
hpcDir :: String,
pluginModNames :: [ModuleName],
pluginModNameOpts :: [(ModuleName,String)],
frontendPluginOpts :: [String],
cachedPlugins :: [LoadedPlugin],
staticPlugins :: [StaticPlugin],
hooks :: Hooks,
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
depIncludeCppDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
packageDBFlags :: [PackageDBFlag],
ignorePackageFlags :: [IgnorePackageFlag],
packageFlags :: [PackageFlag],
pluginPackageFlags :: [PackageFlag],
trustFlags :: [TrustFlag],
packageEnv :: Maybe FilePath,
unitDatabases :: Maybe [UnitDatabase UnitId],
unitState :: UnitState,
filesToClean :: IORef FilesToClean,
dirsToClean :: IORef (Map FilePath FilePath),
nextTempSuffix :: IORef Int,
generatedDumps :: IORef (Set FilePath),
dumpFlags :: EnumSet DumpFlag,
generalFlags :: EnumSet GeneralFlag,
warningFlags :: EnumSet WarningFlag,
fatalWarningFlags :: EnumSet WarningFlag,
language :: Maybe Language,
safeHaskell :: SafeHaskellMode,
safeInfer :: Bool,
safeInferred :: Bool,
thOnLoc :: SrcSpan,
newDerivOnLoc :: SrcSpan,
overlapInstLoc :: SrcSpan,
incoherentOnLoc :: SrcSpan,
pkgTrustOnLoc :: SrcSpan,
warnSafeOnLoc :: SrcSpan,
warnUnsafeOnLoc :: SrcSpan,
trustworthyOnLoc :: SrcSpan,
extensions :: [OnOff LangExt.Extension],
extensionFlags :: EnumSet LangExt.Extension,
ufCreationThreshold :: Int,
ufUseThreshold :: Int,
ufFunAppDiscount :: Int,
ufDictDiscount :: Int,
ufDearOp :: Int,
ufVeryAggressive :: Bool,
maxWorkerArgs :: Int,
ghciHistSize :: Int,
log_action :: LogAction,
dump_action :: DumpAction,
trace_action :: TraceAction,
flushOut :: FlushOut,
flushErr :: FlushErr,
ghcVersionFile :: Maybe FilePath,
haddockOptions :: Maybe String,
ghciScripts :: [String],
pprUserLength :: Int,
pprCols :: Int,
useUnicode :: Bool,
useColor :: OverridingBool,
canUseColor :: Bool,
colScheme :: Col.Scheme,
profAuto :: ProfAuto,
interactivePrint :: Maybe String,
nextWrapperNum :: IORef (ModuleEnv Int),
sseVersion :: Maybe SseVersion,
bmiVersion :: Maybe BmiVersion,
avx :: Bool,
avx2 :: Bool,
avx512cd :: Bool,
avx512er :: Bool,
avx512f :: Bool,
avx512pf :: Bool,
rtldInfo :: IORef (Maybe LinkerInfo),
rtccInfo :: IORef (Maybe CompilerInfo),
maxInlineAllocSize :: Int,
maxInlineMemcpyInsns :: Int,
maxInlineMemsetInsns :: Int,
reverseErrors :: Bool,
maxErrors :: Maybe Int,
initialUnique :: Int,
uniqueIncrement :: Int,
cfgWeightInfo :: CfgWeights
}
data CfgWeights
= CFGWeights
{ uncondWeight :: Int
, condBranchWeight :: Int
, switchWeight :: Int
, callWeight :: Int
, likelyCondWeight :: Int
, unlikelyCondWeight :: Int
, infoTablePenalty :: Int
, backEdgeBonus :: Int
}
defaultCfgWeights :: CfgWeights
defaultCfgWeights
= CFGWeights
{ uncondWeight = 1000
, condBranchWeight = 800
, switchWeight = 1
, callWeight = 10
, likelyCondWeight = 900
, unlikelyCondWeight = 300
, infoTablePenalty = 300
, backEdgeBonus = 400
}
parseCfgWeights :: String -> CfgWeights -> CfgWeights
parseCfgWeights s oldWeights =
foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments
where
assignments = map assignment $ settings s
update "uncondWeight" n w =
w {uncondWeight = n}
update "condBranchWeight" n w =
w {condBranchWeight = n}
update "switchWeight" n w =
w {switchWeight = n}
update "callWeight" n w =
w {callWeight = n}
update "likelyCondWeight" n w =
w {likelyCondWeight = n}
update "unlikelyCondWeight" n w =
w {unlikelyCondWeight = n}
update "infoTablePenalty" n w =
w {infoTablePenalty = n}
update "backEdgeBonus" n w =
w {backEdgeBonus = n}
update other _ _
= panic $ other ++
" is not a cfg weight parameter. " ++
exampleString
settings s
| (s1,rest) <- break (== ',') s
, null rest
= [s1]
| (s1,rest) <- break (== ',') s
= s1 : settings (drop 1 rest)
assignment as
| (name, _:val) <- break (== '=') as
= (name,read val)
| otherwise
= panic $ "Invalid cfg parameters." ++ exampleString
exampleString = "Example parameters: uncondWeight=1000," ++
"condBranchWeight=800,switchWeight=0,callWeight=300" ++
",likelyCondWeight=900,unlikelyCondWeight=300" ++
",infoTablePenalty=300,backEdgeBonus=400"
class HasDynFlags m where
getDynFlags :: m DynFlags
instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where
getDynFlags = lift getDynFlags
instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where
getDynFlags = lift getDynFlags
instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where
getDynFlags = lift getDynFlags
instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
getDynFlags = lift getDynFlags
class ContainsDynFlags t where
extractDynFlags :: t -> DynFlags
data ProfAuto
= NoProfAuto
| ProfAutoAll
| ProfAutoTop
| ProfAutoExports
| ProfAutoCalls
deriving (Eq,Enum)
data LlvmTarget = LlvmTarget
{ lDataLayout :: String
, lCPU :: String
, lAttributes :: [String]
}
data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
, llvmPasses :: [(Int, String)]
}
settings :: DynFlags -> Settings
settings dflags = Settings
{ sGhcNameVersion = ghcNameVersion dflags
, sFileSettings = fileSettings dflags
, sTargetPlatform = targetPlatform dflags
, sToolSettings = toolSettings dflags
, sPlatformMisc = platformMisc dflags
, sPlatformConstants = platformConstants dflags
, sRawSettings = rawSettings dflags
}
programName :: DynFlags -> String
programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags
projectVersion :: DynFlags -> String
projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags)
ghcUsagePath :: DynFlags -> FilePath
ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags
ghciUsagePath :: DynFlags -> FilePath
ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
toolDir :: DynFlags -> Maybe FilePath
toolDir dflags = fileSettings_toolDir $ fileSettings dflags
topDir :: DynFlags -> FilePath
topDir dflags = fileSettings_topDir $ fileSettings dflags
tmpDir :: DynFlags -> String
tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags
extraGccViaCFlags :: DynFlags -> [String]
extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
globalPackageDatabasePath :: DynFlags -> FilePath
globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags
pgm_L :: DynFlags -> String
pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags
pgm_P :: DynFlags -> (String,[Option])
pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags
pgm_F :: DynFlags -> String
pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags
pgm_c :: DynFlags -> String
pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags
pgm_a :: DynFlags -> (String,[Option])
pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags
pgm_l :: DynFlags -> (String,[Option])
pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags
pgm_lm :: DynFlags -> (String,[Option])
pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags
pgm_dll :: DynFlags -> (String,[Option])
pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
pgm_T :: DynFlags -> String
pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags
pgm_windres :: DynFlags -> String
pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags
pgm_libtool :: DynFlags -> String
pgm_libtool dflags = toolSettings_pgm_libtool $ toolSettings dflags
pgm_lcc :: DynFlags -> (String,[Option])
pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags
pgm_ar :: DynFlags -> String
pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags
pgm_otool :: DynFlags -> String
pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags
pgm_install_name_tool :: DynFlags -> String
pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags
pgm_ranlib :: DynFlags -> String
pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags
pgm_lo :: DynFlags -> (String,[Option])
pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags
pgm_lc :: DynFlags -> (String,[Option])
pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags
pgm_i :: DynFlags -> String
pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags
opt_L :: DynFlags -> [String]
opt_L dflags = toolSettings_opt_L $ toolSettings dflags
opt_P :: DynFlags -> [String]
opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
++ toolSettings_opt_P (toolSettings dflags)
opt_P_signature :: DynFlags -> ([String], Fingerprint)
opt_P_signature dflags =
( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
, toolSettings_opt_P_fingerprint $ toolSettings dflags
)
opt_F :: DynFlags -> [String]
opt_F dflags= toolSettings_opt_F $ toolSettings dflags
opt_c :: DynFlags -> [String]
opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
++ toolSettings_opt_c (toolSettings dflags)
opt_cxx :: DynFlags -> [String]
opt_cxx dflags= toolSettings_opt_cxx $ toolSettings dflags
opt_a :: DynFlags -> [String]
opt_a dflags= toolSettings_opt_a $ toolSettings dflags
opt_l :: DynFlags -> [String]
opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
++ toolSettings_opt_l (toolSettings dflags)
opt_lm :: DynFlags -> [String]
opt_lm dflags= toolSettings_opt_lm $ toolSettings dflags
opt_windres :: DynFlags -> [String]
opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags
opt_lcc :: DynFlags -> [String]
opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags
opt_lo :: DynFlags -> [String]
opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags
opt_lc :: DynFlags -> [String]
opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
opt_i :: DynFlags -> [String]
opt_i dflags= toolSettings_opt_i $ toolSettings dflags
versionedAppDir :: String -> PlatformMini -> MaybeT IO FilePath
versionedAppDir appname platform = do
appdir <- tryMaybeT $ getAppUserDataDirectory appname
return $ appdir </> versionedFilePath platform
versionedFilePath :: PlatformMini -> FilePath
versionedFilePath platform = uniqueSubdir platform
data HscTarget
= HscC
| HscAsm
| HscLlvm
| HscInterpreted
| HscNothing
deriving (Eq, Show)
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True
isObjectTarget HscAsm = True
isObjectTarget HscLlvm = True
isObjectTarget _ = False
targetRetainsAllBindings :: HscTarget -> Bool
targetRetainsAllBindings HscInterpreted = True
targetRetainsAllBindings HscNothing = True
targetRetainsAllBindings _ = False
data GhcMode
= CompManager
| OneShot
| MkDepend
deriving Eq
instance Outputable GhcMode where
ppr CompManager = text "CompManager"
ppr OneShot = text "OneShot"
ppr MkDepend = text "MkDepend"
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
isOneShot _other = False
data GhcLink
= NoLink
| LinkBinary
| LinkInMemory
| LinkDynLib
| LinkStaticLib
deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
data PackageArg =
PackageArg String
| UnitIdArg Unit
deriving (Eq, Show)
instance Outputable PackageArg where
ppr (PackageArg pn) = text "package" <+> text pn
ppr (UnitIdArg uid) = text "unit" <+> ppr uid
data ModRenaming = ModRenaming {
modRenamingWithImplicit :: Bool,
modRenamings :: [(ModuleName, ModuleName)]
} deriving (Eq)
instance Outputable ModRenaming where
ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
newtype IgnorePackageFlag = IgnorePackage String
deriving (Eq)
data TrustFlag
= TrustPackage String
| DistrustPackage String
deriving (Eq)
data PackageFlag
= ExposePackage String PackageArg ModRenaming
| HidePackage String
deriving (Eq)
data PackageDBFlag
= PackageDB PkgDbRef
| NoUserPackageDB
| NoGlobalPackageDB
| ClearPackageDBs
deriving (Eq)
packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged idflags1 idflags0 =
packageFlags idflags1 /= packageFlags idflags0 ||
ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||
pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||
trustFlags idflags1 /= trustFlags idflags0 ||
packageDBFlags idflags1 /= packageDBFlags idflags0 ||
packageGFlags idflags1 /= packageGFlags idflags0
where
packageGFlags dflags = map (`gopt` dflags)
[ Opt_HideAllPackages
, Opt_HideAllPluginPackages
, Opt_AutoLinkPackages ]
instance Outputable PackageFlag where
ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
ppr (HidePackage str) = text "-hide-package" <+> text str
defaultHscTarget :: Platform -> HscTarget
defaultHscTarget platform
| platformUnregisterised platform = HscC
| NCG <- platformDefaultBackend platform = HscAsm
| otherwise = HscLlvm
defaultObjectTarget :: DynFlags -> HscTarget
defaultObjectTarget dflags = defaultHscTarget
(targetPlatform dflags)
data DynLibLoader
= Deployable
| SystemDependent
deriving Eq
data RtsOptsEnabled
= RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
| RtsOptsAll
deriving (Show)
positionIndependent :: DynFlags -> Bool
positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())
ifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
ifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g
whenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
whenCannotGenerateDynamicToo dflags f
= ifCannotGenerateDynamicToo dflags f (return ())
ifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
ifCannotGenerateDynamicToo dflags f g
= generateDynamicTooConditional dflags g f g
generateDynamicTooConditional :: MonadIO m
=> DynFlags -> m a -> m a -> m a -> m a
generateDynamicTooConditional dflags canGen cannotGen notTryingToGen
= if gopt Opt_BuildDynamicToo dflags
then do let ref = canGenerateDynamicToo dflags
b <- liftIO $ readIORef ref
if b then canGen else cannotGen
else notTryingToGen
dynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags
dynamicTooMkDynamicDynFlags dflags0
= let dflags1 = addWay' WayDyn dflags0
dflags2 = dflags1 {
outputFile = dynOutputFile dflags1,
hiSuf = dynHiSuf dflags1,
objectSuf = dynObjectSuf dflags1
}
dflags3 = gopt_unset dflags2 Opt_BuildDynamicToo
in dflags3
dynamicOutputFile :: DynFlags -> FilePath -> FilePath
dynamicOutputFile dflags outputFile = dynOut outputFile
where
dynOut = flip addExtension (dynObjectSuf dflags) . dropExtension
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
let
platformCanGenerateDynamicToo
= platformOS (targetPlatform dflags) /= OSMinGW32
refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo
refNextTempSuffix <- newIORef 0
refFilesToClean <- newIORef emptyFilesToClean
refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
refRtldInfo <- newIORef Nothing
refRtccInfo <- newIORef Nothing
wrapperNum <- newIORef emptyModuleEnv
canUseUnicode <- do let enc = localeEncoding
str = "‘’"
(withCString enc str $ \cstr ->
do str' <- peekCString enc cstr
return (str == str'))
`catchIOError` \_ -> return False
ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
maybeGhcColorsEnv <- lookupEnv "GHC_COLORS"
maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
let adjustCols (Just env) = Col.parseScheme env
adjustCols Nothing = id
let (useColor', colScheme') =
(adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)
(useColor dflags, colScheme dflags)
return dflags{
canGenerateDynamicToo = refCanGenerateDynamicToo,
nextTempSuffix = refNextTempSuffix,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps,
nextWrapperNum = wrapperNum,
useUnicode = useUnicode',
useColor = useColor',
canUseColor = stderrSupportsAnsiColors,
colScheme = colScheme',
rtldInfo = refRtldInfo,
rtccInfo = refRtccInfo
}
defaultDynFlags :: Settings -> LlvmConfig -> DynFlags
defaultDynFlags mySettings llvmConfig =
DynFlags {
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget (sTargetPlatform mySettings),
verbosity = 0,
optLevel = 0,
debugLevel = 0,
simplPhases = 2,
maxSimplIterations = 4,
ruleCheck = Nothing,
inlineCheck = Nothing,
binBlobThreshold = 500000,
maxRelevantBinds = Just 6,
maxValidHoleFits = Just 6,
maxRefHoleFits = Just 6,
refLevelHoleFits = Nothing,
maxUncoveredPatterns = 4,
maxPmCheckModels = 30,
simplTickFactor = 100,
specConstrThreshold = Just 2000,
specConstrCount = Just 3,
specConstrRecursive = 3,
liberateCaseThreshold = Just 2000,
floatLamArgs = Just 0,
liftLamsRecArgs = Just 5,
liftLamsNonRecArgs = Just 5,
liftLamsKnown = False,
cmmProcAlignment = Nothing,
historySize = 20,
strictnessBefore = [],
parMakeCount = Just 1,
enableTimeStats = False,
ghcHeapSize = Nothing,
importPaths = ["."],
mainModIs = mAIN,
mainFunIs = Nothing,
reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
homeUnitId = mainUnitId,
homeUnitInstanceOfId = Nothing,
homeUnitInstantiations = [],
objectDir = Nothing,
dylibInstallName = Nothing,
hiDir = Nothing,
hieDir = Nothing,
stubDir = Nothing,
dumpDir = Nothing,
objectSuf = phaseInputExt StopLn,
hcSuf = phaseInputExt HCc,
hiSuf = "hi",
hieSuf = "hie",
canGenerateDynamicToo = panic "defaultDynFlags: No canGenerateDynamicToo",
dynObjectSuf = "dyn_" ++ phaseInputExt StopLn,
dynHiSuf = "dyn_hi",
pluginModNames = [],
pluginModNameOpts = [],
frontendPluginOpts = [],
cachedPlugins = [],
staticPlugins = [],
hooks = emptyHooks,
outputFile = Nothing,
dynOutputFile = Nothing,
outputHi = Nothing,
dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
ldInputs = [],
includePaths = IncludeSpecs [] [],
libraryPaths = [],
frameworkPaths = [],
cmdlineFrameworks = [],
rtsOpts = Nothing,
rtsOptsEnabled = RtsOptsSafeOnly,
rtsOptsSuggestions = True,
hpcDir = ".hpc",
packageDBFlags = [],
packageFlags = [],
pluginPackageFlags = [],
ignorePackageFlags = [],
trustFlags = [],
packageEnv = Nothing,
unitDatabases = Nothing,
unitState = emptyUnitState,
ways = defaultWays mySettings,
splitInfo = Nothing,
ghcNameVersion = sGhcNameVersion mySettings,
fileSettings = sFileSettings mySettings,
toolSettings = sToolSettings mySettings,
targetPlatform = sTargetPlatform mySettings,
platformMisc = sPlatformMisc mySettings,
platformConstants = sPlatformConstants mySettings,
rawSettings = sRawSettings mySettings,
llvmConfig = llvmConfig,
depMakefile = "Makefile",
depIncludePkgDeps = False,
depIncludeCppDeps = False,
depExcludeMods = [],
depSuffixes = [],
nextTempSuffix = panic "defaultDynFlags: No nextTempSuffix",
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps",
ghcVersionFile = Nothing,
haddockOptions = Nothing,
dumpFlags = EnumSet.empty,
generalFlags = EnumSet.fromList (defaultFlags mySettings),
warningFlags = EnumSet.fromList standardWarnings,
fatalWarningFlags = EnumSet.empty,
ghciScripts = [],
language = Nothing,
safeHaskell = Sf_None,
safeInfer = True,
safeInferred = True,
thOnLoc = noSrcSpan,
newDerivOnLoc = noSrcSpan,
overlapInstLoc = noSrcSpan,
incoherentOnLoc = noSrcSpan,
pkgTrustOnLoc = noSrcSpan,
warnSafeOnLoc = noSrcSpan,
warnUnsafeOnLoc = noSrcSpan,
trustworthyOnLoc = noSrcSpan,
extensions = [],
extensionFlags = flattenExtensionFlags Nothing [],
ufCreationThreshold = 750,
ufUseThreshold = 90,
ufFunAppDiscount = 60,
ufDictDiscount = 30,
ufDearOp = 40,
ufVeryAggressive = False,
maxWorkerArgs = 10,
ghciHistSize = 50,
log_action = defaultLogAction,
dump_action = defaultDumpAction,
trace_action = defaultTraceAction,
flushOut = defaultFlushOut,
flushErr = defaultFlushErr,
pprUserLength = 5,
pprCols = 100,
useUnicode = False,
useColor = Auto,
canUseColor = False,
colScheme = Col.defaultScheme,
profAuto = NoProfAuto,
interactivePrint = Nothing,
nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
sseVersion = Nothing,
bmiVersion = Nothing,
avx = False,
avx2 = False,
avx512cd = False,
avx512er = False,
avx512f = False,
avx512pf = False,
rtldInfo = panic "defaultDynFlags: no rtldInfo",
rtccInfo = panic "defaultDynFlags: no rtccInfo",
maxInlineAllocSize = 128,
maxInlineMemcpyInsns = 32,
maxInlineMemsetInsns = 32,
initialUnique = 0,
uniqueIncrement = 1,
reverseErrors = False,
maxErrors = Nothing,
cfgWeightInfo = defaultCfgWeights
}
defaultWays :: Settings -> Set Way
defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
then Set.singleton WayDyn
else Set.empty
type FatalMessager = String -> IO ()
type LogAction = DynFlags
-> WarnReason
-> Severity
-> SrcSpan
-> MsgDoc
-> IO ()
defaultFatalMessager :: FatalMessager
defaultFatalMessager = hPutStrLn stderr
jsonLogAction :: LogAction
jsonLogAction dflags reason severity srcSpan msg
= do
defaultLogActionHPutStrDoc dflags stdout
(withPprStyle (mkCodeStyle CStyle) (doc $$ text ""))
where
doc = renderJSON $
JSObject [ ( "span", json srcSpan )
, ( "doc" , JSString (showSDoc dflags msg) )
, ( "severity", json severity )
, ( "reason" , json reason )
]
defaultLogAction :: LogAction
defaultLogAction dflags reason severity srcSpan msg
= case severity of
SevOutput -> printOut msg
SevDump -> printOut (msg $$ blankLine)
SevInteractive -> putStrSDoc msg
SevInfo -> printErrs msg
SevFatal -> printErrs msg
SevWarning -> printWarns
SevError -> printWarns
where
printOut = defaultLogActionHPrintDoc dflags stdout
printErrs = defaultLogActionHPrintDoc dflags stderr
putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
message = mkLocMessageAnn flagMsg severity srcSpan msg
printWarns = do
hPutChar stderr '\n'
caretDiagnostic <-
if gopt Opt_DiagnosticsShowCaret dflags
then getCaretDiagnostic severity srcSpan
else pure empty
printErrs $ getPprStyle $ \style ->
withPprStyle (setStyleColoured True style)
(message $+$ caretDiagnostic)
flagMsg =
case reason of
NoReason -> Nothing
Reason wflag -> do
spec <- flagSpecOf wflag
return ("-W" ++ flagSpecName spec ++ warnFlagGrp wflag)
ErrReason Nothing ->
return "-Werror"
ErrReason (Just wflag) -> do
spec <- flagSpecOf wflag
return $
"-W" ++ flagSpecName spec ++ warnFlagGrp wflag ++
", -Werror=" ++ flagSpecName spec
warnFlagGrp flag
| gopt Opt_ShowWarnGroups dflags =
case smallestGroups flag of
[] -> ""
groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"
| otherwise = ""
defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> IO ()
defaultLogActionHPrintDoc dflags h d
= defaultLogActionHPutStrDoc dflags h (d $$ text "")
defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> IO ()
defaultLogActionHPutStrDoc dflags h d
= printSDoc ctx Pretty.PageMode h d
where ctx = initSDocContext dflags defaultUserStyle
newtype FlushOut = FlushOut (IO ())
defaultFlushOut :: FlushOut
defaultFlushOut = FlushOut $ hFlush stdout
newtype FlushErr = FlushErr (IO ())
defaultFlushErr :: FlushErr
defaultFlushErr = FlushErr $ hFlush stderr
data OnOff a = On a
| Off a
deriving (Eq, Show)
instance Outputable a => Outputable (OnOff a) where
ppr (On x) = text "On" <+> ppr x
ppr (Off x) = text "Off" <+> ppr x
flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension
flattenExtensionFlags ml = foldr f defaultExtensionFlags
where f (On f) flags = EnumSet.insert f flags
f (Off f) flags = EnumSet.delete f flags
defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)
languageExtensions :: Maybe Language -> [LangExt.Extension]
languageExtensions Nothing
= LangExt.NondecreasingIndentation
: delete LangExt.DatatypeContexts
(languageExtensions (Just Haskell2010))
languageExtensions (Just Haskell98)
= [LangExt.ImplicitPrelude,
LangExt.StarIsType,
LangExt.CUSKs,
LangExt.MonomorphismRestriction,
LangExt.NPlusKPatterns,
LangExt.DatatypeContexts,
LangExt.TraditionalRecordSyntax,
LangExt.NondecreasingIndentation
]
languageExtensions (Just Haskell2010)
= [LangExt.ImplicitPrelude,
LangExt.StarIsType,
LangExt.CUSKs,
LangExt.MonomorphismRestriction,
LangExt.DatatypeContexts,
LangExt.TraditionalRecordSyntax,
LangExt.EmptyDataDecls,
LangExt.ForeignFunctionInterface,
LangExt.PatternGuards,
LangExt.DoAndIfThenElse,
LangExt.RelaxedPolyRec]
hasPprDebug :: DynFlags -> Bool
hasPprDebug = dopt Opt_D_ppr_debug
hasNoDebugOutput :: DynFlags -> Bool
hasNoDebugOutput = dopt Opt_D_no_debug_output
hasNoStateHack :: DynFlags -> Bool
hasNoStateHack = gopt Opt_G_NoStateHack
hasNoOptCoercion :: DynFlags -> Bool
hasNoOptCoercion = gopt Opt_G_NoOptCoercion
dopt :: DumpFlag -> DynFlags -> Bool
dopt f dflags = (f `EnumSet.member` dumpFlags dflags)
|| (verbosity dflags >= 4 && enableIfVerbose f)
where enableIfVerbose Opt_D_dump_tc_trace = False
enableIfVerbose Opt_D_dump_rn_trace = False
enableIfVerbose Opt_D_dump_cs_trace = False
enableIfVerbose Opt_D_dump_if_trace = False
enableIfVerbose Opt_D_dump_vt_trace = False
enableIfVerbose Opt_D_dump_tc = False
enableIfVerbose Opt_D_dump_rn = False
enableIfVerbose Opt_D_dump_rn_stats = False
enableIfVerbose Opt_D_dump_hi_diffs = False
enableIfVerbose Opt_D_verbose_core2core = False
enableIfVerbose Opt_D_verbose_stg2stg = False
enableIfVerbose Opt_D_dump_splices = False
enableIfVerbose Opt_D_th_dec_file = False
enableIfVerbose Opt_D_dump_rule_firings = False
enableIfVerbose Opt_D_dump_rule_rewrites = False
enableIfVerbose Opt_D_dump_simpl_trace = False
enableIfVerbose Opt_D_dump_rtti = False
enableIfVerbose Opt_D_dump_inlinings = False
enableIfVerbose Opt_D_dump_core_stats = False
enableIfVerbose Opt_D_dump_asm_stats = False
enableIfVerbose Opt_D_dump_types = False
enableIfVerbose Opt_D_dump_simpl_iterations = False
enableIfVerbose Opt_D_dump_ticked = False
enableIfVerbose Opt_D_dump_view_pattern_commoning = False
enableIfVerbose Opt_D_dump_mod_cycles = False
enableIfVerbose Opt_D_dump_mod_map = False
enableIfVerbose Opt_D_dump_ec_trace = False
enableIfVerbose _ = True
dopt_set :: DynFlags -> DumpFlag -> DynFlags
dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }
dopt_unset :: DynFlags -> DumpFlag -> DynFlags
dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }
gopt :: GeneralFlag -> DynFlags -> Bool
gopt f dflags = f `EnumSet.member` generalFlags dflags
gopt_set :: DynFlags -> GeneralFlag -> DynFlags
gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }
gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }
wopt :: WarningFlag -> DynFlags -> Bool
wopt f dflags = f `EnumSet.member` warningFlags dflags
wopt_set :: DynFlags -> WarningFlag -> DynFlags
wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }
wopt_fatal :: WarningFlag -> DynFlags -> Bool
wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags
wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_set_fatal dfs f
= dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal dfs f
= dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
xopt :: LangExt.Extension -> DynFlags -> Bool
xopt f dflags = f `EnumSet.member` extensionFlags dflags
xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
xopt_set dfs f
= let onoffs = On f : extensions dfs
in dfs { extensions = onoffs,
extensionFlags = flattenExtensionFlags (language dfs) onoffs }
xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags
xopt_unset dfs f
= let onoffs = Off f : extensions dfs
in dfs { extensions = onoffs,
extensionFlags = flattenExtensionFlags (language dfs) onoffs }
xopt_set_unlessExplSpec
:: LangExt.Extension
-> (DynFlags -> LangExt.Extension -> DynFlags)
-> DynFlags -> DynFlags
xopt_set_unlessExplSpec ext setUnset dflags =
let referedExts = stripOnOff <$> extensions dflags
stripOnOff (On x) = x
stripOnOff (Off x) = x
in
if ext `elem` referedExts then dflags else setUnset dflags ext
lang_set :: DynFlags -> Maybe Language -> DynFlags
lang_set dflags lang =
dflags {
language = lang,
extensionFlags = flattenExtensionFlags lang (extensions dflags)
}
setLanguage :: Language -> DynP ()
setLanguage l = upd (`lang_set` Just l)
dynFlagDependencies :: DynFlags -> [ModuleName]
dynFlagDependencies = pluginModNames
packageTrustOn :: DynFlags -> Bool
packageTrustOn = gopt Opt_PackageTrust
safeHaskellOn :: DynFlags -> Bool
safeHaskellOn dflags = safeHaskellModeEnabled dflags || safeInferOn dflags
safeHaskellModeEnabled :: DynFlags -> Bool
safeHaskellModeEnabled dflags = safeHaskell dflags `elem` [Sf_Unsafe, Sf_Trustworthy
, Sf_Safe ]
safeLanguageOn :: DynFlags -> Bool
safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
safeInferOn :: DynFlags -> Bool
safeInferOn = safeInfer
safeImportsOn :: DynFlags -> Bool
safeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||
safeHaskell dflags == Sf_Trustworthy ||
safeHaskell dflags == Sf_Safe
setSafeHaskell :: SafeHaskellMode -> DynP ()
setSafeHaskell s = updM f
where f dfs = do
let sf = safeHaskell dfs
safeM <- combineSafeFlags sf s
case s of
Sf_Safe -> return $ dfs { safeHaskell = safeM, safeInfer = False }
Sf_Trustworthy -> do
l <- getCurLoc
return $ dfs { safeHaskell = safeM, trustworthyOnLoc = l }
_ -> return $ dfs { safeHaskell = safeM }
safeDirectImpsReq :: DynFlags -> Bool
safeDirectImpsReq d = safeLanguageOn d
safeImplicitImpsReq :: DynFlags -> Bool
safeImplicitImpsReq d = safeLanguageOn d
combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
combineSafeFlags a b | a == Sf_None = return b
| b == Sf_None = return a
| a == Sf_Ignore || b == Sf_Ignore = return Sf_Ignore
| a == b = return a
| otherwise = addErr errm >> pure a
where errm = "Incompatible Safe Haskell flags! ("
++ show a ++ ", " ++ show b ++ ")"
unsafeFlags, unsafeFlagsForInfer
:: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
xopt LangExt.GeneralizedNewtypeDeriving,
flip xopt_unset LangExt.GeneralizedNewtypeDeriving)
, ("-XTemplateHaskell", thOnLoc,
xopt LangExt.TemplateHaskell,
flip xopt_unset LangExt.TemplateHaskell)
]
unsafeFlagsForInfer = unsafeFlags
getOpts :: DynFlags
-> (DynFlags -> [a])
-> [a]
getOpts dflags opts = reverse (opts dflags)
getVerbFlags :: DynFlags -> [String]
getVerbFlags dflags
| verbosity dflags >= 4 = ["-v"]
| otherwise = []
setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,
setDynObjectSuf, setDynHiSuf,
setDylibInstallName,
setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, addOptl, addOptc, addOptcxx, addOptP,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags
setObjectDir f d = d { objectDir = Just f}
setHiDir f d = d { hiDir = Just f}
setHieDir f d = d { hieDir = Just f}
setStubDir f d = d { stubDir = Just f
, includePaths = addGlobalInclude (includePaths d) [f] }
setDumpDir f d = d { dumpDir = Just f}
setOutputDir f = setObjectDir f
. setHieDir f
. setHiDir f
. setStubDir f
. setDumpDir f
setDylibInstallName f d = d { dylibInstallName = Just f}
setObjectSuf f d = d { objectSuf = f}
setDynObjectSuf f d = d { dynObjectSuf = f}
setHiSuf f d = d { hiSuf = f}
setHieSuf f d = d { hieSuf = f}
setDynHiSuf f d = d { dynHiSuf = f}
setHcSuf f d = d { hcSuf = f}
setOutputFile f d = d { outputFile = f}
setDynOutputFile f d = d { dynOutputFile = f}
setOutputHi f d = d { outputHi = f}
setJsonLogAction :: DynFlags -> DynFlags
setJsonLogAction d = d { log_action = jsonLogAction }
mkHomeModule :: DynFlags -> ModuleName -> Module
mkHomeModule dflags = mkModule (homeUnit dflags)
isHomeModule :: DynFlags -> Module -> Bool
isHomeModule dflags m = moduleUnit m == homeUnit dflags
homeUnit :: DynFlags -> Unit
homeUnit dflags =
case (homeUnitInstanceOfId dflags, homeUnitInstantiations dflags) of
(Nothing,[]) -> RealUnit (Definite (homeUnitId dflags))
(Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
(Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with")
(Just u, is)
| all (isHoleModule . snd) is && indefUnit u == homeUnitId dflags
-> mkVirtUnit (updateIndefUnitId (unitState dflags) u) is
| otherwise
-> RealUnit (Definite (homeUnitId dflags))
parseUnitInsts :: String -> Instantiations
parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
[(r, "")] -> r
_ -> throwGhcException $ CmdLineError ("Can't parse -instantiated-with: " ++ str)
where parse = sepBy parseEntry (R.char ',')
parseEntry = do
n <- parseModuleName
_ <- R.char '='
m <- parseHoleyModule
return (n, m)
setUnitInstantiations :: String -> DynFlags -> DynFlags
setUnitInstantiations s d =
d { homeUnitInstantiations = parseUnitInsts s }
setUnitInstanceOf :: String -> DynFlags -> DynFlags
setUnitInstanceOf s d =
d { homeUnitInstanceOfId = Just (Indefinite (UnitId (fsLit s)) Nothing) }
addPluginModuleName :: String -> DynFlags -> DynFlags
addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
clearPluginModuleNames :: DynFlags -> DynFlags
clearPluginModuleNames d =
d { pluginModNames = []
, pluginModNameOpts = []
, cachedPlugins = [] }
addPluginModuleNameOption :: String -> DynFlags -> DynFlags
addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
where (m, rest) = break (== ':') optflag
option = case rest of
[] -> ""
(_:plug_opt) -> plug_opt
addFrontendPluginOption :: String -> DynFlags -> DynFlags
addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d }
parseDynLibLoaderMode f d =
case splitAt 8 f of
("deploy", "") -> d { dynLibLoader = Deployable }
("sysdep", "") -> d { dynLibLoader = SystemDependent }
_ -> throwGhcException (CmdLineError ("Unknown dynlib loader: " ++ f))
setDumpPrefixForce f d = d { dumpPrefixForce = f}
setPgmP f = alterToolSettings (\s -> s { toolSettings_pgm_P = (pgm, map Option args)})
where (pgm:args) = words f
addOptl f = alterToolSettings (\s -> s { toolSettings_opt_l = f : toolSettings_opt_l s})
addOptc f = alterToolSettings (\s -> s { toolSettings_opt_c = f : toolSettings_opt_c s})
addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s})
addOptP f = alterToolSettings $ \s -> s
{ toolSettings_opt_P = f : toolSettings_opt_P s
, toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s)
}
where
fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = f }
setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
addDepExcludeMod :: String -> DynFlags -> DynFlags
addDepExcludeMod m d
= d { depExcludeMods = mkModuleName m : depExcludeMods d }
addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = s : depSuffixes d }
addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}
addGhcVersionFile :: FilePath -> DynFlags -> DynFlags
addGhcVersionFile f d = d { ghcVersionFile = Just f }
addHaddockOpts f d = d { haddockOptions = Just f}
addGhciScript f d = d { ghciScripts = f : ghciScripts d}
setInteractivePrint f d = d { interactivePrint = Just f}
updOptLevel :: Int -> DynFlags -> DynFlags
updOptLevel n dfs
= dfs2{ optLevel = final_n }
where
final_n = max 0 (min 2 n)
dfs1 = foldr (flip gopt_unset) dfs remove_gopts
dfs2 = foldr (flip gopt_set) dfs1 extra_gopts
extra_gopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True
parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False
parseDynamicFlagsFull :: MonadIO m
=> [Flag (CmdLineP DynFlags)]
-> Bool
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
let ((leftover, errs, warns), dflags1)
= runCmdLine (processArgs activeFlags args) dflags0
unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $
map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs
let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
theWays = ways dflags2
unless (allowed_combination theWays) $ liftIO $
throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc (Set.toAscList theWays))))
let chooseOutput
| isJust (outputFile dflags2)
, not (isJust (dynOutputFile dflags2))
= return $ dflags2 { dynOutputFile = Just $ dynamicOutputFile dflags2 outFile }
| otherwise
= return dflags2
where
outFile = fromJust $ outputFile dflags2
dflags3 <- ifGeneratingDynamicToo dflags2 chooseOutput (return dflags2)
let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
when (enableTimeStats dflags4) $ liftIO enableTimingStats
case (ghcHeapSize dflags4) of
Just x -> liftIO (setHeapSize x)
_ -> return ()
liftIO $ setUnsafeGlobalDynFlags dflags4
let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)
return (dflags4, leftover, warns' ++ warns)
putLogMsg :: DynFlags -> WarnReason -> Severity -> SrcSpan -> MsgDoc -> IO ()
putLogMsg dflags = log_action dflags dflags
safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])
safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns)
where
(dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags
check_method (df, warns) (str,loc,test,fix)
| test df = (fix df, warns ++ safeFailure (loc df) str)
| otherwise = (df, warns)
safeFailure loc str
= [L loc $ str ++ " is not allowed in Safe Haskell; ignoring "
++ str]
safeFlagCheck cmdl dflags =
case (safeInferOn dflags) of
True | safeFlags -> (dflags', warn)
True -> (dflags' { safeInferred = False }, warn)
False -> (dflags', warn)
where
(dflags', warn)
| not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags
= (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)
| otherwise = (dflags, [])
pkgWarnMsg = [L (pkgTrustOnLoc dflags') $
"-fpackage-trust ignored;" ++
" must be specified with a Safe Haskell flag"]
safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer
allNonDeprecatedFlags :: [String]
allNonDeprecatedFlags = allFlagsDeps False
allFlagsDeps :: Bool -> [String]
allFlagsDeps keepDeprecated = [ '-':flagName flag
| (deprecated, flag) <- flagsAllDeps
, keepDeprecated || not (isDeprecated deprecated)]
where isDeprecated Deprecated = True
isDeprecated _ = False
flagsAll :: [Flag (CmdLineP DynFlags)]
flagsAll = map snd flagsAllDeps
flagsAllDeps :: [(Deprecation, Flag (CmdLineP DynFlags))]
flagsAllDeps = package_flags_deps ++ dynamic_flags_deps
flagsDynamic :: [Flag (CmdLineP DynFlags)]
flagsDynamic = map snd dynamic_flags_deps
flagsPackage :: [Flag (CmdLineP DynFlags)]
flagsPackage = map snd package_flags_deps
type FlagMaker m = String -> OptKind m -> Flag m
type DynFlagMaker = FlagMaker (CmdLineP DynFlags)
data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)
make_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags)
-> (Deprecation, Flag (CmdLineP DynFlags))
make_ord_flag fm name kind = (NotDeprecated, fm name kind)
make_dep_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags) -> String
-> (Deprecation, Flag (CmdLineP DynFlags))
make_dep_flag fm name kind message = (Deprecated,
fm name $ add_dep_message kind message)
add_dep_message :: OptKind (CmdLineP DynFlags) -> String
-> OptKind (CmdLineP DynFlags)
add_dep_message (NoArg f) message = NoArg $ f >> deprecate message
add_dep_message (HasArg f) message = HasArg $ \s -> f s >> deprecate message
add_dep_message (SepArg f) message = SepArg $ \s -> f s >> deprecate message
add_dep_message (Prefix f) message = Prefix $ \s -> f s >> deprecate message
add_dep_message (OptPrefix f) message =
OptPrefix $ \s -> f s >> deprecate message
add_dep_message (OptIntSuffix f) message =
OptIntSuffix $ \oi -> f oi >> deprecate message
add_dep_message (IntSuffix f) message =
IntSuffix $ \i -> f i >> deprecate message
add_dep_message (FloatSuffix f) message =
FloatSuffix $ \fl -> f fl >> deprecate message
add_dep_message (PassFlag f) message =
PassFlag $ \s -> f s >> deprecate message
add_dep_message (AnySuffix f) message =
AnySuffix $ \s -> f s >> deprecate message
dynamic_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]
dynamic_flags_deps = [
make_dep_flag defFlag "n" (NoArg $ return ())
"The -n flag is deprecated and no longer has any effect"
, make_ord_flag defFlag "cpp" (NoArg (setExtensionFlag LangExt.Cpp))
, make_ord_flag defFlag "F" (NoArg (setGeneralFlag Opt_Pp))
, (Deprecated, defFlag "#include"
(HasArg (\_s ->
deprecate ("-#include and INCLUDE pragmas are " ++
"deprecated: They no longer have any effect"))))
, make_ord_flag defFlag "v" (OptIntSuffix setVerbosity)
, make_ord_flag defGhcFlag "j" (OptIntSuffix
(\n -> case n of
Just n
| n > 0 -> upd (\d -> d { parMakeCount = Just n })
| otherwise -> addErr "Syntax: -j[n] where n > 0"
Nothing -> upd (\d -> d { parMakeCount = Nothing })))
, make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations)
, make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf)
, make_ord_flag defFlag "H" (HasArg (\s -> upd (\d ->
d { ghcHeapSize = Just $ fromIntegral (decodeSize s)})))
, make_ord_flag defFlag "Rghc-timing" (NoArg (upd (\d ->
d { enableTimeStats = True })))
, make_ord_flag defGhcFlag "prof" (NoArg (addWay WayProf))
, make_ord_flag defGhcFlag "eventlog" (NoArg (addWay WayEventLog))
, make_ord_flag defGhcFlag "debug" (NoArg (addWay WayDebug))
, make_ord_flag defGhcFlag "threaded" (NoArg (addWay WayThreaded))
, make_ord_flag defGhcFlag "ticky"
(NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug))
, make_ord_flag defGhcFlag "static" (NoArg removeWayDyn)
, make_ord_flag defGhcFlag "dynamic" (NoArg (addWay WayDyn))
, make_ord_flag defGhcFlag "rdynamic" $ noArg $
#if defined(linux_HOST_OS)
addOptl "-rdynamic"
#elif defined(mingw32_HOST_OS)
addOptl "-Wl,--export-all-symbols"
#else
id
#endif
, make_ord_flag defGhcFlag "relative-dynlib-paths"
(NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
, make_ord_flag defGhcFlag "copy-libs-when-linking"
(NoArg (setGeneralFlag Opt_SingleLibFolder))
, make_ord_flag defGhcFlag "pie" (NoArg (setGeneralFlag Opt_PICExecutable))
, make_ord_flag defGhcFlag "no-pie" (NoArg (unSetGeneralFlag Opt_PICExecutable))
, make_ord_flag defFlag "pgmlo"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo = (f,[]) }
, make_ord_flag defFlag "pgmlc"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc = (f,[]) }
, make_ord_flag defFlag "pgmlm"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm = (f,[]) }
, make_ord_flag defFlag "pgmi"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i = f }
, make_ord_flag defFlag "pgmL"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_L = f }
, make_ord_flag defFlag "pgmP"
(hasArg setPgmP)
, make_ord_flag defFlag "pgmF"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f }
, make_ord_flag defFlag "pgmc"
$ hasArg $ \f -> alterToolSettings $ \s -> s
{ toolSettings_pgm_c = f
,
toolSettings_ccSupportsNoPie = False
}
, make_ord_flag defFlag "pgmc-supports-no-pie"
$ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True }
, make_ord_flag defFlag "pgms"
(HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8"))
, make_ord_flag defFlag "pgma"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a = (f,[]) }
, make_ord_flag defFlag "pgml"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_l = (f,[]) }
, make_ord_flag defFlag "pgmdll"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) }
, make_ord_flag defFlag "pgmwindres"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f }
, make_ord_flag defFlag "pgmlibtool"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f }
, make_ord_flag defFlag "pgmar"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f }
, make_ord_flag defFlag "pgmotool"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f}
, make_ord_flag defFlag "pgminstall_name_tool"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f}
, make_ord_flag defFlag "pgmranlib"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f }
, make_ord_flag defFlag "optlm"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lm = f : toolSettings_opt_lm s }
, make_ord_flag defFlag "optlo"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo = f : toolSettings_opt_lo s }
, make_ord_flag defFlag "optlc"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc = f : toolSettings_opt_lc s }
, make_ord_flag defFlag "opti"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i = f : toolSettings_opt_i s }
, make_ord_flag defFlag "optL"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_L = f : toolSettings_opt_L s }
, make_ord_flag defFlag "optP"
(hasArg addOptP)
, make_ord_flag defFlag "optF"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_F = f : toolSettings_opt_F s }
, make_ord_flag defFlag "optc"
(hasArg addOptc)
, make_ord_flag defFlag "optcxx"
(hasArg addOptcxx)
, make_ord_flag defFlag "opta"
$ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_a = f : toolSettings_opt_a s }
, make_ord_flag defFlag "optl"
(hasArg addOptl)
, make_ord_flag defFlag "optwindres"
$ hasArg $ \f ->
alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s }
, make_ord_flag defGhcFlag "split-objs"
(NoArg $ addWarn "ignoring -split-objs")
, make_ord_flag defGhcFlag "split-sections"
(noArgM (\dflags -> do
if platformHasSubsectionsViaSymbols (targetPlatform dflags)
then do addWarn $
"-split-sections is not useful on this platform " ++
"since it always uses subsections via symbols. Ignoring."
return dflags
else return (gopt_set dflags Opt_SplitSections)))
, make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix)
, make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile)
, make_ord_flag defGhcFlag "include-cpp-deps"
(noArg (setDepIncludeCppDeps True))
, make_ord_flag defGhcFlag "include-pkg-deps"
(noArg (setDepIncludePkgDeps True))
, make_ord_flag defGhcFlag "exclude-module" (hasArg addDepExcludeMod)
, make_ord_flag defGhcFlag "no-link"
(noArg (\d -> d { ghcLink=NoLink }))
, make_ord_flag defGhcFlag "shared"
(noArg (\d -> d { ghcLink=LinkDynLib }))
, make_ord_flag defGhcFlag "staticlib"
(noArg (\d -> setGeneralFlag' Opt_LinkRts (d { ghcLink=LinkStaticLib })))
, make_ord_flag defGhcFlag "dynload" (hasArg parseDynLibLoaderMode)
, make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName)
, make_ord_flag defFlag "L" (Prefix addLibraryPath)
, make_ord_flag defFlag "l" (hasArg (addLdInputs . Option . ("-l" ++)))
, make_ord_flag defFlag "framework-path" (HasArg addFrameworkPath)
, make_ord_flag defFlag "framework" (hasArg addCmdlineFramework)
, make_ord_flag defGhcFlag "odir" (hasArg setObjectDir)
, make_ord_flag defGhcFlag "o" (sepArg (setOutputFile . Just))
, make_ord_flag defGhcFlag "dyno"
(sepArg (setDynOutputFile . Just))
, make_ord_flag defGhcFlag "ohi"
(hasArg (setOutputHi . Just ))
, make_ord_flag defGhcFlag "osuf" (hasArg setObjectSuf)
, make_ord_flag defGhcFlag "dynosuf" (hasArg setDynObjectSuf)
, make_ord_flag defGhcFlag "hcsuf" (hasArg setHcSuf)
, make_ord_flag defGhcFlag "hisuf" (hasArg setHiSuf)
, make_ord_flag defGhcFlag "hiesuf" (hasArg setHieSuf)
, make_ord_flag defGhcFlag "dynhisuf" (hasArg setDynHiSuf)
, make_ord_flag defGhcFlag "hidir" (hasArg setHiDir)
, make_ord_flag defGhcFlag "hiedir" (hasArg setHieDir)
, make_ord_flag defGhcFlag "tmpdir" (hasArg setTmpDir)
, make_ord_flag defGhcFlag "stubdir" (hasArg setStubDir)
, make_ord_flag defGhcFlag "dumpdir" (hasArg setDumpDir)
, make_ord_flag defGhcFlag "outputdir" (hasArg setOutputDir)
, make_ord_flag defGhcFlag "ddump-file-prefix"
(hasArg (setDumpPrefixForce . Just))
, make_ord_flag defGhcFlag "dynamic-too"
(NoArg (setGeneralFlag Opt_BuildDynamicToo))
, make_ord_flag defGhcFlag "keep-hc-file"
(NoArg (setGeneralFlag Opt_KeepHcFiles))
, make_ord_flag defGhcFlag "keep-hc-files"
(NoArg (setGeneralFlag Opt_KeepHcFiles))
, make_ord_flag defGhcFlag "keep-hscpp-file"
(NoArg (setGeneralFlag Opt_KeepHscppFiles))
, make_ord_flag defGhcFlag "keep-hscpp-files"
(NoArg (setGeneralFlag Opt_KeepHscppFiles))
, make_ord_flag defGhcFlag "keep-s-file"
(NoArg (setGeneralFlag Opt_KeepSFiles))
, make_ord_flag defGhcFlag "keep-s-files"
(NoArg (setGeneralFlag Opt_KeepSFiles))
, make_ord_flag defGhcFlag "keep-llvm-file"
(NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)
, make_ord_flag defGhcFlag "keep-llvm-files"
(NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)
, make_ord_flag defGhcFlag "keep-tmp-files"
(NoArg (setGeneralFlag Opt_KeepTmpFiles))
, make_ord_flag defGhcFlag "keep-hi-file"
(NoArg (setGeneralFlag Opt_KeepHiFiles))
, make_ord_flag defGhcFlag "no-keep-hi-file"
(NoArg (unSetGeneralFlag Opt_KeepHiFiles))
, make_ord_flag defGhcFlag "keep-hi-files"
(NoArg (setGeneralFlag Opt_KeepHiFiles))
, make_ord_flag defGhcFlag "no-keep-hi-files"
(NoArg (unSetGeneralFlag Opt_KeepHiFiles))
, make_ord_flag defGhcFlag "keep-o-file"
(NoArg (setGeneralFlag Opt_KeepOFiles))
, make_ord_flag defGhcFlag "no-keep-o-file"
(NoArg (unSetGeneralFlag Opt_KeepOFiles))
, make_ord_flag defGhcFlag "keep-o-files"
(NoArg (setGeneralFlag Opt_KeepOFiles))
, make_ord_flag defGhcFlag "no-keep-o-files"
(NoArg (unSetGeneralFlag Opt_KeepOFiles))
, make_ord_flag defGhcFlag "no-auto-link-packages"
(NoArg (unSetGeneralFlag Opt_AutoLinkPackages))
, make_ord_flag defGhcFlag "no-hs-main"
(NoArg (setGeneralFlag Opt_NoHsMain))
, make_ord_flag defGhcFlag "fno-state-hack"
(NoArg (setGeneralFlag Opt_G_NoStateHack))
, make_ord_flag defGhcFlag "fno-opt-coercion"
(NoArg (setGeneralFlag Opt_G_NoOptCoercion))
, make_ord_flag defGhcFlag "with-rtsopts"
(HasArg setRtsOpts)
, make_ord_flag defGhcFlag "rtsopts"
(NoArg (setRtsOptsEnabled RtsOptsAll))
, make_ord_flag defGhcFlag "rtsopts=all"
(NoArg (setRtsOptsEnabled RtsOptsAll))
, make_ord_flag defGhcFlag "rtsopts=some"
(NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
, make_ord_flag defGhcFlag "rtsopts=none"
(NoArg (setRtsOptsEnabled RtsOptsNone))
, make_ord_flag defGhcFlag "rtsopts=ignore"
(NoArg (setRtsOptsEnabled RtsOptsIgnore))
, make_ord_flag defGhcFlag "rtsopts=ignoreAll"
(NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))
, make_ord_flag defGhcFlag "no-rtsopts"
(NoArg (setRtsOptsEnabled RtsOptsNone))
, make_ord_flag defGhcFlag "no-rtsopts-suggestions"
(noArg (\d -> d {rtsOptsSuggestions = False}))
, make_ord_flag defGhcFlag "dhex-word-literals"
(NoArg (setGeneralFlag Opt_HexWordLiterals))
, make_ord_flag defGhcFlag "ghcversion-file" (hasArg addGhcVersionFile)
, make_ord_flag defGhcFlag "main-is" (SepArg setMainIs)
, make_ord_flag defGhcFlag "haddock" (NoArg (setGeneralFlag Opt_Haddock))
, make_ord_flag defGhcFlag "no-haddock" (NoArg (unSetGeneralFlag Opt_Haddock))
, make_ord_flag defGhcFlag "haddock-opts" (hasArg addHaddockOpts)
, make_ord_flag defGhcFlag "hpcdir" (SepArg setOptHpcDir)
, make_ord_flag defGhciFlag "ghci-script" (hasArg addGhciScript)
, make_ord_flag defGhciFlag "interactive-print" (hasArg setInteractivePrint)
, make_ord_flag defGhcFlag "ticky-allocd"
(NoArg (setGeneralFlag Opt_Ticky_Allocd))
, make_ord_flag defGhcFlag "ticky-LNE"
(NoArg (setGeneralFlag Opt_Ticky_LNE))
, make_ord_flag defGhcFlag "ticky-dyn-thunk"
(NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))
, make_dep_flag defGhcFlag "recomp"
(NoArg $ unSetGeneralFlag Opt_ForceRecomp)
"Use -fno-force-recomp instead"
, make_dep_flag defGhcFlag "no-recomp"
(NoArg $ setGeneralFlag Opt_ForceRecomp) "Use -fforce-recomp instead"
, make_ord_flag defFlag "fmax-errors"
(intSuffix (\n d -> d { maxErrors = Just (max 1 n) }))
, make_ord_flag defFlag "fno-max-errors"
(noArg (\d -> d { maxErrors = Nothing }))
, make_ord_flag defFlag "freverse-errors"
(noArg (\d -> d {reverseErrors = True} ))
, make_ord_flag defFlag "fno-reverse-errors"
(noArg (\d -> d {reverseErrors = False} ))
, make_ord_flag defFlag "D" (AnySuffix (upd . addOptP))
, make_ord_flag defFlag "U" (AnySuffix (upd . addOptP))
, make_ord_flag defFlag "I" (Prefix addIncludePath)
, make_ord_flag defFlag "i" (OptPrefix addImportPath)
, make_ord_flag defFlag "dppr-user-length" (intSuffix (\n d ->
d { pprUserLength = n }))
, make_ord_flag defFlag "dppr-cols" (intSuffix (\n d ->
d { pprCols = n }))
, make_ord_flag defFlag "fdiagnostics-color=auto"
(NoArg (upd (\d -> d { useColor = Auto })))
, make_ord_flag defFlag "fdiagnostics-color=always"
(NoArg (upd (\d -> d { useColor = Always })))
, make_ord_flag defFlag "fdiagnostics-color=never"
(NoArg (upd (\d -> d { useColor = Never })))
, make_ord_flag defGhcFlag "dsuppress-all"
(NoArg $ do setGeneralFlag Opt_SuppressCoercions
setGeneralFlag Opt_SuppressVarKinds
setGeneralFlag Opt_SuppressModulePrefixes
setGeneralFlag Opt_SuppressTypeApplications
setGeneralFlag Opt_SuppressIdInfo
setGeneralFlag Opt_SuppressTicks
setGeneralFlag Opt_SuppressStgExts
setGeneralFlag Opt_SuppressTypeSignatures
setGeneralFlag Opt_SuppressTimestamps)
, make_ord_flag defGhcFlag "dstg-stats"
(NoArg (setGeneralFlag Opt_StgStats))
, make_ord_flag defGhcFlag "ddump-cmm"
(setDumpFlag Opt_D_dump_cmm)
, make_ord_flag defGhcFlag "ddump-cmm-from-stg"
(setDumpFlag Opt_D_dump_cmm_from_stg)
, make_ord_flag defGhcFlag "ddump-cmm-raw"
(setDumpFlag Opt_D_dump_cmm_raw)
, make_ord_flag defGhcFlag "ddump-cmm-verbose"
(setDumpFlag Opt_D_dump_cmm_verbose)
, make_ord_flag defGhcFlag "ddump-cmm-verbose-by-proc"
(setDumpFlag Opt_D_dump_cmm_verbose_by_proc)
, make_ord_flag defGhcFlag "ddump-cmm-cfg"
(setDumpFlag Opt_D_dump_cmm_cfg)
, make_ord_flag defGhcFlag "ddump-cmm-cbe"
(setDumpFlag Opt_D_dump_cmm_cbe)
, make_ord_flag defGhcFlag "ddump-cmm-switch"
(setDumpFlag Opt_D_dump_cmm_switch)
, make_ord_flag defGhcFlag "ddump-cmm-proc"
(setDumpFlag Opt_D_dump_cmm_proc)
, make_ord_flag defGhcFlag "ddump-cmm-sp"
(setDumpFlag Opt_D_dump_cmm_sp)
, make_ord_flag defGhcFlag "ddump-cmm-sink"
(setDumpFlag Opt_D_dump_cmm_sink)
, make_ord_flag defGhcFlag "ddump-cmm-caf"
(setDumpFlag Opt_D_dump_cmm_caf)
, make_ord_flag defGhcFlag "ddump-cmm-procmap"
(setDumpFlag Opt_D_dump_cmm_procmap)
, make_ord_flag defGhcFlag "ddump-cmm-split"
(setDumpFlag Opt_D_dump_cmm_split)
, make_ord_flag defGhcFlag "ddump-cmm-info"
(setDumpFlag Opt_D_dump_cmm_info)
, make_ord_flag defGhcFlag "ddump-cmm-cps"
(setDumpFlag Opt_D_dump_cmm_cps)
, make_ord_flag defGhcFlag "ddump-cmm-opt"
(setDumpFlag Opt_D_dump_opt_cmm)
, make_ord_flag defGhcFlag "ddump-cfg-weights"
(setDumpFlag Opt_D_dump_cfg_weights)
, make_ord_flag defGhcFlag "ddump-core-stats"
(setDumpFlag Opt_D_dump_core_stats)
, make_ord_flag defGhcFlag "ddump-asm"
(setDumpFlag Opt_D_dump_asm)
, make_ord_flag defGhcFlag "ddump-asm-native"
(setDumpFlag Opt_D_dump_asm_native)
, make_ord_flag defGhcFlag "ddump-asm-liveness"
(setDumpFlag Opt_D_dump_asm_liveness)
, make_ord_flag defGhcFlag "ddump-asm-regalloc"
(setDumpFlag Opt_D_dump_asm_regalloc)
, make_ord_flag defGhcFlag "ddump-asm-conflicts"
(setDumpFlag Opt_D_dump_asm_conflicts)
, make_ord_flag defGhcFlag "ddump-asm-regalloc-stages"
(setDumpFlag Opt_D_dump_asm_regalloc_stages)
, make_ord_flag defGhcFlag "ddump-asm-stats"
(setDumpFlag Opt_D_dump_asm_stats)
, make_ord_flag defGhcFlag "ddump-asm-expanded"
(setDumpFlag Opt_D_dump_asm_expanded)
, make_ord_flag defGhcFlag "ddump-llvm"
(NoArg $ setObjTarget HscLlvm >> setDumpFlag' Opt_D_dump_llvm)
, make_ord_flag defGhcFlag "ddump-deriv"
(setDumpFlag Opt_D_dump_deriv)
, make_ord_flag defGhcFlag "ddump-ds"
(setDumpFlag Opt_D_dump_ds)
, make_ord_flag defGhcFlag "ddump-ds-preopt"
(setDumpFlag Opt_D_dump_ds_preopt)
, make_ord_flag defGhcFlag "ddump-foreign"
(setDumpFlag Opt_D_dump_foreign)
, make_ord_flag defGhcFlag "ddump-inlinings"
(setDumpFlag Opt_D_dump_inlinings)
, make_ord_flag defGhcFlag "ddump-rule-firings"
(setDumpFlag Opt_D_dump_rule_firings)
, make_ord_flag defGhcFlag "ddump-rule-rewrites"
(setDumpFlag Opt_D_dump_rule_rewrites)
, make_ord_flag defGhcFlag "ddump-simpl-trace"
(setDumpFlag Opt_D_dump_simpl_trace)
, make_ord_flag defGhcFlag "ddump-occur-anal"
(setDumpFlag Opt_D_dump_occur_anal)
, make_ord_flag defGhcFlag "ddump-parsed"
(setDumpFlag Opt_D_dump_parsed)
, make_ord_flag defGhcFlag "ddump-parsed-ast"
(setDumpFlag Opt_D_dump_parsed_ast)
, make_ord_flag defGhcFlag "ddump-rn"
(setDumpFlag Opt_D_dump_rn)
, make_ord_flag defGhcFlag "ddump-rn-ast"
(setDumpFlag Opt_D_dump_rn_ast)
, make_ord_flag defGhcFlag "ddump-simpl"
(setDumpFlag Opt_D_dump_simpl)
, make_ord_flag defGhcFlag "ddump-simpl-iterations"
(setDumpFlag Opt_D_dump_simpl_iterations)
, make_ord_flag defGhcFlag "ddump-spec"
(setDumpFlag Opt_D_dump_spec)
, make_ord_flag defGhcFlag "ddump-prep"
(setDumpFlag Opt_D_dump_prep)
, make_ord_flag defGhcFlag "ddump-stg"
(setDumpFlag Opt_D_dump_stg)
, make_ord_flag defGhcFlag "ddump-stg-unarised"
(setDumpFlag Opt_D_dump_stg_unarised)
, make_ord_flag defGhcFlag "ddump-stg-final"
(setDumpFlag Opt_D_dump_stg_final)
, make_ord_flag defGhcFlag "ddump-call-arity"
(setDumpFlag Opt_D_dump_call_arity)
, make_ord_flag defGhcFlag "ddump-exitify"
(setDumpFlag Opt_D_dump_exitify)
, make_ord_flag defGhcFlag "ddump-stranal"
(setDumpFlag Opt_D_dump_stranal)
, make_ord_flag defGhcFlag "ddump-str-signatures"
(setDumpFlag Opt_D_dump_str_signatures)
, make_ord_flag defGhcFlag "ddump-cpranal"
(setDumpFlag Opt_D_dump_cpranal)
, make_ord_flag defGhcFlag "ddump-cpr-signatures"
(setDumpFlag Opt_D_dump_cpr_signatures)
, make_ord_flag defGhcFlag "ddump-tc"
(setDumpFlag Opt_D_dump_tc)
, make_ord_flag defGhcFlag "ddump-tc-ast"
(setDumpFlag Opt_D_dump_tc_ast)
, make_ord_flag defGhcFlag "ddump-hie"
(setDumpFlag Opt_D_dump_hie)
, make_ord_flag defGhcFlag "ddump-types"
(setDumpFlag Opt_D_dump_types)
, make_ord_flag defGhcFlag "ddump-rules"
(setDumpFlag Opt_D_dump_rules)
, make_ord_flag defGhcFlag "ddump-cse"
(setDumpFlag Opt_D_dump_cse)
, make_ord_flag defGhcFlag "ddump-worker-wrapper"
(setDumpFlag Opt_D_dump_worker_wrapper)
, make_ord_flag defGhcFlag "ddump-rn-trace"
(setDumpFlag Opt_D_dump_rn_trace)
, make_ord_flag defGhcFlag "ddump-if-trace"
(setDumpFlag Opt_D_dump_if_trace)
, make_ord_flag defGhcFlag "ddump-cs-trace"
(setDumpFlag Opt_D_dump_cs_trace)
, make_ord_flag defGhcFlag "ddump-tc-trace"
(NoArg (do setDumpFlag' Opt_D_dump_tc_trace
setDumpFlag' Opt_D_dump_cs_trace))
, make_ord_flag defGhcFlag "ddump-ec-trace"
(setDumpFlag Opt_D_dump_ec_trace)
, make_ord_flag defGhcFlag "ddump-vt-trace"
(setDumpFlag Opt_D_dump_vt_trace)
, make_ord_flag defGhcFlag "ddump-splices"
(setDumpFlag Opt_D_dump_splices)
, make_ord_flag defGhcFlag "dth-dec-file"
(setDumpFlag Opt_D_th_dec_file)
, make_ord_flag defGhcFlag "ddump-rn-stats"
(setDumpFlag Opt_D_dump_rn_stats)
, make_ord_flag defGhcFlag "ddump-opt-cmm"
(setDumpFlag Opt_D_dump_opt_cmm)
, make_ord_flag defGhcFlag "ddump-simpl-stats"
(setDumpFlag Opt_D_dump_simpl_stats)
, make_ord_flag defGhcFlag "ddump-bcos"
(setDumpFlag Opt_D_dump_BCOs)
, make_ord_flag defGhcFlag "dsource-stats"
(setDumpFlag Opt_D_source_stats)
, make_ord_flag defGhcFlag "dverbose-core2core"
(NoArg $ setVerbosity (Just 2) >> setVerboseCore2Core)
, make_ord_flag defGhcFlag "dverbose-stg2stg"
(setDumpFlag Opt_D_verbose_stg2stg)
, make_ord_flag defGhcFlag "ddump-hi"
(setDumpFlag Opt_D_dump_hi)
, make_ord_flag defGhcFlag "ddump-minimal-imports"
(NoArg (setGeneralFlag Opt_D_dump_minimal_imports))
, make_ord_flag defGhcFlag "ddump-hpc"
(setDumpFlag Opt_D_dump_ticked)
, make_ord_flag defGhcFlag "ddump-ticked"
(setDumpFlag Opt_D_dump_ticked)
, make_ord_flag defGhcFlag "ddump-mod-cycles"
(setDumpFlag Opt_D_dump_mod_cycles)
, make_ord_flag defGhcFlag "ddump-mod-map"
(setDumpFlag Opt_D_dump_mod_map)
, make_ord_flag defGhcFlag "ddump-timings"
(setDumpFlag Opt_D_dump_timings)
, make_ord_flag defGhcFlag "ddump-view-pattern-commoning"
(setDumpFlag Opt_D_dump_view_pattern_commoning)
, make_ord_flag defGhcFlag "ddump-to-file"
(NoArg (setGeneralFlag Opt_DumpToFile))
, make_ord_flag defGhcFlag "ddump-hi-diffs"
(setDumpFlag Opt_D_dump_hi_diffs)
, make_ord_flag defGhcFlag "ddump-rtti"
(setDumpFlag Opt_D_dump_rtti)
, make_ord_flag defGhcFlag "dcore-lint"
(NoArg (setGeneralFlag Opt_DoCoreLinting))
, make_ord_flag defGhcFlag "dlinear-core-lint"
(NoArg (setGeneralFlag Opt_DoLinearCoreLinting))
, make_ord_flag defGhcFlag "dstg-lint"
(NoArg (setGeneralFlag Opt_DoStgLinting))
, make_ord_flag defGhcFlag "dcmm-lint"
(NoArg (setGeneralFlag Opt_DoCmmLinting))
, make_ord_flag defGhcFlag "dasm-lint"
(NoArg (setGeneralFlag Opt_DoAsmLinting))
, make_ord_flag defGhcFlag "dannot-lint"
(NoArg (setGeneralFlag Opt_DoAnnotationLinting))
, make_ord_flag defGhcFlag "dshow-passes"
(NoArg $ forceRecompile >> (setVerbosity $ Just 2))
, make_ord_flag defGhcFlag "dfaststring-stats"
(NoArg (setGeneralFlag Opt_D_faststring_stats))
, make_ord_flag defGhcFlag "dno-llvm-mangler"
(NoArg (setGeneralFlag Opt_NoLlvmMangler))
, make_ord_flag defGhcFlag "dno-typeable-binds"
(NoArg (setGeneralFlag Opt_NoTypeableBinds))
, make_ord_flag defGhcFlag "ddump-debug"
(setDumpFlag Opt_D_dump_debug)
, make_ord_flag defGhcFlag "ddump-json"
(noArg (flip dopt_set Opt_D_dump_json . setJsonLogAction ) )
, make_ord_flag defGhcFlag "dppr-debug"
(setDumpFlag Opt_D_ppr_debug)
, make_ord_flag defGhcFlag "ddebug-output"
(noArg (flip dopt_unset Opt_D_no_debug_output))
, make_ord_flag defGhcFlag "dno-debug-output"
(setDumpFlag Opt_D_no_debug_output)
, make_ord_flag defGhcFlag "msse" (noArg (\d ->
d { sseVersion = Just SSE1 }))
, make_ord_flag defGhcFlag "msse2" (noArg (\d ->
d { sseVersion = Just SSE2 }))
, make_ord_flag defGhcFlag "msse3" (noArg (\d ->
d { sseVersion = Just SSE3 }))
, make_ord_flag defGhcFlag "msse4" (noArg (\d ->
d { sseVersion = Just SSE4 }))
, make_ord_flag defGhcFlag "msse4.2" (noArg (\d ->
d { sseVersion = Just SSE42 }))
, make_ord_flag defGhcFlag "mbmi" (noArg (\d ->
d { bmiVersion = Just BMI1 }))
, make_ord_flag defGhcFlag "mbmi2" (noArg (\d ->
d { bmiVersion = Just BMI2 }))
, make_ord_flag defGhcFlag "mavx" (noArg (\d -> d { avx = True }))
, make_ord_flag defGhcFlag "mavx2" (noArg (\d -> d { avx2 = True }))
, make_ord_flag defGhcFlag "mavx512cd" (noArg (\d ->
d { avx512cd = True }))
, make_ord_flag defGhcFlag "mavx512er" (noArg (\d ->
d { avx512er = True }))
, make_ord_flag defGhcFlag "mavx512f" (noArg (\d -> d { avx512f = True }))
, make_ord_flag defGhcFlag "mavx512pf" (noArg (\d ->
d { avx512pf = True }))
, make_ord_flag defFlag "W" (NoArg (mapM_ setWarningFlag minusWOpts))
, make_ord_flag defFlag "Werror"
(NoArg (do { setGeneralFlag Opt_WarnIsError
; mapM_ setFatalWarningFlag minusWeverythingOpts }))
, make_ord_flag defFlag "Wwarn"
(NoArg (do { unSetGeneralFlag Opt_WarnIsError
; mapM_ unSetFatalWarningFlag minusWeverythingOpts }))
, make_dep_flag defFlag "Wnot" (NoArg (upd (\d ->
d {warningFlags = EnumSet.empty})))
"Use -w or -Wno-everything instead"
, make_ord_flag defFlag "w" (NoArg (upd (\d ->
d {warningFlags = EnumSet.empty})))
, make_ord_flag defFlag "Weverything" (NoArg (mapM_
setWarningFlag minusWeverythingOpts))
, make_ord_flag defFlag "Wno-everything"
(NoArg (upd (\d -> d {warningFlags = EnumSet.empty})))
, make_ord_flag defFlag "Wall" (NoArg (mapM_
setWarningFlag minusWallOpts))
, make_ord_flag defFlag "Wno-all" (NoArg (mapM_
unSetWarningFlag minusWallOpts))
, make_ord_flag defFlag "Wextra" (NoArg (mapM_
setWarningFlag minusWOpts))
, make_ord_flag defFlag "Wno-extra" (NoArg (mapM_
unSetWarningFlag minusWOpts))
, make_ord_flag defFlag "Wdefault" (NoArg (mapM_
setWarningFlag standardWarnings))
, make_ord_flag defFlag "Wno-default" (NoArg (mapM_
unSetWarningFlag standardWarnings))
, make_ord_flag defFlag "Wcompat" (NoArg (mapM_
setWarningFlag minusWcompatOpts))
, make_ord_flag defFlag "Wno-compat" (NoArg (mapM_
unSetWarningFlag minusWcompatOpts))
, make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)
, make_ord_flag defGhcFlag "fplugin-trustworthy"
(NoArg (setGeneralFlag Opt_PluginTrustworthy))
, make_ord_flag defGhcFlag "fplugin" (hasArg addPluginModuleName)
, make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames)
, make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption)
, make_dep_flag defGhcFlag "Onot" (noArgM $ setOptLevel 0 )
"Use -O0 instead"
, make_ord_flag defGhcFlag "O" (optIntSuffixM (\mb_n ->
setOptLevel (mb_n `orElse` 1)))
, make_ord_flag defFlag "fbinary-blob-threshold"
(intSuffix (\n d -> d { binBlobThreshold = fromIntegral n }))
, make_ord_flag defFlag "fmax-relevant-binds"
(intSuffix (\n d -> d { maxRelevantBinds = Just n }))
, make_ord_flag defFlag "fno-max-relevant-binds"
(noArg (\d -> d { maxRelevantBinds = Nothing }))
, make_ord_flag defFlag "fmax-valid-hole-fits"
(intSuffix (\n d -> d { maxValidHoleFits = Just n }))
, make_ord_flag defFlag "fno-max-valid-hole-fits"
(noArg (\d -> d { maxValidHoleFits = Nothing }))
, make_ord_flag defFlag "fmax-refinement-hole-fits"
(intSuffix (\n d -> d { maxRefHoleFits = Just n }))
, make_ord_flag defFlag "fno-max-refinement-hole-fits"
(noArg (\d -> d { maxRefHoleFits = Nothing }))
, make_ord_flag defFlag "frefinement-level-hole-fits"
(intSuffix (\n d -> d { refLevelHoleFits = Just n }))
, make_ord_flag defFlag "fno-refinement-level-hole-fits"
(noArg (\d -> d { refLevelHoleFits = Nothing }))
, make_dep_flag defGhcFlag "fllvm-pass-vectors-in-regs"
(noArg id)
"vectors registers are now passed in registers by default."
, make_ord_flag defFlag "fmax-uncovered-patterns"
(intSuffix (\n d -> d { maxUncoveredPatterns = n }))
, make_ord_flag defFlag "fmax-pmcheck-models"
(intSuffix (\n d -> d { maxPmCheckModels = n }))
, make_ord_flag defFlag "fsimplifier-phases"
(intSuffix (\n d -> d { simplPhases = n }))
, make_ord_flag defFlag "fmax-simplifier-iterations"
(intSuffix (\n d -> d { maxSimplIterations = n }))
, (Deprecated, defFlag "fmax-pmcheck-iterations"
(intSuffixM (\_ d ->
do { deprecate $ "use -fmax-pmcheck-models instead"
; return d })))
, make_ord_flag defFlag "fsimpl-tick-factor"
(intSuffix (\n d -> d { simplTickFactor = n }))
, make_ord_flag defFlag "fspec-constr-threshold"
(intSuffix (\n d -> d { specConstrThreshold = Just n }))
, make_ord_flag defFlag "fno-spec-constr-threshold"
(noArg (\d -> d { specConstrThreshold = Nothing }))
, make_ord_flag defFlag "fspec-constr-count"
(intSuffix (\n d -> d { specConstrCount = Just n }))
, make_ord_flag defFlag "fno-spec-constr-count"
(noArg (\d -> d { specConstrCount = Nothing }))
, make_ord_flag defFlag "fspec-constr-recursive"
(intSuffix (\n d -> d { specConstrRecursive = n }))
, make_ord_flag defFlag "fliberate-case-threshold"
(intSuffix (\n d -> d { liberateCaseThreshold = Just n }))
, make_ord_flag defFlag "fno-liberate-case-threshold"
(noArg (\d -> d { liberateCaseThreshold = Nothing }))
, make_ord_flag defFlag "drule-check"
(sepArg (\s d -> d { ruleCheck = Just s }))
, make_ord_flag defFlag "dinline-check"
(sepArg (\s d -> d { inlineCheck = Just s }))
, make_ord_flag defFlag "freduction-depth"
(intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n }))
, make_ord_flag defFlag "fconstraint-solver-iterations"
(intSuffix (\n d -> d { solverIterations = treatZeroAsInf n }))
, (Deprecated, defFlag "fcontext-stack"
(intSuffixM (\n d ->
do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"
; return $ d { reductionDepth = treatZeroAsInf n } })))
, (Deprecated, defFlag "ftype-function-depth"
(intSuffixM (\n d ->
do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"
; return $ d { reductionDepth = treatZeroAsInf n } })))
, make_ord_flag defFlag "fstrictness-before"
(intSuffix (\n d -> d { strictnessBefore = n : strictnessBefore d }))
, make_ord_flag defFlag "ffloat-lam-args"
(intSuffix (\n d -> d { floatLamArgs = Just n }))
, make_ord_flag defFlag "ffloat-all-lams"
(noArg (\d -> d { floatLamArgs = Nothing }))
, make_ord_flag defFlag "fstg-lift-lams-rec-args"
(intSuffix (\n d -> d { liftLamsRecArgs = Just n }))
, make_ord_flag defFlag "fstg-lift-lams-rec-args-any"
(noArg (\d -> d { liftLamsRecArgs = Nothing }))
, make_ord_flag defFlag "fstg-lift-lams-non-rec-args"
(intSuffix (\n d -> d { liftLamsRecArgs = Just n }))
, make_ord_flag defFlag "fstg-lift-lams-non-rec-args-any"
(noArg (\d -> d { liftLamsRecArgs = Nothing }))
, make_ord_flag defFlag "fstg-lift-lams-known"
(noArg (\d -> d { liftLamsKnown = True }))
, make_ord_flag defFlag "fno-stg-lift-lams-known"
(noArg (\d -> d { liftLamsKnown = False }))
, make_ord_flag defFlag "fproc-alignment"
(intSuffix (\n d -> d { cmmProcAlignment = Just n }))
, make_ord_flag defFlag "fblock-layout-weights"
(HasArg (\s ->
upd (\d -> d { cfgWeightInfo =
parseCfgWeights s (cfgWeightInfo d)})))
, make_ord_flag defFlag "fhistory-size"
(intSuffix (\n d -> d { historySize = n }))
, make_ord_flag defFlag "funfolding-creation-threshold"
(intSuffix (\n d -> d {ufCreationThreshold = n}))
, make_ord_flag defFlag "funfolding-use-threshold"
(intSuffix (\n d -> d {ufUseThreshold = n}))
, make_ord_flag defFlag "funfolding-fun-discount"
(intSuffix (\n d -> d {ufFunAppDiscount = n}))
, make_ord_flag defFlag "funfolding-dict-discount"
(intSuffix (\n d -> d {ufDictDiscount = n}))
, make_dep_flag defFlag "funfolding-keeness-factor"
(floatSuffix (\_ d -> d))
"-funfolding-keeness-factor is no longer respected as of GHC 8.12"
, make_ord_flag defFlag "fmax-worker-args"
(intSuffix (\n d -> d {maxWorkerArgs = n}))
, make_ord_flag defGhciFlag "fghci-hist-size"
(intSuffix (\n d -> d {ghciHistSize = n}))
, make_ord_flag defGhcFlag "fmax-inline-alloc-size"
(intSuffix (\n d -> d { maxInlineAllocSize = n }))
, make_ord_flag defGhcFlag "fmax-inline-memcpy-insns"
(intSuffix (\n d -> d { maxInlineMemcpyInsns = n }))
, make_ord_flag defGhcFlag "fmax-inline-memset-insns"
(intSuffix (\n d -> d { maxInlineMemsetInsns = n }))
, make_ord_flag defGhcFlag "dinitial-unique"
(intSuffix (\n d -> d { initialUnique = n }))
, make_ord_flag defGhcFlag "dunique-increment"
(intSuffix (\n d -> d { uniqueIncrement = n }))
, make_dep_flag defGhcFlag "auto-all"
(noArg (\d -> d { profAuto = ProfAutoAll } ))
"Use -fprof-auto instead"
, make_dep_flag defGhcFlag "no-auto-all"
(noArg (\d -> d { profAuto = NoProfAuto } ))
"Use -fno-prof-auto instead"
, make_dep_flag defGhcFlag "auto"
(noArg (\d -> d { profAuto = ProfAutoExports } ))
"Use -fprof-auto-exported instead"
, make_dep_flag defGhcFlag "no-auto"
(noArg (\d -> d { profAuto = NoProfAuto } ))
"Use -fno-prof-auto instead"
, make_dep_flag defGhcFlag "caf-all"
(NoArg (setGeneralFlag Opt_AutoSccsOnIndividualCafs))
"Use -fprof-cafs instead"
, make_dep_flag defGhcFlag "no-caf-all"
(NoArg (unSetGeneralFlag Opt_AutoSccsOnIndividualCafs))
"Use -fno-prof-cafs instead"
, make_ord_flag defGhcFlag "fprof-auto"
(noArg (\d -> d { profAuto = ProfAutoAll } ))
, make_ord_flag defGhcFlag "fprof-auto-top"
(noArg (\d -> d { profAuto = ProfAutoTop } ))
, make_ord_flag defGhcFlag "fprof-auto-exported"
(noArg (\d -> d { profAuto = ProfAutoExports } ))
, make_ord_flag defGhcFlag "fprof-auto-calls"
(noArg (\d -> d { profAuto = ProfAutoCalls } ))
, make_ord_flag defGhcFlag "fno-prof-auto"
(noArg (\d -> d { profAuto = NoProfAuto } ))
, make_ord_flag defGhcFlag "fasm" (NoArg (setObjTarget HscAsm))
, make_ord_flag defGhcFlag "fvia-c" (NoArg
(deprecate $ "The -fvia-c flag does nothing; " ++
"it will be removed in a future GHC release"))
, make_ord_flag defGhcFlag "fvia-C" (NoArg
(deprecate $ "The -fvia-C flag does nothing; " ++
"it will be removed in a future GHC release"))
, make_ord_flag defGhcFlag "fllvm" (NoArg (setObjTarget HscLlvm))
, make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d ->
d { ghcLink=NoLink }) >> setTarget HscNothing))
, make_ord_flag defFlag "fbyte-code" (NoArg ((upd $ \d ->
gopt_set d Opt_ByteCodeIfUnboxed) >> setTarget HscInterpreted))
, make_ord_flag defFlag "fobject-code" $ NoArg $ do
dflags <- liftEwM getCmdLineState
setTarget $ defaultObjectTarget dflags
, make_dep_flag defFlag "fglasgow-exts"
(NoArg enableGlasgowExts) "Use individual extensions instead"
, make_dep_flag defFlag "fno-glasgow-exts"
(NoArg disableGlasgowExts) "Use individual extensions instead"
, make_ord_flag defFlag "Wunused-binds" (NoArg enableUnusedBinds)
, make_ord_flag defFlag "Wno-unused-binds" (NoArg disableUnusedBinds)
, make_ord_flag defHiddenFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)
, make_ord_flag defHiddenFlag "fno-warn-unused-binds" (NoArg
disableUnusedBinds)
, make_ord_flag defFlag "fpackage-trust" (NoArg setPackageTrust)
, make_ord_flag defFlag "fno-safe-infer" (noArg (\d ->
d { safeInfer = False }))
, make_ord_flag defFlag "fno-safe-haskell" (NoArg (setSafeHaskell Sf_Ignore))
, make_ord_flag defGhcFlag "fPIC" (NoArg (setGeneralFlag Opt_PIC))
, make_ord_flag defGhcFlag "fno-PIC" (NoArg (unSetGeneralFlag Opt_PIC))
, make_ord_flag defGhcFlag "fPIE" (NoArg (setGeneralFlag Opt_PIE))
, make_ord_flag defGhcFlag "fno-PIE" (NoArg (unSetGeneralFlag Opt_PIE))
, make_ord_flag defGhcFlag "g" (OptIntSuffix setDebugLevel)
]
++ map (mkFlag turnOn "" setGeneralFlag ) negatableFlagsDeps
++ map (mkFlag turnOff "no-" unSetGeneralFlag ) negatableFlagsDeps
++ map (mkFlag turnOn "d" setGeneralFlag ) dFlagsDeps
++ map (mkFlag turnOff "dno-" unSetGeneralFlag ) dFlagsDeps
++ map (mkFlag turnOn "f" setGeneralFlag ) fFlagsDeps
++ map (mkFlag turnOff "fno-" unSetGeneralFlag ) fFlagsDeps
++ map (mkFlag turnOn "W" setWarningFlag ) wWarningFlagsDeps
++ map (mkFlag turnOff "Wno-" unSetWarningFlag ) wWarningFlagsDeps
++ map (mkFlag turnOn "Werror=" setWErrorFlag ) wWarningFlagsDeps
++ map (mkFlag turnOn "Wwarn=" unSetFatalWarningFlag )
wWarningFlagsDeps
++ map (mkFlag turnOn "Wno-error=" unSetFatalWarningFlag )
wWarningFlagsDeps
++ map (mkFlag turnOn "fwarn-" setWarningFlag . hideFlag)
wWarningFlagsDeps
++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag)
wWarningFlagsDeps
++ [ (NotDeprecated, unrecognisedWarning "W"),
(Deprecated, unrecognisedWarning "fwarn-"),
(Deprecated, unrecognisedWarning "fno-warn-") ]
++ [ make_ord_flag defFlag "Werror=compat"
(NoArg (mapM_ setWErrorFlag minusWcompatOpts))
, make_ord_flag defFlag "Wno-error=compat"
(NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts))
, make_ord_flag defFlag "Wwarn=compat"
(NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ]
++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps
++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps
++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps
++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlagsDeps
++ map (mkFlag turnOn "X" setLanguage ) languageFlagsDeps
++ map (mkFlag turnOn "X" setSafeHaskell ) safeHaskellFlagsDeps
++ [ make_dep_flag defFlag "XGenerics"
(NoArg $ return ())
("it does nothing; look into -XDefaultSignatures " ++
"and -XDeriveGeneric for generic programming support.")
, make_dep_flag defFlag "XNoGenerics"
(NoArg $ return ())
("it does nothing; look into -XDefaultSignatures and " ++
"-XDeriveGeneric for generic programming support.") ]
unrecognisedWarning :: String -> Flag (CmdLineP DynFlags)
unrecognisedWarning prefix = defHiddenFlag prefix (Prefix action)
where
action :: String -> EwM (CmdLineP DynFlags) ()
action flag = do
f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState
when f $ addFlagWarn Cmd.ReasonUnrecognisedFlag $
"unrecognised warning flag: -" ++ prefix ++ flag
package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]
package_flags_deps = [
make_ord_flag defFlag "package-db"
(HasArg (addPkgDbRef . PkgDbPath))
, make_ord_flag defFlag "clear-package-db" (NoArg clearPkgDb)
, make_ord_flag defFlag "no-global-package-db" (NoArg removeGlobalPkgDb)
, make_ord_flag defFlag "no-user-package-db" (NoArg removeUserPkgDb)
, make_ord_flag defFlag "global-package-db"
(NoArg (addPkgDbRef GlobalPkgDb))
, make_ord_flag defFlag "user-package-db"
(NoArg (addPkgDbRef UserPkgDb))
, make_dep_flag defFlag "package-conf"
(HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead"
, make_dep_flag defFlag "no-user-package-conf"
(NoArg removeUserPkgDb) "Use -no-user-package-db instead"
, make_ord_flag defGhcFlag "package-name" (HasArg $ \name -> do
upd (setUnitId name))
, make_ord_flag defGhcFlag "this-unit-id" (hasArg setUnitId)
, make_ord_flag defFlag "package" (HasArg exposePackage)
, make_ord_flag defFlag "plugin-package-id" (HasArg exposePluginPackageId)
, make_ord_flag defFlag "plugin-package" (HasArg exposePluginPackage)
, make_ord_flag defFlag "package-id" (HasArg exposePackageId)
, make_ord_flag defFlag "hide-package" (HasArg hidePackage)
, make_ord_flag defFlag "hide-all-packages"
(NoArg (setGeneralFlag Opt_HideAllPackages))
, make_ord_flag defFlag "hide-all-plugin-packages"
(NoArg (setGeneralFlag Opt_HideAllPluginPackages))
, make_ord_flag defFlag "package-env" (HasArg setPackageEnv)
, make_ord_flag defFlag "ignore-package" (HasArg ignorePackage)
, make_dep_flag defFlag "syslib" (HasArg exposePackage) "Use -package instead"
, make_ord_flag defFlag "distrust-all-packages"
(NoArg (setGeneralFlag Opt_DistrustAllPackages))
, make_ord_flag defFlag "trust" (HasArg trustPackage)
, make_ord_flag defFlag "distrust" (HasArg distrustPackage)
]
where
setPackageEnv env = upd $ \s -> s { packageEnv = Just env }
flagsForCompletion :: Bool -> [String]
flagsForCompletion isInteractive
= [ '-':flagName flag
| flag <- flagsAll
, modeFilter (flagGhcMode flag)
]
where
modeFilter AllModes = True
modeFilter OnlyGhci = isInteractive
modeFilter OnlyGhc = not isInteractive
modeFilter HiddenFlag = False
type TurnOnFlag = Bool
turnOn :: TurnOnFlag; turnOn = True
turnOff :: TurnOnFlag; turnOff = False
data FlagSpec flag
= FlagSpec
{ flagSpecName :: String
, flagSpecFlag :: flag
, flagSpecAction :: (TurnOnFlag -> DynP ())
, flagSpecGhcMode :: GhcFlagMode
}
flagSpec :: String -> flag -> (Deprecation, FlagSpec flag)
flagSpec name flag = flagSpec' name flag nop
flagSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
-> (Deprecation, FlagSpec flag)
flagSpec' name flag act = (NotDeprecated, FlagSpec name flag act AllModes)
depFlagSpecOp :: String -> flag -> (TurnOnFlag -> DynP ()) -> String
-> (Deprecation, FlagSpec flag)
depFlagSpecOp name flag act dep =
(Deprecated, snd (flagSpec' name flag (\f -> act f >> deprecate dep)))
depFlagSpec :: String -> flag -> String
-> (Deprecation, FlagSpec flag)
depFlagSpec name flag dep = depFlagSpecOp name flag nop dep
depFlagSpecOp' :: String
-> flag
-> (TurnOnFlag -> DynP ())
-> (TurnOnFlag -> String)
-> (Deprecation, FlagSpec flag)
depFlagSpecOp' name flag act dep =
(Deprecated, FlagSpec name flag (\f -> act f >> (deprecate $ dep f))
AllModes)
depFlagSpec' :: String
-> flag
-> (TurnOnFlag -> String)
-> (Deprecation, FlagSpec flag)
depFlagSpec' name flag dep = depFlagSpecOp' name flag nop dep
depFlagSpecCond :: String
-> flag
-> (TurnOnFlag -> Bool)
-> String
-> (Deprecation, FlagSpec flag)
depFlagSpecCond name flag cond dep =
(Deprecated, FlagSpec name flag (\f -> when (cond f) $ deprecate dep)
AllModes)
flagGhciSpec :: String -> flag -> (Deprecation, FlagSpec flag)
flagGhciSpec name flag = flagGhciSpec' name flag nop
flagGhciSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
-> (Deprecation, FlagSpec flag)
flagGhciSpec' name flag act = (NotDeprecated, FlagSpec name flag act OnlyGhci)
flagHiddenSpec :: String -> flag -> (Deprecation, FlagSpec flag)
flagHiddenSpec name flag = flagHiddenSpec' name flag nop
flagHiddenSpec' :: String -> flag -> (TurnOnFlag -> DynP ())
-> (Deprecation, FlagSpec flag)
flagHiddenSpec' name flag act = (NotDeprecated, FlagSpec name flag act
HiddenFlag)
hideFlag :: (Deprecation, FlagSpec a) -> (Deprecation, FlagSpec a)
hideFlag (dep, fs) = (dep, fs { flagSpecGhcMode = HiddenFlag })
mkFlag :: TurnOnFlag
-> String
-> (flag -> DynP ())
-> (Deprecation, FlagSpec flag)
-> (Deprecation, Flag (CmdLineP DynFlags))
mkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode))
= (dep,
Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode)
deprecatedForExtension :: String -> TurnOnFlag -> String
deprecatedForExtension lang turn_on
= "use -X" ++ flag ++
" or pragma {-# LANGUAGE " ++ flag ++ " #-} instead"
where
flag | turn_on = lang
| otherwise = "No" ++ lang
useInstead :: String -> String -> TurnOnFlag -> String
useInstead prefix flag turn_on
= "Use " ++ prefix ++ no ++ flag ++ " instead"
where
no = if turn_on then "" else "no-"
nop :: TurnOnFlag -> DynP ()
nop _ = return ()
flagSpecOf :: WarningFlag -> Maybe (FlagSpec WarningFlag)
flagSpecOf flag = listToMaybe $ filter check wWarningFlags
where
check fs = flagSpecFlag fs == flag
wWarningFlags :: [FlagSpec WarningFlag]
wWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps)
wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)]
wWarningFlagsDeps = [
flagSpec "alternative-layout-rule-transitional"
Opt_WarnAlternativeLayoutRuleTransitional,
depFlagSpec "auto-orphans" Opt_WarnAutoOrphans
"it has no effect",
flagSpec "cpp-undef" Opt_WarnCPPUndef,
flagSpec "unbanged-strict-patterns" Opt_WarnUnbangedStrictPatterns,
flagSpec "deferred-type-errors" Opt_WarnDeferredTypeErrors,
flagSpec "deferred-out-of-scope-variables"
Opt_WarnDeferredOutOfScopeVariables,
flagSpec "deprecations" Opt_WarnWarningsDeprecations,
flagSpec "deprecated-flags" Opt_WarnDeprecatedFlags,
flagSpec "deriving-defaults" Opt_WarnDerivingDefaults,
flagSpec "deriving-typeable" Opt_WarnDerivingTypeable,
flagSpec "dodgy-exports" Opt_WarnDodgyExports,
flagSpec "dodgy-foreign-imports" Opt_WarnDodgyForeignImports,
flagSpec "dodgy-imports" Opt_WarnDodgyImports,
flagSpec "empty-enumerations" Opt_WarnEmptyEnumerations,
depFlagSpec "duplicate-constraints" Opt_WarnDuplicateConstraints
"it is subsumed by -Wredundant-constraints",
flagSpec "redundant-constraints" Opt_WarnRedundantConstraints,
flagSpec "duplicate-exports" Opt_WarnDuplicateExports,
depFlagSpec "hi-shadowing" Opt_WarnHiShadows
"it is not used, and was never implemented",
flagSpec "inaccessible-code" Opt_WarnInaccessibleCode,
flagSpec "implicit-prelude" Opt_WarnImplicitPrelude,
depFlagSpec "implicit-kind-vars" Opt_WarnImplicitKindVars
"it is now an error",
flagSpec "incomplete-patterns" Opt_WarnIncompletePatterns,
flagSpec "incomplete-record-updates" Opt_WarnIncompletePatternsRecUpd,
flagSpec "incomplete-uni-patterns" Opt_WarnIncompleteUniPatterns,
flagSpec "inline-rule-shadowing" Opt_WarnInlineRuleShadowing,
flagSpec "identities" Opt_WarnIdentities,
flagSpec "missing-fields" Opt_WarnMissingFields,
flagSpec "missing-import-lists" Opt_WarnMissingImportList,
flagSpec "missing-export-lists" Opt_WarnMissingExportList,
depFlagSpec "missing-local-sigs" Opt_WarnMissingLocalSignatures
"it is replaced by -Wmissing-local-signatures",
flagSpec "missing-local-signatures" Opt_WarnMissingLocalSignatures,
flagSpec "missing-methods" Opt_WarnMissingMethods,
flagSpec "missing-monadfail-instances" Opt_WarnMissingMonadFailInstances,
flagSpec "semigroup" Opt_WarnSemigroup,
flagSpec "missing-signatures" Opt_WarnMissingSignatures,
depFlagSpec "missing-exported-sigs" Opt_WarnMissingExportedSignatures
"it is replaced by -Wmissing-exported-signatures",
flagSpec "missing-exported-signatures" Opt_WarnMissingExportedSignatures,
flagSpec "monomorphism-restriction" Opt_WarnMonomorphism,
flagSpec "name-shadowing" Opt_WarnNameShadowing,
flagSpec "noncanonical-monad-instances"
Opt_WarnNonCanonicalMonadInstances,
depFlagSpec "noncanonical-monadfail-instances"
Opt_WarnNonCanonicalMonadInstances
"fail is no longer a method of Monad",
flagSpec "noncanonical-monoid-instances"
Opt_WarnNonCanonicalMonoidInstances,
flagSpec "orphans" Opt_WarnOrphans,
flagSpec "overflowed-literals" Opt_WarnOverflowedLiterals,
flagSpec "overlapping-patterns" Opt_WarnOverlappingPatterns,
flagSpec "missed-specialisations" Opt_WarnMissedSpecs,
flagSpec "missed-specializations" Opt_WarnMissedSpecs,
flagSpec "all-missed-specialisations" Opt_WarnAllMissedSpecs,
flagSpec "all-missed-specializations" Opt_WarnAllMissedSpecs,
flagSpec' "safe" Opt_WarnSafe setWarnSafe,
flagSpec "trustworthy-safe" Opt_WarnTrustworthySafe,
flagSpec "inferred-safe-imports" Opt_WarnInferredSafeImports,
flagSpec "missing-safe-haskell-mode" Opt_WarnMissingSafeHaskellMode,
flagSpec "tabs" Opt_WarnTabs,
flagSpec "type-defaults" Opt_WarnTypeDefaults,
flagSpec "typed-holes" Opt_WarnTypedHoles,
flagSpec "partial-type-signatures" Opt_WarnPartialTypeSignatures,
flagSpec "unrecognised-pragmas" Opt_WarnUnrecognisedPragmas,
flagSpec' "unsafe" Opt_WarnUnsafe setWarnUnsafe,
flagSpec "unsupported-calling-conventions"
Opt_WarnUnsupportedCallingConventions,
flagSpec "unsupported-llvm-version" Opt_WarnUnsupportedLlvmVersion,
flagSpec "missed-extra-shared-lib" Opt_WarnMissedExtraSharedLib,
flagSpec "unticked-promoted-constructors"
Opt_WarnUntickedPromotedConstructors,
flagSpec "unused-do-bind" Opt_WarnUnusedDoBind,
flagSpec "unused-foralls" Opt_WarnUnusedForalls,
flagSpec "unused-imports" Opt_WarnUnusedImports,
flagSpec "unused-local-binds" Opt_WarnUnusedLocalBinds,
flagSpec "unused-matches" Opt_WarnUnusedMatches,
flagSpec "unused-pattern-binds" Opt_WarnUnusedPatternBinds,
flagSpec "unused-top-binds" Opt_WarnUnusedTopBinds,
flagSpec "unused-type-patterns" Opt_WarnUnusedTypePatterns,
flagSpec "unused-record-wildcards" Opt_WarnUnusedRecordWildcards,
flagSpec "redundant-record-wildcards" Opt_WarnRedundantRecordWildcards,
flagSpec "warnings-deprecations" Opt_WarnWarningsDeprecations,
flagSpec "wrong-do-bind" Opt_WarnWrongDoBind,
flagSpec "missing-pattern-synonym-signatures"
Opt_WarnMissingPatternSynonymSignatures,
flagSpec "missing-deriving-strategies" Opt_WarnMissingDerivingStrategies,
flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
flagSpec "missing-home-modules" Opt_WarnMissingHomeModules,
flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags,
flagSpec "star-binder" Opt_WarnStarBinder,
flagSpec "star-is-type" Opt_WarnStarIsType,
depFlagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang
"bang patterns can no longer be written with a space",
flagSpec "partial-fields" Opt_WarnPartialFields,
flagSpec "prepositive-qualified-module"
Opt_WarnPrepositiveQualifiedModule,
flagSpec "unused-packages" Opt_WarnUnusedPackages,
flagSpec "compat-unqualified-imports" Opt_WarnCompatUnqualifiedImports,
flagSpec "invalid-haddock" Opt_WarnInvalidHaddock
]
negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
negatableFlagsDeps = [
flagGhciSpec "ignore-dot-ghci" Opt_IgnoreDotGhci ]
dFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
dFlagsDeps = [
flagSpec "ppr-case-as-let" Opt_PprCaseAsLet,
depFlagSpec' "ppr-ticks" Opt_PprShowTicks
(\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)),
flagSpec "suppress-ticks" Opt_SuppressTicks,
depFlagSpec' "suppress-stg-free-vars" Opt_SuppressStgExts
(useInstead "-d" "suppress-stg-exts"),
flagSpec "suppress-stg-exts" Opt_SuppressStgExts,
flagSpec "suppress-coercions" Opt_SuppressCoercions,
flagSpec "suppress-idinfo" Opt_SuppressIdInfo,
flagSpec "suppress-unfoldings" Opt_SuppressUnfoldings,
flagSpec "suppress-module-prefixes" Opt_SuppressModulePrefixes,
flagSpec "suppress-timestamps" Opt_SuppressTimestamps,
flagSpec "suppress-type-applications" Opt_SuppressTypeApplications,
flagSpec "suppress-type-signatures" Opt_SuppressTypeSignatures,
flagSpec "suppress-uniques" Opt_SuppressUniques,
flagSpec "suppress-var-kinds" Opt_SuppressVarKinds
]
fFlags :: [FlagSpec GeneralFlag]
fFlags = map snd fFlagsDeps
fFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
fFlagsDeps = [
flagSpec "asm-shortcutting" Opt_AsmShortcutting,
flagGhciSpec "break-on-error" Opt_BreakOnError,
flagGhciSpec "break-on-exception" Opt_BreakOnException,
flagSpec "building-cabal-package" Opt_BuildingCabalPackage,
flagSpec "call-arity" Opt_CallArity,
flagSpec "exitification" Opt_Exitification,
flagSpec "case-merge" Opt_CaseMerge,
flagSpec "case-folding" Opt_CaseFolding,
flagSpec "cmm-elim-common-blocks" Opt_CmmElimCommonBlocks,
flagSpec "cmm-sink" Opt_CmmSink,
flagSpec "cmm-static-pred" Opt_CmmStaticPred,
flagSpec "cse" Opt_CSE,
flagSpec "stg-cse" Opt_StgCSE,
flagSpec "stg-lift-lams" Opt_StgLiftLams,
flagSpec "cpr-anal" Opt_CprAnal,
flagSpec "defer-diagnostics" Opt_DeferDiagnostics,
flagSpec "defer-type-errors" Opt_DeferTypeErrors,
flagSpec "defer-typed-holes" Opt_DeferTypedHoles,
flagSpec "defer-out-of-scope-variables" Opt_DeferOutOfScopeVariables,
flagSpec "diagnostics-show-caret" Opt_DiagnosticsShowCaret,
flagSpec "dicts-cheap" Opt_DictsCheap,
flagSpec "dicts-strict" Opt_DictsStrict,
flagSpec "dmd-tx-dict-sel" Opt_DmdTxDictSel,
flagSpec "do-eta-reduction" Opt_DoEtaReduction,
flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion,
flagSpec "eager-blackholing" Opt_EagerBlackHoling,
flagSpec "embed-manifest" Opt_EmbedManifest,
flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules,
flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings,
flagSpec "error-spans" Opt_ErrorSpans,
flagSpec "excess-precision" Opt_ExcessPrecision,
flagSpec "expose-all-unfoldings" Opt_ExposeAllUnfoldings,
flagSpec "external-dynamic-refs" Opt_ExternalDynamicRefs,
flagSpec "external-interpreter" Opt_ExternalInterpreter,
flagSpec "flat-cache" Opt_FlatCache,
flagSpec "float-in" Opt_FloatIn,
flagSpec "force-recomp" Opt_ForceRecomp,
flagSpec "ignore-optim-changes" Opt_IgnoreOptimChanges,
flagSpec "ignore-hpc-changes" Opt_IgnoreHpcChanges,
flagSpec "full-laziness" Opt_FullLaziness,
flagSpec "fun-to-thunk" Opt_FunToThunk,
flagSpec "gen-manifest" Opt_GenManifest,
flagSpec "ghci-history" Opt_GhciHistory,
flagSpec "ghci-leak-check" Opt_GhciLeakCheck,
flagSpec "validate-ide-info" Opt_ValidateHie,
flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory,
flagGhciSpec "no-it" Opt_NoIt,
flagSpec "ghci-sandbox" Opt_GhciSandbox,
flagSpec "helpful-errors" Opt_HelpfulErrors,
flagSpec "hpc" Opt_Hpc,
flagSpec "ignore-asserts" Opt_IgnoreAsserts,
flagSpec "ignore-interface-pragmas" Opt_IgnoreInterfacePragmas,
flagGhciSpec "implicit-import-qualified" Opt_ImplicitImportQualified,
flagSpec "irrefutable-tuples" Opt_IrrefutableTuples,
flagSpec "keep-going" Opt_KeepGoing,
flagSpec "late-dmd-anal" Opt_LateDmdAnal,
flagSpec "late-specialise" Opt_LateSpecialise,
flagSpec "liberate-case" Opt_LiberateCase,
flagHiddenSpec "llvm-tbaa" Opt_LlvmTBAA,
flagHiddenSpec "llvm-fill-undef-with-garbage" Opt_LlvmFillUndefWithGarbage,
flagSpec "loopification" Opt_Loopification,
flagSpec "block-layout-cfg" Opt_CfgBlocklayout,
flagSpec "block-layout-weightless" Opt_WeightlessBlocklayout,
flagSpec "omit-interface-pragmas" Opt_OmitInterfacePragmas,
flagSpec "omit-yields" Opt_OmitYields,
flagSpec "optimal-applicative-do" Opt_OptimalApplicativeDo,
flagSpec "pedantic-bottoms" Opt_PedanticBottoms,
flagSpec "pre-inlining" Opt_SimplPreInlining,
flagGhciSpec "print-bind-contents" Opt_PrintBindContents,
flagGhciSpec "print-bind-result" Opt_PrintBindResult,
flagGhciSpec "print-evld-with-show" Opt_PrintEvldWithShow,
flagSpec "print-explicit-foralls" Opt_PrintExplicitForalls,
flagSpec "print-explicit-kinds" Opt_PrintExplicitKinds,
flagSpec "print-explicit-coercions" Opt_PrintExplicitCoercions,
flagSpec "print-explicit-runtime-reps" Opt_PrintExplicitRuntimeReps,
flagSpec "print-equality-relations" Opt_PrintEqualityRelations,
flagSpec "print-axiom-incomps" Opt_PrintAxiomIncomps,
flagSpec "print-unicode-syntax" Opt_PrintUnicodeSyntax,
flagSpec "print-expanded-synonyms" Opt_PrintExpandedSynonyms,
flagSpec "print-potential-instances" Opt_PrintPotentialInstances,
flagSpec "print-typechecker-elaboration" Opt_PrintTypecheckerElaboration,
flagSpec "prof-cafs" Opt_AutoSccsOnIndividualCafs,
flagSpec "prof-count-entries" Opt_ProfCountEntries,
flagSpec "regs-graph" Opt_RegsGraph,
flagSpec "regs-iterative" Opt_RegsIterative,
depFlagSpec' "rewrite-rules" Opt_EnableRewriteRules
(useInstead "-f" "enable-rewrite-rules"),
flagSpec "shared-implib" Opt_SharedImplib,
flagSpec "spec-constr" Opt_SpecConstr,
flagSpec "spec-constr-keen" Opt_SpecConstrKeen,
flagSpec "specialise" Opt_Specialise,
flagSpec "specialize" Opt_Specialise,
flagSpec "specialise-aggressively" Opt_SpecialiseAggressively,
flagSpec "specialize-aggressively" Opt_SpecialiseAggressively,
flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise,
flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise,
flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation,
flagSpec "strictness" Opt_Strictness,
flagSpec "use-rpaths" Opt_RPath,
flagSpec "write-interface" Opt_WriteInterface,
flagSpec "write-ide-info" Opt_WriteHie,
flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields,
flagSpec "unbox-strict-fields" Opt_UnboxStrictFields,
flagSpec "version-macros" Opt_VersionMacros,
flagSpec "worker-wrapper" Opt_WorkerWrapper,
flagSpec "solve-constant-dicts" Opt_SolveConstantDicts,
flagSpec "catch-bottoms" Opt_CatchBottoms,
flagSpec "alignment-sanitisation" Opt_AlignmentSanitisation,
flagSpec "num-constant-folding" Opt_NumConstantFolding,
flagSpec "show-warning-groups" Opt_ShowWarnGroups,
flagSpec "hide-source-paths" Opt_HideSourcePaths,
flagSpec "show-loaded-modules" Opt_ShowLoadedModules,
flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs,
flagSpec "keep-cafs" Opt_KeepCAFs,
flagSpec "link-rts" Opt_LinkRts
]
++ fHoleFlags
fHoleFlags :: [(Deprecation, FlagSpec GeneralFlag)]
fHoleFlags = [
flagSpec "show-hole-constraints" Opt_ShowHoleConstraints,
depFlagSpec' "show-valid-substitutions" Opt_ShowValidHoleFits
(useInstead "-f" "show-valid-hole-fits"),
flagSpec "show-valid-hole-fits" Opt_ShowValidHoleFits,
flagSpec "sort-valid-hole-fits" Opt_SortValidHoleFits,
flagSpec "sort-by-size-hole-fits" Opt_SortBySizeHoleFits,
flagSpec "sort-by-subsumption-hole-fits" Opt_SortBySubsumHoleFits,
flagSpec "abstract-refinement-hole-fits" Opt_AbstractRefHoleFits,
flagSpec "show-hole-matches-of-hole-fits" Opt_ShowMatchesOfHoleFits,
flagSpec "show-provenance-of-hole-fits" Opt_ShowProvOfHoleFits,
flagSpec "show-type-of-hole-fits" Opt_ShowTypeOfHoleFits,
flagSpec "show-type-app-of-hole-fits" Opt_ShowTypeAppOfHoleFits,
flagSpec "show-type-app-vars-of-hole-fits" Opt_ShowTypeAppVarsOfHoleFits,
flagSpec "show-docs-of-hole-fits" Opt_ShowDocsOfHoleFits,
flagSpec "unclutter-valid-hole-fits" Opt_UnclutterValidHoleFits
]
fLangFlags :: [FlagSpec LangExt.Extension]
fLangFlags = map snd fLangFlagsDeps
fLangFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]
fLangFlagsDeps = [
depFlagSpecOp' "th" LangExt.TemplateHaskell
checkTemplateHaskellOk
(deprecatedForExtension "TemplateHaskell"),
depFlagSpec' "fi" LangExt.ForeignFunctionInterface
(deprecatedForExtension "ForeignFunctionInterface"),
depFlagSpec' "ffi" LangExt.ForeignFunctionInterface
(deprecatedForExtension "ForeignFunctionInterface"),
depFlagSpec' "arrows" LangExt.Arrows
(deprecatedForExtension "Arrows"),
depFlagSpec' "implicit-prelude" LangExt.ImplicitPrelude
(deprecatedForExtension "ImplicitPrelude"),
depFlagSpec' "bang-patterns" LangExt.BangPatterns
(deprecatedForExtension "BangPatterns"),
depFlagSpec' "monomorphism-restriction" LangExt.MonomorphismRestriction
(deprecatedForExtension "MonomorphismRestriction"),
depFlagSpec' "mono-pat-binds" LangExt.MonoPatBinds
(deprecatedForExtension "MonoPatBinds"),
depFlagSpec' "extended-default-rules" LangExt.ExtendedDefaultRules
(deprecatedForExtension "ExtendedDefaultRules"),
depFlagSpec' "implicit-params" LangExt.ImplicitParams
(deprecatedForExtension "ImplicitParams"),
depFlagSpec' "scoped-type-variables" LangExt.ScopedTypeVariables
(deprecatedForExtension "ScopedTypeVariables"),
depFlagSpec' "allow-overlapping-instances" LangExt.OverlappingInstances
(deprecatedForExtension "OverlappingInstances"),
depFlagSpec' "allow-undecidable-instances" LangExt.UndecidableInstances
(deprecatedForExtension "UndecidableInstances"),
depFlagSpec' "allow-incoherent-instances" LangExt.IncoherentInstances
(deprecatedForExtension "IncoherentInstances")
]
supportedLanguages :: [String]
supportedLanguages = map (flagSpecName . snd) languageFlagsDeps
supportedLanguageOverlays :: [String]
supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps
supportedExtensions :: PlatformMini -> [String]
supportedExtensions targetPlatformMini = concatMap toFlagSpecNamePair xFlags
where
toFlagSpecNamePair flg
| isAIX, flagSpecFlag flg == LangExt.TemplateHaskell = [noName]
| isAIX, flagSpecFlag flg == LangExt.QuasiQuotes = [noName]
| otherwise = [name, noName]
where
isAIX = platformMini_os targetPlatformMini == OSAIX
noName = "No" ++ name
name = flagSpecName flg
supportedLanguagesAndExtensions :: PlatformMini -> [String]
supportedLanguagesAndExtensions targetPlatformMini =
supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions targetPlatformMini
languageFlagsDeps :: [(Deprecation, FlagSpec Language)]
languageFlagsDeps = [
flagSpec "Haskell98" Haskell98,
flagSpec "Haskell2010" Haskell2010
]
safeHaskellFlagsDeps :: [(Deprecation, FlagSpec SafeHaskellMode)]
safeHaskellFlagsDeps = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]
where mkF flag = flagSpec (show flag) flag
xFlags :: [FlagSpec LangExt.Extension]
xFlags = map snd xFlagsDeps
xFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]
xFlagsDeps = [
flagSpec "AllowAmbiguousTypes" LangExt.AllowAmbiguousTypes,
flagSpec "AlternativeLayoutRule" LangExt.AlternativeLayoutRule,
flagSpec "AlternativeLayoutRuleTransitional"
LangExt.AlternativeLayoutRuleTransitional,
flagSpec "Arrows" LangExt.Arrows,
depFlagSpecCond "AutoDeriveTypeable" LangExt.AutoDeriveTypeable
id
("Typeable instances are created automatically " ++
"for all types since GHC 8.2."),
flagSpec "BangPatterns" LangExt.BangPatterns,
flagSpec "BinaryLiterals" LangExt.BinaryLiterals,
flagSpec "CApiFFI" LangExt.CApiFFI,
flagSpec "CPP" LangExt.Cpp,
flagSpec "CUSKs" LangExt.CUSKs,
flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods,
flagSpec "ConstraintKinds" LangExt.ConstraintKinds,
flagSpec "DataKinds" LangExt.DataKinds,
depFlagSpecCond "DatatypeContexts" LangExt.DatatypeContexts
id
("It was widely considered a misfeature, " ++
"and has been removed from the Haskell language."),
flagSpec "DefaultSignatures" LangExt.DefaultSignatures,
flagSpec "DeriveAnyClass" LangExt.DeriveAnyClass,
flagSpec "DeriveDataTypeable" LangExt.DeriveDataTypeable,
flagSpec "DeriveFoldable" LangExt.DeriveFoldable,
flagSpec "DeriveFunctor" LangExt.DeriveFunctor,
flagSpec "DeriveGeneric" LangExt.DeriveGeneric,
flagSpec "DeriveLift" LangExt.DeriveLift,
flagSpec "DeriveTraversable" LangExt.DeriveTraversable,
flagSpec "DerivingStrategies" LangExt.DerivingStrategies,
flagSpec "DerivingVia" LangExt.DerivingVia,
flagSpec "DisambiguateRecordFields" LangExt.DisambiguateRecordFields,
flagSpec "DoAndIfThenElse" LangExt.DoAndIfThenElse,
flagSpec "BlockArguments" LangExt.BlockArguments,
depFlagSpec' "DoRec" LangExt.RecursiveDo
(deprecatedForExtension "RecursiveDo"),
flagSpec "DuplicateRecordFields" LangExt.DuplicateRecordFields,
flagSpec "EmptyCase" LangExt.EmptyCase,
flagSpec "EmptyDataDecls" LangExt.EmptyDataDecls,
flagSpec "EmptyDataDeriving" LangExt.EmptyDataDeriving,
flagSpec "ExistentialQuantification" LangExt.ExistentialQuantification,
flagSpec "ExplicitForAll" LangExt.ExplicitForAll,
flagSpec "ExplicitNamespaces" LangExt.ExplicitNamespaces,
flagSpec "ExtendedDefaultRules" LangExt.ExtendedDefaultRules,
flagSpec "FlexibleContexts" LangExt.FlexibleContexts,
flagSpec "FlexibleInstances" LangExt.FlexibleInstances,
flagSpec "ForeignFunctionInterface" LangExt.ForeignFunctionInterface,
flagSpec "FunctionalDependencies" LangExt.FunctionalDependencies,
flagSpec "GADTSyntax" LangExt.GADTSyntax,
flagSpec "GADTs" LangExt.GADTs,
flagSpec "GHCForeignImportPrim" LangExt.GHCForeignImportPrim,
flagSpec' "GeneralizedNewtypeDeriving" LangExt.GeneralizedNewtypeDeriving
setGenDeriving,
flagSpec' "GeneralisedNewtypeDeriving" LangExt.GeneralizedNewtypeDeriving
setGenDeriving,
flagSpec "ImplicitParams" LangExt.ImplicitParams,
flagSpec "ImplicitPrelude" LangExt.ImplicitPrelude,
flagSpec "ImportQualifiedPost" LangExt.ImportQualifiedPost,
flagSpec "ImpredicativeTypes" LangExt.ImpredicativeTypes,
flagSpec' "IncoherentInstances" LangExt.IncoherentInstances
setIncoherentInsts,
flagSpec "TypeFamilyDependencies" LangExt.TypeFamilyDependencies,
flagSpec "InstanceSigs" LangExt.InstanceSigs,
flagSpec "ApplicativeDo" LangExt.ApplicativeDo,
flagSpec "InterruptibleFFI" LangExt.InterruptibleFFI,
flagSpec "JavaScriptFFI" LangExt.JavaScriptFFI,
flagSpec "KindSignatures" LangExt.KindSignatures,
flagSpec "LambdaCase" LangExt.LambdaCase,
flagSpec "LexicalNegation" LangExt.LexicalNegation,
flagSpec "LiberalTypeSynonyms" LangExt.LiberalTypeSynonyms,
flagSpec "LinearTypes" LangExt.LinearTypes,
flagSpec "MagicHash" LangExt.MagicHash,
flagSpec "MonadComprehensions" LangExt.MonadComprehensions,
depFlagSpec "MonadFailDesugaring" LangExt.MonadFailDesugaring
"MonadFailDesugaring is now the default behavior",
flagSpec "MonoLocalBinds" LangExt.MonoLocalBinds,
depFlagSpecCond "MonoPatBinds" LangExt.MonoPatBinds
id
"Experimental feature now removed; has no effect",
flagSpec "MonomorphismRestriction" LangExt.MonomorphismRestriction,
flagSpec "MultiParamTypeClasses" LangExt.MultiParamTypeClasses,
flagSpec "MultiWayIf" LangExt.MultiWayIf,
flagSpec "NumericUnderscores" LangExt.NumericUnderscores,
flagSpec "NPlusKPatterns" LangExt.NPlusKPatterns,
flagSpec "NamedFieldPuns" LangExt.RecordPuns,
flagSpec "NamedWildCards" LangExt.NamedWildCards,
flagSpec "NegativeLiterals" LangExt.NegativeLiterals,
flagSpec "HexFloatLiterals" LangExt.HexFloatLiterals,
flagSpec "NondecreasingIndentation" LangExt.NondecreasingIndentation,
depFlagSpec' "NullaryTypeClasses" LangExt.NullaryTypeClasses
(deprecatedForExtension "MultiParamTypeClasses"),
flagSpec "NumDecimals" LangExt.NumDecimals,
depFlagSpecOp "OverlappingInstances" LangExt.OverlappingInstances
setOverlappingInsts
"instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS",
flagSpec "OverloadedLabels" LangExt.OverloadedLabels,
flagSpec "OverloadedLists" LangExt.OverloadedLists,
flagSpec "OverloadedStrings" LangExt.OverloadedStrings,
flagSpec "PackageImports" LangExt.PackageImports,
flagSpec "ParallelArrays" LangExt.ParallelArrays,
flagSpec "ParallelListComp" LangExt.ParallelListComp,
flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures,
flagSpec "PatternGuards" LangExt.PatternGuards,
depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables
(deprecatedForExtension "ScopedTypeVariables"),
flagSpec "PatternSynonyms" LangExt.PatternSynonyms,
flagSpec "PolyKinds" LangExt.PolyKinds,
flagSpec "PolymorphicComponents" LangExt.RankNTypes,
flagSpec "QuantifiedConstraints" LangExt.QuantifiedConstraints,
flagSpec "PostfixOperators" LangExt.PostfixOperators,
flagSpec "QuasiQuotes" LangExt.QuasiQuotes,
flagSpec "QualifiedDo" LangExt.QualifiedDo,
flagSpec "Rank2Types" LangExt.RankNTypes,
flagSpec "RankNTypes" LangExt.RankNTypes,
flagSpec "RebindableSyntax" LangExt.RebindableSyntax,
depFlagSpec' "RecordPuns" LangExt.RecordPuns
(deprecatedForExtension "NamedFieldPuns"),
flagSpec "RecordWildCards" LangExt.RecordWildCards,
flagSpec "RecursiveDo" LangExt.RecursiveDo,
flagSpec "RelaxedLayout" LangExt.RelaxedLayout,
depFlagSpecCond "RelaxedPolyRec" LangExt.RelaxedPolyRec
not
"You can't turn off RelaxedPolyRec any more",
flagSpec "RoleAnnotations" LangExt.RoleAnnotations,
flagSpec "ScopedTypeVariables" LangExt.ScopedTypeVariables,
flagSpec "StandaloneDeriving" LangExt.StandaloneDeriving,
flagSpec "StarIsType" LangExt.StarIsType,
flagSpec "StaticPointers" LangExt.StaticPointers,
flagSpec "Strict" LangExt.Strict,
flagSpec "StrictData" LangExt.StrictData,
flagSpec' "TemplateHaskell" LangExt.TemplateHaskell
checkTemplateHaskellOk,
flagSpec "TemplateHaskellQuotes" LangExt.TemplateHaskellQuotes,
flagSpec "StandaloneKindSignatures" LangExt.StandaloneKindSignatures,
flagSpec "TraditionalRecordSyntax" LangExt.TraditionalRecordSyntax,
flagSpec "TransformListComp" LangExt.TransformListComp,
flagSpec "TupleSections" LangExt.TupleSections,
flagSpec "TypeApplications" LangExt.TypeApplications,
flagSpec "TypeInType" LangExt.TypeInType,
flagSpec "TypeFamilies" LangExt.TypeFamilies,
flagSpec "TypeOperators" LangExt.TypeOperators,
flagSpec "TypeSynonymInstances" LangExt.TypeSynonymInstances,
flagSpec "UnboxedTuples" LangExt.UnboxedTuples,
flagSpec "UnboxedSums" LangExt.UnboxedSums,
flagSpec "UndecidableInstances" LangExt.UndecidableInstances,
flagSpec "UndecidableSuperClasses" LangExt.UndecidableSuperClasses,
flagSpec "UnicodeSyntax" LangExt.UnicodeSyntax,
flagSpec "UnliftedFFITypes" LangExt.UnliftedFFITypes,
flagSpec "UnliftedNewtypes" LangExt.UnliftedNewtypes,
flagSpec "ViewPatterns" LangExt.ViewPatterns
]
defaultFlags :: Settings -> [GeneralFlag]
defaultFlags settings
= [ Opt_AutoLinkPackages,
Opt_DiagnosticsShowCaret,
Opt_EmbedManifest,
Opt_FlatCache,
Opt_GenManifest,
Opt_GhciHistory,
Opt_GhciSandbox,
Opt_HelpfulErrors,
Opt_KeepHiFiles,
Opt_KeepOFiles,
Opt_OmitYields,
Opt_PrintBindContents,
Opt_ProfCountEntries,
Opt_SharedImplib,
Opt_SimplPreInlining,
Opt_VersionMacros
]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
++ default_PIC platform
++ default_RPath platform
++ concatMap (wayGeneralFlags platform) (defaultWays settings)
++ validHoleFitDefaults
where platform = sTargetPlatform settings
validHoleFitDefaults :: [GeneralFlag]
validHoleFitDefaults
= [ Opt_ShowTypeAppOfHoleFits
, Opt_ShowTypeOfHoleFits
, Opt_ShowProvOfHoleFits
, Opt_ShowMatchesOfHoleFits
, Opt_ShowValidHoleFits
, Opt_SortValidHoleFits
, Opt_SortBySizeHoleFits
, Opt_ShowHoleConstraints ]
validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
validHoleFitsImpliedGFlags
= [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
, (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)
, (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)
, (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)
, (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]
default_PIC :: Platform -> [GeneralFlag]
default_PIC platform =
case (platformOS platform, platformArch platform) of
(OSDarwin, ArchAArch64) -> [Opt_PIC]
(OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
(OSDarwin, ArchX86_64) -> [Opt_PIC]
(OSOpenBSD, ArchX86_64) -> [Opt_PIC]
_ -> []
default_RPath :: Platform -> [GeneralFlag]
default_RPath platform | platformOS platform == OSDarwin = []
default_RPath _ = [Opt_RPath]
impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)
,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)
,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting)
,(Opt_Strictness, turnOn, Opt_WorkerWrapper)
] ++ validHoleFitsImpliedGFlags
impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]
impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]
impliedXFlags
= [ (LangExt.RankNTypes, turnOn, LangExt.ExplicitForAll)
, (LangExt.QuantifiedConstraints, turnOn, LangExt.ExplicitForAll)
, (LangExt.ScopedTypeVariables, turnOn, LangExt.ExplicitForAll)
, (LangExt.LiberalTypeSynonyms, turnOn, LangExt.ExplicitForAll)
, (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)
, (LangExt.FlexibleInstances, turnOn, LangExt.TypeSynonymInstances)
, (LangExt.FunctionalDependencies, turnOn, LangExt.MultiParamTypeClasses)
, (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods)
, (LangExt.TypeFamilyDependencies, turnOn, LangExt.TypeFamilies)
, (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)
, (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)
, (LangExt.GADTs, turnOn, LangExt.GADTSyntax)
, (LangExt.GADTs, turnOn, LangExt.MonoLocalBinds)
, (LangExt.TypeFamilies, turnOn, LangExt.MonoLocalBinds)
, (LangExt.TypeFamilies, turnOn, LangExt.KindSignatures)
, (LangExt.PolyKinds, turnOn, LangExt.KindSignatures)
, (LangExt.TypeInType, turnOn, LangExt.DataKinds)
, (LangExt.TypeInType, turnOn, LangExt.PolyKinds)
, (LangExt.TypeInType, turnOn, LangExt.KindSignatures)
, (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)
, (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)
, (LangExt.TypeFamilies, turnOn, LangExt.ExplicitNamespaces)
, (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)
, (LangExt.ImpredicativeTypes, turnOn, LangExt.RankNTypes)
, (LangExt.RecordWildCards, turnOn, LangExt.DisambiguateRecordFields)
, (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)
, (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)
, (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)
, (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)
, (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)
, (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)
, (LangExt.Strict, turnOn, LangExt.StrictData)
]
optLevelFlags :: [([Int], GeneralFlag)]
optLevelFlags
= [ ([0,1,2], Opt_DoLambdaEtaExpansion)
, ([0,1,2], Opt_DoEtaReduction)
, ([0,1,2], Opt_DmdTxDictSel)
, ([0,1,2], Opt_LlvmTBAA)
, ([0], Opt_IgnoreInterfacePragmas)
, ([0], Opt_OmitInterfacePragmas)
, ([1,2], Opt_CallArity)
, ([1,2], Opt_Exitification)
, ([1,2], Opt_CaseMerge)
, ([1,2], Opt_CaseFolding)
, ([1,2], Opt_CmmElimCommonBlocks)
, ([2], Opt_AsmShortcutting)
, ([1,2], Opt_CmmSink)
, ([1,2], Opt_CmmStaticPred)
, ([1,2], Opt_CSE)
, ([1,2], Opt_StgCSE)
, ([2], Opt_StgLiftLams)
, ([1,2], Opt_EnableRewriteRules)
, ([1,2], Opt_FloatIn)
, ([1,2], Opt_FullLaziness)
, ([1,2], Opt_IgnoreAsserts)
, ([1,2], Opt_Loopification)
, ([1,2], Opt_CfgBlocklayout)
, ([1,2], Opt_Specialise)
, ([1,2], Opt_CrossModuleSpecialise)
, ([1,2], Opt_Strictness)
, ([1,2], Opt_UnboxSmallStrictFields)
, ([1,2], Opt_CprAnal)
, ([1,2], Opt_WorkerWrapper)
, ([1,2], Opt_SolveConstantDicts)
, ([1,2], Opt_NumConstantFolding)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
]
warningGroups :: [(String, [WarningFlag])]
warningGroups =
[ ("compat", minusWcompatOpts)
, ("unused-binds", unusedBindsFlags)
, ("default", standardWarnings)
, ("extra", minusWOpts)
, ("all", minusWallOpts)
, ("everything", minusWeverythingOpts)
]
warningHierarchies :: [[String]]
warningHierarchies = hierarchies ++ map (:[]) rest
where
hierarchies = [["default", "extra", "all"]]
rest = filter (`notElem` "everything" : concat hierarchies) $
map fst warningGroups
smallestGroups :: WarningFlag -> [String]
smallestGroups flag = mapMaybe go warningHierarchies where
go (group:rest) = fromMaybe (go rest) $ do
flags <- lookup group warningGroups
guard (flag `elem` flags)
pure (Just group)
go [] = Nothing
standardWarnings :: [WarningFlag]
standardWarnings
= [ Opt_WarnOverlappingPatterns,
Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
Opt_WarnDeferredTypeErrors,
Opt_WarnTypedHoles,
Opt_WarnDeferredOutOfScopeVariables,
Opt_WarnPartialTypeSignatures,
Opt_WarnUnrecognisedPragmas,
Opt_WarnDuplicateExports,
Opt_WarnDerivingDefaults,
Opt_WarnOverflowedLiterals,
Opt_WarnEmptyEnumerations,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnWrongDoBind,
Opt_WarnUnsupportedCallingConventions,
Opt_WarnDodgyForeignImports,
Opt_WarnInlineRuleShadowing,
Opt_WarnAlternativeLayoutRuleTransitional,
Opt_WarnUnsupportedLlvmVersion,
Opt_WarnMissedExtraSharedLib,
Opt_WarnTabs,
Opt_WarnUnrecognisedWarningFlags,
Opt_WarnSimplifiableClassConstraints,
Opt_WarnStarBinder,
Opt_WarnInaccessibleCode,
Opt_WarnSpaceAfterBang
]
minusWOpts :: [WarningFlag]
minusWOpts
= standardWarnings ++
[ Opt_WarnUnusedTopBinds,
Opt_WarnUnusedLocalBinds,
Opt_WarnUnusedPatternBinds,
Opt_WarnUnusedMatches,
Opt_WarnUnusedForalls,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
Opt_WarnDodgyExports,
Opt_WarnDodgyImports,
Opt_WarnUnbangedStrictPatterns
]
minusWallOpts :: [WarningFlag]
minusWallOpts
= minusWOpts ++
[ Opt_WarnTypeDefaults,
Opt_WarnNameShadowing,
Opt_WarnMissingSignatures,
Opt_WarnHiShadows,
Opt_WarnOrphans,
Opt_WarnUnusedDoBind,
Opt_WarnTrustworthySafe,
Opt_WarnUntickedPromotedConstructors,
Opt_WarnMissingPatternSynonymSignatures,
Opt_WarnUnusedRecordWildcards,
Opt_WarnRedundantRecordWildcards,
Opt_WarnStarIsType
]
minusWeverythingOpts :: [WarningFlag]
minusWeverythingOpts = [ toEnum 0 .. ]
minusWcompatOpts :: [WarningFlag]
minusWcompatOpts
= [ Opt_WarnSemigroup
, Opt_WarnNonCanonicalMonoidInstances
, Opt_WarnStarIsType
, Opt_WarnCompatUnqualifiedImports
]
enableUnusedBinds :: DynP ()
enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags
disableUnusedBinds :: DynP ()
disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags
unusedBindsFlags :: [WarningFlag]
unusedBindsFlags = [ Opt_WarnUnusedTopBinds
, Opt_WarnUnusedLocalBinds
, Opt_WarnUnusedPatternBinds
]
enableGlasgowExts :: DynP ()
enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls
mapM_ setExtensionFlag glasgowExtsFlags
disableGlasgowExts :: DynP ()
disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls
mapM_ unSetExtensionFlag glasgowExtsFlags
glasgowExtsFlags :: [LangExt.Extension]
glasgowExtsFlags = [
LangExt.ConstrainedClassMethods
, LangExt.DeriveDataTypeable
, LangExt.DeriveFoldable
, LangExt.DeriveFunctor
, LangExt.DeriveGeneric
, LangExt.DeriveTraversable
, LangExt.EmptyDataDecls
, LangExt.ExistentialQuantification
, LangExt.ExplicitNamespaces
, LangExt.FlexibleContexts
, LangExt.FlexibleInstances
, LangExt.ForeignFunctionInterface
, LangExt.FunctionalDependencies
, LangExt.GeneralizedNewtypeDeriving
, LangExt.ImplicitParams
, LangExt.KindSignatures
, LangExt.LiberalTypeSynonyms
, LangExt.MagicHash
, LangExt.MultiParamTypeClasses
, LangExt.ParallelListComp
, LangExt.PatternGuards
, LangExt.PostfixOperators
, LangExt.RankNTypes
, LangExt.RecursiveDo
, LangExt.ScopedTypeVariables
, LangExt.StandaloneDeriving
, LangExt.TypeOperators
, LangExt.TypeSynonymInstances
, LangExt.UnboxedTuples
, LangExt.UnicodeSyntax
, LangExt.UnliftedFFITypes ]
setWarnSafe :: Bool -> DynP ()
setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })
setWarnSafe False = return ()
setWarnUnsafe :: Bool -> DynP ()
setWarnUnsafe True = getCurLoc >>= \l -> upd (\d -> d { warnUnsafeOnLoc = l })
setWarnUnsafe False = return ()
setPackageTrust :: DynP ()
setPackageTrust = do
setGeneralFlag Opt_PackageTrust
l <- getCurLoc
upd $ \d -> d { pkgTrustOnLoc = l }
setGenDeriving :: TurnOnFlag -> DynP ()
setGenDeriving True = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })
setGenDeriving False = return ()
setOverlappingInsts :: TurnOnFlag -> DynP ()
setOverlappingInsts False = return ()
setOverlappingInsts True = do
l <- getCurLoc
upd (\d -> d { overlapInstLoc = l })
setIncoherentInsts :: TurnOnFlag -> DynP ()
setIncoherentInsts False = return ()
setIncoherentInsts True = do
l <- getCurLoc
upd (\d -> d { incoherentOnLoc = l })
checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
checkTemplateHaskellOk _turn_on
= getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l })
type DynP = EwM (CmdLineP DynFlags)
upd :: (DynFlags -> DynFlags) -> DynP ()
upd f = liftEwM (do dflags <- getCmdLineState
putCmdLineState $! f dflags)
updM :: (DynFlags -> DynP DynFlags) -> DynP ()
updM f = do dflags <- liftEwM getCmdLineState
dflags' <- f dflags
liftEwM $ putCmdLineState $! dflags'
noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
noArg fn = NoArg (upd fn)
noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
noArgM fn = NoArg (updM fn)
hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
hasArg fn = HasArg (upd . fn)
sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
sepArg fn = SepArg (upd . fn)
intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
intSuffix fn = IntSuffix (\n -> upd (fn n))
intSuffixM :: (Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
intSuffixM fn = IntSuffix (\n -> updM (fn n))
floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
floatSuffix fn = FloatSuffix (\n -> upd (fn n))
optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
-> OptKind (CmdLineP DynFlags)
optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
addWay :: Way -> DynP ()
addWay w = upd (addWay' w)
addWay' :: Way -> DynFlags -> DynFlags
addWay' w dflags0 = let platform = targetPlatform dflags0
dflags1 = dflags0 { ways = Set.insert w (ways dflags0) }
dflags2 = foldr setGeneralFlag' dflags1
(wayGeneralFlags platform w)
dflags3 = foldr unSetGeneralFlag' dflags2
(wayUnsetGeneralFlags platform w)
in dflags3
removeWayDyn :: DynP ()
removeWayDyn = upd (\dfs -> dfs { ways = Set.filter (WayDyn /=) (ways dfs) })
setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
setGeneralFlag f = upd (setGeneralFlag' f)
unSetGeneralFlag f = upd (unSetGeneralFlag' f)
setGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
setGeneralFlag' f dflags = foldr ($) (gopt_set dflags f) deps
where
deps = [ if turn_on then setGeneralFlag' d
else unSetGeneralFlag' d
| (f', turn_on, d) <- impliedGFlags, f' == f ]
unSetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
unSetGeneralFlag' f dflags = foldr ($) (gopt_unset dflags f) deps
where
deps = [ if turn_on then setGeneralFlag' d
else unSetGeneralFlag' d
| (f', turn_on, d) <- impliedOffGFlags, f' == f ]
setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
setWarningFlag f = upd (\dfs -> wopt_set dfs f)
unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
setFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP ()
setFatalWarningFlag f = upd (\dfs -> wopt_set_fatal dfs f)
unSetFatalWarningFlag f = upd (\dfs -> wopt_unset_fatal dfs f)
setWErrorFlag :: WarningFlag -> DynP ()
setWErrorFlag flag =
do { setWarningFlag flag
; setFatalWarningFlag flag }
setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP ()
setExtensionFlag f = upd (setExtensionFlag' f)
unSetExtensionFlag f = upd (unSetExtensionFlag' f)
setExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags
setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps
where
deps = [ if turn_on then setExtensionFlag' d
else unSetExtensionFlag' d
| (f', turn_on, d) <- impliedXFlags, f' == f ]
unSetExtensionFlag' f dflags = xopt_unset dflags f
alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags
alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) }
alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) }
setDumpFlag' :: DumpFlag -> DynP ()
setDumpFlag' dump_flag
= do upd (\dfs -> dopt_set dfs dump_flag)
when want_recomp forceRecompile
where
want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
Opt_D_dump_hi_diffs,
Opt_D_no_debug_output]
forceRecompile :: DynP ()
forceRecompile = do dfs <- liftEwM getCmdLineState
when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp)
where
force_recomp dfs = isOneShot (ghcMode dfs)
setVerboseCore2Core :: DynP ()
setVerboseCore2Core = setDumpFlag' Opt_D_verbose_core2core
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
setDebugLevel :: Maybe Int -> DynP ()
setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 })
data PkgDbRef
= GlobalPkgDb
| UserPkgDb
| PkgDbPath FilePath
deriving Eq
addPkgDbRef :: PkgDbRef -> DynP ()
addPkgDbRef p = upd $ \s ->
s { packageDBFlags = PackageDB p : packageDBFlags s }
removeUserPkgDb :: DynP ()
removeUserPkgDb = upd $ \s ->
s { packageDBFlags = NoUserPackageDB : packageDBFlags s }
removeGlobalPkgDb :: DynP ()
removeGlobalPkgDb = upd $ \s ->
s { packageDBFlags = NoGlobalPackageDB : packageDBFlags s }
clearPkgDb :: DynP ()
clearPkgDb = upd $ \s ->
s { packageDBFlags = ClearPackageDBs : packageDBFlags s }
parsePackageFlag :: String
-> ReadP PackageArg
-> String
-> PackageFlag
parsePackageFlag flag arg_parse str
= case filter ((=="").snd) (readP_to_S parse str) of
[(r, "")] -> r
_ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str)
where doc = flag ++ " " ++ str
parse = do
pkg_arg <- tok arg_parse
let mk_expose = ExposePackage doc pkg_arg
( do _ <- tok $ string "with"
fmap (mk_expose . ModRenaming True) parseRns
<++ fmap (mk_expose . ModRenaming False) parseRns
<++ return (mk_expose (ModRenaming True [])))
parseRns = do _ <- tok $ R.char '('
rns <- tok $ sepBy parseItem (tok $ R.char ',')
_ <- tok $ R.char ')'
return rns
parseItem = do
orig <- tok $ parseModuleName
(do _ <- tok $ string "as"
new <- tok $ parseModuleName
return (orig, new)
+++
return (orig, orig))
tok m = m >>= \x -> skipSpaces >> return x
exposePackage, exposePackageId, hidePackage,
exposePluginPackage, exposePluginPackageId,
ignorePackage,
trustPackage, distrustPackage :: String -> DynP ()
exposePackage p = upd (exposePackage' p)
exposePackageId p =
upd (\s -> s{ packageFlags =
parsePackageFlag "-package-id" parseUnitArg p : packageFlags s })
exposePluginPackage p =
upd (\s -> s{ pluginPackageFlags =
parsePackageFlag "-plugin-package" parsePackageArg p : pluginPackageFlags s })
exposePluginPackageId p =
upd (\s -> s{ pluginPackageFlags =
parsePackageFlag "-plugin-package-id" parseUnitArg p : pluginPackageFlags s })
hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
ignorePackage p =
upd (\s -> s{ ignorePackageFlags = IgnorePackage p : ignorePackageFlags s })
trustPackage p = exposePackage p >>
upd (\s -> s{ trustFlags = TrustPackage p : trustFlags s })
distrustPackage p = exposePackage p >>
upd (\s -> s{ trustFlags = DistrustPackage p : trustFlags s })
exposePackage' :: String -> DynFlags -> DynFlags
exposePackage' p dflags
= dflags { packageFlags =
parsePackageFlag "-package" parsePackageArg p : packageFlags dflags }
parsePackageArg :: ReadP PackageArg
parsePackageArg =
fmap PackageArg (munch1 (\c -> isAlphaNum c || c `elem` ":-_."))
parseUnitArg :: ReadP PackageArg
parseUnitArg =
fmap UnitIdArg parseUnit
setUnitId :: String -> DynFlags -> DynFlags
setUnitId p d = d { homeUnitId = stringToUnitId p }
canonicalizeHomeModule :: DynFlags -> ModuleName -> Module
canonicalizeHomeModule dflags mod_name =
case lookup mod_name (homeUnitInstantiations dflags) of
Nothing -> mkHomeModule dflags mod_name
Just mod -> mod
canonicalizeModuleIfHome :: DynFlags -> Module -> Module
canonicalizeModuleIfHome dflags mod
= if homeUnit dflags == moduleUnit mod
then canonicalizeHomeModule dflags (moduleName mod)
else mod
setTarget :: HscTarget -> DynP ()
setTarget l = upd $ \ dfs ->
if ghcLink dfs /= LinkBinary || isObjectTarget l
then dfs{ hscTarget = l }
else dfs
setObjTarget :: HscTarget -> DynP ()
setObjTarget l = updM set
where
set dflags
| isObjectTarget (hscTarget dflags)
= return $ dflags { hscTarget = l }
| otherwise = return dflags
setOptLevel :: Int -> DynFlags -> DynP DynFlags
setOptLevel n dflags = return (updOptLevel n dflags)
checkOptLevel :: Int -> DynFlags -> Either String DynFlags
checkOptLevel n dflags
| hscTarget dflags == HscInterpreted && n > 0
= Left "-O conflicts with --interactive; -O ignored."
| otherwise
= Right dflags
setMainIs :: String -> DynP ()
setMainIs arg
| not (null main_fn) && isLower (head main_fn)
= upd $ \d -> d { mainFunIs = Just main_fn,
mainModIs = mkModule mainUnit (mkModuleName main_mod) }
| isUpper (head arg)
= upd $ \d -> d { mainModIs = mkModule mainUnit (mkModuleName arg) }
| otherwise
= upd $ \d -> d { mainFunIs = Just arg }
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
addLdInputs :: Option -> DynFlags -> DynFlags
addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}
setFlagsFromEnvFile :: FilePath -> String -> DynP ()
setFlagsFromEnvFile envfile content = do
setGeneralFlag Opt_HideAllPackages
parseEnvFile envfile content
parseEnvFile :: FilePath -> String -> DynP ()
parseEnvFile envfile = mapM_ parseEntry . lines
where
parseEntry str = case words str of
("package-db": _) -> addPkgDbRef (PkgDbPath (envdir </> db))
where envdir = takeDirectory envfile
db = drop 11 str
["clear-package-db"] -> clearPkgDb
["global-package-db"] -> addPkgDbRef GlobalPkgDb
["user-package-db"] -> addPkgDbRef UserPkgDb
["package-id", pkgid] -> exposePackageId pkgid
(('-':'-':_):_) -> return ()
[pkgid] -> exposePackageId pkgid
[] -> return ()
_ -> throwGhcException $ CmdLineError $
"Can't parse environment file entry: "
++ envfile ++ ": " ++ str
addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
addImportPath "" = upd (\s -> s{importPaths = []})
addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
addLibraryPath p =
upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
addIncludePath p =
upd (\s -> s{includePaths =
addGlobalInclude (includePaths s) (splitPathList p)})
addFrameworkPath p =
upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
#if !defined(mingw32_HOST_OS)
split_marker :: Char
split_marker = ':'
#endif
splitPathList :: String -> [String]
splitPathList s = filter notNull (splitUp s)
where
#if !defined(mingw32_HOST_OS)
splitUp xs = split split_marker xs
#else
splitUp [] = []
splitUp (x:':':div:xs) | div `elem` dir_markers
= ((x:':':div:p): splitUp rs)
where
(p,rs) = findNextPath xs
splitUp xs = cons p (splitUp rs)
where
(p,rs) = findNextPath xs
cons "" xs = xs
cons x xs = x:xs
findNextPath xs =
case break (`elem` split_markers) xs of
(p, _:ds) -> (p, ds)
(p, xs) -> (p, xs)
split_markers :: [Char]
split_markers = [':', ';']
dir_markers :: [Char]
dir_markers = ['/', '\\']
#endif
setTmpDir :: FilePath -> DynFlags -> DynFlags
setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir }
setRtsOpts :: String -> DynP ()
setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
setOptHpcDir :: String -> DynP ()
setOptHpcDir arg = upd $ \ d -> d {hpcDir = arg}
picCCOpts :: DynFlags -> [String]
picCCOpts dflags = pieOpts ++ picOpts
where
picOpts =
case platformOS (targetPlatform dflags) of
OSDarwin
| gopt Opt_PIC dflags -> ["-fno-common", "-U__PIC__", "-D__PIC__"]
| otherwise -> ["-mdynamic-no-pic"]
OSMinGW32
| gopt Opt_PIC dflags -> ["-U__PIC__", "-D__PIC__"]
| otherwise -> []
_
| gopt Opt_PIC dflags || WayDyn `Set.member` ways dflags ->
["-fPIC", "-U__PIC__", "-D__PIC__"]
| otherwise -> ["-fno-PIC"]
pieOpts
| gopt Opt_PICExecutable dflags = ["-pie"]
| toolSettings_ccSupportsNoPie (toolSettings dflags) = ["-no-pie"]
| otherwise = []
picPOpts :: DynFlags -> [String]
picPOpts dflags
| gopt Opt_PIC dflags = ["-U__PIC__", "-D__PIC__"]
| otherwise = []
compilerInfo :: DynFlags -> [(String, String)]
compilerInfo dflags
=
("Project name", cProjectName)
: map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))
(rawSettings dflags)
++ [("Project version", projectVersion dflags),
("Project Git commit id", cProjectGitCommitId),
("Booter version", cBooterVersion),
("Stage", cStage),
("Build platform", cBuildPlatformString),
("Host platform", cHostPlatformString),
("Target platform", platformMisc_targetPlatformString $ platformMisc dflags),
("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
("Object splitting supported", showBool False),
("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)),
("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)),
("Support dynamic-too", showBool $ not isWindows),
("Support parallel --make", "YES"),
("Support reexported-modules", "YES"),
("Support thinning and renaming package flags", "YES"),
("Support Backpack", "YES"),
("Requires unified installed package IDs", "YES"),
("Uses package keys", "YES"),
("Uses unit IDs", "YES"),
("Dynamic by default", showBool $ dYNAMIC_BY_DEFAULT dflags),
("GHC Dynamic", showBool hostIsDynamic),
("GHC Profiled", showBool hostIsProfiled),
("Debug on", showBool debugIsOn),
("LibDir", topDir dflags),
("Global Package DB", globalPackageDatabasePath dflags)
]
where
showBool True = "YES"
showBool False = "NO"
isWindows = platformOS (targetPlatform dflags) == OSMinGW32
expandDirectories :: FilePath -> Maybe FilePath -> String -> String
expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd
#include "GHCConstantsHaskellWrappers.hs"
bLOCK_SIZE_W :: DynFlags -> Int
bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` platformWordSizeInBytes platform
where platform = targetPlatform dflags
wordAlignment :: Platform -> Alignment
wordAlignment platform = alignmentOf (platformWordSizeInBytes platform)
tAG_MASK :: DynFlags -> Int
tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) 1
mAX_PTR_TAG :: DynFlags -> Int
mAX_PTR_TAG = tAG_MASK
makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
makeDynFlagsConsistent dflags
| os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags
= let dflags' = gopt_unset dflags Opt_BuildDynamicToo
warn = "-dynamic-too is not supported on Windows"
in loop dflags' warn
| hscTarget dflags == HscC &&
not (platformUnregisterised (targetPlatform dflags))
= case platformDefaultBackend (targetPlatform dflags) of
NCG -> let dflags' = dflags { hscTarget = HscAsm }
warn = "Target platform doesn't use unregisterised ABI, so using native code generator rather than compiling via C"
in loop dflags' warn
LLVM -> let dflags' = dflags { hscTarget = HscLlvm }
warn = "Target platform doesn't use unregisterised ABI, so using LLVM rather than compiling via C"
in loop dflags' warn
_ -> pgmError "Compiling via C is only supported with unregisterised ABI but target platform doesn't use it."
| gopt Opt_Hpc dflags && hscTarget dflags == HscInterpreted
= let dflags' = gopt_unset dflags Opt_Hpc
warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc."
in loop dflags' warn
| hscTarget dflags `elem` [HscAsm, HscLlvm] &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { hscTarget = HscC })
"Target platform uses unregisterised ABI, so compiling via C"
| hscTarget dflags == HscAsm &&
not (platformNcgSupported $ targetPlatform dflags)
= let dflags' = dflags { hscTarget = HscLlvm }
warn = "Native code generator doesn't support target platform, so using LLVM"
in loop dflags' warn
| not (osElfTarget os) && gopt Opt_PIE dflags
= loop (gopt_unset dflags Opt_PIE)
"Position-independent only supported on ELF platforms"
| os == OSDarwin &&
arch == ArchX86_64 &&
not (gopt Opt_PIC dflags)
= loop (gopt_set dflags Opt_PIC)
"Enabling -fPIC as it is always on for this platform"
| Left err <- checkOptLevel (optLevel dflags) dflags
= loop (updOptLevel 0 dflags) err
| LinkInMemory <- ghcLink dflags
, not (gopt Opt_ExternalInterpreter dflags)
, hostIsProfiled
, isObjectTarget (hscTarget dflags)
, WayProf `Set.notMember` ways dflags
= loop dflags{ways = Set.insert WayProf (ways dflags)}
"Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
| otherwise = (dflags, [])
where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
loop updated_dflags warning
= case makeDynFlagsConsistent updated_dflags of
(dflags', ws) -> (dflags', L loc warning : ws)
platform = targetPlatform dflags
arch = platformArch platform
os = platformOS platform
defaultGlobalDynFlags :: DynFlags
defaultGlobalDynFlags =
(defaultDynFlags settings llvmConfig) { verbosity = 2 }
where
settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
#if GHC_STAGE < 2
GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
#else
SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags
, getOrSetLibHSghcGlobalDynFlags
, "getOrSetLibHSghcGlobalDynFlags"
, defaultGlobalDynFlags
, DynFlags )
#endif
unsafeGlobalDynFlags :: DynFlags
unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
setUnsafeGlobalDynFlags :: DynFlags -> IO ()
setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
isSseEnabled :: DynFlags -> Bool
isSseEnabled dflags = case platformArch (targetPlatform dflags) of
ArchX86_64 -> True
ArchX86 -> True
_ -> False
isSse2Enabled :: DynFlags -> Bool
isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
ArchX86_64 -> True
ArchX86 -> True
_ -> False
isSse4_2Enabled :: DynFlags -> Bool
isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
isAvxEnabled :: DynFlags -> Bool
isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags
isAvx2Enabled :: DynFlags -> Bool
isAvx2Enabled dflags = avx2 dflags || avx512f dflags
isAvx512cdEnabled :: DynFlags -> Bool
isAvx512cdEnabled dflags = avx512cd dflags
isAvx512erEnabled :: DynFlags -> Bool
isAvx512erEnabled dflags = avx512er dflags
isAvx512fEnabled :: DynFlags -> Bool
isAvx512fEnabled dflags = avx512f dflags
isAvx512pfEnabled :: DynFlags -> Bool
isAvx512pfEnabled dflags = avx512pf dflags
isBmiEnabled :: DynFlags -> Bool
isBmiEnabled dflags = case platformArch (targetPlatform dflags) of
ArchX86_64 -> bmiVersion dflags >= Just BMI1
ArchX86 -> bmiVersion dflags >= Just BMI1
_ -> False
isBmi2Enabled :: DynFlags -> Bool
isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
ArchX86_64 -> bmiVersion dflags >= Just BMI2
ArchX86 -> bmiVersion dflags >= Just BMI2
_ -> False
sccProfilingEnabled :: DynFlags -> Bool
sccProfilingEnabled dflags = ways dflags `hasWay` WayProf
data LinkerInfo
= GnuLD [Option]
| GnuGold [Option]
| LlvmLLD [Option]
| DarwinLD [Option]
| SolarisLD [Option]
| AixLD [Option]
| UnknownLD
deriving Eq
data CompilerInfo
= GCC
| Clang
| AppleClang
| AppleClang51
| UnknownCC
deriving Eq
decodeSize :: String -> Integer
decodeSize str
| c == "" = truncate n
| c == "K" || c == "k" = truncate (n * 1000)
| c == "M" || c == "m" = truncate (n * 1000 * 1000)
| c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
| otherwise = throwGhcException (CmdLineError ("can't decode size: " ++ str))
where (m, c) = span pred str
n = readRational m
pred c = isDigit c || c == '.'
foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO ()
foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
data FilesToClean = FilesToClean {
ftcGhcSession :: !(Set FilePath),
ftcCurrentModule :: !(Set FilePath)
}
emptyFilesToClean :: FilesToClean
emptyFilesToClean = FilesToClean Set.empty Set.empty
initSDocContext :: DynFlags -> PprStyle -> SDocContext
initSDocContext dflags style = SDC
{ sdocStyle = style
, sdocColScheme = colScheme dflags
, sdocLastColour = Col.colReset
, sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags)
, sdocDefaultDepth = pprUserLength dflags
, sdocLineLength = pprCols dflags
, sdocCanUseUnicode = useUnicode dflags
, sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags
, sdocPprDebug = dopt Opt_D_ppr_debug dflags
, sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags
, sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags
, sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags
, sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags
, sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags
, sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags
, sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags
, sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags
, sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags
, sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags
, sdocSuppressTicks = gopt Opt_SuppressTicks dflags
, sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags
, sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags
, sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags
, sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags
, sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags
, sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags
, sdocSuppressUniques = gopt Opt_SuppressUniques dflags
, sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags
, sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags
, sdocErrorSpans = gopt Opt_ErrorSpans dflags
, sdocStarIsType = xopt LangExt.StarIsType dflags
, sdocImpredicativeTypes = xopt LangExt.ImpredicativeTypes dflags
, sdocLinearTypes = xopt LangExt.LinearTypes dflags
, sdocPrintTypeAbbreviations = True
, sdocDynFlags = dflags
}
initDefaultSDocContext :: DynFlags -> SDocContext
initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle