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, lookupRdrEnv
16 import HsTypes ( hsTyVarName, replaceTyVarName )
17 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
18 ImportReason(..), GlobalRdrEnv, AvailEnv,
19 AvailInfo, Avails, 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)
227 lookupGlobalRn :: GlobalRdrEnv -> RdrName -> RnM d (Maybe Name)
228 -- Checks that there is exactly one
229 lookupGlobalRn global_env rdr_name
230 = case lookupRdrEnv global_env rdr_name of
231 Just [(name,_)] -> returnRn (Just name)
232 Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_`
234 Nothing -> returnRn Nothing
238 @lookupOrigName@ takes an RdrName representing an {\em original}
239 name, and adds it to the occurrence pool so that it'll be loaded
240 later. This is used when language constructs (such as monad
241 comprehensions, overloaded literals, or deriving clauses) require some
242 stuff to be loaded that isn't explicitly mentioned in the code.
244 This doesn't apply in interface mode, where everything is explicit,
245 but we don't check for this case: it does no harm to record an
246 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
247 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
248 calls it at all I think).
250 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
252 For List and Tuple types it's important to get the correct
253 @isLocallyDefined@ flag, which is used in turn when deciding
254 whether there are any instance decls in this module are ``special''.
255 The name cache should have the correct provenance, though.
258 lookupOrigName :: RdrName -> RnM d Name
259 lookupOrigName rdr_name
261 = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
264 = -- An Unqual is allowed; interface files contain
265 -- unqualified names for locally-defined things, such as
266 -- constructors of a data type.
267 getModuleRn `thenRn ` \ mod ->
268 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
270 lookupOrigNames :: [RdrName] -> RnM d NameSet
271 lookupOrigNames rdr_names
272 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
273 returnRn (mkNameSet names)
276 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
277 It ensures that the module is set correctly in the name cache, and sets the provenance
278 on the returned name too. The returned name will end up actually in the type, class,
282 lookupSysBinder rdr_name
283 = ASSERT( isUnqual rdr_name )
284 getModuleRn `thenRn` \ mod ->
285 getSrcLocRn `thenRn` \ loc ->
286 newTopBinder mod rdr_name loc
291 %*********************************************************
295 %*********************************************************
298 newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name)
299 -> [(RdrName,SrcLoc)]
301 newLocalsRn mk_name rdr_names_w_loc
302 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
304 n = length rdr_names_w_loc
305 (us', us1) = splitUniqSupply us
306 uniqs = uniqsFromSupply n us1
307 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
308 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
311 setNameSupplyRn (us', cache, ipcache) `thenRn_`
315 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
316 -> [(RdrName,SrcLoc)]
317 -> ([Name] -> RnMS a)
319 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
320 = getModeRn `thenRn` \ mode ->
321 getLocalNameEnv `thenRn` \ name_env ->
323 -- Check for duplicate names
324 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
326 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
328 -- Warn about shadowing, but only in source modules
330 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
335 mk_name = case mode of
336 SourceMode -> mkLocalName
337 InterfaceMode -> mkImportedLocalName
338 -- Keep track of whether the name originally came from
339 -- an interface file.
341 newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names ->
343 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
345 setLocalNameEnv new_local_env (enclosed_scope names)
348 check_shadow name_env (rdr_name,loc)
349 = case lookupRdrEnv name_env rdr_name of
350 Nothing -> returnRn ()
351 Just name -> pushSrcLocRn loc $
352 addWarnRn (shadowedNameWarn rdr_name)
354 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
355 -- A specialised variant when renaming stuff from interface
356 -- files (of which there is a lot)
358 -- * no checks for shadowing
360 -- * deal with free vars
361 bindCoreLocalRn rdr_name enclosed_scope
362 = getSrcLocRn `thenRn` \ loc ->
363 getLocalNameEnv `thenRn` \ name_env ->
364 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
366 (us', us1) = splitUniqSupply us
367 uniq = uniqFromSupply us1
368 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
370 setNameSupplyRn (us', cache, ipcache) `thenRn_`
372 new_name_env = extendRdrEnv name_env rdr_name name
374 setLocalNameEnv new_name_env (enclosed_scope name)
376 bindCoreLocalsRn [] thing_inside = thing_inside []
377 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
378 bindCoreLocalsRn bs $ \ names' ->
379 thing_inside (name':names')
381 bindLocalNames names enclosed_scope
382 = getLocalNameEnv `thenRn` \ name_env ->
383 setLocalNameEnv (addListToRdrEnv name_env pairs)
386 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
388 -------------------------------------
389 bindLocalRn doc rdr_name enclosed_scope
390 = getSrcLocRn `thenRn` \ loc ->
391 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
395 bindLocalsRn doc rdr_names enclosed_scope
396 = getSrcLocRn `thenRn` \ loc ->
397 bindLocatedLocalsRn doc
398 (rdr_names `zip` repeat loc)
401 -- binLocalsFVRn is the same as bindLocalsRn
402 -- except that it deals with free vars
403 bindLocalsFVRn doc rdr_names enclosed_scope
404 = bindLocalsRn doc rdr_names $ \ names ->
405 enclosed_scope names `thenRn` \ (thing, fvs) ->
406 returnRn (thing, delListFromNameSet fvs names)
408 -------------------------------------
409 bindUVarRn :: RdrName -> (Name -> RnMS a) -> RnMS a
410 bindUVarRn = bindCoreLocalRn
412 -------------------------------------
413 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
414 -- This tiresome function is used only in rnDecl on InstDecl
415 extendTyVarEnvFVRn tyvars enclosed_scope
416 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
417 returnRn (thing, delListFromNameSet fvs tyvars)
419 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
420 -> ([HsTyVarBndr Name] -> RnMS a)
422 bindTyVarsRn doc_str tyvar_names enclosed_scope
423 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
424 enclosed_scope tyvars
426 -- Gruesome name: return Names as well as HsTyVars
427 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
428 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
430 bindTyVars2Rn doc_str tyvar_names enclosed_scope
431 = getSrcLocRn `thenRn` \ loc ->
433 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
435 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
436 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
438 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
439 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
440 -> RnMS (a, FreeVars)
441 bindTyVarsFVRn doc_str rdr_names enclosed_scope
442 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
443 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
444 returnRn (thing, delListFromNameSet fvs names)
446 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
447 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
448 -> RnMS (a, FreeVars)
449 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
450 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
451 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
452 returnRn (thing, delListFromNameSet fvs names)
454 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
455 -> ([Name] -> RnMS (a, FreeVars))
456 -> RnMS (a, FreeVars)
457 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
458 = getSrcLocRn `thenRn` \ loc ->
460 located_tyvars = [(tv, loc) | tv <- tyvar_names]
462 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
463 enclosed_scope names `thenRn` \ (thing, fvs) ->
464 returnRn (thing, delListFromNameSet fvs names)
467 -------------------------------------
468 checkDupOrQualNames, checkDupNames :: SDoc
469 -> [(RdrName, SrcLoc)]
471 -- Works in any variant of the renamer monad
473 checkDupOrQualNames doc_str rdr_names_w_loc
474 = -- Check for use of qualified names
475 mapRn_ (qualNameErr doc_str) quals `thenRn_`
476 checkDupNames doc_str rdr_names_w_loc
478 quals = filter (isQual.fst) rdr_names_w_loc
480 checkDupNames doc_str rdr_names_w_loc
481 = -- Check for duplicated names in a binding group
482 mapRn_ (dupNamesErr doc_str) dups
484 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
488 %************************************************************************
490 \subsection{GlobalRdrEnv}
492 %************************************************************************
495 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
496 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
498 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
499 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
501 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
502 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
504 combine_globals :: [(Name,Provenance)] -- Old
505 -> [(Name,Provenance)] -- New
506 -> [(Name,Provenance)]
507 combine_globals ns_old ns_new -- ns_new is often short
508 = foldr add ns_old ns_new
510 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
513 choose n m | n `beats` m = n
516 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
518 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
519 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
520 is_duplicate (n1,_) (n2,_) = n1 == n2
523 We treat two bindings of a locally-defined name as a duplicate,
524 because they might be two separate, local defns and we want to report
525 and error for that, {\em not} eliminate a duplicate.
527 On the other hand, if you import the same name from two different
528 import statements, we {\em do} want to eliminate the duplicate, not report
531 If a module imports itself then there might be a local defn and an imported
532 defn of the same name; in this case the names will compare as equal, but
533 will still have different provenances.
536 @unQualInScope@ returns a function that takes a @Name@ and tells whether
537 its unqualified name is in scope. This is put as a boolean flag in
538 the @Name@'s provenance to guide whether or not to print the name qualified
542 unQualInScope :: GlobalRdrEnv -> Name -> Bool
546 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
547 Just [(name',_)] -> name == name'
552 %************************************************************************
556 %************************************************************************
559 plusAvail (Avail n1) (Avail n2) = Avail n1
560 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
563 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
566 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
567 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
569 emptyAvailEnv = emptyNameEnv
570 unitAvailEnv :: AvailInfo -> AvailEnv
571 unitAvailEnv a = unitNameEnv (availName a) a
573 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
574 plusAvailEnv = plusNameEnv_C plusAvail
576 availEnvElts = nameEnvElts
578 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
579 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
581 availsToNameSet :: [AvailInfo] -> NameSet
582 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
584 availName :: GenAvailInfo name -> name
585 availName (Avail n) = n
586 availName (AvailTC n _) = n
588 availNames :: GenAvailInfo name -> [name]
589 availNames (Avail n) = [n]
590 availNames (AvailTC n ns) = ns
592 -------------------------------------
593 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
594 addSysAvails avail [] = avail
595 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
597 -------------------------------------
598 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
599 -- Used when building the avails we are going to put in an interface file
600 -- We sort the components to reduce needless wobbling of interfaces
601 rdrAvailInfo (Avail n) = Avail (nameOccName n)
602 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
604 -------------------------------------
605 filterAvail :: RdrNameIE -- Wanted
606 -> AvailInfo -- Available
607 -> Maybe AvailInfo -- Resulting available;
608 -- Nothing if (any of the) wanted stuff isn't there
610 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
611 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
612 | otherwise = Nothing
614 is_wanted name = nameOccName name `elem` wanted_occs
615 sub_names_ok = all (`elem` avail_occs) wanted_occs
616 avail_occs = map nameOccName ns
617 wanted_occs = map rdrNameOcc (want:wants)
619 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
622 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
624 filterAvail (IEVar _) avail@(Avail n) = Just avail
625 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
627 wanted n = nameOccName n == occ
629 -- The second equation happens if we import a class op, thus
631 -- where op is a class operation
633 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
634 -- We don't complain even if the IE says T(..), but
635 -- no constrs/class ops of T are available
636 -- Instead that's caught with a warning by the caller
638 filterAvail ie avail = Nothing
640 -------------------------------------
641 sortAvails :: Avails -> Avails
642 sortAvails avails = sortLt lt avails
644 a1 `lt` a2 = mod1 < mod2 ||
645 (mod1 == mod2 && occ1 < occ2)
649 mod1 = nameModule name1
650 mod2 = nameModule name2
651 occ1 = nameOccName name1
652 occ2 = nameOccName name2
654 -------------------------------------
655 pprAvail :: AvailInfo -> SDoc
656 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
658 ns' -> parens (hsep (punctuate comma (map ppr ns')))
660 pprAvail (Avail n) = ppr n
664 %************************************************************************
666 \subsection{Free variable manipulation}
668 %************************************************************************
672 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
674 (ys, fvs_s) = unzip stuff
676 returnRn (ys, plusFVs fvs_s)
680 %************************************************************************
682 \subsection{Envt utility functions}
684 %************************************************************************
687 warnUnusedModules :: [ModuleName] -> RnM d ()
688 warnUnusedModules mods
689 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
690 if warn then mapRn_ (addWarnRn . unused_mod) mods
693 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
694 text "is imported, but nothing from it is used",
695 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
698 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
699 warnUnusedImports names
700 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
701 if warn then warnUnusedBinds names else returnRn ()
703 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
704 warnUnusedLocalBinds names
705 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
706 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
709 warnUnusedMatches names
710 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
711 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
714 -------------------------
716 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
717 warnUnusedBinds names
718 = mapRn_ warnUnusedGroup groups
720 -- Group by provenance
721 groups = equivClasses cmp names
722 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
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.fst) filtered_names)))]
736 filtered_names = filter reportable names
737 (name1, prov1) = head filtered_names
738 (is_local, def_loc, msg)
740 LocalDef -> (True, getSrcLoc name1, 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))