2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnEnv]{Environment manipulation for the renamer monad}
7 module RnEnv where -- Export everything
9 #include "HsVersions.h"
11 import CmdLineOpts ( opt_WarnNameShadowing, opt_WarnUnusedMatches,
12 opt_WarnUnusedBinds, opt_WarnUnusedImports )
14 import RdrHsSyn ( RdrNameIE )
15 import RnHsSyn ( RenamedHsType )
16 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
17 mkRdrUnqual, qualifyRdrName
19 import HsTypes ( getTyVarName, replaceTyVarName )
22 import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
23 ImportReason(..), getSrcLoc,
24 mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
25 mkIPName, isWiredInName, hasBetterProv,
26 nameOccName, setNameModule, nameModule,
27 pprOccName, isLocallyDefined, nameUnique, nameOccName,
28 setNameProvenance, getNameProvenance, pprNameProvenance
31 import OccName ( OccName,
32 mkDFunOcc, occNameUserString, occNameString,
35 import TysWiredIn ( listTyCon )
36 import Type ( funTyCon )
37 import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName )
38 import TyCon ( TyCon )
40 import Unique ( Unique, Uniquable(..) )
42 import SrcLoc ( SrcLoc, noSrcLoc )
44 import Util ( removeDups, equivClasses, thenCmp, sortLt )
50 %*********************************************************
52 \subsection{Making new names}
54 %*********************************************************
57 implicitImportProvenance = NonLocalDef ImplicitImport False
59 newTopBinder :: Module -> OccName -> RnM d Name
61 = -- First check the cache
62 traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
64 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
66 key = (moduleName mod, occ)
68 case lookupFM cache key of
70 -- A hit in the cache! We are at the binding site of the name, which is
71 -- the time we know all about the Name's host Module (in particular, which
72 -- package it comes from), so update the Module in the name.
73 -- But otherwise *leave the Provenance alone*:
75 -- * For imported names, the Provenance may already be correct.
76 -- e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show
77 -- to 'UserImport from Prelude'. Note that we havn't yet opened PrelShow.hi
78 -- Later we find we really need PrelShow.Show, so we open PrelShow.hi, and
79 -- that's when we find the binding occurrence of Show.
81 -- * For locally defined names, we do a setProvenance on the Name
82 -- right after newTopBinder, and then use updateProveances to finally
83 -- set the provenances in the cache correctly.
85 -- NB: for wired-in names it's important not to
86 -- forget that they are wired in even when compiling that module
87 -- (else we spit out redundant defns into the interface file)
90 new_name = setNameModule name mod
91 new_cache = addToFM cache key new_name
93 setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_`
94 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
98 -- Build a completely new Name, and put it in the cache
99 -- Even for locally-defined names we use implicitImportProvenance;
100 -- updateProvenances will set it to rights
102 (us', us1) = splitUniqSupply us
103 uniq = uniqFromSupply us1
104 new_name = mkGlobalName uniq mod occ implicitImportProvenance
105 new_cache = addToFM cache key new_name
107 setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
108 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
112 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
113 -- Used for *occurrences*. We make a place-holder Name, really just
114 -- to agree on its unique, which gets overwritten when we read in
115 -- the binding occurence later (newImportedBinder)
116 -- The place-holder Name doesn't have the right Provenance, and its
117 -- Module won't have the right Package either
119 -- This means that a renamed program may have incorrect info
120 -- on implicitly-imported occurrences, but the correct info on the
121 -- *binding* declaration. It's the type checker that propagates the
122 -- correct information to all the occurrences.
123 -- Since implicitly-imported names never occur in error messages,
124 -- it doesn't matter that we get the correct info in place till later,
125 -- (but since it affects DLL-ery it does matter that we get it right
127 mkImportedGlobalName mod_name occ
128 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
130 key = (mod_name, occ)
132 case lookupFM cache key of
133 Just name -> traceRn (text "mkImportedGlobalName: hit" <+> ppr name) `thenRn_`
135 Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
136 traceRn (text "mkImportedGlobalName: new" <+> ppr name) `thenRn_`
139 (us', us1) = splitUniqSupply us
140 uniq = uniqFromSupply us1
141 mod = mkVanillaModule mod_name
142 name = mkGlobalName uniq mod occ implicitImportProvenance
143 new_cache = addToFM cache key name
145 updateProvenances :: [Name] -> RnM d ()
146 -- Update the provenances of everything that is in scope.
147 -- We must be careful not to disturb the Module package info
148 -- already in the cache. Why not? Consider
149 -- module A module M( f )
150 -- import M( f ) import N( f)
152 -- So f is defined in N, and M re-exports it.
153 -- When processing module A:
154 -- 1. We read M.hi first, and make a vanilla name N.f
155 -- (without reading N.hi). The package info says <THIS>
156 -- for lack of anything better.
157 -- 2. Now we read N, which update the cache to record
158 -- the correct package for N.f.
159 -- 3. Finally we update provenances (once we've read all imports).
160 -- Step 3 must not destroy package info recorded in Step 2.
162 updateProvenances names
163 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
164 setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
166 update name cache = addToFM_C update_prov cache key name
168 key = (moduleName (nameModule name), nameOccName name)
170 update_prov name_in_cache name_with_prov
171 = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
174 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
175 mkImportedGlobalFromRdrName rdr_name
177 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
180 = -- An Unqual is allowed; interface files contain
181 -- unqualified names for locally-defined things, such as
182 -- constructors of a data type.
183 getModuleRn `thenRn ` \ mod_name ->
184 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
188 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
189 case lookupFM ipcache key of
190 Just name -> returnRn name
191 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
194 (us', us1) = splitUniqSupply us
195 uniq = uniqFromSupply us1
196 name = mkIPName uniq key
197 new_ipcache = addToFM ipcache key name
198 where key = (rdrNameOcc rdr_name)
201 %*********************************************************
203 \subsection{Dfuns and default methods}
205 %*********************************************************
207 @newImplicitBinder@ is used for
208 (a) dfuns (RnSource.rnDecl on InstDecls)
209 (b) default methods (RnSource.rnDecl on ClassDecls)
210 when these dfuns/default methods are defined in the module being compiled
213 newImplicitBinder occ src_loc
214 = getModuleRn `thenRn` \ mod_name ->
215 newTopBinder (mkThisModule mod_name) occ `thenRn` \ name ->
216 returnRn (setNameProvenance name (LocalDef src_loc Exported))
219 Make a name for the dict fun for an instance decl
222 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
223 newDFunName key@(cl_occ, tycon_occ) loc
224 = newInstUniq string `thenRn` \ inst_uniq ->
225 newImplicitBinder (mkDFunOcc string inst_uniq) loc
227 -- Any string that is somewhat unique will do
228 string = occNameString cl_occ ++ occNameString tycon_occ
232 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
233 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
234 getDFunKey (HsFunTy _ ty) = getDFunKey ty
235 getDFunKey (HsPredTy (HsPClass cls (ty:_))) = (nameOccName cls, get_tycon_key ty)
237 get_tycon_key (HsTyVar tv) = getOccName tv
238 get_tycon_key (HsAppTy ty _) = get_tycon_key ty
239 get_tycon_key (HsTupleTy (HsTupCon n _) tys) = getOccName n
240 get_tycon_key (HsListTy _) = getOccName listTyCon
241 get_tycon_key (HsFunTy _ _) = getOccName funTyCon
245 %*********************************************************
249 %*********************************************************
252 -------------------------------------
253 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
254 -> [(RdrName,SrcLoc)]
255 -> ([Name] -> RnMS a)
257 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
258 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
260 getModeRn `thenRn` \ mode ->
261 getLocalNameEnv `thenRn` \ name_env ->
263 -- Warn about shadowing, but only in source modules
265 SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
269 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
271 n = length rdr_names_w_loc
272 (us', us1) = splitUniqSupply us
273 uniqs = uniqsFromSupply n us1
274 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
275 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
277 mk_name = case mode of
278 SourceMode -> mkLocalName
279 InterfaceMode -> mkImportedLocalName
280 -- Keep track of whether the name originally came from
281 -- an interface file.
283 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
286 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
288 setLocalNameEnv new_name_env (enclosed_scope names)
291 check_shadow name_env (rdr_name,loc)
292 = case lookupRdrEnv name_env rdr_name of
293 Nothing -> returnRn ()
294 Just name -> pushSrcLocRn loc $
295 addWarnRn (shadowedNameWarn rdr_name)
297 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
298 -> RnMS (a, FreeVars)
299 -- A specialised variant when renaming stuff from interface
300 -- files (of which there is a lot)
302 -- * no checks for shadowing
304 -- * deal with free vars
305 bindCoreLocalFVRn rdr_name enclosed_scope
306 = getSrcLocRn `thenRn` \ loc ->
307 getLocalNameEnv `thenRn` \ name_env ->
308 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
310 (us', us1) = splitUniqSupply us
311 uniq = uniqFromSupply us1
312 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
314 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
316 new_name_env = extendRdrEnv name_env rdr_name name
318 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
319 returnRn (result, delFromNameSet fvs name)
321 bindCoreLocalsFVRn [] thing_inside = thing_inside []
322 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
323 bindCoreLocalsFVRn bs $ \ names' ->
324 thing_inside (name':names')
326 -------------------------------------
327 bindLocalRn doc rdr_name enclosed_scope
328 = getSrcLocRn `thenRn` \ loc ->
329 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
333 bindLocalsRn doc rdr_names enclosed_scope
334 = getSrcLocRn `thenRn` \ loc ->
335 bindLocatedLocalsRn doc
336 (rdr_names `zip` repeat loc)
339 -- binLocalsFVRn is the same as bindLocalsRn
340 -- except that it deals with free vars
341 bindLocalsFVRn doc rdr_names enclosed_scope
342 = bindLocalsRn doc rdr_names $ \ names ->
343 enclosed_scope names `thenRn` \ (thing, fvs) ->
344 returnRn (thing, delListFromNameSet fvs names)
346 -------------------------------------
347 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
348 bindUVarRn = bindLocalRn
350 -------------------------------------
351 extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
352 -- This tiresome function is used only in rnDecl on InstDecl
353 extendTyVarEnvFVRn tyvars enclosed_scope
354 = getLocalNameEnv `thenRn` \ env ->
356 tyvar_names = map getTyVarName tyvars
357 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
358 | name <- tyvar_names
361 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
362 returnRn (thing, delListFromNameSet fvs tyvar_names)
364 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
365 -> ([HsTyVarBndr Name] -> RnMS a)
367 bindTyVarsRn doc_str tyvar_names enclosed_scope
368 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
369 enclosed_scope tyvars
371 -- Gruesome name: return Names as well as HsTyVars
372 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
373 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
375 bindTyVars2Rn doc_str tyvar_names enclosed_scope
376 = getSrcLocRn `thenRn` \ loc ->
378 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
380 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
381 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
383 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
384 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
385 -> RnMS (a, FreeVars)
386 bindTyVarsFVRn doc_str rdr_names enclosed_scope
387 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
388 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
389 returnRn (thing, delListFromNameSet fvs names)
391 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
392 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
393 -> RnMS (a, FreeVars)
394 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
395 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
396 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
397 returnRn (thing, delListFromNameSet fvs names)
400 -------------------------------------
401 checkDupOrQualNames, checkDupNames :: SDoc
402 -> [(RdrName, SrcLoc)]
404 -- Works in any variant of the renamer monad
406 checkDupOrQualNames doc_str rdr_names_w_loc
407 = -- Check for use of qualified names
408 mapRn_ (qualNameErr doc_str) quals `thenRn_`
409 checkDupNames doc_str rdr_names_w_loc
411 quals = filter (isQual.fst) rdr_names_w_loc
413 checkDupNames doc_str rdr_names_w_loc
414 = -- Check for duplicated names in a binding group
415 mapRn_ (dupNamesErr doc_str) dups
417 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
421 %*********************************************************
423 \subsection{Looking up names}
425 %*********************************************************
427 Looking up a name in the RnEnv.
430 lookupBndrRn rdr_name
431 = traceRn (text "lookupBndrRn" <+> ppr rdr_name) `thenRn_`
432 getNameEnvs `thenRn` \ (global_env, local_env) ->
435 case lookupRdrEnv local_env rdr_name of {
436 Just name -> returnRn name ;
439 getModeRn `thenRn` \ mode ->
441 InterfaceMode -> -- Look in the global name cache
442 mkImportedGlobalFromRdrName rdr_name `thenRn` \ n ->
443 traceRn (text "lookupBndrRn result:" <+> ppr n) `thenRn_`
446 SourceMode -> -- Source mode, so look up a *qualified* version
447 -- of the name, so that we get the right one even
448 -- if there are many with the same occ name
449 -- There must *be* a binding
450 getModuleRn `thenRn` \ mod ->
451 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
452 Just (name:rest) -> ASSERT( null rest )
454 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
457 -- lookupOccRn looks up an occurrence of a RdrName
458 lookupOccRn :: RdrName -> RnMS Name
460 = getNameEnvs `thenRn` \ (global_env, local_env) ->
461 lookup_occ global_env local_env rdr_name
463 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
464 -- environment. It's used only for
465 -- record field names
466 -- class op names in class and instance decls
467 lookupGlobalOccRn :: RdrName -> RnMS Name
468 lookupGlobalOccRn rdr_name
469 = getNameEnvs `thenRn` \ (global_env, local_env) ->
470 lookup_global_occ global_env rdr_name
472 -- lookupSigOccRn is used for type signatures and pragmas
478 -- In a sense, it's clear that the 'f' in the signature must refer
479 -- to A.f, but the Haskell98 report does not stipulate this, so
480 -- I treat the 'f' in the signature as a reference to an unqualified
481 -- 'f' and hence fail with an ambiguous reference.
482 lookupSigOccRn :: RdrName -> RnMS Name
483 lookupSigOccRn = lookupOccRn
486 -- This code tries to be cleverer than the above.
487 -- The variable in a signature must refer to a locally-defined thing,
488 -- even if there's an imported thing of the same name.
490 -- But this doesn't work for instance decls:
491 -- instance Enum Int where
492 -- {-# INLINE enumFrom #-}
494 -- Here the enumFrom is an imported reference!
495 lookupSigOccRn rdr_name
496 = getNameEnvs `thenRn` \ (global_env, local_env) ->
497 case (lookupRdrEnv local_env rdr_name, lookupRdrEnv global_env rdr_name) of
498 (Just name, _) -> returnRn name
500 (Nothing, Just names) -> case filter isLocallyDefined names of
502 ns -> pprPanic "lookupSigOccRn" (ppr rdr_name <+> ppr names <+> ppr ns)
503 -- There can't be a local top-level name-clash
504 -- (That's dealt with elsewhere.)
506 (Nothing, Nothing) -> failWithRn (mkUnboundName rdr_name)
507 (unknownNameErr rdr_name)
511 -- Look in both local and global env
512 lookup_occ global_env local_env rdr_name
513 = case lookupRdrEnv local_env rdr_name of
514 Just name -> returnRn name
515 Nothing -> lookup_global_occ global_env rdr_name
517 -- Look in global env only
518 lookup_global_occ global_env rdr_name
519 = case lookupRdrEnv global_env rdr_name of
520 Just [name] -> returnRn name
521 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
523 Nothing -> getModeRn `thenRn` \ mode ->
525 -- Not found when processing source code; so fail
526 SourceMode -> failWithRn (mkUnboundName rdr_name)
527 (unknownNameErr rdr_name)
529 -- Not found when processing an imported declaration,
530 -- so we create a new name for the purpose
531 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
534 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
535 and adds it to the occurrence pool so that it'll be loaded later.
536 This is used when language constructs
537 (such as monad comprehensions, overloaded literals, or deriving clauses)
538 require some stuff to be loaded that isn't explicitly mentioned in the code.
540 This doesn't apply in interface mode, where everything is explicit,
541 but we don't check for this case:
542 it does no harm to record an ``extra'' occurrence
543 and @lookupImplicitOccRn@ isn't used much in interface mode
544 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
546 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
548 For List and Tuple types it's important to get the correct
549 @isLocallyDefined@ flag, which is used in turn when deciding
550 whether there are any instance decls in this module are ``special''.
551 The name cache should have the correct provenance, though.
554 lookupImplicitOccRn :: RdrName -> RnM d Name
555 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
557 lookupImplicitOccsRn :: [RdrName] -> RnM d NameSet
558 lookupImplicitOccsRn rdr_names
559 = mapRn lookupImplicitOccRn rdr_names `thenRn` \ names ->
560 returnRn (mkNameSet names)
563 @unQualInScope@ returns a function that takes a @Name@ and tells whether
564 its unqualified name is in scope. This is put as a boolean flag in
565 the @Name@'s provenance to guide whether or not to print the name qualified
569 unQualInScope :: GlobalRdrEnv -> Name -> Bool
573 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
574 Just [name'] -> name == name'
578 %************************************************************************
580 \subsection{Envt utility functions}
582 %************************************************************************
584 \subsubsection{NameEnv}% ================
587 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
588 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
590 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
591 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
593 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
594 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
596 combine_globals :: [Name] -- Old
599 combine_globals ns_old ns_new -- ns_new is often short
600 = foldr add ns_old ns_new
602 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
605 choose m | n==m && n `hasBetterProv` m = n
609 is_duplicate :: Name -> Name -> Bool
610 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
611 | otherwise = n1 == n2
613 We treat two bindings of a locally-defined name as a duplicate,
614 because they might be two separate, local defns and we want to report
615 and error for that, {\em not} eliminate a duplicate.
617 On the other hand, if you import the same name from two different
618 import statements, we {\em d}* want to eliminate the duplicate, not report
621 If a module imports itself then there might be a local defn and an imported
622 defn of the same name; in this case the names will compare as equal, but
623 will still have different provenances.
627 \subsubsection{AvailInfo}% ================
630 plusAvail (Avail n1) (Avail n2) = Avail n1
631 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
634 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
637 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
638 addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
640 emptyAvailEnv = emptyNameEnv
641 unitAvailEnv :: AvailInfo -> AvailEnv
642 unitAvailEnv a = unitNameEnv (availName a) a
644 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
645 plusAvailEnv = plusNameEnv_C plusAvail
647 availEnvElts = nameEnvElts
649 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
650 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
652 availsToNameSet :: [AvailInfo] -> NameSet
653 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
655 availName :: GenAvailInfo name -> name
656 availName (Avail n) = n
657 availName (AvailTC n _) = n
659 availNames :: GenAvailInfo name -> [name]
660 availNames (Avail n) = [n]
661 availNames (AvailTC n ns) = ns
663 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
664 addSysAvails avail [] = avail
665 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
667 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
668 -- Used when building the avails we are going to put in an interface file
669 -- We sort the components to reduce needless wobbling of interfaces
670 rdrAvailInfo (Avail n) = Avail (nameOccName n)
671 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
673 filterAvail :: RdrNameIE -- Wanted
674 -> AvailInfo -- Available
675 -> Maybe AvailInfo -- Resulting available;
676 -- Nothing if (any of the) wanted stuff isn't there
678 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
679 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
680 | otherwise = Nothing
682 is_wanted name = nameOccName name `elem` wanted_occs
683 sub_names_ok = all (`elem` avail_occs) wanted_occs
684 avail_occs = map nameOccName ns
685 wanted_occs = map rdrNameOcc (want:wants)
687 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
690 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
692 filterAvail (IEVar _) avail@(Avail n) = Just avail
693 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
695 wanted n = nameOccName n == occ
697 -- The second equation happens if we import a class op, thus
699 -- where op is a class operation
701 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
702 -- We don't complain even if the IE says T(..), but
703 -- no constrs/class ops of T are available
704 -- Instead that's caught with a warning by the caller
706 filterAvail ie avail = Nothing
708 pprAvail :: AvailInfo -> SDoc
709 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
711 ns' -> parens (hsep (punctuate comma (map ppr ns')))
713 pprAvail (Avail n) = ppr n
719 %************************************************************************
721 \subsection{Free variable manipulation}
723 %************************************************************************
726 type FreeVars = NameSet
728 plusFV :: FreeVars -> FreeVars -> FreeVars
729 addOneFV :: FreeVars -> Name -> FreeVars
730 unitFV :: Name -> FreeVars
732 plusFVs :: [FreeVars] -> FreeVars
734 isEmptyFVs = isEmptyNameSet
735 emptyFVs = emptyNameSet
736 plusFVs = unionManyNameSets
737 plusFV = unionNameSets
739 -- No point in adding implicitly imported names to the free-var set
740 addOneFV s n = addOneToNameSet s n
741 unitFV n = unitNameSet n
744 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
746 (ys, fvs_s) = unzip stuff
748 returnRn (ys, plusFVs fvs_s)
752 %************************************************************************
754 \subsection{Envt utility functions}
756 %************************************************************************
761 warnUnusedModules :: [ModuleName] -> RnM d ()
762 warnUnusedModules mods
763 | not opt_WarnUnusedImports = returnRn ()
764 | otherwise = mapRn_ (addWarnRn . unused_mod) mods
766 unused_mod m = ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
767 text "is imported, but nothing from it is used"
769 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
770 warnUnusedImports names
771 | not opt_WarnUnusedImports
772 = returnRn () -- Don't force names unless necessary
774 = warnUnusedBinds (const True) names
776 warnUnusedLocalBinds ns
777 | not opt_WarnUnusedBinds = returnRn ()
778 | otherwise = warnUnusedBinds (const True) ns
780 warnUnusedMatches names
781 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
782 | otherwise = returnRn ()
784 -------------------------
786 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
787 warnUnusedBinds warn_when_local names
788 = mapRn_ (warnUnusedGroup warn_when_local) groups
790 -- Group by provenance
791 groups = equivClasses cmp names
792 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
794 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
795 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
796 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
797 (NonLocalDef (UserImport m2 loc2 _) _) =
798 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
799 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
800 -- In-scope NonLocalDefs must have UserImport info on them
802 -------------------------
804 -- NOTE: the function passed to warnUnusedGroup is
805 -- now always (const True) so we should be able to
806 -- simplify the code slightly. I'm leaving it there
807 -- for now just in case I havn't realised why it was there.
808 -- Looks highly bogus to me. SLPJ Dec 99
810 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
811 warnUnusedGroup emit_warning names
812 | null filtered_names = returnRn ()
813 | not (emit_warning is_local) = returnRn ()
815 = pushSrcLocRn def_loc $
817 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
819 filtered_names = filter reportable names
820 name1 = head filtered_names
821 (is_local, def_loc, msg)
822 = case getNameProvenance name1 of
823 LocalDef loc _ -> (True, loc, text "Defined but not used")
824 NonLocalDef (UserImport mod loc _) _ ->
825 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
827 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
829 reportable name = case occNameUserString (nameOccName name) of
832 -- Haskell 98 encourages compilers to suppress warnings about
833 -- unused names in a pattern if they start with "_".
837 addNameClashErrRn rdr_name (name1:names)
838 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
839 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
841 msg1 = ptext SLIT("either") <+> mk_ref name1
842 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
843 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
845 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
846 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
847 4 (vcat [ppr how_in_scope1,
850 shadowedNameWarn shadow
851 = hsep [ptext SLIT("This binding for"),
853 ptext SLIT("shadows an existing binding")]
856 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
858 flavour = occNameFlavour (rdrNameOcc name)
860 qualNameErr descriptor (name,loc)
862 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
867 dupNamesErr descriptor ((name,loc) : dup_things)
869 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
871 (ptext SLIT("in") <+> descriptor))