lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn,
lookupLocatedInstDeclBndr,
lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
- lookupGreRn,
+ lookupGreRn, lookupGreRn_maybe,
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
isExact_maybe, isSrcRdrName,
+ Parent(..),
GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
Provenance(..), pprNameProvenance,
importSpecLoc, importSpecModule
)
-import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity,
- AvailInfo, GenAvailInfo(..) )
+import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
-import NameEnv ( NameEnv, lookupNameEnv )
import OccName ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
reportIfUnused )
import Module ( Module, ModuleName )
| otherwise
= do { mb_gre <- lookupGreLocalRn rdr_name
; case mb_gre of
- Nothing -> unboundName rdr_name
+ Nothing -> do
+ traceRn $ text "lookupTopBndrRn"
+ unboundName rdr_name
Just gre -> returnM (gre_name gre) }
-- lookupLocatedSigOccRn is used for type signatures and pragmas
-- disambiguate.
lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
-lookupLocatedInstDeclBndr cls rdr = do
- imp_avails <- getImports
- wrapLocM (lookupInstDeclBndr (imp_parent imp_avails) cls) rdr
+lookupLocatedInstDeclBndr cls rdr = wrapLocM (lookupInstDeclBndr cls) rdr
-lookupInstDeclBndr :: NameEnv AvailInfo -> Name -> RdrName -> RnM Name
+lookupInstDeclBndr :: Name -> RdrName -> RnM Name
-- This is called on the method name on the left-hand side of an
-- instance declaration binding. eg. instance Functor T where
-- fmap = ...
-- ^^^^ called on this
-- Regardless of how many unqualified fmaps are in scope, we want
-- the one that comes from the Functor class.
-lookupInstDeclBndr availenv cls_name rdr_name
+lookupInstDeclBndr cls_name rdr_name
| isUnqual rdr_name -- Find all the things the rdr-name maps to
= do { -- and pick the one with the right parent name
- let { is_op gre = cls_name == nameParent (gre_name gre)
+ let { is_op gre@(GRE {gre_par = ParentIs n}) = cls_name == n
+ ; is_op other = False
; occ = rdrNameOcc rdr_name
; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
; mb_gre <- lookupGreRn_help rdr_name lookup_fn
; case mb_gre of
Just gre -> return (gre_name gre)
Nothing -> do { addErr (unknownInstBndrErr cls_name rdr_name)
+ ; traceRn (text "lookupInstDeclBndr" <+> ppr rdr_name)
; return (mkUnboundName rdr_name) } }
| otherwise -- Occurs in derived instances, where we just
-- NB: qualified names are rejected by the parser
lookupImportedName rdr_name
- where nameParent nm
- | Just (AvailTC tc subs) <- lookupNameEnv availenv nm = tc
- | otherwise = nm -- might be an Avail, if the Name is
- -- in scope some other way
-
-
newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
--
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 lrdr_name }
+ = do { mb_gre <- lookupGreRn_maybe rdr_name
+ ; case mb_gre of
+ Just gre -> returnM (gre_name gre) ;
+ Nothing -> newTopSrcBinder mod lrdr_name }
--------------------------------------------------
-- Occurrences
| otherwise
= -- First look up the name in the normal environment.
- lookupGreRn rdr_name `thenM` \ mb_gre ->
+ lookupGreRn_maybe rdr_name `thenM` \ mb_gre ->
case mb_gre of {
Just gre -> returnM (gre_name gre) ;
Nothing ->
if isQual rdr_name && mod == iNTERACTIVE then
-- This test is not expensive,
lookupQualifiedName rdr_name -- and only happens for failed lookups
- else
+ else do
+ traceRn $ text "lookupGlobalOccRn"
unboundName rdr_name }
lookupImportedName :: RdrName -> TcRnIf m n Name
lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
-- No filter function; does not report an error on failure
lookupSrcOcc_maybe rdr_name
- = do { mb_gre <- lookupGreRn rdr_name
+ = do { mb_gre <- lookupGreRn_maybe rdr_name
; case mb_gre of
Nothing -> returnM Nothing
Just gre -> returnM (Just (gre_name gre)) }
-------------------------
-lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
+lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Just look up the RdrName in the GlobalRdrEnv
-lookupGreRn rdr_name
+lookupGreRn_maybe rdr_name
= lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
+lookupGreRn :: RdrName -> RnM GlobalRdrElt
+-- If not found, add error message, and return a fake GRE
+lookupGreRn rdr_name
+ = do { mb_gre <- lookupGreRn_maybe rdr_name
+ ; case mb_gre of {
+ Just gre -> return gre ;
+ Nothing -> do
+ { traceRn $ text "lookupGreRn"
+ ; name <- unboundName rdr_name
+ ; return (GRE { gre_name = name, gre_par = NoParent,
+ gre_prov = LocalDef }) }}}
+
lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Similar, but restricted to locally-defined things
lookupGreLocalRn rdr_name
-------------------------
-- Helpers
warnUnusedGREs gres
- = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
+ = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
warnUnusedLocals names
- = warnUnusedBinds [(n,Nothing) | n<-names]
+ = warnUnusedBinds [(n,LocalDef) | n<-names]
-warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
+warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
warnUnusedBinds names = mappM_ warnUnusedName (filter reportable names)
where reportable (name,_)
| isWiredInName name = False -- Don't report unused wired-in names
-------------------------
-warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
-warnUnusedName (name, prov)
- = addWarnAt loc $
+warnUnusedName :: (Name, Provenance) -> RnM ()
+warnUnusedName (name, LocalDef)
+ = addUnusedWarning name (srcLocSpan (nameSrcLoc name))
+ (ptext SLIT("Defined but not used"))
+
+warnUnusedName (name, Imported is)
+ = mapM_ warn is
+ where
+ warn spec = addUnusedWarning name span msg
+ where
+ span = importSpecLoc spec
+ pp_mod = quotes (ppr (importSpecModule spec))
+ msg = ptext SLIT("Imported from") <+> pp_mod <+> ptext SLIT("but not used")
+
+addUnusedWarning name span msg
+ = addWarnAt span $
sep [msg <> colon,
nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
<+> quotes (ppr name)]
- -- TODO should be a proper span
- where
- (loc,msg) = case prov of
- 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"
\end{code}
\begin{code}