-instance Eq Type where
- ty1 == ty2 = case ty1 `compare` ty2 of { EQ -> True; other -> False }
-
-instance Ord Type where
- compare ty1 ty2 = cmpTy emptyVarEnv ty1 ty2
-
-cmpTy :: TyVarEnv TyVar -> Type -> Type -> Ordering
- -- The "env" maps type variables in ty1 to type variables in ty2
- -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
- -- we in effect substitute tv2 for tv1 in t1 before continuing
-
- -- Get rid of NoteTy
-cmpTy env (NoteTy _ ty1) ty2 = cmpTy env ty1 ty2
-cmpTy env ty1 (NoteTy _ ty2) = cmpTy env ty1 ty2
-
- -- Get rid of PredTy
-cmpTy env (PredTy p1) (PredTy p2) = cmpPred env p1 p2
-cmpTy env (PredTy p1) ty2 = cmpTy env (predRepTy p1) ty2
-cmpTy env ty1 (PredTy p2) = cmpTy env ty1 (predRepTy p2)
-
- -- Deal with equal constructors
-cmpTy env (TyVarTy tv1) (TyVarTy tv2) = case lookupVarEnv env tv1 of
- Just tv1a -> tv1a `compare` tv2
- Nothing -> tv1 `compare` tv2
-
-cmpTy env (AppTy f1 a1) (AppTy f2 a2) = cmpTy env f1 f2 `thenCmp` cmpTy env a1 a2
-cmpTy env (FunTy f1 a1) (FunTy f2 a2) = cmpTy env f1 f2 `thenCmp` cmpTy env a1 a2
-cmpTy env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmpTys env tys1 tys2)
-cmpTy env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTy (extendVarEnv env tv1 tv2) t1 t2
-cmpTy env (UsageTy u1 t1) (UsageTy u2 t2) = cmpTy env u1 u2 `thenCmp` cmpTy env t1 t2
-
- -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < UsageTy
-cmpTy env (AppTy _ _) (TyVarTy _) = GT
+coreEqType :: Type -> Type -> Bool
+coreEqType t1 t2
+ = eq rn_env t1 t2
+ where
+ rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
+
+ eq env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
+ eq env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = eq (rnBndr2 env tv1 tv2) t1 t2
+ eq env (AppTy s1 t1) (AppTy s2 t2) = eq env s1 s2 && eq env t1 t2
+ eq env (FunTy s1 t1) (FunTy s2 t2) = eq env s1 s2 && eq env t1 t2
+ eq env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
+ | tc1 == tc2, all2 (eq env) tys1 tys2 = True
+ -- The lengths should be equal because
+ -- the two types have the same kind
+ -- NB: if the type constructors differ that does not
+ -- necessarily mean that the types aren't equal
+ -- (synonyms, newtypes)
+ -- Even if the type constructors are the same, but the arguments
+ -- differ, the two types could be the same (e.g. if the arg is just
+ -- ignored in the RHS). In both these cases we fall through to an
+ -- attempt to expand one side or the other.
+
+ -- Now deal with newtypes, synonyms, pred-tys
+ eq env t1 t2 | Just t1' <- coreView t1 = eq env t1' t2
+ | Just t2' <- coreView t2 = eq env t1 t2'
+
+ -- Fall through case; not equal!
+ eq env t1 t2 = False
+\end{code}
+
+
+%************************************************************************
+%* *
+ Comparision for source types
+ (We don't use instances so that we know where it happens)
+%* *
+%************************************************************************
+
+Note that
+ tcEqType, tcCmpType
+do *not* look through newtypes, PredTypes
+
+\begin{code}
+tcEqType :: Type -> Type -> Bool
+tcEqType t1 t2 = isEqual $ cmpType t1 t2
+
+tcEqTypes :: [Type] -> [Type] -> Bool
+tcEqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2
+
+tcCmpType :: Type -> Type -> Ordering
+tcCmpType t1 t2 = cmpType t1 t2
+
+tcCmpTypes :: [Type] -> [Type] -> Ordering
+tcCmpTypes tys1 tys2 = cmpTypes tys1 tys2
+
+tcEqPred :: PredType -> PredType -> Bool
+tcEqPred p1 p2 = isEqual $ cmpPred p1 p2
+
+tcCmpPred :: PredType -> PredType -> Ordering
+tcCmpPred p1 p2 = cmpPred p1 p2
+
+tcEqTypeX :: RnEnv2 -> Type -> Type -> Bool
+tcEqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2
+\end{code}
+
+Now here comes the real worker
+
+\begin{code}
+cmpType :: Type -> Type -> Ordering
+cmpType t1 t2 = cmpTypeX rn_env t1 t2
+ where
+ rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
+
+cmpTypes :: [Type] -> [Type] -> Ordering
+cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
+ where
+ rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
+
+cmpPred :: PredType -> PredType -> Ordering
+cmpPred p1 p2 = cmpPredX rn_env p1 p2
+ where
+ rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
+
+cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
+cmpTypeX env t1 t2 | Just t1' <- tcView t1 = cmpTypeX env t1' t2
+ | Just t2' <- tcView t2 = cmpTypeX env t1 t2'
+
+cmpTypeX env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 `compare` rnOccR env tv2
+cmpTypeX env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
+cmpTypeX env (AppTy s1 t1) (AppTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
+cmpTypeX env (FunTy s1 t1) (FunTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
+cmpTypeX env (PredTy p1) (PredTy p2) = cmpPredX env p1 p2
+cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
+cmpTypeX env t1 (NoteTy _ t2) = cmpTypeX env t1 t2
+
+ -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy
+cmpTypeX env (AppTy _ _) (TyVarTy _) = GT