[project @ 2006-01-06 16:30:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / simplCore / FloatIn.lhs

diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index a4002a5..0e8edb5 100644 (file)
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -16,9 +16,9 @@ module FloatIn ( floatInwards ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( DynFlags, DynFlag(..) )
+import DynFlags        ( DynFlags, DynFlag(..) )
 import CoreSyn
-import CoreUtils       ( exprIsValue, exprIsDupable )
+import CoreUtils       ( exprIsHNF, exprIsDupable )
 import CoreLint                ( showPass, endPass )
 import CoreFVs         ( CoreExprWithFVs, freeVars, freeVarsOf )
 import Id              ( isOneShotBndr )
@@ -323,10 +323,10 @@ bindings are: (a)~inside the scrutinee, (b)~inside one of the
 alternatives/default [default FVs always {\em first}!].
 
 \begin{code}
-fiExpr to_drop (_, AnnCase scrut case_bndr alts)
+fiExpr to_drop (_, AnnCase scrut case_bndr ty alts)
   = mkCoLets' drop_here1 $
     mkCoLets' drop_here2 $
-    Case (fiExpr scrut_drops scrut) case_bndr
+    Case (fiExpr scrut_drops scrut) case_bndr ty
         (zipWith fi_alt alts_drops_s alts)
   where
        -- Float into the scrut and alts-considered-together just like App
@@ -355,7 +355,7 @@ noFloatIntoRhs (AnnLam b _)             = not (is_one_shot b)
        -- boxing constructor into it, else we box it every time which is very bad
        -- news indeed.
 
-noFloatIntoRhs rhs = exprIsValue (deAnnotate' rhs)     -- We'd just float right back out again...
+noFloatIntoRhs rhs = exprIsHNF (deAnnotate' rhs)       -- We'd just float right back out again...
 
 is_one_shot b = isId b && isOneShotBndr b
 \end{code}