X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=f477038f5d69b3574a262c09608838f70b5af7e6;hb=29e736b7089d535b53e3f02ef04d36331921e42a;hp=e2435c251d6f69d17db12cfa457e738eff30a67d;hpb=8c9cfd756219ed60ebcdf5cd370a3d083fd7e4b8;p=ghc-hetmet.git diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index e2435c2..f477038 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -45,7 +45,7 @@ import CoreUtils ( exprIsDupable, exprIsTrivial, needsCaseBinding, exprType, exprIsHNF, findDefault, mergeAlts, exprOkForSpeculation, exprArity, mkCoerce, mkSCC, mkInlineMe, applyTypeToArg, - dataConInstPat + dataConRepInstPat ) import Rules ( lookupRule ) import BasicTypes ( isMarkedStrict ) @@ -1553,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) = + dataConRepInstPat 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