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,
30 mkLocalName, mkGlobalName,
31 mkIPName, nameOccName, nameModule_maybe,
32 setNameModuleAndLoc, mkNameEnv
34 import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
36 import OccName ( OccName, occNameUserString, occNameFlavour )
37 import Module ( ModuleName, moduleName, mkVanillaModule,
38 mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
39 import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
41 mAIN_Name, pREL_MAIN_Name,
42 ioTyConName, integerTyConName, doubleTyConName, intTyConName,
43 boolTyConName, funTyConName,
44 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
45 eqStringName, printName,
46 hasKey, fractionalClassKey, numClassKey,
47 bindIOName, returnIOName, failIOName
49 import TysWiredIn ( unitTyCon ) -- A little odd
52 import SrcLoc ( SrcLoc, noSrcLoc )
54 import ListSetOps ( removeDups, equivClasses )
55 import Util ( sortLt )
57 import UniqFM ( lookupWithDefaultUFM )
58 import Maybes ( orElse )
60 import FastString ( FastString )
63 %*********************************************************
65 \subsection{Making new names}
67 %*********************************************************
70 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
71 -- newTopBinder puts into the cache the binder with the
72 -- module information set correctly. When the decl is later renamed,
73 -- the binding site will thereby get the correct module.
74 -- There maybe occurrences that don't have the correct Module, but
75 -- by the typechecker will propagate the binding definition to all
76 -- the occurrences, so that doesn't matter
78 newTopBinder mod rdr_name loc
79 = -- First check the cache
81 -- There should never be a qualified name in a binding position (except in instance decls)
82 -- The parser doesn't check this because the same parser parses instance decls
83 (if isQual rdr_name then
84 qualNameErr (text "its declaration") (rdr_name,loc)
89 getNameSupplyRn `thenRn` \ name_supply ->
91 occ = rdrNameOcc rdr_name
92 key = (moduleName mod, occ)
93 cache = nsNames name_supply
95 case lookupFM cache key of
97 -- A hit in the cache! We are at the binding site of the name, and
98 -- this is the moment when we know all about
99 -- a) the Name's host Module (in particular, which
100 -- package it comes from)
101 -- b) its defining SrcLoc
102 -- So we update this info
105 new_name = setNameModuleAndLoc name mod loc
106 new_cache = addToFM cache key new_name
108 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
109 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
112 -- Miss in the cache!
113 -- Build a completely new Name, and put it in the cache
114 -- Even for locally-defined names we use implicitImportProvenance;
115 -- updateProvenances will set it to rights
117 (us', us1) = splitUniqSupply (nsUniqs name_supply)
118 uniq = uniqFromSupply us1
119 new_name = mkGlobalName uniq mod occ loc
120 new_cache = addToFM cache key new_name
122 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
123 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
127 newGlobalName :: ModuleName -> OccName -> RnM d Name
128 -- Used for *occurrences*. We make a place-holder Name, really just
129 -- to agree on its unique, which gets overwritten when we read in
130 -- the binding occurence later (newTopBinder)
131 -- The place-holder Name doesn't have the right SrcLoc, and its
132 -- Module won't have the right Package either.
134 -- (We have to pass a ModuleName, not a Module, because we may be
135 -- simply looking at an occurrence M.x in an interface file.)
137 -- This means that a renamed program may have incorrect info
138 -- on implicitly-imported occurrences, but the correct info on the
139 -- *binding* declaration. It's the type checker that propagates the
140 -- correct information to all the occurrences.
141 -- Since implicitly-imported names never occur in error messages,
142 -- it doesn't matter that we get the correct info in place till later,
143 -- (but since it affects DLL-ery it does matter that we get it right
145 newGlobalName mod_name occ
146 = getNameSupplyRn `thenRn` \ name_supply ->
148 key = (mod_name, occ)
149 cache = nsNames name_supply
151 case lookupFM cache key of
152 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
155 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
156 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
159 (us', us1) = splitUniqSupply (nsUniqs name_supply)
160 uniq = uniqFromSupply us1
161 mod = mkVanillaModule mod_name
162 name = mkGlobalName uniq mod occ noSrcLoc
163 new_cache = addToFM cache key name
166 = getNameSupplyRn `thenRn` \ name_supply ->
168 ipcache = nsIPs name_supply
170 case lookupFM ipcache key of
171 Just name -> returnRn name
172 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
175 (us', us1) = splitUniqSupply (nsUniqs name_supply)
176 uniq = uniqFromSupply us1
177 name = mkIPName uniq key
178 new_ipcache = addToFM ipcache key name
179 where key = (rdrNameOcc rdr_name)
182 %*********************************************************
184 \subsection{Looking up names}
186 %*********************************************************
188 Looking up a name in the RnEnv.
191 lookupBndrRn rdr_name
192 = getLocalNameEnv `thenRn` \ local_env ->
193 case lookupRdrEnv local_env rdr_name of
194 Just name -> returnRn name
195 Nothing -> lookupTopBndrRn rdr_name
197 lookupTopBndrRn rdr_name
198 = getModeRn `thenRn` \ mode ->
199 if isInterfaceMode mode
200 then lookupIfaceName rdr_name
201 else -- Source mode, so look up a *qualified* version
202 -- of the name, so that we get the right one even
203 -- if there are many with the same occ name
204 -- There must *be* a binding
205 getModuleRn `thenRn` \ mod ->
206 getGlobalNameEnv `thenRn` \ global_env ->
207 lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
209 -- lookupSigOccRn is used for type signatures and pragmas
215 -- It's clear that the 'f' in the signature must refer to A.f
216 -- The Haskell98 report does not stipulate this, but it will!
217 -- So we must treat the 'f' in the signature in the same way
218 -- as the binding occurrence of 'f', using lookupBndrRn
219 lookupSigOccRn :: RdrName -> RnMS Name
220 lookupSigOccRn = lookupBndrRn
222 -- lookupOccRn looks up an occurrence of a RdrName
223 lookupOccRn :: RdrName -> RnMS Name
225 = getLocalNameEnv `thenRn` \ local_env ->
226 case lookupRdrEnv local_env rdr_name of
227 Just name -> returnRn name
228 Nothing -> lookupGlobalOccRn rdr_name
230 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
231 -- environment. It's used only for
232 -- record field names
233 -- class op names in class and instance decls
235 lookupGlobalOccRn rdr_name
236 = getModeRn `thenRn` \ mode ->
237 if (isInterfaceMode mode)
238 then lookupIfaceName rdr_name
241 getGlobalNameEnv `thenRn` \ global_env ->
243 SourceMode -> lookupSrcName global_env rdr_name
246 | not (isQual rdr_name) ->
247 lookupSrcName global_env rdr_name
249 -- We allow qualified names on the command line to refer to
250 -- *any* name exported by any module in scope, just as if
251 -- there was an "import qualified M" declaration for every
254 -- First look up the name in the normal environment. If
255 -- it isn't there, we manufacture a new occurrence of an
258 case lookupRdrEnv global_env rdr_name of
259 Just _ -> lookupSrcName global_env rdr_name
260 Nothing -> lookupQualifiedName rdr_name
262 -- a qualified name on the command line can refer to any module at all: we
263 -- try to load the interface if we don't already have it.
264 lookupQualifiedName :: RdrName -> RnM d Name
265 lookupQualifiedName rdr_name
267 mod = rdrNameModule rdr_name
268 occ = rdrNameOcc rdr_name
270 loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
271 case [ name | (_,avails) <- mi_exports iface,
273 name <- availNames avail,
274 nameOccName name == occ ] of
275 (n:ns) -> ASSERT (null ns) returnRn n
276 _ -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
278 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
279 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
280 lookupSrcName global_env rdr_name
281 | isOrig rdr_name -- Can occur in source code too
282 = lookupOrigName rdr_name
285 = case lookupRdrEnv global_env rdr_name of
286 Just [GRE name _ Nothing] -> returnRn name
287 Just [GRE name _ (Just deprec)] -> warnDeprec name deprec `thenRn_`
289 Just stuff@(GRE name _ _ : _) -> addNameClashErrRn rdr_name stuff `thenRn_`
291 Nothing -> failWithRn (mkUnboundName rdr_name)
292 (unknownNameErr rdr_name)
294 lookupOrigName :: RdrName -> RnM d Name
295 lookupOrigName rdr_name
296 = ASSERT( isOrig rdr_name )
297 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
299 lookupIfaceUnqual :: RdrName -> RnM d Name
300 lookupIfaceUnqual rdr_name
301 = ASSERT( isUnqual rdr_name )
302 -- An Unqual is allowed; interface files contain
303 -- unqualified names for locally-defined things, such as
304 -- constructors of a data type.
305 getModuleRn `thenRn ` \ mod ->
306 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
308 lookupIfaceName :: RdrName -> RnM d Name
309 lookupIfaceName rdr_name
310 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
311 | otherwise = lookupOrigName rdr_name
314 @lookupOrigName@ takes an RdrName representing an {\em original}
315 name, and adds it to the occurrence pool so that it'll be loaded
316 later. This is used when language constructs (such as monad
317 comprehensions, overloaded literals, or deriving clauses) require some
318 stuff to be loaded that isn't explicitly mentioned in the code.
320 This doesn't apply in interface mode, where everything is explicit,
321 but we don't check for this case: it does no harm to record an
322 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
323 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
324 calls it at all I think).
326 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
329 lookupOrigNames :: [RdrName] -> RnM d NameSet
330 lookupOrigNames rdr_names
331 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
332 returnRn (mkNameSet names)
335 lookupSysBinder is used for the "system binders" of a type, class, or
336 instance decl. It ensures that the module is set correctly in the
337 name cache, and sets the provenance on the returned name too. The
338 returned name will end up actually in the type, class, or instance.
341 lookupSysBinder rdr_name
342 = ASSERT( isUnqual rdr_name )
343 getModuleRn `thenRn` \ mod ->
344 getSrcLocRn `thenRn` \ loc ->
345 newTopBinder mod rdr_name loc
349 %*********************************************************
351 \subsection{Implicit free vars and sugar names}
353 %*********************************************************
355 @addImplicitFVs@ forces the renamer to slurp in some things which aren't
356 mentioned explicitly, but which might be needed by the type checker.
359 addImplicitFVs :: GlobalRdrEnv
360 -> Maybe (ModuleName, [RenamedHsDecl]) -- Nothing when compling an expression
361 -> FreeVars -- Free in the source
362 -> RnMG (FreeVars, SyntaxMap) -- Augmented source free vars
364 addImplicitFVs gbl_env maybe_mod source_fvs
365 = -- Find out what re-bindable names to use for desugaring
366 rnSyntaxNames gbl_env source_fvs `thenRn` \ (source_fvs1, sugar_map) ->
368 -- Find implicit FVs thade
369 extra_implicits maybe_mod `thenRn` \ extra_fvs ->
372 implicit_fvs = ubiquitousNames `plusFV` extra_fvs
373 slurp_fvs = implicit_fvs `plusFV` source_fvs1
374 -- It's important to do the "plus" this way round, so that
375 -- when compiling the prelude, locally-defined (), Bool, etc
376 -- override the implicit ones.
378 returnRn (slurp_fvs, sugar_map)
381 extra_implicits Nothing -- Compiling a statement
382 = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName])
383 -- These are all needed implicitly when compiling a statement
384 -- See TcModule.tc_stmts
386 extra_implicits (Just (mod_name, decls)) -- Compiling a module
387 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
388 returnRn (deriving_names `plusFV` implicit_main)
390 -- Add occurrences for IO or PrimIO
391 implicit_main | mod_name == mAIN_Name
392 || mod_name == pREL_MAIN_Name = unitFV ioTyConName
393 | otherwise = emptyFVs
395 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
396 cls <- deriv_classes,
397 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
399 -- ubiquitous_names are loaded regardless, because
400 -- they are needed in virtually every program
402 = mkFVs [unpackCStringName, unpackCStringFoldrName,
403 unpackCStringUtf8Name, eqStringName]
404 -- Virtually every program has error messages in it somewhere
407 mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
408 -- Add occurrences for very frequently used types.
409 -- (e.g. we don't want to be bothered with making funTyCon a
410 -- free var at every function application!)
414 implicitGates :: Name -> FreeVars
415 -- If we load class Num, add Integer to the gates
416 -- This takes account of the fact that Integer might be needed for
417 -- defaulting, but we don't want to load Integer (and all its baggage)
418 -- if there's no numeric stuff needed.
419 -- Similarly for class Fractional and Double
421 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
422 -- since Fractional is a superclass of Floating
423 implicitGates cls | cls `hasKey` numClassKey = unitFV integerTyConName
424 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
425 | otherwise = emptyFVs
429 rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
430 -- Look up the re-bindable syntactic sugar names
431 -- Any errors arising from these lookups may surprise the
432 -- programmer, since they aren't explicitly mentioned, and
433 -- the src line will be unhelpful (ToDo)
435 rnSyntaxNames gbl_env source_fvs
436 = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
437 if not no_prelude then
438 returnRn (source_fvs, vanillaSyntaxMap)
441 -- There's a -fno-implicit-prelude flag,
442 -- so build the re-mapping function
444 reqd_syntax_list = filter is_reqd syntaxList
445 is_reqd (n,_) = n `elemNameSet` source_fvs
446 lookup (n,rn) = lookupSrcName gbl_env rn `thenRn` \ rn' ->
449 mapRn lookup reqd_syntax_list `thenRn` \ rn_syntax_list ->
451 -- Delete the proxies and add the actuals
452 proxies = map fst rn_syntax_list
453 actuals = map snd rn_syntax_list
454 new_source_fvs = (proxies `delFVs` source_fvs) `plusFV` mkFVs actuals
456 syntax_env = mkNameEnv rn_syntax_list
457 syntax_map n = lookupNameEnv syntax_env n `orElse` n
459 returnRn (new_source_fvs, syntax_map)
463 %*********************************************************
467 %*********************************************************
470 newLocalsRn :: [(RdrName,SrcLoc)]
472 newLocalsRn rdr_names_w_loc
473 = getNameSupplyRn `thenRn` \ name_supply ->
475 n = length rdr_names_w_loc
476 (us', us1) = splitUniqSupply (nsUniqs name_supply)
477 uniqs = uniqsFromSupply n us1
478 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
479 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
482 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
486 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
487 -> [(RdrName,SrcLoc)]
488 -> ([Name] -> RnMS a)
490 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
491 = getModeRn `thenRn` \ mode ->
492 getLocalNameEnv `thenRn` \ name_env ->
494 -- Check for duplicate names
495 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
497 doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
499 -- Warn about shadowing, but only in source modules
501 SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
505 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
507 new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
509 setLocalNameEnv new_local_env (enclosed_scope names)
512 check_shadow name_env (rdr_name,loc)
513 = case lookupRdrEnv name_env rdr_name of
514 Nothing -> returnRn ()
515 Just name -> pushSrcLocRn loc $
516 addWarnRn (shadowedNameWarn rdr_name)
518 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
519 -- A specialised variant when renaming stuff from interface
520 -- files (of which there is a lot)
522 -- * no checks for shadowing
524 -- * deal with free vars
525 bindCoreLocalRn rdr_name enclosed_scope
526 = getSrcLocRn `thenRn` \ loc ->
527 getLocalNameEnv `thenRn` \ name_env ->
528 getNameSupplyRn `thenRn` \ name_supply ->
530 (us', us1) = splitUniqSupply (nsUniqs name_supply)
531 uniq = uniqFromSupply us1
532 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
534 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
536 new_name_env = extendRdrEnv name_env rdr_name name
538 setLocalNameEnv new_name_env (enclosed_scope name)
540 bindCoreLocalsRn [] thing_inside = thing_inside []
541 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
542 bindCoreLocalsRn bs $ \ names' ->
543 thing_inside (name':names')
545 bindLocalNames names enclosed_scope
546 = getLocalNameEnv `thenRn` \ name_env ->
547 setLocalNameEnv (extendLocalRdrEnv name_env names)
550 bindLocalNamesFV names enclosed_scope
551 = bindLocalNames names $
552 enclosed_scope `thenRn` \ (thing, fvs) ->
553 returnRn (thing, delListFromNameSet fvs names)
556 -------------------------------------
557 bindLocalRn doc rdr_name enclosed_scope
558 = getSrcLocRn `thenRn` \ loc ->
559 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
563 bindLocalsRn doc rdr_names enclosed_scope
564 = getSrcLocRn `thenRn` \ loc ->
565 bindLocatedLocalsRn doc
566 (rdr_names `zip` repeat loc)
569 -- binLocalsFVRn is the same as bindLocalsRn
570 -- except that it deals with free vars
571 bindLocalsFVRn doc rdr_names enclosed_scope
572 = bindLocalsRn doc rdr_names $ \ names ->
573 enclosed_scope names `thenRn` \ (thing, fvs) ->
574 returnRn (thing, delListFromNameSet fvs names)
576 -------------------------------------
577 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
578 -- This tiresome function is used only in rnSourceDecl on InstDecl
579 extendTyVarEnvFVRn tyvars enclosed_scope
580 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
581 returnRn (thing, delListFromNameSet fvs tyvars)
583 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
584 -> ([HsTyVarBndr Name] -> RnMS a)
586 bindTyVarsRn doc_str tyvar_names enclosed_scope
587 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
588 enclosed_scope tyvars
590 -- Gruesome name: return Names as well as HsTyVars
591 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
592 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
594 bindTyVars2Rn doc_str tyvar_names enclosed_scope
595 = getSrcLocRn `thenRn` \ loc ->
597 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
599 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
600 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
602 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
603 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
604 -> RnMS (a, FreeVars)
605 bindTyVarsFVRn doc_str rdr_names enclosed_scope
606 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
607 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
608 returnRn (thing, delListFromNameSet fvs names)
610 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
611 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
612 -> RnMS (a, FreeVars)
613 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
614 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
615 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
616 returnRn (thing, delListFromNameSet fvs names)
618 bindNakedTyVarsFVRn :: SDoc -> [RdrName]
619 -> ([Name] -> RnMS (a, FreeVars))
620 -> RnMS (a, FreeVars)
621 bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
622 = getSrcLocRn `thenRn` \ loc ->
624 located_tyvars = [(tv, loc) | tv <- tyvar_names]
626 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
627 enclosed_scope names `thenRn` \ (thing, fvs) ->
628 returnRn (thing, delListFromNameSet fvs names)
631 -------------------------------------
632 checkDupOrQualNames, checkDupNames :: SDoc
633 -> [(RdrName, SrcLoc)]
635 -- Works in any variant of the renamer monad
637 checkDupOrQualNames doc_str rdr_names_w_loc
638 = -- Check for use of qualified names
639 mapRn_ (qualNameErr doc_str) quals `thenRn_`
640 checkDupNames doc_str rdr_names_w_loc
642 quals = filter (isQual . fst) rdr_names_w_loc
644 checkDupNames doc_str rdr_names_w_loc
645 = -- Check for duplicated names in a binding group
646 mapRn_ (dupNamesErr doc_str) dups
648 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
652 %************************************************************************
654 \subsection{GlobalRdrEnv}
656 %************************************************************************
659 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
660 -> Bool -- True <=> want unqualified import
661 -> Bool -- True <=> want qualified import
662 -> [AvailInfo] -- What's to be hidden (but only the unqualified
663 -- version is hidden)
664 -> (Name -> Provenance)
665 -> Avails -- Whats imported and how
669 mkGlobalRdrEnv this_mod unqual_imp qual_imp hides
670 mk_provenance avails deprecs
673 -- Make the name environment. We're talking about a
674 -- single module here, so there must be no name clashes.
675 -- In practice there only ever will be if it's the module
678 -- Add the things that are available
679 gbl_env1 = foldl add_avail emptyRdrEnv avails
681 -- Delete things that are hidden
682 gbl_env2 = foldl del_avail gbl_env1 hides
684 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
685 add_avail env avail = foldl add_name env (availNames avail)
688 | qual_imp && unqual_imp = env3
693 env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
694 env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt
695 env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt
696 occ = nameOccName name
697 elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
699 del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
701 rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
703 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
704 -- Used to construct a GlobalRdrEnv for an interface that we've
705 -- read from a .hi file. We can't construct the original top-level
706 -- environment because we don't have enough info, but we compromise
707 -- by making an environment from its exports
708 mkIfaceGlobalRdrEnv m_avails
709 = foldl add emptyRdrEnv m_avails
711 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False []
712 (\n -> LocalDef) avails NoDeprecs)
713 -- The NoDeprecs is a bit of a hack I suppose
717 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
718 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
720 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
721 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
723 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
724 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
726 combine_globals :: [GlobalRdrElt] -- Old
727 -> [GlobalRdrElt] -- New
729 combine_globals ns_old ns_new -- ns_new is often short
730 = foldr add ns_old ns_new
732 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
735 choose n m | n `beats` m = n
738 (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
740 is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
741 is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
742 is_duplicate (GRE n1 _ _) (GRE n2 _ _) = n1 == n2
745 We treat two bindings of a locally-defined name as a duplicate,
746 because they might be two separate, local defns and we want to report
747 and error for that, {\em not} eliminate a duplicate.
749 On the other hand, if you import the same name from two different
750 import statements, we {\em do} want to eliminate the duplicate, not report
753 If a module imports itself then there might be a local defn and an imported
754 defn of the same name; in this case the names will compare as equal, but
755 will still have different provenances.
758 @unQualInScope@ returns a function that takes a @Name@ and tells whether
759 its unqualified name is in scope. This is put as a boolean flag in
760 the @Name@'s provenance to guide whether or not to print the name qualified
764 unQualInScope :: GlobalRdrEnv -> Name -> Bool
765 -- True if 'f' is in scope, and has only one binding
766 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
768 = (`elemNameSet` unqual_names)
770 unqual_names :: NameSet
771 unqual_names = foldRdrEnv add emptyNameSet env
772 add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
773 add _ _ unquals = unquals
777 %************************************************************************
781 %************************************************************************
784 plusAvail (Avail n1) (Avail n2) = Avail n1
785 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
788 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
791 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
792 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
794 emptyAvailEnv = emptyNameEnv
795 unitAvailEnv :: AvailInfo -> AvailEnv
796 unitAvailEnv a = unitNameEnv (availName a) a
798 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
799 plusAvailEnv = plusNameEnv_C plusAvail
801 availEnvElts = nameEnvElts
803 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
804 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
806 availsToNameSet :: [AvailInfo] -> NameSet
807 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
809 availName :: GenAvailInfo name -> name
810 availName (Avail n) = n
811 availName (AvailTC n _) = n
813 availNames :: GenAvailInfo name -> [name]
814 availNames (Avail n) = [n]
815 availNames (AvailTC n ns) = ns
817 -------------------------------------
818 filterAvail :: RdrNameIE -- Wanted
819 -> AvailInfo -- Available
820 -> Maybe AvailInfo -- Resulting available;
821 -- Nothing if (any of the) wanted stuff isn't there
823 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
824 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
825 | otherwise = Nothing
827 is_wanted name = nameOccName name `elem` wanted_occs
828 sub_names_ok = all (`elem` avail_occs) wanted_occs
829 avail_occs = map nameOccName ns
830 wanted_occs = map rdrNameOcc (want:wants)
832 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
835 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
837 filterAvail (IEVar _) avail@(Avail n) = Just avail
838 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
840 wanted n = nameOccName n == occ
842 -- The second equation happens if we import a class op, thus
844 -- where op is a class operation
846 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
847 -- We don't complain even if the IE says T(..), but
848 -- no constrs/class ops of T are available
849 -- Instead that's caught with a warning by the caller
851 filterAvail ie avail = Nothing
853 -------------------------------------
854 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
855 -- Group by module and sort by occurrence
856 -- This keeps the list in canonical order
857 groupAvails this_mod avails
858 = [ (mkSysModuleNameFS fs, sortLt lt avails)
859 | (fs,avails) <- fmToList groupFM
862 groupFM :: FiniteMap FastString Avails
863 -- Deliberately use the FastString so we
864 -- get a canonical ordering
865 groupFM = foldl add emptyFM avails
867 add env avail = addToFM_C combine env mod_fs [avail']
869 mod_fs = moduleNameFS (moduleName avail_mod)
870 avail_mod = case nameModule_maybe (availName avail) of
873 combine old _ = avail':old
874 avail' = sortAvail avail
876 a1 `lt` a2 = occ1 < occ2
878 occ1 = nameOccName (availName a1)
879 occ2 = nameOccName (availName a2)
881 sortAvail :: AvailInfo -> AvailInfo
882 -- Sort the sub-names into canonical order.
883 -- The canonical order has the "main name" at the beginning
884 -- (if it's there at all)
885 sortAvail (Avail n) = Avail n
886 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
887 | otherwise = AvailTC n ( sortLt lt ns)
889 n1 `lt` n2 = nameOccName n1 < nameOccName n2
893 %************************************************************************
895 \subsection{Free variable manipulation}
897 %************************************************************************
901 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
903 (ys, fvs_s) = unzip stuff
905 returnRn (ys, plusFVs fvs_s)
909 %************************************************************************
911 \subsection{Envt utility functions}
913 %************************************************************************
916 warnUnusedModules :: [ModuleName] -> RnM d ()
917 warnUnusedModules mods
918 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
919 if warn then mapRn_ (addWarnRn . unused_mod) mods
922 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
923 text "is imported, but nothing from it is used",
924 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
927 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
928 warnUnusedImports names
929 = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
930 if warn then warnUnusedBinds names else returnRn ()
932 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
933 warnUnusedLocalBinds names
934 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
935 if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
938 warnUnusedMatches names
939 = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
940 if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
943 -------------------------
945 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
946 warnUnusedBinds names
947 = mapRn_ warnUnusedGroup groups
949 -- Group by provenance
950 groups = equivClasses cmp names
951 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
954 -------------------------
956 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
957 warnUnusedGroup names
958 | null filtered_names = returnRn ()
959 | not is_local = returnRn ()
961 = pushSrcLocRn def_loc $
963 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
965 filtered_names = filter reportable names
966 (name1, prov1) = head filtered_names
967 (is_local, def_loc, msg)
969 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
971 NonLocalDef (UserImport mod loc _)
972 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
974 reportable (name,_) = case occNameUserString (nameOccName name) of
977 -- Haskell 98 encourages compilers to suppress warnings about
978 -- unused names in a pattern if they start with "_".
982 addNameClashErrRn rdr_name (np1:nps)
983 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
984 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
986 msg1 = ptext SLIT("either") <+> mk_ref np1
987 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
988 mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
990 shadowedNameWarn shadow
991 = hsep [ptext SLIT("This binding for"),
993 ptext SLIT("shadows an existing binding")]
996 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
998 flavour = occNameFlavour (rdrNameOcc name)
1000 qualNameErr descriptor (name,loc)
1001 = pushSrcLocRn loc $
1002 addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
1007 dupNamesErr descriptor ((name,loc) : dup_things)
1008 = pushSrcLocRn loc $
1009 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
1011 (ptext SLIT("in") <+> descriptor))
1013 warnDeprec :: Name -> DeprecTxt -> RnM d ()
1015 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
1016 if not warn_drs then returnRn () else
1017 addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
1018 quotes (ppr name) <+> text "is deprecated:",