Fix Trac #3813: unused variables in GHCi bindings

In a GHCi stmt we don't want to report unused variables, 
because we don't know the scope of the binding, eg

	Prelude> x <- blah

Fixing this needed a little more info about the context of the stmt,
thus the new constructor GhciStmt in the HsStmtContext type.

compiler/deSugar/DsExpr.lhs

@@ -323,6 +323,9 @@ dsExpr (HsDo ListComp stmts body result_ty)
 dsExpr (HsDo DoExpr stmts body result_ty)
   = dsDo stmts body result_ty
 
+dsExpr (HsDo GhciStmt stmts body result_ty)
+  = dsDo stmts body result_ty
+
 dsExpr (HsDo (MDoExpr tbl) stmts body result_ty)
   = dsMDo tbl stmts body result_ty
 

compiler/deSugar/DsMeta.hs

@@ -714,20 +714,26 @@ repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
 			       ; e2 <- addBinds ss (repLE e)
 			       ; z <- repLetE ds e2
 			       ; wrapGenSyns ss z }
+
 -- FIXME: I haven't got the types here right yet
-repE (HsDo DoExpr sts body _) 
+repE e@(HsDo ctxt sts body _) 
+ | case ctxt of { DoExpr -> True; GhciStmt -> True; _ -> False }
  = do { (ss,zs) <- repLSts sts; 
 	body'	<- addBinds ss $ repLE body;
 	ret	<- repNoBindSt body';	
-        e       <- repDoE (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE (HsDo ListComp sts body _)
+        e'      <- repDoE (nonEmptyCoreList (zs ++ [ret]));
+        wrapGenSyns ss e' }
+
+ | ListComp <- ctxt
  = do { (ss,zs) <- repLSts sts; 
 	body'	<- addBinds ss $ repLE body;
 	ret	<- repNoBindSt body';	
-        e       <- repComp (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
+        e'      <- repComp (nonEmptyCoreList (zs ++ [ret]));
+        wrapGenSyns ss e' }
+
+  | otherwise
+  = notHandled "mdo and [: :]" (ppr e)
+
 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
 repE e@(ExplicitTuple es boxed) 

compiler/hsSyn/HsExpr.lhs

@@ -978,7 +978,7 @@ pprDo DoExpr      stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
 pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
 pprDo ListComp    stmts body = pprComp brackets    stmts body
 pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
-pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
+pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt, GhciStmt
 
 ppr_do_stmts :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
 -- Print a bunch of do stmts, with explicit braces and semicolons,
@@ -1092,6 +1092,7 @@ data HsMatchContext id  -- Context of a Match
 data HsStmtContext id
   = ListComp
   | DoExpr
+  | GhciStmt				 -- A command-line Stmt in GHCi pat <- rhs
   | MDoExpr PostTcTable                  -- Recursive do-expression
                                          -- (tiresomely, it needs table
                                          --  of its return/bind ops)
@@ -1143,6 +1144,7 @@ pprStmtContext (TransformStmtCtxt c)
  = sep [ptext (sLit "a transformed branch of"), pprStmtContext c]
 pprStmtContext (PatGuard ctxt)
  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
+pprStmtContext GhciStmt        = ptext (sLit "an interactive GHCi command")
 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
 pprStmtContext (MDoExpr _)     = ptext (sLit "an 'mdo' expression")
 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
@@ -1174,6 +1176,7 @@ matchContextErrString ProcExpr                   = ptext (sLit "proc")
 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
 matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
 matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
+matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
 matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
 matchContextErrString (StmtCtxt (MDoExpr _))     = ptext (sLit "'mdo' expression")
 matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")

compiler/rename/RnEnv.lhs

@@ -651,7 +651,6 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
 --------------------------------
 -- Used for nested fixity decls to bind names along with their fixities.
 -- the fixities are given as a UFM from an OccName's FastString to a fixity decl
--- Also check for unused binders
 bindLocalNamesFV_WithFixities :: [Name]
 			      -> MiniFixityEnv
 			      -> RnM (a, FreeVars) -> RnM (a, FreeVars)

compiler/rename/RnPat.lhs

@@ -133,9 +133,11 @@ which is how you go from a RdrName to a Name
 data NameMaker 
   = LamMk 	-- Lambdas 
       Bool	-- True <=> report unused bindings
+      		--   (even if True, the warning only comes out 
+		--    if -fwarn-unused-matches is on)
 
   | LetMk       -- Let bindings, incl top level
-		-- Do not check for unused bindings
+		-- Do *not* check for unused bindings
       (Maybe Module)   -- Just m  => top level of module m
                        -- Nothing => not top level
       MiniFixityEnv
@@ -146,8 +148,14 @@ topRecNameMaker mod fix_env = LetMk (Just mod) fix_env
 localRecNameMaker :: MiniFixityEnv -> NameMaker
 localRecNameMaker fix_env = LetMk Nothing fix_env 
 
-matchNameMaker :: NameMaker
-matchNameMaker = LamMk True
+matchNameMaker :: HsMatchContext a -> NameMaker
+matchNameMaker ctxt = LamMk report_unused
+  where
+    -- Do not report unused names in interactive contexts
+    -- i.e. when you type 'x <- e' at the GHCi prompt
+    report_unused = case ctxt of
+                      StmtCtxt GhciStmt -> False
+                      _                 -> True
 
 newName :: NameMaker -> Located RdrName -> CpsRn Name
 newName (LamMk report_unused) rdr_name
@@ -212,8 +220,8 @@ rnPats ctxt pats thing_inside
 	  -- (0) bring into scope all of the type variables bound by the patterns
 	  -- (1) rename the patterns, bringing into scope all of the term variables
 	  -- (2) then do the thing inside.
-	; bindPatSigTyVarsFV (collectSigTysFromPats pats) $ 
-	  unCpsRn (rnLPatsAndThen matchNameMaker pats)	  $ \ pats' -> do
+	; bindPatSigTyVarsFV (collectSigTysFromPats pats)     $ 
+	  unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
         { -- Check for duplicated and shadowed names 
 	         -- Because we don't bind the vars all at once, we can't
 	         -- 	check incrementally for duplicates; 

compiler/typecheck/TcMatches.lhs

@@ -243,8 +243,7 @@ tcDoStmts PArrComp stmts body res_ty
                      (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
 
 tcDoStmts DoExpr stmts body res_ty
-  = do	{ (stmts', body') <- tcStmts DoExpr tcDoStmt stmts 
-				     res_ty $
+  = do	{ (stmts', body') <- tcStmts DoExpr tcDoStmt stmts res_ty $
 			     tcBody body
 	; return (HsDo DoExpr stmts' body' res_ty) }
 

compiler/typecheck/TcRnDriver.lhs

@@ -1065,7 +1065,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
     setInteractiveContext hsc_env ictxt $ do {
 
     -- Rename; use CmdLineMode because tcRnStmt is only used interactively
-    (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
+    (([rn_stmt], _), fvs) <- rnStmts GhciStmt [rdr_stmt] (return ((), emptyFVs)) ;
     traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
     failIfErrsM ;
     rnDump (ppr rn_stmt) ;
@@ -1234,7 +1234,7 @@ tcGhciStmts stmts
 	let {
 	    ret_ty    = mkListTy unitTy ;
 	    io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
-	    tc_io_stmts stmts = tcStmts DoExpr tcDoStmt stmts io_ret_ty ;
+	    tc_io_stmts stmts = tcStmts GhciStmt tcDoStmt stmts io_ret_ty ;
 
 	    names = map unLoc (collectLStmtsBinders stmts) ;
 
@@ -1269,7 +1269,7 @@ tcGhciStmts stmts
 
 	traceTc (text "TcRnDriver.tcGhciStmts: done") ;
 	return (ids, mkHsDictLet const_binds $
-		     noLoc (HsDo DoExpr tc_stmts (mk_return ids) io_ret_ty))
+		     noLoc (HsDo GhciStmt tc_stmts (mk_return ids) io_ret_ty))
     }
 \end{code}