-We do define a specialised equality for these \tr{*Type} types; used
-in checking interfaces. Most any other use is likely to be {\em
-wrong}, so be careful!
-\begin{code}
-#ifdef COMPILING_GHC
-
-cmpPolyType :: (a -> a -> TAG_) -> PolyType a -> PolyType a -> TAG_
-cmpMonoType :: (a -> a -> TAG_) -> MonoType a -> MonoType a -> TAG_
-cmpContext :: (a -> a -> TAG_) -> Context a -> Context a -> TAG_
-
--- We assume that HsPreForAllTys have been smashed by now.
-# ifdef DEBUG
-cmpPolyType _ (HsPreForAllTy _ _) _ = panic# "cmpPolyType:HsPreForAllTy:1st arg"
-cmpPolyType _ _ (HsPreForAllTy _ _) = panic# "cmpPolyType:HsPreForAllTy:2nd arg"
-# endif
-
-cmpPolyType cmp (HsForAllTy tvs1 c1 t1) (HsForAllTy tvs2 c2 t2)
- = case (cmp_tvs tvs1 tvs2) of
- EQ_ -> case (cmpContext cmp c1 c2) of
- EQ_ -> cmpMonoType cmp t1 t2
- xxx -> xxx
- xxx -> xxx
- where
- cmp_tvs [] [] = EQ_
- cmp_tvs [] _ = LT_
- cmp_tvs _ [] = GT_
- cmp_tvs (a:as) (b:bs)
- = case cmp a b of { EQ_ -> cmp_tvs as bs; xxx -> xxx }
- cmp_tvs _ _ = panic# "cmp_tvs"
-
------------
-cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2)
- = cmp n1 n2
-
-cmpMonoType cmp (MonoTupleTy tys1) (MonoTupleTy tys2)
- = cmpList (cmpMonoType cmp) tys1 tys2
-cmpMonoType cmp (MonoListTy ty1) (MonoListTy ty2)
- = cmpMonoType cmp ty1 ty2
-
-cmpMonoType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
- = case cmp tc1 tc2 of { EQ_ -> cmpList (cmpMonoType cmp) tys1 tys2; xxx -> xxx }
-
-cmpMonoType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
- = case cmpMonoType cmp a1 a2 of { EQ_ -> cmpMonoType cmp b1 b2; xxx -> xxx }
-
-cmpMonoType cmp (MonoDictTy c1 ty1) (MonoDictTy c2 ty2)
- = case cmp c1 c2 of { EQ_ -> cmpMonoType cmp ty1 ty2; xxx -> xxx }
-
-cmpMonoType cmp ty1 ty2 -- tags must be different
- = let tag1 = tag ty1
- tag2 = tag ty2
- in
- if tag1 _LT_ tag2 then LT_ else GT_
- where
- tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT)
- tag (MonoTupleTy tys1) = ILIT(2)
- tag (MonoListTy ty1) = ILIT(3)
- tag (MonoTyApp tc1 tys1) = ILIT(4)
- tag (MonoFunTy a1 b1) = ILIT(5)
- tag (MonoDictTy c1 ty1) = ILIT(7)
-
--------------------
-cmpContext cmp a b
- = cmpList cmp_ctxt a b
- where
- cmp_ctxt (c1, tv1) (c2, tv2)
- = case cmp c1 c2 of { EQ_ -> cmp tv1 tv2; xxx -> xxx }
-
--------------------
-\end{code}
-