X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FFloatIn.lhs;fp=ghc%2Fcompiler%2FsimplCore%2FFloatIn.lhs;h=6fc36c8de249f3006149c890fff605980a27dd31;hb=cfcebde74cf826af12143a92bcffa8c995eee135;hp=53188bac738dbc4c252a86fe4040d1b8fe8dab5d;hpb=7dd11ebc4d4d091edc0f5e3c13f041b99961c136;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index 53188ba..6fc36c8 100644
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -142,6 +142,11 @@ fiExpr to_drop (_, AnnType ty) = ASSERT( null to_drop )
 				 Type ty
 
 fiExpr to_drop (_, AnnCon c args)
+   | isDataCon c	-- Don't float into the args of a data construtor;
+			-- the simplifier will float straight back out
+   = mkCoLets' to_drop (Con c (map (fiExpr []) args))
+
+   | otherwise
    = mkCoLets' drop_here (Con c args')
    where
      (drop_here : arg_drops) = sepBindsByDropPoint (map freeVarsOf args) to_drop