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 -> 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 -> implicitImportProvenance)
77 implicitImportProvenance = NonLocalDef ImplicitImport False
79 newTopBinder :: Module -> OccName -> (Name -> Provenance) -> RnM d Name
80 newTopBinder mod occ mk_prov
81 = -- First check the cache
82 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
84 key = (moduleName mod, occ)
86 case lookupFM cache key of
88 -- A hit in the cache! Re-use the unique (which may be widely known)
89 -- But otherwise build a new name, thereby
90 -- overwriting whatever module details and provenance is in the cache already;
91 -- This updates WiredIn things and known-key things, which are there from the start.
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 | isWiredInName name = setNameProvenance name (mk_prov name)
103 | otherwise = mkGlobalName (nameUnique name) mod occ (mk_prov name)
104 new_cache = addToFM cache key new_name
106 setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_`
109 -- Miss in the cache!
110 -- Build a completely new Name, and put it in the cache
112 (us', us1) = splitUniqSupply us
113 uniq = uniqFromSupply us1
114 new_name = mkGlobalName uniq mod occ (mk_prov new_name)
115 new_cache = addToFM cache key new_name
117 setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
121 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
122 -- Used for *occurrences*. We make a place-holder Name, really just
123 -- to agree on its unique, which gets overwritten when we read in
124 -- the binding occurence later (newImportedBinder)
125 -- The place-holder Name doesn't have the right Provenance, and its
126 -- Module won't have the right Package either
128 -- This means that a renamed program may have incorrect info
129 -- on implicitly-imported occurrences, but the correct info on the
130 -- *binding* declaration. It's the type checker that propagates the
131 -- correct information to all the occurrences.
132 -- Since implicitly-imported names never occur in error messages,
133 -- it doesn't matter that we get the correct info in place till later,
134 -- (but since it affects DLL-ery it does matter that we get it right
136 mkImportedGlobalName mod_name occ
137 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
139 key = (mod_name, occ)
141 case lookupFM cache key of
142 Just name -> returnRn name
143 Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
146 (us', us1) = splitUniqSupply us
147 uniq = uniqFromSupply us1
148 mod = mkVanillaModule mod_name
149 name = mkGlobalName uniq mod occ implicitImportProvenance
150 new_cache = addToFM cache key name
152 updateProvenances :: [Name] -> RnM d ()
153 updateProvenances names
154 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
155 setNameSupplyRn (us, inst_ns, update cache names, ipcache)
157 update cache [] = cache
158 update cache (name:names) = WARN( not (key `elemFM` cache), ppr name )
159 update (addToFM cache key name) names
161 key = (moduleName (nameModule name), nameOccName name)
164 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
165 mkImportedGlobalFromRdrName rdr_name
167 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
170 = -- An Unqual is allowed; interface files contain
171 -- unqualified names for locally-defined things, such as
172 -- constructors of a data type.
173 getModuleRn `thenRn ` \ mod_name ->
174 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
178 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
179 case lookupFM ipcache key of
180 Just name -> returnRn name
181 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
184 (us', us1) = splitUniqSupply us
185 uniq = uniqFromSupply us1
186 name = mkIPName uniq key
187 new_ipcache = addToFM ipcache key name
188 where key = (rdrNameOcc rdr_name)
191 %*********************************************************
193 \subsection{Dfuns and default methods}
195 %*********************************************************
197 @newImplicitBinder@ is used for (a) dfuns
198 (b) default methods, defined in this module.
201 newImplicitBinder occ src_loc
202 = getModuleRn `thenRn` \ mod_name ->
203 newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc
206 Make a name for the dict fun for an instance decl
209 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
210 newDFunName key@(cl_occ, tycon_occ) loc
211 = newInstUniq string `thenRn` \ inst_uniq ->
212 newImplicitBinder (mkDFunOcc string inst_uniq) loc
214 -- Any string that is somewhat unique will do
215 string = occNameString cl_occ ++ occNameString tycon_occ
219 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
220 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
221 getDFunKey (MonoFunTy _ ty) = getDFunKey ty
222 getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
224 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
225 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
226 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
227 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
228 get_tycon_key (MonoListTy _) = getOccName listTyCon
229 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
233 %*********************************************************
237 %*********************************************************
240 -------------------------------------
241 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
242 -> [(RdrName,SrcLoc)]
243 -> ([Name] -> RnMS a)
245 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
246 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
248 getLocalNameEnv `thenRn` \ name_env ->
249 (if opt_WarnNameShadowing
251 mapRn_ (check_shadow name_env) rdr_names_w_loc
256 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
257 getModeRn `thenRn` \ mode ->
259 n = length rdr_names_w_loc
260 (us', us1) = splitUniqSupply us
261 uniqs = uniqsFromSupply n us1
262 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
263 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
265 mk_name = case mode of
266 SourceMode -> mkLocalName
267 InterfaceMode -> mkImportedLocalName
268 -- Keep track of whether the name originally came from
269 -- an interface file.
271 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
274 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
276 setLocalNameEnv new_name_env (enclosed_scope names)
279 check_shadow name_env (rdr_name,loc)
280 = case lookupRdrEnv name_env rdr_name of
281 Nothing -> returnRn ()
282 Just name -> pushSrcLocRn loc $
283 addWarnRn (shadowedNameWarn rdr_name)
285 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
286 -> RnMS (a, FreeVars)
287 -- A specialised variant when renaming stuff from interface
288 -- files (of which there is a lot)
290 -- * no checks for shadowing
292 -- * deal with free vars
293 bindCoreLocalFVRn rdr_name enclosed_scope
294 = getSrcLocRn `thenRn` \ loc ->
295 getLocalNameEnv `thenRn` \ name_env ->
296 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
298 (us', us1) = splitUniqSupply us
299 uniq = uniqFromSupply us1
300 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
302 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
304 new_name_env = extendRdrEnv name_env rdr_name name
306 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
307 returnRn (result, delFromNameSet fvs name)
309 bindCoreLocalsFVRn [] thing_inside = thing_inside []
310 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
311 bindCoreLocalsFVRn bs $ \ names' ->
312 thing_inside (name':names')
314 -------------------------------------
315 bindLocalRn doc rdr_name enclosed_scope
316 = getSrcLocRn `thenRn` \ loc ->
317 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
321 bindLocalsRn doc rdr_names enclosed_scope
322 = getSrcLocRn `thenRn` \ loc ->
323 bindLocatedLocalsRn doc
324 (rdr_names `zip` repeat loc)
327 -- binLocalsFVRn is the same as bindLocalsRn
328 -- except that it deals with free vars
329 bindLocalsFVRn doc rdr_names enclosed_scope
330 = bindLocalsRn doc rdr_names $ \ names ->
331 enclosed_scope names `thenRn` \ (thing, fvs) ->
332 returnRn (thing, delListFromNameSet fvs names)
334 -------------------------------------
335 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
336 bindUVarRn = bindLocalRn
338 -------------------------------------
339 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
340 -- This tiresome function is used only in rnDecl on InstDecl
341 extendTyVarEnvFVRn tyvars enclosed_scope
342 = getLocalNameEnv `thenRn` \ env ->
344 tyvar_names = map getTyVarName tyvars
345 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
346 | name <- tyvar_names
349 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
350 returnRn (thing, delListFromNameSet fvs tyvar_names)
352 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
353 -> ([HsTyVar Name] -> RnMS a)
355 bindTyVarsRn doc_str tyvar_names enclosed_scope
356 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
357 enclosed_scope tyvars
359 -- Gruesome name: return Names as well as HsTyVars
360 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
361 -> ([Name] -> [HsTyVar Name] -> RnMS a)
363 bindTyVars2Rn doc_str tyvar_names enclosed_scope
364 = getSrcLocRn `thenRn` \ loc ->
366 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
368 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
369 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
371 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
372 -> ([HsTyVar Name] -> RnMS (a, FreeVars))
373 -> RnMS (a, FreeVars)
374 bindTyVarsFVRn doc_str rdr_names enclosed_scope
375 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
376 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
377 returnRn (thing, delListFromNameSet fvs names)
379 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
380 -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars))
381 -> RnMS (a, FreeVars)
382 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
383 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
384 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
385 returnRn (thing, delListFromNameSet fvs names)
388 -------------------------------------
389 checkDupOrQualNames, checkDupNames :: SDoc
390 -> [(RdrName, SrcLoc)]
392 -- Works in any variant of the renamer monad
394 checkDupOrQualNames doc_str rdr_names_w_loc
395 = -- Check for use of qualified names
396 mapRn_ (qualNameErr doc_str) quals `thenRn_`
397 checkDupNames doc_str rdr_names_w_loc
399 quals = filter (isQual.fst) rdr_names_w_loc
401 checkDupNames doc_str rdr_names_w_loc
402 = -- Check for duplicated names in a binding group
403 mapRn_ (dupNamesErr doc_str) dups
405 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
409 %*********************************************************
411 \subsection{Looking up names}
413 %*********************************************************
415 Looking up a name in the RnEnv.
418 lookupBndrRn rdr_name
419 = getNameEnvs `thenRn` \ (global_env, local_env) ->
422 case lookupRdrEnv local_env rdr_name of {
423 Just name -> returnRn name ;
426 getModeRn `thenRn` \ mode ->
428 InterfaceMode -> -- Look in the global name cache
429 mkImportedGlobalFromRdrName rdr_name
431 SourceMode -> -- Source mode, so look up a *qualified* version
432 -- of the name, so that we get the right one even
433 -- if there are many with the same occ name
434 -- There must *be* a binding
435 getModuleRn `thenRn` \ mod ->
436 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
437 Just (name:rest) -> ASSERT( null rest )
439 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
442 -- Just like lookupRn except that we record the occurrence too
443 -- Perhaps surprisingly, even wired-in names are recorded.
444 -- Why? So that we know which wired-in names are referred to when
445 -- deciding which instance declarations to import.
446 lookupOccRn :: RdrName -> RnMS Name
448 = getNameEnvs `thenRn` \ (global_env, local_env) ->
449 lookup_occ global_env local_env rdr_name
451 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
452 -- environment. It's used only for
453 -- record field names
454 -- class op names in class and instance decls
455 lookupGlobalOccRn :: RdrName -> RnMS Name
456 lookupGlobalOccRn rdr_name
457 = getNameEnvs `thenRn` \ (global_env, local_env) ->
458 lookup_global_occ global_env rdr_name
460 -- Look in both local and global env
461 lookup_occ global_env local_env rdr_name
462 = case lookupRdrEnv local_env rdr_name of
463 Just name -> returnRn name
464 Nothing -> lookup_global_occ global_env rdr_name
466 -- Look in global env only
467 lookup_global_occ global_env rdr_name
468 = case lookupRdrEnv global_env rdr_name of
469 Just [name] -> returnRn name
470 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
472 Nothing -> getModeRn `thenRn` \ mode ->
474 -- Not found when processing source code; so fail
475 SourceMode -> failWithRn (mkUnboundName rdr_name)
476 (unknownNameErr rdr_name)
478 -- Not found when processing an imported declaration,
479 -- so we create a new name for the purpose
480 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
483 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
484 and adds it to the occurrence pool so that it'll be loaded later.
485 This is used when language constructs
486 (such as monad comprehensions, overloaded literals, or deriving clauses)
487 require some stuff to be loaded that isn't explicitly mentioned in the code.
489 This doesn't apply in interface mode, where everything is explicit,
490 but we don't check for this case:
491 it does no harm to record an ``extra'' occurrence
492 and @lookupImplicitOccRn@ isn't used much in interface mode
493 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
495 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
497 For List and Tuple types it's important to get the correct
498 @isLocallyDefined@ flag, which is used in turn when deciding
499 whether there are any instance decls in this module are ``special''.
500 The name cache should have the correct provenance, though.
503 lookupImplicitOccRn :: RdrName -> RnM d Name
504 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
507 @unQualInScope@ returns a function that takes a @Name@ and tells whether
508 its unqualified name is in scope. This is put as a boolean flag in
509 the @Name@'s provenance to guide whether or not to print the name qualified
513 unQualInScope :: GlobalRdrEnv -> Name -> Bool
517 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
518 Just [name'] -> name == name'
522 %************************************************************************
524 \subsection{Envt utility functions}
526 %************************************************************************
528 \subsubsection{NameEnv}% ================
531 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
532 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
534 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
535 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
537 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
538 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
540 combine_globals :: [Name] -- Old
543 combine_globals ns_old ns_new -- ns_new is often short
544 = foldr add ns_old ns_new
546 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
549 choose n' | n==n' && better_provenance n n' = n
553 -- a local thing over an imported thing
554 -- a user-imported thing over a non-user-imported thing
555 -- an explicitly-imported thing over an implicitly imported thing
556 better_provenance n1 n2
557 = case (getNameProvenance n1, getNameProvenance n2) of
558 (LocalDef _ _, _ ) -> True
559 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
560 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
563 is_duplicate :: Name -> Name -> Bool
564 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
565 | otherwise = 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 d}* 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.
581 \subsubsection{ExportAvails}% ================
584 mkEmptyExportAvails :: ModuleName -> ExportAvails
585 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
587 mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
588 mkExportAvails mod_name unqual_imp name_env avails
589 = (mod_avail_env, entity_avail_env)
591 mod_avail_env = unitFM mod_name unqual_avails
593 -- unqual_avails is the Avails that are visible in *unqualfied* form
594 -- (1.4 Report, Section 5.1.1)
596 -- import T hiding( f )
597 -- we delete f from avails
599 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
600 | otherwise = mapMaybe prune avails
602 prune (Avail n) | unqual_in_scope n = Just (Avail n)
603 prune (Avail n) | otherwise = Nothing
604 prune (AvailTC n ns) | null uqs = Nothing
605 | otherwise = Just (AvailTC n uqs)
607 uqs = filter unqual_in_scope ns
609 unqual_in_scope n = unQualInScope name_env n
611 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
612 name <- availNames avail]
614 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
615 plusExportAvails (m1, e1) (m2, e2)
616 = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
617 -- ToDo: wasteful: we do this once for each constructor!
621 \subsubsection{AvailInfo}% ================
624 plusAvail (Avail n1) (Avail n2) = Avail n1
625 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
628 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
631 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
632 addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
634 emptyAvailEnv = emptyNameEnv
635 unitAvailEnv :: AvailInfo -> AvailEnv
636 unitAvailEnv a = unitNameEnv (availName a) a
638 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
639 plusAvailEnv = plusNameEnv_C plusAvail
641 availEnvElts = nameEnvElts
643 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
644 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
646 availsToNameSet :: [AvailInfo] -> NameSet
647 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
649 availName :: AvailInfo -> Name
650 availName (Avail n) = n
651 availName (AvailTC n _) = n
653 availNames :: AvailInfo -> [Name]
654 availNames (Avail n) = [n]
655 availNames (AvailTC n ns) = ns
657 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
658 addSysAvails avail [] = avail
659 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
661 filterAvail :: RdrNameIE -- Wanted
662 -> AvailInfo -- Available
663 -> Maybe AvailInfo -- Resulting available;
664 -- Nothing if (any of the) wanted stuff isn't there
666 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
667 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
668 | otherwise = Nothing
670 is_wanted name = nameOccName name `elem` wanted_occs
671 sub_names_ok = all (`elem` avail_occs) wanted_occs
672 avail_occs = map nameOccName ns
673 wanted_occs = map rdrNameOcc (want:wants)
675 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
678 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
680 filterAvail (IEVar _) avail@(Avail n) = Just avail
681 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
683 wanted n = nameOccName n == occ
685 -- The second equation happens if we import a class op, thus
687 -- where op is a class operation
689 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
690 -- We don't complain even if the IE says T(..), but
691 -- no constrs/class ops of T are available
692 -- Instead that's caught with a warning by the caller
694 filterAvail ie avail = Nothing
696 pprAvail :: AvailInfo -> SDoc
697 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
699 ns' -> parens (hsep (punctuate comma (map ppr ns')))
701 pprAvail (Avail n) = ppr n
707 %************************************************************************
709 \subsection{Free variable manipulation}
711 %************************************************************************
714 type FreeVars = NameSet
716 plusFV :: FreeVars -> FreeVars -> FreeVars
717 addOneFV :: FreeVars -> Name -> FreeVars
718 unitFV :: Name -> FreeVars
720 plusFVs :: [FreeVars] -> FreeVars
722 isEmptyFVs = isEmptyNameSet
723 emptyFVs = emptyNameSet
724 plusFVs = unionManyNameSets
725 plusFV = unionNameSets
727 -- No point in adding implicitly imported names to the free-var set
728 addOneFV s n = addOneToNameSet s n
729 unitFV n = unitNameSet n
732 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
734 (ys, fvs_s) = unzip stuff
736 returnRn (ys, plusFVs fvs_s)
740 %************************************************************************
742 \subsection{Envt utility functions}
744 %************************************************************************
749 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
751 warnUnusedImports names
752 | not opt_WarnUnusedImports
753 = returnRn () -- Don't force names unless necessary
755 = warnUnusedBinds (const True) names
757 warnUnusedLocalBinds ns
758 | not opt_WarnUnusedBinds = returnRn ()
759 | otherwise = warnUnusedBinds (const True) ns
761 warnUnusedMatches names
762 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
763 | otherwise = returnRn ()
765 -------------------------
767 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
768 warnUnusedBinds warn_when_local names
769 = mapRn_ (warnUnusedGroup warn_when_local) groups
771 -- Group by provenance
772 groups = equivClasses cmp names
773 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
775 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
776 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
777 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
778 (NonLocalDef (UserImport m2 loc2 _) _) =
779 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
780 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
781 -- In-scope NonLocalDefs must have UserImport info on them
783 -------------------------
785 -- NOTE: the function passed to warnUnusedGroup is
786 -- now always (const True) so we should be able to
787 -- simplify the code slightly. I'm leaving it there
788 -- for now just in case I havn't realised why it was there.
789 -- Looks highly bogus to me. SLPJ Dec 99
791 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
792 warnUnusedGroup emit_warning names
793 | null filtered_names = returnRn ()
794 | not (emit_warning is_local) = returnRn ()
796 = pushSrcLocRn def_loc $
798 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
800 filtered_names = filter reportable names
801 name1 = head filtered_names
802 (is_local, def_loc, msg)
803 = case getNameProvenance name1 of
804 LocalDef loc _ -> (True, loc, text "Defined but not used")
805 NonLocalDef (UserImport mod loc _) _ ->
806 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
808 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
810 reportable name = case occNameUserString (nameOccName name) of
813 -- Haskell 98 encourages compilers to suppress warnings about
814 -- unused names in a pattern if they start with "_".
818 addNameClashErrRn rdr_name (name1:names)
819 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
820 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
822 msg1 = ptext SLIT("either") <+> mk_ref name1
823 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
824 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
826 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
827 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
828 4 (vcat [ppr how_in_scope1,
831 shadowedNameWarn shadow
832 = hsep [ptext SLIT("This binding for"),
834 ptext SLIT("shadows an existing binding")]
837 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
839 flavour = occNameFlavour (rdrNameOcc name)
841 qualNameErr descriptor (name,loc)
843 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
848 dupNamesErr descriptor ((name,loc) : dup_things)
850 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
852 (ptext SLIT("in") <+> descriptor))