+ new_cycle = CyclicSCC (zipWithEqual "occAnalBind" mk_new_bind tagged_binders cycle)
+ mk_new_bind tagged_bndr ((_, (_, rhs')), key, keys) = ((tagged_bndr, rhs'), key, keys)
+\end{code}
+
+@reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
+strongly connected component (there's guaranteed to be a cycle). It returns the
+same pairs, but
+ a) in a better order,
+ b) with some of the Ids having a IMustNotBeINLINEd pragma
+
+The "no-inline" Ids are sufficient to break all cycles in the SCC. This means
+that the simplifier can guarantee not to loop provided it never records an inlining
+for these no-inline guys.
+
+Furthermore, the order of the binds is such that if we neglect dependencies
+on the no-inline Ids then the binds are topologically sorted. This means
+that the simplifier will generally do a good job if it works from top bottom,
+recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
+
+Here's a case that bit me:
+
+ letrec
+ a = b
+ b = \x. BIG
+ in
+ ...a...a...a....
+
+Re-ordering doesn't change the order of bindings, but there was no loop-breaker.
+(The first binding was a var-rhs; the second was a one-occ.) So the simplifier looped.
+My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
+Perhaps something cleverer would suffice.
+
+\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 (pair, _, _)) = [pair]
+
+ -- Common case of simple self-recursion
+reOrderRec env (CyclicSCC [bind])
+ = [((addNoInlinePragma bndr, occ_info), rhs)]
+ where
+ (((bndr,occ_info), rhs), _, _) = bind
+
+reOrderRec env (CyclicSCC 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))
+ ++
+ [((addNoInlinePragma bndr, occ_info), rhs)]
+
+ where
+ (chosen_pair, unchosen) = choose_loop_breaker binds
+ ((bndr,occ_info), rhs) = chosen_pair
+
+ -- Choosing the loop breaker; heursitic
+ choose_loop_breaker (bind@(pair, _, _) : rest)
+ | not (null rest) &&
+ bad_choice pair
+ = (chosen, bind : unchosen) -- Don't pick it
+ | otherwise -- Pick it
+ = (pair,rest)
+ where
+ (chosen, unchosen) = choose_loop_breaker rest
+
+ bad_choice ((bndr, occ_info), rhs)
+ = var_rhs rhs -- Dont pick var RHS
+ || inlineMe env bndr -- Dont pick INLINE thing
+ || one_occ occ_info -- Dont pick single-occ thing
+ || not_fun_ty (idType bndr) -- Dont pick data-ty thing
+
+ not_fun_ty ty = not (maybeToBool (getFunTy_maybe rho_ty))
+ where
+ (_, rho_ty) = splitForAllTy ty
+
+ -- A variable RHS
+ var_rhs (Var v) = True
+ var_rhs other_rhs = False
+
+ -- One textual occurrence, whether inside lambda or whatever
+ -- We stick to just FunOccs because if we're not going to be able
+ -- to inline the thing on this round it might be better to pick
+ -- this one as the loop breaker. 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.
+
+ one_occ (OneOcc fun_or_arg _ _ _ _) = isFun fun_or_arg
+ one_occ other_bind = False