lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn,
lookupLocatedGlobalOccRn, lookupGlobalOccRn,
- lookupTopFixSigNames, lookupSrcOcc_maybe,
- lookupFixityRn, lookupLocatedSigOccRn,
+ lookupLocalDataTcNames, lookupSrcOcc_maybe,
+ lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn,
lookupLocatedInstDeclBndr,
- lookupSyntaxName, lookupSyntaxNames, lookupImportedName,
+ lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
import LoadIface ( loadHomeInterface, loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
-import HsSyn
+import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
+ LHsTyVarBndr, LHsType,
+ Fixity, hsLTyVarLocNames, replaceTyVarName )
import RdrHsSyn ( extractHsTyRdrTyVars )
-import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
+import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
isExact_maybe, isSrcRdrName,
GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
- Provenance(..), pprNameProvenance, ImportSpec(..)
+ Provenance(..), pprNameProvenance,
+ importSpecLoc, importSpecModule
)
-import HsTypes ( replaceTyVarName )
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 CmdLineOpts
-import FastString ( FastString )
+import Monad ( when )
+import DynFlags
\end{code}
%*********************************************************
Nothing ->
-- We allow qualified names on the command line to refer to
- -- *any* name exported by any module in scope, just as if
+ -- *any* name exported by any module in scope, just as if
-- there was an "import qualified M" declaration for every
-- module.
getModule `thenM` \ mod ->
%*********************************************************
\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
We store the relevant Name in the HsSyn tree, in
* HsIntegral/HsFractional
* NegApp
- * NPlusKPatIn
+ * NPlusKPat
* HsDo
respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName,
fromRationalName etc), but the renamer changes this to the appropriate user
checks the type of the user thing against the type of the standard thing.
\begin{code}
-lookupSyntaxName :: Name -- The standard name
- -> RnM (Name, FreeVars) -- Possibly a non-standard name
+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 ->
- returnM (usr_name, unitFV usr_name)
+ returnM (HsVar usr_name, unitFV usr_name)
where
- normal_case = returnM (std_name, emptyFVs)
+ normal_case = returnM (HsVar std_name, emptyFVs)
-lookupSyntaxNames :: [Name] -- Standard names
- -> RnM (ReboundNames Name, FreeVars) -- See comments with HsExpr.ReboundNames
-lookupSyntaxNames std_names
+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
else
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