+
{-# 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
-- Dynamic flags
DynFlag(..),
DynFlags(..),
- HscTarget(..),
+ HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
Option(..),
+ DynLibLoader(..),
+ fFlags, xFlags,
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo(..),
allFlags,
-- misc stuff
- machdepCCOpts, picCCOpts
+ machdepCCOpts, picCCOpts,
+ supportedLanguages,
+ compilerInfo,
) where
#include "HsVersions.h"
-import Module ( Module, mkModuleName, mkModule )
+import Module
import PackageConfig
import PrelNames ( mAIN )
#ifdef i386_TARGET_ARCH
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic ( panic, GhcException(..) )
import UniqFM ( UniqFM )
-import Util ( notNull, splitLongestPrefix, normalisePath )
-import Maybes ( fromJust, orElse )
+import Util
+import Maybes ( orElse, fromJust )
import SrcLoc ( SrcSpan )
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
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 Data.Char ( isDigit, isUpper )
+import Data.Char
+import System.FilePath
import System.IO ( hPutStrLn, stderr )
-import Breakpoints ( BkptHandler )
-import Module ( ModuleName )
-
-- -----------------------------------------------------------------------------
-- DynFlags
-- 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_coalesce
+ | Opt_D_dump_asm_regalloc
+ | Opt_D_dump_asm_regalloc_stages
+ | Opt_D_dump_asm_conflicts
+ | Opt_D_dump_asm_stats
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_flatC
| Opt_D_dump_foreign
| Opt_D_dump_inlinings
+ | Opt_D_dump_rule_firings
| Opt_D_dump_occur_anal
| Opt_D_dump_parsed
| 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
| 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_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_WarnIncompletePatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnMissingFields
| Opt_WarnOverlappingPatterns
| Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
+ | Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
| Opt_WarnDodgyImports
| Opt_WarnOrphans
+ | Opt_WarnTabs
-- language opts
- | Opt_AllowOverlappingInstances
- | Opt_AllowUndecidableInstances
- | Opt_AllowIncoherentInstances
+ | Opt_OverlappingInstances
+ | Opt_UndecidableInstances
+ | Opt_IncoherentInstances
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
- | Opt_GlasgowExts
- | Opt_FFI
+ | Opt_ForeignFunctionInterface
+ | Opt_UnliftedFFITypes
| Opt_PArr -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax
- | Opt_TH
+ | Opt_TemplateHaskell
+ | Opt_QuasiQuotes
| Opt_ImplicitParams
| Opt_Generics
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
+ | Opt_UnboxedTuples
| Opt_BangPatterns
- | Opt_IndexedTypes
+ | 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_PatternGuards
+ | 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_IgnoreInterfacePragmas
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
- | Opt_IgnoreBreakpoints
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
+ | Opt_MethodSharing
| Opt_DictsCheap
+ | Opt_RewriteRules
+ | Opt_Vectorise
+ | Opt_RegsGraph -- do graph coloring register allocation
+ | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
-- misc opts
| Opt_Cpp
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
- | Opt_Debugging
| 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,
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],
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],
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
- opt_dll :: [String],
opt_dep :: [String],
+ opt_windres :: [String],
-- commands for particular phases
pgm_L :: String,
pgm_dll :: (String,[Option]),
pgm_T :: String,
pgm_sysman :: String,
+ pgm_windres :: String,
-- Package flags
extraPkgConfs :: [FilePath],
-- Package state
-- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM InstalledPackageInfo),
+ pkgDatabase :: Maybe (UniqFM PackageConfig),
pkgState :: PackageState,
-- hsc dynamic flags
flags :: [DynFlag],
-- message output
- log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+ log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
- -- breakpoint handling
- ,bkptHandler :: Maybe (BkptHandler Module)
+ haddockOptions :: Maybe String
}
data HscTarget
| HscNothing
deriving (Eq, Show)
+-- | will this target result in an object file on the disk?
+isObjectTarget :: HscTarget -> Bool
+isObjectTarget HscC = True
+isObjectTarget HscAsm = True
+isObjectTarget _ = False
+
+-- | The 'GhcMode' tells us whether we're doing multi-module
+-- compilation (controlled via the "GHC" API) or one-shot
+-- (single-module) compilation. This makes a difference primarily to
+-- the "Finder": in one-shot mode we look for interface files for
+-- imported modules, but in multi-module mode we look for source files
+-- in order to check whether they need to be recompiled.
data GhcMode
- = BatchCompile -- | @ghc --make Main@
- | Interactive -- | @ghc --interactive@
- | OneShot -- | @ghc -c Foo.hs@
- | JustTypecheck -- | Development environemnts, refactorer, etc.
- | MkDepend
+ = CompManager -- ^ --make, GHCi, etc.
+ | OneShot -- ^ ghc -c Foo.hs
+ | MkDepend -- ^ ghc -M, see Finder for why we need this
deriving Eq
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
- = -- Only relevant for modes
- -- DoMake and StopBefore StopLn
- NoLink -- Don't link at all
- | StaticLink -- Ordinary linker [the default]
- | MkDLL -- Make a DLL
+ = 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, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
-isNoLink other = False
+isNoLink _ = False
data PackageFlag
= ExposePackage String
| IgnorePackage String
deriving Eq
-defaultHscTarget
+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
+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
rtsBuildTag = rts_build_tag
}
+defaultDynFlags :: DynFlags
defaultDynFlags =
DynFlags {
- ghcMode = OneShot,
- ghcLink = StaticLink,
+ ghcMode = CompManager,
+ ghcLink = LinkBinary,
coreToDo = Nothing,
stgToDo = Nothing,
hscTarget = defaultHscTarget,
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 = ["."],
outputFile = Nothing,
outputHi = Nothing,
+ dynLibLoader = Deployable,
+ dumpPrefix = Nothing,
+ dumpPrefixForce = Nothing,
includePaths = [],
libraryPaths = [],
frameworkPaths = [],
hpcDir = ".hpc",
opt_L = [],
- opt_P = [],
+ opt_P = (if opt_PIC
+ then ["-D__PIC__"]
+ else []),
opt_F = [],
opt_c = [],
opt_a = [],
opt_m = [],
opt_l = [],
- opt_dll = [],
opt_dep = [],
+ opt_windres = [],
extraPkgConfs = [],
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
+ 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,
- bkptHandler = 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_Strictness,
- -- strictness is on by default, but this only
- -- applies to -O.
- Opt_CSE, -- similarly for CSE.
- Opt_FullLaziness, -- ...and for full laziness
-
- 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.
-
- Opt_DoAsmMangling,
-
- -- and the default no-optimisation options:
- Opt_IgnoreInterfacePragmas,
- Opt_OmitInterfacePragmas,
-
- -- on by default:
- Opt_PrintBindResult
- ] ++ standardWarnings,
-
log_action = \severity srcSpan style msg ->
case severity of
SevInfo -> hPutStrLn stderr (show (msg style))
| 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)}
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}
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}
-addOptdll f d = d{ opt_dll = f : opt_dll d}
addOptdep f d = d{ opt_dep = f : opt_dep d}
+addOptwindres f d = d{ opt_windres = f : opt_windres d}
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
+addHaddockOpts f d = d{ haddockOptions = Just f}
+
-- -----------------------------------------------------------------------------
-- Command-line options
updOptLevel :: Int -> DynFlags -> DynFlags
-- Set dynflags appropriate to the optimisation level
updOptLevel n dfs
- = dfs2{ optLevel = n }
+ = dfs2{ optLevel = final_n }
where
+ 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
- | n == 0 = opt_0_dopts
- | otherwise = opt_1_dopts
-
- remove_dopts
- | n == 0 = opt_1_dopts
- | otherwise = opt_0_dopts
+ extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
+ remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
-opt_0_dopts = [
- Opt_IgnoreInterfacePragmas,
- Opt_OmitInterfacePragmas
+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.
]
-opt_1_dopts = [
- Opt_IgnoreAsserts,
- Opt_DoEtaReduction,
- Opt_CaseMerge
- ]
-
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
+standardWarnings :: [DynFlag]
standardWarnings
= [ Opt_WarnDeprecations,
Opt_WarnOverlappingPatterns,
Opt_WarnDuplicateExports
]
+minusWOpts :: [DynFlag]
minusWOpts
= standardWarnings ++
[ Opt_WarnUnusedBinds,
Opt_WarnDodgyImports
]
+minusWallOpts :: [DynFlag]
minusWallOpts
= minusWOpts ++
[ Opt_WarnTypeDefaults,
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.
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
-
- | CoreDoNothing -- useful when building up lists of these things
+ | CoreDoVectorisation
+ | CoreDoNothing -- Useful when building up
+ | CoreDoPasses [CoreToDo] -- lists of these things
data SimplifierMode -- See comments in SimplMonad
= SimplGently
- | SimplPhase Int
+ | SimplPhase Int [String]
data SimplifierSwitch
= MaxSimplifierIterations Int
-- 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
| 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
+ vectorisation = dopt Opt_Vectorise 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
+ ]
+
+ -- 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] ]
- 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 [
+ simpl_gently = CoreDoSimplify SimplGently [
-- Simplify "gently"
-- Don't inline anything till full laziness has bitten
-- In particular, inlining wrappers inhibits 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
+ [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,
+
+ -- 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, simpl_gently ]),
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
CoreDoSpecialising,
- if full_laziness then CoreDoFloatOutwards (FloatOutSw False False)
- else CoreDoNothing,
+ 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 },
+ simpl_phases,
- 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 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),
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
#ifdef OLD_STRICTNESS
- CoreDoOldStrictness
+ CoreDoOldStrictness,
#endif
- if strictness then CoreDoStrictness else CoreDoNothing,
- CoreDoWorkerWrapper,
- CoreDoGlomBinds,
-
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ],
-
- if full_laziness then
- CoreDoFloatOutwards (FloatOutSw False -- Not lambdas
- True) -- Float constants
- else CoreDoNothing,
+ 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
-- f_el22 (f_el21 r_midblock)
- -- 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
-
- if cse then CoreCSE else CoreDoNothing,
+ 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-liberation for -O2. This should be after
--- strictness analysis and the simplification which follows it.
+ maybe_rule_check 0,
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }
- ]
-
- ++
-
- (if opt_level >= 2 then
- [ CoreLiberateCase,
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ], -- Run the simplifier after LiberateCase to vastly
+ -- 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
- CoreDoSpecConstr
- ]
- else
- [])
- ++
+ runWhen spec_constr CoreDoSpecConstr,
+
+ maybe_rule_check 0,
-- Final clean-up simplification:
- [ CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]
+ simpl_phase 0 ["final"] max_iter
]
-- -----------------------------------------------------------------------------
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 = [
, ( "F" , NoArg (setDynFlag Opt_Pp))
, ( "#include" , HasArg (addCmdlineHCInclude) )
, ( "v" , OptIntSuffix setVerbosity )
+
------- Specific phases --------------------------------------------
, ( "pgmL" , HasArg (upd . setPgmL) )
, ( "pgmP" , HasArg (upd . setPgmP) )
, ( "pgma" , HasArg (upd . setPgma) )
, ( "pgml" , HasArg (upd . setPgml) )
, ( "pgmdll" , HasArg (upd . setPgmdll) )
+ , ( "pgmwindres" , HasArg (upd . setPgmwindres) )
, ( "optL" , HasArg (upd . addOptL) )
, ( "optP" , HasArg (upd . addOptP) )
, ( "optm" , HasArg (upd . addOptm) )
, ( "opta" , HasArg (upd . addOpta) )
, ( "optl" , HasArg (upd . addOptl) )
- , ( "optdll" , HasArg (upd . addOptdll) )
, ( "optdep" , HasArg (upd . addOptdep) )
+ , ( "optwindres" , HasArg (upd . addOptwindres) )
, ( "split-objs" , NoArg (if can_split
then setDynFlag Opt_SplitObjs
-------- Linking ----------------------------------------------------
, ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
, ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
- , ( "-mk-dll" , NoArg (upd $ \d -> d{ ghcLink=MkDLL } ))
+ , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
+ , ( "dynload" , HasArg (upd . parseDynLibLoaderMode))
------- Libraries ---------------------------------------------------
, ( "L" , Prefix addLibraryPath )
- , ( "l" , AnySuffix (\s -> do upd (addOptl s)
- upd (addOptdll s)))
+ , ( "l" , AnySuffix (\s -> do upd (addOptl s)))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
, ( "framework" , HasArg (upd . addCmdlineFramework) )
------- Output Redirection ------------------------------------------
- , ( "odir" , HasArg (upd . setObjectDir . Just))
+ , ( "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 . Just))
+ , ( "hidir" , HasArg (upd . setHiDir))
, ( "tmpdir" , HasArg (upd . setTmpDir))
- , ( "stubdir" , HasArg (upd . setStubDir . Just))
+ , ( "stubdir" , HasArg (upd . setStubDir))
+ , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just))
------- Keeping temporary files -------------------------------------
- , ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles))
- , ( "keep-s-file" , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles))
- , ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles))
- , ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles))
+ -- 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))
+ , ( "keep-s-file" , NoArg (setDynFlag Opt_KeepSFiles))
+ , ( "keep-s-files" , NoArg (setDynFlag Opt_KeepSFiles))
+ , ( "keep-raw-s-file" , NoArg (setDynFlag Opt_KeepRawSFiles))
+ , ( "keep-raw-s-files", NoArg (setDynFlag Opt_KeepRawSFiles))
+ -- This only makes sense as plural
+ , ( "keep-tmp-files" , NoArg (setDynFlag Opt_KeepTmpFiles))
------- Miscellaneous ----------------------------------------------
, ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain))
, ( "main-is" , SepArg setMainIs )
, ( "haddock" , NoArg (setDynFlag Opt_Haddock) )
+ , ( "haddock-opts" , HasArg (upd . addHaddockOpts))
, ( "hpcdir" , SepArg setOptHpcDir )
------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
, ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
, ( "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-regalloc", setDumpFlag Opt_D_dump_asm_regalloc)
+ , ( "ddump-asm-conflicts", setDumpFlag Opt_D_dump_asm_conflicts)
+ , ( "ddump-asm-regalloc-stages",
+ setDumpFlag Opt_D_dump_asm_regalloc_stages)
+ , ( "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-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-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", NoArg (setDynFlag Opt_D_dump_rn_trace))
- , ( "ddump-if-trace", NoArg (setDynFlag Opt_D_dump_if_trace))
+ , ( "ddump-rn-trace", setDumpFlag Opt_D_dump_rn_trace)
+ , ( "ddump-if-trace", setDumpFlag Opt_D_dump_if_trace)
, ( "ddump-tc-trace", setDumpFlag Opt_D_dump_tc_trace)
, ( "ddump-splices", setDumpFlag Opt_D_dump_splices)
- , ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats))
+ , ( "ddump-rn-stats", setDumpFlag Opt_D_dump_rn_stats)
, ( "ddump-opt-cmm", setDumpFlag Opt_D_dump_opt_cmm)
, ( "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-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs))
, ( "ddump-hi", setDumpFlag Opt_D_dump_hi)
- , ( "ddump-minimal-imports", NoArg (setDynFlag Opt_D_dump_minimal_imports))
+ , ( "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-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))
, ( "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 minusWallOpts) )
+ ------ 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)))
- , ( "O" , PrefixPred (all isDigit)
- (\f -> upd (setOptLevel (read f))))
-
- , ( "fmax-simplifier-iterations",
- PrefixPred (all isDigit)
- (\n -> upd (\dfs ->
- dfs{ maxSimplIterations = read n })) )
-
- , ( "frule-check",
- SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
+ , ( "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 -----------------------------------------------
- , ( "fno-code", NoArg (setTarget HscNothing))
- , ( "fasm", AnySuffix (\_ -> setTarget HscAsm) )
- , ( "fvia-c", NoArg (setTarget HscC) )
- , ( "fvia-C", NoArg (setTarget HscC) )
+ , ( "fasm", NoArg (setObjTarget HscAsm) )
+ , ( "fvia-c", NoArg (setObjTarget HscC) )
+ , ( "fvia-C", NoArg (setObjTarget HscC) )
+
+ , ( "fno-code", NoArg (setTarget HscNothing))
+ , ( "fbyte-code", NoArg (setTarget HscInterpreted) )
+ , ( "fobject-code", NoArg (setTarget defaultHscTarget) )
, ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) )
, ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
- , ( "fcontext-stack" , OptIntSuffix $ \mb_n -> upd $ \dfs ->
- dfs{ ctxtStkDepth = mb_n `orElse` 3 })
-
- -- the rest of the -f* and -fno-* flags
- , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
- , ( "f", PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
+ -- the rest of the -f* and -fno-* flags
+ , ( "f", PrefixPred (isFlag fFlags)
+ (\f -> setDynFlag (getFlag fFlags f)) )
+ , ( "f", PrefixPred (isPrefFlag "no-" fFlags)
+ (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f)) )
+
+ -- the -X* and -XNo* flags
+ , ( "X", PrefixPred (isFlag xFlags)
+ (\f -> setDynFlag (getFlag xFlags f)) )
+ , ( "X", PrefixPred (isPrefFlag "No" xFlags)
+ (\f -> unSetDynFlag (getPrefFlag "No" xFlags f)) )
]
-- these -f<blah> flags can all be reversed with -fno-<blah>
+fFlags :: [(String, DynFlag)]
fFlags = [
- ( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
- ( "warn-hi-shadowing", Opt_WarnHiShadows ),
- ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ),
- ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ),
- ( "warn-missing-fields", Opt_WarnMissingFields ),
- ( "warn-missing-methods", Opt_WarnMissingMethods ),
- ( "warn-missing-signatures", Opt_WarnMissingSigs ),
- ( "warn-name-shadowing", Opt_WarnNameShadowing ),
- ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ),
- ( "warn-simple-patterns", Opt_WarnSimplePatterns ),
- ( "warn-type-defaults", Opt_WarnTypeDefaults ),
- ( "warn-unused-binds", Opt_WarnUnusedBinds ),
- ( "warn-unused-imports", Opt_WarnUnusedImports ),
- ( "warn-unused-matches", Opt_WarnUnusedMatches ),
- ( "warn-deprecations", Opt_WarnDeprecations ),
- ( "warn-orphans", Opt_WarnOrphans ),
- ( "fi", Opt_FFI ), -- support `-ffi'...
- ( "ffi", Opt_FFI ), -- ...and also `-fffi'
- ( "arrows", Opt_Arrows ), -- arrow syntax
- ( "parr", Opt_PArr ),
- ( "th", Opt_TH ),
- ( "implicit-prelude", Opt_ImplicitPrelude ),
- ( "scoped-type-variables", Opt_ScopedTypeVariables ),
- ( "bang-patterns", Opt_BangPatterns ),
- ( "indexed-types", Opt_IndexedTypes ),
- ( "monomorphism-restriction", Opt_MonomorphismRestriction ),
- ( "mono-pat-binds", Opt_MonoPatBinds ),
- ( "extended-default-rules", Opt_ExtendedDefaultRules ),
- ( "implicit-params", Opt_ImplicitParams ),
- ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ),
- ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ),
- ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ),
- ( "generics", Opt_Generics ),
- ( "strictness", Opt_Strictness ),
- ( "full-laziness", Opt_FullLaziness ),
- ( "cse", Opt_CSE ),
- ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ),
- ( "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 ),
- ( "dicts-cheap", Opt_DictsCheap ),
- ( "excess-precision", Opt_ExcessPrecision ),
- ( "asm-mangling", Opt_DoAsmMangling ),
- ( "print-bind-result", Opt_PrintBindResult ),
- ( "force-recomp", Opt_ForceRecomp ),
- ( "hpc", Opt_Hpc ),
- ( "hpc-tracer", Opt_Hpc_Tracer )
+ ( "warn-dodgy-imports", Opt_WarnDodgyImports ),
+ ( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
+ ( "warn-hi-shadowing", Opt_WarnHiShadows ),
+ ( "warn-implicit-prelude", Opt_WarnImplicitPrelude ),
+ ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ),
+ ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ),
+ ( "warn-missing-fields", Opt_WarnMissingFields ),
+ ( "warn-missing-methods", Opt_WarnMissingMethods ),
+ ( "warn-missing-signatures", Opt_WarnMissingSigs ),
+ ( "warn-name-shadowing", Opt_WarnNameShadowing ),
+ ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ),
+ ( "warn-simple-patterns", Opt_WarnSimplePatterns ),
+ ( "warn-type-defaults", Opt_WarnTypeDefaults ),
+ ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ),
+ ( "warn-unused-binds", Opt_WarnUnusedBinds ),
+ ( "warn-unused-imports", Opt_WarnUnusedImports ),
+ ( "warn-unused-matches", Opt_WarnUnusedMatches ),
+ ( "warn-deprecations", Opt_WarnDeprecations ),
+ ( "warn-orphans", Opt_WarnOrphans ),
+ ( "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 ),
+ ( "cse", Opt_CSE ),
+ ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ),
+ ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
+ ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
+ ( "ignore-asserts", Opt_IgnoreAsserts ),
+ ( "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 ),
+ ( "print-bind-result", Opt_PrintBindResult ),
+ ( "force-recomp", Opt_ForceRecomp ),
+ ( "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:
+ ( "fi", Opt_ForeignFunctionInterface ),
+ -- Deprecated in favour of -XForeignFunctionInterface:
+ ( "ffi", Opt_ForeignFunctionInterface ),
+ -- Deprecated in favour of -XArrows:
+ ( "arrows", Opt_Arrows ),
+ -- Deprecated in favour of -XGenerics:
+ ( "generics", Opt_Generics ),
+ -- Deprecated in favour of -XImplicitPrelude:
+ ( "implicit-prelude", Opt_ImplicitPrelude ),
+ -- Deprecated in favour of -XBangPatterns:
+ ( "bang-patterns", Opt_BangPatterns ),
+ -- Deprecated in favour of -XMonomorphismRestriction:
+ ( "monomorphism-restriction", Opt_MonomorphismRestriction ),
+ -- Deprecated in favour of -XMonoPatBinds:
+ ( "mono-pat-binds", Opt_MonoPatBinds ),
+ -- Deprecated in favour of -XExtendedDefaultRules:
+ ( "extended-default-rules", Opt_ExtendedDefaultRules ),
+ -- Deprecated in favour of -XImplicitParams:
+ ( "implicit-params", Opt_ImplicitParams ),
+ -- Deprecated in favour of -XScopedTypeVariables:
+ ( "scoped-type-variables", Opt_ScopedTypeVariables ),
+ -- Deprecated in favour of -XPArr:
+ ( "parr", Opt_PArr ),
+ -- Deprecated in favour of -XOverlappingInstances:
+ ( "allow-overlapping-instances", Opt_OverlappingInstances ),
+ -- Deprecated in favour of -XUndecidableInstances:
+ ( "allow-undecidable-instances", Opt_UndecidableInstances ),
+ -- Deprecated in favour of -XIncoherentInstances:
+ ( "allow-incoherent-instances", Opt_IncoherentInstances ),
+ ( "gen-manifest", Opt_GenManifest ),
+ ( "embed-manifest", Opt_EmbedManifest )
]
+supportedLanguages :: [String]
+supportedLanguages = map fst xFlags
+
+-- These -X<blah> flags can all be reversed with -XNo<blah>
+xFlags :: [(String, DynFlag)]
+xFlags = [
+ ( "CPP", Opt_Cpp ),
+ ( "PatternGuards", Opt_PatternGuards ),
+ ( "UnicodeSyntax", Opt_UnicodeSyntax ),
+ ( "MagicHash", Opt_MagicHash ),
+ ( "PolymorphicComponents", Opt_PolymorphicComponents ),
+ ( "ExistentialQuantification", Opt_ExistentialQuantification ),
+ ( "KindSignatures", Opt_KindSignatures ),
+ ( "PatternSignatures", Opt_PatternSignatures ),
+ ( "EmptyDataDecls", Opt_EmptyDataDecls ),
+ ( "ParallelListComp", Opt_ParallelListComp ),
+ ( "TransformListComp", Opt_TransformListComp ),
+ ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ),
+ ( "UnliftedFFITypes", Opt_UnliftedFFITypes ),
+ ( "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 ),
+ ( "RecordWildCards", Opt_RecordWildCards ),
+ ( "RecordPuns", Opt_RecordPuns ),
+ ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ),
+ ( "OverloadedStrings", Opt_OverloadedStrings ),
+ ( "GADTs", Opt_GADTs ),
+ ( "ViewPatterns", Opt_ViewPatterns),
+ ( "TypeFamilies", Opt_TypeFamilies ),
+ ( "BangPatterns", Opt_BangPatterns ),
+ -- On by default:
+ ( "MonomorphismRestriction", Opt_MonomorphismRestriction ),
+ -- On by default (which is not strictly H98):
+ ( "MonoPatBinds", Opt_MonoPatBinds ),
+ ( "RelaxedPolyRec", Opt_RelaxedPolyRec),
+ ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ),
+ ( "ImplicitParams", Opt_ImplicitParams ),
+ ( "ScopedTypeVariables", Opt_ScopedTypeVariables ),
+ ( "UnboxedTuples", Opt_UnboxedTuples ),
+ ( "StandaloneDeriving", Opt_StandaloneDeriving ),
+ ( "DeriveDataTypeable", Opt_DeriveDataTypeable ),
+ ( "TypeSynonymInstances", Opt_TypeSynonymInstances ),
+ ( "FlexibleContexts", Opt_FlexibleContexts ),
+ ( "FlexibleInstances", Opt_FlexibleInstances ),
+ ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ),
+ ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ),
+ ( "FunctionalDependencies", Opt_FunctionalDependencies ),
+ ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ),
+ ( "OverlappingInstances", Opt_OverlappingInstances ),
+ ( "UndecidableInstances", Opt_UndecidableInstances ),
+ ( "IncoherentInstances", Opt_IncoherentInstances )
+ ]
-glasgowExtsFlags = [
- Opt_GlasgowExts,
- Opt_FFI,
- Opt_ImplicitParams,
- Opt_ScopedTypeVariables,
- Opt_IndexedTypes ]
+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
+ ]
-isFFlag f = f `elem` (map fst fFlags)
-getFFlag f = fromJust (lookup f fFlags)
+glasgowExtsFlags :: [DynFlag]
+glasgowExtsFlags = [
+ Opt_PrintExplicitForalls
+ , Opt_ForeignFunctionInterface
+ , Opt_UnliftedFFITypes
+ , Opt_GADTs
+ , Opt_ImplicitParams
+ , Opt_ScopedTypeVariables
+ , Opt_UnboxedTuples
+ , Opt_TypeSynonymInstances
+ , Opt_StandaloneDeriving
+ , Opt_DeriveDataTypeable
+ , Opt_FlexibleContexts
+ , Opt_FlexibleInstances
+ , Opt_ConstrainedClassMethods
+ , Opt_MultiParamTypeClasses
+ , Opt_FunctionalDependencies
+ , Opt_MagicHash
+ , Opt_PolymorphicComponents
+ , Opt_ExistentialQuantification
+ , Opt_UnicodeSyntax
+ , Opt_PatternGuards
+ , Opt_LiberalTypeSynonyms
+ , Opt_RankNTypes
+ , Opt_ImpredicativeTypes
+ , Opt_TypeOperators
+ , Opt_RecursiveDo
+ , Opt_ParallelListComp
+ , Opt_EmptyDataDecls
+ , Opt_KindSignatures
+ , Opt_PatternSignatures
+ , Opt_GeneralizedNewtypeDeriving
+ , Opt_TypeFamilies ]
+
+------------------
+isFlag :: [(String,a)] -> String -> Bool
+isFlag flags f = any (\(ff,_) -> ff == f) flags
+
+isPrefFlag :: String -> [(String,a)] -> String -> Bool
+isPrefFlag pref flags no_f
+ | Just f <- maybePrefixMatch pref no_f = isFlag flags f
+ | otherwise = False
+
+------------------
+getFlag :: [(String,a)] -> String -> a
+getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
+ (o:_) -> o
+ [] -> panic ("get_flag " ++ f)
+
+getPrefFlag :: String -> [(String,a)] -> String -> a
+getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f))
+-- We should only be passed flags which match the prefix
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
dfs <- getCmdLineState
putCmdLineState $! (f dfs)
+--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> dopt_set dfs f)
+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)
+
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
setDumpFlag dump_flag
- = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag 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, hidePackage, ignorePackage :: String -> DynP ()
exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
hidePackage 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"))
where
pid = stringToPackageId p
--- we can only switch between HscC, and HscAsmm with dynamic flags
--- (-fvia-C, -fasm, -filx respectively).
-setTarget l = upd (\dfs -> case hscTarget dfs of
- HscC -> dfs{ hscTarget = l }
- HscAsm -> dfs{ hscTarget = l }
- _ -> dfs)
+-- 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
+ | ghcLink dfs /= LinkBinary || isObjectTarget l = dfs{ hscTarget = l }
+ | 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
+-- can be safely used in an OPTIONS_GHC pragma.
+setObjTarget :: HscTarget -> DynP ()
+setObjTarget l = upd set
+ where
+ set dfs
+ | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
+ | otherwise = dfs
setOptLevel :: Int -> DynFlags -> DynFlags
setOptLevel 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) }
+ | 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 main_mod }
+ = 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})
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)
-- finding the next split marker.
findNextPath xs =
case break (`elem` split_markers) xs of
- (p, d:ds) -> (p, ds)
+ (p, _:ds) -> (p, ds)
(p, xs) -> (p, xs)
split_markers :: [Char]
-- 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
-----------------------------------------------------------------------------
-- Via-C compilation stuff
+-- There are some options that we need to pass to gcc when compiling
+-- Haskell code via C, but are only supported by recent versions of
+-- gcc. The configure script decides which of these options we need,
+-- and puts them in the file "extra-gcc-opts" in $topdir, which is
+-- read before each via-C compilation. The advantage of having these
+-- in a separate file is that the file can be created at install-time
+-- depending on the available gcc version, and even re-generated later
+-- if gcc is upgraded.
+--
+-- 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 _dflags
#if alpha_TARGET_ARCH
= ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
--
-- -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
+ = let n_regs = stolen_x86_regs _dflags
sta = opt_Static
in
( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
--- , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else ""
+-- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
],
[ "-fno-defer-pop",
-#ifdef HAVE_GCC_MNO_OMIT_LFPTR
- -- Some gccs are configured with
- -- -momit-leaf-frame-pointer on by default, and it
- -- apparently takes precedence over
- -- -fomit-frame-pointer, so we disable it first here.
- "-mno-omit-leaf-frame-pointer",
-#endif
-#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME
- "-fno-unit-at-a-time",
- -- unit-at-a-time doesn't do us any good, and screws
- -- up -split-objs by moving the split markers around.
- -- It's only turned on with -O2, but put it here just
- -- in case someone uses -optc-O2.
-#endif
"-fomit-frame-pointer",
-- we want -fno-builtin, because when gcc inlines
-- built-in functions like memcpy() it tends to
-- and get in the way of -split-objs. Another option
-- would be to throw them away in the mangler, but this
-- is easier.
-#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME
- "-fno-unit-at-a-time",
- -- unit-at-a-time doesn't do us any good, and screws
- -- up -split-objs by moving the split markers around.
- -- It's only turned on with -O2, but put it here just
- -- in case someone uses -optc-O2.
-#endif
"-fno-builtin"
-- calling builtins like strlen() using the FFI can
-- cause gcc to run out of regs, so use the external
#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.
-- in dynamic libraries.
| opt_PIC
- = ["-fno-common"]
+ = ["-fno-common", "-D__PIC__"]
| otherwise
= ["-mdynamic-no-pic"]
#elif mingw32_TARGET_OS
-- no -fPIC for Windows
+ | opt_PIC
+ = ["-D__PIC__"]
+ | otherwise
= []
#else
| opt_PIC
- = ["-fPIC"]
+ = ["-fPIC", "-D__PIC__"]
| otherwise
= []
#endif
-- Splitting
can_split :: Bool
-can_split =
-#if defined(i386_TARGET_ARCH) \
- || defined(x86_64_TARGET_ARCH) \
- || defined(alpha_TARGET_ARCH) \
- || defined(hppa_TARGET_ARCH) \
- || defined(m68k_TARGET_ARCH) \
- || defined(mips_TARGET_ARCH) \
- || defined(powerpc_TARGET_ARCH) \
- || defined(rs6000_TARGET_ARCH) \
- || defined(sparc_TARGET_ARCH)
- True
-#else
- False
-#endif
+can_split = cSplitObjs == "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)]
projects / ghc-hetmet.git / blobdiff