lookupFixity
)
import TcRnMonad
-import Name ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName,
- mkInternalName, mkExternalName, mkIPName, nameSrcLoc,
- nameOccName, setNameSrcLoc, nameModule )
+import Name ( Name, getName, nameIsLocalOrFrom,
+ isWiredInName, mkInternalName, mkExternalName, mkIPName,
+ nameSrcLoc, nameOccName, setNameSrcLoc, nameModule )
import NameSet
-import OccName ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour )
+import OccName ( OccName, tcName, isDataOcc, occNameFlavour, reportIfUnused )
import Module ( Module, ModuleName, moduleName, mkHomeModule,
lookupModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
import PrelNames ( mkUnboundName, intTyConName,
import Finder ( findModule )
import FiniteMap
import UniqSupply
-import SrcLoc ( SrcLoc, noSrcLoc, importedSrcLoc )
+import SrcLoc ( SrcLoc, importedSrcLoc )
import Outputable
import ListSetOps ( removeDups, equivClasses )
import BasicTypes ( mapIPName, FixitySig(..) )
= returnM name
| otherwise
- = newGlobalName mod (rdrNameOcc rdr_name) loc
+ = ASSERT( not (isOrig rdr_name) || rdrNameModule rdr_name == moduleName mod )
+ -- When reading External Core we get Orig names as binders,
+ -- but they should agree with the module gotten from the monad
+ newGlobalName mod (rdrNameOcc rdr_name) loc
newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
newGlobalName mod occ loc
Nothing -> -- No names from this module yet
ioToTcRn (findModule mod_name) `thenM` \ mb_loc ->
case mb_loc of
- Just (mod, _) -> new_name mod
- Nothing -> addErr (noModule mod_name) `thenM_`
- -- Things have really gone wrong at this point,
- -- so having the wrong package info in the
- -- Module is the least of our worries.
- new_name (mkHomeModule mod_name)
- where
- noModule mod_name = ptext SLIT("Can't find interface for module") <+> ppr mod_name
+ Right (mod, _) -> new_name mod
+ Left files ->
+ getDOpts `thenM` \ dflags ->
+ addErr (noIfaceErr dflags mod_name False files) `thenM_`
+ -- Things have really gone wrong at this point,
+ -- so having the wrong package info in the
+ -- Module is the least of our worries.
+ new_name (mkHomeModule mod_name)
newIPName rdr_name_ip
-- A separate function (importsFromLocalDecls) reports duplicate top level
-- decls, so here it's safe just to choose an arbitrary one.
- -- There should never be a qualified name in a binding position
- -- The parser could check this, but doesn't (yet)
- | isQual rdr_name
- = getSrcLocM `thenM` \ loc ->
- qualNameErr (text "In its declaration") (rdr_name,loc) `thenM_`
- returnM (mkUnboundName rdr_name)
-
- | otherwise
- = ASSERT( not (isOrig rdr_name) )
- -- Original names are used only for occurrences,
- -- not binding sites
+-- There should never be a qualified name in a binding position in Haskell,
+-- but there can be if we have read in an external-Core file.
+-- The Haskell parser checks for the illegal qualified name in Haskell
+-- source files, so we don't need to do so here.
- getModeRn `thenM` \ mode ->
+ = getModeRn `thenM` \ mode ->
case mode of
InterfaceMode mod ->
getSrcLocM `thenM` \ loc ->
getGblEnv `thenM` \ gbl_env ->
let
avail_env = imp_env (tcg_imports gbl_env)
+ occ = rdrNameOcc rdr_name
in
- case lookupAvailEnv avail_env cls_name of
+ case lookupAvailEnv_maybe avail_env cls_name of
Nothing ->
-- If the class itself isn't in scope, then cls_name will
-- be unboundName, and there'll already be an error for
other -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
- | isQual rdr_name -- Should never have a qualified name in a binding position
- = getSrcLocM `thenM` \ loc ->
- qualNameErr (text "In an instance method") (rdr_name,loc) `thenM_`
- returnM (mkUnboundName rdr_name)
-
+
| otherwise -- Occurs in derived instances, where we just
-- refer directly to the right method, and avail_env
-- isn't available
= ASSERT2( not (isQual rdr_name), ppr rdr_name )
+ -- NB: qualified names are rejected by the parser
lookupOrigName rdr_name
- where
- occ = rdrNameOcc rdr_name
lookupSysBndr :: RdrName -> RnM Name
-- Used for the 'system binders' in a data type or class declaration
namesNeededForFlattening `plusFV`
ubiquitousNames
+
+thProxyName :: NameSet
+mkTemplateHaskellFVs :: NameSet -> NameSet
-- This is a bit of a hack. When we see the Template-Haskell construct
-- [| expr |]
-- we are going to need lots of the ``smart constructors'' defined in
-- the main Template Haskell data type module. Rather than treat them
-- all as free vars at every occurrence site, we just make the Q type
-- consructor a free var.... and then use that here to haul in the others
-mkTemplateHaskellFVs source_fvs
+
#ifdef GHCI
- -- Only if Template Haskell is enabled
+--------------- Template Haskell enabled --------------
+thProxyName = unitFV qTyConName
+
+mkTemplateHaskellFVs source_fvs
| qTyConName `elemNameSet` source_fvs = templateHaskellNames
-#endif
| otherwise = emptyFVs
+#else
+--------------- Template Haskell disabled --------------
+
+thProxyName = emptyFVs
+mkTemplateHaskellFVs source_fvs = emptyFVs
+#endif
+--------------------------------------------------------
+
-- ubiquitous_names are loaded regardless, because
-- they are needed in virtually every program
ubiquitousNames
-- binLocalsFVRn is the same as bindLocalsRn
-- except that it deals with free vars
-bindLocalsFVRn doc rdr_names enclosed_scope
+bindLocalsFV doc rdr_names enclosed_scope
= bindLocalsRn doc rdr_names $ \ names ->
enclosed_scope names `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs names)
bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
enclosed_scope (zipWith replaceTyVarName tyvar_names names)
-bindPatSigTyVars :: [RdrNameHsType]
- -> RnM (a, FreeVars)
- -> RnM (a, FreeVars)
+bindPatSigTyVars :: [RdrNameHsType] -> ([Name] -> RnM a) -> RnM a
-- Find the type variables in the pattern type
-- signatures that must be brought into scope
-bindPatSigTyVars tys enclosed_scope
+bindPatSigTyVars tys thing_inside
= getLocalRdrEnv `thenM` \ name_env ->
getSrcLocM `thenM` \ loc ->
let
located_tyvars = [(tv, loc) | tv <- forall_tyvars]
doc_sig = text "In a pattern type-signature"
in
- bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
- enclosed_scope `thenM` \ (thing, fvs) ->
- returnM (thing, delListFromNameSet fvs names)
+ bindLocatedLocalsRn doc_sig located_tyvars thing_inside
+bindPatSigTyVarsFV :: [RdrNameHsType]
+ -> RnM (a, FreeVars)
+ -> RnM (a, FreeVars)
+bindPatSigTyVarsFV tys thing_inside
+ = bindPatSigTyVars tys $ \ tvs ->
+ thing_inside `thenM` \ (result,fvs) ->
+ returnM (result, fvs `delListFromNameSet` tvs)
-------------------------------------
checkDupOrQualNames, checkDupNames :: SDoc
-- Works in any variant of the renamer monad
checkDupOrQualNames doc_str rdr_names_w_loc
- = -- Check for use of qualified names
- mappM_ (qualNameErr doc_str) quals `thenM_`
+ = -- Qualified names in patterns are now rejected by the parser
+ -- but I'm not 100% certain that it finds all cases, so I've left
+ -- this check in for now. Should go eventually.
+ -- Hmm. Sooner rather than later.. data type decls
+-- mappM_ (qualNameErr doc_str) quals `thenM_`
checkDupNames doc_str rdr_names_w_loc
where
quals = filter (isQual . fst) rdr_names_w_loc
where
occ = nameOccName name
elt = GRE {gre_name = name,
- gre_parent = parent,
+ gre_parent = if name == parent
+ then Nothing
+ else Just parent,
gre_prov = mk_provenance name,
gre_deprec = lookupDeprec deprecs name}
-
\end{code}
\begin{code}
warnUnusedBinds :: [(Name,Provenance)] -> TcRn m ()
warnUnusedBinds names
- = mappM_ warnUnusedGroup groups
+ = mappM_ warnUnusedGroup groups
where
-- Group by provenance
- groups = equivClasses cmp names
+ groups = equivClasses cmp (filter reportable names)
(_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
+ reportable (name,_) = reportIfUnused (nameOccName name)
+
-------------------------
warnUnusedGroup :: [(Name,Provenance)] -> TcRn m ()
warnUnusedGroup names
- | null filtered_names = returnM ()
- | not is_local = returnM ()
- | otherwise
= addSrcLoc def_loc $
- addWarn $
- sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
+ addWarn $
+ sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
where
- filtered_names = filter reportable names
- (name1, prov1) = head filtered_names
- (is_local, def_loc, msg)
- = case prov1 of
- LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
-
- NonLocalDef (UserImport mod loc _)
- -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
-
- reportable (name,_) = case occNameUserString (nameOccName name) of
- ('_' : _) -> False
- zz_other -> True
- -- Haskell 98 encourages compilers to suppress warnings about
- -- unused names in a pattern if they start with "_".
+ (name1, prov1) = head names
+ loc1 = nameSrcLoc name1
+ (def_loc, msg) = case prov1 of
+ LocalDef -> (loc1, unused_msg)
+ NonLocalDef (UserImport mod loc _) -> (loc, imp_from mod)
+
+ unused_msg = text "Defined but not used"
+ imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
\end{code}
\begin{code}
addNameClashErrRn rdr_name (np1:nps)
= addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
- ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+ ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
where
msg1 = ptext SLIT("either") <+> mk_ref np1
msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
$$
descriptor)
+noIfaceErr dflags mod_name boot_file files
+ = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
+ $$ extra
+ where
+ extra
+ | verbosity dflags < 3 =
+ text "(use -v to see a list of the files searched for)"
+ | otherwise =
+ hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
+
warnDeprec :: GlobalRdrElt -> TcRn m ()
warnDeprec (GRE {gre_name = name, gre_deprec = Just txt})
= ifOptM Opt_WarnDeprecations $