newTopSrcBinder, lookupFamInstDeclBndr,
lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn,
- lookupLocatedGlobalOccRn,
- lookupGlobalOccRn, lookupGlobalOccRn_maybe,
+ lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupLocalDataTcNames, lookupSigOccRn,
lookupFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
newLocalBndrRn, newLocalBndrsRn, newIPNameRn,
bindLocalName, bindLocalNames, bindLocalNamesFV,
MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
- bindLocalNamesFV_WithFixities,
+ addLocalFixities,
bindLocatedLocalsFV, bindLocatedLocalsRn,
bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
- bindTyVarsRn, extendTyVarEnvFVRn,
+ bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
checkDupRdrNames, checkDupAndShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames,
addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
- warnUnusedMatches, warnUnusedModules, warnUnusedImports,
+ warnUnusedMatches,
warnUnusedTopBinds, warnUnusedLocalBinds,
dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg
) where
import LoadIface ( loadInterfaceForName, loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
+import TcEnv ( getHetMetLevel )
import HsSyn
import RdrHsSyn ( extractHsTyRdrTyVars )
import RdrName
import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage )
import TcRnMonad
import Id ( isRecordSelector )
-import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
- nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
+import Name
import NameSet
import NameEnv
+import Module ( ModuleName, moduleName )
import UniqFM
import DataCon ( dataConFieldLabels )
-import OccName
-import Module ( Module, ModuleName )
-import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
- consDataConKey, forall_tv_RDR )
+import PrelNames ( mkUnboundName, rOOT_MAIN, consDataConKey, forall_tv_RDR )
import Unique
import BasicTypes
import ErrUtils ( Message )
%*********************************************************
\begin{code}
-newTopSrcBinder :: Module -> Located RdrName -> RnM Name
-newTopSrcBinder this_mod (L loc rdr_name)
+newTopSrcBinder :: Located RdrName -> RnM Name
+newTopSrcBinder (L loc rdr_name)
| Just name <- isExact_maybe rdr_name
= -- This is here to catch
-- (a) Exact-name binders created by Template Haskell
-- data T = (,) Int Int
-- unless we are in GHC.Tup
ASSERT2( isExternalName name, ppr name )
- do { unless (this_mod == nameModule name)
+ do { this_mod <- getModule
+ ; unless (this_mod == nameModule name)
(addErrAt loc (badOrigBinding rdr_name))
; return name }
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
- = do { unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+ = do { this_mod <- getModule
+ ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
(addErrAt loc (badOrigBinding rdr_name))
-- When reading External Core we get Orig names as binders,
-- but they should agree with the module gotten from the monad
; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
else
-- Normal case
- newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
+ do { this_mod <- getModule
+ ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
\end{code}
%*********************************************************
case nopt of
Just n' -> return n'
Nothing -> do traceRn $ text "lookupTopBndrRn"
- unboundName n
+ unboundName WL_LocalTop n
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
-- See Note [Type and class operator definitions]
let occ = rdrNameOcc rdr_name
; when (isTcOcc occ && isSymOcc occ)
- (do { op_ok <- doptM Opt_TypeOperators
+ (do { op_ok <- xoptM Opt_TypeOperators
; unless op_ok (addErr (opDeclErr rdr_name)) })
; mb_gre <- lookupGreLocalRn rdr_name
-- lookupOccRn looks up an occurrence of a RdrName
lookupOccRn :: RdrName -> RnM Name
lookupOccRn rdr_name
- = getLocalRdrEnv `thenM` \ local_env ->
- case lookupLocalRdrEnv local_env rdr_name of
- Just name -> return name
- Nothing -> lookupGlobalOccRn rdr_name
-
-lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
-
-lookupGlobalOccRn :: RdrName -> RnM Name
--- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
--- environment. Adds an error message if the RdrName is not in scope.
--- Also has a special case for GHCi.
+ = do { local_env <- getLocalRdrEnv
+ ; case lookupLocalRdrEnv local_env rdr_name of {
+ Just name -> return name ;
+ Nothing -> do
-lookupGlobalOccRn rdr_name
- = do { -- First look up the name in the normal environment.
- mb_name <- lookupGlobalOccRn_maybe rdr_name
+ { mb_name <- lookupGlobalOccRn_maybe rdr_name
; case mb_name of {
Just n -> return n ;
Nothing -> do
-- *any* name exported by any module in scope, just as if there
-- was an "import qualified M" declaration for every module.
allow_qual <- doptM Opt_ImplicitImportQualified
- ; mod <- getModule
+ ; is_ghci <- getIsGHCi
-- This test is not expensive,
-- and only happens for failed lookups
- ; if isQual rdr_name && allow_qual && mod == iNTERACTIVE
+ ; if isQual rdr_name && allow_qual && is_ghci
then lookupQualifiedName rdr_name
- else unboundName rdr_name } } }
+ else unboundName WL_Any rdr_name } } } } }
+
+
+lookupGlobalOccRn :: RdrName -> RnM Name
+-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
+-- environment. Adds an error message if the RdrName is not in scope.
+lookupGlobalOccRn rdr_name
+ = do { mb_name <- lookupGlobalOccRn_maybe rdr_name
+ ; case mb_name of
+ Just n -> return n
+ Nothing -> unboundName WL_Global rdr_name }
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- No filter function; does not report an error on failure
Just gre -> return (Just (gre_name gre)) }
-unboundName :: RdrName -> RnM Name
-unboundName rdr_name
- = do { addErr (unknownNameErr rdr_name)
- ; env <- getGlobalRdrEnv;
- ; traceRn (vcat [unknownNameErr rdr_name,
- ptext (sLit "Global envt is:"),
- nest 3 (pprGlobalRdrEnv env)])
- ; return (mkUnboundName rdr_name) }
-
--------------------------------------------------
-- Lookup in the Global RdrEnv of the module
--------------------------------------------------
Just gre -> return gre ;
Nothing -> do
{ traceRn $ text "lookupGreRn"
- ; name <- unboundName rdr_name
+ ; name <- unboundName WL_Global rdr_name
; return (GRE { gre_name = name, gre_par = NoParent,
gre_prov = LocalDef }) }}}
name == occ ] of
((mod,occ):ns) -> ASSERT (null ns)
lookupOrig mod occ
- _ -> unboundName rdr_name
+ _ -> unboundName WL_Any rdr_name
| otherwise
= pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
doc = ptext (sLit "Need to find") <+> ppr rdr_name
\end{code}
+Note [Looking up signature names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lookupSigOccRn is used for type signatures and pragmas
Is this valid?
module A
correctly report "misplaced type sig".
\begin{code}
-lookupSigOccRn :: Maybe NameSet -- Just ns => source file; these are the binders
+lookupSigOccRn :: Maybe NameSet -- Just ns => these are the binders
-- in the same group
- -- Nothing => hs-boot file; signatures without
+ -- Nothing => signatures without
-- binders are expected
+ -- (a) top-level (SPECIALISE prags)
+ -- (b) class decls
+ -- (c) hs-boot files
-> Sig RdrName
-> Located RdrName -> RnM (Located Name)
lookupSigOccRn mb_bound_names sig
Left err -> do { addErr err; return (mkUnboundName rdr_name) }
Right name -> return name }
-lookupBindGroupOcc :: Maybe NameSet -- Just ns => source file; these are the binders
- -- in the same group
- -- Nothing => hs-boot file; signatures without
- -- binders are expected
- -> SDoc
+lookupBindGroupOcc :: Maybe NameSet -- See notes on the (Maybe NameSet)
+ -> SDoc -- in lookupSigOccRn
-> RdrName -> RnM (Either Message Name)
-- Looks up the RdrName, expecting it to resolve to one of the
-- bound names passed in. If not, return an appropriate error message
+--
+-- See Note [Looking up signature names]
lookupBindGroupOcc mb_bound_names what rdr_name
- = do { local_env <- getLocalRdrEnv
- ; case lookupLocalRdrEnv local_env rdr_name of
- Just n -> check_local_name n
- Nothing -> do -- Not defined in a nested scope
+ = do { local_env <- getLocalRdrEnv
+ ; case lookupLocalRdrEnv local_env rdr_name of {
+ Just n -> check_local_name n;
+ Nothing -> do -- Not defined in a nested scope
{ env <- getGlobalRdrEnv
- ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
- ; case (filter isLocalGRE gres) of
- (gre:_) -> check_local_name (gre_name gre)
- -- If there is more than one local GRE for the
- -- same OccName, that will be reported separately
- [] | null gres -> bale_out_with empty
- | otherwise -> bale_out_with import_msg
- }}
+ ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
+ ; case (filter isLocalGRE gres) of
+ (gre:_) -> check_local_name (gre_name gre)
+ -- If there is more than one local GRE for the
+ -- same OccName 'f', that will be reported separately
+ -- as a duplicate top-level binding for 'f'
+ [] | null gres -> bale_out_with empty
+ | otherwise -> bale_out_with import_msg
+ }}}
where
check_local_name name -- The name is in scope, and not imported
= case mb_bound_names of
--------------------------------
-- 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
-bindLocalNamesFV_WithFixities :: [Name]
- -> MiniFixityEnv
- -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-bindLocalNamesFV_WithFixities names fixities thing_inside
- = bindLocalNamesFV names $
- extendFixityEnv boundFixities $
- thing_inside
+
+addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
+addLocalFixities mini_fix_env names thing_inside
+ = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
where
- -- find the names that have fixity decls
- boundFixities = foldr
- (\ name -> \ acc ->
- -- check whether this name has a fixity decl
- case lookupFsEnv fixities (occNameFS (nameOccName name)) of
- Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc
- Nothing -> acc) [] names
- -- bind the names; extend the fixity env; do the thing inside
+ find_fixity name
+ = case lookupFsEnv mini_fix_env (occNameFS occ) of
+ Just (L _ fix) -> Just (name, FixItem occ fix)
+ Nothing -> Nothing
+ where
+ occ = nameOccName name
\end{code}
--------------------------------
%* *
Rebindable names
Dealing with rebindable syntax is driven by the
- Opt_NoImplicitPrelude dynamic flag.
+ Opt_RebindableSyntax dynamic flag.
In "deriving" code we don't want to use rebindable syntax
so we switch off the flag locally
lookupSyntaxName :: Name -- The standard name
-> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name
lookupSyntaxName std_name
- = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude ->
- if implicit_prelude then normal_case
- else
- -- Get the similarly named thing from the local environment
- lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
- return (HsVar usr_name, unitFV usr_name)
- where
- normal_case = return (HsVar std_name, emptyFVs)
+ = do ec <- getHetMetLevel
+ std_name' <- return $ setNameDepth (length ec) std_name
+ rebindable_on <- xoptM Opt_RebindableSyntax
+ if not rebindable_on
+ then return (HsVar std_name', emptyFVs)
+ else do usr_name <- lookupOccRn (mkRdrUnqual (nameOccName std_name'))
+ return (HsVar usr_name, unitFV usr_name)
+ -- Get the similarly named thing from the local environment
lookupSyntaxTable :: [Name] -- Standard names
-> RnM (SyntaxTable Name, FreeVars) -- See comments with HsExpr.ReboundNames
lookupSyntaxTable std_names
- = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude ->
- if implicit_prelude then normal_case
+ = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
+ if not rebindable_on then normal_case
else
-- Get the similarly named thing from the local environment
mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV names enclosed_scope
= do { (result, fvs) <- bindLocalNames names enclosed_scope
- ; return (result, delListFromNameSet fvs names) }
+ ; return (result, delFVs names fvs) }
-------------------------------------
bindLocatedLocalsFV rdr_names enclosed_scope
= bindLocatedLocalsRn rdr_names $ \ names ->
enclosed_scope names `thenM` \ (thing, fvs) ->
- return (thing, delListFromNameSet fvs names)
+ return (thing, delFVs names fvs)
-------------------------------------
+bindTyVarsFV :: [LHsTyVarBndr RdrName]
+ -> ([LHsTyVarBndr Name] -> RnM (a, FreeVars))
+ -> RnM (a, FreeVars)
+bindTyVarsFV tyvars thing_inside
+ = bindTyVarsRn tyvars $ \ tyvars' ->
+ do { (res, fvs) <- thing_inside tyvars'
+ ; return (res, delFVs (map hsLTyVarName tyvars') fvs) }
+
bindTyVarsRn :: [LHsTyVarBndr RdrName]
-> ([LHsTyVarBndr Name] -> RnM a)
-> RnM a
-- Haskell-98 binding of type variables; e.g. within a data type decl
bindTyVarsRn tyvar_names enclosed_scope
= bindLocatedLocalsRn located_tyvars $ \ names ->
- do { kind_sigs_ok <- doptM Opt_KindSignatures
+ do { kind_sigs_ok <- xoptM Opt_KindSignatures
; unless (null kinded_tyvars || kind_sigs_ok)
(mapM_ (addErr . kindSigErr) kinded_tyvars)
; enclosed_scope (zipWith replace tyvar_names names) }
-- Find the type variables in the pattern type
-- signatures that must be brought into scope
bindPatSigTyVars tys thing_inside
- = do { scoped_tyvars <- doptM Opt_ScopedTypeVariables
+ = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables
; if not scoped_tyvars then
thing_inside []
else
-> RnM (a, FreeVars)
-> RnM (a, FreeVars)
bindSigTyVarsFV tvs thing_inside
- = do { scoped_tyvars <- doptM Opt_ScopedTypeVariables
+ = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables
; if not scoped_tyvars then
thing_inside
else
-------------------------------------
checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM ()
checkShadowedOccs (global_env,local_env) loc_occs
- = ifOptM Opt_WarnNameShadowing $
+ = ifDOptM Opt_WarnNameShadowing $
do { traceRn (text "shadow" <+> ppr loc_occs)
; mapM_ check_shadow loc_occs }
where
-- punning or wild-cards are on (cf Trac #2723)
is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
= do { dflags <- getDOpts
- ; if (dopt Opt_RecordPuns dflags || dopt Opt_RecordWildCards dflags)
+ ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
then do { is_fld <- is_rec_fld gre; return (not is_fld) }
else return True }
is_shadowed_gre _other = return True
%************************************************************************
%* *
+ What to do when a lookup fails
+%* *
+%************************************************************************
+
+\begin{code}
+data WhereLooking = WL_Any -- Any binding
+ | WL_Global -- Any top-level binding (local or imported)
+ | WL_LocalTop -- Any top-level binding in this module
+
+unboundName :: WhereLooking -> RdrName -> RnM Name
+unboundName where_look rdr_name
+ = do { show_helpful_errors <- doptM Opt_HelpfulErrors
+ ; let err = unknownNameErr rdr_name
+ ; if not show_helpful_errors
+ then addErr err
+ else do { extra_err <- unknownNameSuggestErr where_look rdr_name
+ ; addErr (err $$ extra_err) }
+
+ ; env <- getGlobalRdrEnv;
+ ; traceRn (vcat [unknownNameErr rdr_name,
+ ptext (sLit "Global envt is:"),
+ nest 3 (pprGlobalRdrEnv env)])
+
+ ; return (mkUnboundName rdr_name) }
+
+unknownNameErr :: RdrName -> SDoc
+unknownNameErr rdr_name
+ = vcat [ hang (ptext (sLit "Not in scope:"))
+ 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+ <+> quotes (ppr rdr_name))
+ , extra ]
+ where
+ extra | rdr_name == forall_tv_RDR = perhapsForallMsg
+ | otherwise = empty
+
+type HowInScope = Either SrcSpan ImpDeclSpec
+ -- Left loc => locally bound at loc
+ -- Right ispec => imported as specified by ispec
+
+unknownNameSuggestErr :: WhereLooking -> RdrName -> RnM SDoc
+unknownNameSuggestErr where_look tried_rdr_name
+ = do { local_env <- getLocalRdrEnv
+ ; global_env <- getGlobalRdrEnv
+
+ ; let all_possibilities :: [(String, (RdrName, HowInScope))]
+ all_possibilities
+ = [ (showSDoc (ppr r), (r, Left loc))
+ | (r,loc) <- local_possibilities local_env ]
+ ++ [ (showSDoc (ppr r), rp) | (r,rp) <- global_possibilities global_env ]
+
+ suggest = fuzzyLookup (showSDoc (ppr tried_rdr_name)) all_possibilities
+ perhaps = ptext (sLit "Perhaps you meant")
+ extra_err = case suggest of
+ [] -> empty
+ [p] -> perhaps <+> pp_item p
+ ps -> sep [ perhaps <+> ptext (sLit "one of these:")
+ , nest 2 (pprWithCommas pp_item ps) ]
+ ; return extra_err }
+ where
+ pp_item :: (RdrName, HowInScope) -> SDoc
+ pp_item (rdr, Left loc) = quotes (ppr rdr) <+> -- Locally defined
+ parens (ptext (sLit "line") <+> int (srcSpanStartLine loc))
+ pp_item (rdr, Right is) = quotes (ppr rdr) <+> -- Imported
+ parens (ptext (sLit "imported from") <+> ppr (is_mod is))
+
+ tried_occ = rdrNameOcc tried_rdr_name
+ tried_is_sym = isSymOcc tried_occ
+ tried_ns = occNameSpace tried_occ
+ tried_is_qual = isQual tried_rdr_name
+
+ correct_name_space occ = occNameSpace occ == tried_ns
+ && isSymOcc occ == tried_is_sym
+ -- Treat operator and non-operators as non-matching
+ -- This heuristic avoids things like
+ -- Not in scope 'f'; perhaps you meant '+' (from Prelude)
+
+ local_ok = case where_look of { WL_Any -> True; _ -> False }
+ local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]
+ local_possibilities env
+ | tried_is_qual = []
+ | not local_ok = []
+ | otherwise = [ (mkRdrUnqual occ, nameSrcSpan name)
+ | name <- occEnvElts env
+ , let occ = nameOccName name
+ , correct_name_space occ]
+
+ gre_ok :: GlobalRdrElt -> Bool
+ gre_ok = case where_look of
+ WL_LocalTop -> isLocalGRE
+ _ -> \_ -> True
+
+ global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
+ global_possibilities global_env
+ | tried_is_qual = [ (rdr_qual, (rdr_qual, how))
+ | gre <- globalRdrEnvElts global_env
+ , gre_ok gre
+ , let name = gre_name gre
+ occ = nameOccName name
+ , correct_name_space occ
+ , (mod, how) <- quals_in_scope name (gre_prov gre)
+ , let rdr_qual = mkRdrQual mod occ ]
+
+ | otherwise = [ (rdr_unqual, pair)
+ | gre <- globalRdrEnvElts global_env
+ , gre_ok gre
+ , let name = gre_name gre
+ prov = gre_prov gre
+ occ = nameOccName name
+ rdr_unqual = mkRdrUnqual occ
+ , correct_name_space occ
+ , pair <- case (unquals_in_scope name prov, quals_only occ prov) of
+ (how:_, _) -> [ (rdr_unqual, how) ]
+ ([], pr:_) -> [ pr ] -- See Note [Only-quals]
+ ([], []) -> [] ]
+
+ -- Note [Only-quals]
+ -- The second alternative returns those names with the same
+ -- OccName as the one we tried, but live in *qualified* imports
+ -- e.g. if you have:
+ --
+ -- > import qualified Data.Map as Map
+ -- > foo :: Map
+ --
+ -- then we suggest @Map.Map@.
+
+ --------------------
+ unquals_in_scope :: Name -> Provenance -> [HowInScope]
+ unquals_in_scope n LocalDef = [ Left (nameSrcSpan n) ]
+ unquals_in_scope _ (Imported is) = [ Right ispec
+ | i <- is, let ispec = is_decl i
+ , not (is_qual ispec) ]
+
+ --------------------
+ quals_in_scope :: Name -> Provenance -> [(ModuleName, HowInScope)]
+ -- Ones for which the qualified version is in scope
+ quals_in_scope n LocalDef = case nameModule_maybe n of
+ Nothing -> []
+ Just m -> [(moduleName m, Left (nameSrcSpan n))]
+ quals_in_scope _ (Imported is) = [ (is_as ispec, Right ispec)
+ | i <- is, let ispec = is_decl i ]
+
+ --------------------
+ quals_only :: OccName -> Provenance -> [(RdrName, HowInScope)]
+ -- Ones for which *only* the qualified version is in scope
+ quals_only _ LocalDef = []
+ quals_only occ (Imported is) = [ (mkRdrQual (is_as ispec) occ, Right ispec)
+ | i <- is, let ispec = is_decl i, is_qual ispec ]
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Free variable manipulation}
%* *
%************************************************************************
%************************************************************************
\begin{code}
-warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
-warnUnusedModules mods
- = ifOptM Opt_WarnUnusedImports (mapM_ bleat mods)
- where
- bleat (mod,loc) = addWarnAt loc (mk_warn mod)
- mk_warn m = vcat [ptext (sLit "Module") <+> quotes (ppr m)
- <+> text "is imported, but nothing from it is used,",
- nest 2 (ptext (sLit "except perhaps instances visible in")
- <+> quotes (ppr m)),
- ptext (sLit "To suppress this warning, use:")
- <+> ptext (sLit "import") <+> ppr m <> parens empty ]
-
-
-warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
-warnUnusedImports gres = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
-warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds (warnUnusedGREs gres)
+warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
+warnUnusedTopBinds gres
+ = ifDOptM Opt_WarnUnusedBinds
+ $ do isBoot <- tcIsHsBoot
+ let noParent gre = case gre_par gre of
+ NoParent -> True
+ ParentIs _ -> False
+ -- Don't warn about unused bindings with parents in
+ -- .hs-boot files, as you are sometimes required to give
+ -- unused bindings (trac #3449).
+ gres' = if isBoot then filter noParent gres
+ else gres
+ warnUnusedGREs gres'
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds
check_unused :: DynFlag -> [Name] -> FreeVars -> RnM ()
check_unused flag bound_names used_names
- = ifOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names))
+ = ifDOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names))
-------------------------
-- Helpers
(np1:nps) = names
msg1 = ptext (sLit "either") <+> mk_ref np1
msgs = [ptext (sLit " or") <+> mk_ref np | np <- nps]
- mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
+ mk_ref gre = sep [quotes (ppr (gre_name gre)) <> comma, pprNameProvenance gre]
shadowedNameWarn :: OccName -> [SDoc] -> SDoc
shadowedNameWarn occ shadowed_locs
<+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs,
nest 2 (vcat shadowed_locs)]
-unknownNameErr :: RdrName -> SDoc
-unknownNameErr rdr_name
- = vcat [ hang (ptext (sLit "Not in scope:"))
- 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
- <+> quotes (ppr rdr_name))
- , extra ]
- where
- extra | rdr_name == forall_tv_RDR = perhapsForallMsg
- | otherwise = empty
-
perhapsForallMsg :: SDoc
perhapsForallMsg
= vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")
projects / ghc-hetmet.git / blobdiff