Commit edc68b2f authored by thomie's avatar thomie
Browse files

Remove `replaceDynFlags` from `ContainsDynFlags`

Refactoring only. It's shorter, and brings
`HasDynFlags/ContainsDynFLags` in line with `HasModule/ContainsModule`.
Introduce `updTopEnv`.

Reviewed by: bgamari

Differential Revision: https://phabricator.haskell.org/D1832
parent 98d6a29e
......@@ -611,7 +611,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
-- If we are compiling a Haskell module, and doing
-- -dynamic-too, but couldn't do the -dynamic-too fast
-- path, then rerun the pipeline for the dyn way
let dflags = extractDynFlags hsc_env
let dflags = hsc_dflags hsc_env
-- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do
when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
......
......@@ -905,7 +905,6 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where
class ContainsDynFlags t where
extractDynFlags :: t -> DynFlags
replaceDynFlags :: t -> DynFlags -> t
data ProfAuto
= NoProfAuto -- ^ no SCC annotations added
......
......@@ -408,10 +408,6 @@ data HscEnv
#endif
}
instance ContainsDynFlags HscEnv where
extractDynFlags env = hsc_dflags env
replaceDynFlags env dflags = env {hsc_dflags = dflags}
#ifdef GHCI
data IServ = IServ
{ iservPipe :: Pipe
......
......@@ -278,6 +278,10 @@ discardResult a = a >> return ()
getTopEnv :: TcRnIf gbl lcl HscEnv
getTopEnv = do { env <- getEnv; return (env_top env) }
updTopEnv :: (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updTopEnv upd = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = upd top })
getGblEnv :: TcRnIf gbl lcl gbl
getGblEnv = do { env <- getEnv; return (env_gbl env) }
......@@ -319,16 +323,16 @@ woptM :: WarningFlag -> TcRnIf gbl lcl Bool
woptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) }
setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setXOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} )
setXOptM flag =
updTopEnv (\top -> top { hsc_dflags = xopt_set (hsc_dflags top) flag})
unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetGOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = gopt_unset (hsc_dflags top) flag}} )
unsetGOptM flag =
updTopEnv (\top -> top { hsc_dflags = gopt_unset (hsc_dflags top) flag})
unsetWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetWOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = wopt_unset (hsc_dflags top) flag}} )
unsetWOptM flag =
updTopEnv (\top -> top { hsc_dflags = wopt_unset (hsc_dflags top) flag})
-- | Do it flag is true
whenDOptM :: DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
......@@ -351,11 +355,9 @@ getGhcMode :: TcRnIf gbl lcl GhcMode
getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) }
withDoDynamicToo :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
withDoDynamicToo m = do env <- getEnv
let dflags = extractDynFlags env
dflags' = dynamicTooMkDynamicDynFlags dflags
env' = replaceDynFlags env dflags'
setEnv env' m
withDoDynamicToo =
updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) ->
top { hsc_dflags = dynamicTooMkDynamicDynFlags dflags })
getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) }
......
......@@ -237,8 +237,6 @@ data Env gbl lcl
instance ContainsDynFlags (Env gbl lcl) where
extractDynFlags env = hsc_dflags (env_top env)
replaceDynFlags env dflags
= env {env_top = replaceDynFlags (env_top env) dflags}
instance ContainsModule gbl => ContainsModule (Env gbl lcl) where
extractModule env = extractModule (env_gbl env)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment