X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplCase.lhs;h=a539af9e42c43716ee79d54cb93ce20653aaa4e7;hb=f01a8e8c9c53bfb5ab3393ed3457ebf25390efa1;hp=6783e1154d070c7fd90598bcc1d7e606b7bfa0a9;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplCase.lhs b/ghc/compiler/simplCore/SimplCase.lhs
index 6783e11..a539af9 100644
--- a/ghc/compiler/simplCore/SimplCase.lhs
+++ b/ghc/compiler/simplCore/SimplCase.lhs
@@ -36,7 +36,7 @@ import SimplUtils	( mkValLamTryingEta )
 import Type		( isPrimType, maybeAppDataTyCon, mkFunTys, eqTy )
 import Unique		( Unique{-instance Eq-} )
 import Usage		( GenUsage{-instance Eq-} )
-import Util		( isIn, isSingleton, panic, assertPanic )
+import Util		( isIn, isSingleton, zipEqual, panic, assertPanic )
 \end{code}
 
 Float let out of case.
@@ -681,7 +681,7 @@ completeAlgCaseWithKnownCon env con con_args (AlgAlts alts deflt) rhs_c
       | alt_con == con
       = 	-- Matching alternative!
 	let
-	    new_env = extendIdEnvWithAtomList env (zip alt_args con_args)
+	    new_env = extendIdEnvWithAtomList env (zipEqual alt_args (filter isValArg con_args))
 	in
 	rhs_c new_env rhs