+ returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+ L loc (BindStmt pat' expr' bind_op fail_op))]
+
+rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _)))
+ = do { addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
+ ; failM }
+
+rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds)))
+ = rnValBinds (trimWith all_bndrs) binds `thenM` \ (binds', du_binds) ->
+ returnM [(duDefs du_binds, duUses du_binds,
+ emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
+
+rn_rec_stmt all_bndrs (L loc (RecStmt stmts _ _ _ _)) -- Flatten Rec inside Rec
+ = rn_rec_stmts all_bndrs stmts
+
+rn_rec_stmt all_bndrs stmt@(L _ (ParStmt _)) -- Syntactically illegal in mdo
+ = pprPanic "rn_rec_stmt" (ppr stmt)
+
+---------------------------------------------
+addFwdRefs :: [Segment a] -> [Segment a]
+-- So far the segments only have forward refs *within* the Stmt
+-- (which happens for bind: x <- ...x...)
+-- This function adds the cross-seg fwd ref info
+
+addFwdRefs pairs
+ = fst (foldr mk_seg ([], emptyNameSet) pairs)
+ where
+ mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
+ = (new_seg : segs, all_defs)
+ where
+ new_seg = (defs, uses, new_fwds, stmts)
+ all_defs = later_defs `unionNameSets` defs
+ new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
+ -- Add the downstream fwd refs here
+
+----------------------------------------------------
+-- Glomming the singleton segments of an mdo into
+-- minimal recursive groups.
+--
+-- At first I thought this was just strongly connected components, but
+-- there's an important constraint: the order of the stmts must not change.
+--
+-- Consider
+-- mdo { x <- ...y...
+-- p <- z
+-- y <- ...x...
+-- q <- x
+-- z <- y
+-- r <- x }
+--
+-- Here, the first stmt mention 'y', which is bound in the third.
+-- But that means that the innocent second stmt (p <- z) gets caught
+-- up in the recursion. And that in turn means that the binding for
+-- 'z' has to be included... and so on.
+--
+-- Start at the tail { r <- x }
+-- Now add the next one { z <- y ; r <- x }
+-- Now add one more { q <- x ; z <- y ; r <- x }
+-- Now one more... but this time we have to group a bunch into rec
+-- { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
+-- Now one more, which we can add on without a rec
+-- { p <- z ;
+-- rec { y <- ...x... ; q <- x ; z <- y } ;
+-- r <- x }
+-- Finally we add the last one; since it mentions y we have to
+-- glom it togeher with the first two groups
+-- { rec { x <- ...y...; p <- z ; y <- ...x... ;
+-- q <- x ; z <- y } ;
+-- r <- x }
+
+glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
+
+glomSegments [] = []
+glomSegments ((defs,uses,fwds,stmt) : segs)
+ -- Actually stmts will always be a singleton
+ = (seg_defs, seg_uses, seg_fwds, seg_stmts) : others
+ where
+ segs' = glomSegments segs
+ (extras, others) = grab uses segs'
+ (ds, us, fs, ss) = unzip4 extras
+
+ seg_defs = plusFVs ds `plusFV` defs
+ seg_uses = plusFVs us `plusFV` uses
+ seg_fwds = plusFVs fs `plusFV` fwds
+ seg_stmts = stmt : concat ss
+
+ grab :: NameSet -- The client
+ -> [Segment a]
+ -> ([Segment a], -- Needed by the 'client'
+ [Segment a]) -- Not needed by the client
+ -- The result is simply a split of the input
+ grab uses dus
+ = (reverse yeses, reverse noes)
+ where
+ (noes, yeses) = span not_needed (reverse dus)
+ not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
+
+
+----------------------------------------------------
+segsToStmts :: [Segment [LStmt Name]]
+ -> FreeVars -- Free vars used 'later'
+ -> ([LStmt Name], FreeVars)
+
+segsToStmts [] fvs_later = ([], fvs_later)
+segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
+ = ASSERT( not (null ss) )
+ (new_stmt : later_stmts, later_uses `plusFV` uses)
+ where
+ (later_stmts, later_uses) = segsToStmts segs fvs_later
+ new_stmt | non_rec = head ss
+ | otherwise = L (getLoc (head ss)) $
+ RecStmt ss (nameSetToList used_later) (nameSetToList fwds)
+ [] emptyLHsBinds
+ where
+ non_rec = isSingleton ss && isEmptyNameSet fwds
+ used_later = defs `intersectNameSet` later_uses
+ -- The ones needed after the RecStmt