+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.
+
+My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
+Perhaps something cleverer would suffice.
+===============
+
+You might think that you can prevent non-termination simply by making
+sure that we simplify a recursive binding's RHS in an environment that
+simply clones the recursive Id. But no. Consider
+
+ letrec f = \x -> let z = f x' in ...
+
+ in
+ let n = f y
+ in
+ case n of { ... }
+
+We bind n to its *simplified* RHS, we then *re-simplify* it when
+we inline n. Then we may well inline f; and then the same thing
+happens with z!
+
+I don't think it's possible to prevent non-termination by environment
+manipulation in this way. Apart from anything else, successive
+iterations of the simplifier may unroll recursive loops in cases like
+that above. The idea of beaking every recursive loop with an
+IMustNotBeINLINEd pragma is much much better.
+
+
+\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])
+ = [(setInlinePragma 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))
+ ++
+ [(setInlinePragma 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 &&
+ not (isExportedId bndr) = 3 -- Practically certain to be inlined
+ | inlineCandidate bndr rhs = 3 -- Likely to be inlined
+ | not_fun_ty (idType bndr) = 2 -- Data types help with cases
+ | not (isEmptyCoreRules (getIdSpecialisation 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 = case getInlinePragma id of
+ IMustBeINLINEd -> True
+ ICanSafelyBeINLINEd _ _ -> True
+ other -> False
+
+ -- 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 (maybeToBool (splitFunTy_maybe rho_ty))
+ where
+ (_, rho_ty) = splitForAllTys ty