-- Returns True iff the data con *definitely cannot* match a
-- scrutinee of type (T tys)
-- where T is the type constructor for the data con
---
+-- NB: look at *all* equality constraints, not only those
+-- in dataConEqSpec; see Trac #5168
dataConCannotMatch tys con
- | null eq_spec = False -- Common
+ | null theta = False -- Common
| all isTyVarTy tys = False -- Also common
| otherwise
- = typesCantMatch (map (substTyVar subst . fst) eq_spec)
- (map snd eq_spec)
+ = typesCantMatch [(Type.substTy subst ty1, Type.substTy subst ty2)
+ | EqPred ty1 ty2 <- theta ]
where
dc_tvs = dataConUnivTyVars con
- eq_spec = dataConEqSpec con
+ theta = dataConTheta con
subst = zipTopTvSubst dc_tvs tys
\end{code}
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
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