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 FlattenInfo ( namesNeededForFlattening )
15 import RdrHsSyn ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
16 import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
17 mkRdrUnqual, mkRdrQual,
18 lookupRdrEnv, foldRdrEnv, rdrEnvToList, elemRdrEnv,
21 import HsTypes ( hsTyVarName, replaceTyVarName )
22 import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
23 ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
24 AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
25 ModIface(..), GhciMode(..),
26 Deprecations(..), lookupDeprec,
31 getSrcLoc, nameIsLocalOrFrom,
32 mkInternalName, mkExternalName,
33 mkIPName, nameOccName, nameModule_maybe,
38 import OccName ( OccName, occNameUserString, occNameFlavour )
39 import Module ( ModuleName, moduleName, mkVanillaModule,
40 mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
41 import PrelNames ( mkUnboundName,
43 mAIN_Name, main_RDR_Unqual,
44 runMainName, intTyConName,
45 boolTyConName, funTyConName,
46 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
47 eqStringName, printName,
48 bindIOName, returnIOName, failIOName, thenIOName
50 import TysWiredIn ( unitTyCon ) -- A little odd
53 import SrcLoc ( SrcLoc, noSrcLoc )
55 import ListSetOps ( removeDups, equivClasses )
56 import Util ( sortLt )
57 import BasicTypes ( mapIPName )
59 import UniqFM ( lookupWithDefaultUFM )
60 import Maybe ( mapMaybe )
62 import FastString ( FastString )
65 %*********************************************************
67 \subsection{Making new names}
69 %*********************************************************
72 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
73 -- newTopBinder puts into the cache the binder with the
74 -- module information set correctly. When the decl is later renamed,
75 -- the binding site will thereby get the correct module.
76 -- There maybe occurrences that don't have the correct Module, but
77 -- by the typechecker will propagate the binding definition to all
78 -- the occurrences, so that doesn't matter
80 newTopBinder mod rdr_name loc
81 = -- First check the cache
83 -- There should never be a qualified name in a binding position (except in instance decls)
84 -- The parser doesn't check this because the same parser parses instance decls
85 (if isQual rdr_name then
86 qualNameErr (text "In its declaration") (rdr_name,loc)
91 getNameSupplyRn `thenRn` \ name_supply ->
93 occ = rdrNameOcc rdr_name
94 key = (moduleName mod, occ)
95 cache = nsNames name_supply
97 case lookupFM cache key of
99 -- A hit in the cache! We are at the binding site of the name, and
100 -- this is the moment when we know all about
101 -- a) the Name's host Module (in particular, which
102 -- package it comes from)
103 -- b) its defining SrcLoc
104 -- So we update this info
107 new_name = setNameModuleAndLoc name mod loc
108 new_cache = addToFM cache key new_name
110 setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
111 -- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
114 -- Miss in the cache!
115 -- Build a completely new Name, and put it in the cache
116 -- Even for locally-defined names we use implicitImportProvenance;
117 -- updateProvenances will set it to rights
119 (us', us1) = splitUniqSupply (nsUniqs name_supply)
120 uniq = uniqFromSupply us1
121 new_name = mkExternalName uniq mod occ loc
122 new_cache = addToFM cache key new_name
124 setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
125 -- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
129 newGlobalName :: ModuleName -> OccName -> RnM d Name
130 -- Used for *occurrences*. We make a place-holder Name, really just
131 -- to agree on its unique, which gets overwritten when we read in
132 -- the binding occurence later (newTopBinder)
133 -- The place-holder Name doesn't have the right SrcLoc, and its
134 -- Module won't have the right Package either.
136 -- (We have to pass a ModuleName, not a Module, because we may be
137 -- simply looking at an occurrence M.x in an interface file.)
139 -- This means that a renamed program may have incorrect info
140 -- on implicitly-imported occurrences, but the correct info on the
141 -- *binding* declaration. It's the type checker that propagates the
142 -- correct information to all the occurrences.
143 -- Since implicitly-imported names never occur in error messages,
144 -- it doesn't matter that we get the correct info in place till later,
145 -- (but since it affects DLL-ery it does matter that we get it right
147 newGlobalName mod_name occ
148 = getNameSupplyRn `thenRn` \ name_supply ->
150 key = (mod_name, occ)
151 cache = nsNames name_supply
153 case lookupFM cache key of
154 Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
157 Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
158 -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
161 (us', us1) = splitUniqSupply (nsUniqs name_supply)
162 uniq = uniqFromSupply us1
163 mod = mkVanillaModule mod_name
164 name = mkExternalName uniq mod occ noSrcLoc
165 new_cache = addToFM cache key name
167 newIPName rdr_name_ip
168 = getNameSupplyRn `thenRn` \ name_supply ->
170 ipcache = nsIPs name_supply
172 case lookupFM ipcache key of
173 Just name_ip -> returnRn name_ip
174 Nothing -> setNameSupplyRn new_ns `thenRn_`
177 (us', us1) = splitUniqSupply (nsUniqs name_supply)
178 uniq = uniqFromSupply us1
179 name_ip = mapIPName mk_name rdr_name_ip
180 mk_name rdr_name = mkIPName uniq (rdrNameOcc rdr_name)
181 new_ipcache = addToFM ipcache key name_ip
182 new_ns = name_supply {nsUniqs = us', nsIPs = new_ipcache}
184 key = rdr_name_ip -- Ensures that ?x and %x get distinct Names
187 %*********************************************************
189 \subsection{Looking up names}
191 %*********************************************************
193 Looking up a name in the RnEnv.
196 lookupBndrRn rdr_name
197 = getLocalNameEnv `thenRn` \ local_env ->
198 case lookupRdrEnv local_env rdr_name of
199 Just name -> returnRn name
200 Nothing -> lookupTopBndrRn rdr_name
202 lookupTopBndrRn rdr_name
203 -- Look up a top-level local binder. We may be looking up an unqualified 'f',
204 -- and there may be several imported 'f's too, which must not confuse us.
205 -- So we have to filter out the non-local ones.
206 -- A separate function (importsFromLocalDecls) reports duplicate top level
207 -- decls, so here it's safe just to choose an arbitrary one.
210 -- This is here just to catch the PrelBase defn of (say) [] and similar
211 -- The parser reads the special syntax and returns an Orig RdrName
212 -- But the global_env contains only Qual RdrNames, so we won't
213 -- find it there; instead just get the name via the Orig route
215 = -- This is a binding site for the name, so check first that it
216 -- the current module is the correct one; otherwise GHC can get
217 -- very confused indeed. This test rejects code like
218 -- data T = (,) Int Int
219 -- unless we are in GHC.Tup
220 getModuleRn `thenRn` \ mod ->
221 checkRn (moduleName mod == rdrNameModule rdr_name)
222 (badOrigBinding rdr_name) `thenRn_`
223 lookupOrigName rdr_name
226 = getModeRn `thenRn` \ mode ->
227 if isInterfaceMode mode
228 then lookupSysBinder rdr_name
229 -- lookupSysBinder uses the Module in the monad to set
230 -- the correct module for the binder. This is important because
231 -- when GHCi is reading in an old interface, it just sucks it
232 -- in entire (Rename.loadHomeDecls) which uses lookupTopBndrRn
233 -- rather than via the iface file cache which uses newTopBndrRn
234 -- We must get the correct Module into the thing.
237 getModuleRn `thenRn` \ mod ->
238 getGlobalNameEnv `thenRn` \ global_env ->
239 case lookup_local mod global_env rdr_name of
240 Just name -> returnRn name
241 Nothing -> failWithRn (mkUnboundName rdr_name)
242 (unknownNameErr rdr_name)
244 lookup_local mod global_env rdr_name
245 = case lookupRdrEnv global_env rdr_name of
247 Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of
252 -- lookupSigOccRn is used for type signatures and pragmas
258 -- It's clear that the 'f' in the signature must refer to A.f
259 -- The Haskell98 report does not stipulate this, but it will!
260 -- So we must treat the 'f' in the signature in the same way
261 -- as the binding occurrence of 'f', using lookupBndrRn
262 lookupSigOccRn :: RdrName -> RnMS Name
263 lookupSigOccRn = lookupBndrRn
265 -- lookupInstDeclBndr is used for the binders in an
266 -- instance declaration. Here we use the class name to
269 lookupInstDeclBndr :: Name -> RdrName -> RnMS Name
270 -- We use the selector name as the binder
271 lookupInstDeclBndr cls_name rdr_name
272 | isOrig rdr_name -- Occurs in derived instances, where we just
273 -- refer diectly to the right method
274 = lookupOrigName rdr_name
277 = getGlobalAvails `thenRn` \ avail_env ->
278 case lookupNameEnv avail_env cls_name of
279 -- The class itself isn't in scope, so cls_name is unboundName
280 -- e.g. import Prelude hiding( Ord )
281 -- instance Ord T where ...
282 -- The program is wrong, but that should not cause a crash.
283 Nothing -> returnRn (mkUnboundName rdr_name)
284 Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
285 (n:ns)-> ASSERT( null ns ) returnRn n
286 [] -> failWithRn (mkUnboundName rdr_name)
287 (unknownNameErr rdr_name)
288 other -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
290 occ = rdrNameOcc rdr_name
292 -- lookupOccRn looks up an occurrence of a RdrName
293 lookupOccRn :: RdrName -> RnMS Name
295 = getLocalNameEnv `thenRn` \ local_env ->
296 case lookupRdrEnv local_env rdr_name of
297 Just name -> returnRn name
298 Nothing -> lookupGlobalOccRn rdr_name
300 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
301 -- environment. It's used only for
302 -- record field names
303 -- class op names in class and instance decls
305 lookupGlobalOccRn rdr_name
306 = getModeRn `thenRn` \ mode ->
307 if (isInterfaceMode mode)
308 then lookupIfaceName rdr_name
311 getGlobalNameEnv `thenRn` \ global_env ->
313 SourceMode -> lookupSrcName global_env rdr_name
316 | not (isQual rdr_name) ->
317 lookupSrcName global_env rdr_name
319 -- We allow qualified names on the command line to refer to
320 -- *any* name exported by any module in scope, just as if
321 -- there was an "import qualified M" declaration for every
324 -- First look up the name in the normal environment. If
325 -- it isn't there, we manufacture a new occurrence of an
328 case lookupRdrEnv global_env rdr_name of
329 Just _ -> lookupSrcName global_env rdr_name
330 Nothing -> lookupQualifiedName rdr_name
332 -- a qualified name on the command line can refer to any module at all: we
333 -- try to load the interface if we don't already have it.
334 lookupQualifiedName :: RdrName -> RnM d Name
335 lookupQualifiedName rdr_name
337 mod = rdrNameModule rdr_name
338 occ = rdrNameOcc rdr_name
340 loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
341 case [ name | (_,avails) <- mi_exports iface,
343 name <- availNames avail,
344 nameOccName name == occ ] of
345 (n:ns) -> ASSERT (null ns) returnRn n
346 _ -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
348 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
349 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
350 lookupSrcName global_env rdr_name
351 | isOrig rdr_name -- Can occur in source code too
352 = lookupOrigName rdr_name
355 = case lookupRdrEnv global_env rdr_name of
356 Just [GRE name _ Nothing] -> returnRn name
357 Just [GRE name _ (Just deprec)] -> warnDeprec name deprec `thenRn_`
359 Just stuff@(GRE name _ _ : _) -> addNameClashErrRn rdr_name stuff `thenRn_`
361 Nothing -> failWithRn (mkUnboundName rdr_name)
362 (unknownNameErr rdr_name)
364 lookupOrigName :: RdrName -> RnM d Name
365 lookupOrigName rdr_name
366 = -- NO: ASSERT( isOrig rdr_name )
367 -- Now that .hi-boot files are read by the main parser, they contain
368 -- ordinary qualified names (which we treat as Orig names here).
369 newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
371 lookupIfaceUnqual :: RdrName -> RnM d Name
372 lookupIfaceUnqual rdr_name
373 = ASSERT( isUnqual rdr_name )
374 -- An Unqual is allowed; interface files contain
375 -- unqualified names for locally-defined things, such as
376 -- constructors of a data type.
377 getModuleRn `thenRn ` \ mod ->
378 newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
380 lookupIfaceName :: RdrName -> RnM d Name
381 lookupIfaceName rdr_name
382 | isUnqual rdr_name = lookupIfaceUnqual rdr_name
383 | otherwise = lookupOrigName rdr_name
386 @lookupOrigName@ takes an RdrName representing an {\em original}
387 name, and adds it to the occurrence pool so that it'll be loaded
388 later. This is used when language constructs (such as monad
389 comprehensions, overloaded literals, or deriving clauses) require some
390 stuff to be loaded that isn't explicitly mentioned in the code.
392 This doesn't apply in interface mode, where everything is explicit,
393 but we don't check for this case: it does no harm to record an
394 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
395 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
396 calls it at all I think).
398 \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
401 lookupOrigNames :: [RdrName] -> RnM d NameSet
402 lookupOrigNames rdr_names
403 = mapRn lookupOrigName rdr_names `thenRn` \ names ->
404 returnRn (mkNameSet names)
407 lookupSysBinder is used for the "system binders" of a type, class, or
408 instance decl. It ensures that the module is set correctly in the
409 name cache, and sets the provenance on the returned name too. The
410 returned name will end up actually in the type, class, or instance.
413 lookupSysBinder rdr_name
414 = ASSERT( isUnqual rdr_name )
415 getModuleRn `thenRn` \ mod ->
416 getSrcLocRn `thenRn` \ loc ->
417 newTopBinder mod rdr_name loc
421 %*********************************************************
423 \subsection{Implicit free vars and sugar names}
425 %*********************************************************
427 @getXImplicitFVs@ forces the renamer to slurp in some things which aren't
428 mentioned explicitly, but which might be needed by the type checker.
431 getImplicitStmtFVs -- Compiling a statement
432 = returnRn (mkFVs [printName, bindIOName, thenIOName,
433 returnIOName, failIOName]
434 `plusFV` ubiquitousNames)
435 -- These are all needed implicitly when compiling a statement
436 -- See TcModule.tc_stmts
438 getImplicitModuleFVs decls -- Compiling a module
439 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
440 returnRn (deriving_names `plusFV` ubiquitousNames)
442 -- deriv_classes is now a list of HsTypes, so a "normal" one
443 -- appears as a (HsClassP c []). The non-normal ones for the new
444 -- newtype-deriving extension, and they don't require any
445 -- implicit names, so we can silently filter them out.
446 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
447 HsClassP cls [] <- deriv_classes,
448 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
450 -- ubiquitous_names are loaded regardless, because
451 -- they are needed in virtually every program
453 = mkFVs [unpackCStringName, unpackCStringFoldrName,
454 unpackCStringUtf8Name, eqStringName]
455 -- Virtually every program has error messages in it somewhere
458 mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
459 -- Add occurrences for very frequently used types.
460 -- (e.g. we don't want to be bothered with making funTyCon a
461 -- free var at every function application!)
463 namesNeededForFlattening
464 -- this will be empty unless flattening is activated
466 checkMain ghci_mode mod_name gbl_env
467 -- LOOKUP main IF WE'RE IN MODULE Main
468 -- The main point of this is to drag in the declaration for 'main',
469 -- its in another module, and for the Prelude function 'runMain',
470 -- so that the type checker will find them
472 -- We have to return the main_name separately, because it's a
473 -- bona fide 'use', and should be recorded as such, but the others
475 | mod_name /= mAIN_Name
476 = returnRn (Nothing, emptyFVs, emptyFVs)
478 | not (main_RDR_Unqual `elemRdrEnv` gbl_env)
479 = complain_no_main `thenRn_`
480 returnRn (Nothing, emptyFVs, emptyFVs)
483 = lookupSrcName gbl_env main_RDR_Unqual `thenRn` \ main_name ->
484 returnRn (Just main_name, unitFV main_name, unitFV runMainName)
487 complain_no_main | ghci_mode == Interactive = addWarnRn noMainMsg
488 | otherwise = addErrRn noMainMsg
489 -- In interactive mode, only warn about the absence of main
492 %************************************************************************
494 \subsection{Re-bindable desugaring names}
496 %************************************************************************
498 Haskell 98 says that when you say "3" you get the "fromInteger" from the
499 Standard Prelude, regardless of what is in scope. However, to experiment
500 with having a language that is less coupled to the standard prelude, we're
501 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
502 happens to be in scope. Then you can
504 import MyPrelude as Prelude
505 to get the desired effect.
507 At the moment this just happens for
508 * fromInteger, fromRational on literals (in expressions and patterns)
509 * negate (in expressions)
510 * minus (arising from n+k patterns)
512 We store the relevant Name in the HsSyn tree, in
513 * HsIntegral/HsFractional
516 respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName,
517 fromRationalName etc), but the renamer changes this to the appropriate user
518 name if Opt_NoImplicitPrelude is on. That is what lookupSyntaxName does.
521 lookupSyntaxName :: Name -- The standard name
522 -> RnMS Name -- Possibly a non-standard name
523 lookupSyntaxName std_name
524 = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude ->
525 if not no_prelude then
526 returnRn std_name -- Normal case
529 rdr_name = mkRdrUnqual (nameOccName std_name)
530 -- Get the similarly named thing from the local environment
536 %*********************************************************
540 %*********************************************************
543 newLocalsRn :: [(RdrName,SrcLoc)]
545 newLocalsRn rdr_names_w_loc
546 = getNameSupplyRn `thenRn` \ name_supply ->
548 (us', us1) = splitUniqSupply (nsUniqs name_supply)
549 uniqs = uniqsFromSupply us1
550 names = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
551 | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
554 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
558 bindLocatedLocalsRn :: SDoc -- Documentation string for error message
559 -> [(RdrName,SrcLoc)]
560 -> ([Name] -> RnMS a)
562 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
563 = getModeRn `thenRn` \ mode ->
564 getLocalNameEnv `thenRn` \ local_env ->
565 getGlobalNameEnv `thenRn` \ global_env ->
567 -- Check for duplicate names
568 checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
570 -- Warn about shadowing, but only in source modules
572 check_shadow (rdr_name,loc)
573 | rdr_name `elemRdrEnv` local_env
574 || rdr_name `elemRdrEnv` global_env
575 = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name)
581 SourceMode -> ifOptRn Opt_WarnNameShadowing $
582 mapRn_ check_shadow rdr_names_w_loc
586 newLocalsRn rdr_names_w_loc `thenRn` \ names ->
588 new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
590 setLocalNameEnv new_local_env (enclosed_scope names)
592 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
593 -- A specialised variant when renaming stuff from interface
594 -- files (of which there is a lot)
596 -- * no checks for shadowing
598 -- * deal with free vars
599 bindCoreLocalRn rdr_name enclosed_scope
600 = getSrcLocRn `thenRn` \ loc ->
601 getLocalNameEnv `thenRn` \ name_env ->
602 getNameSupplyRn `thenRn` \ name_supply ->
604 (us', us1) = splitUniqSupply (nsUniqs name_supply)
605 uniq = uniqFromSupply us1
606 name = mkInternalName uniq (rdrNameOcc rdr_name) loc
608 setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
610 new_name_env = extendRdrEnv name_env rdr_name name
612 setLocalNameEnv new_name_env (enclosed_scope name)
614 bindCoreLocalsRn [] thing_inside = thing_inside []
615 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' ->
616 bindCoreLocalsRn bs $ \ names' ->
617 thing_inside (name':names')
619 bindLocalNames names enclosed_scope
620 = getLocalNameEnv `thenRn` \ name_env ->
621 setLocalNameEnv (extendLocalRdrEnv name_env names)
624 bindLocalNamesFV names enclosed_scope
625 = bindLocalNames names $
626 enclosed_scope `thenRn` \ (thing, fvs) ->
627 returnRn (thing, delListFromNameSet fvs names)
630 -------------------------------------
631 bindLocalRn doc rdr_name enclosed_scope
632 = getSrcLocRn `thenRn` \ loc ->
633 bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
637 bindLocalsRn doc rdr_names enclosed_scope
638 = getSrcLocRn `thenRn` \ loc ->
639 bindLocatedLocalsRn doc
640 (rdr_names `zip` repeat loc)
643 -- binLocalsFVRn is the same as bindLocalsRn
644 -- except that it deals with free vars
645 bindLocalsFVRn doc rdr_names enclosed_scope
646 = bindLocalsRn doc rdr_names $ \ names ->
647 enclosed_scope names `thenRn` \ (thing, fvs) ->
648 returnRn (thing, delListFromNameSet fvs names)
650 -------------------------------------
651 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
652 -- This tiresome function is used only in rnSourceDecl on InstDecl
653 extendTyVarEnvFVRn tyvars enclosed_scope
654 = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) ->
655 returnRn (thing, delListFromNameSet fvs tyvars)
657 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
658 -> ([HsTyVarBndr Name] -> RnMS a)
660 bindTyVarsRn doc_str tyvar_names enclosed_scope
661 = getSrcLocRn `thenRn` \ loc ->
663 located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
665 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
666 enclosed_scope (zipWith replaceTyVarName tyvar_names names)
668 bindPatSigTyVars :: [RdrNameHsType]
669 -> RnMS (a, FreeVars)
670 -> RnMS (a, FreeVars)
671 -- Find the type variables in the pattern type
672 -- signatures that must be brought into scope
674 bindPatSigTyVars tys enclosed_scope
675 = getLocalNameEnv `thenRn` \ name_env ->
676 getSrcLocRn `thenRn` \ loc ->
678 forall_tyvars = nub [ tv | ty <- tys,
679 tv <- extractHsTyRdrTyVars ty,
680 not (tv `elemFM` name_env)
682 -- The 'nub' is important. For example:
683 -- f (x :: t) (y :: t) = ....
684 -- We don't want to complain about binding t twice!
686 located_tyvars = [(tv, loc) | tv <- forall_tyvars]
687 doc_sig = text "In a pattern type-signature"
689 bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
690 enclosed_scope `thenRn` \ (thing, fvs) ->
691 returnRn (thing, delListFromNameSet fvs names)
694 -------------------------------------
695 checkDupOrQualNames, checkDupNames :: SDoc
696 -> [(RdrName, SrcLoc)]
698 -- Works in any variant of the renamer monad
700 checkDupOrQualNames doc_str rdr_names_w_loc
701 = -- Check for use of qualified names
702 mapRn_ (qualNameErr doc_str) quals `thenRn_`
703 checkDupNames doc_str rdr_names_w_loc
705 quals = filter (isQual . fst) rdr_names_w_loc
707 checkDupNames doc_str rdr_names_w_loc
708 = -- Check for duplicated names in a binding group
709 mapRn_ (dupNamesErr doc_str) dups
711 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
715 %************************************************************************
717 \subsection{GlobalRdrEnv}
719 %************************************************************************
722 mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
723 -> Bool -- True <=> want unqualified import
724 -> (Name -> Provenance)
725 -> Avails -- Whats imported
729 mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
732 -- Make the name environment. We're talking about a
733 -- single module here, so there must be no name clashes.
734 -- In practice there only ever will be if it's the module
737 -- Add qualified names for the things that are available
738 -- (Qualified names are always imported)
739 gbl_env1 = foldl add_avail emptyRdrEnv avails
741 -- Add unqualified names
742 gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1)
743 | otherwise = gbl_env1
745 add_unqual env (qual_name, elts)
746 = foldl add_one env elts
748 add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
749 unqual_name = unqualifyRdrName qual_name
750 -- The qualified import should only have added one
751 -- binding for each qualified name! But if there's an error in
752 -- the module (multiple bindings for the same name) we may get
753 -- duplicates. So the simple thing is to do the fold.
755 add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
756 add_avail env avail = foldl add_name env (availNames avail)
758 add_name env name -- Add qualified name only
759 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
761 occ = nameOccName name
762 elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
766 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
767 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
769 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
770 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
772 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
773 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
775 combine_globals :: [GlobalRdrElt] -- Old
776 -> [GlobalRdrElt] -- New
778 combine_globals ns_old ns_new -- ns_new is often short
779 = foldr add ns_old ns_new
781 add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
784 choose n m | n `beats` m = n
787 (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
789 is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
790 is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
791 is_duplicate (GRE n1 _ _) (GRE n2 _ _) = n1 == n2
794 We treat two bindings of a locally-defined name as a duplicate,
795 because they might be two separate, local defns and we want to report
796 and error for that, {\em not} eliminate a duplicate.
798 On the other hand, if you import the same name from two different
799 import statements, we {\em do} want to eliminate the duplicate, not report
802 If a module imports itself then there might be a local defn and an imported
803 defn of the same name; in this case the names will compare as equal, but
804 will still have different provenances.
807 @unQualInScope@ returns a function that takes a @Name@ and tells whether
808 its unqualified name is in scope. This is put as a boolean flag in
809 the @Name@'s provenance to guide whether or not to print the name qualified
813 unQualInScope :: GlobalRdrEnv -> Name -> Bool
814 -- True if 'f' is in scope, and has only one binding,
815 -- and the thing it is bound to is the name we are looking for
816 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
818 -- This fn is only efficient if the shared
819 -- partial application is used a lot.
821 = (`elemNameSet` unqual_names)
823 unqual_names :: NameSet
824 unqual_names = foldRdrEnv add emptyNameSet env
825 add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
826 add _ _ unquals = unquals
830 %************************************************************************
834 %************************************************************************
837 plusAvail (Avail n1) (Avail n2) = Avail n1
838 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
841 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
844 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
845 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
847 unitAvailEnv :: AvailInfo -> AvailEnv
848 unitAvailEnv a = unitNameEnv (availName a) a
850 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
851 plusAvailEnv = plusNameEnv_C plusAvail
853 availEnvElts = nameEnvElts
855 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
856 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
858 availsToNameSet :: [AvailInfo] -> NameSet
859 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
861 availName :: GenAvailInfo name -> name
862 availName (Avail n) = n
863 availName (AvailTC n _) = n
865 availNames :: GenAvailInfo name -> [name]
866 availNames (Avail n) = [n]
867 availNames (AvailTC n ns) = ns
869 -------------------------------------
870 filterAvail :: RdrNameIE -- Wanted
871 -> AvailInfo -- Available
872 -> Maybe AvailInfo -- Resulting available;
873 -- Nothing if (any of the) wanted stuff isn't there
875 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
876 | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
877 | otherwise = Nothing
879 is_wanted name = nameOccName name `elem` wanted_occs
880 sub_names_ok = all (`elem` avail_occs) wanted_occs
881 avail_occs = map nameOccName ns
882 wanted_occs = map rdrNameOcc (want:wants)
884 filterAvail (IEThingAbs _) (AvailTC n ns) = ASSERT( n `elem` ns )
887 filterAvail (IEThingAbs _) avail@(Avail n) = Just avail -- Type synonyms
889 filterAvail (IEVar _) avail@(Avail n) = Just avail
890 filterAvail (IEVar v) avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
892 wanted n = nameOccName n == occ
894 -- The second equation happens if we import a class op, thus
896 -- where op is a class operation
898 filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
899 -- We don't complain even if the IE says T(..), but
900 -- no constrs/class ops of T are available
901 -- Instead that's caught with a warning by the caller
903 filterAvail ie avail = Nothing
905 -------------------------------------
906 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
907 -- Group by module and sort by occurrence
908 -- This keeps the list in canonical order
909 groupAvails this_mod avails
910 = [ (mkSysModuleNameFS fs, sortLt lt avails)
911 | (fs,avails) <- fmToList groupFM
914 groupFM :: FiniteMap FastString Avails
915 -- Deliberately use the FastString so we
916 -- get a canonical ordering
917 groupFM = foldl add emptyFM avails
919 add env avail = addToFM_C combine env mod_fs [avail']
921 mod_fs = moduleNameFS (moduleName avail_mod)
922 avail_mod = case nameModule_maybe (availName avail) of
925 combine old _ = avail':old
926 avail' = sortAvail avail
928 a1 `lt` a2 = occ1 < occ2
930 occ1 = nameOccName (availName a1)
931 occ2 = nameOccName (availName a2)
933 sortAvail :: AvailInfo -> AvailInfo
934 -- Sort the sub-names into canonical order.
935 -- The canonical order has the "main name" at the beginning
936 -- (if it's there at all)
937 sortAvail (Avail n) = Avail n
938 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
939 | otherwise = AvailTC n ( sortLt lt ns)
941 n1 `lt` n2 = nameOccName n1 < nameOccName n2
945 pruneAvails :: (Name -> Bool) -- Keep if this is True
948 pruneAvails keep avails
949 = mapMaybe del avails
951 del :: AvailInfo -> Maybe AvailInfo -- Nothing => nothing left!
952 del (Avail n) | keep n = Just (Avail n)
953 | otherwise = Nothing
954 del (AvailTC n ns) | null ns' = Nothing
955 | otherwise = Just (AvailTC n ns')
960 %************************************************************************
962 \subsection{Free variable manipulation}
964 %************************************************************************
968 mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
970 (ys, fvs_s) = unzip stuff
972 returnRn (ys, plusFVs fvs_s)
976 %************************************************************************
978 \subsection{Envt utility functions}
980 %************************************************************************
983 warnUnusedModules :: [ModuleName] -> RnM d ()
984 warnUnusedModules mods
985 = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
987 unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
988 text "is imported, but nothing from it is used",
989 parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
992 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
993 warnUnusedImports names
994 = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
996 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
997 warnUnusedLocalBinds names
998 = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
1000 warnUnusedMatches names
1001 = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
1003 -------------------------
1005 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
1006 warnUnusedBinds names
1007 = mapRn_ warnUnusedGroup groups
1009 -- Group by provenance
1010 groups = equivClasses cmp names
1011 (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
1014 -------------------------
1016 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
1017 warnUnusedGroup names
1018 | null filtered_names = returnRn ()
1019 | not is_local = returnRn ()
1021 = pushSrcLocRn def_loc $
1023 sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
1025 filtered_names = filter reportable names
1026 (name1, prov1) = head filtered_names
1027 (is_local, def_loc, msg)
1029 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
1031 NonLocalDef (UserImport mod loc _)
1032 -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
1034 reportable (name,_) = case occNameUserString (nameOccName name) of
1037 -- Haskell 98 encourages compilers to suppress warnings about
1038 -- unused names in a pattern if they start with "_".
1042 addNameClashErrRn rdr_name (np1:nps)
1043 = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
1044 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
1046 msg1 = ptext SLIT("either") <+> mk_ref np1
1047 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
1048 mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
1050 shadowedNameWarn shadow
1051 = hsep [ptext SLIT("This binding for"),
1052 quotes (ppr shadow),
1053 ptext SLIT("shadows an existing binding")]
1055 noMainMsg = ptext SLIT("No 'main' defined in module Main")
1058 = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
1060 flavour = occNameFlavour (rdrNameOcc name)
1063 = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
1064 -- The rdrNameOcc is because we don't want to print Prelude.(,)
1066 qualNameErr descriptor (name,loc)
1067 = pushSrcLocRn loc $
1068 addErrRn (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
1071 dupNamesErr descriptor ((name,loc) : dup_things)
1072 = pushSrcLocRn loc $
1073 addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
1077 warnDeprec :: Name -> DeprecTxt -> RnM d ()
1079 = ifOptRn Opt_WarnDeprecations $
1080 addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
1081 quotes (ppr name) <+> text "is deprecated:",