2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnEnv]{Environment manipulation for the renamer monad}
7 module RnEnv where -- Export everything
9 #include "HsVersions.h"
11 import CmdLineOpts ( opt_WarnNameShadowing, opt_WarnUnusedMatches,
12 opt_WarnUnusedBinds, opt_WarnUnusedImports )
14 import RdrHsSyn ( RdrNameIE )
15 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, mkRdrUnqual, qualifyRdrName )
16 import HsTypes ( getTyVarName, replaceTyVarName )
17 import BasicTypes ( Fixity(..), FixityDirection(..) )
19 import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
20 ImportReason(..), getSrcLoc,
21 mkLocalName, mkGlobalName, isSystemName,
22 nameOccName, nameModule, setNameModule,
23 pprOccName, isLocallyDefined, nameUnique, nameOccName,
24 setNameProvenance, getNameProvenance, pprNameProvenance
27 import OccName ( OccName,
31 import Module ( moduleIfaceFlavour )
32 import TyCon ( TyCon )
34 import Unique ( Unique, Uniquable(..), unboundKey )
35 import UniqFM ( emptyUFM, listToUFM, plusUFM_C )
37 import SrcLoc ( SrcLoc, noSrcLoc )
39 import Util ( removeDups, equivClasses, thenCmp )
41 import Maybes ( mapMaybe )
46 %*********************************************************
48 \subsection{Making new names}
50 %*********************************************************
53 newImportedGlobalName :: Module -> OccName -> RnM s d Name
54 newImportedGlobalName mod occ
55 = -- First check the cache
56 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
60 case lookupFM cache key of
62 -- A hit in the cache!
63 -- Make sure that the module in the name has the same IfaceFlavour as
64 -- the module we are looking for; if not, make it so
65 -- so that it has the right HiFlag component.
66 -- (This is necessary for known-key things.
67 -- For example, GHCmain.lhs imports as SOURCE
68 -- Main; but Main.main is a known-key thing.)
69 Just name | isSystemName name -- A known-key name; fix the provenance and module
70 -> getOmitQualFn `thenRn` \ omit_fn ->
72 new_name = setNameProvenance (setNameModule name mod)
73 (NonLocalDef ImplicitImport (omit_fn name))
74 new_cache = addToFM cache key new_name
76 setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
82 Nothing -> -- Miss in the cache!
83 -- Build a new original name, and put it in the cache
84 getOmitQualFn `thenRn` \ omit_fn ->
85 setModuleFlavourRn mod `thenRn` \ mod' ->
87 (us', us1) = splitUniqSupply us
88 uniq = uniqFromSupply us1
89 name = mkGlobalName uniq mod' occ (NonLocalDef ImplicitImport (omit_fn name))
90 -- For in-scope things we improve the provenance
91 -- in RnNames.importsFromImportDecl
92 new_cache = addToFM cache key name
94 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
98 newImportedGlobalFromRdrName rdr_name
100 = newImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
103 = -- An Unqual is allowed; interface files contain
104 -- unqualified names for locally-defined things, such as
105 -- constructors of a data type.
106 getModuleRn `thenRn ` \ mod_name ->
107 newImportedGlobalName mod_name (rdrNameOcc rdr_name)
110 newLocallyDefinedGlobalName :: Module -> OccName
111 -> (Name -> ExportFlag) -> SrcLoc
113 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
114 = -- First check the cache
115 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
118 mk_prov name = LocalDef loc (rec_exp_fn name)
119 -- We must set the provenance of the thing in the cache
120 -- correctly, particularly whether or not it is locally defined.
122 -- Since newLocallyDefinedGlobalName is used only
123 -- at binding occurrences, we may as well get the provenance
124 -- dead right first time; hence the rec_exp_fn passed in
126 case lookupFM cache key of
128 -- A hit in the cache!
129 -- Overwrite whatever provenance is in the cache already;
130 -- this updates WiredIn things and known-key things,
131 -- which are there from the start, to LocalDef.
133 -- It also means that if there are two defns for the same thing
134 -- in a module, then each gets a separate SrcLoc
136 new_name = setNameProvenance name (mk_prov new_name)
137 new_cache = addToFM cache key new_name
139 setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
142 -- Miss in the cache!
143 -- Build a new original name, and put it in the cache
145 (us', us1) = splitUniqSupply us
146 uniq = uniqFromSupply us1
147 new_name = mkGlobalName uniq mod occ (mk_prov new_name)
148 new_cache = addToFM cache key new_name
150 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
154 newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
155 newLocalNames rdr_names
156 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
159 (us', us1) = splitUniqSupply us
160 uniqs = uniqsFromSupply n us1
161 locals = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
162 | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
165 setNameSupplyRn (us', inst_ns, cache) `thenRn_`
168 newDFunName cl_occ tycon_occ (Just n) src_loc -- Imported ones have "Just n"
169 = newImportedGlobalFromRdrName n
171 newDFunName cl_occ tycon_occ Nothing src_loc -- Local instance decls have a "Nothing"
172 = getModuleRn `thenRn` \ mod_name ->
173 newInstUniq (cl_occ, tycon_occ) `thenRn` \ inst_uniq ->
175 dfun_occ = mkDFunOcc cl_occ tycon_occ inst_uniq
177 newLocallyDefinedGlobalName mod_name dfun_occ (\_ -> Exported) src_loc
180 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
181 -- during compiler debugging.
182 mkUnboundName :: RdrName -> Name
183 mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
185 isUnboundName :: Name -> Bool
186 isUnboundName name = getUnique name == unboundKey
190 -------------------------------------
191 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
192 -> [(RdrName,SrcLoc)]
193 -> ([Name] -> RnMS s a)
195 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
196 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
198 getLocalNameEnv `thenRn` \ name_env ->
199 (if opt_WarnNameShadowing
201 mapRn_ (check_shadow name_env) rdr_names_w_loc
206 newLocalNames rdr_names_w_loc `thenRn` \ names ->
208 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
210 setLocalNameEnv new_name_env (enclosed_scope names)
212 check_shadow name_env (rdr_name,loc)
213 = case lookupRdrEnv name_env rdr_name of
214 Nothing -> returnRn ()
215 Just name -> pushSrcLocRn loc $
216 addWarnRn (shadowedNameWarn rdr_name)
219 -------------------------------------
220 bindLocalsRn doc_str rdr_names enclosed_scope
221 = getSrcLocRn `thenRn` \ loc ->
222 bindLocatedLocalsRn (text doc_str)
223 (rdr_names `zip` repeat loc)
226 -- binLocalsFVRn is the same as bindLocalsRn
227 -- except that it deals with free vars
228 bindLocalsFVRn doc_str rdr_names enclosed_scope
229 = bindLocalsRn doc_str rdr_names $ \ names ->
230 enclosed_scope names `thenRn` \ (thing, fvs) ->
231 returnRn (thing, delListFromNameSet fvs names)
233 -------------------------------------
234 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS s (a, FreeVars) -> RnMS s (a, FreeVars)
235 -- This tiresome function is used only in rnDecl on InstDecl
236 extendTyVarEnvFVRn tyvars enclosed_scope
237 = getLocalNameEnv `thenRn` \ env ->
239 tyvar_names = map getTyVarName tyvars
240 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
241 | name <- tyvar_names
244 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
245 returnRn (thing, delListFromNameSet fvs tyvar_names)
247 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
248 -> ([HsTyVar Name] -> RnMS s a)
250 bindTyVarsRn doc_str tyvar_names enclosed_scope
251 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
252 enclosed_scope tyvars
254 -- Gruesome name: return Names as well as HsTyVars
255 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
256 -> ([Name] -> [HsTyVar Name] -> RnMS s a)
258 bindTyVars2Rn doc_str tyvar_names enclosed_scope
259 = getSrcLocRn `thenRn` \ loc ->
261 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
263 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
264 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
266 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
267 -> ([HsTyVar Name] -> RnMS s (a, FreeVars))
268 -> RnMS s (a, FreeVars)
269 bindTyVarsFVRn doc_str rdr_names enclosed_scope
270 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
271 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
272 returnRn (thing, delListFromNameSet fvs names)
274 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
275 -> ([Name] -> [HsTyVar Name] -> RnMS s (a, FreeVars))
276 -> RnMS s (a, FreeVars)
277 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
278 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
279 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
280 returnRn (thing, delListFromNameSet fvs names)
283 -------------------------------------
284 checkDupOrQualNames, checkDupNames :: SDoc
285 -> [(RdrName, SrcLoc)]
287 -- Works in any variant of the renamer monad
289 checkDupOrQualNames doc_str rdr_names_w_loc
290 = -- Check for use of qualified names
291 mapRn_ (qualNameErr doc_str) quals `thenRn_`
292 checkDupNames doc_str rdr_names_w_loc
294 quals = filter (isQual.fst) rdr_names_w_loc
296 checkDupNames doc_str rdr_names_w_loc
297 = -- Check for duplicated names in a binding group
298 mapRn_ (dupNamesErr doc_str) dups
300 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
304 %*********************************************************
306 \subsection{Looking up names}
308 %*********************************************************
310 Looking up a name in the RnEnv.
313 lookupBndrRn rdr_name
314 = getNameEnvs `thenRn` \ (global_env, local_env) ->
317 case lookupRdrEnv local_env rdr_name of {
318 Just name -> returnRn name ;
321 getModeRn `thenRn` \ mode ->
323 InterfaceMode _ -> -- Look in the global name cache
324 newImportedGlobalFromRdrName rdr_name
326 SourceMode -> -- Source mode, so look up a *qualified* version
327 -- of the name, so that we get the right one even
328 -- if there are many with the same occ name
329 -- There must *be* a binding
330 getModuleRn `thenRn` \ mod ->
331 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
332 Just (name:rest) -> ASSERT( null rest )
334 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
337 -- Just like lookupRn except that we record the occurrence too
338 -- Perhaps surprisingly, even wired-in names are recorded.
339 -- Why? So that we know which wired-in names are referred to when
340 -- deciding which instance declarations to import.
341 lookupOccRn :: RdrName -> RnMS s Name
343 = getNameEnvs `thenRn` \ (global_env, local_env) ->
344 lookup_occ global_env local_env rdr_name `thenRn` \ name ->
345 addOccurrenceName name
347 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
348 -- environment. It's used only for
349 -- record field names
350 -- class op names in class and instance decls
351 lookupGlobalOccRn :: RdrName -> RnMS s Name
352 lookupGlobalOccRn rdr_name
353 = getNameEnvs `thenRn` \ (global_env, local_env) ->
354 lookup_global_occ global_env rdr_name `thenRn` \ name ->
355 addOccurrenceName name
357 -- Look in both local and global env
358 lookup_occ global_env local_env rdr_name
359 = case lookupRdrEnv local_env rdr_name of
360 Just name -> returnRn name
361 Nothing -> lookup_global_occ global_env rdr_name
363 -- Look in global env only
364 lookup_global_occ global_env rdr_name
365 = case lookupRdrEnv global_env rdr_name of
366 Just [name] -> returnRn name
367 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
369 Nothing -> getModeRn `thenRn` \ mode ->
371 -- Not found when processing source code; so fail
372 SourceMode -> failUnboundNameErrRn rdr_name
374 -- Not found when processing an imported declaration,
375 -- so we create a new name for the purpose
376 InterfaceMode _ -> newImportedGlobalFromRdrName rdr_name
379 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
380 -- adds it to the occurrence pool so that it'll be loaded later. This is
381 -- used when language constructs (such as monad comprehensions, overloaded literals,
382 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
383 -- mentioned in the code.
385 -- This doesn't apply in interface mode, where everything is explicit, but
386 -- we don't check for this case: it does no harm to record an "extra" occurrence
387 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
388 -- Nothing clause of rnDerivs that calls it at all I think).
389 -- [Jan 98: this comment is wrong: rnHsType uses it quite a bit.]
391 -- For List and Tuple types it's important to get the correct
392 -- isLocallyDefined flag, which is used in turn when deciding
393 -- whether there are any instance decls in this module are "special".
394 -- The name cache should have the correct provenance, though.
396 lookupImplicitOccRn :: RdrName -> RnMS s Name
397 lookupImplicitOccRn rdr_name
398 = newImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
399 addOccurrenceName name
401 addImplicitOccRn :: Name -> RnMS s Name
402 addImplicitOccRn name = addOccurrenceName name
404 addImplicitOccsRn :: [Name] -> RnMS s ()
405 addImplicitOccsRn names = addOccurrenceNames names
409 lookupFixity :: Name -> RnMS s Fixity
411 = getFixityEnv `thenRn` \ fixity_env ->
412 case lookupNameEnv fixity_env name of
413 Just (FixitySig _ fixity _) -> returnRn fixity
414 Nothing -> returnRn (Fixity 9 InfixL) -- Default case
417 unQualInScope returns a function that takes a Name and tells whether
418 its unqualified name is in scope. This is put as a boolean flag in
419 the Name's provenance to guide whether or not to print the name qualified
423 unQualInScope :: GlobalRdrEnv -> Name -> Bool
427 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
428 Just [name'] -> name == name'
432 %************************************************************************
434 \subsection{Envt utility functions}
436 %************************************************************************
438 =============== RnEnv ================
440 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
441 = RnEnv (n1 `plusGlobalRdrEnv` n2)
442 (f1 `plusNameEnv` f2)
446 =============== NameEnv ================
448 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
449 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
451 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
452 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
454 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
455 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
457 combine_globals :: [Name] -- Old
460 combine_globals ns_old ns_new -- ns_new is often short
461 = foldr add ns_old ns_new
463 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
466 choose n' | n==n' && better_provenance n n' = n
470 -- a local thing over an imported thing
471 -- a user-imported thing over a non-user-imported thing
472 -- an explicitly-imported thing over an implicitly imported thing
473 better_provenance n1 n2
474 = case (getNameProvenance n1, getNameProvenance n2) of
475 (LocalDef _ _, _ ) -> True
476 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
477 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
480 is_duplicate :: Name -> Name -> Bool
481 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
482 | otherwise = n1 == n2
483 -- We treat two bindings of a locally-defined name as a duplicate,
484 -- because they might be two separate, local defns and we want to report
485 -- and error for that, *not* eliminate a duplicate.
487 -- On the other hand, if you import the same name from two different
488 -- import statements, we *do* want to eliminate the duplicate, not report
491 -- If a module imports itself then there might be a local defn and an imported
492 -- defn of the same name; in this case the names will compare as equal, but
493 -- will still have different provenances
498 =============== ExportAvails ================
500 mkEmptyExportAvails :: Module -> ExportAvails
501 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
503 mkExportAvails :: Module -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
504 mkExportAvails mod_name unqual_imp name_env avails
505 = (mod_avail_env, entity_avail_env)
507 mod_avail_env = unitFM mod_name unqual_avails
509 -- unqual_avails is the Avails that are visible in *unqualfied* form
510 -- (1.4 Report, Section 5.1.1)
512 -- import T hiding( f )
513 -- we delete f from avails
515 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
516 | otherwise = mapMaybe prune avails
518 prune (Avail n) | unqual_in_scope n = Just (Avail n)
519 prune (Avail n) | otherwise = Nothing
520 prune (AvailTC n ns) | null uqs = Nothing
521 | otherwise = Just (AvailTC n uqs)
523 uqs = filter unqual_in_scope ns
525 unqual_in_scope n = unQualInScope name_env n
527 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
528 name <- availNames avail]
530 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
531 plusExportAvails (m1, e1) (m2, e2)
532 = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
533 -- ToDo: wasteful: we do this once for each constructor!
537 =============== AvailInfo ================
539 plusAvail (Avail n1) (Avail n2) = Avail n1
540 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
543 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
546 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
547 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
549 availsToNameSet :: [AvailInfo] -> NameSet
550 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
552 availName :: AvailInfo -> Name
553 availName (Avail n) = n
554 availName (AvailTC n _) = n
556 availNames :: AvailInfo -> [Name]
557 availNames (Avail n) = [n]
558 availNames (AvailTC n ns) = ns
560 filterAvail :: RdrNameIE -- Wanted
561 -> AvailInfo -- Available
562 -> Maybe AvailInfo -- Resulting available;
563 -- Nothing if (any of the) wanted stuff isn't there
565 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
566 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
567 | otherwise = Nothing
569 is_wanted name = nameOccName name `elem` wanted_occs
570 sub_names_ok = all (`elem` avail_occs) wanted_occs
571 avail_occs = map nameOccName ns
572 wanted_occs = map rdrNameOcc (want:wants)
574 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
577 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
579 filterAvail (IEVar _) avail@(Avail n) = Just avail
580 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
582 wanted n = nameOccName n == occ
584 -- The second equation happens if we import a class op, thus
586 -- where op is a class operation
588 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
590 filterAvail ie avail = Nothing
593 -- In interfaces, pprAvail gets given the OccName of the "host" thing
594 pprAvail avail = getPprStyle $ \ sty ->
595 if ifaceStyle sty then
596 ppr_avail (pprOccName . nameOccName) avail
600 ppr_avail pp_name (AvailTC n ns) = hsep [
602 parens $ hsep $ punctuate comma $
605 ppr_avail pp_name (Avail n) = pp_name n
611 %************************************************************************
613 \subsection{Free variable manipulation}
615 %************************************************************************
618 type FreeVars = NameSet
620 plusFV :: FreeVars -> FreeVars -> FreeVars
621 addOneFV :: FreeVars -> Name -> FreeVars
622 unitFV :: Name -> FreeVars
624 plusFVs :: [FreeVars] -> FreeVars
626 emptyFVs = emptyNameSet
627 plusFVs = unionManyNameSets
628 plusFV = unionNameSets
630 -- No point in adding implicitly imported names to the free-var set
631 addOneFV s n = addOneToNameSet s n
632 unitFV n = unitNameSet n
636 %************************************************************************
638 \subsection{Envt utility functions}
640 %************************************************************************
644 warnUnusedLocalBinds, warnUnusedTopNames, warnUnusedMatches :: [Name] -> RnM s d ()
646 warnUnusedTopNames names
647 | not opt_WarnUnusedBinds && not opt_WarnUnusedImports = returnRn () -- Don't force ns unless necessary
648 | otherwise = warnUnusedBinds (\ is_local -> not is_local) names
650 warnUnusedLocalBinds ns
651 | not opt_WarnUnusedBinds = returnRn ()
652 | otherwise = warnUnusedBinds (\ is_local -> is_local) ns
654 warnUnusedMatches names
655 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
656 | otherwise = returnRn ()
658 -------------------------
660 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM s d ()
661 warnUnusedBinds warn_when_local names
662 = mapRn_ (warnUnusedGroup warn_when_local) groups
664 -- Group by provenance
665 groups = equivClasses cmp names
666 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
668 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
669 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
670 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
671 (NonLocalDef (UserImport m2 loc2 _) _) = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
672 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
673 -- In-scope NonLocalDefs must have UserImport info on them
675 -------------------------
677 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM s d ()
681 warnUnusedGroup emit_warning names
682 | not (emit_warning is_local) = returnRn ()
684 = pushSrcLocRn def_loc $
686 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr names)))]
689 (is_local, def_loc, msg)
690 = case getNameProvenance name1 of
691 LocalDef loc _ -> (True, loc, text "Defined but not used")
692 NonLocalDef (UserImport mod loc _) _ -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
694 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
698 addNameClashErrRn rdr_name (name1:names)
699 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
700 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
702 msg1 = ptext SLIT("either") <+> mk_ref name1
703 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
704 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
706 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
707 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
708 4 (vcat [ppr how_in_scope1,
711 failUnboundNameErrRn :: RdrName -> RnM s d Name
712 failUnboundNameErrRn rdr_name =
713 failWithRn (mkUnboundName rdr_name)
714 (unknownNameErr rdr_name)
716 shadowedNameWarn shadow
717 = hsep [ptext SLIT("This binding for"),
719 ptext SLIT("shadows an existing binding")]
722 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
724 flavour = occNameFlavour (rdrNameOcc name)
726 qualNameErr descriptor (name,loc)
728 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
733 dupNamesErr descriptor ((name,loc) : dup_things)
735 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
737 (ptext SLIT("in") <+> descriptor))