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(..) )
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` \ (us, cache, ipcache) ->
72 occ = rdrNameOcc rdr_name
73 key = (moduleName mod, occ)
75 case lookupFM cache key of
77 -- A hit in the cache! We are at the binding site of the name, and
78 -- this is the moment when we know all about
79 -- a) the Name's host Module (in particular, which
80 -- package it comes from)
81 -- b) its defining SrcLoc
82 -- So we update this info
85 new_name = setNameModuleAndLoc name mod loc
86 new_cache = addToFM cache key new_name
88 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
89 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
93 -- Build a completely new Name, and put it in the cache
94 -- Even for locally-defined names we use implicitImportProvenance;
95 -- updateProvenances will set it to rights
97 (us', us1) = splitUniqSupply us
98 uniq = uniqFromSupply us1
99 new_name = mkGlobalName uniq mod occ loc
100 new_cache = addToFM cache key new_name
102 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
103 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
107 newGlobalName :: ModuleName -> OccName -> RnM d Name
108 -- Used for *occurrences*. We make a place-holder Name, really just
109 -- to agree on its unique, which gets overwritten when we read in
110 -- the binding occurence later (newTopBinder)
111 -- The place-holder Name doesn't have the right SrcLoc, and its
112 -- Module won't have the right Package either.
114 -- (We have to pass a ModuleName, not a Module, because we may be
115 -- simply looking at an occurrence M.x in an interface file.)
117 -- This means that a renamed program may have incorrect info
118 -- on implicitly-imported occurrences, but the correct info on the
119 -- *binding* declaration. It's the type checker that propagates the
120 -- correct information to all the occurrences.
121 -- Since implicitly-imported names never occur in error messages,
122 -- it doesn't matter that we get the correct info in place till later,
123 -- (but since it affects DLL-ery it does matter that we get it right
125 newGlobalName mod_name occ
126 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
128 key = (mod_name, occ)
130 case lookupFM cache key of
131 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
134 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
135 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
138 (us', us1) = splitUniqSupply us
139 uniq = uniqFromSupply us1
140 mod = mkVanillaModule mod_name
141 name = mkGlobalName uniq mod occ noSrcLoc
142 new_cache = addToFM cache key name
145 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
146 case lookupFM ipcache key of
147 Just name -> returnRn name
148 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
151 (us', us1) = splitUniqSupply us
152 uniq = uniqFromSupply us1
153 name = mkIPName uniq key
154 new_ipcache = addToFM ipcache key name
155 where key = (rdrNameOcc rdr_name)
158 %*********************************************************
160 \subsection{Looking up names}
162 %*********************************************************
164 Looking up a name in the RnEnv.
167 lookupBndrRn rdr_name
168 = getLocalNameEnv `thenRn` \ local_env ->
169 case lookupRdrEnv local_env rdr_name of
170 Just name -> returnRn name
171 Nothing -> lookupTopBndrRn rdr_name
173 lookupTopBndrRn rdr_name
174 = getModeRn `thenRn` \ mode ->
176 InterfaceMode -> lookupIfaceName rdr_name
178 SourceMode -> -- Source mode, so look up a *qualified* version
179 -- of the name, so that we get the right one even
180 -- if there are many with the same occ name
181 -- There must *be* a binding
182 getModuleRn `thenRn` \ mod ->
183 getGlobalNameEnv `thenRn` \ global_env ->
184 lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
186 -- lookupSigOccRn is used for type signatures and pragmas
192 -- It's clear that the 'f' in the signature must refer to A.f
193 -- The Haskell98 report does not stipulate this, but it will!
194 -- So we must treat the 'f' in the signature in the same way
195 -- as the binding occurrence of 'f', using lookupBndrRn
196 lookupSigOccRn :: RdrName -> RnMS Name
197 lookupSigOccRn = lookupBndrRn
199 -- lookupOccRn looks up an occurrence of a RdrName
200 lookupOccRn :: RdrName -> RnMS Name
202 = getLocalNameEnv `thenRn` \ local_env ->
203 case lookupRdrEnv local_env rdr_name of
204 Just name -> returnRn name
205 Nothing -> lookupGlobalOccRn rdr_name
207 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
208 -- environment. It's used only for
209 -- record field names
210 -- class op names in class and instance decls
212 lookupGlobalOccRn rdr_name
213 = getModeRn `thenRn` \ mode ->
215 SourceMode -> getGlobalNameEnv `thenRn` \ global_env ->
216 lookupSrcName global_env rdr_name
218 InterfaceMode -> lookupIfaceName rdr_name
220 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
221 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
222 lookupSrcName global_env rdr_name
223 | isOrig rdr_name -- Can occur in source code too
224 = lookupOrigName rdr_name
227 = case lookupRdrEnv global_env rdr_name of
228 Just [(name,_)] -> returnRn name
229 Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_`
231 Nothing -> failWithRn (mkUnboundName rdr_name)
232 (unknownNameErr rdr_name)
234 lookupOrigName :: RdrName -> RnM d Name
235 lookupOrigName rdr_name
236 = ASSERT( isOrig rdr_name )
237 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
239 lookupIfaceUnqual :: RdrName -> RnM d Name
240 lookupIfaceUnqual rdr_name
241 = ASSERT( isUnqual rdr_name )
242 -- An Unqual is allowed; interface files contain
243 -- unqualified names for locally-defined things, such as
244 -- constructors of a data type.
245 getModuleRn `thenRn ` \ mod ->
246 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
248 lookupIfaceName :: RdrName -> RnM d Name
249 lookupIfaceName rdr_name
250 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
251 | otherwise = lookupOrigName rdr_name
254 @lookupOrigName@ takes an RdrName representing an {\em original}
255 name, and adds it to the occurrence pool so that it'll be loaded
256 later. This is used when language constructs (such as monad
257 comprehensions, overloaded literals, or deriving clauses) require some
258 stuff to be loaded that isn't explicitly mentioned in the code.
260 This doesn't apply in interface mode, where everything is explicit,
261 but we don't check for this case: it does no harm to record an
262 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
263 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
264 calls it at all I think).
266 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
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 :: [(RdrName,SrcLoc)]
300 newLocalsRn rdr_names_w_loc
301 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
303 n = length rdr_names_w_loc
304 (us', us1) = splitUniqSupply us
305 uniqs = uniqsFromSupply n us1
306 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
307 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
310 setNameSupplyRn (us', cache, ipcache) `thenRn_`
314 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
315 -> [(RdrName,SrcLoc)]
316 -> ([Name] -> RnMS a)
318 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
319 = getModeRn `thenRn` \ mode ->
320 getLocalNameEnv `thenRn` \ name_env ->
322 -- Check for duplicate names
323 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
325 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
327 -- Warn about shadowing, but only in source modules
329 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
333 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
335 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
337 setLocalNameEnv new_local_env (enclosed_scope names)
340 check_shadow name_env (rdr_name,loc)
341 = case lookupRdrEnv name_env rdr_name of
342 Nothing -> returnRn ()
343 Just name -> pushSrcLocRn loc $
344 addWarnRn (shadowedNameWarn rdr_name)
346 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
347 -- A specialised variant when renaming stuff from interface
348 -- files (of which there is a lot)
350 -- * no checks for shadowing
352 -- * deal with free vars
353 bindCoreLocalRn rdr_name enclosed_scope
354 = getSrcLocRn `thenRn` \ loc ->
355 getLocalNameEnv `thenRn` \ name_env ->
356 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
358 (us', us1) = splitUniqSupply us
359 uniq = uniqFromSupply us1
360 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
362 setNameSupplyRn (us', cache, ipcache) `thenRn_`
364 new_name_env = extendRdrEnv name_env rdr_name name
366 setLocalNameEnv new_name_env (enclosed_scope name)
368 bindCoreLocalsRn [] thing_inside = thing_inside []
369 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
370 bindCoreLocalsRn 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 bindLocalNamesFV names enclosed_scope
381 = bindLocalNames names $
382 enclosed_scope `thenRn` \ (thing, fvs) ->
383 returnRn (thing, delListFromNameSet fvs names)
386 -------------------------------------
387 bindLocalRn doc rdr_name enclosed_scope
388 = getSrcLocRn `thenRn` \ loc ->
389 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
393 bindLocalsRn doc rdr_names enclosed_scope
394 = getSrcLocRn `thenRn` \ loc ->
395 bindLocatedLocalsRn doc
396 (rdr_names `zip` repeat loc)
399 -- binLocalsFVRn is the same as bindLocalsRn
400 -- except that it deals with free vars
401 bindLocalsFVRn doc rdr_names enclosed_scope
402 = bindLocalsRn doc rdr_names $ \ names ->
403 enclosed_scope names `thenRn` \ (thing, fvs) ->
404 returnRn (thing, delListFromNameSet fvs names)
406 -------------------------------------
407 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
408 -- This tiresome function is used only in rnDecl on InstDecl
409 extendTyVarEnvFVRn tyvars enclosed_scope
410 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
411 returnRn (thing, delListFromNameSet fvs tyvars)
413 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
414 -> ([HsTyVarBndr Name] -> RnMS a)
416 bindTyVarsRn doc_str tyvar_names enclosed_scope
417 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
418 enclosed_scope tyvars
420 -- Gruesome name: return Names as well as HsTyVars
421 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
422 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
424 bindTyVars2Rn doc_str tyvar_names enclosed_scope
425 = getSrcLocRn `thenRn` \ loc ->
427 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
429 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
430 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
432 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
433 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
434 -> RnMS (a, FreeVars)
435 bindTyVarsFVRn doc_str rdr_names enclosed_scope
436 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
437 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
438 returnRn (thing, delListFromNameSet fvs names)
440 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
441 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
442 -> RnMS (a, FreeVars)
443 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
444 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
445 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
446 returnRn (thing, delListFromNameSet fvs names)
448 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
449 -> ([Name] -> RnMS (a, FreeVars))
450 -> RnMS (a, FreeVars)
451 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
452 = getSrcLocRn `thenRn` \ loc ->
454 located_tyvars = [(tv, loc) | tv <- tyvar_names]
456 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
457 enclosed_scope names `thenRn` \ (thing, fvs) ->
458 returnRn (thing, delListFromNameSet fvs names)
461 -------------------------------------
462 checkDupOrQualNames, checkDupNames :: SDoc
463 -> [(RdrName, SrcLoc)]
465 -- Works in any variant of the renamer monad
467 checkDupOrQualNames doc_str rdr_names_w_loc
468 = -- Check for use of qualified names
469 mapRn_ (qualNameErr doc_str) quals `thenRn_`
470 checkDupNames doc_str rdr_names_w_loc
472 quals = filter (isQual . fst) rdr_names_w_loc
474 checkDupNames doc_str rdr_names_w_loc
475 = -- Check for duplicated names in a binding group
476 mapRn_ (dupNamesErr doc_str) dups
478 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
482 %************************************************************************
484 \subsection{GlobalRdrEnv}
486 %************************************************************************
489 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
490 -> Bool -- True <=> want unqualified import
491 -> [AvailInfo] -- What's to be hidden (but only the unqualified
492 -- version is hidden)
493 -> (Name -> Provenance)
494 -> Avails -- Whats imported and how
497 mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails
500 -- Make the name environment. We're talking about a
501 -- single module here, so there must be no name clashes.
502 -- In practice there only ever will be if it's the module
505 -- Add the things that are available
506 gbl_env1 = foldl add_avail emptyRdrEnv avails
508 -- Delete things that are hidden
509 gbl_env2 = foldl del_avail gbl_env1 hides
511 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
512 add_avail env avail = foldl add_name env (availNames avail)
518 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) (name,prov)
519 env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov)
520 occ = nameOccName name
521 prov = mk_provenance name
523 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
525 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
527 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
528 -- Used to construct a GlobalRdrEnv for an interface that we've
529 -- read from a .hi file. We can't construct the original top-level
530 -- environment because we don't have enough info, but we compromise
531 -- by making an environment from its exports
532 mkIfaceGlobalRdrEnv m_avails
533 = foldl add emptyRdrEnv m_avails
535 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True [] (\n -> LocalDef) avails)
539 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
540 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
542 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
543 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
545 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
546 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
548 combine_globals :: [(Name,Provenance)] -- Old
549 -> [(Name,Provenance)] -- New
550 -> [(Name,Provenance)]
551 combine_globals ns_old ns_new -- ns_new is often short
552 = foldr add ns_old ns_new
554 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
557 choose n m | n `beats` m = n
560 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
562 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
563 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
564 is_duplicate (n1,_) (n2,_) = n1 == n2
567 We treat two bindings of a locally-defined name as a duplicate,
568 because they might be two separate, local defns and we want to report
569 and error for that, {\em not} eliminate a duplicate.
571 On the other hand, if you import the same name from two different
572 import statements, we {\em do} want to eliminate the duplicate, not report
575 If a module imports itself then there might be a local defn and an imported
576 defn of the same name; in this case the names will compare as equal, but
577 will still have different provenances.
580 @unQualInScope@ returns a function that takes a @Name@ and tells whether
581 its unqualified name is in scope. This is put as a boolean flag in
582 the @Name@'s provenance to guide whether or not to print the name qualified
586 unQualInScope :: GlobalRdrEnv -> Name -> Bool
588 = (`elemNameSet` unqual_names)
590 unqual_names :: NameSet
591 unqual_names = foldRdrEnv add emptyNameSet env
592 add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
593 add _ _ unquals = unquals
597 %************************************************************************
601 %************************************************************************
604 plusAvail (Avail n1) (Avail n2) = Avail n1
605 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
608 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
611 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
612 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
614 emptyAvailEnv = emptyNameEnv
615 unitAvailEnv :: AvailInfo -> AvailEnv
616 unitAvailEnv a = unitNameEnv (availName a) a
618 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
619 plusAvailEnv = plusNameEnv_C plusAvail
621 availEnvElts = nameEnvElts
623 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
624 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
626 availsToNameSet :: [AvailInfo] -> NameSet
627 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
629 availName :: GenAvailInfo name -> name
630 availName (Avail n) = n
631 availName (AvailTC n _) = n
633 availNames :: GenAvailInfo name -> [name]
634 availNames (Avail n) = [n]
635 availNames (AvailTC n ns) = ns
637 -------------------------------------
638 filterAvail :: RdrNameIE -- Wanted
639 -> AvailInfo -- Available
640 -> Maybe AvailInfo -- Resulting available;
641 -- Nothing if (any of the) wanted stuff isn't there
643 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
644 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
645 | otherwise = Nothing
647 is_wanted name = nameOccName name `elem` wanted_occs
648 sub_names_ok = all (`elem` avail_occs) wanted_occs
649 avail_occs = map nameOccName ns
650 wanted_occs = map rdrNameOcc (want:wants)
652 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
655 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
657 filterAvail (IEVar _) avail@(Avail n) = Just avail
658 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
660 wanted n = nameOccName n == occ
662 -- The second equation happens if we import a class op, thus
664 -- where op is a class operation
666 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
667 -- We don't complain even if the IE says T(..), but
668 -- no constrs/class ops of T are available
669 -- Instead that's caught with a warning by the caller
671 filterAvail ie avail = Nothing
673 -------------------------------------
674 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
675 -- Group by module and sort by occurrence
676 -- This keeps the list in canonical order
677 groupAvails this_mod avails
678 = [ (mkSysModuleNameFS fs, sortLt lt avails)
679 | (fs,avails) <- fmToList groupFM
682 groupFM :: FiniteMap FastString Avails
683 -- Deliberately use the FastString so we
684 -- get a canonical ordering
685 groupFM = foldl add emptyFM avails
687 add env avail = addToFM_C combine env mod_fs [avail']
689 mod_fs = moduleNameFS (moduleName avail_mod)
690 avail_mod = case nameModule_maybe (availName avail) of
693 combine old _ = avail':old
694 avail' = sortAvail avail
696 a1 `lt` a2 = occ1 < occ2
698 occ1 = nameOccName (availName a1)
699 occ2 = nameOccName (availName a2)
701 sortAvail :: AvailInfo -> AvailInfo
702 -- Sort the sub-names into canonical order.
703 -- The canonical order has the "main name" at the beginning
704 -- (if it's there at all)
705 sortAvail (Avail n) = Avail n
706 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
707 | otherwise = AvailTC n ( sortLt lt ns)
709 n1 `lt` n2 = nameOccName n1 < nameOccName n2
713 %************************************************************************
715 \subsection{Free variable manipulation}
717 %************************************************************************
721 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
723 (ys, fvs_s) = unzip stuff
725 returnRn (ys, plusFVs fvs_s)
729 %************************************************************************
731 \subsection{Envt utility functions}
733 %************************************************************************
736 warnUnusedModules :: [ModuleName] -> RnM d ()
737 warnUnusedModules mods
738 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
739 if warn then mapRn_ (addWarnRn . unused_mod) mods
742 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
743 text "is imported, but nothing from it is used",
744 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
747 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
748 warnUnusedImports names
749 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
750 if warn then warnUnusedBinds names else returnRn ()
752 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
753 warnUnusedLocalBinds names
754 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
755 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
758 warnUnusedMatches names
759 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
760 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
763 -------------------------
765 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
766 warnUnusedBinds names
767 = mapRn_ warnUnusedGroup groups
769 -- Group by provenance
770 groups = equivClasses cmp names
771 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
774 -------------------------
776 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
777 warnUnusedGroup names
778 | null filtered_names = returnRn ()
779 | not is_local = returnRn ()
781 = pushSrcLocRn def_loc $
783 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
785 filtered_names = filter reportable names
786 (name1, prov1) = head filtered_names
787 (is_local, def_loc, msg)
789 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
791 NonLocalDef (UserImport mod loc _)
792 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
794 reportable (name,_) = case occNameUserString (nameOccName name) of
797 -- Haskell 98 encourages compilers to suppress warnings about
798 -- unused names in a pattern if they start with "_".
802 addNameClashErrRn rdr_name (np1:nps)
803 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
804 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
806 msg1 = ptext SLIT("either") <+> mk_ref np1
807 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
808 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
810 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
811 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
812 4 (vcat [ppr how_in_scope1,
815 shadowedNameWarn shadow
816 = hsep [ptext SLIT("This binding for"),
818 ptext SLIT("shadows an existing binding")]
821 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
823 flavour = occNameFlavour (rdrNameOcc name)
825 qualNameErr descriptor (name,loc)
827 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
832 dupNamesErr descriptor ((name,loc) : dup_things)
834 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
836 (ptext SLIT("in") <+> descriptor))