X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=0dde73d4b36f1d55f95767fbda8cb8e626cc95c3;hb=8912a05e1bcc30c7e8e5e017d9cf10176076f141;hp=f9cc644157f0f9c086e09cbf7c27221e08c04ccf;hpb=6fcf90065dc4e75b7dc6bbf238a9891a71ae5a86;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index f9cc644..0dde73d 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -44,7 +44,8 @@ import CoreUtils	( exprIsDupable, exprIsTrivial, needsCaseBinding,
 			  exprIsConApp_maybe, mkPiTypes, findAlt, 
 			  exprType, exprIsHNF, findDefault, mergeAlts,
 			  exprOkForSpeculation, exprArity, 
-			  mkCoerce, mkSCC, mkInlineMe, applyTypeToArg
+			  mkCoerce, mkSCC, mkInlineMe, applyTypeToArg,
+                          dataConInstPat
 			)
 import Rules		( lookupRule )
 import BasicTypes	( isMarkedStrict )
@@ -1552,7 +1553,10 @@ simplDefault env case_bndr' imposs_cons cont (Just rhs)
 
 	[con] -> 	-- It matches exactly one constructor, so fill it in
 		 do { tick (FillInCaseDefault case_bndr')
-		    ; con_alt <- mkDataConAlt con inst_tys rhs
+                    ; us <- getUniquesSmpl
+                    ; let (ex_tvs, co_tvs, arg_ids) =
+                              dataConInstPat us con inst_tys
+                    ; let con_alt = (DataAlt con, ex_tvs ++ co_tvs ++ arg_ids, rhs)
 		    ; Just (_, alt') <- simplAlt env [] case_bndr' cont con_alt
 			-- The simplAlt must succeed with Just because we have
 			-- already filtered out construtors that can't match