- (float_uds, (dict_binds, calls)) -- This binding is needed in the UDs, so float it out
- -> return ([], float_uds `plusUDs` mkBigUD bind' dict_binds calls)
-
-
--- A truly gruesome function
-mkBigUD bind@(NonRec _ _) dbs calls
- = -- Common case: non-recursive and no specialisations
- -- (if there were any specialistions it would have been made recursive)
- MkUD { dict_binds = listToBag (mkDB bind : dbs),
- calls = listToCallDetails calls }
-
-mkBigUD bind dbs calls
- = -- General case
- MkUD { dict_binds = unitBag (mkDB (Rec (bind_prs bind ++ dbsToPairs dbs))),
- -- Make a huge Rec
- calls = listToCallDetails calls }
- where
- bind_prs (NonRec b r) = [(b,r)]
- bind_prs (Rec prs) = prs
+ (all_db_prs, all_db_fvs) = add (bind, b_fvs) $
+ foldrBag add ([], emptyVarSet) $
+ rhs_dbs `unionBags` body_dbs
+ add (NonRec b r, b_fvs) (prs, fvs) = ((b,r) : prs, b_fvs `unionVarSet` fvs)
+ add (Rec b_prs, b_fvs) (prs, fvs) = (b_prs ++ prs, b_fvs `unionVarSet` fvs)