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 rnDecl 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 -> [AvailInfo] -- What's to be hidden (but only the unqualified
497 -- version is hidden)
498 -> (Name -> Provenance)
499 -> Avails -- Whats imported and how
502 mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails
505 -- Make the name environment. We're talking about a
506 -- single module here, so there must be no name clashes.
507 -- In practice there only ever will be if it's the module
510 -- Add the things that are available
511 gbl_env1 = foldl add_avail emptyRdrEnv avails
513 -- Delete things that are hidden
514 gbl_env2 = foldl del_avail gbl_env1 hides
516 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
517 add_avail env avail = foldl add_name env (availNames avail)
523 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) (name,prov)
524 env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov)
525 occ = nameOccName name
526 prov = mk_provenance name
528 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
530 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
532 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
533 -- Used to construct a GlobalRdrEnv for an interface that we've
534 -- read from a .hi file. We can't construct the original top-level
535 -- environment because we don't have enough info, but we compromise
536 -- by making an environment from its exports
537 mkIfaceGlobalRdrEnv m_avails
538 = foldl add emptyRdrEnv m_avails
540 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True [] (\n -> LocalDef) avails)
544 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
545 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
547 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
548 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
550 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
551 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
553 combine_globals :: [(Name,Provenance)] -- Old
554 -> [(Name,Provenance)] -- New
555 -> [(Name,Provenance)]
556 combine_globals ns_old ns_new -- ns_new is often short
557 = foldr add ns_old ns_new
559 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
562 choose n m | n `beats` m = n
565 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
567 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
568 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
569 is_duplicate (n1,_) (n2,_) = n1 == n2
572 We treat two bindings of a locally-defined name as a duplicate,
573 because they might be two separate, local defns and we want to report
574 and error for that, {\em not} eliminate a duplicate.
576 On the other hand, if you import the same name from two different
577 import statements, we {\em do} want to eliminate the duplicate, not report
580 If a module imports itself then there might be a local defn and an imported
581 defn of the same name; in this case the names will compare as equal, but
582 will still have different provenances.
585 @unQualInScope@ returns a function that takes a @Name@ and tells whether
586 its unqualified name is in scope. This is put as a boolean flag in
587 the @Name@'s provenance to guide whether or not to print the name qualified
591 unQualInScope :: GlobalRdrEnv -> Name -> Bool
593 = (`elemNameSet` unqual_names)
595 unqual_names :: NameSet
596 unqual_names = foldRdrEnv add emptyNameSet env
597 add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
598 add _ _ unquals = unquals
602 %************************************************************************
606 %************************************************************************
609 plusAvail (Avail n1) (Avail n2) = Avail n1
610 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
613 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
616 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
617 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
619 emptyAvailEnv = emptyNameEnv
620 unitAvailEnv :: AvailInfo -> AvailEnv
621 unitAvailEnv a = unitNameEnv (availName a) a
623 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
624 plusAvailEnv = plusNameEnv_C plusAvail
626 availEnvElts = nameEnvElts
628 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
629 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
631 availsToNameSet :: [AvailInfo] -> NameSet
632 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
634 availName :: GenAvailInfo name -> name
635 availName (Avail n) = n
636 availName (AvailTC n _) = n
638 availNames :: GenAvailInfo name -> [name]
639 availNames (Avail n) = [n]
640 availNames (AvailTC n ns) = ns
642 -------------------------------------
643 filterAvail :: RdrNameIE -- Wanted
644 -> AvailInfo -- Available
645 -> Maybe AvailInfo -- Resulting available;
646 -- Nothing if (any of the) wanted stuff isn't there
648 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
649 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
650 | otherwise = Nothing
652 is_wanted name = nameOccName name `elem` wanted_occs
653 sub_names_ok = all (`elem` avail_occs) wanted_occs
654 avail_occs = map nameOccName ns
655 wanted_occs = map rdrNameOcc (want:wants)
657 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
660 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
662 filterAvail (IEVar _) avail@(Avail n) = Just avail
663 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
665 wanted n = nameOccName n == occ
667 -- The second equation happens if we import a class op, thus
669 -- where op is a class operation
671 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
672 -- We don't complain even if the IE says T(..), but
673 -- no constrs/class ops of T are available
674 -- Instead that's caught with a warning by the caller
676 filterAvail ie avail = Nothing
678 -------------------------------------
679 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
680 -- Group by module and sort by occurrence
681 -- This keeps the list in canonical order
682 groupAvails this_mod avails
683 = [ (mkSysModuleNameFS fs, sortLt lt avails)
684 | (fs,avails) <- fmToList groupFM
687 groupFM :: FiniteMap FastString Avails
688 -- Deliberately use the FastString so we
689 -- get a canonical ordering
690 groupFM = foldl add emptyFM avails
692 add env avail = addToFM_C combine env mod_fs [avail']
694 mod_fs = moduleNameFS (moduleName avail_mod)
695 avail_mod = case nameModule_maybe (availName avail) of
698 combine old _ = avail':old
699 avail' = sortAvail avail
701 a1 `lt` a2 = occ1 < occ2
703 occ1 = nameOccName (availName a1)
704 occ2 = nameOccName (availName a2)
706 sortAvail :: AvailInfo -> AvailInfo
707 -- Sort the sub-names into canonical order.
708 -- The canonical order has the "main name" at the beginning
709 -- (if it's there at all)
710 sortAvail (Avail n) = Avail n
711 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
712 | otherwise = AvailTC n ( sortLt lt ns)
714 n1 `lt` n2 = nameOccName n1 < nameOccName n2
718 %************************************************************************
720 \subsection{Free variable manipulation}
722 %************************************************************************
726 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
728 (ys, fvs_s) = unzip stuff
730 returnRn (ys, plusFVs fvs_s)
734 %************************************************************************
736 \subsection{Envt utility functions}
738 %************************************************************************
741 warnUnusedModules :: [ModuleName] -> RnM d ()
742 warnUnusedModules mods
743 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
744 if warn then mapRn_ (addWarnRn . unused_mod) mods
747 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
748 text "is imported, but nothing from it is used",
749 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
752 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
753 warnUnusedImports names
754 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
755 if warn then warnUnusedBinds names else returnRn ()
757 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
758 warnUnusedLocalBinds names
759 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
760 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
763 warnUnusedMatches names
764 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
765 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
768 -------------------------
770 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
771 warnUnusedBinds names
772 = mapRn_ warnUnusedGroup groups
774 -- Group by provenance
775 groups = equivClasses cmp names
776 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
779 -------------------------
781 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
782 warnUnusedGroup names
783 | null filtered_names = returnRn ()
784 | not is_local = returnRn ()
786 = pushSrcLocRn def_loc $
788 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
790 filtered_names = filter reportable names
791 (name1, prov1) = head filtered_names
792 (is_local, def_loc, msg)
794 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
796 NonLocalDef (UserImport mod loc _)
797 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
799 reportable (name,_) = case occNameUserString (nameOccName name) of
802 -- Haskell 98 encourages compilers to suppress warnings about
803 -- unused names in a pattern if they start with "_".
807 addNameClashErrRn rdr_name (np1:nps)
808 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
809 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
811 msg1 = ptext SLIT("either") <+> mk_ref np1
812 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
813 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
815 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
816 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
817 4 (vcat [ppr how_in_scope1,
820 shadowedNameWarn shadow
821 = hsep [ptext SLIT("This binding for"),
823 ptext SLIT("shadows an existing binding")]
826 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
828 flavour = occNameFlavour (rdrNameOcc name)
830 qualNameErr descriptor (name,loc)
832 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
837 dupNamesErr descriptor ((name,loc) : dup_things)
839 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
841 (ptext SLIT("in") <+> descriptor))