------------------------------------------------------------------------------
---
+-- |
-- Dynamic flags
--
--
-- (c) The University of Glasgow 2005
--
------------------------------------------------------------------------------
--- | Most flags are dynamic flags, which means they can change from
+-- Most flags are dynamic flags, which means they can change from
-- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a
-- multi-session GHC each session can be using different dynamic
-- flags. Dynamic flags can also be set at the prompt in GHCi.
Option(..),
DynLibLoader(..),
fFlags, xFlags,
- DPHBackend(..),
+ dphPackage,
-- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
-- ** Parsing DynFlags
parseDynamicFlags,
+ parseDynamicNoPackageFlags,
allFlags,
supportedLanguages, languageOptions,
import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
-import SrcLoc ( SrcSpan )
+import SrcLoc
import FastString
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
| Opt_D_dump_BCOs
| Opt_D_dump_vect
| Opt_D_dump_hpc
+ | Opt_D_dump_rtti
| Opt_D_source_stats
| Opt_D_verbose_core2core
| Opt_D_verbose_stg2stg
| Opt_TemplateHaskell
| Opt_QuasiQuotes
| Opt_ImplicitParams
- | Opt_Generics
+ | Opt_Generics -- "Derivable type classes"
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
| Opt_UnboxedTuples
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
- | Opt_PatternSignatures
| Opt_ParallelListComp
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
+ | Opt_NewQualifiedOperators
| Opt_PrintExplicitForalls
| Opt_UnboxStrictFields
| Opt_MethodSharing
| Opt_DictsCheap
- | Opt_RewriteRules
+ | 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
| Opt_KeepSFiles
| Opt_KeepRawSFiles
| Opt_KeepTmpFiles
+ | Opt_KeepRawTokenStream
deriving (Eq, Show)
stgToDo :: Maybe [StgToDo], -- similarly
hscTarget :: HscTarget,
hscOutName :: String, -- ^ Name of the output file
- extCoreName :: String, -- ^ Name of the .core output file
+ extCoreName :: String, -- ^ Name of the .hcr output file
verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels"
optLevel :: Int, -- ^ Optimisation level
simplPhases :: Int, -- ^ Number of simplifier phases
dphBackend :: DPHBackend,
- thisPackage :: PackageId,
+ thisPackage :: PackageId, -- ^ name of package currently being compiled
-- ways
wayNames :: [WayName], -- ^ Way flags from the command line
| MkDepend -- ^ @ghc -M@, see "Finder" for why we need this
deriving Eq
+instance Outputable GhcMode where
+ ppr CompManager = ptext (sLit "CompManager")
+ ppr OneShot = ptext (sLit "OneShot")
+ ppr MkDepend = ptext (sLit "MkDepend")
+
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
isOneShot _other = False
ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath",
ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath",
topDir = panic "defaultDynFlags: No topDir",
- systemPackageConfig = panic "defaultDynFlags: No systemPackageConfig",
+ systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags",
pgm_L = panic "defaultDynFlags: No pgm_L",
pgm_P = panic "defaultDynFlags: No pgm_P",
pgm_F = panic "defaultDynFlags: No pgm_F",
| verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+setObjectDir, setHiDir, setStubDir, setOutputDir,
+ setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
addCmdlineFramework, addHaddockOpts
setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
-- -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
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
, ([0], Opt_OmitInterfacePragmas)
, ([1,2], Opt_IgnoreAsserts)
- , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
- -- in PrelRules
+ , ([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)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
- , ([2], Opt_StaticArgumentTransformation)
+
+-- , ([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:
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
- | CoreDoVectorisation DPHBackend
+ | CoreDoVectorisation PackageId
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
vectorisation
= runWhen (dopt Opt_Vectorise dflags)
- $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+ $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ]
-- By default, we have 2 phases before phase 0.
, Flag "hidir" (HasArg (upd . setHiDir)) Supported
, Flag "tmpdir" (HasArg (upd . setTmpDir)) Supported
, Flag "stubdir" (HasArg (upd . setStubDir)) Supported
+ , Flag "outputdir" (HasArg (upd . setOutputDir)) Supported
, Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just))
Supported
, Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp))
(Deprecated "Use -fforce-recomp instead")
- ------- Packages ----------------------------------------------------
- , Flag "package-conf" (HasArg extraPkgConf_) Supported
- , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
- Supported
- , Flag "package-name" (HasArg (upd . setPackageName)) Supported
- , Flag "package" (HasArg exposePackage) Supported
- , Flag "hide-package" (HasArg hidePackage) Supported
- , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
- Supported
- , Flag "ignore-package" (HasArg ignorePackage)
- Supported
- , Flag "syslib" (HasArg exposePackage)
- (Deprecated "Use -package instead")
-
------ HsCpp opts ---------------------------------------------------
, Flag "D" (AnySuffix (upd . addOptP)) Supported
, Flag "U" (AnySuffix (upd . addOptP)) Supported
Supported
, Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
Supported
+ , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
+ Supported
, Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting))
Supported
, Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting))
Supported
, Flag "dshow-passes"
- (NoArg (do setDynFlag Opt_ForceRecomp
+ (NoArg (do forceRecompile
setVerbosity (Just 2)))
Supported
, Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats))
------ DPH flags ----------------------------------------------------
, Flag "fdph-seq"
- (NoArg (upd (setDPHBackend DPHSeq)))
+ (NoArg (setDPHBackend DPHSeq))
Supported
, Flag "fdph-par"
- (NoArg (upd (setDPHBackend DPHPar)))
+ (NoArg (setDPHBackend DPHPar))
+ Supported
+ , Flag "fdph-this"
+ (NoArg (setDPHBackend DPHThis))
Supported
------ Compiler flags -----------------------------------------------
++ map (mkFlag True "X" setDynFlag ) xFlags
++ map (mkFlag False "XNo" unSetDynFlag) xFlags
+package_flags :: [Flag DynP]
+package_flags = [
+ ------- Packages ----------------------------------------------------
+ Flag "package-conf" (HasArg extraPkgConf_) Supported
+ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+ Supported
+ , Flag "package-name" (HasArg (upd . setPackageName)) Supported
+ , Flag "package" (HasArg exposePackage) Supported
+ , Flag "hide-package" (HasArg hidePackage) Supported
+ , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
+ Supported
+ , Flag "ignore-package" (HasArg ignorePackage)
+ Supported
+ , Flag "syslib" (HasArg exposePackage)
+ (Deprecated "Use -package instead")
+ ]
+
mkFlag :: Bool -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
-> (DynFlag -> DynP ())
= Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
deprecatedForLanguage :: String -> Bool -> Deprecated
-deprecatedForLanguage lang turnOn =
- Deprecated ("Use the " ++ prefix ++ lang ++ " language instead")
- where prefix = if turnOn then "" else "No"
+deprecatedForLanguage lang turn_on
+ = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+ where
+ flag | turn_on = lang
+ | otherwise = "No"++lang
+
+useInstead :: String -> Bool -> Deprecated
+useInstead flag turn_on
+ = Deprecated ("Use -f" ++ no ++ flag ++ " instead")
+ where
+ no = if turn_on then "" else "no-"
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fFlags :: [(String, DynFlag, Bool -> Deprecated)]
( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ),
( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ),
( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ),
+ ( "warn-deprecations", Opt_WarnWarningsDeprecations, const Supported ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ),
( "warn-orphans", Opt_WarnOrphans, const Supported ),
( "warn-tabs", Opt_WarnTabs, 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 ),
( "asm-mangling", Opt_DoAsmMangling, const Supported ),
( "print-bind-result", Opt_PrintBindResult, const Supported ),
( "force-recomp", Opt_ForceRecomp, const Supported ),
( "hpc-no-auto", Opt_Hpc_No_Auto, const Supported ),
- ( "rewrite-rules", Opt_RewriteRules, const Supported ),
+ ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+ ( "enable-rewrite-rules", Opt_EnableRewriteRules, const Supported ),
( "break-on-exception", Opt_BreakOnException, const Supported ),
( "break-on-error", Opt_BreakOnError, const Supported ),
( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ),
( "PolymorphicComponents", Opt_PolymorphicComponents, const Supported ),
( "ExistentialQuantification", Opt_ExistentialQuantification, const Supported ),
( "KindSignatures", Opt_KindSignatures, const Supported ),
- ( "PatternSignatures", Opt_PatternSignatures, const Supported ),
( "EmptyDataDecls", Opt_EmptyDataDecls, const Supported ),
( "ParallelListComp", Opt_ParallelListComp, const Supported ),
( "TransformListComp", Opt_TransformListComp, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
( "ImplicitParams", Opt_ImplicitParams, const Supported ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
+
+ ( "PatternSignatures", Opt_ScopedTypeVariables,
+ deprecatedForLanguage "ScopedTypeVariables" ),
+
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ),
( "OverlappingInstances", Opt_OverlappingInstances, const Supported ),
( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
( "IncoherentInstances", Opt_IncoherentInstances, const Supported ),
- ( "PackageImports", Opt_PackageImports, const Supported )
+ ( "PackageImports", Opt_PackageImports, const Supported ),
+ ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported )
]
-impliedFlags :: [(DynFlag, [DynFlag])]
-impliedFlags = [
- ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to
- -- be completely rigid for GADTs
- , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see
- -- Note [Scoped tyvars] in TcBinds
+impliedFlags :: [(DynFlag, DynFlag)]
+impliedFlags
+ = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to
+ -- be completely rigid for GADTs
+
+ , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see
+ -- Note [Scoped tyvars] in TcBinds
]
glasgowExtsFlags :: [DynFlag]
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
- , Opt_PatternSignatures
, Opt_GeneralizedNewtypeDeriving
, Opt_TypeFamilies ]
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
-parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
-parseDynamicFlags dflags args = do
+-- | Parse dynamic flags from a list of command line arguments. Returns the
+-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
+-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
+-- flags or missing arguments).
+parseDynamicFlags :: Monad m =>
+ DynFlags -> [Located String]
+ -> m (DynFlags, [Located String], [Located String])
+ -- ^ Updated 'DynFlags', left-over arguments, and
+ -- list of warnings.
+parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
+
+-- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
+-- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
+parseDynamicNoPackageFlags :: Monad m =>
+ DynFlags -> [Located String]
+ -> m (DynFlags, [Located String], [Located String])
+ -- ^ Updated 'DynFlags', left-over arguments, and
+ -- list of warnings.
+parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
+
+parseDynamicFlags_ :: Monad m =>
+ DynFlags -> [Located String] -> Bool
+ -> m (DynFlags, [Located String], [Located String])
+parseDynamicFlags_ dflags args pkg_flags = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
-- optdep -f -optdepdepend
-- optdep -f -optdep depend
-- but the spaces trip up proper argument handling. So get rid of them.
- let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs
+ let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
f (x : xs) = x : f xs
f xs = xs
args' = f args
+
+ -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
+ flag_spec | pkg_flags = package_flags ++ dynamic_flags
+ | otherwise = dynamic_flags
+
let ((leftover, errs, warns), dflags')
- = runCmdLine (processArgs dynamic_flags args') dflags
- when (not (null errs)) $ do
- ghcError (UsageError (unlines errs))
+ = runCmdLine (processArgs flag_spec args') dflags
+ when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (dflags', leftover, warns)
type DynP = CmdLineP DynFlags
--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
+setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
+ ; mapM_ setDynFlag deps }
where
- deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
+ deps = [ d | (f', d) <- impliedFlags, f' == f ]
-- When you set f, set the ones it implies
+ -- NB: use setDynFlag 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)
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
setDumpFlag dump_flag
- | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
- | otherwise = NoArg (setDynFlag dump_flag)
+ = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
where
- -- Whenver we -ddump, switch off the recompilation checker,
- -- else you don't see the dump!
- -- However, certain dumpy-things are really interested in what's going
+ -- Certain dumpy-things are really interested in what's going
-- on during recompilation checking, so in those cases we
-- don't want to turn it off.
- force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
- Opt_D_dump_hi_diffs]
+ want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
+ Opt_D_dump_hi_diffs]
+
+forceRecompile :: DynP ()
+-- Whenver we -ddump, force recompilation (by switching off the
+-- recompilation checker), else you don't see the dump! However,
+-- don't switch it off in --make mode, else *everything* gets
+-- recompiled which probably isn't what you want
+forceRecompile = do { dfs <- getCmdLineState
+ ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
+ where
+ force_recomp dfs = isOneShot (ghcMode dfs)
setVerboseCore2Core :: DynP ()
-setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
- setDynFlag Opt_D_verbose_core2core
+setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core
+ forceRecompile
upd (\s -> s { shouldDumpSimplPhase = const True })
setDumpSimplPhases :: String -> DynP ()
-setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+setDumpSimplPhases s = do forceRecompile
upd (\s -> s { shouldDumpSimplPhase = spec })
where
spec :: SimplifierMode -> Bool
-- -fdicts-cheap always inline dictionaries
-- -fmax-simplifier-iterations20 this is necessary sometimes
-- -fno-spec-constr-threshold run SpecConstr even for big loops
+-- -fno-spec-constr-count SpecConstr as much as possible
+-- -finline-enough-args hack to prevent excessive inlining
--
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
, specConstrThreshold = Nothing
+ , specConstrCount = Nothing
})
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
+ `dopt_set` Opt_InlineIfEnoughArgs
data DPHBackend = DPHPar
| DPHSeq
-
-setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
-setDPHBackend backend dflags = dflags { dphBackend = backend }
-
+ | DPHThis
+ deriving(Eq, Ord, Enum, Show)
+
+setDPHBackend :: DPHBackend -> DynP ()
+setDPHBackend backend
+ = do
+ upd $ \dflags -> dflags { dphBackend = backend }
+ mapM_ exposePackage (dph_packages backend)
+ where
+ dph_packages DPHThis = []
+ dph_packages DPHPar = ["dph-prim-par", "dph-par"]
+ dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"]
+
+dphPackage :: DynFlags -> PackageId
+dphPackage dflags = case dphBackend dflags of
+ DPHPar -> dphParPackageId
+ DPHSeq -> dphSeqPackageId
+ DPHThis -> thisPackage dflags
setMainIs :: String -> DynP ()
setMainIs arg