+
+\begin{code}
+reOrderRec
+ :: OccEnv
+ -> SCC (Node Details2)
+ -> [Details2]
+ -- Sorted into a plausible order. Enough of the Ids have
+ -- dontINLINE pragmas that there are no loops left.
+
+ -- Non-recursive case
+reOrderRec env (AcyclicSCC (bind, _, _)) = [bind]
+
+ -- Common case of simple self-recursion
+reOrderRec env (CyclicSCC [bind])
+ = [(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
+ where
+ ((tagged_bndr, rhs), _, _) = bind
+
+reOrderRec env (CyclicSCC (bind : binds))
+ = -- Choose a loop breaker, mark it no-inline,
+ -- do SCC analysis on the rest, and recursively sort them out
+ concat (map (reOrderRec env) (stronglyConnCompR unchosen))
+ ++
+ [(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
+
+ where
+ (chosen_pair, unchosen) = choose_loop_breaker bind (score bind) [] binds
+ (tagged_bndr, rhs) = chosen_pair
+
+ -- This loop looks for the bind with the lowest score
+ -- to pick as the loop breaker. The rest accumulate in
+ choose_loop_breaker (details,_,_) loop_sc acc []
+ = (details, acc) -- Done
+
+ choose_loop_breaker loop_bind loop_sc acc (bind : binds)
+ | sc < loop_sc -- Lower score so pick this new one
+ = choose_loop_breaker bind sc (loop_bind : acc) binds
+
+ | otherwise -- No lower so don't pick it
+ = choose_loop_breaker loop_bind loop_sc (bind : acc) binds
+ where
+ sc = score bind
+
+ score :: Node Details2 -> Int -- Higher score => less likely to be picked as loop breaker
+ score ((bndr, rhs), _, _)
+ | exprIsTrivial rhs = 4 -- Practically certain to be inlined
+ -- Used to have also: && not (isExportedId bndr)
+ -- But I found this sometimes cost an extra iteration when we have
+ -- rec { d = (a,b); a = ...df...; b = ...df...; df = d }
+ -- where df is the exported dictionary. Then df makes a really
+ -- bad choice for loop breaker
+
+ | not_fun_ty (idType bndr) = 3 -- Data types help with cases
+ -- This used to have a lower score than inlineCandidate, but
+ -- it's *really* helpful if dictionaries get inlined fast,
+ -- so I'm experimenting with giving higher priority to data-typed things
+
+ | inlineCandidate bndr rhs = 2 -- Likely to be inlined
+
+ | not (isEmptyCoreRules (idSpecialisation bndr)) = 1
+ -- Avoid things with specialisations; we'd like
+ -- to take advantage of them in the subsequent bindings
+
+ | otherwise = 0
+
+ inlineCandidate :: Id -> CoreExpr -> Bool
+ inlineCandidate id (Note InlineMe _) = True
+ inlineCandidate id rhs = isOneOcc (idOccInfo id)
+
+ -- Real example (the Enum Ordering instance from PrelBase):
+ -- rec f = \ x -> case d of (p,q,r) -> p x
+ -- g = \ x -> case d of (p,q,r) -> q x
+ -- d = (v, f, g)
+ --
+ -- Here, f and g occur just once; but we can't inline them into d.
+ -- On the other hand we *could* simplify those case expressions if
+ -- we didn't stupidly choose d as the loop breaker.
+ -- But we won't because constructor args are marked "Many".
+
+ not_fun_ty ty = not (isFunTy (dropForAlls ty))