{-# OPTIONS -fno-warn-missing-fields #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Dynamic flags
-----------------------------------------------------------------------------
module DynFlags (
- -- Dynamic flags
- DynFlag(..),
- DynFlags(..),
- HscTarget(..), isObjectTarget, defaultObjectTarget,
- GhcMode(..), isOneShot,
- GhcLink(..), isNoLink,
- PackageFlag(..),
- Option(..),
-
- -- Configuration of the core-to-core and stg-to-stg phases
- CoreToDo(..),
- StgToDo(..),
- SimplifierSwitch(..),
- SimplifierMode(..), FloatOutSwitches(..),
- getCoreToDo, getStgToDo,
-
- -- 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,
- updOptLevel,
- setTmpDir,
- setPackageName,
-
- -- parsing DynFlags
- parseDynamicFlags,
+ -- Dynamic flags
+ DynFlag(..),
+ DynFlags(..),
+ HscTarget(..), isObjectTarget, defaultObjectTarget,
+ GhcMode(..), isOneShot,
+ GhcLink(..), isNoLink,
+ PackageFlag(..),
+ Option(..),
+ DynLibLoader(..),
+ fFlags, xFlags,
+
+ -- Configuration of the core-to-core and stg-to-stg phases
+ CoreToDo(..),
+ StgToDo(..),
+ SimplifierSwitch(..),
+ SimplifierMode(..), FloatOutSwitches(..),
+ getCoreToDo, getStgToDo,
+
+ -- 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,
+ updOptLevel,
+ setTmpDir,
+ setPackageName,
+
+ -- parsing DynFlags
+ parseDynamicFlags,
allFlags,
- -- misc stuff
- machdepCCOpts, picCCOpts,
+ -- misc stuff
+ machdepCCOpts, picCCOpts,
supportedLanguages,
compilerInfo,
) where
#include "HsVersions.h"
-import Module ( Module, mkModuleName, mkModule )
+import Module
import PackageConfig
-import PrelNames ( mAIN )
+import PrelNames ( mAIN )
#ifdef i386_TARGET_ARCH
-import StaticFlags ( opt_Static )
+import StaticFlags ( opt_Static )
#endif
-import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
- v_RTS_Build_tag )
+import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
+ v_RTS_Build_tag )
import {-# SOURCE #-} Packages (PackageState)
-import DriverPhases ( Phase(..), phaseInputExt )
+import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
-import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
-import Panic ( panic, GhcException(..) )
+import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
+import Panic ( panic, GhcException(..) )
import UniqFM ( UniqFM )
import Util
-import Maybes ( orElse, fromJust )
+import Maybes ( orElse, fromJust )
import SrcLoc ( SrcSpan )
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
-import Data.IORef ( readIORef )
+import Data.IORef ( readIORef )
import Control.Exception ( throwDyn )
-import Control.Monad ( when )
-#ifdef mingw32_TARGET_OS
-import Data.List ( isPrefixOf )
-#else
-import Util ( split )
-#endif
+import Control.Monad ( when )
-import Data.Char ( isUpper, toLower )
+import Data.Char
+import System.FilePath
import System.IO ( hPutStrLn, stderr )
-- -----------------------------------------------------------------------------
-- debugging flags
= Opt_D_dump_cmm
+ | Opt_D_dump_cmmz
+ | Opt_D_dump_cmmz_pretty
| Opt_D_dump_cps_cmm
+ | Opt_D_dump_cvt_cmm
| Opt_D_dump_asm
| Opt_D_dump_asm_native
| Opt_D_dump_asm_liveness
| Opt_D_dump_asm_regalloc
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
- | Opt_D_drop_asm_stats
+ | Opt_D_dump_asm_stats
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_rn
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
+ | Opt_D_dump_simpl_phases
| Opt_D_dump_spec
| Opt_D_dump_prep
| Opt_D_dump_stg
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_dump_mod_cycles
+ | Opt_D_dump_view_pattern_commoning
| Opt_D_faststring_stats
+ | Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
+ | Opt_D_no_debug_output
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
+ | Opt_DoAsmLinting
- | Opt_WarnIsError -- -Werror; makes warnings fatal
+ | Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnImplicitPrelude
| Opt_IncoherentInstances
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
- | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
+ | 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_PArr -- Syntactic support for parallel arrays
+ | Opt_Arrows -- Arrow-notation syntax
| Opt_TemplateHaskell
+ | Opt_QuasiQuotes
| Opt_ImplicitParams
| Opt_Generics
- | Opt_ImplicitPrelude
+ | Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
| Opt_UnboxedTuples
| Opt_BangPatterns
| Opt_DisambiguateRecordFields
| Opt_RecordWildCards
| Opt_RecordPuns
+ | Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
| Opt_StandaloneDeriving
| Opt_KindSignatures
| Opt_PatternSignatures
| Opt_ParallelListComp
+ | Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_PatternGuards
- | Opt_PartiallyAppliedClosedTypeSynonyms
+ | Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_RankNTypes
+ | Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PrintExplicitForalls
-- optimisation opts
| Opt_Strictness
| Opt_FullLaziness
+ | Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
- | Opt_IgnoreBreakpoints
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
+ | Opt_MethodSharing
| Opt_DictsCheap
| Opt_RewriteRules
| Opt_Vectorise
- | Opt_RegsGraph
+ | Opt_RegsGraph -- do graph coloring register allocation
+ | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
-- misc opts
| Opt_Cpp
| Opt_HideAllPackages
| Opt_PrintBindResult
| Opt_Haddock
+ | Opt_HaddockOptions
| Opt_Hpc_No_Auto
| Opt_BreakOnException
+ | Opt_BreakOnError
+ | Opt_PrintEvldWithShow
+ | Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
+ | Opt_RunCPSZ
+ | Opt_ConvertToZipCfgAndBack
-- keeping stuff
| Opt_KeepHiDiffs
| Opt_KeepRawSFiles
| Opt_KeepTmpFiles
- deriving (Eq)
-
+ deriving (Eq, Show)
+
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
- maxSimplIterations :: Int, -- max simplifier iterations
- ruleCheck :: Maybe String,
-
- specThreshold :: Int, -- Threshold for function specialisation
-
- stolen_x86_regs :: Int,
- cmdlineHcIncludes :: [String], -- -#includes
- importPaths :: [FilePath],
- mainModIs :: Module,
- mainFunIs :: Maybe String,
- ctxtStkDepth :: Int, -- Typechecker context stack depth
-
- thisPackage :: PackageId,
+ 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,
+ ruleCheck :: Maybe String,
+
+ specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr
+ specConstrCount :: Maybe Int, -- Max number of specialisations for any one function
+ liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase
+
+ stolen_x86_regs :: Int,
+ cmdlineHcIncludes :: [String], -- -#includes
+ importPaths :: [FilePath],
+ mainModIs :: Module,
+ mainFunIs :: Maybe String,
+ ctxtStkDepth :: Int, -- Typechecker context stack depth
+
+ thisPackage :: PackageId,
-- ways
- wayNames :: [WayName], -- way flags from the cmd line
- buildTag :: String, -- the global "way" (eg. "p" for prof)
- rtsBuildTag :: String, -- the RTS "way"
-
+ wayNames :: [WayName], -- way flags from the cmd line
+ buildTag :: String, -- the global "way" (eg. "p" for prof)
+ rtsBuildTag :: String, -- the RTS "way"
+
-- paths etc.
- objectDir :: Maybe String,
- hiDir :: Maybe String,
- stubDir :: Maybe String,
-
- objectSuf :: String,
- hcSuf :: String,
- hiSuf :: String,
-
- outputFile :: Maybe String,
- outputHi :: Maybe String,
-
- includePaths :: [String],
- libraryPaths :: [String],
- frameworkPaths :: [String], -- used on darwin only
- cmdlineFrameworks :: [String], -- ditto
- tmpDir :: String, -- no trailing '/'
-
+ objectDir :: Maybe String,
+ hiDir :: Maybe String,
+ stubDir :: Maybe String,
+
+ objectSuf :: String,
+ hcSuf :: String,
+ hiSuf :: String,
+
+ outputFile :: Maybe String,
+ outputHi :: Maybe String,
+ dynLibLoader :: DynLibLoader,
+
+ -- | 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
+ dumpPrefixForce :: Maybe FilePath,
+
+ includePaths :: [String],
+ libraryPaths :: [String],
+ frameworkPaths :: [String], -- used on darwin only
+ cmdlineFrameworks :: [String], -- ditto
+ tmpDir :: String, -- no trailing '/'
+
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
- hpcDir :: String, -- ^ path to store the .mix files
+ hpcDir :: String, -- ^ path to store the .mix files
-- options for particular phases
- opt_L :: [String],
- opt_P :: [String],
- opt_F :: [String],
- opt_c :: [String],
- opt_m :: [String],
- opt_a :: [String],
- opt_l :: [String],
- opt_dep :: [String],
- opt_windres :: [String],
+ opt_L :: [String],
+ opt_P :: [String],
+ opt_F :: [String],
+ opt_c :: [String],
+ opt_m :: [String],
+ opt_a :: [String],
+ opt_l :: [String],
+ opt_dep :: [String],
+ opt_windres :: [String],
-- 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_dll :: (String,[Option]),
+ 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_dll :: (String,[Option]),
pgm_T :: String,
pgm_sysman :: String,
pgm_windres :: String,
-- Package flags
- extraPkgConfs :: [FilePath],
+ extraPkgConfs :: [FilePath],
topDir :: FilePath, -- filled in by SysTools
systemPackageConfig :: FilePath, -- ditto
- -- The -package-conf flags given on the command line, in the order
- -- they appeared.
+ -- 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
+ packageFlags :: [PackageFlag],
+ -- The -package and -hide-package flags from the command-line
-- Package state
- -- NB. do not modify this field, it is calculated by
+ -- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM InstalledPackageInfo),
- pkgState :: PackageState,
+ pkgDatabase :: Maybe (UniqFM PackageConfig),
+ pkgState :: PackageState,
-- hsc dynamic flags
- flags :: [DynFlag],
-
+ flags :: [DynFlag],
+
-- message output
- log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+ log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
+
+ haddockOptions :: Maybe String
}
data HscTarget
-- in order to check whether they need to be recompiled.
data GhcMode
= CompManager -- ^ --make, GHCi, etc.
- | OneShot -- ^ ghc -c Foo.hs
+ | OneShot -- ^ ghc -c Foo.hs
| MkDepend -- ^ ghc -M, see Finder for why we need this
deriving Eq
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
+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)
- deriving Eq
+ | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
+ deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
-isNoLink other = False
+isNoLink _ = False
data PackageFlag
= ExposePackage String
| IgnorePackage String
deriving Eq
+defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
-- | the 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
+defaultObjectTarget :: HscTarget
defaultObjectTarget
- | cGhcWithNativeCodeGen == "YES" = HscAsm
- | otherwise = HscC
+ | cGhcWithNativeCodeGen == "YES" = HscAsm
+ | otherwise = HscC
+
+data DynLibLoader
+ = Deployable
+ | Wrapped (Maybe String)
+ | SystemDependent
+ deriving Eq
+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
return dflags{
- wayNames = ways,
- buildTag = build_tag,
- rtsBuildTag = rts_build_tag
- }
+ wayNames = ways,
+ buildTag = build_tag,
+ rtsBuildTag = rts_build_tag
+ }
+defaultDynFlags :: DynFlags
defaultDynFlags =
DynFlags {
- ghcMode = CompManager,
- ghcLink = LinkBinary,
- coreToDo = Nothing,
- stgToDo = Nothing,
- hscTarget = defaultHscTarget,
- hscOutName = "",
- extCoreName = "",
- verbosity = 0,
- optLevel = 0,
- maxSimplIterations = 4,
- ruleCheck = Nothing,
- specThreshold = 200,
- stolen_x86_regs = 4,
- cmdlineHcIncludes = [],
- importPaths = ["."],
- mainModIs = mAIN,
- mainFunIs = Nothing,
- ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
-
- thisPackage = mainPackageId,
-
- objectDir = Nothing,
- hiDir = Nothing,
- stubDir = Nothing,
-
- objectSuf = phaseInputExt StopLn,
- hcSuf = phaseInputExt HCc,
- hiSuf = "hi",
-
- outputFile = Nothing,
- outputHi = Nothing,
- includePaths = [],
- libraryPaths = [],
- frameworkPaths = [],
- cmdlineFrameworks = [],
- tmpDir = cDEFAULT_TMPDIR,
-
- hpcDir = ".hpc",
-
- opt_L = [],
- opt_P = (if opt_PIC
- then ["-D__PIC__"]
- else []),
- opt_F = [],
- opt_c = [],
- opt_a = [],
- opt_m = [],
- opt_l = [],
- opt_dep = [],
+ ghcMode = CompManager,
+ ghcLink = LinkBinary,
+ coreToDo = Nothing,
+ stgToDo = Nothing,
+ hscTarget = defaultHscTarget,
+ hscOutName = "",
+ extCoreName = "",
+ verbosity = 0,
+ optLevel = 0,
+ simplPhases = 2,
+ maxSimplIterations = 4,
+ shouldDumpSimplPhase = const False,
+ ruleCheck = Nothing,
+ specConstrThreshold = Just 200,
+ specConstrCount = Just 3,
+ liberateCaseThreshold = Just 200,
+ stolen_x86_regs = 4,
+ cmdlineHcIncludes = [],
+ importPaths = ["."],
+ mainModIs = mAIN,
+ mainFunIs = Nothing,
+ ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
+
+ thisPackage = mainPackageId,
+
+ objectDir = Nothing,
+ hiDir = Nothing,
+ stubDir = Nothing,
+
+ objectSuf = phaseInputExt StopLn,
+ hcSuf = phaseInputExt HCc,
+ hiSuf = "hi",
+
+ outputFile = Nothing,
+ outputHi = Nothing,
+ dynLibLoader = Deployable,
+ dumpPrefix = Nothing,
+ dumpPrefixForce = Nothing,
+ includePaths = [],
+ libraryPaths = [],
+ frameworkPaths = [],
+ cmdlineFrameworks = [],
+ tmpDir = cDEFAULT_TMPDIR,
+
+ hpcDir = ".hpc",
+
+ opt_L = [],
+ opt_P = (if opt_PIC
+ then ["-D__PIC__"]
+ else []),
+ opt_F = [],
+ opt_c = [],
+ opt_a = [],
+ opt_m = [],
+ opt_l = [],
+ opt_dep = [],
opt_windres = [],
-
- extraPkgConfs = [],
- packageFlags = [],
+
+ extraPkgConfs = [],
+ packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- flags = [
- 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_DoAsmMangling,
-
+ haddockOptions = Nothing,
+ flags = [
+ 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,
- -- on by default:
- Opt_PrintBindResult ]
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
- ++ standardWarnings,
-
- log_action = \severity srcSpan style msg ->
+ 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))
}
-{-
+{-
Verbosity levels:
-
- 0 | print errors & warnings only
+
+ 0 | print errors & warnings only
1 | minimal verbosity: print "compiling M ... done." for each module.
2 | equivalent to -dshow-passes
3 | equivalent to existing "ghc -v"
getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
getOpts dflags opts = reverse (opts dflags)
- -- We add to the options from the front, so we need to reverse the list
+ -- We add to the options from the front, so we need to reverse the list
getVerbFlag :: DynFlags -> String
-getVerbFlag dflags
- | verbosity dflags >= 3 = "-v"
+getVerbFlag dflags
+ | verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir f d = d{ objectDir = f}
-setHiDir f d = d{ hiDir = f}
-setStubDir f d = d{ stubDir = f}
+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,
+ addCmdlineFramework, addHaddockOpts
+ :: String -> DynFlags -> DynFlags
+setOutputFile, setOutputHi, setDumpPrefixForce
+ :: Maybe String -> DynFlags -> DynFlags
+
+setObjectDir f d = d{ objectDir = Just f}
+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.
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setOutputFile f d = d{ outputFile = f}
setOutputHi f d = d{ outputHi = f}
+parseDynLibLoaderMode f d =
+ 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"
+
+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)}
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
+addHaddockOpts f d = d{ haddockOptions = Just f}
+
-- -----------------------------------------------------------------------------
-- Command-line options
data Option
= FileOption -- an entry that _contains_ filename(s) / filepaths.
- String -- a non-filepath prefix that shouldn't be
- -- transformed (e.g., "/out=")
- String -- the filepath/filename portion
+ String -- a non-filepath prefix that shouldn't be
+ -- transformed (e.g., "/out=")
+ String -- the filepath/filename portion
| Option String
-
+
-----------------------------------------------------------------------------
-- Setting the optimisation level
updOptLevel n dfs
= dfs2{ optLevel = final_n }
where
- final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2
+ final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2
dfs1 = foldr (flip dopt_unset) dfs remove_dopts
dfs2 = foldr (flip dopt_set) dfs1 extra_dopts
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_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)
+ , ([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_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.
+ -- 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_WarnOverlappingPatterns,
- Opt_WarnMissingFields,
- Opt_WarnMissingMethods,
- Opt_WarnDuplicateExports
+ Opt_WarnOverlappingPatterns,
+ Opt_WarnMissingFields,
+ Opt_WarnMissingMethods,
+ Opt_WarnDuplicateExports
]
+minusWOpts :: [DynFlag]
minusWOpts
- = standardWarnings ++
- [ Opt_WarnUnusedBinds,
- Opt_WarnUnusedMatches,
- Opt_WarnUnusedImports,
- Opt_WarnIncompletePatterns,
- Opt_WarnDodgyImports
+ = 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
+ [ Opt_WarnTypeDefaults,
+ Opt_WarnNameShadowing,
+ Opt_WarnMissingSigs,
+ Opt_WarnHiShadows,
+ Opt_WarnOrphans
]
-- minuswRemovesOpts should be every warning option
+minuswRemovesOpts :: [DynFlag]
minuswRemovesOpts
= minusWallOpts ++
[Opt_WarnImplicitPrelude,
-- -----------------------------------------------------------------------------
-- 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.
+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.
+ = 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
| CoreDoOldStrictness
| CoreDoGlomBinds
| CoreCSE
- | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
- -- matching this string
+ | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
+ -- matching this string
| CoreDoVectorisation
- | CoreDoNothing -- Useful when building up
- | CoreDoPasses [CoreToDo] -- lists of these things
+ | CoreDoNothing -- Useful when building up
+ | CoreDoPasses [CoreToDo] -- lists of these things
-data SimplifierMode -- See comments in SimplMonad
+data SimplifierMode -- See comments in SimplMonad
= SimplGently
- | SimplPhase Int
+ | 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
+ = 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 do_this = CoreDoNothing
+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
- max_iter = maxSimplIterations dflags
+ 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
liberate_case = dopt Opt_LiberateCase dflags
rule_check = ruleCheck dflags
vectorisation = dopt Opt_Vectorise dflags
-
- core_todo =
+ -- 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
+ ]
+
+ -- 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
- [
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]
- ]
- else {- opt_level >= 1 -} [
-
- -- initial simplify: mk specialiser happy: minimum effort please
- 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
- ],
+ [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]),
+ 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 CoreDoStaticArgs,
+ -- XXX disabled, see #2321
+ -- initial simplify: mk specialiser happy: minimum effort please
+ simpl_gently,
-- We run vectorisation here for now, but we might also try to run
-- it later
- runWhen vectorisation (CoreDoPasses [
- CoreDoVectorisation,
- CoreDoSimplify SimplGently
- [NoCaseOfCase,
- MaxSimplifierIterations max_iter]]),
-
- -- 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,
-
- CoreDoSimplify (SimplPhase 2) [
- -- 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.
- MaxSimplifierIterations max_iter
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
-
- CoreDoSimplify (SimplPhase 1) [
- -- Need inline-phase2 here 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
- MaxSimplifierIterations max_iter
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
-
- CoreDoSimplify (SimplPhase 0) [
- -- Phase 0: allow all Ids to be inlined now
- -- This gets foldr inlined before strictness analysis
-
- MaxSimplifierIterations 3
- -- 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!
-
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+ runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, 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,
+ CoreDoOldStrictness,
#endif
- runWhen strictness (CoreDoPasses [
- CoreDoStrictness,
- CoreDoWorkerWrapper,
- CoreDoGlomBinds,
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations 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,
-
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
-
- -- Case-liberation for -O2. This should be after
- -- strictness analysis and the simplification which follows it.
- runWhen liberate_case (CoreDoPasses [
- CoreLiberateCase,
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations 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,
-
- -- Final clean-up simplification:
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]
+ 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
]
-- -----------------------------------------------------------------------------
| Just todo <- stgToDo dflags = todo -- set explicitly by user
| otherwise = todo2
where
- stg_stats = dopt Opt_StgStats dflags
+ stg_stats = dopt Opt_StgStats dflags
- todo1 = if stg_stats then [D_stg_stats] else []
+ todo1 = if stg_stats then [D_stg_stats] else []
- todo2 | WayProf `elem` wayNames dflags
- = StgDoMassageForProfiling : todo1
- | otherwise
- = todo1
+ todo2 | WayProf `elem` wayNames dflags
+ = StgDoMassageForProfiling : todo1
+ | otherwise
+ = todo1
-- -----------------------------------------------------------------------------
-- DynFlags parser
allFlags = map ('-':) $
[ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
map ("fno-"++) flags ++
- map ("f"++) flags
+ map ("f"++) flags ++
+ map ("X"++) xs ++
+ map ("XNo"++) xs
where ok (PrefixPred _ _) = False
ok _ = True
flags = map fst fFlags
+ xs = map fst xFlags
dynamic_flags :: [(String, OptKind DynP)]
dynamic_flags = [
( "n" , NoArg (setDynFlag Opt_DryRun) )
- , ( "cpp" , NoArg (setDynFlag Opt_Cpp))
- , ( "F" , NoArg (setDynFlag Opt_Pp))
- , ( "#include" , HasArg (addCmdlineHCInclude) )
- , ( "v" , OptIntSuffix setVerbosity )
+ , ( "cpp" , NoArg (setDynFlag Opt_Cpp))
+ , ( "F" , NoArg (setDynFlag Opt_Pp))
+ , ( "#include" , HasArg (addCmdlineHCInclude) )
+ , ( "v" , OptIntSuffix setVerbosity )
------- Specific phases --------------------------------------------
- , ( "pgmL" , HasArg (upd . setPgmL) )
- , ( "pgmP" , HasArg (upd . setPgmP) )
- , ( "pgmF" , HasArg (upd . setPgmF) )
- , ( "pgmc" , HasArg (upd . setPgmc) )
- , ( "pgmm" , HasArg (upd . setPgmm) )
- , ( "pgms" , HasArg (upd . setPgms) )
- , ( "pgma" , HasArg (upd . setPgma) )
- , ( "pgml" , HasArg (upd . setPgml) )
- , ( "pgmdll" , HasArg (upd . setPgmdll) )
+ , ( "pgmL" , HasArg (upd . setPgmL) )
+ , ( "pgmP" , HasArg (upd . setPgmP) )
+ , ( "pgmF" , HasArg (upd . setPgmF) )
+ , ( "pgmc" , HasArg (upd . setPgmc) )
+ , ( "pgmm" , HasArg (upd . setPgmm) )
+ , ( "pgms" , HasArg (upd . setPgms) )
+ , ( "pgma" , HasArg (upd . setPgma) )
+ , ( "pgml" , HasArg (upd . setPgml) )
+ , ( "pgmdll" , HasArg (upd . setPgmdll) )
, ( "pgmwindres" , HasArg (upd . setPgmwindres) )
- , ( "optL" , HasArg (upd . addOptL) )
- , ( "optP" , HasArg (upd . addOptP) )
- , ( "optF" , HasArg (upd . addOptF) )
- , ( "optc" , HasArg (upd . addOptc) )
- , ( "optm" , HasArg (upd . addOptm) )
- , ( "opta" , HasArg (upd . addOpta) )
- , ( "optl" , HasArg (upd . addOptl) )
- , ( "optdep" , HasArg (upd . addOptdep) )
+ , ( "optL" , HasArg (upd . addOptL) )
+ , ( "optP" , HasArg (upd . addOptP) )
+ , ( "optF" , HasArg (upd . addOptF) )
+ , ( "optc" , HasArg (upd . addOptc) )
+ , ( "optm" , HasArg (upd . addOptm) )
+ , ( "opta" , HasArg (upd . addOpta) )
+ , ( "optl" , HasArg (upd . addOptl) )
+ , ( "optdep" , HasArg (upd . addOptdep) )
, ( "optwindres" , HasArg (upd . addOptwindres) )
- , ( "split-objs" , NoArg (if can_split
- then setDynFlag Opt_SplitObjs
- else return ()) )
+ , ( "split-objs" , NoArg (if can_split
+ then setDynFlag Opt_SplitObjs
+ else return ()) )
- -------- Linking ----------------------------------------------------
- , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
- , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
- , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
+ -------- Linking ----------------------------------------------------
+ , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
+ , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
+ , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
+ , ( "dynload" , HasArg (upd . parseDynLibLoaderMode))
- ------- Libraries ---------------------------------------------------
- , ( "L" , Prefix addLibraryPath )
- , ( "l" , AnySuffix (\s -> do upd (addOptl s)))
+ ------- Libraries ---------------------------------------------------
+ , ( "L" , Prefix addLibraryPath )
+ , ( "l" , AnySuffix (\s -> do upd (addOptl s)))
- ------- Frameworks --------------------------------------------------
+ ------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
, ( "framework-path" , HasArg addFrameworkPath )
- , ( "framework" , HasArg (upd . addCmdlineFramework) )
-
- ------- Output Redirection ------------------------------------------
- , ( "odir" , HasArg (upd . setObjectDir . Just))
- , ( "o" , SepArg (upd . setOutputFile . Just))
- , ( "ohi" , HasArg (upd . setOutputHi . Just ))
- , ( "osuf" , HasArg (upd . setObjectSuf))
- , ( "hcsuf" , HasArg (upd . setHcSuf))
- , ( "hisuf" , HasArg (upd . setHiSuf))
- , ( "hidir" , HasArg (upd . setHiDir . Just))
- , ( "tmpdir" , HasArg (upd . setTmpDir))
- , ( "stubdir" , HasArg (upd . setStubDir . Just))
-
- ------- Keeping temporary files -------------------------------------
+ , ( "framework" , HasArg (upd . addCmdlineFramework) )
+
+ ------- Output Redirection ------------------------------------------
+ , ( "odir" , HasArg (upd . setObjectDir))
+ , ( "o" , SepArg (upd . setOutputFile . Just))
+ , ( "ohi" , HasArg (upd . setOutputHi . Just ))
+ , ( "osuf" , HasArg (upd . setObjectSuf))
+ , ( "hcsuf" , HasArg (upd . setHcSuf))
+ , ( "hisuf" , HasArg (upd . setHiSuf))
+ , ( "hidir" , HasArg (upd . setHiDir))
+ , ( "tmpdir" , HasArg (upd . setTmpDir))
+ , ( "stubdir" , HasArg (upd . setStubDir))
+ , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just))
+
+ ------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)
, ( "keep-hc-file" , NoArg (setDynFlag Opt_KeepHcFiles))
, ( "keep-hc-files" , NoArg (setDynFlag Opt_KeepHcFiles))
-- This only makes sense as plural
, ( "keep-tmp-files" , NoArg (setDynFlag Opt_KeepTmpFiles))
- ------- Miscellaneous ----------------------------------------------
+ ------- Miscellaneous ----------------------------------------------
, ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain))
- , ( "main-is" , SepArg setMainIs )
- , ( "haddock" , NoArg (setDynFlag Opt_Haddock) )
- , ( "hpcdir" , SepArg setOptHpcDir )
+ , ( "main-is" , SepArg setMainIs )
+ , ( "haddock" , NoArg (setDynFlag Opt_Haddock) )
+ , ( "haddock-opts" , HasArg (upd . addHaddockOpts))
+ , ( "hpcdir" , SepArg setOptHpcDir )
- ------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
- , ( "recomp" , NoArg (unSetDynFlag Opt_ForceRecomp) )
- , ( "no-recomp" , NoArg (setDynFlag Opt_ForceRecomp) )
+ ------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
+ , ( "recomp" , NoArg (unSetDynFlag Opt_ForceRecomp) )
+ , ( "no-recomp" , NoArg (setDynFlag Opt_ForceRecomp) )
------- Packages ----------------------------------------------------
, ( "package-conf" , HasArg extraPkgConf_ )
, ( "ignore-package" , HasArg ignorePackage )
, ( "syslib" , HasArg exposePackage ) -- for compatibility
- ------ HsCpp opts ---------------------------------------------------
- , ( "D", AnySuffix (upd . addOptP) )
- , ( "U", AnySuffix (upd . addOptP) )
+ ------ HsCpp opts ---------------------------------------------------
+ , ( "D", AnySuffix (upd . addOptP) )
+ , ( "U", AnySuffix (upd . addOptP) )
- ------- Include/Import Paths ----------------------------------------
- , ( "I" , Prefix addIncludePath)
- , ( "i" , OptPrefix addImportPath )
+ ------- Include/Import Paths ----------------------------------------
+ , ( "I" , Prefix addIncludePath)
+ , ( "i" , OptPrefix addImportPath )
- ------ Debugging ----------------------------------------------------
- , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
+ ------ Debugging ----------------------------------------------------
+ , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
- , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
- , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
- , ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
+ , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
+ , ( "ddump-cmmz", setDumpFlag Opt_D_dump_cmmz)
+ , ( "ddump-cmmz-pretty", setDumpFlag Opt_D_dump_cmmz_pretty)
+ , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
+ , ( "ddump-cvt-cmm", setDumpFlag Opt_D_dump_cvt_cmm)
+ , ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
, ( "ddump-asm-native", setDumpFlag Opt_D_dump_asm_native)
, ( "ddump-asm-liveness", setDumpFlag Opt_D_dump_asm_liveness)
, ( "ddump-asm-coalesce", setDumpFlag Opt_D_dump_asm_coalesce)
, ( "ddump-asm-conflicts", setDumpFlag Opt_D_dump_asm_conflicts)
, ( "ddump-asm-regalloc-stages",
setDumpFlag Opt_D_dump_asm_regalloc_stages)
- , ( "ddrop-asm-stats", setDumpFlag Opt_D_drop_asm_stats)
- , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
- , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
- , ( "ddump-ds", setDumpFlag Opt_D_dump_ds)
- , ( "ddump-flatC", setDumpFlag Opt_D_dump_flatC)
- , ( "ddump-foreign", setDumpFlag Opt_D_dump_foreign)
- , ( "ddump-inlinings", setDumpFlag Opt_D_dump_inlinings)
- , ( "ddump-rule-firings", setDumpFlag Opt_D_dump_rule_firings)
- , ( "ddump-occur-anal", setDumpFlag Opt_D_dump_occur_anal)
- , ( "ddump-parsed", setDumpFlag Opt_D_dump_parsed)
- , ( "ddump-rn", setDumpFlag Opt_D_dump_rn)
- , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl)
+ , ( "ddump-asm-stats", setDumpFlag Opt_D_dump_asm_stats)
+ , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
+ , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
+ , ( "ddump-ds", setDumpFlag Opt_D_dump_ds)
+ , ( "ddump-flatC", setDumpFlag Opt_D_dump_flatC)
+ , ( "ddump-foreign", setDumpFlag Opt_D_dump_foreign)
+ , ( "ddump-inlinings", setDumpFlag Opt_D_dump_inlinings)
+ , ( "ddump-rule-firings", setDumpFlag Opt_D_dump_rule_firings)
+ , ( "ddump-occur-anal", setDumpFlag Opt_D_dump_occur_anal)
+ , ( "ddump-parsed", setDumpFlag Opt_D_dump_parsed)
+ , ( "ddump-rn", setDumpFlag Opt_D_dump_rn)
+ , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl)
, ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations)
- , ( "ddump-spec", setDumpFlag Opt_D_dump_spec)
- , ( "ddump-prep", setDumpFlag Opt_D_dump_prep)
- , ( "ddump-stg", setDumpFlag Opt_D_dump_stg)
- , ( "ddump-stranal", setDumpFlag Opt_D_dump_stranal)
- , ( "ddump-tc", setDumpFlag Opt_D_dump_tc)
- , ( "ddump-types", setDumpFlag Opt_D_dump_types)
- , ( "ddump-rules", setDumpFlag Opt_D_dump_rules)
- , ( "ddump-cse", setDumpFlag Opt_D_dump_cse)
+ , ( "ddump-simpl-phases", OptPrefix setDumpSimplPhases)
+ , ( "ddump-spec", setDumpFlag Opt_D_dump_spec)
+ , ( "ddump-prep", setDumpFlag Opt_D_dump_prep)
+ , ( "ddump-stg", setDumpFlag Opt_D_dump_stg)
+ , ( "ddump-stranal", setDumpFlag Opt_D_dump_stranal)
+ , ( "ddump-tc", setDumpFlag Opt_D_dump_tc)
+ , ( "ddump-types", setDumpFlag Opt_D_dump_types)
+ , ( "ddump-rules", setDumpFlag Opt_D_dump_rules)
+ , ( "ddump-cse", setDumpFlag Opt_D_dump_cse)
, ( "ddump-worker-wrapper", setDumpFlag Opt_D_dump_worker_wrapper)
, ( "ddump-rn-trace", setDumpFlag Opt_D_dump_rn_trace)
, ( "ddump-if-trace", setDumpFlag Opt_D_dump_if_trace)
, ( "ddump-simpl-stats", setDumpFlag Opt_D_dump_simpl_stats)
, ( "ddump-bcos", setDumpFlag Opt_D_dump_BCOs)
, ( "dsource-stats", setDumpFlag Opt_D_source_stats)
- , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core)
+ , ( "dverbose-core2core", NoArg setVerboseCore2Core)
, ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg)
, ( "ddump-hi", setDumpFlag Opt_D_dump_hi)
, ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports)
- , ( "ddump-vect", setDumpFlag Opt_D_dump_vect)
- , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc)
- , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles)
-
- , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs))
- , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting))
- , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting))
- , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting))
+ , ( "ddump-vect", setDumpFlag Opt_D_dump_vect)
+ , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc)
+ , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles)
+ , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning)
+ , ( "ddump-to-file", setDumpFlag Opt_DumpToFile)
+ , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs)
+
+ , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting))
+ , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting))
+ , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting))
+ , ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting))
, ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp
- setVerbosity (Just 2)) )
- , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats))
-
- ------ Machine dependant (-m<blah>) stuff ---------------------------
-
- , ( "monly-2-regs", NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
- , ( "monly-3-regs", NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
- , ( "monly-4-regs", NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
-
- ------ Warning opts -------------------------------------------------
- , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) )
- , ( "Werror" , NoArg (setDynFlag Opt_WarnIsError) )
- , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) )
- , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
- , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) )
-
- ------ Optimisation flags ------------------------------------------
- , ( "O" , NoArg (upd (setOptLevel 1)))
- , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated
- , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
- -- If the number is missing, use 1
-
- , ( "fmax-simplifier-iterations", IntSuffix (\n ->
- upd (\dfs -> dfs{ maxSimplIterations = n })) )
-
- -- liberate-case-threshold is an old flag for '-fspec-threshold'
- , ( "fspec-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
- , ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
-
- , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
- , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
+ setVerbosity (Just 2)) )
+ , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats))
+
+ ------ Machine dependant (-m<blah>) stuff ---------------------------
+
+ , ( "monly-2-regs", NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
+ , ( "monly-3-regs", NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
+ , ( "monly-4-regs", NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
+
+ ------ Warning opts -------------------------------------------------
+ , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) )
+ , ( "Werror", NoArg (setDynFlag Opt_WarnIsError) )
+ , ( "Wwarn" , NoArg (unSetDynFlag Opt_WarnIsError) )
+ , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) )
+ , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) -- DEPRECATED
+ , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) )
+
+ ------ Optimisation flags ------------------------------------------
+ , ( "O" , NoArg (upd (setOptLevel 1)))
+ , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated
+ , ( "Odph" , NoArg (upd setDPHOpt))
+ , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
+ -- If the number is missing, use 1
+
+ , ( "fsimplifier-phases", IntSuffix (\n ->
+ upd (\dfs -> dfs{ simplPhases = n })) )
+ , ( "fmax-simplifier-iterations", IntSuffix (\n ->
+ upd (\dfs -> dfs{ maxSimplIterations = n })) )
+
+ , ( "fspec-constr-threshold", IntSuffix (\n ->
+ upd (\dfs -> dfs{ specConstrThreshold = Just n })))
+ , ( "fno-spec-constr-threshold", NoArg (
+ upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
+ , ( "fspec-constr-count", IntSuffix (\n ->
+ upd (\dfs -> dfs{ specConstrCount = Just n })))
+ , ( "fno-spec-constr-count", NoArg (
+ upd (\dfs -> dfs{ specConstrCount = Nothing })))
+ , ( "fliberate-case-threshold", IntSuffix (\n ->
+ upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
+ , ( "fno-liberate-case-threshold", NoArg (
+ upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
+
+ , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
+ , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
------ Compiler flags -----------------------------------------------
-- these -f<blah> flags can all be reversed with -fno-<blah>
+fFlags :: [(String, DynFlag)]
fFlags = [
( "warn-dodgy-imports", Opt_WarnDodgyImports ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
( "warn-tabs", Opt_WarnTabs ),
( "print-explicit-foralls", Opt_PrintExplicitForalls ),
( "strictness", Opt_Strictness ),
+ ( "static-argument-transformation", Opt_StaticArgumentTransformation ),
( "full-laziness", Opt_FullLaziness ),
( "liberate-case", Opt_LiberateCase ),
( "spec-constr", Opt_SpecConstr ),
( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
( "ignore-asserts", Opt_IgnoreAsserts ),
- ( "ignore-breakpoints", Opt_IgnoreBreakpoints),
( "do-eta-reduction", Opt_DoEtaReduction ),
( "case-merge", Opt_CaseMerge ),
( "unbox-strict-fields", Opt_UnboxStrictFields ),
+ ( "method-sharing", Opt_MethodSharing ),
( "dicts-cheap", Opt_DictsCheap ),
( "excess-precision", Opt_ExcessPrecision ),
( "asm-mangling", Opt_DoAsmMangling ),
( "hpc-no-auto", Opt_Hpc_No_Auto ),
( "rewrite-rules", Opt_RewriteRules ),
( "break-on-exception", Opt_BreakOnException ),
+ ( "break-on-error", Opt_BreakOnError ),
+ ( "print-evld-with-show", Opt_PrintEvldWithShow ),
+ ( "print-bind-contents", Opt_PrintBindContents ),
+ ( "run-cps", Opt_RunCPSZ ),
+ ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack),
( "vectorise", Opt_Vectorise ),
( "regs-graph", Opt_RegsGraph),
+ ( "regs-iterative", Opt_RegsIterative),
-- Deprecated in favour of -XTemplateHaskell:
( "th", Opt_TemplateHaskell ),
-- Deprecated in favour of -XForeignFunctionInterface:
( "PatternSignatures", Opt_PatternSignatures ),
( "EmptyDataDecls", Opt_EmptyDataDecls ),
( "ParallelListComp", Opt_ParallelListComp ),
+ ( "TransformListComp", Opt_TransformListComp ),
( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ),
( "UnliftedFFITypes", Opt_UnliftedFFITypes ),
- ( "PartiallyAppliedClosedTypeSynonyms",
- Opt_PartiallyAppliedClosedTypeSynonyms ),
+ ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ),
( "Rank2Types", Opt_Rank2Types ),
( "RankNTypes", Opt_RankNTypes ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes ),
( "TypeOperators", Opt_TypeOperators ),
( "RecursiveDo", Opt_RecursiveDo ),
( "Arrows", Opt_Arrows ),
( "PArr", Opt_PArr ),
( "TemplateHaskell", Opt_TemplateHaskell ),
+ ( "QuasiQuotes", Opt_QuasiQuotes ),
( "Generics", Opt_Generics ),
-- On by default:
( "ImplicitPrelude", Opt_ImplicitPrelude ),
( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ),
( "OverloadedStrings", Opt_OverloadedStrings ),
( "GADTs", Opt_GADTs ),
+ ( "ViewPatterns", Opt_ViewPatterns),
( "TypeFamilies", Opt_TypeFamilies ),
( "BangPatterns", Opt_BangPatterns ),
-- On by default:
impliedFlags :: [(DynFlag, [DynFlag])]
impliedFlags = [
- ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs
+ ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to
+ -- be completely rigid for GADTs
+ , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see
+ -- Note [Scoped tyvars] in TcBinds
]
+glasgowExtsFlags :: [DynFlag]
glasgowExtsFlags = [
Opt_PrintExplicitForalls
, Opt_ForeignFunctionInterface
, Opt_UnliftedFFITypes
- , Opt_GADTs
- , Opt_ImplicitParams
- , Opt_ScopedTypeVariables
+ , Opt_GADTs
+ , Opt_ImplicitParams
+ , Opt_ScopedTypeVariables
, Opt_UnboxedTuples
, Opt_TypeSynonymInstances
, Opt_StandaloneDeriving
, Opt_ConstrainedClassMethods
, Opt_MultiParamTypeClasses
, Opt_FunctionalDependencies
- , Opt_MagicHash
+ , Opt_MagicHash
, Opt_PolymorphicComponents
, Opt_ExistentialQuantification
, Opt_UnicodeSyntax
, Opt_PatternGuards
- , Opt_PartiallyAppliedClosedTypeSynonyms
+ , Opt_LiberalTypeSynonyms
, Opt_RankNTypes
+ , Opt_ImpredicativeTypes
, Opt_TypeOperators
, Opt_RecursiveDo
, Opt_ParallelListComp
, Opt_KindSignatures
, Opt_PatternSignatures
, Opt_GeneralizedNewtypeDeriving
- , Opt_TypeFamilies ]
+ , Opt_TypeFamilies ]
------------------
isFlag :: [(String,a)] -> String -> Bool
------------------
getFlag :: [(String,a)] -> String -> a
getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
- (o:os) -> o
+ (o:_) -> o
[] -> panic ("get_flag " ++ f)
getPrefFlag :: String -> [(String,a)] -> String -> a
parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags,[String])
parseDynamicFlags dflags args = do
- let ((leftover,errs),dflags')
- = runCmdLine (processArgs dynamic_flags args) dflags
+ let ((leftover,errs),dflags')
+ = runCmdLine (processArgs dynamic_flags args) dflags
when (not (null errs)) $ do
throwDyn (UsageError (unlines errs))
return (dflags', leftover)
type DynP = CmdLineP DynFlags
upd :: (DynFlags -> DynFlags) -> DynP ()
-upd f = do
+upd f = do
dfs <- getCmdLineState
putCmdLineState $! (f dfs)
setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
where
deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
- -- 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)
+ -- 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)
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
-setDumpFlag dump_flag
- = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
- -- Whenver we -ddump, switch off the recompilation checker,
- -- else you don't see the dump!
+setDumpFlag dump_flag
+ | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
+ | otherwise = NoArg (setDynFlag dump_flag)
+ 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
+ -- 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]
+
+setVerboseCore2Core :: DynP ()
+setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
+ setDynFlag Opt_D_verbose_core2core
+ upd (\s -> s { shouldDumpSimplPhase = const True })
+
+setDumpSimplPhases :: String -> DynP ()
+setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+ upd (\s -> s { shouldDumpSimplPhase = 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
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
+addCmdlineHCInclude :: String -> DynP ()
addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
+extraPkgConf_ :: FilePath -> DynP ()
extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
-exposePackage p =
+exposePackage, hidePackage, ignorePackage :: String -> DynP ()
+exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
-hidePackage p =
+hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
-ignorePackage p =
+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"))
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
+setTarget :: HscTarget -> DynP ()
setTarget l = upd set
- where
- set dfs
+ where
+ set dfs
| ghcLink dfs /= LinkBinary || isObjectTarget l = dfs{ hscTarget = l }
| otherwise = dfs
-- 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
-- can be safely used in an OPTIONS_GHC pragma.
+setObjTarget :: HscTarget -> DynP ()
setObjTarget l = upd set
- where
- set dfs
+ where
+ set dfs
| isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
| otherwise = dfs
setOptLevel :: Int -> DynFlags -> DynFlags
setOptLevel n dflags
| hscTarget dflags == HscInterpreted && n > 0
- = dflags
- -- not in IO any more, oh well:
- -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
+ = dflags
+ -- not in IO any more, oh well:
+ -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
| otherwise
- = updOptLevel n dflags
+ = updOptLevel n dflags
+
+
+-- -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
+--
+setDPHOpt :: DynFlags -> DynFlags
+setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
+ , specConstrThreshold = Nothing
+ })
+ `dopt_set` Opt_DictsCheap
+ `dopt_unset` Opt_MethodSharing
+
setMainIs :: String -> DynP ()
setMainIs arg
- | not (null main_fn) -- The arg looked like "Foo.baz"
+ | not (null main_fn) && isLower (head main_fn)
+ -- The arg looked like "Foo.Bar.baz"
= upd $ \d -> d{ mainFunIs = Just main_fn,
- mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
- | isUpper (head main_mod) -- The arg looked like "Foo"
- = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
-
- | otherwise -- The arg looked like "baz"
- = upd $ \d -> d{ mainFunIs = Just main_mod }
+ | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar"
+ = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
+
+ | otherwise -- The arg looked like "baz"
+ = upd $ \d -> d{ mainFunIs = Just arg }
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
-----------------------------------------------------------------------------
-- Paths & Libraries
+addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
+
-- -i on its own deletes the import paths
addImportPath "" = upd (\s -> s{importPaths = []})
addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
-addLibraryPath p =
+addLibraryPath p =
upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
-addIncludePath p =
+addIncludePath p =
upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
-addFrameworkPath p =
+addFrameworkPath p =
upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
+#ifndef mingw32_TARGET_OS
+split_marker :: Char
split_marker = ':' -- not configurable (ToDo)
+#endif
splitPathList :: String -> [String]
splitPathList s = filter notNull (splitUp s)
- -- empty paths are ignored: there might be a trailing
- -- ':' in the initial list, for example. Empty paths can
- -- cause confusion when they are translated into -I options
- -- for passing to gcc.
+ -- empty paths are ignored: there might be a trailing
+ -- ':' in the initial list, for example. Empty paths can
+ -- cause confusion when they are translated into -I options
+ -- for passing to gcc.
where
#ifndef mingw32_TARGET_OS
splitUp xs = split split_marker xs
-#else
+#else
-- Windows: 'hybrid' support for DOS-style paths in directory lists.
- --
+ --
-- That is, if "foo:bar:baz" is used, this interpreted as
-- consisting of three entries, 'foo', 'bar', 'baz'.
-- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
-- So, use either.
splitUp [] = []
splitUp (x:':':div:xs) | div `elem` dir_markers
- = ((x:':':div:p): splitUp rs)
- where
- (p,rs) = findNextPath xs
- -- we used to check for existence of the path here, but that
- -- required the IO monad to be threaded through the command-line
- -- parser which is quite inconvenient. The
+ = ((x:':':div:p): splitUp rs)
+ where
+ (p,rs) = findNextPath xs
+ -- we used to check for existence of the path here, but that
+ -- required the IO monad to be threaded through the command-line
+ -- parser which is quite inconvenient. The
splitUp xs = cons p (splitUp rs)
- where
- (p,rs) = findNextPath xs
-
- cons "" xs = xs
- cons x xs = x:xs
+ where
+ (p,rs) = findNextPath xs
+
+ cons "" xs = xs
+ cons x xs = x:xs
-- will be called either when we've consumed nought or the
-- "<Drive>:/" part of a DOS path, so splitting is just a Q of
-- finding the next split marker.
- findNextPath xs =
+ findNextPath xs =
case break (`elem` split_markers) xs of
- (p, d:ds) -> (p, ds)
- (p, xs) -> (p, xs)
+ (p, _:ds) -> (p, ds)
+ (p, xs) -> (p, xs)
split_markers :: [Char]
split_markers = [':', ';']
-- tmpDir, where we store temporary files.
setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
- where
-#if !defined(mingw32_HOST_OS)
- canonicalise p = normalisePath p
-#else
- -- Canonicalisation of temp path under win32 is a bit more
- -- involved: (a) strip trailing slash,
- -- (b) normalise slashes
- -- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
- --
- canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-
- -- if we're operating under cygwin, and TMP/TEMP is of
- -- the form "/cygdrive/drive/path", translate this to
- -- "drive:/path" (as GHC isn't a cygwin app and doesn't
- -- understand /cygdrive paths.)
- xltCygdrive path
- | "/cygdrive/" `isPrefixOf` path =
- case drop (length "/cygdrive/") path of
- drive:xs@('/':_) -> drive:':':xs
- _ -> path
- | otherwise = path
-
- -- strip the trailing backslash (awful, but we only do this once).
- removeTrailingSlash path =
- case last path of
- '/' -> init path
- '\\' -> init path
- _ -> path
-#endif
+setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
+ -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
+ -- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
-- Hpc stuff
-- platform.
machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
- [String]) -- for registerised HC compilations
-machdepCCOpts dflags
+ [String]) -- for registerised HC compilations
+machdepCCOpts _dflags
#if alpha_TARGET_ARCH
- = ( ["-w", "-mieee"
+ = ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
- , "-D_REENTRANT"
+ , "-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.
+ ], [] )
+ -- 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"], [] )
+ = ( ["-D_HPUX_SOURCE"], [] )
#elif m68k_TARGET_ARCH
-- -fno-defer-pop : for the .hc files, we want all the pushing/
-- 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"] )
+ = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
#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 ""
--- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" 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 ]
- )
+ = let n_regs = stolen_x86_regs _dflags
+ sta = opt_Static
+ in
+ ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
+-- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" 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"] )
+ = ( [], ["-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.
- ] )
+ = ( [], ["-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.
+ = ( [], ["-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.
#elif powerpc_apple_darwin_TARGET
-- -no-cpp-precomp:
-- declarations.
= ( [], ["-no-cpp-precomp"] )
#else
- = ( [], [] )
+ = ( [], [] )
#endif
picCCOpts :: DynFlags -> [String]
-picCCOpts dflags
+picCCOpts _dflags
#if darwin_TARGET_OS
-- Apple prefers to do things the other way round.
-- PIC is on by default.
("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),
- ("Leading underscore", cLeadingUnderscore)]
+ ("RTS ways", cGhcRTSWays),
+ ("Leading underscore", cLeadingUnderscore),
+ ("Debug on", show debugIsOn)
+ ]
projects / ghc-hetmet.git / blobdiff