-- flags. Dynamic flags can also be set at the prompt in GHCi.
module DynFlags (
-- * Dynamic flags and associated configuration types
+ DOpt(..),
DynFlag(..),
+ ExtensionFlag(..),
+ flattenExtensionFlags,
+ ensureFlattenedExtensionFlags,
+ lopt_set_flattened,
+ lopt_unset_flattened,
DynFlags(..),
+ RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
Option(..), showOpt,
DynLibLoader(..),
- fFlags, xFlags,
+ fFlags, fLangFlags, xFlags,
dphPackage,
wayNames,
defaultDynFlags, -- DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
- dopt, -- DynFlag -> DynFlags -> Bool
- dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlag,
updOptLevel,
parseDynamicNoPackageFlags,
allFlags,
- supportedLanguages, languageOptions,
+ supportedLanguagesAndExtensions,
-- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
- -- * Configuration of the core-to-core passes
- CoreToDo(..),
- SimplifierMode(..),
- SimplifierSwitch(..),
- FloatOutSwitches(..),
- getCoreToDo,
-
-- * Configuration of the stg-to-stg passes
StgToDo(..),
getStgToDo,
| 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_WarnIncompletePatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnMissingFields
+ | Opt_WarnMissingImportList
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
| Opt_WarnNameShadowing
| Opt_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind
-
-
- -- language opts
- | Opt_OverlappingInstances
- | Opt_UndecidableInstances
- | Opt_IncoherentInstances
- | Opt_MonomorphismRestriction
- | Opt_MonoPatBinds
- | Opt_MonoLocalBinds
- | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
- | Opt_ForeignFunctionInterface
- | Opt_UnliftedFFITypes
- | Opt_GHCForeignImportPrim
- | Opt_PArr -- Syntactic support for parallel arrays
- | Opt_Arrows -- Arrow-notation syntax
- | Opt_TemplateHaskell
- | Opt_QuasiQuotes
- | Opt_ImplicitParams
- | Opt_Generics -- "Derivable type classes"
- | Opt_ImplicitPrelude
- | Opt_ScopedTypeVariables
- | Opt_UnboxedTuples
- | Opt_BangPatterns
- | Opt_TypeFamilies
- | Opt_OverloadedStrings
- | Opt_DisambiguateRecordFields
- | Opt_RecordWildCards
- | Opt_RecordPuns
- | Opt_ViewPatterns
- | Opt_GADTs
- | Opt_RelaxedPolyRec
- | Opt_NPlusKPatterns
-
- | Opt_StandaloneDeriving
- | Opt_DeriveDataTypeable
- | Opt_DeriveFunctor
- | Opt_DeriveTraversable
- | Opt_DeriveFoldable
-
- | Opt_TypeSynonymInstances
- | Opt_FlexibleContexts
- | Opt_FlexibleInstances
- | Opt_ConstrainedClassMethods
- | Opt_MultiParamTypeClasses
- | Opt_FunctionalDependencies
- | Opt_UnicodeSyntax
- | Opt_PolymorphicComponents
- | Opt_ExistentialQuantification
- | Opt_MagicHash
- | Opt_EmptyDataDecls
- | Opt_KindSignatures
- | Opt_ParallelListComp
- | Opt_TransformListComp
- | Opt_GeneralizedNewtypeDeriving
- | Opt_RecursiveDo
- | Opt_DoRec
- | Opt_PostfixOperators
- | Opt_TupleSections
- | Opt_PatternGuards
- | Opt_LiberalTypeSynonyms
- | Opt_Rank2Types
- | Opt_RankNTypes
- | Opt_ImpredicativeTypes
- | Opt_TypeOperators
- | Opt_PackageImports
- | Opt_NewQualifiedOperators
- | Opt_ExplicitForAll
+ | Opt_WarnAlternativeLayoutRuleTransitional
| Opt_PrintExplicitForalls
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
- | Opt_IgnoreInterfacePragmas
- | Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
+ -- Interface files
+ | Opt_IgnoreInterfacePragmas
+ | Opt_OmitInterfacePragmas
+ | Opt_ExposeAllUnfoldings
+
-- profiling opts
| Opt_AutoSccsOnAllToplevs
| Opt_AutoSccsOnExportedToplevs
| Opt_AutoSccsOnIndividualCafs
-- misc opts
- | Opt_Cpp
| Opt_Pp
| Opt_ForceRecomp
| Opt_DryRun
| Opt_EmitExternalCore
| Opt_SharedImplib
| Opt_BuildingCabalPackage
+ | Opt_SSE2
-- temporary flags
| Opt_RunCPS
| 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_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
+ | Opt_ForeignFunctionInterface
+ | Opt_UnliftedFFITypes
+ | Opt_GHCForeignImportPrim
+ | Opt_PArr -- Syntactic support for parallel arrays
+ | Opt_Arrows -- Arrow-notation syntax
+ | Opt_TemplateHaskell
+ | Opt_QuasiQuotes
+ | Opt_ImplicitParams
+ | Opt_Generics -- "Derivable type classes"
+ | Opt_ImplicitPrelude
+ | Opt_ScopedTypeVariables
+ | Opt_UnboxedTuples
+ | Opt_BangPatterns
+ | Opt_TypeFamilies
+ | Opt_OverloadedStrings
+ | Opt_DisambiguateRecordFields
+ | Opt_RecordWildCards
+ | Opt_RecordPuns
+ | Opt_ViewPatterns
+ | Opt_GADTs
+ | Opt_RelaxedPolyRec
+ | Opt_NPlusKPatterns
+ | Opt_DoAndIfThenElse
+ | Opt_StandaloneDeriving
+ | Opt_DeriveDataTypeable
+ | Opt_DeriveFunctor
+ | Opt_DeriveTraversable
+ | Opt_DeriveFoldable
+
+ | Opt_TypeSynonymInstances
+ | Opt_FlexibleContexts
+ | Opt_FlexibleInstances
+ | Opt_ConstrainedClassMethods
+ | Opt_MultiParamTypeClasses
+ | Opt_FunctionalDependencies
+ | Opt_UnicodeSyntax
+ | Opt_PolymorphicComponents
+ | Opt_ExistentialQuantification
+ | Opt_MagicHash
+ | Opt_EmptyDataDecls
+ | Opt_KindSignatures
+ | Opt_ParallelListComp
+ | Opt_TransformListComp
+ | Opt_GeneralizedNewtypeDeriving
+ | Opt_RecursiveDo
+ | Opt_DoRec
+ | Opt_PostfixOperators
+ | Opt_TupleSections
+ | Opt_PatternGuards
+ | Opt_LiberalTypeSynonyms
+ | Opt_Rank2Types
+ | Opt_RankNTypes
+ | Opt_ImpredicativeTypes
+ | Opt_TypeOperators
+ | Opt_PackageImports
+ | Opt_NewQualifiedOperators
+ | Opt_ExplicitForAll
+ | Opt_AlternativeLayoutRule
+ | Opt_AlternativeLayoutRuleTransitional
+ | Opt_DatatypeContexts
deriving (Eq, Show)
-- | Contains not only a collection of 'DynFlag's but also a plethora of
data DynFlags = DynFlags {
ghcMode :: GhcMode,
ghcLink :: GhcLink,
- coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile
- stgToDo :: Maybe [StgToDo], -- similarly
hscTarget :: HscTarget,
hscOutName :: String, -- ^ Name of the output file
extCoreName :: String, -- ^ Name of the .hcr output file
- verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels"
+ verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level
simplPhases :: Int, -- ^ Number of simplifier phases
maxSimplIterations :: Int, -- ^ Max simplifier iterations
- shouldDumpSimplPhase :: SimplifierMode -> Bool,
+ shouldDumpSimplPhase :: Maybe String,
ruleCheck :: Maybe String,
strictnessBefore :: [Int], -- ^ Additional demand analysis
-- paths etc.
objectDir :: Maybe String,
+ dylibInstallName :: Maybe String,
hiDir :: Maybe String,
stubDir :: Maybe String,
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
+ rtsOpts :: Maybe String,
+ rtsOptsEnabled :: RtsOptsEnabled,
hpcDir :: String, -- ^ Path to store the .mix files
opt_a :: [String],
opt_l :: [String],
opt_windres :: [String],
+ opt_lo :: [String], -- LLVM: llvm optimiser
+ opt_lc :: [String], -- LLVM: llc static compiler
-- commands for particular phases
pgm_L :: String,
pgm_T :: String,
pgm_sysman :: String,
pgm_windres :: String,
+ pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser
+ pgm_lc :: (String,[Option]), -- LLVM: llc static compiler
-- For ghc -M
depMakefile :: FilePath,
-- hsc dynamic flags
flags :: [DynFlag],
+ language :: Maybe Language,
+ extensionFlags :: Either [OnOff ExtensionFlag]
+ [ExtensionFlag],
-- | Message output action: use "ErrUtils" instead of this if you can
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
data HscTarget
= HscC -- ^ Generate C code.
| HscAsm -- ^ Generate assembly using the native code generator.
+ | HscLlvm -- ^ Generate assembly using the llvm code generator.
| HscJava -- ^ Generate Java bytecode.
| HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory')
| HscNothing -- ^ Don't generate any code. See notes above.
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True
isObjectTarget HscAsm = True
+isObjectTarget HscLlvm = True
isObjectTarget _ = False
-- | The 'GhcMode' tells us whether we're doing multi-module
| SystemDependent
deriving Eq
+data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
DynFlags {
ghcMode = CompManager,
ghcLink = LinkBinary,
- coreToDo = Nothing,
- stgToDo = Nothing,
hscTarget = defaultHscTarget,
hscOutName = "",
extCoreName = "",
optLevel = 0,
simplPhases = 2,
maxSimplIterations = 4,
- shouldDumpSimplPhase = const False,
+ shouldDumpSimplPhase = Nothing,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
specConstrCount = Just 3,
thisPackage = mainPackageId,
objectDir = Nothing,
+ dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
frameworkPaths = [],
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
+ rtsOpts = Nothing,
+ rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
opt_m = [],
opt_l = [],
opt_windres = [],
+ opt_lo = [],
+ opt_lc = [],
extraPkgConfs = [],
packageFlags = [],
pgm_T = panic "defaultDynFlags: No pgm_T",
pgm_sysman = panic "defaultDynFlags: No pgm_sysman",
pgm_windres = panic "defaultDynFlags: No pgm_windres",
+ pgm_lo = panic "defaultDynFlags: No pgm_lo",
+ pgm_lc = panic "defaultDynFlags: No pgm_lc",
-- end of initSysTools values
-- ghc -M values
depMakefile = "Makefile",
Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
- Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
- -- behaviour the default, to see if anyone notices
- -- SLPJ July 06
-
- Opt_ImplicitPrelude,
- Opt_MonomorphismRestriction,
- Opt_NPlusKPatterns,
-
Opt_MethodSharing,
Opt_DoAsmMangling,
-- The default -O0 options
++ standardWarnings,
+ language = Nothing,
+ extensionFlags = Left [],
+
log_action = \severity srcSpan style msg ->
case severity of
- SevInfo -> printErrs (msg style)
- SevFatal -> printErrs (msg style)
- _ -> do
+ SevOutput -> printOutput (msg style)
+ SevInfo -> printErrs (msg style)
+ SevFatal -> printErrs (msg style)
+ _ -> do
hPutChar stderr '\n'
printErrs ((mkLocMessage srcSpan msg) style)
-- careful (#2302): printErrs prints in UTF-8, whereas
}
{-
- #verbosity_levels#
- Verbosity levels:
-
+Note [Verbosity levels]
+~~~~~~~~~~~~~~~~~~~~~~~
0 | print errors & warnings only
1 | minimal verbosity: print "compiling M ... done." for each module.
2 | equivalent to -dshow-passes
5 | "ghc -v -ddump-all"
-}
+data OnOff a = On a
+ | Off a
+
+flattenExtensionFlags :: DynFlags -> DynFlags
+flattenExtensionFlags dflags
+ = case extensionFlags dflags of
+ Left onoffs ->
+ dflags {
+ extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs
+ }
+ Right _ ->
+ panic "Flattening already-flattened extension flags"
+
+ensureFlattenedExtensionFlags :: DynFlags -> DynFlags
+ensureFlattenedExtensionFlags dflags
+ = case extensionFlags dflags of
+ Left onoffs ->
+ dflags {
+ extensionFlags = Right $ flattenExtensionFlags' (language dflags) onoffs
+ }
+ Right _ ->
+ dflags
+
+-- OnOffs accumulate in reverse order, so we use foldr in order to
+-- process them in the right order
+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 -- Experimentally, I'm making this non-standard
+ -- behaviour the default, to see if anyone notices
+ -- SLPJ July 06
+ : 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]
+
+-- The DOpt class is a temporary workaround, to avoid having to do
+-- a mass-renaming dopt->lopt at the moment
+class DOpt a where
+ dopt :: a -> DynFlags -> Bool
+ dopt_set :: DynFlags -> a -> DynFlags
+ dopt_unset :: DynFlags -> a -> DynFlags
+
+instance DOpt DynFlag where
+ dopt = dopt'
+ dopt_set = dopt_set'
+ dopt_unset = dopt_unset'
+
+instance DOpt ExtensionFlag where
+ dopt = lopt
+ dopt_set = lopt_set
+ dopt_unset = lopt_unset
+
-- | Test whether a 'DynFlag' is set
-dopt :: DynFlag -> DynFlags -> Bool
-dopt f dflags = f `elem` (flags dflags)
+dopt' :: DynFlag -> DynFlags -> Bool
+dopt' f dflags = f `elem` (flags dflags)
-- | Set a 'DynFlag'
-dopt_set :: DynFlags -> DynFlag -> DynFlags
-dopt_set dfs f = dfs{ flags = f : flags dfs }
+dopt_set' :: DynFlags -> DynFlag -> DynFlags
+dopt_set' dfs f = dfs{ flags = f : flags dfs }
-- | Unset a 'DynFlag'
-dopt_unset :: DynFlags -> DynFlag -> DynFlags
-dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+dopt_unset' :: DynFlags -> DynFlag -> DynFlags
+dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+
+-- | Test whether a 'ExtensionFlag' is set
+lopt :: ExtensionFlag -> DynFlags -> Bool
+lopt f dflags = case extensionFlags dflags of
+ Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
+ Right flags -> f `elem` flags
+
+-- | Set a 'ExtensionFlag'
+lopt_set :: DynFlags -> ExtensionFlag -> DynFlags
+lopt_set dfs f = case extensionFlags dfs of
+ Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
+ Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")
+
+-- | Set a 'ExtensionFlag'
+lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+lopt_set_flattened dfs f = case extensionFlags dfs of
+ Left _ ->
+ panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
+ Right flags ->
+ dfs { extensionFlags = Right (f : delete f flags) }
+
+-- | Unset a 'ExtensionFlag'
+lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+lopt_unset dfs f = case extensionFlags dfs of
+ Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
+ Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")
+
+-- | Unset a 'ExtensionFlag'
+lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+lopt_unset_flattened dfs f = case extensionFlags dfs of
+ Left _ ->
+ panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
+ Right flags ->
+ dfs { extensionFlags = Right (delete f flags) }
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
| verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir, setHiDir, setStubDir, setOutputDir,
+setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
- addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
+ setPgmlo, setPgmlc,
+ addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc,
addCmdlineFramework, addHaddockOpts
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-- \#included from the .hc file when compiling with -fvia-C.
setOutputDir f = setObjectDir f . setHiDir f . setStubDir f
+setDylibInstallName f d = d{ dylibInstallName = Just f}
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setPgml f d = d{ pgm_l = (f,[])}
setPgmdll f d = d{ pgm_dll = (f,[])}
setPgmwindres f d = d{ pgm_windres = f}
+setPgmlo f d = d{ pgm_lo = (f,[])}
+setPgmlc f d = d{ pgm_lc = (f,[])}
addOptL f d = d{ opt_L = f : opt_L d}
addOptP f d = d{ opt_P = f : opt_P d}
addOpta f d = d{ opt_a = f : opt_a d}
addOptl f d = d{ opt_l = f : opt_l d}
addOptwindres f d = d{ opt_windres = f : opt_windres d}
+addOptlo f d = d{ opt_lo = f : opt_lo d}
+addOptlc f d = d{ opt_lc = f : opt_lc d}
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = deOptDep f }
Opt_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports,
- Opt_WarnWrongDoBind
+ Opt_WarnWrongDoBind,
+ Opt_WarnAlternativeLayoutRuleTransitional
]
minusWOpts :: [DynFlag]
]
-- -----------------------------------------------------------------------------
--- CoreToDo: abstraction of core-to-core passes to run.
-
-data CoreToDo -- These are diff core-to-core passes,
- -- which may be invoked in any order,
- -- as many times as you like.
-
- = CoreDoSimplify -- The core-to-core simplifier.
- SimplifierMode
- [SimplifierSwitch]
- -- Each run of the simplifier can take a different
- -- set of simplifier-specific flags.
- | CoreDoFloatInwards
- | CoreDoFloatOutwards FloatOutSwitches
- | CoreLiberateCase
- | CoreDoPrintCore
- | CoreDoStaticArgs
- | CoreDoStrictness
- | CoreDoWorkerWrapper
- | CoreDoSpecialising
- | CoreDoSpecConstr
- | CoreDoOldStrictness
- | CoreDoGlomBinds
- | CoreCSE
- | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
- -- matching this string
- | CoreDoVectorisation PackageId
- | CoreDoNothing -- Useful when building up
- | CoreDoPasses [CoreToDo] -- lists of these things
-
-
-data SimplifierMode -- See comments in SimplMonad
- = SimplGently
- { sm_rules :: Bool -- Whether RULES are enabled
- , sm_inline :: Bool } -- Whether inlining is enabled
-
- | SimplPhase
- { sm_num :: Int -- Phase number; counts downward so 0 is last phase
- , sm_names :: [String] } -- Name(s) of the phase
-
-instance Outputable SimplifierMode where
- ppr (SimplPhase { sm_num = n, sm_names = ss })
- = int n <+> brackets (text (concat $ intersperse "," ss))
- ppr (SimplGently { sm_rules = r, sm_inline = i })
- = ptext (sLit "gentle") <>
- brackets (pp_flag r (sLit "rules") <> comma <>
- pp_flag i (sLit "inline"))
- where
- pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s
-
-data SimplifierSwitch
- = MaxSimplifierIterations Int
- | NoCaseOfCase
-
-data FloatOutSwitches = FloatOutSwitches {
- floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level
- floatOutConstants :: Bool -- ^ True <=> float constants to top level,
- -- even if they do not escape a lambda
- }
-
-instance Outputable FloatOutSwitches where
- ppr = pprFloatOutSwitches
-
-pprFloatOutSwitches :: FloatOutSwitches -> SDoc
-pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
- <+> pp_not (floatOutConstants sw) <+> text "constants"
- where
- pp_not True = empty
- pp_not False = text "not"
-
--- | Switches that specify the minimum amount of floating out
--- gentleFloatOutSwitches :: FloatOutSwitches
--- gentleFloatOutSwitches = FloatOutSwitches False False
-
--- | Switches that do not specify floating out of lambdas, just of constants
-constantsOnlyFloatOutSwitches :: FloatOutSwitches
-constantsOnlyFloatOutSwitches = FloatOutSwitches False True
-
-
--- The core-to-core pass ordering is derived from the DynFlags:
-runWhen :: Bool -> CoreToDo -> CoreToDo
-runWhen True do_this = do_this
-runWhen False _ = CoreDoNothing
-
-runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
-runMaybe (Just x) f = f x
-runMaybe Nothing _ = CoreDoNothing
-
-getCoreToDo :: DynFlags -> [CoreToDo]
-getCoreToDo dflags
- | Just todo <- coreToDo dflags = todo -- set explicitly by user
- | otherwise = core_todo
- where
- opt_level = optLevel dflags
- phases = simplPhases dflags
- max_iter = maxSimplIterations dflags
- strictness = dopt Opt_Strictness dflags
- full_laziness = dopt Opt_FullLaziness dflags
- do_specialise = dopt Opt_Specialise dflags
- do_float_in = dopt Opt_FloatIn dflags
- cse = dopt Opt_CSE dflags
- spec_constr = dopt Opt_SpecConstr dflags
- liberate_case = dopt Opt_LiberateCase dflags
- rule_check = ruleCheck dflags
- static_args = dopt Opt_StaticArgumentTransformation dflags
-
- maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
-
- maybe_strictness_before phase
- = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
-
- simpl_phase phase names iter
- = CoreDoPasses
- [ maybe_strictness_before phase,
- CoreDoSimplify (SimplPhase phase names) [
- MaxSimplifierIterations iter
- ],
- maybe_rule_check phase
- ]
-
- vectorisation
- = runWhen (dopt Opt_Vectorise dflags)
- $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ]
-
-
- -- By default, we have 2 phases before phase 0.
-
- -- Want to run with inline phase 2 after the specialiser to give
- -- maximum chance for fusion to work before we inline build/augment
- -- in phase 1. This made a difference in 'ansi' where an
- -- overloaded function wasn't inlined till too late.
-
- -- Need phase 1 so that build/augment get
- -- inlined. I found that spectral/hartel/genfft lost some useful
- -- strictness in the function sumcode' if augment is not inlined
- -- before strictness analysis runs
- simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
- | phase <- [phases, phases-1 .. 1] ]
-
-
- -- initial simplify: mk specialiser happy: minimum effort please
- simpl_gently = CoreDoSimplify
- (SimplGently { sm_rules = True, sm_inline = False })
- [
- -- Simplify "gently"
- -- Don't inline anything till full laziness has bitten
- -- In particular, inlining wrappers inhibits floating
- -- e.g. ...(case f x of ...)...
- -- ==> ...(case (case x of I# x# -> fw x#) of ...)...
- -- ==> ...(case x of I# x# -> case fw x# of ...)...
- -- and now the redex (f x) isn't floatable any more
- -- Similarly, don't apply any rules until after full
- -- laziness. Notably, list fusion can prevent floating.
-
- NoCaseOfCase, -- Don't do case-of-case transformations.
- -- This makes full laziness work better
- MaxSimplifierIterations max_iter
- ]
-
- core_todo =
- if opt_level == 0 then
- [vectorisation,
- simpl_phase 0 ["final"] max_iter]
- else {- opt_level >= 1 -} [
-
- -- We want to do the static argument transform before full laziness as it
- -- may expose extra opportunities to float things outwards. However, to fix
- -- up the output of the transformation we need at do at least one simplify
- -- after this before anything else
- runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
-
- -- We run vectorisation here for now, but we might also try to run
- -- it later
- vectorisation,
-
- -- initial simplify: mk specialiser happy: minimum effort please
- simpl_gently,
-
- -- Specialisation is best done before full laziness
- -- so that overloaded functions have all their dictionary lambdas manifest
- runWhen do_specialise CoreDoSpecialising,
-
- runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
- -- Was: gentleFloatOutSwitches
- -- I have no idea why, but not floating constants to top level is
- -- very bad in some cases.
- -- Notably: p_ident in spectral/rewrite
- -- Changing from "gentle" to "constantsOnly" improved
- -- rewrite's allocation by 19%, and made 0.0% difference
- -- to any other nofib benchmark
-
- runWhen do_float_in CoreDoFloatInwards,
-
- simpl_phases,
-
- -- Phase 0: allow all Ids to be inlined now
- -- This gets foldr inlined before strictness analysis
-
- -- At least 3 iterations because otherwise we land up with
- -- huge dead expressions because of an infelicity in the
- -- simpifier.
- -- let k = BIG in foldr k z xs
- -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
- -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
- -- Don't stop now!
- simpl_phase 0 ["main"] (max max_iter 3),
-
-
-#ifdef OLD_STRICTNESS
- CoreDoOldStrictness,
-#endif
- runWhen strictness (CoreDoPasses [
- CoreDoStrictness,
- CoreDoWorkerWrapper,
- CoreDoGlomBinds,
- simpl_phase 0 ["post-worker-wrapper"] max_iter
- ]),
-
- runWhen full_laziness
- (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
- -- nofib/spectral/hartel/wang doubles in speed if you
- -- do full laziness late in the day. It only happens
- -- after fusion and other stuff, so the early pass doesn't
- -- catch it. For the record, the redex is
- -- f_el22 (f_el21 r_midblock)
-
-
- runWhen cse CoreCSE,
- -- We want CSE to follow the final full-laziness pass, because it may
- -- succeed in commoning up things floated out by full laziness.
- -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
-
- runWhen do_float_in CoreDoFloatInwards,
-
- maybe_rule_check 0,
-
- -- Case-liberation for -O2. This should be after
- -- strictness analysis and the simplification which follows it.
- runWhen liberate_case (CoreDoPasses [
- CoreLiberateCase,
- simpl_phase 0 ["post-liberate-case"] max_iter
- ]), -- Run the simplifier after LiberateCase to vastly
- -- reduce the possiblility of shadowing
- -- Reason: see Note [Shadowing] in SpecConstr.lhs
-
- runWhen spec_constr CoreDoSpecConstr,
-
- maybe_rule_check 0,
-
- -- Final clean-up simplification:
- simpl_phase 0 ["final"] max_iter
- ]
-
--- -----------------------------------------------------------------------------
-- StgToDo: abstraction of stg-to-stg passes to run.
data StgToDo
getStgToDo :: DynFlags -> [StgToDo]
getStgToDo dflags
- | Just todo <- stgToDo dflags = todo -- set explicitly by user
- | otherwise = todo2
+ = todo2
where
stg_stats = dopt Opt_StgStats dflags
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) flags ++
map ("f"++) flags ++
- map ("X"++) supportedLanguages ++
- map ("XNo"++) supportedLanguages
+ map ("f"++) flags' ++
+ map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
+ flags' = [ name | (name, _, _) <- fLangFlags ]
dynamic_flags :: [Flag DynP]
dynamic_flags = [
Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported
- , Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported
+ , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) Supported
, Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported
, Flag "#include" (HasArg (addCmdlineHCInclude))
- (Deprecated "No longer has any effect")
+ (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")
, Flag "v" (OptIntSuffix setVerbosity) Supported
------- Specific phases --------------------------------------------
+ -- need to appear before -pgmL to be parsed as LLVM flags.
+ , Flag "pgmlo" (HasArg (upd . setPgmlo)) Supported
+ , Flag "pgmlc" (HasArg (upd . setPgmlc)) Supported
+
, Flag "pgmL" (HasArg (upd . setPgmL)) Supported
, Flag "pgmP" (HasArg (upd . setPgmP)) Supported
, Flag "pgmF" (HasArg (upd . setPgmF)) Supported
, Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported
, Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported
+ -- need to appear before -optl/-opta to be parsed as LLVM flags.
+ , Flag "optlo" (HasArg (upd . addOptlo)) Supported
+ , Flag "optlc" (HasArg (upd . addOptlc)) Supported
+
, Flag "optL" (HasArg (upd . addOptL)) Supported
, Flag "optP" (HasArg (upd . addOptP)) Supported
, Flag "optF" (HasArg (upd . addOptF)) Supported
(Deprecated "Use -exclude-module instead")
-------- Linking ----------------------------------------------------
- , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
- Supported
, Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
- (Deprecated "Use -c instead")
+ Supported
, Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
Supported
, Flag "dynload" (HasArg (upd . parseDynLibLoaderMode))
Supported
+ , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath ) Supported
, Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) Supported
, Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
, Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
+ , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported
+ , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported
-- This only makes sense as plural
, Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
------- Miscellaneous ----------------------------------------------
, Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
+ , Flag "with-rtsopts" (HasArg setRtsOpts) Supported
+ , Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+ , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+ , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) Supported
+ , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
+ , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
, Flag "main-is" (SepArg setMainIs ) Supported
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
, Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported
Supported
, Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
Supported
+ , Flag "ddump-llvm" (NoArg (do { setObjTarget HscLlvm
+ ; setDumpFlag' Opt_D_dump_llvm}))
+ Supported
, Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
Supported
, Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
Supported
, Flag "dsource-stats" (setDumpFlag Opt_D_source_stats)
Supported
- , Flag "dverbose-core2core" (NoArg setVerboseCore2Core)
+ , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2)
+ ; setVerboseCore2Core }))
Supported
, Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
Supported
, Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
Supported
+ , Flag "msse2" (NoArg (setDynFlag Opt_SSE2))
+ Supported
+
------ Warning opts -------------------------------------------------
, Flag "W" (NoArg (mapM_ setDynFlag minusWOpts))
Supported
------ Compiler flags -----------------------------------------------
, Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported
- , Flag "fvia-c" (NoArg (setObjTarget HscC)) Supported
- , Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported
-
- , Flag "fno-code" (NoArg (setTarget HscNothing)) Supported
+ , Flag "fvia-c" (NoArg (setObjTarget HscC))
+ (Deprecated "The -fvia-c flag will be removed in a future GHC release")
+ , Flag "fvia-C" (NoArg (setObjTarget HscC))
+ (Deprecated "The -fvia-C flag will be removed in a future GHC release")
+ , Flag "fllvm" (NoArg (setObjTarget HscLlvm)) Supported
+
+ , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
+ setTarget HscNothing))
+ Supported
, Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported
, Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported
- , Flag "fglasgow-exts" (NoArg (mapM_ setDynFlag glasgowExtsFlags))
+ , Flag "fglasgow-exts" (NoArg enableGlasgowExts)
Supported
- , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags))
+ , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts)
Supported
]
++ map (mkFlag True "f" setDynFlag ) fFlags
++ map (mkFlag False "fno-" unSetDynFlag) fFlags
- ++ map (mkFlag True "X" setDynFlag ) xFlags
- ++ map (mkFlag False "XNo" unSetDynFlag) xFlags
+ ++ map (mkFlag True "f" setExtensionFlag ) fLangFlags
+ ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags
+ ++ map (mkFlag True "X" setExtensionFlag ) xFlags
+ ++ map (mkFlag False "XNo" unSetExtensionFlag) xFlags
+ ++ map (mkFlag True "X" setLanguage ) languageFlags
package_flags :: [Flag DynP]
package_flags = [
mkFlag :: Bool -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
- -> (DynFlag -> DynP ())
- -> (String, DynFlag, Bool -> Deprecated)
+ -> (flag -> DynP ())
+ -> (String, flag, Bool -> Deprecated)
-> Flag DynP
-mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
- = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
+mkFlag turnOn flagPrefix f (name, flag, deprecated)
+ = Flag (flagPrefix ++ name) (NoArg (f flag)) (deprecated turnOn)
-deprecatedForLanguage :: String -> Bool -> Deprecated
-deprecatedForLanguage lang turn_on
+deprecatedForExtension :: String -> Bool -> Deprecated
+deprecatedForExtension lang turn_on
= Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where
flag | turn_on = lang
( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, const Supported ),
( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, const Supported ),
( "warn-missing-fields", Opt_WarnMissingFields, const Supported ),
+ ( "warn-missing-import-lists", Opt_WarnMissingImportList, const Supported ),
( "warn-missing-methods", Opt_WarnMissingMethods, const Supported ),
( "warn-missing-signatures", Opt_WarnMissingSigs, const Supported ),
( "warn-name-shadowing", Opt_WarnNameShadowing, const Supported ),
const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ),
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ),
+ ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
( "specialise", Opt_Specialise, const Supported ),
( "cse", Opt_CSE, const Supported ),
( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ),
( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ),
+ ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, const Supported ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ),
( "ignore-asserts", Opt_IgnoreAsserts, const Supported ),
( "do-eta-reduction", Opt_DoEtaReduction, const Supported ),
( "vectorise", Opt_Vectorise, const Supported ),
( "regs-graph", Opt_RegsGraph, const Supported ),
( "regs-iterative", Opt_RegsIterative, const Supported ),
+ ( "gen-manifest", Opt_GenManifest, const Supported ),
+ ( "embed-manifest", Opt_EmbedManifest, const Supported ),
+ ( "ext-core", Opt_EmitExternalCore, const Supported ),
+ ( "shared-implib", Opt_SharedImplib, const Supported ),
+ ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ),
+ ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported )
+ ]
+
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
+fLangFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
+fLangFlags = [
( "th", Opt_TemplateHaskell,
- deprecatedForLanguage "TemplateHaskell" ),
+ deprecatedForExtension "TemplateHaskell" ),
( "fi", Opt_ForeignFunctionInterface,
- deprecatedForLanguage "ForeignFunctionInterface" ),
+ deprecatedForExtension "ForeignFunctionInterface" ),
( "ffi", Opt_ForeignFunctionInterface,
- deprecatedForLanguage "ForeignFunctionInterface" ),
+ deprecatedForExtension "ForeignFunctionInterface" ),
( "arrows", Opt_Arrows,
- deprecatedForLanguage "Arrows" ),
+ deprecatedForExtension "Arrows" ),
( "generics", Opt_Generics,
- deprecatedForLanguage "Generics" ),
+ deprecatedForExtension "Generics" ),
( "implicit-prelude", Opt_ImplicitPrelude,
- deprecatedForLanguage "ImplicitPrelude" ),
+ deprecatedForExtension "ImplicitPrelude" ),
( "bang-patterns", Opt_BangPatterns,
- deprecatedForLanguage "BangPatterns" ),
+ deprecatedForExtension "BangPatterns" ),
( "monomorphism-restriction", Opt_MonomorphismRestriction,
- deprecatedForLanguage "MonomorphismRestriction" ),
+ deprecatedForExtension "MonomorphismRestriction" ),
( "mono-pat-binds", Opt_MonoPatBinds,
- deprecatedForLanguage "MonoPatBinds" ),
+ deprecatedForExtension "MonoPatBinds" ),
( "extended-default-rules", Opt_ExtendedDefaultRules,
- deprecatedForLanguage "ExtendedDefaultRules" ),
+ deprecatedForExtension "ExtendedDefaultRules" ),
( "implicit-params", Opt_ImplicitParams,
- deprecatedForLanguage "ImplicitParams" ),
+ deprecatedForExtension "ImplicitParams" ),
( "scoped-type-variables", Opt_ScopedTypeVariables,
- deprecatedForLanguage "ScopedTypeVariables" ),
+ deprecatedForExtension "ScopedTypeVariables" ),
( "parr", Opt_PArr,
- deprecatedForLanguage "PArr" ),
+ deprecatedForExtension "PArr" ),
( "allow-overlapping-instances", Opt_OverlappingInstances,
- deprecatedForLanguage "OverlappingInstances" ),
+ deprecatedForExtension "OverlappingInstances" ),
( "allow-undecidable-instances", Opt_UndecidableInstances,
- deprecatedForLanguage "UndecidableInstances" ),
+ deprecatedForExtension "UndecidableInstances" ),
( "allow-incoherent-instances", Opt_IncoherentInstances,
- deprecatedForLanguage "IncoherentInstances" ),
- ( "gen-manifest", Opt_GenManifest, const Supported ),
- ( "embed-manifest", Opt_EmbedManifest, const Supported ),
- ( "ext-core", Opt_EmitExternalCore, const Supported ),
- ( "shared-implib", Opt_SharedImplib, const Supported ),
- ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ),
- ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported )
+ deprecatedForExtension "IncoherentInstances" )
]
supportedLanguages :: [String]
-supportedLanguages = [ name | (name, _, _) <- xFlags ]
+supportedLanguages = [ name | (name, _, _) <- languageFlags ]
+
+supportedExtensions :: [String]
+supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
--- This may contain duplicates
-languageOptions :: [DynFlag]
-languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
+supportedLanguagesAndExtensions :: [String]
+supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
+
+-- | These -X<blah> flags cannot be reversed with -XNo<blah>
+languageFlags :: [(String, Language, Bool -> Deprecated)]
+languageFlags = [
+ ( "Haskell98", Haskell98, const Supported ),
+ ( "Haskell2010", Haskell2010, const Supported )
+ ]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
-xFlags :: [(String, DynFlag, Bool -> Deprecated)]
+xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PostfixOperators", Opt_PostfixOperators, const Supported ),
const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
( "TypeOperators", Opt_TypeOperators, const Supported ),
( "RecursiveDo", Opt_RecursiveDo,
- deprecatedForLanguage "DoRec"),
+ deprecatedForExtension "DoRec"),
( "DoRec", Opt_DoRec, const Supported ),
( "Arrows", Opt_Arrows, const Supported ),
( "PArr", Opt_PArr, const Supported ),
( "TemplateHaskell", Opt_TemplateHaskell, const Supported ),
( "QuasiQuotes", Opt_QuasiQuotes, const Supported ),
( "Generics", Opt_Generics, const Supported ),
- -- On by default:
( "ImplicitPrelude", Opt_ImplicitPrelude, const Supported ),
( "RecordWildCards", Opt_RecordWildCards, const Supported ),
( "NamedFieldPuns", Opt_RecordPuns, const Supported ),
( "RecordPuns", Opt_RecordPuns,
- deprecatedForLanguage "NamedFieldPuns" ),
+ deprecatedForExtension "NamedFieldPuns" ),
( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, const Supported ),
( "OverloadedStrings", Opt_OverloadedStrings, const Supported ),
( "GADTs", Opt_GADTs, const Supported ),
( "ViewPatterns", Opt_ViewPatterns, const Supported ),
( "TypeFamilies", Opt_TypeFamilies, const Supported ),
( "BangPatterns", Opt_BangPatterns, const Supported ),
- -- On by default:
( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ),
- -- On by default:
( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ),
- -- On by default (which is not strictly H98):
+ ( "DoAndIfThenElse", Opt_DoAndIfThenElse, const Supported ),
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
( "ExplicitForAll", Opt_ExplicitForAll, const Supported ),
+ ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ),
+ ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ),
+ ( "DatatypeContexts", Opt_DatatypeContexts, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
( "PatternSignatures", Opt_ScopedTypeVariables,
- deprecatedForLanguage "ScopedTypeVariables" ),
+ deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
( "IncoherentInstances", Opt_IncoherentInstances, const Supported ),
( "PackageImports", Opt_PackageImports, const Supported ),
- ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported )
+ ( "NewQualifiedOperators", Opt_NewQualifiedOperators,
+ const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" )
]
-impliedFlags :: [(DynFlag, DynFlag)]
+impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
impliedFlags
= [ (Opt_RankNTypes, Opt_ExplicitForAll)
, (Opt_Rank2Types, Opt_ExplicitForAll)
, (Opt_RecordWildCards, Opt_DisambiguateRecordFields)
]
-glasgowExtsFlags :: [DynFlag]
+enableGlasgowExts :: DynP ()
+enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
+ mapM_ setExtensionFlag glasgowExtsFlags
+
+disableGlasgowExts :: DynP ()
+disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
+ mapM_ unSetExtensionFlag glasgowExtsFlags
+
+glasgowExtsFlags :: [ExtensionFlag]
glasgowExtsFlags = [
- Opt_PrintExplicitForalls
- , Opt_ForeignFunctionInterface
+ Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
, Opt_GADTs
, Opt_ImplicitParams
--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
- ; mapM_ setDynFlag deps }
+setDynFlag f = upd (\dfs -> dopt_set dfs f)
+unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+
+--------------------------
+setLanguage :: Language -> DynP ()
+setLanguage l = upd (\dfs -> dfs { language = Just l })
+
+--------------------------
+setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
+setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
+ ; mapM_ setExtensionFlag deps }
where
deps = [ d | (f', d) <- impliedFlags, f' == f ]
-- When you set f, set the ones it implies
- -- NB: use setDynFlag recursively, in case the implied flags
- -- implies further flags
+ -- NB: use setExtensionFlag recursively, in case the implied flags
+ -- implies further flags
-- When you un-set f, however, we don't un-set the things it implies
-- (except for -fno-glasgow-exts, which is treated specially)
-unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
-setDumpFlag dump_flag
- = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
+setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
+
+setDumpFlag' :: DynFlag -> DynP ()
+setDumpFlag' dump_flag
+ = do { setDynFlag dump_flag
+ ; when want_recomp forceRecompile }
where
-- Certain dumpy-things are really interested in what's going
-- on during recompilation checking, so in those cases we
force_recomp dfs = isOneShot (ghcMode dfs)
setVerboseCore2Core :: DynP ()
-setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core
- forceRecompile
- upd (\s -> s { shouldDumpSimplPhase = const True })
+setVerboseCore2Core = do forceRecompile
+ setDynFlag Opt_D_verbose_core2core
+ upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
+
setDumpSimplPhases :: String -> DynP ()
setDumpSimplPhases s = do forceRecompile
- upd (\s -> s { shouldDumpSimplPhase = spec })
+ upd (\dfs -> dfs { shouldDumpSimplPhase = Just spec })
where
- spec :: SimplifierMode -> Bool
- spec = join (||)
- . map (join (&&) . map match . split ':')
- . split ','
- $ case s of
- '=' : s' -> s'
- _ -> s
-
- join :: (Bool -> Bool -> Bool)
- -> [SimplifierMode -> Bool]
- -> SimplifierMode -> Bool
- join _ [] = const True
- join op ss = foldr1 (\f g x -> f x `op` g x) ss
-
- match :: String -> SimplifierMode -> Bool
- match "" = const True
- match s = case reads s of
- [(n,"")] -> phase_num n
- _ -> phase_name s
-
- phase_num :: Int -> SimplifierMode -> Bool
- phase_num n (SimplPhase k _) = n == k
- phase_num _ _ = False
-
- phase_name :: String -> SimplifierMode -> Bool
- phase_name s (SimplGently {}) = s == "gentle"
- phase_name s (SimplPhase { sm_names = ss }) = s `elem` ss
+ spec = case s of { ('=' : s') -> s'; _ -> s }
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
-- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
+-- RTS opts
+
+setRtsOpts :: String -> DynP ()
+setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
+
+-----------------------------------------------------------------------------
-- Hpc stuff
setOptHpcDir :: String -> DynP ()
| otherwise
= []
#else
+ -- we need -fPIC for C files when we are compiling with -dynamic,
+ -- otherwise things like stub.c files don't get compiled
+ -- correctly. They need to reference data in the Haskell
+ -- objects, but can't without -fPIC. See
+ -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
| opt_PIC || not opt_Static
= ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise
("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),
- ("Win32 DLLs", String cEnableWin32DLLs),
("RTS ways", String cGhcRTSWays),
("Leading underscore", String cLeadingUnderscore),
("Debug on", String (show debugIsOn)),
- ("LibDir", FromDynFlags topDir)
+ ("LibDir", FromDynFlags topDir),
+ ("Global Package DB", FromDynFlags systemPackageConfig)
]