X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;fp=compiler%2FbasicTypes%2FDataCon.lhs;h=458bfd3f8193ac6eca8402344223311ed3f52898;hp=5e359848e2248b81b83eea7eeb100cb8fd7d84b5;hb=a10a21dadac041e928ad5dab3810b68ab35bc9bb;hpb=5096055e9aa46a7cc8b5a1292f7094fe588ec4d1 diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 5e359848..458bfd3 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -835,16 +835,17 @@ dataConCannotMatch :: [Type] -> DataCon -> Bool -- 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}