module DynFlags (
DynFlag(..),
WarningFlag(..),
ExtensionFlag(..),
LogAction,
glasgowExtsFlags,
dopt,
dopt_set,
dopt_unset,
wopt,
wopt_set,
wopt_unset,
xopt,
xopt_set,
xopt_unset,
DynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
Option(..), showOpt,
DynLibLoader(..),
fFlags, fWarningFlags, fLangFlags, xFlags,
DPHBackend(..), dphPackageMaybe,
wayNames, dynFlagDependencies,
SafeHaskellMode(..),
safeHaskellOn, safeLanguageOn,
safeDirectImpsReq, safeImplicitImpsReq,
Settings(..),
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
extraGccViaCFlags, systemPackageConfig,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
pgm_sysman, pgm_windres, pgm_lo, pgm_lc,
opt_L, opt_P, opt_F, opt_c, opt_a, opt_l,
opt_windres, opt_lo, opt_lc,
defaultDynFlags,
initDynFlags,
defaultLogAction,
getOpts,
getVerbFlags,
updOptLevel,
setTmpDir,
setPackageName,
doingTickyProfiling,
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
allFlags,
supportedLanguagesAndExtensions,
picCCOpts,
StgToDo(..),
getStgToDo,
compilerInfo
#ifdef GHCI
, rtsIsProfiled
#endif
) where
#include "HsVersions.h"
import Platform
import Module
import PackageConfig
import PrelNames ( mAIN )
import StaticFlags
import Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic
import Util
import Maybes ( orElse )
import SrcLoc
import FastString
import Outputable
#ifdef GHCI
import Foreign.C ( CInt )
#endif
import ErrUtils ( Severity(..), Message, mkLocMessage )
#ifdef GHCI
import System.IO.Unsafe ( unsafePerformIO )
#endif
import Data.IORef
import Control.Monad ( when )
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.IO ( stderr, hPutChar )
data DynFlag
= Opt_D_dump_cmm
| Opt_D_dump_raw_cmm
| Opt_D_dump_cmmz
| Opt_D_dump_cmmz_pretty
| Opt_D_dump_cmmz_cbe
| Opt_D_dump_cmmz_proc
| Opt_D_dump_cmmz_spills
| Opt_D_dump_cmmz_rewrite
| Opt_D_dump_cmmz_dead
| Opt_D_dump_cmmz_stub
| Opt_D_dump_cmmz_sp
| Opt_D_dump_cmmz_procmap
| Opt_D_dump_cmmz_split
| Opt_D_dump_cmmz_lower
| Opt_D_dump_cmmz_info
| Opt_D_dump_cmmz_cafs
| Opt_D_dump_cps_cmm
| Opt_D_dump_cvt_cmm
| Opt_D_dump_asm
| Opt_D_dump_asm_native
| Opt_D_dump_asm_liveness
| Opt_D_dump_asm_coalesce
| Opt_D_dump_asm_regalloc
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
| Opt_D_dump_asm_stats
| Opt_D_dump_asm_expanded
| Opt_D_dump_llvm
| Opt_D_dump_core_stats
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_flatC
| Opt_D_dump_foreign
| Opt_D_dump_inlinings
| Opt_D_dump_rule_firings
| Opt_D_dump_rule_rewrites
| Opt_D_dump_occur_anal
| Opt_D_dump_parsed
| Opt_D_dump_rn
| Opt_D_dump_core_pipeline
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
| Opt_D_dump_simpl_phases
| Opt_D_dump_spec
| Opt_D_dump_prep
| Opt_D_dump_stg
| Opt_D_dump_stranal
| Opt_D_dump_tc
| Opt_D_dump_types
| Opt_D_dump_rules
| Opt_D_dump_cse
| Opt_D_dump_worker_wrapper
| Opt_D_dump_rn_trace
| Opt_D_dump_rn_stats
| Opt_D_dump_opt_cmm
| Opt_D_dump_simpl_stats
| Opt_D_dump_cs_trace
| Opt_D_dump_tc_trace
| Opt_D_dump_if_trace
| Opt_D_dump_vt_trace
| Opt_D_dump_splices
| Opt_D_dump_BCOs
| Opt_D_dump_vect
| Opt_D_dump_hpc
| Opt_D_dump_rtti
| Opt_D_source_stats
| Opt_D_verbose_core2core
| Opt_D_verbose_stg2stg
| Opt_D_dump_hi
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_dump_mod_cycles
| Opt_D_dump_view_pattern_commoning
| Opt_D_faststring_stats
| Opt_DumpToFile
| Opt_D_no_debug_output
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
| Opt_DoAsmLinting
| Opt_WarnIsError
| Opt_PrintExplicitForalls
| Opt_Strictness
| Opt_FullLaziness
| Opt_FloatIn
| Opt_Specialise
| Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
| Opt_DictsCheap
| Opt_EnableRewriteRules
| Opt_Vectorise
| Opt_RegsGraph
| Opt_RegsIterative
| Opt_IgnoreInterfacePragmas
| Opt_OmitInterfacePragmas
| Opt_ExposeAllUnfoldings
| Opt_AutoSccsOnAllToplevs
| Opt_AutoSccsOnExportedToplevs
| Opt_AutoSccsOnIndividualCafs
| Opt_Pp
| Opt_ForceRecomp
| Opt_ExcessPrecision
| Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
| Opt_DistrustAllPackages
| Opt_PrintBindResult
| Opt_Haddock
| Opt_HaddockOptions
| Opt_Hpc_No_Auto
| Opt_BreakOnException
| Opt_BreakOnError
| Opt_PrintEvldWithShow
| Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
| Opt_EmitExternalCore
| Opt_SharedImplib
| Opt_BuildingCabalPackage
| Opt_SSE2
| Opt_GhciSandbox
| Opt_HelpfulErrors
| Opt_RunCPS
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
| Opt_ImplicitImportQualified
| Opt_TryNewCodeGen
| Opt_KeepHiDiffs
| Opt_KeepHcFiles
| Opt_KeepSFiles
| Opt_KeepTmpFiles
| Opt_KeepRawTokenStream
| Opt_KeepLlvmFiles
deriving (Eq, Show)
data WarningFlag =
Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnImplicitPrelude
| Opt_WarnIncompletePatterns
| Opt_WarnIncompleteUniPatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnMissingFields
| Opt_WarnMissingImportList
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
| Opt_WarnMissingLocalSigs
| Opt_WarnNameShadowing
| Opt_WarnOverlappingPatterns
| Opt_WarnTypeDefaults
| Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
| Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnAutoOrphans
| Opt_WarnIdentities
| Opt_WarnTabs
| Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
| Opt_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind
| Opt_WarnAlternativeLayoutRuleTransitional
deriving (Eq, Show)
data Language = Haskell98 | Haskell2010
data SafeHaskellMode
= Sf_None
| Sf_SafeImports
| Sf_Trustworthy
| Sf_Safe
deriving (Eq)
instance Outputable SafeHaskellMode where
ppr Sf_None = ptext $ sLit "None"
ppr Sf_SafeImports = ptext $ sLit "SafeImports"
ppr Sf_Trustworthy = ptext $ sLit "Trustworthy"
ppr Sf_Safe = ptext $ sLit "Safe"
data ExtensionFlag
= Opt_Cpp
| Opt_OverlappingInstances
| Opt_UndecidableInstances
| Opt_IncoherentInstances
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
| Opt_MonoLocalBinds
| Opt_RelaxedPolyRec
| Opt_ExtendedDefaultRules
| Opt_ForeignFunctionInterface
| Opt_UnliftedFFITypes
| Opt_InterruptibleFFI
| Opt_GHCForeignImportPrim
| Opt_ParallelArrays
| Opt_Arrows
| Opt_TemplateHaskell
| Opt_QuasiQuotes
| Opt_ImplicitParams
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
| Opt_UnboxedTuples
| Opt_BangPatterns
| Opt_TypeFamilies
| Opt_OverloadedStrings
| Opt_DisambiguateRecordFields
| Opt_RecordWildCards
| Opt_RecordPuns
| Opt_ViewPatterns
| Opt_GADTs
| Opt_GADTSyntax
| Opt_NPlusKPatterns
| Opt_DoAndIfThenElse
| Opt_RebindableSyntax
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_DeriveFunctor
| Opt_DeriveTraversable
| Opt_DeriveFoldable
| Opt_DeriveGeneric
| Opt_DefaultSignatures
| Opt_TypeSynonymInstances
| Opt_FlexibleContexts
| Opt_FlexibleInstances
| Opt_ConstrainedClassMethods
| Opt_MultiParamTypeClasses
| Opt_FunctionalDependencies
| Opt_UnicodeSyntax
| Opt_PolymorphicComponents
| Opt_ExistentialQuantification
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
| Opt_ParallelListComp
| Opt_TransformListComp
| Opt_MonadComprehensions
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_DoRec
| Opt_PostfixOperators
| Opt_TupleSections
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_RankNTypes
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
| Opt_ExplicitForAll
| Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional
| Opt_DatatypeContexts
| Opt_NondecreasingIndentation
| Opt_RelaxedLayout
deriving (Eq, Show)
data DynFlags = DynFlags {
ghcMode :: GhcMode,
ghcLink :: GhcLink,
hscTarget :: HscTarget,
hscOutName :: String,
extCoreName :: String,
verbosity :: Int,
optLevel :: Int,
simplPhases :: Int,
maxSimplIterations :: Int,
shouldDumpSimplPhase :: Maybe String,
ruleCheck :: Maybe String,
strictnessBefore :: [Int],
specConstrThreshold :: Maybe Int,
specConstrCount :: Maybe Int,
liberateCaseThreshold :: Maybe Int,
floatLamArgs :: Maybe Int,
targetPlatform :: Platform.Platform,
cmdlineHcIncludes :: [String],
importPaths :: [FilePath],
mainModIs :: Module,
mainFunIs :: Maybe String,
ctxtStkDepth :: Int,
dphBackend :: DPHBackend,
thisPackage :: PackageId,
ways :: [Way],
buildTag :: String,
rtsBuildTag :: String,
splitInfo :: Maybe (String,Int),
objectDir :: Maybe String,
dylibInstallName :: Maybe String,
hiDir :: Maybe String,
stubDir :: Maybe String,
objectSuf :: String,
hcSuf :: String,
hiSuf :: String,
outputFile :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
dumpPrefix :: Maybe FilePath,
dumpPrefixForce :: Maybe FilePath,
includePaths :: [String],
libraryPaths :: [String],
frameworkPaths :: [String],
cmdlineFrameworks :: [String],
rtsOpts :: Maybe String,
rtsOptsEnabled :: RtsOptsEnabled,
hpcDir :: String,
pluginModNames :: [ModuleName],
pluginModNameOpts :: [(ModuleName,String)],
settings :: Settings,
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
extraPkgConfs :: [FilePath],
packageFlags :: [PackageFlag],
pkgDatabase :: Maybe [PackageConfig],
pkgState :: PackageState,
filesToClean :: IORef [FilePath],
dirsToClean :: IORef (Map FilePath FilePath),
generatedDumps :: IORef (Set FilePath),
flags :: [DynFlag],
warningFlags :: [WarningFlag],
language :: Maybe Language,
safeHaskell :: SafeHaskellMode,
extensions :: [OnOff ExtensionFlag],
extensionFlags :: [ExtensionFlag],
log_action :: LogAction,
haddockOptions :: Maybe String
}
data Settings = Settings {
sGhcUsagePath :: FilePath,
sGhciUsagePath :: FilePath,
sTopDir :: FilePath,
sTmpDir :: String,
sRawSettings :: [(String, String)],
sExtraGccViaCFlags :: [String],
sSystemPackageConfig :: FilePath,
sPgm_L :: String,
sPgm_P :: (String,[Option]),
sPgm_F :: String,
sPgm_c :: (String,[Option]),
sPgm_s :: (String,[Option]),
sPgm_a :: (String,[Option]),
sPgm_l :: (String,[Option]),
sPgm_dll :: (String,[Option]),
sPgm_T :: String,
sPgm_sysman :: String,
sPgm_windres :: String,
sPgm_lo :: (String,[Option]),
sPgm_lc :: (String,[Option]),
sOpt_L :: [String],
sOpt_P :: [String],
sOpt_F :: [String],
sOpt_c :: [String],
sOpt_a :: [String],
sOpt_l :: [String],
sOpt_windres :: [String],
sOpt_lo :: [String],
sOpt_lc :: [String]
}
ghcUsagePath :: DynFlags -> FilePath
ghcUsagePath dflags = sGhcUsagePath (settings dflags)
ghciUsagePath :: DynFlags -> FilePath
ghciUsagePath dflags = sGhciUsagePath (settings dflags)
topDir :: DynFlags -> FilePath
topDir dflags = sTopDir (settings dflags)
tmpDir :: DynFlags -> String
tmpDir dflags = sTmpDir (settings dflags)
rawSettings :: DynFlags -> [(String, String)]
rawSettings dflags = sRawSettings (settings dflags)
extraGccViaCFlags :: DynFlags -> [String]
extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)
systemPackageConfig :: DynFlags -> FilePath
systemPackageConfig dflags = sSystemPackageConfig (settings dflags)
pgm_L :: DynFlags -> String
pgm_L dflags = sPgm_L (settings dflags)
pgm_P :: DynFlags -> (String,[Option])
pgm_P dflags = sPgm_P (settings dflags)
pgm_F :: DynFlags -> String
pgm_F dflags = sPgm_F (settings dflags)
pgm_c :: DynFlags -> (String,[Option])
pgm_c dflags = sPgm_c (settings dflags)
pgm_s :: DynFlags -> (String,[Option])
pgm_s dflags = sPgm_s (settings dflags)
pgm_a :: DynFlags -> (String,[Option])
pgm_a dflags = sPgm_a (settings dflags)
pgm_l :: DynFlags -> (String,[Option])
pgm_l dflags = sPgm_l (settings dflags)
pgm_dll :: DynFlags -> (String,[Option])
pgm_dll dflags = sPgm_dll (settings dflags)
pgm_T :: DynFlags -> String
pgm_T dflags = sPgm_T (settings dflags)
pgm_sysman :: DynFlags -> String
pgm_sysman dflags = sPgm_sysman (settings dflags)
pgm_windres :: DynFlags -> String
pgm_windres dflags = sPgm_windres (settings dflags)
pgm_lo :: DynFlags -> (String,[Option])
pgm_lo dflags = sPgm_lo (settings dflags)
pgm_lc :: DynFlags -> (String,[Option])
pgm_lc dflags = sPgm_lc (settings dflags)
opt_L :: DynFlags -> [String]
opt_L dflags = sOpt_L (settings dflags)
opt_P :: DynFlags -> [String]
opt_P dflags = sOpt_P (settings dflags)
opt_F :: DynFlags -> [String]
opt_F dflags = sOpt_F (settings dflags)
opt_c :: DynFlags -> [String]
opt_c dflags = sOpt_c (settings dflags)
opt_a :: DynFlags -> [String]
opt_a dflags = sOpt_a (settings dflags)
opt_l :: DynFlags -> [String]
opt_l dflags = sOpt_l (settings dflags)
opt_windres :: DynFlags -> [String]
opt_windres dflags = sOpt_windres (settings dflags)
opt_lo :: DynFlags -> [String]
opt_lo dflags = sOpt_lo (settings dflags)
opt_lc :: DynFlags -> [String]
opt_lc dflags = sOpt_lc (settings dflags)
wayNames :: DynFlags -> [WayName]
wayNames = map wayName . ways
data HscTarget
= HscC
| HscAsm
| HscLlvm
| HscInterpreted
| HscNothing
deriving (Eq, Show)
showHscTargetFlag :: HscTarget -> String
showHscTargetFlag HscC = "-fvia-c"
showHscTargetFlag HscAsm = "-fasm"
showHscTargetFlag HscLlvm = "-fllvm"
showHscTargetFlag HscInterpreted = "-fbyte-code"
showHscTargetFlag HscNothing = "-fno-code"
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True
isObjectTarget HscAsm = True
isObjectTarget HscLlvm = True
isObjectTarget _ = False
data GhcMode
= CompManager
| OneShot
| MkDepend
deriving Eq
instance Outputable GhcMode where
ppr CompManager = ptext (sLit "CompManager")
ppr OneShot = ptext (sLit "OneShot")
ppr MkDepend = ptext (sLit "MkDepend")
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
isOneShot _other = False
data GhcLink
= NoLink
| LinkBinary
| LinkInMemory
| LinkDynLib
deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
doingTickyProfiling :: DynFlags -> Bool
doingTickyProfiling _ = opt_Ticky
data PackageFlag
= ExposePackage String
| ExposePackageId String
| HidePackage String
| IgnorePackage String
| TrustPackage String
| DistrustPackage String
deriving Eq
defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
defaultObjectTarget :: HscTarget
defaultObjectTarget
| cGhcUnregisterised == "YES" = HscC
| cGhcWithNativeCodeGen == "YES" = HscAsm
| otherwise = HscLlvm
data DynLibLoader
= Deployable
| SystemDependent
deriving Eq
data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
deriving (Show)
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps
}
defaultDynFlags :: Settings -> DynFlags
defaultDynFlags mySettings =
DynFlags {
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget,
hscOutName = "",
extCoreName = "",
verbosity = 0,
optLevel = 0,
simplPhases = 2,
maxSimplIterations = 4,
shouldDumpSimplPhase = Nothing,
ruleCheck = Nothing,
specConstrThreshold = Just 2000,
specConstrCount = Just 3,
liberateCaseThreshold = Just 2000,
floatLamArgs = Just 0,
strictnessBefore = [],
targetPlatform = defaultTargetPlatform,
cmdlineHcIncludes = [],
importPaths = ["."],
mainModIs = mAIN,
mainFunIs = Nothing,
ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
dphBackend = DPHNone,
thisPackage = mainPackageId,
objectDir = Nothing,
dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
objectSuf = phaseInputExt StopLn,
hcSuf = phaseInputExt HCc,
hiSuf = "hi",
pluginModNames = [],
pluginModNameOpts = [],
outputFile = Nothing,
outputHi = Nothing,
dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
includePaths = [],
libraryPaths = [],
frameworkPaths = [],
cmdlineFrameworks = [],
rtsOpts = Nothing,
rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
extraPkgConfs = [],
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
ways = panic "defaultDynFlags: No ways",
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing,
settings = mySettings,
depMakefile = "Makefile",
depIncludePkgDeps = False,
depExcludeMods = [],
depSuffixes = [],
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing,
flags = defaultFlags,
warningFlags = standardWarnings,
language = Nothing,
safeHaskell = Sf_None,
extensions = [],
extensionFlags = flattenExtensionFlags Nothing [],
log_action = defaultLogAction
}
type LogAction = Severity -> SrcSpan -> PprStyle -> Message -> IO ()
defaultLogAction :: LogAction
defaultLogAction severity srcSpan style msg
= case severity of
SevOutput -> printSDoc msg style
SevInfo -> printErrs msg style
SevFatal -> printErrs msg style
_ -> do hPutChar stderr '\n'
printErrs (mkLocMessage srcSpan msg) style
data OnOff a = On a
| Off a
flattenExtensionFlags :: Maybe Language -> [OnOff ExtensionFlag]
-> [ExtensionFlag]
flattenExtensionFlags ml = foldr f defaultExtensionFlags
where f (On f) flags = f : delete f flags
f (Off f) flags = delete f flags
defaultExtensionFlags = languageExtensions ml
languageExtensions :: Maybe Language -> [ExtensionFlag]
languageExtensions Nothing
= Opt_MonoPatBinds
: Opt_NondecreasingIndentation
: delete Opt_DatatypeContexts
(languageExtensions (Just Haskell2010))
languageExtensions (Just Haskell98)
= [Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
Opt_NPlusKPatterns,
Opt_DatatypeContexts,
Opt_NondecreasingIndentation
]
languageExtensions (Just Haskell2010)
= [Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
Opt_DatatypeContexts,
Opt_EmptyDataDecls,
Opt_ForeignFunctionInterface,
Opt_PatternGuards,
Opt_DoAndIfThenElse,
Opt_RelaxedPolyRec]
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags)
dopt_set :: DynFlags -> DynFlag -> DynFlags
dopt_set dfs f = dfs{ flags = f : flags dfs }
dopt_unset :: DynFlags -> DynFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
wopt :: WarningFlag -> DynFlags -> Bool
wopt f dflags = f `elem` (warningFlags dflags)
wopt_set :: DynFlags -> WarningFlag -> DynFlags
wopt_set dfs f = dfs{ warningFlags = f : warningFlags dfs }
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset dfs f = dfs{ warningFlags = filter (/= f) (warningFlags dfs) }
xopt :: ExtensionFlag -> DynFlags -> Bool
xopt f dflags = f `elem` extensionFlags dflags
xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
xopt_set dfs f
= let onoffs = On f : extensions dfs
in dfs { extensions = onoffs,
extensionFlags = flattenExtensionFlags (language dfs) onoffs }
xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
xopt_unset dfs f
= let onoffs = Off f : extensions dfs
in dfs { extensions = onoffs,
extensionFlags = flattenExtensionFlags (language dfs) onoffs }
setLanguage :: Language -> DynP ()
setLanguage l = upd f
where f dfs = let mLang = Just l
oneoffs = extensions dfs
in dfs {
language = mLang,
extensionFlags = flattenExtensionFlags mLang oneoffs
}
dynFlagDependencies :: DynFlags -> [ModuleName]
dynFlagDependencies = pluginModNames
safeLanguageOn :: DynFlags -> Bool
safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
safeHaskellOn :: DynFlags -> Bool
safeHaskellOn dflags = safeHaskell dflags /= Sf_None
setSafeHaskell :: SafeHaskellMode -> DynP ()
setSafeHaskell s = updM f
where f dfs = do
let sf = safeHaskell dfs
safeM <- combineSafeFlags sf s
return $ dfs { safeHaskell = safeM }
safeDirectImpsReq :: DynFlags -> Bool
safeDirectImpsReq = safeLanguageOn
safeImplicitImpsReq :: DynFlags -> Bool
safeImplicitImpsReq = safeLanguageOn
combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
combineSafeFlags a b =
case (a,b) of
(Sf_None, sf) -> return sf
(sf, Sf_None) -> return sf
(Sf_SafeImports, sf) -> return sf
(sf, Sf_SafeImports) -> return sf
(Sf_Trustworthy, Sf_Safe) -> err
(Sf_Safe, Sf_Trustworthy) -> err
(a,b) | a == b -> return a
| otherwise -> err
where err = do
let s = "Incompatible Safe Haskell flags! (" ++ showPpr a ++ ", " ++ showPpr b ++ ")"
addErr s
return $ panic s
getOpts :: DynFlags
-> (DynFlags -> [a])
-> [a]
getOpts dflags opts = reverse (opts dflags)
getVerbFlags :: DynFlags -> [String]
getVerbFlags dflags
| verbosity dflags >= 4 = ["-v"]
| otherwise = []
setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, addOptl, addOptP,
addCmdlineFramework, addHaddockOpts
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags
setObjectDir f d = d{ objectDir = Just f}
setHiDir f d = d{ hiDir = Just f}
setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
setOutputDir f = setObjectDir f . setHiDir f . setStubDir f
setDylibInstallName f d = d{ dylibInstallName = Just f}
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setHcSuf f d = d{ hcSuf = f}
setOutputFile f d = d{ outputFile = f}
setOutputHi f d = d{ outputHi = f}
addPluginModuleName :: String -> DynFlags -> DynFlags
addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
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
parseDynLibLoaderMode f d =
case splitAt 8 f of
("deploy", "") -> d{ dynLibLoader = Deployable }
("sysdep", "") -> d{ dynLibLoader = SystemDependent }
_ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
setDumpPrefixForce f d = d { dumpPrefixForce = f}
setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s})
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = deOptDep f }
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
addDepExcludeMod :: String -> DynFlags -> DynFlags
addDepExcludeMod m d
= d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
deOptDep :: String -> String
deOptDep x = case stripPrefix "-optdep" x of
Just rest -> rest
Nothing -> x
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
addHaddockOpts f d = d{ haddockOptions = Just f}
data Option
= FileOption
String
String
| Option String
deriving ( Eq )
showOpt :: Option -> String
showOpt (FileOption pre f) = pre ++ f
showOpt (Option s) = s
updOptLevel :: Int -> DynFlags -> DynFlags
updOptLevel n dfs
= dfs2{ optLevel = final_n }
where
final_n = max 0 (min 2 n)
dfs1 = foldr (flip dopt_unset) dfs remove_dopts
dfs2 = foldr (flip dopt_set) dfs1 extra_dopts
extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
data StgToDo
= StgDoMassageForProfiling
| D_stg_stats
getStgToDo :: DynFlags -> [StgToDo]
getStgToDo dflags
= todo2
where
stg_stats = dopt Opt_StgStats dflags
todo1 = if stg_stats then [D_stg_stats] else []
todo2 | WayProf `elem` wayNames dflags
= StgDoMassageForProfiling : todo1
| otherwise
= todo1
parseDynamicFlagsCmdLine :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlagsCmdLine dflags args = parseDynamicFlags dflags args True
parseDynamicFilePragma :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
parseDynamicFilePragma dflags args = parseDynamicFlags dflags args False
parseDynamicFlags :: Monad m =>
DynFlags -> [Located String] -> Bool
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags dflags0 args cmdline = do
let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
f (x : xs) = x : f xs
f xs = xs
args' = f args
flag_spec | cmdline = package_flags ++ dynamic_flags
| otherwise = dynamic_flags
let safeLevel = if safeLanguageOn dflags0
then determineSafeLevel cmdline else NeverAllowed
let ((leftover, errs, warns), dflags1)
= runCmdLine (processArgs flag_spec args' safeLevel cmdline) dflags0
when (not (null errs)) $ ghcError $ errorsToGhcException errs
let (dflags2, sh_warns) = if (safeLanguageOn dflags1)
then shFlagsDisallowed dflags1
else (dflags1, [])
return (dflags2, leftover, sh_warns ++ warns)
shFlagsDisallowed :: DynFlags -> (DynFlags, [Located String])
shFlagsDisallowed dflags = foldl check_method (dflags, []) bad_flags
where
check_method (df, warns) (test,str,fix)
| test df = (fix df, warns ++ safeFailure str)
| otherwise = (df, warns)
bad_flags = [(xopt Opt_GeneralizedNewtypeDeriving, "-XGeneralizedNewtypeDeriving",
flip xopt_unset Opt_GeneralizedNewtypeDeriving),
(xopt Opt_TemplateHaskell, "-XTemplateHaskell",
flip xopt_unset Opt_TemplateHaskell)]
safeFailure str = [L noSrcSpan $ "Warning: " ++ str ++ " is not allowed in"
++ " Safe Haskell; ignoring " ++ str]
allFlags :: [String]
allFlags = map ('-':) $
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) fflags ++
map ("f"++) fflags ++
map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
fflags = fflags0 ++ fflags1 ++ fflags2
fflags0 = [ name | (name, _, _, _) <- fFlags ]
fflags1 = [ name | (name, _, _, _) <- fWarningFlags ]
fflags2 = [ name | (name, _, _, _) <- fLangFlags ]
dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [
flagA "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
, flagA "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, flagA "F" (NoArg (setDynFlag Opt_Pp))
, flagA "#include"
(HasArg (\s -> do { addCmdlineHCInclude s
; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
, flagA "v" (OptIntSuffix setVerbosity)
, flagA "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
, flagA "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])})))
, flagA "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f})))
, flagA "pgmP" (hasArg setPgmP)
, flagA "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f})))
, flagA "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])})))
, flagA "pgmm" (HasArg (\_ -> addWarn "The -pgmm flag does nothing; it will be removed in a future GHC release"))
, flagA "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])})))
, flagA "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])})))
, flagA "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])})))
, flagA "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
, flagA "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
, flagA "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s})))
, flagA "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s})))
, flagA "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, flagA "optP" (hasArg addOptP)
, flagA "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
, flagA "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s})))
, flagA "optm" (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release"))
, flagA "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, flagA "optl" (hasArg addOptl)
, flagA "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
, flagA "split-objs"
(NoArg (if can_split
then setDynFlag Opt_SplitObjs
else addWarn "ignoring -fsplit-objs"))
, flagA "dep-suffix" (hasArg addDepSuffix)
, flagA "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
, flagA "dep-makefile" (hasArg setDepMakefile)
, flagA "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
, flagA "optdep-w" (NoArg (deprecate "doesn't do anything"))
, flagA "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
, flagA "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, flagA "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, flagA "exclude-module" (hasArg addDepExcludeMod)
, flagA "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, flagA "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, flagA "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
, flagA "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
, flagA "dynload" (hasArg parseDynLibLoaderMode)
, flagA "dylib-install-name" (hasArg setDylibInstallName)
, flagA "L" (Prefix addLibraryPath)
, flagA "l" (hasArg (addOptl . ("-l" ++)))
, flagA "framework-path" (HasArg addFrameworkPath)
, flagA "framework" (hasArg addCmdlineFramework)
, flagA "odir" (hasArg setObjectDir)
, flagA "o" (sepArg (setOutputFile . Just))
, flagA "ohi" (hasArg (setOutputHi . Just ))
, flagA "osuf" (hasArg setObjectSuf)
, flagA "hcsuf" (hasArg setHcSuf)
, flagA "hisuf" (hasArg setHiSuf)
, flagA "hidir" (hasArg setHiDir)
, flagA "tmpdir" (hasArg setTmpDir)
, flagA "stubdir" (hasArg setStubDir)
, flagA "outputdir" (hasArg setOutputDir)
, flagA "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
, flagA "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles))
, flagA "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles))
, flagA "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles))
, flagA "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles))
, flagA "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
, flagA "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
, flagA "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles))
, flagA "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles))
, flagA "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles))
, flagA "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
, flagA "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain))
, flagA "with-rtsopts" (HasArg setRtsOpts)
, flagA "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll))
, flagA "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll))
, flagA "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
, flagA "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone))
, flagA "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone))
, flagA "main-is" (SepArg setMainIs)
, flagA "haddock" (NoArg (setDynFlag Opt_Haddock))
, flagA "haddock-opts" (hasArg addHaddockOpts)
, flagA "hpcdir" (SepArg setOptHpcDir)
, flagA "recomp" (NoArg (do { unSetDynFlag Opt_ForceRecomp
; deprecate "Use -fno-force-recomp instead" }))
, flagA "no-recomp" (NoArg (do { setDynFlag Opt_ForceRecomp
; deprecate "Use -fforce-recomp instead" }))
, flagA "D" (AnySuffix (upd . addOptP))
, flagA "U" (AnySuffix (upd . addOptP))
, flagA "I" (Prefix addIncludePath)
, flagA "i" (OptPrefix addImportPath)
, flagA "dstg-stats" (NoArg (setDynFlag Opt_StgStats))
, flagA "ddump-cmm" (setDumpFlag Opt_D_dump_cmm)
, flagA "ddump-raw-cmm" (setDumpFlag Opt_D_dump_raw_cmm)
, flagA "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz)
, flagA "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty)
, flagA "ddump-cmmz-cbe" (setDumpFlag Opt_D_dump_cmmz_cbe)
, flagA "ddump-cmmz-spills" (setDumpFlag Opt_D_dump_cmmz_spills)
, flagA "ddump-cmmz-proc" (setDumpFlag Opt_D_dump_cmmz_proc)
, flagA "ddump-cmmz-rewrite" (setDumpFlag Opt_D_dump_cmmz_rewrite)
, flagA "ddump-cmmz-dead" (setDumpFlag Opt_D_dump_cmmz_dead)
, flagA "ddump-cmmz-stub" (setDumpFlag Opt_D_dump_cmmz_stub)
, flagA "ddump-cmmz-sp" (setDumpFlag Opt_D_dump_cmmz_sp)
, flagA "ddump-cmmz-procmap" (setDumpFlag Opt_D_dump_cmmz_procmap)
, flagA "ddump-cmmz-split" (setDumpFlag Opt_D_dump_cmmz_split)
, flagA "ddump-cmmz-lower" (setDumpFlag Opt_D_dump_cmmz_lower)
, flagA "ddump-cmmz-info" (setDumpFlag Opt_D_dump_cmmz_info)
, flagA "ddump-cmmz-cafs" (setDumpFlag Opt_D_dump_cmmz_cafs)
, flagA "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats)
, flagA "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm)
, flagA "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm)
, flagA "ddump-asm" (setDumpFlag Opt_D_dump_asm)
, flagA "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native)
, flagA "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness)
, flagA "ddump-asm-coalesce" (setDumpFlag Opt_D_dump_asm_coalesce)
, flagA "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc)
, flagA "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts)
, flagA "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
, flagA "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
, flagA "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
, flagA "ddump-llvm" (NoArg (do { setObjTarget HscLlvm
; setDumpFlag' Opt_D_dump_llvm}))
, flagA "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
, flagA "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
, flagA "ddump-ds" (setDumpFlag Opt_D_dump_ds)
, flagA "ddump-flatC" (setDumpFlag Opt_D_dump_flatC)
, flagA "ddump-foreign" (setDumpFlag Opt_D_dump_foreign)
, flagA "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings)
, flagA "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings)
, flagA "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites)
, flagA "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal)
, flagA "ddump-parsed" (setDumpFlag Opt_D_dump_parsed)
, flagA "ddump-rn" (setDumpFlag Opt_D_dump_rn)
, flagA "ddump-core-pipeline" (setDumpFlag Opt_D_dump_core_pipeline)
, flagA "ddump-simpl" (setDumpFlag Opt_D_dump_simpl)
, flagA "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations)
, flagA "ddump-simpl-phases" (OptPrefix setDumpSimplPhases)
, flagA "ddump-spec" (setDumpFlag Opt_D_dump_spec)
, flagA "ddump-prep" (setDumpFlag Opt_D_dump_prep)
, flagA "ddump-stg" (setDumpFlag Opt_D_dump_stg)
, flagA "ddump-stranal" (setDumpFlag Opt_D_dump_stranal)
, flagA "ddump-tc" (setDumpFlag Opt_D_dump_tc)
, flagA "ddump-types" (setDumpFlag Opt_D_dump_types)
, flagA "ddump-rules" (setDumpFlag Opt_D_dump_rules)
, flagA "ddump-cse" (setDumpFlag Opt_D_dump_cse)
, flagA "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper)
, flagA "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace)
, flagA "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace)
, flagA "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace)
, flagA "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace)
, flagA "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace)
, flagA "ddump-splices" (setDumpFlag Opt_D_dump_splices)
, flagA "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats)
, flagA "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm)
, flagA "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats)
, flagA "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs)
, flagA "dsource-stats" (setDumpFlag Opt_D_source_stats)
, flagA "dverbose-core2core" (NoArg (do { setVerbosity (Just 2)
; setVerboseCore2Core }))
, flagA "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
, flagA "ddump-hi" (setDumpFlag Opt_D_dump_hi)
, flagA "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports)
, flagA "ddump-vect" (setDumpFlag Opt_D_dump_vect)
, flagA "ddump-hpc" (setDumpFlag Opt_D_dump_hpc)
, flagA "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles)
, flagA "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
, flagA "ddump-to-file" (setDumpFlag Opt_DumpToFile)
, flagA "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
, flagA "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
, flagA "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting))
, flagA "dstg-lint" (NoArg (setDynFlag Opt_DoStgLinting))
, flagA "dcmm-lint" (NoArg (setDynFlag Opt_DoCmmLinting))
, flagA "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting))
, flagA "dshow-passes" (NoArg (do forceRecompile
setVerbosity (Just 2)))
, flagA "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats))
, flagA "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
, flagA "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
, flagA "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
, flagA "msse2" (NoArg (setDynFlag Opt_SSE2))
, flagA "W" (NoArg (mapM_ setWarningFlag minusWOpts))
, flagA "Werror" (NoArg (setDynFlag Opt_WarnIsError))
, flagA "Wwarn" (NoArg (unSetDynFlag Opt_WarnIsError))
, flagA "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts))
, flagA "Wnot" (NoArg (do upd (\dfs -> dfs {warningFlags = []})
deprecate "Use -w instead"))
, flagA "w" (NoArg (upd (\dfs -> dfs {warningFlags = []})))
, flagA "fplugin-opt" (hasArg addPluginModuleNameOption)
, flagA "fplugin" (hasArg addPluginModuleName)
, flagA "O" (noArgM (setOptLevel 1))
, flagA "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead"
setOptLevel 0 dflags))
, flagA "Odph" (noArgM setDPHOpt)
, flagA "O" (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1)))
, flagA "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n }))
, flagA "fmax-simplifier-iterations" (intSuffix (\n d -> d{ maxSimplIterations = n }))
, flagA "fspec-constr-threshold" (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
, flagA "fno-spec-constr-threshold" (noArg (\d -> d{ specConstrThreshold = Nothing }))
, flagA "fspec-constr-count" (intSuffix (\n d -> d{ specConstrCount = Just n }))
, flagA "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount = Nothing }))
, flagA "fliberate-case-threshold" (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
, flagA "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
, flagA "frule-check" (sepArg (\s d -> d{ ruleCheck = Just s }))
, flagA "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n }))
, flagA "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
, flagA "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n }))
, flagA "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing }))
, flagA "fauto-sccs-on-all-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
, flagA "auto-all" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
, flagA "no-auto-all" (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
, flagA "fauto-sccs-on-exported-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
, flagA "auto" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
, flagA "no-auto" (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
, flagA "fauto-sccs-on-individual-cafs" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
, flagA "caf-all" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
, flagA "no-caf-all" (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
, flagA "fdph-seq" (NoArg (setDPHBackend DPHSeq))
, flagA "fdph-par" (NoArg (setDPHBackend DPHPar))
, flagA "fdph-this" (NoArg (setDPHBackend DPHThis))
, flagA "fdph-none" (NoArg (setDPHBackend DPHNone))
, flagA "fasm" (NoArg (setObjTarget HscAsm))
, flagA "fvia-c" (NoArg
(addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release"))
, flagA "fvia-C" (NoArg
(addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release"))
, flagA "fllvm" (NoArg (setObjTarget HscLlvm))
, flagA "fno-code" (NoArg (do { upd $ \d -> d{ ghcLink=NoLink }
; setTarget HscNothing }))
, flagA "fbyte-code" (NoArg (setTarget HscInterpreted))
, flagA "fobject-code" (NoArg (setTarget defaultHscTarget))
, flagA "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
, flagA "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
]
++ map (mkFlag turnOn "f" setDynFlag ) fFlags
++ map (mkFlag turnOff "fno-" unSetDynFlag) fFlags
++ map (mkFlag turnOn "f" setWarningFlag ) fWarningFlags
++ map (mkFlag turnOff "fno-" unSetWarningFlag) fWarningFlags
++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlags
++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlags
++ map (mkFlag turnOn "X" setExtensionFlag ) xFlags
++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlags
++ map (mkFlag turnOn "X" setLanguage) languageFlags
++ map (mkFlag turnOn "X" setSafeHaskell) safeHaskellFlags
++ [ flagA "XGenerics" (NoArg (deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support."))
, flagA "XNoGenerics" (NoArg (deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support.")) ]
package_flags :: [Flag (CmdLineP DynFlags)]
package_flags = [
flagC "package-conf" (HasArg extraPkgConf_)
, flagC "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
, flagC "package-name" (hasArg setPackageName)
, flagC "package-id" (HasArg exposePackageId)
, flagC "package" (HasArg exposePackage)
, flagC "hide-package" (HasArg hidePackage)
, flagC "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
, flagC "ignore-package" (HasArg ignorePackage)
, flagC "syslib" (HasArg (\s -> do { exposePackage s
; deprecate "Use -package instead" }))
, flagC "trust" (HasArg trustPackage)
, flagC "distrust" (HasArg distrustPackage)
, flagC "distrust-all-packages" (NoArg (setDynFlag Opt_DistrustAllPackages))
]
type TurnOnFlag = Bool
turnOn :: TurnOnFlag; turnOn = True
turnOff :: TurnOnFlag; turnOff = False
type FlagSpec flag
= ( String
, FlagSafety
, flag
, TurnOnFlag -> DynP ())
mkFlag :: TurnOnFlag
-> String
-> (flag -> DynP ())
-> FlagSpec flag
-> Flag (CmdLineP DynFlags)
mkFlag turn_on flagPrefix f (name, fsafe, flag, extra_action)
= Flag (flagPrefix ++ name) fsafe (NoArg (f flag >> extra_action turn_on))
deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
deprecatedForExtension lang turn_on
= deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where
flag | turn_on = lang
| otherwise = "No"++lang
useInstead :: String -> TurnOnFlag -> DynP ()
useInstead flag turn_on
= deprecate ("Use -f" ++ no ++ flag ++ " instead")
where
no = if turn_on then "" else "no-"
nop :: TurnOnFlag -> DynP ()
nop _ = return ()
fWarningFlags :: [FlagSpec WarningFlag]
fWarningFlags = [
( "warn-dodgy-foreign-imports", AlwaysAllowed, Opt_WarnDodgyForeignImports, nop ),
( "warn-dodgy-exports", AlwaysAllowed, Opt_WarnDodgyExports, nop ),
( "warn-dodgy-imports", AlwaysAllowed, Opt_WarnDodgyImports, nop ),
( "warn-duplicate-exports", AlwaysAllowed, Opt_WarnDuplicateExports, nop ),
( "warn-hi-shadowing", AlwaysAllowed, Opt_WarnHiShadows, nop ),
( "warn-implicit-prelude", AlwaysAllowed, Opt_WarnImplicitPrelude, nop ),
( "warn-incomplete-patterns", AlwaysAllowed, Opt_WarnIncompletePatterns, nop ),
( "warn-incomplete-uni-patterns", AlwaysAllowed, Opt_WarnIncompleteUniPatterns, nop ),
( "warn-incomplete-record-updates", AlwaysAllowed, Opt_WarnIncompletePatternsRecUpd, nop ),
( "warn-missing-fields", AlwaysAllowed, Opt_WarnMissingFields, nop ),
( "warn-missing-import-lists", AlwaysAllowed, Opt_WarnMissingImportList, nop ),
( "warn-missing-methods", AlwaysAllowed, Opt_WarnMissingMethods, nop ),
( "warn-missing-signatures", AlwaysAllowed, Opt_WarnMissingSigs, nop ),
( "warn-missing-local-sigs", AlwaysAllowed, Opt_WarnMissingLocalSigs, nop ),
( "warn-name-shadowing", AlwaysAllowed, Opt_WarnNameShadowing, nop ),
( "warn-overlapping-patterns", AlwaysAllowed, Opt_WarnOverlappingPatterns, nop ),
( "warn-type-defaults", AlwaysAllowed, Opt_WarnTypeDefaults, nop ),
( "warn-monomorphism-restriction", AlwaysAllowed, Opt_WarnMonomorphism, nop ),
( "warn-unused-binds", AlwaysAllowed, Opt_WarnUnusedBinds, nop ),
( "warn-unused-imports", AlwaysAllowed, Opt_WarnUnusedImports, nop ),
( "warn-unused-matches", AlwaysAllowed, Opt_WarnUnusedMatches, nop ),
( "warn-warnings-deprecations", AlwaysAllowed, Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecations", AlwaysAllowed, Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecated-flags", AlwaysAllowed, Opt_WarnDeprecatedFlags, nop ),
( "warn-orphans", AlwaysAllowed, Opt_WarnOrphans, nop ),
( "warn-identities", AlwaysAllowed, Opt_WarnIdentities, nop ),
( "warn-auto-orphans", AlwaysAllowed, Opt_WarnAutoOrphans, nop ),
( "warn-tabs", AlwaysAllowed, Opt_WarnTabs, nop ),
( "warn-unrecognised-pragmas", AlwaysAllowed, Opt_WarnUnrecognisedPragmas, nop ),
( "warn-lazy-unlifted-bindings", AlwaysAllowed, Opt_WarnLazyUnliftedBindings, nop),
( "warn-unused-do-bind", AlwaysAllowed, Opt_WarnUnusedDoBind, nop ),
( "warn-wrong-do-bind", AlwaysAllowed, Opt_WarnWrongDoBind, nop ),
( "warn-alternative-layout-rule-transitional", AlwaysAllowed, Opt_WarnAlternativeLayoutRuleTransitional, nop )]
fFlags :: [FlagSpec DynFlag]
fFlags = [
( "print-explicit-foralls", AlwaysAllowed, Opt_PrintExplicitForalls, nop ),
( "strictness", AlwaysAllowed, Opt_Strictness, nop ),
( "specialise", AlwaysAllowed, Opt_Specialise, nop ),
( "float-in", AlwaysAllowed, Opt_FloatIn, nop ),
( "static-argument-transformation", AlwaysAllowed, Opt_StaticArgumentTransformation, nop ),
( "full-laziness", AlwaysAllowed, Opt_FullLaziness, nop ),
( "liberate-case", AlwaysAllowed, Opt_LiberateCase, nop ),
( "spec-constr", AlwaysAllowed, Opt_SpecConstr, nop ),
( "cse", AlwaysAllowed, Opt_CSE, nop ),
( "ignore-interface-pragmas", AlwaysAllowed, Opt_IgnoreInterfacePragmas, nop ),
( "omit-interface-pragmas", AlwaysAllowed, Opt_OmitInterfacePragmas, nop ),
( "expose-all-unfoldings", AlwaysAllowed, Opt_ExposeAllUnfoldings, nop ),
( "do-lambda-eta-expansion", AlwaysAllowed, Opt_DoLambdaEtaExpansion, nop ),
( "ignore-asserts", AlwaysAllowed, Opt_IgnoreAsserts, nop ),
( "do-eta-reduction", AlwaysAllowed, Opt_DoEtaReduction, nop ),
( "case-merge", AlwaysAllowed, Opt_CaseMerge, nop ),
( "unbox-strict-fields", AlwaysAllowed, Opt_UnboxStrictFields, nop ),
( "dicts-cheap", AlwaysAllowed, Opt_DictsCheap, nop ),
( "excess-precision", AlwaysAllowed, Opt_ExcessPrecision, nop ),
( "eager-blackholing", AlwaysAllowed, Opt_EagerBlackHoling, nop ),
( "print-bind-result", AlwaysAllowed, Opt_PrintBindResult, nop ),
( "force-recomp", AlwaysAllowed, Opt_ForceRecomp, nop ),
( "hpc-no-auto", AlwaysAllowed, Opt_Hpc_No_Auto, nop ),
( "rewrite-rules", AlwaysAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
( "enable-rewrite-rules", AlwaysAllowed, Opt_EnableRewriteRules, nop ),
( "break-on-exception", AlwaysAllowed, Opt_BreakOnException, nop ),
( "break-on-error", AlwaysAllowed, Opt_BreakOnError, nop ),
( "print-evld-with-show", AlwaysAllowed, Opt_PrintEvldWithShow, nop ),
( "print-bind-contents", AlwaysAllowed, Opt_PrintBindContents, nop ),
( "run-cps", AlwaysAllowed, Opt_RunCPS, nop ),
( "run-cpsz", AlwaysAllowed, Opt_RunCPSZ, nop ),
( "new-codegen", AlwaysAllowed, Opt_TryNewCodeGen, nop ),
( "convert-to-zipper-and-back", AlwaysAllowed, Opt_ConvertToZipCfgAndBack, nop ),
( "vectorise", AlwaysAllowed, Opt_Vectorise, nop ),
( "regs-graph", AlwaysAllowed, Opt_RegsGraph, nop ),
( "regs-iterative", AlwaysAllowed, Opt_RegsIterative, nop ),
( "gen-manifest", AlwaysAllowed, Opt_GenManifest, nop ),
( "embed-manifest", AlwaysAllowed, Opt_EmbedManifest, nop ),
( "ext-core", AlwaysAllowed, Opt_EmitExternalCore, nop ),
( "shared-implib", AlwaysAllowed, Opt_SharedImplib, nop ),
( "ghci-sandbox", AlwaysAllowed, Opt_GhciSandbox, nop ),
( "helpful-errors", AlwaysAllowed, Opt_HelpfulErrors, nop ),
( "building-cabal-package", AlwaysAllowed, Opt_BuildingCabalPackage, nop ),
( "implicit-import-qualified", AlwaysAllowed, Opt_ImplicitImportQualified, nop )
]
fLangFlags :: [FlagSpec ExtensionFlag]
fLangFlags = [
( "th", NeverAllowed, Opt_TemplateHaskell,
deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
( "fi", RestrictedFunction, Opt_ForeignFunctionInterface,
deprecatedForExtension "ForeignFunctionInterface" ),
( "ffi", RestrictedFunction, Opt_ForeignFunctionInterface,
deprecatedForExtension "ForeignFunctionInterface" ),
( "arrows", AlwaysAllowed, Opt_Arrows,
deprecatedForExtension "Arrows" ),
( "implicit-prelude", AlwaysAllowed, Opt_ImplicitPrelude,
deprecatedForExtension "ImplicitPrelude" ),
( "bang-patterns", AlwaysAllowed, Opt_BangPatterns,
deprecatedForExtension "BangPatterns" ),
( "monomorphism-restriction", AlwaysAllowed, Opt_MonomorphismRestriction,
deprecatedForExtension "MonomorphismRestriction" ),
( "mono-pat-binds", AlwaysAllowed, Opt_MonoPatBinds,
deprecatedForExtension "MonoPatBinds" ),
( "extended-default-rules", AlwaysAllowed, Opt_ExtendedDefaultRules,
deprecatedForExtension "ExtendedDefaultRules" ),
( "implicit-params", AlwaysAllowed, Opt_ImplicitParams,
deprecatedForExtension "ImplicitParams" ),
( "scoped-type-variables", AlwaysAllowed, Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
( "parr", AlwaysAllowed, Opt_ParallelArrays,
deprecatedForExtension "ParallelArrays" ),
( "PArr", AlwaysAllowed, Opt_ParallelArrays,
deprecatedForExtension "ParallelArrays" ),
( "allow-overlapping-instances", RestrictedFunction, Opt_OverlappingInstances,
deprecatedForExtension "OverlappingInstances" ),
( "allow-undecidable-instances", AlwaysAllowed, Opt_UndecidableInstances,
deprecatedForExtension "UndecidableInstances" ),
( "allow-incoherent-instances", AlwaysAllowed, Opt_IncoherentInstances,
deprecatedForExtension "IncoherentInstances" )
]
supportedLanguages :: [String]
supportedLanguages = [ name | (name, _, _, _) <- languageFlags ]
supportedLanguageOverlays :: [String]
supportedLanguageOverlays = [ name | (name, _, _, _) <- safeHaskellFlags ]
supportedExtensions :: [String]
supportedExtensions = [ name' | (name, _, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
supportedLanguagesAndExtensions :: [String]
supportedLanguagesAndExtensions =
supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions
languageFlags :: [FlagSpec Language]
languageFlags = [
( "Haskell98", AlwaysAllowed, Haskell98, nop ),
( "Haskell2010", AlwaysAllowed, Haskell2010, nop )
]
safeHaskellFlags :: [FlagSpec SafeHaskellMode]
safeHaskellFlags = [mkF Sf_SafeImports, mkF Sf_Trustworthy, mkF' Sf_Safe]
where mkF flag = (showPpr flag, AlwaysAllowed, flag, nop)
mkF' flag = (showPpr flag, EnablesSafe, flag, nop)
xFlags :: [FlagSpec ExtensionFlag]
xFlags = [
( "CPP", AlwaysAllowed, Opt_Cpp, nop ),
( "PostfixOperators", AlwaysAllowed, Opt_PostfixOperators, nop ),
( "TupleSections", AlwaysAllowed, Opt_TupleSections, nop ),
( "PatternGuards", AlwaysAllowed, Opt_PatternGuards, nop ),
( "UnicodeSyntax", AlwaysAllowed, Opt_UnicodeSyntax, nop ),
( "MagicHash", AlwaysAllowed, Opt_MagicHash, nop ),
( "PolymorphicComponents", AlwaysAllowed, Opt_PolymorphicComponents, nop ),
( "ExistentialQuantification", AlwaysAllowed, Opt_ExistentialQuantification, nop ),
( "KindSignatures", AlwaysAllowed, Opt_KindSignatures, nop ),
( "EmptyDataDecls", AlwaysAllowed, Opt_EmptyDataDecls, nop ),
( "ParallelListComp", AlwaysAllowed, Opt_ParallelListComp, nop ),
( "TransformListComp", AlwaysAllowed, Opt_TransformListComp, nop ),
( "MonadComprehensions", AlwaysAllowed, Opt_MonadComprehensions, nop),
( "ForeignFunctionInterface", RestrictedFunction, Opt_ForeignFunctionInterface, nop ),
( "UnliftedFFITypes", AlwaysAllowed, Opt_UnliftedFFITypes, nop ),
( "InterruptibleFFI", AlwaysAllowed, Opt_InterruptibleFFI, nop ),
( "GHCForeignImportPrim", AlwaysAllowed, Opt_GHCForeignImportPrim, nop ),
( "LiberalTypeSynonyms", AlwaysAllowed, Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", AlwaysAllowed, Opt_Rank2Types, nop ),
( "RankNTypes", AlwaysAllowed, Opt_RankNTypes, nop ),
( "ImpredicativeTypes", AlwaysAllowed, Opt_ImpredicativeTypes, nop),
( "TypeOperators", AlwaysAllowed, Opt_TypeOperators, nop ),
( "RecursiveDo", AlwaysAllowed, Opt_RecursiveDo,
deprecatedForExtension "DoRec"),
( "DoRec", AlwaysAllowed, Opt_DoRec, nop ),
( "Arrows", AlwaysAllowed, Opt_Arrows, nop ),
( "ParallelArrays", AlwaysAllowed, Opt_ParallelArrays, nop ),
( "TemplateHaskell", NeverAllowed, Opt_TemplateHaskell, checkTemplateHaskellOk ),
( "QuasiQuotes", AlwaysAllowed, Opt_QuasiQuotes, nop ),
( "ImplicitPrelude", AlwaysAllowed, Opt_ImplicitPrelude, nop ),
( "RecordWildCards", AlwaysAllowed, Opt_RecordWildCards, nop ),
( "NamedFieldPuns", AlwaysAllowed, Opt_RecordPuns, nop ),
( "RecordPuns", AlwaysAllowed, Opt_RecordPuns,
deprecatedForExtension "NamedFieldPuns" ),
( "DisambiguateRecordFields", AlwaysAllowed, Opt_DisambiguateRecordFields, nop ),
( "OverloadedStrings", AlwaysAllowed, Opt_OverloadedStrings, nop ),
( "GADTs", AlwaysAllowed, Opt_GADTs, nop ),
( "GADTSyntax", AlwaysAllowed, Opt_GADTSyntax, nop ),
( "ViewPatterns", AlwaysAllowed, Opt_ViewPatterns, nop ),
( "TypeFamilies", AlwaysAllowed, Opt_TypeFamilies, nop ),
( "BangPatterns", AlwaysAllowed, Opt_BangPatterns, nop ),
( "MonomorphismRestriction", AlwaysAllowed, Opt_MonomorphismRestriction, nop ),
( "NPlusKPatterns", AlwaysAllowed, Opt_NPlusKPatterns, nop ),
( "DoAndIfThenElse", AlwaysAllowed, Opt_DoAndIfThenElse, nop ),
( "RebindableSyntax", AlwaysAllowed, Opt_RebindableSyntax, nop ),
( "MonoPatBinds", AlwaysAllowed, Opt_MonoPatBinds, nop ),
( "ExplicitForAll", AlwaysAllowed, Opt_ExplicitForAll, nop ),
( "AlternativeLayoutRule", AlwaysAllowed, Opt_AlternativeLayoutRule, nop ),
( "AlternativeLayoutRuleTransitional",AlwaysAllowed, Opt_AlternativeLayoutRuleTransitional, nop ),
( "DatatypeContexts", AlwaysAllowed, Opt_DatatypeContexts,
\ turn_on -> when turn_on $ deprecate "It was widely considered a misfeature, and has been removed from the Haskell language." ),
( "NondecreasingIndentation", AlwaysAllowed, Opt_NondecreasingIndentation, nop ),
( "RelaxedLayout", AlwaysAllowed, Opt_RelaxedLayout, nop ),
( "MonoLocalBinds", AlwaysAllowed, Opt_MonoLocalBinds, nop ),
( "RelaxedPolyRec", AlwaysAllowed, Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on
then deprecate "You can't turn off RelaxedPolyRec any more"
else return () ),
( "ExtendedDefaultRules", AlwaysAllowed, Opt_ExtendedDefaultRules, nop ),
( "ImplicitParams", AlwaysAllowed, Opt_ImplicitParams, nop ),
( "ScopedTypeVariables", AlwaysAllowed, Opt_ScopedTypeVariables, nop ),
( "PatternSignatures", AlwaysAllowed, Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", AlwaysAllowed, Opt_UnboxedTuples, nop ),
( "StandaloneDeriving", AlwaysAllowed, Opt_StandaloneDeriving, nop ),
( "DeriveDataTypeable", AlwaysAllowed, Opt_DeriveDataTypeable, nop ),
( "DeriveFunctor", AlwaysAllowed, Opt_DeriveFunctor, nop ),
( "DeriveTraversable", AlwaysAllowed, Opt_DeriveTraversable, nop ),
( "DeriveFoldable", AlwaysAllowed, Opt_DeriveFoldable, nop ),
( "DeriveGeneric", AlwaysAllowed, Opt_DeriveGeneric, nop ),
( "DefaultSignatures", AlwaysAllowed, Opt_DefaultSignatures, nop ),
( "TypeSynonymInstances", AlwaysAllowed, Opt_TypeSynonymInstances, nop ),
( "FlexibleContexts", AlwaysAllowed, Opt_FlexibleContexts, nop ),
( "FlexibleInstances", AlwaysAllowed, Opt_FlexibleInstances, nop ),
( "ConstrainedClassMethods", AlwaysAllowed, Opt_ConstrainedClassMethods, nop ),
( "MultiParamTypeClasses", AlwaysAllowed, Opt_MultiParamTypeClasses, nop ),
( "FunctionalDependencies", AlwaysAllowed, Opt_FunctionalDependencies, nop ),
( "GeneralizedNewtypeDeriving", AlwaysAllowed, Opt_GeneralizedNewtypeDeriving, nop ),
( "OverlappingInstances", RestrictedFunction, Opt_OverlappingInstances, nop ),
( "UndecidableInstances", AlwaysAllowed, Opt_UndecidableInstances, nop ),
( "IncoherentInstances", AlwaysAllowed, Opt_IncoherentInstances, nop ),
( "PackageImports", AlwaysAllowed, Opt_PackageImports, nop )
]
defaultFlags :: [DynFlag]
defaultFlags
= [ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
Opt_SharedImplib,
#if GHC_DEFAULT_NEW_CODEGEN
Opt_TryNewCodeGen,
#endif
Opt_GenManifest,
Opt_EmbedManifest,
Opt_PrintBindContents,
Opt_GhciSandbox,
Opt_HelpfulErrors
]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
impliedFlags
= [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll)
, (Opt_Rank2Types, turnOn, Opt_ExplicitForAll)
, (Opt_ScopedTypeVariables, turnOn, Opt_ExplicitForAll)
, (Opt_LiberalTypeSynonyms, turnOn, Opt_ExplicitForAll)
, (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll)
, (Opt_PolymorphicComponents, turnOn, Opt_ExplicitForAll)
, (Opt_FlexibleInstances, turnOn, Opt_TypeSynonymInstances)
, (Opt_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses)
, (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude)
, (Opt_GADTs, turnOn, Opt_GADTSyntax)
, (Opt_GADTs, turnOn, Opt_MonoLocalBinds)
, (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds)
, (Opt_TypeFamilies, turnOn, Opt_KindSignatures)
, (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes)
, (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields)
, (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
]
optLevelFlags :: [([Int], DynFlag)]
optLevelFlags
= [ ([0], Opt_IgnoreInterfacePragmas)
, ([0], Opt_OmitInterfacePragmas)
, ([1,2], Opt_IgnoreAsserts)
, ([1,2], Opt_EnableRewriteRules)
, ([1,2], Opt_DoEtaReduction)
, ([1,2], Opt_CaseMerge)
, ([1,2], Opt_Strictness)
, ([1,2], Opt_CSE)
, ([1,2], Opt_FullLaziness)
, ([1,2], Opt_Specialise)
, ([1,2], Opt_FloatIn)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
, ([2], Opt_RegsGraph)
, ([0,1,2], Opt_DoLambdaEtaExpansion)
]
standardWarnings :: [WarningFlag]
standardWarnings
= [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
Opt_WarnUnrecognisedPragmas,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports,
Opt_WarnWrongDoBind,
Opt_WarnAlternativeLayoutRuleTransitional
]
minusWOpts :: [WarningFlag]
minusWOpts
= standardWarnings ++
[ Opt_WarnUnusedBinds,
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
Opt_WarnDodgyExports,
Opt_WarnDodgyImports
]
minusWallOpts :: [WarningFlag]
minusWallOpts
= minusWOpts ++
[ Opt_WarnTypeDefaults,
Opt_WarnNameShadowing,
Opt_WarnMissingSigs,
Opt_WarnHiShadows,
Opt_WarnOrphans,
Opt_WarnUnusedDoBind
]
enableGlasgowExts :: DynP ()
enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
mapM_ setExtensionFlag glasgowExtsFlags
disableGlasgowExts :: DynP ()
disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
mapM_ unSetExtensionFlag glasgowExtsFlags
glasgowExtsFlags :: [ExtensionFlag]
glasgowExtsFlags = [
Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
, Opt_ImplicitParams
, Opt_ScopedTypeVariables
, Opt_UnboxedTuples
, Opt_TypeSynonymInstances
, Opt_StandaloneDeriving
, Opt_DeriveDataTypeable
, Opt_DeriveFunctor
, Opt_DeriveFoldable
, Opt_DeriveTraversable
, Opt_DeriveGeneric
, Opt_FlexibleContexts
, Opt_FlexibleInstances
, Opt_ConstrainedClassMethods
, Opt_MultiParamTypeClasses
, Opt_FunctionalDependencies
, Opt_MagicHash
, Opt_PolymorphicComponents
, Opt_ExistentialQuantification
, Opt_UnicodeSyntax
, Opt_PostfixOperators
, Opt_PatternGuards
, Opt_LiberalTypeSynonyms
, Opt_RankNTypes
, Opt_TypeOperators
, Opt_DoRec
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
, Opt_GeneralizedNewtypeDeriving ]
#ifdef GHCI
foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
rtsIsProfiled :: Bool
rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
#endif
checkTemplateHaskellOk :: Bool -> DynP ()
#ifdef GHCI
checkTemplateHaskellOk turn_on
| turn_on && rtsIsProfiled
= addErr "You can't use Template Haskell with a profiled compiler"
| otherwise
= return ()
#else
checkTemplateHaskellOk _ = return ()
#endif
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)
noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
hasArg fn = HasArg (upd . fn)
hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
hasArgDF fn deprec = HasArg (\s -> do { upd (fn s)
; deprecate deprec })
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))
optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
-> OptKind (CmdLineP DynFlags)
optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
setDynFlag f = upd (\dfs -> dopt_set dfs f)
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
setWarningFlag f = upd (\dfs -> wopt_set dfs f)
unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
; sequence_ deps }
where
deps = [ if turn_on then setExtensionFlag d
else unSetExtensionFlag d
| (f', turn_on, d) <- impliedFlags, f' == f ]
unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
alterSettings f dflags = dflags { settings = f (settings dflags) }
setDumpFlag' :: DynFlag -> DynP ()
setDumpFlag' dump_flag
= do { setDynFlag dump_flag
; when want_recomp forceRecompile }
where
want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
Opt_D_dump_hi_diffs]
forceRecompile :: DynP ()
forceRecompile = do { dfs <- liftEwM getCmdLineState
; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
where
force_recomp dfs = isOneShot (ghcMode dfs)
setVerboseCore2Core :: DynP ()
setVerboseCore2Core = do forceRecompile
setDynFlag Opt_D_verbose_core2core
upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
setDumpSimplPhases :: String -> DynP ()
setDumpSimplPhases s = do forceRecompile
upd (\dfs -> dfs { shouldDumpSimplPhase = Just spec })
where
spec = case s of { ('=' : s') -> s'; _ -> s }
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
addCmdlineHCInclude :: String -> DynP ()
addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
extraPkgConf_ :: FilePath -> DynP ()
extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
exposePackage, exposePackageId, hidePackage, ignorePackage,
trustPackage, distrustPackage :: String -> DynP ()
exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
exposePackageId p =
upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
ignorePackage p =
upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
trustPackage p = exposePackage p >>
upd (\s -> s{ packageFlags = TrustPackage p : packageFlags s })
distrustPackage p = exposePackage p >>
upd (\s -> s{ packageFlags = DistrustPackage p : packageFlags s })
setPackageName :: String -> DynFlags -> DynFlags
setPackageName p s = s{ thisPackage = stringToPackageId p }
setTarget :: HscTarget -> DynP ()
setTarget l = upd set
where
set dfs
| ghcLink dfs /= LinkBinary || isObjectTarget l = dfs{ hscTarget = l }
| otherwise = dfs
setObjTarget :: HscTarget -> DynP ()
setObjTarget l = updM set
where
set dflags
| isObjectTarget (hscTarget dflags)
= case l of
HscC
| cGhcUnregisterised /= "YES" ->
do addWarn ("Compiler not unregisterised, so ignoring " ++ flag)
return dflags
HscAsm
| cGhcWithNativeCodeGen /= "YES" ->
do addWarn ("Compiler has no native codegen, so ignoring " ++
flag)
return dflags
HscLlvm
| not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
(not opt_Static || opt_PIC)
->
do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
return dflags
_ -> return $ dflags { hscTarget = l }
| otherwise = return dflags
where platform = targetPlatform dflags
arch = platformArch platform
os = platformOS platform
flag = showHscTargetFlag l
setOptLevel :: Int -> DynFlags -> DynP DynFlags
setOptLevel n dflags
| hscTarget dflags == HscInterpreted && n > 0
= do addWarn "-O conflicts with --interactive; -O ignored."
return dflags
| otherwise
= return (updOptLevel n dflags)
setDPHOpt :: DynFlags -> DynP DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
, simplPhases = 3
})
data DPHBackend = DPHPar
| DPHSeq
| DPHThis
| DPHNone
deriving(Eq, Ord, Enum, Show)
setDPHBackend :: DPHBackend -> DynP ()
setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend }
dphPackageMaybe :: DynFlags -> Maybe PackageId
dphPackageMaybe dflags
= case dphBackend dflags of
DPHPar -> Just dphParPackageId
DPHSeq -> Just dphSeqPackageId
DPHThis -> Just (thisPackage dflags)
DPHNone -> Nothing
setMainIs :: String -> DynP ()
setMainIs arg
| not (null main_fn) && isLower (head main_fn)
= upd $ \d -> d{ mainFunIs = Just main_fn,
mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
| isUpper (head arg)
= upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
| otherwise
= upd $ \d -> d{ mainFunIs = Just arg }
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
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 = includePaths s ++ splitPathList p})
addFrameworkPath p =
upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
#ifndef mingw32_TARGET_OS
split_marker :: Char
split_marker = ':'
#endif
splitPathList :: String -> [String]
splitPathList s = filter notNull (splitUp s)
where
#ifndef mingw32_TARGET_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 = alterSettings (\s -> s { sTmpDir = 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
#if darwin_TARGET_OS
| opt_PIC
= ["-fno-common", "-U __PIC__","-D__PIC__"]
| otherwise
= ["-mdynamic-no-pic"]
#elif mingw32_TARGET_OS
| opt_PIC
= ["-U __PIC__","-D__PIC__"]
| otherwise
= []
#else
| opt_PIC || not opt_Static
= ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise
= []
#endif
can_split :: Bool
can_split = cSupportsSplitObjs == "YES"
compilerInfo :: DynFlags -> [(String, String)]
compilerInfo dflags
=
("Project name", cProjectName)
: rawSettings dflags
++ [("Project version", cProjectVersion),
("Booter version", cBooterVersion),
("Stage", cStage),
("Build platform", cBuildPlatformString),
("Host platform", cHostPlatformString),
("Target platform", cTargetPlatformString),
("Have interpreter", cGhcWithInterpreter),
("Object splitting supported", cSupportsSplitObjs),
("Have native code generator", cGhcWithNativeCodeGen),
("Support SMP", cGhcWithSMP),
("Unregisterised", cGhcUnregisterised),
("Tables next to code", cGhcEnableTablesNextToCode),
("RTS ways", cGhcRTSWays),
("Leading underscore", cLeadingUnderscore),
("Debug on", show debugIsOn),
("LibDir", topDir dflags),
("Global Package DB", systemPackageConfig dflags),
("Gcc Linker flags", show cGccLinkerOpts),
("Ld Linker flags", show cLdLinkerOpts)
]