newTopSrcBinder, lookupFamInstDeclBndr,
lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn,
- lookupLocatedGlobalOccRn,
- lookupGlobalOccRn, lookupGlobalOccRn_maybe,
+ lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupLocalDataTcNames, lookupSigOccRn,
lookupFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
- lookupSyntaxName, lookupSyntaxTable,
+ lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
getLookupOccRn, addUsedRdrNames,
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 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 LazyUniqFM
+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
-- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
-- The latter does pickGREs, but we want to allow 'x'
-- even if only 'M.x' is in scope
- [gre] -> do { addUsedRdrNames (used_rdr_names gre)
+ [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
; return (gre_name gre) }
[] -> do { addErr (unknownSubordinateErr doc rdr_name)
; traceRn (text "RnEnv.lookup_sub_bndr" <+> (ppr rdr_name $$ ppr gres))
gres -> do { addNameClashErrRn rdr_name gres
; return (gre_name (head gres)) } }
where
+ rdr_occ = rdrNameOcc rdr_name
+
pick NoParent gres -- Normal lookup
= pickGREs rdr_name gres
pick (ParentIs p) gres -- Disambiguating lookup
right_parent _ _ = False
-- Note [Usage for sub-bndrs]
- used_rdr_names gre
- | isQual rdr_name = [rdr_name]
+ used_rdr_name gre
+ | isQual rdr_name = rdr_name
| otherwise = case gre_prov gre of
- LocalDef -> [rdr_name]
- Imported is -> map mk_qual_rdr is
- mk_qual_rdr imp_spec = mkRdrQual (is_as (is_decl imp_spec)) rdr_occ
- rdr_occ = rdrNameOcc rdr_name
+ LocalDef -> rdr_name
+ Imported is -> used_rdr_name_from_is is
+
+ used_rdr_name_from_is imp_specs -- rdr_name is unqualified
+ | not (all (is_qual . is_decl) imp_specs)
+ = rdr_name -- An unqualified import is available
+ | otherwise
+ = -- Only qualified imports available, so make up
+ -- a suitable qualifed name from the first imp_spec
+ ASSERT( not (null imp_specs) )
+ mkRdrQual (is_as (is_decl (head imp_specs))) rdr_occ
newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
~~~~~~~~~~~~~~~~~~~~~~~~~~
If you have this
import qualified M( C( f ) )
- intance M.C T where
+ instance M.C T where
f x = x
then is the qualified import M.f used? Obviously yes.
But the RdrName used in the instance decl is unqualified. In effect,
we fill in the qualification by looking for f's whose class is M.C
But when adding to the UsedRdrNames we must make that qualification
-explicit, otherwise we get "Redundant import of M.C".
+explicit (saying "used M.f"), otherwise we get "Redundant import of M.f".
+
+So we make up a suitable (fake) RdrName. But be careful
+ import qualifed M
+ import M( C(f) )
+ instance C T where
+ f x = x
+Here we want to record a use of 'f', not of 'M.f', otherwise
+we'll miss the fact that the qualified import is redundant.
--------------------------------------------------
-- Occurrences
-- 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
+ = do { local_env <- getLocalRdrEnv
+ ; case lookupLocalRdrEnv local_env rdr_name of {
+ Just name -> return name ;
+ Nothing -> do
-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.
-
-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
checks the type of the user thing against the type of the standard thing.
\begin{code}
+lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
+-- Different to lookupSyntaxName because in the non-rebindable
+-- case we desugar directly rather than calling an existing function
+-- Hence the (Maybe (SyntaxExpr Name)) return type
+lookupIfThenElse
+ = do { rebind <- xoptM Opt_RebindableSyntax
+ ; if not rebind
+ then return (Nothing, emptyFVs)
+ else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
+ ; return (Just (HsVar ite), unitFV ite) } }
+
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
+ = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
+ if not rebindable_on then normal_case
else
-- Get the similarly named thing from the local environment
lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
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'))
+ where loc' = case loc of
+ UnhelpfulSpan _ ->
+ panic "unknownNameSuggestErr UnhelpfulSpan"
+ RealSrcSpan l -> l
+ 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