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"
12 import RdrHsSyn ( RdrNameIE )
13 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
14 mkRdrUnqual, qualifyRdrName
16 import HsTypes ( hsTyVarName, replaceTyVarName )
17 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
18 ImportReason(..), GlobalRdrEnv, AvailEnv,
19 AvailInfo, GenAvailInfo(..), RdrAvailInfo )
21 import Name ( Name, NamedThing(..),
23 mkLocalName, mkImportedLocalName, mkGlobalName,
24 mkIPName, nameOccName, nameModule,
25 extendNameEnv_C, plusNameEnv_C, nameEnvElts,
29 import OccName ( OccName, occNameUserString, occNameFlavour )
30 import Module ( ModuleName, moduleName, mkVanillaModule )
32 import Unique ( Unique )
34 import SrcLoc ( SrcLoc, noSrcLoc )
36 import ListSetOps ( removeDups, equivClasses )
37 import Util ( sortLt )
39 import PrelNames ( mkUnboundName )
43 %*********************************************************
45 \subsection{Making new names}
47 %*********************************************************
50 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
51 newTopBinder mod rdr_name loc
52 = -- First check the cache
53 traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_`
55 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
57 occ = rdrNameOcc rdr_name
58 key = (moduleName mod, occ)
60 case lookupFM cache key of
62 -- A hit in the cache! We are at the binding site of the name, and
63 -- this is the moment when we know all about
64 -- a) the Name's host Module (in particular, which
65 -- package it comes from)
66 -- b) its defining SrcLoc
67 -- So we update this info
70 new_name = setNameModuleAndLoc name mod loc
71 new_cache = addToFM cache key new_name
73 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
74 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
78 -- Build a completely new Name, and put it in the cache
79 -- Even for locally-defined names we use implicitImportProvenance;
80 -- updateProvenances will set it to rights
82 (us', us1) = splitUniqSupply us
83 uniq = uniqFromSupply us1
84 new_name = mkGlobalName uniq mod occ loc
85 new_cache = addToFM cache key new_name
87 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
88 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
92 newGlobalName :: ModuleName -> OccName -> RnM d Name
93 -- Used for *occurrences*. We make a place-holder Name, really just
94 -- to agree on its unique, which gets overwritten when we read in
95 -- the binding occurence later (newTopBinder)
96 -- The place-holder Name doesn't have the right SrcLoc, and its
97 -- Module won't have the right Package either.
99 -- (We have to pass a ModuleName, not a Module, because we may be
100 -- simply looking at an occurrence M.x in an interface file.)
102 -- This means that a renamed program may have incorrect info
103 -- on implicitly-imported occurrences, but the correct info on the
104 -- *binding* declaration. It's the type checker that propagates the
105 -- correct information to all the occurrences.
106 -- Since implicitly-imported names never occur in error messages,
107 -- it doesn't matter that we get the correct info in place till later,
108 -- (but since it affects DLL-ery it does matter that we get it right
110 newGlobalName mod_name occ
111 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
113 key = (mod_name, occ)
115 case lookupFM cache key of
116 Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
119 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
120 traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
123 (us', us1) = splitUniqSupply us
124 uniq = uniqFromSupply us1
125 mod = mkVanillaModule mod_name
126 name = mkGlobalName uniq mod occ noSrcLoc
127 new_cache = addToFM cache key name
130 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
131 case lookupFM ipcache key of
132 Just name -> returnRn name
133 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
136 (us', us1) = splitUniqSupply us
137 uniq = uniqFromSupply us1
138 name = mkIPName uniq key
139 new_ipcache = addToFM ipcache key name
140 where key = (rdrNameOcc rdr_name)
143 %*********************************************************
145 \subsection{Looking up names}
147 %*********************************************************
149 Looking up a name in the RnEnv.
152 lookupBndrRn rdr_name
153 = getLocalNameEnv `thenRn` \ local_env ->
154 case lookupRdrEnv local_env rdr_name of
155 Just name -> returnRn name
156 Nothing -> lookupTopBndrRn rdr_name
158 lookupTopBndrRn rdr_name
159 = getModeRn `thenRn` \ mode ->
161 InterfaceMode -> -- Look in the global name cache
162 lookupOrigName rdr_name
164 SourceMode -> -- Source mode, so look up a *qualified* version
165 -- of the name, so that we get the right one even
166 -- if there are many with the same occ name
167 -- There must *be* a binding
168 getModuleRn `thenRn` \ mod ->
169 getGlobalNameEnv `thenRn` \ global_env ->
170 case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of
171 Just ((name,_):rest) -> ASSERT( null rest )
173 Nothing -> -- Almost always this case is a compiler bug.
174 -- But consider a type signature that doesn't have
175 -- a corresponding binder:
176 -- module M where { f :: Int->Int }
177 -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
178 -- and we don't want to panic. So we report an out-of-scope error
179 failWithRn (mkUnboundName rdr_name)
180 (unknownNameErr rdr_name)
182 -- lookupSigOccRn is used for type signatures and pragmas
188 -- It's clear that the 'f' in the signature must refer to A.f
189 -- The Haskell98 report does not stipulate this, but it will!
190 -- So we must treat the 'f' in the signature in the same way
191 -- as the binding occurrence of 'f', using lookupBndrRn
192 lookupSigOccRn :: RdrName -> RnMS Name
193 lookupSigOccRn = lookupBndrRn
195 -- lookupOccRn looks up an occurrence of a RdrName
196 lookupOccRn :: RdrName -> RnMS Name
198 = getLocalNameEnv `thenRn` \ local_env ->
199 case lookupRdrEnv local_env rdr_name of
200 Just name -> returnRn name
201 Nothing -> lookupGlobalOccRn rdr_name
203 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
204 -- environment. It's used only for
205 -- record field names
206 -- class op names in class and instance decls
207 lookupGlobalOccRn rdr_name
208 = getModeRn `thenRn` \ mode ->
210 -- When processing interface files, the global env
211 -- is always empty, so go straight to the name cache
212 InterfaceMode -> lookupOrigName rdr_name ;
216 getGlobalNameEnv `thenRn` \ global_env ->
217 case lookupRdrEnv global_env rdr_name of
218 Just [(name,_)] -> returnRn name
219 Just stuff@((name,_):_)
220 -> addNameClashErrRn rdr_name stuff `thenRn_`
222 Nothing -> -- Not found when processing source code; so fail
223 failWithRn (mkUnboundName rdr_name)
224 (unknownNameErr rdr_name)
229 @lookupOrigName@ takes an RdrName representing an {\em original}
230 name, and adds it to the occurrence pool so that it'll be loaded
231 later. This is used when language constructs (such as monad
232 comprehensions, overloaded literals, or deriving clauses) require some
233 stuff to be loaded that isn't explicitly mentioned in the code.
235 This doesn't apply in interface mode, where everything is explicit,
236 but we don't check for this case: it does no harm to record an
237 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
238 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
239 calls it at all I think).
241 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
243 For List and Tuple types it's important to get the correct
244 @isLocallyDefined@ flag, which is used in turn when deciding
245 whether there are any instance decls in this module are ``special''.
246 The name cache should have the correct provenance, though.
249 lookupOrigName :: RdrName -> RnM d Name
250 lookupOrigName rdr_name
252 = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
255 = -- An Unqual is allowed; interface files contain
256 -- unqualified names for locally-defined things, such as
257 -- constructors of a data type.
258 getModuleRn `thenRn ` \ mod ->
259 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
261 lookupOrigNames :: [RdrName] -> RnM d NameSet
262 lookupOrigNames rdr_names
263 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
264 returnRn (mkNameSet names)
267 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
268 It ensures that the module is set correctly in the name cache, and sets the provenance
269 on the returned name too. The returned name will end up actually in the type, class,
273 lookupSysBinder rdr_name
274 = ASSERT( isUnqual rdr_name )
275 getModuleRn `thenRn` \ mod ->
276 getSrcLocRn `thenRn` \ loc ->
277 newTopBinder mod rdr_name loc
282 %*********************************************************
286 %*********************************************************
289 newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
290 -> [(RdrName,SrcLoc)]
292 newLocalsRn mk_name rdr_names_w_loc
293 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
295 n = length rdr_names_w_loc
296 (us', us1) = splitUniqSupply us
297 uniqs = uniqsFromSupply n us1
298 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
299 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
302 setNameSupplyRn (us', cache, ipcache) `thenRn_`
306 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
307 -> [(RdrName,SrcLoc)]
308 -> ([Name] -> RnMS a)
310 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
311 = getModeRn `thenRn` \ mode ->
312 getLocalNameEnv `thenRn` \ name_env ->
314 -- Check for duplicate names
315 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
317 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
319 -- Warn about shadowing, but only in source modules
321 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
326 mk_name = case mode of
327 SourceMode -> mkLocalName
328 InterfaceMode -> mkImportedLocalName
329 -- Keep track of whether the name originally came from
330 -- an interface file.
332 newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names ->
334 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
336 setLocalNameEnv new_local_env (enclosed_scope names)
339 check_shadow name_env (rdr_name,loc)
340 = case lookupRdrEnv name_env rdr_name of
341 Nothing -> returnRn ()
342 Just name -> pushSrcLocRn loc $
343 addWarnRn (shadowedNameWarn rdr_name)
345 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
346 -> RnMS (a, FreeVars)
347 -- A specialised variant when renaming stuff from interface
348 -- files (of which there is a lot)
350 -- * no checks for shadowing
352 -- * deal with free vars
353 bindCoreLocalFVRn rdr_name enclosed_scope
354 = getSrcLocRn `thenRn` \ loc ->
355 getLocalNameEnv `thenRn` \ name_env ->
356 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
358 (us', us1) = splitUniqSupply us
359 uniq = uniqFromSupply us1
360 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
362 setNameSupplyRn (us', cache, ipcache) `thenRn_`
364 new_name_env = extendRdrEnv name_env rdr_name name
366 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
367 returnRn (result, delFromNameSet fvs name)
369 bindCoreLocalsFVRn [] thing_inside = thing_inside []
370 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
371 bindCoreLocalsFVRn bs $ \ names' ->
372 thing_inside (name':names')
374 bindLocalNames names enclosed_scope
375 = getLocalNameEnv `thenRn` \ name_env ->
376 setLocalNameEnv (addListToRdrEnv name_env pairs)
379 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
381 -------------------------------------
382 bindLocalRn doc rdr_name enclosed_scope
383 = getSrcLocRn `thenRn` \ loc ->
384 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
388 bindLocalsRn doc rdr_names enclosed_scope
389 = getSrcLocRn `thenRn` \ loc ->
390 bindLocatedLocalsRn doc
391 (rdr_names `zip` repeat loc)
394 -- binLocalsFVRn is the same as bindLocalsRn
395 -- except that it deals with free vars
396 bindLocalsFVRn doc rdr_names enclosed_scope
397 = bindLocalsRn doc rdr_names $ \ names ->
398 enclosed_scope names `thenRn` \ (thing, fvs) ->
399 returnRn (thing, delListFromNameSet fvs names)
401 -------------------------------------
402 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
403 bindUVarRn = bindLocalRn
405 -------------------------------------
406 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
407 -- This tiresome function is used only in rnDecl on InstDecl
408 extendTyVarEnvFVRn tyvars enclosed_scope
409 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
410 returnRn (thing, delListFromNameSet fvs tyvars)
412 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
413 -> ([HsTyVarBndr Name] -> RnMS a)
415 bindTyVarsRn doc_str tyvar_names enclosed_scope
416 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
417 enclosed_scope tyvars
419 -- Gruesome name: return Names as well as HsTyVars
420 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
421 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
423 bindTyVars2Rn doc_str tyvar_names enclosed_scope
424 = getSrcLocRn `thenRn` \ loc ->
426 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
428 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
429 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
431 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
432 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
433 -> RnMS (a, FreeVars)
434 bindTyVarsFVRn doc_str rdr_names enclosed_scope
435 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
436 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
437 returnRn (thing, delListFromNameSet fvs names)
439 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
440 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
441 -> RnMS (a, FreeVars)
442 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
443 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
444 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
445 returnRn (thing, delListFromNameSet fvs names)
447 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
448 -> ([Name] -> RnMS (a, FreeVars))
449 -> RnMS (a, FreeVars)
450 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
451 = getSrcLocRn `thenRn` \ loc ->
453 located_tyvars = [(tv, loc) | tv <- tyvar_names]
455 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
456 enclosed_scope names `thenRn` \ (thing, fvs) ->
457 returnRn (thing, delListFromNameSet fvs names)
460 -------------------------------------
461 checkDupOrQualNames, checkDupNames :: SDoc
462 -> [(RdrName, SrcLoc)]
464 -- Works in any variant of the renamer monad
466 checkDupOrQualNames doc_str rdr_names_w_loc
467 = -- Check for use of qualified names
468 mapRn_ (qualNameErr doc_str) quals `thenRn_`
469 checkDupNames doc_str rdr_names_w_loc
471 quals = filter (isQual.fst) rdr_names_w_loc
473 checkDupNames doc_str rdr_names_w_loc
474 = -- Check for duplicated names in a binding group
475 mapRn_ (dupNamesErr doc_str) dups
477 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
481 %************************************************************************
483 \subsection{GlobalRdrEnv}
485 %************************************************************************
488 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
489 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
491 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
492 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
494 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
495 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
497 combine_globals :: [(Name,Provenance)] -- Old
498 -> [(Name,Provenance)] -- New
499 -> [(Name,Provenance)]
500 combine_globals ns_old ns_new -- ns_new is often short
501 = foldr add ns_old ns_new
503 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
506 choose n m | n `beats` m = n
509 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
511 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
512 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
513 is_duplicate (n1,_) (n2,_) = n1 == n2
516 We treat two bindings of a locally-defined name as a duplicate,
517 because they might be two separate, local defns and we want to report
518 and error for that, {\em not} eliminate a duplicate.
520 On the other hand, if you import the same name from two different
521 import statements, we {\em do} want to eliminate the duplicate, not report
524 If a module imports itself then there might be a local defn and an imported
525 defn of the same name; in this case the names will compare as equal, but
526 will still have different provenances.
529 @unQualInScope@ returns a function that takes a @Name@ and tells whether
530 its unqualified name is in scope. This is put as a boolean flag in
531 the @Name@'s provenance to guide whether or not to print the name qualified
535 unQualInScope :: GlobalRdrEnv -> Name -> Bool
539 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
540 Just [(name',_)] -> name == name'
545 %************************************************************************
549 %************************************************************************
552 plusAvail (Avail n1) (Avail n2) = Avail n1
553 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
556 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
559 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
560 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
562 emptyAvailEnv = emptyNameEnv
563 unitAvailEnv :: AvailInfo -> AvailEnv
564 unitAvailEnv a = unitNameEnv (availName a) a
566 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
567 plusAvailEnv = plusNameEnv_C plusAvail
569 availEnvElts = nameEnvElts
571 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
572 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
574 availsToNameSet :: [AvailInfo] -> NameSet
575 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
577 availName :: GenAvailInfo name -> name
578 availName (Avail n) = n
579 availName (AvailTC n _) = n
581 availNames :: GenAvailInfo name -> [name]
582 availNames (Avail n) = [n]
583 availNames (AvailTC n ns) = ns
585 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
586 addSysAvails avail [] = avail
587 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
589 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
590 -- Used when building the avails we are going to put in an interface file
591 -- We sort the components to reduce needless wobbling of interfaces
592 rdrAvailInfo (Avail n) = Avail (nameOccName n)
593 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
595 filterAvail :: RdrNameIE -- Wanted
596 -> AvailInfo -- Available
597 -> Maybe AvailInfo -- Resulting available;
598 -- Nothing if (any of the) wanted stuff isn't there
600 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
601 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
602 | otherwise = Nothing
604 is_wanted name = nameOccName name `elem` wanted_occs
605 sub_names_ok = all (`elem` avail_occs) wanted_occs
606 avail_occs = map nameOccName ns
607 wanted_occs = map rdrNameOcc (want:wants)
609 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
612 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
614 filterAvail (IEVar _) avail@(Avail n) = Just avail
615 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
617 wanted n = nameOccName n == occ
619 -- The second equation happens if we import a class op, thus
621 -- where op is a class operation
623 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
624 -- We don't complain even if the IE says T(..), but
625 -- no constrs/class ops of T are available
626 -- Instead that's caught with a warning by the caller
628 filterAvail ie avail = Nothing
630 pprAvail :: AvailInfo -> SDoc
631 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
633 ns' -> parens (hsep (punctuate comma (map ppr ns')))
635 pprAvail (Avail n) = ppr n
639 %************************************************************************
641 \subsection{Free variable manipulation}
643 %************************************************************************
646 type FreeVars = NameSet
648 plusFV :: FreeVars -> FreeVars -> FreeVars
649 addOneFV :: FreeVars -> Name -> FreeVars
650 unitFV :: Name -> FreeVars
652 plusFVs :: [FreeVars] -> FreeVars
653 mkFVs :: [Name] -> FreeVars
655 isEmptyFVs = isEmptyNameSet
656 emptyFVs = emptyNameSet
657 plusFVs = unionManyNameSets
658 plusFV = unionNameSets
661 -- No point in adding implicitly imported names to the free-var set
662 addOneFV s n = addOneToNameSet s n
663 unitFV n = unitNameSet n
666 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
668 (ys, fvs_s) = unzip stuff
670 returnRn (ys, plusFVs fvs_s)
674 %************************************************************************
676 \subsection{Envt utility functions}
678 %************************************************************************
681 warnUnusedModules :: [Module] -> RnM d ()
682 warnUnusedModules mods
683 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
684 if warn then mapRn_ (addWarnRn . unused_mod) mods
687 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
688 text "is imported, but nothing from it is used",
689 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
690 quotes (ppr (moduleName m)))]
692 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
693 warnUnusedImports names
694 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
695 if warn then warnUnusedBinds names else returnRn ()
697 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
698 warnUnusedLocalBinds names
699 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
700 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
703 warnUnusedMatches names
704 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
705 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
708 -------------------------
710 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
711 warnUnusedBinds names
712 = mapRn_ warnUnusedGroup groups
714 -- Group by provenance
715 groups = equivClasses cmp names
716 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
719 -------------------------
721 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
722 warnUnusedGroup names
723 | null filtered_names = returnRn ()
724 | not is_local = returnRn ()
726 = pushSrcLocRn def_loc $
728 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
730 filtered_names = filter reportable names
731 (name1, prov1) = head filtered_names
732 (is_local, def_loc, msg)
734 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
736 NonLocalDef (UserImport mod loc _) _
737 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
739 reportable (name,_) = case occNameUserString (nameOccName name) of
742 -- Haskell 98 encourages compilers to suppress warnings about
743 -- unused names in a pattern if they start with "_".
747 addNameClashErrRn rdr_name (np1:nps)
748 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
749 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
751 msg1 = ptext SLIT("either") <+> mk_ref np1
752 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
753 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
755 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
756 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
757 4 (vcat [ppr how_in_scope1,
760 shadowedNameWarn shadow
761 = hsep [ptext SLIT("This binding for"),
763 ptext SLIT("shadows an existing binding")]
766 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
768 flavour = occNameFlavour (rdrNameOcc name)
770 qualNameErr descriptor (name,loc)
772 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
777 dupNamesErr descriptor ((name,loc) : dup_things)
779 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
781 (ptext SLIT("in") <+> descriptor))