[project @ 1996-04-30 17:34:02 by partain]

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

diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index 27b6c08..b534011 100644 (file)
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -172,12 +172,11 @@ fiExpr to_drop (_,AnnLam b@(TyBinder tyvar) body)
   where
     whnf :: CoreExprWithFVs -> Bool
 
-    whnf (_,AnnLit _)              = True
-    whnf (_,AnnCon _ _)                    = True
-    whnf (_,AnnLam (ValBinder _) _) = True
-    whnf (_,AnnLam _             e) = whnf e
-    whnf (_,AnnSCC _ e)                    = whnf e
-    whnf _                         = False
+    whnf (_,AnnLit _)  = True
+    whnf (_,AnnCon _ _)        = True
+    whnf (_,AnnLam x e) = if isValBinder x then True else whnf e
+    whnf (_,AnnSCC _ e)        = whnf e
+    whnf _             = False
 \end{code}
 
 Applications: we could float inside applications, but it's probably
@@ -201,6 +200,12 @@ fiExpr to_drop (_, AnnSCC cc expr)
   = mkCoLets' to_drop (SCC cc (fiExpr [] expr))
 \end{code}
 
+\begin{code}
+fiExpr to_drop (_, AnnCoerce c ty expr)
+  = _trace "fiExpr:Coerce:wimping out" $
+    mkCoLets' to_drop (Coerce c ty (fiExpr [] expr))
+\end{code}
+
 For @Lets@, the possible ``drop points'' for the \tr{to_drop}
 bindings are: (a)~in the body, (b1)~in the RHS of a NonRec binding,
 or~(b2), in each of the RHSs of the pairs of a @Rec@.