------------------------------------------------------------------------------
---
+-- |
-- Dynamic flags
--
--- Most flags are dynamic flags, which means they can change from
--- compilation to compilation using OPTIONS_GHC pragmas, and in a
--- multi-session GHC each session can be using different dynamic
--- flags. Dynamic flags can also be set at the prompt in GHCi.
--
-- (c) The University of Glasgow 2005
--
------------------------------------------------------------------------------
+-- Most flags are dynamic flags, which means they can change from
+-- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a
+-- multi-session GHC each session can be using different dynamic
+-- flags. Dynamic flags can also be set at the prompt in GHCi.
module DynFlags (
- -- Dynamic flags
+ -- * Dynamic flags and associated configuration types
DynFlag(..),
DynFlags(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
Option(..),
DynLibLoader(..),
fFlags, xFlags,
- DPHBackend(..),
-
- -- Configuration of the core-to-core and stg-to-stg phases
- CoreToDo(..),
- StgToDo(..),
- SimplifierSwitch(..),
- SimplifierMode(..), FloatOutSwitches(..),
- getCoreToDo, getStgToDo,
+ dphPackage,
- -- Manipulating DynFlags
+ -- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
dopt, -- DynFlag -> DynFlags -> Bool
dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
- getOpts, -- (DynFlags -> [a]) -> IO [a]
+ getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlag,
+ getMainFun,
updOptLevel,
setTmpDir,
setPackageName,
- -- parsing DynFlags
+ -- ** Parsing DynFlags
parseDynamicFlags,
allFlags,
- -- misc stuff
+ supportedLanguages, languageOptions,
+
+ -- ** DynFlag C compiler options
machdepCCOpts, picCCOpts,
- supportedLanguages, languageOptions,
- compilerInfo,
+
+ -- * Configuration of the core-to-core passes
+ CoreToDo(..),
+ SimplifierMode(..),
+ SimplifierSwitch(..),
+ FloatOutSwitches(..),
+ getCoreToDo,
+
+ -- * Configuration of the stg-to-stg passes
+ StgToDo(..),
+ getStgToDo,
+
+ -- * Compiler configuration suitable for display to the user
+ compilerInfo
) where
#include "HsVersions.h"
import Module
import PackageConfig
-import PrelNames ( mAIN )
+import PrelNames ( mAIN, main_RDR_Unqual )
+import RdrName ( RdrName, mkRdrUnqual )
+import OccName ( mkVarOccFS )
#ifdef i386_TARGET_ARCH
import StaticFlags ( opt_Static )
#endif
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
-import Panic ( panic, GhcException(..) )
+import Panic
import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
-import SrcLoc ( SrcSpan )
+import SrcLoc
+import FastString
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.IORef ( readIORef )
-import Control.Exception ( throwDyn )
import Control.Monad ( when )
import Data.Char
-- -----------------------------------------------------------------------------
-- DynFlags
+-- | Enumerates the simple on-or-off dynamic flags
data DynFlag
-- debugging flags
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
+ | Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
-- language opts
| Opt_TemplateHaskell
| Opt_QuasiQuotes
| Opt_ImplicitParams
- | Opt_Generics
+ | Opt_Generics -- "Derivable type classes"
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
| Opt_UnboxedTuples
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
- | Opt_PatternSignatures
| Opt_ParallelListComp
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RankNTypes
| Opt_ImpredicativeTypes
| Opt_TypeOperators
+ | Opt_PackageImports
| Opt_PrintExplicitForalls
| Opt_UnboxStrictFields
| Opt_MethodSharing
| Opt_DictsCheap
- | Opt_RewriteRules
+ | Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_Vectorise
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
| Opt_AutoLinkPackages
+ | Opt_ImplicitImportQualified
-- keeping stuff
| Opt_KeepHiDiffs
deriving (Eq, Show)
+-- | Contains not only a collection of 'DynFlag's but also a plethora of
+-- information relating to the compilation of a single file or GHC session
data DynFlags = DynFlags {
ghcMode :: GhcMode,
ghcLink :: GhcLink,
coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile
stgToDo :: Maybe [StgToDo], -- similarly
hscTarget :: HscTarget,
- hscOutName :: String, -- name of the output file
- extCoreName :: String, -- name of the .core output file
- verbosity :: Int, -- verbosity level
- optLevel :: Int, -- optimisation level
- simplPhases :: Int, -- number of simplifier phases
- maxSimplIterations :: Int, -- max simplifier iterations
+ hscOutName :: String, -- ^ Name of the output file
+ extCoreName :: String, -- ^ Name of the .hcr output file
+ verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels"
+ 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
+ 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
+ cmdlineHcIncludes :: [String], -- ^ @\-\#includes@
importPaths :: [FilePath],
mainModIs :: Module,
mainFunIs :: Maybe String,
- ctxtStkDepth :: Int, -- Typechecker context stack depth
+ ctxtStkDepth :: Int, -- ^ Typechecker context stack depth
dphBackend :: DPHBackend,
- thisPackage :: PackageId,
+ thisPackage :: PackageId, -- ^ name of package currently being compiled
-- ways
- wayNames :: [WayName], -- way flags from the cmd line
- buildTag :: String, -- the global "way" (eg. "p" for prof)
- rtsBuildTag :: String, -- the RTS "way"
+ wayNames :: [WayName], -- ^ Way flags from the command line
+ buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof)
+ rtsBuildTag :: String, -- ^ The RTS \"way\"
-- paths etc.
objectDir :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
- -- | This is set by DriverPipeline.runPipeline based on where
+ -- | This is set by 'DriverPipeline.runPipeline' based on where
-- its output is going.
dumpPrefix :: Maybe FilePath,
- -- | Override the dumpPrefix set by runPipeline.
- -- Set by -ddump-file-prefix
+ -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
+ -- Set by @-ddump-file-prefix@
dumpPrefixForce :: Maybe FilePath,
includePaths :: [String],
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
- hpcDir :: String, -- ^ path to store the .mix files
+ hpcDir :: String, -- ^ Path to store the .mix files
-- options for particular phases
opt_L :: [String],
extraPkgConfs :: [FilePath],
topDir :: FilePath, -- filled in by SysTools
systemPackageConfig :: FilePath, -- ditto
- -- The -package-conf flags given on the command line, in the order
+ -- ^ The @-package-conf@ flags given on the command line, in the order
-- they appeared.
packageFlags :: [PackageFlag],
- -- The -package and -hide-package flags from the command-line
+ -- ^ The @-package@ and @-hide-package@ flags from the command-line
-- Package state
-- NB. do not modify this field, it is calculated by
-- hsc dynamic flags
flags :: [DynFlag],
- -- message output
+ -- | Message output action: use "ErrUtils" instead of this if you can
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
haddockOptions :: Maybe String
| HscNothing
deriving (Eq, Show)
--- | will this target result in an object file on the disk?
+-- | Will this target result in an object file on the disk?
isObjectTarget :: HscTarget -> Bool
isObjectTarget HscC = True
isObjectTarget HscAsm = True
-- imported modules, but in multi-module mode we look for source files
-- in order to check whether they need to be recompiled.
data GhcMode
- = CompManager -- ^ --make, GHCi, etc.
- | OneShot -- ^ ghc -c Foo.hs
- | MkDepend -- ^ ghc -M, see Finder for why we need this
+ = CompManager -- ^ @\-\-make@, GHCi, etc.
+ | OneShot -- ^ @ghc -c Foo.hs@
+ | MkDepend -- ^ @ghc -M@, see "Finder" for why we need this
deriving Eq
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
isOneShot _other = False
--- | What kind of linking to do.
-data GhcLink -- What to do in the link step, if there is one
- = NoLink -- Don't link at all
- | LinkBinary -- Link object code into a binary
- | LinkInMemory -- Use the in-memory dynamic linker
- | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
+-- | What to do in the link step, if there is one.
+data GhcLink
+ = NoLink -- ^ Don't link at all
+ | LinkBinary -- ^ Link object code into a binary
+ | LinkInMemory -- ^ Use the in-memory dynamic linker
+ | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
--- | the 'HscTarget' value corresponding to the default way to create
+-- | The 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
defaultObjectTarget :: HscTarget
defaultObjectTarget
| SystemDependent
deriving Eq
+-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
-- someday these will be dynamic flags
rtsBuildTag = rts_build_tag
}
+-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
+-- and must be fully initialized by 'GHC.newSession' first.
defaultDynFlags :: DynFlags
defaultDynFlags =
DynFlags {
ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath",
ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath",
topDir = panic "defaultDynFlags: No topDir",
- systemPackageConfig = panic "defaultDynFlags: No systemPackageConfig",
+ systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags",
pgm_L = panic "defaultDynFlags: No pgm_L",
pgm_P = panic "defaultDynFlags: No pgm_P",
pgm_F = panic "defaultDynFlags: No pgm_F",
}
{-
+ #verbosity_levels#
Verbosity levels:
0 | print errors & warnings only
5 | "ghc -v -ddump-all"
-}
+-- | Test whether a 'DynFlag' is set
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags)
+-- | Set a 'DynFlag'
dopt_set :: DynFlags -> DynFlag -> DynFlags
dopt_set dfs f = dfs{ flags = f : flags dfs }
+-- | Unset a 'DynFlag'
dopt_unset :: DynFlags -> DynFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
+-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
+getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
+ -> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors
+ -> [a] -- ^ Correctly ordered extracted options
getOpts dflags opts = reverse (opts dflags)
-- We add to the options from the front, so we need to reverse the list
+-- | Gets the verbosity flag for the current verbosity level. This is fed to
+-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
getVerbFlag :: DynFlags -> String
getVerbFlag dflags
| verbosity dflags >= 3 = "-v"
-- -----------------------------------------------------------------------------
-- Command-line options
--- When invoking external tools as part of the compilation pipeline, we
+-- | When invoking external tools as part of the compilation pipeline, we
-- pass these a sequence of options on the command-line. Rather than
-- just using a list of Strings, we use a type that allows us to distinguish
--- between filepaths and 'other stuff'. [The reason being, of course, that
+-- between filepaths and 'other stuff'. The reason for this is that
-- this type gives us a handle on transforming filenames, and filenames only,
--- to whatever format they're expected to be on a particular platform.]
-
+-- to whatever format they're expected to be on a particular platform.
data Option
= FileOption -- an entry that _contains_ filename(s) / filepaths.
String -- a non-filepath prefix that shouldn't be
-- Setting the optimisation level
updOptLevel :: Int -> DynFlags -> DynFlags
--- Set dynflags appropriate to the optimisation level
+-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
updOptLevel n dfs
= dfs2{ optLevel = final_n }
where
, ([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_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
+ -- in PrelRules
, ([1,2], Opt_DoEtaReduction)
, ([1,2], Opt_CaseMerge)
, ([1,2], Opt_Strictness)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
- , ([2], Opt_StaticArgumentTransformation)
+
+-- , ([2], Opt_StaticArgumentTransformation)
+-- Max writes: I think it's probably best not to enable SAT with -O2 for the
+-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
+-- several improvements to the heuristics, and I'm concerned that without
+-- those changes SAT will interfere with some attempts to write "high
+-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
+-- this year. In particular, the version in HEAD lacks the tail call
+-- criterion, so many things that look like reasonable loops will be
+-- turned into functions with extra (unneccesary) thunk creation.
, ([0,1,2], Opt_DoLambdaEtaExpansion)
-- This one is important for a tiresome reason:
standardWarnings
= [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
+ Opt_WarnUnrecognisedPragmas,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnIncompletePatternsRecUpd,
Opt_WarnSimplePatterns,
Opt_WarnMonomorphism,
+ Opt_WarnUnrecognisedPragmas,
Opt_WarnTabs
]
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
- | CoreDoVectorisation DPHBackend
+ | CoreDoVectorisation PackageId
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
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.
------ DPH flags ----------------------------------------------------
, Flag "fdph-seq"
- (NoArg (upd (setDPHBackend DPHSeq)))
+ (NoArg (setDPHBackend DPHSeq))
Supported
, Flag "fdph-par"
- (NoArg (upd (setDPHBackend DPHPar)))
+ (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
-mkFlag :: Bool -- True => turn it on, False => turn it off
- -> String
+mkFlag :: Bool -- ^ True <=> it should be turned on
+ -> String -- ^ The flag prefix
-> (DynFlag -> DynP ())
-> (String, DynFlag, Bool -> Deprecated)
-> Flag DynP
= Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
deprecatedForLanguage :: String -> Bool -> Deprecated
-deprecatedForLanguage lang turnOn =
- Deprecated ("Use the " ++ prefix ++ lang ++ " language instead")
- where prefix = if turnOn then "" else "No"
-
--- these -f<blah> flags can all be reversed with -fno-<blah>
+deprecatedForLanguage lang turn_on
+ = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+ where
+ flag | turn_on = lang
+ | otherwise = "No"++lang
+
+useInstead :: String -> Bool -> Deprecated
+useInstead flag turn_on
+ = Deprecated ("Use -f" ++ no ++ flag ++ " instead")
+ where
+ no = if turn_on then "" else "no-"
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fFlags :: [(String, DynFlag, Bool -> Deprecated)]
fFlags = [
( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ),
( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ),
( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ),
( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ),
+ ( "warn-deprecations", Opt_WarnWarningsDeprecations, const Supported ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ),
( "warn-orphans", Opt_WarnOrphans, const Supported ),
( "warn-tabs", Opt_WarnTabs, const Supported ),
+ ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ),
( "print-bind-result", Opt_PrintBindResult, const Supported ),
( "force-recomp", Opt_ForceRecomp, const Supported ),
( "hpc-no-auto", Opt_Hpc_No_Auto, const Supported ),
- ( "rewrite-rules", Opt_RewriteRules, const Supported ),
+ ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+ ( "enable-rewrite-rules", Opt_EnableRewriteRules, const Supported ),
( "break-on-exception", Opt_BreakOnException, const Supported ),
( "break-on-error", Opt_BreakOnError, const Supported ),
( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ),
( "allow-incoherent-instances", Opt_IncoherentInstances,
deprecatedForLanguage "IncoherentInstances" ),
( "gen-manifest", Opt_GenManifest, const Supported ),
- ( "embed-manifest", Opt_EmbedManifest, const Supported )
+ ( "embed-manifest", Opt_EmbedManifest, const Supported ),
+ ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported )
]
supportedLanguages :: [String]
languageOptions :: [DynFlag]
languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
--- These -X<blah> flags can all be reversed with -XNo<blah>
+-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags :: [(String, DynFlag, Bool -> Deprecated)]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
( "PolymorphicComponents", Opt_PolymorphicComponents, const Supported ),
( "ExistentialQuantification", Opt_ExistentialQuantification, const Supported ),
( "KindSignatures", Opt_KindSignatures, const Supported ),
- ( "PatternSignatures", Opt_PatternSignatures, const Supported ),
( "EmptyDataDecls", Opt_EmptyDataDecls, const Supported ),
( "ParallelListComp", Opt_ParallelListComp, const Supported ),
( "TransformListComp", Opt_TransformListComp, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
( "ImplicitParams", Opt_ImplicitParams, const Supported ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ),
+
+ ( "PatternSignatures", Opt_ScopedTypeVariables,
+ deprecatedForLanguage "ScopedTypeVariables" ),
+
( "UnboxedTuples", Opt_UnboxedTuples, const Supported ),
( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ),
( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ),
( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ),
( "OverlappingInstances", Opt_OverlappingInstances, const Supported ),
( "UndecidableInstances", Opt_UndecidableInstances, const Supported ),
- ( "IncoherentInstances", Opt_IncoherentInstances, const Supported )
+ ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ),
+ ( "PackageImports", Opt_PackageImports, const Supported )
]
-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
+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
]
glasgowExtsFlags :: [DynFlag]
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
- , Opt_PatternSignatures
, Opt_GeneralizedNewtypeDeriving
, Opt_TypeFamilies ]
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
-parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
+-- | Parse dynamic flags from a list of command line argument. Returns the
+-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
+-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
+-- flags or missing arguments).
+parseDynamicFlags :: Monad m =>
+ DynFlags -> [Located String]
+ -> m (DynFlags, [Located String], [Located String])
+ -- ^ Updated 'DynFlags', left-over arguments, and
+ -- list of warnings.
parseDynamicFlags dflags args = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep -f -optdepdepend
-- optdep -f -optdep depend
-- but the spaces trip up proper argument handling. So get rid of them.
- let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs
+ let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
f (x : xs) = x : f xs
f xs = xs
args' = f args
let ((leftover, errs, warns), dflags')
= runCmdLine (processArgs dynamic_flags args') dflags
- when (not (null errs)) $ do
- throwDyn (UsageError (unlines errs))
+ when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (dflags', leftover, warns)
type DynP = CmdLineP DynFlags
--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
+setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
+ ; mapM_ setDynFlag deps }
where
- deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
+ deps = [ d | (f', d) <- impliedFlags, f' == f ]
-- When you set f, set the ones it implies
+ -- NB: use setDynFlag recursively, in case the implied flags
+ -- implies further flags
-- When you un-set f, however, we don't un-set the things it implies
-- (except for -fno-glasgow-exts, which is treated specially)
setPackageName :: String -> DynFlags -> DynFlags
setPackageName p
| Nothing <- unpackPackageId pid
- = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
+ = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
| otherwise
= \s -> s{ thisPackage = pid }
where
-- -fdicts-cheap always inline dictionaries
-- -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
--
setDPHOpt :: DynFlags -> DynFlags
setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
, specConstrThreshold = Nothing
+ , specConstrCount = Nothing
})
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
data DPHBackend = DPHPar
| DPHSeq
+ | DPHThis
+ deriving(Eq, Ord, Enum, Show)
+
+setDPHBackend :: DPHBackend -> DynP ()
+setDPHBackend backend
+ = do
+ upd $ \dflags -> dflags { dphBackend = backend }
+ mapM_ exposePackage (dph_packages backend)
+ where
+ dph_packages DPHThis = []
+ dph_packages DPHPar = ["dph-prim-par", "dph-par"]
+ dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"]
-setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
-setDPHBackend backend dflags = dflags { dphBackend = backend }
-
+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
projects / ghc-hetmet.git / blobdiff