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, 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 bindLocalNamesFV names enclosed_scope
385 = bindLocalNames names $
386 enclosed_scope `thenRn` \ (thing, fvs) ->
387 returnRn (thing, delListFromNameSet fvs names)
390 -------------------------------------
391 bindLocalRn doc rdr_name enclosed_scope
392 = getSrcLocRn `thenRn` \ loc ->
393 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
397 bindLocalsRn doc rdr_names enclosed_scope
398 = getSrcLocRn `thenRn` \ loc ->
399 bindLocatedLocalsRn doc
400 (rdr_names `zip` repeat loc)
403 -- binLocalsFVRn is the same as bindLocalsRn
404 -- except that it deals with free vars
405 bindLocalsFVRn doc rdr_names enclosed_scope
406 = bindLocalsRn doc rdr_names $ \ names ->
407 enclosed_scope names `thenRn` \ (thing, fvs) ->
408 returnRn (thing, delListFromNameSet fvs names)
410 -------------------------------------
411 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
412 -- This tiresome function is used only in rnDecl on InstDecl
413 extendTyVarEnvFVRn tyvars enclosed_scope
414 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
415 returnRn (thing, delListFromNameSet fvs tyvars)
417 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
418 -> ([HsTyVarBndr Name] -> RnMS a)
420 bindTyVarsRn doc_str tyvar_names enclosed_scope
421 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
422 enclosed_scope tyvars
424 -- Gruesome name: return Names as well as HsTyVars
425 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
426 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
428 bindTyVars2Rn doc_str tyvar_names enclosed_scope
429 = getSrcLocRn `thenRn` \ loc ->
431 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
433 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
434 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
436 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
437 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
438 -> RnMS (a, FreeVars)
439 bindTyVarsFVRn doc_str rdr_names enclosed_scope
440 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
441 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
442 returnRn (thing, delListFromNameSet fvs names)
444 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
445 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
446 -> RnMS (a, FreeVars)
447 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
448 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
449 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
450 returnRn (thing, delListFromNameSet fvs names)
452 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
453 -> ([Name] -> RnMS (a, FreeVars))
454 -> RnMS (a, FreeVars)
455 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
456 = getSrcLocRn `thenRn` \ loc ->
458 located_tyvars = [(tv, loc) | tv <- tyvar_names]
460 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
461 enclosed_scope names `thenRn` \ (thing, fvs) ->
462 returnRn (thing, delListFromNameSet fvs names)
465 -------------------------------------
466 checkDupOrQualNames, checkDupNames :: SDoc
467 -> [(RdrName, SrcLoc)]
469 -- Works in any variant of the renamer monad
471 checkDupOrQualNames doc_str rdr_names_w_loc
472 = -- Check for use of qualified names
473 mapRn_ (qualNameErr doc_str) quals `thenRn_`
474 checkDupNames doc_str rdr_names_w_loc
476 quals = filter (isQual . fst) rdr_names_w_loc
478 checkDupNames doc_str rdr_names_w_loc
479 = -- Check for duplicated names in a binding group
480 mapRn_ (dupNamesErr doc_str) dups
482 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
486 %************************************************************************
488 \subsection{GlobalRdrEnv}
490 %************************************************************************
493 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
494 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
496 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
497 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
499 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
500 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
502 combine_globals :: [(Name,Provenance)] -- Old
503 -> [(Name,Provenance)] -- New
504 -> [(Name,Provenance)]
505 combine_globals ns_old ns_new -- ns_new is often short
506 = foldr add ns_old ns_new
508 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
511 choose n m | n `beats` m = n
514 (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
516 is_duplicate :: (Name,Provenance) -> (Name,Provenance) -> Bool
517 is_duplicate (n1,LocalDef) (n2,LocalDef) = False
518 is_duplicate (n1,_) (n2,_) = n1 == n2
521 We treat two bindings of a locally-defined name as a duplicate,
522 because they might be two separate, local defns and we want to report
523 and error for that, {\em not} eliminate a duplicate.
525 On the other hand, if you import the same name from two different
526 import statements, we {\em do} want to eliminate the duplicate, not report
529 If a module imports itself then there might be a local defn and an imported
530 defn of the same name; in this case the names will compare as equal, but
531 will still have different provenances.
534 @unQualInScope@ returns a function that takes a @Name@ and tells whether
535 its unqualified name is in scope. This is put as a boolean flag in
536 the @Name@'s provenance to guide whether or not to print the name qualified
540 unQualInScope :: GlobalRdrEnv -> Name -> Bool
542 = (`elemNameSet` unqual_names)
544 unqual_names :: NameSet
545 unqual_names = foldRdrEnv add emptyNameSet env
546 add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
547 add _ _ unquals = unquals
551 %************************************************************************
555 %************************************************************************
558 plusAvail (Avail n1) (Avail n2) = Avail n1
559 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
562 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
565 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
566 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
568 emptyAvailEnv = emptyNameEnv
569 unitAvailEnv :: AvailInfo -> AvailEnv
570 unitAvailEnv a = unitNameEnv (availName a) a
572 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
573 plusAvailEnv = plusNameEnv_C plusAvail
575 availEnvElts = nameEnvElts
577 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
578 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
580 availsToNameSet :: [AvailInfo] -> NameSet
581 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
583 availName :: GenAvailInfo name -> name
584 availName (Avail n) = n
585 availName (AvailTC n _) = n
587 availNames :: GenAvailInfo name -> [name]
588 availNames (Avail n) = [n]
589 availNames (AvailTC n ns) = ns
591 -------------------------------------
592 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
593 addSysAvails avail [] = avail
594 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
596 -------------------------------------
597 filterAvail :: RdrNameIE -- Wanted
598 -> AvailInfo -- Available
599 -> Maybe AvailInfo -- Resulting available;
600 -- Nothing if (any of the) wanted stuff isn't there
602 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
603 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
604 | otherwise = Nothing
606 is_wanted name = nameOccName name `elem` wanted_occs
607 sub_names_ok = all (`elem` avail_occs) wanted_occs
608 avail_occs = map nameOccName ns
609 wanted_occs = map rdrNameOcc (want:wants)
611 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
614 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
616 filterAvail (IEVar _) avail@(Avail n) = Just avail
617 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
619 wanted n = nameOccName n == occ
621 -- The second equation happens if we import a class op, thus
623 -- where op is a class operation
625 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
626 -- We don't complain even if the IE says T(..), but
627 -- no constrs/class ops of T are available
628 -- Instead that's caught with a warning by the caller
630 filterAvail ie avail = Nothing
632 -------------------------------------
633 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
634 -- Group by module and sort by occurrence
635 -- This keeps the list in canonical order
636 groupAvails this_mod avails
637 = [ (mkSysModuleNameFS fs, sortLt lt avails)
638 | (fs,avails) <- fmToList groupFM
641 groupFM :: FiniteMap FastString Avails
642 -- Deliberately use the FastString so we
643 -- get a canonical ordering
644 groupFM = foldl add emptyFM avails
646 add env avail = addToFM_C combine env mod_fs [avail']
648 mod_fs = moduleNameFS (moduleName avail_mod)
649 avail_mod = case nameModule_maybe (availName avail) of
652 combine old _ = avail':old
653 avail' = sortAvail avail
655 a1 `lt` a2 = occ1 < occ2
657 occ1 = nameOccName (availName a1)
658 occ2 = nameOccName (availName a2)
660 sortAvail :: AvailInfo -> AvailInfo
661 -- Sort the sub-names into canonical order.
662 -- The canonical order has the "main name" at the beginning
663 -- (if it's there at all)
664 sortAvail (Avail n) = Avail n
665 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
666 | otherwise = AvailTC n ( sortLt lt ns)
668 n1 `lt` n2 = nameOccName n1 < nameOccName n2
672 %************************************************************************
674 \subsection{Free variable manipulation}
676 %************************************************************************
680 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
682 (ys, fvs_s) = unzip stuff
684 returnRn (ys, plusFVs fvs_s)
688 %************************************************************************
690 \subsection{Envt utility functions}
692 %************************************************************************
695 warnUnusedModules :: [ModuleName] -> RnM d ()
696 warnUnusedModules mods
697 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
698 if warn then mapRn_ (addWarnRn . unused_mod) mods
701 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
702 text "is imported, but nothing from it is used",
703 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
706 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
707 warnUnusedImports names
708 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
709 if warn then warnUnusedBinds names else returnRn ()
711 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
712 warnUnusedLocalBinds names
713 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
714 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
717 warnUnusedMatches names
718 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
719 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
722 -------------------------
724 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
725 warnUnusedBinds names
726 = mapRn_ warnUnusedGroup groups
728 -- Group by provenance
729 groups = equivClasses cmp names
730 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
733 -------------------------
735 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
736 warnUnusedGroup names
737 | null filtered_names = returnRn ()
738 | not is_local = returnRn ()
740 = pushSrcLocRn def_loc $
742 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
744 filtered_names = filter reportable names
745 (name1, prov1) = head filtered_names
746 (is_local, def_loc, msg)
748 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
750 NonLocalDef (UserImport mod loc _)
751 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
753 reportable (name,_) = case occNameUserString (nameOccName name) of
756 -- Haskell 98 encourages compilers to suppress warnings about
757 -- unused names in a pattern if they start with "_".
761 addNameClashErrRn rdr_name (np1:nps)
762 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
763 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
765 msg1 = ptext SLIT("either") <+> mk_ref np1
766 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
767 mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
769 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
770 = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
771 4 (vcat [ppr how_in_scope1,
774 shadowedNameWarn shadow
775 = hsep [ptext SLIT("This binding for"),
777 ptext SLIT("shadows an existing binding")]
780 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
782 flavour = occNameFlavour (rdrNameOcc name)
784 qualNameErr descriptor (name,loc)
786 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
791 dupNamesErr descriptor ((name,loc) : dup_things)
793 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
795 (ptext SLIT("in") <+> descriptor))