- return Nothing
--- Leave all other expressions unchanged
-casewild expr = return expr
--- Perform this transform everywhere
-casewildtop = everywhere ("casewild", casewild)
-
---------------------------------
--- Case value simplification
---------------------------------
-casevalsimpl, casevalsimpltop :: Transform
-casevalsimpl expr@(Case scrut b ty alts) = do
- -- Try to simplify each alternative, resulting in an optional binding and a
- -- new alternative.
- (bindings_maybe, alts') <- (Monad.liftM unzip) $ mapM doalt alts
- let bindings = Maybe.catMaybes bindings_maybe
- -- Create a new let around the case, that binds of the cases values.
- let newlet = Let (Rec bindings) (Case scrut b ty alts')
- -- If there were no values that needed and allowed simplification, don't
- -- change the case.
- if null bindings then return expr else change newlet
- where
- doalt :: CoreAlt -> TransformMonad (Maybe (CoreBndr, CoreExpr), CoreAlt)
- -- Don't simplify values that are already simple
- doalt alt@(con, bndrs, Var _) = return (Nothing, alt)
- -- Simplify each alt by creating a new id, binding the case value to it and
- -- replacing the case value with that id. Only do this when the case value
- -- does not use any of the binders bound by this alternative, for that would
- -- cause those binders to become unbound when moving the value outside of
- -- the case statement. Also, don't create a binding for non-representable
- -- expressions, to prevent loops with inlinenonrep.
- doalt alt@(con, bndrs, expr) = do
- repr <- isRepr expr
- -- Find if any of the binders are used by expr
- let usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
- if (not usesvars && repr)
- then do
- id <- mkInternalVar "caseval" (CoreUtils.exprType expr)
- -- We don't flag a change here, since casevalsimpl will do that above
- -- based on Just we return here.
- return $ (Just (id, expr), (con, bndrs, Var id))
- else
- -- Don't simplify anything else
- return (Nothing, alt)
+ -- Just leave the original binder in place, and don't generate an
+ -- extra selector case.
+ return (b, Nothing)
+ -- Process the expression of a case alternative. Accepts an expression
+ -- and whether this expression uses any of the binders in the
+ -- alternative. Returns an optional new binding and a new expression.
+ doexpr :: CoreExpr -> Bool -> TransformMonad (Maybe (CoreBndr, CoreExpr), CoreExpr)
+ doexpr expr uses_bndrs = do
+ local_var <- Trans.lift $ is_local_var expr
+ repr <- isRepr expr
+ -- Extract any expressions that do not use any binders from this
+ -- alternative, is not a local var already and is representable (to
+ -- prevent loops with inlinenonrep).
+ if (not uses_bndrs) && (not local_var) && repr
+ then do
+ id <- Trans.lift $ mkInternalVar "caseval" (CoreUtils.exprType expr)
+ -- We don't flag a change here, since casevalsimpl will do that above
+ -- based on Just we return here.
+ return $ (Just (id, expr), Var id)
+ else
+ -- Don't simplify anything else
+ return (Nothing, expr)