Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/488454620b77df3cb19069947ef14a3b445a444c >--------------------------------------------------------------- commit 488454620b77df3cb19069947ef14a3b445a444c Author: Geoffrey Mainland <[email protected]> Date: Thu Apr 26 13:00:07 2012 +0100 Allow case expressions with a single alternative to be floated in. This change generalizes support for floating in case expressions. Previously, case expression with an unlifted scrutinee and a single DEFAULT alternative were floated in. In particular, this allowed array index operations to be floated in. We also want to float in SIMD unpack primops, which return an unboxed tuple of scalars, thus the generalization. >--------------------------------------------------------------- compiler/simplCore/FloatIn.lhs | 16 ++++++++++++---- 1 files changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 0601d7b..c0c6478 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -354,19 +354,27 @@ For @Case@, the possible ``drop points'' for the \tr{to_drop} bindings are: (a)~inside the scrutinee, (b)~inside one of the alternatives/default [default FVs always {\em first}!]. +Floating case expressions inward was added to fix Trac #5658: strict bindings +not floated in. In particular, this change allows array indexing operations, +which have a single DEFAULT alternative without any binders, to be floated +inward. SIMD primops for unpacking SIMD vectors into an unboxed tuple of unboxed +scalars also need to be floated inward, but unpacks have a single non-DEFAULT +alternative that binds the elements of the tuple. We now therefore also support +floating in cases with a single alternative that may bind values. + \begin{code} -fiExpr to_drop (_, AnnCase scrut case_bndr _ [(DEFAULT,[],rhs)]) +fiExpr to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)]) | isUnLiftedType (idType case_bndr) , exprOkForSideEffects (deAnnotate scrut) = wrapFloats shared_binds $ fiExpr (case_float : rhs_binds) rhs where - case_float = FB (unitVarSet case_bndr) scrut_fvs - (FloatCase scrut' case_bndr DEFAULT []) + case_float = FB (mkVarSet (case_bndr : alt_bndrs)) scrut_fvs + (FloatCase scrut' case_bndr con alt_bndrs) scrut' = fiExpr scrut_binds scrut [shared_binds, scrut_binds, rhs_binds] = sepBindsByDropPoint False [freeVarsOf scrut, rhs_fvs] to_drop - rhs_fvs = freeVarsOf rhs `delVarSet` case_bndr + rhs_fvs = freeVarsOf rhs `delVarSetList` (case_bndr : alt_bndrs) scrut_fvs = freeVarsOf scrut fiExpr to_drop (_, AnnCase scrut case_bndr ty alts) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
