-- 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,
+ glasgowExtsFlags,
+ dopt,
+ dopt_set,
+ dopt_unset,
+ xopt,
+ xopt_set,
+ xopt_unset,
DynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
-- * Compiler configuration suitable for display to the user
Printable(..),
- compilerInfo, rtsIsProfiled
+ compilerInfo
+#ifdef GHCI
+-- Only in stage 2 can we be sure that the RTS
+-- exposes the appropriate runtime boolean
+ , rtsIsProfiled
+#endif
) where
#include "HsVersions.h"
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_D_dump_foreign
| Opt_D_dump_inlinings
| Opt_D_dump_rule_firings
+ | Opt_D_dump_rule_rewrites
| Opt_D_dump_occur_anal
| Opt_D_dump_parsed
| Opt_D_dump_rn
| Opt_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_GHCForeignImportPrim
- | Opt_PArr -- Syntactic support for parallel arrays
+ | Opt_ParallelArrays -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax
| Opt_TemplateHaskell
| Opt_QuasiQuotes
| Opt_RecordPuns
| Opt_ViewPatterns
| Opt_GADTs
- | Opt_RelaxedPolyRec
| Opt_NPlusKPatterns
| Opt_DoAndIfThenElse
+ | Opt_RebindableSyntax
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
- | Opt_NewQualifiedOperators
| Opt_ExplicitForAll
| 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 (),
data DynLibLoader
= Deployable
- | Wrapped (Maybe String)
| SystemDependent
deriving Eq
-- 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
: 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
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = f `elem` extensionFlags dflags
-- | 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) }
+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
case splitAt 8 f of
("deploy", "") -> d{ dynLibLoader = Deployable }
("sysdep", "") -> d{ dynLibLoader = SystemDependent }
- ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing }
- ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
- ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) }
_ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
setDumpPrefixForce f d = d { dumpPrefixForce = f}
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_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.
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; ignoring -fllvm"], dflags1{ hscTarget = HscAsm })
+ = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
+ ++ "dynamic on this platform;\n ignoring -fllvm"],
+ dflags1{ hscTarget = HscAsm })
#endif
| otherwise = ([], dflags1)
, 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-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites)
, 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 "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 )
]
deprecatedForExtension "ImplicitParams" ),
( "scoped-type-variables", Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
- ( "parr", Opt_PArr,
- deprecatedForExtension "PArr" ),
+ ( "parr", Opt_ParallelArrays,
+ deprecatedForExtension "ParallelArrays" ),
+ ( "PArr", Opt_ParallelArrays,
+ deprecatedForExtension "ParallelArrays" ),
( "allow-overlapping-instances", Opt_OverlappingInstances,
deprecatedForExtension "OverlappingInstances" ),
( "allow-undecidable-instances", Opt_UndecidableInstances,
( "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"),
( "DoRec", Opt_DoRec, nop ),
( "Arrows", Opt_Arrows, nop ),
- ( "PArr", Opt_PArr, nop ),
+ ( "ParallelArrays", Opt_ParallelArrays, nop ),
( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
( "QuasiQuotes", Opt_QuasiQuotes, nop ),
( "Generics", Opt_Generics, 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 ),
+ ( "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 ),
( "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'" )
+ ( "PackageImports", Opt_PackageImports, nop )
]
-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_RelaxedPolyRec) -- We want type-sig variables to
- -- be completely rigid for GADTs
-
- , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- 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_FlexibleInstances, turnOn, Opt_TypeSynonymInstances)
+
+ , (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_RelaxedPolyRec) -- 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
-- If so, you can't use Template Haskell
foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
rtsIsProfiled :: Bool
-rtsIsProfiled = False -- unsafePerformIO rtsIsProfiledIO /= 0
+rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
checkTemplateHaskellOk :: Bool -> DynP ()
checkTemplateHaskellOk turn_on
= addErr "You can't use Template Haskell with a profiled compiler"
| otherwise
= return ()
+#else
+-- In stage 1 we don't know that the RTS has rts_isProfiled,
+-- so we simply say "ok". It doesn't matter because TH isn't
+-- available in stage 1 anyway.
+checkTemplateHaskellOk turn_on = return ()
+#endif
{- **********************************************************************
%* *
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
machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
[String]) -- for registerised HC compilations
-machdepCCOpts _dflags
+machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags
+ in (cCcOpts ++ flagsAll, flagsRegHc)
+
+machdepCCOpts' :: DynFlags -> ([String], -- flags for all C compilations
+ [String]) -- for registerised HC compilations
+machdepCCOpts' _dflags
#if alpha_TARGET_ARCH
= ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
-- the fp (%ebp) for our register maps.
= let n_regs = stolen_x86_regs _dflags
in
- (
-#if darwin_TARGET_OS
- -- By default, gcc on OS X will generate SSE
- -- instructions, which need things 16-byte aligned,
- -- but we don't 16-byte align things. Thus drop
- -- back to generic i686 compatibility. Trac #2983.
- --
- -- Since Snow Leopard (10.6), gcc defaults to x86_64.
- ["-march=i686", "-m32"],
-#else
+ (
[ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
],
-#endif
[ "-fno-defer-pop",
"-fomit-frame-pointer",
-- we want -fno-builtin, because when gcc inlines
#elif x86_64_TARGET_ARCH
= (
-#if darwin_TARGET_OS
- ["-m64"],
-#else
- [],
-#endif
+ [],
["-fomit-frame-pointer",
"-fno-asynchronous-unwind-tables",
-- the unwind tables are unnecessary for HC code,