[project @ 2004-11-10 01:56:00 by wolfgang]

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

diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index 6a05a98..061cd4b 100644 (file)
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -21,7 +21,7 @@ import CoreSyn
 import CoreUtils       ( exprIsValue, exprIsDupable )
 import CoreLint                ( showPass, endPass )
 import CoreFVs         ( CoreExprWithFVs, freeVars, freeVarsOf )
-import Id              ( isOneShotLambda )
+import Id              ( isOneShotBndr )
 import Var             ( Id, idType )
 import Type            ( isUnLiftedType )
 import VarSet
@@ -220,6 +220,9 @@ fiExpr to_drop (_, AnnNote InlineMe expr)
 fiExpr to_drop (_, AnnNote note@(Coerce _ _) expr)
   =    -- Just float in past coercion
     Note note (fiExpr to_drop expr)
+
+fiExpr to_drop (_, AnnNote note@(CoreNote _) expr)
+  = Note note (fiExpr to_drop expr)
 \end{code}
 
 For @Lets@, the possible ``drop points'' for the \tr{to_drop}
@@ -320,10 +323,11 @@ 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)
+-- gaw 2004
+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
@@ -354,7 +358,7 @@ noFloatIntoRhs (AnnLam b _)             = not (is_one_shot b)
 
 noFloatIntoRhs rhs = exprIsValue (deAnnotate' rhs)     -- We'd just float right back out again...
 
-is_one_shot b = isId b && isOneShotLambda b
+is_one_shot b = isId b && isOneShotBndr b
 \end{code}