[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.

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index b8501e3..daa9767 100644 (file)
--- 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 (file)
--- 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