2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnEnv]{Environment manipulation for the renamer monad}
7 #include "HsVersions.h"
9 module RnEnv where -- Export everything
11 IMPORT_1_3(List (nub))
14 import CmdLineOpts ( opt_WarnNameShadowing )
16 import RdrHsSyn ( RdrName(..), SYN_IE(RdrNameIE),
17 rdrNameOcc, ieOcc, isQual, qual
19 import HsTypes ( getTyVarName, replaceTyVarName )
20 import BasicTypes ( Fixity(..), FixityDirection(..) )
22 import Name ( Name, OccName(..), Provenance(..), DefnInfo(..), ExportFlag(..), NamedThing(..),
23 occNameString, occNameFlavour,
24 SYN_IE(NameSet), emptyNameSet, addListToNameSet,
25 mkLocalName, mkGlobalName, modAndOcc, isLocallyDefinedName,
26 isWiredInName, nameOccName, setNameProvenance, isVarOcc, getNameProvenance,
27 pprProvenance, pprOccName, pprModule, pprNameProvenance
29 import TyCon ( TyCon )
30 import TysWiredIn ( tupleTyCon, listTyCon, charTyCon, intTyCon )
33 import Unique ( Unique, Uniquable(..), unboundKey )
34 import UniqFM ( listToUFM, plusUFM_C )
35 import Maybes ( maybeToBool )
37 import SrcLoc ( SrcLoc, noSrcLoc )
39 import Outputable ( PprStyle(..) )
40 import Util --( panic, removeDups, pprTrace, assertPanic )
46 %*********************************************************
48 \subsection{Making new names}
50 %*********************************************************
53 newGlobalName :: Module -> OccName -> RnM s d Name
55 = -- First check the cache
56 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
57 let key = (mod,occ) in
58 case lookupFM cache key of
60 -- A hit in the cache! Return it, but change the src loc
61 -- of the thing we've found if this is a second definition site
62 -- (that is, if loc /= NoSrcLoc)
63 Just name -> returnRn name
65 -- Miss in the cache, so build a new original name,
66 -- and put it in the cache
69 (us', us1) = splitUniqSupply us
71 name = mkGlobalName uniq mod occ VanillaDefn Implicit
72 cache' = addToFM cache key name
74 setNameSupplyRn (us', inst_ns, cache') `thenRn_`
77 newLocallyDefinedGlobalName :: Module -> OccName
78 -> (Name -> ExportFlag) -> SrcLoc
80 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
81 = -- First check the cache
82 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
84 -- We are at the binding site for a locally-defined thing, so
85 -- you might think it can't be in the cache, but it can if it's a
86 -- wired in thing. In that case we need to use the correct unique etc...
87 -- so all we do is replace its provenance.
88 -- If it's not in the cache we put it there with the correct provenance.
89 -- The idea is that, after all this, the cache
90 -- will contain a Name with the correct Provenance (i.e. Local)
92 -- OLD (now wrong) COMMENT:
93 -- "Actually, there's a catch. If this is the *second* binding for something
94 -- we want to allocate a *fresh* unique, rather than using the same Name as before.
95 -- Otherwise we don't detect conflicting definitions of the same top-level name!
96 -- So the only time we re-use a Name already in the cache is when it's one of
97 -- the Implicit magic-unique ones mentioned in the previous para"
99 -- This (incorrect) patch doesn't work for record decls, when we have
100 -- the same field declared in multiple constructors. With the above patch,
101 -- each occurrence got a new Name --- aargh!
103 -- So I reverted to the simple caching method (no "second-binding" thing)
104 -- The multiple-local-binding case is now handled by improving the conflict
105 -- detection in plusNameEnv.
107 provenance = LocalDef (rec_exp_fn new_name) loc
108 (us', us1) = splitUniqSupply us
111 new_name = case lookupFM cache key of
112 Just name -> setNameProvenance name provenance
113 other -> mkGlobalName uniq mod occ VanillaDefn provenance
114 new_cache = addToFM cache key new_name
116 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
119 -- newSysName is used to create the names for
120 -- a) default methods
121 -- These are never mentioned explicitly in source code (hence no point in looking
122 -- them up in the NameEnv), but when reading an interface file
123 -- we may want to slurp in their pragma info. In the source file itself we
124 -- need to create these names too so that we export them into the inferface file for this module.
126 newSysName :: OccName -> ExportFlag -> SrcLoc -> RnMS s Name
127 newSysName occ export_flag loc
128 = getModeRn `thenRn` \ mode ->
129 getModuleRn `thenRn` \ mod_name ->
131 SourceMode -> newLocallyDefinedGlobalName
135 InterfaceMode _ -> newGlobalName mod_name occ
137 -- newDfunName is a variant, specially for dfuns.
138 -- When renaming derived definitions we are in *interface* mode (because we can trip
139 -- over original names), but we still want to make the Dfun locally-defined.
140 -- So we can't use whether or not we're in source mode to decide the locally-defined question.
141 newDfunName :: Maybe RdrName -> SrcLoc -> RnMS s Name
142 newDfunName Nothing src_loc -- Local instance decls have a "Nothing"
143 = getModuleRn `thenRn` \ mod_name ->
144 newInstUniq `thenRn` \ inst_uniq ->
146 dfun_occ = VarOcc (_PK_ ("$d" ++ show inst_uniq))
148 newLocallyDefinedGlobalName mod_name dfun_occ
149 (\_ -> Exported) src_loc
151 newDfunName (Just n) src_loc -- Imported ones have "Just n"
152 = getModuleRn `thenRn` \ mod_name ->
153 newGlobalName mod_name (rdrNameOcc n)
156 newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
157 newLocalNames rdr_names
158 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
161 (us', us1) = splitUniqSupply us
162 uniqs = getUniques n us1
163 locals = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
164 | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
167 setNameSupplyRn (us', inst_ns, cache) `thenRn_`
170 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
171 -- during compiler debugging.
172 mkUnboundName :: RdrName -> Name
173 mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
175 isUnboundName :: Name -> Bool
176 isUnboundName name = uniqueOf name == unboundKey
180 bindLocatedLocalsRn :: (PprStyle -> Doc) -- Documentation string for error message
181 -> [(RdrName,SrcLoc)]
182 -> ([Name] -> RnMS s a)
184 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
185 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
187 getNameEnv `thenRn` \ name_env ->
188 (if opt_WarnNameShadowing
190 mapRn (check_shadow name_env) rdr_names_w_loc
195 newLocalNames rdr_names_w_loc `thenRn` \ names ->
197 new_name_env = addListToFM name_env (map fst rdr_names_w_loc `zip` names)
199 setNameEnv new_name_env (enclosed_scope names)
201 check_shadow name_env (rdr_name,loc)
202 = case lookupFM name_env rdr_name of
203 Nothing -> returnRn ()
204 Just name -> pushSrcLocRn loc $
205 addWarnRn (shadowedNameWarn rdr_name)
207 bindLocalsRn doc_str rdr_names enclosed_scope
208 = getSrcLocRn `thenRn` \ loc ->
209 bindLocatedLocalsRn (\_ -> text doc_str)
210 (rdr_names `zip` repeat loc)
213 bindTyVarsRn doc_str tyvar_names enclosed_scope
214 = getSrcLocRn `thenRn` \ loc ->
216 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
218 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
219 enclosed_scope (zipWith replaceTyVarName tyvar_names names)
221 -- Works in any variant of the renamer monad
222 checkDupOrQualNames, checkDupNames :: (PprStyle -> Doc)
223 -> [(RdrName, SrcLoc)]
226 checkDupOrQualNames doc_str rdr_names_w_loc
227 = -- Check for use of qualified names
228 mapRn (qualNameErr doc_str) quals `thenRn_`
229 checkDupNames doc_str rdr_names_w_loc
231 quals = filter (isQual.fst) rdr_names_w_loc
233 checkDupNames doc_str rdr_names_w_loc
234 = -- Check for dupicated names in a binding group
235 mapRn (dupNamesErr doc_str) dups `thenRn_`
238 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `cmp` n2) rdr_names_w_loc
242 %*********************************************************
244 \subsection{Looking up names}
246 %*********************************************************
248 Looking up a name in the RnEnv.
251 lookupRn :: NameEnv -> RdrName -> RnMS s Name
252 lookupRn name_env rdr_name
253 = case lookupFM name_env rdr_name of
256 Just name -> returnRn name
259 Nothing -> getModeRn `thenRn` \ mode ->
261 -- Not found when processing source code; so fail
262 SourceMode -> failWithRn (mkUnboundName rdr_name)
263 (unknownNameErr rdr_name)
265 -- Not found when processing an imported declaration,
266 -- so we create a new name for the purpose
270 Qual mod_name occ -> newGlobalName mod_name occ
272 -- An Unqual is allowed; interface files contain
273 -- unqualified names for locally-defined things, such as
274 -- constructors of a data type.
275 Unqual occ -> getModuleRn `thenRn ` \ mod_name ->
276 newGlobalName mod_name occ
279 lookupBndrRn rdr_name
280 = getNameEnv `thenRn` \ name_env ->
281 lookupRn name_env rdr_name
283 -- Just like lookupRn except that we record the occurrence too
284 -- Perhaps surprisingly, even wired-in names are recorded.
285 -- Why? So that we know which wired-in names are referred to when
286 -- deciding which instance declarations to import.
287 lookupOccRn :: RdrName -> RnMS s Name
289 = getNameEnv `thenRn` \ name_env ->
290 lookupRn name_env rdr_name `thenRn` \ name ->
291 addOccurrenceName name
293 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
294 -- environment. It's used for record field names only.
295 lookupGlobalOccRn :: RdrName -> RnMS s Name
296 lookupGlobalOccRn rdr_name
297 = getGlobalNameEnv `thenRn` \ name_env ->
298 lookupRn name_env rdr_name `thenRn` \ name ->
299 addOccurrenceName name
303 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
304 -- adds it to the occurrence pool so that it'll be loaded later. This is
305 -- used when language constructs (such as monad comprehensions, overloaded literals,
306 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
307 -- mentioned in the code.
309 -- This doesn't apply in interface mode, where everything is explicit, but
310 -- we don't check for this case: it does no harm to record an "extra" occurrence
311 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
312 -- Nothing clause of rnDerivs that calls it at all I think).
314 -- For List and Tuple types it's important to get the correct
315 -- isLocallyDefined flag, which is used in turn when deciding
316 -- whether there are any instance decls in this module are "special".
317 -- The name cache should have the correct provenance, though.
319 lookupImplicitOccRn :: RdrName -> RnMS s Name
320 lookupImplicitOccRn (Qual mod occ)
321 = newGlobalName mod occ `thenRn` \ name ->
322 addOccurrenceName name
324 addImplicitOccRn :: Name -> RnMS s Name
325 addImplicitOccRn name = addOccurrenceName name
327 addImplicitOccsRn :: [Name] -> RnMS s ()
328 addImplicitOccsRn names = addOccurrenceNames names
330 listType_RDR = qual (modAndOcc listType_name)
331 tupleType_RDR n = qual (modAndOcc (tupleType_name n))
333 charType_name = getName charTyCon
334 listType_name = getName listTyCon
335 tupleType_name n = getName (tupleTyCon n)
339 lookupFixity :: RdrName -> RnMS s Fixity
340 lookupFixity rdr_name
341 = getFixityEnv `thenRn` \ fixity_env ->
342 returnRn (lookupFixityEnv fixity_env rdr_name)
347 %************************************************************************
349 \subsection{Envt utility functions}
351 %************************************************************************
353 =============== RnEnv ================
355 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
356 = plusNameEnvRn n1 n2 `thenRn` \ n ->
357 plusFixityEnvRn f1 f2 `thenRn` \ f ->
361 =============== NameEnv ================
363 plusNameEnvRn :: NameEnv -> NameEnv -> RnM s d NameEnv
364 plusNameEnvRn env1 env2
365 = mapRn (addErrRn.nameClashErr) (conflictsFM conflicting_name env1 env2) `thenRn_`
366 returnRn (env1 `plusFM` env2)
368 addOneToNameEnv :: NameEnv -> RdrName -> Name -> RnM s d NameEnv
369 addOneToNameEnv env rdr_name name
370 = case lookupFM env rdr_name of
371 Just name2 | conflicting_name name name2
372 -> addErrRn (nameClashErr (rdr_name, (name, name2))) `thenRn_`
375 Nothing -> returnRn (addToFM env rdr_name name)
377 conflicting_name n1 n2 = (n1 /= n2) || (isLocallyDefinedName n1 && isLocallyDefinedName n2)
378 -- We complain of a conflict if one RdrName maps to two different Names,
379 -- OR if one RdrName maps to the same *locally-defined* Name. The latter
380 -- case is to catch two separate, local definitions of the same thing.
382 -- If a module imports itself then there might be a local defn and an imported
383 -- defn of the same name; in this case the names will compare as equal, but
384 -- will still have different provenances.
386 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
387 lookupNameEnv = lookupFM
389 delOneFromNameEnv :: NameEnv -> RdrName -> NameEnv
390 delOneFromNameEnv env rdr_name = delFromFM env rdr_name
393 =============== FixityEnv ================
395 plusFixityEnvRn f1 f2
396 = mapRn (addErrRn.fixityClashErr) (conflictsFM bad_fix f1 f2) `thenRn_`
397 returnRn (f1 `plusFM` f2)
399 addOneToFixityEnv env rdr_name fixity = addToFM env rdr_name fixity
401 lookupFixityEnv env rdr_name
402 = case lookupFM env rdr_name of
403 Just (fixity,_) -> fixity
404 Nothing -> Fixity 9 InfixL -- Default case
406 bad_fix :: (Fixity, Provenance) -> (Fixity, Provenance) -> Bool
407 bad_fix (f1,_) (f2,_) = f1 /= f2
409 pprFixityProvenance :: PprStyle -> (Fixity,Provenance) -> Doc
410 pprFixityProvenance sty (fixity, prov) = pprProvenance sty prov
415 =============== Avails ================
417 mkExportAvails :: Bool -> Module -> [AvailInfo] -> ExportAvails
418 mkExportAvails unqualified_import mod_name avails
419 = (mod_avail_env, entity_avail_env)
421 -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
422 mod_avail_env | unqualified_import = unitFM mod_name avails
423 | otherwise = emptyFM
425 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
426 name <- availEntityNames avail]
428 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
429 plusExportAvails (m1, e1) (m2, e2)
430 = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
434 =============== AvailInfo ================
436 plusAvail (Avail n1) (Avail n2) = Avail n1
437 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
438 plusAvail a NotAvailable = a
439 plusAvail NotAvailable a = a
442 plusAvail a1 a2 = panic ("RnEnv.plusAvail " ++ (show (hsep [pprAvail PprDebug a1,pprAvail PprDebug a2])))
445 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
446 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
448 availsToNameSet :: [AvailInfo] -> NameSet
449 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
451 availName :: AvailInfo -> Name
452 availName (Avail n) = n
453 availName (AvailTC n _) = n
455 availNames :: AvailInfo -> [Name]
456 availNames NotAvailable = []
457 availNames (Avail n) = [n]
458 availNames (AvailTC n ns) = ns
460 -- availEntityNames is used to extract the names that can appear on their own in
461 -- an export or import list. For class decls, class methods can appear on their
462 -- own, thus import A( op )
463 -- but constructors cannot; thus
465 -- means import type T from B, not constructor T.
467 availEntityNames :: AvailInfo -> [Name]
468 availEntityNames NotAvailable = []
469 availEntityNames (Avail n) = [n]
470 availEntityNames (AvailTC n ns) = n : filter (isVarOcc . nameOccName) ns
472 filterAvail :: RdrNameIE -- Wanted
473 -> AvailInfo -- Available
474 -> AvailInfo -- Resulting available;
475 -- NotAvailable if wanted stuff isn't there
477 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
478 | sub_names_ok = AvailTC n (filter is_wanted ns)
479 | otherwise = pprTrace "filterAvail" (hsep [ppr PprDebug ie, pprAvail PprDebug avail]) $
482 is_wanted name = nameOccName name `elem` wanted_occs
483 sub_names_ok = all (`elem` avail_occs) wanted_occs
484 avail_occs = map nameOccName ns
485 wanted_occs = map rdrNameOcc (want:wants)
487 filterAvail (IEThingAbs _) (AvailTC n ns)
488 | n `elem` ns = AvailTC n [n]
490 filterAvail (IEThingAbs _) avail@(Avail n) = avail -- Type synonyms
492 filterAvail (IEVar _) avail@(Avail n) = avail
493 filterAvail (IEVar v) avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
495 wanted n = nameOccName n == occ
497 -- The second equation happens if we import a class op, thus
499 -- where op is a class operation
501 filterAvail (IEThingAll _) avail@(AvailTC _ _) = avail
503 filterAvail ie avail = NotAvailable
506 -- In interfaces, pprAvail gets given the OccName of the "host" thing
507 pprAvail PprInterface avail = ppr_avail (pprOccName PprInterface . nameOccName) avail
508 pprAvail sty avail = ppr_avail (ppr sty) avail
510 ppr_avail pp_name NotAvailable = ptext SLIT("NotAvailable")
511 ppr_avail pp_name (AvailTC n ns) = hsep [
513 parens $ hsep $ punctuate comma $
516 ppr_avail pp_name (Avail n) = pp_name n
522 %************************************************************************
524 \subsection{Finite map utilities}
526 %************************************************************************
529 Generally useful function on finite maps to check for overlap.
533 => (b->b->Bool) -- False <=> no conflict; you can pick either
534 -> FiniteMap a b -> FiniteMap a b
536 conflictsFM bad fm1 fm2
537 = filter (\(a,(b1,b2)) -> bad b1 b2)
538 (fmToList (intersectFM_C (\b1 b2 -> (b1,b2)) fm1 fm2))
542 -> FiniteMap a b -> a -> b
544 conflictFM bad fm key elt
545 = case lookupFM fm key of
546 Just elt' | bad elt elt' -> [(key,(elt,elt'))]
551 %************************************************************************
553 \subsection{Envt utility functions}
555 %************************************************************************
559 nameClashErr (rdr_name, (name1,name2)) sty
560 = hang (hsep [ptext SLIT("Conflicting definitions for:"), ppr sty rdr_name])
561 4 (vcat [pprNameProvenance sty name1,
562 pprNameProvenance sty name2])
564 fixityClashErr (rdr_name, (fp1,fp2)) sty
565 = hang (hsep [ptext SLIT("Conflicting fixities for:"), ppr sty rdr_name])
566 4 (vcat [pprFixityProvenance sty fp1,
567 pprFixityProvenance sty fp2])
569 shadowedNameWarn shadow sty
570 = hcat [ptext SLIT("This binding for"),
572 ptext SLIT("shadows an existing binding")]
574 unknownNameErr name sty
575 = sep [text flavour, ptext SLIT("not in scope:"), ppr sty name]
577 flavour = occNameFlavour (rdrNameOcc name)
579 qualNameErr descriptor (name,loc)
581 addErrRn (\sty -> hsep [ ptext SLIT("Invalid use of qualified name"),
586 dupNamesErr descriptor ((name,loc) : dup_things)
588 addErrRn (\sty -> hsep [ptext SLIT("Conflicting definitions for"),
590 ptext SLIT("in"), descriptor sty])