-rnStmt ctxt (LetStmt binds) thing_inside
- = do { checkErr (ok ctxt binds)
- (badIpBinds (ptext SLIT("a parallel list comprehension:")) binds)
- ; rnLocalBindsAndThen binds $ \ binds' -> do
- { (thing, fvs) <- thing_inside
- ; return ((LetStmt binds', thing), fvs) }}
- where
- -- We do not allow implicit-parameter bindings in a parallel
- -- list comprehension. I'm not sure what it might mean.
- ok (ParStmtCtxt _) (HsIPBinds _) = False
- ok _ _ = True
-
-rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
- = bindLocatedLocalsRn doc (collectLStmtsBinders rec_stmts) $ \ bndrs ->
- rn_rec_stmts bndrs rec_stmts `thenM` \ segs ->
- thing_inside `thenM` \ (thing, fvs) ->
- let
- segs_w_fwd_refs = addFwdRefs segs
- (ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
- later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
- fwd_vars = nameSetToList (plusFVs fs)
- uses = plusFVs us
- rec_stmt = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
- in
- returnM ((rec_stmt, thing), uses `plusFV` fvs)
- where
- doc = text "In a recursive do statement"
-
-rnStmt ctxt (ParStmt segs) thing_inside
- = do { opt_GlasgowExts <- doptM Opt_GlasgowExts
- ; checkM opt_GlasgowExts parStmtErr
- ; orig_lcl_env <- getLocalRdrEnv
- ; ((segs',thing), fvs) <- go orig_lcl_env [] segs
- ; return ((ParStmt segs', thing), fvs) }
+rnStmt _ (L loc (LetStmt binds)) thing_inside
+ = do { rnLocalBindsAndThen binds $ \binds' -> do
+ { (thing, fvs) <- thing_inside (collectLocalBinders binds')
+ ; return (([L loc (LetStmt binds')], thing), fvs) } }
+
+rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
+ = do {
+ -- Step1: Bring all the binders of the mdo into scope
+ -- (Remember that this also removes the binders from the
+ -- finally-returned free-vars.)
+ -- And 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.)
+ ; rnRecStmtsAndThen rec_stmts $ \ segs -> do
+
+ { let bndrs = nameSetToList $ foldr (unionNameSets . (\(ds,_,_,_) -> ds))
+ emptyNameSet segs
+ ; (thing, fvs_later) <- thing_inside bndrs
+ ; (return_op, fvs1) <- lookupStmtName ctxt returnMName
+ ; (mfix_op, fvs2) <- lookupStmtName ctxt mfixName
+ ; (bind_op, fvs3) <- lookupStmtName ctxt bindMName
+ ; let
+ -- Step 2: 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 3: 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 4: 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
+ empty_rec_stmt = emptyRecStmt { recS_ret_fn = return_op
+ , recS_mfix_fn = mfix_op
+ , recS_bind_fn = bind_op }
+ (rec_stmts', fvs) = segsToStmts empty_rec_stmt grouped_segs fvs_later
+
+ ; return ((rec_stmts', thing), fvs `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } }
+
+rnStmt ctxt (L loc (ParStmt segs _ _ _)) thing_inside
+ = do { (mzip_op, fvs1) <- lookupStmtName ctxt mzipName
+ ; (bind_op, fvs2) <- lookupStmtName ctxt bindMName
+ ; (return_op, fvs3) <- lookupStmtName ctxt returnMName
+ ; ((segs', thing), fvs4) <- rnParallelStmts (ParStmtCtxt ctxt) segs thing_inside
+ ; return ( ([L loc (ParStmt segs' mzip_op bind_op return_op)], thing)
+ , fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
+
+rnStmt ctxt (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = form
+ , trS_using = using })) thing_inside
+ = do { -- Rename the 'using' expression in the context before the transform is begun
+ (using', fvs1) <- case form of
+ GroupFormB -> do { (e,fvs) <- lookupStmtName ctxt groupMName
+ ; return (noLoc e, fvs) }
+ _ -> rnLExpr using
+
+ -- Rename the stmts and the 'by' expression
+ -- Keep track of the variables mentioned in the 'by' expression
+ ; ((stmts', (by', used_bndrs, thing)), fvs2)
+ <- rnStmts (TransStmtCtxt ctxt) stmts $ \ bndrs ->
+ do { (by', fvs_by) <- mapMaybeFvRn rnLExpr by
+ ; (thing, fvs_thing) <- thing_inside bndrs
+ ; let fvs = fvs_by `plusFV` fvs_thing
+ used_bndrs = filter (`elemNameSet` fvs) bndrs
+ -- The paper (Fig 5) has a bug here; we must treat any free varaible
+ -- of the "thing inside", **or of the by-expression**, as used
+ ; return ((by', used_bndrs, thing), fvs) }
+
+ -- Lookup `return`, `(>>=)` and `liftM` for monad comprehensions
+ ; (return_op, fvs3) <- lookupStmtName ctxt returnMName
+ ; (bind_op, fvs4) <- lookupStmtName ctxt bindMName
+ ; (fmap_op, fvs5) <- case form of
+ ThenForm -> return (noSyntaxExpr, emptyFVs)
+ _ -> lookupStmtName ctxt fmapName
+
+ ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3
+ `plusFV` fvs4 `plusFV` fvs5
+ bndr_map = used_bndrs `zip` used_bndrs
+ -- See Note [TransStmt binder map] in HsExpr
+
+ ; traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr bndr_map)
+ ; return (([L loc (TransStmt { trS_stmts = stmts', trS_bndrs = bndr_map
+ , trS_by = by', trS_using = using', trS_form = form
+ , trS_ret = return_op, trS_bind = bind_op
+ , trS_fmap = fmap_op })], thing), all_fvs) }
+
+type ParSeg id = ([LStmt id], [id]) -- The Names are bound by the Stmts
+
+rnParallelStmts :: forall thing. HsStmtContext Name
+ -> [ParSeg RdrName]
+ -> ([Name] -> RnM (thing, FreeVars))
+ -> RnM (([ParSeg Name], thing), FreeVars)
+-- Note [Renaming parallel Stmts]
+rnParallelStmts ctxt segs thing_inside
+ = do { orig_lcl_env <- getLocalRdrEnv
+ ; rn_segs orig_lcl_env [] segs }