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,
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 Module ( ModuleName, moduleName )
import UniqFM
import DataCon ( dataConFieldLabels )
-import OccName
-import 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 )
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
%* *
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 ->
-- 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 :: [GlobalRdrElt] -> RnM ()
warnUnusedTopBinds gres
- = ifOptM Opt_WarnUnusedBinds
+ = ifDOptM Opt_WarnUnusedBinds
$ do isBoot <- tcIsHsBoot
let noParent gre = case gre_par gre of
NoParent -> True
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