Commit 86f6acdc authored by ian@well-typed.com's avatar ian@well-typed.com

Rename DynFlag to GeneralFlag

This avoids confusion due to [DynFlag] and DynFlags being completely
different types.
parent 5cd52bfd
......@@ -184,7 +184,7 @@ runUniqSM m = do
return (initUs_ us m)
dumpGraph :: DynFlags -> DynFlag -> String -> CmmGraph -> IO ()
dumpGraph :: DynFlags -> GeneralFlag -> String -> CmmGraph -> IO ()
dumpGraph dflags flag name g = do
when (dopt Opt_DoCmmLinting dflags) $ do_lint g
dumpWith dflags flag name g
......@@ -195,7 +195,7 @@ dumpGraph dflags flag name g = do
}
Nothing -> return ()
dumpWith :: Outputable a => DynFlags -> DynFlag -> String -> a -> IO ()
dumpWith :: Outputable a => DynFlags -> GeneralFlag -> String -> a -> IO ()
dumpWith dflags flag txt g = do
-- ToDo: No easy way of say "dump all the cmmz, *and* split
-- them into files." Also, -ddump-cmmz doesn't play nicely
......
......@@ -34,7 +34,7 @@ import TyCon ( isRecursiveTyCon, isClassTyCon )
import Coercion
import BasicTypes
import Unique
import DynFlags ( DynFlags, DynFlag(..), dopt )
import DynFlags ( DynFlags, GeneralFlag(..), dopt )
import Outputable
import FastString
import Pair
......
......@@ -76,7 +76,7 @@ import Unique
import UniqSupply
import Maybes
import ErrUtils
import DynFlags ( DynFlags, DynFlag(..) )
import DynFlags ( DynFlags, GeneralFlag(..) )
import BasicTypes ( isAlwaysActive )
import Util
import Pair
......
......@@ -224,7 +224,7 @@ pprTypeAndContents id = do
--------------------------------------------------------------
-- Utils
traceOptIf :: GhcMonad m => DynFlag -> SDoc -> m ()
traceOptIf :: GhcMonad m => GeneralFlag -> SDoc -> m ()
traceOptIf flag doc = do
dflags <- GHC.getSessionDynFlags
when (dopt flag dflags) $ liftIO $ printInfoForUser dflags alwaysQualify doc
......@@ -13,7 +13,7 @@
module DynFlags (
-- * Dynamic flags and associated configuration types
DynFlag(..),
GeneralFlag(..),
WarningFlag(..),
ExtensionFlag(..),
Language(..),
......@@ -96,7 +96,7 @@ module DynFlags (
supportedLanguagesAndExtensions,
-- ** DynFlag C compiler options
-- ** DynFlags C compiler options
picCCOpts, picPOpts,
-- * Configuration of the stg-to-stg passes
......@@ -170,7 +170,7 @@ import qualified Data.IntSet as IntSet
-- DynFlags
-- | Enumerates the simple on-or-off dynamic flags
data DynFlag
data GeneralFlag
-- debugging flags
= Opt_D_dump_cmm
......@@ -536,7 +536,7 @@ data ExtensionFlag
| Opt_TypeHoles
deriving (Eq, Enum, Show)
-- | Contains not only a collection of 'DynFlag's but also a plethora of
-- | Contains not only a collection of 'GeneralFlag's but also a plethora of
-- information relating to the compilation of a single file or GHC session
data DynFlags = DynFlags {
ghcMode :: GhcMode,
......@@ -1024,10 +1024,10 @@ wayDesc WayPar = "Parallel"
wayDesc WayGran = "GranSim"
wayDesc WayNDP = "Nested data parallelism"
wayDynFlags :: Platform -> Way -> [DynFlag]
wayDynFlags _ WayThreaded = []
wayDynFlags _ WayDebug = []
wayDynFlags platform WayDyn =
wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
wayGeneralFlags _ WayThreaded = []
wayGeneralFlags _ WayDebug = []
wayGeneralFlags platform WayDyn =
case platformOS platform of
-- On Windows, code that is to be linked into a dynamic
-- library must be compiled with -fPIC. Labels not in
......@@ -1037,11 +1037,11 @@ wayDynFlags platform WayDyn =
OSDarwin -> [Opt_PIC]
OSLinux -> [Opt_PIC]
_ -> []
wayDynFlags _ WayProf = [Opt_SccProfilingOn]
wayDynFlags _ WayEventLog = []
wayDynFlags _ WayPar = [Opt_Parallel]
wayDynFlags _ WayGran = [Opt_GranMacros]
wayDynFlags _ WayNDP = []
wayGeneralFlags _ WayProf = [Opt_SccProfilingOn]
wayGeneralFlags _ WayEventLog = []
wayGeneralFlags _ WayPar = [Opt_Parallel]
wayGeneralFlags _ WayGran = [Opt_GranMacros]
wayGeneralFlags _ WayNDP = []
wayExtras :: Platform -> Way -> DynP ()
wayExtras _ WayThreaded = return ()
......@@ -1354,16 +1354,16 @@ languageExtensions (Just Haskell2010)
Opt_DoAndIfThenElse,
Opt_RelaxedPolyRec]
-- | Test whether a 'DynFlag' is set
dopt :: DynFlag -> DynFlags -> Bool
-- | Test whether a 'GeneralFlag' is set
dopt :: GeneralFlag -> DynFlags -> Bool
dopt f dflags = fromEnum f `IntSet.member` flags dflags
-- | Set a 'DynFlag'
dopt_set :: DynFlags -> DynFlag -> DynFlags
-- | Set a 'GeneralFlag'
dopt_set :: DynFlags -> GeneralFlag -> DynFlags
dopt_set dfs f = dfs{ flags = IntSet.insert (fromEnum f) (flags dfs) }
-- | Unset a 'DynFlag'
dopt_unset :: DynFlags -> DynFlag -> DynFlags
-- | Unset a 'GeneralFlag'
dopt_unset :: DynFlags -> GeneralFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = IntSet.delete (fromEnum f) (flags dfs) }
-- | Test whether a 'WarningFlag' is set
......@@ -2270,12 +2270,12 @@ fWarningFlags = [
( "warn-inline-rule-shadowing", Opt_WarnInlineRuleShadowing, nop ) ]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
negatableFlags :: [FlagSpec DynFlag]
negatableFlags :: [FlagSpec GeneralFlag]
negatableFlags = [
( "ignore-dot-ghci", Opt_IgnoreDotGhci, nop ) ]
-- | These @-d\<blah\>@ flags can all be reversed with @-dno-\<blah\>@
dFlags :: [FlagSpec DynFlag]
dFlags :: [FlagSpec GeneralFlag]
dFlags = [
( "suppress-coercions", Opt_SuppressCoercions, nop),
( "suppress-var-kinds", Opt_SuppressVarKinds, nop),
......@@ -2287,7 +2287,7 @@ dFlags = [
( "ppr-case-as-let", Opt_PprCaseAsLet, nop)]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fFlags :: [FlagSpec DynFlag]
fFlags :: [FlagSpec GeneralFlag]
fFlags = [
( "error-spans", Opt_ErrorSpans, nop ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ),
......@@ -2513,7 +2513,7 @@ xFlags = [
( "TypeHoles", Opt_TypeHoles, nop )
]
defaultFlags :: Settings -> [DynFlag]
defaultFlags :: Settings -> [GeneralFlag]
defaultFlags settings
= [ Opt_AutoLinkPackages,
......@@ -2543,7 +2543,7 @@ defaultFlags settings
_ -> [])
++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
then wayDynFlags platform WayDyn
then wayGeneralFlags platform WayDyn
else [Opt_Static])
where platform = sTargetPlatform settings
......@@ -2589,7 +2589,7 @@ impliedFlags
, (Opt_ImplicitParams, turnOn, Opt_FlexibleInstances)
]
optLevelFlags :: [([Int], DynFlag)]
optLevelFlags :: [([Int], GeneralFlag)]
optLevelFlags
= [ ([0], Opt_IgnoreInterfacePragmas)
, ([0], Opt_OmitInterfacePragmas)
......@@ -2807,7 +2807,7 @@ optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
-> OptKind (CmdLineP DynFlags)
optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag :: GeneralFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
--------------------------
......@@ -2816,13 +2816,13 @@ addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
dfs <- liftEwM getCmdLineState
let platform = targetPlatform dfs
wayExtras platform w
mapM_ setDynFlag $ wayDynFlags platform w
mapM_ setDynFlag $ wayGeneralFlags platform w
removeWay :: Way -> DynP ()
removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
setDynFlag, unSetDynFlag :: GeneralFlag -> DynP ()
setDynFlag f = upd (\dfs -> dopt_set dfs f)
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
......@@ -2852,7 +2852,7 @@ alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
alterSettings f dflags = dflags { settings = f (settings dflags) }
--------------------------
setDumpFlag' :: DynFlag -> DynP ()
setDumpFlag' :: GeneralFlag -> DynP ()
setDumpFlag' dump_flag
= do setDynFlag dump_flag
when want_recomp forceRecompile
......
......@@ -193,7 +193,7 @@ doIfSet :: Bool -> IO () -> IO ()
doIfSet flag action | flag = action
| otherwise = return ()
doIfSet_dyn :: DynFlags -> DynFlag -> IO () -> IO()
doIfSet_dyn :: DynFlags -> GeneralFlag -> IO () -> IO()
doIfSet_dyn dflags flag action | dopt flag dflags = action
| otherwise = return ()
......@@ -205,7 +205,7 @@ dumpIfSet dflags flag hdr doc
| not flag = return ()
| otherwise = log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (mkDumpDoc hdr doc)
dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpIfSet_dyn :: DynFlags -> GeneralFlag -> String -> SDoc -> IO ()
dumpIfSet_dyn dflags flag hdr doc
| dopt flag dflags || verbosity dflags >= 4
= dumpSDoc dflags flag hdr doc
......@@ -228,9 +228,9 @@ mkDumpDoc hdr doc
--
-- When hdr is empty, we print in a more compact format (no separators and
-- blank lines)
dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpSDoc dflags dflag hdr doc
= do let mFile = chooseDumpFile dflags dflag
dumpSDoc :: DynFlags -> GeneralFlag -> String -> SDoc -> IO ()
dumpSDoc dflags flag hdr doc
= do let mFile = chooseDumpFile dflags flag
case mFile of
-- write the dump to a file
-- don't add the header in this case, we can see what kind
......@@ -261,12 +261,12 @@ dumpSDoc dflags dflag hdr doc
-- | Choose where to put a dump file based on DynFlags
--
chooseDumpFile :: DynFlags -> DynFlag -> Maybe String
chooseDumpFile dflags dflag
chooseDumpFile :: DynFlags -> GeneralFlag -> Maybe String
chooseDumpFile dflags flag
| dopt Opt_DumpToFile dflags
, Just prefix <- getPrefix
= Just $ setDir (prefix ++ (beautifyDumpName dflag))
= Just $ setDir (prefix ++ (beautifyDumpName flag))
| otherwise
= Nothing
......@@ -286,10 +286,10 @@ chooseDumpFile dflags dflag
Just d -> d </> f
Nothing -> f
-- | Build a nice file name from name of a DynFlag constructor
beautifyDumpName :: DynFlag -> String
beautifyDumpName dflag
= let str = show dflag
-- | Build a nice file name from name of a GeneralFlag constructor
beautifyDumpName :: GeneralFlag -> String
beautifyDumpName flag
= let str = show flag
cut = if isPrefixOf "Opt_D_" str then drop 6 str else str
dash = map (\c -> if c == '_' then '-' else c) cut
in dash
......
......@@ -22,7 +22,7 @@ module GHC (
needsTemplateHaskell,
-- * Flags and settings
DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), dopt,
GhcMode(..), GhcLink(..), defaultObjectTarget,
parseDynamicFlags,
getSessionDynFlags, setSessionDynFlags,
......
......@@ -68,7 +68,7 @@ import qualified Data.Set as Set
-- ---------------------------------------------------------------------------
-- The Package state
-- | Package state is all stored in 'DynFlag's, including the details of
-- | Package state is all stored in 'DynFlags', including the details of
-- all packages, which packages are exposed, and which modules they
-- provide.
--
......
......@@ -142,8 +142,8 @@ endPass dflags pass binds rules
; lintPassResult dflags pass binds }
where
mb_flag = case coreDumpFlag pass of
Just dflag | dopt dflag dflags -> Just dflag
| dopt Opt_D_verbose_core2core dflags -> Just dflag
Just flag | dopt flag dflags -> Just flag
| dopt Opt_D_verbose_core2core dflags -> Just flag
_ -> Nothing
dumpIfSet :: DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO ()
......@@ -151,15 +151,15 @@ dumpIfSet dflags dump_me pass extra_info doc
= Err.dumpIfSet dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc
dumpPassResult :: DynFlags
-> Maybe DynFlag -- Just df => show details in a file whose
-> Maybe GeneralFlag -- Just df => show details in a file whose
-- name is specified by df
-> SDoc -- Header
-> SDoc -- Extra info to appear after header
-> CoreProgram -> [CoreRule]
-> IO ()
dumpPassResult dflags mb_flag hdr extra_info binds rules
| Just dflag <- mb_flag
= Err.dumpSDoc dflags dflag (showSDoc dflags hdr) dump_doc
| Just flag <- mb_flag
= Err.dumpSDoc dflags flag (showSDoc dflags hdr) dump_doc
| otherwise
= Err.debugTraceMsg dflags 2 size_doc
......@@ -265,7 +265,7 @@ data CoreToDo -- These are diff core-to-core passes,
\end{code}
\begin{code}
coreDumpFlag :: CoreToDo -> Maybe DynFlag
coreDumpFlag :: CoreToDo -> Maybe GeneralFlag
coreDumpFlag (CoreDoSimplify {}) = Just Opt_D_dump_simpl_phases
coreDumpFlag (CoreDoPluginPass {}) = Just Opt_D_dump_core_pipeline
coreDumpFlag CoreDoFloatInwards = Just Opt_D_verbose_core2core
......@@ -1019,7 +1019,7 @@ debugTraceMsg :: SDoc -> CoreM ()
debugTraceMsg = msg (flip Err.debugTraceMsg 3)
-- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher
dumpIfSet_dyn :: DynFlag -> String -> SDoc -> CoreM ()
dumpIfSet_dyn :: GeneralFlag -> String -> SDoc -> CoreM ()
dumpIfSet_dyn flag str = msg (\dflags -> Err.dumpIfSet_dyn dflags flag str)
\end{code}
......
......@@ -22,7 +22,7 @@ import MkCore
import CoreArity ( etaExpand )
import CoreMonad ( FloatOutSwitches(..) )
import DynFlags ( DynFlags, DynFlag(..) )
import DynFlags ( DynFlags, GeneralFlag(..) )
import ErrUtils ( dumpIfSet_dyn )
import Id ( Id, idArity, isBottomingId )
import Var ( Var )
......
......@@ -1585,7 +1585,7 @@ tryRules env rules fn args call_cont
| otherwise
= return ()
log_rule dflags dflag hdr details = liftIO . dumpSDoc dflags dflag "" $
log_rule dflags flag hdr details = liftIO . dumpSDoc dflags flag "" $
sep [text hdr, nest 4 details]
\end{code}
......
......@@ -23,7 +23,7 @@ import StgLint ( lintStgBindings )
import StgStats ( showStgStats )
import UnariseStg ( unarise )
import DynFlags ( DynFlags(..), DynFlag(..), dopt, StgToDo(..),
import DynFlags ( DynFlags(..), GeneralFlag(..), dopt, StgToDo(..),
getStgToDo )
import Module ( Module )
import ErrUtils
......
......@@ -263,7 +263,7 @@ Command-line flags
xoptM :: ExtensionFlag -> TcRnIf gbl lcl Bool
xoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) }
doptM :: DynFlag -> TcRnIf gbl lcl Bool
doptM :: GeneralFlag -> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDynFlags; return (dopt flag dflags) }
woptM :: WarningFlag -> TcRnIf gbl lcl Bool
......@@ -273,7 +273,7 @@ setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setXOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} )
unsetDOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetDOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetDOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
......@@ -282,7 +282,7 @@ unsetWOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = wopt_unset (hsc_dflags top) flag}} )
-- | Do it flag is true
ifDOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
ifDOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
ifDOptM flag thing_inside = do b <- doptM flag
when b thing_inside
......@@ -437,12 +437,12 @@ traceIf = traceOptIf Opt_D_dump_if_trace
traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
traceOptIf :: DynFlag -> SDoc -> TcRnIf m n () -- No RdrEnv available, so qualify everything
traceOptIf :: GeneralFlag -> SDoc -> TcRnIf m n () -- No RdrEnv available, so qualify everything
traceOptIf flag doc = ifDOptM flag $
do dflags <- getDynFlags
liftIO (printInfoForUser dflags alwaysQualify doc)
traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
traceOptTcRn :: GeneralFlag -> SDoc -> TcRn ()
-- Output the message, with current location if opt_PprStyle_Debug
traceOptTcRn flag doc = ifDOptM flag $ do
{ loc <- getSrcSpanM
......@@ -461,7 +461,7 @@ debugDumpTcRn :: SDoc -> TcRn ()
debugDumpTcRn doc | opt_NoDebugOutput = return ()
| otherwise = dumpTcRn doc
dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
dumpOptTcRn :: GeneralFlag -> SDoc -> TcRn ()
dumpOptTcRn flag doc = ifDOptM flag (dumpTcRn doc)
\end{code}
......
......@@ -130,7 +130,7 @@ traceVt herald doc
-- |Dump the given program conditionally.
--
dumpOptVt :: DynFlag -> String -> SDoc -> VM ()
dumpOptVt :: GeneralFlag -> String -> SDoc -> VM ()
dumpOptVt flag header doc
= do { b <- liftDs $ doptM flag
; if b
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment