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, pprModuleName )
39 import TyCon ( TyCon )
41 import Unique ( Unique, Uniquable(..) )
43 import SrcLoc ( SrcLoc, noSrcLoc )
45 import Util ( removeDups, equivClasses, thenCmp )
51 %*********************************************************
53 \subsection{Making new names}
55 %*********************************************************
58 newLocalTopBinder :: Module -> OccName
59 -> (Name -> ExportFlag) -> SrcLoc
61 newLocalTopBinder mod occ rec_exp_fn loc
62 = newTopBinder mod occ (\name -> setNameProvenance name (LocalDef loc (rec_exp_fn name)))
63 -- We must set the provenance of the thing in the cache
64 -- correctly, particularly whether or not it is locally defined.
66 -- Since newLocalTopBinder is used only
67 -- at binding occurrences, we may as well get the provenance
68 -- dead right first time; hence the rec_exp_fn passed in
70 newImportedBinder :: Module -> RdrName -> RnM d Name
71 newImportedBinder mod rdr_name
72 = ASSERT2( isUnqual rdr_name, ppr rdr_name )
73 newTopBinder mod (rdrNameOcc rdr_name) (\name -> name)
74 -- Provenance is already implicitImportProvenance
76 implicitImportProvenance = NonLocalDef ImplicitImport False
78 newTopBinder :: Module -> OccName -> (Name -> Name) -> RnM d Name
79 newTopBinder mod occ set_prov
80 = -- First check the cache
81 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
83 key = (moduleName mod, occ)
85 case lookupFM cache key of
87 -- A hit in the cache!
88 -- Set the Module of the thing, and set its provenance (hack pending
91 -- It also means that if there are two defns for the same thing
92 -- in a module, then each gets a separate SrcLoc
94 -- There's a complication for wired-in names. We don't want to
95 -- forget that they are wired in even when compiling that module
96 -- (else we spit out redundant defns into the interface file)
97 -- So for them we just set the provenance
100 new_name = set_prov (setNameModule name mod)
101 new_cache = addToFM cache key new_name
103 setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_`
106 -- Miss in the cache!
107 -- Build a completely new Name, and put it in the cache
109 (us', us1) = splitUniqSupply us
110 uniq = uniqFromSupply us1
111 new_name = set_prov (mkGlobalName uniq mod occ implicitImportProvenance)
112 new_cache = addToFM cache key new_name
114 setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
118 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
119 -- Used for *occurrences*. We make a place-holder Name, really just
120 -- to agree on its unique, which gets overwritten when we read in
121 -- the binding occurence later (newImportedBinder)
122 -- The place-holder Name doesn't have the right Provenance, and its
123 -- Module won't have the right Package either
125 -- This means that a renamed program may have incorrect info
126 -- on implicitly-imported occurrences, but the correct info on the
127 -- *binding* declaration. It's the type checker that propagates the
128 -- correct information to all the occurrences.
129 -- Since implicitly-imported names never occur in error messages,
130 -- it doesn't matter that we get the correct info in place till later,
131 -- (but since it affects DLL-ery it does matter that we get it right
133 mkImportedGlobalName mod_name occ
134 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
136 key = (mod_name, occ)
138 case lookupFM cache key of
139 Just name -> returnRn name
140 Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_`
143 (us', us1) = splitUniqSupply us
144 uniq = uniqFromSupply us1
145 mod = mkVanillaModule mod_name
146 name = mkGlobalName uniq mod occ implicitImportProvenance
147 new_cache = addToFM cache key name
149 updateProvenances :: [Name] -> RnM d ()
150 -- Update the provenances of everything that is in scope.
151 -- We must be careful not to disturb the Module package info
152 -- already in the cache. Why not? Consider
153 -- module A module M( f )
154 -- import M( f ) import N( f)
156 -- So f is defined in N, and M re-exports it.
157 -- When processing module A:
158 -- 1. We read M.hi first, and make a vanilla name N.f
159 -- (without reading N.hi). The package info says <THIS>
160 -- for lack of anything better.
161 -- 2. Now we read N, which update the cache to record
162 -- the correct package for N.f.
163 -- 3. Finally we update provenances (once we've read all imports).
164 -- Step 3 must not destroy package info recorded in Step 2.
166 updateProvenances names
167 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
168 setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
170 update name cache = addToFM_C update_prov cache key name
172 key = (moduleName (nameModule name), nameOccName name)
174 update_prov name_in_cache name_with_prov
175 = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
179 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
180 mkImportedGlobalFromRdrName rdr_name
182 = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
185 = -- An Unqual is allowed; interface files contain
186 -- unqualified names for locally-defined things, such as
187 -- constructors of a data type.
188 getModuleRn `thenRn ` \ mod_name ->
189 mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
193 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
194 case lookupFM ipcache key of
195 Just name -> returnRn name
196 Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
199 (us', us1) = splitUniqSupply us
200 uniq = uniqFromSupply us1
201 name = mkIPName uniq key
202 new_ipcache = addToFM ipcache key name
203 where key = (rdrNameOcc rdr_name)
206 %*********************************************************
208 \subsection{Dfuns and default methods}
210 %*********************************************************
212 @newImplicitBinder@ is used for (a) dfuns
213 (b) default methods, defined in this module.
216 newImplicitBinder occ src_loc
217 = getModuleRn `thenRn` \ mod_name ->
218 newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc
221 Make a name for the dict fun for an instance decl
224 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
225 newDFunName key@(cl_occ, tycon_occ) loc
226 = newInstUniq string `thenRn` \ inst_uniq ->
227 newImplicitBinder (mkDFunOcc string inst_uniq) loc
229 -- Any string that is somewhat unique will do
230 string = occNameString cl_occ ++ occNameString tycon_occ
234 getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names
235 getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty
236 getDFunKey (MonoFunTy _ ty) = getDFunKey ty
237 getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
239 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
240 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
241 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
242 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
243 get_tycon_key (MonoListTy _) = getOccName listTyCon
244 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
248 %*********************************************************
252 %*********************************************************
255 -------------------------------------
256 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
257 -> [(RdrName,SrcLoc)]
258 -> ([Name] -> RnMS a)
260 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
261 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
263 getLocalNameEnv `thenRn` \ name_env ->
264 (if opt_WarnNameShadowing
266 mapRn_ (check_shadow name_env) rdr_names_w_loc
271 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
272 getModeRn `thenRn` \ mode ->
274 n = length rdr_names_w_loc
275 (us', us1) = splitUniqSupply us
276 uniqs = uniqsFromSupply n us1
277 names = [ mk_name uniq (rdrNameOcc rdr_name) loc
278 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
280 mk_name = case mode of
281 SourceMode -> mkLocalName
282 InterfaceMode -> mkImportedLocalName
283 -- Keep track of whether the name originally came from
284 -- an interface file.
286 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
289 new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
291 setLocalNameEnv new_name_env (enclosed_scope names)
294 check_shadow name_env (rdr_name,loc)
295 = case lookupRdrEnv name_env rdr_name of
296 Nothing -> returnRn ()
297 Just name -> pushSrcLocRn loc $
298 addWarnRn (shadowedNameWarn rdr_name)
300 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
301 -> RnMS (a, FreeVars)
302 -- A specialised variant when renaming stuff from interface
303 -- files (of which there is a lot)
305 -- * no checks for shadowing
307 -- * deal with free vars
308 bindCoreLocalFVRn rdr_name enclosed_scope
309 = getSrcLocRn `thenRn` \ loc ->
310 getLocalNameEnv `thenRn` \ name_env ->
311 getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
313 (us', us1) = splitUniqSupply us
314 uniq = uniqFromSupply us1
315 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
317 setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
319 new_name_env = extendRdrEnv name_env rdr_name name
321 setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
322 returnRn (result, delFromNameSet fvs name)
324 bindCoreLocalsFVRn [] thing_inside = thing_inside []
325 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
326 bindCoreLocalsFVRn bs $ \ names' ->
327 thing_inside (name':names')
329 -------------------------------------
330 bindLocalRn doc rdr_name enclosed_scope
331 = getSrcLocRn `thenRn` \ loc ->
332 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
336 bindLocalsRn doc rdr_names enclosed_scope
337 = getSrcLocRn `thenRn` \ loc ->
338 bindLocatedLocalsRn doc
339 (rdr_names `zip` repeat loc)
342 -- binLocalsFVRn is the same as bindLocalsRn
343 -- except that it deals with free vars
344 bindLocalsFVRn doc rdr_names enclosed_scope
345 = bindLocalsRn doc rdr_names $ \ names ->
346 enclosed_scope names `thenRn` \ (thing, fvs) ->
347 returnRn (thing, delListFromNameSet fvs names)
349 -------------------------------------
350 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
351 bindUVarRn = bindLocalRn
353 -------------------------------------
354 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
355 -- This tiresome function is used only in rnDecl on InstDecl
356 extendTyVarEnvFVRn tyvars enclosed_scope
357 = getLocalNameEnv `thenRn` \ env ->
359 tyvar_names = map getTyVarName tyvars
360 new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
361 | name <- tyvar_names
364 setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
365 returnRn (thing, delListFromNameSet fvs tyvar_names)
367 bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
368 -> ([HsTyVar Name] -> RnMS a)
370 bindTyVarsRn doc_str tyvar_names enclosed_scope
371 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
372 enclosed_scope tyvars
374 -- Gruesome name: return Names as well as HsTyVars
375 bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
376 -> ([Name] -> [HsTyVar Name] -> RnMS a)
378 bindTyVars2Rn doc_str tyvar_names enclosed_scope
379 = getSrcLocRn `thenRn` \ loc ->
381 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
383 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
384 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
386 bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
387 -> ([HsTyVar Name] -> RnMS (a, FreeVars))
388 -> RnMS (a, FreeVars)
389 bindTyVarsFVRn doc_str rdr_names enclosed_scope
390 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
391 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
392 returnRn (thing, delListFromNameSet fvs names)
394 bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName]
395 -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars))
396 -> RnMS (a, FreeVars)
397 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
398 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
399 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
400 returnRn (thing, delListFromNameSet fvs names)
403 -------------------------------------
404 checkDupOrQualNames, checkDupNames :: SDoc
405 -> [(RdrName, SrcLoc)]
407 -- Works in any variant of the renamer monad
409 checkDupOrQualNames doc_str rdr_names_w_loc
410 = -- Check for use of qualified names
411 mapRn_ (qualNameErr doc_str) quals `thenRn_`
412 checkDupNames doc_str rdr_names_w_loc
414 quals = filter (isQual.fst) rdr_names_w_loc
416 checkDupNames doc_str rdr_names_w_loc
417 = -- Check for duplicated names in a binding group
418 mapRn_ (dupNamesErr doc_str) dups
420 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
424 %*********************************************************
426 \subsection{Looking up names}
428 %*********************************************************
430 Looking up a name in the RnEnv.
433 lookupBndrRn rdr_name
434 = getNameEnvs `thenRn` \ (global_env, local_env) ->
437 case lookupRdrEnv local_env rdr_name of {
438 Just name -> returnRn name ;
441 getModeRn `thenRn` \ mode ->
443 InterfaceMode -> -- Look in the global name cache
444 mkImportedGlobalFromRdrName rdr_name
446 SourceMode -> -- Source mode, so look up a *qualified* version
447 -- of the name, so that we get the right one even
448 -- if there are many with the same occ name
449 -- There must *be* a binding
450 getModuleRn `thenRn` \ mod ->
451 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
452 Just (name:rest) -> ASSERT( null rest )
454 Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name)
457 -- Just like lookupRn except that we record the occurrence too
458 -- Perhaps surprisingly, even wired-in names are recorded.
459 -- Why? So that we know which wired-in names are referred to when
460 -- deciding which instance declarations to import.
461 lookupOccRn :: RdrName -> RnMS Name
463 = getNameEnvs `thenRn` \ (global_env, local_env) ->
464 lookup_occ global_env local_env rdr_name
466 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
467 -- environment. It's used only for
468 -- record field names
469 -- class op names in class and instance decls
470 lookupGlobalOccRn :: RdrName -> RnMS Name
471 lookupGlobalOccRn rdr_name
472 = getNameEnvs `thenRn` \ (global_env, local_env) ->
473 lookup_global_occ global_env rdr_name
475 -- Look in both local and global env
476 lookup_occ global_env local_env rdr_name
477 = case lookupRdrEnv local_env rdr_name of
478 Just name -> returnRn name
479 Nothing -> lookup_global_occ global_env rdr_name
481 -- Look in global env only
482 lookup_global_occ global_env rdr_name
483 = case lookupRdrEnv global_env rdr_name of
484 Just [name] -> returnRn name
485 Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
487 Nothing -> getModeRn `thenRn` \ mode ->
489 -- Not found when processing source code; so fail
490 SourceMode -> failWithRn (mkUnboundName rdr_name)
491 (unknownNameErr rdr_name)
493 -- Not found when processing an imported declaration,
494 -- so we create a new name for the purpose
495 InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
498 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
499 and adds it to the occurrence pool so that it'll be loaded later.
500 This is used when language constructs
501 (such as monad comprehensions, overloaded literals, or deriving clauses)
502 require some stuff to be loaded that isn't explicitly mentioned in the code.
504 This doesn't apply in interface mode, where everything is explicit,
505 but we don't check for this case:
506 it does no harm to record an ``extra'' occurrence
507 and @lookupImplicitOccRn@ isn't used much in interface mode
508 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
510 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
512 For List and Tuple types it's important to get the correct
513 @isLocallyDefined@ flag, which is used in turn when deciding
514 whether there are any instance decls in this module are ``special''.
515 The name cache should have the correct provenance, though.
518 lookupImplicitOccRn :: RdrName -> RnM d Name
519 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
522 @unQualInScope@ returns a function that takes a @Name@ and tells whether
523 its unqualified name is in scope. This is put as a boolean flag in
524 the @Name@'s provenance to guide whether or not to print the name qualified
528 unQualInScope :: GlobalRdrEnv -> Name -> Bool
532 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
533 Just [name'] -> name == name'
537 %************************************************************************
539 \subsection{Envt utility functions}
541 %************************************************************************
543 \subsubsection{NameEnv}% ================
546 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
547 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
549 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
550 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
552 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
553 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
555 combine_globals :: [Name] -- Old
558 combine_globals ns_old ns_new -- ns_new is often short
559 = foldr add ns_old ns_new
561 add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
564 choose n' | n==n' && better_provenance n n' = n
568 -- a local thing over an imported thing
569 -- a user-imported thing over a non-user-imported thing
570 -- an explicitly-imported thing over an implicitly imported thing
571 better_provenance n1 n2
572 = case (getNameProvenance n1, getNameProvenance n2) of
573 (LocalDef _ _, _ ) -> True
574 (NonLocalDef (UserImport _ _ True) _, _ ) -> True
575 (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
578 is_duplicate :: Name -> Name -> Bool
579 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
580 | otherwise = n1 == n2
582 We treat two bindings of a locally-defined name as a duplicate,
583 because they might be two separate, local defns and we want to report
584 and error for that, {\em not} eliminate a duplicate.
586 On the other hand, if you import the same name from two different
587 import statements, we {\em d}* want to eliminate the duplicate, not report
590 If a module imports itself then there might be a local defn and an imported
591 defn of the same name; in this case the names will compare as equal, but
592 will still have different provenances.
596 \subsubsection{AvailInfo}% ================
599 plusAvail (Avail n1) (Avail n2) = Avail n1
600 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
603 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
606 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
607 addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
609 emptyAvailEnv = emptyNameEnv
610 unitAvailEnv :: AvailInfo -> AvailEnv
611 unitAvailEnv a = unitNameEnv (availName a) a
613 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
614 plusAvailEnv = plusNameEnv_C plusAvail
616 availEnvElts = nameEnvElts
618 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
619 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
621 availsToNameSet :: [AvailInfo] -> NameSet
622 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
624 availName :: AvailInfo -> Name
625 availName (Avail n) = n
626 availName (AvailTC n _) = n
628 availNames :: AvailInfo -> [Name]
629 availNames (Avail n) = [n]
630 availNames (AvailTC n ns) = ns
632 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
633 addSysAvails avail [] = avail
634 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
636 filterAvail :: RdrNameIE -- Wanted
637 -> AvailInfo -- Available
638 -> Maybe AvailInfo -- Resulting available;
639 -- Nothing if (any of the) wanted stuff isn't there
641 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
642 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
643 | otherwise = Nothing
645 is_wanted name = nameOccName name `elem` wanted_occs
646 sub_names_ok = all (`elem` avail_occs) wanted_occs
647 avail_occs = map nameOccName ns
648 wanted_occs = map rdrNameOcc (want:wants)
650 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
653 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
655 filterAvail (IEVar _) avail@(Avail n) = Just avail
656 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
658 wanted n = nameOccName n == occ
660 -- The second equation happens if we import a class op, thus
662 -- where op is a class operation
664 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
665 -- We don't complain even if the IE says T(..), but
666 -- no constrs/class ops of T are available
667 -- Instead that's caught with a warning by the caller
669 filterAvail ie avail = Nothing
671 pprAvail :: AvailInfo -> SDoc
672 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
674 ns' -> parens (hsep (punctuate comma (map ppr ns')))
676 pprAvail (Avail n) = ppr n
682 %************************************************************************
684 \subsection{Free variable manipulation}
686 %************************************************************************
689 type FreeVars = NameSet
691 plusFV :: FreeVars -> FreeVars -> FreeVars
692 addOneFV :: FreeVars -> Name -> FreeVars
693 unitFV :: Name -> FreeVars
695 plusFVs :: [FreeVars] -> FreeVars
697 isEmptyFVs = isEmptyNameSet
698 emptyFVs = emptyNameSet
699 plusFVs = unionManyNameSets
700 plusFV = unionNameSets
702 -- No point in adding implicitly imported names to the free-var set
703 addOneFV s n = addOneToNameSet s n
704 unitFV n = unitNameSet n
707 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
709 (ys, fvs_s) = unzip stuff
711 returnRn (ys, plusFVs fvs_s)
715 %************************************************************************
717 \subsection{Envt utility functions}
719 %************************************************************************
724 warnUnusedModules :: [ModuleName] -> RnM d ()
725 warnUnusedModules mods
726 | not opt_WarnUnusedImports = returnRn ()
727 | otherwise = mapRn_ (addWarnRn . unused_mod) mods
729 unused_mod m = ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
730 text "is imported, but nothing from it is used"
732 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
733 warnUnusedImports names
734 | not opt_WarnUnusedImports
735 = returnRn () -- Don't force names unless necessary
737 = warnUnusedBinds (const True) names
739 warnUnusedLocalBinds ns
740 | not opt_WarnUnusedBinds = returnRn ()
741 | otherwise = warnUnusedBinds (const True) ns
743 warnUnusedMatches names
744 | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
745 | otherwise = returnRn ()
747 -------------------------
749 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
750 warnUnusedBinds warn_when_local names
751 = mapRn_ (warnUnusedGroup warn_when_local) groups
753 -- Group by provenance
754 groups = equivClasses cmp names
755 name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
757 cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
758 cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
759 cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
760 (NonLocalDef (UserImport m2 loc2 _) _) =
761 (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
762 cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
763 -- In-scope NonLocalDefs must have UserImport info on them
765 -------------------------
767 -- NOTE: the function passed to warnUnusedGroup is
768 -- now always (const True) so we should be able to
769 -- simplify the code slightly. I'm leaving it there
770 -- for now just in case I havn't realised why it was there.
771 -- Looks highly bogus to me. SLPJ Dec 99
773 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
774 warnUnusedGroup emit_warning names
775 | null filtered_names = returnRn ()
776 | not (emit_warning is_local) = returnRn ()
778 = pushSrcLocRn def_loc $
780 sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
782 filtered_names = filter reportable names
783 name1 = head filtered_names
784 (is_local, def_loc, msg)
785 = case getNameProvenance name1 of
786 LocalDef loc _ -> (True, loc, text "Defined but not used")
787 NonLocalDef (UserImport mod loc _) _ ->
788 (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
790 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
792 reportable name = case occNameUserString (nameOccName name) of
795 -- Haskell 98 encourages compilers to suppress warnings about
796 -- unused names in a pattern if they start with "_".
800 addNameClashErrRn rdr_name (name1:names)
801 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
802 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
804 msg1 = ptext SLIT("either") <+> mk_ref name1
805 msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
806 mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
808 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
809 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
810 4 (vcat [ppr how_in_scope1,
813 shadowedNameWarn shadow
814 = hsep [ptext SLIT("This binding for"),
816 ptext SLIT("shadows an existing binding")]
819 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
821 flavour = occNameFlavour (rdrNameOcc name)
823 qualNameErr descriptor (name,loc)
825 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
830 dupNamesErr descriptor ((name,loc) : dup_things)
832 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
834 (ptext SLIT("in") <+> descriptor))