-type RnExprTy = RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
-
-rnStmts :: RnExprTy
- -> [RdrNameStmt]
- -> RnMS ([RenamedStmt], FreeVars)
-
-rnStmts rn_expr []
- = returnRn ([], emptyFVs)
-
-rnStmts rn_expr (stmt:stmts)
- = rnStmt rn_expr stmt $ \ stmt' ->
- rnStmts rn_expr stmts `thenRn` \ (stmts', fvs) ->
- returnRn (stmt' : stmts', fvs)
-
-rnStmt :: RnExprTy -> RdrNameStmt
- -> (RenamedStmt -> RnMS (a, FreeVars))
- -> RnMS (a, FreeVars)
--- Because of mutual recursion we have to pass in rnExpr.
-
-rnStmt rn_expr (BindStmt pat expr src_loc) thing_inside
- = pushSrcLocRn src_loc $
- rn_expr expr `thenRn` \ (expr', fv_expr) ->
- bindLocalsFVRn doc binders $ \ new_binders ->
- rnPat pat `thenRn` \ (pat', fv_pat) ->
- thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ (result, fvs) ->
- returnRn (result, fv_expr `plusFV` fvs `plusFV` fv_pat)
+type FwdRefs = NameSet
+type Segment stmts = (Defs,
+ Uses, -- May include defs
+ FwdRefs, -- A subset of uses that are
+ -- (a) used before they are bound in this segment, or
+ -- (b) used here, and bound in subsequent segments
+ stmts) -- Either Stmt or [Stmt]
+
+
+----------------------------------------------------
+rnMDoStmts :: [LStmt RdrName] -> RnM ([LStmt Name], FreeVars)
+rnMDoStmts stmts
+ = -- Step1: bring all the binders of the mdo into scope
+ -- Remember that this also removes the binders from the
+ -- finally-returned free-vars
+ bindLocatedLocalsRn doc (collectStmtsBinders stmts) $ \ _ ->
+
+ -- Step 2: Rename each individual stmt, making a
+ -- singleton segment. At this stage the FwdRefs field
+ -- isn't finished: it's empty for all except a BindStmt
+ -- for which it's the fwd refs within the bind itself
+ -- (This set may not be empty, because we're in a recursive
+ -- context.)
+ rn_rec_stmts stmts `thenM` \ segs ->
+ let
+ -- Step 3: Fill in the fwd refs.
+ -- The segments are all singletons, but their fwd-ref
+ -- field mentions all the things used by the segment
+ -- that are bound after their use
+ segs_w_fwd_refs = addFwdRefs segs
+
+ -- Step 4: Group together the segments to make bigger segments
+ -- Invariant: in the result, no segment uses a variable
+ -- bound in a later segment
+ grouped_segs = glomSegments segs_w_fwd_refs
+
+ -- Step 5: Turn the segments into Stmts
+ -- Use RecStmt when and only when there are fwd refs
+ -- Also gather up the uses from the end towards the
+ -- start, so we can tell the RecStmt which things are
+ -- used 'after' the RecStmt
+ stmts_w_fvs = segsToStmts grouped_segs
+ in
+ returnM stmts_w_fvs
+ where
+
+ doc = text "In a recursive mdo-expression"
+
+
+----------------------------------------------------
+rn_rec_stmt :: LStmt RdrName -> RnM [Segment (LStmt Name)]
+ -- Rename a Stmt that is inside a RecStmt (or mdo)
+ -- Assumes all binders are already in scope
+ -- Turns each stmt into a singleton Stmt
+
+rn_rec_stmt (L loc (ExprStmt expr _))
+ = rnLExpr expr `thenM` \ (expr', fvs) ->
+ returnM [(emptyNameSet, fvs, emptyNameSet,
+ L loc (ExprStmt expr' placeHolderType))]
+
+rn_rec_stmt (L loc (ResultStmt expr))
+ = rnLExpr expr `thenM` \ (expr', fvs) ->
+ returnM [(emptyNameSet, fvs, emptyNameSet,
+ L loc (ResultStmt expr'))]
+
+rn_rec_stmt (L loc (BindStmt pat expr))
+ = rnLExpr expr `thenM` \ (expr', fv_expr) ->
+ rnLPat pat `thenM` \ (pat', fv_pat) ->
+ let
+ bndrs = mkNameSet (collectPatBinders pat')
+ fvs = fv_expr `plusFV` fv_pat
+ in
+ returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+ L loc (BindStmt pat' expr'))]
+
+rn_rec_stmt (L loc (LetStmt binds))
+ = rnBindGroups binds `thenM` \ (binds', du_binds) ->
+ returnM [(duDefs du_binds, duUses du_binds,
+ emptyNameSet, L loc (LetStmt binds'))]
+
+rn_rec_stmt (L loc (RecStmt stmts _ _ _)) -- Flatten Rec inside Rec
+ = rn_rec_stmts stmts
+
+rn_rec_stmt stmt@(L _ (ParStmt _)) -- Syntactically illegal in mdo
+ = pprPanic "rn_rec_stmt" (ppr stmt)
+
+---------------------------------------------
+rn_rec_stmts :: [LStmt RdrName] -> RnM [Segment (LStmt Name)]
+rn_rec_stmts stmts = mappM rn_rec_stmt stmts `thenM` \ segs_s ->
+ returnM (concat segs_s)
+
+
+---------------------------------------------
+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)