module DynFlags (
DynFlag(..),
ExtensionFlag(..),
glasgowExtsFlags,
dopt,
dopt_set,
dopt_unset,
xopt,
xopt_set,
xopt_unset,
DynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
Option(..), showOpt,
DynLibLoader(..),
fFlags, fLangFlags, xFlags,
dphPackage,
wayNames,
defaultDynFlags,
initDynFlags,
getOpts,
getVerbFlag,
updOptLevel,
setTmpDir,
setPackageName,
doingTickyProfiling,
parseDynamicFlags,
parseDynamicNoPackageFlags,
allFlags,
supportedLanguagesAndExtensions,
machdepCCOpts, picCCOpts,
StgToDo(..),
getStgToDo,
Printable(..),
compilerInfo
#ifdef GHCI
, rtsIsProfiled
#endif
) where
#include "HsVersions.h"
#ifndef OMIT_NATIVE_CODEGEN
import Platform
#endif
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
import Foreign.C ( CInt )
import ErrUtils ( Severity(..), Message, mkLocMessage )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef
import Control.Monad ( when )
import Data.Char
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import System.FilePath
import System.IO ( stderr, hPutChar )
data DynFlag
= Opt_D_dump_cmm
| Opt_D_dump_cmmz
| Opt_D_dump_cmmz_pretty
| Opt_D_dump_cps_cmm
| Opt_D_dump_cvt_cmm
| Opt_D_dump_asm
| Opt_D_dump_asm_native
| Opt_D_dump_asm_liveness
| Opt_D_dump_asm_coalesce
| Opt_D_dump_asm_regalloc
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
| Opt_D_dump_asm_stats
| Opt_D_dump_asm_expanded
| Opt_D_dump_llvm
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_flatC
| Opt_D_dump_foreign
| Opt_D_dump_inlinings
| Opt_D_dump_rule_firings
| Opt_D_dump_occur_anal
| Opt_D_dump_parsed
| Opt_D_dump_rn
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
| Opt_D_dump_simpl_phases
| Opt_D_dump_spec
| Opt_D_dump_prep
| Opt_D_dump_stg
| Opt_D_dump_stranal
| Opt_D_dump_tc
| Opt_D_dump_types
| Opt_D_dump_rules
| Opt_D_dump_cse
| Opt_D_dump_worker_wrapper
| Opt_D_dump_rn_trace
| Opt_D_dump_rn_stats
| Opt_D_dump_opt_cmm
| Opt_D_dump_simpl_stats
| Opt_D_dump_cs_trace
| Opt_D_dump_tc_trace
| Opt_D_dump_if_trace
| Opt_D_dump_splices
| Opt_D_dump_BCOs
| Opt_D_dump_vect
| Opt_D_dump_hpc
| Opt_D_dump_rtti
| Opt_D_source_stats
| Opt_D_verbose_core2core
| Opt_D_verbose_stg2stg
| Opt_D_dump_hi
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_dump_mod_cycles
| Opt_D_dump_view_pattern_commoning
| Opt_D_faststring_stats
| Opt_DumpToFile
| Opt_D_no_debug_output
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
| Opt_DoAsmLinting
| Opt_WarnIsError
| Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnImplicitPrelude
| Opt_WarnIncompletePatterns
| 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_WarnTabs
| Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
| Opt_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind
| Opt_WarnAlternativeLayoutRuleTransitional
| 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_MethodSharing
| 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_DryRun
| Opt_DoAsmMangling
| Opt_ExcessPrecision
| Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
| Opt_PrintBindResult
| Opt_Haddock
| Opt_HaddockOptions
| Opt_Hpc_No_Auto
| Opt_BreakOnException
| Opt_BreakOnError
| Opt_PrintEvldWithShow
| Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
| Opt_EmitExternalCore
| Opt_SharedImplib
| Opt_BuildingCabalPackage
| Opt_SSE2
| Opt_GhciSandbox
| Opt_RunCPS
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
| Opt_ImplicitImportQualified
| Opt_TryNewCodeGen
| Opt_KeepHiDiffs
| Opt_KeepHcFiles
| Opt_KeepSFiles
| Opt_KeepRawSFiles
| Opt_KeepTmpFiles
| Opt_KeepRawTokenStream
| Opt_KeepLlvmFiles
deriving (Eq, Show)
data Language = Haskell98 | Haskell2010
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_GHCForeignImportPrim
| Opt_PArr
| Opt_Arrows
| Opt_TemplateHaskell
| Opt_QuasiQuotes
| Opt_ImplicitParams
| Opt_Generics
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
| Opt_UnboxedTuples
| Opt_BangPatterns
| Opt_TypeFamilies
| Opt_OverloadedStrings
| Opt_DisambiguateRecordFields
| Opt_RecordWildCards
| Opt_RecordPuns
| Opt_ViewPatterns
| Opt_GADTs
| Opt_NPlusKPatterns
| Opt_DoAndIfThenElse
| Opt_RebindableSyntax
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_DeriveFunctor
| Opt_DeriveTraversable
| Opt_DeriveFoldable
| Opt_TypeSynonymInstances
| Opt_FlexibleContexts
| Opt_FlexibleInstances
| Opt_ConstrainedClassMethods
| Opt_MultiParamTypeClasses
| Opt_FunctionalDependencies
| Opt_UnicodeSyntax
| Opt_PolymorphicComponents
| Opt_ExistentialQuantification
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
| Opt_ParallelListComp
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_DoRec
| Opt_PostfixOperators
| Opt_TupleSections
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_RankNTypes
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
| Opt_NewQualifiedOperators
| Opt_ExplicitForAll
| Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional
| Opt_DatatypeContexts
deriving (Eq, Show)
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,
#ifndef OMIT_NATIVE_CODEGEN
targetPlatform :: Platform,
#endif
stolen_x86_regs :: Int,
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],
tmpDir :: String,
ghcUsagePath :: FilePath,
ghciUsagePath :: FilePath,
rtsOpts :: Maybe String,
rtsOptsEnabled :: RtsOptsEnabled,
hpcDir :: String,
opt_L :: [String],
opt_P :: [String],
opt_F :: [String],
opt_c :: [String],
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
opt_windres :: [String],
opt_lo :: [String],
opt_lc :: [String],
pgm_L :: String,
pgm_P :: (String,[Option]),
pgm_F :: String,
pgm_c :: (String,[Option]),
pgm_m :: (String,[Option]),
pgm_s :: (String,[Option]),
pgm_a :: (String,[Option]),
pgm_l :: (String,[Option]),
pgm_dll :: (String,[Option]),
pgm_T :: String,
pgm_sysman :: String,
pgm_windres :: String,
pgm_lo :: (String,[Option]),
pgm_lc :: (String,[Option]),
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
extraPkgConfs :: [FilePath],
topDir :: FilePath,
systemPackageConfig :: FilePath,
packageFlags :: [PackageFlag],
pkgDatabase :: Maybe [PackageConfig],
pkgState :: PackageState,
filesToClean :: IORef [FilePath],
dirsToClean :: IORef (Map FilePath FilePath),
flags :: [DynFlag],
language :: Maybe Language,
extensions :: [OnOff ExtensionFlag],
extensionFlags :: [ExtensionFlag],
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
haddockOptions :: Maybe String
}
wayNames :: DynFlags -> [WayName]
wayNames = map wayName . ways
data HscTarget
= HscC
| HscAsm
| HscLlvm
| HscJava
| HscInterpreted
| HscNothing
deriving (Eq, Show)
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
deriving Eq
defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
defaultObjectTarget :: HscTarget
defaultObjectTarget
| cGhcWithNativeCodeGen == "YES" = HscAsm
| otherwise = HscC
data DynLibLoader
= Deployable
| SystemDependent
deriving Eq
data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean
}
defaultDynFlags :: DynFlags
defaultDynFlags =
DynFlags {
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget,
hscOutName = "",
extCoreName = "",
verbosity = 0,
optLevel = 0,
simplPhases = 2,
maxSimplIterations = 4,
shouldDumpSimplPhase = Nothing,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
floatLamArgs = Just 0,
strictnessBefore = [],
#ifndef OMIT_NATIVE_CODEGEN
targetPlatform = defaultTargetPlatform,
#endif
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
importPaths = ["."],
mainModIs = mAIN,
mainFunIs = Nothing,
ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
dphBackend = DPHPar,
thisPackage = mainPackageId,
objectDir = Nothing,
dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
objectSuf = phaseInputExt StopLn,
hcSuf = phaseInputExt HCc,
hiSuf = "hi",
outputFile = Nothing,
outputHi = Nothing,
dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
includePaths = [],
libraryPaths = [],
frameworkPaths = [],
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
rtsOpts = Nothing,
rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
opt_L = [],
opt_P = (if opt_PIC
then ["-D__PIC__", "-U __PIC__"]
else []),
opt_F = [],
opt_c = [],
opt_a = [],
opt_m = [],
opt_l = [],
opt_windres = [],
opt_lo = [],
opt_lc = [],
extraPkgConfs = [],
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
ways = panic "defaultDynFlags: No ways",
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing,
ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath",
ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath",
topDir = panic "defaultDynFlags: No topDir",
systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags",
pgm_L = panic "defaultDynFlags: No pgm_L",
pgm_P = panic "defaultDynFlags: No pgm_P",
pgm_F = panic "defaultDynFlags: No pgm_F",
pgm_c = panic "defaultDynFlags: No pgm_c",
pgm_m = panic "defaultDynFlags: No pgm_m",
pgm_s = panic "defaultDynFlags: No pgm_s",
pgm_a = panic "defaultDynFlags: No pgm_a",
pgm_l = panic "defaultDynFlags: No pgm_l",
pgm_dll = panic "defaultDynFlags: No pgm_dll",
pgm_T = panic "defaultDynFlags: No pgm_T",
pgm_sysman = panic "defaultDynFlags: No pgm_sysman",
pgm_windres = panic "defaultDynFlags: No pgm_windres",
pgm_lo = panic "defaultDynFlags: No pgm_lo",
pgm_lc = panic "defaultDynFlags: No pgm_lc",
depMakefile = "Makefile",
depIncludePkgDeps = False,
depExcludeMods = [],
depSuffixes = [],
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
haddockOptions = Nothing,
flags = defaultFlags,
language = Nothing,
extensions = [],
extensionFlags = flattenExtensionFlags Nothing [],
log_action = \severity srcSpan style msg ->
case severity of
SevOutput -> printOutput (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
: languageExtensions (Just Haskell2010)
languageExtensions (Just Haskell98)
= [Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
Opt_NPlusKPatterns,
Opt_DatatypeContexts]
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) }
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
}
getOpts :: DynFlags
-> (DynFlags -> [a])
-> [a]
getOpts dflags opts = reverse (opts dflags)
getVerbFlag :: DynFlags -> String
getVerbFlag dflags
| verbosity dflags >= 3 = "-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}
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 d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)}
addOptl f d = d{ opt_l = f : opt_l d}
addOptP f d = d{ opt_P = f : opt_P d}
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = deOptDep f }
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
addDepExcludeMod :: String -> DynFlags -> DynFlags
addDepExcludeMod m d
= d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
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
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
parseDynamicFlags :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
parseDynamicNoPackageFlags :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
parseDynamicFlags_ :: Monad m =>
DynFlags -> [Located String] -> Bool
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags_ dflags0 args pkg_flags = 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 | pkg_flags = package_flags ++ dynamic_flags
| otherwise = dynamic_flags
let ((leftover, errs, warns), dflags1)
= runCmdLine (processArgs flag_spec args') dflags0
when (not (null errs)) $ ghcError $ errorsToGhcException errs
let (pic_warns, dflags2)
| opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
= ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
dflags1{ hscTarget = HscAsm })
#if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
| (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
= ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
++ "dynamic on this platform;\n ignoring -fllvm"],
dflags1{ hscTarget = HscAsm })
#endif
| otherwise = ([], dflags1)
return (dflags2, leftover, pic_warns ++ warns)
allFlags :: [String]
allFlags = map ('-':) $
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) flags ++
map ("f"++) flags ++
map ("f"++) flags' ++
map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
flags' = [ name | (name, _, _) <- fLangFlags ]
dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [
Flag "n" (NoArg (setDynFlag Opt_DryRun))
, Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, Flag "F" (NoArg (setDynFlag Opt_Pp))
, Flag "#include"
(HasArg (\s -> do { addCmdlineHCInclude s
; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
, Flag "v" (OptIntSuffix setVerbosity)
, Flag "pgmlo" (hasArg (\f d -> d{ pgm_lo = (f,[])}))
, Flag "pgmlc" (hasArg (\f d -> d{ pgm_lc = (f,[])}))
, Flag "pgmL" (hasArg (\f d -> d{ pgm_L = f}))
, Flag "pgmP" (hasArg setPgmP)
, Flag "pgmF" (hasArg (\f d -> d{ pgm_F = f}))
, Flag "pgmc" (hasArg (\f d -> d{ pgm_c = (f,[])}))
, Flag "pgmm" (hasArg (\f d -> d{ pgm_m = (f,[])}))
, Flag "pgms" (hasArg (\f d -> d{ pgm_s = (f,[])}))
, Flag "pgma" (hasArg (\f d -> d{ pgm_a = (f,[])}))
, Flag "pgml" (hasArg (\f d -> d{ pgm_l = (f,[])}))
, Flag "pgmdll" (hasArg (\f d -> d{ pgm_dll = (f,[])}))
, Flag "pgmwindres" (hasArg (\f d -> d{ pgm_windres = f}))
, Flag "optlo" (hasArg (\f d -> d{ opt_lo = f : opt_lo d}))
, Flag "optlc" (hasArg (\f d -> d{ opt_lc = f : opt_lc d}))
, Flag "optL" (hasArg (\f d -> d{ opt_L = f : opt_L d}))
, Flag "optP" (hasArg addOptP)
, Flag "optF" (hasArg (\f d -> d{ opt_F = f : opt_F d}))
, Flag "optc" (hasArg (\f d -> d{ opt_c = f : opt_c d}))
, Flag "optm" (hasArg (\f d -> d{ opt_m = f : opt_m d}))
, Flag "opta" (hasArg (\f d -> d{ opt_a = f : opt_a d}))
, Flag "optl" (hasArg addOptl)
, Flag "optwindres" (hasArg (\f d -> d{ opt_windres = f : opt_windres d}))
, Flag "split-objs"
(NoArg (if can_split
then setDynFlag Opt_SplitObjs
else addWarn "ignoring -fsplit-objs"))
, Flag "dep-suffix" (hasArg addDepSuffix)
, Flag "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
, Flag "dep-makefile" (hasArg setDepMakefile)
, Flag "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
, Flag "optdep-w" (NoArg (deprecate "doesn't do anything"))
, Flag "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
, Flag "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, Flag "exclude-module" (hasArg addDepExcludeMod)
, Flag "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, Flag "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, Flag "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
, Flag "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
, Flag "dynload" (hasArg parseDynLibLoaderMode)
, Flag "dylib-install-name" (hasArg setDylibInstallName)
, Flag "L" (Prefix addLibraryPath)
, Flag "l" (AnySuffix (upd . addOptl))
, Flag "framework-path" (HasArg addFrameworkPath)
, Flag "framework" (hasArg addCmdlineFramework)
, Flag "odir" (hasArg setObjectDir)
, Flag "o" (SepArg (upd . setOutputFile . Just))
, Flag "ohi" (hasArg (setOutputHi . Just ))
, Flag "osuf" (hasArg setObjectSuf)
, Flag "hcsuf" (hasArg setHcSuf)
, Flag "hisuf" (hasArg setHiSuf)
, Flag "hidir" (hasArg setHiDir)
, Flag "tmpdir" (hasArg setTmpDir)
, Flag "stubdir" (hasArg setStubDir)
, Flag "outputdir" (hasArg setOutputDir)
, Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
, Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles))
, Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles))
, Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles))
, Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles))
, Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles))
, Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles))
, Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles))
, Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles))
, Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles))
, Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain))
, Flag "with-rtsopts" (HasArg setRtsOpts)
, Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll))
, Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll))
, Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
, Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone))
, Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone))
, Flag "main-is" (SepArg setMainIs)
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock))
, Flag "haddock-opts" (hasArg addHaddockOpts)
, Flag "hpcdir" (SepArg setOptHpcDir)
, Flag "recomp" (NoArg (do { unSetDynFlag Opt_ForceRecomp
; deprecate "Use -fno-force-recomp instead" }))
, Flag "no-recomp" (NoArg (do { setDynFlag Opt_ForceRecomp
; deprecate "Use -fforce-recomp instead" }))
, Flag "D" (AnySuffix (upd . addOptP))
, Flag "U" (AnySuffix (upd . addOptP))
, Flag "I" (Prefix addIncludePath)
, Flag "i" (OptPrefix addImportPath)
, Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats))
, Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm)
, Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz)
, Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty)
, Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm)
, Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm)
, Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm)
, Flag "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native)
, Flag "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness)
, Flag "ddump-asm-coalesce" (setDumpFlag Opt_D_dump_asm_coalesce)
, Flag "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc)
, Flag "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts)
, Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
, Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
, Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
, Flag "ddump-llvm" (NoArg (do { setObjTarget HscLlvm
; setDumpFlag' Opt_D_dump_llvm}))
, Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
, Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
, Flag "ddump-ds" (setDumpFlag Opt_D_dump_ds)
, Flag "ddump-flatC" (setDumpFlag Opt_D_dump_flatC)
, Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign)
, Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings)
, Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings)
, Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal)
, Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed)
, Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn)
, Flag "ddump-simpl" (setDumpFlag Opt_D_dump_simpl)
, Flag "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations)
, Flag "ddump-simpl-phases" (OptPrefix setDumpSimplPhases)
, Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec)
, Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep)
, Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg)
, Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal)
, Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc)
, Flag "ddump-types" (setDumpFlag Opt_D_dump_types)
, Flag "ddump-rules" (setDumpFlag Opt_D_dump_rules)
, Flag "ddump-cse" (setDumpFlag Opt_D_dump_cse)
, Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper)
, Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace)
, Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace)
, Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace)
, Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace)
, Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices)
, Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats)
, Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm)
, Flag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats)
, Flag "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs)
, Flag "dsource-stats" (setDumpFlag Opt_D_source_stats)
, Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2)
; setVerboseCore2Core }))
, Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
, Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi)
, Flag "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports)
, Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect)
, Flag "ddump-hpc" (setDumpFlag Opt_D_dump_hpc)
, Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles)
, Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
, Flag "ddump-to-file" (setDumpFlag Opt_DumpToFile)
, Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
, Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
, Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting))
, Flag "dstg-lint" (NoArg (setDynFlag Opt_DoStgLinting))
, Flag "dcmm-lint" (NoArg (setDynFlag Opt_DoCmmLinting))
, Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting))
, Flag "dshow-passes" (NoArg (do forceRecompile
setVerbosity (Just 2)))
, Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats))
, Flag "monly-2-regs" (noArg (\s -> s{stolen_x86_regs = 2}))
, Flag "monly-3-regs" (noArg (\s -> s{stolen_x86_regs = 3}))
, Flag "monly-4-regs" (noArg (\s -> s{stolen_x86_regs = 4}))
, Flag "msse2" (NoArg (setDynFlag Opt_SSE2))
, Flag "W" (NoArg (mapM_ setDynFlag minusWOpts))
, Flag "Werror" (NoArg (setDynFlag Opt_WarnIsError))
, Flag "Wwarn" (NoArg (unSetDynFlag Opt_WarnIsError))
, Flag "Wall" (NoArg (mapM_ setDynFlag minusWallOpts))
, Flag "Wnot" (NoArg (do { mapM_ unSetDynFlag minusWallOpts
; deprecate "Use -w instead" }))
, Flag "w" (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
, Flag "O" (noArg (setOptLevel 1))
, Flag "Onot" (noArgDF (setOptLevel 0) "Use -O0 instead")
, Flag "Odph" (noArg setDPHOpt)
, Flag "O" (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
, Flag "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n }))
, Flag "fmax-simplifier-iterations" (intSuffix (\n d -> d{ maxSimplIterations = n }))
, Flag "fspec-constr-threshold" (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
, Flag "fno-spec-constr-threshold" (noArg (\d -> d{ specConstrThreshold = Nothing }))
, Flag "fspec-constr-count" (intSuffix (\n d -> d{ specConstrCount = Just n }))
, Flag "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount = Nothing }))
, Flag "fliberate-case-threshold" (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
, Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
, Flag "frule-check" (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s })))
, Flag "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n }))
, Flag "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
, Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n }))
, Flag "ffloat-all-lams" (intSuffix (\n d -> d{ floatLamArgs = Nothing }))
, Flag "fauto-sccs-on-all-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
, Flag "auto-all" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
, Flag "no-auto-all" (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
, Flag "fauto-sccs-on-exported-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
, Flag "auto" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
, Flag "no-auto" (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
, Flag "fauto-sccs-on-individual-cafs" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
, Flag "caf-all" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
, Flag "no-caf-all" (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
, Flag "fdph-seq" (NoArg (setDPHBackend DPHSeq))
, Flag "fdph-par" (NoArg (setDPHBackend DPHPar))
, Flag "fdph-this" (NoArg (setDPHBackend DPHThis))
, Flag "fasm" (NoArg (setObjTarget HscAsm))
, Flag "fvia-c" (NoArg (setObjTarget HscC >>
(addWarn "The -fvia-c flag will be removed in a future GHC release")))
, Flag "fvia-C" (NoArg (setObjTarget HscC >>
(addWarn "The -fvia-C flag will be removed in a future GHC release")))
, Flag "fllvm" (NoArg (setObjTarget HscLlvm))
, Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
setTarget HscNothing))
, Flag "fbyte-code" (NoArg (setTarget HscInterpreted))
, Flag "fobject-code" (NoArg (setTarget defaultHscTarget))
, Flag "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
, Flag "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" 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
package_flags :: [Flag (CmdLineP DynFlags)]
package_flags = [
Flag "package-conf" (HasArg extraPkgConf_)
, Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
, Flag "package-name" (hasArg setPackageName)
, Flag "package-id" (HasArg exposePackageId)
, Flag "package" (HasArg exposePackage)
, Flag "hide-package" (HasArg hidePackage)
, Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
, Flag "ignore-package" (HasArg ignorePackage)
, Flag "syslib" (HasArg (\s -> do { exposePackage s
; deprecate "Use -package instead" }))
]
type TurnOnFlag = Bool
turnOn :: TurnOnFlag; turnOn = True
turnOff :: TurnOnFlag; turnOff = False
type FlagSpec flag
= ( String
, flag
, TurnOnFlag -> DynP ())
mkFlag :: TurnOnFlag
-> String
-> (flag -> DynP ())
-> FlagSpec flag
-> Flag (CmdLineP DynFlags)
mkFlag turn_on flagPrefix f (name, flag, extra_action)
= Flag (flagPrefix ++ name) (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 ()
fFlags :: [FlagSpec DynFlag]
fFlags = [
( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ),
( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ),
( "warn-hi-shadowing", Opt_WarnHiShadows, nop ),
( "warn-implicit-prelude", Opt_WarnImplicitPrelude, nop ),
( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, nop ),
( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, nop ),
( "warn-missing-fields", Opt_WarnMissingFields, nop ),
( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ),
( "warn-missing-methods", Opt_WarnMissingMethods, nop ),
( "warn-missing-signatures", Opt_WarnMissingSigs, nop ),
( "warn-missing-local-sigs", Opt_WarnMissingLocalSigs, nop ),
( "warn-name-shadowing", Opt_WarnNameShadowing, nop ),
( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ),
( "warn-type-defaults", Opt_WarnTypeDefaults, nop ),
( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ),
( "warn-unused-binds", Opt_WarnUnusedBinds, nop ),
( "warn-unused-imports", Opt_WarnUnusedImports, nop ),
( "warn-unused-matches", Opt_WarnUnusedMatches, nop ),
( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecations", Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, nop ),
( "warn-orphans", Opt_WarnOrphans, nop ),
( "warn-auto-orphans", Opt_WarnAutoOrphans, nop ),
( "warn-tabs", Opt_WarnTabs, nop ),
( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ),
( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, nop),
( "warn-unused-do-bind", Opt_WarnUnusedDoBind, nop ),
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ),
( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ),
( "strictness", Opt_Strictness, nop ),
( "specialise", Opt_Specialise, nop ),
( "float-in", Opt_FloatIn, nop ),
( "static-argument-transformation", Opt_StaticArgumentTransformation, nop ),
( "full-laziness", Opt_FullLaziness, nop ),
( "liberate-case", Opt_LiberateCase, nop ),
( "spec-constr", Opt_SpecConstr, nop ),
( "cse", Opt_CSE, nop ),
( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, nop ),
( "omit-interface-pragmas", Opt_OmitInterfacePragmas, nop ),
( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, nop ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, nop ),
( "ignore-asserts", Opt_IgnoreAsserts, nop ),
( "do-eta-reduction", Opt_DoEtaReduction, nop ),
( "case-merge", Opt_CaseMerge, nop ),
( "unbox-strict-fields", Opt_UnboxStrictFields, nop ),
( "method-sharing", Opt_MethodSharing, nop ),
( "dicts-cheap", Opt_DictsCheap, nop ),
( "excess-precision", Opt_ExcessPrecision, nop ),
( "eager-blackholing", Opt_EagerBlackHoling, nop ),
( "asm-mangling", Opt_DoAsmMangling, nop ),
( "print-bind-result", Opt_PrintBindResult, nop ),
( "force-recomp", Opt_ForceRecomp, nop ),
( "hpc-no-auto", Opt_Hpc_No_Auto, nop ),
( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
( "enable-rewrite-rules", Opt_EnableRewriteRules, nop ),
( "break-on-exception", Opt_BreakOnException, nop ),
( "break-on-error", Opt_BreakOnError, nop ),
( "print-evld-with-show", Opt_PrintEvldWithShow, nop ),
( "print-bind-contents", Opt_PrintBindContents, nop ),
( "run-cps", Opt_RunCPS, nop ),
( "run-cpsz", Opt_RunCPSZ, nop ),
( "new-codegen", Opt_TryNewCodeGen, nop ),
( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, nop ),
( "vectorise", Opt_Vectorise, nop ),
( "regs-graph", Opt_RegsGraph, nop ),
( "regs-iterative", Opt_RegsIterative, nop ),
( "gen-manifest", Opt_GenManifest, nop ),
( "embed-manifest", Opt_EmbedManifest, nop ),
( "ext-core", Opt_EmitExternalCore, nop ),
( "shared-implib", Opt_SharedImplib, nop ),
( "ghci-sandbox", Opt_GhciSandbox, nop ),
( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop )
]
fLangFlags :: [FlagSpec ExtensionFlag]
fLangFlags = [
( "th", Opt_TemplateHaskell,
deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
( "fi", Opt_ForeignFunctionInterface,
deprecatedForExtension "ForeignFunctionInterface" ),
( "ffi", Opt_ForeignFunctionInterface,
deprecatedForExtension "ForeignFunctionInterface" ),
( "arrows", Opt_Arrows,
deprecatedForExtension "Arrows" ),
( "generics", Opt_Generics,
deprecatedForExtension "Generics" ),
( "implicit-prelude", Opt_ImplicitPrelude,
deprecatedForExtension "ImplicitPrelude" ),
( "bang-patterns", Opt_BangPatterns,
deprecatedForExtension "BangPatterns" ),
( "monomorphism-restriction", Opt_MonomorphismRestriction,
deprecatedForExtension "MonomorphismRestriction" ),
( "mono-pat-binds", Opt_MonoPatBinds,
deprecatedForExtension "MonoPatBinds" ),
( "extended-default-rules", Opt_ExtendedDefaultRules,
deprecatedForExtension "ExtendedDefaultRules" ),
( "implicit-params", Opt_ImplicitParams,
deprecatedForExtension "ImplicitParams" ),
( "scoped-type-variables", Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
( "parr", Opt_PArr,
deprecatedForExtension "PArr" ),
( "allow-overlapping-instances", Opt_OverlappingInstances,
deprecatedForExtension "OverlappingInstances" ),
( "allow-undecidable-instances", Opt_UndecidableInstances,
deprecatedForExtension "UndecidableInstances" ),
( "allow-incoherent-instances", Opt_IncoherentInstances,
deprecatedForExtension "IncoherentInstances" )
]
supportedLanguages :: [String]
supportedLanguages = [ name | (name, _, _) <- languageFlags ]
supportedExtensions :: [String]
supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
supportedLanguagesAndExtensions :: [String]
supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
languageFlags :: [FlagSpec Language]
languageFlags = [
( "Haskell98", Haskell98, nop ),
( "Haskell2010", Haskell2010, nop )
]
xFlags :: [FlagSpec ExtensionFlag]
xFlags = [
( "CPP", Opt_Cpp, nop ),
( "PostfixOperators", Opt_PostfixOperators, nop ),
( "TupleSections", Opt_TupleSections, nop ),
( "PatternGuards", Opt_PatternGuards, nop ),
( "UnicodeSyntax", Opt_UnicodeSyntax, nop ),
( "MagicHash", Opt_MagicHash, nop ),
( "PolymorphicComponents", Opt_PolymorphicComponents, nop ),
( "ExistentialQuantification", Opt_ExistentialQuantification, nop ),
( "KindSignatures", Opt_KindSignatures, nop ),
( "EmptyDataDecls", Opt_EmptyDataDecls, nop ),
( "ParallelListComp", Opt_ParallelListComp, nop ),
( "TransformListComp", Opt_TransformListComp, nop ),
( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, nop ),
( "UnliftedFFITypes", Opt_UnliftedFFITypes, nop ),
( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, nop ),
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", Opt_Rank2Types, nop ),
( "RankNTypes", Opt_RankNTypes, nop ),
( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ),
( "RecursiveDo", Opt_RecursiveDo,
deprecatedForExtension "DoRec"),
( "DoRec", Opt_DoRec, nop ),
( "Arrows", Opt_Arrows, nop ),
( "PArr", Opt_PArr, nop ),
( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
( "QuasiQuotes", Opt_QuasiQuotes, nop ),
( "Generics", Opt_Generics, nop ),
( "ImplicitPrelude", Opt_ImplicitPrelude, nop ),
( "RecordWildCards", Opt_RecordWildCards, nop ),
( "NamedFieldPuns", Opt_RecordPuns, nop ),
( "RecordPuns", Opt_RecordPuns,
deprecatedForExtension "NamedFieldPuns" ),
( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, nop ),
( "OverloadedStrings", Opt_OverloadedStrings, nop ),
( "GADTs", Opt_GADTs, nop ),
( "ViewPatterns", Opt_ViewPatterns, nop ),
( "TypeFamilies", Opt_TypeFamilies, nop ),
( "BangPatterns", Opt_BangPatterns, nop ),
( "MonomorphismRestriction", Opt_MonomorphismRestriction, nop ),
( "NPlusKPatterns", Opt_NPlusKPatterns, nop ),
( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ),
( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "MonoPatBinds", Opt_MonoPatBinds, nop ),
( "ExplicitForAll", Opt_ExplicitForAll, nop ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
( "DatatypeContexts", Opt_DatatypeContexts, nop ),
( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on
then deprecate "You can't turn off RelaxedPolyRec any more"
else return () ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ),
( "ImplicitParams", Opt_ImplicitParams, nop ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ),
( "PatternSignatures", Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, nop ),
( "StandaloneDeriving", Opt_StandaloneDeriving, nop ),
( "DeriveDataTypeable", Opt_DeriveDataTypeable, nop ),
( "DeriveFunctor", Opt_DeriveFunctor, nop ),
( "DeriveTraversable", Opt_DeriveTraversable, nop ),
( "DeriveFoldable", Opt_DeriveFoldable, nop ),
( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ),
( "FlexibleContexts", Opt_FlexibleContexts, nop ),
( "FlexibleInstances", Opt_FlexibleInstances, nop ),
( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, nop ),
( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, nop ),
( "FunctionalDependencies", Opt_FunctionalDependencies, nop ),
( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, nop ),
( "OverlappingInstances", Opt_OverlappingInstances, nop ),
( "UndecidableInstances", Opt_UndecidableInstances, nop ),
( "IncoherentInstances", Opt_IncoherentInstances, nop ),
( "PackageImports", Opt_PackageImports, nop ),
( "NewQualifiedOperators", Opt_NewQualifiedOperators,
\_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
]
defaultFlags :: [DynFlag]
defaultFlags
= [ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
Opt_MethodSharing,
Opt_DoAsmMangling,
Opt_SharedImplib,
Opt_GenManifest,
Opt_EmbedManifest,
Opt_PrintBindContents,
Opt_GhciSandbox
]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
++ standardWarnings
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_RebindableSyntax, turnOff, Opt_ImplicitPrelude)
, (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)
]
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 :: [DynFlag]
standardWarnings
= [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
Opt_WarnUnrecognisedPragmas,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports,
Opt_WarnWrongDoBind,
Opt_WarnAlternativeLayoutRuleTransitional
]
minusWOpts :: [DynFlag]
minusWOpts
= standardWarnings ++
[ Opt_WarnUnusedBinds,
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
Opt_WarnDodgyExports,
Opt_WarnDodgyImports
]
minusWallOpts :: [DynFlag]
minusWallOpts
= minusWOpts ++
[ Opt_WarnTypeDefaults,
Opt_WarnNameShadowing,
Opt_WarnMissingSigs,
Opt_WarnHiShadows,
Opt_WarnOrphans,
Opt_WarnUnusedDoBind
]
minuswRemovesOpts :: [DynFlag]
minuswRemovesOpts
= minusWallOpts ++
[Opt_WarnImplicitPrelude,
Opt_WarnIncompletePatternsRecUpd,
Opt_WarnMonomorphism,
Opt_WarnUnrecognisedPragmas,
Opt_WarnAutoOrphans,
Opt_WarnTabs
]
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_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
checkTemplateHaskellOk :: Bool -> DynP ()
checkTemplateHaskellOk turn_on
| turn_on && rtsIsProfiled
= addErr "You can't use Template Haskell with a profiled compiler"
| otherwise
= return ()
#else
checkTemplateHaskellOk turn_on = return ()
#endif
type DynP = EwM (CmdLineP DynFlags)
upd :: (DynFlags -> DynFlags) -> DynP ()
upd f = liftEwM (do { dfs <- getCmdLineState
; putCmdLineState $! (f dfs) })
noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
noArg fn = NoArg (upd 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 })
intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
intSuffix fn = IntSuffix (\n -> upd (fn n))
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)
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)
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 :: 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 })
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 = upd set
where
set dfs
| isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
| otherwise = dfs
setOptLevel :: Int -> DynFlags -> DynFlags
setOptLevel n dflags
| hscTarget dflags == HscInterpreted && n > 0
= dflags
| otherwise
= updOptLevel n dflags
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
, simplPhases = 3
, specConstrThreshold = Nothing
, specConstrCount = Nothing
})
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
data DPHBackend = DPHPar
| DPHSeq
| DPHThis
deriving(Eq, Ord, Enum, Show)
setDPHBackend :: DPHBackend -> DynP ()
setDPHBackend backend
= do
upd $ \dflags -> dflags { dphBackend = backend }
mapM_ exposePackage (dph_packages backend)
where
dph_packages DPHThis = []
dph_packages DPHPar = ["dph-prim-par", "dph-par"]
dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"]
dphPackage :: DynFlags -> PackageId
dphPackage dflags = case dphBackend dflags of
DPHPar -> dphParPackageId
DPHSeq -> dphSeqPackageId
DPHThis -> thisPackage dflags
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 dflags = dflags{ 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}
machdepCCOpts :: DynFlags -> ([String],
[String])
machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags
in (cCcOpts ++ flagsAll, flagsRegHc)
machdepCCOpts' :: DynFlags -> ([String],
[String])
machdepCCOpts' _dflags
#if alpha_TARGET_ARCH
= ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
, "-D_REENTRANT"
#endif
], [] )
#elif hppa_TARGET_ARCH
= ( ["-D_HPUX_SOURCE"], [] )
#elif m68k_TARGET_ARCH
= ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
#elif i386_TARGET_ARCH
= let n_regs = stolen_x86_regs _dflags
in
(
[ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
],
[ "-fno-defer-pop",
"-fomit-frame-pointer",
"-fno-builtin",
"-DSTOLEN_X86_REGS="++show n_regs ]
)
#elif ia64_TARGET_ARCH
= ( [], ["-fomit-frame-pointer", "-G0"] )
#elif x86_64_TARGET_ARCH
= (
[],
["-fomit-frame-pointer",
"-fno-asynchronous-unwind-tables",
"-fno-builtin"
] )
#elif sparc_TARGET_ARCH
= ( [], ["-w"] )
#elif powerpc_apple_darwin_TARGET
= ( [], ["-no-cpp-precomp"] )
#else
= ( [], [] )
#endif
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 = cSplitObjs == "YES"
data Printable = String String
| FromDynFlags (DynFlags -> String)
compilerInfo :: [(String, Printable)]
compilerInfo = [("Project name", String cProjectName),
("Project version", String cProjectVersion),
("Booter version", String cBooterVersion),
("Stage", String cStage),
("Build platform", String cBuildPlatform),
("Host platform", String cHostPlatform),
("Target platform", String cTargetPlatform),
("Have interpreter", String cGhcWithInterpreter),
("Object splitting", String cSplitObjs),
("Have native code generator", String cGhcWithNativeCodeGen),
("Have llvm code generator", String cGhcWithLlvmCodeGen),
("Support SMP", String cGhcWithSMP),
("Unregisterised", String cGhcUnregisterised),
("Tables next to code", String cGhcEnableTablesNextToCode),
("RTS ways", String cGhcRTSWays),
("Leading underscore", String cLeadingUnderscore),
("Debug on", String (show debugIsOn)),
("LibDir", FromDynFlags topDir),
("Global Package DB", FromDynFlags systemPackageConfig),
("C compiler flags", String (show cCcOpts)),
("Gcc Linker flags", String (show cGccLinkerOpts)),
("Ld Linker flags", String (show cLdLinkerOpts))
]