Remove `replaceDynFlags` from `ContainsDynFlags`
authorThomas Miedema <thomasmiedema@gmail.com>
Tue, 19 Jan 2016 10:54:36 +0000 (11:54 +0100)
committerThomas Miedema <thomasmiedema@gmail.com>
Sun, 24 Jan 2016 19:33:30 +0000 (20:33 +0100)
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

compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/HscTypes.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnTypes.hs

index f40efd0..3de94fd 100644 (file)
@@ -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
index 79406a7..c9b7a99 100644 (file)
@@ -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
index 16a1ebd..6d43ec0 100644 (file)
@@ -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
index b0b1e3d..692e9f3 100644 (file)
@@ -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) }
index 07037c7..d7670f1 100644 (file)
@@ -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)