HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags(..),
- defaultDynFlags,
v_Static_hsc_opts,
switchIsOn,
isStaticHscFlag,
- opt_PprStyle_NoPrags,
- opt_PprStyle_RawTypes,
- opt_PprUserLength,
- opt_PprStyle_Debug,
-
- dopt,
-
- -- other dynamic flags
- dopt_CoreToDo,
- dopt_StgToDo,
- dopt_HscLang,
- dopt_OutName,
+ -- Manipulating DynFlags
+ defaultDynFlags, -- DynFlags
+ dopt, -- DynFlag -> DynFlags -> Bool
+ dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
+ dopt_CoreToDo, -- DynFlags -> [CoreToDo]
+ dopt_StgToDo, -- DynFlags -> [StgToDo]
+ dopt_HscLang, -- DynFlags -> HscLang
+ dopt_OutName, -- DynFlags -> String
+
+ -- Manipulating the DynFlags state
+ getDynFlags, -- IO DynFlags
+ setDynFlags, -- DynFlags -> IO ()
+ updDynFlags, -- (DynFlags -> DynFlags) -> IO ()
+ dynFlag, -- (DynFlags -> a) -> IO a
+ setDynFlag, unSetDynFlag, -- DynFlag -> IO ()
+ saveDynFlags, -- IO ()
+ restoreDynFlags, -- IO DynFlags
-- sets of warning opts
standardWarnings,
minusWOpts,
minusWallOpts,
+ -- Output style options
+ opt_PprStyle_NoPrags,
+ opt_PprStyle_RawTypes,
+ opt_PprUserLength,
+ opt_PprStyle_Debug,
+
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs,
opt_Parallel,
opt_SMP,
opt_NoMonomorphismRestriction,
- opt_KeepStgTypes,
+ opt_RuntimeTypes,
-- optimisation opts
opt_NoMethodSharing,
opt_SimplDoLambdaEtaExpansion,
opt_SimplCaseMerge,
opt_SimplExcessPrecision,
+ opt_MaxWorkerArgs,
-- Unfolding control
opt_UF_CreationThreshold,
opt_NoPruneTyDecls,
opt_NoPruneDecls,
opt_Static,
- opt_Unregisterised
+ opt_Unregisterised,
+ opt_EmitExternalCore
) where
#include "HsVersions.h"
import Array ( array, (//) )
import GlaExts
-import IOExts ( IORef, readIORef )
+import IOExts ( IORef, readIORef, writeIORef )
import Constants -- Default values for some flags
import Util
import FastTypes
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
+ | Opt_WarnMisc
-- language opts
| Opt_AllowOverlappingInstances
hscOutName :: String, -- name of the output file
hscStubHOutName :: String, -- name of the .stub_h output file
hscStubCOutName :: String, -- name of the .stub_c output file
+ extCoreName :: String, -- name of the .core output file
verbosity :: Int, -- verbosity level
cppFlag :: Bool, -- preprocess with cpp?
stolen_x86_regs :: Int,
flags :: [DynFlag]
}
+data HscLang
+ = HscC
+ | HscAsm
+ | HscJava
+ | HscILX
+ | HscInterpreted
+ deriving (Eq, Show)
+
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
hscLang = HscC,
hscOutName = "",
hscStubHOutName = "", hscStubCOutName = "",
+ extCoreName = "",
verbosity = 0,
cppFlag = False,
stolen_x86_regs = 4,
dopt_OutName :: DynFlags -> String
dopt_OutName = hscOutName
-data HscLang
- = HscC
- | HscAsm
- | HscJava
-#ifdef ILX
- | HscILX
-#endif
- | HscInterpreted
- deriving (Eq, Show)
-
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
+
+dopt_set :: DynFlags -> DynFlag -> DynFlags
+dopt_set dfs f = dfs{ flags = f : flags dfs }
+
+dopt_unset :: DynFlags -> DynFlag -> DynFlags
+dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
\end{code}
+-----------------------------------------------------------------------------
+-- Mess about with the mutable variables holding the dynamic arguments
+
+-- v_InitDynFlags
+-- is the "baseline" dynamic flags, initialised from
+-- the defaults and command line options, and updated by the
+-- ':s' command in GHCi.
+--
+-- v_DynFlags
+-- is the dynamic flags for the current compilation. It is reset
+-- to the value of v_InitDynFlags before each compilation, then
+-- updated by reading any OPTIONS pragma in the current module.
+
+\begin{code}
+GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
+GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
+
+setDynFlags :: DynFlags -> IO ()
+setDynFlags dfs = writeIORef v_DynFlags dfs
+
+saveDynFlags :: IO ()
+saveDynFlags = do dfs <- readIORef v_DynFlags
+ writeIORef v_InitDynFlags dfs
+
+restoreDynFlags :: IO DynFlags
+restoreDynFlags = do dfs <- readIORef v_InitDynFlags
+ writeIORef v_DynFlags dfs
+ return dfs
+
+getDynFlags :: IO DynFlags
+getDynFlags = readIORef v_DynFlags
+
+updDynFlags :: (DynFlags -> DynFlags) -> IO ()
+updDynFlags f = do dfs <- readIORef v_DynFlags
+ writeIORef v_DynFlags (f dfs)
+
+dynFlag :: (DynFlags -> a) -> IO a
+dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
+
+setDynFlag, unSetDynFlag :: DynFlag -> IO ()
+setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f)
+unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
+\end{code}
+
+
%************************************************************************
%* *
\subsection{Warnings}
[ Opt_WarnUnusedBinds,
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
- Opt_WarnIncompletePatterns
+ Opt_WarnIncompletePatterns,
+ Opt_WarnMisc
]
minusWallOpts
opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")
+opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
{-
The optional '-inpackage=P' flag tells what package
opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check")
opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
-opt_KeepStgTypes = lookUp SLIT("-fkeep-stg-types")
+opt_RuntimeTypes = lookUp SLIT("-fruntime-types")
-- Simplifier switches
opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining")
opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls")
opt_Static = lookUp SLIT("-static")
opt_Unregisterised = lookUp SLIT("-funregisterised")
+opt_EmitExternalCore = lookUp SLIT("-fext-core")
\end{code}
%************************************************************************
"fno-method-sharing",
"fno-monomorphism-restriction",
"fomit-interface-pragmas",
- "fkeep-stg-types",
+ "fruntime-types",
"fno-pre-inlining",
"fdo-eta-reduction",
"fdo-lambda-eta-expansion",
"fno-prune-decls",
"fno-prune-tydecls",
"static",
- "funregisterised"
+ "funregisterised",
+ "fext-core"
]
|| any (flip prefixMatch f) [
"fcontext-stack",
"fliberate-case-threshold",
+ "fmax-worker-args",
"fhistory-size",
"funfolding-creation-threshold",
"funfolding-use-threshold",
projects / ghc-hetmet.git / blobdiff