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, isSystemName, isWiredInName,
26 nameOccName, setNameModule, nameModule,
27 pprOccName, isLocallyDefined, nameUnique, nameOccName,
29 setNameProvenance, getNameProvenance, pprNameProvenance
32 import OccName ( OccName,
33 mkDFunOcc, occNameUserString, occNameString,
36 import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon )
37 import Type ( funTyCon )
38 import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule )
39 import TyCon ( TyCon )
41 import Unique ( Unique, Uniquable(..) )
42 import UniqFM ( emptyUFM, listToUFM, plusUFM_C )
44 import SrcLoc ( SrcLoc, noSrcLoc )
46 import Util ( removeDups, equivClasses, thenCmp )
48 import Maybes ( mapMaybe )
53 %*********************************************************
55 \subsection{Making new names}
57 %*********************************************************
60 newLocalTopBinder :: Module -> OccName
61 -> (Name -> ExportFlag) -> SrcLoc
63 newLocalTopBinder mod occ rec_exp_fn loc
64 = newTopBinder mod occ (\name -> setNameProvenance name (LocalDef loc (rec_exp_fn name)))
65 -- We must set the provenance of the thing in the cache
66 -- correctly, particularly whether or not it is locally defined.
68 -- Since newLocalTopBinder is used only
69 -- at binding occurrences, we may as well get the provenance
70 -- dead right first time; hence the rec_exp_fn passed in
72 newImportedBinder :: Module -> RdrName -> RnM d Name
73 newImportedBinder mod rdr_name
74 = ASSERT2( isUnqual rdr_name, ppr rdr_name )
75 newTopBinder mod (rdrNameOcc rdr_name) (\name -> name)
76 -- Provenance is already implicitImportProvenance
78 implicitImportProvenance = NonLocalDef ImplicitImport False
80 newTopBinder :: Module -> OccName -> (Name -> Name) -> RnM d Name
81 newTopBinder mod occ set_prov
82 = -- First check the cache
83 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
85 key = (moduleName mod, occ)
87 case lookupFM cache key of
89 -- A hit in the cache!
90 -- Set the Module of the thing, and set its provenance (hack pending
93 -- It also means that if there are two defns for the same thing
94 -- in a module, then each gets a separate SrcLoc
96 -- There's a complication for wired-in names. We don't want to
97 -- forget that they are wired in even when compiling that module
98 -- (else we spit out redundant defns into the interface file)
99 -- So for them we just set the provenance
102 new_name = set_prov (setNameModule name mod)
103 new_cache = addToFM cache key new_name
105 setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_`
108 -- Miss in the cache!
109 -- Build a completely new Name, and put it in the cache
111 (us', us1) = splitUniqSupply us
112 uniq = uniqFromSupply us1
113 new_name = set_prov (mkGlobalName uniq mod occ implicitImportProvenance)
114 new_cache = addToFM cache key new_name
116 setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
120 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
121 -- Used for *occurrences*. We make a place-holder Name, really just
122 -- to agree on its unique, which gets overwritten when we read in
123 -- the binding occurence later (newImportedBinder)
124 -- The place-holder Name doesn't have the right Provenance, and its
125 -- Module won't have the right Package either
127 -- This means that a renamed program may have incorrect info
128 -- on implicitly-imported occurrences, but the correct info on the
129 -- *binding* declaration. It's the type checker that propagates the
130 -- correct information to all the occurrences.
131 -- Since implicitly-imported names never occur in error messages,
132 -- it doesn't matter that we get the correct info in place till later,
133 -- (but since it affects DLL-ery it does matter that we get it right
135 mkImportedGlobalName mod_name occ
136 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
138 key = (mod_name, occ)
140 case lookupFM cache key of
141 Just name -> returnRn name
142 Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
145 (us', us1) = splitUniqSupply us
146 uniq = uniqFromSupply us1
147 mod = mkVanillaModule mod_name
148 name = mkGlobalName uniq mod occ implicitImportProvenance
149 new_cache = addToFM cache key name
151 updateProvenances :: [Name] -> RnM d ()
152 -- Update the provenances of everything that is in scope.
153 -- We must be careful not to disturb the Module package info
154 -- already in the cache. Why not? Consider
155 -- module A module M( f )
156 -- import M( f ) import N( f)
158 -- So f is defined in N, and M re-exports it.
159 -- When processing module A:
160 -- 1. We read M.hi first, and make a vanilla name N.f
161 -- (without reading N.hi). The package info says <THIS>
162 -- for lack of anything better.
163 -- 2. Now we read N, which update the cache to record
164 -- the correct package for N.f.
165 -- 3. Finally we update provenances (once we've read all imports).
166 -- Step 3 must not destroy package info recorded in Step 2.
168 updateProvenances names
169 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
170 setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
172 update name cache = addToFM_C update_prov cache key name
174 key = (moduleName (nameModule name), nameOccName name)
176 update_prov name_in_cache name_with_prov
177 = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
181 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
182 mkImportedGlobalFromRdrName rdr_name
184 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
187 = -- An Unqual is allowed; interface files contain
188 -- unqualified names for locally-defined things, such as
189 -- constructors of a data type.
190 getModuleRn `thenRn ` \ mod_name ->
191 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
195 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
196 case lookupFM ipcache key of
197 Just name -> returnRn name
198 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
201 (us', us1) = splitUniqSupply us
202 uniq = uniqFromSupply us1
203 name = mkIPName uniq key
204 new_ipcache = addToFM ipcache key name
205 where key = (rdrNameOcc rdr_name)
208 %*********************************************************
210 \subsection{Dfuns and default methods}
212 %*********************************************************
214 @newImplicitBinder@ is used for (a) dfuns
215 (b) default methods, defined in this module.
218 newImplicitBinder occ src_loc
219 = getModuleRn `thenRn` \ mod_name ->
220 newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc
223 Make a name for the dict fun for an instance decl
226 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
227 newDFunName key@(cl_occ, tycon_occ) loc
228 = newInstUniq string `thenRn` \ inst_uniq ->
229 newImplicitBinder (mkDFunOcc string inst_uniq) loc
231 -- Any string that is somewhat unique will do
232 string = occNameString cl_occ ++ occNameString tycon_occ
236 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
237 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
238 getDFunKey (MonoFunTy _ ty) = getDFunKey ty
239 getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
241 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
242 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
243 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
244 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
245 get_tycon_key (MonoListTy _) = getOccName listTyCon
246 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
250 %*********************************************************
254 %*********************************************************
257 -------------------------------------
258 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
259 -> [(RdrName,SrcLoc)]
260 -> ([Name] -> RnMS a)
262 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
263 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
265 getLocalNameEnv `thenRn` \ name_env ->
266 (if opt_WarnNameShadowing
268 mapRn_ (check_shadow name_env) rdr_names_w_loc
273 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
274 getModeRn `thenRn` \ mode ->
276 n = length rdr_names_w_loc
277 (us', us1) = splitUniqSupply us
278 uniqs = uniqsFromSupply n us1
279 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
280 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
282 mk_name = case mode of
283 SourceMode -> mkLocalName
284 InterfaceMode -> mkImportedLocalName
285 -- Keep track of whether the name originally came from
286 -- an interface file.
288 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
291 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
293 setLocalNameEnv new_name_env (enclosed_scope names)
296 check_shadow name_env (rdr_name,loc)
297 = case lookupRdrEnv name_env rdr_name of
298 Nothing -> returnRn ()
299 Just name -> pushSrcLocRn loc $
300 addWarnRn (shadowedNameWarn rdr_name)
302 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
303 -> RnMS (a, FreeVars)
304 -- A specialised variant when renaming stuff from interface
305 -- files (of which there is a lot)
307 -- * no checks for shadowing
309 -- * deal with free vars
310 bindCoreLocalFVRn rdr_name enclosed_scope
311 = getSrcLocRn `thenRn` \ loc ->
312 getLocalNameEnv `thenRn` \ name_env ->
313 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
315 (us', us1) = splitUniqSupply us
316 uniq = uniqFromSupply us1
317 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
319 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
321 new_name_env = extendRdrEnv name_env rdr_name name
323 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
324 returnRn (result, delFromNameSet fvs name)
326 bindCoreLocalsFVRn [] thing_inside = thing_inside []
327 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
328 bindCoreLocalsFVRn bs $ \ names' ->
329 thing_inside (name':names')
331 -------------------------------------
332 bindLocalRn doc rdr_name enclosed_scope
333 = getSrcLocRn `thenRn` \ loc ->
334 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
338 bindLocalsRn doc rdr_names enclosed_scope
339 = getSrcLocRn `thenRn` \ loc ->
340 bindLocatedLocalsRn doc
341 (rdr_names `zip` repeat loc)
344 -- binLocalsFVRn is the same as bindLocalsRn
345 -- except that it deals with free vars
346 bindLocalsFVRn doc rdr_names enclosed_scope
347 = bindLocalsRn doc rdr_names $ \ names ->
348 enclosed_scope names `thenRn` \ (thing, fvs) ->
349 returnRn (thing, delListFromNameSet fvs names)
351 -------------------------------------
352 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
353 bindUVarRn = bindLocalRn
355 -------------------------------------
356 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
357 -- This tiresome function is used only in rnDecl on InstDecl
358 extendTyVarEnvFVRn tyvars enclosed_scope
359 = getLocalNameEnv `thenRn` \ env ->
361 tyvar_names = map getTyVarName tyvars
362 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
363 | name <- tyvar_names
366 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
367 returnRn (thing, delListFromNameSet fvs tyvar_names)
369 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
370 -> ([HsTyVar Name] -> RnMS a)
372 bindTyVarsRn doc_str tyvar_names enclosed_scope
373 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
374 enclosed_scope tyvars
376 -- Gruesome name: return Names as well as HsTyVars
377 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
378 -> ([Name] -> [HsTyVar Name] -> RnMS a)
380 bindTyVars2Rn doc_str tyvar_names enclosed_scope
381 = getSrcLocRn `thenRn` \ loc ->
383 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
385 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
386 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
388 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
389 -> ([HsTyVar Name] -> RnMS (a, FreeVars))
390 -> RnMS (a, FreeVars)
391 bindTyVarsFVRn doc_str rdr_names enclosed_scope
392 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
393 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
394 returnRn (thing, delListFromNameSet fvs names)
396 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
397 -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars))
398 -> RnMS (a, FreeVars)
399 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
400 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
401 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
402 returnRn (thing, delListFromNameSet fvs names)
405 -------------------------------------
406 checkDupOrQualNames, checkDupNames :: SDoc
407 -> [(RdrName, SrcLoc)]
409 -- Works in any variant of the renamer monad
411 checkDupOrQualNames doc_str rdr_names_w_loc
412 = -- Check for use of qualified names
413 mapRn_ (qualNameErr doc_str) quals `thenRn_`
414 checkDupNames doc_str rdr_names_w_loc
416 quals = filter (isQual.fst) rdr_names_w_loc
418 checkDupNames doc_str rdr_names_w_loc
419 = -- Check for duplicated names in a binding group
420 mapRn_ (dupNamesErr doc_str) dups
422 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
426 %*********************************************************
428 \subsection{Looking up names}
430 %*********************************************************
432 Looking up a name in the RnEnv.
435 lookupBndrRn rdr_name
436 = getNameEnvs `thenRn` \ (global_env, local_env) ->
439 case lookupRdrEnv local_env rdr_name of {
440 Just name -> returnRn name ;
443 getModeRn `thenRn` \ mode ->
445 InterfaceMode -> -- Look in the global name cache
446 mkImportedGlobalFromRdrName rdr_name
448 SourceMode -> -- Source mode, so look up a *qualified* version
449 -- of the name, so that we get the right one even
450 -- if there are many with the same occ name
451 -- There must *be* a binding
452 getModuleRn `thenRn` \ mod ->
453 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
454 Just (name:rest) -> ASSERT( null rest )
456 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
459 -- Just like lookupRn except that we record the occurrence too
460 -- Perhaps surprisingly, even wired-in names are recorded.
461 -- Why? So that we know which wired-in names are referred to when
462 -- deciding which instance declarations to import.
463 lookupOccRn :: RdrName -> RnMS Name
465 = getNameEnvs `thenRn` \ (global_env, local_env) ->
466 lookup_occ global_env local_env rdr_name
468 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
469 -- environment. It's used only for
470 -- record field names
471 -- class op names in class and instance decls
472 lookupGlobalOccRn :: RdrName -> RnMS Name
473 lookupGlobalOccRn rdr_name
474 = getNameEnvs `thenRn` \ (global_env, local_env) ->
475 lookup_global_occ global_env rdr_name
477 -- Look in both local and global env
478 lookup_occ global_env local_env rdr_name
479 = case lookupRdrEnv local_env rdr_name of
480 Just name -> returnRn name
481 Nothing -> lookup_global_occ global_env rdr_name
483 -- Look in global env only
484 lookup_global_occ global_env rdr_name
485 = case lookupRdrEnv global_env rdr_name of
486 Just [name] -> returnRn name
487 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
489 Nothing -> getModeRn `thenRn` \ mode ->
491 -- Not found when processing source code; so fail
492 SourceMode -> failWithRn (mkUnboundName rdr_name)
493 (unknownNameErr rdr_name)
495 -- Not found when processing an imported declaration,
496 -- so we create a new name for the purpose
497 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
500 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
501 and adds it to the occurrence pool so that it'll be loaded later.
502 This is used when language constructs
503 (such as monad comprehensions, overloaded literals, or deriving clauses)
504 require some stuff to be loaded that isn't explicitly mentioned in the code.
506 This doesn't apply in interface mode, where everything is explicit,
507 but we don't check for this case:
508 it does no harm to record an ``extra'' occurrence
509 and @lookupImplicitOccRn@ isn't used much in interface mode
510 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
512 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
514 For List and Tuple types it's important to get the correct
515 @isLocallyDefined@ flag, which is used in turn when deciding
516 whether there are any instance decls in this module are ``special''.
517 The name cache should have the correct provenance, though.
520 lookupImplicitOccRn :: RdrName -> RnM d Name
521 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
524 @unQualInScope@ returns a function that takes a @Name@ and tells whether
525 its unqualified name is in scope. This is put as a boolean flag in
526 the @Name@'s provenance to guide whether or not to print the name qualified
530 unQualInScope :: GlobalRdrEnv -> Name -> Bool
534 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
535 Just [name'] -> name == name'
539 %************************************************************************
541 \subsection{Envt utility functions}
543 %************************************************************************
545 \subsubsection{NameEnv}% ================
548 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
549 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
551 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
552 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
554 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
555 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
557 combine_globals :: [Name] -- Old
560 combine_globals ns_old ns_new -- ns_new is often short
561 = foldr add ns_old ns_new
563 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
566 choose n' | n==n' && better_provenance n n' = n
570 -- a local thing over an imported thing
571 -- a user-imported thing over a non-user-imported thing
572 -- an explicitly-imported thing over an implicitly imported thing
573 better_provenance n1 n2
574 = case (getNameProvenance n1, getNameProvenance n2) of
575 (LocalDef _ _, _ ) -> True
576 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
577 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
580 is_duplicate :: Name -> Name -> Bool
581 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
582 | otherwise = n1 == n2
584 We treat two bindings of a locally-defined name as a duplicate,
585 because they might be two separate, local defns and we want to report
586 and error for that, {\em not} eliminate a duplicate.
588 On the other hand, if you import the same name from two different
589 import statements, we {\em d}* want to eliminate the duplicate, not report
592 If a module imports itself then there might be a local defn and an imported
593 defn of the same name; in this case the names will compare as equal, but
594 will still have different provenances.
598 \subsubsection{ExportAvails}% ================
601 mkEmptyExportAvails :: ModuleName -> ExportAvails
602 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
604 mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
605 mkExportAvails mod_name unqual_imp name_env avails
606 = (mod_avail_env, entity_avail_env)
608 mod_avail_env = unitFM mod_name unqual_avails
610 -- unqual_avails is the Avails that are visible in *unqualfied* form
611 -- (1.4 Report, Section 5.1.1)
613 -- import T hiding( f )
614 -- we delete f from avails
616 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
617 | otherwise = mapMaybe prune avails
619 prune (Avail n) | unqual_in_scope n = Just (Avail n)
620 prune (Avail n) | otherwise = Nothing
621 prune (AvailTC n ns) | null uqs = Nothing
622 | otherwise = Just (AvailTC n uqs)
624 uqs = filter unqual_in_scope ns
626 unqual_in_scope n = unQualInScope name_env n
628 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
629 name <- availNames avail]
631 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
632 plusExportAvails (m1, e1) (m2, e2)
633 = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
634 -- ToDo: wasteful: we do this once for each constructor!
638 \subsubsection{AvailInfo}% ================
641 plusAvail (Avail n1) (Avail n2) = Avail n1
642 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
645 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
648 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
649 addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
651 emptyAvailEnv = emptyNameEnv
652 unitAvailEnv :: AvailInfo -> AvailEnv
653 unitAvailEnv a = unitNameEnv (availName a) a
655 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
656 plusAvailEnv = plusNameEnv_C plusAvail
658 availEnvElts = nameEnvElts
660 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
661 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
663 availsToNameSet :: [AvailInfo] -> NameSet
664 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
666 availName :: AvailInfo -> Name
667 availName (Avail n) = n
668 availName (AvailTC n _) = n
670 availNames :: AvailInfo -> [Name]
671 availNames (Avail n) = [n]
672 availNames (AvailTC n ns) = ns
674 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
675 addSysAvails avail [] = avail
676 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
678 filterAvail :: RdrNameIE -- Wanted
679 -> AvailInfo -- Available
680 -> Maybe AvailInfo -- Resulting available;
681 -- Nothing if (any of the) wanted stuff isn't there
683 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
684 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
685 | otherwise = Nothing
687 is_wanted name = nameOccName name `elem` wanted_occs
688 sub_names_ok = all (`elem` avail_occs) wanted_occs
689 avail_occs = map nameOccName ns
690 wanted_occs = map rdrNameOcc (want:wants)
692 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
695 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
697 filterAvail (IEVar _) avail@(Avail n) = Just avail
698 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
700 wanted n = nameOccName n == occ
702 -- The second equation happens if we import a class op, thus
704 -- where op is a class operation
706 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
707 -- We don't complain even if the IE says T(..), but
708 -- no constrs/class ops of T are available
709 -- Instead that's caught with a warning by the caller
711 filterAvail ie avail = Nothing
713 pprAvail :: AvailInfo -> SDoc
714 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
716 ns' -> parens (hsep (punctuate comma (map ppr ns')))
718 pprAvail (Avail n) = ppr n
724 %************************************************************************
726 \subsection{Free variable manipulation}
728 %************************************************************************
731 type FreeVars = NameSet
733 plusFV :: FreeVars -> FreeVars -> FreeVars
734 addOneFV :: FreeVars -> Name -> FreeVars
735 unitFV :: Name -> FreeVars
737 plusFVs :: [FreeVars] -> FreeVars
739 isEmptyFVs = isEmptyNameSet
740 emptyFVs = emptyNameSet
741 plusFVs = unionManyNameSets
742 plusFV = unionNameSets
744 -- No point in adding implicitly imported names to the free-var set
745 addOneFV s n = addOneToNameSet s n
746 unitFV n = unitNameSet n
749 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
751 (ys, fvs_s) = unzip stuff
753 returnRn (ys, plusFVs fvs_s)
757 %************************************************************************
759 \subsection{Envt utility functions}
761 %************************************************************************
766 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
768 warnUnusedImports names
769 | not opt_WarnUnusedImports
770 = returnRn () -- Don't force names unless necessary
772 = warnUnusedBinds (const True) names
774 warnUnusedLocalBinds ns
775 | not opt_WarnUnusedBinds = returnRn ()
776 | otherwise = warnUnusedBinds (const True) ns
778 warnUnusedMatches names
779 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
780 | otherwise = returnRn ()
782 -------------------------
784 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
785 warnUnusedBinds warn_when_local names
786 = mapRn_ (warnUnusedGroup warn_when_local) groups
788 -- Group by provenance
789 groups = equivClasses cmp names
790 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
792 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
793 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
794 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
795 (NonLocalDef (UserImport m2 loc2 _) _) =
796 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
797 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
798 -- In-scope NonLocalDefs must have UserImport info on them
800 -------------------------
802 -- NOTE: the function passed to warnUnusedGroup is
803 -- now always (const True) so we should be able to
804 -- simplify the code slightly. I'm leaving it there
805 -- for now just in case I havn't realised why it was there.
806 -- Looks highly bogus to me. SLPJ Dec 99
808 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
809 warnUnusedGroup emit_warning names
810 | null filtered_names = returnRn ()
811 | not (emit_warning is_local) = returnRn ()
813 = pushSrcLocRn def_loc $
815 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
817 filtered_names = filter reportable names
818 name1 = head filtered_names
819 (is_local, def_loc, msg)
820 = case getNameProvenance name1 of
821 LocalDef loc _ -> (True, loc, text "Defined but not used")
822 NonLocalDef (UserImport mod loc _) _ ->
823 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
825 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
827 reportable name = case occNameUserString (nameOccName name) of
830 -- Haskell 98 encourages compilers to suppress warnings about
831 -- unused names in a pattern if they start with "_".
835 addNameClashErrRn rdr_name (name1:names)
836 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
837 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
839 msg1 = ptext SLIT("either") <+> mk_ref name1
840 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
841 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
843 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
844 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
845 4 (vcat [ppr how_in_scope1,
848 shadowedNameWarn shadow
849 = hsep [ptext SLIT("This binding for"),
851 ptext SLIT("shadows an existing binding")]
854 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
856 flavour = occNameFlavour (rdrNameOcc name)
858 qualNameErr descriptor (name,loc)
860 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
865 dupNamesErr descriptor ((name,loc) : dup_things)
867 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
869 (ptext SLIT("in") <+> descriptor))