Separate the language flags from the other DynFlag's

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 88bf5f5..3f5c4f1 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -11,7 +11,9 @@
 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
         -- * Dynamic flags and associated configuration types
 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
         -- * Dynamic flags and associated configuration types

+        DOpt(..),

         DynFlag(..),
         DynFlag(..),

+        LanguageFlag(..),

         DynFlags(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
         GhcMode(..), isOneShot,
         DynFlags(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
         GhcMode(..), isOneShot,

@@ -19,7 +21,7 @@ module DynFlags (
         PackageFlag(..),
         Option(..), showOpt,
         DynLibLoader(..),
         PackageFlag(..),
         Option(..), showOpt,
         DynLibLoader(..),

-        fFlags, xFlags,
+        fFlags, fLangFlags, xFlags,

         dphPackage,
         wayNames,
 
         dphPackage,
         wayNames,
 

@@ -27,8 +29,6 @@ module DynFlags (
         defaultDynFlags,                -- DynFlags
         initDynFlags,                   -- DynFlags -> IO DynFlags
 
         defaultDynFlags,                -- DynFlags
         initDynFlags,                   -- DynFlags -> IO DynFlags
 

-        dopt,                           -- DynFlag -> DynFlags -> Bool
-        dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags

         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
         getVerbFlag,
         updOptLevel,
         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
         getVerbFlag,
         updOptLevel,

@@ -188,76 +188,6 @@ data DynFlag
    | Opt_WarnWrongDoBind
    | Opt_WarnAlternativeLayoutRuleTransitional
 
    | Opt_WarnWrongDoBind
    | Opt_WarnAlternativeLayoutRuleTransitional
 

-
-   -- language opts
-   | Opt_OverlappingInstances
-   | Opt_UndecidableInstances
-   | Opt_IncoherentInstances
-   | Opt_MonomorphismRestriction
-   | Opt_MonoPatBinds
-   | Opt_MonoLocalBinds
-   | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
-   | Opt_ForeignFunctionInterface
-   | Opt_UnliftedFFITypes
-   | Opt_GHCForeignImportPrim
-   | Opt_PArr                           -- Syntactic support for parallel arrays
-   | Opt_Arrows                         -- Arrow-notation syntax
-   | Opt_TemplateHaskell
-   | Opt_QuasiQuotes
-   | Opt_ImplicitParams
-   | Opt_Generics                      -- "Derivable type classes"
-   | Opt_ImplicitPrelude
-   | Opt_ScopedTypeVariables
-   | Opt_UnboxedTuples
-   | Opt_BangPatterns
-   | Opt_TypeFamilies
-   | Opt_OverloadedStrings
-   | Opt_DisambiguateRecordFields
-   | Opt_RecordWildCards
-   | Opt_RecordPuns
-   | Opt_ViewPatterns
-   | Opt_GADTs
-   | Opt_RelaxedPolyRec
-   | Opt_NPlusKPatterns
-
-   | Opt_StandaloneDeriving
-   | Opt_DeriveDataTypeable
-   | Opt_DeriveFunctor
-   | Opt_DeriveTraversable
-   | Opt_DeriveFoldable
-
-   | Opt_TypeSynonymInstances
-   | Opt_FlexibleContexts
-   | Opt_FlexibleInstances
-   | Opt_ConstrainedClassMethods
-   | Opt_MultiParamTypeClasses
-   | Opt_FunctionalDependencies
-   | Opt_UnicodeSyntax
-   | Opt_PolymorphicComponents
-   | Opt_ExistentialQuantification
-   | Opt_MagicHash
-   | Opt_EmptyDataDecls
-   | Opt_KindSignatures
-   | Opt_ParallelListComp
-   | Opt_TransformListComp
-   | Opt_GeneralizedNewtypeDeriving
-   | Opt_RecursiveDo
-   | Opt_DoRec
-   | Opt_PostfixOperators
-   | Opt_TupleSections
-   | Opt_PatternGuards
-   | Opt_LiberalTypeSynonyms
-   | Opt_Rank2Types
-   | Opt_RankNTypes
-   | Opt_ImpredicativeTypes
-   | Opt_TypeOperators
-   | Opt_PackageImports
-   | Opt_NewQualifiedOperators
-   | Opt_ExplicitForAll
-   | Opt_AlternativeLayoutRule
-   | Opt_AlternativeLayoutRuleTransitional
-   | Opt_DatatypeContexts
-

    | Opt_PrintExplicitForalls
 
    -- optimisation opts
    | Opt_PrintExplicitForalls
 
    -- optimisation opts

@@ -292,7 +222,6 @@ data DynFlag
    | Opt_AutoSccsOnIndividualCafs
 
    -- misc opts
    | Opt_AutoSccsOnIndividualCafs
 
    -- misc opts

-   | Opt_Cpp

    | Opt_Pp
    | Opt_ForceRecomp
    | Opt_DryRun
    | Opt_Pp
    | Opt_ForceRecomp
    | Opt_DryRun

@@ -339,6 +268,77 @@ data DynFlag
 
    deriving (Eq, Show)
 
 
    deriving (Eq, Show)
 

+data LanguageFlag
+   = Opt_Cpp
+   | Opt_OverlappingInstances
+   | Opt_UndecidableInstances
+   | Opt_IncoherentInstances
+   | Opt_MonomorphismRestriction
+   | Opt_MonoPatBinds
+   | Opt_MonoLocalBinds
+   | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
+   | Opt_ForeignFunctionInterface
+   | Opt_UnliftedFFITypes
+   | Opt_GHCForeignImportPrim
+   | Opt_PArr                           -- Syntactic support for parallel arrays
+   | Opt_Arrows                         -- Arrow-notation syntax
+   | Opt_TemplateHaskell
+   | Opt_QuasiQuotes
+   | Opt_ImplicitParams
+   | Opt_Generics                      -- "Derivable type classes"
+   | Opt_ImplicitPrelude
+   | Opt_ScopedTypeVariables
+   | Opt_UnboxedTuples
+   | Opt_BangPatterns
+   | Opt_TypeFamilies
+   | Opt_OverloadedStrings
+   | Opt_DisambiguateRecordFields
+   | Opt_RecordWildCards
+   | Opt_RecordPuns
+   | Opt_ViewPatterns
+   | Opt_GADTs
+   | Opt_RelaxedPolyRec
+   | Opt_NPlusKPatterns
+
+   | Opt_StandaloneDeriving
+   | Opt_DeriveDataTypeable
+   | Opt_DeriveFunctor
+   | Opt_DeriveTraversable
+   | Opt_DeriveFoldable
+
+   | Opt_TypeSynonymInstances
+   | Opt_FlexibleContexts
+   | Opt_FlexibleInstances
+   | Opt_ConstrainedClassMethods
+   | Opt_MultiParamTypeClasses
+   | Opt_FunctionalDependencies
+   | Opt_UnicodeSyntax
+   | Opt_PolymorphicComponents
+   | Opt_ExistentialQuantification
+   | Opt_MagicHash
+   | Opt_EmptyDataDecls
+   | Opt_KindSignatures
+   | Opt_ParallelListComp
+   | Opt_TransformListComp
+   | Opt_GeneralizedNewtypeDeriving
+   | Opt_RecursiveDo
+   | Opt_DoRec
+   | Opt_PostfixOperators
+   | Opt_TupleSections
+   | Opt_PatternGuards
+   | Opt_LiberalTypeSynonyms
+   | Opt_Rank2Types
+   | Opt_RankNTypes
+   | Opt_ImpredicativeTypes
+   | Opt_TypeOperators
+   | Opt_PackageImports
+   | Opt_NewQualifiedOperators
+   | Opt_ExplicitForAll
+   | Opt_AlternativeLayoutRule
+   | Opt_AlternativeLayoutRuleTransitional
+   | Opt_DatatypeContexts
+   deriving (Eq, Show)
+

 -- | Contains not only a collection of 'DynFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
 -- | Contains not only a collection of 'DynFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {

@@ -473,6 +473,7 @@ data DynFlags = DynFlags {
 
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
   -- hsc dynamic flags
   flags                 :: [DynFlag],

+  languageFlags         :: [LanguageFlag],

 
   -- | Message output action: use "ErrUtils" instead of this if you can
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 
   -- | Message output action: use "ErrUtils" instead of this if you can
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),

@@ -710,15 +711,6 @@ defaultDynFlags =
             Opt_AutoLinkPackages,
             Opt_ReadUserPackageConf,
 
             Opt_AutoLinkPackages,
             Opt_ReadUserPackageConf,
 

-            Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
-                                -- behaviour the default, to see if anyone notices
-                                -- SLPJ July 06
-
-            Opt_ImplicitPrelude,
-            Opt_MonomorphismRestriction,
-            Opt_NPlusKPatterns,
-            Opt_DatatypeContexts,
-

             Opt_MethodSharing,
 
             Opt_DoAsmMangling,
             Opt_MethodSharing,
 
             Opt_DoAsmMangling,

@@ -733,6 +725,17 @@ defaultDynFlags =
                     -- The default -O0 options
             ++ standardWarnings,
 
                     -- The default -O0 options
             ++ standardWarnings,
 

+        languageFlags = [
+            Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
+                                -- behaviour the default, to see if anyone notices
+                                -- SLPJ July 06
+
+            Opt_ImplicitPrelude,
+            Opt_MonomorphismRestriction,
+            Opt_NPlusKPatterns,
+            Opt_DatatypeContexts
+            ],
+

         log_action = \severity srcSpan style msg ->
                         case severity of
                           SevInfo  -> printErrs (msg style)
         log_action = \severity srcSpan style msg ->
                         case severity of
                           SevInfo  -> printErrs (msg style)

@@ -756,17 +759,46 @@ Note [Verbosity levels]
     5   |   "ghc -v -ddump-all"
 -}
 
     5   |   "ghc -v -ddump-all"
 -}
 

+-- 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 LanguageFlag where
+    dopt = lopt
+    dopt_set = lopt_set
+    dopt_unset = lopt_unset
+

 -- | Test whether a 'DynFlag' is set
 -- | 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'
 
 -- | 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'
 
 -- | 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 'LanguageFlag' is set
+lopt :: LanguageFlag -> DynFlags -> Bool
+lopt f dflags  = f `elem` languageFlags dflags
+
+-- | Set a 'LanguageFlag'
+lopt_set :: DynFlags -> LanguageFlag -> DynFlags
+lopt_set dfs f = dfs{ languageFlags = f : languageFlags dfs }
+
+-- | Unset a 'LanguageFlag'
+lopt_unset :: DynFlags -> LanguageFlag -> DynFlags
+lopt_unset dfs f = dfs{ languageFlags = filter (/= f) (languageFlags dfs) }

 
 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
 
 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from

@@ -1023,15 +1055,17 @@ allFlags = map ('-':) $
            [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
            map ("fno-"++) flags ++
            map ("f"++) flags ++
            [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
            map ("fno-"++) flags ++
            map ("f"++) flags ++

+           map ("f"++) flags' ++

            map ("X"++) supportedLanguages
     where ok (PrefixPred _ _) = False
           ok _ = True
           flags = [ name | (name, _, _) <- fFlags ]
            map ("X"++) supportedLanguages
     where ok (PrefixPred _ _) = False
           ok _ = True
           flags = [ name | (name, _, _) <- fFlags ]

+          flags' = [ name | (name, _, _) <- fLangFlags ]

 
 dynamic_flags :: [Flag DynP]
 dynamic_flags = [
     Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported
 
 dynamic_flags :: [Flag DynP]
 dynamic_flags = [
     Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported

-  , Flag "cpp"            (NoArg  (setDynFlag Opt_Cpp)) Supported
+  , Flag "cpp"            (NoArg  (setLanguageFlag 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 "F"              (NoArg  (setDynFlag Opt_Pp)) Supported
   , Flag "#include"       (HasArg (addCmdlineHCInclude))
                              (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")

@@ -1427,15 +1461,17 @@ dynamic_flags = [
   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted)) Supported
   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget)) Supported
 
   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted)) Supported
   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget)) Supported
 

-  , Flag "fglasgow-exts"    (NoArg (mapM_ setDynFlag   glasgowExtsFlags))
+  , Flag "fglasgow-exts"    (NoArg enableGlasgowExts)

          Supported
          Supported

-  , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags))
+  , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts)

          Supported
  ]
  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
          Supported
  ]
  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags

