X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=312ae943a8ca3c9987060f2fc4f1461142abeb1e;hp=fae899d4d1d29705be954df58c49cccfd80880d8;hb=c8c2f6bb7d79a2a6aeaa3233363fdf0bbbfad205;hpb=fdf8656855d26105ff36bdd24d41827b05037b91 diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index fae899d..312ae94 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -300,7 +300,7 @@ data DataCon -- the context constrains only universally quantified variables -- MkT :: forall a b. (a ~ b, Ord b) => a -> T a b dcOtherTheta :: ThetaType, -- The other constraints in the data con's type - -- *other than* those in the dcEqSpec + -- other than those in the dcEqSpec dcStupidTheta :: ThetaType, -- The context of the data type declaration -- data Eq a => T a = ... @@ -659,7 +659,7 @@ dataConStrictMarks = dcStrictMarks -- | Strictness of evidence arguments to the wrapper function dataConExStricts :: DataCon -> [HsBang] -- Usually empty, so we don't bother to cache this -dataConExStricts dc = map mk_dict_strict_mark $ (dcOtherTheta dc) +dataConExStricts dc = map mk_dict_strict_mark $ (dataConTheta dc) -- | Source-level arity of the data constructor dataConSourceArity :: DataCon -> Arity @@ -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}