+ = etaExpandRhs bndr rhs `thenUs` \ rhs1 ->
+ corePrepExprFloat env rhs1 `thenUs` \ (floats, rhs2) ->
+ cloneBndr env bndr `thenUs` \ (_, bndr') ->
+ mkLocalNonRec bndr' (bdrDem bndr) floats rhs2 `thenUs` \ (floats', bndr'') ->
+ -- We want bndr'' in the envt, because it records
+ -- the evaluated-ness of the binder
+ returnUs (extendCorePrepEnv env bndr bndr'', floats')
+
+corePrepBind env (Rec pairs) = corePrepRecPairs NotTopLevel env pairs
+
+--------------------------------
+corePrepRecPairs :: TopLevelFlag -> CorePrepEnv
+ -> [(Id,CoreExpr)] -- Recursive bindings
+ -> UniqSM (CorePrepEnv, Floats)
+-- Used for all recursive bindings, top level and otherwise
+corePrepRecPairs lvl env pairs
+ = cloneBndrs env (map fst pairs) `thenUs` \ (env', bndrs') ->
+ mapAndUnzipUs (corePrepRhs lvl Recursive env') pairs `thenUs` \ (floats_s, rhss') ->
+ returnUs (env', unitFloat (FloatLet (Rec (flatten (concatFloats floats_s) bndrs' rhss'))))
+ where
+ -- Flatten all the floats, and the currrent
+ -- group into a single giant Rec
+ flatten (Floats _ floats) bndrs rhss = foldrOL get (bndrs `zip` rhss) floats
+
+ get (FloatLet (NonRec b r)) prs2 = (b,r) : prs2
+ get (FloatLet (Rec prs1)) prs2 = prs1 ++ prs2
+ get b prs2 = pprPanic "corePrepRecPairs" (ppr b)
+
+--------------------------------
+corePrepRhs :: TopLevelFlag -> RecFlag
+ -> CorePrepEnv -> (Id, CoreExpr)
+ -> UniqSM (Floats, CoreExpr)
+-- Used for top-level bindings, and local recursive bindings
+corePrepRhs top_lvl is_rec env (bndr, rhs)
+ = etaExpandRhs bndr rhs `thenUs` \ rhs' ->
+ corePrepExprFloat env rhs' `thenUs` \ floats_w_rhs ->
+ floatRhs top_lvl is_rec bndr floats_w_rhs