- ++ map (mkFlag True  "X"    setDynFlag  ) xFlags
- ++ map (mkFlag False "XNo"  unSetDynFlag) xFlags
+ ++ map (mkFlag True  "f"    setLanguageFlag  ) fLangFlags
+ ++ map (mkFlag False "fno-" unSetLanguageFlag) fLangFlags
+ ++ map (mkFlag True  "X"    setLanguageFlag  ) xFlags
+ ++ map (mkFlag False "XNo"  unSetLanguageFlag) xFlags

 
 package_flags :: [Flag DynP]
 package_flags = [
 
 package_flags :: [Flag DynP]
 package_flags = [

@@ -1457,11 +1493,11 @@ package_flags = [
 
 mkFlag :: Bool                  -- ^ True <=> it should be turned on
        -> String                -- ^ The flag prefix
 
 mkFlag :: Bool                  -- ^ True <=> it should be turned on
        -> String                -- ^ The flag prefix

-       -> (DynFlag -> DynP ())
-       -> (String, DynFlag, Bool -> Deprecated)
+       -> (flag -> DynP ())
+       -> (String, flag, Bool -> Deprecated)

        -> Flag DynP
        -> Flag DynP

-mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
-    = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
+mkFlag turnOn flagPrefix f (name, flag, deprecated)
+    = Flag (flagPrefix ++ name) (NoArg (f flag)) (deprecated turnOn)

 
 deprecatedForLanguage :: String -> Bool -> Deprecated
 deprecatedForLanguage lang turn_on
 
 deprecatedForLanguage :: String -> Bool -> Deprecated
 deprecatedForLanguage lang turn_on

@@ -1548,6 +1584,17 @@ fFlags = [
   ( "vectorise",                        Opt_Vectorise, const Supported ),
   ( "regs-graph",                       Opt_RegsGraph, const Supported ),
   ( "regs-iterative",                   Opt_RegsIterative, 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 )
+  ]
+
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
+fLangFlags :: [(String, LanguageFlag, Bool -> Deprecated)]
+fLangFlags = [

   ( "th",                               Opt_TemplateHaskell,
     deprecatedForLanguage "TemplateHaskell" ),
   ( "fi",                               Opt_ForeignFunctionInterface,
   ( "th",                               Opt_TemplateHaskell,
     deprecatedForLanguage "TemplateHaskell" ),
   ( "fi",                               Opt_ForeignFunctionInterface,

@@ -1579,24 +1626,18 @@ fFlags = [
   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
     deprecatedForLanguage "UndecidableInstances" ),
   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
     deprecatedForLanguage "UndecidableInstances" ),
   ( "allow-incoherent-instances",       Opt_IncoherentInstances,

-    deprecatedForLanguage "IncoherentInstances" ),
-  ( "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 )
+    deprecatedForLanguage "IncoherentInstances" )

   ]
 
 supportedLanguages :: [String]
 supportedLanguages = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
 
 -- This may contain duplicates
   ]
 
 supportedLanguages :: [String]
 supportedLanguages = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
 
 -- This may contain duplicates

-languageOptions :: [DynFlag]
-languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
+languageOptions :: [LanguageFlag]
+languageOptions = [ langFlag | (_, langFlag, _) <- xFlags ]

 
 -- | These -X<blah> flags can all be reversed with -XNo<blah>
 
 -- | These -X<blah> flags can all be reversed with -XNo<blah>

-xFlags :: [(String, DynFlag, Bool -> Deprecated)]
+xFlags :: [(String, LanguageFlag, Bool -> Deprecated)]

 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),

@@ -1680,7 +1721,7 @@ xFlags = [
     const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" )
   ]
 
     const $ Deprecated "The new qualified operator syntax was rejected by Haskell'" )
   ]
 

