+{-# OPTIONS_GHC -w #-}
+-- Temporary, until rtsIsProfiled is fixed
------------------------------------------------------------------------------
---
+-- |
-- Dynamic flags
--
--- 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.
--
-- (c) The University of Glasgow 2005
--
------------------------------------------------------------------------------
+-- 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.
module DynFlags (
- -- Dynamic flags
+ -- * Dynamic flags and associated configuration types
DynFlag(..),
+ ExtensionFlag(..),
+ glasgowExtsFlags,
+ dopt,
+ dopt_set,
+ dopt_unset,
+ xopt,
+ xopt_set,
+ xopt_unset,
DynFlags(..),
+ RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
- Option(..),
+ Option(..), showOpt,
DynLibLoader(..),
- fFlags, xFlags,
- DPHBackend(..),
+ fFlags, fLangFlags, xFlags,
+ DPHBackend(..), dphPackageMaybe,
+ wayNames,
- -- Configuration of the core-to-core and stg-to-stg phases
- CoreToDo(..),
- StgToDo(..),
- SimplifierSwitch(..),
- SimplifierMode(..), FloatOutSwitches(..),
- getCoreToDo, getStgToDo,
-
- -- Manipulating DynFlags
+ -- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
- dopt, -- DynFlag -> DynFlags -> Bool
- dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
- getOpts, -- (DynFlags -> [a]) -> IO [a]
- getVerbFlag,
+ getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
+ getVerbFlags,
updOptLevel,
setTmpDir,
setPackageName,
+ doingTickyProfiling,
- -- parsing DynFlags
+ -- ** Parsing DynFlags
parseDynamicFlags,
+ parseDynamicNoPackageFlags,
allFlags,
- -- misc stuff
+ supportedLanguagesAndExtensions,
+
+ -- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
- supportedLanguages, languageOptions,
- compilerInfo,
+
+ -- * Configuration of the stg-to-stg passes
+ StgToDo(..),
+ getStgToDo,
+
+ -- * Compiler configuration suitable for display to the user
+ Printable(..),
+ 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"
+#ifndef OMIT_NATIVE_CODEGEN
+import Platform
+#endif
import Module
import PackageConfig
import PrelNames ( mAIN )
-#ifdef i386_TARGET_ARCH
-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 ( panic, GhcException(..) )
-import UniqFM ( UniqFM )
+import Panic
import Util
import Maybes ( orElse )
-import SrcLoc ( SrcSpan )
+import SrcLoc
+import FastString
import Outputable
+import Foreign.C ( CInt )
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
-import Data.IORef ( readIORef )
-import Control.Exception ( throwDyn )
+import System.IO.Unsafe ( unsafePerformIO )
+import Data.IORef
import Control.Monad ( when )
import Data.Char
+import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
import System.FilePath
-import System.IO ( hPutStrLn, stderr )
+import System.IO ( stderr, hPutChar )
-- -----------------------------------------------------------------------------
-- DynFlags
+-- | Enumerates the simple on-or-off dynamic flags
data DynFlag
-- debugging flags
= Opt_D_dump_cmm
+ | Opt_D_dump_raw_cmm
| Opt_D_dump_cmmz
| Opt_D_dump_cmmz_pretty
| Opt_D_dump_cps_cmm
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
| Opt_D_dump_asm_stats
+ | Opt_D_dump_asm_expanded
+ | Opt_D_dump_llvm
+ | Opt_D_dump_core_stats
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| 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_D_dump_rn_stats
| Opt_D_dump_opt_cmm
| Opt_D_dump_simpl_stats
+ | Opt_D_dump_cs_trace -- Constraint solver in type checker
| Opt_D_dump_tc_trace
| Opt_D_dump_if_trace
+ | Opt_D_dump_vt_trace
| Opt_D_dump_splices
| 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_DoCmmLinting
| Opt_DoAsmLinting
+ | Opt_F_coqpass -- run the core-to-core coqPass (does whatever CoqPass.hs says)
+ | Opt_D_coqpass -- run the core-to-string coqPass and dumps the result
+ | Opt_D_dump_coqpass -- dumps the output of the core-to-core coqPass
+
| Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnImplicitPrelude
| Opt_WarnIncompletePatterns
+ | Opt_WarnIncompleteUniPatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnMissingFields
+ | Opt_WarnMissingImportList
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
+ | Opt_WarnMissingLocalSigs
| Opt_WarnNameShadowing
| Opt_WarnOverlappingPatterns
- | Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
| Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
- | Opt_WarnDeprecations
+ | Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
+ | Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
+ | Opt_WarnAutoOrphans
+ | Opt_WarnIdentities
| Opt_WarnTabs
+ | Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
-
- -- language opts
- | Opt_OverlappingInstances
- | Opt_UndecidableInstances
- | Opt_IncoherentInstances
- | Opt_MonomorphismRestriction
- | Opt_MonoPatBinds
- | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
- | Opt_ForeignFunctionInterface
- | Opt_UnliftedFFITypes
- | Opt_PArr -- Syntactic support for parallel arrays
- | Opt_Arrows -- Arrow-notation syntax
- | Opt_TemplateHaskell
- | Opt_QuasiQuotes
- | Opt_ImplicitParams
- | Opt_Generics
- | Opt_ImplicitPrelude
- | Opt_ScopedTypeVariables
- | Opt_UnboxedTuples
- | Opt_BangPatterns
- | Opt_TypeFamilies
- | Opt_OverloadedStrings
- | Opt_DisambiguateRecordFields
- | Opt_RecordWildCards
- | Opt_RecordPuns
- | Opt_ViewPatterns
- | Opt_GADTs
- | Opt_RelaxedPolyRec
- | Opt_StandaloneDeriving
- | Opt_DeriveDataTypeable
- | Opt_TypeSynonymInstances
- | Opt_FlexibleContexts
- | Opt_FlexibleInstances
- | Opt_ConstrainedClassMethods
- | Opt_MultiParamTypeClasses
- | Opt_FunctionalDependencies
- | Opt_UnicodeSyntax
- | Opt_PolymorphicComponents
- | Opt_ExistentialQuantification
- | Opt_MagicHash
- | Opt_EmptyDataDecls
- | Opt_KindSignatures
- | Opt_PatternSignatures
- | Opt_ParallelListComp
- | Opt_TransformListComp
- | Opt_GeneralizedNewtypeDeriving
- | Opt_RecursiveDo
- | Opt_PostfixOperators
- | Opt_PatternGuards
- | Opt_LiberalTypeSynonyms
- | Opt_Rank2Types
- | Opt_RankNTypes
- | Opt_ImpredicativeTypes
- | Opt_TypeOperators
+ | Opt_WarnLazyUnliftedBindings
+ | Opt_WarnUnusedDoBind
+ | Opt_WarnWrongDoBind
+ | Opt_WarnAlternativeLayoutRuleTransitional
| 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_CaseMerge
| Opt_UnboxStrictFields
- | Opt_MethodSharing
+ | Opt_MethodSharing -- Now a no-op; remove in GHC 7.2
| Opt_DictsCheap
- | Opt_RewriteRules
+ | 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_AutoSccsOnIndividualCafs
+
-- misc opts
- | Opt_Cpp
| Opt_Pp
| Opt_ForceRecomp
| Opt_DryRun
- | Opt_DoAsmMangling
| Opt_ExcessPrecision
+ | Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
| Opt_SplitObjs
| Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
+ | Opt_EmitExternalCore
+ | Opt_SharedImplib
+ | Opt_BuildingCabalPackage
+ | Opt_SSE2
+ | Opt_GhciSandbox
+ | Opt_HelpfulErrors
+
+ -- temporary flags
+ | Opt_RunCPS
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
+ | Opt_ImplicitImportQualified
+ | Opt_TryNewCodeGen
-- keeping stuff
| Opt_KeepHiDiffs
| Opt_KeepHcFiles
| Opt_KeepSFiles
- | Opt_KeepRawSFiles
| Opt_KeepTmpFiles
+ | Opt_KeepRawTokenStream
+ | Opt_KeepLlvmFiles
deriving (Eq, Show)
+data Language = Haskell98 | Haskell2010
+
+data ExtensionFlag
+ = Opt_Cpp
+ | Opt_OverlappingInstances
+ | Opt_UndecidableInstances
+ | Opt_IncoherentInstances
+ | 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_ParallelArrays -- Syntactic support for parallel arrays
+ | Opt_Arrows -- Arrow-notation syntax
+ | Opt_ModalTypes -- Heterogeneous Metaprogramming (modal types, brackets, escape, CSP)
+ | Opt_TemplateHaskell
+ | Opt_QuasiQuotes
+ | Opt_ImplicitParams
+ | Opt_Generics -- "Derivable type classes"
+ | Opt_ImplicitPrelude
+ | Opt_ScopedTypeVariables
+ | Opt_UnboxedTuples
+ | Opt_BangPatterns
+ | Opt_TypeFamilies
+ | Opt_OverloadedStrings
+ | Opt_DisambiguateRecordFields
+ | Opt_RecordWildCards
+ | Opt_RecordPuns
+ | Opt_ViewPatterns
+ | Opt_GADTs
+ | Opt_GADTSyntax
+ | Opt_NPlusKPatterns
+ | Opt_DoAndIfThenElse
+ | Opt_RebindableSyntax
+
+ | Opt_StandaloneDeriving
+ | Opt_DeriveDataTypeable
+ | Opt_DeriveFunctor
+ | Opt_DeriveTraversable
+ | Opt_DeriveFoldable
+
+ | Opt_TypeSynonymInstances
+ | Opt_FlexibleContexts
+ | Opt_FlexibleInstances
+ | Opt_ConstrainedClassMethods
+ | Opt_MultiParamTypeClasses
+ | Opt_FunctionalDependencies
+ | Opt_UnicodeSyntax
+ | Opt_PolymorphicComponents
+ | Opt_ExistentialQuantification
+ | Opt_MagicHash
+ | Opt_EmptyDataDecls
+ | Opt_KindSignatures
+ | Opt_ParallelListComp
+ | Opt_TransformListComp
+ | Opt_GeneralizedNewtypeDeriving
+ | Opt_RecursiveDo
+ | Opt_DoRec
+ | Opt_PostfixOperators
+ | Opt_TupleSections
+ | Opt_PatternGuards
+ | Opt_LiberalTypeSynonyms
+ | Opt_Rank2Types
+ | Opt_RankNTypes
+ | Opt_ImpredicativeTypes
+ | Opt_TypeOperators
+ | Opt_PackageImports
+ | 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
+-- information relating to the compilation of a single file or GHC session
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 .core output file
- verbosity :: Int, -- verbosity level
- optLevel :: Int, -- optimisation level
- simplPhases :: Int, -- number of simplifier phases
- maxSimplIterations :: Int, -- max simplifier iterations
- shouldDumpSimplPhase :: SimplifierMode -> Bool,
+ hscOutName :: String, -- ^ Name of the output file
+ extCoreName :: String, -- ^ Name of the .hcr output file
+ verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
+ optLevel :: Int, -- ^ Optimisation level
+ simplPhases :: Int, -- ^ Number of simplifier phases
+ maxSimplIterations :: Int, -- ^ Max simplifier iterations
+ 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
- liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase
+ 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
- stolen_x86_regs :: Int,
- cmdlineHcIncludes :: [String], -- -#includes
+#ifndef OMIT_NATIVE_CODEGEN
+ targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG.
+#endif
+ cmdlineHcIncludes :: [String], -- ^ @\-\#includes@
importPaths :: [FilePath],
mainModIs :: Module,
mainFunIs :: Maybe String,
- ctxtStkDepth :: Int, -- Typechecker context stack depth
+ ctxtStkDepth :: Int, -- ^ Typechecker context stack depth
dphBackend :: DPHBackend,
- thisPackage :: PackageId,
+ thisPackage :: PackageId, -- ^ name of package currently being compiled
-- ways
- wayNames :: [WayName], -- way flags from the cmd line
- buildTag :: String, -- the global "way" (eg. "p" for prof)
- rtsBuildTag :: String, -- the RTS "way"
+ ways :: [Way], -- ^ Way flags from the command line
+ buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof)
+ rtsBuildTag :: String, -- ^ The RTS \"way\"
+
+ -- For object splitting
+ splitInfo :: Maybe (String,Int),
-- paths etc.
objectDir :: Maybe String,
+ dylibInstallName :: Maybe String,
hiDir :: Maybe String,
stubDir :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
- -- | This is set by DriverPipeline.runPipeline based on where
+ -- | This is set by 'DriverPipeline.runPipeline' based on where
-- its output is going.
dumpPrefix :: Maybe FilePath,
- -- | Override the dumpPrefix set by runPipeline.
- -- Set by -ddump-file-prefix
+ -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
+ -- Set by @-ddump-file-prefix@
dumpPrefixForce :: Maybe FilePath,
includePaths :: [String],
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
+ rtsOpts :: Maybe String,
+ rtsOptsEnabled :: RtsOptsEnabled,
- hpcDir :: String, -- ^ path to store the .mix files
+ hpcDir :: String, -- ^ Path to store the .mix files
-- options for particular phases
opt_L :: [String],
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
- opt_dep :: [String],
opt_windres :: [String],
+ opt_lo :: [String], -- LLVM: llvm optimiser
+ opt_lc :: [String], -- LLVM: llc static compiler
-- commands for particular phases
pgm_L :: String,
pgm_P :: (String,[Option]),
pgm_F :: String,
pgm_c :: (String,[Option]),
- pgm_m :: (String,[Option]),
pgm_s :: (String,[Option]),
pgm_a :: (String,[Option]),
pgm_l :: (String,[Option]),
pgm_T :: String,
pgm_sysman :: String,
pgm_windres :: String,
+ pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser
+ pgm_lc :: (String,[Option]), -- LLVM: llc static compiler
+
+ -- For ghc -M
+ depMakefile :: FilePath,
+ depIncludePkgDeps :: Bool,
+ depExcludeMods :: [ModuleName],
+ depSuffixes :: [String],
-- Package flags
extraPkgConfs :: [FilePath],
topDir :: FilePath, -- filled in by SysTools
systemPackageConfig :: FilePath, -- ditto
- -- The -package-conf flags given on the command line, in the order
+ -- ^ The @-package-conf@ flags given on the command line, in the order
-- they appeared.
packageFlags :: [PackageFlag],
- -- The -package and -hide-package flags from the command-line
+ -- ^ The @-package@ and @-hide-package@ flags from the command-line
-- 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
+ -- These have to be IORefs, because the defaultCleanupHandler needs to
+ -- know what to clean when an exception happens
+ filesToClean :: IORef [FilePath],
+ dirsToClean :: IORef (Map FilePath FilePath),
+
-- hsc dynamic flags
flags :: [DynFlag],
-
- -- message output
+ -- Don't change this without updating extensionFlags:
+ language :: Maybe Language,
+ -- 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 (),
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
+-- something sensible.
+--
+-- 'HscNothing' can be used to avoid generating any output, however, note
+-- that:
+--
+-- * This will not run the desugaring step, thus no warnings generated in
+-- this step will be output. In particular, this includes warnings related
+-- to pattern matching. You can run the desugarer manually using
+-- 'GHC.desugarModule'.
+--
+-- * If a program uses Template Haskell the typechecker may try to run code
+-- from an imported module. This will fail if no code has been generated
+-- for this module. You can use 'GHC.needsTemplateHaskell' to detect
+-- whether this might be the case and choose to either switch to a
+-- different target or avoid typechecking such modules. (The latter may
+-- preferable for security reasons.)
+--
data HscTarget
- = HscC
- | HscAsm
- | HscJava
- | HscInterpreted
- | HscNothing
+ = HscC -- ^ Generate C code.
+ | HscAsm -- ^ Generate assembly using the native code generator.
+ | HscLlvm -- ^ Generate assembly using the llvm code generator.
+ | HscJava -- ^ Generate Java bytecode.
+ | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory')
+ | HscNothing -- ^ Don't generate any code. See notes above.
deriving (Eq, Show)
--- | will this target result in an object file on the disk?
+-- | Will this target result in an object file on the disk?
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True
isObjectTarget HscAsm = True
+isObjectTarget HscLlvm = True
isObjectTarget _ = False
-- | The 'GhcMode' tells us whether we're doing multi-module
-- imported modules, but in multi-module mode we look for source files
-- in order to check whether they need to be recompiled.
data GhcMode
- = CompManager -- ^ --make, GHCi, etc.
- | OneShot -- ^ ghc -c Foo.hs
- | MkDepend -- ^ ghc -M, see Finder for why we need this
+ = CompManager -- ^ @\-\-make@, GHCi, etc.
+ | OneShot -- ^ @ghc -c Foo.hs@
+ | 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
--- | What kind of linking to do.
-data GhcLink -- What to do in the link step, if there is one
- = NoLink -- Don't link at all
- | LinkBinary -- Link object code into a binary
- | LinkInMemory -- Use the in-memory dynamic linker
- | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
+-- | What to do in the link step, if there is one.
+data GhcLink
+ = NoLink -- ^ Don't link at all
+ | LinkBinary -- ^ Link object code into a binary
+ | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both
+ -- bytecode and object code).
+ | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
+-- Is it worth evaluating this Bool and caching it in the DynFlags value
+-- during initDynFlags?
+doingTickyProfiling :: DynFlags -> Bool
+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
defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
--- | the 'HscTarget' value corresponding to the default way to create
+-- | The 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
defaultObjectTarget :: HscTarget
defaultObjectTarget
data DynLibLoader
= Deployable
- | Wrapped (Maybe String)
| SystemDependent
deriving Eq
+data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+ deriving (Show)
+
+-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
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 Map.empty
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
}
+-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
+-- and must be fully initialized by 'GHC.newSession' first.
defaultDynFlags :: DynFlags
defaultDynFlags =
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,
- stolen_x86_regs = 4,
+ floatLamArgs = Just 0, -- Default: float only if no fvs
+ strictnessBefore = [],
+
+#ifndef OMIT_NATIVE_CODEGEN
+ targetPlatform = defaultTargetPlatform,
+#endif
cmdlineHcIncludes = [],
importPaths = ["."],
mainModIs = mAIN,
mainFunIs = Nothing,
ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
- dphBackend = DPHPar,
+ dphBackend = DPHNone,
thisPackage = mainPackageId,
objectDir = Nothing,
+ dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
outputFile = Nothing,
outputHi = Nothing,
- dynLibLoader = Deployable,
+ dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
includePaths = [],
frameworkPaths = [],
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
+ rtsOpts = Nothing,
+ rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
opt_L = [],
opt_P = (if opt_PIC
- then ["-D__PIC__"]
+ then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
else []),
opt_F = [],
opt_c = [],
opt_a = [],
opt_m = [],
opt_l = [],
- opt_dep = [],
opt_windres = [],
+ opt_lo = [],
+ opt_lc = [],
extraPkgConfs = [],
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,
-- initSysTools fills all these in
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",
pgm_c = panic "defaultDynFlags: No pgm_c",
- pgm_m = panic "defaultDynFlags: No pgm_m",
pgm_s = panic "defaultDynFlags: No pgm_s",
pgm_a = panic "defaultDynFlags: No pgm_a",
pgm_l = panic "defaultDynFlags: No pgm_l",
pgm_T = panic "defaultDynFlags: No pgm_T",
pgm_sysman = panic "defaultDynFlags: No pgm_sysman",
pgm_windres = panic "defaultDynFlags: No pgm_windres",
+ pgm_lo = panic "defaultDynFlags: No pgm_lo",
+ pgm_lc = panic "defaultDynFlags: No pgm_lc",
-- end of initSysTools values
+ -- ghc -M values
+ depMakefile = "Makefile",
+ depIncludePkgDeps = False,
+ depExcludeMods = [],
+ depSuffixes = [],
+ -- end of ghc -M values
+ filesToClean = panic "defaultDynFlags: No filesToClean",
+ dirsToClean = panic "defaultDynFlags: No dirsToClean",
haddockOptions = Nothing,
- flags = [
- Opt_AutoLinkPackages,
- Opt_ReadUserPackageConf,
-
- Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
- -- behaviour the default, to see if anyone notices
- -- SLPJ July 06
-
- Opt_ImplicitPrelude,
- Opt_MonomorphismRestriction,
-
- Opt_MethodSharing,
-
- Opt_DoAsmMangling,
-
- Opt_GenManifest,
- Opt_EmbedManifest,
- Opt_PrintBindContents
- ]
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
- ++ standardWarnings,
+ flags = defaultFlags,
+ language = Nothing,
+ extensions = [],
+ extensionFlags = flattenExtensionFlags Nothing [],
log_action = \severity srcSpan style msg ->
case severity of
- SevInfo -> hPutStrLn stderr (show (msg style))
- SevFatal -> hPutStrLn stderr (show (msg style))
- _ -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
+ SevOutput -> printOutput (msg style)
+ SevInfo -> printErrs (msg style)
+ SevFatal -> printErrs (msg style)
+ _ -> do
+ hPutChar stderr '\n'
+ printErrs ((mkLocMessage srcSpan msg) style)
+ -- careful (#2302): printErrs prints in UTF-8, whereas
+ -- converting to string first and using hPutStr would
+ -- just emit the low 8 bits of each unicode char.
}
{-
- 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
5 | "ghc -v -ddump-all"
-}
+data OnOff a = On a
+ | Off a
+
+-- 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
+ 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,
+ Opt_NondecreasingIndentation
+ -- strictly speaking non-standard, but we always had this
+ -- on implicitly before the option was added in 7.1, and
+ -- turning it off breaks code, so we're keeping it on for
+ -- backwards compatibility. Cabal uses -XHaskell98 by
+ -- default unless you specify another language.
+ ]
+
+languageExtensions (Just Haskell2010)
+ = [Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+ Opt_DatatypeContexts,
+ Opt_EmptyDataDecls,
+ Opt_ForeignFunctionInterface,
+ Opt_PatternGuards,
+ Opt_DoAndIfThenElse,
+ Opt_RelaxedPolyRec]
+
+-- | Test whether a 'DynFlag' is set
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 }
+-- | Unset a 'DynFlag'
dopt_unset :: DynFlags -> DynFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
+-- | Test whether a 'ExtensionFlag' is set
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = f `elem` extensionFlags dflags
+
+-- | Set a 'ExtensionFlag'
+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'
+xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset dfs f
+ = let onoffs = Off f : extensions dfs
+ in dfs { extensions = onoffs,
+ extensionFlags = flattenExtensionFlags (language dfs) onoffs }
+
+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
+ -> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors
+ -> [a] -- ^ Correctly ordered extracted options
getOpts dflags opts = reverse (opts dflags)
-- We add to the options from the front, so we need to reverse the list
-getVerbFlag :: DynFlags -> String
-getVerbFlag dflags
- | verbosity dflags >= 3 = "-v"
- | otherwise = ""
+-- | Gets the verbosity flag for the current verbosity level. This is fed to
+-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
+getVerbFlags :: DynFlags -> [String]
+getVerbFlags dflags
+ | verbosity dflags >= 4 = ["-v"]
+ | otherwise = []
-setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
- setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
- addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
+setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
+ setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+ setPgmP, addOptl, addOptP,
addCmdlineFramework, addHaddockOpts
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
setHiDir f d = d{ hiDir = Just f}
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.
+ -- \#included from the .hc file when compiling via C (i.e. unregisterised
+ -- builds).
+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}
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) }
- (_,_) -> error "Unknown dynlib loader"
+ _ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
setDumpPrefixForce f d = d { dumpPrefixForce = f}
-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option.
setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)}
-
-setPgmL f d = d{ pgm_L = f}
-setPgmF f d = d{ pgm_F = f}
-setPgmc f d = d{ pgm_c = (f,[])}
-setPgmm f d = d{ pgm_m = (f,[])}
-setPgms f d = d{ pgm_s = (f,[])}
-setPgma f d = d{ pgm_a = (f,[])}
-setPgml f d = d{ pgm_l = (f,[])}
-setPgmdll f d = d{ pgm_dll = (f,[])}
-setPgmwindres f d = d{ pgm_windres = f}
-
-addOptL f d = d{ opt_L = f : opt_L d}
-addOptP f d = d{ opt_P = f : opt_P d}
-addOptF f d = d{ opt_F = f : opt_F d}
-addOptc f d = d{ opt_c = f : opt_c d}
-addOptm f d = d{ opt_m = f : opt_m d}
-addOpta f d = d{ opt_a = f : opt_a d}
addOptl f d = d{ opt_l = f : opt_l d}
-addOptdep f d = d{ opt_dep = f : opt_dep d}
-addOptwindres f d = d{ opt_windres = f : opt_windres d}
+addOptP f d = d{ opt_P = f : opt_P d}
+
+
+setDepMakefile :: FilePath -> DynFlags -> DynFlags
+setDepMakefile f d = d { depMakefile = deOptDep f }
+
+setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
+setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
+
+addDepExcludeMod :: String -> DynFlags -> DynFlags
+addDepExcludeMod m d
+ = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
+
+addDepSuffix :: FilePath -> DynFlags -> DynFlags
+addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
+
+-- XXX Legacy code:
+-- We used to use "-optdep-flag -optdeparg", so for legacy applications
+-- we need to strip the "-optdep" off of the arg
+deOptDep :: String -> String
+deOptDep x = case stripPrefix "-optdep" x of
+ Just rest -> rest
+ Nothing -> x
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
-- -----------------------------------------------------------------------------
-- Command-line options
--- When invoking external tools as part of the compilation pipeline, we
+-- | When invoking external tools as part of the compilation pipeline, we
-- pass these a sequence of options on the command-line. Rather than
-- just using a list of Strings, we use a type that allows us to distinguish
--- between filepaths and 'other stuff'. [The reason being, of course, that
+-- between filepaths and 'other stuff'. The reason for this is that
-- this type gives us a handle on transforming filenames, and filenames only,
--- to whatever format they're expected to be on a particular platform.]
-
+-- to whatever format they're expected to be on a particular platform.
data Option
= FileOption -- an entry that _contains_ filename(s) / filepaths.
String -- a non-filepath prefix that shouldn't be
String -- the filepath/filename portion
| Option String
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s) = s
+
-----------------------------------------------------------------------------
-- Setting the optimisation level
updOptLevel :: Int -> DynFlags -> DynFlags
--- Set dynflags appropriate to the optimisation level
+-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
updOptLevel n dfs
= dfs2{ optLevel = final_n }
where
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_RewriteRules) -- 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)
-
- , ([2], Opt_LiberateCase)
- , ([2], Opt_SpecConstr)
- , ([2], Opt_StaticArgumentTransformation)
-
- , ([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_WarnDeprecations,
- Opt_WarnDeprecatedFlags,
- Opt_WarnOverlappingPatterns,
- Opt_WarnMissingFields,
- Opt_WarnMissingMethods,
- Opt_WarnDuplicateExports,
- Opt_WarnDodgyForeignImports
- ]
-
-minusWOpts :: [DynFlag]
-minusWOpts
- = standardWarnings ++
- [ Opt_WarnUnusedBinds,
- Opt_WarnUnusedMatches,
- Opt_WarnUnusedImports,
- Opt_WarnIncompletePatterns,
- Opt_WarnDodgyImports
- ]
-
-minusWallOpts :: [DynFlag]
-minusWallOpts
- = minusWOpts ++
- [ Opt_WarnTypeDefaults,
- Opt_WarnNameShadowing,
- Opt_WarnMissingSigs,
- Opt_WarnHiShadows,
- Opt_WarnOrphans
- ]
-
--- minuswRemovesOpts should be every warning option
-minuswRemovesOpts :: [DynFlag]
-minuswRemovesOpts
- = minusWallOpts ++
- [Opt_WarnImplicitPrelude,
- Opt_WarnIncompletePatternsRecUpd,
- Opt_WarnSimplePatterns,
- Opt_WarnMonomorphism,
- Opt_WarnTabs
- ]
-
--- -----------------------------------------------------------------------------
--- 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 DPHBackend
- | CoreDoNothing -- Useful when building up
- | CoreDoPasses [CoreToDo] -- lists of these things
-
-data SimplifierMode -- See comments in SimplMonad
- = SimplGently
- | SimplPhase Int [String]
-
-data SimplifierSwitch
- = MaxSimplifierIterations Int
- | NoCaseOfCase
-
-data FloatOutSwitches
- = FloatOutSw Bool -- True <=> float lambdas to top level
- Bool -- True <=> float constants to top level,
- -- even if they do not escape a lambda
-
-
--- 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 (dphBackend 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 (FloatOutSw False False)),
-
- 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 (FloatOutSw False -- Not lambdas
- True)), -- Float constants
- -- 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.
getStgToDo :: DynFlags -> [StgToDo]
getStgToDo dflags
- | Just todo <- stgToDo dflags = todo -- set explicitly by user
- | otherwise = todo2
+ = todo2
where
stg_stats = dopt Opt_StgStats dflags
| otherwise
= todo1
+{- **********************************************************************
+%* *
+ DynFlags parser
+%* *
+%********************************************************************* -}
+
-- -----------------------------------------------------------------------------
--- DynFlags parser
+-- Parsing the dynamic flags.
+
+-- | 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_ dflags0 args pkg_flags = do
+ -- XXX Legacy support code
+ -- We used to accept things like
+ -- optdep-f -optdepdepend
+ -- optdep-f -optdep depend
+ -- optdep -f -optdepdepend
+ -- optdep -f -optdep depend
+ -- but the spaces trip up proper argument handling. So get rid of them.
+ 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), dflags1)
+ = runCmdLine (processArgs flag_spec args') dflags0
+ when (not (null errs)) $ ghcError $ errorsToGhcException errs
+
+ let (pic_warns, dflags2)
+#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;\n ignoring -fllvm"],
+ dflags1{ hscTarget = HscAsm })
+#endif
+ | otherwise = ([], dflags1)
+
+ return (dflags2, leftover, pic_warns ++ warns)
+
+
+{- **********************************************************************
+%* *
+ DynFlags specifications
+%* *
+%********************************************************************* -}
allFlags :: [String]
allFlags = map ('-':) $
[ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
map ("fno-"++) flags ++
map ("f"++) flags ++
- map ("X"++) supportedLanguages ++
- map ("XNo"++) supportedLanguages
+ map ("f"++) flags' ++
+ map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
+ flags' = [ name | (name, _, _) <- fLangFlags ]
-dynamic_flags :: [Flag DynP]
+--------------- The main flags themselves ------------------
+dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [
- 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 "v" (OptIntSuffix setVerbosity) Supported
+ Flag "n" (NoArg (setDynFlag Opt_DryRun))
+ , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
+ , Flag "F" (NoArg (setDynFlag Opt_Pp))
+ , Flag "#include"
+ (HasArg (\s -> do { addCmdlineHCInclude s
+ ; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
+ , Flag "v" (OptIntSuffix setVerbosity)
------- Specific phases --------------------------------------------
- , Flag "pgmL" (HasArg (upd . setPgmL)) Supported
- , Flag "pgmP" (HasArg (upd . setPgmP)) Supported
- , Flag "pgmF" (HasArg (upd . setPgmF)) Supported
- , Flag "pgmc" (HasArg (upd . setPgmc)) Supported
- , Flag "pgmm" (HasArg (upd . setPgmm)) Supported
- , Flag "pgms" (HasArg (upd . setPgms)) Supported
- , Flag "pgma" (HasArg (upd . setPgma)) Supported
- , Flag "pgml" (HasArg (upd . setPgml)) Supported
- , Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported
- , Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported
-
- , Flag "optL" (HasArg (upd . addOptL)) Supported
- , Flag "optP" (HasArg (upd . addOptP)) Supported
- , Flag "optF" (HasArg (upd . addOptF)) Supported
- , Flag "optc" (HasArg (upd . addOptc)) Supported
- , Flag "optm" (HasArg (upd . addOptm)) Supported
- , Flag "opta" (HasArg (upd . addOpta)) Supported
- , Flag "optl" (HasArg (upd . addOptl)) Supported
- , Flag "optdep" (HasArg (upd . addOptdep)) Supported
- , Flag "optwindres" (HasArg (upd . addOptwindres)) Supported
+ -- need to appear before -pgmL to be parsed as LLVM flags.
+ , Flag "pgmlo" (hasArg (\f d -> d{ pgm_lo = (f,[])}))
+ , Flag "pgmlc" (hasArg (\f d -> d{ pgm_lc = (f,[])}))
+ , Flag "pgmL" (hasArg (\f d -> d{ pgm_L = f}))
+ , Flag "pgmP" (hasArg setPgmP)
+ , Flag "pgmF" (hasArg (\f d -> d{ pgm_F = f}))
+ , Flag "pgmc" (hasArg (\f d -> d{ pgm_c = (f,[])}))
+ , Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
+ , Flag "pgms" (hasArg (\f d -> d{ pgm_s = (f,[])}))
+ , Flag "pgma" (hasArg (\f d -> d{ pgm_a = (f,[])}))
+ , Flag "pgml" (hasArg (\f d -> d{ pgm_l = (f,[])}))
+ , Flag "pgmdll" (hasArg (\f d -> d{ pgm_dll = (f,[])}))
+ , Flag "pgmwindres" (hasArg (\f d -> d{ pgm_windres = f}))
+
+ -- need to appear before -optl/-opta to be parsed as LLVM flags.
+ , Flag "optlo" (hasArg (\f d -> d{ opt_lo = f : opt_lo d}))
+ , Flag "optlc" (hasArg (\f d -> d{ opt_lc = f : opt_lc d}))
+ , Flag "optL" (hasArg (\f d -> d{ opt_L = f : opt_L d}))
+ , Flag "optP" (hasArg addOptP)
+ , Flag "optF" (hasArg (\f d -> d{ opt_F = f : opt_F d}))
+ , Flag "optc" (hasArg (\f d -> d{ opt_c = f : opt_c d}))
+ , Flag "optm" (hasArg (\f d -> d{ opt_m = f : opt_m d}))
+ , Flag "opta" (hasArg (\f d -> d{ opt_a = f : opt_a d}))
+ , Flag "optl" (hasArg addOptl)
+ , Flag "optwindres" (hasArg (\f d -> d{ opt_windres = f : opt_windres d}))
, Flag "split-objs"
- (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
- Supported
+ (NoArg (if can_split
+ then setDynFlag Opt_SplitObjs
+ else addWarn "ignoring -fsplit-objs"))
+
+ -------- ghc -M -----------------------------------------------------
+ , Flag "dep-suffix" (hasArg addDepSuffix)
+ , Flag "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
+ , Flag "dep-makefile" (hasArg setDepMakefile)
+ , Flag "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
+ , Flag "optdep-w" (NoArg (deprecate "doesn't do anything"))
+ , Flag "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
+ , Flag "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+ , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+ , Flag "exclude-module" (hasArg addDepExcludeMod)
+ , Flag "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
+ , Flag "optdep-x" (hasArgDF addDepExcludeMod "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")
- , Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
- Supported
- , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode))
- Supported
+ , Flag "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
+ , Flag "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
+ , Flag "dynload" (hasArg parseDynLibLoaderMode)
+ , Flag "dylib-install-name" (hasArg setDylibInstallName)
------- Libraries ---------------------------------------------------
- , Flag "L" (Prefix addLibraryPath ) Supported
- , Flag "l" (AnySuffix (\s -> do upd (addOptl s))) Supported
+ , Flag "L" (Prefix addLibraryPath)
+ , Flag "l" (AnySuffix (upd . addOptl))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
- , Flag "framework-path" (HasArg addFrameworkPath ) Supported
- , Flag "framework" (HasArg (upd . addCmdlineFramework)) Supported
+ , Flag "framework-path" (HasArg addFrameworkPath)
+ , Flag "framework" (hasArg addCmdlineFramework)
------- Output Redirection ------------------------------------------
- , Flag "odir" (HasArg (upd . setObjectDir)) Supported
- , Flag "o" (SepArg (upd . setOutputFile . Just)) Supported
- , Flag "ohi" (HasArg (upd . setOutputHi . Just )) Supported
- , Flag "osuf" (HasArg (upd . setObjectSuf)) Supported
- , Flag "hcsuf" (HasArg (upd . setHcSuf)) Supported
- , Flag "hisuf" (HasArg (upd . setHiSuf)) Supported
- , Flag "hidir" (HasArg (upd . setHiDir)) Supported
- , Flag "tmpdir" (HasArg (upd . setTmpDir)) Supported
- , Flag "stubdir" (HasArg (upd . setStubDir)) Supported
- , Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just))
- Supported
+ , Flag "odir" (hasArg setObjectDir)
+ , Flag "o" (SepArg (upd . setOutputFile . Just))
+ , Flag "ohi" (hasArg (setOutputHi . Just ))
+ , Flag "osuf" (hasArg setObjectSuf)
+ , Flag "hcsuf" (hasArg setHcSuf)
+ , Flag "hisuf" (hasArg setHiSuf)
+ , Flag "hidir" (hasArg setHiDir)
+ , Flag "tmpdir" (hasArg setTmpDir)
+ , Flag "stubdir" (hasArg setStubDir)
+ , Flag "outputdir" (hasArg setOutputDir)
+ , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)
- , Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
- , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
- , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) Supported
- , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) Supported
- , Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
- , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
+ , Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles))
+ , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles))
+ , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles))
+ , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles))
+ , Flag "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
+ , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
+ , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles))
+ , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles))
-- This only makes sense as plural
- , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
+ , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles))
------- Miscellaneous ----------------------------------------------
- , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
- , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
- , Flag "main-is" (SepArg setMainIs ) Supported
- , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
- , Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported
- , Flag "hpcdir" (SepArg setOptHpcDir) Supported
+ , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
+ , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain))
+ , Flag "with-rtsopts" (HasArg setRtsOpts)
+ , Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll))
+ , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll))
+ , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
+ , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone))
+ , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone))
+ , Flag "main-is" (SepArg setMainIs)
+ , Flag "haddock" (NoArg (setDynFlag Opt_Haddock))
+ , Flag "haddock-opts" (hasArg addHaddockOpts)
+ , Flag "hpcdir" (SepArg setOptHpcDir)
------- recompilation checker --------------------------------------
- , Flag "recomp" (NoArg (unSetDynFlag Opt_ForceRecomp))
- (Deprecated "Use -fno-force-recomp instead")
- , 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")
+ , Flag "recomp" (NoArg (do { unSetDynFlag Opt_ForceRecomp
+ ; deprecate "Use -fno-force-recomp instead" }))
+ , Flag "no-recomp" (NoArg (do { setDynFlag Opt_ForceRecomp
+ ; deprecate "Use -fforce-recomp instead" }))
------ HsCpp opts ---------------------------------------------------
- , Flag "D" (AnySuffix (upd . addOptP)) Supported
- , Flag "U" (AnySuffix (upd . addOptP)) Supported
+ , Flag "D" (AnySuffix (upd . addOptP))
+ , Flag "U" (AnySuffix (upd . addOptP))
------- Include/Import Paths ----------------------------------------
- , Flag "I" (Prefix addIncludePath) Supported
- , Flag "i" (OptPrefix addImportPath ) Supported
+ , Flag "I" (Prefix addIncludePath)
+ , Flag "i" (OptPrefix addImportPath)
------ Debugging ----------------------------------------------------
- , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) Supported
+ , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats))
, Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm)
- Supported
+ , Flag "ddump-raw-cmm" (setDumpFlag Opt_D_dump_raw_cmm)
, Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz)
- Supported
, Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty)
- Supported
+ , Flag "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats)
, Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm)
- Supported
, Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm)
- Supported
, Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm)
- Supported
, Flag "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native)
- Supported
, Flag "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness)
- Supported
, Flag "ddump-asm-coalesce" (setDumpFlag Opt_D_dump_asm_coalesce)
- Supported
, Flag "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc)
- Supported
, Flag "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts)
- Supported
- , Flag "ddump-asm-regalloc-stages"
- (setDumpFlag Opt_D_dump_asm_regalloc_stages)
- Supported
+ , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
, Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
- Supported
+ , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
+ , Flag "ddump-llvm" (NoArg (do { setObjTarget HscLlvm
+ ; setDumpFlag' Opt_D_dump_llvm}))
, Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
- Supported
, Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
- Supported
, Flag "ddump-ds" (setDumpFlag Opt_D_dump_ds)
- Supported
, Flag "ddump-flatC" (setDumpFlag Opt_D_dump_flatC)
- Supported
, Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign)
- Supported
, Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings)
- Supported
, Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings)
- Supported
+ , Flag "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites)
, Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal)
- Supported
, Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed)
- Supported
, Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn)
- Supported
, Flag "ddump-simpl" (setDumpFlag Opt_D_dump_simpl)
- Supported
, Flag "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations)
- Supported
, Flag "ddump-simpl-phases" (OptPrefix setDumpSimplPhases)
- Supported
, Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec)
- Supported
, Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep)
- Supported
, Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg)
- Supported
, Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal)
- Supported
, Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc)
- Supported
, Flag "ddump-types" (setDumpFlag Opt_D_dump_types)
- Supported
, Flag "ddump-rules" (setDumpFlag Opt_D_dump_rules)
- Supported
, Flag "ddump-cse" (setDumpFlag Opt_D_dump_cse)
- Supported
, Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper)
- Supported
, Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace)
- Supported
, Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace)
- Supported
+ , Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace)
, Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace)
- Supported
+ , Flag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace)
, Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices)
- Supported
, Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats)
- Supported
, Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm)
- Supported
, Flag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats)
- Supported
, Flag "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs)
- Supported
, Flag "dsource-stats" (setDumpFlag Opt_D_source_stats)
- Supported
- , Flag "dverbose-core2core" (NoArg setVerboseCore2Core)
- Supported
+ , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2)
+ ; setVerboseCore2Core }))
, Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
- Supported
, Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi)
- Supported
, Flag "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports)
- Supported
, Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect)
- Supported
, Flag "ddump-hpc" (setDumpFlag Opt_D_dump_hpc)
- Supported
, Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles)
- Supported
, Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
- Supported
, Flag "ddump-to-file" (setDumpFlag Opt_DumpToFile)
- Supported
, Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
- Supported
-
+ , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
, Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting))
- Supported
, Flag "dstg-lint" (NoArg (setDynFlag Opt_DoStgLinting))
- Supported
, Flag "dcmm-lint" (NoArg (setDynFlag Opt_DoCmmLinting))
- Supported
, Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting))
- Supported
- , Flag "dshow-passes"
- (NoArg (do setDynFlag Opt_ForceRecomp
- setVerbosity (Just 2)))
- Supported
+ , Flag "dshow-passes" (NoArg (do forceRecompile
+ setVerbosity (Just 2)))
, Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats))
- Supported
+
+ ------ Coq-in-GHC ---------------------------
+ , Flag "dcoqpass" (NoArg (setDynFlag Opt_D_coqpass))
+ , Flag "ddump-coqpass" (NoArg (setDynFlag Opt_D_dump_coqpass))
+ , Flag "fcoqpass" (NoArg (setDynFlag Opt_F_coqpass))
------ Machine dependant (-m<blah>) stuff ---------------------------
- , Flag "monly-2-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
- Supported
- , Flag "monly-3-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
- Supported
- , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
- Supported
+ , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
+ , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
+ , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
+ , Flag "msse2" (NoArg (setDynFlag Opt_SSE2))
------ Warning opts -------------------------------------------------
, Flag "W" (NoArg (mapM_ setDynFlag minusWOpts))
- Supported
, Flag "Werror" (NoArg (setDynFlag Opt_WarnIsError))
- Supported
, Flag "Wwarn" (NoArg (unSetDynFlag Opt_WarnIsError))
- Supported
, Flag "Wall" (NoArg (mapM_ setDynFlag minusWallOpts))
- Supported
- , Flag "Wnot" (NoArg (mapM_ unSetDynFlag minusWallOpts))
- (Deprecated "Use -w instead")
+ , Flag "Wnot" (NoArg (do { mapM_ unSetDynFlag minusWallOpts
+ ; deprecate "Use -w instead" }))
, Flag "w" (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
- Supported
------ Optimisation flags ------------------------------------------
- , Flag "O" (NoArg (upd (setOptLevel 1))) Supported
- , Flag "Onot" (NoArg (upd (setOptLevel 0)))
- (Deprecated "Use -O0 instead")
- , Flag "Odph" (NoArg (upd setDPHOpt)) Supported
+ , Flag "O" (noArg (setOptLevel 1))
+ , Flag "Onot" (noArgDF (setOptLevel 0) "Use -O0 instead")
+ , Flag "Odph" (noArg setDPHOpt)
, Flag "O" (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
- Supported
-- If the number is missing, use 1
- , Flag "fsimplifier-phases"
- (IntSuffix (\n -> upd (\dfs -> dfs{ simplPhases = n })))
- Supported
- , Flag "fmax-simplifier-iterations"
- (IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n })))
- Supported
-
- , Flag "fspec-constr-threshold"
- (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrThreshold = Just n })))
- Supported
- , Flag "fno-spec-constr-threshold"
- (NoArg (upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
- Supported
- , Flag "fspec-constr-count"
- (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrCount = Just n })))
- Supported
- , Flag "fno-spec-constr-count"
- (NoArg (upd (\dfs -> dfs{ specConstrCount = Nothing })))
- Supported
- , Flag "fliberate-case-threshold"
- (IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
- Supported
- , Flag "fno-liberate-case-threshold"
- (NoArg (upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
- Supported
-
- , Flag "frule-check"
- (SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
- Supported
- , Flag "fcontext-stack"
- (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
- Supported
+ , Flag "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n }))
+ , Flag "fmax-simplifier-iterations" (intSuffix (\n d -> d{ maxSimplIterations = n }))
+ , Flag "fspec-constr-threshold" (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
+ , Flag "fno-spec-constr-threshold" (noArg (\d -> d{ specConstrThreshold = Nothing }))
+ , Flag "fspec-constr-count" (intSuffix (\n d -> d{ specConstrCount = Just n }))
+ , Flag "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount = Nothing }))
+ , Flag "fliberate-case-threshold" (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
+ , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
+ , 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 ----------------------------------------------------
+
+ -- XXX Should the -f* flags be deprecated?
+ -- They don't seem to be documented
+ , Flag "fauto-sccs-on-all-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ , Flag "auto-all" (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ , Flag "no-auto-all" (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+ , Flag "fauto-sccs-on-exported-toplevs" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ , Flag "auto" (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ , Flag "no-auto" (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+ , Flag "fauto-sccs-on-individual-cafs" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ , Flag "caf-all" (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ , Flag "no-caf-all" (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
------ DPH flags ----------------------------------------------------
- , Flag "fdph-seq"
- (NoArg (upd (setDPHBackend DPHSeq)))
- Supported
- , Flag "fdph-par"
- (NoArg (upd (setDPHBackend DPHPar)))
- Supported
+ , Flag "fdph-seq" (NoArg (setDPHBackend DPHSeq))
+ , Flag "fdph-par" (NoArg (setDPHBackend DPHPar))
+ , Flag "fdph-this" (NoArg (setDPHBackend DPHThis))
+ , Flag "fdph-none" (NoArg (setDPHBackend DPHNone))
------ Compiler flags -----------------------------------------------
- , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported
- , Flag "fvia-c" (NoArg (setObjTarget HscC)) Supported
- , Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported
+ , Flag "fasm" (NoArg (setObjTarget HscAsm))
+ , Flag "fvia-c" (NoArg
+ (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release"))
+ , Flag "fvia-C" (NoArg
+ (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release"))
+ , Flag "fllvm" (NoArg (setObjTarget HscLlvm))
+
+ , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
+ setTarget HscNothing))
+ , Flag "fbyte-code" (NoArg (setTarget HscInterpreted))
+ , Flag "fobject-code" (NoArg (setTarget defaultHscTarget))
+ , Flag "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
+ , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
+ ]
+ ++ 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 = [
+ ------- Packages ----------------------------------------------------
+ Flag "package-conf" (HasArg extraPkgConf_)
+ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+ , Flag "package-name" (hasArg setPackageName)
+ , Flag "package-id" (HasArg exposePackageId)
+ , Flag "package" (HasArg exposePackage)
+ , Flag "hide-package" (HasArg hidePackage)
+ , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
+ , Flag "ignore-package" (HasArg ignorePackage)
+ , Flag "syslib" (HasArg (\s -> do { exposePackage s
+ ; deprecate "Use -package instead" }))
+ ]
- , Flag "fno-code" (NoArg (setTarget HscNothing)) Supported
- , Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported
- , Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported
+type TurnOnFlag = Bool -- True <=> we are turning the flag on
+ -- False <=> we are turning the flag off
+turnOn :: TurnOnFlag; turnOn = True
+turnOff :: TurnOnFlag; turnOff = False
+
+type FlagSpec flag
+ = ( String -- Flag in string form
+ , flag -- Flag in internal form
+ , TurnOnFlag -> DynP ()) -- Extra action to run when the flag is found
+ -- Typically, emit a warning or error
+
+mkFlag :: 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 turn_on flagPrefix f (name, flag, extra_action)
+ = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on))
+
+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 -> TurnOnFlag -> DynP ()
+useInstead flag turn_on
+ = deprecate ("Use -f" ++ no ++ flag ++ " instead")
+ where
+ no = if turn_on then "" else "no-"
- , Flag "fglasgow-exts" (NoArg (mapM_ setDynFlag glasgowExtsFlags))
- Supported
- , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags))
- Supported
- ]
- ++ map (mkFlag True "f" setDynFlag ) fFlags
- ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
- ++ map (mkFlag True "X" setDynFlag ) xFlags
- ++ map (mkFlag False "XNo" unSetDynFlag) xFlags
-
-mkFlag :: Bool -- True => turn it on, False => turn it off
- -> String
- -> (DynFlag -> DynP ())
- -> (String, DynFlag, Bool -> Deprecated)
- -> Flag DynP
-mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
- = 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"
-
--- these -f<blah> flags can all be reversed with -fno-<blah>
-
-fFlags :: [(String, DynFlag, Bool -> Deprecated)]
+nop :: TurnOnFlag -> DynP ()
+nop _ = return ()
+
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
+fFlags :: [FlagSpec DynFlag]
fFlags = [
- ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ),
- ( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ),
- ( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ),
- ( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ),
- ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, const Supported ),
- ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, const Supported ),
- ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, const Supported ),
- ( "warn-missing-fields", Opt_WarnMissingFields, const Supported ),
- ( "warn-missing-methods", Opt_WarnMissingMethods, const Supported ),
- ( "warn-missing-signatures", Opt_WarnMissingSigs, const Supported ),
- ( "warn-name-shadowing", Opt_WarnNameShadowing, const Supported ),
- ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, const Supported ),
- ( "warn-simple-patterns", Opt_WarnSimplePatterns, const Supported ),
- ( "warn-type-defaults", Opt_WarnTypeDefaults, const Supported ),
- ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, const Supported ),
- ( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ),
- ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ),
- ( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ),
- ( "warn-deprecations", Opt_WarnDeprecations, const Supported ),
- ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ),
- ( "warn-orphans", Opt_WarnOrphans, const Supported ),
- ( "warn-tabs", Opt_WarnTabs, const Supported ),
- ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
- ( "strictness", Opt_Strictness, const Supported ),
- ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ),
- ( "full-laziness", Opt_FullLaziness, const Supported ),
- ( "liberate-case", Opt_LiberateCase, const Supported ),
- ( "spec-constr", Opt_SpecConstr, const Supported ),
- ( "cse", Opt_CSE, const Supported ),
- ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ),
- ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ),
- ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ),
- ( "ignore-asserts", Opt_IgnoreAsserts, const Supported ),
- ( "do-eta-reduction", Opt_DoEtaReduction, const Supported ),
- ( "case-merge", Opt_CaseMerge, const Supported ),
- ( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ),
- ( "method-sharing", Opt_MethodSharing, const Supported ),
- ( "dicts-cheap", Opt_DictsCheap, 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 ),
- ( "break-on-exception", Opt_BreakOnException, const Supported ),
- ( "break-on-error", Opt_BreakOnError, const Supported ),
- ( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ),
- ( "print-bind-contents", Opt_PrintBindContents, const Supported ),
- ( "run-cps", Opt_RunCPSZ, const Supported ),
- ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, const Supported ),
- ( "vectorise", Opt_Vectorise, const Supported ),
- ( "regs-graph", Opt_RegsGraph, const Supported ),
- ( "regs-iterative", Opt_RegsIterative, const Supported ),
+ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ),
+ ( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ),
+ ( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ),
+ ( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ),
+ ( "warn-hi-shadowing", Opt_WarnHiShadows, nop ),
+ ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, nop ),
+ ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, nop ),
+ ( "warn-incomplete-uni-patterns", Opt_WarnIncompleteUniPatterns, nop ),
+ ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, nop ),
+ ( "warn-missing-fields", Opt_WarnMissingFields, nop ),
+ ( "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-type-defaults", Opt_WarnTypeDefaults, nop ),
+ ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ),
+ ( "warn-unused-binds", Opt_WarnUnusedBinds, nop ),
+ ( "warn-unused-imports", Opt_WarnUnusedImports, nop ),
+ ( "warn-unused-matches", Opt_WarnUnusedMatches, nop ),
+ ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, 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, nop),
+ ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, nop ),
+ ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ),
+ ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
+ ( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ),
+ ( "strictness", Opt_Strictness, nop ),
+ ( "specialise", Opt_Specialise, nop ),
+ ( "float-in", Opt_FloatIn, nop ),
+ ( "static-argument-transformation", Opt_StaticArgumentTransformation, nop ),
+ ( "full-laziness", Opt_FullLaziness, nop ),
+ ( "liberate-case", Opt_LiberateCase, nop ),
+ ( "spec-constr", Opt_SpecConstr, nop ),
+ ( "cse", Opt_CSE, nop ),
+ ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, nop ),
+ ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, nop ),
+ ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, nop ),
+ ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, nop ),
+ ( "ignore-asserts", Opt_IgnoreAsserts, nop ),
+ ( "do-eta-reduction", Opt_DoEtaReduction, nop ),
+ ( "case-merge", Opt_CaseMerge, nop ),
+ ( "unbox-strict-fields", Opt_UnboxStrictFields, 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 ),
+ ( "print-bind-result", Opt_PrintBindResult, nop ),
+ ( "force-recomp", Opt_ForceRecomp, nop ),
+ ( "hpc-no-auto", Opt_Hpc_No_Auto, nop ),
+ ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+ ( "enable-rewrite-rules", Opt_EnableRewriteRules, nop ),
+ ( "break-on-exception", Opt_BreakOnException, nop ),
+ ( "break-on-error", Opt_BreakOnError, nop ),
+ ( "print-evld-with-show", Opt_PrintEvldWithShow, nop ),
+ ( "print-bind-contents", Opt_PrintBindContents, nop ),
+ ( "run-cps", Opt_RunCPS, nop ),
+ ( "run-cpsz", Opt_RunCPSZ, nop ),
+ ( "new-codegen", Opt_TryNewCodeGen, nop ),
+ ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, nop ),
+ ( "vectorise", Opt_Vectorise, nop ),
+ ( "regs-graph", Opt_RegsGraph, nop ),
+ ( "regs-iterative", Opt_RegsIterative, nop ),
+ ( "gen-manifest", Opt_GenManifest, nop ),
+ ( "embed-manifest", Opt_EmbedManifest, nop ),
+ ( "ext-core", Opt_EmitExternalCore, nop ),
+ ( "shared-implib", Opt_SharedImplib, nop ),
+ ( "ghci-sandbox", Opt_GhciSandbox, nop ),
+ ( "helpful-errors", Opt_HelpfulErrors, nop ),
+ ( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
+ ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop )
+ ]
+
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
+fLangFlags :: [FlagSpec ExtensionFlag]
+fLangFlags = [
( "th", Opt_TemplateHaskell,
- deprecatedForLanguage "TemplateHaskell" ),
+ deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
( "fi", Opt_ForeignFunctionInterface,
- deprecatedForLanguage "ForeignFunctionInterface" ),
+ deprecatedForExtension "ForeignFunctionInterface" ),
( "ffi", Opt_ForeignFunctionInterface,
- deprecatedForLanguage "ForeignFunctionInterface" ),
+ deprecatedForExtension "ForeignFunctionInterface" ),
( "arrows", Opt_Arrows,
- deprecatedForLanguage "Arrows" ),
+ deprecatedForExtension "Arrows" ),
( "generics", Opt_Generics,
- deprecatedForLanguage "Generics" ),
+ deprecatedForExtension "Generics" ),
( "implicit-prelude", Opt_ImplicitPrelude,
- deprecatedForLanguage "ImplicitPrelude" ),
+ deprecatedForExtension "ImplicitPrelude" ),
( "bang-patterns", Opt_BangPatterns,
- deprecatedForLanguage "BangPatterns" ),
+ deprecatedForExtension "BangPatterns" ),
( "monomorphism-restriction", Opt_MonomorphismRestriction,
- deprecatedForLanguage "MonomorphismRestriction" ),
+ deprecatedForExtension "MonomorphismRestriction" ),
( "mono-pat-binds", Opt_MonoPatBinds,
- deprecatedForLanguage "MonoPatBinds" ),
+ deprecatedForExtension "MonoPatBinds" ),
( "extended-default-rules", Opt_ExtendedDefaultRules,
- deprecatedForLanguage "ExtendedDefaultRules" ),
+ deprecatedForExtension "ExtendedDefaultRules" ),
( "implicit-params", Opt_ImplicitParams,
- deprecatedForLanguage "ImplicitParams" ),
+ deprecatedForExtension "ImplicitParams" ),
( "scoped-type-variables", Opt_ScopedTypeVariables,
- deprecatedForLanguage "ScopedTypeVariables" ),
- ( "parr", Opt_PArr,
- deprecatedForLanguage "PArr" ),
+ deprecatedForExtension "ScopedTypeVariables" ),
+ ( "parr", Opt_ParallelArrays,
+ deprecatedForExtension "ParallelArrays" ),
+ ( "PArr", Opt_ParallelArrays,
+ deprecatedForExtension "ParallelArrays" ),
( "allow-overlapping-instances", Opt_OverlappingInstances,
- deprecatedForLanguage "OverlappingInstances" ),
+ deprecatedForExtension "OverlappingInstances" ),
( "allow-undecidable-instances", Opt_UndecidableInstances,
- deprecatedForLanguage "UndecidableInstances" ),
+ deprecatedForExtension "UndecidableInstances" ),
( "allow-incoherent-instances", Opt_IncoherentInstances,
- deprecatedForLanguage "IncoherentInstances" ),
- ( "gen-manifest", Opt_GenManifest, const Supported ),
- ( "embed-manifest", Opt_EmbedManifest, const Supported )
+ deprecatedForExtension "IncoherentInstances" )
]
supportedLanguages :: [String]
-supportedLanguages = [ name | (name, _, _) <- xFlags ]
+supportedLanguages = [ name | (name, _, _) <- languageFlags ]
+
+supportedExtensions :: [String]
+supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
--- This may contain duplicates
-languageOptions :: [DynFlag]
-languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
+supportedLanguagesAndExtensions :: [String]
+supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
+
+-- | These -X<blah> flags cannot be reversed with -XNo<blah>
+languageFlags :: [FlagSpec Language]
+languageFlags = [
+ ( "Haskell98", Haskell98, nop ),
+ ( "Haskell2010", Haskell2010, nop )
+ ]
--- These -X<blah> flags can all be reversed with -XNo<blah>
-xFlags :: [(String, DynFlag, Bool -> Deprecated)]
+-- | These -X<blah> flags can all be reversed with -XNo<blah>
+xFlags :: [FlagSpec ExtensionFlag]
xFlags = [
- ( "CPP", Opt_Cpp, const Supported ),
- ( "PostfixOperators", Opt_PostfixOperators, const Supported ),
- ( "PatternGuards", Opt_PatternGuards, const Supported ),
- ( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ),
- ( "MagicHash", Opt_MagicHash, 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 ),
- ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ),
- ( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ),
- ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ),
- ( "Rank2Types", Opt_Rank2Types, const Supported ),
- ( "RankNTypes", Opt_RankNTypes, const Supported ),
- ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ),
- ( "TypeOperators", Opt_TypeOperators, const Supported ),
- ( "RecursiveDo", Opt_RecursiveDo, const Supported ),
- ( "Arrows", Opt_Arrows, const Supported ),
- ( "PArr", Opt_PArr, const Supported ),
- ( "TemplateHaskell", Opt_TemplateHaskell, const Supported ),
- ( "QuasiQuotes", Opt_QuasiQuotes, const Supported ),
- ( "Generics", Opt_Generics, const Supported ),
- -- On by default:
- ( "ImplicitPrelude", Opt_ImplicitPrelude, const Supported ),
- ( "RecordWildCards", Opt_RecordWildCards, const Supported ),
- ( "NamedFieldPuns", Opt_RecordPuns, const Supported ),
+ ( "CPP", Opt_Cpp, nop ),
+ ( "PostfixOperators", Opt_PostfixOperators, nop ),
+ ( "TupleSections", Opt_TupleSections, nop ),
+ ( "PatternGuards", Opt_PatternGuards, nop ),
+ ( "UnicodeSyntax", Opt_UnicodeSyntax, nop ),
+ ( "MagicHash", Opt_MagicHash, nop ),
+ ( "PolymorphicComponents", Opt_PolymorphicComponents, nop ),
+ ( "ExistentialQuantification", Opt_ExistentialQuantification, nop ),
+ ( "KindSignatures", Opt_KindSignatures, nop ),
+ ( "EmptyDataDecls", Opt_EmptyDataDecls, nop ),
+ ( "ParallelListComp", Opt_ParallelListComp, nop ),
+ ( "TransformListComp", Opt_TransformListComp, nop ),
+ ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, nop ),
+ ( "UnliftedFFITypes", Opt_UnliftedFFITypes, nop ),
+ ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, nop ),
+ ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
+ ( "Rank2Types", Opt_Rank2Types, nop ),
+ ( "RankNTypes", Opt_RankNTypes, nop ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
+ ( "TypeOperators", Opt_TypeOperators, nop ),
+ ( "RecursiveDo", Opt_RecursiveDo,
+ deprecatedForExtension "DoRec"),
+ ( "DoRec", Opt_DoRec, nop ),
+ ( "Arrows", Opt_Arrows, nop ),
+ ( "ModalTypes", Opt_ModalTypes, nop ),
+ ( "ParallelArrays", Opt_ParallelArrays, nop ),
+ ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
+ ( "QuasiQuotes", Opt_QuasiQuotes, nop ),
+ ( "Generics", Opt_Generics, nop ),
+ ( "ImplicitPrelude", Opt_ImplicitPrelude, nop ),
+ ( "RecordWildCards", Opt_RecordWildCards, nop ),
+ ( "NamedFieldPuns", Opt_RecordPuns, nop ),
( "RecordPuns", Opt_RecordPuns,
- deprecatedForLanguage "NamedFieldPuns" ),
- ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, const Supported ),
- ( "OverloadedStrings", Opt_OverloadedStrings, const Supported ),
- ( "GADTs", Opt_GADTs, const Supported ),
- ( "ViewPatterns", Opt_ViewPatterns, const Supported ),
- ( "TypeFamilies", Opt_TypeFamilies, const Supported ),
- ( "BangPatterns", Opt_BangPatterns, const Supported ),
- -- On by default:
- ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ),
- -- On by default (which is not strictly H98):
- ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
- ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
- ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
- ( "ImplicitParams", Opt_ImplicitParams, const Supported ),
- ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
- ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
- ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
- ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ),
- ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ),
- ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ),
- ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ),
- ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, const Supported ),
- ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, const Supported ),
- ( "FunctionalDependencies", Opt_FunctionalDependencies, const Supported ),
- ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ),
- ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ),
- ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
- ( "IncoherentInstances", Opt_IncoherentInstances, const Supported )
+ deprecatedForExtension "NamedFieldPuns" ),
+ ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, nop ),
+ ( "OverloadedStrings", Opt_OverloadedStrings, nop ),
+ ( "GADTs", Opt_GADTs, nop ),
+ ( "GADTSyntax", Opt_GADTSyntax, nop ),
+ ( "ViewPatterns", Opt_ViewPatterns, nop ),
+ ( "TypeFamilies", Opt_TypeFamilies, nop ),
+ ( "BangPatterns", Opt_BangPatterns, 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,
+ \ 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 ),
+
+ ( "PatternSignatures", Opt_ScopedTypeVariables,
+ deprecatedForExtension "ScopedTypeVariables" ),
+
+ ( "UnboxedTuples", Opt_UnboxedTuples, nop ),
+ ( "StandaloneDeriving", Opt_StandaloneDeriving, nop ),
+ ( "DeriveDataTypeable", Opt_DeriveDataTypeable, nop ),
+ ( "DeriveFunctor", Opt_DeriveFunctor, nop ),
+ ( "DeriveTraversable", Opt_DeriveTraversable, nop ),
+ ( "DeriveFoldable", Opt_DeriveFoldable, nop ),
+ ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ),
+ ( "FlexibleContexts", Opt_FlexibleContexts, nop ),
+ ( "FlexibleInstances", Opt_FlexibleInstances, nop ),
+ ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, nop ),
+ ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, nop ),
+ ( "FunctionalDependencies", Opt_FunctionalDependencies, nop ),
+ ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, nop ),
+ ( "OverlappingInstances", Opt_OverlappingInstances, nop ),
+ ( "UndecidableInstances", Opt_UndecidableInstances, nop ),
+ ( "IncoherentInstances", Opt_IncoherentInstances, nop ),
+ ( "PackageImports", Opt_PackageImports, nop )
]
-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
+defaultFlags :: [DynFlag]
+defaultFlags
+ = [ Opt_AutoLinkPackages,
+ Opt_ReadUserPackageConf,
+
+ Opt_SharedImplib,
+
+#if GHC_DEFAULT_NEW_CODEGEN
+ Opt_TryNewCodeGen,
+#endif
+
+ Opt_GenManifest,
+ Opt_EmbedManifest,
+ Opt_PrintBindContents,
+ Opt_GhciSandbox,
+ Opt_HelpfulErrors
+ ]
+
+ ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+ -- The default -O0 options
+
+ ++ standardWarnings
+
+impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
+impliedFlags
+ = [ (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_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses)
+
+ , (Opt_ModalTypes, turnOn, Opt_RankNTypes)
+ , (Opt_ModalTypes, turnOn, Opt_ExplicitForAll)
+ --, (Opt_ModalTypes, turnOn, Opt_RebindableSyntax)
+ , (Opt_ModalTypes, turnOff, Opt_MonomorphismRestriction)
+
+ , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off!
+
+ , (Opt_GADTs, turnOn, Opt_GADTSyntax)
+ , (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_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, turnOn, Opt_DisambiguateRecordFields)
+
+ , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
]
-glasgowExtsFlags :: [DynFlag]
+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]
+-- Things you get with -W
+minusWOpts
+ = standardWarnings ++
+ [ Opt_WarnUnusedBinds,
+ Opt_WarnUnusedMatches,
+ Opt_WarnUnusedImports,
+ Opt_WarnIncompletePatterns,
+ Opt_WarnDodgyExports,
+ Opt_WarnDodgyImports
+ ]
+
+minusWallOpts :: [DynFlag]
+-- Things you get with -Wall
+minusWallOpts
+ = minusWOpts ++
+ [ Opt_WarnTypeDefaults,
+ Opt_WarnNameShadowing,
+ Opt_WarnMissingSigs,
+ Opt_WarnHiShadows,
+ Opt_WarnOrphans,
+ Opt_WarnUnusedDoBind
+ ]
+
+minuswRemovesOpts :: [DynFlag]
+-- minuswRemovesOpts should be every warning option
+minuswRemovesOpts
+ = minusWallOpts ++
+ [Opt_WarnTabs,
+ Opt_WarnIncompletePatternsRecUpd,
+ Opt_WarnIncompleteUniPatterns,
+ Opt_WarnMonomorphism,
+ Opt_WarnUnrecognisedPragmas,
+ Opt_WarnAutoOrphans,
+ Opt_WarnImplicitPrelude
+ ]
+
+enableGlasgowExts :: DynP ()
+enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
+ mapM_ setExtensionFlag glasgowExtsFlags
+
+disableGlasgowExts :: DynP ()
+disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
+ mapM_ unSetExtensionFlag glasgowExtsFlags
+
+glasgowExtsFlags :: [ExtensionFlag]
glasgowExtsFlags = [
- Opt_PrintExplicitForalls
- , Opt_ForeignFunctionInterface
+ Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
- , Opt_GADTs
, Opt_ImplicitParams
, Opt_ScopedTypeVariables
, Opt_UnboxedTuples
, Opt_TypeSynonymInstances
, Opt_StandaloneDeriving
, Opt_DeriveDataTypeable
+ , Opt_DeriveFunctor
+ , Opt_DeriveFoldable
+ , Opt_DeriveTraversable
, Opt_FlexibleContexts
, Opt_FlexibleInstances
, Opt_ConstrainedClassMethods
, Opt_PatternGuards
, Opt_LiberalTypeSynonyms
, Opt_RankNTypes
- , Opt_ImpredicativeTypes
, Opt_TypeOperators
- , Opt_RecursiveDo
+ , Opt_DoRec
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
- , Opt_PatternSignatures
- , Opt_GeneralizedNewtypeDeriving
- , Opt_TypeFamilies ]
+ , Opt_GeneralizedNewtypeDeriving ]
--- -----------------------------------------------------------------------------
--- Parsing the dynamic flags.
+#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 = unsafePerformIO rtsIsProfiledIO /= 0
-parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
-parseDynamicFlags dflags args = do
- let ((leftover, errs, warns), dflags')
- = runCmdLine (processArgs dynamic_flags args) dflags
- when (not (null errs)) $ do
- throwDyn (UsageError (unlines errs))
- return (dflags', leftover, warns)
+checkTemplateHaskellOk :: Bool -> DynP ()
+checkTemplateHaskellOk turn_on
+ | turn_on && rtsIsProfiled
+ = 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
-type DynP = CmdLineP DynFlags
+{- **********************************************************************
+%* *
+ DynFlags constructors
+%* *
+%********************************************************************* -}
+
+type DynP = EwM (CmdLineP DynFlags)
upd :: (DynFlags -> DynFlags) -> DynP ()
-upd f = do
- dfs <- getCmdLineState
- putCmdLineState $! (f dfs)
+upd f = liftEwM (do { dfs <- getCmdLineState
+ ; putCmdLineState $! (f dfs) })
+
+--------------- Constructor functions for OptKind -----------------
+noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+noArg fn = NoArg (upd fn)
+
+noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
+noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
+
+hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+hasArg fn = HasArg (upd . fn)
+
+hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
+hasArgDF fn deprec = HasArg (\s -> do { upd (fn s)
+ ; deprecate deprec })
+
+intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+intSuffix fn = IntSuffix (\n -> upd (fn n))
+
+setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
+setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
+setDynFlag f = upd (\dfs -> dopt_set dfs f)
+unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+
+--------------------------
+setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
+setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
+ ; sequence_ deps }
where
- deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
+ 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
- -- When you un-set f, however, we don't un-set the things it implies
- -- (except for -fno-glasgow-exts, which is treated specially)
+ -- NB: use setExtensionFlag recursively, in case the implied flags
+ -- implies further flags
-unSetDynFlag f = upd (\dfs -> dopt_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 -> OptKind DynP
-setDumpFlag dump_flag
- | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
- | otherwise = NoArg (setDynFlag dump_flag)
+setDumpFlag' :: DynFlag -> DynP ()
+setDumpFlag' dump_flag
+ = do { 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 <- liftEwM 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
- 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 setDynFlag Opt_ForceRecomp
- upd (\s -> s { shouldDumpSimplPhase = spec })
+setDumpSimplPhases s = do forceRecompile
+ 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
- = throwDyn (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).
| otherwise = dfs
-- Changes the target only if we're compiling object code. This is
--- used by -fasm and -fvia-C, which switch from one to the other, but
--- not from bytecode to object-code. The idea is that -fasm/-fvia-C
+-- used by -fasm and -fllvm, which switch from one to the other, but
+-- not from bytecode to object-code. The idea is that -fasm/-fllvm
-- can be safely used in an OPTIONS_GHC pragma.
setObjTarget :: HscTarget -> DynP ()
setObjTarget l = upd set
-- -Odph is equivalent to
--
-- -O2 optimise as much as possible
--- -fno-method-sharing sharing specialisation defeats fusion
--- sometimes
--- -fdicts-cheap always inline dictionaries
-- -fmax-simplifier-iterations20 this is necessary sometimes
--- -fno-spec-constr-threshold run SpecConstr even for big loops
+-- -fsimplifier-phases=3 we use an additional simplifier phase for fusion
--
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
- , specConstrThreshold = Nothing
+ , simplPhases = 3
})
- `dopt_set` Opt_DictsCheap
- `dopt_unset` Opt_MethodSharing
-data DPHBackend = DPHPar
- | DPHSeq
+-- Determines the package used by the vectoriser for the symbols of the vectorised code.
+-- 'DPHNone' indicates that no data-parallel backend library is available; hence, the
+-- vectoriser cannot be used.
+--
+data DPHBackend = DPHPar -- "dph-par"
+ | DPHSeq -- "dph-seq"
+ | DPHThis -- the currently compiled package
+ | DPHNone -- no DPH library available
+ deriving(Eq, Ord, Enum, Show)
-setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
-setDPHBackend backend dflags = dflags { dphBackend = backend }
+setDPHBackend :: DPHBackend -> DynP ()
+setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend }
+-- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax.
+--
+dphPackageMaybe :: DynFlags -> Maybe PackageId
+dphPackageMaybe dflags
+ = case dphBackend dflags of
+ DPHPar -> Just dphParPackageId
+ DPHSeq -> Just dphSeqPackageId
+ DPHThis -> Just (thisPackage dflags)
+ DPHNone -> Nothing
setMainIs :: String -> DynP ()
setMainIs arg
-- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
+-- RTS opts
+
+setRtsOpts :: String -> DynP ()
+setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
+
+-----------------------------------------------------------------------------
-- Hpc stuff
setOptHpcDir :: String -> DynP ()
-- The options below are not dependent on the version of gcc, only the
-- platform.
-machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
- [String]) -- for registerised HC compilations
-machdepCCOpts _dflags
+machdepCCOpts :: DynFlags -> [String] -- flags for all C compilations
+machdepCCOpts dflags = cCcOpts ++ machdepCCOpts'
+
+machdepCCOpts' :: [String] -- flags for all C compilations
+machdepCCOpts'
#if alpha_TARGET_ARCH
- = ( ["-w", "-mieee"
+ = ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
, "-D_REENTRANT"
#endif
- ], [] )
+ ]
-- For now, to suppress the gcc warning "call-clobbered
-- register used for global register variable", we simply
-- disable all warnings altogether using the -w flag. Oh well.
#elif hppa_TARGET_ARCH
-- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
-- (very nice, but too bad the HP /usr/include files don't agree.)
- = ( ["-D_HPUX_SOURCE"], [] )
-
-#elif m68k_TARGET_ARCH
- -- -fno-defer-pop : for the .hc files, we want all the pushing/
- -- popping of args to routines to be explicit; if we let things
- -- be deferred 'til after an STGJUMP, imminent death is certain!
- --
- -- -fomit-frame-pointer : *don't*
- -- It's better to have a6 completely tied up being a frame pointer
- -- rather than let GCC pick random things to do with it.
- -- (If we want to steal a6, then we would try to do things
- -- as on iX86, where we *do* steal the frame pointer [%ebp].)
- = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
+ = ["-D_HPUX_SOURCE"]
#elif i386_TARGET_ARCH
-- -fno-defer-pop : basically the same game as for m68k
--
-- -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 ""
- ],
- [ "-fno-defer-pop",
- "-fomit-frame-pointer",
- -- we want -fno-builtin, because when gcc inlines
- -- built-in functions like memcpy() it tends to
- -- run out of registers, requiring -monly-n-regs
- "-fno-builtin",
- "-DSTOLEN_X86_REGS="++show n_regs ]
- )
-
-#elif ia64_TARGET_ARCH
- = ( [], ["-fomit-frame-pointer", "-G0"] )
-
-#elif x86_64_TARGET_ARCH
- = ( [], ["-fomit-frame-pointer",
- "-fno-asynchronous-unwind-tables",
- -- the unwind tables are unnecessary for HC code,
- -- and get in the way of -split-objs. Another option
- -- would be to throw them away in the mangler, but this
- -- is easier.
- "-fno-builtin"
- -- calling builtins like strlen() using the FFI can
- -- cause gcc to run out of regs, so use the external
- -- version.
- ] )
-
-#elif sparc_TARGET_ARCH
- = ( [], ["-w"] )
- -- For now, to suppress the gcc warning "call-clobbered
- -- register used for global register variable", we simply
- -- disable all warnings altogether using the -w flag. Oh well.
+ = if opt_Static then ["-DDONT_WANT_WIN32_DLL_SUPPORT"] else []
-#elif powerpc_apple_darwin_TARGET
- -- -no-cpp-precomp:
- -- Disable Apple's precompiling preprocessor. It's a great thing
- -- for "normal" programs, but it doesn't support register variable
- -- declarations.
- = ( [], ["-no-cpp-precomp"] )
#else
- = ( [], [] )
+ = []
#endif
picCCOpts :: DynFlags -> [String]
-- in dynamic libraries.
| opt_PIC
- = ["-fno-common", "-D__PIC__"]
+ = ["-fno-common", "-U __PIC__","-D__PIC__"]
| otherwise
= ["-mdynamic-no-pic"]
#elif mingw32_TARGET_OS
-- no -fPIC for Windows
| opt_PIC
- = ["-D__PIC__"]
+ = ["-U __PIC__","-D__PIC__"]
| otherwise
= []
#else
- | opt_PIC
- = ["-fPIC", "-D__PIC__"]
+ -- we need -fPIC for C files when we are compiling with -dynamic,
+ -- otherwise things like stub.c files don't get compiled
+ -- correctly. They need to reference data in the Haskell
+ -- objects, but can't without -fPIC. See
+ -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
+ | opt_PIC || not opt_Static
+ = ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise
= []
#endif
-- Splitting
can_split :: Bool
-can_split = cSplitObjs == "YES"
+can_split = cSupportsSplitObjs == "YES"
-- -----------------------------------------------------------------------------
-- Compiler Info
-compilerInfo :: [(String, String)]
-compilerInfo = [("Project name", cProjectName),
- ("Project version", cProjectVersion),
- ("Booter version", cBooterVersion),
- ("Stage", cStage),
- ("Interface file version", cHscIfaceFileVersion),
- ("Have interpreter", cGhcWithInterpreter),
- ("Object splitting", cSplitObjs),
- ("Have native code generator", cGhcWithNativeCodeGen),
- ("Support SMP", cGhcWithSMP),
- ("Unregisterised", cGhcUnregisterised),
- ("Tables next to code", cGhcEnableTablesNextToCode),
- ("Win32 DLLs", cEnableWin32DLLs),
- ("RTS ways", cGhcRTSWays),
- ("Leading underscore", cLeadingUnderscore),
- ("Debug on", show debugIsOn)
+data Printable = String String
+ | FromDynFlags (DynFlags -> String)
+
+compilerInfo :: [(String, Printable)]
+compilerInfo = [("Project name", String cProjectName),
+ ("Project version", String cProjectVersion),
+ ("Booter version", String cBooterVersion),
+ ("Stage", String cStage),
+ ("Build platform", String cBuildPlatformString),
+ ("Host platform", String cHostPlatformString),
+ ("Target platform", String cTargetPlatformString),
+ ("Have interpreter", String cGhcWithInterpreter),
+ ("Object splitting supported", String cSupportsSplitObjs),
+ ("Have native code generator", String cGhcWithNativeCodeGen),
+ ("Support SMP", String cGhcWithSMP),
+ ("Unregisterised", String cGhcUnregisterised),
+ ("Tables next to code", String cGhcEnableTablesNextToCode),
+ ("RTS ways", String cGhcRTSWays),
+ ("Leading underscore", String cLeadingUnderscore),
+ ("Debug on", String (show debugIsOn)),
+ ("LibDir", FromDynFlags topDir),
+ ("Global Package DB", FromDynFlags systemPackageConfig),
+ ("C compiler flags", String (show cCcOpts)),
+ ("Gcc Linker flags", String (show cGccLinkerOpts)),
+ ("Ld Linker flags", String (show cLdLinkerOpts))
]
projects / ghc-hetmet.git / blobdiff