Commit 85f969a6 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

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.
parent dfa43eb4
......@@ -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
......
......@@ -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)
......
......@@ -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")
......
......@@ -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)
......
......@@ -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;
......
......@@ -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) }
......
......@@ -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}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment