X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=289fdef46ffab5890985130c2983e137ffbf3998;hb=3e83dfb21b2f2220dce97427fff5c19459ae68d1;hp=3eaadf759f533dbebeab04783778737ebd0b900c;hpb=d5bba9ee196f64a077e922680b16fe6f28fb79db;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index 3eaadf7..289fdef 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -409,7 +409,10 @@ mkDataCon name declared_infix
 	  eq_spec theta
 	  orig_arg_tys tycon
 	  stupid_theta ids
-  = con
+  = ASSERT( not (any isEqPred theta) )
+	-- We don't currently allow any equality predicates on
+	-- a data constructor (apart from the GADT ones in eq_spec)
+    con
   where
     is_vanilla = null ex_tvs && null eq_spec && null theta
     con = ASSERT( is_vanilla || not (isNewTyCon tycon) )
@@ -432,10 +435,9 @@ mkDataCon name declared_infix
 	-- The 'arg_stricts' passed to mkDataCon are simply those for the
 	-- source-language arguments.  We add extra ones for the
 	-- dictionary arguments right here.
-    (more_eq_preds, dict_preds) = partition isEqPred theta
     dict_tys     = mkPredTys theta
     real_arg_tys = dict_tys                      ++ orig_arg_tys
-    real_stricts = map mk_dict_strict_mark dict_preds ++ arg_stricts
+    real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
 
 	-- Representation arguments and demands
 	-- To do: eliminate duplication with MkId
@@ -601,10 +603,10 @@ dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
 
 -- And the same deal for the original arg tys
 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
-dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys,
+dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 			       dcUnivTyVars = univ_tvs, 
 			       dcExTyVars = ex_tvs}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
+ = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
    map (substTyWith tyvars inst_tys) arg_tys
  where
    tyvars = univ_tvs ++ ex_tvs