+\begin{code}
+type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
+ -- which is gotten from the Id.
+data Details
+ = ND { nd_bndr :: Id -- Binder
+ , nd_rhs :: CoreExpr -- RHS
+
+ , nd_uds :: UsageDetails -- Usage from RHS,
+ -- including RULES and InlineRule unfolding
+
+ , nd_inl :: IdSet -- Other binders *from this Rec group* mentioned in
+ } -- its InlineRule unfolding (if present)
+ -- AND the RHS
+ -- but *excluding* any RULES
+ -- This is the IdSet that may be used if the Id is inlined
+
+reOrderRec :: Int -> SCC (Node Details)
+ -> [(Id,CoreExpr)] -> [(Id,CoreExpr)]
+-- Sorted into a plausible order. Enough of the Ids have
+-- IAmALoopBreaker pragmas that there are no loops left.
+reOrderRec _ (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs }, _, _))
+ pairs = (bndr, rhs) : pairs
+reOrderRec depth (CyclicSCC cycle) pairs = reOrderCycle depth cycle pairs
+
+reOrderCycle :: Int -> [Node Details] -> [(Id,CoreExpr)] -> [(Id,CoreExpr)]
+reOrderCycle _ [] _
+ = panic "reOrderCycle"
+reOrderCycle _ [(ND { nd_bndr = bndr, nd_rhs = rhs }, _, _)] pairs
+ = -- Common case of simple self-recursion
+ (makeLoopBreaker False bndr, rhs) : pairs
+
+reOrderCycle depth (bind : binds) pairs
+ = -- Choose a loop breaker, mark it no-inline,
+ -- do SCC analysis on the rest, and recursively sort them out
+-- pprTrace "reOrderCycle" (ppr [b | (ND { nd_bndr = b }, _, _) <- bind:binds]) $
+ foldr (reOrderRec new_depth)
+ ([ (makeLoopBreaker False bndr, rhs)
+ | (ND { nd_bndr = bndr, nd_rhs = rhs }, _, _) <- chosen_binds] ++ pairs)
+ (stronglyConnCompFromEdgedVerticesR unchosen)
+ where
+ (chosen_binds, unchosen) = choose_loop_breaker [bind] (score bind) [] binds
+
+ approximate_loop_breaker = depth >= 2
+ new_depth | approximate_loop_breaker = 0
+ | otherwise = depth+1
+ -- After two iterations (d=0, d=1) give up
+ -- and approximate, returning to d=0
+
+ -- This loop looks for the bind with the lowest score
+ -- to pick as the loop breaker. The rest accumulate in
+ choose_loop_breaker loop_binds _loop_sc acc []
+ = (loop_binds, acc) -- Done
+
+ -- If approximate_loop_breaker is True, we pick *all*
+ -- nodes with lowest score, else just one
+ -- See Note [Complexity of loop breaking]
+ choose_loop_breaker loop_binds loop_sc acc (bind : binds)
+ | sc < loop_sc -- Lower score so pick this new one
+ = choose_loop_breaker [bind] sc (loop_binds ++ acc) binds
+
+ | approximate_loop_breaker && sc == loop_sc
+ = choose_loop_breaker (bind : loop_binds) loop_sc acc binds
+
+ | otherwise -- Higher score so don't pick it
+ = choose_loop_breaker loop_binds loop_sc (bind : acc) binds
+ where
+ sc = score bind
+
+ score :: Node Details -> Int -- Higher score => less likely to be picked as loop breaker
+ score (ND { nd_bndr = bndr, nd_rhs = rhs }, _, _)
+ | not (isId bndr) = 100 -- A type or cercion variable is never a loop breaker
+
+ | isDFunId bndr = 9 -- Never choose a DFun as a loop breaker
+ -- Note [DFuns should not be loop breakers]
+
+ | Just inl_source <- isStableCoreUnfolding_maybe (idUnfolding bndr)
+ = case inl_source of
+ InlineWrapper {} -> 10 -- Note [INLINE pragmas]
+ _other -> 3 -- Data structures are more important than this
+ -- so that dictionary/method recursion unravels
+ -- Note that this case hits all InlineRule things, so we
+ -- never look at 'rhs for InlineRule stuff. That's right, because
+ -- 'rhs' is irrelevant for inlining things with an InlineRule
+
+ | is_con_app rhs = 5 -- Data types help with cases: Note [Constructor applications]
+
+ | exprIsTrivial rhs = 10 -- 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
+
+
+-- If an Id is marked "never inline" then it makes a great loop breaker
+-- The only reason for not checking that here is that it is rare
+-- and I've never seen a situation where it makes a difference,
+-- so it probably isn't worth the time to test on every binder
+-- | isNeverActive (idInlinePragma bndr) = -10
+
+ | isOneOcc (idOccInfo bndr) = 2 -- Likely to be inlined
+
+ | canUnfold (realIdUnfolding bndr) = 1
+ -- The Id has some kind of unfolding
+ -- Ignore loop-breaker-ness here because that is what we are setting!
+
+ | otherwise = 0
+
+ -- Checking for a constructor application
+ -- Cheap and cheerful; the simplifer moves casts out of the way
+ -- The lambda case is important to spot x = /\a. C (f a)
+ -- which comes up when C is a dictionary constructor and
+ -- f is a default method.
+ -- Example: the instance for Show (ST s a) in GHC.ST
+ --
+ -- However we *also* treat (\x. C p q) as a con-app-like thing,
+ -- Note [Closure conversion]
+ is_con_app (Var v) = isConLikeId v
+ is_con_app (App f _) = is_con_app f
+ is_con_app (Lam _ e) = is_con_app e
+ is_con_app (Note _ e) = is_con_app e
+ is_con_app _ = False
+
+makeLoopBreaker :: Bool -> Id -> Id
+-- Set the loop-breaker flag: see Note [Weak loop breakers]
+makeLoopBreaker weak bndr
+ = ASSERT2( isId bndr, ppr bndr ) setIdOccInfo bndr (IAmALoopBreaker weak)
+\end{code}
+
+Note [Complexity of loop breaking]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The loop-breaking algorithm knocks out one binder at a time, and
+performs a new SCC analysis on the remaining binders. That can
+behave very badly in tightly-coupled groups of bindings; in the
+worst case it can be (N**2)*log N, because it does a full SCC
+on N, then N-1, then N-2 and so on.
+
+To avoid this, we switch plans after 2 (or whatever) attempts:
+ Plan A: pick one binder with the lowest score, make it
+ a loop breaker, and try again
+ Plan B: pick *all* binders with the lowest score, make them
+ all loop breakers, and try again
+Since there are only a small finite number of scores, this will
+terminate in a constant number of iterations, rather than O(N)
+iterations.
+
+You might thing that it's very unlikely, but RULES make it much
+more likely. Here's a real example from Trac #1969:
+ Rec { $dm = \d.\x. op d
+ {-# RULES forall d. $dm Int d = $s$dm1
+ forall d. $dm Bool d = $s$dm2 #-}
+
+ dInt = MkD .... opInt ...
+ dInt = MkD .... opBool ...
+ opInt = $dm dInt
+ opBool = $dm dBool
+
+ $s$dm1 = \x. op dInt
+ $s$dm2 = \x. op dBool }
+The RULES stuff means that we can't choose $dm as a loop breaker
+(Note [Choosing loop breakers]), so we must choose at least (say)
+opInt *and* opBool, and so on. The number of loop breakders is
+linear in the number of instance declarations.
+
+Note [INLINE pragmas]
+~~~~~~~~~~~~~~~~~~~~~
+Avoid choosing a function with an INLINE pramga as the loop breaker!
+If such a function is mutually-recursive with a non-INLINE thing,
+then the latter should be the loop-breaker.
+
+Usually this is just a question of optimisation. But a particularly
+bad case is wrappers generated by the demand analyser: if you make
+then into a loop breaker you may get an infinite inlining loop. For
+example:
+ rec {
+ $wfoo x = ....foo x....
+
+ {-loop brk-} foo x = ...$wfoo x...
+ }
+The interface file sees the unfolding for $wfoo, and sees that foo is
+strict (and hence it gets an auto-generated wrapper). Result: an
+infinite inlining in the importing scope. So be a bit careful if you
+change this. A good example is Tree.repTree in
+nofib/spectral/minimax. If the repTree wrapper is chosen as the loop
+breaker then compiling Game.hs goes into an infinite loop. This
+happened when we gave is_con_app a lower score than inline candidates:
+
+ Tree.repTree
+ = __inline_me (/\a. \w w1 w2 ->
+ case Tree.$wrepTree @ a w w1 w2 of
+ { (# ww1, ww2 #) -> Branch @ a ww1 ww2 })
+ Tree.$wrepTree
+ = /\a w w1 w2 ->
+ (# w2_smP, map a (Tree a) (Tree.repTree a w1 w) (w w2) #)
+
+Here we do *not* want to choose 'repTree' as the loop breaker.
+
+Note [DFuns should not be loop breakers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's particularly bad to make a DFun into a loop breaker. See
+Note [How instance declarations are translated] in TcInstDcls
+
+We give DFuns a higher score than ordinary CONLIKE things because
+if there's a choice we want the DFun to be the non-looop breker. Eg
+
+rec { sc = /\ a \$dC. $fBWrap (T a) ($fCT @ a $dC)
+
+ $fCT :: forall a_afE. (Roman.C a_afE) => Roman.C (Roman.T a_afE)
+ {-# DFUN #-}
+ $fCT = /\a \$dC. MkD (T a) ((sc @ a $dC) |> blah) ($ctoF @ a $dC)
+ }
+
+Here 'sc' (the superclass) looks CONLIKE, but we'll never get to it
+if we can't unravel the DFun first.