Fix Trac #5658: strict bindings not floated in

Two changes here

* The main change here is to enhance the FloatIn pass so that it can
  float case-bindings inwards.  In particular the case bindings for
  array indexing.

* Also change the code in Simplify, to allow a case on array
  indexing (ie can_fail is true) to be discarded altogether if its
  results are unused.

Lots of new comments in PrimOp about can_fail and has_side_effects

Some refactoring to share the FloatBind data structure between
FloatIn and FloatOut

1 files changed, 22 insertions, 0 deletions

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index dd41184994..15b43b45ee 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -21,6 +21,9 @@ module MkCore (
         mkFloatExpr, mkDoubleExpr,
         mkCharExpr, mkStringExpr, mkStringExprFS,
 
+        -- * Floats
+        FloatBind(..), wrapFloat,
+
         -- * Constructing/deconstructing implicit parameter boxes
         mkIPUnbox, mkIPBox,
 
@@ -389,6 +392,25 @@ mkBigCoreTupTy :: [Type] -> Type
 mkBigCoreTupTy = mkChunkified mkBoxedTupleTy
 \end{code}
 
+
+%************************************************************************
+%*                                                                      *
+                Floats
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+data FloatBind 
+  = FloatLet  CoreBind
+  | FloatCase CoreExpr Id AltCon [Var]       
+      -- case e of y { C ys -> ... }
+      -- See Note [Floating cases] in SetLevels
+
+wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
+wrapFloat (FloatLet defns)       body = Let defns body
+wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)]
+\end{code}
+
 %************************************************************************
 %*                                                                      *
 \subsection{Tuple destructors}