X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FFloatIn.lhs;fp=compiler%2FsimplCore%2FFloatIn.lhs;h=48daf7853b422c41c8075c2b4e39830e73346912;hp=82825c3abef0afa14d412ea769c49ff99be603ac;hb=c8c2f6bb7d79a2a6aeaa3233363fdf0bbbfad205;hpb=025477ef644353f9168a16d0cb9431bcca36be4d

diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index 82825c3..48daf78 100644
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -126,16 +126,15 @@ fiExpr :: FloatingBinds		-- Binds we're trying to drop
        -> CoreExprWithFVs	-- Input expr
        -> CoreExpr		-- Result
 
-fiExpr to_drop (_, AnnVar v) = mkCoLets' to_drop (Var v)
-
-fiExpr to_drop (_, AnnType ty) = ASSERT( null to_drop )
-                                  Type ty
-fiExpr to_drop (_, AnnCoercion co) = ASSERT( null to_drop )
-                                     Coercion co
-fiExpr to_drop (_, AnnCast expr co)
-  = Cast (fiExpr to_drop expr) co	-- Just float in past coercion
-
-fiExpr _ (_, AnnLit lit) = Lit lit
+fiExpr to_drop (_, AnnLit lit)     = ASSERT( null to_drop ) Lit lit
+fiExpr to_drop (_, AnnType ty)     = ASSERT( null to_drop ) Type ty
+fiExpr to_drop (_, AnnVar v)       = mkCoLets' to_drop (Var v)
+fiExpr to_drop (_, AnnCoercion co) = mkCoLets' to_drop (Coercion co)
+fiExpr to_drop (_, AnnCast expr (fvs_co, co))
+  = mkCoLets' (drop_here ++ co_drop) $
+    Cast (fiExpr e_drop expr) co
+  where
+    [drop_here, e_drop, co_drop] = sepBindsByDropPoint False [freeVarsOf expr, fvs_co] to_drop
 \end{code}
 
 Applications: we do float inside applications, mainly because we