+ (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)
+ where
+ wrap_defns = mapBag wrap_one
+ wrap_one (NonRec binder rhs) = NonRec binder (mkSCC cc rhs)
+ wrap_one (Rec pairs) = Rec (mapSnd (mkSCC cc) pairs)