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, isUnqual,
16 mkRdrUnqual, qualifyRdrName
18 import HsTypes ( hsTyVarName, hsTyVarNames, replaceTyVarName )
19 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
20 ImportReason(..), GlobalRdrEnv, Avails, AvailEnv,
21 AvailInfo, GenAvailInfo(..), RdrAvailInfo )
23 import Name ( Name, NamedThing(..),
25 mkLocalName, mkImportedLocalName, mkGlobalName,
26 mkIPName, isLocallyDefined,
27 nameOccName, nameModule,
28 extendNameEnv_C, plusNameEnv_C, nameEnvElts,
32 import OccName ( OccName, occNameUserString, occNameFlavour )
33 import Module ( ModuleName, moduleName, mkVanillaModule )
35 import Unique ( Unique )
37 import SrcLoc ( SrcLoc, noSrcLoc )
39 import ListSetOps ( removeDups, equivClasses )
40 import Util ( thenCmp, sortLt )
42 import PrelNames ( mkUnboundName )
47 %*********************************************************
49 \subsection{Making new names}
51 %*********************************************************
54 implicitImportProvenance = NonLocalDef ImplicitImport False
56 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
57 newTopBinder mod rdr_name loc
58 = -- First check the cache
59 traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_`
61 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
63 occ = rdrNameOcc rdr_name
64 key = (moduleName mod, occ)
66 case lookupFM cache key of
68 -- A hit in the cache! We are at the binding site of the name, and
69 -- this is the moment when we know all about
70 -- a) the Name's host Module (in particular, which
71 -- package it comes from)
72 -- b) its defining SrcLoc
73 -- So we update this info
76 new_name = setNameModuleAndLoc name mod loc
77 new_cache = addToFM cache key new_name
79 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
80 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
84 -- Build a completely new Name, and put it in the cache
85 -- Even for locally-defined names we use implicitImportProvenance;
86 -- updateProvenances will set it to rights
88 (us', us1) = splitUniqSupply us
89 uniq = uniqFromSupply us1
90 new_name = mkGlobalName uniq mod occ loc
91 new_cache = addToFM cache key new_name
93 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
94 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
98 newGlobalName :: ModuleName -> OccName -> RnM d Name
99 -- Used for *occurrences*. We make a place-holder Name, really just
100 -- to agree on its unique, which gets overwritten when we read in
101 -- the binding occurence later (newTopBinder)
102 -- The place-holder Name doesn't have the right SrcLoc, and its
103 -- Module won't have the right Package either.
105 -- (We have to pass a ModuleName, not a Module, because we may be
106 -- simply looking at an occurrence M.x in an interface file.)
108 -- This means that a renamed program may have incorrect info
109 -- on implicitly-imported occurrences, but the correct info on the
110 -- *binding* declaration. It's the type checker that propagates the
111 -- correct information to all the occurrences.
112 -- Since implicitly-imported names never occur in error messages,
113 -- it doesn't matter that we get the correct info in place till later,
114 -- (but since it affects DLL-ery it does matter that we get it right
116 newGlobalName mod_name occ
117 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
119 key = (mod_name, occ)
121 case lookupFM cache key of
122 Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
125 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
126 traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
129 (us', us1) = splitUniqSupply us
130 uniq = uniqFromSupply us1
131 mod = mkVanillaModule mod_name
132 name = mkGlobalName uniq mod occ noSrcLoc
133 new_cache = addToFM cache key name
136 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
137 case lookupFM ipcache key of
138 Just name -> returnRn name
139 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
142 (us', us1) = splitUniqSupply us
143 uniq = uniqFromSupply us1
144 name = mkIPName uniq key
145 new_ipcache = addToFM ipcache key name
146 where key = (rdrNameOcc rdr_name)
149 %*********************************************************
151 \subsection{Looking up names}
153 %*********************************************************
155 Looking up a name in the RnEnv.
158 lookupBndrRn rdr_name
159 = getLocalNameEnv `thenRn` \ local_env ->
160 case lookupRdrEnv local_env rdr_name of
161 Just name -> returnRn name
162 Nothing -> lookupTopBndrRn rdr_name
164 lookupTopBndrRn rdr_name
165 = getModeRn `thenRn` \ mode ->
167 InterfaceMode -> -- Look in the global name cache
168 lookupOrigName rdr_name
170 SourceMode -> -- Source mode, so look up a *qualified* version
171 -- of the name, so that we get the right one even
172 -- if there are many with the same occ name
173 -- There must *be* a binding
174 getModuleRn `thenRn` \ mod ->
175 getGlobalNameEnv `thenRn` \ global_env ->
176 case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of
177 Just (name:rest) -> ASSERT( null rest )
179 Nothing -> -- Almost always this case is a compiler bug.
180 -- But consider a type signature that doesn't have
181 -- a corresponding binder:
182 -- module M where { f :: Int->Int }
183 -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
184 -- and we don't want to panic. So we report an out-of-scope error
185 failWithRn (mkUnboundName rdr_name)
186 (unknownNameErr rdr_name)
188 -- lookupSigOccRn is used for type signatures and pragmas
194 -- It's clear that the 'f' in the signature must refer to A.f
195 -- The Haskell98 report does not stipulate this, but it will!
196 -- So we must treat the 'f' in the signature in the same way
197 -- as the binding occurrence of 'f', using lookupBndrRn
198 lookupSigOccRn :: RdrName -> RnMS Name
199 lookupSigOccRn = lookupBndrRn
201 -- lookupOccRn looks up an occurrence of a RdrName
202 lookupOccRn :: RdrName -> RnMS Name
204 = getLocalNameEnv `thenRn` \ local_env ->
205 case lookupRdrEnv local_env rdr_name of
206 Just name -> returnRn name
207 Nothing -> lookupGlobalOccRn rdr_name
209 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
210 -- environment. It's used only for
211 -- record field names
212 -- class op names in class and instance decls
213 lookupGlobalOccRn rdr_name
214 = getModeRn `thenRn` \ mode ->
216 -- When processing interface files, the global env
217 -- is always empty, so go straight to the name cache
218 InterfaceMode -> lookupOrigName rdr_name ;
222 getGlobalNameEnv `thenRn` \ global_env ->
223 case lookupRdrEnv global_env rdr_name of
224 Just [(name,_)] -> returnRn name
225 Just stuff@(_:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
227 Nothing -> -- Not found when processing source code; so fail
228 failWithRn (mkUnboundName rdr_name)
229 (unknownNameErr rdr_name)
234 @lookupOrigName@ takes an RdrName representing an {\em original}
235 name, and adds it to the occurrence pool so that it'll be loaded
236 later. This is used when language constructs (such as monad
237 comprehensions, overloaded literals, or deriving clauses) require some
238 stuff to be loaded that isn't explicitly mentioned in the code.
240 This doesn't apply in interface mode, where everything is explicit,
241 but we don't check for this case: it does no harm to record an
242 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
243 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
244 calls it at all I think).
246 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
248 For List and Tuple types it's important to get the correct
249 @isLocallyDefined@ flag, which is used in turn when deciding
250 whether there are any instance decls in this module are ``special''.
251 The name cache should have the correct provenance, though.
254 lookupOrigName :: RdrName -> RnM d Name
255 lookupOrigName rdr_name
257 = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
260 = -- An Unqual is allowed; interface files contain
261 -- unqualified names for locally-defined things, such as
262 -- constructors of a data type.
263 getModuleRn `thenRn ` \ mod ->
264 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
266 lookupOrigNames :: [RdrName] -> RnM d NameSet
267 lookupOrigNames rdr_names
268 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
269 returnRn (mkNameSet names)
272 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
273 It ensures that the module is set correctly in the name cache, and sets the provenance
274 on the returned name too. The returned name will end up actually in the type, class,
278 lookupSysBinder rdr_name
279 = ASSERT( isUnqual rdr_name )
280 getModuleRn `thenRn` \ mod ->
281 getSrcLocRn `thenRn` \ loc ->
282 newTopBinder mod rdr_name loc
287 %*********************************************************
291 %*********************************************************
294 newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
295 -> [(RdrName,SrcLoc)]
297 newLocalsRn mk_name rdr_names_w_loc
298 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
300 n = length rdr_names_w_loc
301 (us', us1) = splitUniqSupply us
302 uniqs = uniqsFromSupply n us1
303 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
304 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
307 setNameSupplyRn (us', cache, ipcache) `thenRn_`
311 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
312 -> [(RdrName,SrcLoc)]
313 -> ([Name] -> RnMS a)
315 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
316 = getModeRn `thenRn` \ mode ->
317 getLocalNameEnv `thenRn` \ name_env ->
319 -- Check for duplicate names
320 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
322 -- Warn about shadowing, but only in source modules
324 SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
329 mk_name = case mode of
330 SourceMode -> mkLocalName
331 InterfaceMode -> mkImportedLocalName
332 -- Keep track of whether the name originally came from
333 -- an interface file.
335 newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names ->
337 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
339 setLocalNameEnv new_local_env (enclosed_scope names)
342 check_shadow name_env (rdr_name,loc)
343 = case lookupRdrEnv name_env rdr_name of
344 Nothing -> returnRn ()
345 Just name -> pushSrcLocRn loc $
346 addWarnRn (shadowedNameWarn rdr_name)
348 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
349 -> RnMS (a, FreeVars)
350 -- A specialised variant when renaming stuff from interface
351 -- files (of which there is a lot)
353 -- * no checks for shadowing
355 -- * deal with free vars
356 bindCoreLocalFVRn rdr_name enclosed_scope
357 = getSrcLocRn `thenRn` \ loc ->
358 getLocalNameEnv `thenRn` \ name_env ->
359 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
361 (us', us1) = splitUniqSupply us
362 uniq = uniqFromSupply us1
363 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
365 setNameSupplyRn (us', cache, ipcache) `thenRn_`
367 new_name_env = extendRdrEnv name_env rdr_name name
369 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
370 returnRn (result, delFromNameSet fvs name)
372 bindCoreLocalsFVRn [] thing_inside = thing_inside []
373 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
374 bindCoreLocalsFVRn bs $ \ names' ->
375 thing_inside (name':names')
377 bindLocalNames names enclosed_scope
378 = getLocalNameEnv `thenRn` \ name_env ->
379 setLocalNameEnv (addListToRdrEnv name_env pairs)
382 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
384 -------------------------------------
385 bindLocalRn doc rdr_name enclosed_scope
386 = getSrcLocRn `thenRn` \ loc ->
387 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
391 bindLocalsRn doc rdr_names enclosed_scope
392 = getSrcLocRn `thenRn` \ loc ->
393 bindLocatedLocalsRn doc
394 (rdr_names `zip` repeat loc)
397 -- binLocalsFVRn is the same as bindLocalsRn
398 -- except that it deals with free vars
399 bindLocalsFVRn doc rdr_names enclosed_scope
400 = bindLocalsRn doc rdr_names $ \ names ->
401 enclosed_scope names `thenRn` \ (thing, fvs) ->
402 returnRn (thing, delListFromNameSet fvs names)
404 -------------------------------------
405 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
406 bindUVarRn = bindLocalRn
408 -------------------------------------
409 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
410 -- This tiresome function is used only in rnDecl on InstDecl
411 extendTyVarEnvFVRn tyvars enclosed_scope
412 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
413 returnRn (thing, delListFromNameSet fvs tyvars)
415 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
416 -> ([HsTyVarBndr Name] -> RnMS a)
418 bindTyVarsRn doc_str tyvar_names enclosed_scope
419 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
420 enclosed_scope tyvars
422 -- Gruesome name: return Names as well as HsTyVars
423 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
424 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
426 bindTyVars2Rn doc_str tyvar_names enclosed_scope
427 = getSrcLocRn `thenRn` \ loc ->
429 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
431 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
432 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
434 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
435 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
436 -> RnMS (a, FreeVars)
437 bindTyVarsFVRn doc_str rdr_names enclosed_scope
438 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
439 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
440 returnRn (thing, delListFromNameSet fvs names)
442 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
443 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
444 -> RnMS (a, FreeVars)
445 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
446 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
447 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
448 returnRn (thing, delListFromNameSet fvs names)
450 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
451 -> ([Name] -> RnMS (a, FreeVars))
452 -> RnMS (a, FreeVars)
453 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
454 = getSrcLocRn `thenRn` \ loc ->
456 located_tyvars = [(tv, loc) | tv <- tyvar_names]
458 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
459 enclosed_scope names `thenRn` \ (thing, fvs) ->
460 returnRn (thing, delListFromNameSet fvs names)
463 -------------------------------------
464 checkDupOrQualNames, checkDupNames :: SDoc
465 -> [(RdrName, SrcLoc)]
467 -- Works in any variant of the renamer monad
469 checkDupOrQualNames doc_str rdr_names_w_loc
470 = -- Check for use of qualified names
471 mapRn_ (qualNameErr doc_str) quals `thenRn_`
472 checkDupNames doc_str rdr_names_w_loc
474 quals = filter (isQual.fst) rdr_names_w_loc
476 checkDupNames doc_str rdr_names_w_loc
477 = -- Check for duplicated names in a binding group
478 mapRn_ (dupNamesErr doc_str) dups
480 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
484 %************************************************************************
486 \subsection{GlobalRdrEnv}
488 %************************************************************************
491 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
492 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
494 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
495 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
497 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
498 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
500 combine_globals :: [(Name,Provenance)] -- Old
501 -> [(Name,Provenance)] -- New
502 -> [(Name,Provenance)]
503 combine_globals ns_old ns_new -- ns_new is often short
504 = foldr add ns_old ns_new
506 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
509 choose n m | n `beats` m = n
512 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
514 is_duplicate :: Provenance -> (Name,Provenance) -> Bool
515 is_duplicate (n1,LocalDef _) (n2,LocalDef _) = False
516 is_duplicate n1 n2 = n1 == n2
519 We treat two bindings of a locally-defined name as a duplicate,
520 because they might be two separate, local defns and we want to report
521 and error for that, {\em not} eliminate a duplicate.
523 On the other hand, if you import the same name from two different
524 import statements, we {\em do} want to eliminate the duplicate, not report
527 If a module imports itself then there might be a local defn and an imported
528 defn of the same name; in this case the names will compare as equal, but
529 will still have different provenances.
532 @unQualInScope@ returns a function that takes a @Name@ and tells whether
533 its unqualified name is in scope. This is put as a boolean flag in
534 the @Name@'s provenance to guide whether or not to print the name qualified
538 unQualInScope :: GlobalRdrEnv -> Name -> Bool
542 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
543 Just [(name',_)] -> name == name'
548 %************************************************************************
552 %************************************************************************
555 plusAvail (Avail n1) (Avail n2) = Avail n1
556 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
559 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
562 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
563 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
565 emptyAvailEnv = emptyNameEnv
566 unitAvailEnv :: AvailInfo -> AvailEnv
567 unitAvailEnv a = unitNameEnv (availName a) a
569 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
570 plusAvailEnv = plusNameEnv_C plusAvail
572 availEnvElts = nameEnvElts
574 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
575 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
577 availsToNameSet :: [AvailInfo] -> NameSet
578 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
580 availName :: GenAvailInfo name -> name
581 availName (Avail n) = n
582 availName (AvailTC n _) = n
584 availNames :: GenAvailInfo name -> [name]
585 availNames (Avail n) = [n]
586 availNames (AvailTC n ns) = ns
588 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
589 addSysAvails avail [] = avail
590 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
592 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
593 -- Used when building the avails we are going to put in an interface file
594 -- We sort the components to reduce needless wobbling of interfaces
595 rdrAvailInfo (Avail n) = Avail (nameOccName n)
596 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
598 filterAvail :: RdrNameIE -- Wanted
599 -> AvailInfo -- Available
600 -> Maybe AvailInfo -- Resulting available;
601 -- Nothing if (any of the) wanted stuff isn't there
603 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
604 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
605 | otherwise = Nothing
607 is_wanted name = nameOccName name `elem` wanted_occs
608 sub_names_ok = all (`elem` avail_occs) wanted_occs
609 avail_occs = map nameOccName ns
610 wanted_occs = map rdrNameOcc (want:wants)
612 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
615 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
617 filterAvail (IEVar _) avail@(Avail n) = Just avail
618 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
620 wanted n = nameOccName n == occ
622 -- The second equation happens if we import a class op, thus
624 -- where op is a class operation
626 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
627 -- We don't complain even if the IE says T(..), but
628 -- no constrs/class ops of T are available
629 -- Instead that's caught with a warning by the caller
631 filterAvail ie avail = Nothing
633 pprAvail :: AvailInfo -> SDoc
634 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
636 ns' -> parens (hsep (punctuate comma (map ppr ns')))
638 pprAvail (Avail n) = ppr n
642 %************************************************************************
644 \subsection{Free variable manipulation}
646 %************************************************************************
649 type FreeVars = NameSet
651 plusFV :: FreeVars -> FreeVars -> FreeVars
652 addOneFV :: FreeVars -> Name -> FreeVars
653 unitFV :: Name -> FreeVars
655 plusFVs :: [FreeVars] -> FreeVars
656 mkFVs :: [Name] -> FreeVars
658 isEmptyFVs = isEmptyNameSet
659 emptyFVs = emptyNameSet
660 plusFVs = unionManyNameSets
661 plusFV = unionNameSets
664 -- No point in adding implicitly imported names to the free-var set
665 addOneFV s n = addOneToNameSet s n
666 unitFV n = unitNameSet n
669 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
671 (ys, fvs_s) = unzip stuff
673 returnRn (ys, plusFVs fvs_s)
677 %************************************************************************
679 \subsection{Envt utility functions}
681 %************************************************************************
684 warnUnusedModules :: [Module] -> RnM d ()
685 warnUnusedModules mods
686 | not opt_WarnUnusedImports = returnRn ()
687 | otherwise = mapRn_ (addWarnRn . unused_mod . moduleName) mods
689 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
690 text "is imported, but nothing from it is used",
691 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
692 quotes (ppr (moduleName m)))]
694 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
695 warnUnusedImports names
696 | not opt_WarnUnusedImports
697 = returnRn () -- Don't force names unless necessary
699 = warnUnusedBinds names
701 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
702 warnUnusedLocalBinds names
703 | not opt_WarnUnusedBinds = returnRn ()
704 | otherwise = warnUnusedBinds [(n,LocalDef) | n<-names]
706 warnUnusedMatches names
707 | opt_WarnUnusedMatches = warnUnusedGroup [(n,LocalDef) | n<-names]
708 | otherwise = returnRn ()
710 -------------------------
712 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
713 warnUnusedBinds names
714 = mapRn_ warnUnusedGroup groups
716 -- Group by provenance
717 groups = equivClasses cmp names
718 (_,prov1) `cmp` (_,prov2) = prov1 `cmp_prov` prov2
720 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
721 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
722 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
723 (NonLocalDef (UserImport m2 loc2 _) _) =
724 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
725 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
726 -- In-scope NonLocalDefs must have UserImport info on them
728 -------------------------
730 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
731 warnUnusedGroup names
732 | null filtered_names = returnRn ()
733 | not is_local = returnRn ()
735 = pushSrcLocRn def_loc $
737 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
739 filtered_names = filter reportable names
740 (name1, prov1) = head filtered_names
741 (is_local, def_loc, msg)
743 LocalDef loc _ -> (True, loc, text "Defined but not used")
745 NonLocalDef (UserImport mod loc _) _
746 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
748 reportable (name,_) = case occNameUserString (nameOccName name) of
751 -- Haskell 98 encourages compilers to suppress warnings about
752 -- unused names in a pattern if they start with "_".
756 addNameClashErrRn rdr_name (np1:nps)
757 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
758 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
760 msg1 = ptext SLIT("either") <+> mk_ref np1
761 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
762 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
764 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
765 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
766 4 (vcat [ppr how_in_scope1,
769 shadowedNameWarn shadow
770 = hsep [ptext SLIT("This binding for"),
772 ptext SLIT("shadows an existing binding")]
775 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
777 flavour = occNameFlavour (rdrNameOcc name)
779 qualNameErr descriptor (name,loc)
781 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
786 dupNamesErr descriptor ((name,loc) : dup_things)
788 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
790 (ptext SLIT("in") <+> descriptor))