-
-- |
-- Dynamic flags
--
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
- Option(..),
+ Option(..), showOpt,
DynLibLoader(..),
fFlags, xFlags,
- DPHBackend(..),
+ dphPackage,
+ wayNames,
-- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlag,
- getMainFun,
updOptLevel,
setTmpDir,
setPackageName,
+ doingTickyProfiling,
-- ** Parsing DynFlags
parseDynamicFlags,
+ parseDynamicNoPackageFlags,
allFlags,
supportedLanguages, languageOptions,
getStgToDo,
-- * Compiler configuration suitable for display to the user
+ Printable(..),
compilerInfo
) where
#include "HsVersions.h"
+#ifndef OMIT_NATIVE_CODEGEN
+import Platform
+#endif
import Module
import PackageConfig
-import PrelNames ( mAIN, main_RDR_Unqual )
-import RdrName ( RdrName, mkRdrUnqual )
-import OccName ( mkVarOccFS )
-#ifdef i386_TARGET_ARCH
-import StaticFlags ( opt_Static )
-#endif
-import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
- v_RTS_Build_tag )
+import PrelNames ( mAIN )
+import StaticFlags
import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic
-import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
import SrcLoc
import FastString
+import FiniteMap
+import BasicTypes ( CompilerPhase )
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
-import Data.IORef ( readIORef )
+import Data.IORef
import Control.Monad ( when )
import Data.Char
+import Data.List
import System.FilePath
import System.IO ( stderr, hPutChar )
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
| Opt_D_dump_asm_stats
+ | Opt_D_dump_asm_expanded
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_BCOs
| Opt_D_dump_vect
| Opt_D_dump_hpc
+ | Opt_D_dump_rtti
| Opt_D_source_stats
| Opt_D_verbose_core2core
| Opt_D_verbose_stg2stg
| Opt_WarnUnusedMatches
| Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
+ | Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
| Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
+ | Opt_WarnLazyUnliftedBindings
+ | Opt_WarnUnusedDoBind
+ | Opt_WarnWrongDoBind
+
-- language opts
| Opt_OverlappingInstances
| Opt_IncoherentInstances
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
+ | Opt_MonoLocalBinds
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
| Opt_ForeignFunctionInterface
| Opt_UnliftedFFITypes
+ | Opt_GHCForeignImportPrim
| Opt_PArr -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax
| Opt_TemplateHaskell
| Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
+ | Opt_NPlusKPatterns
+
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
+ | Opt_DeriveFunctor
+ | Opt_DeriveTraversable
+ | Opt_DeriveFoldable
+
| Opt_TypeSynonymInstances
| Opt_FlexibleContexts
| Opt_FlexibleInstances
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
+ | Opt_DoRec
| Opt_PostfixOperators
+ | Opt_TupleSections
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
+ | Opt_NewQualifiedOperators
+ | Opt_ExplicitForAll
+ | Opt_AlternativeLayoutRule
| Opt_PrintExplicitForalls
-- optimisation opts
| Opt_Strictness
| Opt_FullLaziness
+ | Opt_FloatIn
+ | Opt_Specialise
| Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
- | Opt_IgnoreInterfacePragmas
- | Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
+ -- Interface files
+ | Opt_IgnoreInterfacePragmas
+ | Opt_OmitInterfacePragmas
+ | Opt_ExposeAllUnfoldings
+
+ -- profiling opts
+ | Opt_AutoSccsOnAllToplevs
+ | Opt_AutoSccsOnExportedToplevs
+ | Opt_AutoSccsOnIndividualCafs
+
-- misc opts
| Opt_Cpp
| Opt_Pp
| Opt_DryRun
| Opt_DoAsmMangling
| Opt_ExcessPrecision
+ | Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
| Opt_SplitObjs
| Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
+ | Opt_EmitExternalCore
+ | Opt_SharedImplib
+ | Opt_BuildingCabalPackage
+
+ -- temporary flags
+ | Opt_RunCPS
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
| Opt_ImplicitImportQualified
+ | Opt_TryNewCodeGen
-- keeping stuff
| Opt_KeepHiDiffs
| Opt_KeepSFiles
| Opt_KeepRawSFiles
| Opt_KeepTmpFiles
+ | Opt_KeepRawTokenStream
deriving (Eq, Show)
hscTarget :: HscTarget,
hscOutName :: String, -- ^ Name of the output file
extCoreName :: String, -- ^ Name of the .hcr output file
- verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels"
+ verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level
simplPhases :: Int, -- ^ Number of simplifier phases
maxSimplIterations :: Int, -- ^ Max simplifier iterations
shouldDumpSimplPhase :: SimplifierMode -> Bool,
ruleCheck :: Maybe String,
+ strictnessBefore :: [Int], -- ^ Additional demand analysis
specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase
+#ifndef OMIT_NATIVE_CODEGEN
+ targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG.
+#endif
stolen_x86_regs :: Int,
cmdlineHcIncludes :: [String], -- ^ @\-\#includes@
importPaths :: [FilePath],
thisPackage :: PackageId, -- ^ name of package currently being compiled
-- ways
- wayNames :: [WayName], -- ^ Way flags from the command line
+ ways :: [Way], -- ^ Way flags from the command line
buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof)
rtsBuildTag :: String, -- ^ The RTS \"way\"
+ -- For object splitting
+ splitInfo :: Maybe (String,Int),
+
-- paths etc.
objectDir :: Maybe String,
+ dylibInstallName :: Maybe String,
hiDir :: Maybe String,
stubDir :: Maybe String,
depIncludePkgDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
- depWarnings :: Bool,
-- Package flags
extraPkgConfs :: [FilePath],
-- Package state
-- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM PackageConfig),
+ pkgDatabase :: Maybe [PackageConfig],
pkgState :: PackageState,
+ -- Temporary files
+ -- These have to be IORefs, because the defaultCleanupHandler needs to
+ -- know what to clean when an exception happens
+ filesToClean :: IORef [FilePath],
+ dirsToClean :: IORef (FiniteMap FilePath FilePath),
+
-- hsc dynamic flags
flags :: [DynFlag],
haddockOptions :: Maybe String
}
+wayNames :: DynFlags -> [WayName]
+wayNames = map wayName . ways
+
+-- | The target code type of the compilation (if any).
+--
+-- Whenever you change the target, also make sure to set 'ghcLink' to
+-- something sensible.
+--
+-- 'HscNothing' can be used to avoid generating any output, however, note
+-- that:
+--
+-- * This will not run the desugaring step, thus no warnings generated in
+-- this step will be output. In particular, this includes warnings related
+-- to pattern matching. You can run the desugarer manually using
+-- 'GHC.desugarModule'.
+--
+-- * If a program uses Template Haskell the typechecker may try to run code
+-- from an imported module. This will fail if no code has been generated
+-- for this module. You can use 'GHC.needsTemplateHaskell' to detect
+-- whether this might be the case and choose to either switch to a
+-- different target or avoid typechecking such modules. (The latter may
+-- preferable for security reasons.)
+--
data HscTarget
- = HscC
- | HscAsm
- | HscJava
- | HscInterpreted
- | HscNothing
+ = HscC -- ^ Generate C code.
+ | HscAsm -- ^ Generate assembly using the native code generator.
+ | HscJava -- ^ Generate Java bytecode.
+ | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory')
+ | HscNothing -- ^ Don't generate any code. See notes above.
deriving (Eq, Show)
-- | Will this target result in an object file on the disk?
| MkDepend -- ^ @ghc -M@, see "Finder" for why we need this
deriving Eq
+instance Outputable GhcMode where
+ ppr CompManager = ptext (sLit "CompManager")
+ ppr OneShot = ptext (sLit "OneShot")
+ ppr MkDepend = ptext (sLit "MkDepend")
+
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
isOneShot _other = False
data GhcLink
= NoLink -- ^ Don't link at all
| LinkBinary -- ^ Link object code into a binary
- | LinkInMemory -- ^ Use the in-memory dynamic linker
+ | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both
+ -- bytecode and object code).
| LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
deriving (Eq, Show)
isNoLink NoLink = True
isNoLink _ = False
+-- Is it worth evaluating this Bool and caching it in the DynFlags value
+-- during initDynFlags?
+doingTickyProfiling :: DynFlags -> Bool
+doingTickyProfiling _ = opt_Ticky
+ -- XXX -ticky is a static flag, because it implies -debug which is also
+ -- static. If the way flags were made dynamic, we could fix this.
+
data PackageFlag
= ExposePackage String
+ | ExposePackageId String
| HidePackage String
| IgnorePackage String
deriving Eq
initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
- build_tag <- readIORef v_Build_tag
- rts_build_tag <- readIORef v_RTS_Build_tag
+ refFilesToClean <- newIORef []
+ refDirsToClean <- newIORef emptyFM
return dflags{
- wayNames = ways,
- buildTag = build_tag,
- rtsBuildTag = rts_build_tag
+ ways = ways,
+ buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
+ rtsBuildTag = mkBuildTag ways,
+ filesToClean = refFilesToClean,
+ dirsToClean = refDirsToClean
}
-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
specConstrThreshold = Just 200,
specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
+ strictnessBefore = [],
+
+#ifndef OMIT_NATIVE_CODEGEN
+ targetPlatform = defaultTargetPlatform,
+#endif
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
importPaths = ["."],
thisPackage = mainPackageId,
objectDir = Nothing,
+ dylibInstallName = Nothing,
hiDir = Nothing,
stubDir = Nothing,
outputFile = Nothing,
outputHi = Nothing,
- dynLibLoader = Deployable,
+ dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
includePaths = [],
opt_L = [],
opt_P = (if opt_PIC
- then ["-D__PIC__"]
+ then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
else []),
opt_F = [],
opt_c = [],
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- wayNames = panic "defaultDynFlags: No wayNames",
+ ways = panic "defaultDynFlags: No ways",
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
+ splitInfo = Nothing,
-- initSysTools fills all these in
ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath",
ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath",
depIncludePkgDeps = False,
depExcludeMods = [],
depSuffixes = [],
- depWarnings = True,
-- end of ghc -M values
+ filesToClean = panic "defaultDynFlags: No filesToClean",
+ dirsToClean = panic "defaultDynFlags: No dirsToClean",
haddockOptions = Nothing,
flags = [
Opt_AutoLinkPackages,
Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
+ Opt_NPlusKPatterns,
Opt_MethodSharing,
Opt_DoAsmMangling,
+ Opt_SharedImplib,
+
Opt_GenManifest,
Opt_EmbedManifest,
Opt_PrintBindContents
}
{-
- #verbosity_levels#
- Verbosity levels:
-
+Note [Verbosity levels]
+~~~~~~~~~~~~~~~~~~~~~~~
0 | print errors & warnings only
1 | minimal verbosity: print "compiling M ... done." for each module.
2 | equivalent to -dshow-passes
| verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
+ setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
addCmdlineFramework, addHaddockOpts
setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-- \#included from the .hc file when compiling with -fvia-C.
+setOutputDir f = setObjectDir f . setHiDir f . setStubDir f
+setDylibInstallName f d = d{ dylibInstallName = Just f}
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing }
("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) }
- (_,_) -> error "Unknown dynlib loader"
+ _ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
setDumpPrefixForce f d = d { dumpPrefixForce = f}
addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
-setDepWarnings :: Bool -> DynFlags -> DynFlags
-setDepWarnings b d = d { depWarnings = b }
-
-- XXX Legacy code:
-- We used to use "-optdep-flag -optdeparg", so for legacy applications
-- we need to strip the "-optdep" off of the arg
deOptDep :: String -> String
-deOptDep x = case maybePrefixMatch "-optdep" x of
+deOptDep x = case stripPrefix "-optdep" x of
Just rest -> rest
Nothing -> x
String -- the filepath/filename portion
| Option String
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s) = s
+
-----------------------------------------------------------------------------
-- Setting the optimisation level
, ([1,2], Opt_Strictness)
, ([1,2], Opt_CSE)
, ([1,2], Opt_FullLaziness)
+ , ([1,2], Opt_Specialise)
+ , ([1,2], Opt_FloatIn)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnDuplicateExports,
- Opt_WarnDodgyForeignImports
+ Opt_WarnLazyUnliftedBindings,
+ Opt_WarnDodgyForeignImports,
+ Opt_WarnWrongDoBind
]
minusWOpts :: [DynFlag]
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
+ Opt_WarnDodgyExports,
Opt_WarnDodgyImports
]
Opt_WarnNameShadowing,
Opt_WarnMissingSigs,
Opt_WarnHiShadows,
- Opt_WarnOrphans
+ Opt_WarnOrphans,
+ Opt_WarnUnusedDoBind
]
-- minuswRemovesOpts should be every warning option
| CoreDoOldStrictness
| CoreDoGlomBinds
| CoreCSE
- | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
- -- matching this string
- | CoreDoVectorisation DPHBackend
+ | CoreDoRuleCheck CompilerPhase String -- Check for non-application of rules
+ -- matching this string
+ | CoreDoVectorisation PackageId
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
+
data SimplifierMode -- See comments in SimplMonad
= SimplGently
- | SimplPhase Int [String]
+ { sm_rules :: Bool -- Whether RULES are enabled
+ , sm_inline :: Bool } -- Whether inlining is enabled
+
+ | SimplPhase
+ { sm_num :: Int -- Phase number; counts downward so 0 is last phase
+ , sm_names :: [String] } -- Name(s) of the phase
+
+instance Outputable SimplifierMode where
+ ppr (SimplPhase { sm_num = n, sm_names = ss })
+ = int n <+> brackets (text (concat $ intersperse "," ss))
+ ppr (SimplGently { sm_rules = r, sm_inline = i })
+ = ptext (sLit "gentle") <>
+ brackets (pp_flag r (sLit "rules") <> comma <>
+ pp_flag i (sLit "inline"))
+ where
+ pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s
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
+data FloatOutSwitches = FloatOutSwitches {
+ floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level
+ floatOutConstants :: Bool -- ^ True <=> float constants to top level,
+ -- even if they do not escape a lambda
+ }
+
+instance Outputable FloatOutSwitches where
+ ppr = pprFloatOutSwitches
+
+pprFloatOutSwitches :: FloatOutSwitches -> SDoc
+pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
+ <+> pp_not (floatOutConstants sw) <+> text "constants"
+ where
+ pp_not True = empty
+ pp_not False = text "not"
+
+-- | Switches that specify the minimum amount of floating out
+-- gentleFloatOutSwitches :: FloatOutSwitches
+-- gentleFloatOutSwitches = FloatOutSwitches False False
+
+-- | Switches that do not specify floating out of lambdas, just of constants
+constantsOnlyFloatOutSwitches :: FloatOutSwitches
+constantsOnlyFloatOutSwitches = FloatOutSwitches False True
-- The core-to-core pass ordering is derived from the DynFlags:
max_iter = maxSimplIterations dflags
strictness = dopt Opt_Strictness dflags
full_laziness = dopt Opt_FullLaziness dflags
+ do_specialise = dopt Opt_Specialise dflags
+ do_float_in = dopt Opt_FloatIn dflags
cse = dopt Opt_CSE dflags
spec_constr = dopt Opt_SpecConstr dflags
liberate_case = dopt Opt_LiberateCase dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
+ maybe_strictness_before phase
+ = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
+
simpl_phase phase names iter
= CoreDoPasses
- [ CoreDoSimplify (SimplPhase phase names) [
+ [ maybe_strictness_before phase,
+ CoreDoSimplify (SimplPhase phase names) [
MaxSimplifierIterations iter
],
maybe_rule_check phase
vectorisation
= runWhen (dopt Opt_Vectorise dflags)
- $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+ $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ]
-- By default, we have 2 phases before phase 0.
-- initial simplify: mk specialiser happy: minimum effort please
- simpl_gently = CoreDoSimplify SimplGently [
+ simpl_gently = CoreDoSimplify
+ (SimplGently { sm_rules = True, sm_inline = False })
+ [
-- Simplify "gently"
-- Don't inline anything till full laziness has bitten
-- In particular, inlining wrappers inhibits floating
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
- CoreDoSpecialising,
+ runWhen do_specialise CoreDoSpecialising,
- runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
+ runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
+ -- Was: gentleFloatOutSwitches
+ -- I have no idea why, but not floating constants to top level is
+ -- very bad in some cases.
+ -- Notably: p_ident in spectral/rewrite
+ -- Changing from "gentle" to "constantsOnly" improved
+ -- rewrite's allocation by 19%, and made 0.0% difference
+ -- to any other nofib benchmark
- CoreDoFloatInwards,
+ runWhen do_float_in CoreDoFloatInwards,
simpl_phases,
-- Don't stop now!
simpl_phase 0 ["main"] (max max_iter 3),
-
-#ifdef OLD_STRICTNESS
- CoreDoOldStrictness,
-#endif
runWhen strictness (CoreDoPasses [
CoreDoStrictness,
CoreDoWorkerWrapper,
]),
runWhen full_laziness
- (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas
- True)), -- Float constants
+ (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
-- nofib/spectral/hartel/wang doubles in speed if you
-- do full laziness late in the day. It only happens
-- after fusion and other stuff, so the early pass doesn't
-- 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,
+ runWhen do_float_in CoreDoFloatInwards,
maybe_rule_check 0,
Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported
, Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported
, Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported
- , Flag "#include" (HasArg (addCmdlineHCInclude)) Supported
+ , Flag "#include" (HasArg (addCmdlineHCInclude))
+ (Deprecated "No longer has any effect")
, Flag "v" (OptIntSuffix setVerbosity) Supported
------- Specific phases --------------------------------------------
, Flag "dep-makefile" (HasArg (upd . setDepMakefile)) Supported
, Flag "optdep-f" (HasArg (upd . setDepMakefile))
(Deprecated "Use -dep-makefile instead")
- , Flag "optdep-w" (NoArg (upd (setDepWarnings False)))
+ , Flag "optdep-w" (NoArg (return ()))
(Deprecated "-optdep-w doesn't do anything")
, Flag "include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported
, Flag "optdep--include-prelude" (NoArg (upd (setDepIncludePkgDeps True)))
Supported
, Flag "dynload" (HasArg (upd . parseDynLibLoaderMode))
Supported
+ , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath ) Supported
, Flag "hidir" (HasArg (upd . setHiDir)) Supported
, Flag "tmpdir" (HasArg (upd . setTmpDir)) Supported
, Flag "stubdir" (HasArg (upd . setStubDir)) Supported
+ , Flag "outputdir" (HasArg (upd . setOutputDir)) Supported
, Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just))
Supported
, Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp))
(Deprecated "Use -fforce-recomp instead")
- ------- Packages ----------------------------------------------------
- , Flag "package-conf" (HasArg extraPkgConf_) Supported
- , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
- Supported
- , Flag "package-name" (HasArg (upd . setPackageName)) Supported
- , Flag "package" (HasArg exposePackage) Supported
- , Flag "hide-package" (HasArg hidePackage) Supported
- , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
- Supported
- , Flag "ignore-package" (HasArg ignorePackage)
- Supported
- , Flag "syslib" (HasArg exposePackage)
- (Deprecated "Use -package instead")
-
------ HsCpp opts ---------------------------------------------------
, Flag "D" (AnySuffix (upd . addOptP)) Supported
, Flag "U" (AnySuffix (upd . addOptP)) Supported
Supported
, Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
Supported
+ , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
+ Supported
, Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
Supported
, Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
Supported
, Flag "dsource-stats" (setDumpFlag Opt_D_source_stats)
Supported
- , Flag "dverbose-core2core" (NoArg setVerboseCore2Core)
+ , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2)
+ ; setVerboseCore2Core }))
Supported
, Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
Supported
Supported
, Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
Supported
+ , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
+ Supported
, Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting))
Supported
, Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting))
Supported
, Flag "dshow-passes"
- (NoArg (do setDynFlag Opt_ForceRecomp
+ (NoArg (do forceRecompile
setVerbosity (Just 2)))
Supported
, Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats))
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
Supported
+ , Flag "fstrictness-before"
+ (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs })))
+ Supported
+
+ ------ Profiling ----------------------------------------------------
+
+ -- XXX Should the -f* flags be deprecated?
+ -- They don't seem to be documented
+ , Flag "fauto-sccs-on-all-toplevs"
+ (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "auto-all"
+ (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "no-auto-all"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "fauto-sccs-on-exported-toplevs"
+ (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "auto"
+ (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "no-auto"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "fauto-sccs-on-individual-cafs"
+ (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+ , Flag "caf-all"
+ (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+ , Flag "no-caf-all"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+
------ DPH flags ----------------------------------------------------
, Flag "fdph-seq"
, Flag "fdph-par"
(NoArg (setDPHBackend DPHPar))
Supported
+ , Flag "fdph-this"
+ (NoArg (setDPHBackend DPHThis))
+ Supported
------ Compiler flags -----------------------------------------------
++ map (mkFlag True "X" setDynFlag ) xFlags
++ map (mkFlag False "XNo" unSetDynFlag) xFlags
+package_flags :: [Flag DynP]
+package_flags = [
+ ------- Packages ----------------------------------------------------
+ Flag "package-conf" (HasArg extraPkgConf_) Supported
+ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+ Supported
+ , Flag "package-name" (HasArg (upd . setPackageName)) Supported
+ , Flag "package-id" (HasArg exposePackageId) Supported
+ , Flag "package" (HasArg exposePackage) Supported
+ , Flag "hide-package" (HasArg hidePackage) Supported
+ , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
+ Supported
+ , Flag "ignore-package" (HasArg ignorePackage)
+ Supported
+ , Flag "syslib" (HasArg exposePackage)
+ (Deprecated "Use -package instead")
+ ]
+
mkFlag :: Bool -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
-> (DynFlag -> DynP ())
deprecatedForLanguage :: String -> Bool -> Deprecated
deprecatedForLanguage lang turn_on
- = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+ = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where
flag | turn_on = lang
| otherwise = "No"++lang
fFlags :: [(String, DynFlag, Bool -> Deprecated)]
fFlags = [
( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ),
+ ( "warn-dodgy-exports", Opt_WarnDodgyExports, const Supported ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ),
( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ),
( "warn-orphans", Opt_WarnOrphans, const Supported ),
( "warn-tabs", Opt_WarnTabs, const Supported ),
( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ),
+ ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings,
+ const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+ ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ),
+ ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
+ ( "specialise", Opt_Specialise, const Supported ),
+ ( "float-in", Opt_FloatIn, const Supported ),
( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ),
( "full-laziness", Opt_FullLaziness, const Supported ),
( "liberate-case", Opt_LiberateCase, const Supported ),
( "cse", Opt_CSE, const Supported ),
( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ),
( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ),
+ ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, const Supported ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ),
( "ignore-asserts", Opt_IgnoreAsserts, const Supported ),
( "do-eta-reduction", Opt_DoEtaReduction, const Supported ),
( "method-sharing", Opt_MethodSharing, const Supported ),
( "dicts-cheap", Opt_DictsCheap, const Supported ),
( "excess-precision", Opt_ExcessPrecision, const Supported ),
+ ( "eager-blackholing", Opt_EagerBlackHoling, const Supported ),
( "asm-mangling", Opt_DoAsmMangling, const Supported ),
( "print-bind-result", Opt_PrintBindResult, const Supported ),
( "force-recomp", Opt_ForceRecomp, const Supported ),
( "break-on-error", Opt_BreakOnError, const Supported ),
( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ),
( "print-bind-contents", Opt_PrintBindContents, const Supported ),
- ( "run-cps", Opt_RunCPSZ, const Supported ),
+ ( "run-cps", Opt_RunCPS, const Supported ),
+ ( "run-cpsz", Opt_RunCPSZ, const Supported ),
+ ( "new-codegen", Opt_TryNewCodeGen, const Supported ),
( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, const Supported ),
( "vectorise", Opt_Vectorise, const Supported ),
( "regs-graph", Opt_RegsGraph, const Supported ),
deprecatedForLanguage "IncoherentInstances" ),
( "gen-manifest", Opt_GenManifest, const Supported ),
( "embed-manifest", Opt_EmbedManifest, const Supported ),
+ ( "ext-core", Opt_EmitExternalCore, const Supported ),
+ ( "shared-implib", Opt_SharedImplib, const Supported ),
+ ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported )
]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PostfixOperators", Opt_PostfixOperators, const Supported ),
+ ( "TupleSections", Opt_TupleSections, const Supported ),
( "PatternGuards", Opt_PatternGuards, const Supported ),
( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ),
( "MagicHash", Opt_MagicHash, const Supported ),
( "TransformListComp", Opt_TransformListComp, const Supported ),
( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ),
( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ),
+ ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, const Supported ),
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ),
( "Rank2Types", Opt_Rank2Types, const Supported ),
( "RankNTypes", Opt_RankNTypes, const Supported ),
- ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes,
+ const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
( "TypeOperators", Opt_TypeOperators, const Supported ),
- ( "RecursiveDo", Opt_RecursiveDo, const Supported ),
+ ( "RecursiveDo", Opt_RecursiveDo,
+ deprecatedForLanguage "DoRec"),
+ ( "DoRec", Opt_DoRec, const Supported ),
( "Arrows", Opt_Arrows, const Supported ),
( "PArr", Opt_PArr, const Supported ),
( "TemplateHaskell", Opt_TemplateHaskell, const Supported ),
( "BangPatterns", Opt_BangPatterns, const Supported ),
-- On by default:
( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ),
+ -- On by default:
+ ( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ),
-- On by default (which is not strictly H98):
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
+ ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ),
+ ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ),
+ ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
( "ImplicitParams", Opt_ImplicitParams, const Supported ),
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ),
+ ( "DeriveFunctor", Opt_DeriveFunctor, const Supported ),
+ ( "DeriveTraversable", Opt_DeriveTraversable, const Supported ),
+ ( "DeriveFoldable", Opt_DeriveFoldable, const Supported ),
( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ),
( "FlexibleContexts", Opt_FlexibleContexts, const Supported ),
( "FlexibleInstances", Opt_FlexibleInstances, const Supported ),
( "OverlappingInstances", Opt_OverlappingInstances, const Supported ),
( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
( "IncoherentInstances", Opt_IncoherentInstances, const Supported ),
- ( "PackageImports", Opt_PackageImports, const Supported )
+ ( "PackageImports", Opt_PackageImports, const Supported ),
+ ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported )
]
impliedFlags :: [(DynFlag, DynFlag)]
impliedFlags
- = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to
+ = [ (Opt_RankNTypes, Opt_ExplicitForAll)
+ , (Opt_Rank2Types, Opt_ExplicitForAll)
+ , (Opt_ScopedTypeVariables, Opt_ExplicitForAll)
+ , (Opt_LiberalTypeSynonyms, Opt_ExplicitForAll)
+ , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
+ , (Opt_PolymorphicComponents, Opt_ExplicitForAll)
+
+ , (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to
-- be completely rigid for GADTs
+ , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- Trac #2944 gives a nice example
+ , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures
+ -- all over the place
+
, (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see
-- Note [Scoped tyvars] in TcBinds
+ , (Opt_ImpredicativeTypes, Opt_RankNTypes)
+
+ -- Record wild-cards implies field disambiguation
+ -- Otherwise if you write (C {..}) you may well get
+ -- stuff like " 'a' not in scope ", which is a bit silly
+ -- if the compiler has just filled in field 'a' of constructor 'C'
+ , (Opt_RecordWildCards, Opt_DisambiguateRecordFields)
]
glasgowExtsFlags :: [DynFlag]
, Opt_TypeSynonymInstances
, Opt_StandaloneDeriving
, Opt_DeriveDataTypeable
+ , Opt_DeriveFunctor
+ , Opt_DeriveFoldable
+ , Opt_DeriveTraversable
, Opt_FlexibleContexts
, Opt_FlexibleInstances
, Opt_ConstrainedClassMethods
, Opt_PatternGuards
, Opt_LiberalTypeSynonyms
, Opt_RankNTypes
- , Opt_ImpredicativeTypes
, Opt_TypeOperators
- , Opt_RecursiveDo
+ , Opt_DoRec
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
--- | Parse dynamic flags from a list of command line argument. Returns the
+-- | Parse dynamic flags from a list of command line arguments. Returns the
-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
-- flags or missing arguments).
-> m (DynFlags, [Located String], [Located String])
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
-parseDynamicFlags dflags args = do
+parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
+
+-- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
+-- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
+parseDynamicNoPackageFlags :: Monad m =>
+ DynFlags -> [Located String]
+ -> m (DynFlags, [Located String], [Located String])
+ -- ^ Updated 'DynFlags', left-over arguments, and
+ -- list of warnings.
+parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
+
+parseDynamicFlags_ :: Monad m =>
+ DynFlags -> [Located String] -> Bool
+ -> m (DynFlags, [Located String], [Located String])
+parseDynamicFlags_ dflags0 args pkg_flags = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
f (x : xs) = x : f xs
f xs = xs
args' = f args
- let ((leftover, errs, warns), dflags')
- = runCmdLine (processArgs dynamic_flags args') dflags
+
+ -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
+ flag_spec | pkg_flags = package_flags ++ dynamic_flags
+ | otherwise = dynamic_flags
+
+ let ((leftover, errs, warns), dflags1)
+ = runCmdLine (processArgs flag_spec args') dflags0
when (not (null errs)) $ ghcError $ errorsToGhcException errs
- return (dflags', leftover, warns)
+
+ -- Cannot use -fPIC with registerised -fvia-C, because the mangler
+ -- isn't up to the job. We know that if hscTarget == HscC, then the
+ -- user has explicitly used -fvia-C, because -fasm is the default,
+ -- unless there is no NCG on this platform. The latter case is
+ -- checked when the -fPIC flag is parsed.
+ --
+ let (pic_warns, dflags2) =
+ if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
+ then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
+ dflags1{ hscTarget = HscAsm })
+ else ([], dflags1)
+
+ return (dflags2, leftover, pic_warns ++ warns)
type DynP = CmdLineP DynFlags
--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
setDumpFlag dump_flag
- | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
- | otherwise = NoArg (setDynFlag dump_flag)
+ = NoArg (do { setDynFlag dump_flag
+ ; when want_recomp forceRecompile })
where
- -- Whenver we -ddump, switch off the recompilation checker,
- -- else you don't see the dump!
- -- However, certain dumpy-things are really interested in what's going
+ -- Certain dumpy-things are really interested in what's going
-- on during recompilation checking, so in those cases we
-- don't want to turn it off.
- force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
- Opt_D_dump_hi_diffs]
+ want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
+ Opt_D_dump_hi_diffs]
+
+forceRecompile :: DynP ()
+-- Whenver we -ddump, force recompilation (by switching off the
+-- recompilation checker), else you don't see the dump! However,
+-- don't switch it off in --make mode, else *everything* gets
+-- recompiled which probably isn't what you want
+forceRecompile = do { dfs <- getCmdLineState
+ ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
+ where
+ force_recomp dfs = isOneShot (ghcMode dfs)
setVerboseCore2Core :: DynP ()
-setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
- setDynFlag Opt_D_verbose_core2core
+setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core
+ forceRecompile
upd (\s -> s { shouldDumpSimplPhase = const True })
setDumpSimplPhases :: String -> DynP ()
-setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+setDumpSimplPhases s = do forceRecompile
upd (\s -> s { shouldDumpSimplPhase = spec })
where
spec :: SimplifierMode -> Bool
phase_num _ _ = False
phase_name :: String -> SimplifierMode -> Bool
- phase_name s SimplGently = s == "gentle"
- phase_name s (SimplPhase _ ss) = s `elem` ss
+ phase_name s (SimplGently {}) = s == "gentle"
+ phase_name s (SimplPhase { sm_names = ss }) = s `elem` ss
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
extraPkgConf_ :: FilePath -> DynP ()
extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
-exposePackage, hidePackage, ignorePackage :: String -> DynP ()
+exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()
exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
+exposePackageId p =
+ upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
ignorePackage p =
upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p
- | Nothing <- unpackPackageId pid
- = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
- | otherwise
- = \s -> s{ thisPackage = pid }
- where
- pid = stringToPackageId p
+setPackageName p s = s{ thisPackage = stringToPackageId p }
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
-- sometimes
-- -fdicts-cheap always inline dictionaries
-- -fmax-simplifier-iterations20 this is necessary sometimes
+-- -fsimplifier-phases=3 we use an additional simplifier phase
+-- for fusion
-- -fno-spec-constr-threshold run SpecConstr even for big loops
-- -fno-spec-constr-count SpecConstr as much as possible
+-- -finline-enough-args hack to prevent excessive inlining
--
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
+ , simplPhases = 3
, specConstrThreshold = Nothing
, specConstrCount = Nothing
})
data DPHBackend = DPHPar
| DPHSeq
+ | DPHThis
+ deriving(Eq, Ord, Enum, Show)
setDPHBackend :: DPHBackend -> DynP ()
setDPHBackend backend
= do
upd $ \dflags -> dflags { dphBackend = backend }
- exposePackage $ "dph-prim-" ++ suffix backend
- exposePackage $ "dph-" ++ suffix backend
+ mapM_ exposePackage (dph_packages backend)
where
- suffix DPHPar = "par"
- suffix DPHSeq = "seq"
+ dph_packages DPHThis = []
+ dph_packages DPHPar = ["dph-prim-par", "dph-par"]
+ dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"]
+
+dphPackage :: DynFlags -> PackageId
+dphPackage dflags = case dphBackend dflags of
+ DPHPar -> dphParPackageId
+ DPHSeq -> dphSeqPackageId
+ DPHThis -> thisPackage dflags
setMainIs :: String -> DynP ()
setMainIs arg
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
--- | Get the unqualified name of the function to use as the \"main\" for the main module.
--- Either returns the default name or the one configured on the command line with -main-is
-getMainFun :: DynFlags -> RdrName
-getMainFun dflags = case (mainFunIs dflags) of
- Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
- Nothing -> main_RDR_Unqual
-
-----------------------------------------------------------------------------
-- Paths & Libraries
-- -fomit-frame-pointer : *must* in .hc files; because we're stealing
-- the fp (%ebp) for our register maps.
= let n_regs = stolen_x86_regs _dflags
- sta = opt_Static
in
- ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
+ (
+#if darwin_TARGET_OS
+ -- By default, gcc on OS X will generate SSE
+ -- instructions, which need things 16-byte aligned,
+ -- but we don't 16-byte align things. Thus drop
+ -- back to generic i686 compatibility. Trac #2983.
+ --
+ -- Since Snow Leopard (10.6), gcc defaults to x86_64.
+ ["-march=i686", "-m32"],
+#else
+ [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
],
+#endif
[ "-fno-defer-pop",
"-fomit-frame-pointer",
-- we want -fno-builtin, because when gcc inlines
= ( [], ["-fomit-frame-pointer", "-G0"] )
#elif x86_64_TARGET_ARCH
- = ( [], ["-fomit-frame-pointer",
+ = (
+#if darwin_TARGET_OS
+ ["-m64"],
+#else
+ [],
+#endif
+ ["-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
-- in dynamic libraries.
| opt_PIC
- = ["-fno-common", "-D__PIC__"]
+ = ["-fno-common", "-U __PIC__","-D__PIC__"]
| otherwise
= ["-mdynamic-no-pic"]
#elif mingw32_TARGET_OS
-- no -fPIC for Windows
| opt_PIC
- = ["-D__PIC__"]
+ = ["-U __PIC__","-D__PIC__"]
| otherwise
= []
#else
- | opt_PIC
- = ["-fPIC", "-D__PIC__"]
+ | opt_PIC || not opt_Static
+ = ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise
= []
#endif
-- -----------------------------------------------------------------------------
-- Compiler Info
-compilerInfo :: [(String, String)]
-compilerInfo = [("Project name", cProjectName),
- ("Project version", cProjectVersion),
- ("Booter version", cBooterVersion),
- ("Stage", cStage),
- ("Interface file version", cHscIfaceFileVersion),
- ("Have interpreter", cGhcWithInterpreter),
- ("Object splitting", cSplitObjs),
- ("Have native code generator", cGhcWithNativeCodeGen),
- ("Support SMP", cGhcWithSMP),
- ("Unregisterised", cGhcUnregisterised),
- ("Tables next to code", cGhcEnableTablesNextToCode),
- ("Win32 DLLs", cEnableWin32DLLs),
- ("RTS ways", cGhcRTSWays),
- ("Leading underscore", cLeadingUnderscore),
- ("Debug on", show debugIsOn)
+data Printable = String String
+ | FromDynFlags (DynFlags -> String)
+
+compilerInfo :: [(String, Printable)]
+compilerInfo = [("Project name", String cProjectName),
+ ("Project version", String cProjectVersion),
+ ("Booter version", String cBooterVersion),
+ ("Stage", String cStage),
+ ("Have interpreter", String cGhcWithInterpreter),
+ ("Object splitting", String cSplitObjs),
+ ("Have native code generator", String cGhcWithNativeCodeGen),
+ ("Support SMP", String cGhcWithSMP),
+ ("Unregisterised", String cGhcUnregisterised),
+ ("Tables next to code", String cGhcEnableTablesNextToCode),
+ ("Win32 DLLs", String cEnableWin32DLLs),
+ ("RTS ways", String cGhcRTSWays),
+ ("Leading underscore", String cLeadingUnderscore),
+ ("Debug on", String (show debugIsOn)),
+ ("LibDir", FromDynFlags topDir)
]