From: simonpj@microsoft.com <unknown>
Date: Tue, 21 Oct 2008 14:30:19 +0000 (+0000)
Subject: Don't float an expression wrapped in a cast
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e1e3d37b988c8839a74552bcebeef7f9293b0a6c

Don't float an expression wrapped in a cast

There is no point in floating out an expression wrapped in a coercion;
If we do we'll transform
	lvl = e |> co [_$_]
to
	lvl' = e; lvl = lvl' |> co
and then inline lvl.  Better just to float out the payload (e).
---

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 2c84589..e20bc83 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -376,6 +376,13 @@ lvlMFE ::  Bool			-- True <=> strict context [body of case or let]
 lvlMFE _ _ _ (_, AnnType ty)
   = return (Type ty)
 
+-- No point in floating out an expression wrapped in a coercion;
+-- If we do we'll transform  lvl = e |> co 
+--			 to  lvl' = e; lvl = lvl' |> co
+-- and then inline lvl.  Better just to float out the payload.
+lvlMFE strict_ctxt ctxt_lvl env (_, AnnCast e co)
+  = do	{ expr' <- lvlMFE strict_ctxt ctxt_lvl env e
+	; return (Cast expr' co) }
 
 lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
   |  isUnLiftedType ty			-- Can't let-bind it; see Note [Unlifted MFEs]