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
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
-- (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;
-- Nor can we check incrementally for shadowing, else we'll
-- complain *twice* about duplicates e.g. f (x,x) = ...
; let names = collectPatsBinders pats'
- ; checkDupNames doc_pat names
- ; checkShadowedNames doc_pat envs_before
- [(nameSrcSpan name, nameOccName name) | name <- names]
+ ; addErrCtxt doc_pat $ checkDupAndShadowedNames envs_before names
; thing_inside pats' } }
where
doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
, hsRecFieldArg = arg
, hsRecPun = pun })
- = do { fld' <- lookupLocatedSubBndr parent doc fld
+ = do { fld' <- wrapLocM (lookupSubBndr parent doc) fld
; arg' <- if pun
then do { checkErr pun_ok (badPun fld)
; return (name_to_arg fld') }
extras = [ HsRecField
{ hsRecFieldId = L loc f
, hsRecFieldArg = name_to_arg (L loc f)
- , hsRecPun = True }
+ , hsRecPun = False }
| f <- absent_flds ]
; return (flds ++ extras) }