X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=85b4b49f659f5b840895ae199aadce398fd4b9d3;hb=4a7acfe8e74b4367c8043db7b824f203bf13ce00;hp=36e723d20919d9b62741b0df49492a8122a41a63;hpb=99cf312c0bacfd96f7b2827bd3dc12aaa8fa920f;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 36e723d..85b4b49 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -611,7 +611,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
@@ -814,9 +813,12 @@ simplCast env body co cont
            -- t2 :=: s2 with left and right on the curried form: 
            --    (->) t1 t2 :=: (->) s1 s2
            [co1, co2] = decomposeCo 2 co
-           new_arg    = mkCoerce (mkSymCoercion co1) (substExpr arg_env arg)
-           arg_env    = setInScope arg_se env
-           result     = ApplyTo dup new_arg (zapSubstEnv env) (addCoerce co2 cont)
+           new_arg    = mkCoerce (mkSymCoercion co1) arg'
+	   arg'       = case arg_se of
+			  Nothing     -> arg
+			  Just arg_se -> substExpr (setInScope arg_se env) arg
+           result     = ApplyTo dup new_arg (Just $ zapSubstEnv env) 
+				(addCoerce co2 cont)
        addCoerce co cont = CoerceIt co cont
     in
     simplType env co		`thenSmpl` \ co' ->
@@ -1517,6 +1519,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
@@ -1557,7 +1560,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)
@@ -1713,6 +1716,7 @@ knownCon env scrut con args bndr alts cont
 		   simplNonRecX env bndr bndr_rhs		$ \ env ->
 		   simplExprF env rhs cont
 	        where
+		   dead_bndr  = isDeadBinder bndr
 		   n_drop_tys = tyConArity (dataConTyCon dc)
 
 -- Ugh!