Commit 9b7eec86 authored by Alanas Plascinskas's avatar Alanas Plascinskas Committed by Ben Gamari

tcExtendTyVarEnv2 changed to tcExtendNameTyVarEnv

Reviewers: mpickering, goldfire, bgamari

Reviewed By: mpickering

Subscribers: goldfire, rwbarton, thomie, carter

GHC Trac Issues: #15017

Differential Revision: https://phabricator.haskell.org/D4732
parent 08073e16
...@@ -710,7 +710,7 @@ tcPolyCheck prag_fn ...@@ -710,7 +710,7 @@ tcPolyCheck prag_fn
; (ev_binds, (co_fn, matches')) ; (ev_binds, (co_fn, matches'))
<- checkConstraints skol_info skol_tvs ev_vars $ <- checkConstraints skol_info skol_tvs ev_vars $
tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $ tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $
tcExtendTyVarEnv2 tv_prs $ tcExtendNameTyVarEnv tv_prs $
setSrcSpan loc $ setSrcSpan loc $
tcMatchesFun (L nm_loc mono_name) matches (mkCheckExpType tau) tcMatchesFun (L nm_loc mono_name) matches (mkCheckExpType tau)
...@@ -1457,8 +1457,8 @@ tcExtendTyVarEnvFromSig :: TcIdSigInst -> TcM a -> TcM a ...@@ -1457,8 +1457,8 @@ tcExtendTyVarEnvFromSig :: TcIdSigInst -> TcM a -> TcM a
tcExtendTyVarEnvFromSig sig_inst thing_inside tcExtendTyVarEnvFromSig sig_inst thing_inside
| TISI { sig_inst_skols = skol_prs, sig_inst_wcs = wcs } <- sig_inst | TISI { sig_inst_skols = skol_prs, sig_inst_wcs = wcs } <- sig_inst
-- Note [Use tcExtendTyVar not scopeTyVars in tcRhs] -- Note [Use tcExtendTyVar not scopeTyVars in tcRhs]
= tcExtendTyVarEnv2 wcs $ = tcExtendNameTyVarEnv wcs $
tcExtendTyVarEnv2 skol_prs $ tcExtendNameTyVarEnv skol_prs $
thing_inside thing_inside
tcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a tcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a
......
...@@ -27,7 +27,7 @@ module TcEnv( ...@@ -27,7 +27,7 @@ module TcEnv(
-- Local environment -- Local environment
tcExtendKindEnv, tcExtendKindEnvList, tcExtendKindEnv, tcExtendKindEnvList,
tcExtendTyVarEnv, tcExtendTyVarEnv2, tcExtendTyVarEnv, tcExtendNameTyVarEnv,
tcExtendLetEnv, tcExtendSigIds, tcExtendRecIds, tcExtendLetEnv, tcExtendSigIds, tcExtendRecIds,
tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
tcExtendBinderStack, tcExtendLocalTypeEnv, tcExtendBinderStack, tcExtendLocalTypeEnv,
...@@ -464,13 +464,13 @@ tcExtendKindEnv extra_env thing_inside ...@@ -464,13 +464,13 @@ tcExtendKindEnv extra_env thing_inside
-- bumps the TcLevel. -- bumps the TcLevel.
tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
tcExtendTyVarEnv tvs thing_inside tcExtendTyVarEnv tvs thing_inside
= tcExtendTyVarEnv2 (mkTyVarNamePairs tvs) thing_inside = tcExtendNameTyVarEnv (mkTyVarNamePairs tvs) thing_inside
-- Before using this function, consider using TcHsType.scopeTyVars2, which -- Before using this function, consider using TcHsType.scopeTyVars2, which
-- bumps the TcLevel and thus prevents any of these TyVars from appearing -- bumps the TcLevel and thus prevents any of these TyVars from appearing
-- in kinds of tyvars in an outer scope. -- in kinds of tyvars in an outer scope.
tcExtendTyVarEnv2 :: [(Name,TcTyVar)] -> TcM r -> TcM r tcExtendNameTyVarEnv :: [(Name,TcTyVar)] -> TcM r -> TcM r
tcExtendTyVarEnv2 binds thing_inside tcExtendNameTyVarEnv binds thing_inside
-- this should be used only for explicitly mentioned scoped variables. -- this should be used only for explicitly mentioned scoped variables.
-- thus, no coercion variables -- thus, no coercion variables
= do { tc_extend_local_env NotTopLevel = do { tc_extend_local_env NotTopLevel
......
...@@ -1583,7 +1583,7 @@ tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) ...@@ -1583,7 +1583,7 @@ tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc })
; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs ; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs
skol_tvs = map snd tv_prs skol_tvs = map snd tv_prs
; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $ ; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $
tcExtendTyVarEnv2 tv_prs $ tcExtendNameTyVarEnv tv_prs $
tcPolyExprNC expr tau tcPolyExprNC expr tau
; let poly_wrap = mkWpTyLams skol_tvs ; let poly_wrap = mkWpTyLams skol_tvs
...@@ -1596,8 +1596,8 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) ...@@ -1596,8 +1596,8 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
do { (tclvl, wanted, (expr', sig_inst)) do { (tclvl, wanted, (expr', sig_inst))
<- pushLevelAndCaptureConstraints $ <- pushLevelAndCaptureConstraints $
do { sig_inst <- tcInstSig sig do { sig_inst <- tcInstSig sig
; expr' <- tcExtendTyVarEnv2 (sig_inst_skols sig_inst) $ ; expr' <- tcExtendNameTyVarEnv (sig_inst_skols sig_inst) $
tcExtendTyVarEnv2 (sig_inst_wcs sig_inst) $ tcExtendNameTyVarEnv (sig_inst_wcs sig_inst) $
tcPolyExprNC expr (sig_inst_tau sig_inst) tcPolyExprNC expr (sig_inst_tau sig_inst)
; return (expr', sig_inst) } ; return (expr', sig_inst) }
-- See Note [Partial expression signatures] -- See Note [Partial expression signatures]
......
...@@ -1516,7 +1516,7 @@ tcWildCardBindersX new_wc maybe_skol_info wc_names thing_inside ...@@ -1516,7 +1516,7 @@ tcWildCardBindersX new_wc maybe_skol_info wc_names thing_inside
where where
scope_tvs scope_tvs
| Just info <- maybe_skol_info = scopeTyVars2 info | Just info <- maybe_skol_info = scopeTyVars2 info
| otherwise = tcExtendTyVarEnv2 | otherwise = tcExtendNameTyVarEnv
-- | Kind-check a 'LHsQTyVars'. If the decl under consideration has a complete, -- | Kind-check a 'LHsQTyVars'. If the decl under consideration has a complete,
-- user-supplied kind signature (CUSK), generalise the result. -- user-supplied kind signature (CUSK), generalise the result.
...@@ -1922,7 +1922,7 @@ scopeTyVars2 :: SkolemInfo -> [(Name, TcTyVar)] -> TcM a -> TcM a ...@@ -1922,7 +1922,7 @@ scopeTyVars2 :: SkolemInfo -> [(Name, TcTyVar)] -> TcM a -> TcM a
scopeTyVars2 skol_info prs thing_inside scopeTyVars2 skol_info prs thing_inside
= fmap snd $ -- discard the TcEvBinds, which will always be empty = fmap snd $ -- discard the TcEvBinds, which will always be empty
checkConstraints skol_info (map snd prs) [{- no EvVars -}] $ checkConstraints skol_info (map snd prs) [{- no EvVars -}] $
tcExtendTyVarEnv2 prs $ tcExtendNameTyVarEnv prs $
thing_inside thing_inside
------------------ ------------------
...@@ -2079,7 +2079,7 @@ kcTyClTyVars :: Name -> TcM a -> TcM a ...@@ -2079,7 +2079,7 @@ kcTyClTyVars :: Name -> TcM a -> TcM a
kcTyClTyVars tycon_name thing_inside kcTyClTyVars tycon_name thing_inside
-- See Note [Use SigTvs in kind-checking pass] in TcTyClsDecls -- See Note [Use SigTvs in kind-checking pass] in TcTyClsDecls
= do { tycon <- kcLookupTcTyCon tycon_name = do { tycon <- kcLookupTcTyCon tycon_name
; tcExtendTyVarEnv2 (tcTyConScopedTyVars tycon) $ thing_inside } ; tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ thing_inside }
tcTyClTyVars :: Name tcTyClTyVars :: Name
-> ([TyConBinder] -> Kind -> TcM a) -> TcM a -> ([TyConBinder] -> Kind -> TcM a) -> TcM a
......
...@@ -1303,7 +1303,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys ...@@ -1303,7 +1303,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
, ib_derived = is_derived }) , ib_derived = is_derived })
-- tcExtendTyVarEnv (not scopeTyVars) is OK because the TcLevel is pushed -- tcExtendTyVarEnv (not scopeTyVars) is OK because the TcLevel is pushed
-- in checkInstConstraints -- in checkInstConstraints
= tcExtendTyVarEnv2 (lexical_tvs `zip` tyvars) $ = tcExtendNameTyVarEnv (lexical_tvs `zip` tyvars) $
-- The lexical_tvs scope over the 'where' part -- The lexical_tvs scope over the 'where' part
do { traceTc "tcInstMeth" (ppr sigs $$ ppr binds) do { traceTc "tcInstMeth" (ppr sigs $$ ppr binds)
; checkMinimalDefinition ; checkMinimalDefinition
......
...@@ -409,12 +409,12 @@ tc_pat penv (ViewPat _ expr pat) overall_pat_ty thing_inside ...@@ -409,12 +409,12 @@ tc_pat penv (ViewPat _ expr pat) overall_pat_ty thing_inside
tc_pat penv (SigPat sig_ty pat ) pat_ty thing_inside tc_pat penv (SigPat sig_ty pat ) pat_ty thing_inside
= do { (inner_ty, tv_binds, wcs, wrap) <- tcPatSig (inPatBind penv) = do { (inner_ty, tv_binds, wcs, wrap) <- tcPatSig (inPatBind penv)
sig_ty pat_ty sig_ty pat_ty
-- Using tcExtendTyVarEnv2 is appropriate here (not scopeTyVars2) -- Using tcExtendNameTyVarEnv is appropriate here (not scopeTyVars2)
-- because we're not really bringing fresh tyvars into scope. -- because we're not really bringing fresh tyvars into scope.
-- We're *naming* existing tyvars. Note that it is OK for a tyvar -- We're *naming* existing tyvars. Note that it is OK for a tyvar
-- from an outer scope to mention one of these tyvars in its kind. -- from an outer scope to mention one of these tyvars in its kind.
; (pat', res) <- tcExtendTyVarEnv2 wcs $ ; (pat', res) <- tcExtendNameTyVarEnv wcs $
tcExtendTyVarEnv2 tv_binds $ tcExtendNameTyVarEnv tv_binds $
tc_lpat pat (mkCheckExpType inner_ty) penv thing_inside tc_lpat pat (mkCheckExpType inner_ty) penv thing_inside
; pat_ty <- readExpType pat_ty ; pat_ty <- readExpType pat_ty
; return (mkHsWrapPat wrap (SigPat inner_ty pat') pat_ty, res) } ; return (mkHsWrapPat wrap (SigPat inner_ty pat') pat_ty, res) }
......
...@@ -155,7 +155,7 @@ tcRuleBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs) ...@@ -155,7 +155,7 @@ tcRuleBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs)
-- See Note [Pattern signature binders] in TcHsType -- See Note [Pattern signature binders] in TcHsType
-- The type variables scope over subsequent bindings; yuk -- The type variables scope over subsequent bindings; yuk
; vars <- tcExtendTyVarEnv2 tvs $ ; vars <- tcExtendNameTyVarEnv tvs $
tcRuleBndrs rule_bndrs tcRuleBndrs rule_bndrs
; return (map snd tvs ++ id : vars) } ; return (map snd tvs ++ id : vars) }
tcRuleBndrs (L _ (XRuleBndr _) : _) = panic "tcRuleBndrs" tcRuleBndrs (L _ (XRuleBndr _) : _) = panic "tcRuleBndrs"
......
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