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 {-# SOURCE #-} RnHiFiles
13 import HscTypes ( ModIface(..) )
15 import RnHsSyn ( RenamedHsDecl )
16 import RdrHsSyn ( RdrNameIE )
17 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
18 mkRdrUnqual, mkRdrQual, qualifyRdrName, lookupRdrEnv, foldRdrEnv
20 import HsTypes ( hsTyVarName, replaceTyVarName )
21 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
22 ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
23 AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
24 Deprecations(..), lookupDeprec
29 mkLocalName, mkGlobalName,
30 mkIPName, nameOccName, nameModule_maybe,
31 setNameModuleAndLoc, mkNameEnv
33 import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
35 import OccName ( OccName, occNameUserString, occNameFlavour )
36 import Module ( ModuleName, moduleName, mkVanillaModule,
37 mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
38 import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
39 import Type ( funTyCon )
40 import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
42 mAIN_Name, pREL_MAIN_Name,
43 ioTyConName, printName,
44 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
49 import SrcLoc ( SrcLoc, noSrcLoc )
51 import ListSetOps ( removeDups, equivClasses )
52 import Util ( sortLt )
54 import UniqFM ( lookupWithDefaultUFM )
55 import Maybes ( orElse )
57 import FastString ( FastString )
60 %*********************************************************
62 \subsection{Making new names}
64 %*********************************************************
67 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
68 -- newTopBinder puts into the cache the binder with the
69 -- module information set correctly. When the decl is later renamed,
70 -- the binding site will thereby get the correct module.
71 -- There maybe occurrences that don't have the correct Module, but
72 -- by the typechecker will propagate the binding definition to all
73 -- the occurrences, so that doesn't matter
75 newTopBinder mod rdr_name loc
76 = -- First check the cache
78 -- There should never be a qualified name in a binding position (except in instance decls)
79 -- The parser doesn't check this because the same parser parses instance decls
80 (if isQual rdr_name then
81 qualNameErr (text "its declaration") (rdr_name,loc)
86 getNameSupplyRn `thenRn` \ name_supply ->
88 occ = rdrNameOcc rdr_name
89 key = (moduleName mod, occ)
90 cache = nsNames name_supply
92 case lookupFM cache key of
94 -- A hit in the cache! We are at the binding site of the name, and
95 -- this is the moment when we know all about
96 -- a) the Name's host Module (in particular, which
97 -- package it comes from)
98 -- b) its defining SrcLoc
99 -- So we update this info
102 new_name = setNameModuleAndLoc name mod loc
103 new_cache = addToFM cache key new_name
105 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
106 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
109 -- Miss in the cache!
110 -- Build a completely new Name, and put it in the cache
111 -- Even for locally-defined names we use implicitImportProvenance;
112 -- updateProvenances will set it to rights
114 (us', us1) = splitUniqSupply (nsUniqs name_supply)
115 uniq = uniqFromSupply us1
116 new_name = mkGlobalName uniq mod occ loc
117 new_cache = addToFM cache key new_name
119 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
120 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
124 newGlobalName :: ModuleName -> OccName -> RnM d Name
125 -- Used for *occurrences*. We make a place-holder Name, really just
126 -- to agree on its unique, which gets overwritten when we read in
127 -- the binding occurence later (newTopBinder)
128 -- The place-holder Name doesn't have the right SrcLoc, and its
129 -- Module won't have the right Package either.
131 -- (We have to pass a ModuleName, not a Module, because we may be
132 -- simply looking at an occurrence M.x in an interface file.)
134 -- This means that a renamed program may have incorrect info
135 -- on implicitly-imported occurrences, but the correct info on the
136 -- *binding* declaration. It's the type checker that propagates the
137 -- correct information to all the occurrences.
138 -- Since implicitly-imported names never occur in error messages,
139 -- it doesn't matter that we get the correct info in place till later,
140 -- (but since it affects DLL-ery it does matter that we get it right
142 newGlobalName mod_name occ
143 = getNameSupplyRn `thenRn` \ name_supply ->
145 key = (mod_name, occ)
146 cache = nsNames name_supply
148 case lookupFM cache key of
149 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
152 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
153 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
156 (us', us1) = splitUniqSupply (nsUniqs name_supply)
157 uniq = uniqFromSupply us1
158 mod = mkVanillaModule mod_name
159 name = mkGlobalName uniq mod occ noSrcLoc
160 new_cache = addToFM cache key name
163 = getNameSupplyRn `thenRn` \ name_supply ->
165 ipcache = nsIPs name_supply
167 case lookupFM ipcache key of
168 Just name -> returnRn name
169 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
172 (us', us1) = splitUniqSupply (nsUniqs name_supply)
173 uniq = uniqFromSupply us1
174 name = mkIPName uniq key
175 new_ipcache = addToFM ipcache key name
176 where key = (rdrNameOcc rdr_name)
179 %*********************************************************
181 \subsection{Looking up names}
183 %*********************************************************
185 Looking up a name in the RnEnv.
188 lookupBndrRn rdr_name
189 = getLocalNameEnv `thenRn` \ local_env ->
190 case lookupRdrEnv local_env rdr_name of
191 Just name -> returnRn name
192 Nothing -> lookupTopBndrRn rdr_name
194 lookupTopBndrRn rdr_name
195 = getModeRn `thenRn` \ mode ->
196 if isInterfaceMode mode
197 then lookupIfaceName rdr_name
198 else -- Source mode, so look up a *qualified* version
199 -- of the name, so that we get the right one even
200 -- if there are many with the same occ name
201 -- There must *be* a binding
202 getModuleRn `thenRn` \ mod ->
203 getGlobalNameEnv `thenRn` \ global_env ->
204 lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
206 -- lookupSigOccRn is used for type signatures and pragmas
212 -- It's clear that the 'f' in the signature must refer to A.f
213 -- The Haskell98 report does not stipulate this, but it will!
214 -- So we must treat the 'f' in the signature in the same way
215 -- as the binding occurrence of 'f', using lookupBndrRn
216 lookupSigOccRn :: RdrName -> RnMS Name
217 lookupSigOccRn = lookupBndrRn
219 -- lookupOccRn looks up an occurrence of a RdrName
220 lookupOccRn :: RdrName -> RnMS Name
222 = getLocalNameEnv `thenRn` \ local_env ->
223 case lookupRdrEnv local_env rdr_name of
224 Just name -> returnRn name
225 Nothing -> lookupGlobalOccRn rdr_name
227 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
228 -- environment. It's used only for
229 -- record field names
230 -- class op names in class and instance decls
232 lookupGlobalOccRn rdr_name
233 = getModeRn `thenRn` \ mode ->
234 if (isInterfaceMode mode)
235 then lookupIfaceName rdr_name
238 getGlobalNameEnv `thenRn` \ global_env ->
240 SourceMode -> lookupSrcName global_env rdr_name
243 | not (isQual rdr_name) ->
244 lookupSrcName global_env rdr_name
246 -- We allow qualified names on the command line to refer to
247 -- *any* name exported by any module in scope, just as if
248 -- there was an "import qualified M" declaration for every
251 -- First look up the name in the normal environment. If
252 -- it isn't there, we manufacture a new occurrence of an
255 case lookupRdrEnv global_env rdr_name of
256 Just _ -> lookupSrcName global_env rdr_name
257 Nothing -> lookupQualifiedName rdr_name
259 -- a qualified name on the command line can refer to any module at all: we
260 -- try to load the interface if we don't already have it.
261 lookupQualifiedName :: RdrName -> RnM d Name
262 lookupQualifiedName rdr_name
264 mod = rdrNameModule rdr_name
265 occ = rdrNameOcc rdr_name
267 loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
268 case [ name | (_,avails) <- mi_exports iface,
270 name <- availNames avail,
271 nameOccName name == occ ] of
272 (n:ns) -> ASSERT (null ns) returnRn n
273 _ -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
275 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
276 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
277 lookupSrcName global_env rdr_name
278 | isOrig rdr_name -- Can occur in source code too
279 = lookupOrigName rdr_name
282 = case lookupRdrEnv global_env rdr_name of
283 Just [GRE name _ Nothing] -> returnRn name
284 Just [GRE name _ (Just deprec)] -> warnDeprec name deprec `thenRn_`
286 Just stuff@(GRE name _ _ : _) -> addNameClashErrRn rdr_name stuff `thenRn_`
288 Nothing -> failWithRn (mkUnboundName rdr_name)
289 (unknownNameErr rdr_name)
291 lookupOrigName :: RdrName -> RnM d Name
292 lookupOrigName rdr_name
293 = ASSERT( isOrig rdr_name )
294 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
296 lookupIfaceUnqual :: RdrName -> RnM d Name
297 lookupIfaceUnqual rdr_name
298 = ASSERT( isUnqual rdr_name )
299 -- An Unqual is allowed; interface files contain
300 -- unqualified names for locally-defined things, such as
301 -- constructors of a data type.
302 getModuleRn `thenRn ` \ mod ->
303 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
305 lookupIfaceName :: RdrName -> RnM d Name
306 lookupIfaceName rdr_name
307 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
308 | otherwise = lookupOrigName rdr_name
311 @lookupOrigName@ takes an RdrName representing an {\em original}
312 name, and adds it to the occurrence pool so that it'll be loaded
313 later. This is used when language constructs (such as monad
314 comprehensions, overloaded literals, or deriving clauses) require some
315 stuff to be loaded that isn't explicitly mentioned in the code.
317 This doesn't apply in interface mode, where everything is explicit,
318 but we don't check for this case: it does no harm to record an
319 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
320 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
321 calls it at all I think).
323 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
326 lookupOrigNames :: [RdrName] -> RnM d NameSet
327 lookupOrigNames rdr_names
328 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
329 returnRn (mkNameSet names)
332 lookupSysBinder is used for the "system binders" of a type, class, or
333 instance decl. It ensures that the module is set correctly in the
334 name cache, and sets the provenance on the returned name too. The
335 returned name will end up actually in the type, class, or instance.
338 lookupSysBinder rdr_name
339 = ASSERT( isUnqual rdr_name )
340 getModuleRn `thenRn` \ mod ->
341 getSrcLocRn `thenRn` \ loc ->
342 newTopBinder mod rdr_name loc
346 %*********************************************************
348 \subsection{Implicit free vars and sugar names}
350 %*********************************************************
352 @addImplicitFVs@ forces the renamer to slurp in some things which aren't
353 mentioned explicitly, but which might be needed by the type checker.
356 addImplicitFVs :: GlobalRdrEnv
357 -> Maybe (ModuleName, [RenamedHsDecl]) -- Nothing when compling an expression
358 -> FreeVars -- Free in the source
359 -> RnMG (FreeVars, SyntaxMap) -- Augmented source free vars
361 addImplicitFVs gbl_env maybe_mod source_fvs
362 = -- Find out what re-bindable names to use for desugaring
363 rnSyntaxNames gbl_env source_fvs `thenRn` \ (source_fvs1, sugar_map) ->
365 -- Find implicit FVs thade
366 extra_implicits maybe_mod `thenRn` \ extra_fvs ->
369 implicit_fvs = ubiquitousNames `plusFV` extra_fvs
370 slurp_fvs = implicit_fvs `plusFV` source_fvs1
371 -- It's important to do the "plus" this way round, so that
372 -- when compiling the prelude, locally-defined (), Bool, etc
373 -- override the implicit ones.
375 returnRn (slurp_fvs, sugar_map)
378 extra_implicits Nothing -- Compiling an expression
379 = returnRn (unitFV printName) -- print :: a -> IO () may be needed later
381 extra_implicits (Just (mod_name, decls)) -- Compiling a module
382 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
383 returnRn (deriving_names `plusFV` implicit_main)
385 -- Add occurrences for IO or PrimIO
386 implicit_main | mod_name == mAIN_Name
387 || mod_name == pREL_MAIN_Name = unitFV ioTyConName
388 | otherwise = emptyFVs
390 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
391 cls <- deriv_classes,
392 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
394 -- ubiquitous_names are loaded regardless, because
395 -- they are needed in virtually every program
397 = mkFVs [unpackCStringName, unpackCStringFoldrName,
398 unpackCStringUtf8Name, eqStringName]
399 -- Virtually every program has error messages in it somewhere
402 mkFVs (map getName [unitTyCon, funTyCon, boolTyCon, intTyCon])
403 -- Add occurrences for Int, and (), because they
404 -- are the types to which ambigious type variables may be defaulted by
405 -- the type checker; so they won't always appear explicitly.
406 -- [The () one is a GHC extension for defaulting CCall results.]
407 -- ALSO: funTyCon, since it occurs implicitly everywhere!
408 -- (we don't want to be bothered with making funTyCon a
409 -- free var at every function application!)
410 -- Double is dealt with separately in getGates
414 rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
415 -- Look up the re-bindable syntactic sugar names
416 -- Any errors arising from these lookups may surprise the
417 -- programmer, since they aren't explicitly mentioned, and
418 -- the src line will be unhelpful (ToDo)
420 rnSyntaxNames gbl_env source_fvs
421 = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
422 if not no_prelude then
423 returnRn (source_fvs, vanillaSyntaxMap)
426 -- There's a -fno-implicit-prelude flag,
427 -- so build the re-mapping function
429 reqd_syntax_list = filter is_reqd syntaxList
430 is_reqd (n,_) = n `elemNameSet` source_fvs
431 lookup (n,rn) = lookupSrcName gbl_env rn `thenRn` \ rn' ->
434 mapRn lookup reqd_syntax_list `thenRn` \ rn_syntax_list ->
436 -- Delete the proxies and add the actuals
437 proxies = map fst rn_syntax_list
438 actuals = map snd rn_syntax_list
439 new_source_fvs = (proxies `delFVs` source_fvs) `plusFV` mkFVs actuals
441 syntax_env = mkNameEnv rn_syntax_list
442 syntax_map n = lookupNameEnv syntax_env n `orElse` n
444 returnRn (new_source_fvs, syntax_map)
448 %*********************************************************
452 %*********************************************************
455 newLocalsRn :: [(RdrName,SrcLoc)]
457 newLocalsRn rdr_names_w_loc
458 = getNameSupplyRn `thenRn` \ name_supply ->
460 n = length rdr_names_w_loc
461 (us', us1) = splitUniqSupply (nsUniqs name_supply)
462 uniqs = uniqsFromSupply n us1
463 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
464 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
467 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
471 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
472 -> [(RdrName,SrcLoc)]
473 -> ([Name] -> RnMS a)
475 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
476 = getModeRn `thenRn` \ mode ->
477 getLocalNameEnv `thenRn` \ name_env ->
479 -- Check for duplicate names
480 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
482 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
484 -- Warn about shadowing, but only in source modules
486 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
490 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
492 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
494 setLocalNameEnv new_local_env (enclosed_scope names)
497 check_shadow name_env (rdr_name,loc)
498 = case lookupRdrEnv name_env rdr_name of
499 Nothing -> returnRn ()
500 Just name -> pushSrcLocRn loc $
501 addWarnRn (shadowedNameWarn rdr_name)
503 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
504 -- A specialised variant when renaming stuff from interface
505 -- files (of which there is a lot)
507 -- * no checks for shadowing
509 -- * deal with free vars
510 bindCoreLocalRn rdr_name enclosed_scope
511 = getSrcLocRn `thenRn` \ loc ->
512 getLocalNameEnv `thenRn` \ name_env ->
513 getNameSupplyRn `thenRn` \ name_supply ->
515 (us', us1) = splitUniqSupply (nsUniqs name_supply)
516 uniq = uniqFromSupply us1
517 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
519 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
521 new_name_env = extendRdrEnv name_env rdr_name name
523 setLocalNameEnv new_name_env (enclosed_scope name)
525 bindCoreLocalsRn [] thing_inside = thing_inside []
526 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
527 bindCoreLocalsRn bs $ \ names' ->
528 thing_inside (name':names')
530 bindLocalNames names enclosed_scope
531 = getLocalNameEnv `thenRn` \ name_env ->
532 setLocalNameEnv (addListToRdrEnv name_env pairs)
535 pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
537 bindLocalNamesFV names enclosed_scope
538 = bindLocalNames names $
539 enclosed_scope `thenRn` \ (thing, fvs) ->
540 returnRn (thing, delListFromNameSet fvs names)
543 -------------------------------------
544 bindLocalRn doc rdr_name enclosed_scope
545 = getSrcLocRn `thenRn` \ loc ->
546 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
550 bindLocalsRn doc rdr_names enclosed_scope
551 = getSrcLocRn `thenRn` \ loc ->
552 bindLocatedLocalsRn doc
553 (rdr_names `zip` repeat loc)
556 -- binLocalsFVRn is the same as bindLocalsRn
557 -- except that it deals with free vars
558 bindLocalsFVRn doc rdr_names enclosed_scope
559 = bindLocalsRn doc rdr_names $ \ names ->
560 enclosed_scope names `thenRn` \ (thing, fvs) ->
561 returnRn (thing, delListFromNameSet fvs names)
563 -------------------------------------
564 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
565 -- This tiresome function is used only in rnSourceDecl on InstDecl
566 extendTyVarEnvFVRn tyvars enclosed_scope
567 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
568 returnRn (thing, delListFromNameSet fvs tyvars)
570 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
571 -> ([HsTyVarBndr Name] -> RnMS a)
573 bindTyVarsRn doc_str tyvar_names enclosed_scope
574 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
575 enclosed_scope tyvars
577 -- Gruesome name: return Names as well as HsTyVars
578 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
579 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
581 bindTyVars2Rn doc_str tyvar_names enclosed_scope
582 = getSrcLocRn `thenRn` \ loc ->
584 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
586 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
587 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
589 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
590 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
591 -> RnMS (a, FreeVars)
592 bindTyVarsFVRn doc_str rdr_names enclosed_scope
593 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
594 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
595 returnRn (thing, delListFromNameSet fvs names)
597 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
598 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
599 -> RnMS (a, FreeVars)
600 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
601 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
602 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
603 returnRn (thing, delListFromNameSet fvs names)
605 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
606 -> ([Name] -> RnMS (a, FreeVars))
607 -> RnMS (a, FreeVars)
608 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
609 = getSrcLocRn `thenRn` \ loc ->
611 located_tyvars = [(tv, loc) | tv <- tyvar_names]
613 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
614 enclosed_scope names `thenRn` \ (thing, fvs) ->
615 returnRn (thing, delListFromNameSet fvs names)
618 -------------------------------------
619 checkDupOrQualNames, checkDupNames :: SDoc
620 -> [(RdrName, SrcLoc)]
622 -- Works in any variant of the renamer monad
624 checkDupOrQualNames doc_str rdr_names_w_loc
625 = -- Check for use of qualified names
626 mapRn_ (qualNameErr doc_str) quals `thenRn_`
627 checkDupNames doc_str rdr_names_w_loc
629 quals = filter (isQual . fst) rdr_names_w_loc
631 checkDupNames doc_str rdr_names_w_loc
632 = -- Check for duplicated names in a binding group
633 mapRn_ (dupNamesErr doc_str) dups
635 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
639 %************************************************************************
641 \subsection{GlobalRdrEnv}
643 %************************************************************************
646 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
647 -> Bool -- True <=> want unqualified import
648 -> Bool -- True <=> want qualified import
649 -> [AvailInfo] -- What's to be hidden (but only the unqualified
650 -- version is hidden)
651 -> (Name -> Provenance)
652 -> Avails -- Whats imported and how
656 mkGlobalRdrEnv this_mod unqual_imp qual_imp hides
657 mk_provenance avails deprecs
660 -- Make the name environment. We're talking about a
661 -- single module here, so there must be no name clashes.
662 -- In practice there only ever will be if it's the module
665 -- Add the things that are available
666 gbl_env1 = foldl add_avail emptyRdrEnv avails
668 -- Delete things that are hidden
669 gbl_env2 = foldl del_avail gbl_env1 hides
671 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
672 add_avail env avail = foldl add_name env (availNames avail)
675 | qual_imp && unqual_imp = env3
680 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
681 env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt
682 env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt
683 occ = nameOccName name
684 elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
686 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
688 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
690 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
691 -- Used to construct a GlobalRdrEnv for an interface that we've
692 -- read from a .hi file. We can't construct the original top-level
693 -- environment because we don't have enough info, but we compromise
694 -- by making an environment from its exports
695 mkIfaceGlobalRdrEnv m_avails
696 = foldl add emptyRdrEnv m_avails
698 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False []
699 (\n -> LocalDef) avails NoDeprecs)
700 -- The NoDeprecs is a bit of a hack I suppose
704 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
705 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
707 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
708 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
710 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
711 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
713 combine_globals :: [GlobalRdrElt] -- Old
714 -> [GlobalRdrElt] -- New
716 combine_globals ns_old ns_new -- ns_new is often short
717 = foldr add ns_old ns_new
719 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
722 choose n m | n `beats` m = n
725 (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
727 is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
728 is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
729 is_duplicate (GRE n1 _ _) (GRE n2 _ _) = n1 == n2
732 We treat two bindings of a locally-defined name as a duplicate,
733 because they might be two separate, local defns and we want to report
734 and error for that, {\em not} eliminate a duplicate.
736 On the other hand, if you import the same name from two different
737 import statements, we {\em do} want to eliminate the duplicate, not report
740 If a module imports itself then there might be a local defn and an imported
741 defn of the same name; in this case the names will compare as equal, but
742 will still have different provenances.
745 @unQualInScope@ returns a function that takes a @Name@ and tells whether
746 its unqualified name is in scope. This is put as a boolean flag in
747 the @Name@'s provenance to guide whether or not to print the name qualified
751 unQualInScope :: GlobalRdrEnv -> Name -> Bool
753 = (`elemNameSet` unqual_names)
755 unqual_names :: NameSet
756 unqual_names = foldRdrEnv add emptyNameSet env
757 add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
758 add _ _ unquals = unquals
762 %************************************************************************
766 %************************************************************************
769 plusAvail (Avail n1) (Avail n2) = Avail n1
770 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
773 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
776 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
777 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
779 emptyAvailEnv = emptyNameEnv
780 unitAvailEnv :: AvailInfo -> AvailEnv
781 unitAvailEnv a = unitNameEnv (availName a) a
783 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
784 plusAvailEnv = plusNameEnv_C plusAvail
786 availEnvElts = nameEnvElts
788 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
789 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
791 availsToNameSet :: [AvailInfo] -> NameSet
792 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
794 availName :: GenAvailInfo name -> name
795 availName (Avail n) = n
796 availName (AvailTC n _) = n
798 availNames :: GenAvailInfo name -> [name]
799 availNames (Avail n) = [n]
800 availNames (AvailTC n ns) = ns
802 -------------------------------------
803 filterAvail :: RdrNameIE -- Wanted
804 -> AvailInfo -- Available
805 -> Maybe AvailInfo -- Resulting available;
806 -- Nothing if (any of the) wanted stuff isn't there
808 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
809 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
810 | otherwise = Nothing
812 is_wanted name = nameOccName name `elem` wanted_occs
813 sub_names_ok = all (`elem` avail_occs) wanted_occs
814 avail_occs = map nameOccName ns
815 wanted_occs = map rdrNameOcc (want:wants)
817 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
820 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
822 filterAvail (IEVar _) avail@(Avail n) = Just avail
823 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
825 wanted n = nameOccName n == occ
827 -- The second equation happens if we import a class op, thus
829 -- where op is a class operation
831 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
832 -- We don't complain even if the IE says T(..), but
833 -- no constrs/class ops of T are available
834 -- Instead that's caught with a warning by the caller
836 filterAvail ie avail = Nothing
838 -------------------------------------
839 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
840 -- Group by module and sort by occurrence
841 -- This keeps the list in canonical order
842 groupAvails this_mod avails
843 = [ (mkSysModuleNameFS fs, sortLt lt avails)
844 | (fs,avails) <- fmToList groupFM
847 groupFM :: FiniteMap FastString Avails
848 -- Deliberately use the FastString so we
849 -- get a canonical ordering
850 groupFM = foldl add emptyFM avails
852 add env avail = addToFM_C combine env mod_fs [avail']
854 mod_fs = moduleNameFS (moduleName avail_mod)
855 avail_mod = case nameModule_maybe (availName avail) of
858 combine old _ = avail':old
859 avail' = sortAvail avail
861 a1 `lt` a2 = occ1 < occ2
863 occ1 = nameOccName (availName a1)
864 occ2 = nameOccName (availName a2)
866 sortAvail :: AvailInfo -> AvailInfo
867 -- Sort the sub-names into canonical order.
868 -- The canonical order has the "main name" at the beginning
869 -- (if it's there at all)
870 sortAvail (Avail n) = Avail n
871 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
872 | otherwise = AvailTC n ( sortLt lt ns)
874 n1 `lt` n2 = nameOccName n1 < nameOccName n2
878 %************************************************************************
880 \subsection{Free variable manipulation}
882 %************************************************************************
886 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
888 (ys, fvs_s) = unzip stuff
890 returnRn (ys, plusFVs fvs_s)
894 %************************************************************************
896 \subsection{Envt utility functions}
898 %************************************************************************
901 warnUnusedModules :: [ModuleName] -> RnM d ()
902 warnUnusedModules mods
903 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
904 if warn then mapRn_ (addWarnRn . unused_mod) mods
907 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
908 text "is imported, but nothing from it is used",
909 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
912 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
913 warnUnusedImports names
914 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
915 if warn then warnUnusedBinds names else returnRn ()
917 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
918 warnUnusedLocalBinds names
919 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
920 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
923 warnUnusedMatches names
924 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
925 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
928 -------------------------
930 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
931 warnUnusedBinds names
932 = mapRn_ warnUnusedGroup groups
934 -- Group by provenance
935 groups = equivClasses cmp names
936 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
939 -------------------------
941 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
942 warnUnusedGroup names
943 | null filtered_names = returnRn ()
944 | not is_local = returnRn ()
946 = pushSrcLocRn def_loc $
948 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
950 filtered_names = filter reportable names
951 (name1, prov1) = head filtered_names
952 (is_local, def_loc, msg)
954 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
956 NonLocalDef (UserImport mod loc _)
957 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
959 reportable (name,_) = case occNameUserString (nameOccName name) of
962 -- Haskell 98 encourages compilers to suppress warnings about
963 -- unused names in a pattern if they start with "_".
967 addNameClashErrRn rdr_name (np1:nps)
968 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
969 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
971 msg1 = ptext SLIT("either") <+> mk_ref np1
972 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
973 mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
975 shadowedNameWarn shadow
976 = hsep [ptext SLIT("This binding for"),
978 ptext SLIT("shadows an existing binding")]
981 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
983 flavour = occNameFlavour (rdrNameOcc name)
985 qualNameErr descriptor (name,loc)
987 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
992 dupNamesErr descriptor ((name,loc) : dup_things)
994 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
996 (ptext SLIT("in") <+> descriptor))
998 warnDeprec :: Name -> DeprecTxt -> RnM d ()
1000 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
1001 if not warn_drs then returnRn () else
1002 addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
1003 quotes (ppr name) <+> text "is deprecated:",