\begin{code}
module CmdLineOpts (
- CoreToDo(..),
- SimplifierSwitch(..), isAmongSimpl,
- StgToDo(..),
- SwitchResult(..),
+ CoreToDo(..), StgToDo(..),
+ SimplifierSwitch(..),
+ SimplifierMode(..),
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags(..),
- defaultDynFlags,
v_Static_hsc_opts,
- intSwitchSet,
- switchIsOn,
isStaticHscFlag,
- opt_PprStyle_NoPrags,
- opt_PprStyle_RawTypes,
- opt_PprUserLength,
- opt_PprStyle_Debug,
-
- dopt,
- dopt_set,
- dopt_unset,
-
- -- 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
import Config
import Maybes ( firstJust )
-import Panic ( panic )
-
-#if __GLASGOW_HASKELL__ < 301
-import ArrBase ( Array(..) )
-#else
-import PrelArr ( Array(..) )
-#endif
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-data SwitchResult
- = SwBool Bool -- on/off
- | SwString FAST_STRING -- nothing or a String
- | SwInt Int -- nothing or an Int
-\end{code}
-
-\begin{code}
data CoreToDo -- These are diff core-to-core passes,
-- which may be invoked in any order,
-- as many times as you like.
= CoreDoSimplify -- The core-to-core simplifier.
- (SimplifierSwitch -> SwitchResult)
+ SimplifierMode
+ [SimplifierSwitch]
-- Each run of the simplifier can take a different
-- set of simplifier-specific flags.
| CoreDoFloatInwards
| CoreDoCPResult
| CoreDoGlomBinds
| CoreCSE
+ | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
+ -- matching this string
| CoreDoNothing -- useful when building up lists of these things
\end{code}
\end{code}
\begin{code}
+data SimplifierMode -- See comments in SimplMonad
+ = SimplGently
+ | SimplPhase Int
+
data SimplifierSwitch
= MaxSimplifierIterations Int
- | SimplInlinePhase Int
- | DontApplyRules
| NoCaseOfCase
- | SimplLetToCase
\end{code}
%************************************************************************
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
| Opt_D_dump_spec
- | Opt_D_dump_sat
+ | Opt_D_dump_prep
| Opt_D_dump_stg
| Opt_D_dump_stranal
| Opt_D_dump_tc
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,
opt_c :: [String],
opt_a :: [String],
opt_m :: [String],
+#ifdef ILX
+ opt_I :: [String],
+ opt_i :: [String],
+#endif
-- hsc dynamic flags
flags :: [DynFlag]
}
+data HscLang
+ = HscC
+ | HscAsm
+ | HscJava
+ | HscILX
+ | HscInterpreted
+ | HscNothing
+ deriving (Eq, Show)
+
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
hscLang = HscC,
hscOutName = "",
hscStubHOutName = "", hscStubCOutName = "",
+ extCoreName = "",
verbosity = 0,
cppFlag = False,
stolen_x86_regs = 4,
opt_c = [],
opt_a = [],
opt_m = [],
+#ifdef ILX
+ opt_I = [],
+ opt_i = [],
+#endif
flags = standardWarnings,
}
dopt_OutName :: DynFlags -> String
dopt_OutName = hscOutName
+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}
-data HscLang
- = HscC
- | HscAsm
- | HscJava
-#ifdef ILX
- | HscILX
-#endif
- | HscInterpreted
- deriving (Eq, Show)
+-----------------------------------------------------------------------------
+-- Mess about with the mutable variables holding the dynamic arguments
-dopt_HscLang :: DynFlags -> HscLang
-dopt_HscLang = hscLang
+-- 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_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
- Opt_WarnDuplicateExports,
- Opt_WarnMisc
+ Opt_WarnDuplicateExports
]
minusWOpts
[ 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",
+ "frule-check"
]
|| any (flip prefixMatch f) [
"fcontext-stack",
"fliberate-case-threshold",
+ "fmax-worker-args",
"fhistory-size",
"funfolding-creation-threshold",
"funfolding-use-threshold",
%************************************************************************
%* *
-\subsection{Switch ordering}
-%* *
-%************************************************************************
-
-These things behave just like enumeration types.
-
-\begin{code}
-instance Eq SimplifierSwitch where
- a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
-
-instance Ord SimplifierSwitch where
- a < b = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
- a <= b = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
-
-
-tagOf_SimplSwitch (SimplInlinePhase _) = _ILIT(1)
-tagOf_SimplSwitch (MaxSimplifierIterations _) = _ILIT(2)
-tagOf_SimplSwitch DontApplyRules = _ILIT(3)
-tagOf_SimplSwitch SimplLetToCase = _ILIT(4)
-tagOf_SimplSwitch NoCaseOfCase = _ILIT(5)
-
--- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
-
-lAST_SIMPL_SWITCH_TAG = 5
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Switch lookup}
-%* *
-%************************************************************************
-
-\begin{code}
-isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
- -- in the list; defaults right at the end.
- = let
- tidied_on_switches = foldl rm_dups [] on_switches
- -- The fold*l* ensures that we keep the latest switches;
- -- ie the ones that occur earliest in the list.
-
- sw_tbl :: Array Int SwitchResult
- sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
- all_undefined)
- // defined_elems
-
- all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
-
- defined_elems = map mk_assoc_elem tidied_on_switches
- in
- -- (avoid some unboxing, bounds checking, and other horrible things:)
-#if __GLASGOW_HASKELL__ < 405
- case sw_tbl of { Array bounds_who_needs_'em stuff ->
-#else
- case sw_tbl of { Array _ _ stuff ->
-#endif
- \ switch ->
- case (indexArray# stuff (tagOf_SimplSwitch switch)) of
-#if __GLASGOW_HASKELL__ < 400
- Lift v -> v
-#elif __GLASGOW_HASKELL__ < 403
- (# _, v #) -> v
-#else
- (# v #) -> v
-#endif
- }
- where
- mk_assoc_elem k@(MaxSimplifierIterations lvl)
- = (iBox (tagOf_SimplSwitch k), SwInt lvl)
- mk_assoc_elem k@(SimplInlinePhase n)
- = (iBox (tagOf_SimplSwitch k), SwInt n)
- mk_assoc_elem k
- = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-
- -- cannot have duplicates if we are going to use the array thing
- rm_dups switches_so_far switch
- = if switch `is_elem` switches_so_far
- then switches_so_far
- else switch : switches_so_far
- where
- sw `is_elem` [] = False
- sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
- || sw `is_elem` ss
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection{Misc functions for command-line options}
%* *
%************************************************************************
-\begin{code}
-switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
-
-switchIsOn lookup_fn switch
- = case (lookup_fn switch) of
- SwBool False -> False
- _ -> True
-
-intSwitchSet :: (switch -> SwitchResult)
- -> (Int -> switch)
- -> Maybe Int
-
-intSwitchSet lookup_fn switch
- = case (lookup_fn (switch (panic "intSwitchSet"))) of
- SwInt int -> Just int
- _ -> Nothing
-\end{code}
\begin{code}
startsWith :: String -> String -> Maybe String