Refactor the command-line argument parsing (again)

This change allows the client of CmdLineParser a bit more flexibility,
by giving him an arbitrary computation (not just a deprecation
message) for each flag.

There are several clients, so there are lots of boilerplate changes.

Immediate motivation: if RTS is not profiled, we want to make
Template Haskell illegal.  That wasn't with the old setup.

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 64d218d..67515e5 100644 (file)
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -12,8 +12,10 @@
 module CmdLineParser (
         processArgs, OptKind(..),
         CmdLineP(..), getCmdLineState, putCmdLineState,
-        Flag(..), Deprecated(..),
-        errorsToGhcException
+        Flag(..), 
+        errorsToGhcException,
+
+        EwM, addErr, addWarn, getArg, liftEwM, deprecate
   ) where
 
 #include "HsVersions.h"
@@ -21,33 +23,98 @@ module CmdLineParser (
 import Util
 import Outputable
 import Panic
+import Bag
 import SrcLoc
 
 import Data.List
 
+--------------------------------------------------------
+--        The Flag and OptKind types
+--------------------------------------------------------
+
 data Flag m = Flag
-    {
-        flagName :: String,           -- flag, without the leading -
-        flagOptKind :: (OptKind m),   -- what to do if we see it
-        flagDeprecated :: Deprecated  -- is the flag deprecated?
+    {   flagName    :: String,       -- Flag, without the leading "-"
+        flagOptKind :: OptKind m     -- What to do if we see it
     }
 
-data Deprecated = Supported
-                | Deprecated String
-                | DeprecatedFullText String
-
+-------------------------------
 data OptKind m                      -- Suppose the flag is -f
- = NoArg (m ())                     -- -f all by itself
- | HasArg    (String -> m ())       -- -farg or -f arg
- | SepArg    (String -> m ())       -- -f arg
- | Prefix    (String -> m ())       -- -farg
- | OptPrefix (String -> m ())       -- -f or -farg (i.e. the arg is optional)
- | OptIntSuffix (Maybe Int -> m ()) -- -f or -f=n; pass n to fn
- | IntSuffix (Int -> m ())          -- -f or -f=n; pass n to fn
- | PassFlag  (String -> m ())       -- -f; pass "-f" fn
- | AnySuffix (String -> m ())       -- -f or -farg; pass entire "-farg" to fn
- | PrefixPred    (String -> Bool) (String -> m ())
- | AnySuffixPred (String -> Bool) (String -> m ())
+ = NoArg     (EwM m ())                 -- -f all by itself
+ | HasArg    (String -> EwM m ())       -- -farg or -f arg
+ | SepArg    (String -> EwM m ())       -- -f arg
+ | Prefix    (String -> EwM m ())       -- -farg
+ | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)
+ | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
+ | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn
+ | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn
+ | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn
+ | PrefixPred    (String -> Bool) (String -> EwM m ())
+ | AnySuffixPred (String -> Bool) (String -> EwM m ())
+
+
+--------------------------------------------------------
+--        The EwM monad 
+--------------------------------------------------------
+
+type Err   = Located String
+type Warn  = Located String
+type Errs  = Bag Err
+type Warns = Bag Warn
+
+-- EwM (short for "errors and warnings monad") is a
+-- monad transformer for m that adds an (err, warn) state
+newtype EwM m a = EwM { unEwM :: Located String            -- Current arg
+                              -> Errs -> Warns
+                              -> m (Errs, Warns, a) }
+
+instance Monad m => Monad (EwM m) where
+  (EwM f) >>= k = EwM (\l e w -> do { (e', w', r) <- f l e w 
+                                    ; unEwM (k r) l e' w' })
+  return v = EwM (\_ e w -> return (e, w, v))
+
+setArg :: Located String -> EwM m a -> EwM m a
+setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
+
+addErr :: Monad m => String -> EwM m ()
+addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` L loc e, ws, ()))
+
+addWarn :: Monad m => String -> EwM m ()
+addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ()))
+  where
+    w = "Warning: " ++ msg
+
+deprecate :: Monad m => String -> EwM m ()
+deprecate s 
+  = do { arg <- getArg
+       ; addWarn (arg ++ " is deprecated: " ++ s) }
+
+getArg :: Monad m => EwM m String
+getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))
+
+liftEwM :: Monad m => m a -> EwM m a
+liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
+
+-- -----------------------------------------------------------------------------
+-- A state monad for use in the command-line parser
+-- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
+
+newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
+
+instance Monad (CmdLineP s) where
+        return a = CmdLineP $ \s -> (a, s)
+        m >>= k  = CmdLineP $ \s -> let
+                (a, s') = runCmdLine m s
+                in runCmdLine (k a) s'
+
+getCmdLineState :: CmdLineP s s
+getCmdLineState   = CmdLineP $ \s -> (s,s)
+putCmdLineState :: s -> CmdLineP s ()
+putCmdLineState s = CmdLineP $ \_ -> ((),s)
+
+
+--------------------------------------------------------
+--        Processing arguments
+--------------------------------------------------------
 
 processArgs :: Monad m
             => [Flag m] -- cmdline parser spec
@@ -57,36 +124,34 @@ processArgs :: Monad m
                   [Located String],  -- errors
                   [Located String]   -- warnings
                  )
-processArgs spec args = process spec args [] [] []
+processArgs spec args 
+  = do { (errs, warns, spare) <- unEwM (process args []) 
+                                       (panic "processArgs: no arg yet")
+                                       emptyBag emptyBag 
+       ; return (spare, bagToList errs, bagToList warns) }
   where
-    process _spec [] spare errs warns =
-      return (reverse spare, reverse errs, reverse warns)
+    -- process :: [Located String] -> [Located String] -> EwM m [Located String]
+    process [] spare = return (reverse spare)
 
-    process spec (locArg@(L loc dash_arg@('-' : arg)) : args) spare errs warns =
+    process (locArg@(L _ ('-' : arg)) : args) spare =
       case findArg spec arg of
-        Just (rest, action, deprecated) ->
-           let warns' = case deprecated of
-                        Deprecated warning ->
-                            L loc ("Warning: " ++ dash_arg ++ " is deprecated: " ++ warning) : warns
-                        DeprecatedFullText warning ->
-                            L loc ("Warning: " ++ warning) : warns
-                        Supported -> warns
-           in case processOneArg action rest arg args of
-              Left err            -> process spec args spare (L loc err : errs) warns'
-              Right (action,rest) -> do action
-                                        process spec rest spare errs warns'
-        Nothing -> process spec args (locArg : spare) errs warns
-
-    process spec (arg : args) spare errs warns =
-      process spec args (arg : spare) errs warns
+        Just (rest, opt_kind) ->
+           case processOneArg opt_kind rest arg args of
+              Left err            -> do { setArg locArg $ addErr err
+                                        ; process args spare }
+              Right (action,rest) -> do { setArg locArg $ action
+                                        ; process rest spare }
+        Nothing -> process args (locArg : spare) 
+
+    process (arg : args) spare = process args (arg : spare) 
 
 
 processOneArg :: OptKind m -> String -> String -> [Located String]
-              -> Either String (m (), [Located String])
-processOneArg action rest arg args
+              -> Either String (EwM m (), [Located String])
+processOneArg opt_kind rest arg args
   = let dash_arg = '-' : arg
         rest_no_eq = dropEq rest
-    in case action of
+    in case opt_kind of
         NoArg  a -> ASSERT(null rest) Right (a, args)
 
         HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
@@ -119,9 +184,9 @@ processOneArg action rest arg args
         AnySuffixPred _ f -> Right (f dash_arg, args)
 
 
-findArg :: [Flag m] -> String -> Maybe (String, OptKind m, Deprecated)
+findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
 findArg spec arg
-  = case [ (removeSpaces rest, optKind, flagDeprecated flag)
+  = case [ (removeSpaces rest, optKind)
          | flag <- spec,
            let optKind = flagOptKind flag,
            Just rest <- [stripPrefix (flagName flag) arg],
@@ -162,22 +227,6 @@ unknownFlagErr f = Left ("unrecognised flag: " ++ f)
 missingArgErr :: String -> Either String a
 missingArgErr f = Left ("missing argument for flag: " ++ f)
 
--- -----------------------------------------------------------------------------
--- A state monad for use in the command-line parser
-
-newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
-
-instance Monad (CmdLineP s) where
-        return a = CmdLineP $ \s -> (a, s)
-        m >>= k  = CmdLineP $ \s -> let
-                (a, s') = runCmdLine m s
-                in runCmdLine (k a) s'
-
-getCmdLineState :: CmdLineP s s
-getCmdLineState   = CmdLineP $ \s -> (s,s)
-putCmdLineState :: s -> CmdLineP s ()
-putCmdLineState s = CmdLineP $ \_ -> ((),s)
-
 -- ---------------------------------------------------------------------
 -- Utils
 

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index da1e4c7..6c3ea22 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -w #-}
+-- Temporary, until rtsIsProfiled is fixed
+
 -- |
 -- Dynamic flags
 --
@@ -57,7 +60,7 @@ module DynFlags (
 
         -- * Compiler configuration suitable for display to the user
         Printable(..),
-        compilerInfo
+        compilerInfo, rtsIsProfiled
   ) where
 
 #include "HsVersions.h"
@@ -81,8 +84,10 @@ import SrcLoc
 import FastString
 import FiniteMap
 import Outputable
+import Foreign.C       ( CInt )
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
+import System.IO.Unsafe        ( unsafePerformIO )
 import Data.IORef
 import Control.Monad    ( when )
 
@@ -897,9 +902,7 @@ getVerbFlag dflags
 
 setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
          setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
-         setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
-         setPgmlo, setPgmlc,
-         addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptlo, addOptlc,
+         setPgmP, addOptl, addOptP,
          addCmdlineFramework, addHaddockOpts
    :: String -> DynFlags -> DynFlags
 setOutputFile, setOutputHi, setDumpPrefixForce
@@ -934,29 +937,9 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 -- Config.hs should really use Option.
 setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
-
-setPgmL   f d = d{ pgm_L   = f}
-setPgmF   f d = d{ pgm_F   = f}
-setPgmc   f d = d{ pgm_c   = (f,[])}
-setPgmm   f d = d{ pgm_m   = (f,[])}
-setPgms   f d = d{ pgm_s   = (f,[])}
-setPgma   f d = d{ pgm_a   = (f,[])}
-setPgml   f d = d{ pgm_l   = (f,[])}
-setPgmdll f d = d{ pgm_dll = (f,[])}
-setPgmwindres f d = d{ pgm_windres = f}
-setPgmlo  f d = d{ pgm_lo  = (f,[])}
-setPgmlc  f d = d{ pgm_lc  = (f,[])}
-
-addOptL   f d = d{ opt_L   = f : opt_L d}
-addOptP   f d = d{ opt_P   = f : opt_P d}
-addOptF   f d = d{ opt_F   = f : opt_F d}
-addOptc   f d = d{ opt_c   = f : opt_c d}
-addOptm   f d = d{ opt_m   = f : opt_m d}
-addOpta   f d = d{ opt_a   = f : opt_a d}
 addOptl   f d = d{ opt_l   = f : opt_l d}
-addOptwindres f d = d{ opt_windres = f : opt_windres d}
-addOptlo  f d = d{ opt_lo  = f : opt_lo d}
-addOptlc  f d = d{ opt_lc  = f : opt_lc d}
+addOptP   f d = d{ opt_P   = f : opt_P d}
+
 
 setDepMakefile :: FilePath -> DynFlags -> DynFlags
 setDepMakefile f d = d { depMakefile = deOptDep f }
@@ -1128,8 +1111,84 @@ getStgToDo dflags
               | otherwise
               = todo1
 
+{- **********************************************************************
+%*                                                                     *
+               DynFlags parser
+%*                                                                     *
+%********************************************************************* -}
+
 -- -----------------------------------------------------------------------------
--- DynFlags parser
+-- Parsing the dynamic flags.
+
+-- | 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).
+parseDynamicFlags :: Monad m =>
+                     DynFlags -> [Located String]
+                  -> m (DynFlags, [Located String], [Located String])
+                     -- ^ Updated 'DynFlags', left-over arguments, and
+                     -- list of warnings.
+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_ dflags0 args pkg_flags = do
+  -- XXX Legacy support code
+  -- We used to accept things like
+  --     optdep-f  -optdepdepend
+  --     optdep-f  -optdep depend
+  --     optdep -f -optdepdepend
+  --     optdep -f -optdep depend
+  -- but the spaces trip up proper argument handling. So get rid of them.
+  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
+
+      -- 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), dflags1)
+          = runCmdLine (processArgs flag_spec args') dflags0
+  when (not (null errs)) $ ghcError $ errorsToGhcException errs
+
+  -- Cannot use -fPIC with registerised -fvia-C, because the mangler
+  -- isn't up to the job.  We know that if hscTarget == HscC, then the
+  -- user has explicitly used -fvia-C, because -fasm is the default,
+  -- unless there is no NCG on this platform.  The latter case is
+  -- checked when the -fPIC flag is parsed.
+  --
+  let (pic_warns, dflags2)
+        | opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
+        = ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
+                dflags1{ hscTarget = HscAsm })
+#if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
+        | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
+        = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -dynamic on this"
+                ++ "platform; ignoring -fllvm"], dflags1{ hscTarget = HscAsm })
+#endif
+        | otherwise = ([], dflags1)
+
+  return (dflags2, leftover, pic_warns ++ warns)
+
+
+{- **********************************************************************
+%*                                                                     *
+               DynFlags specifications
+%*                                                                     *
+%********************************************************************* -}
 
 allFlags :: [String]
 allFlags = map ('-':) $
@@ -1143,412 +1202,271 @@ allFlags = map ('-':) $
           flags = [ name | (name, _, _) <- fFlags ]
           flags' = [ name | (name, _, _) <- fLangFlags ]
 
-dynamic_flags :: [Flag DynP]
+--------------- The main flags themselves ------------------
+dynamic_flags :: [Flag (CmdLineP DynFlags)]
 dynamic_flags = [
-    Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported
-  , Flag "cpp"            (NoArg  (setExtensionFlag Opt_Cpp)) Supported
-  , Flag "F"              (NoArg  (setDynFlag Opt_Pp)) Supported
-  , Flag "#include"       (HasArg (addCmdlineHCInclude))
-                             (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")
-  , Flag "v"              (OptIntSuffix setVerbosity) Supported
+    Flag "n"        (NoArg (setDynFlag Opt_DryRun))
+  , Flag "cpp"      (NoArg (setExtensionFlag Opt_Cpp)) 
+  , Flag "F"        (NoArg (setDynFlag Opt_Pp)) 
+  , Flag "#include" 
+         (HasArg (\s -> do { addCmdlineHCInclude s
+                           ; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
+  , Flag "v"        (OptIntSuffix setVerbosity)
 
         ------- Specific phases  --------------------------------------------
     -- need to appear before -pgmL to be parsed as LLVM flags.
-  , Flag "pgmlo"         (HasArg (upd . setPgmlo)) Supported
-  , Flag "pgmlc"         (HasArg (upd . setPgmlc)) Supported
-
-  , Flag "pgmL"           (HasArg (upd . setPgmL)) Supported
-  , Flag "pgmP"           (HasArg (upd . setPgmP)) Supported
-  , Flag "pgmF"           (HasArg (upd . setPgmF)) Supported
-  , Flag "pgmc"           (HasArg (upd . setPgmc)) Supported
-  , Flag "pgmm"           (HasArg (upd . setPgmm)) Supported
-  , Flag "pgms"           (HasArg (upd . setPgms)) Supported
-  , Flag "pgma"           (HasArg (upd . setPgma)) Supported
-  , Flag "pgml"           (HasArg (upd . setPgml)) Supported
-  , Flag "pgmdll"         (HasArg (upd . setPgmdll)) Supported
-  , Flag "pgmwindres"     (HasArg (upd . setPgmwindres)) Supported
+  , Flag "pgmlo"          (hasArg (\f d -> d{ pgm_lo  = (f,[])}))
+  , Flag "pgmlc"          (hasArg (\f d -> d{ pgm_lc  = (f,[])}))
+  , Flag "pgmL"           (hasArg (\f d -> d{ pgm_L   = f}))
+  , Flag "pgmP"           (hasArg setPgmP)
+  , Flag "pgmF"           (hasArg (\f d -> d{ pgm_F   = f}))
+  , Flag "pgmc"           (hasArg (\f d -> d{ pgm_c   = (f,[])}))
+  , Flag "pgmm"           (hasArg (\f d -> d{ pgm_m   = (f,[])}))
+  , Flag "pgms"           (hasArg (\f d -> d{ pgm_s   = (f,[])}))
+  , Flag "pgma"           (hasArg (\f d -> d{ pgm_a   = (f,[])}))
+  , Flag "pgml"           (hasArg (\f d -> d{ pgm_l   = (f,[])}))
+  , Flag "pgmdll"         (hasArg (\f d -> d{ pgm_dll = (f,[])}))
+  , Flag "pgmwindres"     (hasArg (\f d -> d{ pgm_windres = f}))
 
     -- need to appear before -optl/-opta to be parsed as LLVM flags.
-  , Flag "optlo"          (HasArg (upd . addOptlo)) Supported
-  , Flag "optlc"          (HasArg (upd . addOptlc)) Supported
-
-  , Flag "optL"           (HasArg (upd . addOptL)) Supported
-  , Flag "optP"           (HasArg (upd . addOptP)) Supported
-  , Flag "optF"           (HasArg (upd . addOptF)) Supported
-  , Flag "optc"           (HasArg (upd . addOptc)) Supported
-  , Flag "optm"           (HasArg (upd . addOptm)) Supported
-  , Flag "opta"           (HasArg (upd . addOpta)) Supported
-  , Flag "optl"           (HasArg (upd . addOptl)) Supported
-  , Flag "optwindres"     (HasArg (upd . addOptwindres)) Supported
+  , Flag "optlo"          (hasArg (\f d -> d{ opt_lo  = f : opt_lo d}))
+  , Flag "optlc"          (hasArg (\f d -> d{ opt_lc  = f : opt_lc d}))
+  , Flag "optL"           (hasArg (\f d -> d{ opt_L   = f : opt_L d}))
+  , Flag "optP"           (hasArg addOptP)
+  , Flag "optF"           (hasArg (\f d -> d{ opt_F   = f : opt_F d}))
+  , Flag "optc"           (hasArg (\f d -> d{ opt_c   = f : opt_c d}))
+  , Flag "optm"           (hasArg (\f d -> d{ opt_m   = f : opt_m d}))
+  , Flag "opta"           (hasArg (\f d -> d{ opt_a   = f : opt_a d}))
+  , Flag "optl"           (hasArg addOptl)
+  , Flag "optwindres"     (hasArg (\f d -> d{ opt_windres = f : opt_windres d}))
 
   , Flag "split-objs"
-         (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
-         Supported
+         (NoArg (if can_split 
+                 then setDynFlag Opt_SplitObjs
+                 else addWarn "ignoring -fsplit-objs"))
 
         -------- ghc -M -----------------------------------------------------
-  , Flag "dep-suffix"               (HasArg (upd . addDepSuffix)) Supported
-  , Flag "optdep-s"                 (HasArg (upd . addDepSuffix))
-         (Deprecated "Use -dep-suffix instead")
-  , Flag "dep-makefile"             (HasArg (upd . setDepMakefile)) Supported
-  , Flag "optdep-f"                 (HasArg (upd . setDepMakefile))
-         (Deprecated "Use -dep-makefile instead")
-  , 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)))
-         (Deprecated "Use -include-pkg-deps instead")
-  , Flag "optdep--include-pkg-deps" (NoArg  (upd (setDepIncludePkgDeps True)))
-         (Deprecated "Use -include-pkg-deps instead")
-  , Flag "exclude-module"           (HasArg (upd . addDepExcludeMod)) Supported
-  , Flag "optdep--exclude-module"   (HasArg (upd . addDepExcludeMod))
-         (Deprecated "Use -exclude-module instead")
-  , Flag "optdep-x"                 (HasArg (upd . addDepExcludeMod))
-         (Deprecated "Use -exclude-module instead")
+  , Flag "dep-suffix"     (hasArg addDepSuffix)
+  , Flag "optdep-s"       (hasArgDF addDepSuffix "Use -dep-suffix instead")
+  , Flag "dep-makefile"   (hasArg setDepMakefile)
+  , Flag "optdep-f"       (hasArgDF setDepMakefile "Use -dep-makefile instead")
+  , Flag "optdep-w"       (NoArg  (deprecate "doesn't do anything"))
+  , Flag "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))
+  , Flag "optdep--include-prelude"  (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+  , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+  , Flag "exclude-module"           (hasArg addDepExcludeMod)
+  , Flag "optdep--exclude-module"   (hasArgDF addDepExcludeMod "Use -exclude-module instead")
+  , Flag "optdep-x"                 (hasArgDF addDepExcludeMod "Use -exclude-module instead")
 
         -------- Linking ----------------------------------------------------
-  , Flag "no-link"        (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
-         Supported
-  , Flag "shared"         (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
-         Supported
-  , Flag "dynload"        (HasArg (upd . parseDynLibLoaderMode))
-         Supported
-  , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
+  , Flag "no-link"            (noArg (\d -> d{ ghcLink=NoLink }))
+  , Flag "shared"             (noArg (\d -> d{ ghcLink=LinkDynLib }))
+  , Flag "dynload"            (hasArg parseDynLibLoaderMode)
+  , Flag "dylib-install-name" (hasArg setDylibInstallName)
 
         ------- Libraries ---------------------------------------------------
-  , Flag "L"              (Prefix addLibraryPath ) Supported
-  , Flag "l"              (AnySuffix (\s -> do upd (addOptl s))) Supported
+  , Flag "L"   (Prefix    addLibraryPath)
+  , Flag "l"   (AnySuffix (upd . addOptl))
 
         ------- Frameworks --------------------------------------------------
         -- -framework-path should really be -F ...
-  , Flag "framework-path" (HasArg addFrameworkPath ) Supported
-  , Flag "framework"      (HasArg (upd . addCmdlineFramework)) Supported
+  , Flag "framework-path" (HasArg addFrameworkPath)
+  , Flag "framework"      (hasArg addCmdlineFramework)
 
         ------- Output Redirection ------------------------------------------
-  , Flag "odir"           (HasArg (upd . setObjectDir)) Supported
-  , Flag "o"              (SepArg (upd . setOutputFile . Just)) Supported
-  , Flag "ohi"            (HasArg (upd . setOutputHi   . Just )) Supported
-  , Flag "osuf"           (HasArg (upd . setObjectSuf)) Supported
-  , Flag "hcsuf"          (HasArg (upd . setHcSuf)) Supported
-  , Flag "hisuf"          (HasArg (upd . setHiSuf)) Supported
-  , 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 "odir"              (hasArg setObjectDir)
+  , Flag "o"                 (SepArg (upd . setOutputFile . Just))
+  , Flag "ohi"               (hasArg (setOutputHi . Just ))
+  , Flag "osuf"              (hasArg setObjectSuf)
+  , Flag "hcsuf"             (hasArg setHcSuf)
+  , Flag "hisuf"             (hasArg setHiSuf)
+  , Flag "hidir"             (hasArg setHiDir)
+  , Flag "tmpdir"            (hasArg setTmpDir)
+  , Flag "stubdir"           (hasArg setStubDir)
+  , Flag "outputdir"         (hasArg setOutputDir)
+  , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
 
         ------- Keeping temporary files -------------------------------------
      -- These can be singular (think ghc -c) or plural (think ghc --make)
-  , Flag "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
-  , Flag "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
-  , Flag "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles)) Supported
-  , Flag "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles)) Supported
-  , Flag "keep-raw-s-file"  (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
-  , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
-  , Flag "keep-llvm-file"   (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported
-  , Flag "keep-llvm-files"  (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported
+  , Flag "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles))
+  , Flag "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles))
+  , Flag "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles))
+  , Flag "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles))
+  , Flag "keep-raw-s-file"  (NoArg (setDynFlag Opt_KeepRawSFiles))
+  , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles))
+  , Flag "keep-llvm-file"   (NoArg (setDynFlag Opt_KeepLlvmFiles))
+  , Flag "keep-llvm-files"  (NoArg (setDynFlag Opt_KeepLlvmFiles))
      -- This only makes sense as plural
-  , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
+  , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles))
 
         ------- Miscellaneous ----------------------------------------------
-  , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
-  , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain)) Supported
-  , Flag "with-rtsopts"   (HasArg setRtsOpts) Supported
-  , Flag "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
-  , Flag "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
-  , Flag "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) Supported
-  , Flag "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
-  , Flag "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
-  , Flag "main-is"        (SepArg setMainIs ) Supported
-  , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock)) Supported
-  , Flag "haddock-opts"   (HasArg (upd . addHaddockOpts)) Supported
-  , Flag "hpcdir"         (SepArg setOptHpcDir) Supported
+  , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
+  , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain))
+  , Flag "with-rtsopts"   (HasArg setRtsOpts)
+  , Flag "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll))
+  , Flag "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll))
+  , Flag "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
+  , Flag "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone))
+  , Flag "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone))
+  , Flag "main-is"        (SepArg setMainIs)
+  , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock))
+  , Flag "haddock-opts"   (hasArg addHaddockOpts)
+  , Flag "hpcdir"         (SepArg setOptHpcDir)
 
         ------- recompilation checker --------------------------------------
-  , Flag "recomp"         (NoArg (unSetDynFlag Opt_ForceRecomp))
-         (Deprecated "Use -fno-force-recomp instead")
-  , Flag "no-recomp"      (NoArg (setDynFlag   Opt_ForceRecomp))
-         (Deprecated "Use -fforce-recomp instead")
+  , Flag "recomp"         (NoArg (do { unSetDynFlag Opt_ForceRecomp
+                                     ; deprecate "Use -fno-force-recomp instead" }))
+  , Flag "no-recomp"      (NoArg (do { setDynFlag Opt_ForceRecomp
+                                     ; deprecate "Use -fforce-recomp instead" }))
 
         ------ HsCpp opts ---------------------------------------------------
-  , Flag "D"              (AnySuffix (upd . addOptP)) Supported
-  , Flag "U"              (AnySuffix (upd . addOptP)) Supported
+  , Flag "D"              (AnySuffix (upd . addOptP))
+  , Flag "U"              (AnySuffix (upd . addOptP))
 
         ------- Include/Import Paths ----------------------------------------
-  , Flag "I"              (Prefix    addIncludePath) Supported
-  , Flag "i"              (OptPrefix addImportPath ) Supported
+  , Flag "I"              (Prefix    addIncludePath)
+  , Flag "i"              (OptPrefix addImportPath)
 
         ------ Debugging ----------------------------------------------------
-  , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats)) Supported
+  , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats))
 
   , Flag "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
-         Supported
   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
-         Supported
   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
-         Supported
   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
-         Supported
   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
-         Supported
   , Flag "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
-         Supported
   , Flag "ddump-asm-native"        (setDumpFlag Opt_D_dump_asm_native)
-         Supported
   , Flag "ddump-asm-liveness"      (setDumpFlag Opt_D_dump_asm_liveness)
-         Supported
   , Flag "ddump-asm-coalesce"      (setDumpFlag Opt_D_dump_asm_coalesce)
-         Supported
   , Flag "ddump-asm-regalloc"      (setDumpFlag Opt_D_dump_asm_regalloc)
-         Supported
   , Flag "ddump-asm-conflicts"     (setDumpFlag Opt_D_dump_asm_conflicts)
-         Supported
-  , Flag "ddump-asm-regalloc-stages"
-                                 (setDumpFlag Opt_D_dump_asm_regalloc_stages)
-         Supported
+  , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
-         Supported
   , Flag "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
-         Supported
   , Flag "ddump-llvm"              (NoArg (do { setObjTarget HscLlvm
                                               ; setDumpFlag' Opt_D_dump_llvm}))
-         Supported
   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
-         Supported
   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
-         Supported
   , Flag "ddump-ds"                (setDumpFlag Opt_D_dump_ds)
-         Supported
   , Flag "ddump-flatC"             (setDumpFlag Opt_D_dump_flatC)
-         Supported
   , Flag "ddump-foreign"           (setDumpFlag Opt_D_dump_foreign)
-         Supported
   , Flag "ddump-inlinings"         (setDumpFlag Opt_D_dump_inlinings)
-         Supported
   , Flag "ddump-rule-firings"      (setDumpFlag Opt_D_dump_rule_firings)
-         Supported
   , Flag "ddump-occur-anal"        (setDumpFlag Opt_D_dump_occur_anal)
-         Supported
   , Flag "ddump-parsed"            (setDumpFlag Opt_D_dump_parsed)
-         Supported
   , Flag "ddump-rn"                (setDumpFlag Opt_D_dump_rn)
-         Supported
   , Flag "ddump-simpl"             (setDumpFlag Opt_D_dump_simpl)
-         Supported
   , Flag "ddump-simpl-iterations"  (setDumpFlag Opt_D_dump_simpl_iterations)
-         Supported
   , Flag "ddump-simpl-phases"      (OptPrefix setDumpSimplPhases)
-         Supported
   , Flag "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
-         Supported
   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
-         Supported
   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
-         Supported
   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
-         Supported
   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
-         Supported
   , Flag "ddump-types"             (setDumpFlag Opt_D_dump_types)
-         Supported
   , Flag "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
-         Supported
   , Flag "ddump-cse"               (setDumpFlag Opt_D_dump_cse)
-         Supported
   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
-         Supported
   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
-         Supported
   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
-         Supported
   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
-         Supported
   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
-         Supported
   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
-         Supported
   , Flag "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
-         Supported
   , Flag "ddump-simpl-stats"       (setDumpFlag Opt_D_dump_simpl_stats)
-         Supported
   , Flag "ddump-bcos"              (setDumpFlag Opt_D_dump_BCOs)
-         Supported
   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
-         Supported
   , Flag "dverbose-core2core"      (NoArg (do { setVerbosity (Just 2)
                                               ; setVerboseCore2Core }))
-         Supported
   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
-         Supported
   , Flag "ddump-hi"                (setDumpFlag Opt_D_dump_hi)
-         Supported
   , Flag "ddump-minimal-imports"   (setDumpFlag Opt_D_dump_minimal_imports)
-         Supported
   , Flag "ddump-vect"              (setDumpFlag Opt_D_dump_vect)
-         Supported
   , Flag "ddump-hpc"               (setDumpFlag Opt_D_dump_hpc)
-         Supported
   , Flag "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
-         Supported
   , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
-         Supported
   , Flag "ddump-to-file"           (setDumpFlag Opt_DumpToFile)
-         Supported
   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
-         Supported
   , Flag "ddump-rtti"             (setDumpFlag Opt_D_dump_rtti)
-         Supported
-
   , Flag "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
-         Supported
   , Flag "dstg-lint"               (NoArg (setDynFlag Opt_DoStgLinting))
-         Supported
   , Flag "dcmm-lint"               (NoArg (setDynFlag Opt_DoCmmLinting))
-         Supported
   , Flag "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
-         Supported
-  , Flag "dshow-passes"
-         (NoArg (do forceRecompile
-                    setVerbosity (Just 2)))
-         Supported
+  , Flag "dshow-passes"            (NoArg (do forceRecompile
+                                              setVerbosity (Just 2)))
   , Flag "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
-         Supported
 
         ------ Machine dependant (-m<blah>) stuff ---------------------------
 
-  , Flag "monly-2-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
-         Supported
-  , Flag "monly-3-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
-         Supported
-  , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
-         Supported
-
-  , Flag "msse2" (NoArg (setDynFlag Opt_SSE2))
-         Supported
+  , Flag "monly-2-regs" (noArg (\s -> s{stolen_x86_regs = 2}))
+  , Flag "monly-3-regs" (noArg (\s -> s{stolen_x86_regs = 3}))
+  , Flag "monly-4-regs" (noArg (\s -> s{stolen_x86_regs = 4}))
+  , Flag "msse2"        (NoArg (setDynFlag Opt_SSE2))
 
      ------ Warning opts -------------------------------------------------
   , Flag "W"      (NoArg (mapM_ setDynFlag   minusWOpts))
-         Supported
   , Flag "Werror" (NoArg (setDynFlag         Opt_WarnIsError))
-         Supported
   , Flag "Wwarn"  (NoArg (unSetDynFlag       Opt_WarnIsError))
-         Supported
   , Flag "Wall"   (NoArg (mapM_ setDynFlag   minusWallOpts))
-         Supported
-  , Flag "Wnot"   (NoArg (mapM_ unSetDynFlag minusWallOpts))
-         (Deprecated "Use -w instead")
+  , Flag "Wnot"   (NoArg (do { mapM_ unSetDynFlag minusWallOpts
+                             ; deprecate "Use -w instead" }))
   , Flag "w"      (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
-         Supported
 
         ------ Optimisation flags ------------------------------------------
-  , Flag "O"      (NoArg (upd (setOptLevel 1))) Supported
-  , Flag "Onot"   (NoArg (upd (setOptLevel 0)))
-         (Deprecated "Use -O0 instead")
-  , Flag "Odph"   (NoArg (upd setDPHOpt)) Supported
+  , Flag "O"      (noArg (setOptLevel 1))
+  , Flag "Onot"   (noArgDF (setOptLevel 0) "Use -O0 instead")
+  , Flag "Odph"   (noArg setDPHOpt)
   , Flag "O"      (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
-         Supported
                 -- If the number is missing, use 1
 
-  , Flag "fsimplifier-phases"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ simplPhases = n })))
-         Supported
-  , Flag "fmax-simplifier-iterations"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n })))
-         Supported
-
-  , Flag "fspec-constr-threshold"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrThreshold = Just n })))
-         Supported
-  , Flag "fno-spec-constr-threshold"
-         (NoArg (upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
-         Supported
-  , Flag "fspec-constr-count"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrCount = Just n })))
-         Supported
-  , Flag "fno-spec-constr-count"
-         (NoArg (upd (\dfs -> dfs{ specConstrCount = Nothing })))
-         Supported
-  , Flag "fliberate-case-threshold"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
-         Supported
-  , Flag "fno-liberate-case-threshold"
-         (NoArg (upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
-         Supported
-
-  , Flag "frule-check"
-         (SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
-         Supported
-  , Flag "fcontext-stack"
-         (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
-         Supported
-
-  , Flag "fstrictness-before"
-         (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs })))
-         Supported
+  , Flag "fsimplifier-phases"          (intSuffix (\n d -> d{ simplPhases = n }))
+  , Flag "fmax-simplifier-iterations"  (intSuffix (\n d -> d{ maxSimplIterations = n }))
+  , Flag "fspec-constr-threshold"      (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
+  , Flag "fno-spec-constr-threshold"   (noArg (\d -> d{ specConstrThreshold = Nothing }))
+  , Flag "fspec-constr-count"          (intSuffix (\n d -> d{ specConstrCount = Just n }))
+  , Flag "fno-spec-constr-count"       (noArg (\d -> d{ specConstrCount = Nothing }))
+  , Flag "fliberate-case-threshold"    (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
+  , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
+  , Flag "frule-check"                 (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s })))
+  , Flag "fcontext-stack"              (intSuffix (\n d -> d{ ctxtStkDepth = n }))
+  , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
 
         ------ 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
+  , Flag "fauto-sccs-on-all-toplevs"              (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+  , Flag "auto-all"                               (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+  , Flag "no-auto-all"                            (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+  , Flag "fauto-sccs-on-exported-toplevs"  (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+  , Flag "auto"                            (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+  , Flag "no-auto"                         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+  , Flag "fauto-sccs-on-individual-cafs"   (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+  , Flag "caf-all"                         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+  , Flag "no-caf-all"                      (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
 
         ------ DPH flags ----------------------------------------------------
 
-  , Flag "fdph-seq"
-         (NoArg (setDPHBackend DPHSeq))
-         Supported
-  , Flag "fdph-par"
-         (NoArg (setDPHBackend DPHPar))
-         Supported
-  , Flag "fdph-this"
-         (NoArg (setDPHBackend DPHThis))
-         Supported
+  , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
+  , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
+  , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))
 
         ------ Compiler flags -----------------------------------------------
 
-  , Flag "fasm"             (NoArg (setObjTarget HscAsm)) Supported
-  , Flag "fvia-c"           (NoArg (setObjTarget HscC))
-         (Deprecated "The -fvia-c flag will be removed in a future GHC release")
-  , Flag "fvia-C"           (NoArg (setObjTarget HscC))
-         (Deprecated "The -fvia-C flag will be removed in a future GHC release")
-  , Flag "fllvm"            (NoArg (setObjTarget HscLlvm)) Supported
+  , Flag "fasm"             (NoArg (setObjTarget HscAsm))
+  , Flag "fvia-c"           (NoArg (setObjTarget HscC >>
+         (addWarn "The -fvia-c flag will be removed in a future GHC release")))
+  , Flag "fvia-C"           (NoArg (setObjTarget HscC >>
+         (addWarn "The -fvia-C flag will be removed in a future GHC release")))
+  , Flag "fllvm"            (NoArg (setObjTarget HscLlvm))
 
   , Flag "fno-code"         (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
                                        setTarget HscNothing))
-                                   Supported
-  , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted)) Supported
-  , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget)) Supported
-
+  , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted))
+  , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget))
   , Flag "fglasgow-exts"    (NoArg enableGlasgowExts)
-         Supported
   , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts)
-         Supported
  ]
  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
@@ -1556,132 +1474,141 @@ dynamic_flags = [
  ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags
  ++ map (mkFlag True  "X"    setExtensionFlag  ) xFlags
  ++ map (mkFlag False "XNo"  unSetExtensionFlag) xFlags
- ++ map (mkFlag True  "X"    setLanguage  ) languageFlags
+ ++ map (mkFlag True  "X"    setLanguage) languageFlags
 
-package_flags :: [Flag DynP]
+package_flags :: [Flag (CmdLineP DynFlags)]
 package_flags = [
         ------- Packages ----------------------------------------------------
-    Flag "package-conf"   (HasArg extraPkgConf_) Supported
+    Flag "package-conf"         (HasArg extraPkgConf_)
   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
-         Supported
-  , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
-  , Flag "package-id"     (HasArg exposePackageId) 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")
+  , Flag "package-name"        (hasArg setPackageName)
+  , Flag "package-id"          (HasArg exposePackageId)
+  , Flag "package"             (HasArg exposePackage)
+  , Flag "hide-package"        (HasArg hidePackage)
+  , Flag "hide-all-packages"   (NoArg (setDynFlag Opt_HideAllPackages))
+  , Flag "ignore-package"      (HasArg ignorePackage)
+  , Flag "syslib"              (HasArg (\s -> do { exposePackage s
+                                                  ; deprecate "Use -package instead" }))
   ]
 
+type FlagSpec flag 
+   = ( String  -- Flag in string form
+     , flag     -- Flag in internal form
+     , Bool -> DynP ())         -- Extra action to run when the flag is found
+                                -- Typically, emit a warning or error
+                                -- True  <=> we are turning the flag on
+                                -- False <=> we are turning the flag on
+
+
 mkFlag :: Bool                  -- ^ True <=> it should be turned on
        -> String                -- ^ The flag prefix
-       -> (flag -> DynP ())
-       -> (String, flag, Bool -> Deprecated)
-       -> Flag DynP
-mkFlag turnOn flagPrefix f (name, flag, deprecated)
-    = Flag (flagPrefix ++ name) (NoArg (f flag)) (deprecated turnOn)
+       -> (flag -> DynP ())    -- ^ What to do when the flag is found
+       -> FlagSpec flag                -- ^ Specification of this particular flag
+       -> Flag (CmdLineP DynFlags)
+mkFlag turnOn flagPrefix f (name, flag, extra_action)
+    = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turnOn))
 
-deprecatedForExtension :: String -> Bool -> Deprecated
+deprecatedForExtension :: String -> Bool -> DynP ()
 deprecatedForExtension lang turn_on
-    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
+    = deprecate ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
     where 
       flag | turn_on    = lang
            | otherwise = "No"++lang
 
-useInstead :: String -> Bool -> Deprecated
+useInstead :: String -> Bool -> DynP ()
 useInstead flag turn_on
-  = Deprecated ("Use -f" ++ no ++ flag ++ " instead")
+  = deprecate ("Use -f" ++ no ++ flag ++ " instead")
   where
     no = if turn_on then "" else "no-"
 
+nop :: Bool -> DynP ()
+nop _ = return ()
+
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
-fFlags :: [(String, DynFlag, Bool -> Deprecated)]
+fFlags :: [FlagSpec DynFlag]
 fFlags = [
-  ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
-  ( "warn-dodgy-exports",               Opt_WarnDodgyExports, const Supported ),
-  ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
-  ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
-  ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
-  ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, const Supported ),
-  ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, const Supported ),
-  ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, const Supported ),
-  ( "warn-missing-fields",              Opt_WarnMissingFields, const Supported ),
-  ( "warn-missing-import-lists",        Opt_WarnMissingImportList, const Supported ),
-  ( "warn-missing-methods",             Opt_WarnMissingMethods, const Supported ),
-  ( "warn-missing-signatures",          Opt_WarnMissingSigs, const Supported ),
-  ( "warn-name-shadowing",              Opt_WarnNameShadowing, const Supported ),
-  ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, const Supported ),
-  ( "warn-simple-patterns",             Opt_WarnSimplePatterns, const Supported ),
-  ( "warn-type-defaults",               Opt_WarnTypeDefaults, const Supported ),
-  ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, const Supported ),
-  ( "warn-unused-binds",                Opt_WarnUnusedBinds, 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 ),
+  ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, nop ),
+  ( "warn-dodgy-exports",               Opt_WarnDodgyExports, nop ),
+  ( "warn-dodgy-imports",               Opt_WarnDodgyImports, nop ),
+  ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, nop ),
+  ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
+  ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
+  ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),
+  ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
+  ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
+  ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
+  ( "warn-missing-methods",             Opt_WarnMissingMethods, nop ),
+  ( "warn-missing-signatures",          Opt_WarnMissingSigs, nop ),
+  ( "warn-name-shadowing",              Opt_WarnNameShadowing, nop ),
+  ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, nop ),
+  ( "warn-simple-patterns",             Opt_WarnSimplePatterns, nop ),
+  ( "warn-type-defaults",               Opt_WarnTypeDefaults, nop ),
+  ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, nop ),
+  ( "warn-unused-binds",                Opt_WarnUnusedBinds, nop ),
+  ( "warn-unused-imports",              Opt_WarnUnusedImports, nop ),
+  ( "warn-unused-matches",              Opt_WarnUnusedMatches, nop ),
+  ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, nop ),
+  ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
+  ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
+  ( "warn-orphans",                     Opt_WarnOrphans, nop ),
+  ( "warn-tabs",                        Opt_WarnTabs, nop ),
+  ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
   ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
-    const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
-  ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, const Supported ),
-  ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, const Supported ),
-  ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ),
-  ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
-  ( "strictness",                       Opt_Strictness, const Supported ),
-  ( "specialise",                       Opt_Specialise, const Supported ),
-  ( "float-in",                         Opt_FloatIn, const Supported ),
-  ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
-  ( "full-laziness",                    Opt_FullLaziness, const Supported ),
-  ( "liberate-case",                    Opt_LiberateCase, const Supported ),
-  ( "spec-constr",                      Opt_SpecConstr, const Supported ),
-  ( "cse",                              Opt_CSE, const Supported ),
-  ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, const Supported ),
-  ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, const Supported ),
-  ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, const Supported ),
-  ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, const Supported ),
-  ( "ignore-asserts",                   Opt_IgnoreAsserts, const Supported ),
-  ( "do-eta-reduction",                 Opt_DoEtaReduction, const Supported ),
-  ( "case-merge",                       Opt_CaseMerge, const Supported ),
-  ( "unbox-strict-fields",              Opt_UnboxStrictFields, const Supported ),
-  ( "method-sharing",                   Opt_MethodSharing, const Supported ),
-  ( "dicts-cheap",                      Opt_DictsCheap, 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 ),
-  ( "hpc-no-auto",                      Opt_Hpc_No_Auto, const Supported ),
+    \_ -> deprecate "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
+  ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
+  ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
+  ( "print-explicit-foralls",           Opt_PrintExplicitForalls, nop ),
+  ( "strictness",                       Opt_Strictness, nop ),
+  ( "specialise",                       Opt_Specialise, nop ),
+  ( "float-in",                         Opt_FloatIn, nop ),
+  ( "static-argument-transformation",   Opt_StaticArgumentTransformation, nop ),
+  ( "full-laziness",                    Opt_FullLaziness, nop ),
+  ( "liberate-case",                    Opt_LiberateCase, nop ),
+  ( "spec-constr",                      Opt_SpecConstr, nop ),
+  ( "cse",                              Opt_CSE, nop ),
+  ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, nop ),
+  ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, nop ),
+  ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, nop ),
+  ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, nop ),
+  ( "ignore-asserts",                   Opt_IgnoreAsserts, nop ),
+  ( "do-eta-reduction",                 Opt_DoEtaReduction, nop ),
+  ( "case-merge",                       Opt_CaseMerge, nop ),
+  ( "unbox-strict-fields",              Opt_UnboxStrictFields, nop ),
+  ( "method-sharing",                   Opt_MethodSharing, nop ),
+  ( "dicts-cheap",                      Opt_DictsCheap, nop ),
+  ( "excess-precision",                 Opt_ExcessPrecision, nop ),
+  ( "eager-blackholing",                Opt_EagerBlackHoling, nop ),
+  ( "asm-mangling",                     Opt_DoAsmMangling, nop ),
+  ( "print-bind-result",                Opt_PrintBindResult, nop ),
+  ( "force-recomp",                     Opt_ForceRecomp, nop ),
+  ( "hpc-no-auto",                      Opt_Hpc_No_Auto, nop ),
   ( "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 ),
-  ( "print-bind-contents",              Opt_PrintBindContents, 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 ),
-  ( "regs-iterative",                   Opt_RegsIterative, const Supported ),
-  ( "gen-manifest",                     Opt_GenManifest, const Supported ),
-  ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
-  ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
-  ( "shared-implib",                    Opt_SharedImplib, const Supported ),
-  ( "building-cabal-package",           Opt_BuildingCabalPackage, const Supported ),
-  ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
+  ( "enable-rewrite-rules",             Opt_EnableRewriteRules, nop ),
+  ( "break-on-exception",               Opt_BreakOnException, nop ),
+  ( "break-on-error",                   Opt_BreakOnError, nop ),
+  ( "print-evld-with-show",             Opt_PrintEvldWithShow, nop ),
+  ( "print-bind-contents",              Opt_PrintBindContents, nop ),
+  ( "run-cps",                          Opt_RunCPS, nop ),
+  ( "run-cpsz",                         Opt_RunCPSZ, nop ),
+  ( "new-codegen",                      Opt_TryNewCodeGen, nop ),
+  ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, nop ),
+  ( "vectorise",                        Opt_Vectorise, nop ),
+  ( "regs-graph",                       Opt_RegsGraph, nop ),
+  ( "regs-iterative",                   Opt_RegsIterative, nop ),
+  ( "gen-manifest",                     Opt_GenManifest, nop ),
+  ( "embed-manifest",                   Opt_EmbedManifest, nop ),
+  ( "ext-core",                         Opt_EmitExternalCore, nop ),
+  ( "shared-implib",                    Opt_SharedImplib, nop ),
+  ( "building-cabal-package",           Opt_BuildingCabalPackage, nop ),
+  ( "implicit-import-qualified",        Opt_ImplicitImportQualified, nop )
   ]
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
-fLangFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
+fLangFlags :: [FlagSpec ExtensionFlag]
 fLangFlags = [
   ( "th",                               Opt_TemplateHaskell,
-    deprecatedForExtension "TemplateHaskell" ),
+    deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
   ( "fi",                               Opt_ForeignFunctionInterface,
     deprecatedForExtension "ForeignFunctionInterface" ),
   ( "ffi",                              Opt_ForeignFunctionInterface,
@@ -1724,91 +1651,91 @@ supportedLanguagesAndExtensions :: [String]
 supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
 
 -- | These -X<blah> flags cannot be reversed with -XNo<blah>
-languageFlags :: [(String, Language, Bool -> Deprecated)]
+languageFlags :: [FlagSpec Language]
 languageFlags = [
-  ( "Haskell98",                        Haskell98, const Supported ),
-  ( "Haskell2010",                      Haskell2010, const Supported )
+  ( "Haskell98",                        Haskell98, nop ),
+  ( "Haskell2010",                      Haskell2010, nop )
   ]
 
 -- | These -X<blah> flags can all be reversed with -XNo<blah>
-xFlags :: [(String, ExtensionFlag, Bool -> Deprecated)]
+xFlags :: [FlagSpec ExtensionFlag]
 xFlags = [
-  ( "CPP",                              Opt_Cpp, const Supported ),
-  ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
-  ( "TupleSections",                    Opt_TupleSections, const Supported ),
-  ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
-  ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
-  ( "MagicHash",                        Opt_MagicHash, const Supported ),
-  ( "PolymorphicComponents",            Opt_PolymorphicComponents, const Supported ),
-  ( "ExistentialQuantification",        Opt_ExistentialQuantification, const Supported ),
-  ( "KindSignatures",                   Opt_KindSignatures, const Supported ),
-  ( "EmptyDataDecls",                   Opt_EmptyDataDecls, const Supported ),
-  ( "ParallelListComp",                 Opt_ParallelListComp, const Supported ),
-  ( "TransformListComp",                Opt_TransformListComp, const Supported ),
-  ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
-  ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
-  ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, const Supported ),
-  ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
-  ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
-  ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
+  ( "CPP",                              Opt_Cpp, nop ),
+  ( "PostfixOperators",                 Opt_PostfixOperators, nop ),
+  ( "TupleSections",                    Opt_TupleSections, nop ),
+  ( "PatternGuards",                    Opt_PatternGuards, nop ),
+  ( "UnicodeSyntax",                    Opt_UnicodeSyntax, nop ),
+  ( "MagicHash",                        Opt_MagicHash, nop ),
+  ( "PolymorphicComponents",            Opt_PolymorphicComponents, nop ),
+  ( "ExistentialQuantification",        Opt_ExistentialQuantification, nop ),
+  ( "KindSignatures",                   Opt_KindSignatures, nop ),
+  ( "EmptyDataDecls",                   Opt_EmptyDataDecls, nop ),
+  ( "ParallelListComp",                 Opt_ParallelListComp, nop ),
+  ( "TransformListComp",                Opt_TransformListComp, nop ),
+  ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, nop ),
+  ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, nop ),
+  ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, nop ),
+  ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, nop ),
+  ( "Rank2Types",                       Opt_Rank2Types, nop ),
+  ( "RankNTypes",                       Opt_RankNTypes, nop ),
   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, 
-        const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
-  ( "TypeOperators",                    Opt_TypeOperators, const Supported ),
+        \_ -> deprecate "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
+  ( "TypeOperators",                    Opt_TypeOperators, nop ),
   ( "RecursiveDo",                      Opt_RecursiveDo,
     deprecatedForExtension "DoRec"),
-  ( "DoRec",                            Opt_DoRec, const Supported ),
-  ( "Arrows",                           Opt_Arrows, const Supported ),
-  ( "PArr",                             Opt_PArr, const Supported ),
-  ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
-  ( "QuasiQuotes",                      Opt_QuasiQuotes, const Supported ),
-  ( "Generics",                         Opt_Generics, const Supported ),
-  ( "ImplicitPrelude",                  Opt_ImplicitPrelude, const Supported ),
-  ( "RecordWildCards",                  Opt_RecordWildCards, const Supported ),
-  ( "NamedFieldPuns",                   Opt_RecordPuns, const Supported ),
+  ( "DoRec",                            Opt_DoRec, nop ),
+  ( "Arrows",                           Opt_Arrows, nop ),
+  ( "PArr",                             Opt_PArr, nop ),
+  ( "TemplateHaskell",                  Opt_TemplateHaskell, checkTemplateHaskellOk ),
+  ( "QuasiQuotes",                      Opt_QuasiQuotes, nop ),
+  ( "Generics",                         Opt_Generics, nop ),
+  ( "ImplicitPrelude",                  Opt_ImplicitPrelude, nop ),
+  ( "RecordWildCards",                  Opt_RecordWildCards, nop ),
+  ( "NamedFieldPuns",                   Opt_RecordPuns, nop ),
   ( "RecordPuns",                       Opt_RecordPuns,
     deprecatedForExtension "NamedFieldPuns" ),
-  ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, const Supported ),
-  ( "OverloadedStrings",                Opt_OverloadedStrings, const Supported ),
-  ( "GADTs",                            Opt_GADTs, const Supported ),
-  ( "ViewPatterns",                     Opt_ViewPatterns, const Supported ),
-  ( "TypeFamilies",                     Opt_TypeFamilies, const Supported ),
-  ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
-  ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
-  ( "NPlusKPatterns",                   Opt_NPlusKPatterns, const Supported ),
-  ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, const Supported ),
-  ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
-  ( "ExplicitForAll",                   Opt_ExplicitForAll, const Supported ),
-  ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, const Supported ),
-  ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ),
-  ( "DatatypeContexts",                 Opt_DatatypeContexts, const Supported ),
-  ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
-  ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
-  ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
-  ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
-  ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, const Supported ),
+  ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, nop ),
+  ( "OverloadedStrings",                Opt_OverloadedStrings, nop ),
+  ( "GADTs",                            Opt_GADTs, nop ),
+  ( "ViewPatterns",                     Opt_ViewPatterns, nop ),
+  ( "TypeFamilies",                     Opt_TypeFamilies, nop ),
+  ( "BangPatterns",                     Opt_BangPatterns, nop ),
+  ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, nop ),
+  ( "NPlusKPatterns",                   Opt_NPlusKPatterns, nop ),
+  ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, nop ),
+  ( "MonoPatBinds",                     Opt_MonoPatBinds, nop ),
+  ( "ExplicitForAll",                   Opt_ExplicitForAll, nop ),
+  ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, nop ),
+  ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
+  ( "DatatypeContexts",                 Opt_DatatypeContexts, nop ),
+  ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),
+  ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, nop ),
+  ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, nop ),
+  ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
+  ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, nop ),
 
   ( "PatternSignatures",                Opt_ScopedTypeVariables, 
     deprecatedForExtension "ScopedTypeVariables" ),
 
-  ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
-  ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
-  ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
-  ( "DeriveFunctor",                    Opt_DeriveFunctor, const Supported ),
-  ( "DeriveTraversable",                Opt_DeriveTraversable, const Supported ),
-  ( "DeriveFoldable",                   Opt_DeriveFoldable, const Supported ),
-  ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
-  ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
-  ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
-  ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, const Supported ),
-  ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, const Supported ),
-  ( "FunctionalDependencies",           Opt_FunctionalDependencies, const Supported ),
-  ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, const Supported ),
-  ( "OverlappingInstances",             Opt_OverlappingInstances, const Supported ),
-  ( "UndecidableInstances",             Opt_UndecidableInstances, const Supported ),
-  ( "IncoherentInstances",              Opt_IncoherentInstances, const Supported ),
-  ( "PackageImports",                   Opt_PackageImports, const Supported ),
+  ( "UnboxedTuples",                    Opt_UnboxedTuples, nop ),
+  ( "StandaloneDeriving",               Opt_StandaloneDeriving, nop ),
+  ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, nop ),
+  ( "DeriveFunctor",                    Opt_DeriveFunctor, nop ),
+  ( "DeriveTraversable",                Opt_DeriveTraversable, nop ),
+  ( "DeriveFoldable",                   Opt_DeriveFoldable, nop ),
+  ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, nop ),
+  ( "FlexibleContexts",                 Opt_FlexibleContexts, nop ),
+  ( "FlexibleInstances",                Opt_FlexibleInstances, nop ),
+  ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, nop ),
+  ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, nop ),
+  ( "FunctionalDependencies",           Opt_FunctionalDependencies, nop ),
+  ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, nop ),
+  ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
+  ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
+  ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
+  ( "PackageImports",                   Opt_PackageImports, nop ),
   ( "NewQualifiedOperators",            Opt_NewQualifiedOperators,
-    const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" )
+    \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
   ]
 
 impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
@@ -1881,82 +1808,55 @@ glasgowExtsFlags = [
            , Opt_GeneralizedNewtypeDeriving
            , Opt_TypeFamilies ]
 
--- -----------------------------------------------------------------------------
--- Parsing the dynamic flags.
+-- Consult the RTS to find whether GHC itself has been built profiled
+-- If so, you can't use Template Haskell
+foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
 
--- | 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).
-parseDynamicFlags :: Monad m =>
-                     DynFlags -> [Located String]
-                  -> m (DynFlags, [Located String], [Located String])
-                     -- ^ Updated 'DynFlags', left-over arguments, and
-                     -- list of warnings.
-parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
+rtsIsProfiled :: Bool
+rtsIsProfiled = False -- unsafePerformIO rtsIsProfiledIO /= 0
 
--- | 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
+checkTemplateHaskellOk :: Bool -> DynP ()
+checkTemplateHaskellOk turn_on 
+  | turn_on && rtsIsProfiled
+  = addErr "You can't use Template Haskell with a profiled compiler"
+  | otherwise
+  = return ()
 
-parseDynamicFlags_ :: Monad m =>
-                      DynFlags -> [Located String] -> Bool
-                  -> m (DynFlags, [Located String], [Located String])
-parseDynamicFlags_ dflags0 args pkg_flags = do
-  -- XXX Legacy support code
-  -- We used to accept things like
-  --     optdep-f  -optdepdepend
-  --     optdep-f  -optdep depend
-  --     optdep -f -optdepdepend
-  --     optdep -f -optdep depend
-  -- but the spaces trip up proper argument handling. So get rid of them.
-  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
+{- **********************************************************************
+%*                                                                     *
+               DynFlags constructors
+%*                                                                     *
+%********************************************************************* -}
 
-      -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
-      flag_spec | pkg_flags = package_flags ++ dynamic_flags
-                | otherwise = dynamic_flags
+type DynP = EwM (CmdLineP DynFlags)
 
-  let ((leftover, errs, warns), dflags1)
-          = runCmdLine (processArgs flag_spec args') dflags0
-  when (not (null errs)) $ ghcError $ errorsToGhcException errs
+upd :: (DynFlags -> DynFlags) -> DynP ()
+upd f = liftEwM (do { dfs <- getCmdLineState
+                    ; putCmdLineState $! (f dfs) })
 
-  -- Cannot use -fPIC with registerised -fvia-C, because the mangler
-  -- isn't up to the job.  We know that if hscTarget == HscC, then the
-  -- user has explicitly used -fvia-C, because -fasm is the default,
-  -- unless there is no NCG on this platform.  The latter case is
-  -- checked when the -fPIC flag is parsed.
-  --
-  let (pic_warns, dflags2)
-        | opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
-        = ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
-                dflags1{ hscTarget = HscAsm })
-#if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
-        | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
-        = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -dynamic on this"
-                ++ "platform; ignoring -fllvm"], dflags1{ hscTarget = HscAsm })
-#endif
-        | otherwise = ([], dflags1)
+--------------- Constructor functions for OptKind -----------------
+noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+noArg fn = NoArg (upd fn)
 
-  return (dflags2, leftover, pic_warns ++ warns)
+noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
+noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
 
-type DynP = CmdLineP DynFlags
+hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+hasArg fn = HasArg (upd . fn)
 
-upd :: (DynFlags -> DynFlags) -> DynP ()
-upd f = do
-   dfs <- getCmdLineState
-   putCmdLineState $! (f dfs)
+hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
+hasArgDF fn deprec = HasArg (\s -> do { upd (fn s)
+                                      ; deprecate deprec })
+
+intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+intSuffix fn = IntSuffix (\n -> upd (fn n))
+
+setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
+setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
 
 --------------------------
 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> dopt_set dfs f)
+setDynFlag   f = upd (\dfs -> dopt_set dfs f)
 unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 
 --------------------------
@@ -1978,13 +1878,10 @@ setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
 unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
 
 --------------------------
-setDumpFlag :: DynFlag -> OptKind DynP
-setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
-
 setDumpFlag' :: DynFlag -> DynP ()
 setDumpFlag' dump_flag
   = do { setDynFlag dump_flag
-              ; when want_recomp forceRecompile }
+       ; when want_recomp forceRecompile }
   where
        -- Certain dumpy-things are really interested in what's going
         -- on during recompilation checking, so in those cases we
@@ -1997,7 +1894,7 @@ forceRecompile :: DynP ()
 -- recompilation checker), else you don't see the dump! However, 
 -- don't switch it off in --make mode, else *everything* gets
 -- recompiled which probably isn't what you want
-forceRecompile = do { dfs <- getCmdLineState
+forceRecompile = do { dfs <- liftEwM getCmdLineState
                    ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
        where
          force_recomp dfs = isOneShot (ghcMode dfs)

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 933503e..3ab10a4 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -1026,6 +1026,11 @@ hscParseThing parser dflags str
 compileExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
 
 compileExpr hsc_env srcspan ds_expr
+  | rtsIsProfiled
+  = panic "You can't call compileExpr in a profiled compiler"
+         -- Otherwise you get a seg-fault when you run it
+
+  | otherwise
   = do { let { dflags  = hsc_dflags hsc_env ;
                lint_on = dopt Opt_DoCoreLinting dflags }
              

diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index dd421b8..36a2fd1 100644 (file)
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -13,7 +13,9 @@ module StaticFlagParser (parseStaticFlags) where
 
 #include "HsVersions.h"
 
-import StaticFlags
+import qualified StaticFlags as SF
+import StaticFlags ( v_opt_C_ready, getWayFlags, tablesNextToCode, WayName(..)
+                   , opt_SimplExcessPrecision )
 import CmdLineParser
 import Config
 import SrcLoc
@@ -101,61 +103,60 @@ static_flags :: [Flag IO]
 
 static_flags = [
         ------- GHCi -------------------------------------------------------
-    Flag "ignore-dot-ghci" (PassFlag addOpt) Supported
-  , Flag "read-dot-ghci"   (NoArg (removeOpt "-ignore-dot-ghci")) Supported
+    Flag "ignore-dot-ghci" (PassFlag addOpt) 
+  , Flag "read-dot-ghci"   (NoArg (removeOpt "-ignore-dot-ghci"))
 
         ------- ways --------------------------------------------------------
-  , Flag "prof"           (NoArg (addWay WayProf)) Supported
-  , Flag "eventlog"       (NoArg (addWay WayEventLog)) Supported
-  , Flag "parallel"       (NoArg (addWay WayPar)) Supported
-  , Flag "gransim"        (NoArg (addWay WayGran)) Supported
-  , Flag "smp"            (NoArg (addWay WayThreaded))
-         (Deprecated "Use -threaded instead")
-  , Flag "debug"          (NoArg (addWay WayDebug)) Supported
-  , Flag "ndp"            (NoArg (addWay WayNDP)) Supported
-  , Flag "threaded"       (NoArg (addWay WayThreaded)) Supported
-
-  , Flag "ticky"          (PassFlag (\f -> do addOpt f; addWay WayDebug)) Supported
+  , Flag "prof"           (NoArg (addWay WayProf)) 
+  , Flag "eventlog"       (NoArg (addWay WayEventLog))
+  , Flag "parallel"       (NoArg (addWay WayPar))
+  , Flag "gransim"        (NoArg (addWay WayGran))
+  , Flag "smp"            (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
+  , Flag "debug"          (NoArg (addWay WayDebug))
+  , Flag "ndp"            (NoArg (addWay WayNDP))
+  , Flag "threaded"       (NoArg (addWay WayThreaded))
+
+  , Flag "ticky"          (PassFlag (\f -> do addOpt f; addWay WayDebug))
     -- -ticky enables ticky-ticky code generation, and also implies -debug which
     -- is required to get the RTS ticky support.
 
         ------ Debugging ----------------------------------------------------
-  , Flag "dppr-debug"        (PassFlag addOpt) Supported
-  , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
-  , Flag "dsuppress-coercions" (PassFlag addOpt) Supported
-  , Flag "dppr-user-length"  (AnySuffix addOpt) Supported
-  , Flag "dopt-fuel"         (AnySuffix addOpt) Supported
-  , Flag "dno-debug-output"  (PassFlag addOpt) Supported
-  , Flag "dstub-dead-values" (PassFlag addOpt) Supported
+  , Flag "dppr-debug"        (PassFlag addOpt)
+  , Flag "dsuppress-uniques" (PassFlag addOpt)
+  , Flag "dsuppress-coercions" (PassFlag addOpt)
+  , Flag "dppr-user-length"  (AnySuffix addOpt)
+  , Flag "dopt-fuel"         (AnySuffix addOpt)
+  , Flag "dno-debug-output"  (PassFlag addOpt)
+  , Flag "dstub-dead-values" (PassFlag addOpt)
       -- rest of the debugging flags are dynamic
 
         ----- Linker --------------------------------------------------------
-  , Flag "static"         (PassFlag addOpt) Supported
-  , Flag "dynamic"        (NoArg (removeOpt "-static" >> addWay WayDyn)) Supported
+  , Flag "static"         (PassFlag addOpt)
+  , Flag "dynamic"        (NoArg (removeOpt "-static" >> addWay WayDyn))
     -- ignored for compat w/ gcc:
-  , Flag "rdynamic"       (NoArg (return ())) Supported
+  , Flag "rdynamic"       (NoArg (return ()))
 
         ----- RTS opts ------------------------------------------------------
-  , Flag "H"              (HasArg (setHeapSize . fromIntegral . decodeSize))
-         Supported
-  , Flag "Rghc-timing"    (NoArg  (enableTimingStats)) Supported
+  , Flag "H"              (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
+        
+  , Flag "Rghc-timing"    (NoArg (liftEwM enableTimingStats))
 
         ------ Compiler flags -----------------------------------------------
 
         -- -fPIC requires extra checking: only the NCG supports it.
         -- See also DynFlags.parseDynamicFlags.
-  , Flag "fPIC" (PassFlag setPIC) Supported
+  , Flag "fPIC" (PassFlag setPIC)
 
         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
   , Flag "fno-"
          (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
-         Supported
+        
 
         -- Pass all remaining "-f<blah>" options to hsc
-  , Flag "f" (AnySuffixPred isStaticFlag addOpt) Supported
+  , Flag "f" (AnySuffixPred isStaticFlag addOpt)
   ]
 
-setPIC :: String -> IO ()
+setPIC :: String -> StaticP ()
 setPIC | cGhcWithNativeCodeGen == "YES" || cGhcUnregisterised == "YES"
        = addOpt
        | otherwise
@@ -217,6 +218,18 @@ decodeSize str
         n      = readRational m
         pred c = isDigit c || c == '.'
 
+
+type StaticP = EwM IO
+
+addOpt :: String -> StaticP ()
+addOpt = liftEwM . SF.addOpt
+
+addWay :: WayName -> StaticP ()
+addWay = liftEwM . SF.addWay
+
+removeOpt :: String -> StaticP ()
+removeOpt = liftEwM . SF.removeOpt
+
 -----------------------------------------------------------------------------
 -- RTS Hooks
 

diff --git a/ghc/Main.hs b/ghc/Main.hs
index 3b4d5e0..fab773b 100644 (file)
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -497,24 +497,15 @@ mode_flags :: [Flag ModeM]
 mode_flags =
   [  ------- help / version ----------------------------------------------
     Flag "?"                     (PassFlag (setMode showGhcUsageMode))
-         Supported
   , Flag "-help"                 (PassFlag (setMode showGhcUsageMode))
-         Supported
   , Flag "V"                     (PassFlag (setMode showVersionMode))
-         Supported
   , Flag "-version"              (PassFlag (setMode showVersionMode))
-         Supported
   , Flag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
-         Supported
   , Flag "-info"                 (PassFlag (setMode showInfoMode))
-         Supported
   , Flag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
-         Supported
   , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
-         Supported
   ] ++
   [ Flag k'                     (PassFlag (setMode mode))
-         Supported
   | (k, v) <- compilerInfo,
     let k' = "-print-" ++ map (replaceSpace . toLower) k
         replaceSpace ' ' = '-'
@@ -526,33 +517,23 @@ mode_flags =
       ------- interfaces ----------------------------------------------------
   [ Flag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
                                                "--show-iface"))
-         Supported
 
       ------- primary modes ------------------------------------------------
   , Flag "c"            (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
                                             addFlag "-no-link" f))
-         Supported
   , Flag "M"            (PassFlag (setMode doMkDependHSMode))
-         Supported
   , Flag "E"            (PassFlag (setMode (stopBeforeMode anyHsc)))
-         Supported
   , Flag "C"            (PassFlag (\f -> do setMode (stopBeforeMode HCc) f
                                             addFlag "-fvia-C" f))
-         Supported
   , Flag "S"            (PassFlag (setMode (stopBeforeMode As)))
-         Supported
   , Flag "-make"        (PassFlag (setMode doMakeMode))
-         Supported
   , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
-         Supported
   , Flag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
-         Supported
   , Flag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))
-         Supported
   ]
 
-setMode :: Mode -> String -> ModeM ()
-setMode newMode newFlag = do
+setMode :: Mode -> String -> EwM ModeM ()
+setMode newMode newFlag = liftEwM $ do
     (mModeFlag, errs, flags') <- getCmdLineState
     let (modeFlag', errs') =
             case mModeFlag of
@@ -595,8 +576,8 @@ flagMismatchErr :: String -> String -> String
 flagMismatchErr oldFlag newFlag
     = "cannot use `" ++ oldFlag ++  "' with `" ++ newFlag ++ "'"
 
-addFlag :: String -> String -> ModeM ()
-addFlag s flag = do
+addFlag :: String -> String -> EwM ModeM ()
+addFlag s flag = liftEwM $ do
   (m, e, flags') <- getCmdLineState
   putCmdLineState (m, e, mkGeneralLocated loc s : flags')
     where loc = "addFlag by " ++ flag ++ " on the commandline"