-floatExpr :: IdEnv Level
- -> Level
- -> LevelledExpr
- -> (FloatStats, FloatBinds, CoreExpr)
-
-floatExpr env _ (Var v) = (zeroStats, [], Var v)
-floatExpr env _ (Type ty) = (zeroStats, [], Type ty)
-floatExpr env lvl (Con con as)
- = case floatList (floatExpr env lvl) as of { (stats, floats, as') ->
- (stats, floats, Con con as') }
+floatExpr, floatRhs, floatNonRecRhs
+ :: Level
+ -> LevelledExpr
+ -> (FloatStats, FloatBinds, CoreExpr)
+
+floatRhs lvl arg -- Used rec rhss, and case-alternative rhss
+ = case (floatExpr lvl arg) of { (fsa, floats, arg') ->
+ case (partitionByMajorLevel lvl floats) of { (floats', heres) ->
+ -- Dump bindings that aren't going to escape from a lambda;
+ -- in particular, we must dump the ones that are bound by
+ -- the rec or case alternative
+ (fsa, floats', install heres arg') }}
+
+floatNonRecRhs lvl arg -- Used for nested non-rec rhss, and fn args
+ = case (floatExpr lvl arg) of { (fsa, floats, arg') ->
+ -- Dump bindings that aren't going to escape from a lambda
+ -- This isn't a scoping issue (the binder isn't in scope in the RHS of a non-rec binding)
+ -- Rather, it is to avoid floating the x binding out of
+ -- f (let x = e in b)
+ -- unnecessarily. But we first test for values or trival rhss,
+ -- because (in particular) we don't want to insert new bindings between
+ -- the "=" and the "\". E.g.
+ -- f = \x -> let <bind> in <body>
+ -- We do not want
+ -- f = let <bind> in \x -> <body>
+ -- (a) The simplifier will immediately float it further out, so we may
+ -- as well do so right now; in general, keeping rhss as manifest
+ -- values is good
+ -- (b) If a float-in pass follows immediately, it might add yet more
+ -- 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.
+ if exprIsHNF arg' || exprIsTrivial arg' then
+ (fsa, floats, arg')
+ else
+ case (partitionByMajorLevel lvl floats) of { (floats', heres) ->
+ (fsa, floats', install heres arg') }}
+
+floatExpr _ (Var v) = (zeroStats, [], Var v)
+floatExpr _ (Type ty) = (zeroStats, [], Type ty)
+floatExpr _ (Lit lit) = (zeroStats, [], Lit lit)