- in
- case splitUDs bndrs all_uds of
-
- (_, ([],[])) -- This binding doesn't bind anything needed
- -- in the UDs, so put the binding here
- -- This is the case for most non-dict bindings, except
- -- for the few that are mentioned in a dict binding
- -- that is floating upwards in body_uds
- -> returnSM ([bind'], all_uds)
-
- (float_uds, (dict_binds, calls)) -- This binding is needed in the UDs, so float it out
- -> returnSM ([], 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 }
+ , calls = all_calls
+ , ud_fvs = all_fvs })
+
+ | case bind of { NonRec {} -> True; Rec {} -> False }
+ -- Common case 2: no specialisation happened, and binding
+ -- is non-recursive. But the binding may be
+ -- mentioned in body_dbs, so we should put it first
+ = ([], MkUD { dict_binds = rhs_dbs `unionBags` ((bind, b_fvs) `consBag` body_dbs)
+ , calls = all_calls
+ , ud_fvs = all_fvs `unionVarSet` b_fvs })
+
+ | otherwise -- General case: make a huge Rec (sigh)
+ = ([], MkUD { dict_binds = unitBag (Rec all_db_prs, all_db_fvs)
+ , calls = all_calls
+ , ud_fvs = all_fvs `unionVarSet` b_fvs })