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_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind
+ | Opt_WarnAlternativeLayoutRuleTransitional
-- language opts
| 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_AlternativeLayoutRuleTransitional
| 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_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
+ | Opt_RtsOptsEnabled
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
| Opt_EmbedManifest
| Opt_EmitExternalCore
| Opt_SharedImplib
+ | Opt_BuildingCabalPackage
+ | Opt_SSE2
-- 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,
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
+ rtsOpts :: Maybe String,
hpcDir :: String, -- ^ Path to store the .mix files
-- 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,
frameworkPaths = [],
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
+ rtsOpts = Nothing,
hpcDir = ".hpc",
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_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports,
- Opt_WarnWrongDoBind
+ Opt_WarnWrongDoBind,
+ Opt_WarnAlternativeLayoutRuleTransitional
]
minusWOpts :: [DynFlag]
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
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) flags ++
map ("f"++) flags ++
- map ("X"++) supportedLanguages ++
- map ("XNo"++) supportedLanguages
+ map ("X"++) supportedLanguages
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
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))
+ (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")
, Flag "v" (OptIntSuffix setVerbosity) Supported
------- Specific phases --------------------------------------------
(Deprecated "Use -exclude-module instead")
-------- Linking ----------------------------------------------------
- , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
- Supported
, Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
- (Deprecated "Use -c instead")
+ Supported
, Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
Supported
, Flag "dynload" (HasArg (upd . parseDynLibLoaderMode))
Supported
+ , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath ) Supported
------- Miscellaneous ----------------------------------------------
, Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
+ , Flag "with-rtsopts" (HasArg setRtsOpts) Supported
+ , Flag "rtsopts" (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported
+ , Flag "no-rtsopts" (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported
, Flag "main-is" (SepArg setMainIs ) Supported
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
, Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) 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
, Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
Supported
+ , Flag "msse2" (NoArg (setDynFlag Opt_SSE2))
+ Supported
+
------ Warning opts -------------------------------------------------
, Flag "W" (NoArg (mapM_ setDynFlag minusWOpts))
Supported
(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 "fvia-c" (NoArg (setObjTarget HscC)) Supported
, Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported
- , Flag "fno-code" (NoArg (setTarget HscNothing)) Supported
+ , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
+ setTarget HscNothing))
+ Supported
, Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported
, Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported
, Flag "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 ),
const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ),
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ),
+ ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
+ ( "specialise", Opt_Specialise, const Supported ),
+ ( "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 )
]
supportedLanguages :: [String]
-supportedLanguages = [ name | (name, _, _) <- xFlags ]
+supportedLanguages = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
-- This may contain duplicates
languageOptions :: [DynFlag]
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 ),
+ ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, 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
-- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
+-- RTS opts
+
+setRtsOpts :: String -> DynP ()
+setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+
+-----------------------------------------------------------------------------
-- Hpc stuff
setOptHpcDir :: String -> DynP ()
-- -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),
("Support SMP", String cGhcWithSMP),
("Unregisterised", String cGhcUnregisterised),
("Tables next to code", String cGhcEnableTablesNextToCode),
- ("Win32 DLLs", String cEnableWin32DLLs),
("RTS ways", String cGhcRTSWays),
("Leading underscore", String cLeadingUnderscore),
("Debug on", String (show debugIsOn)),
- ("LibDir", FromDynFlags topDir)
+ ("LibDir", FromDynFlags topDir),
+ ("Global Package DB", FromDynFlags systemPackageConfig)
]
projects / ghc-hetmet.git / blobdiff