- traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr usedBinderMap)
- return ((GroupStmt (stmts', usedBinderMap) groupByClause', thing), fvs)
-
-rnNormalStmtsAndFindUsedBinders :: HsStmtContext Name
- -> [LStmt RdrName]
- -> ([Name] -> RnM (thing, FreeVars))
- -> RnM (([LStmt Name], [Name], thing), FreeVars)
-rnNormalStmtsAndFindUsedBinders ctxt stmts thing_inside = do
- ((stmts', (used_bndrs, inner_thing)), fvs) <- rnNormalStmts ctxt stmts $ do
- -- Find the Names that are bound by stmts that
- -- by assumption we have just renamed
- local_env <- getLocalRdrEnv
- let
- stmts_binders = collectLStmtsBinders stmts
- bndrs = map (expectJust "rnStmt"
- . lookupLocalRdrEnv local_env
- . unLoc) stmts_binders
-
- -- If shadow, we'll look up (Unqual x) twice, getting
- -- the second binding both times, which is the
- -- one we want
- unshadowed_bndrs = nub bndrs
-
- -- Typecheck the thing inside, passing on all
- -- the Names bound before it for its information
- (thing, fvs) <- thing_inside unshadowed_bndrs
-
- -- Figure out which of the bound names are used
- -- after the statements we renamed
- let used_bndrs = filter (`elemNameSet` fvs) bndrs
- return ((used_bndrs, thing), fvs)
-
- -- Flatten the tuple returned by the above call a bit!
- return ((stmts', used_bndrs, inner_thing), fvs)
-
-
-rnParallelStmts ctxt segs thing_inside = do
- orig_lcl_env <- getLocalRdrEnv
- go orig_lcl_env [] segs
- where
- go orig_lcl_env bndrs [] = do
- let (bndrs', dups) = removeDups cmpByOcc bndrs
- inner_env = extendLocalRdrEnv orig_lcl_env bndrs'
-
- mappM dupErr dups
- (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
- return (([], thing), fvs)
-
- go orig_lcl_env bndrs_so_far ((stmts, _) : segs) = do
- ((stmts', bndrs, (segs', thing)), fvs) <- rnNormalStmtsAndFindUsedBinders ctxt stmts $ \new_bndrs -> do
- -- Typecheck the thing inside, passing on all
- -- the Names bound, but separately; revert the envt
- setLocalRdrEnv orig_lcl_env $ do
- go orig_lcl_env (new_bndrs ++ bndrs_so_far) segs
-
- let seg' = (stmts', bndrs)
- return (((seg':segs'), thing), delListFromNameSet fvs bndrs)
-
- cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
- dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
+ -- 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 }
+ where
+ rn_segs :: LocalRdrEnv
+ -> [Name] -> [ParSeg RdrName]
+ -> RnM (([ParSeg Name], thing), FreeVars)
+ rn_segs _ bndrs_so_far []
+ = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far
+ ; mapM_ dupErr dups
+ ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')
+ ; return (([], thing), fvs) }
+
+ rn_segs env bndrs_so_far ((stmts,_) : segs)
+ = do { ((stmts', (used_bndrs, segs', thing)), fvs)
+ <- rnStmts ctxt stmts $ \ bndrs ->
+ setLocalRdrEnv env $ do
+ { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs
+ ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
+ ; return ((used_bndrs, segs', thing), fvs) }
+
+ ; let seg' = (stmts', used_bndrs)
+ ; return ((seg':segs', thing), fvs) }
+
+ cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
+ dupErr vs = addErr (ptext (sLit "Duplicate binding in parallel list comprehension for:")