-- flags. Dynamic flags can also be set at the prompt in GHCi.
module DynFlags (
-- * Dynamic flags and associated configuration types
- DOpt(..),
DynFlag(..),
ExtensionFlag(..),
glasgowExtsFlags,
- flattenExtensionFlags,
- ensureFlattenedExtensionFlags,
- lopt_set_flattened,
- lopt_unset_flattened,
+ dopt,
+ dopt_set,
+ dopt_unset,
+ xopt,
+ xopt_set,
+ xopt_unset,
DynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
import Maybes ( orElse )
import SrcLoc
import FastString
-import FiniteMap
import Outputable
import Foreign.C ( CInt )
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.Char
import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
import System.FilePath
import System.IO ( stderr, hPutChar )
| Opt_WarnMissingImportList
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
+ | Opt_WarnMissingLocalSigs
| Opt_WarnNameShadowing
| Opt_WarnOverlappingPatterns
- | Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
| Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
+ | Opt_WarnAutoOrphans
+ | Opt_WarnIdentities
| Opt_WarnTabs
| Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
- | Opt_MethodSharing
+ | Opt_MethodSharing -- Now a no-op; remove in GHC 7.2
| Opt_DictsCheap
| Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_Vectorise
| Opt_SharedImplib
| Opt_BuildingCabalPackage
| Opt_SSE2
+ | Opt_GhciSandbox
-- temporary flags
| Opt_RunCPS
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
| Opt_MonoLocalBinds
+ | Opt_RelaxedPolyRec -- Deprecated
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
| Opt_ForeignFunctionInterface
| Opt_UnliftedFFITypes
| Opt_RecordPuns
| Opt_ViewPatterns
| Opt_GADTs
- | Opt_OutsideIn
- | Opt_RelaxedPolyRec -- Deprecated
| Opt_NPlusKPatterns
| Opt_DoAndIfThenElse
+ | Opt_RebindableSyntax
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional
| Opt_DatatypeContexts
+ | Opt_NondecreasingIndentation
+ | Opt_RelaxedLayout
deriving (Eq, Show)
-- | Contains not only a collection of 'DynFlag's but also a plethora of
specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase
+ floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating
+ -- See CoreMonad.FloatOutSwitches
#ifndef OMIT_NATIVE_CODEGEN
targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG.
-- These have to be IORefs, because the defaultCleanupHandler needs to
-- know what to clean when an exception happens
filesToClean :: IORef [FilePath],
- dirsToClean :: IORef (FiniteMap FilePath FilePath),
+ dirsToClean :: IORef (Map FilePath FilePath),
-- hsc dynamic flags
flags :: [DynFlag],
+ -- Don't change this without updating extensionFlags:
language :: Maybe Language,
- extensionFlags :: Either [OnOff ExtensionFlag]
- [ExtensionFlag],
+ -- Don't change this without updating extensionFlags:
+ extensions :: [OnOff ExtensionFlag],
+ -- extensionFlags should always be equal to
+ -- flattenExtensionFlags language extensions
+ extensionFlags :: [ExtensionFlag],
-- | Message output action: use "ErrUtils" instead of this if you can
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
-- someday these will be dynamic flags
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
- refDirsToClean <- newIORef emptyFM
+ refDirsToClean <- newIORef Map.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
specConstrThreshold = Just 200,
specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
+ floatLamArgs = Just 0, -- Default: float only if no fvs
strictnessBefore = [],
#ifndef OMIT_NATIVE_CODEGEN
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
haddockOptions = Nothing,
- flags = [
- Opt_AutoLinkPackages,
- Opt_ReadUserPackageConf,
-
- Opt_MethodSharing,
-
- Opt_DoAsmMangling,
-
- Opt_SharedImplib,
-
- Opt_GenManifest,
- Opt_EmbedManifest,
- Opt_PrintBindContents
- ]
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
- ++ standardWarnings,
-
+ flags = defaultFlags,
language = Nothing,
- extensionFlags = Left [],
+ extensions = [],
+ extensionFlags = flattenExtensionFlags Nothing [],
log_action = \severity srcSpan style msg ->
case severity of
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
+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
+ -- Nothing => the default case
= Opt_MonoPatBinds -- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
+ -- In due course I'd like Opt_MonoLocalBinds to be on by default
+ -- But NB it's implied by GADTs etc
+ -- SLPJ September 2010
+ : Opt_NondecreasingIndentation -- This has been on by default for some time
+ : Opt_RelaxedLayout -- This has been on by default for some time
: languageExtensions (Just Haskell2010)
+
languageExtensions (Just Haskell98)
= [Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
Opt_NPlusKPatterns,
Opt_DatatypeContexts]
+
languageExtensions (Just Haskell2010)
= [Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
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")
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = f `elem` extensionFlags dflags
-- | 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) }
+xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set dfs f
+ = let onoffs = On f : extensions dfs
+ in dfs { extensions = onoffs,
+ extensionFlags = flattenExtensionFlags (language dfs) onoffs }
-- | 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")
+xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset dfs f
+ = let onoffs = Off f : extensions dfs
+ in dfs { extensions = onoffs,
+ extensionFlags = flattenExtensionFlags (language dfs) onoffs }
--- | 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) }
+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
+ }
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
-optLevelFlags :: [([Int], DynFlag)]
-optLevelFlags
- = [ ([0], Opt_IgnoreInterfacePragmas)
- , ([0], Opt_OmitInterfacePragmas)
-
- , ([1,2], Opt_IgnoreAsserts)
- , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
- -- in PrelRules
- , ([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)
-
--- , ([2], Opt_StaticArgumentTransformation)
--- Max writes: I think it's probably best not to enable SAT with -O2 for the
--- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
--- several improvements to the heuristics, and I'm concerned that without
--- those changes SAT will interfere with some attempts to write "high
--- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
--- this year. In particular, the version in HEAD lacks the tail call
--- criterion, so many things that look like reasonable loops will be
--- turned into functions with extra (unneccesary) thunk creation.
-
- , ([0,1,2], Opt_DoLambdaEtaExpansion)
- -- This one is important for a tiresome reason:
- -- we want to make sure that the bindings for data
- -- constructors are eta-expanded. This is probably
- -- a good thing anyway, but it seems fragile.
- ]
-
--- -----------------------------------------------------------------------------
--- Standard sets of warning options
-
-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 should be every warning option
-minuswRemovesOpts :: [DynFlag]
-minuswRemovesOpts
- = minusWallOpts ++
- [Opt_WarnImplicitPrelude,
- Opt_WarnIncompletePatternsRecUpd,
- Opt_WarnSimplePatterns,
- Opt_WarnMonomorphism,
- Opt_WarnUnrecognisedPragmas,
- Opt_WarnTabs
- ]
-
-- -----------------------------------------------------------------------------
-- StgToDo: abstraction of stg-to-stg passes to run.
, 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 }))
------ Profiling ----------------------------------------------------
setTarget HscNothing))
, Flag "fbyte-code" (NoArg (setTarget HscInterpreted))
, Flag "fobject-code" (NoArg (setTarget defaultHscTarget))
- , Flag "fglasgow-exts" (NoArg enableGlasgowExts)
- , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts)
+ , Flag "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
+ , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
]
- ++ map (mkFlag True "f" setDynFlag ) fFlags
- ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
- ++ 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
+ ++ 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 = [
; deprecate "Use -package instead" }))
]
-type FlagSpec flag
+type TurnOnFlag = Bool -- True <=> we are turning the flag on
+ -- False <=> we are turning the flag off
+turnOn :: TurnOnFlag; turnOn = True
+turnOff :: TurnOnFlag; turnOff = False
+
+type FlagSpec flag
= ( String -- Flag in string form
, flag -- Flag in internal form
- , Bool -> DynP ()) -- Extra action to run when the flag is found
- -- Typically, emit a warning or error
- -- True <=> we are turning the flag on
- -- False <=> we are turning the flag on
+ , TurnOnFlag -> DynP ()) -- Extra action to run when the flag is found
+ -- Typically, emit a warning or error
-
-mkFlag :: Bool -- ^ True <=> it should be turned on
+mkFlag :: TurnOnFlag -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
-> (flag -> DynP ()) -- ^ What to do when the flag is found
-> FlagSpec flag -- ^ Specification of this particular flag
-> Flag (CmdLineP DynFlags)
-mkFlag turnOn flagPrefix f (name, flag, extra_action)
- = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turnOn))
+mkFlag turn_on flagPrefix f (name, flag, extra_action)
+ = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on))
-deprecatedForExtension :: String -> Bool -> DynP ()
+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 -> Bool -> DynP ()
+useInstead :: String -> TurnOnFlag -> DynP ()
useInstead flag turn_on
= deprecate ("Use -f" ++ no ++ flag ++ " instead")
where
no = if turn_on then "" else "no-"
-nop :: Bool -> DynP ()
+nop :: TurnOnFlag -> DynP ()
nop _ = return ()
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
( "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-simple-patterns", Opt_WarnSimplePatterns, nop ),
( "warn-type-defaults", Opt_WarnTypeDefaults, nop ),
( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ),
( "warn-unused-binds", Opt_WarnUnusedBinds, nop ),
( "warn-deprecations", Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, nop ),
( "warn-orphans", Opt_WarnOrphans, nop ),
+ ( "warn-identities", Opt_WarnIdentities, nop ),
+ ( "warn-auto-orphans", Opt_WarnAutoOrphans, nop ),
( "warn-tabs", Opt_WarnTabs, nop ),
( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ),
- ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings,
- \_ -> deprecate "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+ ( "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 ),
( "do-eta-reduction", Opt_DoEtaReduction, nop ),
( "case-merge", Opt_CaseMerge, nop ),
( "unbox-strict-fields", Opt_UnboxStrictFields, nop ),
- ( "method-sharing", Opt_MethodSharing, nop ),
+ ( "method-sharing", Opt_MethodSharing,
+ \_ -> deprecate "doesn't do anything any more"),
+ -- Remove altogether in GHC 7.2
( "dicts-cheap", Opt_DictsCheap, nop ),
( "excess-precision", Opt_ExcessPrecision, nop ),
( "eager-blackholing", Opt_EagerBlackHoling, 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 )
]
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", Opt_Rank2Types, nop ),
( "RankNTypes", Opt_RankNTypes, nop ),
- ( "ImpredicativeTypes", Opt_ImpredicativeTypes,
- \_ -> deprecate "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ),
( "RecursiveDo", Opt_RecursiveDo,
deprecatedForExtension "DoRec"),
( "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 ),
+ ( "NondecreasingIndentation", Opt_NondecreasingIndentation, nop ),
+ ( "RelaxedLayout", Opt_RelaxedLayout, nop ),
( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
- ( "RelaxedPolyRec", Opt_RelaxedPolyRec, 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 ),
\_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
]
-impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
+defaultFlags :: [DynFlag]
+defaultFlags
+ = [ Opt_AutoLinkPackages,
+ Opt_ReadUserPackageConf,
+
+ Opt_DoAsmMangling,
+
+ Opt_SharedImplib,
+
+ Opt_GenManifest,
+ Opt_EmbedManifest,
+ Opt_PrintBindContents,
+ Opt_GhciSandbox
+ ]
+
+ ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+ -- The default -O0 options
+
+ ++ standardWarnings
+
+impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
impliedFlags
- = [ (Opt_RankNTypes, Opt_ExplicitForAll)
- , (Opt_Rank2Types, Opt_ExplicitForAll)
- , (Opt_ScopedTypeVariables, Opt_ExplicitForAll)
- , (Opt_LiberalTypeSynonyms, Opt_ExplicitForAll)
- , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
- , (Opt_PolymorphicComponents, Opt_ExplicitForAll)
-
- , (Opt_GADTs, Opt_OutsideIn) -- We want type-sig variables to
- -- be completely rigid for GADTs
-
- , (Opt_TypeFamilies, Opt_OutsideIn) -- Trac #2944 gives a nice example
- , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures
+ = [ (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) -- NB: turn off!
+
+ , (Opt_GADTs, turnOn, Opt_MonoLocalBinds)
+ , (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds)
+
+ , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures
-- all over the place
- , (Opt_ScopedTypeVariables, Opt_OutsideIn) -- Ditto for scoped type variables; see
- -- Note [Scoped tyvars] in TcBinds
- , (Opt_ImpredicativeTypes, Opt_RankNTypes)
+ , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes)
-- Record wild-cards implies field disambiguation
-- Otherwise if you write (C {..}) you may well get
-- stuff like " 'a' not in scope ", which is a bit silly
-- if the compiler has just filled in field 'a' of constructor 'C'
- , (Opt_RecordWildCards, Opt_DisambiguateRecordFields)
+ , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields)
]
+optLevelFlags :: [([Int], DynFlag)]
+optLevelFlags
+ = [ ([0], Opt_IgnoreInterfacePragmas)
+ , ([0], Opt_OmitInterfacePragmas)
+
+ , ([1,2], Opt_IgnoreAsserts)
+ , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
+ -- in PrelRules
+ , ([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)
+
+-- , ([2], Opt_StaticArgumentTransformation)
+-- Max writes: I think it's probably best not to enable SAT with -O2 for the
+-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
+-- several improvements to the heuristics, and I'm concerned that without
+-- those changes SAT will interfere with some attempts to write "high
+-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
+-- this year. In particular, the version in HEAD lacks the tail call
+-- criterion, so many things that look like reasonable loops will be
+-- turned into functions with extra (unneccesary) thunk creation.
+
+ , ([0,1,2], Opt_DoLambdaEtaExpansion)
+ -- This one is important for a tiresome reason:
+ -- we want to make sure that the bindings for data
+ -- constructors are eta-expanded. This is probably
+ -- a good thing anyway, but it seems fragile.
+ ]
+
+-- -----------------------------------------------------------------------------
+-- Standard sets of warning options
+
+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,
+ Opt_WarnIdentities
+ ]
+
+-- minuswRemovesOpts should be every warning option
+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
glasgowExtsFlags = [
Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
- , Opt_GADTs
, Opt_ImplicitParams
, Opt_ScopedTypeVariables
, Opt_UnboxedTuples
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
- , Opt_GeneralizedNewtypeDeriving
- , Opt_TypeFamilies ]
+ , Opt_GeneralizedNewtypeDeriving ]
#ifdef GHCI
-- Consult the RTS to find whether GHC itself has been built profiled
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 }
+setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
+ ; sequence_ deps }
where
- deps = [ d | (f', d) <- impliedFlags, f' == f ]
+ deps = [ if turn_on then setExtensionFlag d
+ else unSetExtensionFlag d
+ | (f', turn_on, d) <- impliedFlags, f' == f ]
-- When you set f, set the ones it implies
-- 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)
-unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
+unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
+ -- When you un-set f, however, we don't un-set the things it implies
+ -- (except for -fno-glasgow-exts, which is treated specially)
--------------------------
setDumpFlag' :: DynFlag -> DynP ()
, specConstrCount = Nothing
})
`dopt_set` Opt_DictsCheap
- `dopt_unset` Opt_MethodSharing
data DPHBackend = DPHPar
| DPHSeq
("Object splitting", String cSplitObjs),
("Have native code generator", String cGhcWithNativeCodeGen),
("Have llvm code generator", String cGhcWithLlvmCodeGen),
+ ("Use archives for ghci", String (show cUseArchivesForGhci)),
("Support SMP", String cGhcWithSMP),
("Unregisterised", String cGhcUnregisterised),
("Tables next to code", String cGhcEnableTablesNextToCode),
projects / ghc-hetmet.git / blobdiff