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 ( pprNameProvenance )
21 import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
22 ImportReason(..), getSrcLoc,
23 mkLocalName, mkImportedLocalName, mkGlobalName,
24 mkIPName, hasBetterProv, isLocallyDefined,
25 nameOccName, setNameModule, nameModule,
26 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 )
36 import ListSetOps ( removeDups, equivClasses )
37 import Util ( thenCmp, sortLt )
39 import PrelNames ( mkUnboundName )
44 %*********************************************************
46 \subsection{Making new names}
48 %*********************************************************
51 implicitImportProvenance = NonLocalDef ImplicitImport False
53 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
54 newTopBinder mod rdr_name loc
55 = -- First check the cache
56 traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
58 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
60 occ = rdrNameOcc rdr_name
61 key = (moduleName mod, occ)
63 case lookupFM cache key of
65 -- A hit in the cache! We are at the binding site of the name, and
66 -- this is the moment when we know all about
67 -- a) the Name's host Module (in particular, which
68 -- package it comes from)
69 -- b) its defining SrcLoc
70 -- So we update this info
73 new_name = setNameModuleAndLoc name mod loc
74 new_cache = addToFM cache key new_name
76 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
77 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
81 -- Build a completely new Name, and put it in the cache
82 -- Even for locally-defined names we use implicitImportProvenance;
83 -- updateProvenances will set it to rights
85 (us', us1) = splitUniqSupply us
86 uniq = uniqFromSupply us1
87 new_name = mkGlobalName uniq mod occ loc
88 new_cache = addToFM cache key new_name
90 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
91 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
95 newGlobalName :: ModuleName -> OccName -> RnM d Name
96 -- Used for *occurrences*. We make a place-holder Name, really just
97 -- to agree on its unique, which gets overwritten when we read in
98 -- the binding occurence later (newTopBinder)
99 -- The place-holder Name doesn't have the right SrcLoc, and its
100 -- Module won't have the right Package either.
102 -- (We have to pass a ModuleName, not a Module, because we may be
103 -- simply looking at an occurrence M.x in an interface file.)
105 -- This means that a renamed program may have incorrect info
106 -- on implicitly-imported occurrences, but the correct info on the
107 -- *binding* declaration. It's the type checker that propagates the
108 -- correct information to all the occurrences.
109 -- Since implicitly-imported names never occur in error messages,
110 -- it doesn't matter that we get the correct info in place till later,
111 -- (but since it affects DLL-ery it does matter that we get it right
113 newGlobalName mod_name occ
114 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
116 key = (mod_name, occ)
118 case lookupFM cache key of
119 Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
122 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
123 traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
126 (us', us1) = splitUniqSupply us
127 uniq = uniqFromSupply us1
128 mod = mkVanillaModule mod_name
129 name = mkGlobalName uniq mod occ noSrcLoc
130 new_cache = addToFM cache key name
133 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
134 case lookupFM ipcache key of
135 Just name -> returnRn name
136 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
139 (us', us1) = splitUniqSupply us
140 uniq = uniqFromSupply us1
141 name = mkIPName uniq key
142 new_ipcache = addToFM ipcache key name
143 where key = (rdrNameOcc rdr_name)
146 %*********************************************************
148 \subsection{Looking up names}
150 %*********************************************************
152 Looking up a name in the RnEnv.
155 lookupBndrRn rdr_name
156 = getLocalNameEnv `thenRn` \ local_env ->
157 case lookupRdrEnv local_env rdr_name of
158 Just name -> returnRn name
159 Nothing -> lookupTopBndrRn rdr_name
161 lookupTopBndrRn rdr_name
162 = getModeRn `thenRn` \ mode ->
164 InterfaceMode -> -- Look in the global name cache
165 lookupOrigName rdr_name
167 SourceMode -> -- Source mode, so look up a *qualified* version
168 -- of the name, so that we get the right one even
169 -- if there are many with the same occ name
170 -- There must *be* a binding
171 getModuleRn `thenRn` \ mod ->
172 getGlobalNameEnv `thenRn` \ global_env ->
173 case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of
174 Just (name:rest) -> ASSERT( null rest )
176 Nothing -> -- Almost always this case is a compiler bug.
177 -- But consider a type signature that doesn't have
178 -- a corresponding binder:
179 -- module M where { f :: Int->Int }
180 -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
181 -- and we don't want to panic. So we report an out-of-scope error
182 failWithRn (mkUnboundName rdr_name)
183 (unknownNameErr rdr_name)
185 -- lookupSigOccRn is used for type signatures and pragmas
191 -- It's clear that the 'f' in the signature must refer to A.f
192 -- The Haskell98 report does not stipulate this, but it will!
193 -- So we must treat the 'f' in the signature in the same way
194 -- as the binding occurrence of 'f', using lookupBndrRn
195 lookupSigOccRn :: RdrName -> RnMS Name
196 lookupSigOccRn = lookupBndrRn
198 -- lookupOccRn looks up an occurrence of a RdrName
199 lookupOccRn :: RdrName -> RnMS Name
201 = getLocalNameEnv `thenRn` \ local_env ->
202 case lookupRdrEnv local_env rdr_name of
203 Just name -> returnRn name
204 Nothing -> lookupGlobalOccRn rdr_name
206 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
207 -- environment. It's used only for
208 -- record field names
209 -- class op names in class and instance decls
210 lookupGlobalOccRn rdr_name
211 = getModeRn `thenRn` \ mode ->
213 -- When processing interface files, the global env
214 -- is always empty, so go straight to the name cache
215 InterfaceMode -> lookupOrigName rdr_name ;
219 getGlobalNameEnv `thenRn` \ global_env ->
220 case lookupRdrEnv global_env rdr_name of
221 Just [(name,_)] -> returnRn name
222 Just stuff@(_:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
224 Nothing -> -- Not found when processing source code; so fail
225 failWithRn (mkUnboundName rdr_name)
226 (unknownNameErr rdr_name)
231 @lookupOrigName@ takes an RdrName representing an {\em original}
232 name, and adds it to the occurrence pool so that it'll be loaded
233 later. This is used when language constructs (such as monad
234 comprehensions, overloaded literals, or deriving clauses) require some
235 stuff to be loaded that isn't explicitly mentioned in the code.
237 This doesn't apply in interface mode, where everything is explicit,
238 but we don't check for this case: it does no harm to record an
239 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
240 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
241 calls it at all I think).
243 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
245 For List and Tuple types it's important to get the correct
246 @isLocallyDefined@ flag, which is used in turn when deciding
247 whether there are any instance decls in this module are ``special''.
248 The name cache should have the correct provenance, though.
251 lookupOrigName :: RdrName -> RnM d Name
252 lookupOrigName rdr_name
254 = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
257 = -- An Unqual is allowed; interface files contain
258 -- unqualified names for locally-defined things, such as
259 -- constructors of a data type.
260 getModuleRn `thenRn ` \ mod ->
261 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
263 lookupOrigNames :: [RdrName] -> RnM d NameSet
264 lookupOrigNames rdr_names
265 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
266 returnRn (mkNameSet names)
269 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
270 It ensures that the module is set correctly in the name cache, and sets the provenance
271 on the returned name too. The returned name will end up actually in the type, class,
275 lookupSysBinder rdr_name
276 = ASSERT( isUnqual rdr_name )
277 getModuleRn `thenRn` \ mod ->
278 getSrcLocRn `thenRn` \ loc ->
279 newTopBinder mod rdr_name loc
284 %*********************************************************
288 %*********************************************************
291 newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
292 -> [(RdrName,SrcLoc)]
294 newLocalsRn mk_name rdr_names_w_loc
295 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
297 n = length rdr_names_w_loc
298 (us', us1) = splitUniqSupply us
299 uniqs = uniqsFromSupply n us1
300 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
301 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
304 setNameSupplyRn (us', cache, ipcache) `thenRn_`
308 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
309 -> [(RdrName,SrcLoc)]
310 -> ([Name] -> RnMS a)
312 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
313 = getModeRn `thenRn` \ mode ->
314 getLocalNameEnv `thenRn` \ name_env ->
316 -- Check for duplicate names
317 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
319 -- Warn about shadowing, but only in source modules
321 SourceMode | opt_WarnNameShadowing -> 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 :: Provenance -> (Name,Provenance) -> Bool
512 is_duplicate (n1,LocalDef _) (n2,LocalDef _) = False
513 is_duplicate _ _ = 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 | not opt_WarnUnusedImports = returnRn ()
684 | otherwise = mapRn_ (addWarnRn . unused_mod . moduleName) mods
686 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
687 text "is imported, but nothing from it is used",
688 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
689 quotes (pprModuleName m))]
691 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
692 warnUnusedImports names
693 | not opt_WarnUnusedImports
694 = returnRn () -- Don't force names unless necessary
696 = warnUnusedBinds names
698 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
699 warnUnusedLocalBinds ns
700 | not opt_WarnUnusedBinds = returnRn ()
701 | otherwise = warnUnusedBinds [(n,LocalDef) | n<-ns]
703 warnUnusedMatches names
704 | opt_WarnUnusedMatches = warnUnusedGroup [(n,LocalDef) | n<-ns]
705 | otherwise = returnRn ()
707 -------------------------
709 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
710 warnUnusedBinds names
711 = mapRn_ warnUnusedGroup groups
713 -- Group by provenance
714 groups = equivClasses cmp names
715 (_,prov1) `cmp` (_,prov2) = prov1 `cmp_prov` prov2
717 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
718 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
719 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
720 (NonLocalDef (UserImport m2 loc2 _) _) =
721 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
722 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
723 -- In-scope NonLocalDefs must have UserImport info on them
725 -------------------------
727 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
728 warnUnusedGroup names
729 | null filtered_names = returnRn ()
730 | not is_local = returnRn ()
732 = pushSrcLocRn def_loc $
734 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
736 filtered_names = filter reportable names
737 (name1, prov1) = head filtered_names
738 (is_local, def_loc, msg)
740 LocalDef loc _ -> (True, loc, text "Defined but not used")
742 NonLocalDef (UserImport mod loc _) _
743 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
745 reportable (name,_) = case occNameUserString (nameOccName name) of
748 -- Haskell 98 encourages compilers to suppress warnings about
749 -- unused names in a pattern if they start with "_".
753 addNameClashErrRn rdr_name (np1:nps)
754 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
755 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
757 msg1 = ptext SLIT("either") <+> mk_ref np1
758 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
759 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
761 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
762 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
763 4 (vcat [ppr how_in_scope1,
766 shadowedNameWarn shadow
767 = hsep [ptext SLIT("This binding for"),
769 ptext SLIT("shadows an existing binding")]
772 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
774 flavour = occNameFlavour (rdrNameOcc name)
776 qualNameErr descriptor (name,loc)
778 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
783 dupNamesErr descriptor ((name,loc) : dup_things)
785 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
787 (ptext SLIT("in") <+> descriptor))