= 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 ->
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
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
-- 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}
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,_) = 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 "_".
+
-------------------------
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 = getSrcLoc 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 $
projects / ghc-hetmet.git / blobdiff