diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 2 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 64 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 4 | ||||
| -rw-r--r-- | compiler/main/HeaderInfo.hs | 2 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.lhs | 2 |
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 |