X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=e2435c251d6f69d17db12cfa457e738eff30a67d;hb=8c9cfd756219ed60ebcdf5cd370a3d083fd7e4b8;hp=efc59d16cc3cae17a7ed1f1667d11f24be1ecc56;hpb=f0fc29ce3e100c613846b7b2daa1bee4c751138d;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index efc59d1..e2435c2 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 )
@@ -611,7 +612,6 @@ completeLazyBind env top_lvl old_bndr new_bndr new_rhs
 	-- means that we can avoid tests in exprIsConApp, for example.
 	-- This is important: if exprIsConApp says 'yes' for a recursive
 	-- thing, then we can get into an infinite loop
-
 	-- If the unfolding is a value, the demand info may
 	-- go pear-shaped, so we nuke it.  Example:
 	--	let x = (a,b) in
@@ -1520,6 +1520,7 @@ simplDefault :: SimplEnv
 
 simplDefault env case_bndr' imposs_cons cont Nothing
   = return []	-- No default branch
+
 simplDefault env case_bndr' imposs_cons cont (Just rhs)
   | 	-- This branch handles the case where we are 
 	-- scrutinisng an algebraic data type
@@ -1560,7 +1561,7 @@ simplDefault env case_bndr' imposs_cons cont (Just rhs)
 
 	two_or_more -> simplify_default (map DataAlt gadt_imposs ++ imposs_cons)
 
-  | otherwise
+  | otherwise 
   = simplify_default imposs_cons
   where
     cant_match tys data_con = not (dataConCanMatch data_con tys)
@@ -1696,7 +1697,7 @@ knownCon env scrut con args bndr alts cont
 				  simplExprF env rhs cont
 
 	(DataAlt dc, bs, rhs)  
-		-> ASSERT( n_drop_tys + length bs == length args )
+		-> -- ASSERT( n_drop_tys + length bs == length args )
 		   bind_args env dead_bndr bs (drop n_drop_tys args)	$ \ env ->
 		   let
 			-- It's useful to bind bndr to scrut, rather than to a fresh