Commit 5de363ca authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Refactoring: mainly rename ic_env_tvs to ic_untch

Plus remember to zonk the free_tvs in TcUnify.newImplication
parent 5a185e27
......@@ -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
......
......@@ -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) }
......
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
......@@ -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
......
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