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
14 import RdrHsSyn ( RdrNameIE )
15 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
16 mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv
18 import HsTypes ( hsTyVarName, replaceTyVarName )
19 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
20 ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
21 AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
23 Deprecations(..), lookupDeprec,
28 getSrcLoc, nameIsLocalOrFrom,
29 mkLocalName, mkGlobalName,
30 mkIPName, nameOccName, nameModule_maybe,
35 import OccName ( OccName, occNameUserString, occNameFlavour )
36 import Module ( ModuleName, moduleName, mkVanillaModule,
37 mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
38 import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
40 mAIN_Name, pREL_MAIN_Name,
41 ioTyConName, intTyConName,
42 boolTyConName, funTyConName,
43 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
44 eqStringName, printName,
45 bindIOName, returnIOName, failIOName
47 import TysWiredIn ( unitTyCon ) -- A little odd
50 import SrcLoc ( SrcLoc, noSrcLoc )
52 import ListSetOps ( removeDups, equivClasses )
53 import Util ( sortLt )
55 import UniqFM ( lookupWithDefaultUFM )
56 import Maybes ( orElse )
58 import FastString ( FastString )
61 %*********************************************************
63 \subsection{Making new names}
65 %*********************************************************
68 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
69 -- newTopBinder puts into the cache the binder with the
70 -- module information set correctly. When the decl is later renamed,
71 -- the binding site will thereby get the correct module.
72 -- There maybe occurrences that don't have the correct Module, but
73 -- by the typechecker will propagate the binding definition to all
74 -- the occurrences, so that doesn't matter
76 newTopBinder mod rdr_name loc
77 = -- First check the cache
79 -- There should never be a qualified name in a binding position (except in instance decls)
80 -- The parser doesn't check this because the same parser parses instance decls
81 (if isQual rdr_name then
82 qualNameErr (text "its declaration") (rdr_name,loc)
87 getNameSupplyRn `thenRn` \ name_supply ->
89 occ = rdrNameOcc rdr_name
90 key = (moduleName mod, occ)
91 cache = nsNames name_supply
93 case lookupFM cache key of
95 -- A hit in the cache! We are at the binding site of the name, and
96 -- this is the moment when we know all about
97 -- a) the Name's host Module (in particular, which
98 -- package it comes from)
99 -- b) its defining SrcLoc
100 -- So we update this info
103 new_name = setNameModuleAndLoc name mod loc
104 new_cache = addToFM cache key new_name
106 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
107 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
110 -- Miss in the cache!
111 -- Build a completely new Name, and put it in the cache
112 -- Even for locally-defined names we use implicitImportProvenance;
113 -- updateProvenances will set it to rights
115 (us', us1) = splitUniqSupply (nsUniqs name_supply)
116 uniq = uniqFromSupply us1
117 new_name = mkGlobalName uniq mod occ loc
118 new_cache = addToFM cache key new_name
120 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
121 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
125 newGlobalName :: ModuleName -> OccName -> RnM d Name
126 -- Used for *occurrences*. We make a place-holder Name, really just
127 -- to agree on its unique, which gets overwritten when we read in
128 -- the binding occurence later (newTopBinder)
129 -- The place-holder Name doesn't have the right SrcLoc, and its
130 -- Module won't have the right Package either.
132 -- (We have to pass a ModuleName, not a Module, because we may be
133 -- simply looking at an occurrence M.x in an interface file.)
135 -- This means that a renamed program may have incorrect info
136 -- on implicitly-imported occurrences, but the correct info on the
137 -- *binding* declaration. It's the type checker that propagates the
138 -- correct information to all the occurrences.
139 -- Since implicitly-imported names never occur in error messages,
140 -- it doesn't matter that we get the correct info in place till later,
141 -- (but since it affects DLL-ery it does matter that we get it right
143 newGlobalName mod_name occ
144 = getNameSupplyRn `thenRn` \ name_supply ->
146 key = (mod_name, occ)
147 cache = nsNames name_supply
149 case lookupFM cache key of
150 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
153 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
154 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
157 (us', us1) = splitUniqSupply (nsUniqs name_supply)
158 uniq = uniqFromSupply us1
159 mod = mkVanillaModule mod_name
160 name = mkGlobalName uniq mod occ noSrcLoc
161 new_cache = addToFM cache key name
164 = getNameSupplyRn `thenRn` \ name_supply ->
166 ipcache = nsIPs name_supply
168 case lookupFM ipcache key of
169 Just name -> returnRn name
170 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
173 (us', us1) = splitUniqSupply (nsUniqs name_supply)
174 uniq = uniqFromSupply us1
175 name = mkIPName uniq key
176 new_ipcache = addToFM ipcache key name
177 where key = (rdrNameOcc rdr_name)
180 %*********************************************************
182 \subsection{Looking up names}
184 %*********************************************************
186 Looking up a name in the RnEnv.
189 lookupBndrRn rdr_name
190 = getLocalNameEnv `thenRn` \ local_env ->
191 case lookupRdrEnv local_env rdr_name of
192 Just name -> returnRn name
193 Nothing -> lookupTopBndrRn rdr_name
195 lookupTopBndrRn rdr_name
196 -- Look up a top-level local binder. We may be looking up an unqualified 'f',
197 -- and there may be several imported 'f's too, which must not confuse us.
198 -- So we have to filter out the non-local ones.
199 -- A separate function (importsFromLocalDecls) reports duplicate top level
200 -- decls, so here it's safe just to choose an arbitrary one.
203 -- This is here just to catch the PrelBase defn of (say) [] and similar
204 -- The parser reads the special syntax and returns an Orig RdrName
205 -- But the global_env contains only Qual RdrNames, so we won't
206 -- find it there; instead just get the name via the Orig route
207 = lookupOrigName rdr_name
210 = getModeRn `thenRn` \ mode ->
211 if isInterfaceMode mode
212 then lookupIfaceName rdr_name
214 getModuleRn `thenRn` \ mod ->
215 getGlobalNameEnv `thenRn` \ global_env ->
216 case lookup_local mod global_env rdr_name of
217 Just name -> returnRn name
218 Nothing -> failWithRn (mkUnboundName rdr_name)
219 (unknownNameErr rdr_name)
221 lookup_local mod global_env rdr_name
222 = case lookupRdrEnv global_env rdr_name of
224 Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of
229 -- lookupSigOccRn is used for type signatures and pragmas
235 -- It's clear that the 'f' in the signature must refer to A.f
236 -- The Haskell98 report does not stipulate this, but it will!
237 -- So we must treat the 'f' in the signature in the same way
238 -- as the binding occurrence of 'f', using lookupBndrRn
239 lookupSigOccRn :: RdrName -> RnMS Name
240 lookupSigOccRn = lookupBndrRn
242 -- lookupOccRn looks up an occurrence of a RdrName
243 lookupOccRn :: RdrName -> RnMS Name
245 = getLocalNameEnv `thenRn` \ local_env ->
246 case lookupRdrEnv local_env rdr_name of
247 Just name -> returnRn name
248 Nothing -> lookupGlobalOccRn rdr_name
250 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
251 -- environment. It's used only for
252 -- record field names
253 -- class op names in class and instance decls
255 lookupGlobalOccRn rdr_name
256 = getModeRn `thenRn` \ mode ->
257 if (isInterfaceMode mode)
258 then lookupIfaceName rdr_name
261 getGlobalNameEnv `thenRn` \ global_env ->
263 SourceMode -> lookupSrcName global_env rdr_name
266 | not (isQual rdr_name) ->
267 lookupSrcName global_env rdr_name
269 -- We allow qualified names on the command line to refer to
270 -- *any* name exported by any module in scope, just as if
271 -- there was an "import qualified M" declaration for every
274 -- First look up the name in the normal environment. If
275 -- it isn't there, we manufacture a new occurrence of an
278 case lookupRdrEnv global_env rdr_name of
279 Just _ -> lookupSrcName global_env rdr_name
280 Nothing -> lookupQualifiedName rdr_name
282 -- a qualified name on the command line can refer to any module at all: we
283 -- try to load the interface if we don't already have it.
284 lookupQualifiedName :: RdrName -> RnM d Name
285 lookupQualifiedName rdr_name
287 mod = rdrNameModule rdr_name
288 occ = rdrNameOcc rdr_name
290 loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
291 case [ name | (_,avails) <- mi_exports iface,
293 name <- availNames avail,
294 nameOccName name == occ ] of
295 (n:ns) -> ASSERT (null ns) returnRn n
296 _ -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
298 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
299 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
300 lookupSrcName global_env rdr_name
301 | isOrig rdr_name -- Can occur in source code too
302 = lookupOrigName rdr_name
305 = case lookupRdrEnv global_env rdr_name of
306 Just [GRE name _ Nothing] -> returnRn name
307 Just [GRE name _ (Just deprec)] -> warnDeprec name deprec `thenRn_`
309 Just stuff@(GRE name _ _ : _) -> addNameClashErrRn rdr_name stuff `thenRn_`
311 Nothing -> failWithRn (mkUnboundName rdr_name)
312 (unknownNameErr rdr_name)
314 lookupOrigName :: RdrName -> RnM d Name
315 lookupOrigName rdr_name
316 = ASSERT( isOrig rdr_name )
317 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
319 lookupIfaceUnqual :: RdrName -> RnM d Name
320 lookupIfaceUnqual rdr_name
321 = ASSERT( isUnqual rdr_name )
322 -- An Unqual is allowed; interface files contain
323 -- unqualified names for locally-defined things, such as
324 -- constructors of a data type.
325 getModuleRn `thenRn ` \ mod ->
326 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
328 lookupIfaceName :: RdrName -> RnM d Name
329 lookupIfaceName rdr_name
330 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
331 | otherwise = lookupOrigName rdr_name
334 @lookupOrigName@ takes an RdrName representing an {\em original}
335 name, and adds it to the occurrence pool so that it'll be loaded
336 later. This is used when language constructs (such as monad
337 comprehensions, overloaded literals, or deriving clauses) require some
338 stuff to be loaded that isn't explicitly mentioned in the code.
340 This doesn't apply in interface mode, where everything is explicit,
341 but we don't check for this case: it does no harm to record an
342 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
343 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
344 calls it at all I think).
346 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
349 lookupOrigNames :: [RdrName] -> RnM d NameSet
350 lookupOrigNames rdr_names
351 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
352 returnRn (mkNameSet names)
355 lookupSysBinder is used for the "system binders" of a type, class, or
356 instance decl. It ensures that the module is set correctly in the
357 name cache, and sets the provenance on the returned name too. The
358 returned name will end up actually in the type, class, or instance.
361 lookupSysBinder rdr_name
362 = ASSERT( isUnqual rdr_name )
363 getModuleRn `thenRn` \ mod ->
364 getSrcLocRn `thenRn` \ loc ->
365 newTopBinder mod rdr_name loc
369 %*********************************************************
371 \subsection{Implicit free vars and sugar names}
373 %*********************************************************
375 @getXImplicitFVs@ forces the renamer to slurp in some things which aren't
376 mentioned explicitly, but which might be needed by the type checker.
379 getImplicitStmtFVs -- Compiling a statement
380 = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName]
381 `plusFV` ubiquitousNames)
382 -- These are all needed implicitly when compiling a statement
383 -- See TcModule.tc_stmts
385 getImplicitModuleFVs mod_name decls -- Compiling a module
386 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
387 returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
389 -- Add occurrences for IO or PrimIO
390 implicit_main | mod_name == mAIN_Name
391 || mod_name == pREL_MAIN_Name = unitFV ioTyConName
392 | otherwise = emptyFVs
394 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
395 cls <- deriv_classes,
396 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
398 -- ubiquitous_names are loaded regardless, because
399 -- they are needed in virtually every program
401 = mkFVs [unpackCStringName, unpackCStringFoldrName,
402 unpackCStringUtf8Name, eqStringName]
403 -- Virtually every program has error messages in it somewhere
406 mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
407 -- Add occurrences for very frequently used types.
408 -- (e.g. we don't want to be bothered with making funTyCon a
409 -- free var at every function application!)
413 rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
414 -- Look up the re-bindable syntactic sugar names
415 -- Any errors arising from these lookups may surprise the
416 -- programmer, since they aren't explicitly mentioned, and
417 -- the src line will be unhelpful (ToDo)
419 rnSyntaxNames gbl_env source_fvs
420 = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
421 if not no_prelude then
422 returnRn (source_fvs, vanillaSyntaxMap)
425 -- There's a -fno-implicit-prelude flag,
426 -- so build the re-mapping function
428 reqd_syntax_list = filter is_reqd syntaxList
429 is_reqd (n,_) = n `elemNameSet` source_fvs
430 lookup (n,rn) = lookupSrcName gbl_env rn `thenRn` \ rn' ->
433 mapRn lookup reqd_syntax_list `thenRn` \ rn_syntax_list ->
435 -- Delete the proxies and add the actuals
436 proxies = map fst rn_syntax_list
437 actuals = map snd rn_syntax_list
438 new_source_fvs = (proxies `delFVs` source_fvs) `plusFV` mkFVs actuals
440 syntax_env = mkNameEnv rn_syntax_list
441 syntax_map n = lookupNameEnv syntax_env n `orElse` n
443 returnRn (new_source_fvs, syntax_map)
447 %*********************************************************
451 %*********************************************************
454 newLocalsRn :: [(RdrName,SrcLoc)]
456 newLocalsRn rdr_names_w_loc
457 = getNameSupplyRn `thenRn` \ name_supply ->
459 (us', us1) = splitUniqSupply (nsUniqs name_supply)
460 uniqs = uniqsFromSupply us1
461 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
462 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
465 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
469 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
470 -> [(RdrName,SrcLoc)]
471 -> ([Name] -> RnMS a)
473 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
474 = getModeRn `thenRn` \ mode ->
475 getLocalNameEnv `thenRn` \ name_env ->
477 -- Check for duplicate names
478 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
480 -- Warn about shadowing, but only in source modules
482 SourceMode -> ifOptRn Opt_WarnNameShadowing $
483 mapRn_ (check_shadow name_env) rdr_names_w_loc
487 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
489 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
491 setLocalNameEnv new_local_env (enclosed_scope names)
494 check_shadow name_env (rdr_name,loc)
495 = case lookupRdrEnv name_env rdr_name of
496 Nothing -> returnRn ()
497 Just name -> pushSrcLocRn loc $
498 addWarnRn (shadowedNameWarn rdr_name)
500 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
501 -- A specialised variant when renaming stuff from interface
502 -- files (of which there is a lot)
504 -- * no checks for shadowing
506 -- * deal with free vars
507 bindCoreLocalRn rdr_name enclosed_scope
508 = getSrcLocRn `thenRn` \ loc ->
509 getLocalNameEnv `thenRn` \ name_env ->
510 getNameSupplyRn `thenRn` \ name_supply ->
512 (us', us1) = splitUniqSupply (nsUniqs name_supply)
513 uniq = uniqFromSupply us1
514 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
516 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
518 new_name_env = extendRdrEnv name_env rdr_name name
520 setLocalNameEnv new_name_env (enclosed_scope name)
522 bindCoreLocalsRn [] thing_inside = thing_inside []
523 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
524 bindCoreLocalsRn bs $ \ names' ->
525 thing_inside (name':names')
527 bindLocalNames names enclosed_scope
528 = getLocalNameEnv `thenRn` \ name_env ->
529 setLocalNameEnv (extendLocalRdrEnv name_env names)
532 bindLocalNamesFV names enclosed_scope
533 = bindLocalNames names $
534 enclosed_scope `thenRn` \ (thing, fvs) ->
535 returnRn (thing, delListFromNameSet fvs names)
538 -------------------------------------
539 bindLocalRn doc rdr_name enclosed_scope
540 = getSrcLocRn `thenRn` \ loc ->
541 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
545 bindLocalsRn doc rdr_names enclosed_scope
546 = getSrcLocRn `thenRn` \ loc ->
547 bindLocatedLocalsRn doc
548 (rdr_names `zip` repeat loc)
551 -- binLocalsFVRn is the same as bindLocalsRn
552 -- except that it deals with free vars
553 bindLocalsFVRn doc rdr_names enclosed_scope
554 = bindLocalsRn doc rdr_names $ \ names ->
555 enclosed_scope names `thenRn` \ (thing, fvs) ->
556 returnRn (thing, delListFromNameSet fvs names)
558 -------------------------------------
559 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
560 -- This tiresome function is used only in rnSourceDecl on InstDecl
561 extendTyVarEnvFVRn tyvars enclosed_scope
562 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
563 returnRn (thing, delListFromNameSet fvs tyvars)
565 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
566 -> ([HsTyVarBndr Name] -> RnMS a)
568 bindTyVarsRn doc_str tyvar_names enclosed_scope
569 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
570 enclosed_scope tyvars
572 -- Gruesome name: return Names as well as HsTyVars
573 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
574 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
576 bindTyVars2Rn doc_str tyvar_names enclosed_scope
577 = getSrcLocRn `thenRn` \ loc ->
579 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
581 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
582 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
584 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
585 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
586 -> RnMS (a, FreeVars)
587 bindTyVarsFVRn doc_str rdr_names enclosed_scope
588 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
589 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
590 returnRn (thing, delListFromNameSet fvs names)
592 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
593 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
594 -> RnMS (a, FreeVars)
595 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
596 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
597 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
598 returnRn (thing, delListFromNameSet fvs names)
600 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
601 -> ([Name] -> RnMS (a, FreeVars))
602 -> RnMS (a, FreeVars)
603 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
604 = getSrcLocRn `thenRn` \ loc ->
606 located_tyvars = [(tv, loc) | tv <- tyvar_names]
608 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
609 enclosed_scope names `thenRn` \ (thing, fvs) ->
610 returnRn (thing, delListFromNameSet fvs names)
613 -------------------------------------
614 checkDupOrQualNames, checkDupNames :: SDoc
615 -> [(RdrName, SrcLoc)]
617 -- Works in any variant of the renamer monad
619 checkDupOrQualNames doc_str rdr_names_w_loc
620 = -- Check for use of qualified names
621 mapRn_ (qualNameErr doc_str) quals `thenRn_`
622 checkDupNames doc_str rdr_names_w_loc
624 quals = filter (isQual . fst) rdr_names_w_loc
626 checkDupNames doc_str rdr_names_w_loc
627 = -- Check for duplicated names in a binding group
628 mapRn_ (dupNamesErr doc_str) dups
630 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
634 %************************************************************************
636 \subsection{GlobalRdrEnv}
638 %************************************************************************
641 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
642 -> Bool -- True <=> want unqualified import
643 -> Bool -- True <=> want qualified import
644 -> [AvailInfo] -- What's to be hidden (but only the unqualified
645 -- version is hidden)
646 -> (Name -> Provenance)
647 -> Avails -- Whats imported and how
651 mkGlobalRdrEnv this_mod unqual_imp qual_imp hides
652 mk_provenance avails deprecs
655 -- Make the name environment. We're talking about a
656 -- single module here, so there must be no name clashes.
657 -- In practice there only ever will be if it's the module
660 -- Add the things that are available
661 gbl_env1 = foldl add_avail emptyRdrEnv avails
663 -- Delete things that are hidden
664 gbl_env2 = foldl del_avail gbl_env1 hides
666 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
667 add_avail env avail = foldl add_name env (availNames avail)
670 | qual_imp && unqual_imp = env3
675 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
676 env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt
677 env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt
678 occ = nameOccName name
679 elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
681 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
683 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
685 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
686 -- Used to construct a GlobalRdrEnv for an interface that we've
687 -- read from a .hi file. We can't construct the original top-level
688 -- environment because we don't have enough info, but we compromise
689 -- by making an environment from its exports
690 mkIfaceGlobalRdrEnv m_avails
691 = foldl add emptyRdrEnv m_avails
693 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False []
694 (\n -> LocalDef) avails NoDeprecs)
695 -- The NoDeprecs is a bit of a hack I suppose
699 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
700 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
702 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
703 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
705 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
706 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
708 combine_globals :: [GlobalRdrElt] -- Old
709 -> [GlobalRdrElt] -- New
711 combine_globals ns_old ns_new -- ns_new is often short
712 = foldr add ns_old ns_new
714 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
717 choose n m | n `beats` m = n
720 (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
722 is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
723 is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
724 is_duplicate (GRE n1 _ _) (GRE n2 _ _) = n1 == n2
727 We treat two bindings of a locally-defined name as a duplicate,
728 because they might be two separate, local defns and we want to report
729 and error for that, {\em not} eliminate a duplicate.
731 On the other hand, if you import the same name from two different
732 import statements, we {\em do} want to eliminate the duplicate, not report
735 If a module imports itself then there might be a local defn and an imported
736 defn of the same name; in this case the names will compare as equal, but
737 will still have different provenances.
740 @unQualInScope@ returns a function that takes a @Name@ and tells whether
741 its unqualified name is in scope. This is put as a boolean flag in
742 the @Name@'s provenance to guide whether or not to print the name qualified
746 unQualInScope :: GlobalRdrEnv -> Name -> Bool
747 -- True if 'f' is in scope, and has only one binding
748 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
750 = (`elemNameSet` unqual_names)
752 unqual_names :: NameSet
753 unqual_names = foldRdrEnv add emptyNameSet env
754 add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
755 add _ _ unquals = unquals
759 %************************************************************************
763 %************************************************************************
766 plusAvail (Avail n1) (Avail n2) = Avail n1
767 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
770 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
773 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
774 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
776 emptyAvailEnv = emptyNameEnv
777 unitAvailEnv :: AvailInfo -> AvailEnv
778 unitAvailEnv a = unitNameEnv (availName a) a
780 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
781 plusAvailEnv = plusNameEnv_C plusAvail
783 availEnvElts = nameEnvElts
785 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
786 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
788 availsToNameSet :: [AvailInfo] -> NameSet
789 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
791 availName :: GenAvailInfo name -> name
792 availName (Avail n) = n
793 availName (AvailTC n _) = n
795 availNames :: GenAvailInfo name -> [name]
796 availNames (Avail n) = [n]
797 availNames (AvailTC n ns) = ns
799 -------------------------------------
800 filterAvail :: RdrNameIE -- Wanted
801 -> AvailInfo -- Available
802 -> Maybe AvailInfo -- Resulting available;
803 -- Nothing if (any of the) wanted stuff isn't there
805 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
806 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
807 | otherwise = Nothing
809 is_wanted name = nameOccName name `elem` wanted_occs
810 sub_names_ok = all (`elem` avail_occs) wanted_occs
811 avail_occs = map nameOccName ns
812 wanted_occs = map rdrNameOcc (want:wants)
814 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
817 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
819 filterAvail (IEVar _) avail@(Avail n) = Just avail
820 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
822 wanted n = nameOccName n == occ
824 -- The second equation happens if we import a class op, thus
826 -- where op is a class operation
828 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
829 -- We don't complain even if the IE says T(..), but
830 -- no constrs/class ops of T are available
831 -- Instead that's caught with a warning by the caller
833 filterAvail ie avail = Nothing
835 -------------------------------------
836 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
837 -- Group by module and sort by occurrence
838 -- This keeps the list in canonical order
839 groupAvails this_mod avails
840 = [ (mkSysModuleNameFS fs, sortLt lt avails)
841 | (fs,avails) <- fmToList groupFM
844 groupFM :: FiniteMap FastString Avails
845 -- Deliberately use the FastString so we
846 -- get a canonical ordering
847 groupFM = foldl add emptyFM avails
849 add env avail = addToFM_C combine env mod_fs [avail']
851 mod_fs = moduleNameFS (moduleName avail_mod)
852 avail_mod = case nameModule_maybe (availName avail) of
855 combine old _ = avail':old
856 avail' = sortAvail avail
858 a1 `lt` a2 = occ1 < occ2
860 occ1 = nameOccName (availName a1)
861 occ2 = nameOccName (availName a2)
863 sortAvail :: AvailInfo -> AvailInfo
864 -- Sort the sub-names into canonical order.
865 -- The canonical order has the "main name" at the beginning
866 -- (if it's there at all)
867 sortAvail (Avail n) = Avail n
868 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
869 | otherwise = AvailTC n ( sortLt lt ns)
871 n1 `lt` n2 = nameOccName n1 < nameOccName n2
875 %************************************************************************
877 \subsection{Free variable manipulation}
879 %************************************************************************
883 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
885 (ys, fvs_s) = unzip stuff
887 returnRn (ys, plusFVs fvs_s)
891 %************************************************************************
893 \subsection{Envt utility functions}
895 %************************************************************************
898 warnUnusedModules :: [ModuleName] -> RnM d ()
899 warnUnusedModules mods
900 = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
902 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
903 text "is imported, but nothing from it is used",
904 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
907 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
908 warnUnusedImports names
909 = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
911 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
912 warnUnusedLocalBinds names
913 = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
915 warnUnusedMatches names
916 = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
918 -------------------------
920 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
921 warnUnusedBinds names
922 = mapRn_ warnUnusedGroup groups
924 -- Group by provenance
925 groups = equivClasses cmp names
926 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
929 -------------------------
931 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
932 warnUnusedGroup names
933 | null filtered_names = returnRn ()
934 | not is_local = returnRn ()
936 = pushSrcLocRn def_loc $
938 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
940 filtered_names = filter reportable names
941 (name1, prov1) = head filtered_names
942 (is_local, def_loc, msg)
944 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
946 NonLocalDef (UserImport mod loc _)
947 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
949 reportable (name,_) = case occNameUserString (nameOccName name) of
952 -- Haskell 98 encourages compilers to suppress warnings about
953 -- unused names in a pattern if they start with "_".
957 addNameClashErrRn rdr_name (np1:nps)
958 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
959 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
961 msg1 = ptext SLIT("either") <+> mk_ref np1
962 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
963 mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
965 shadowedNameWarn shadow
966 = hsep [ptext SLIT("This binding for"),
968 ptext SLIT("shadows an existing binding")]
971 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
973 flavour = occNameFlavour (rdrNameOcc name)
975 qualNameErr descriptor (name,loc)
977 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
982 dupNamesErr descriptor ((name,loc) : dup_things)
984 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
986 (ptext SLIT("in") <+> descriptor))
988 warnDeprec :: Name -> DeprecTxt -> RnM d ()
990 = ifOptRn Opt_WarnDeprecations $
991 addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
992 quotes (ppr name) <+> text "is deprecated:",