; stuff <- zipWithM (cpePair top_lvl Recursive False env') bndrs1 rhss
; let (floats_s, bndrs2, rhss2) = unzip3 stuff
- all_pairs = foldrOL add_float (bndrs1 `zip` rhss2)
+ all_pairs = foldrOL add_float (bndrs2 `zip` rhss2)
(concatFloats floats_s)
; return (extendCorePrepEnvList env (bndrs `zip` bndrs2),
unitFloat (FloatLet (Rec all_pairs))) }
; let float = mkFloat False False v rhs2
; return (addFloat floats2 float, cpeEtaExpand arity (Var v)) })
- -- Record if the binder is evaluated
+ -- Record if the binder is evaluated
+ -- and otherwise trim off the unfolding altogether
+ -- It's not used by the code generator; getting rid of it reduces
+ -- heap usage and, since we may be changing uniques, we'd have
+ -- to substitute to keep it right
; let bndr' | exprIsHNF rhs' = bndr `setIdUnfolding` evaldUnfolding
- | otherwise = bndr
+ | otherwise = bndr `setIdUnfolding` noUnfolding
; return (floats3, bndr', rhs') }
where
cpeArg :: CorePrepEnv -> RhsDemand -> CoreArg -> Type
-> UniqSM (Floats, CpeTriv)
cpeArg env is_strict arg arg_ty
- | cpe_ExprIsTrivial arg -- Do not eta expand etc a trivial argument
- = cpeBody env arg -- Must still do substitution though
- | otherwise
- = do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda
+ = do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda
; (floats2, arg2) <- if want_float floats1 arg1
then return (floats1, arg1)
else do { body1 <- rhsToBodyNF arg1
-- Else case: arg1 might have lambdas, and we can't
-- put them inside a wrapBinds
- ; v <- newVar arg_ty
+ ; if cpe_ExprIsTrivial arg2 -- Do not eta expand a trivial argument
+ then return (floats2, arg2)
+ else do
+ { v <- newVar arg_ty
; let arg3 = cpeEtaExpand (exprArity arg2) arg2
arg_float = mkFloat is_strict is_unlifted v arg3
- ; return (addFloat floats2 arg_float, Var v) }
+ ; return (addFloat floats2 arg_float, Var v) } }
where
is_unlifted = isUnLiftedType arg_ty
want_float = wantFloatNested NonRecursive (is_strict || is_unlifted)