From aa94469a1e3911b490330faf39b4ff43eab6f0c2 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 2 Oct 2003 22:31:49 +0000
Subject: [PATCH 1/1] [project @ 2003-10-02 22:31:46 by sof] Fix handling of
 unused-matches for parallel list comprs. e.g, for,

     [ e | v1 <- e11 | v2 <- e21 ]

'e' wasn't considered part of v1 & v2's scope. Is now.
---
 ghc/compiler/rename/RnExpr.lhs  |   29 +++++++++++++++++++----------
 ghc/compiler/rename/RnTypes.lhs |    8 +++++---
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index b8501e3..daa9767 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -81,8 +81,8 @@ rnMatch ctxt match@(Match pats maybe_rhs_sig grhss)
     )					`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
@@ -387,8 +387,8 @@ rnExpr e@(ELazyPat _) = addErr (patSynErr e)	`thenM_`
 \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)
@@ -687,8 +687,8 @@ rnNormalStmts ctxt [] = returnM ([], emptyFVs)
 	-- 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)
@@ -703,8 +703,14 @@ rnNormalStmts ctxt (BindStmt pat expr src_loc : stmts)
     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
@@ -735,13 +741,16 @@ rnNormalStmts ctxt (ParStmt stmtss : stmts)
 	--       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
 
diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index 8644587..0125dab 100644
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -288,6 +288,7 @@ rnPred doc (HsIParam n ty)
 
 \begin{code}
 rnPatsAndThen :: HsMatchContext Name
+	      -> Bool
 	      -> [RdrNamePat] 
 	      -> ([RenamedPat] -> RnM (a, FreeVars))
 	      -> RnM (a, FreeVars)
@@ -299,7 +300,7 @@ rnPatsAndThen :: HsMatchContext Name
 -- 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) ->
@@ -308,8 +309,9 @@ rnPatsAndThen ctxt pats thing_inside
     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
-- 
1.7.10.4