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, RdrNameHsType, extractHsTyRdrTyVars )
15 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
16 mkRdrUnqual, mkRdrQual,
17 lookupRdrEnv, foldRdrEnv, rdrEnvToList, elemRdrEnv,
20 import HsTypes ( hsTyVarName, replaceTyVarName )
21 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
22 ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
23 AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
25 Deprecations(..), lookupDeprec,
30 getSrcLoc, nameIsLocalOrFrom,
31 mkLocalName, mkGlobalName,
32 mkIPName, nameOccName, nameModule_maybe,
37 import OccName ( OccName, occNameUserString, occNameFlavour )
38 import Module ( ModuleName, moduleName, mkVanillaModule,
39 mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
40 import PrelNames ( mkUnboundName,
42 mAIN_Name, pREL_MAIN_Name,
43 ioTyConName, intTyConName,
44 boolTyConName, funTyConName,
45 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
46 eqStringName, printName,
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 )
59 import FastString ( FastString )
61 import Maybe ( isJust )
64 %*********************************************************
66 \subsection{Making new names}
68 %*********************************************************
71 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
72 -- newTopBinder puts into the cache the binder with the
73 -- module information set correctly. When the decl is later renamed,
74 -- the binding site will thereby get the correct module.
75 -- There maybe occurrences that don't have the correct Module, but
76 -- by the typechecker will propagate the binding definition to all
77 -- the occurrences, so that doesn't matter
79 newTopBinder mod rdr_name loc
80 = -- First check the cache
82 -- There should never be a qualified name in a binding position (except in instance decls)
83 -- The parser doesn't check this because the same parser parses instance decls
84 (if isQual rdr_name then
85 qualNameErr (text "In its declaration") (rdr_name,loc)
90 getNameSupplyRn `thenRn` \ name_supply ->
92 occ = rdrNameOcc rdr_name
93 key = (moduleName mod, occ)
94 cache = nsNames name_supply
96 case lookupFM cache key of
98 -- A hit in the cache! We are at the binding site of the name, and
99 -- this is the moment when we know all about
100 -- a) the Name's host Module (in particular, which
101 -- package it comes from)
102 -- b) its defining SrcLoc
103 -- So we update this info
106 new_name = setNameModuleAndLoc name mod loc
107 new_cache = addToFM cache key new_name
109 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
110 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
113 -- Miss in the cache!
114 -- Build a completely new Name, and put it in the cache
115 -- Even for locally-defined names we use implicitImportProvenance;
116 -- updateProvenances will set it to rights
118 (us', us1) = splitUniqSupply (nsUniqs name_supply)
119 uniq = uniqFromSupply us1
120 new_name = mkGlobalName uniq mod occ loc
121 new_cache = addToFM cache key new_name
123 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
124 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
128 newGlobalName :: ModuleName -> OccName -> RnM d Name
129 -- Used for *occurrences*. We make a place-holder Name, really just
130 -- to agree on its unique, which gets overwritten when we read in
131 -- the binding occurence later (newTopBinder)
132 -- The place-holder Name doesn't have the right SrcLoc, and its
133 -- Module won't have the right Package either.
135 -- (We have to pass a ModuleName, not a Module, because we may be
136 -- simply looking at an occurrence M.x in an interface file.)
138 -- This means that a renamed program may have incorrect info
139 -- on implicitly-imported occurrences, but the correct info on the
140 -- *binding* declaration. It's the type checker that propagates the
141 -- correct information to all the occurrences.
142 -- Since implicitly-imported names never occur in error messages,
143 -- it doesn't matter that we get the correct info in place till later,
144 -- (but since it affects DLL-ery it does matter that we get it right
146 newGlobalName mod_name occ
147 = getNameSupplyRn `thenRn` \ name_supply ->
149 key = (mod_name, occ)
150 cache = nsNames name_supply
152 case lookupFM cache key of
153 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
156 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
157 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
160 (us', us1) = splitUniqSupply (nsUniqs name_supply)
161 uniq = uniqFromSupply us1
162 mod = mkVanillaModule mod_name
163 name = mkGlobalName uniq mod occ noSrcLoc
164 new_cache = addToFM cache key name
167 = getNameSupplyRn `thenRn` \ name_supply ->
169 ipcache = nsIPs name_supply
171 case lookupFM ipcache key of
172 Just name -> returnRn name
173 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
176 (us', us1) = splitUniqSupply (nsUniqs name_supply)
177 uniq = uniqFromSupply us1
178 name = mkIPName uniq key
179 new_ipcache = addToFM ipcache key name
180 where key = (rdrNameOcc rdr_name)
183 %*********************************************************
185 \subsection{Looking up names}
187 %*********************************************************
189 Looking up a name in the RnEnv.
192 lookupBndrRn rdr_name
193 = getLocalNameEnv `thenRn` \ local_env ->
194 case lookupRdrEnv local_env rdr_name of
195 Just name -> returnRn name
196 Nothing -> lookupTopBndrRn rdr_name
198 lookupTopBndrRn rdr_name
199 -- Look up a top-level local binder. We may be looking up an unqualified 'f',
200 -- and there may be several imported 'f's too, which must not confuse us.
201 -- So we have to filter out the non-local ones.
202 -- A separate function (importsFromLocalDecls) reports duplicate top level
203 -- decls, so here it's safe just to choose an arbitrary one.
206 -- This is here just to catch the PrelBase defn of (say) [] and similar
207 -- The parser reads the special syntax and returns an Orig RdrName
208 -- But the global_env contains only Qual RdrNames, so we won't
209 -- find it there; instead just get the name via the Orig route
210 = lookupOrigName rdr_name
213 = getModeRn `thenRn` \ mode ->
214 if isInterfaceMode mode
215 then lookupIfaceName rdr_name
217 getModuleRn `thenRn` \ mod ->
218 getGlobalNameEnv `thenRn` \ global_env ->
219 case lookup_local mod global_env rdr_name of
220 Just name -> returnRn name
221 Nothing -> failWithRn (mkUnboundName rdr_name)
222 (unknownNameErr rdr_name)
224 lookup_local mod global_env rdr_name
225 = case lookupRdrEnv global_env rdr_name of
227 Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of
232 -- lookupSigOccRn is used for type signatures and pragmas
238 -- It's clear that the 'f' in the signature must refer to A.f
239 -- The Haskell98 report does not stipulate this, but it will!
240 -- So we must treat the 'f' in the signature in the same way
241 -- as the binding occurrence of 'f', using lookupBndrRn
242 lookupSigOccRn :: RdrName -> RnMS Name
243 lookupSigOccRn = lookupBndrRn
245 -- lookupOccRn looks up an occurrence of a RdrName
246 lookupOccRn :: RdrName -> RnMS Name
248 = getLocalNameEnv `thenRn` \ local_env ->
249 case lookupRdrEnv local_env rdr_name of
250 Just name -> returnRn name
251 Nothing -> lookupGlobalOccRn rdr_name
253 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
254 -- environment. It's used only for
255 -- record field names
256 -- class op names in class and instance decls
258 lookupGlobalOccRn rdr_name
259 = getModeRn `thenRn` \ mode ->
260 if (isInterfaceMode mode)
261 then lookupIfaceName rdr_name
264 getGlobalNameEnv `thenRn` \ global_env ->
266 SourceMode -> lookupSrcName global_env rdr_name
269 | not (isQual rdr_name) ->
270 lookupSrcName global_env rdr_name
272 -- We allow qualified names on the command line to refer to
273 -- *any* name exported by any module in scope, just as if
274 -- there was an "import qualified M" declaration for every
277 -- First look up the name in the normal environment. If
278 -- it isn't there, we manufacture a new occurrence of an
281 case lookupRdrEnv global_env rdr_name of
282 Just _ -> lookupSrcName global_env rdr_name
283 Nothing -> lookupQualifiedName rdr_name
285 -- a qualified name on the command line can refer to any module at all: we
286 -- try to load the interface if we don't already have it.
287 lookupQualifiedName :: RdrName -> RnM d Name
288 lookupQualifiedName rdr_name
290 mod = rdrNameModule rdr_name
291 occ = rdrNameOcc rdr_name
293 loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
294 case [ name | (_,avails) <- mi_exports iface,
296 name <- availNames avail,
297 nameOccName name == occ ] of
298 (n:ns) -> ASSERT (null ns) returnRn n
299 _ -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
301 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
302 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
303 lookupSrcName global_env rdr_name
304 | isOrig rdr_name -- Can occur in source code too
305 = lookupOrigName rdr_name
308 = case lookupRdrEnv global_env rdr_name of
309 Just [GRE name _ Nothing] -> returnRn name
310 Just [GRE name _ (Just deprec)] -> warnDeprec name deprec `thenRn_`
312 Just stuff@(GRE name _ _ : _) -> addNameClashErrRn rdr_name stuff `thenRn_`
314 Nothing -> failWithRn (mkUnboundName rdr_name)
315 (unknownNameErr rdr_name)
317 lookupOrigName :: RdrName -> RnM d Name
318 lookupOrigName rdr_name
319 = ASSERT( isOrig rdr_name )
320 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
322 lookupIfaceUnqual :: RdrName -> RnM d Name
323 lookupIfaceUnqual rdr_name
324 = ASSERT( isUnqual rdr_name )
325 -- An Unqual is allowed; interface files contain
326 -- unqualified names for locally-defined things, such as
327 -- constructors of a data type.
328 getModuleRn `thenRn ` \ mod ->
329 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
331 lookupIfaceName :: RdrName -> RnM d Name
332 lookupIfaceName rdr_name
333 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
334 | otherwise = lookupOrigName rdr_name
337 @lookupOrigName@ takes an RdrName representing an {\em original}
338 name, and adds it to the occurrence pool so that it'll be loaded
339 later. This is used when language constructs (such as monad
340 comprehensions, overloaded literals, or deriving clauses) require some
341 stuff to be loaded that isn't explicitly mentioned in the code.
343 This doesn't apply in interface mode, where everything is explicit,
344 but we don't check for this case: it does no harm to record an
345 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
346 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
347 calls it at all I think).
349 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
352 lookupOrigNames :: [RdrName] -> RnM d NameSet
353 lookupOrigNames rdr_names
354 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
355 returnRn (mkNameSet names)
358 lookupSysBinder is used for the "system binders" of a type, class, or
359 instance decl. It ensures that the module is set correctly in the
360 name cache, and sets the provenance on the returned name too. The
361 returned name will end up actually in the type, class, or instance.
364 lookupSysBinder rdr_name
365 = ASSERT( isUnqual rdr_name )
366 getModuleRn `thenRn` \ mod ->
367 getSrcLocRn `thenRn` \ loc ->
368 newTopBinder mod rdr_name loc
372 %*********************************************************
374 \subsection{Implicit free vars and sugar names}
376 %*********************************************************
378 @getXImplicitFVs@ forces the renamer to slurp in some things which aren't
379 mentioned explicitly, but which might be needed by the type checker.
382 getImplicitStmtFVs -- Compiling a statement
383 = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName]
384 `plusFV` ubiquitousNames)
385 -- These are all needed implicitly when compiling a statement
386 -- See TcModule.tc_stmts
388 getImplicitModuleFVs mod_name decls -- Compiling a module
389 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
390 returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
392 -- Add occurrences for IO or PrimIO
393 implicit_main | mod_name == mAIN_Name
394 || mod_name == pREL_MAIN_Name = unitFV ioTyConName
395 | otherwise = emptyFVs
397 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
398 cls <- deriv_classes,
399 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
401 -- ubiquitous_names are loaded regardless, because
402 -- they are needed in virtually every program
404 = mkFVs [unpackCStringName, unpackCStringFoldrName,
405 unpackCStringUtf8Name, eqStringName]
406 -- Virtually every program has error messages in it somewhere
409 mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
410 -- Add occurrences for very frequently used types.
411 -- (e.g. we don't want to be bothered with making funTyCon a
412 -- free var at every function application!)
415 %************************************************************************
417 \subsection{Re-bindable desugaring names}
419 %************************************************************************
421 Haskell 98 says that when you say "3" you get the "fromInteger" from the
422 Standard Prelude, regardless of what is in scope. However, to experiment
423 with having a language that is less coupled to the standard prelude, we're
424 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
425 happens to be in scope. Then you can
427 import MyPrelude as Prelude
428 to get the desired effect.
430 At the moment this just happens for
431 * fromInteger, fromRational on literals (in expressions and patterns)
432 * negate (in expressions)
433 * minus (arising from n+k patterns)
435 We store the relevant Name in the HsSyn tree, in
436 * HsIntegral/HsFractional
439 respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName,
440 fromRationalName etc), but the renamer changes this to the appropriate user
441 name if Opt_NoImplicitPrelude is on. That is what lookupSyntaxName does.
444 lookupSyntaxName :: Name -- The standard name
445 -> RnMS Name -- Possibly a non-standard name
446 lookupSyntaxName std_name
447 = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
448 if not no_prelude then
449 returnRn std_name -- Normal case
452 rdr_name = mkRdrUnqual (nameOccName std_name)
453 -- Get the similarly named thing from the local environment
459 %*********************************************************
463 %*********************************************************
466 newLocalsRn :: [(RdrName,SrcLoc)]
468 newLocalsRn rdr_names_w_loc
469 = getNameSupplyRn `thenRn` \ name_supply ->
471 (us', us1) = splitUniqSupply (nsUniqs name_supply)
472 uniqs = uniqsFromSupply us1
473 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
474 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
477 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
481 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
482 -> [(RdrName,SrcLoc)]
483 -> ([Name] -> RnMS a)
485 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
486 = getModeRn `thenRn` \ mode ->
487 getLocalNameEnv `thenRn` \ local_env ->
488 getGlobalNameEnv `thenRn` \ global_env ->
490 -- Check for duplicate names
491 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
493 -- Warn about shadowing, but only in source modules
495 check_shadow (rdr_name,loc)
496 | rdr_name `elemRdrEnv` local_env
497 || rdr_name `elemRdrEnv` global_env
498 = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name)
504 SourceMode -> ifOptRn Opt_WarnNameShadowing $
505 mapRn_ check_shadow rdr_names_w_loc
509 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
511 new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
513 setLocalNameEnv new_local_env (enclosed_scope names)
515 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
516 -- A specialised variant when renaming stuff from interface
517 -- files (of which there is a lot)
519 -- * no checks for shadowing
521 -- * deal with free vars
522 bindCoreLocalRn rdr_name enclosed_scope
523 = getSrcLocRn `thenRn` \ loc ->
524 getLocalNameEnv `thenRn` \ name_env ->
525 getNameSupplyRn `thenRn` \ name_supply ->
527 (us', us1) = splitUniqSupply (nsUniqs name_supply)
528 uniq = uniqFromSupply us1
529 name = mkLocalName uniq (rdrNameOcc rdr_name) loc
531 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
533 new_name_env = extendRdrEnv name_env rdr_name name
535 setLocalNameEnv new_name_env (enclosed_scope name)
537 bindCoreLocalsRn [] thing_inside = thing_inside []
538 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
539 bindCoreLocalsRn bs $ \ names' ->
540 thing_inside (name':names')
542 bindLocalNames names enclosed_scope
543 = getLocalNameEnv `thenRn` \ name_env ->
544 setLocalNameEnv (extendLocalRdrEnv name_env names)
547 bindLocalNamesFV names enclosed_scope
548 = bindLocalNames names $
549 enclosed_scope `thenRn` \ (thing, fvs) ->
550 returnRn (thing, delListFromNameSet fvs names)
553 -------------------------------------
554 bindLocalRn doc rdr_name enclosed_scope
555 = getSrcLocRn `thenRn` \ loc ->
556 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
560 bindLocalsRn doc rdr_names enclosed_scope
561 = getSrcLocRn `thenRn` \ loc ->
562 bindLocatedLocalsRn doc
563 (rdr_names `zip` repeat loc)
566 -- binLocalsFVRn is the same as bindLocalsRn
567 -- except that it deals with free vars
568 bindLocalsFVRn doc rdr_names enclosed_scope
569 = bindLocalsRn doc rdr_names $ \ names ->
570 enclosed_scope names `thenRn` \ (thing, fvs) ->
571 returnRn (thing, delListFromNameSet fvs names)
573 -------------------------------------
574 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
575 -- This tiresome function is used only in rnSourceDecl on InstDecl
576 extendTyVarEnvFVRn tyvars enclosed_scope
577 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
578 returnRn (thing, delListFromNameSet fvs tyvars)
580 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
581 -> ([HsTyVarBndr Name] -> RnMS a)
583 bindTyVarsRn doc_str tyvar_names enclosed_scope
584 = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
585 enclosed_scope tyvars
587 -- Gruesome name: return Names as well as HsTyVars
588 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
589 -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
591 bindTyVars2Rn doc_str tyvar_names enclosed_scope
592 = getSrcLocRn `thenRn` \ loc ->
594 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
596 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
597 enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
599 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
600 -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
601 -> RnMS (a, FreeVars)
602 bindTyVarsFVRn doc_str rdr_names enclosed_scope
603 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
604 enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
605 returnRn (thing, delListFromNameSet fvs names)
607 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
608 -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
609 -> RnMS (a, FreeVars)
610 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
611 = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
612 enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
613 returnRn (thing, delListFromNameSet fvs names)
615 bindPatSigTyVars :: [RdrNameHsType]
616 -> ([Name] -> RnMS (a, FreeVars))
617 -> RnMS (a, FreeVars)
618 -- Find the type variables in the pattern type
619 -- signatures that must be brought into scope
621 bindPatSigTyVars tys enclosed_scope
622 = getLocalNameEnv `thenRn` \ name_env ->
623 getSrcLocRn `thenRn` \ loc ->
625 forall_tyvars = nub [ tv | ty <- tys,
626 tv <- extractHsTyRdrTyVars ty,
627 not (tv `elemFM` name_env)
629 -- The 'nub' is important. For example:
630 -- f (x :: t) (y :: t) = ....
631 -- We don't want to complain about binding t twice!
633 located_tyvars = [(tv, loc) | tv <- forall_tyvars]
634 doc_sig = text "In a pattern type-signature"
636 bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
637 enclosed_scope names `thenRn` \ (thing, fvs) ->
638 returnRn (thing, delListFromNameSet fvs names)
641 -------------------------------------
642 checkDupOrQualNames, checkDupNames :: SDoc
643 -> [(RdrName, SrcLoc)]
645 -- Works in any variant of the renamer monad
647 checkDupOrQualNames doc_str rdr_names_w_loc
648 = -- Check for use of qualified names
649 mapRn_ (qualNameErr doc_str) quals `thenRn_`
650 checkDupNames doc_str rdr_names_w_loc
652 quals = filter (isQual . fst) rdr_names_w_loc
654 checkDupNames doc_str rdr_names_w_loc
655 = -- Check for duplicated names in a binding group
656 mapRn_ (dupNamesErr doc_str) dups
658 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
662 %************************************************************************
664 \subsection{GlobalRdrEnv}
666 %************************************************************************
669 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
670 -> Bool -- True <=> want unqualified import
671 -> (Name -> Provenance)
672 -> Avails -- Whats imported
673 -> Avails -- What's to be hidden
674 -- I.e. import (imports - hides)
678 mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
681 -- Make the name environment. We're talking about a
682 -- single module here, so there must be no name clashes.
683 -- In practice there only ever will be if it's the module
686 -- Add qualified names for the things that are available
687 -- (Qualified names are always imported)
688 gbl_env1 = foldl add_avail emptyRdrEnv avails
690 -- Delete (qualified names of) things that are hidden
691 gbl_env2 = foldl del_avail gbl_env1 hides
693 -- Add unqualified names
694 gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
695 | otherwise = gbl_env2
697 add_unqual env (qual_name, elts)
698 = foldl add_one env elts
700 add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
701 unqual_name = unqualifyRdrName qual_name
702 -- The qualified import should only have added one
703 -- binding for each qualified name! But if there's an error in
704 -- the module (multiple bindings for the same name) we may get
705 -- duplicates. So the simple thing is to do the fold.
708 = foldl delOneFromGlobalRdrEnv env rdr_names
710 rdr_names = map (mkRdrQual this_mod . nameOccName)
714 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
715 add_avail env avail = foldl add_name env (availNames avail)
717 add_name env name -- Add qualified name only
718 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
720 occ = nameOccName name
721 elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
723 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
724 -- Used to construct a GlobalRdrEnv for an interface that we've
725 -- read from a .hi file. We can't construct the original top-level
726 -- environment because we don't have enough info, but we compromise
727 -- by making an environment from its exports
728 mkIfaceGlobalRdrEnv m_avails
729 = foldl add emptyRdrEnv m_avails
731 add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
732 (\n -> LocalDef) avails [] NoDeprecs)
733 -- The NoDeprecs is a bit of a hack I suppose
737 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
738 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
740 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
741 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
743 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
744 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
746 combine_globals :: [GlobalRdrElt] -- Old
747 -> [GlobalRdrElt] -- New
749 combine_globals ns_old ns_new -- ns_new is often short
750 = foldr add ns_old ns_new
752 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
755 choose n m | n `beats` m = n
758 (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
760 is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
761 is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
762 is_duplicate (GRE n1 _ _) (GRE n2 _ _) = n1 == n2
765 We treat two bindings of a locally-defined name as a duplicate,
766 because they might be two separate, local defns and we want to report
767 and error for that, {\em not} eliminate a duplicate.
769 On the other hand, if you import the same name from two different
770 import statements, we {\em do} want to eliminate the duplicate, not report
773 If a module imports itself then there might be a local defn and an imported
774 defn of the same name; in this case the names will compare as equal, but
775 will still have different provenances.
778 @unQualInScope@ returns a function that takes a @Name@ and tells whether
779 its unqualified name is in scope. This is put as a boolean flag in
780 the @Name@'s provenance to guide whether or not to print the name qualified
784 unQualInScope :: GlobalRdrEnv -> Name -> Bool
785 -- True if 'f' is in scope, and has only one binding
786 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
788 = (`elemNameSet` unqual_names)
790 unqual_names :: NameSet
791 unqual_names = foldRdrEnv add emptyNameSet env
792 add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
793 add _ _ unquals = unquals
797 %************************************************************************
801 %************************************************************************
804 plusAvail (Avail n1) (Avail n2) = Avail n1
805 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
808 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
811 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
812 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
814 emptyAvailEnv = emptyNameEnv
815 unitAvailEnv :: AvailInfo -> AvailEnv
816 unitAvailEnv a = unitNameEnv (availName a) a
818 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
819 plusAvailEnv = plusNameEnv_C plusAvail
821 availEnvElts = nameEnvElts
823 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
824 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
826 availsToNameSet :: [AvailInfo] -> NameSet
827 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
829 availName :: GenAvailInfo name -> name
830 availName (Avail n) = n
831 availName (AvailTC n _) = n
833 availNames :: GenAvailInfo name -> [name]
834 availNames (Avail n) = [n]
835 availNames (AvailTC n ns) = ns
837 -------------------------------------
838 filterAvail :: RdrNameIE -- Wanted
839 -> AvailInfo -- Available
840 -> Maybe AvailInfo -- Resulting available;
841 -- Nothing if (any of the) wanted stuff isn't there
843 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
844 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
845 | otherwise = Nothing
847 is_wanted name = nameOccName name `elem` wanted_occs
848 sub_names_ok = all (`elem` avail_occs) wanted_occs
849 avail_occs = map nameOccName ns
850 wanted_occs = map rdrNameOcc (want:wants)
852 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
855 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
857 filterAvail (IEVar _) avail@(Avail n) = Just avail
858 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
860 wanted n = nameOccName n == occ
862 -- The second equation happens if we import a class op, thus
864 -- where op is a class operation
866 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
867 -- We don't complain even if the IE says T(..), but
868 -- no constrs/class ops of T are available
869 -- Instead that's caught with a warning by the caller
871 filterAvail ie avail = Nothing
873 -------------------------------------
874 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
875 -- Group by module and sort by occurrence
876 -- This keeps the list in canonical order
877 groupAvails this_mod avails
878 = [ (mkSysModuleNameFS fs, sortLt lt avails)
879 | (fs,avails) <- fmToList groupFM
882 groupFM :: FiniteMap FastString Avails
883 -- Deliberately use the FastString so we
884 -- get a canonical ordering
885 groupFM = foldl add emptyFM avails
887 add env avail = addToFM_C combine env mod_fs [avail']
889 mod_fs = moduleNameFS (moduleName avail_mod)
890 avail_mod = case nameModule_maybe (availName avail) of
893 combine old _ = avail':old
894 avail' = sortAvail avail
896 a1 `lt` a2 = occ1 < occ2
898 occ1 = nameOccName (availName a1)
899 occ2 = nameOccName (availName a2)
901 sortAvail :: AvailInfo -> AvailInfo
902 -- Sort the sub-names into canonical order.
903 -- The canonical order has the "main name" at the beginning
904 -- (if it's there at all)
905 sortAvail (Avail n) = Avail n
906 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
907 | otherwise = AvailTC n ( sortLt lt ns)
909 n1 `lt` n2 = nameOccName n1 < nameOccName n2
913 %************************************************************************
915 \subsection{Free variable manipulation}
917 %************************************************************************
921 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
923 (ys, fvs_s) = unzip stuff
925 returnRn (ys, plusFVs fvs_s)
929 %************************************************************************
931 \subsection{Envt utility functions}
933 %************************************************************************
936 warnUnusedModules :: [ModuleName] -> RnM d ()
937 warnUnusedModules mods
938 = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
940 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
941 text "is imported, but nothing from it is used",
942 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
945 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
946 warnUnusedImports names
947 = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
949 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
950 warnUnusedLocalBinds names
951 = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
953 warnUnusedMatches names
954 = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
956 -------------------------
958 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
959 warnUnusedBinds names
960 = mapRn_ warnUnusedGroup groups
962 -- Group by provenance
963 groups = equivClasses cmp names
964 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
967 -------------------------
969 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
970 warnUnusedGroup names
971 | null filtered_names = returnRn ()
972 | not is_local = returnRn ()
974 = pushSrcLocRn def_loc $
976 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
978 filtered_names = filter reportable names
979 (name1, prov1) = head filtered_names
980 (is_local, def_loc, msg)
982 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
984 NonLocalDef (UserImport mod loc _)
985 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
987 reportable (name,_) = case occNameUserString (nameOccName name) of
990 -- Haskell 98 encourages compilers to suppress warnings about
991 -- unused names in a pattern if they start with "_".
995 addNameClashErrRn rdr_name (np1:nps)
996 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
997 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
999 msg1 = ptext SLIT("either") <+> mk_ref np1
1000 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
1001 mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
1003 shadowedNameWarn shadow
1004 = hsep [ptext SLIT("This binding for"),
1005 quotes (ppr shadow),
1006 ptext SLIT("shadows an existing binding")]
1009 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
1011 flavour = occNameFlavour (rdrNameOcc name)
1013 qualNameErr descriptor (name,loc)
1014 = pushSrcLocRn loc $
1015 addErrRn (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
1018 dupNamesErr descriptor ((name,loc) : dup_things)
1019 = pushSrcLocRn loc $
1020 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
1024 warnDeprec :: Name -> DeprecTxt -> RnM d ()
1026 = ifOptRn Opt_WarnDeprecations $
1027 addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
1028 quotes (ppr name) <+> text "is deprecated:",