X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FUnify.lhs;fp=compiler%2Ftypes%2FUnify.lhs;h=9c448ce0653af13079713ebe84b28896ced3781d;hp=38507830ab8523c706196b265590345f9be46813;hb=a10a21dadac041e928ad5dab3810b68ab35bc9bb;hpb=5096055e9aa46a7cc8b5a1292f7094fe588ec4d1 diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 3850783..9c448ce 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -316,9 +316,8 @@ anything, type functions (incl newtypes) match anything, and only distinct data types fail to match. We can elaborate later. \begin{code} -typesCantMatch :: [Type] -> [Type] -> Bool -typesCantMatch tys1 tys2 = ASSERT( equalLength tys1 tys2 ) - or (zipWith cant_match tys1 tys2) +typesCantMatch :: [(Type,Type)] -> Bool +typesCantMatch prs = any (\(s,t) -> cant_match s t) prs where cant_match :: Type -> Type -> Bool cant_match t1 t2 @@ -330,7 +329,7 @@ typesCantMatch tys1 tys2 = ASSERT( equalLength tys1 tys2 ) cant_match (TyConApp tc1 tys1) (TyConApp tc2 tys2) | isDataTyCon tc1 && isDataTyCon tc2 - = tc1 /= tc2 || typesCantMatch tys1 tys2 + = tc1 /= tc2 || typesCantMatch (zipEqual "typesCantMatch" tys1 tys2) cant_match (FunTy {}) (TyConApp tc _) = isDataTyCon tc cant_match (TyConApp tc _) (FunTy {}) = isDataTyCon tc