Refactoring: mainly rename ic_env_tvs to ic_untch

Plus remember to zonk the free_tvs in TcUnify.newImplication

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index dd91b06..84fb1b8 100644 (file)
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -469,7 +469,7 @@ tcGetGlobalTyVars :: TcM TcTyVarSet
 tcGetGlobalTyVars
   = do { (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv
        ; gbl_tvs  <- readMutVar gtv_var
-       ; gbl_tvs' <- zonkTcTyVarsAndFV (varSetElems gbl_tvs)
+       ; gbl_tvs' <- zonkTcTyVarsAndFV gbl_tvs
        ; writeMutVar gtv_var gbl_tvs'
        ; return gbl_tvs' }
 \end{code}
@@ -480,8 +480,8 @@ tcGetGlobalTyVars
 zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
 zonkTcTyVars tyvars = mapM zonkTcTyVar tyvars
 
-zonkTcTyVarsAndFV :: [TcTyVar] -> TcM TcTyVarSet
-zonkTcTyVarsAndFV tyvars = tyVarsOfTypes <$> mapM zonkTcTyVar tyvars
+zonkTcTyVarsAndFV :: TcTyVarSet -> TcM TcTyVarSet
+zonkTcTyVarsAndFV tyvars = tyVarsOfTypes <$> mapM zonkTcTyVar (varSetElems tyvars)
 
 -----------------  Types
 
@@ -601,12 +601,12 @@ zonkQuantifiedTyVar tv
 
 \begin{code}
 zonkImplication :: Implication -> TcM Implication
-zonkImplication implic@(Implic { ic_env_tvs = env_tvs, ic_given = given 
+zonkImplication implic@(Implic { ic_untch = env_tvs, ic_given = given 
                                , ic_wanted = wanted })
-  = do { env_tvs' <- zonkTcTyVarsAndFV (varSetElems env_tvs)
+  = do { env_tvs' <- zonkTcTyVarsAndFV env_tvs
        ; given'   <- mapM zonkEvVar given
        ; wanted'  <- mapBagM zonkWanted wanted
-       ; return (implic { ic_env_tvs = env_tvs', ic_given = given'
+       ; return (implic { ic_untch = env_tvs', ic_given = given'
                         , ic_wanted = wanted' }) }
 
 zonkEvVar :: EvVar -> TcM EvVar

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index b1d963e..f171336 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -964,8 +964,8 @@ setUntouchables untch_tvs thing_inside
   = updLclEnv (\ env -> env { tcl_untch = untch_tvs }) thing_inside 
 
 getUntouchables :: TcM TcTyVarSet 
-getUntouchables
-   = do { env <- getLclEnv; return (tcl_untch env) } 
+getUntouchables = do { env <- getLclEnv; return (tcl_untch env) } 
+   -- NB: no need to zonk this TcTyVarSet: they are, after all, untouchable!
 
 isUntouchable :: TcTyVar -> TcM Bool
 isUntouchable tv = do { env <- getLclEnv; return (tv `elemVarSet` tcl_untch env) }

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index fce06d1..253a5c0 100644 (file)
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -703,11 +703,11 @@ type GivenLoc  = CtLoc SkolemInfo
 
 data Implication
   = Implic {  
-      ic_env_tvs :: Untouchables, -- Untouchables: unification variables
+      ic_untch :: Untouchables, -- Untouchables: unification variables
                                   -- free in the environment
-      ic_env     :: TcTypeEnv,    -- The type environment
+      ic_env   :: TcTypeEnv,    -- The type environment
                                  -- Used only when generating error messages
-         -- Generally, ic_env_tvs = tvsof(ic_env)
+         -- Generally, ic_untch is a superset of tvsof(ic_env)
          -- However, we don't zonk ic_env when zonking the Implication
          -- Instead we do that when generating a skolem-escape error message
 
@@ -813,10 +813,10 @@ pprWantedEvVarWithLoc (WantedEvVar v loc) = hang (pprEvVarWithType v)
 pprWantedEvVar        (WantedEvVar v _)   = pprEvVarWithType v
 
 instance Outputable Implication where
-  ppr (Implic { ic_env_tvs = env_tvs, ic_skols = skols, ic_given = given
+  ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
               , ic_wanted = wanted, ic_binds = binds, ic_loc = loc })
    = ptext (sLit "Implic") <+> braces 
-     (sep [ ptext (sLit "Untouchables = ") <+> ppr env_tvs
+     (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
           , ptext (sLit "Skolems = ") <+> ppr skols
           , ptext (sLit "Given = ") <+> pprEvVars given
           , ptext (sLit "Wanted = ") <+> ppr wanted

diff --git a/compiler/typecheck/TcRules.lhs b/compiler/typecheck/TcRules.lhs
index 83ec995..71c5399 100644 (file)
--- a/compiler/typecheck/TcRules.lhs
+++ b/compiler/typecheck/TcRules.lhs
@@ -89,7 +89,7 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
 
             -- Now figure out what to quantify over
             -- c.f. TcSimplify.simplifyInfer
-       ; zonked_forall_tvs <- zonkTcTyVarsAndFV (varSetElems forall_tvs)
+       ; zonked_forall_tvs <- zonkTcTyVarsAndFV forall_tvs
        ; gbl_tvs           <- tcGetGlobalTyVars             -- Already zonked
        ; qtvs <- zonkQuantifiedTyVars (varSetElems (zonked_forall_tvs `minusVarSet` gbl_tvs))
 

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 0e7acdd..d8be2d1 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -185,7 +185,7 @@ simplifyInfer :: Bool                   -- Apply monomorphism restriction
                       TcEvBinds)    -- ... binding these evidence variables
 simplifyInfer apply_mr tau_tvs wanted
   | isEmptyBag wanted    -- Trivial case is quite common
-  = do { zonked_tau_tvs <- zonkTcTyVarsAndFV (varSetElems tau_tvs)
+  = do { zonked_tau_tvs <- zonkTcTyVarsAndFV tau_tvs
        ; gbl_tvs        <- tcGetGlobalTyVars        -- Already zonked
        ; qtvs <- zonkQuantifiedTyVars (varSetElems (zonked_tau_tvs `minusVarSet` gbl_tvs))
        ; return (qtvs, [], emptyTcEvBinds) }
@@ -202,7 +202,7 @@ simplifyInfer apply_mr tau_tvs wanted
               <- simplifyAsMuchAsPossible SimplInfer zonked_wanted
 
        ; gbl_tvs <- tcGetGlobalTyVars
-       ; zonked_tau_tvs <- zonkTcTyVarsAndFV (varSetElems tau_tvs)
+       ; zonked_tau_tvs <- zonkTcTyVarsAndFV tau_tvs
        ; zonked_simples <- mapBagM zonkWantedEvVar simple_wanted
        ; let qtvs = findQuantifiedTyVars apply_mr zonked_simples zonked_tau_tvs gbl_tvs
              (bound, free) | apply_mr  = (emptyBag, zonked_simples)
@@ -512,7 +512,7 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
        ; rhs_binds_var@(EvBindsVar evb_ref _)  <- newTcEvBinds
        ; loc        <- getCtLoc (RuleSkol name)
        ; rhs_binds1 <- simplifyCheck SimplCheck $ unitBag $ WcImplic $ 
-             Implic { ic_env_tvs = emptyVarSet   -- No untouchables
+             Implic { ic_untch = emptyVarSet     -- No untouchables
                    , ic_env = emptyNameEnv
                    , ic_skols = mkVarSet tv_bndrs
                    , ic_scoped = panic "emitImplication"
@@ -642,12 +642,12 @@ solveImplication :: InertSet     -- Given
 -- 
 -- Precondition: everything is zonked by now
 solveImplication inert 
-     imp@(Implic { ic_env_tvs = untch 
-                 , ic_binds   = ev_binds
-                 , ic_skols   = skols 
-                 , ic_given   = givens
+     imp@(Implic { ic_untch  = untch 
+                 , ic_binds  = ev_binds
+                 , ic_skols  = skols 
+                 , ic_given  = givens
                  , ic_wanted = wanteds
-                 , ic_loc = loc })
+                 , ic_loc    = loc })
   = nestImplicTcS ev_binds untch $
     do { traceTcS "solveImplication {" (ppr imp) 
 

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 340be9a..348c70e 100644 (file)
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -413,12 +413,12 @@ newImplication :: SkolemInfo -> TcTyVarSet -> [TcTyVar]
 newImplication skol_info free_tvs skol_tvs given thing_inside
   = ASSERT2( all isTcTyVar skol_tvs, ppr skol_tvs )
     ASSERT2( all isSkolemTyVar skol_tvs, ppr skol_tvs )
-    do { gbl_tvs <- tcGetGlobalTyVars
-       ; lcl_env <- getLclTypeEnv
-       ; let all_free_tvs = gbl_tvs `unionVarSet` free_tvs
+    do { gbl_tvs  <- tcGetGlobalTyVars
+       ; free_tvs <- zonkTcTyVarsAndFV free_tvs
+       ; let untch = gbl_tvs `unionVarSet` free_tvs
 
        ; (result, wanted) <- getConstraints               $ 
-                             setUntouchables all_free_tvs $
+                             setUntouchables untch $
                              thing_inside
 
        ; if isEmptyBag wanted && not (hasEqualities given) 
@@ -431,8 +431,9 @@ newImplication skol_info free_tvs skol_tvs given thing_inside
             return (emptyTcEvBinds, emptyWanteds, result)
          else do
        { ev_binds_var <- newTcEvBinds
+       ; lcl_env <- getLclTypeEnv
        ; loc <- getCtLoc skol_info
-       ; let implic = Implic { ic_env_tvs = all_free_tvs
+       ; let implic = Implic { ic_untch = untch
                             , ic_env = lcl_env
                             , ic_skols = mkVarSet skol_tvs
                             , ic_scoped = panic "emitImplication"
@@ -444,7 +445,6 @@ newImplication skol_info free_tvs skol_tvs given thing_inside
        ; return (TcEvBinds ev_binds_var, unitBag (WcImplic implic), result) } }
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                 Boxy unification
@@ -1194,7 +1194,7 @@ checkSigTyVarsWrt :: TcTyVarSet -> [TcTyVar] -> TcM ()
 -- The extra_tvs can include boxy type variables;
 --      e.g. TcMatches.tcCheckExistentialPat
 checkSigTyVarsWrt extra_tvs sig_tvs
-  = do  { extra_tvs' <- zonkTcTyVarsAndFV (varSetElems extra_tvs)
+  = do  { extra_tvs' <- zonkTcTyVarsAndFV extra_tvs
         ; check_sig_tyvars extra_tvs' sig_tvs }
 
 check_sig_tyvars