lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn,
lookupLocatedGlobalOccRn, lookupGlobalOccRn,
- lookupTopFixSigNames, lookupSrcOcc_maybe,
- lookupFixityRn, lookupLocatedSigOccRn,
+ lookupLocalDataTcNames, lookupSrcOcc_maybe,
+ lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn,
lookupLocatedInstDeclBndr,
lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
import LoadIface ( loadHomeInterface, loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
- HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType,
- LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName )
+ LHsTyVarBndr, LHsType,
+ Fixity, hsLTyVarLocNames, replaceTyVarName )
import RdrHsSyn ( extractHsTyRdrTyVars )
import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
isExact_maybe, isSrcRdrName,
GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
- Provenance(..), pprNameProvenance, ImportSpec(..)
+ Provenance(..), pprNameProvenance,
+ importSpecLoc, importSpecModule
)
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
-import Name ( Name, nameIsLocalOrFrom, mkInternalName,
+import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
import NameSet
-import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
+import OccName ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
+ reportIfUnused )
import Module ( Module )
import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
import UniqSupply
import Util ( sortLe )
import ListSetOps ( removeDups )
import List ( nubBy )
+import Monad ( when )
import DynFlags
\end{code}
%*********************************************************
\begin{code}
-lookupTopFixSigNames :: RdrName -> RnM [Name]
+lookupLocalDataTcNames :: RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con
-- for con-like things
-lookupTopFixSigNames rdr_name
+-- Complain if neither is in scope
+lookupLocalDataTcNames rdr_name
| Just n <- isExact_maybe rdr_name
-- Special case for (:), which doesn't get into the GlobalRdrEnv
= return [n] -- For this we don't need to try the tycon too
| otherwise
= do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
- ; return [gre_name gre | Just gre <- mb_gres] }
+ ; case [gre_name gre | Just gre <- mb_gres] of
+ [] -> do { addErr (unknownNameErr rdr_name)
+ ; return [] }
+ names -> return names
+ }
--------------------------------
bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
--
-- loadHomeInterface will find B.hi even if B is a hidden module,
-- and that's what we want.
- initIfaceTcRn (loadHomeInterface doc name) `thenM` \ iface ->
+ loadHomeInterface doc name `thenM` \ iface ->
returnM (mi_fix_fn iface (nameOccName name))
where
- doc = ptext SLIT("Checking fixity for") <+> ppr name
+ doc = ptext SLIT("Checking fixity for") <+> ppr name
+---------------
+lookupTyFixityRn :: Located Name -> RnM Fixity
+lookupTyFixityRn (L loc n)
+ = doptM Opt_GlasgowExts `thenM` \ glaExts ->
+ when (not glaExts)
+ (setSrcSpan loc $ addWarn (infixTyConWarn n)) `thenM_`
+ lookupFixityRn n
+
+---------------
dataTcOccs :: RdrName -> [RdrName]
-- If the input is a data constructor, return both it and a type
-- constructor. This is useful when we aren't sure which we are
thing_inside `thenM` \ (result,fvs) ->
returnM (result, fvs `delListFromNameSet` tvs)
-bindSigTyVarsFV :: [LSig Name]
+bindSigTyVarsFV :: [Name]
-> RnM (a, FreeVars)
-> RnM (a, FreeVars)
--- Bind the top-level forall'd type variables in the sigs.
--- E.g f :: a -> a
--- f = rhs
--- The 'a' scopes over the rhs
---
--- NB: there'll usually be just one (for a function binding)
--- but if there are many, one may shadow the rest; too bad!
--- e.g x :: [a] -> [a]
--- y :: [(a,a)] -> a
--- (x,y) = e
--- In e, 'a' will be in scope, and it'll be the one from 'y'!
-bindSigTyVarsFV sigs thing_inside
+bindSigTyVarsFV tvs thing_inside
= do { scoped_tyvars <- doptM Opt_ScopedTypeVariables
; if not scoped_tyvars then
thing_inside
else
bindLocalNamesFV tvs thing_inside }
- where
- tvs = [ hsLTyVarName ltv
- | L _ (Sig _ (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs, ltv <- ltvs ]
- -- Note the pattern-match on "Explicit"; we only bind
- -- type variables from signatures with an explicit top-level for-all
-
extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-- This function is used only in rnSourceDecl on InstDecl
= ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
where
bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
- mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
- text "is imported, but nothing from it is used",
- parens (ptext SLIT("except perhaps instances visible in") <+>
- quotes (ppr m))]
+ 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)
warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
warnUnusedBinds names = mappM_ warnUnusedName (filter reportable names)
- where reportable (name,_) = reportIfUnused (nameOccName name)
+ where reportable (name,_)
+ | isWiredInName name = False -- Don't report unused wired-in names
+ -- Otherwise we get a zillion warnings
+ -- from Data.Tuple
+ | otherwise = reportIfUnused (nameOccName name)
-------------------------
warnUnusedName (name, prov)
= addWarnAt loc $
sep [msg <> colon,
- nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
+ nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
+ <+> quotes (ppr name)]
-- TODO should be a proper span
where
(loc,msg) = case prov of
- Just (Imported is _) ->
- ( is_loc (head is), imp_from (is_mod imp_spec) )
- where
- imp_spec = head is
- other ->
- ( srcLocSpan (nameSrcLoc name), unused_msg )
+ Just (Imported is)
+ -> (importSpecLoc imp_spec, imp_from (importSpecModule imp_spec))
+ where
+ imp_spec = head is
+ other -> (srcLocSpan (nameSrcLoc name), unused_msg)
unused_msg = text "Defined but not used"
imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
unknownNameErr rdr_name
= sep [ptext SLIT("Not in scope:"),
- nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
+ nest 2 $ pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+ <+> quotes (ppr rdr_name)]
unknownInstBndrErr cls op
= quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
locations | one_line = empty
| otherwise = ptext SLIT("Bound at:") <+>
vcat (map ppr (sortLe (<=) locs))
+
+infixTyConWarn op
+ = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
+ ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
\end{code}
projects / ghc-hetmet.git / blobdiff