Add separate functions for querying DynFlag and ExtensionFlag options

and remove the temporary DOpt class workaround.

5 files changed, 31 insertions, 43 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 6b50811fef..08d568fa6b 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -707,7 +707,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
        checkProcessArgsResult unhandled_flags
        let dflags1' = flattenExtensionFlags dflags1
 
-       if not (dopt Opt_Cpp dflags1') then do
+       if not (xopt Opt_Cpp dflags1') then do
            -- we have to be careful to emit warnings only once.
            unless (dopt Opt_Pp dflags1') $ handleFlagWarnings dflags1' warns
 
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 47d9f6da1b..b90753befb 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -14,14 +14,19 @@
 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
         -- * Dynamic flags and associated configuration types
-        DOpt(..),
         DynFlag(..),
         ExtensionFlag(..),
         glasgowExtsFlags,
         flattenExtensionFlags,
         ensureFlattenedExtensionFlags,
-        lopt_set_flattened,
-        lopt_unset_flattened,
+        dopt,
+        dopt_set,
+        dopt_unset,
+        xopt,
+        xopt_set,
+        xopt_unset,
+        xopt_set_flattened,
+        xopt_unset_flattened,
         DynFlags(..),
         RtsOptsEnabled(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
@@ -814,64 +819,47 @@ languageExtensions (Just Haskell2010)
        Opt_DoAndIfThenElse,
        Opt_RelaxedPolyRec]
 
--- The DOpt class is a temporary workaround, to avoid having to do
--- a mass-renaming dopt->lopt at the moment
-class DOpt a where
-    dopt :: a -> DynFlags -> Bool
-    dopt_set :: DynFlags -> a -> DynFlags
-    dopt_unset :: DynFlags -> a -> DynFlags
-
-instance DOpt DynFlag where
-    dopt = dopt'
-    dopt_set = dopt_set'
-    dopt_unset = dopt_unset'
-
-instance DOpt ExtensionFlag where
-    dopt = lopt
-    dopt_set = lopt_set
-    dopt_unset = lopt_unset
-
 -- | Test whether a 'DynFlag' is set
-dopt' :: DynFlag -> DynFlags -> Bool
-dopt' f dflags  = f `elem` (flags dflags)
+dopt :: DynFlag -> DynFlags -> Bool
+dopt f dflags  = f `elem` (flags dflags)
 
 -- | Set a 'DynFlag'
-dopt_set' :: DynFlags -> DynFlag -> DynFlags
-dopt_set' dfs f = dfs{ flags = f : flags dfs }
+dopt_set :: DynFlags -> DynFlag -> DynFlags
+dopt_set dfs f = dfs{ flags = f : flags dfs }
 
 -- | Unset a 'DynFlag'
-dopt_unset' :: DynFlags -> DynFlag -> DynFlags
-dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+dopt_unset :: DynFlags -> DynFlag -> DynFlags
+dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 
 -- | Test whether a 'ExtensionFlag' is set
-lopt :: ExtensionFlag -> DynFlags -> Bool
-lopt f dflags = case extensionFlags dflags of
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = case extensionFlags dflags of
                 Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
                 Right flags -> f `elem` flags
 
 -- | Set a 'ExtensionFlag'
-lopt_set :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set dfs f = case extensionFlags dfs of
+xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set dfs f = case extensionFlags dfs of
                  Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
                  Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")
 
 -- | Set a 'ExtensionFlag'
-lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set_flattened dfs f = case extensionFlags dfs of
+xopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set_flattened dfs f = case extensionFlags dfs of
                            Left _ ->
                                panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
                            Right flags ->
                                dfs { extensionFlags = Right (f : delete f flags) }
 
 -- | Unset a 'ExtensionFlag'
-lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset dfs f = case extensionFlags dfs of
+xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset dfs f = case extensionFlags dfs of
                    Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
                    Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")
 
 -- | Unset a 'ExtensionFlag'
-lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset_flattened dfs f = case extensionFlags dfs of
+xopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset_flattened dfs f = case extensionFlags dfs of
                              Left _ ->
                                  panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
                              Right flags ->
@@ -1883,7 +1871,7 @@ setLanguage l = upd (\dfs -> dfs { language = Just l })
 
 --------------------------
 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
-setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
+setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
                         ; mapM_ setExtensionFlag deps }
   where
     deps = [ d | (f', d) <- impliedFlags, f' == f ]
@@ -1893,7 +1881,7 @@ setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 
-unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
+unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
 
 --------------------------
 setDumpFlag' :: DynFlag -> DynP ()
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c3aa8323de..82a5adc3a0 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -2289,7 +2289,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
 		| Just (Unlit _) <- mb_phase    = True
 	        | Nothing <- mb_phase, Unlit _ <- startPhase src_fn  = True
 		  -- note: local_opts is only required if there's no Unlit phase
-		| dopt Opt_Cpp dflags'		= True
+		| xopt Opt_Cpp dflags'		= True
 		| dopt Opt_Pp  dflags'		= True
 		| otherwise			= False
 
@@ -2372,7 +2372,7 @@ getModuleGraph = liftM hsc_mod_graph getSession
 -- have Template Haskell enabled whether it is actually needed or not.
 needsTemplateHaskell :: ModuleGraph -> Bool
 needsTemplateHaskell ms =
-    any (dopt Opt_TemplateHaskell . ms_hspp_opts) ms
+    any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
 
 -- | Return @True@ <==> module is loaded.
 isLoaded :: GhcMonad m => ModuleName -> m Bool
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index d21eeac860..0f0798b70f 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -79,7 +79,7 @@ getImports dflags buf filename source_filename = do
 		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) 
 					ord_idecls
 
-                implicit_prelude = dopt Opt_ImplicitPrelude dflags
+                implicit_prelude = xopt Opt_ImplicitPrelude dflags
                 implicit_imports = mkPrelImports (unLoc mod) implicit_prelude imps
 	      in
 	      return (src_idecls, implicit_imports ++ ordinary_imps, mod)
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 7d045632ba..c0952d6b98 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -300,7 +300,7 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
   = do	{ let { dflags     = hsc_dflags hsc_env
 	      ; omit_prags = dopt Opt_OmitInterfacePragmas dflags
 	      ; expose_all = dopt Opt_ExposeAllUnfoldings  dflags
-	      ; th	   = dopt Opt_TemplateHaskell      dflags
+	      ; th	   = xopt Opt_TemplateHaskell      dflags
               }
 	; showPass dflags CoreTidy