-impliedFlags :: [(DynFlag, DynFlag)]
+impliedFlags :: [(LanguageFlag, LanguageFlag)]

 impliedFlags
   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
     , (Opt_Rank2Types,                Opt_ExplicitForAll)
 impliedFlags
   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
     , (Opt_Rank2Types,                Opt_ExplicitForAll)

@@ -1707,10 +1748,17 @@ impliedFlags
     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 

-glasgowExtsFlags :: [DynFlag]
+enableGlasgowExts :: DynP ()
+enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
+                       mapM_ setLanguageFlag glasgowExtsFlags
+
+disableGlasgowExts :: DynP ()
+disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
+                        mapM_ unSetLanguageFlag glasgowExtsFlags
+
+glasgowExtsFlags :: [LanguageFlag]

 glasgowExtsFlags = [
 glasgowExtsFlags = [

-             Opt_PrintExplicitForalls
-           , Opt_ForeignFunctionInterface
+             Opt_ForeignFunctionInterface

            , Opt_UnliftedFFITypes
            , Opt_GADTs
            , Opt_ImplicitParams
            , Opt_UnliftedFFITypes
            , Opt_GADTs
            , Opt_ImplicitParams

@@ -1813,17 +1861,22 @@ upd f = do
 
 --------------------------
 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
 
 --------------------------
 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()

-setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
-                 ; mapM_ setDynFlag deps }
+setDynFlag f = upd (\dfs -> dopt_set dfs f)
+unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+
+--------------------------
+setLanguageFlag, unSetLanguageFlag :: LanguageFlag -> DynP ()
+setLanguageFlag f = do { upd (\dfs -> lopt_set dfs f)
+                       ; mapM_ setLanguageFlag deps }

   where
     deps = [ d | (f', d) <- impliedFlags, f' == f ]
         -- When you set f, set the ones it implies
   where
     deps = [ d | (f', d) <- impliedFlags, f' == f ]
         -- When you set f, set the ones it implies

-       -- NB: use setDynFlag recursively, in case the implied flags
-       --     implies further flags
+        -- NB: use setLanguageFlag recursively, in case the implied flags
+        --     implies further flags

         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 
         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 

-unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+unSetLanguageFlag f = upd (\dfs -> lopt_unset dfs f)

 
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP
 
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 2afd04d..9efe64e 100644 (file)
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -28,7 +28,7 @@ import RnPat          (rnPats, rnBindPat,
                       )
                       
 import RnEnv
                       )
                       
 import RnEnv

-import DynFlags        ( DynFlag(..) )
+import DynFlags

 import Name
 import NameEnv
 import NameSet
 import Name
 import NameEnv
 import NameSet

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 620b1fe..a369835 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -30,7 +30,7 @@ import RnEnv
 import RnTypes         ( rnHsTypeFVs, rnSplice, checkTH,
                          mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
 import RnPat
 import RnTypes         ( rnHsTypeFVs, rnSplice, checkTH,
                          mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
 import RnPat

-import DynFlags                ( DynFlag(..) )
+import DynFlags

 import BasicTypes      ( FixityDirection(..) )
 import PrelNames
 
 import BasicTypes      ( FixityDirection(..) )
 import PrelNames
 

diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index fffd80f..01f621b 100644 (file)
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -40,7 +40,7 @@ import TcRnMonad
 import TcHsSyn         ( hsOverLitName )
 import RnEnv
 import RnTypes
 import TcHsSyn         ( hsOverLitName )
 import RnEnv
 import RnTypes

-import DynFlags                ( DynFlag(..) )
+import DynFlags

 import PrelNames
 import Constants       ( mAX_TUPLE_SIZE )
 import Name
 import PrelNames
 import Constants       ( mAX_TUPLE_SIZE )
 import Name

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 9b04da0..e362a12 100644 (file)
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -46,7 +46,7 @@ import Bag
 import FastString
 import Util            ( filterOut )
 import SrcLoc
 import FastString
 import Util            ( filterOut )
 import SrcLoc

-import DynFlags                ( DynFlag(..), DynFlags, thisPackage )
+import DynFlags

 import HscTypes                ( HscEnv, hsc_dflags )
 import BasicTypes       ( Boxity(..) )
 import ListSetOps       ( findDupsEq )
 import HscTypes                ( HscEnv, hsc_dflags )
 import BasicTypes       ( Boxity(..) )
 import ListSetOps       ( findDupsEq )

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 135f18d..5fcb45c 100644 (file)
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -977,7 +977,7 @@ cond_functorOK allowFunctions (dflags, rep_tc)
     functions  = ptext (sLit "contains function types")
     wrong_arg  = ptext (sLit "uses the type variable in an argument other than the last")
 
     functions  = ptext (sLit "contains function types")
     wrong_arg  = ptext (sLit "uses the type variable in an argument other than the last")
 

-checkFlag :: DynFlag -> Condition
+checkFlag :: LanguageFlag -> Condition

 checkFlag flag (dflags, _)
   | dopt flag dflags = Nothing
   | otherwise        = Just why
 checkFlag flag (dflags, _)
   | dopt flag dflags = Nothing
   | otherwise        = Just why

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 5592b80..022796e 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -36,7 +36,7 @@ import TyCon
 import DataCon
 import PrelNames
 import BasicTypes hiding (SuccessFlag(..))
 import DataCon
 import PrelNames
 import BasicTypes hiding (SuccessFlag(..))

-import DynFlags        ( DynFlag( Opt_GADTs ) )
+import DynFlags

 import SrcLoc
 import ErrUtils
 import Util
 import SrcLoc
 import ErrUtils
 import Util

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index aa3ae5d..06f08a3 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -230,19 +230,19 @@ Command-line flags
 getDOpts :: TcRnIf gbl lcl DynFlags
 getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
 
 getDOpts :: TcRnIf gbl lcl DynFlags
 getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
 

-doptM :: DynFlag -> TcRnIf gbl lcl Bool
+doptM :: DOpt d => d -> TcRnIf gbl lcl Bool

 doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
 
 doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
 

-setOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+setOptM :: DOpt d => d -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a

 setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
                         env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
 
 setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
                         env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
 

-unsetOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+unsetOptM :: DOpt d => d -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a

 unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
                         env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
 
 -- | Do it flag is true
 unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
                         env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
 
 -- | Do it flag is true

-ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
+ifOptM :: DOpt d => d -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()

 ifOptM flag thing_inside = do { b <- doptM flag; 
                                if b then thing_inside else return () }
 
 ifOptM flag thing_inside = do { b <- doptM flag; 
                                if b then thing_inside else return () }
 

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 6b8f984..8669f94 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1403,15 +1403,13 @@ setCmd ""
           ))
        io $ putStrLn (showSDoc (
           vcat (text "other dynamic, non-language, flag settings:" 
           ))
        io $ putStrLn (showSDoc (
           vcat (text "other dynamic, non-language, flag settings:" 

-               :map (flagSetting dflags) nonLanguageDynFlags)
+               :map (flagSetting dflags) others)

           ))
   where flagSetting dflags (str, f, _)
           | dopt f dflags = text "  " <> text "-f"    <> text str
           | otherwise     = text "  " <> text "-fno-" <> text str
         (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                         DynFlags.fFlags
           ))
   where flagSetting dflags (str, f, _)
           | dopt f dflags = text "  " <> text "-f"    <> text str
           | otherwise     = text "  " <> text "-fno-" <> text str
         (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                         DynFlags.fFlags

-        nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions)
-                                        others

         flags = [Opt_PrintExplicitForalls
                 ,Opt_PrintBindResult
                 ,Opt_BreakOnException
         flags = [Opt_PrintExplicitForalls
                 ,Opt_PrintBindResult
                 ,Opt_BreakOnException