[commit: ghc] master: Refactor nestImplicTcS (58e7316)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/58e7316e919abac55bf3ea0213bc92521ec94081/ghc

>---------------------------------------------------------------

commit 58e7316e919abac55bf3ea0213bc92521ec94081
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Aug 17 14:38:02 2016 +0100

    Refactor nestImplicTcS
    
    Simpler code, and simpler to understand.
    No change in behaviour.


>---------------------------------------------------------------

58e7316e919abac55bf3ea0213bc92521ec94081
 compiler/typecheck/TcSMonad.hs | 62 ++++++++++++++++++++++--------------------
 1 file changed, 32 insertions(+), 30 deletions(-)

diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 29837a9..687168b 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2380,8 +2380,11 @@ bumpStepCountTcS = TcS $ \env -> do { let ref = tcs_count env
 
 -- | Mark variables as used filling a coercion hole
 useVars :: TyCoVarSet -> TcS ()
-useVars vars = TcS $ \env -> do { let ref = tcs_used_tcvs env
-                                ; TcM.updTcRef ref (`unionVarSet` vars) }
+useVars vars = TcS $ \env -> useVarsTcM (tcs_used_tcvs env) vars
+
+-- | Like 'useVars' but in the TcM monad
+useVarsTcM :: IORef TyCoVarSet -> TyCoVarSet -> TcM ()
+useVarsTcM ref vars = TcM.updTcRef ref (`unionVarSet` vars)
 
 csTraceTcS :: SDoc -> TcS ()
 csTraceTcS doc
@@ -2497,45 +2500,44 @@ nestImplicTcS :: Maybe EvBindsVar -> TyCoVarSet -- bound in this implication
                                       -- coercion holes (for redundant-constraint
                                       -- tracking)
 nestImplicTcS m_ref bound_tcvs inner_tclvl (TcS thing_inside)
-  = do { (res, used_tcvs) <-
-         TcS $ \ TcSEnv { tcs_unified       = unified_var
-                        , tcs_inerts        = old_inert_var
-                        , tcs_count         = count
-                        , tcs_need_deriveds = solve_deriveds
-                        } ->
-      do { inerts <- TcM.readTcRef old_inert_var
-         ; let nest_inert = inerts { inert_flat_cache = emptyExactFunEqs }
+  = TcS $ \ TcSEnv { tcs_unified       = unified_var
+                   , tcs_inerts        = old_inert_var
+                   , tcs_count         = count
+                   , tcs_used_tcvs     = used_var
+                   , tcs_need_deriveds = solve_deriveds
+                   } ->
+    do { inerts <- TcM.readTcRef old_inert_var
+       ; let nest_inert = inerts { inert_flat_cache = emptyExactFunEqs }
                                      -- See Note [Do not inherit the flat cache]
-         ; new_inert_var <- TcM.newTcRef nest_inert
-         ; new_wl_var    <- TcM.newTcRef emptyWorkList
-         ; new_used_var  <- TcM.newTcRef emptyVarSet
-         ; let nest_env = TcSEnv { tcs_ev_binds      = m_ref
-                                 , tcs_unified       = unified_var
-                                 , tcs_count         = count
-                                 , tcs_inerts        = new_inert_var
-                                 , tcs_worklist      = new_wl_var
-                                 , tcs_used_tcvs     = new_used_var
-                                 , tcs_need_deriveds = solve_deriveds }
-         ; res <- TcM.setTcLevel inner_tclvl $
-                  thing_inside nest_env
+       ; new_inert_var <- TcM.newTcRef nest_inert
+       ; new_wl_var    <- TcM.newTcRef emptyWorkList
+       ; new_used_var  <- TcM.newTcRef emptyVarSet
+       ; let nest_env = TcSEnv { tcs_ev_binds      = m_ref
+                               , tcs_unified       = unified_var
+                               , tcs_count         = count
+                               , tcs_inerts        = new_inert_var
+                               , tcs_worklist      = new_wl_var
+                               , tcs_used_tcvs     = new_used_var
+                               , tcs_need_deriveds = solve_deriveds }
+       ; res <- TcM.setTcLevel inner_tclvl $
+                thing_inside nest_env
 
 #ifdef DEBUG
-         -- Perform a check that the thing_inside did not cause cycles
-         ; whenIsJust m_ref $ \ ref ->
-           do { ev_binds <- TcM.getTcEvBinds ref
-              ; checkForCyclicBinds ev_binds }
+       -- Perform a check that the thing_inside did not cause cycles
+       ; whenIsJust m_ref $ \ ref ->
+         do { ev_binds <- TcM.getTcEvBinds ref
+            ; checkForCyclicBinds ev_binds }
 #endif
-         ; used_tcvs <- TcM.readTcRef new_used_var
-         ; return (res, used_tcvs) }
+       ; used_tcvs <- TcM.readTcRef new_used_var
 
        ; local_ev_vars <- case m_ref of
            Nothing  -> return emptyVarSet
-           Just ref -> do { binds <- wrapTcS $ TcM.getTcEvBinds ref
+           Just ref -> do { binds <- TcM.getTcEvBinds ref
                           ; return $ mkVarSet $ map evBindVar $ bagToList binds }
        ; let all_locals = bound_tcvs `unionVarSet` local_ev_vars
              (inner_used_tcvs, outer_used_tcvs)
                = partitionVarSet (`elemVarSet` all_locals) used_tcvs
-       ; useVars outer_used_tcvs
+       ; useVarsTcM used_var outer_used_tcvs
 
        ; return (res, inner_used_tcvs) }