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
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, mkImportedLocalName, 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.}}
268 For List and Tuple types it's important to get the correct
269 @isLocallyDefined@ flag, which is used in turn when deciding
270 whether there are any instance decls in this module are ``special''.
271 The name cache should have the correct provenance, though.
274 lookupOrigNames :: [RdrName] -> RnM d NameSet
275 lookupOrigNames rdr_names
276 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
277 returnRn (mkNameSet names)
280 lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
281 It ensures that the module is set correctly in the name cache, and sets the provenance
282 on the returned name too. The returned name will end up actually in the type, class,
286 lookupSysBinder rdr_name
287 = ASSERT( isUnqual rdr_name )
288 getModuleRn `thenRn` \ mod ->
289 getSrcLocRn `thenRn` \ loc ->
290 newTopBinder mod rdr_name loc
295 %*********************************************************
299 %*********************************************************
302 newLocalsRn :: [(RdrName,SrcLoc)]
304 newLocalsRn rdr_names_w_loc
305 = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
307 n = length rdr_names_w_loc
308 (us', us1) = splitUniqSupply us
309 uniqs = uniqsFromSupply n us1
310 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
311 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
314 setNameSupplyRn (us', cache, ipcache) `thenRn_`
318 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
319 -> [(RdrName,SrcLoc)]
320 -> ([Name] -> RnMS a)
322 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
323 = getModeRn `thenRn` \ mode ->
324 getLocalNameEnv `thenRn` \ name_env ->
326 -- Check for duplicate names
327 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
329 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
331 -- Warn about shadowing, but only in source modules
333 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
337 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
339 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
341 setLocalNameEnv new_local_env (enclosed_scope names)
344 check_shadow name_env (rdr_name,loc)
345 = case lookupRdrEnv name_env rdr_name of
346 Nothing -> returnRn ()
347 Just name -> pushSrcLocRn loc $
348 addWarnRn (shadowedNameWarn rdr_name)
350 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
351 -- A specialised variant when renaming stuff from interface
352 -- files (of which there is a lot)
354 -- * no checks for shadowing
356 -- * deal with free vars
357 bindCoreLocalRn rdr_name enclosed_scope
358 = getSrcLocRn `thenRn` \ loc ->
359 getLocalNameEnv `thenRn` \ name_env ->
360 getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
362 (us', us1) = splitUniqSupply us
363 uniq = uniqFromSupply us1
364 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
366 setNameSupplyRn (us', cache, ipcache) `thenRn_`
368 new_name_env = extendRdrEnv name_env rdr_name name
370 setLocalNameEnv new_name_env (enclosed_scope name)
372 bindCoreLocalsRn [] thing_inside = thing_inside []
373 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
374 bindCoreLocalsRn bs $ \ names' ->
375 thing_inside (name':names')
377 bindLocalNames names enclosed_scope
378 = getLocalNameEnv `thenRn` \ name_env ->
379 setLocalNameEnv (addListToRdrEnv name_env pairs)
382 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
384 -------------------------------------
385 bindLocalRn doc rdr_name enclosed_scope
386 = getSrcLocRn `thenRn` \ loc ->
387 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
391 bindLocalsRn doc rdr_names enclosed_scope
392 = getSrcLocRn `thenRn` \ loc ->
393 bindLocatedLocalsRn doc
394 (rdr_names `zip` repeat loc)
397 -- binLocalsFVRn is the same as bindLocalsRn
398 -- except that it deals with free vars
399 bindLocalsFVRn doc rdr_names enclosed_scope
400 = bindLocalsRn doc rdr_names $ \ names ->
401 enclosed_scope names `thenRn` \ (thing, fvs) ->
402 returnRn (thing, delListFromNameSet fvs names)
404 -------------------------------------
405 bindUVarRn :: RdrName -> (Name -> RnMS a) -> RnMS a
406 bindUVarRn = bindCoreLocalRn
408 -------------------------------------
409 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
410 -- This tiresome function is used only in rnDecl on InstDecl
411 extendTyVarEnvFVRn tyvars enclosed_scope
412 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
413 returnRn (thing, delListFromNameSet fvs tyvars)
415 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
416 -> ([HsTyVarBndr Name] -> RnMS a)
418 bindTyVarsRn doc_str tyvar_names enclosed_scope
419 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
420 enclosed_scope tyvars
422 -- Gruesome name: return Names as well as HsTyVars
423 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
424 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
426 bindTyVars2Rn doc_str tyvar_names enclosed_scope
427 = getSrcLocRn `thenRn` \ loc ->
429 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
431 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
432 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
434 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
435 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
436 -> RnMS (a, FreeVars)
437 bindTyVarsFVRn doc_str rdr_names enclosed_scope
438 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
439 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
440 returnRn (thing, delListFromNameSet fvs names)
442 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
443 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
444 -> RnMS (a, FreeVars)
445 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
446 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
447 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
448 returnRn (thing, delListFromNameSet fvs names)
450 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
451 -> ([Name] -> RnMS (a, FreeVars))
452 -> RnMS (a, FreeVars)
453 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
454 = getSrcLocRn `thenRn` \ loc ->
456 located_tyvars = [(tv, loc) | tv <- tyvar_names]
458 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
459 enclosed_scope names `thenRn` \ (thing, fvs) ->
460 returnRn (thing, delListFromNameSet fvs names)
463 -------------------------------------
464 checkDupOrQualNames, checkDupNames :: SDoc
465 -> [(RdrName, SrcLoc)]
467 -- Works in any variant of the renamer monad
469 checkDupOrQualNames doc_str rdr_names_w_loc
470 = -- Check for use of qualified names
471 mapRn_ (qualNameErr doc_str) quals `thenRn_`
472 checkDupNames doc_str rdr_names_w_loc
474 quals = filter (isQual . fst) rdr_names_w_loc
476 checkDupNames doc_str rdr_names_w_loc
477 = -- Check for duplicated names in a binding group
478 mapRn_ (dupNamesErr doc_str) dups
480 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
484 %************************************************************************
486 \subsection{GlobalRdrEnv}
488 %************************************************************************
491 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
492 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
494 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
495 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
497 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
498 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
500 combine_globals :: [(Name,Provenance)] -- Old
501 -> [(Name,Provenance)] -- New
502 -> [(Name,Provenance)]
503 combine_globals ns_old ns_new -- ns_new is often short
504 = foldr add ns_old ns_new
506 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
509 choose n m | n `beats` m = n
512 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
514 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
515 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
516 is_duplicate (n1,_) (n2,_) = n1 == n2
519 We treat two bindings of a locally-defined name as a duplicate,
520 because they might be two separate, local defns and we want to report
521 and error for that, {\em not} eliminate a duplicate.
523 On the other hand, if you import the same name from two different
524 import statements, we {\em do} want to eliminate the duplicate, not report
527 If a module imports itself then there might be a local defn and an imported
528 defn of the same name; in this case the names will compare as equal, but
529 will still have different provenances.
532 @unQualInScope@ returns a function that takes a @Name@ and tells whether
533 its unqualified name is in scope. This is put as a boolean flag in
534 the @Name@'s provenance to guide whether or not to print the name qualified
538 unQualInScope :: GlobalRdrEnv -> Name -> Bool
542 lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
543 Just [(name',_)] -> name == name'
548 %************************************************************************
552 %************************************************************************
555 plusAvail (Avail n1) (Avail n2) = Avail n1
556 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
559 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
562 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
563 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
565 emptyAvailEnv = emptyNameEnv
566 unitAvailEnv :: AvailInfo -> AvailEnv
567 unitAvailEnv a = unitNameEnv (availName a) a
569 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
570 plusAvailEnv = plusNameEnv_C plusAvail
572 availEnvElts = nameEnvElts
574 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
575 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
577 availsToNameSet :: [AvailInfo] -> NameSet
578 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
580 availName :: GenAvailInfo name -> name
581 availName (Avail n) = n
582 availName (AvailTC n _) = n
584 availNames :: GenAvailInfo name -> [name]
585 availNames (Avail n) = [n]
586 availNames (AvailTC n ns) = ns
588 -------------------------------------
589 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
590 addSysAvails avail [] = avail
591 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
593 -------------------------------------
594 filterAvail :: RdrNameIE -- Wanted
595 -> AvailInfo -- Available
596 -> Maybe AvailInfo -- Resulting available;
597 -- Nothing if (any of the) wanted stuff isn't there
599 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
600 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
601 | otherwise = Nothing
603 is_wanted name = nameOccName name `elem` wanted_occs
604 sub_names_ok = all (`elem` avail_occs) wanted_occs
605 avail_occs = map nameOccName ns
606 wanted_occs = map rdrNameOcc (want:wants)
608 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
611 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
613 filterAvail (IEVar _) avail@(Avail n) = Just avail
614 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
616 wanted n = nameOccName n == occ
618 -- The second equation happens if we import a class op, thus
620 -- where op is a class operation
622 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
623 -- We don't complain even if the IE says T(..), but
624 -- no constrs/class ops of T are available
625 -- Instead that's caught with a warning by the caller
627 filterAvail ie avail = Nothing
629 -------------------------------------
630 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
631 -- Group by module and sort by occurrence
632 -- This keeps the list in canonical order
633 groupAvails this_mod avails
634 = [ (mkSysModuleNameFS fs, sortLt lt avails)
635 | (fs,avails) <- fmToList groupFM
638 groupFM :: FiniteMap FastString Avails
639 -- Deliberately use the FastString so we
640 -- get a canonical ordering
641 groupFM = foldl add emptyFM avails
643 add env avail = addToFM_C combine env mod_fs [avail']
645 mod_fs = moduleNameFS (moduleName avail_mod)
646 avail_mod = case nameModule_maybe (availName avail) of
649 combine old _ = avail':old
650 avail' = sortAvail avail
652 a1 `lt` a2 = occ1 < occ2
654 occ1 = nameOccName (availName a1)
655 occ2 = nameOccName (availName a2)
657 sortAvail :: AvailInfo -> AvailInfo
658 -- Sort the sub-names into canonical order.
659 -- The canonical order has the "main name" at the beginning
660 -- (if it's there at all)
661 sortAvail (Avail n) = Avail n
662 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
663 | otherwise = AvailTC n ( sortLt lt ns)
665 n1 `lt` n2 = nameOccName n1 < nameOccName n2
669 %************************************************************************
671 \subsection{Free variable manipulation}
673 %************************************************************************
677 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
679 (ys, fvs_s) = unzip stuff
681 returnRn (ys, plusFVs fvs_s)
685 %************************************************************************
687 \subsection{Envt utility functions}
689 %************************************************************************
692 warnUnusedModules :: [ModuleName] -> RnM d ()
693 warnUnusedModules mods
694 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
695 if warn then mapRn_ (addWarnRn . unused_mod) mods
698 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
699 text "is imported, but nothing from it is used",
700 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
703 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
704 warnUnusedImports names
705 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
706 if warn then warnUnusedBinds names else returnRn ()
708 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
709 warnUnusedLocalBinds names
710 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
711 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
714 warnUnusedMatches names
715 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
716 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
719 -------------------------
721 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
722 warnUnusedBinds names
723 = mapRn_ warnUnusedGroup groups
725 -- Group by provenance
726 groups = equivClasses cmp names
727 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
730 -------------------------
732 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
733 warnUnusedGroup names
734 | null filtered_names = returnRn ()
735 | not is_local = returnRn ()
737 = pushSrcLocRn def_loc $
739 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
741 filtered_names = filter reportable names
742 (name1, prov1) = head filtered_names
743 (is_local, def_loc, msg)
745 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
747 NonLocalDef (UserImport mod loc _) _
748 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
750 reportable (name,_) = case occNameUserString (nameOccName name) of
753 -- Haskell 98 encourages compilers to suppress warnings about
754 -- unused names in a pattern if they start with "_".
758 addNameClashErrRn rdr_name (np1:nps)
759 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
760 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
762 msg1 = ptext SLIT("either") <+> mk_ref np1
763 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
764 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
766 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
767 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
768 4 (vcat [ppr how_in_scope1,
771 shadowedNameWarn shadow
772 = hsep [ptext SLIT("This binding for"),
774 ptext SLIT("shadows an existing binding")]
777 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
779 flavour = occNameFlavour (rdrNameOcc name)
781 qualNameErr descriptor (name,loc)
783 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
788 dupNamesErr descriptor ((name,loc) : dup_things)
790 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
792 (ptext SLIT("in") <+> descriptor))