\begin{code}
module RnEnv (
- newTopSrcBinder,
+ newTopSrcBinder, lookupFamInstDeclBndr,
lookupLocatedBndrRn, lookupBndrRn,
lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn,
lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn,
lookupLocatedInstDeclBndr,
lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
+ lookupGreRn,
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
#include "HsVersions.h"
-import LoadIface ( loadHomeInterface, loadSrcInterface )
+import LoadIface ( loadInterfaceForName, loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
LHsTyVarBndr, LHsType,
Fixity, hsLTyVarLocNames, replaceTyVarName )
import RdrHsSyn ( extractHsTyRdrTyVars )
-import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
+import RdrName ( RdrName, isQual, isUnqual, isOrig_maybe,
+ isQual_maybe,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
isExact_maybe, isSrcRdrName,
import NameSet
import OccName ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
reportIfUnused )
-import Module ( Module )
+import Module ( Module, ModuleName )
import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
import UniqSupply
import BasicTypes ( IPName, mapIPName )
import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
- srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
+ srcLocSpan, getLoc, combineSrcSpans, isOneLineSpan )
import Outputable
import Util ( sortLe )
import ListSetOps ( removeDups )
-- data T = (,) Int Int
-- unless we are in GHC.Tup
ASSERT2( isExternalName name, ppr name )
- do checkErr (this_mod == nameModule name)
- (badOrigBinding rdr_name)
- returnM name
+ do { checkM (this_mod == nameModule name)
+ (addErrAt loc (badOrigBinding rdr_name))
+ ; return name }
- | isOrig rdr_name
- = do checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
- (badOrigBinding rdr_name)
+ | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+ = do { checkM (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
--
-- 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 rdr_mod (rdrNameOcc rdr_name) mb_parent
- (srcSpanStart loc) --TODO, should pass the whole span
+ ; newGlobalBinder rdr_mod rdr_occ mb_parent (srcSpanStart loc) }
+ --TODO, should pass the whole span
| otherwise
- = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
- where
- rdr_mod = rdrNameModule rdr_name
+ = do { checkM (not (isQual rdr_name))
+ (addErrAt loc (badQualBndrErr rdr_name))
+ -- Binders should not be qualified; if they are, and with a different
+ -- module name, we we get a confusing "M.T is not in scope" error later
+ ; newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc) }
\end{code}
%*********************************************************
| Just name <- isExact_maybe rdr_name
= returnM name
- | isOrig rdr_name
+ | Just (rdr_mod, rdr_occ) <- isOrig_maybe 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 (rdrNameModule rdr_name)
- (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
+ ; newGlobalBinder rdr_mod rdr_occ Nothing (srcSpanStart loc) }
| otherwise
= do { mb_gre <- lookupGreLocalRn rdr_name
newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
+-- Looking up family names in type instances is a subtle affair. The family
+-- may be imported, in which case we need to lookup the occurence of a global
+-- name. Alternatively, the family may be in the same binding group (and in
+-- fact in a declaration processed later), and we need to create a new top
+-- source binder.
+--
+-- So, also this is strictly speaking an occurence, we cannot raise an error
+-- message yet for instances without a family declaration. This will happen
+-- during renaming the type instance declaration in RnSource.rnTyClDecl.
+--
+lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name
+lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
+ | not (isSrcRdrName rdr_name)
+ = lookupImportedName rdr_name
+
+ | otherwise
+ = -- First look up the name in the normal environment.
+ lookupGreRn rdr_name `thenM` \ mb_gre ->
+ case mb_gre of {
+ Just gre -> returnM (gre_name gre) ;
+ Nothing -> newTopSrcBinder mod Nothing lrdr_name }
+
--------------------------------------------------
-- Occurrences
--------------------------------------------------
-- This happens in derived code
= returnM n
- | otherwise -- Always Orig, even when reading a .hi-boot file
- = ASSERT( not (isUnqual rdr_name) )
- lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+ -- Always Orig, even when reading a .hi-boot file
+ | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+ = lookupOrig rdr_mod rdr_occ
+
+ | otherwise
+ = pprPanic "RnEnv.lookupImportedName" (ppr rdr_name)
unboundName :: RdrName -> RnM Name
unboundName rdr_name
-- try to load the interface if we don't already have it.
lookupQualifiedName :: RdrName -> RnM Name
lookupQualifiedName rdr_name
- = let
- mod = rdrNameModule rdr_name
- occ = rdrNameOcc rdr_name
- in
+ | Just (mod,occ) <- isQual_maybe rdr_name
-- Note: we want to behave as we would for a source file import here,
-- and respect hiddenness of modules/packages, hence loadSrcInterface.
- loadSrcInterface doc mod False `thenM` \ iface ->
+ = loadSrcInterface doc mod False `thenM` \ iface ->
case [ (mod,occ) |
(mod,avails) <- mi_exports iface,
((mod,occ):ns) -> ASSERT (null ns)
lookupOrig mod occ
_ -> unboundName rdr_name
+
+ | otherwise
+ = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
where
doc = ptext SLIT("Need to find") <+> ppr rdr_name
\end{code}
else -- It's imported
-- For imported names, we have to get their fixities by doing a
- -- loadHomeInterface, and consulting the Ifaces that comes back
+ -- loadInterfaceForName, and consulting the Ifaces that comes back
-- from that, because the interface file for the Name might not
-- have been loaded yet. Why not? Suppose you import module A,
-- which exports a function 'f', thus;
-- 'f', we need to know its fixity, and it's then, and only
-- then, that we load B.hi. That is what's happening here.
--
- -- loadHomeInterface will find B.hi even if B is a hidden module,
+ -- loadInterfaceForName will find B.hi even if B is a hidden module,
-- and that's what we want.
- loadHomeInterface doc name `thenM` \ iface ->
+ loadInterfaceForName doc name `thenM` \ iface ->
returnM (mi_fix_fn iface (nameOccName name))
where
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
+ = do { glaExts <- doptM Opt_GlasgowExts
+ ; when (not glaExts) (addWarnAt loc (infixTyConWarn n))
+ ; lookupFixityRn n }
---------------
dataTcOccs :: RdrName -> [RdrName]
check_shadow (L loc rdr_name)
| rdr_name `elemLocalRdrEnv` local_env
|| not (null (lookupGRE_RdrName rdr_name global_env ))
- = setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
+ = addWarnAt loc (shadowedNameWarn doc_str rdr_name)
| otherwise = returnM ()
in
mappM_ check_shadow loc_rdr_names
%************************************************************************
\begin{code}
-warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
+warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
warnUnusedModules mods
= ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
where
- bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
+ 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")
\end{code}
\begin{code}
-addNameClashErrRn rdr_name (np1:nps)
+addNameClashErrRn rdr_name names
= addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
where
+ (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
dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
dupNamesErr descriptor located_names
- = setSrcSpan big_loc $
- addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
- locations,
- descriptor])
+ = addErrAt big_loc $
+ vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
+ locations, descriptor]
where
L _ name1 = head located_names
locs = map getLoc located_names
big_loc = foldr1 combineSrcSpans locs
- one_line = srcSpanStartLine big_loc == srcSpanEndLine big_loc
+ one_line = isOneLineSpan big_loc
locations | one_line = empty
| otherwise = ptext SLIT("Bound at:") <+>
vcat (map ppr (sortLe (<=) locs))
+badQualBndrErr rdr_name
+ = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name
+
infixTyConWarn op
= vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
projects / ghc-hetmet.git / blobdiff