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
nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
-import LazyUniqFM
+import UniqFM
import DataCon ( dataConFieldLabels )
import OccName
-import Module ( Module, ModuleName )
import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
consDataConKey, forall_tv_RDR )
import Unique
%*********************************************************
\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}
%*********************************************************
--------------------------------
-- 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}
--------------------------------
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
%************************************************************************
\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
+ = ifOptM 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
projects / ghc-hetmet.git / blobdiff