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 )
45 %*********************************************************
47 \subsection{Making new names}
49 %*********************************************************
52 newImportedGlobalName :: Module -> OccName
54 newImportedGlobalName mod occ
55 = -- First check the cache
56 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
59 mod_hif = moduleIfaceFlavour mod
61 case lookupFM cache key of
63 -- A hit in the cache!
64 -- Make sure that the module in the name has the same IfaceFlavour as
65 -- the module we are looking for; if not, make it so
66 -- so that it has the right HiFlag component.
67 -- (This is necessary for known-key things.
68 -- For example, GHCmain.lhs imports as SOURCE
69 -- Main; but Main.main is a known-key thing.)
70 Just name | isSystemName name -- A known-key name; fix the provenance and module
71 -> getOmitQualFn `thenRn` \ omit_fn ->
73 new_name = setNameProvenance (setNameModule name mod)
74 (NonLocalDef ImplicitImport (omit_fn name))
75 new_cache = addToFM cache key new_name
77 setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
83 Nothing -> -- Miss in the cache!
84 -- Build a new original name, and put it in the cache
85 getOmitQualFn `thenRn` \ omit_fn ->
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 dupicated names in a binding group
298 mapRn (dupNamesErr doc_str) dups `thenRn_`
301 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
305 %*********************************************************
307 \subsection{Looking up names}
309 %*********************************************************
311 Looking up a name in the RnEnv.
314 lookupBndrRn rdr_name
315 = getNameEnvs `thenRn` \ (global_env, local_env) ->
318 case lookupRdrEnv local_env rdr_name of {
319 Just name -> returnRn name ;
322 getModeRn `thenRn` \ mode ->
324 InterfaceMode _ -> -- Look in the global name cache
325 newImportedGlobalFromRdrName rdr_name
327 SourceMode -> -- Source mode, so look up a *qualified* version
328 -- of the name, so that we get the right one even
329 -- if there are many with the same occ name
330 -- There must *be* a binding
331 getModuleRn `thenRn` \ mod ->
332 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
333 Just (name:rest) -> ASSERT( null rest )
335 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
338 -- Just like lookupRn except that we record the occurrence too
339 -- Perhaps surprisingly, even wired-in names are recorded.
340 -- Why? So that we know which wired-in names are referred to when
341 -- deciding which instance declarations to import.
342 lookupOccRn :: RdrName -> RnMS s Name
344 = getNameEnvs `thenRn` \ (global_env, local_env) ->
345 lookup_occ global_env local_env rdr_name `thenRn` \ name ->
346 addOccurrenceName name
348 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
349 -- environment. It's used only for
350 -- record field names
351 -- class op names in class and instance decls
352 lookupGlobalOccRn :: RdrName -> RnMS s Name
353 lookupGlobalOccRn rdr_name
354 = getNameEnvs `thenRn` \ (global_env, local_env) ->
355 lookup_global_occ global_env rdr_name `thenRn` \ name ->
356 addOccurrenceName name
358 -- Look in both local and global env
359 lookup_occ global_env local_env rdr_name
360 = case lookupRdrEnv local_env rdr_name of
361 Just name -> returnRn name
362 Nothing -> lookup_global_occ global_env rdr_name
364 -- Look in global env only
365 lookup_global_occ global_env rdr_name
366 = case lookupRdrEnv global_env rdr_name of
367 Just [name] -> returnRn name
368 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
370 Nothing -> getModeRn `thenRn` \ mode ->
372 -- Not found when processing source code; so fail
373 SourceMode -> failWithRn (mkUnboundName rdr_name)
374 (unknownNameErr rdr_name)
376 -- Not found when processing an imported declaration,
377 -- so we create a new name for the purpose
378 InterfaceMode _ -> newImportedGlobalFromRdrName rdr_name
381 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
382 -- adds it to the occurrence pool so that it'll be loaded later. This is
383 -- used when language constructs (such as monad comprehensions, overloaded literals,
384 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
385 -- mentioned in the code.
387 -- This doesn't apply in interface mode, where everything is explicit, but
388 -- we don't check for this case: it does no harm to record an "extra" occurrence
389 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
390 -- Nothing clause of rnDerivs that calls it at all I think).
391 -- [Jan 98: this comment is wrong: rnHsType uses it quite a bit.]
393 -- For List and Tuple types it's important to get the correct
394 -- isLocallyDefined flag, which is used in turn when deciding
395 -- whether there are any instance decls in this module are "special".
396 -- The name cache should have the correct provenance, though.
398 lookupImplicitOccRn :: RdrName -> RnMS s Name
399 lookupImplicitOccRn rdr_name
400 = newImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
401 addOccurrenceName name
403 addImplicitOccRn :: Name -> RnMS s Name
404 addImplicitOccRn name = addOccurrenceName name
406 addImplicitOccsRn :: [Name] -> RnMS s ()
407 addImplicitOccsRn names = addOccurrenceNames names
411 lookupFixity :: Name -> RnMS s Fixity
413 = getFixityEnv `thenRn` \ fixity_env ->
414 case lookupNameEnv fixity_env name of
415 Just (FixitySig _ fixity _) -> returnRn fixity
416 Nothing -> returnRn (Fixity 9 InfixL) -- Default case
419 unQualInScope returns a function that takes a Name and tells whether
420 its unqualified name is in scope. This is put as a boolean flag in
421 the Name's provenance to guide whether or not to print the name qualified
425 unQualInScope :: GlobalRdrEnv -> Name -> Bool
429 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
430 Just [name'] -> name == name'
434 %************************************************************************
436 \subsection{Envt utility functions}
438 %************************************************************************
440 =============== RnEnv ================
442 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
443 = RnEnv (n1 `plusGlobalRdrEnv` n2)
444 (f1 `plusNameEnv` f2)
448 =============== NameEnv ================
450 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
451 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
453 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
454 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
456 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
457 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
459 combine_globals :: [Name] -- Old
462 combine_globals ns_old ns_new -- ns_new is often short
463 = foldr add ns_old ns_new
465 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
468 choose n' | n==n' && better_provenance n n' = n
472 -- a local thing over an imported thing
473 -- a user-imported thing over a non-user-imported thing
474 -- an explicitly-imported thing over an implicitly imported thing
475 better_provenance n1 n2
476 = case (getNameProvenance n1, getNameProvenance n2) of
477 (LocalDef _ _, _ ) -> True
478 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
479 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
482 is_duplicate :: Name -> Name -> Bool
483 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
484 | otherwise = n1 == n2
485 -- We treat two bindings of a locally-defined name as a duplicate,
486 -- because they might be two separate, local defns and we want to report
487 -- and error for that, *not* eliminate a duplicate.
489 -- On the other hand, if you import the same name from two different
490 -- import statements, we *do* want to eliminate the duplicate, not report
493 -- If a module imports itself then there might be a local defn and an imported
494 -- defn of the same name; in this case the names will compare as equal, but
495 -- will still have different provenances
500 =============== ExportAvails ================
502 mkEmptyExportAvails :: Module -> ExportAvails
503 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
505 mkExportAvails :: Module -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
506 mkExportAvails mod_name unqual_imp name_env avails
507 = (mod_avail_env, entity_avail_env)
509 mod_avail_env = unitFM mod_name unqual_avails
511 -- unqual_avails is the Avails that are visible in *unqualfied* form
512 -- (1.4 Report, Section 5.1.1)
514 -- import T hiding( f )
515 -- we delete f from avails
517 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
518 | otherwise = mapMaybe prune avails
520 prune (Avail n) | unqual_in_scope n = Just (Avail n)
521 prune (Avail n) | otherwise = Nothing
522 prune (AvailTC n ns) | null uqs = Nothing
523 | otherwise = Just (AvailTC n uqs)
525 uqs = filter unqual_in_scope ns
527 unqual_in_scope n = unQualInScope name_env n
529 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
530 name <- availNames avail]
532 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
533 plusExportAvails (m1, e1) (m2, e2)
534 = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
535 -- ToDo: wasteful: we do this once for each constructor!
539 =============== AvailInfo ================
541 plusAvail (Avail n1) (Avail n2) = Avail n1
542 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
545 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
548 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
549 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
551 availsToNameSet :: [AvailInfo] -> NameSet
552 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
554 availName :: AvailInfo -> Name
555 availName (Avail n) = n
556 availName (AvailTC n _) = n
558 availNames :: AvailInfo -> [Name]
559 availNames (Avail n) = [n]
560 availNames (AvailTC n ns) = ns
562 filterAvail :: RdrNameIE -- Wanted
563 -> AvailInfo -- Available
564 -> Maybe AvailInfo -- Resulting available;
565 -- Nothing if (any of the) wanted stuff isn't there
567 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
568 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
569 | otherwise = Nothing
571 is_wanted name = nameOccName name `elem` wanted_occs
572 sub_names_ok = all (`elem` avail_occs) wanted_occs
573 avail_occs = map nameOccName ns
574 wanted_occs = map rdrNameOcc (want:wants)
576 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
579 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
581 filterAvail (IEVar _) avail@(Avail n) = Just avail
582 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
584 wanted n = nameOccName n == occ
586 -- The second equation happens if we import a class op, thus
588 -- where op is a class operation
590 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
592 filterAvail ie avail = Nothing
595 -- In interfaces, pprAvail gets given the OccName of the "host" thing
596 pprAvail avail = getPprStyle $ \ sty ->
597 if ifaceStyle sty then
598 ppr_avail (pprOccName . nameOccName) avail
602 ppr_avail pp_name (AvailTC n ns) = hsep [
604 parens $ hsep $ punctuate comma $
607 ppr_avail pp_name (Avail n) = pp_name n
613 %************************************************************************
615 \subsection{Free variable manipulation}
617 %************************************************************************
620 type FreeVars = NameSet
622 plusFV :: FreeVars -> FreeVars -> FreeVars
623 addOneFV :: FreeVars -> Name -> FreeVars
624 unitFV :: Name -> FreeVars
626 plusFVs :: [FreeVars] -> FreeVars
628 emptyFVs = emptyNameSet
629 plusFVs = unionManyNameSets
630 plusFV = unionNameSets
632 -- No point in adding implicitly imported names to the free-var set
633 addOneFV s n = addOneToNameSet s n
634 unitFV n = unitNameSet n
638 %************************************************************************
640 \subsection{Envt utility functions}
642 %************************************************************************
646 warnUnusedLocalBinds, warnUnusedTopNames, warnUnusedMatches :: [Name] -> RnM s d ()
648 warnUnusedTopNames names
649 | not opt_WarnUnusedBinds && not opt_WarnUnusedImports = returnRn () -- Don't force ns unless necessary
650 | otherwise = warnUnusedBinds names
652 warnUnusedLocalBinds ns
653 | not opt_WarnUnusedBinds = returnRn ()
654 | otherwise = warnUnusedBinds ns
656 warnUnusedMatches names
657 | opt_WarnUnusedMatches = warnUnusedGroup names
658 | otherwise = returnRn ()
660 -------------------------
662 warnUnusedBinds :: [Name] -> RnM s d ()
663 warnUnusedBinds names
664 = mapRn warnUnusedGroup groups `thenRn_`
667 -- Group by provenance
668 groups = equivClasses cmp names
669 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
671 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
672 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
673 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
674 (NonLocalDef (UserImport m2 loc2 _) _) = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
675 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
676 -- In-scope NonLocalDefs must have UserImport info on them
678 -------------------------
680 warnUnusedGroup :: [Name] -> RnM s d ()
684 warnUnusedGroup names
685 | is_local && not opt_WarnUnusedBinds = returnRn ()
686 | not is_local && not opt_WarnUnusedImports = returnRn ()
688 = pushSrcLocRn def_loc $
690 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr names)))]
693 (is_local, def_loc, msg)
694 = case getNameProvenance name1 of
695 LocalDef loc _ -> (True, loc, text "Defined but not used")
696 NonLocalDef (UserImport mod loc _) _ -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
697 text "but but not used")
698 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
702 addNameClashErrRn rdr_name (name1:names)
703 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
704 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
706 msg1 = ptext SLIT("either") <+> mk_ref name1
707 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
708 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
710 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
711 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
712 4 (vcat [ppr how_in_scope1,
715 shadowedNameWarn shadow
716 = hsep [ptext SLIT("This binding for"),
718 ptext SLIT("shadows an existing binding")]
721 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
723 flavour = occNameFlavour (rdrNameOcc name)
725 qualNameErr descriptor (name,loc)
727 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
732 dupNamesErr descriptor ((name,loc) : dup_things)
734 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
736 (ptext SLIT("in") <+> descriptor))