Commit fac0efc3 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Define mkTvSubst, and use it

   mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst
produces a TCvSubst with an empty CvSubstEnv
parent 96d45145
......@@ -43,7 +43,6 @@ import Avail
import Unify( tcUnifyTy )
import Class
import Type
import Coercion
import ErrUtils
import DataCon
import Maybes
......@@ -2107,8 +2106,7 @@ genDerivStuff loc clas dfun_name tycon inst_tys tyvars
-- resort is -XDeriveAnyClass (since -XGeneralizedNewtypeDeriving
-- fell through).
let mini_env = mkVarEnv (classTyVars clas `zip` inst_tys)
mini_subst = mkTCvSubst (mkInScopeSet (mkVarSet tyvars))
(mini_env, emptyCvSubstEnv)
mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
; tyfam_insts <-
ASSERT2( isNothing (canDeriveAnyClass dflags tycon clas)
......
......@@ -2049,10 +2049,8 @@ mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty id
where
cls_tvs = classTyVars cls
in_scope = mkInScopeSet $ mkVarSet inst_tvs
lhs_subst = mkTCvSubst in_scope (zipTyEnv cls_tvs cls_tys, emptyCvSubstEnv)
rhs_subst = mkTCvSubst in_scope
( zipTyEnv cls_tvs (changeLast cls_tys rhs_ty)
, emptyCvSubstEnv )
lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs cls_tys)
rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast cls_tys rhs_ty))
(_class_tvs, _class_constraint, user_meth_ty)
= tcSplitMethodTy (varType id)
......
......@@ -37,7 +37,6 @@ import MkCore ( nO_METHOD_BINDING_ERROR_ID )
import Type
import TcEvidence
import TyCon
import Coercion ( emptyCvSubstEnv )
import CoAxiom
import DataCon
import Class
......@@ -529,8 +528,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
; (tyvars, theta, clas, inst_tys) <- tcHsClsInstType InstDeclCtxt poly_ty
; let mini_env = mkVarEnv (classTyVars clas `zip` inst_tys)
mini_subst = mkTCvSubst (mkInScopeSet (mkVarSet tyvars))
(mini_env, emptyCvSubstEnv)
mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
mb_info = Just (clas, mini_env)
-- Next, process any associated types.
......
......@@ -151,7 +151,7 @@ module TcType (
getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope,
extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubstAndInScope,
Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr,
extendTCvSubstList, isInScope, mkTCvSubst, zipTyEnv, zipCoEnv,
extendTCvSubstList, isInScope, mkTCvSubst, mkTvSubst, zipTyEnv, zipCoEnv,
Type.substTy, substTys, substTyWith, substTyWithCoVars,
substTyAddInScope,
substTyUnchecked, substTysUnchecked, substThetaUnchecked,
......
......@@ -1434,8 +1434,7 @@ emptyFlattenEnv :: InScopeSet -> FlattenEnv
emptyFlattenEnv in_scope
= FlattenEnv { fe_type_map = emptyTypeMap
, fe_in_scope = in_scope
, fe_subst = mkTCvSubst in_scope ( emptyTvSubstEnv
, emptyCvSubstEnv ) }
, fe_subst = mkEmptyTCvSubst in_scope }
-- See Note [Flattening]
flattenTys :: InScopeSet -> [Type] -> [Type]
......
......@@ -76,7 +76,9 @@ module TyCoRep (
-- * Substitutions
TCvSubst(..), TvSubstEnv, CvSubstEnv,
emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubstEnv, composeTCvSubst,
emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst, mkTCvSubst, getTvSubstEnv,
emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst,
mkTCvSubst, mkTvSubst,
getTvSubstEnv,
getCvSubstEnv, getTCvInScope, isInScope, notElemTCvSubst,
setTvSubstEnv, setCvSubstEnv, zapTCvSubst,
extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
......@@ -1570,6 +1572,10 @@ isEmptyTCvSubst (TCvSubst _ tenv cenv) = isEmptyVarEnv tenv && isEmptyVarEnv cen
mkTCvSubst :: InScopeSet -> (TvSubstEnv, CvSubstEnv) -> TCvSubst
mkTCvSubst in_scope (tenv, cenv) = TCvSubst in_scope tenv cenv
mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst
-- ^ Mkae a TCvSubst with specified tyvar subst and empty covar subst
mkTvSubst in_scope tenv = TCvSubst in_scope tenv emptyCvSubstEnv
getTvSubstEnv :: TCvSubst -> TvSubstEnv
getTvSubstEnv (TCvSubst _ env _) = env
......@@ -1671,7 +1677,7 @@ zipTvSubst tvs tys
, not (all isTyVar tvs) || length tvs /= length tys
= pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst
| otherwise
= TCvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv emptyCvSubstEnv
= mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv
where
tenv = zipTyEnv tvs tys
......@@ -1691,7 +1697,7 @@ zipCvSubst cvs cos
-- NB: It is specifically OK if the lists are of different lengths.
zipTyBinderSubst :: [TyBinder] -> [Type] -> TCvSubst
zipTyBinderSubst bndrs tys
= TCvSubst is tenv emptyCvSubstEnv
= mkTvSubst is tenv
where
is = mkInScopeSet (tyCoVarsOfTypes tys)
tenv = mkVarEnv [ (tv, ty) | (Named tv _, ty) <- zip bndrs tys ]
......@@ -1701,7 +1707,7 @@ zipTyBinderSubst bndrs tys
mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst
mkTvSubstPrs prs =
ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs )
TCvSubst in_scope tenv emptyCvSubstEnv
mkTvSubst in_scope tenv
where tenv = mkVarEnv prs
in_scope = mkInScopeSet $ tyCoVarsOfTypes $ map snd prs
onlyTyVarsAndNoCoercionTy =
......@@ -1824,7 +1830,7 @@ substTyWithUnchecked tvs tys
substTyWithInScope :: InScopeSet -> [TyVar] -> [Type] -> Type -> Type
substTyWithInScope in_scope tvs tys ty =
ASSERT( length tvs == length tys )
substTy (mkTCvSubst in_scope (tenv, emptyCvSubstEnv)) ty
substTy (mkTvSubst in_scope tenv) ty
where tenv = zipTyEnv tvs tys
-- | Coercion substitution, see 'zipTvSubst'
......
......@@ -482,20 +482,18 @@ niFixTCvSubst tenv = f tenv
in_domain tv = tv `elemVarEnv` tenv
range_tvs = foldVarEnv (unionVarSet . tyCoVarsOfType) emptyVarSet tenv
subst = mkTCvSubst (mkInScopeSet range_tvs)
(tenv, emptyCvSubstEnv)
subst = mkTvSubst (mkInScopeSet range_tvs) tenv
-- env' extends env by replacing any free type with
-- that same tyvar with a substituted kind
-- See note [Finding the substitution fixpoint]
tenv' = extendVarEnvList tenv [ (rtv, mkTyVarTy $
setTyVarKind rtv $
substTy subst $
tyVarKind rtv)
| rtv <- varSetElems range_tvs
, not (in_domain rtv) ]
subst' = mkTCvSubst (mkInScopeSet range_tvs)
(tenv', emptyCvSubstEnv)
tenv' = extendVarEnvList tenv [ (rtv, mkTyVarTy $
setTyVarKind rtv $
substTy subst $
tyVarKind rtv)
| rtv <- varSetElems range_tvs
, not (in_domain rtv) ]
subst' = mkTvSubst (mkInScopeSet range_tvs) tenv'
niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet
-- Apply the non-idempotent substitution to a set of type variables,
......
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