+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 (thing, FreeVars)
+ -> RnM (([LStmt Name], thing), FreeVars)
+rnMDoStmts stmts thing_inside
+ = -- 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 (collectLStmtsBinders stmts) $ \ bndrs ->
+ do {
+ -- 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.)
+ segs <- rn_rec_stmts bndrs stmts
+
+ ; (thing, fvs_later) <- thing_inside
+
+ ; 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', fvs) = segsToStmts grouped_segs fvs_later
+
+ ; return ((stmts', thing), fvs) }
+ where
+ doc = text "In a recursive mdo-expression"
+
+---------------------------------------------
+rn_rec_stmts :: [Name] -> [LStmt RdrName] -> RnM [Segment (LStmt Name)]
+rn_rec_stmts bndrs stmts = mappM (rn_rec_stmt bndrs) stmts `thenM` \ segs_s ->
+ returnM (concat segs_s)
+
+----------------------------------------------------
+rn_rec_stmt :: [Name] -> 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 all_bndrs (L loc (ExprStmt expr _ _))
+ = rnLExpr expr `thenM` \ (expr', fvs) ->
+ lookupSyntaxName thenMName `thenM` \ (then_op, fvs1) ->
+ returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
+ L loc (ExprStmt expr' then_op placeHolderType))]
+
+rn_rec_stmt all_bndrs (L loc (BindStmt pat expr _ _))
+ = rnLExpr expr `thenM` \ (expr', fv_expr) ->
+ rnLPat pat `thenM` \ (pat', fv_pat) ->
+ lookupSyntaxName bindMName `thenM` \ (bind_op, fvs1) ->
+ lookupSyntaxName failMName `thenM` \ (fail_op, fvs2) ->
+ let
+ bndrs = mkNameSet (collectPatBinders pat')
+ fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
+ in
+ returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+ L loc (BindStmt pat' expr' bind_op fail_op))]