Define mkTvSubst, and use it

   mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst
produces a TCvSubst with an empty CvSubstEnv

compiler/typecheck/TcDeriv.hs

@@ -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)

compiler/typecheck/TcGenDeriv.hs

@@ -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)
 

compiler/typecheck/TcInstDcls.hs

@@ -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.

compiler/typecheck/TcType.hs

@@ -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,

compiler/types/FamInstEnv.hs

@@ -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]

compiler/types/TyCoRep.hs

@@ -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'

compiler/types/Unify.hs

@@ -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,