) `thenM` \ (maybe_rhs_sig', ty_fvs) ->
-- Now the main event
- rnPatsAndThen ctxt pats $ \ pats' ->
- rnGRHSs ctxt grhss `thenM` \ (grhss', grhss_fvs) ->
+ rnPatsAndThen ctxt True pats $ \ pats' ->
+ rnGRHSs ctxt grhss `thenM` \ (grhss', grhss_fvs) ->
returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
-- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
\begin{code}
rnExpr (HsProc pat body src_loc)
= addSrcLoc src_loc $
- rnPatsAndThen ProcExpr [pat] $ \ [pat'] ->
- rnCmdTop body `thenM` \ (body',fvBody) ->
+ rnPatsAndThen ProcExpr True [pat] $ \ [pat'] ->
+ rnCmdTop body `thenM` \ (body',fvBody) ->
returnM (HsProc pat' body' src_loc, fvBody)
rnExpr (HsArrApp arrow arg _ ho rtl srcloc)
-- Happens at the end of the sub-lists of a ParStmts
rnNormalStmts ctxt (ExprStmt expr _ src_loc : stmts)
- = addSrcLoc src_loc $
- rnExpr expr `thenM` \ (expr', fv_expr) ->
+ = addSrcLoc src_loc $
+ rnExpr expr `thenM` \ (expr', fv_expr) ->
rnNormalStmts ctxt stmts `thenM` \ (stmts', fvs) ->
returnM (ExprStmt expr' placeHolderType src_loc : stmts',
fv_expr `plusFV` fvs)
rnExpr expr `thenM` \ (expr', fv_expr) ->
-- The binders do not scope over the expression
- rnPatsAndThen (StmtCtxt ctxt) [pat] $ \ [pat'] ->
- rnNormalStmts ctxt stmts `thenM` \ (stmts', fvs) ->
+ let
+ reportUnused =
+ case ctxt of
+ ParStmtCtxt{} -> False
+ _ -> True
+ in
+ rnPatsAndThen (StmtCtxt ctxt) reportUnused [pat] $ \ [pat'] ->
+ rnNormalStmts ctxt stmts `thenM` \ (stmts', fvs) ->
returnM (BindStmt pat' expr' src_loc : stmts',
fv_expr `plusFV` fvs) -- fv_expr shouldn't really be filtered by
-- the rnPatsAndThen, but it does not matter
-- shadow the next; e.g. x <- xs; x <- ys
rnNormalStmts ctxt stmts `thenM` \ (stmts', fvs) ->
- -- Cut down the exported binders to just the ones neede in the body
+ -- Cut down the exported binders to just the ones needed in the body
let
used_bndrs_s = map (filter (`elemNameSet` fvs)) bndrss
+ unused_bndrs = filter (not . (`elemNameSet` fvs)) bndrs
in
+ -- With processing of the branches and the tail of comprehension done,
+ -- we can finally compute&report any unused ParStmt binders.
+ warnUnusedMatches unused_bndrs `thenM_`
returnM (ParStmt (stmtss' `zip` used_bndrs_s) : stmts',
fv_stmtss `plusFV` fvs)
-
where
rn_branch (stmts, _) = rnNormalStmts (ParStmtCtxt ctxt) stmts
\begin{code}
rnPatsAndThen :: HsMatchContext Name
+ -> Bool
-> [RdrNamePat]
-> ([RenamedPat] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
-- matches together, so that we spot the repeated variable in
-- f x x = 1
-rnPatsAndThen ctxt pats thing_inside
+rnPatsAndThen ctxt repUnused pats thing_inside
= bindPatSigTyVarsFV pat_sig_tys $
bindLocalsFV doc_pat bndrs $ \ new_bndrs ->
rnPats pats `thenM` \ (pats', pat_fvs) ->
let
unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
in
- warnUnusedMatches unused_binders `thenM_`
-
+ (if repUnused
+ then warnUnusedMatches unused_binders
+ else returnM ()) `thenM_`
returnM (res, res_fvs `plusFV` pat_fvs)
where
pat_sig_tys = collectSigTysFromPats pats