projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fixed two bugs concerning fanilies
[ghc-hetmet.git]
/
compiler
/
simplCore
/
Simplify.lhs
diff --git
a/compiler/simplCore/Simplify.lhs
b/compiler/simplCore/Simplify.lhs
index
e2435c2
..
f477038
100644
(file)
--- 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,
exprType, exprIsHNF, findDefault, mergeAlts,
exprOkForSpeculation, exprArity,
mkCoerce, mkSCC, mkInlineMe, applyTypeToArg,
- dataConInstPat
+ dataConRepInstPat
)
import Rules ( lookupRule )
import BasicTypes ( isMarkedStrict )
)
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] -> -- 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
; 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