+ = foldrBag install_group expr defn_groups
+ where
+ install_group defns body = Let defns body
+
+partitionByMajorLevel, partitionByLevel
+ :: Level -- Partitioning level
+ -> FloatBinds -- Defns to be divided into 2 piles...
+ -> (FloatBinds, -- Defns with level strictly < partition level,
+ Bag FloatBind) -- The rest
+
+-- ---- partitionByMajorLevel ----
+-- Float it if we escape a value lambda, *or* if we get to the top level
+-- If we can get to the top level, say "yes" anyway. This means that
+-- x = f e
+-- transforms to
+-- lvl = e
+-- x = f lvl
+-- which is as it should be
+
+partitionByMajorLevel (Level major _) (FB tops defns)
+ = (FB tops outer, heres `unionBags` flattenMajor inner)
+ where
+ (outer, mb_heres, inner) = splitUFM defns major
+ heres = case mb_heres of
+ Nothing -> emptyBag
+ Just h -> flattenMinor h
+
+partitionByLevel (Level major minor) (FB tops defns)
+ = (FB tops (outer_maj `plusMajor` unitUFM major outer_min),
+ here_min `unionBags` flattenMinor inner_min
+ `unionBags` flattenMajor inner_maj)
+
+ where
+ (outer_maj, mb_here_maj, inner_maj) = splitUFM defns major
+ (outer_min, mb_here_min, inner_min) = case mb_here_maj of
+ Nothing -> (emptyUFM, Nothing, emptyUFM)
+ Just min_defns -> splitUFM min_defns minor
+ here_min = mb_here_min `orElse` emptyBag
+
+wrapCostCentre :: CostCentre -> FloatBinds -> FloatBinds
+wrapCostCentre cc (FB tops defns)
+ = FB (wrap_defns tops) (mapUFM (mapUFM wrap_defns) defns)