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, mkUnboundName,
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, pprModuleName )
32 import Unique ( Unique )
34 import SrcLoc ( SrcLoc )
36 import ListSetOps ( removeDups, equivClasses )
37 import Util ( thenCmp, sortLt )
43 %*********************************************************
45 \subsection{Making new names}
47 %*********************************************************
50 implicitImportProvenance = NonLocalDef ImplicitImport False
52 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
53 newTopBinder mod rdr_name loc
54 = -- First check the cache
55 traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
57 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
59 occ = rdrNameOcc rdr_name
60 key = (moduleName mod, occ)
62 case lookupFM cache key of
64 -- A hit in the cache! We are at the binding site of the name, and
65 -- this is the moment when we know all about
66 -- a) the Name's host Module (in particular, which
67 -- package it comes from)
68 -- b) its defining SrcLoc
69 -- So we update this info
72 new_name = setNameModuleAndLoc name mod loc
73 new_cache = addToFM cache key new_name
75 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
76 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
80 -- Build a completely new Name, and put it in the cache
81 -- Even for locally-defined names we use implicitImportProvenance;
82 -- updateProvenances will set it to rights
84 (us', us1) = splitUniqSupply us
85 uniq = uniqFromSupply us1
86 new_name = mkGlobalName uniq mod occ loc
87 new_cache = addToFM cache key new_name
89 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
90 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
94 newGlobalName :: ModuleName -> OccName -> RnM d Name
95 -- Used for *occurrences*. We make a place-holder Name, really just
96 -- to agree on its unique, which gets overwritten when we read in
97 -- the binding occurence later (newTopBinder)
98 -- The place-holder Name doesn't have the right SrcLoc, and its
99 -- Module won't have the right Package either.
101 -- (We have to pass a ModuleName, not a Module, because we may be
102 -- simply looking at an occurrence M.x in an interface file.)
104 -- This means that a renamed program may have incorrect info
105 -- on implicitly-imported occurrences, but the correct info on the
106 -- *binding* declaration. It's the type checker that propagates the
107 -- correct information to all the occurrences.
108 -- Since implicitly-imported names never occur in error messages,
109 -- it doesn't matter that we get the correct info in place till later,
110 -- (but since it affects DLL-ery it does matter that we get it right
112 newGlobalName mod_name occ
113 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
115 key = (mod_name, occ)
117 case lookupFM cache key of
118 Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
121 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
122 traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
125 (us', us1) = splitUniqSupply us
126 uniq = uniqFromSupply us1
127 mod = mkVanillaModule mod_name
128 name = mkGlobalName uniq mod occ noSrcLoc
129 new_cache = addToFM cache key name
132 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
133 case lookupFM ipcache key of
134 Just name -> returnRn name
135 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
138 (us', us1) = splitUniqSupply us
139 uniq = uniqFromSupply us1
140 name = mkIPName uniq key
141 new_ipcache = addToFM ipcache key name
142 where key = (rdrNameOcc rdr_name)
145 %*********************************************************
147 \subsection{Looking up names}
149 %*********************************************************
151 Looking up a name in the RnEnv.
154 lookupBndrRn rdr_name
155 = getLocalNameEnv `thenRn` \ local_env ->
156 case lookupRdrEnv local_env rdr_name of
157 Just name -> returnRn name
158 Nothing -> lookupTopBndrRn rdr_name
160 lookupTopBndrRn rdr_name
161 = getModeRn `thenRn` \ mode ->
163 InterfaceMode -> -- Look in the global name cache
164 lookupOrigName rdr_name
166 SourceMode -> -- Source mode, so look up a *qualified* version
167 -- of the name, so that we get the right one even
168 -- if there are many with the same occ name
169 -- There must *be* a binding
170 getModuleRn `thenRn` \ mod ->
171 getGlobalNameEnv `thenRn` \ global_env ->
172 case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of
173 Just (name:rest) -> ASSERT( null rest )
175 Nothing -> -- Almost always this case is a compiler bug.
176 -- But consider a type signature that doesn't have
177 -- a corresponding binder:
178 -- module M where { f :: Int->Int }
179 -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
180 -- and we don't want to panic. So we report an out-of-scope error
181 failWithRn (mkUnboundName rdr_name)
182 (unknownNameErr rdr_name)
184 -- lookupSigOccRn is used for type signatures and pragmas
190 -- It's clear that the 'f' in the signature must refer to A.f
191 -- The Haskell98 report does not stipulate this, but it will!
192 -- So we must treat the 'f' in the signature in the same way
193 -- as the binding occurrence of 'f', using lookupBndrRn
194 lookupSigOccRn :: RdrName -> RnMS Name
195 lookupSigOccRn = lookupBndrRn
197 -- lookupOccRn looks up an occurrence of a RdrName
198 lookupOccRn :: RdrName -> RnMS Name
200 = getLocalNameEnv `thenRn` \ local_env ->
201 case lookupRdrEnv local_env rdr_name of
202 Just name -> returnRn name
203 Nothing -> lookupGlobalOccRn rdr_name
205 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
206 -- environment. It's used only for
207 -- record field names
208 -- class op names in class and instance decls
209 lookupGlobalOccRn rdr_name
210 = getModeRn `thenRn` \ mode ->
212 -- When processing interface files, the global env
213 -- is always empty, so go straight to the name cache
214 InterfaceMode -> lookupOrigName rdr_name ;
218 getGlobalNameEnv `thenRn` \ global_env ->
219 case lookupRdrEnv global_env rdr_name of
220 Just [(name,_)] -> returnRn name
221 Just stuff@(_:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
223 Nothing -> -- Not found when processing source code; so fail
224 failWithRn (mkUnboundName rdr_name)
225 (unknownNameErr rdr_name)
230 @lookupOrigName@ takes an RdrName representing an {\em original}
231 name, and adds it to the occurrence pool so that it'll be loaded
232 later. This is used when language constructs (such as monad
233 comprehensions, overloaded literals, or deriving clauses) require some
234 stuff to be loaded that isn't explicitly mentioned in the code.
236 This doesn't apply in interface mode, where everything is explicit,
237 but we don't check for this case: it does no harm to record an
238 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
239 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
240 calls it at all I think).
242 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
244 For List and Tuple types it's important to get the correct
245 @isLocallyDefined@ flag, which is used in turn when deciding
246 whether there are any instance decls in this module are ``special''.
247 The name cache should have the correct provenance, though.
250 lookupOrigName :: RdrName -> RnM d Name
251 lookupOrigName rdr_name
253 = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
256 = -- An Unqual is allowed; interface files contain
257 -- unqualified names for locally-defined things, such as
258 -- constructors of a data type.
259 getModuleRn `thenRn ` \ mod ->
260 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
262 lookupOrigNames :: [RdrName] -> RnM d NameSet
263 lookupOrigNames rdr_names
264 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
265 returnRn (mkNameSet names)
268 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
269 It ensures that the module is set correctly in the name cache, and sets the provenance
270 on the returned name too. The returned name will end up actually in the type, class,
274 lookupSysBinder rdr_name
275 = ASSERT( isUnqual rdr_name )
276 getModuleRn `thenRn` \ mod ->
277 getSrcLocRn `thenRn` \ loc ->
278 newTopBinder mod rdr_name loc
283 %*********************************************************
287 %*********************************************************
290 newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
291 -> [(RdrName,SrcLoc)]
293 newLocalsRn mk_name rdr_names_w_loc
294 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
296 n = length rdr_names_w_loc
297 (us', us1) = splitUniqSupply us
298 uniqs = uniqsFromSupply n us1
299 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
300 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
303 setNameSupplyRn (us', cache, ipcache) `thenRn_`
307 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
308 -> [(RdrName,SrcLoc)]
309 -> ([Name] -> RnMS a)
311 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
312 = getModeRn `thenRn` \ mode ->
313 getLocalNameEnv `thenRn` \ name_env ->
315 -- Check for duplicate names
316 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
318 -- Warn about shadowing, but only in source modules
320 SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
325 mk_name = case mode of
326 SourceMode -> mkLocalName
327 InterfaceMode -> mkImportedLocalName
328 -- Keep track of whether the name originally came from
329 -- an interface file.
331 newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names ->
333 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
335 setLocalNameEnv new_local_env (enclosed_scope names)
338 check_shadow name_env (rdr_name,loc)
339 = case lookupRdrEnv name_env rdr_name of
340 Nothing -> returnRn ()
341 Just name -> pushSrcLocRn loc $
342 addWarnRn (shadowedNameWarn rdr_name)
344 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
345 -> RnMS (a, FreeVars)
346 -- A specialised variant when renaming stuff from interface
347 -- files (of which there is a lot)
349 -- * no checks for shadowing
351 -- * deal with free vars
352 bindCoreLocalFVRn rdr_name enclosed_scope
353 = getSrcLocRn `thenRn` \ loc ->
354 getLocalNameEnv `thenRn` \ name_env ->
355 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
357 (us', us1) = splitUniqSupply us
358 uniq = uniqFromSupply us1
359 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
361 setNameSupplyRn (us', cache, ipcache) `thenRn_`
363 new_name_env = extendRdrEnv name_env rdr_name name
365 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
366 returnRn (result, delFromNameSet fvs name)
368 bindCoreLocalsFVRn [] thing_inside = thing_inside []
369 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
370 bindCoreLocalsFVRn bs $ \ names' ->
371 thing_inside (name':names')
373 bindLocalNames names enclosed_scope
374 = getLocalNameEnv `thenRn` \ name_env ->
375 setLocalNameEnv (addListToRdrEnv name_env pairs)
378 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
380 -------------------------------------
381 bindLocalRn doc rdr_name enclosed_scope
382 = getSrcLocRn `thenRn` \ loc ->
383 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
387 bindLocalsRn doc rdr_names enclosed_scope
388 = getSrcLocRn `thenRn` \ loc ->
389 bindLocatedLocalsRn doc
390 (rdr_names `zip` repeat loc)
393 -- binLocalsFVRn is the same as bindLocalsRn
394 -- except that it deals with free vars
395 bindLocalsFVRn doc rdr_names enclosed_scope
396 = bindLocalsRn doc rdr_names $ \ names ->
397 enclosed_scope names `thenRn` \ (thing, fvs) ->
398 returnRn (thing, delListFromNameSet fvs names)
400 -------------------------------------
401 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
402 bindUVarRn = bindLocalRn
404 -------------------------------------
405 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
406 -- This tiresome function is used only in rnDecl on InstDecl
407 extendTyVarEnvFVRn tyvars enclosed_scope
408 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
409 returnRn (thing, delListFromNameSet fvs tyvars)
411 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
412 -> ([HsTyVarBndr Name] -> RnMS a)
414 bindTyVarsRn doc_str tyvar_names enclosed_scope
415 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
416 enclosed_scope tyvars
418 -- Gruesome name: return Names as well as HsTyVars
419 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
420 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
422 bindTyVars2Rn doc_str tyvar_names enclosed_scope
423 = getSrcLocRn `thenRn` \ loc ->
425 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
427 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
428 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
430 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
431 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
432 -> RnMS (a, FreeVars)
433 bindTyVarsFVRn doc_str rdr_names enclosed_scope
434 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
435 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
436 returnRn (thing, delListFromNameSet fvs names)
438 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
439 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
440 -> RnMS (a, FreeVars)
441 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
442 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
443 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
444 returnRn (thing, delListFromNameSet fvs names)
446 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
447 -> ([Name] -> RnMS (a, FreeVars))
448 -> RnMS (a, FreeVars)
449 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
450 = getSrcLocRn `thenRn` \ loc ->
452 located_tyvars = [(tv, loc) | tv <- tyvar_names]
454 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
455 enclosed_scope names `thenRn` \ (thing, fvs) ->
456 returnRn (thing, delListFromNameSet fvs names)
459 -------------------------------------
460 checkDupOrQualNames, checkDupNames :: SDoc
461 -> [(RdrName, SrcLoc)]
463 -- Works in any variant of the renamer monad
465 checkDupOrQualNames doc_str rdr_names_w_loc
466 = -- Check for use of qualified names
467 mapRn_ (qualNameErr doc_str) quals `thenRn_`
468 checkDupNames doc_str rdr_names_w_loc
470 quals = filter (isQual.fst) rdr_names_w_loc
472 checkDupNames doc_str rdr_names_w_loc
473 = -- Check for duplicated names in a binding group
474 mapRn_ (dupNamesErr doc_str) dups
476 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
480 %************************************************************************
482 \subsection{GlobalRdrEnv}
484 %************************************************************************
487 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
488 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
490 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
491 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
493 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
494 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
496 combine_globals :: [(Name,Provenance)] -- Old
497 -> [(Name,Provenance)] -- New
498 -> [(Name,Provenance)]
499 combine_globals ns_old ns_new -- ns_new is often short
500 = foldr add ns_old ns_new
502 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
505 choose n m | n `beats` m = n
508 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
510 is_duplicate :: Provenance -> (Name,Provenance) -> Bool
511 is_duplicate (n1,LocalDef _) (n2,LocalDef _) = False
512 is_duplicate _ _ = n1 == n2
515 We treat two bindings of a locally-defined name as a duplicate,
516 because they might be two separate, local defns and we want to report
517 and error for that, {\em not} eliminate a duplicate.
519 On the other hand, if you import the same name from two different
520 import statements, we {\em do} want to eliminate the duplicate, not report
523 If a module imports itself then there might be a local defn and an imported
524 defn of the same name; in this case the names will compare as equal, but
525 will still have different provenances.
528 @unQualInScope@ returns a function that takes a @Name@ and tells whether
529 its unqualified name is in scope. This is put as a boolean flag in
530 the @Name@'s provenance to guide whether or not to print the name qualified
534 unQualInScope :: GlobalRdrEnv -> Name -> Bool
538 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
539 Just [(name',_)] -> name == name'
544 %************************************************************************
548 %************************************************************************
551 plusAvail (Avail n1) (Avail n2) = Avail n1
552 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
555 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
558 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
559 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
561 emptyAvailEnv = emptyNameEnv
562 unitAvailEnv :: AvailInfo -> AvailEnv
563 unitAvailEnv a = unitNameEnv (availName a) a
565 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
566 plusAvailEnv = plusNameEnv_C plusAvail
568 availEnvElts = nameEnvElts
570 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
571 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
573 availsToNameSet :: [AvailInfo] -> NameSet
574 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
576 availName :: GenAvailInfo name -> name
577 availName (Avail n) = n
578 availName (AvailTC n _) = n
580 availNames :: GenAvailInfo name -> [name]
581 availNames (Avail n) = [n]
582 availNames (AvailTC n ns) = ns
584 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
585 addSysAvails avail [] = avail
586 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
588 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
589 -- Used when building the avails we are going to put in an interface file
590 -- We sort the components to reduce needless wobbling of interfaces
591 rdrAvailInfo (Avail n) = Avail (nameOccName n)
592 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
594 filterAvail :: RdrNameIE -- Wanted
595 -> AvailInfo -- Available
596 -> Maybe AvailInfo -- Resulting available;
597 -- Nothing if (any of the) wanted stuff isn't there
599 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
600 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
601 | otherwise = Nothing
603 is_wanted name = nameOccName name `elem` wanted_occs
604 sub_names_ok = all (`elem` avail_occs) wanted_occs
605 avail_occs = map nameOccName ns
606 wanted_occs = map rdrNameOcc (want:wants)
608 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
611 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
613 filterAvail (IEVar _) avail@(Avail n) = Just avail
614 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
616 wanted n = nameOccName n == occ
618 -- The second equation happens if we import a class op, thus
620 -- where op is a class operation
622 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
623 -- We don't complain even if the IE says T(..), but
624 -- no constrs/class ops of T are available
625 -- Instead that's caught with a warning by the caller
627 filterAvail ie avail = Nothing
629 pprAvail :: AvailInfo -> SDoc
630 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
632 ns' -> parens (hsep (punctuate comma (map ppr ns')))
634 pprAvail (Avail n) = ppr n
638 %************************************************************************
640 \subsection{Free variable manipulation}
642 %************************************************************************
645 type FreeVars = NameSet
647 plusFV :: FreeVars -> FreeVars -> FreeVars
648 addOneFV :: FreeVars -> Name -> FreeVars
649 unitFV :: Name -> FreeVars
651 plusFVs :: [FreeVars] -> FreeVars
652 mkFVs :: [Name] -> FreeVars
654 isEmptyFVs = isEmptyNameSet
655 emptyFVs = emptyNameSet
656 plusFVs = unionManyNameSets
657 plusFV = unionNameSets
660 -- No point in adding implicitly imported names to the free-var set
661 addOneFV s n = addOneToNameSet s n
662 unitFV n = unitNameSet n
665 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
667 (ys, fvs_s) = unzip stuff
669 returnRn (ys, plusFVs fvs_s)
673 %************************************************************************
675 \subsection{Envt utility functions}
677 %************************************************************************
680 warnUnusedModules :: [Module] -> RnM d ()
681 warnUnusedModules mods
682 | not opt_WarnUnusedImports = returnRn ()
683 | otherwise = mapRn_ (addWarnRn . unused_mod . moduleName) mods
685 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
686 text "is imported, but nothing from it is used",
687 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
688 quotes (pprModuleName m))]
690 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
691 warnUnusedImports names
692 | not opt_WarnUnusedImports
693 = returnRn () -- Don't force names unless necessary
695 = warnUnusedBinds names
697 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
698 warnUnusedLocalBinds ns
699 | not opt_WarnUnusedBinds = returnRn ()
700 | otherwise = warnUnusedBinds [(n,LocalDef) | n<-ns]
702 warnUnusedMatches names
703 | opt_WarnUnusedMatches = warnUnusedGroup [(n,LocalDef) | n<-ns]
704 | otherwise = returnRn ()
706 -------------------------
708 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
709 warnUnusedBinds names
710 = mapRn_ warnUnusedGroup groups
712 -- Group by provenance
713 groups = equivClasses cmp names
714 (_,prov1) `cmp` (_,prov2) = prov1 `cmp_prov` prov2
716 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
717 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
718 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
719 (NonLocalDef (UserImport m2 loc2 _) _) =
720 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
721 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
722 -- In-scope NonLocalDefs must have UserImport info on them
724 -------------------------
726 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
727 warnUnusedGroup names
728 | null filtered_names = returnRn ()
729 | not is_local = returnRn ()
731 = pushSrcLocRn def_loc $
733 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
735 filtered_names = filter reportable names
736 (name1, prov1) = head filtered_names
737 (is_local, def_loc, msg)
739 LocalDef loc _ -> (True, loc, text "Defined but not used")
741 NonLocalDef (UserImport mod loc _) _
742 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
744 reportable (name,_) = case occNameUserString (nameOccName name) of
747 -- Haskell 98 encourages compilers to suppress warnings about
748 -- unused names in a pattern if they start with "_".
752 addNameClashErrRn rdr_name (np1:nps)
753 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
754 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
756 msg1 = ptext SLIT("either") <+> mk_ref np1
757 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
758 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
760 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
761 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
762 4 (vcat [ppr how_in_scope1,
765 shadowedNameWarn shadow
766 = hsep [ptext SLIT("This binding for"),
768 ptext SLIT("shadows an existing binding")]
771 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
773 flavour = occNameFlavour (rdrNameOcc name)
775 qualNameErr descriptor (name,loc)
777 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
782 dupNamesErr descriptor ((name,loc) : dup_things)
784 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
786 (ptext SLIT("in") <+> descriptor))