#include "HsVersions.h"
import CoreSyn
-import CoreUtils ( mkSCC, exprIsHNF, exprIsTrivial )
+import CoreUtils
import DynFlags ( DynFlags, DynFlag(..), FloatOutSwitches(..) )
import ErrUtils ( dumpIfSet_dyn )
floatRhs lvl arg -- Used for nested non-rec rhss, and fn args
-- See Note [Floating out of RHS]
= case (floatExpr lvl arg) of { (fsa, floats, arg') ->
- if exprIsHNF arg' || exprIsTrivial arg' then
+ if exprIsCheap arg' then
(fsa, floats, arg')
else
case (partitionByMajorLevel lvl floats) of { (floats', heres) ->
-- bindings just after the '='. And some of them might (correctly)
-- be strict even though the 'let f' is lazy, because f, being a value,
-- gets its demand-info zapped by the simplifier.
+--
+-- We use exprIsCheap because that is also what's used by the simplifier
+-- to decide whether to float a let out of a let
floatExpr _ (Var v) = (zeroStats, [], Var v)
floatExpr _ (Type ty) = (zeroStats, [], Type ty)
floatExpr lvl (Let (NonRec (TB bndr bndr_lvl) rhs) body)
| isUnLiftedType (idType bndr) -- Treat unlifted lets just like a case
- = case floatExpr lvl rhs of { (fs, rhs_floats, rhs') ->
- case floatRhs bndr_lvl body of { (fs, body_floats, body') ->
+ -- I.e. floatExpr for rhs, floatCaseAlt for body
+ = case floatExpr lvl rhs of { (fs, rhs_floats, rhs') ->
+ case floatCaseAlt bndr_lvl body of { (fs, body_floats, body') ->
(fs, rhs_floats ++ body_floats, Let (NonRec bndr rhs') body') }}
floatExpr lvl (Let bind body)