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 updateProvenances names
153 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
154 setNameSupplyRn (us, inst_ns, update cache names, ipcache)
156 update cache [] = cache
157 update cache (name:names) = WARN( not (key `elemFM` cache), ppr name )
158 update (addToFM cache key name) names
160 key = (moduleName (nameModule name), nameOccName name)
163 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
164 mkImportedGlobalFromRdrName rdr_name
166 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
169 = -- An Unqual is allowed; interface files contain
170 -- unqualified names for locally-defined things, such as
171 -- constructors of a data type.
172 getModuleRn `thenRn ` \ mod_name ->
173 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
177 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
178 case lookupFM ipcache key of
179 Just name -> returnRn name
180 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
183 (us', us1) = splitUniqSupply us
184 uniq = uniqFromSupply us1
185 name = mkIPName uniq key
186 new_ipcache = addToFM ipcache key name
187 where key = (rdrNameOcc rdr_name)
190 %*********************************************************
192 \subsection{Dfuns and default methods}
194 %*********************************************************
196 @newImplicitBinder@ is used for (a) dfuns
197 (b) default methods, defined in this module.
200 newImplicitBinder occ src_loc
201 = getModuleRn `thenRn` \ mod_name ->
202 newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc
205 Make a name for the dict fun for an instance decl
208 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
209 newDFunName key@(cl_occ, tycon_occ) loc
210 = newInstUniq string `thenRn` \ inst_uniq ->
211 newImplicitBinder (mkDFunOcc string inst_uniq) loc
213 -- Any string that is somewhat unique will do
214 string = occNameString cl_occ ++ occNameString tycon_occ
218 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
219 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
220 getDFunKey (MonoFunTy _ ty) = getDFunKey ty
221 getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
223 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
224 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
225 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
226 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
227 get_tycon_key (MonoListTy _) = getOccName listTyCon
228 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
232 %*********************************************************
236 %*********************************************************
239 -------------------------------------
240 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
241 -> [(RdrName,SrcLoc)]
242 -> ([Name] -> RnMS a)
244 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
245 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
247 getLocalNameEnv `thenRn` \ name_env ->
248 (if opt_WarnNameShadowing
250 mapRn_ (check_shadow name_env) rdr_names_w_loc
255 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
256 getModeRn `thenRn` \ mode ->
258 n = length rdr_names_w_loc
259 (us', us1) = splitUniqSupply us
260 uniqs = uniqsFromSupply n us1
261 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
262 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
264 mk_name = case mode of
265 SourceMode -> mkLocalName
266 InterfaceMode -> mkImportedLocalName
267 -- Keep track of whether the name originally came from
268 -- an interface file.
270 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
273 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
275 setLocalNameEnv new_name_env (enclosed_scope names)
278 check_shadow name_env (rdr_name,loc)
279 = case lookupRdrEnv name_env rdr_name of
280 Nothing -> returnRn ()
281 Just name -> pushSrcLocRn loc $
282 addWarnRn (shadowedNameWarn rdr_name)
284 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
285 -> RnMS (a, FreeVars)
286 -- A specialised variant when renaming stuff from interface
287 -- files (of which there is a lot)
289 -- * no checks for shadowing
291 -- * deal with free vars
292 bindCoreLocalFVRn rdr_name enclosed_scope
293 = getSrcLocRn `thenRn` \ loc ->
294 getLocalNameEnv `thenRn` \ name_env ->
295 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
297 (us', us1) = splitUniqSupply us
298 uniq = uniqFromSupply us1
299 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
301 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
303 new_name_env = extendRdrEnv name_env rdr_name name
305 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
306 returnRn (result, delFromNameSet fvs name)
308 bindCoreLocalsFVRn [] thing_inside = thing_inside []
309 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
310 bindCoreLocalsFVRn bs $ \ names' ->
311 thing_inside (name':names')
313 -------------------------------------
314 bindLocalRn doc rdr_name enclosed_scope
315 = getSrcLocRn `thenRn` \ loc ->
316 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
320 bindLocalsRn doc rdr_names enclosed_scope
321 = getSrcLocRn `thenRn` \ loc ->
322 bindLocatedLocalsRn doc
323 (rdr_names `zip` repeat loc)
326 -- binLocalsFVRn is the same as bindLocalsRn
327 -- except that it deals with free vars
328 bindLocalsFVRn doc rdr_names enclosed_scope
329 = bindLocalsRn doc rdr_names $ \ names ->
330 enclosed_scope names `thenRn` \ (thing, fvs) ->
331 returnRn (thing, delListFromNameSet fvs names)
333 -------------------------------------
334 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
335 bindUVarRn = bindLocalRn
337 -------------------------------------
338 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
339 -- This tiresome function is used only in rnDecl on InstDecl
340 extendTyVarEnvFVRn tyvars enclosed_scope
341 = getLocalNameEnv `thenRn` \ env ->
343 tyvar_names = map getTyVarName tyvars
344 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
345 | name <- tyvar_names
348 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
349 returnRn (thing, delListFromNameSet fvs tyvar_names)
351 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
352 -> ([HsTyVar Name] -> RnMS a)
354 bindTyVarsRn doc_str tyvar_names enclosed_scope
355 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
356 enclosed_scope tyvars
358 -- Gruesome name: return Names as well as HsTyVars
359 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
360 -> ([Name] -> [HsTyVar Name] -> RnMS a)
362 bindTyVars2Rn doc_str tyvar_names enclosed_scope
363 = getSrcLocRn `thenRn` \ loc ->
365 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
367 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
368 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
370 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
371 -> ([HsTyVar Name] -> RnMS (a, FreeVars))
372 -> RnMS (a, FreeVars)
373 bindTyVarsFVRn doc_str rdr_names enclosed_scope
374 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
375 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
376 returnRn (thing, delListFromNameSet fvs names)
378 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
379 -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars))
380 -> RnMS (a, FreeVars)
381 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
382 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
383 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
384 returnRn (thing, delListFromNameSet fvs names)
387 -------------------------------------
388 checkDupOrQualNames, checkDupNames :: SDoc
389 -> [(RdrName, SrcLoc)]
391 -- Works in any variant of the renamer monad
393 checkDupOrQualNames doc_str rdr_names_w_loc
394 = -- Check for use of qualified names
395 mapRn_ (qualNameErr doc_str) quals `thenRn_`
396 checkDupNames doc_str rdr_names_w_loc
398 quals = filter (isQual.fst) rdr_names_w_loc
400 checkDupNames doc_str rdr_names_w_loc
401 = -- Check for duplicated names in a binding group
402 mapRn_ (dupNamesErr doc_str) dups
404 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
408 %*********************************************************
410 \subsection{Looking up names}
412 %*********************************************************
414 Looking up a name in the RnEnv.
417 lookupBndrRn rdr_name
418 = getNameEnvs `thenRn` \ (global_env, local_env) ->
421 case lookupRdrEnv local_env rdr_name of {
422 Just name -> returnRn name ;
425 getModeRn `thenRn` \ mode ->
427 InterfaceMode -> -- Look in the global name cache
428 mkImportedGlobalFromRdrName rdr_name
430 SourceMode -> -- Source mode, so look up a *qualified* version
431 -- of the name, so that we get the right one even
432 -- if there are many with the same occ name
433 -- There must *be* a binding
434 getModuleRn `thenRn` \ mod ->
435 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
436 Just (name:rest) -> ASSERT( null rest )
438 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
441 -- Just like lookupRn except that we record the occurrence too
442 -- Perhaps surprisingly, even wired-in names are recorded.
443 -- Why? So that we know which wired-in names are referred to when
444 -- deciding which instance declarations to import.
445 lookupOccRn :: RdrName -> RnMS Name
447 = getNameEnvs `thenRn` \ (global_env, local_env) ->
448 lookup_occ global_env local_env rdr_name
450 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
451 -- environment. It's used only for
452 -- record field names
453 -- class op names in class and instance decls
454 lookupGlobalOccRn :: RdrName -> RnMS Name
455 lookupGlobalOccRn rdr_name
456 = getNameEnvs `thenRn` \ (global_env, local_env) ->
457 lookup_global_occ global_env rdr_name
459 -- Look in both local and global env
460 lookup_occ global_env local_env rdr_name
461 = case lookupRdrEnv local_env rdr_name of
462 Just name -> returnRn name
463 Nothing -> lookup_global_occ global_env rdr_name
465 -- Look in global env only
466 lookup_global_occ global_env rdr_name
467 = case lookupRdrEnv global_env rdr_name of
468 Just [name] -> returnRn name
469 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
471 Nothing -> getModeRn `thenRn` \ mode ->
473 -- Not found when processing source code; so fail
474 SourceMode -> failWithRn (mkUnboundName rdr_name)
475 (unknownNameErr rdr_name)
477 -- Not found when processing an imported declaration,
478 -- so we create a new name for the purpose
479 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
482 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
483 and adds it to the occurrence pool so that it'll be loaded later.
484 This is used when language constructs
485 (such as monad comprehensions, overloaded literals, or deriving clauses)
486 require some stuff to be loaded that isn't explicitly mentioned in the code.
488 This doesn't apply in interface mode, where everything is explicit,
489 but we don't check for this case:
490 it does no harm to record an ``extra'' occurrence
491 and @lookupImplicitOccRn@ isn't used much in interface mode
492 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
494 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
496 For List and Tuple types it's important to get the correct
497 @isLocallyDefined@ flag, which is used in turn when deciding
498 whether there are any instance decls in this module are ``special''.
499 The name cache should have the correct provenance, though.
502 lookupImplicitOccRn :: RdrName -> RnM d Name
503 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
506 @unQualInScope@ returns a function that takes a @Name@ and tells whether
507 its unqualified name is in scope. This is put as a boolean flag in
508 the @Name@'s provenance to guide whether or not to print the name qualified
512 unQualInScope :: GlobalRdrEnv -> Name -> Bool
516 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
517 Just [name'] -> name == name'
521 %************************************************************************
523 \subsection{Envt utility functions}
525 %************************************************************************
527 \subsubsection{NameEnv}% ================
530 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
531 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
533 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
534 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
536 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
537 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
539 combine_globals :: [Name] -- Old
542 combine_globals ns_old ns_new -- ns_new is often short
543 = foldr add ns_old ns_new
545 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
548 choose n' | n==n' && better_provenance n n' = n
552 -- a local thing over an imported thing
553 -- a user-imported thing over a non-user-imported thing
554 -- an explicitly-imported thing over an implicitly imported thing
555 better_provenance n1 n2
556 = case (getNameProvenance n1, getNameProvenance n2) of
557 (LocalDef _ _, _ ) -> True
558 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
559 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
562 is_duplicate :: Name -> Name -> Bool
563 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
564 | otherwise = n1 == n2
566 We treat two bindings of a locally-defined name as a duplicate,
567 because they might be two separate, local defns and we want to report
568 and error for that, {\em not} eliminate a duplicate.
570 On the other hand, if you import the same name from two different
571 import statements, we {\em d}* want to eliminate the duplicate, not report
574 If a module imports itself then there might be a local defn and an imported
575 defn of the same name; in this case the names will compare as equal, but
576 will still have different provenances.
580 \subsubsection{ExportAvails}% ================
583 mkEmptyExportAvails :: ModuleName -> ExportAvails
584 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
586 mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
587 mkExportAvails mod_name unqual_imp name_env avails
588 = (mod_avail_env, entity_avail_env)
590 mod_avail_env = unitFM mod_name unqual_avails
592 -- unqual_avails is the Avails that are visible in *unqualfied* form
593 -- (1.4 Report, Section 5.1.1)
595 -- import T hiding( f )
596 -- we delete f from avails
598 unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
599 | otherwise = mapMaybe prune avails
601 prune (Avail n) | unqual_in_scope n = Just (Avail n)
602 prune (Avail n) | otherwise = Nothing
603 prune (AvailTC n ns) | null uqs = Nothing
604 | otherwise = Just (AvailTC n uqs)
606 uqs = filter unqual_in_scope ns
608 unqual_in_scope n = unQualInScope name_env n
610 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
611 name <- availNames avail]
613 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
614 plusExportAvails (m1, e1) (m2, e2)
615 = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
616 -- ToDo: wasteful: we do this once for each constructor!
620 \subsubsection{AvailInfo}% ================
623 plusAvail (Avail n1) (Avail n2) = Avail n1
624 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
627 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
630 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
631 addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
633 emptyAvailEnv = emptyNameEnv
634 unitAvailEnv :: AvailInfo -> AvailEnv
635 unitAvailEnv a = unitNameEnv (availName a) a
637 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
638 plusAvailEnv = plusNameEnv_C plusAvail
640 availEnvElts = nameEnvElts
642 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
643 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
645 availsToNameSet :: [AvailInfo] -> NameSet
646 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
648 availName :: AvailInfo -> Name
649 availName (Avail n) = n
650 availName (AvailTC n _) = n
652 availNames :: AvailInfo -> [Name]
653 availNames (Avail n) = [n]
654 availNames (AvailTC n ns) = ns
656 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
657 addSysAvails avail [] = avail
658 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
660 filterAvail :: RdrNameIE -- Wanted
661 -> AvailInfo -- Available
662 -> Maybe AvailInfo -- Resulting available;
663 -- Nothing if (any of the) wanted stuff isn't there
665 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
666 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
667 | otherwise = Nothing
669 is_wanted name = nameOccName name `elem` wanted_occs
670 sub_names_ok = all (`elem` avail_occs) wanted_occs
671 avail_occs = map nameOccName ns
672 wanted_occs = map rdrNameOcc (want:wants)
674 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
677 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
679 filterAvail (IEVar _) avail@(Avail n) = Just avail
680 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
682 wanted n = nameOccName n == occ
684 -- The second equation happens if we import a class op, thus
686 -- where op is a class operation
688 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
689 -- We don't complain even if the IE says T(..), but
690 -- no constrs/class ops of T are available
691 -- Instead that's caught with a warning by the caller
693 filterAvail ie avail = Nothing
695 pprAvail :: AvailInfo -> SDoc
696 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
698 ns' -> parens (hsep (punctuate comma (map ppr ns')))
700 pprAvail (Avail n) = ppr n
706 %************************************************************************
708 \subsection{Free variable manipulation}
710 %************************************************************************
713 type FreeVars = NameSet
715 plusFV :: FreeVars -> FreeVars -> FreeVars
716 addOneFV :: FreeVars -> Name -> FreeVars
717 unitFV :: Name -> FreeVars
719 plusFVs :: [FreeVars] -> FreeVars
721 isEmptyFVs = isEmptyNameSet
722 emptyFVs = emptyNameSet
723 plusFVs = unionManyNameSets
724 plusFV = unionNameSets
726 -- No point in adding implicitly imported names to the free-var set
727 addOneFV s n = addOneToNameSet s n
728 unitFV n = unitNameSet n
731 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
733 (ys, fvs_s) = unzip stuff
735 returnRn (ys, plusFVs fvs_s)
739 %************************************************************************
741 \subsection{Envt utility functions}
743 %************************************************************************
748 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
750 warnUnusedImports names
751 | not opt_WarnUnusedImports
752 = returnRn () -- Don't force names unless necessary
754 = warnUnusedBinds (const True) names
756 warnUnusedLocalBinds ns
757 | not opt_WarnUnusedBinds = returnRn ()
758 | otherwise = warnUnusedBinds (const True) ns
760 warnUnusedMatches names
761 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
762 | otherwise = returnRn ()
764 -------------------------
766 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
767 warnUnusedBinds warn_when_local names
768 = mapRn_ (warnUnusedGroup warn_when_local) groups
770 -- Group by provenance
771 groups = equivClasses cmp names
772 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
774 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
775 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
776 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
777 (NonLocalDef (UserImport m2 loc2 _) _) =
778 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
779 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
780 -- In-scope NonLocalDefs must have UserImport info on them
782 -------------------------
784 -- NOTE: the function passed to warnUnusedGroup is
785 -- now always (const True) so we should be able to
786 -- simplify the code slightly. I'm leaving it there
787 -- for now just in case I havn't realised why it was there.
788 -- Looks highly bogus to me. SLPJ Dec 99
790 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
791 warnUnusedGroup emit_warning names
792 | null filtered_names = returnRn ()
793 | not (emit_warning is_local) = returnRn ()
795 = pushSrcLocRn def_loc $
797 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
799 filtered_names = filter reportable names
800 name1 = head filtered_names
801 (is_local, def_loc, msg)
802 = case getNameProvenance name1 of
803 LocalDef loc _ -> (True, loc, text "Defined but not used")
804 NonLocalDef (UserImport mod loc _) _ ->
805 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
807 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
809 reportable name = case occNameUserString (nameOccName name) of
812 -- Haskell 98 encourages compilers to suppress warnings about
813 -- unused names in a pattern if they start with "_".
817 addNameClashErrRn rdr_name (name1:names)
818 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
819 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
821 msg1 = ptext SLIT("either") <+> mk_ref name1
822 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
823 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
825 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
826 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
827 4 (vcat [ppr how_in_scope1,
830 shadowedNameWarn shadow
831 = hsep [ptext SLIT("This binding for"),
833 ptext SLIT("shadows an existing binding")]
836 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
838 flavour = occNameFlavour (rdrNameOcc name)
840 qualNameErr descriptor (name,loc)
842 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
847 dupNamesErr descriptor ((name,loc) : dup_things)
849 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
851 (ptext SLIT("in") <+> descriptor))