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,
29 occNameFlavour, moduleIfaceFlavour
31 import TyCon ( TyCon )
33 import Unique ( Unique, Uniquable(..), unboundKey )
34 import UniqFM ( emptyUFM, listToUFM, plusUFM_C )
36 import SrcLoc ( SrcLoc, noSrcLoc )
38 import Util ( removeDups, equivClasses, thenCmp )
40 import Maybes ( mapMaybe )
41 import Char ( isAlphanum )
46 %*********************************************************
48 \subsection{Making new names}
50 %*********************************************************
53 newImportedGlobalName :: Module -> OccName
55 newImportedGlobalName mod occ
56 = -- First check the cache
57 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
60 mod_hif = moduleIfaceFlavour mod
62 case lookupFM cache key of
64 -- A hit in the cache!
65 -- Make sure that the module in the name has the same IfaceFlavour as
66 -- the module we are looking for; if not, make it so
67 -- so that it has the right HiFlag component.
68 -- (This is necessary for known-key things.
69 -- For example, GHCmain.lhs imports as SOURCE
70 -- Main; but Main.main is a known-key thing.)
71 Just name | isSystemName name -- A known-key name; fix the provenance and module
72 -> getOmitQualFn `thenRn` \ omit_fn ->
74 new_name = setNameProvenance (setNameModule name mod)
75 (NonLocalDef ImplicitImport (omit_fn name))
76 new_cache = addToFM cache key new_name
78 setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
84 Nothing -> -- Miss in the cache!
85 -- Build a new original name, and put it in the cache
86 getOmitQualFn `thenRn` \ omit_fn ->
88 (us', us1) = splitUniqSupply us
89 uniq = uniqFromSupply us1
90 name = mkGlobalName uniq mod occ (NonLocalDef ImplicitImport (omit_fn name))
91 -- For in-scope things we improve the provenance
92 -- in RnNames.importsFromImportDecl
93 new_cache = addToFM cache key name
95 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
99 newImportedGlobalFromRdrName rdr_name
101 = newImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
104 = -- An Unqual is allowed; interface files contain
105 -- unqualified names for locally-defined things, such as
106 -- constructors of a data type.
107 getModuleRn `thenRn ` \ mod_name ->
108 newImportedGlobalName mod_name (rdrNameOcc rdr_name)
111 newLocallyDefinedGlobalName :: Module -> OccName
112 -> (Name -> ExportFlag) -> SrcLoc
114 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
115 = -- First check the cache
116 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
119 mk_prov name = LocalDef loc (rec_exp_fn name)
120 -- We must set the provenance of the thing in the cache
121 -- correctly, particularly whether or not it is locally defined.
123 -- Since newLocallyDefinedGlobalName is used only
124 -- at binding occurrences, we may as well get the provenance
125 -- dead right first time; hence the rec_exp_fn passed in
127 case lookupFM cache key of
129 -- A hit in the cache!
130 -- Overwrite whatever provenance is in the cache already;
131 -- this updates WiredIn things and known-key things,
132 -- which are there from the start, to LocalDef.
134 -- It also means that if there are two defns for the same thing
135 -- in a module, then each gets a separate SrcLoc
137 new_name = setNameProvenance name (mk_prov new_name)
138 new_cache = addToFM cache key new_name
140 setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
143 -- Miss in the cache!
144 -- Build a new original name, and put it in the cache
146 (us', us1) = splitUniqSupply us
147 uniq = uniqFromSupply us1
148 new_name = mkGlobalName uniq mod occ (mk_prov new_name)
149 new_cache = addToFM cache key new_name
151 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
155 newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
156 newLocalNames rdr_names
157 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
160 (us', us1) = splitUniqSupply us
161 uniqs = uniqsFromSupply n us1
162 locals = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
163 | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
166 setNameSupplyRn (us', inst_ns, cache) `thenRn_`
169 newDFunName cl_occ tycon_occ (Just n) src_loc -- Imported ones have "Just n"
170 = newImportedGlobalFromRdrName n
172 newDFunName cl_occ tycon_occ Nothing src_loc -- Local instance decls have a "Nothing"
173 = getModuleRn `thenRn` \ mod_name ->
174 newInstUniq (cl_occ, tycon_occ) `thenRn` \ inst_uniq ->
176 dfun_occ = mkDFunOcc cl_occ tycon_occ inst_uniq
178 newLocallyDefinedGlobalName mod_name dfun_occ (\_ -> Exported) src_loc
181 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
182 -- during compiler debugging.
183 mkUnboundName :: RdrName -> Name
184 mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
186 isUnboundName :: Name -> Bool
187 isUnboundName name = getUnique name == unboundKey
191 -------------------------------------
192 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
193 -> [(RdrName,SrcLoc)]
194 -> ([Name] -> RnMS s a)
196 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
197 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
199 getLocalNameEnv `thenRn` \ name_env ->
200 (if opt_WarnNameShadowing
202 mapRn (check_shadow name_env) rdr_names_w_loc
207 newLocalNames rdr_names_w_loc `thenRn` \ names ->
209 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
211 setLocalNameEnv new_name_env (enclosed_scope names)
213 check_shadow name_env (rdr_name,loc)
214 = case lookupRdrEnv name_env rdr_name of
215 Nothing -> returnRn ()
216 Just name -> pushSrcLocRn loc $
217 addWarnRn (shadowedNameWarn rdr_name)
220 -------------------------------------
221 bindLocalsRn doc_str rdr_names enclosed_scope
222 = getSrcLocRn `thenRn` \ loc ->
223 bindLocatedLocalsRn (text doc_str)
224 (rdr_names `zip` repeat loc)
227 -- binLocalsFVRn is the same as bindLocalsRn
228 -- except that it deals with free vars
229 bindLocalsFVRn doc_str rdr_names enclosed_scope
230 = bindLocalsRn doc_str rdr_names $ \ names ->
231 enclosed_scope names `thenRn` \ (thing, fvs) ->
232 returnRn (thing, delListFromNameSet fvs names)
234 -------------------------------------
235 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS s (a, FreeVars) -> RnMS s (a, FreeVars)
236 -- This tiresome function is used only in rnDecl on InstDecl
237 extendTyVarEnvFVRn tyvars enclosed_scope
238 = getLocalNameEnv `thenRn` \ env ->
240 tyvar_names = map getTyVarName tyvars
241 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
242 | name <- tyvar_names
245 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
246 returnRn (thing, delListFromNameSet fvs tyvar_names)
248 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
249 -> ([HsTyVar Name] -> RnMS s a)
251 bindTyVarsRn doc_str tyvar_names enclosed_scope
252 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
253 enclosed_scope tyvars
255 -- Gruesome name: return Names as well as HsTyVars
256 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
257 -> ([Name] -> [HsTyVar Name] -> RnMS s a)
259 bindTyVars2Rn doc_str tyvar_names enclosed_scope
260 = getSrcLocRn `thenRn` \ loc ->
262 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
264 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
265 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
267 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
268 -> ([HsTyVar Name] -> RnMS s (a, FreeVars))
269 -> RnMS s (a, FreeVars)
270 bindTyVarsFVRn doc_str rdr_names enclosed_scope
271 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
272 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
273 returnRn (thing, delListFromNameSet fvs names)
275 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
276 -> ([Name] -> [HsTyVar Name] -> RnMS s (a, FreeVars))
277 -> RnMS s (a, FreeVars)
278 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
279 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
280 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
281 returnRn (thing, delListFromNameSet fvs names)
284 -------------------------------------
285 checkDupOrQualNames, checkDupNames :: SDoc
286 -> [(RdrName, SrcLoc)]
288 -- Works in any variant of the renamer monad
290 checkDupOrQualNames doc_str rdr_names_w_loc
291 = -- Check for use of qualified names
292 mapRn (qualNameErr doc_str) quals `thenRn_`
293 checkDupNames doc_str rdr_names_w_loc
295 quals = filter (isQual.fst) rdr_names_w_loc
297 checkDupNames doc_str rdr_names_w_loc
298 = -- Check for dupicated names in a binding group
299 mapRn (dupNamesErr doc_str) dups `thenRn_`
302 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
306 %*********************************************************
308 \subsection{Looking up names}
310 %*********************************************************
312 Looking up a name in the RnEnv.
315 lookupBndrRn rdr_name
316 = getNameEnvs `thenRn` \ (global_env, local_env) ->
319 case lookupRdrEnv local_env rdr_name of {
320 Just name -> returnRn name ;
323 getModeRn `thenRn` \ mode ->
325 InterfaceMode _ -> -- Look in the global name cache
326 newImportedGlobalFromRdrName rdr_name
328 SourceMode -> -- Source mode, so look up a *qualified* version
329 -- of the name, so that we get the right one even
330 -- if there are many with the same occ name
331 -- There must *be* a binding
332 getModuleRn `thenRn` \ mod ->
333 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
334 Just (name:rest) -> ASSERT( null rest )
336 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
339 -- Just like lookupRn except that we record the occurrence too
340 -- Perhaps surprisingly, even wired-in names are recorded.
341 -- Why? So that we know which wired-in names are referred to when
342 -- deciding which instance declarations to import.
343 lookupOccRn :: RdrName -> RnMS s Name
345 = getNameEnvs `thenRn` \ (global_env, local_env) ->
346 lookup_occ global_env local_env rdr_name `thenRn` \ name ->
347 addOccurrenceName name
349 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
350 -- environment. It's used only for
351 -- record field names
352 -- class op names in class and instance decls
353 lookupGlobalOccRn :: RdrName -> RnMS s Name
354 lookupGlobalOccRn rdr_name
355 = getNameEnvs `thenRn` \ (global_env, local_env) ->
356 lookup_global_occ global_env rdr_name `thenRn` \ name ->
357 addOccurrenceName name
359 -- Look in both local and global env
360 lookup_occ global_env local_env rdr_name
361 = case lookupRdrEnv local_env rdr_name of
362 Just name -> returnRn name
363 Nothing -> lookup_global_occ global_env rdr_name
365 -- Look in global env only
366 lookup_global_occ global_env rdr_name
367 = case lookupRdrEnv global_env rdr_name of
368 Just [name] -> returnRn name
369 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
371 Nothing -> getModeRn `thenRn` \ mode ->
373 -- Not found when processing source code; so fail
374 SourceMode -> failWithRn (mkUnboundName rdr_name)
375 (unknownNameErr rdr_name)
377 -- Not found when processing an imported declaration,
378 -- so we create a new name for the purpose
379 InterfaceMode _ -> newImportedGlobalFromRdrName rdr_name
382 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
383 -- adds it to the occurrence pool so that it'll be loaded later. This is
384 -- used when language constructs (such as monad comprehensions, overloaded literals,
385 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
386 -- mentioned in the code.
388 -- This doesn't apply in interface mode, where everything is explicit, but
389 -- we don't check for this case: it does no harm to record an "extra" occurrence
390 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
391 -- Nothing clause of rnDerivs that calls it at all I think).
392 -- [Jan 98: this comment is wrong: rnHsType uses it quite a bit.]
394 -- For List and Tuple types it's important to get the correct
395 -- isLocallyDefined flag, which is used in turn when deciding
396 -- whether there are any instance decls in this module are "special".
397 -- The name cache should have the correct provenance, though.
399 lookupImplicitOccRn :: RdrName -> RnMS s Name
400 lookupImplicitOccRn rdr_name
401 = newImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
402 addOccurrenceName name
404 addImplicitOccRn :: Name -> RnMS s Name
405 addImplicitOccRn name = addOccurrenceName name
407 addImplicitOccsRn :: [Name] -> RnMS s ()
408 addImplicitOccsRn names = addOccurrenceNames names
412 lookupFixity :: Name -> RnMS s Fixity
414 = getFixityEnv `thenRn` \ fixity_env ->
415 case lookupNameEnv fixity_env name of
416 Just (FixitySig _ fixity _) -> returnRn fixity
417 Nothing -> returnRn (Fixity 9 InfixL) -- Default case
420 unQualInScope returns a function that takes a Name and tells whether
421 its unqualified name is in scope. This is put as a boolean flag in
422 the Name's provenance to guide whether or not to print the name qualified
426 unQualInScope :: GlobalRdrEnv -> Name -> Bool
430 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
431 Just [name'] -> name == name'
435 %************************************************************************
437 \subsection{Envt utility functions}
439 %************************************************************************
441 =============== RnEnv ================
443 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
444 = RnEnv (n1 `plusGlobalRdrEnv` n2)
445 (f1 `plusNameEnv` f2)
449 =============== NameEnv ================
451 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
452 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
454 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
455 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
457 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
458 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
460 combine_globals :: [Name] -- Old
463 combine_globals ns_old ns_new -- ns_new is often short
464 = foldr add ns_old ns_new
466 add n ns | all (no_conflict n) ns_old = map choose ns -- Eliminate duplicates
469 choose n' | n==n' && better_provenance n n' = n
473 -- a local thing over an imported thing
474 -- a user-imported thing over a non-user-imported thing
475 -- an explicitly-imported thing over an implicitly imported thing
476 better_provenance n1 n2
477 = case (getNameProvenance n1, getNameProvenance n2) of
478 (LocalDef _ _, _ ) -> True
479 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
480 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
483 no_conflict :: Name -> Name -> Bool
484 no_conflict n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
485 | otherwise = n1 == n2
486 -- We complain of a conflict if one RdrName maps to two different Names,
487 -- OR if one RdrName maps to the same *locally-defined* Name. The latter
488 -- case is to catch two separate, local definitions of the same thing.
490 -- If a module imports itself then there might be a local defn and an imported
491 -- defn of the same name; in this case the names will compare as equal, but
492 -- will still have different provenances
497 =============== ExportAvails ================
499 mkEmptyExportAvails :: Module -> ExportAvails
500 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
502 mkExportAvails :: Module -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
503 mkExportAvails mod_name unqual_imp name_env avails
504 = (mod_avail_env, entity_avail_env)
506 mod_avail_env = unitFM mod_name unqual_avails
508 -- unqual_avails is the Avails that are visible in *unqualfied* form
509 -- (1.4 Report, Section 5.1.1)
511 -- import T hiding( f )
512 -- we delete f from avails
514 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
515 | otherwise = mapMaybe prune avails
517 prune (Avail n) | unqual_in_scope n = Just (Avail n)
518 prune (Avail n) | otherwise = Nothing
519 prune (AvailTC n ns) | null uqs = Nothing
520 | otherwise = Just (AvailTC n uqs)
522 uqs = filter unqual_in_scope ns
524 unqual_in_scope n = unQualInScope name_env n
526 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
527 name <- availNames avail]
529 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
530 plusExportAvails (m1, e1) (m2, e2)
531 = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
532 -- ToDo: wasteful: we do this once for each constructor!
536 =============== AvailInfo ================
538 plusAvail (Avail n1) (Avail n2) = Avail n1
539 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
542 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
545 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
546 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
548 availsToNameSet :: [AvailInfo] -> NameSet
549 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
551 availName :: AvailInfo -> Name
552 availName (Avail n) = n
553 availName (AvailTC n _) = n
555 availNames :: AvailInfo -> [Name]
556 availNames (Avail n) = [n]
557 availNames (AvailTC n ns) = ns
559 filterAvail :: RdrNameIE -- Wanted
560 -> AvailInfo -- Available
561 -> Maybe AvailInfo -- Resulting available;
562 -- Nothing if (any of the) wanted stuff isn't there
564 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
565 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
566 | otherwise = Nothing
568 is_wanted name = nameOccName name `elem` wanted_occs
569 sub_names_ok = all (`elem` avail_occs) wanted_occs
570 avail_occs = map nameOccName ns
571 wanted_occs = map rdrNameOcc (want:wants)
573 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
576 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
578 filterAvail (IEVar _) avail@(Avail n) = Just avail
579 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
581 wanted n = nameOccName n == occ
583 -- The second equation happens if we import a class op, thus
585 -- where op is a class operation
587 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
589 filterAvail ie avail = Nothing
592 -- In interfaces, pprAvail gets given the OccName of the "host" thing
593 pprAvail avail = getPprStyle $ \ sty ->
594 if ifaceStyle sty then
595 ppr_avail (pprOccName . nameOccName) avail
599 ppr_avail pp_name (AvailTC n ns) = hsep [
601 parens $ hsep $ punctuate comma $
604 ppr_avail pp_name (Avail n) = pp_name n
610 %************************************************************************
612 \subsection{Free variable manipulation}
614 %************************************************************************
617 type FreeVars = NameSet
619 plusFV :: FreeVars -> FreeVars -> FreeVars
620 addOneFV :: FreeVars -> Name -> FreeVars
621 unitFV :: Name -> FreeVars
623 plusFVs :: [FreeVars] -> FreeVars
625 emptyFVs = emptyNameSet
626 plusFVs = unionManyNameSets
627 plusFV = unionNameSets
629 -- No point in adding implicitly imported names to the free-var set
630 addOneFV s n = addOneToNameSet s n
631 unitFV n = unitNameSet n
635 %************************************************************************
637 \subsection{Envt utility functions}
639 %************************************************************************
643 warnUnusedLocalBinds, warnUnusedTopNames, warnUnusedMatches :: [Name] -> RnM s d ()
645 warnUnusedTopNames names
646 | not opt_WarnUnusedBinds && not opt_WarnUnusedImports = returnRn () -- Don't force ns unless necessary
647 | otherwise = warnUnusedBinds names
649 warnUnusedLocalBinds ns
650 | not opt_WarnUnusedBinds = returnRn ()
651 | otherwise = warnUnusedBinds ns
653 warnUnusedMatches names
654 | opt_WarnUnusedMatches = warnUnusedGroup names
655 | otherwise = returnRn ()
657 -------------------------
659 warnUnusedBinds :: [Name] -> RnM s d ()
660 warnUnusedBinds names
661 = mapRn warnUnusedGroup groups `thenRn_`
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 :: [Name] -> RnM s d ()
681 warnUnusedGroup names
682 | is_local && not opt_WarnUnusedBinds = returnRn ()
683 | not is_local && not opt_WarnUnusedImports = returnRn ()
685 = pushSrcLocRn def_loc $
687 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr names)))]
690 (is_local, def_loc, msg)
691 = case getNameProvenance name1 of
692 LocalDef loc _ -> (True, loc, text "Defined but not used")
693 NonLocalDef (UserImport mod loc _) _ -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
694 text "but but not used")
695 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
699 addNameClashErrRn rdr_name (name1:names)
700 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
701 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
703 msg1 = ptext SLIT("either") <+> mk_ref name1
704 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
705 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
707 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
708 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
709 4 (vcat [ppr how_in_scope1,
712 shadowedNameWarn shadow
713 = hsep [ptext SLIT("This binding for"),
715 ptext SLIT("shadows an existing binding")]
718 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
720 flavour = occNameFlavour (rdrNameOcc name)
722 qualNameErr descriptor (name,loc)
724 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
729 dupNamesErr descriptor ((name,loc) : dup_things)
731 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
733 (ptext SLIT("in") <+> descriptor))