-- * Type free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
- expandTypeSynonyms,
+ expandTypeSynonyms,
+ typeSize,
-- * Type comparison
coreEqType, coreEqType2,
getTvSubstEnv, setTvSubstEnv, zapTvSubstEnv, getTvInScope,
extendTvInScope, extendTvInScopeList,
extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
- isEmptyTvSubst,
+ isEmptyTvSubst, unionTvSubst,
-- ** Performing substitution on types
substTy, substTys, substTyWith, substTysWith, substTheta,
\begin{code}
tyVarsOfType :: Type -> TyVarSet
-- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
-tyVarsOfType (TyVarTy tv) = unitVarSet tv
-tyVarsOfType (TyConApp _ tys) = tyVarsOfTypes tys
-tyVarsOfType (PredTy sty) = tyVarsOfPred sty
-tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
-tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
-tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
+tyVarsOfType (TyVarTy tv) = unitVarSet tv
+tyVarsOfType (TyConApp _ tys) = tyVarsOfTypes tys
+tyVarsOfType (PredTy sty) = tyVarsOfPred sty
+tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
+tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
+tyVarsOfType (ForAllTy tv ty) -- The kind of a coercion binder
+ -- can mention type variables!
+ | isTyVar tv = inner_tvs `delVarSet` tv
+ | otherwise {- Coercion -} = -- ASSERT( not (tv `elemVarSet` inner_tvs) )
+ inner_tvs `unionVarSet` tyVarsOfType (tyVarKind tv)
+ where
+ inner_tvs = tyVarsOfType ty
tyVarsOfTypes :: [Type] -> TyVarSet
tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
%************************************************************************
%* *
+ Size
+%* *
+%************************************************************************
+
+\begin{code}
+typeSize :: Type -> Int
+typeSize (TyVarTy _) = 1
+typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2
+typeSize (FunTy t1 t2) = typeSize t1 + typeSize t2
+typeSize (PredTy p) = predSize p
+typeSize (ForAllTy _ t) = 1 + typeSize t
+typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
+
+predSize :: PredType -> Int
+predSize (IParam _ t) = 1 + typeSize t
+predSize (ClassP _ ts) = 1 + sum (map typeSize ts)
+predSize (EqPred t1 t2) = typeSize t1 + typeSize t2
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Type families}
%* *
%************************************************************************
extendTvSubstList (TvSubst in_scope env) tvs tys
= TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
+unionTvSubst :: TvSubst -> TvSubst -> TvSubst
+-- Works when the ranges are disjoint
+unionTvSubst (TvSubst in_scope1 env1) (TvSubst in_scope2 env2)
+ = ASSERT( not (env1 `intersectsVarEnv` env2) )
+ TvSubst (in_scope1 `unionInScope` in_scope2)
+ (env1 `plusVarEnv` env2)
+
-- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
-- the types given; but it's just a thunk so with a bit of luck
-- it'll never be evaluated