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 ( hsTyVarName, hsTyVarNames, 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,
29 extendNameEnv_C, plusNameEnv_C, nameEnvElts
32 import OccName ( OccName,
33 mkDFunOcc, occNameUserString, occNameString,
36 import TysWiredIn ( listTyCon )
37 import Type ( funTyCon )
38 import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName )
41 import SrcLoc ( SrcLoc, noSrcLoc )
43 import Util ( removeDups, equivClasses, thenCmp, sortLt )
49 %*********************************************************
51 \subsection{Making new names}
53 %*********************************************************
56 implicitImportProvenance = NonLocalDef ImplicitImport False
58 newTopBinder :: Module -> OccName -> RnM d Name
60 = -- First check the cache
61 traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
63 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
65 key = (moduleName mod, occ)
67 case lookupFM cache key of
69 -- A hit in the cache! We are at the binding site of the name, which is
70 -- the time we know all about the Name's host Module (in particular, which
71 -- package it comes from), so update the Module in the name.
72 -- But otherwise *leave the Provenance alone*:
74 -- * For imported names, the Provenance may already be correct.
75 -- e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show
76 -- to 'UserImport from Prelude'. Note that we havn't yet opened PrelShow.hi
77 -- Later we find we really need PrelShow.Show, so we open PrelShow.hi, and
78 -- that's when we find the binding occurrence of Show.
80 -- * For locally defined names, we do a setProvenance on the Name
81 -- right after newTopBinder, and then use updateProveances to finally
82 -- set the provenances in the cache correctly.
84 -- NB: for wired-in names it's important not to
85 -- forget that they are wired in even when compiling that module
86 -- (else we spit out redundant defns into the interface file)
89 new_name = setNameModule name mod
90 new_cache = addToFM cache key new_name
92 setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_`
93 traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
97 -- Build a completely new Name, and put it in the cache
98 -- Even for locally-defined names we use implicitImportProvenance;
99 -- updateProvenances will set it to rights
101 (us', us1) = splitUniqSupply us
102 uniq = uniqFromSupply us1
103 new_name = mkGlobalName uniq mod occ implicitImportProvenance
104 new_cache = addToFM cache key new_name
106 setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
107 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
111 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
112 -- Used for *occurrences*. We make a place-holder Name, really just
113 -- to agree on its unique, which gets overwritten when we read in
114 -- the binding occurence later (newImportedBinder)
115 -- The place-holder Name doesn't have the right Provenance, and its
116 -- Module won't have the right Package either
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 mkImportedGlobalName mod_name occ
127 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
129 key = (mod_name, occ)
131 case lookupFM cache key of
132 Just name -> traceRn (text "mkImportedGlobalName: hit" <+> ppr name) `thenRn_`
134 Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
135 traceRn (text "mkImportedGlobalName: new" <+> ppr name) `thenRn_`
138 (us', us1) = splitUniqSupply us
139 uniq = uniqFromSupply us1
140 mod = mkVanillaModule mod_name
141 name = mkGlobalName uniq mod occ implicitImportProvenance
142 new_cache = addToFM cache key name
144 updateProvenances :: [Name] -> RnM d ()
145 -- Update the provenances of everything that is in scope.
146 -- We must be careful not to disturb the Module package info
147 -- already in the cache. Why not? Consider
148 -- module A module M( f )
149 -- import M( f ) import N( f)
151 -- So f is defined in N, and M re-exports it.
152 -- When processing module A:
153 -- 1. We read M.hi first, and make a vanilla name N.f
154 -- (without reading N.hi). The package info says <THIS>
155 -- for lack of anything better.
156 -- 2. Now we read N, which update the cache to record
157 -- the correct package for N.f.
158 -- 3. Finally we update provenances (once we've read all imports).
159 -- Step 3 must not destroy package info recorded in Step 2.
161 updateProvenances names
162 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
163 setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
165 update name cache = addToFM_C update_prov cache key name
167 key = (moduleName (nameModule name), nameOccName name)
169 update_prov name_in_cache name_with_prov
170 = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
173 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
174 mkImportedGlobalFromRdrName rdr_name
176 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
179 = -- An Unqual is allowed; interface files contain
180 -- unqualified names for locally-defined things, such as
181 -- constructors of a data type.
182 getModuleRn `thenRn ` \ mod_name ->
183 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
187 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
188 case lookupFM ipcache key of
189 Just name -> returnRn name
190 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
193 (us', us1) = splitUniqSupply us
194 uniq = uniqFromSupply us1
195 name = mkIPName uniq key
196 new_ipcache = addToFM ipcache key name
197 where key = (rdrNameOcc rdr_name)
200 %*********************************************************
202 \subsection{Dfuns and default methods}
204 %*********************************************************
206 @newImplicitBinder@ is used for
207 (a) dfuns (RnSource.rnDecl on InstDecls)
208 (b) default methods (RnSource.rnDecl on ClassDecls)
209 when these dfuns/default methods are defined in the module being compiled
212 newImplicitBinder occ src_loc
213 = getModuleRn `thenRn` \ mod_name ->
214 newTopBinder (mkThisModule mod_name) occ `thenRn` \ name ->
215 returnRn (setNameProvenance name (LocalDef src_loc Exported))
218 Make a name for the dict fun for an instance decl
221 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
222 newDFunName key@(cl_occ, tycon_occ) loc
223 = newInstUniq string `thenRn` \ inst_uniq ->
224 newImplicitBinder (mkDFunOcc string inst_uniq) loc
226 -- Any string that is somewhat unique will do
227 string = occNameString cl_occ ++ occNameString tycon_occ
231 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
232 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
233 getDFunKey (HsFunTy _ ty) = getDFunKey ty
234 getDFunKey (HsPredTy (HsPClass cls (ty:_))) = (nameOccName cls, get_tycon_key ty)
236 get_tycon_key (HsTyVar tv) = getOccName tv
237 get_tycon_key (HsAppTy ty _) = get_tycon_key ty
238 get_tycon_key (HsTupleTy (HsTupCon n _) tys) = getOccName n
239 get_tycon_key (HsListTy _) = getOccName listTyCon
240 get_tycon_key (HsFunTy _ _) = getOccName funTyCon
244 %*********************************************************
248 %*********************************************************
251 -------------------------------------
252 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
253 -> [(RdrName,SrcLoc)]
254 -> ([Name] -> RnMS a)
256 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
257 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
259 getModeRn `thenRn` \ mode ->
260 getLocalNameEnv `thenRn` \ name_env ->
262 -- Warn about shadowing, but only in source modules
264 SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
268 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
270 n = length rdr_names_w_loc
271 (us', us1) = splitUniqSupply us
272 uniqs = uniqsFromSupply n us1
273 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
274 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
276 mk_name = case mode of
277 SourceMode -> mkLocalName
278 InterfaceMode -> mkImportedLocalName
279 -- Keep track of whether the name originally came from
280 -- an interface file.
282 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
285 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
287 setLocalNameEnv new_name_env (enclosed_scope names)
290 check_shadow name_env (rdr_name,loc)
291 = case lookupRdrEnv name_env rdr_name of
292 Nothing -> returnRn ()
293 Just name -> pushSrcLocRn loc $
294 addWarnRn (shadowedNameWarn rdr_name)
296 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
297 -> RnMS (a, FreeVars)
298 -- A specialised variant when renaming stuff from interface
299 -- files (of which there is a lot)
301 -- * no checks for shadowing
303 -- * deal with free vars
304 bindCoreLocalFVRn rdr_name enclosed_scope
305 = getSrcLocRn `thenRn` \ loc ->
306 getLocalNameEnv `thenRn` \ name_env ->
307 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
309 (us', us1) = splitUniqSupply us
310 uniq = uniqFromSupply us1
311 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
313 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
315 new_name_env = extendRdrEnv name_env rdr_name name
317 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
318 returnRn (result, delFromNameSet fvs name)
320 bindCoreLocalsFVRn [] thing_inside = thing_inside []
321 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
322 bindCoreLocalsFVRn bs $ \ names' ->
323 thing_inside (name':names')
325 -------------------------------------
326 bindLocalRn doc rdr_name enclosed_scope
327 = getSrcLocRn `thenRn` \ loc ->
328 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
332 bindLocalsRn doc rdr_names enclosed_scope
333 = getSrcLocRn `thenRn` \ loc ->
334 bindLocatedLocalsRn doc
335 (rdr_names `zip` repeat loc)
338 -- binLocalsFVRn is the same as bindLocalsRn
339 -- except that it deals with free vars
340 bindLocalsFVRn doc rdr_names enclosed_scope
341 = bindLocalsRn doc rdr_names $ \ names ->
342 enclosed_scope names `thenRn` \ (thing, fvs) ->
343 returnRn (thing, delListFromNameSet fvs names)
345 -------------------------------------
346 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
347 bindUVarRn = bindLocalRn
349 -------------------------------------
350 extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
351 -- This tiresome function is used only in rnDecl on InstDecl
352 extendTyVarEnvFVRn tyvars enclosed_scope
353 = getLocalNameEnv `thenRn` \ env ->
355 tyvar_names = hsTyVarNames tyvars
356 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
357 | name <- tyvar_names
360 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
361 returnRn (thing, delListFromNameSet fvs tyvar_names)
363 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
364 -> ([HsTyVarBndr Name] -> RnMS a)
366 bindTyVarsRn doc_str tyvar_names enclosed_scope
367 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
368 enclosed_scope tyvars
370 -- Gruesome name: return Names as well as HsTyVars
371 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
372 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
374 bindTyVars2Rn doc_str tyvar_names enclosed_scope
375 = getSrcLocRn `thenRn` \ loc ->
377 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
379 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
380 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
382 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
383 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
384 -> RnMS (a, FreeVars)
385 bindTyVarsFVRn doc_str rdr_names enclosed_scope
386 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
387 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
388 returnRn (thing, delListFromNameSet fvs names)
390 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
391 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
392 -> RnMS (a, FreeVars)
393 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
394 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
395 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
396 returnRn (thing, delListFromNameSet fvs names)
399 -------------------------------------
400 checkDupOrQualNames, checkDupNames :: SDoc
401 -> [(RdrName, SrcLoc)]
403 -- Works in any variant of the renamer monad
405 checkDupOrQualNames doc_str rdr_names_w_loc
406 = -- Check for use of qualified names
407 mapRn_ (qualNameErr doc_str) quals `thenRn_`
408 checkDupNames doc_str rdr_names_w_loc
410 quals = filter (isQual.fst) rdr_names_w_loc
412 checkDupNames doc_str rdr_names_w_loc
413 = -- Check for duplicated names in a binding group
414 mapRn_ (dupNamesErr doc_str) dups
416 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
420 %*********************************************************
422 \subsection{Looking up names}
424 %*********************************************************
426 Looking up a name in the RnEnv.
429 lookupBndrRn rdr_name
430 = traceRn (text "lookupBndrRn" <+> ppr rdr_name) `thenRn_`
431 getNameEnvs `thenRn` \ (global_env, local_env) ->
434 case lookupRdrEnv local_env rdr_name of {
435 Just name -> returnRn name ;
438 getModeRn `thenRn` \ mode ->
440 InterfaceMode -> -- Look in the global name cache
441 mkImportedGlobalFromRdrName rdr_name `thenRn` \ n ->
442 traceRn (text "lookupBndrRn result:" <+> ppr n) `thenRn_`
445 SourceMode -> -- Source mode, so look up a *qualified* version
446 -- of the name, so that we get the right one even
447 -- if there are many with the same occ name
448 -- There must *be* a binding
449 getModuleRn `thenRn` \ mod ->
450 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
451 Just (name:rest) -> ASSERT( null rest )
453 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
456 -- lookupOccRn looks up an occurrence of a RdrName
457 lookupOccRn :: RdrName -> RnMS Name
459 = getNameEnvs `thenRn` \ (global_env, local_env) ->
460 lookup_occ global_env local_env rdr_name
462 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
463 -- environment. It's used only for
464 -- record field names
465 -- class op names in class and instance decls
466 lookupGlobalOccRn :: RdrName -> RnMS Name
467 lookupGlobalOccRn rdr_name
468 = getNameEnvs `thenRn` \ (global_env, local_env) ->
469 lookup_global_occ global_env rdr_name
471 -- lookupSigOccRn is used for type signatures and pragmas
477 -- In a sense, it's clear that the 'f' in the signature must refer
478 -- to A.f, but the Haskell98 report does not stipulate this, so
479 -- I treat the 'f' in the signature as a reference to an unqualified
480 -- 'f' and hence fail with an ambiguous reference.
481 lookupSigOccRn :: RdrName -> RnMS Name
482 lookupSigOccRn = lookupOccRn
485 -- This code tries to be cleverer than the above.
486 -- The variable in a signature must refer to a locally-defined thing,
487 -- even if there's an imported thing of the same name.
489 -- But this doesn't work for instance decls:
490 -- instance Enum Int where
491 -- {-# INLINE enumFrom #-}
493 -- Here the enumFrom is an imported reference!
494 lookupSigOccRn rdr_name
495 = getNameEnvs `thenRn` \ (global_env, local_env) ->
496 case (lookupRdrEnv local_env rdr_name, lookupRdrEnv global_env rdr_name) of
497 (Just name, _) -> returnRn name
499 (Nothing, Just names) -> case filter isLocallyDefined names of
501 ns -> pprPanic "lookupSigOccRn" (ppr rdr_name <+> ppr names <+> ppr ns)
502 -- There can't be a local top-level name-clash
503 -- (That's dealt with elsewhere.)
505 (Nothing, Nothing) -> failWithRn (mkUnboundName rdr_name)
506 (unknownNameErr rdr_name)
510 -- Look in both local and global env
511 lookup_occ global_env local_env rdr_name
512 = case lookupRdrEnv local_env rdr_name of
513 Just name -> returnRn name
514 Nothing -> lookup_global_occ global_env rdr_name
516 -- Look in global env only
517 lookup_global_occ global_env rdr_name
518 = case lookupRdrEnv global_env rdr_name of
519 Just [name] -> returnRn name
520 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
522 Nothing -> getModeRn `thenRn` \ mode ->
524 -- Not found when processing source code; so fail
525 SourceMode -> failWithRn (mkUnboundName rdr_name)
526 (unknownNameErr rdr_name)
528 -- Not found when processing an imported declaration,
529 -- so we create a new name for the purpose
530 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
533 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
534 and adds it to the occurrence pool so that it'll be loaded later.
535 This is used when language constructs
536 (such as monad comprehensions, overloaded literals, or deriving clauses)
537 require some stuff to be loaded that isn't explicitly mentioned in the code.
539 This doesn't apply in interface mode, where everything is explicit,
540 but we don't check for this case:
541 it does no harm to record an ``extra'' occurrence
542 and @lookupImplicitOccRn@ isn't used much in interface mode
543 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
545 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
547 For List and Tuple types it's important to get the correct
548 @isLocallyDefined@ flag, which is used in turn when deciding
549 whether there are any instance decls in this module are ``special''.
550 The name cache should have the correct provenance, though.
553 lookupImplicitOccRn :: RdrName -> RnM d Name
554 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
556 lookupImplicitOccsRn :: [RdrName] -> RnM d NameSet
557 lookupImplicitOccsRn rdr_names
558 = mapRn lookupImplicitOccRn rdr_names `thenRn` \ names ->
559 returnRn (mkNameSet names)
562 @unQualInScope@ returns a function that takes a @Name@ and tells whether
563 its unqualified name is in scope. This is put as a boolean flag in
564 the @Name@'s provenance to guide whether or not to print the name qualified
568 unQualInScope :: GlobalRdrEnv -> Name -> Bool
572 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
573 Just [name'] -> name == name'
577 %************************************************************************
579 \subsection{Envt utility functions}
581 %************************************************************************
583 \subsubsection{NameEnv}% ================
586 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
587 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
589 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
590 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
592 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
593 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
595 combine_globals :: [Name] -- Old
598 combine_globals ns_old ns_new -- ns_new is often short
599 = foldr add ns_old ns_new
601 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
604 choose m | n==m && n `hasBetterProv` m = n
608 is_duplicate :: Name -> Name -> Bool
609 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
610 | otherwise = n1 == n2
612 We treat two bindings of a locally-defined name as a duplicate,
613 because they might be two separate, local defns and we want to report
614 and error for that, {\em not} eliminate a duplicate.
616 On the other hand, if you import the same name from two different
617 import statements, we {\em d}* want to eliminate the duplicate, not report
620 If a module imports itself then there might be a local defn and an imported
621 defn of the same name; in this case the names will compare as equal, but
622 will still have different provenances.
626 \subsubsection{AvailInfo}% ================
629 plusAvail (Avail n1) (Avail n2) = Avail n1
630 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
633 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
636 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
637 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
639 emptyAvailEnv = emptyNameEnv
640 unitAvailEnv :: AvailInfo -> AvailEnv
641 unitAvailEnv a = unitNameEnv (availName a) a
643 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
644 plusAvailEnv = plusNameEnv_C plusAvail
646 availEnvElts = nameEnvElts
648 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
649 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
651 availsToNameSet :: [AvailInfo] -> NameSet
652 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
654 availName :: GenAvailInfo name -> name
655 availName (Avail n) = n
656 availName (AvailTC n _) = n
658 availNames :: GenAvailInfo name -> [name]
659 availNames (Avail n) = [n]
660 availNames (AvailTC n ns) = ns
662 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
663 addSysAvails avail [] = avail
664 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
666 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
667 -- Used when building the avails we are going to put in an interface file
668 -- We sort the components to reduce needless wobbling of interfaces
669 rdrAvailInfo (Avail n) = Avail (nameOccName n)
670 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
672 filterAvail :: RdrNameIE -- Wanted
673 -> AvailInfo -- Available
674 -> Maybe AvailInfo -- Resulting available;
675 -- Nothing if (any of the) wanted stuff isn't there
677 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
678 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
679 | otherwise = Nothing
681 is_wanted name = nameOccName name `elem` wanted_occs
682 sub_names_ok = all (`elem` avail_occs) wanted_occs
683 avail_occs = map nameOccName ns
684 wanted_occs = map rdrNameOcc (want:wants)
686 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
689 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
691 filterAvail (IEVar _) avail@(Avail n) = Just avail
692 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
694 wanted n = nameOccName n == occ
696 -- The second equation happens if we import a class op, thus
698 -- where op is a class operation
700 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
701 -- We don't complain even if the IE says T(..), but
702 -- no constrs/class ops of T are available
703 -- Instead that's caught with a warning by the caller
705 filterAvail ie avail = Nothing
707 pprAvail :: AvailInfo -> SDoc
708 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
710 ns' -> parens (hsep (punctuate comma (map ppr ns')))
712 pprAvail (Avail n) = ppr n
718 %************************************************************************
720 \subsection{Free variable manipulation}
722 %************************************************************************
725 type FreeVars = NameSet
727 plusFV :: FreeVars -> FreeVars -> FreeVars
728 addOneFV :: FreeVars -> Name -> FreeVars
729 unitFV :: Name -> FreeVars
731 plusFVs :: [FreeVars] -> FreeVars
733 isEmptyFVs = isEmptyNameSet
734 emptyFVs = emptyNameSet
735 plusFVs = unionManyNameSets
736 plusFV = unionNameSets
738 -- No point in adding implicitly imported names to the free-var set
739 addOneFV s n = addOneToNameSet s n
740 unitFV n = unitNameSet n
743 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
745 (ys, fvs_s) = unzip stuff
747 returnRn (ys, plusFVs fvs_s)
751 %************************************************************************
753 \subsection{Envt utility functions}
755 %************************************************************************
760 warnUnusedModules :: [ModuleName] -> RnM d ()
761 warnUnusedModules mods
762 | not opt_WarnUnusedImports = returnRn ()
763 | otherwise = mapRn_ (addWarnRn . unused_mod) mods
765 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
766 text "is imported, but nothing from it is used",
767 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
768 quotes (pprModuleName m))]
770 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
771 warnUnusedImports names
772 | not opt_WarnUnusedImports
773 = returnRn () -- Don't force names unless necessary
775 = warnUnusedBinds (const True) names
777 warnUnusedLocalBinds ns
778 | not opt_WarnUnusedBinds = returnRn ()
779 | otherwise = warnUnusedBinds (const True) ns
781 warnUnusedMatches names
782 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
783 | otherwise = returnRn ()
785 -------------------------
787 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
788 warnUnusedBinds warn_when_local names
789 = mapRn_ (warnUnusedGroup warn_when_local) groups
791 -- Group by provenance
792 groups = equivClasses cmp names
793 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
795 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
796 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
797 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
798 (NonLocalDef (UserImport m2 loc2 _) _) =
799 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
800 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
801 -- In-scope NonLocalDefs must have UserImport info on them
803 -------------------------
805 -- NOTE: the function passed to warnUnusedGroup is
806 -- now always (const True) so we should be able to
807 -- simplify the code slightly. I'm leaving it there
808 -- for now just in case I havn't realised why it was there.
809 -- Looks highly bogus to me. SLPJ Dec 99
811 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
812 warnUnusedGroup emit_warning names
813 | null filtered_names = returnRn ()
814 | not (emit_warning is_local) = returnRn ()
816 = pushSrcLocRn def_loc $
818 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
820 filtered_names = filter reportable names
821 name1 = head filtered_names
822 (is_local, def_loc, msg)
823 = case getNameProvenance name1 of
824 LocalDef loc _ -> (True, loc, text "Defined but not used")
825 NonLocalDef (UserImport mod loc _) _ ->
826 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
828 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
830 reportable name = case occNameUserString (nameOccName name) of
833 -- Haskell 98 encourages compilers to suppress warnings about
834 -- unused names in a pattern if they start with "_".
838 addNameClashErrRn rdr_name (name1:names)
839 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
840 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
842 msg1 = ptext SLIT("either") <+> mk_ref name1
843 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
844 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
846 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
847 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
848 4 (vcat [ppr how_in_scope1,
851 shadowedNameWarn shadow
852 = hsep [ptext SLIT("This binding for"),
854 ptext SLIT("shadows an existing binding")]
857 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
859 flavour = occNameFlavour (rdrNameOcc name)
861 qualNameErr descriptor (name,loc)
863 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
868 dupNamesErr descriptor ((name,loc) : dup_things)
870 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
872 (ptext SLIT("in") <+> descriptor))