isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
Provenance(..), pprNameProvenance, ImportSpec(..)
)
-import HsTypes ( hsTyVarName, replaceTyVarName )
+import HsTypes ( replaceTyVarName )
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
import Name ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
nameSrcLoc, nameOccName, nameModuleName, nameParent )
import NameSet
-import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused,
- isVarOcc )
+import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
import Module ( Module, ModuleName, moduleName, mkHomeModule )
-import PrelNames ( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE )
+import PrelNames ( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE, consDataConKey, hasKey )
import UniqSupply
import BasicTypes ( IPName, mapIPName )
-import SrcLoc ( srcSpanStart, Located(..), eqLocated, unLoc,
+import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
srcLocSpan )
import Outputable
import ListSetOps ( removeDups )
\begin{code}
newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
-newTopSrcBinder mod mb_parent (L loc rdr_name)
+newTopSrcBinder this_mod mb_parent (L loc rdr_name)
| Just name <- isExact_maybe rdr_name
- = returnM name
+ -- This is here to catch
+ -- (a) Exact-name binders created by Template Haskell
+ -- (b) The PrelBase defn of (say) [] and similar, for which
+ -- the parser reads the special syntax and returns an Exact RdrName
+ --
+ -- We are at a binding site for the name, so check first that it
+ -- the current module is the correct one; otherwise GHC can get
+ -- very confused indeed. This test rejects code like
+ -- data T = (,) Int Int
+ -- unless we are in GHC.Tup
+ = do checkErr (isInternalName name || this_mod_name == nameModuleName name)
+ (badOrigBinding rdr_name)
+ returnM name
| isOrig rdr_name
- = ASSERT( rdr_mod == moduleName mod || rdr_mod == rOOT_MAIN_Name )
+ = do checkErr (rdr_mod_name == this_mod_name || rdr_mod_name == rOOT_MAIN_Name)
+ (badOrigBinding rdr_name)
-- When reading External Core we get Orig names as binders,
-- but they should agree with the module gotten from the monad
--
- -- Except for the ":Main.main = ..." definition inserted into
- -- the Main module
+ -- We can get built-in syntax showing up here too, sadly. If you type
+ -- data T = (,,,)
+ -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
+ -- uses setRdrNameSpace to make it into a data constructors. At that point
+ -- the nice Exact name for the TyCon gets swizzled to an Orig name.
+ -- Hence the badOrigBinding error message.
--
- -- Because of this latter case, we take the module from the RdrName,
- -- not from the environment. In principle, it'd be fine to have an
- -- arbitrary mixture of external core definitions in a single module,
+ -- Except for the ":Main.main = ..." definition inserted into
+ -- the Main module; ugh!
+
+ -- Because of this latter case, we call newGlobalBinder with a module from
+ -- the RdrName, not from the environment. In principle, it'd be fine to
+ -- have an arbitrary mixture of external core definitions in a single module,
-- (apart from module-initialisation issues, perhaps).
- newGlobalBinder (mkHomeModule rdr_mod) (rdrNameOcc rdr_name) mb_parent
- (srcSpanStart loc) --TODO, should pass the whole span
+ newGlobalBinder (mkHomeModule rdr_mod_name) (rdrNameOcc rdr_name) mb_parent
+ (srcSpanStart loc) --TODO, should pass the whole span
| otherwise
- = newGlobalBinder mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
+ = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
where
- rdr_mod = rdrNameModule rdr_name
+ this_mod_name = moduleName this_mod
+ rdr_mod_name = rdrNameModule rdr_name
\end{code}
%*********************************************************
lookupLocatedBndrRn = wrapLocM lookupBndrRn
lookupBndrRn :: RdrName -> RnM Name
--- NOTE: assumes that the SrcSpan of the binder has already been addSrcSpan'd
+-- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
lookupBndrRn rdr_name
= getLocalRdrEnv `thenM` \ local_env ->
case lookupLocalRdrEnv local_env rdr_name of
lookupTopBndrRn rdr_name
| Just name <- isExact_maybe rdr_name
- -- This is here to catch
- -- (a) Exact-name binders created by Template Haskell
- -- (b) The PrelBase defn of (say) [] and similar, for which
- -- the parser reads the special syntax and returns an Exact RdrName
- --
- -- We are at a binding site for the name, so check first that it
- -- the current module is the correct one; otherwise GHC can get
- -- very confused indeed. This test rejects code like
- -- data T = (,) Int Int
- -- unless we are in GHC.Tup
- = getModule `thenM` \ mod ->
- checkErr (isInternalName name || moduleName mod == nameModuleName name)
- (badOrigBinding rdr_name) `thenM_`
- returnM name
+ = returnM name
| isOrig rdr_name
-- This deals with the case of derived bindings, where
-- we don't bother to call newTopSrcBinder first
-- We assume there is no "parent" name
- = do
- loc <- getSrcSpanM
- newGlobalBinder (mkHomeModule (rdrNameModule rdr_name))
- (rdrNameOcc rdr_name) Nothing (srcSpanStart loc)
+ = do { loc <- getSrcSpanM
+ ; newGlobalBinder (mkHomeModule (rdrNameModule rdr_name))
+ (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
| otherwise
= do { mb_gre <- lookupGreLocalRn rdr_name
-- 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
-- looking at.
---
--- ToDo: If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
--- and we don't have a systematic way to find the TyCon's Name from
--- the DataCon's name. Sigh
dataTcOccs rdr_name
- | isDataOcc occ = [rdr_name_tc, rdr_name]
- | otherwise = [rdr_name]
+ | Just n <- isExact_maybe rdr_name -- Ghastly special case
+ , n `hasKey` consDataConKey = [rdr_name] -- see note below
+ | isDataOcc occ = [rdr_name_tc, rdr_name]
+ | otherwise = [rdr_name]
where
occ = rdrNameOcc rdr_name
rdr_name_tc = setRdrNameSpace rdr_name tcName
+
+-- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
+-- and setRdrNameSpace generates an Orig, which is fine
+-- But it's not fine for (:), because there *is* no corresponding type
+-- constructor. If we generate an Orig tycon for GHC.Base.(:), it'll
+-- appear to be in scope (because Orig's simply allocate a new name-cache
+-- entry) and then we get an error when we use dataTcOccs in
+-- TcRnDriver.tcRnGetInfo. Large sigh.
\end{code}
%************************************************************************
-- Get the similarly named thing from the local environment
mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
- returnM (std_names `zip` map nlHsVar usr_names, mkFVs usr_names)
+ returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
where
- normal_case = returnM (std_names `zip` map nlHsVar std_names, emptyFVs)
+ normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
\end{code}
-> RnM a
bindTyVarsRn doc_str tyvar_names enclosed_scope
= let
- located_tyvars = [L loc (hsTyVarName tv) | L loc tv <- tyvar_names]
+ located_tyvars = hsLTyVarLocNames tyvar_names
in
bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
enclosed_scope (zipWith replace tyvar_names names)
check_shadow (L loc rdr_name)
| rdr_name `elemLocalRdrEnv` local_env
|| not (null (lookupGRE_RdrName rdr_name global_env ))
- = addSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
+ = setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
| otherwise = returnM ()
in
mappM_ check_shadow loc_rdr_names
%************************************************************************
\begin{code}
-warnUnusedModules :: [ModuleName] -> RnM ()
+warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
warnUnusedModules mods
- = ifOptM Opt_WarnUnusedImports (mappM_ (addWarn . unused_mod) mods)
+ = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
where
- unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
- text "is imported, but nothing from it is used",
+ 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))]
warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
warnUnusedName (name, prov)
- = addWarnAt loc (sep [msg <> colon, nest 4 (ppr name)])
+ = addWarnAt loc $
+ sep [msg <> colon,
+ nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
-- TODO should be a proper span
where
(loc,msg) = case prov of
ptext SLIT("shadows an existing binding")]
$$ doc
-unknownNameErr name
+unknownNameErr rdr_name
= sep [ptext SLIT("Not in scope:"),
- if isVarOcc occ_name then quotes (ppr name)
- else text (occNameFlavour occ_name)
- <+> quotes (ppr name)]
- where
- occ_name = rdrNameOcc name
+ nest 2 $ occNameFlavour (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)
-- The rdrNameOcc is because we don't want to print Prelude.(,)
dupNamesErr descriptor (L loc name : dup_things)
- = addSrcSpan loc $
+ = setSrcSpan loc $
addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
$$
descriptor)
projects / ghc-hetmet.git / blobdiff