| 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_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.
specConstrThreshold = Just 200,
specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
+ floatLamArgs = Just 0, -- Default: float only if no fvs
strictnessBefore = [],
#ifndef OMIT_NATIVE_CODEGEN
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,
, 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 ----------------------------------------------------
, 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
- = ( 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
+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
+ , 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-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 ),
( "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 ),
( "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,
\ turn_on -> if not turn_on
= [ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
- Opt_MethodSharing,
-
Opt_DoAsmMangling,
Opt_SharedImplib,
++ standardWarnings
-impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
+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_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, Opt_ImplicitPrelude)
+ , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off!
- , (Opt_GADTs, Opt_MonoLocalBinds)
- , (Opt_TypeFamilies, Opt_MonoLocalBinds)
+ , (Opt_GADTs, turnOn, Opt_MonoLocalBinds)
+ , (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds)
- , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures
+ , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures
-- all over the place
- , (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)]
Opt_WarnMissingSigs,
Opt_WarnHiShadows,
Opt_WarnOrphans,
- Opt_WarnUnusedDoBind
+ Opt_WarnUnusedDoBind,
+ Opt_WarnIdentities
]
-- minuswRemovesOpts should be every warning option
--------------------------
setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
- ; mapM_ setExtensionFlag deps }
+ ; 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 -> 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
projects / ghc-hetmet.git / blobdiff