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"
12 import RdrHsSyn ( RdrNameIE )
13 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
14 mkRdrUnqual, mkRdrUnqual, qualifyRdrName, lookupRdrEnv, foldRdrEnv
16 import HsTypes ( hsTyVarName, replaceTyVarName )
17 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
18 ImportReason(..), GlobalRdrEnv, AvailEnv,
19 AvailInfo, Avails, GenAvailInfo(..) )
21 import Name ( Name, NamedThing(..),
23 mkLocalName, mkGlobalName,
24 mkIPName, nameOccName, nameModule_maybe,
27 import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
29 import OccName ( OccName, occNameUserString, occNameFlavour )
30 import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS )
33 import SrcLoc ( SrcLoc, noSrcLoc )
35 import ListSetOps ( removeDups, equivClasses )
36 import Util ( sortLt )
38 import PrelNames ( mkUnboundName )
40 import FastString ( FastString )
43 %*********************************************************
45 \subsection{Making new names}
47 %*********************************************************
50 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
51 -- newTopBinder puts into the cache the binder with the
52 -- module information set correctly. When the decl is later renamed,
53 -- the binding site will thereby get the correct module.
54 -- There maybe occurrences that don't have the correct Module, but
55 -- by the typechecker will propagate the binding definition to all
56 -- the occurrences, so that doesn't matter
58 newTopBinder mod rdr_name loc
59 = -- First check the cache
60 -- traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_`
62 -- There should never be a qualified name in a binding position (except in instance decls)
63 -- The parser doesn't check this because the same parser parses instance decls
64 (if isQual rdr_name then
65 qualNameErr (text "its declaration") (rdr_name,loc)
70 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
72 occ = rdrNameOcc rdr_name
73 key = (moduleName mod, occ)
75 case lookupFM cache key of
77 -- A hit in the cache! We are at the binding site of the name, and
78 -- this is the moment when we know all about
79 -- a) the Name's host Module (in particular, which
80 -- package it comes from)
81 -- b) its defining SrcLoc
82 -- So we update this info
85 new_name = setNameModuleAndLoc name mod loc
86 new_cache = addToFM cache key new_name
88 setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
89 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
93 -- Build a completely new Name, and put it in the cache
94 -- Even for locally-defined names we use implicitImportProvenance;
95 -- updateProvenances will set it to rights
97 (us', us1) = splitUniqSupply us
98 uniq = uniqFromSupply us1
99 new_name = mkGlobalName uniq mod occ loc
100 new_cache = addToFM cache key new_name
102 setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
103 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
107 newGlobalName :: ModuleName -> OccName -> RnM d Name
108 -- Used for *occurrences*. We make a place-holder Name, really just
109 -- to agree on its unique, which gets overwritten when we read in
110 -- the binding occurence later (newTopBinder)
111 -- The place-holder Name doesn't have the right SrcLoc, and its
112 -- Module won't have the right Package either.
114 -- (We have to pass a ModuleName, not a Module, because we may be
115 -- simply looking at an occurrence M.x in an interface file.)
117 -- This means that a renamed program may have incorrect info
118 -- on implicitly-imported occurrences, but the correct info on the
119 -- *binding* declaration. It's the type checker that propagates the
120 -- correct information to all the occurrences.
121 -- Since implicitly-imported names never occur in error messages,
122 -- it doesn't matter that we get the correct info in place till later,
123 -- (but since it affects DLL-ery it does matter that we get it right
125 newGlobalName mod_name occ
126 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
128 key = (mod_name, occ)
130 case lookupFM cache key of
131 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
134 Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
135 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
138 (us', us1) = splitUniqSupply us
139 uniq = uniqFromSupply us1
140 mod = mkVanillaModule mod_name
141 name = mkGlobalName uniq mod occ noSrcLoc
142 new_cache = addToFM cache key name
145 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
146 case lookupFM ipcache key of
147 Just name -> returnRn name
148 Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_`
151 (us', us1) = splitUniqSupply us
152 uniq = uniqFromSupply us1
153 name = mkIPName uniq key
154 new_ipcache = addToFM ipcache key name
155 where key = (rdrNameOcc rdr_name)
158 %*********************************************************
160 \subsection{Looking up names}
162 %*********************************************************
164 Looking up a name in the RnEnv.
167 lookupBndrRn rdr_name
168 = getLocalNameEnv `thenRn` \ local_env ->
169 case lookupRdrEnv local_env rdr_name of
170 Just name -> returnRn name
171 Nothing -> lookupTopBndrRn rdr_name
173 lookupTopBndrRn rdr_name
174 = getModeRn `thenRn` \ mode ->
176 InterfaceMode -> lookupIfaceName rdr_name
178 SourceMode -> -- Source mode, so look up a *qualified* version
179 -- of the name, so that we get the right one even
180 -- if there are many with the same occ name
181 -- There must *be* a binding
182 getModuleRn `thenRn` \ mod ->
183 getGlobalNameEnv `thenRn` \ global_env ->
184 lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
186 -- lookupSigOccRn is used for type signatures and pragmas
192 -- It's clear that the 'f' in the signature must refer to A.f
193 -- The Haskell98 report does not stipulate this, but it will!
194 -- So we must treat the 'f' in the signature in the same way
195 -- as the binding occurrence of 'f', using lookupBndrRn
196 lookupSigOccRn :: RdrName -> RnMS Name
197 lookupSigOccRn = lookupBndrRn
199 -- lookupOccRn looks up an occurrence of a RdrName
200 lookupOccRn :: RdrName -> RnMS Name
202 = getLocalNameEnv `thenRn` \ local_env ->
203 case lookupRdrEnv local_env rdr_name of
204 Just name -> returnRn name
205 Nothing -> lookupGlobalOccRn rdr_name
207 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
208 -- environment. It's used only for
209 -- record field names
210 -- class op names in class and instance decls
212 lookupGlobalOccRn rdr_name
213 = getModeRn `thenRn` \ mode ->
215 SourceMode -> getGlobalNameEnv `thenRn` \ global_env ->
216 lookupSrcName global_env rdr_name
218 InterfaceMode -> lookupIfaceName rdr_name
220 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
221 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
222 lookupSrcName global_env rdr_name
223 | isOrig rdr_name -- Can occur in source code too
224 = lookupOrigName rdr_name
227 = case lookupRdrEnv global_env rdr_name of
228 Just [(name,_)] -> returnRn name
229 Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_`
231 Nothing -> failWithRn (mkUnboundName rdr_name)
232 (unknownNameErr rdr_name)
234 lookupOrigName :: RdrName -> RnM d Name
235 lookupOrigName rdr_name
236 = ASSERT( isOrig rdr_name )
237 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
239 lookupIfaceUnqual :: RdrName -> RnM d Name
240 lookupIfaceUnqual rdr_name
241 = ASSERT( isUnqual rdr_name )
242 -- An Unqual is allowed; interface files contain
243 -- unqualified names for locally-defined things, such as
244 -- constructors of a data type.
245 getModuleRn `thenRn ` \ mod ->
246 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
248 lookupIfaceName :: RdrName -> RnM d Name
249 lookupIfaceName rdr_name
250 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
251 | otherwise = lookupOrigName rdr_name
254 @lookupOrigName@ takes an RdrName representing an {\em original}
255 name, and adds it to the occurrence pool so that it'll be loaded
256 later. This is used when language constructs (such as monad
257 comprehensions, overloaded literals, or deriving clauses) require some
258 stuff to be loaded that isn't explicitly mentioned in the code.
260 This doesn't apply in interface mode, where everything is explicit,
261 but we don't check for this case: it does no harm to record an
262 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
263 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
264 calls it at all I think).
266 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
270 lookupOrigNames :: [RdrName] -> RnM d NameSet
271 lookupOrigNames rdr_names
272 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
273 returnRn (mkNameSet names)
276 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
277 It ensures that the module is set correctly in the name cache, and sets the provenance
278 on the returned name too. The returned name will end up actually in the type, class,
282 lookupSysBinder rdr_name
283 = ASSERT( isUnqual rdr_name )
284 getModuleRn `thenRn` \ mod ->
285 getSrcLocRn `thenRn` \ loc ->
286 newTopBinder mod rdr_name loc
291 %*********************************************************
295 %*********************************************************
298 newLocalsRn :: [(RdrName,SrcLoc)]
300 newLocalsRn rdr_names_w_loc
301 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
303 n = length rdr_names_w_loc
304 (us', us1) = splitUniqSupply us
305 uniqs = uniqsFromSupply n us1
306 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
307 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
310 setNameSupplyRn (us', cache, ipcache) `thenRn_`
314 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
315 -> [(RdrName,SrcLoc)]
316 -> ([Name] -> RnMS a)
318 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
319 = getModeRn `thenRn` \ mode ->
320 getLocalNameEnv `thenRn` \ name_env ->
322 -- Check for duplicate names
323 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
325 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
327 -- Warn about shadowing, but only in source modules
329 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
333 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
335 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
337 setLocalNameEnv new_local_env (enclosed_scope names)
340 check_shadow name_env (rdr_name,loc)
341 = case lookupRdrEnv name_env rdr_name of
342 Nothing -> returnRn ()
343 Just name -> pushSrcLocRn loc $
344 addWarnRn (shadowedNameWarn rdr_name)
346 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
347 -- A specialised variant when renaming stuff from interface
348 -- files (of which there is a lot)
350 -- * no checks for shadowing
352 -- * deal with free vars
353 bindCoreLocalRn rdr_name enclosed_scope
354 = getSrcLocRn `thenRn` \ loc ->
355 getLocalNameEnv `thenRn` \ name_env ->
356 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
358 (us', us1) = splitUniqSupply us
359 uniq = uniqFromSupply us1
360 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
362 setNameSupplyRn (us', cache, ipcache) `thenRn_`
364 new_name_env = extendRdrEnv name_env rdr_name name
366 setLocalNameEnv new_name_env (enclosed_scope name)
368 bindCoreLocalsRn [] thing_inside = thing_inside []
369 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
370 bindCoreLocalsRn bs $ \ names' ->
371 thing_inside (name':names')
373 bindLocalNames names enclosed_scope
374 = getLocalNameEnv `thenRn` \ name_env ->
375 setLocalNameEnv (addListToRdrEnv name_env pairs)
378 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
380 bindLocalNamesFV names enclosed_scope
381 = bindLocalNames names $
382 enclosed_scope `thenRn` \ (thing, fvs) ->
383 returnRn (thing, delListFromNameSet fvs names)
386 -------------------------------------
387 bindLocalRn doc rdr_name enclosed_scope
388 = getSrcLocRn `thenRn` \ loc ->
389 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
393 bindLocalsRn doc rdr_names enclosed_scope
394 = getSrcLocRn `thenRn` \ loc ->
395 bindLocatedLocalsRn doc
396 (rdr_names `zip` repeat loc)
399 -- binLocalsFVRn is the same as bindLocalsRn
400 -- except that it deals with free vars
401 bindLocalsFVRn doc rdr_names enclosed_scope
402 = bindLocalsRn doc rdr_names $ \ names ->
403 enclosed_scope names `thenRn` \ (thing, fvs) ->
404 returnRn (thing, delListFromNameSet fvs names)
406 -------------------------------------
407 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
408 -- This tiresome function is used only in rnDecl on InstDecl
409 extendTyVarEnvFVRn tyvars enclosed_scope
410 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
411 returnRn (thing, delListFromNameSet fvs tyvars)
413 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
414 -> ([HsTyVarBndr Name] -> RnMS a)
416 bindTyVarsRn doc_str tyvar_names enclosed_scope
417 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
418 enclosed_scope tyvars
420 -- Gruesome name: return Names as well as HsTyVars
421 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
422 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
424 bindTyVars2Rn doc_str tyvar_names enclosed_scope
425 = getSrcLocRn `thenRn` \ loc ->
427 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
429 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
430 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
432 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
433 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
434 -> RnMS (a, FreeVars)
435 bindTyVarsFVRn doc_str rdr_names enclosed_scope
436 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
437 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
438 returnRn (thing, delListFromNameSet fvs names)
440 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
441 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
442 -> RnMS (a, FreeVars)
443 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
444 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
445 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
446 returnRn (thing, delListFromNameSet fvs names)
448 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
449 -> ([Name] -> RnMS (a, FreeVars))
450 -> RnMS (a, FreeVars)
451 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
452 = getSrcLocRn `thenRn` \ loc ->
454 located_tyvars = [(tv, loc) | tv <- tyvar_names]
456 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
457 enclosed_scope names `thenRn` \ (thing, fvs) ->
458 returnRn (thing, delListFromNameSet fvs names)
461 -------------------------------------
462 checkDupOrQualNames, checkDupNames :: SDoc
463 -> [(RdrName, SrcLoc)]
465 -- Works in any variant of the renamer monad
467 checkDupOrQualNames doc_str rdr_names_w_loc
468 = -- Check for use of qualified names
469 mapRn_ (qualNameErr doc_str) quals `thenRn_`
470 checkDupNames doc_str rdr_names_w_loc
472 quals = filter (isQual . fst) rdr_names_w_loc
474 checkDupNames doc_str rdr_names_w_loc
475 = -- Check for duplicated names in a binding group
476 mapRn_ (dupNamesErr doc_str) dups
478 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
482 %************************************************************************
484 \subsection{GlobalRdrEnv}
486 %************************************************************************
489 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
490 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
492 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
493 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
495 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
496 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
498 combine_globals :: [(Name,Provenance)] -- Old
499 -> [(Name,Provenance)] -- New
500 -> [(Name,Provenance)]
501 combine_globals ns_old ns_new -- ns_new is often short
502 = foldr add ns_old ns_new
504 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
507 choose n m | n `beats` m = n
510 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
512 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
513 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
514 is_duplicate (n1,_) (n2,_) = n1 == n2
517 We treat two bindings of a locally-defined name as a duplicate,
518 because they might be two separate, local defns and we want to report
519 and error for that, {\em not} eliminate a duplicate.
521 On the other hand, if you import the same name from two different
522 import statements, we {\em do} want to eliminate the duplicate, not report
525 If a module imports itself then there might be a local defn and an imported
526 defn of the same name; in this case the names will compare as equal, but
527 will still have different provenances.
530 @unQualInScope@ returns a function that takes a @Name@ and tells whether
531 its unqualified name is in scope. This is put as a boolean flag in
532 the @Name@'s provenance to guide whether or not to print the name qualified
536 unQualInScope :: GlobalRdrEnv -> Name -> Bool
538 = (`elemNameSet` unqual_names)
540 unqual_names :: NameSet
541 unqual_names = foldRdrEnv add emptyNameSet env
542 add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
543 add _ _ unquals = unquals
547 %************************************************************************
551 %************************************************************************
554 plusAvail (Avail n1) (Avail n2) = Avail n1
555 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
558 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
561 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
562 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
564 emptyAvailEnv = emptyNameEnv
565 unitAvailEnv :: AvailInfo -> AvailEnv
566 unitAvailEnv a = unitNameEnv (availName a) a
568 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
569 plusAvailEnv = plusNameEnv_C plusAvail
571 availEnvElts = nameEnvElts
573 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
574 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
576 availsToNameSet :: [AvailInfo] -> NameSet
577 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
579 availName :: GenAvailInfo name -> name
580 availName (Avail n) = n
581 availName (AvailTC n _) = n
583 availNames :: GenAvailInfo name -> [name]
584 availNames (Avail n) = [n]
585 availNames (AvailTC n ns) = ns
587 -------------------------------------
588 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
589 addSysAvails avail [] = avail
590 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
592 -------------------------------------
593 filterAvail :: RdrNameIE -- Wanted
594 -> AvailInfo -- Available
595 -> Maybe AvailInfo -- Resulting available;
596 -- Nothing if (any of the) wanted stuff isn't there
598 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
599 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
600 | otherwise = Nothing
602 is_wanted name = nameOccName name `elem` wanted_occs
603 sub_names_ok = all (`elem` avail_occs) wanted_occs
604 avail_occs = map nameOccName ns
605 wanted_occs = map rdrNameOcc (want:wants)
607 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
610 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
612 filterAvail (IEVar _) avail@(Avail n) = Just avail
613 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
615 wanted n = nameOccName n == occ
617 -- The second equation happens if we import a class op, thus
619 -- where op is a class operation
621 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
622 -- We don't complain even if the IE says T(..), but
623 -- no constrs/class ops of T are available
624 -- Instead that's caught with a warning by the caller
626 filterAvail ie avail = Nothing
628 -------------------------------------
629 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
630 -- Group by module and sort by occurrence
631 -- This keeps the list in canonical order
632 groupAvails this_mod avails
633 = [ (mkSysModuleNameFS fs, sortLt lt avails)
634 | (fs,avails) <- fmToList groupFM
637 groupFM :: FiniteMap FastString Avails
638 -- Deliberately use the FastString so we
639 -- get a canonical ordering
640 groupFM = foldl add emptyFM avails
642 add env avail = addToFM_C combine env mod_fs [avail']
644 mod_fs = moduleNameFS (moduleName avail_mod)
645 avail_mod = case nameModule_maybe (availName avail) of
648 combine old _ = avail':old
649 avail' = sortAvail avail
651 a1 `lt` a2 = occ1 < occ2
653 occ1 = nameOccName (availName a1)
654 occ2 = nameOccName (availName a2)
656 sortAvail :: AvailInfo -> AvailInfo
657 -- Sort the sub-names into canonical order.
658 -- The canonical order has the "main name" at the beginning
659 -- (if it's there at all)
660 sortAvail (Avail n) = Avail n
661 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
662 | otherwise = AvailTC n ( sortLt lt ns)
664 n1 `lt` n2 = nameOccName n1 < nameOccName n2
668 %************************************************************************
670 \subsection{Free variable manipulation}
672 %************************************************************************
676 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
678 (ys, fvs_s) = unzip stuff
680 returnRn (ys, plusFVs fvs_s)
684 %************************************************************************
686 \subsection{Envt utility functions}
688 %************************************************************************
691 warnUnusedModules :: [ModuleName] -> RnM d ()
692 warnUnusedModules mods
693 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
694 if warn then mapRn_ (addWarnRn . unused_mod) mods
697 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
698 text "is imported, but nothing from it is used",
699 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
702 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
703 warnUnusedImports names
704 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
705 if warn then warnUnusedBinds names else returnRn ()
707 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
708 warnUnusedLocalBinds names
709 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
710 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
713 warnUnusedMatches names
714 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
715 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
718 -------------------------
720 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
721 warnUnusedBinds names
722 = mapRn_ warnUnusedGroup groups
724 -- Group by provenance
725 groups = equivClasses cmp names
726 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
729 -------------------------
731 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
732 warnUnusedGroup names
733 | null filtered_names = returnRn ()
734 | not is_local = returnRn ()
736 = pushSrcLocRn def_loc $
738 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
740 filtered_names = filter reportable names
741 (name1, prov1) = head filtered_names
742 (is_local, def_loc, msg)
744 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
746 NonLocalDef (UserImport mod loc _)
747 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
749 reportable (name,_) = case occNameUserString (nameOccName name) of
752 -- Haskell 98 encourages compilers to suppress warnings about
753 -- unused names in a pattern if they start with "_".
757 addNameClashErrRn rdr_name (np1:nps)
758 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
759 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
761 msg1 = ptext SLIT("either") <+> mk_ref np1
762 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
763 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
765 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
766 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
767 4 (vcat [ppr how_in_scope1,
770 shadowedNameWarn shadow
771 = hsep [ptext SLIT("This binding for"),
773 ptext SLIT("shadows an existing binding")]
776 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
778 flavour = occNameFlavour (rdrNameOcc name)
780 qualNameErr descriptor (name,loc)
782 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
787 dupNamesErr descriptor ((name,loc) : dup_things)
789 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
791 (ptext SLIT("in") <+> descriptor))