-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 { parallel_list_comp <- doptM Opt_ParallelListComp
- ; checkM parallel_list_comp parStmtErr
- ; orig_lcl_env <- getLocalRdrEnv
- ; ((segs',thing), fvs) <- go orig_lcl_env [] segs
- ; return ((ParStmt segs', thing), fvs) }
+ -- 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 { checkParStmt ctxt
+ ; ((segs', thing), fvs) <- rnParallelStmts (ParStmtCtxt ctxt) segs thing_inside
+ ; return (([L loc (ParStmt segs')], thing), fvs) }
+
+rnStmt ctxt (L loc (TransformStmt stmts _ using by)) thing_inside
+ = do { checkTransformStmt ctxt
+
+ ; (using', fvs1) <- rnLExpr using
+
+ ; ((stmts', (by', used_bndrs, thing)), fvs2)
+ <- rnStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
+ do { (by', fvs_by) <- case by of
+ Nothing -> return (Nothing, emptyFVs)
+ Just e -> do { (e', fvs) <- rnLExpr e; return (Just e', fvs) }
+ ; (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) }
+
+ ; return (([L loc (TransformStmt stmts' used_bndrs using' by')], thing),
+ fvs1 `plusFV` fvs2) }
+
+rnStmt ctxt (L loc (GroupStmt stmts _ by using)) thing_inside
+ = do { checkTransformStmt ctxt
+
+ -- Rename the 'using' expression in the context before the transform is begun
+ ; (using', fvs1) <- case using of
+ Left e -> do { (e', fvs) <- rnLExpr e; return (Left e', fvs) }
+ Right _ -> do { (e', fvs) <- lookupSyntaxName groupWithName
+ ; return (Right e', fvs) }
+
+ -- Rename the stmts and the 'by' expression
+ -- Keep track of the variables mentioned in the 'by' expression
+ ; ((stmts', (by', used_bndrs, thing)), fvs2)
+ <- rnStmts (TransformStmtCtxt 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
+ ; return ((by', used_bndrs, thing), fvs) }
+
+ ; let all_fvs = fvs1 `plusFV` fvs2
+ bndr_map = used_bndrs `zip` used_bndrs
+ -- See Note [GroupStmt binder map] in HsExpr
+
+ ; traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr bndr_map)
+ ; return (([L loc (GroupStmt stmts' bndr_map by' using')], 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 }