GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
- Option(..),
+ Option(..), showOpt,
DynLibLoader(..),
fFlags, xFlags,
dphPackage,
+ wayNames,
-- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
-- ** 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,
import Module
import PackageConfig
import PrelNames ( mAIN )
-#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS))
-import StaticFlags ( opt_Static )
-#endif
-import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
- v_RTS_Build_tag )
+import StaticFlags
import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic
-import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
import SrcLoc
| Opt_WarnUnusedMatches
| Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
+ | Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
| Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
+ | Opt_NPlusKPatterns
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
+ | Opt_DoRec
| Opt_PostfixOperators
+ | Opt_TupleSections
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_TypeOperators
| Opt_PackageImports
| Opt_NewQualifiedOperators
+ | Opt_ExplicitForAll
+ | Opt_AlternativeLayoutRule
| Opt_PrintExplicitForalls
-- optimisation opts
| Opt_Strictness
| Opt_FullLaziness
+ | Opt_FloatIn
+ | Opt_Specialise
| Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
- | Opt_IgnoreInterfacePragmas
- | Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_UnboxStrictFields
| Opt_MethodSharing
| Opt_DictsCheap
- | Opt_InlineIfEnoughArgs
| Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_Vectorise
| 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_EmbedManifest
| Opt_EmitExternalCore
| Opt_SharedImplib
+ | Opt_BuildingCabalPackage
-- temporary flags
| Opt_RunCPS
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
specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
thisPackage :: PackageId, -- ^ name of package currently being compiled
-- ways
- wayNames :: [WayName], -- ^ Way flags from the command line
+ ways :: [Way], -- ^ Way flags from the command line
buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof)
rtsBuildTag :: String, -- ^ The RTS \"way\"
-- paths etc.
objectDir :: Maybe String,
+ dylibInstallName :: Maybe String,
hiDir :: Maybe String,
stubDir :: Maybe String,
-- Package state
-- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM PackageConfig),
+ pkgDatabase :: Maybe [PackageConfig],
pkgState :: PackageState,
-- Temporary files
haddockOptions :: Maybe String
}
+wayNames :: DynFlags -> [WayName]
+wayNames = map wayName . ways
+
-- | The target code type of the compilation (if any).
--
-- Whenever you change the target, also make sure to set 'ghcLink' to
-- Is it worth evaluating this Bool and caching it in the DynFlags value
-- during initDynFlags?
doingTickyProfiling :: DynFlags -> Bool
-doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
+doingTickyProfiling _ = opt_Ticky
+ -- XXX -ticky is a static flag, because it implies -debug which is also
+ -- static. If the way flags were made dynamic, we could fix this.
data PackageFlag
= ExposePackage String
+ | ExposePackageId String
| HidePackage String
| IgnorePackage String
deriving Eq
initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
- build_tag <- readIORef v_Build_tag
- rts_build_tag <- readIORef v_RTS_Build_tag
refFilesToClean <- newIORef []
refDirsToClean <- newIORef emptyFM
return dflags{
- wayNames = ways,
- buildTag = build_tag,
- rtsBuildTag = rts_build_tag,
+ ways = ways,
+ buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
+ rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean
}
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,
liberateCaseThreshold = Just 200,
+ strictnessBefore = [],
+
#ifndef OMIT_NATIVE_CODEGEN
targetPlatform = defaultTargetPlatform,
#endif
thisPackage = mainPackageId,
objectDir = Nothing,
+ dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- wayNames = panic "defaultDynFlags: No wayNames",
+ ways = panic "defaultDynFlags: No ways",
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing,
Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
+ Opt_NPlusKPatterns,
Opt_MethodSharing,
}
{-
- #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
| 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,
-- -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}
String -- the filepath/filename portion
| Option String
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s) = s
+
-----------------------------------------------------------------------------
-- Setting the optimisation level
, ([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)
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
+ Opt_WarnDodgyExports,
Opt_WarnDodgyImports
]
]
-- -----------------------------------------------------------------------------
--- 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
- | SimplPhase Int [String]
-
-instance Outputable SimplifierMode where
- ppr SimplGently = ptext (sLit "gentle")
- ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss))
-
-
-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
- 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)
-
- simpl_phase phase names iter
- = CoreDoPasses
- [ 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 [
- -- 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
- 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
-
- 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
-
- 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
Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported
, Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported
, Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported
- , Flag "#include" (HasArg (addCmdlineHCInclude)) Supported
+ , Flag "#include" (HasArg (addCmdlineHCInclude))
+ (Deprecated "No longer has any effect")
, Flag "v" (OptIntSuffix setVerbosity) Supported
------- Specific phases --------------------------------------------
Supported
, Flag "dynload" (HasArg (upd . parseDynLibLoaderMode))
Supported
+ , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath ) Supported
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
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
Supported
+ , Flag "fstrictness-before"
+ (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs })))
+ Supported
+
------ Profiling ----------------------------------------------------
-- XXX Should the -f* flags be deprecated?
, Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
Supported
, Flag "package-name" (HasArg (upd . setPackageName)) Supported
+ , Flag "package-id" (HasArg exposePackageId) Supported
, Flag "package" (HasArg exposePackage) Supported
, Flag "hide-package" (HasArg hidePackage) Supported
, Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
deprecatedForLanguage :: String -> Bool -> Deprecated
deprecatedForLanguage lang turn_on
- = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+ = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where
flag | turn_on = lang
| otherwise = "No"++lang
fFlags :: [(String, DynFlag, Bool -> Deprecated)]
fFlags = [
( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ),
+ ( "warn-dodgy-exports", Opt_WarnDodgyExports, const Supported ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ),
( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ),
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
+ ( "specialise", Opt_Specialise, const Supported ),
+ ( "float-in", Opt_FloatIn, const Supported ),
( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ),
( "full-laziness", Opt_FullLaziness, const Supported ),
( "liberate-case", Opt_LiberateCase, 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 ),
( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ),
( "method-sharing", Opt_MethodSharing, const Supported ),
( "dicts-cheap", Opt_DictsCheap, const Supported ),
- ( "inline-if-enough-args", Opt_InlineIfEnoughArgs, const Supported ),
( "excess-precision", Opt_ExcessPrecision, const Supported ),
( "eager-blackholing", Opt_EagerBlackHoling, const Supported ),
( "asm-mangling", Opt_DoAsmMangling, 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 )
]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PostfixOperators", Opt_PostfixOperators, const Supported ),
+ ( "TupleSections", Opt_TupleSections, const Supported ),
( "PatternGuards", Opt_PatternGuards, const Supported ),
( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ),
( "MagicHash", Opt_MagicHash, const Supported ),
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ),
( "Rank2Types", Opt_Rank2Types, const Supported ),
( "RankNTypes", Opt_RankNTypes, const Supported ),
- ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes,
+ const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
( "TypeOperators", Opt_TypeOperators, const Supported ),
- ( "RecursiveDo", Opt_RecursiveDo, const Supported ),
+ ( "RecursiveDo", Opt_RecursiveDo,
+ deprecatedForLanguage "DoRec"),
+ ( "DoRec", Opt_DoRec, const Supported ),
( "Arrows", Opt_Arrows, const Supported ),
( "PArr", Opt_PArr, const Supported ),
( "TemplateHaskell", Opt_TemplateHaskell, 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):
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
+ ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ),
+ ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
impliedFlags :: [(DynFlag, DynFlag)]
impliedFlags
- = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to
+ = [ (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_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see
-- Note [Scoped tyvars] in TcBinds
, (Opt_ImpredicativeTypes, 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)
]
glasgowExtsFlags :: [DynFlag]
, Opt_LiberalTypeSynonyms
, Opt_RankNTypes
, Opt_TypeOperators
- , Opt_RecursiveDo
+ , Opt_DoRec
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
parseDynamicFlags_ :: Monad m =>
DynFlags -> [Located String] -> Bool
-> m (DynFlags, [Located String], [Located String])
-parseDynamicFlags_ dflags args pkg_flags = do
+parseDynamicFlags_ dflags0 args pkg_flags = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
flag_spec | pkg_flags = package_flags ++ dynamic_flags
| otherwise = dynamic_flags
- let ((leftover, errs, warns), dflags')
- = runCmdLine (processArgs flag_spec args') dflags
+ let ((leftover, errs, warns), dflags1)
+ = runCmdLine (processArgs flag_spec args') dflags0
when (not (null errs)) $ ghcError $ errorsToGhcException errs
- return (dflags', leftover, warns)
+
+ -- Cannot use -fPIC with registerised -fvia-C, because the mangler
+ -- isn't up to the job. We know that if hscTarget == HscC, then the
+ -- user has explicitly used -fvia-C, because -fasm is the default,
+ -- unless there is no NCG on this platform. The latter case is
+ -- checked when the -fPIC flag is parsed.
+ --
+ let (pic_warns, dflags2) =
+ if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
+ then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
+ dflags1{ hscTarget = HscAsm })
+ else ([], dflags1)
+
+ return (dflags2, leftover, pic_warns ++ warns)
type DynP = CmdLineP DynFlags
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
setDumpFlag dump_flag
- = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
+ = NoArg (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 _ 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 })
extraPkgConf_ :: FilePath -> DynP ()
extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
-exposePackage, hidePackage, ignorePackage :: String -> DynP ()
+exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()
exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
+exposePackageId p =
+ upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
ignorePackage p =
upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p
- | Nothing <- unpackPackageId pid
- = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
- | otherwise
- = \s -> s{ thisPackage = pid }
- where
- pid = stringToPackageId p
+setPackageName p s = s{ thisPackage = stringToPackageId p }
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
})
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
- `dopt_set` Opt_InlineIfEnoughArgs
data DPHBackend = DPHPar
| DPHSeq
-- -fomit-frame-pointer : *must* in .hc files; because we're stealing
-- the fp (%ebp) for our register maps.
= let n_regs = stolen_x86_regs _dflags
- sta = opt_Static
in
- ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
+ (
+#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
("Project version", String cProjectVersion),
("Booter version", String cBooterVersion),
("Stage", String cStage),
- ("Interface file version", String cHscIfaceFileVersion),
("Have interpreter", String cGhcWithInterpreter),
("Object splitting", String cSplitObjs),
("Have native code generator", String cGhcWithNativeCodeGen),
projects / ghc-hetmet.git / blobdiff