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, isOrig,
14 mkRdrUnqual, mkRdrQual, qualifyRdrName, lookupRdrEnv, foldRdrEnv
16 import HsTypes ( hsTyVarName, replaceTyVarName )
17 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
18 ImportReason(..), GlobalRdrEnv, AvailEnv,
19 AvailInfo, Avails, GenAvailInfo(..), NameSupply(..) )
21 import Name ( Name, NamedThing(..),
23 mkLocalName, mkGlobalName,
24 mkIPName, nameOccName, nameModule_maybe,
27 import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
29 import OccName ( OccName, occNameUserString, occNameFlavour )
30 import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS )
33 import SrcLoc ( SrcLoc, noSrcLoc )
35 import ListSetOps ( removeDups, equivClasses )
36 import Util ( sortLt )
38 import PrelNames ( mkUnboundName )
40 import FastString ( FastString )
43 %*********************************************************
45 \subsection{Making new names}
47 %*********************************************************
50 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
51 -- newTopBinder puts into the cache the binder with the
52 -- module information set correctly. When the decl is later renamed,
53 -- the binding site will thereby get the correct module.
54 -- There maybe occurrences that don't have the correct Module, but
55 -- by the typechecker will propagate the binding definition to all
56 -- the occurrences, so that doesn't matter
58 newTopBinder mod rdr_name loc
59 = -- First check the cache
60 -- traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_`
62 -- There should never be a qualified name in a binding position (except in instance decls)
63 -- The parser doesn't check this because the same parser parses instance decls
64 (if isQual rdr_name then
65 qualNameErr (text "its declaration") (rdr_name,loc)
70 getNameSupplyRn `thenRn` \ name_supply ->
72 occ = rdrNameOcc rdr_name
73 key = (moduleName mod, occ)
74 cache = nsNames name_supply
76 case lookupFM cache key of
78 -- A hit in the cache! We are at the binding site of the name, and
79 -- this is the moment when we know all about
80 -- a) the Name's host Module (in particular, which
81 -- package it comes from)
82 -- b) its defining SrcLoc
83 -- So we update this info
86 new_name = setNameModuleAndLoc name mod loc
87 new_cache = addToFM cache key new_name
89 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
90 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
94 -- Build a completely new Name, and put it in the cache
95 -- Even for locally-defined names we use implicitImportProvenance;
96 -- updateProvenances will set it to rights
98 (us', us1) = splitUniqSupply (nsUniqs name_supply)
99 uniq = uniqFromSupply us1
100 new_name = mkGlobalName uniq mod occ loc
101 new_cache = addToFM cache key new_name
103 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
104 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
108 newGlobalName :: ModuleName -> OccName -> RnM d Name
109 -- Used for *occurrences*. We make a place-holder Name, really just
110 -- to agree on its unique, which gets overwritten when we read in
111 -- the binding occurence later (newTopBinder)
112 -- The place-holder Name doesn't have the right SrcLoc, and its
113 -- Module won't have the right Package either.
115 -- (We have to pass a ModuleName, not a Module, because we may be
116 -- simply looking at an occurrence M.x in an interface file.)
118 -- This means that a renamed program may have incorrect info
119 -- on implicitly-imported occurrences, but the correct info on the
120 -- *binding* declaration. It's the type checker that propagates the
121 -- correct information to all the occurrences.
122 -- Since implicitly-imported names never occur in error messages,
123 -- it doesn't matter that we get the correct info in place till later,
124 -- (but since it affects DLL-ery it does matter that we get it right
126 newGlobalName mod_name occ
127 = getNameSupplyRn `thenRn` \ name_supply ->
129 key = (mod_name, occ)
130 cache = nsNames name_supply
132 case lookupFM cache key of
133 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
136 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
137 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
140 (us', us1) = splitUniqSupply (nsUniqs name_supply)
141 uniq = uniqFromSupply us1
142 mod = mkVanillaModule mod_name
143 name = mkGlobalName uniq mod occ noSrcLoc
144 new_cache = addToFM cache key name
147 = getNameSupplyRn `thenRn` \ name_supply ->
149 ipcache = nsIPs name_supply
151 case lookupFM ipcache key of
152 Just name -> returnRn name
153 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
156 (us', us1) = splitUniqSupply (nsUniqs name_supply)
157 uniq = uniqFromSupply us1
158 name = mkIPName uniq key
159 new_ipcache = addToFM ipcache key name
160 where key = (rdrNameOcc rdr_name)
163 %*********************************************************
165 \subsection{Looking up names}
167 %*********************************************************
169 Looking up a name in the RnEnv.
172 lookupBndrRn rdr_name
173 = getLocalNameEnv `thenRn` \ local_env ->
174 case lookupRdrEnv local_env rdr_name of
175 Just name -> returnRn name
176 Nothing -> lookupTopBndrRn rdr_name
178 lookupTopBndrRn rdr_name
179 = getModeRn `thenRn` \ mode ->
181 InterfaceMode -> lookupIfaceName rdr_name
183 SourceMode -> -- Source mode, so look up a *qualified* version
184 -- of the name, so that we get the right one even
185 -- if there are many with the same occ name
186 -- There must *be* a binding
187 getModuleRn `thenRn` \ mod ->
188 getGlobalNameEnv `thenRn` \ global_env ->
189 lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
191 -- lookupSigOccRn is used for type signatures and pragmas
197 -- It's clear that the 'f' in the signature must refer to A.f
198 -- The Haskell98 report does not stipulate this, but it will!
199 -- So we must treat the 'f' in the signature in the same way
200 -- as the binding occurrence of 'f', using lookupBndrRn
201 lookupSigOccRn :: RdrName -> RnMS Name
202 lookupSigOccRn = lookupBndrRn
204 -- lookupOccRn looks up an occurrence of a RdrName
205 lookupOccRn :: RdrName -> RnMS Name
207 = getLocalNameEnv `thenRn` \ local_env ->
208 case lookupRdrEnv local_env rdr_name of
209 Just name -> returnRn name
210 Nothing -> lookupGlobalOccRn rdr_name
212 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
213 -- environment. It's used only for
214 -- record field names
215 -- class op names in class and instance decls
217 lookupGlobalOccRn rdr_name
218 = getModeRn `thenRn` \ mode ->
220 SourceMode -> getGlobalNameEnv `thenRn` \ global_env ->
221 lookupSrcName global_env rdr_name
223 InterfaceMode -> lookupIfaceName rdr_name
225 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
226 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
227 lookupSrcName global_env rdr_name
228 | isOrig rdr_name -- Can occur in source code too
229 = lookupOrigName rdr_name
232 = case lookupRdrEnv global_env rdr_name of
233 Just [(name,_)] -> returnRn name
234 Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_`
236 Nothing -> failWithRn (mkUnboundName rdr_name)
237 (unknownNameErr rdr_name)
239 lookupOrigName :: RdrName -> RnM d Name
240 lookupOrigName rdr_name
241 = ASSERT( isOrig rdr_name )
242 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
244 lookupIfaceUnqual :: RdrName -> RnM d Name
245 lookupIfaceUnqual rdr_name
246 = ASSERT( isUnqual rdr_name )
247 -- An Unqual is allowed; interface files contain
248 -- unqualified names for locally-defined things, such as
249 -- constructors of a data type.
250 getModuleRn `thenRn ` \ mod ->
251 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
253 lookupIfaceName :: RdrName -> RnM d Name
254 lookupIfaceName rdr_name
255 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
256 | otherwise = lookupOrigName rdr_name
259 @lookupOrigName@ takes an RdrName representing an {\em original}
260 name, and adds it to the occurrence pool so that it'll be loaded
261 later. This is used when language constructs (such as monad
262 comprehensions, overloaded literals, or deriving clauses) require some
263 stuff to be loaded that isn't explicitly mentioned in the code.
265 This doesn't apply in interface mode, where everything is explicit,
266 but we don't check for this case: it does no harm to record an
267 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
268 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
269 calls it at all I think).
271 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
275 lookupOrigNames :: [RdrName] -> RnM d NameSet
276 lookupOrigNames rdr_names
277 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
278 returnRn (mkNameSet names)
281 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
282 It ensures that the module is set correctly in the name cache, and sets the provenance
283 on the returned name too. The returned name will end up actually in the type, class,
287 lookupSysBinder rdr_name
288 = ASSERT( isUnqual rdr_name )
289 getModuleRn `thenRn` \ mod ->
290 getSrcLocRn `thenRn` \ loc ->
291 newTopBinder mod rdr_name loc
296 %*********************************************************
300 %*********************************************************
303 newLocalsRn :: [(RdrName,SrcLoc)]
305 newLocalsRn rdr_names_w_loc
306 = getNameSupplyRn `thenRn` \ name_supply ->
308 n = length rdr_names_w_loc
309 (us', us1) = splitUniqSupply (nsUniqs name_supply)
310 uniqs = uniqsFromSupply n us1
311 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
312 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
315 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
319 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
320 -> [(RdrName,SrcLoc)]
321 -> ([Name] -> RnMS a)
323 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
324 = getModeRn `thenRn` \ mode ->
325 getLocalNameEnv `thenRn` \ name_env ->
327 -- Check for duplicate names
328 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
330 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
332 -- Warn about shadowing, but only in source modules
334 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
338 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
340 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
342 setLocalNameEnv new_local_env (enclosed_scope names)
345 check_shadow name_env (rdr_name,loc)
346 = case lookupRdrEnv name_env rdr_name of
347 Nothing -> returnRn ()
348 Just name -> pushSrcLocRn loc $
349 addWarnRn (shadowedNameWarn rdr_name)
351 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
352 -- A specialised variant when renaming stuff from interface
353 -- files (of which there is a lot)
355 -- * no checks for shadowing
357 -- * deal with free vars
358 bindCoreLocalRn rdr_name enclosed_scope
359 = getSrcLocRn `thenRn` \ loc ->
360 getLocalNameEnv `thenRn` \ name_env ->
361 getNameSupplyRn `thenRn` \ name_supply ->
363 (us', us1) = splitUniqSupply (nsUniqs name_supply)
364 uniq = uniqFromSupply us1
365 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
367 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
369 new_name_env = extendRdrEnv name_env rdr_name name
371 setLocalNameEnv new_name_env (enclosed_scope name)
373 bindCoreLocalsRn [] thing_inside = thing_inside []
374 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
375 bindCoreLocalsRn bs $ \ names' ->
376 thing_inside (name':names')
378 bindLocalNames names enclosed_scope
379 = getLocalNameEnv `thenRn` \ name_env ->
380 setLocalNameEnv (addListToRdrEnv name_env pairs)
383 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
385 bindLocalNamesFV names enclosed_scope
386 = bindLocalNames names $
387 enclosed_scope `thenRn` \ (thing, fvs) ->
388 returnRn (thing, delListFromNameSet fvs names)
391 -------------------------------------
392 bindLocalRn doc rdr_name enclosed_scope
393 = getSrcLocRn `thenRn` \ loc ->
394 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
398 bindLocalsRn doc rdr_names enclosed_scope
399 = getSrcLocRn `thenRn` \ loc ->
400 bindLocatedLocalsRn doc
401 (rdr_names `zip` repeat loc)
404 -- binLocalsFVRn is the same as bindLocalsRn
405 -- except that it deals with free vars
406 bindLocalsFVRn doc rdr_names enclosed_scope
407 = bindLocalsRn doc rdr_names $ \ names ->
408 enclosed_scope names `thenRn` \ (thing, fvs) ->
409 returnRn (thing, delListFromNameSet fvs names)
411 -------------------------------------
412 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
413 -- This tiresome function is used only in rnSourceDecl on InstDecl
414 extendTyVarEnvFVRn tyvars enclosed_scope
415 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
416 returnRn (thing, delListFromNameSet fvs tyvars)
418 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
419 -> ([HsTyVarBndr Name] -> RnMS a)
421 bindTyVarsRn doc_str tyvar_names enclosed_scope
422 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
423 enclosed_scope tyvars
425 -- Gruesome name: return Names as well as HsTyVars
426 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
427 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
429 bindTyVars2Rn doc_str tyvar_names enclosed_scope
430 = getSrcLocRn `thenRn` \ loc ->
432 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
434 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
435 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
437 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
438 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
439 -> RnMS (a, FreeVars)
440 bindTyVarsFVRn doc_str rdr_names enclosed_scope
441 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
442 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
443 returnRn (thing, delListFromNameSet fvs names)
445 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
446 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
447 -> RnMS (a, FreeVars)
448 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
449 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
450 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
451 returnRn (thing, delListFromNameSet fvs names)
453 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
454 -> ([Name] -> RnMS (a, FreeVars))
455 -> RnMS (a, FreeVars)
456 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
457 = getSrcLocRn `thenRn` \ loc ->
459 located_tyvars = [(tv, loc) | tv <- tyvar_names]
461 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
462 enclosed_scope names `thenRn` \ (thing, fvs) ->
463 returnRn (thing, delListFromNameSet fvs names)
466 -------------------------------------
467 checkDupOrQualNames, checkDupNames :: SDoc
468 -> [(RdrName, SrcLoc)]
470 -- Works in any variant of the renamer monad
472 checkDupOrQualNames doc_str rdr_names_w_loc
473 = -- Check for use of qualified names
474 mapRn_ (qualNameErr doc_str) quals `thenRn_`
475 checkDupNames doc_str rdr_names_w_loc
477 quals = filter (isQual . fst) rdr_names_w_loc
479 checkDupNames doc_str rdr_names_w_loc
480 = -- Check for duplicated names in a binding group
481 mapRn_ (dupNamesErr doc_str) dups
483 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
487 %************************************************************************
489 \subsection{GlobalRdrEnv}
491 %************************************************************************
494 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
495 -> Bool -- True <=> want unqualified import
496 -> Bool -- True <=> want qualified import
497 -> [AvailInfo] -- What's to be hidden (but only the unqualified
498 -- version is hidden)
499 -> (Name -> Provenance)
500 -> Avails -- Whats imported and how
503 mkGlobalRdrEnv this_mod unqual_imp qual_imp hides mk_provenance avails
506 -- Make the name environment. We're talking about a
507 -- single module here, so there must be no name clashes.
508 -- In practice there only ever will be if it's the module
511 -- Add the things that are available
512 gbl_env1 = foldl add_avail emptyRdrEnv avails
514 -- Delete things that are hidden
515 gbl_env2 = foldl del_avail gbl_env1 hides
517 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
518 add_avail env avail = foldl add_name env (availNames avail)
521 | qual_imp && unqual_imp = env3
526 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) (name,prov)
527 env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) (name,prov)
528 env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov)
529 occ = nameOccName name
530 prov = mk_provenance name
532 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
534 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
536 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
537 -- Used to construct a GlobalRdrEnv for an interface that we've
538 -- read from a .hi file. We can't construct the original top-level
539 -- environment because we don't have enough info, but we compromise
540 -- by making an environment from its exports
541 mkIfaceGlobalRdrEnv m_avails
542 = foldl add emptyRdrEnv m_avails
544 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False [] (\n -> LocalDef) avails)
548 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
549 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
551 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
552 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
554 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
555 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
557 combine_globals :: [(Name,Provenance)] -- Old
558 -> [(Name,Provenance)] -- New
559 -> [(Name,Provenance)]
560 combine_globals ns_old ns_new -- ns_new is often short
561 = foldr add ns_old ns_new
563 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
566 choose n m | n `beats` m = n
569 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
571 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
572 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
573 is_duplicate (n1,_) (n2,_) = n1 == n2
576 We treat two bindings of a locally-defined name as a duplicate,
577 because they might be two separate, local defns and we want to report
578 and error for that, {\em not} eliminate a duplicate.
580 On the other hand, if you import the same name from two different
581 import statements, we {\em do} want to eliminate the duplicate, not report
584 If a module imports itself then there might be a local defn and an imported
585 defn of the same name; in this case the names will compare as equal, but
586 will still have different provenances.
589 @unQualInScope@ returns a function that takes a @Name@ and tells whether
590 its unqualified name is in scope. This is put as a boolean flag in
591 the @Name@'s provenance to guide whether or not to print the name qualified
595 unQualInScope :: GlobalRdrEnv -> Name -> Bool
597 = (`elemNameSet` unqual_names)
599 unqual_names :: NameSet
600 unqual_names = foldRdrEnv add emptyNameSet env
601 add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
602 add _ _ unquals = unquals
606 %************************************************************************
610 %************************************************************************
613 plusAvail (Avail n1) (Avail n2) = Avail n1
614 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
617 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
620 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
621 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
623 emptyAvailEnv = emptyNameEnv
624 unitAvailEnv :: AvailInfo -> AvailEnv
625 unitAvailEnv a = unitNameEnv (availName a) a
627 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
628 plusAvailEnv = plusNameEnv_C plusAvail
630 availEnvElts = nameEnvElts
632 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
633 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
635 availsToNameSet :: [AvailInfo] -> NameSet
636 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
638 availName :: GenAvailInfo name -> name
639 availName (Avail n) = n
640 availName (AvailTC n _) = n
642 availNames :: GenAvailInfo name -> [name]
643 availNames (Avail n) = [n]
644 availNames (AvailTC n ns) = ns
646 -------------------------------------
647 filterAvail :: RdrNameIE -- Wanted
648 -> AvailInfo -- Available
649 -> Maybe AvailInfo -- Resulting available;
650 -- Nothing if (any of the) wanted stuff isn't there
652 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
653 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
654 | otherwise = Nothing
656 is_wanted name = nameOccName name `elem` wanted_occs
657 sub_names_ok = all (`elem` avail_occs) wanted_occs
658 avail_occs = map nameOccName ns
659 wanted_occs = map rdrNameOcc (want:wants)
661 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
664 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
666 filterAvail (IEVar _) avail@(Avail n) = Just avail
667 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
669 wanted n = nameOccName n == occ
671 -- The second equation happens if we import a class op, thus
673 -- where op is a class operation
675 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
676 -- We don't complain even if the IE says T(..), but
677 -- no constrs/class ops of T are available
678 -- Instead that's caught with a warning by the caller
680 filterAvail ie avail = Nothing
682 -------------------------------------
683 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
684 -- Group by module and sort by occurrence
685 -- This keeps the list in canonical order
686 groupAvails this_mod avails
687 = [ (mkSysModuleNameFS fs, sortLt lt avails)
688 | (fs,avails) <- fmToList groupFM
691 groupFM :: FiniteMap FastString Avails
692 -- Deliberately use the FastString so we
693 -- get a canonical ordering
694 groupFM = foldl add emptyFM avails
696 add env avail = addToFM_C combine env mod_fs [avail']
698 mod_fs = moduleNameFS (moduleName avail_mod)
699 avail_mod = case nameModule_maybe (availName avail) of
702 combine old _ = avail':old
703 avail' = sortAvail avail
705 a1 `lt` a2 = occ1 < occ2
707 occ1 = nameOccName (availName a1)
708 occ2 = nameOccName (availName a2)
710 sortAvail :: AvailInfo -> AvailInfo
711 -- Sort the sub-names into canonical order.
712 -- The canonical order has the "main name" at the beginning
713 -- (if it's there at all)
714 sortAvail (Avail n) = Avail n
715 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
716 | otherwise = AvailTC n ( sortLt lt ns)
718 n1 `lt` n2 = nameOccName n1 < nameOccName n2
722 %************************************************************************
724 \subsection{Free variable manipulation}
726 %************************************************************************
730 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
732 (ys, fvs_s) = unzip stuff
734 returnRn (ys, plusFVs fvs_s)
738 %************************************************************************
740 \subsection{Envt utility functions}
742 %************************************************************************
745 warnUnusedModules :: [ModuleName] -> RnM d ()
746 warnUnusedModules mods
747 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
748 if warn then mapRn_ (addWarnRn . unused_mod) mods
751 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
752 text "is imported, but nothing from it is used",
753 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
756 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
757 warnUnusedImports names
758 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
759 if warn then warnUnusedBinds names else returnRn ()
761 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
762 warnUnusedLocalBinds names
763 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
764 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
767 warnUnusedMatches names
768 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
769 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
772 -------------------------
774 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
775 warnUnusedBinds names
776 = mapRn_ warnUnusedGroup groups
778 -- Group by provenance
779 groups = equivClasses cmp names
780 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
783 -------------------------
785 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
786 warnUnusedGroup names
787 | null filtered_names = returnRn ()
788 | not is_local = returnRn ()
790 = pushSrcLocRn def_loc $
792 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
794 filtered_names = filter reportable names
795 (name1, prov1) = head filtered_names
796 (is_local, def_loc, msg)
798 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
800 NonLocalDef (UserImport mod loc _)
801 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
803 reportable (name,_) = case occNameUserString (nameOccName name) of
806 -- Haskell 98 encourages compilers to suppress warnings about
807 -- unused names in a pattern if they start with "_".
811 addNameClashErrRn rdr_name (np1:nps)
812 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
813 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
815 msg1 = ptext SLIT("either") <+> mk_ref np1
816 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
817 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
819 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
820 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
821 4 (vcat [ppr how_in_scope1,
824 shadowedNameWarn shadow
825 = hsep [ptext SLIT("This binding for"),
827 ptext SLIT("shadows an existing binding")]
830 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
832 flavour = occNameFlavour (rdrNameOcc name)
834 qualNameErr descriptor (name,loc)
836 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
841 dupNamesErr descriptor ((name,loc) : dup_things)
843 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
845 (ptext SLIT("in") <+> descriptor))