-- ** Parsing DynFlags
parseDynamicFlags,
+ parseDynamicNoPackageFlags,
allFlags,
supportedLanguages, languageOptions,
import Control.Monad ( when )
import Data.Char
+import Data.List ( intersperse )
import System.FilePath
import System.IO ( stderr, hPutChar )
| Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PackageImports
+ | Opt_NewQualifiedOperators
| Opt_PrintExplicitForalls
| Opt_UnboxStrictFields
| Opt_MethodSharing
| Opt_DictsCheap
+ | Opt_InlineIfEnoughArgs
| Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_Vectorise
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
+ -- 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
+
+ -- temporary flags
+ | Opt_RunCPS
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
| Opt_ImplicitImportQualified
+ | Opt_TryNewCodeGen
-- keeping stuff
| Opt_KeepHiDiffs
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,
hiDir :: Maybe String,
depIncludePkgDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
- depWarnings :: Bool,
-- Package flags
extraPkgConfs :: [FilePath],
haddockOptions :: Maybe String
}
+-- | 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?
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)
opt_L = [],
opt_P = (if opt_PIC
- then ["-D__PIC__"]
+ then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
else []),
opt_F = [],
opt_c = [],
wayNames = panic "defaultDynFlags: No wayNames",
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
haddockOptions = Nothing,
flags = [
| verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+setObjectDir, setHiDir, setStubDir, setOutputDir,
+ setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
addCmdlineFramework, addHaddockOpts
setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-- \#included from the .hc file when compiling with -fvia-C.
+setOutputDir f = setObjectDir f . setHiDir f . setStubDir f
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
("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
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
+
data SimplifierMode -- See comments in SimplMonad
= SimplGently
| SimplPhase Int [String]
+instance Outputable SimplifierMode where
+ ppr SimplGently = ptext (sLit "gentle")
+ ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss))
+
+
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:
-- so that overloaded functions have all their dictionary lambdas manifest
CoreDoSpecialising,
- runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
+ runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches),
CoreDoFloatInwards,
]),
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
, 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)))
, 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
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
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"
++ map (mkFlag True "X" setDynFlag ) xFlags
++ map (mkFlag False "XNo" unSetDynFlag) xFlags
+package_flags :: [Flag DynP]
+package_flags = [
+ ------- Packages ----------------------------------------------------
+ Flag "package-conf" (HasArg extraPkgConf_) Supported
+ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+ Supported
+ , Flag "package-name" (HasArg (upd . setPackageName)) Supported
+ , Flag "package" (HasArg exposePackage) Supported
+ , Flag "hide-package" (HasArg hidePackage) Supported
+ , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
+ Supported
+ , Flag "ignore-package" (HasArg ignorePackage)
+ Supported
+ , Flag "syslib" (HasArg exposePackage)
+ (Deprecated "Use -package instead")
+ ]
+
mkFlag :: Bool -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
-> (DynFlag -> DynP ())
( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ),
( "method-sharing", Opt_MethodSharing, const Supported ),
( "dicts-cheap", Opt_DictsCheap, const Supported ),
+ ( "inline-if-enough-args", Opt_InlineIfEnoughArgs, const Supported ),
( "excess-precision", Opt_ExcessPrecision, const Supported ),
+ ( "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 ),
( "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)]
-- -----------------------------------------------------------------------------
-- 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_ dflags 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
+
+ -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
+ flag_spec | pkg_flags = package_flags ++ dynamic_flags
+ | otherwise = dynamic_flags
+
let ((leftover, errs, warns), dflags')
- = runCmdLine (processArgs dynamic_flags args') dflags
+ = runCmdLine (processArgs flag_spec args') dflags
when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (dflags', leftover, warns)
-- -fmax-simplifier-iterations20 this is necessary sometimes
-- -fno-spec-constr-threshold run SpecConstr even for big loops
-- -fno-spec-constr-count SpecConstr as much as possible
+-- -finline-enough-args hack to prevent excessive inlining
--
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
})
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
+ `dopt_set` Opt_InlineIfEnoughArgs
data DPHBackend = DPHPar
| DPHSeq
-- 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__"]
+ = ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise
= []
#endif
projects / ghc-hetmet.git / blobdiff