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(..), IfaceFlavour(..), pprModule )
22 import Name ( Name, OccName(..), Provenance(..), 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 )
32 import Unique ( Unique, Uniquable(..), unboundKey )
33 import UniqFM ( listToUFM, plusUFM_C )
34 import Maybes ( maybeToBool )
36 import SrcLoc ( SrcLoc, noSrcLoc )
38 import Outputable ( Outputable(..), PprStyle(..) )
39 import Util ( Ord3(..), panic, removeDups, pprTrace, assertPanic )
45 %*********************************************************
47 \subsection{Making new names}
49 %*********************************************************
52 newGlobalName :: Module -> OccName -> IfaceFlavour -> RnM s d Name
53 newGlobalName mod occ iface_flavour
54 = -- First check the cache
55 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
56 let key = (mod,occ) in
57 case lookupFM cache key of
59 -- A hit in the cache! Return it, but change the src loc
60 -- of the thing we've found if this is a second definition site
61 -- (that is, if loc /= NoSrcLoc)
62 Just name -> returnRn name
64 -- Miss in the cache, so build a new original name,
65 -- And put it in the cache
68 (us', us1) = splitUniqSupply us
70 name = mkGlobalName uniq mod occ (Implicit iface_flavour)
71 cache' = addToFM cache key name
73 setNameSupplyRn (us', inst_ns, cache') `thenRn_`
76 newLocallyDefinedGlobalName :: Module -> OccName
77 -> (Name -> ExportFlag) -> SrcLoc
79 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
80 = -- First check the cache
81 getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
83 -- We are at the binding site for a locally-defined thing, so
84 -- you might think it can't be in the cache, but it can if it's a
85 -- wired in thing. In that case we need to use the correct unique etc...
86 -- so all we do is replace its provenance.
87 -- If it's not in the cache we put it there with the correct provenance.
88 -- The idea is that, after all this, the cache
89 -- will contain a Name with the correct Provenance (i.e. Local)
91 -- OLD (now wrong) COMMENT:
92 -- "Actually, there's a catch. If this is the *second* binding for something
93 -- we want to allocate a *fresh* unique, rather than using the same Name as before.
94 -- Otherwise we don't detect conflicting definitions of the same top-level name!
95 -- So the only time we re-use a Name already in the cache is when it's one of
96 -- the Implicit magic-unique ones mentioned in the previous para"
98 -- This (incorrect) patch doesn't work for record decls, when we have
99 -- the same field declared in multiple constructors. With the above patch,
100 -- each occurrence got a new Name --- aargh!
102 -- So I reverted to the simple caching method (no "second-binding" thing)
103 -- The multiple-local-binding case is now handled by improving the conflict
104 -- detection in plusNameEnv.
106 provenance = LocalDef (rec_exp_fn new_name) loc
107 (us', us1) = splitUniqSupply us
110 new_name = case lookupFM cache key of
111 Just name -> setNameProvenance name provenance
112 other -> mkGlobalName uniq mod occ provenance
113 new_cache = addToFM cache key new_name
115 setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
118 -- newDfunName is a variant, specially for dfuns.
119 -- When renaming derived definitions we are in *interface* mode (because we can trip
120 -- over original names), but we still want to make the Dfun locally-defined.
121 -- So we can't use whether or not we're in source mode to decide the locally-defined question.
122 newDfunName :: Maybe RdrName -> SrcLoc -> RnMS s Name
123 newDfunName Nothing src_loc -- Local instance decls have a "Nothing"
124 = getModuleRn `thenRn` \ mod_name ->
125 newInstUniq `thenRn` \ inst_uniq ->
127 dfun_occ = VarOcc (_PK_ ("$d" ++ show inst_uniq))
129 newLocallyDefinedGlobalName mod_name dfun_occ
130 (\_ -> Exported) src_loc
132 newDfunName (Just n) src_loc -- Imported ones have "Just n"
133 = getModuleRn `thenRn` \ mod_name ->
134 newGlobalName mod_name (rdrNameOcc n) HiFile {- Correct? -}
137 newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
138 newLocalNames rdr_names
139 = getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
142 (us', us1) = splitUniqSupply us
143 uniqs = getUniques n us1
144 locals = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
145 | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
148 setNameSupplyRn (us', inst_ns, cache) `thenRn_`
151 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
152 -- during compiler debugging.
153 mkUnboundName :: RdrName -> Name
154 mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
156 isUnboundName :: Name -> Bool
157 isUnboundName name = uniqueOf name == unboundKey
161 bindLocatedLocalsRn :: (PprStyle -> Doc) -- Documentation string for error message
162 -> [(RdrName,SrcLoc)]
163 -> ([Name] -> RnMS s a)
165 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
166 = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
168 getNameEnv `thenRn` \ name_env ->
169 (if opt_WarnNameShadowing
171 mapRn (check_shadow name_env) rdr_names_w_loc
176 newLocalNames rdr_names_w_loc `thenRn` \ names ->
178 new_name_env = addListToFM name_env (map fst rdr_names_w_loc `zip` names)
180 setNameEnv new_name_env (enclosed_scope names)
182 check_shadow name_env (rdr_name,loc)
183 = case lookupFM name_env rdr_name of
184 Nothing -> returnRn ()
185 Just name -> pushSrcLocRn loc $
186 addWarnRn (shadowedNameWarn rdr_name)
188 bindLocalsRn doc_str rdr_names enclosed_scope
189 = getSrcLocRn `thenRn` \ loc ->
190 bindLocatedLocalsRn (\_ -> text doc_str)
191 (rdr_names `zip` repeat loc)
194 bindTyVarsRn doc_str tyvar_names enclosed_scope
195 = getSrcLocRn `thenRn` \ loc ->
197 located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
199 bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
200 enclosed_scope (zipWith replaceTyVarName tyvar_names names)
202 -- Works in any variant of the renamer monad
203 checkDupOrQualNames, checkDupNames :: (PprStyle -> Doc)
204 -> [(RdrName, SrcLoc)]
207 checkDupOrQualNames doc_str rdr_names_w_loc
208 = -- Check for use of qualified names
209 mapRn (qualNameErr doc_str) quals `thenRn_`
210 checkDupNames doc_str rdr_names_w_loc
212 quals = filter (isQual.fst) rdr_names_w_loc
214 checkDupNames doc_str rdr_names_w_loc
215 = -- Check for dupicated names in a binding group
216 mapRn (dupNamesErr doc_str) dups `thenRn_`
219 (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `cmp` n2) rdr_names_w_loc
223 ifaceFlavour name = case getNameProvenance name of
224 Imported _ _ hif -> hif
226 other -> HiFile -- Shouldn't happen
230 %*********************************************************
232 \subsection{Looking up names}
234 %*********************************************************
236 Looking up a name in the RnEnv.
239 lookupRn :: NameEnv -> RdrName -> RnMS s Name
240 lookupRn name_env rdr_name
241 = case lookupFM name_env rdr_name of
244 Just name -> returnRn name
247 Nothing -> getModeRn `thenRn` \ mode ->
249 -- Not found when processing source code; so fail
250 SourceMode -> failWithRn (mkUnboundName rdr_name)
251 (unknownNameErr rdr_name)
253 -- Not found when processing an imported declaration,
254 -- so we create a new name for the purpose
258 Qual mod_name occ hif -> newGlobalName mod_name occ hif
260 -- An Unqual is allowed; interface files contain
261 -- unqualified names for locally-defined things, such as
262 -- constructors of a data type.
263 Unqual occ -> getModuleRn `thenRn ` \ mod_name ->
264 newGlobalName mod_name occ HiFile
267 lookupBndrRn rdr_name
268 = getNameEnv `thenRn` \ name_env ->
269 lookupRn name_env rdr_name
271 -- Just like lookupRn except that we record the occurrence too
272 -- Perhaps surprisingly, even wired-in names are recorded.
273 -- Why? So that we know which wired-in names are referred to when
274 -- deciding which instance declarations to import.
275 lookupOccRn :: RdrName -> RnMS s Name
277 = getNameEnv `thenRn` \ name_env ->
278 lookupRn name_env rdr_name `thenRn` \ name ->
279 addOccurrenceName name
281 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
282 -- environment. It's used for record field names only.
283 lookupGlobalOccRn :: RdrName -> RnMS s Name
284 lookupGlobalOccRn rdr_name
285 = getGlobalNameEnv `thenRn` \ name_env ->
286 lookupRn name_env rdr_name `thenRn` \ name ->
287 addOccurrenceName name
291 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
292 -- adds it to the occurrence pool so that it'll be loaded later. This is
293 -- used when language constructs (such as monad comprehensions, overloaded literals,
294 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
295 -- mentioned in the code.
297 -- This doesn't apply in interface mode, where everything is explicit, but
298 -- we don't check for this case: it does no harm to record an "extra" occurrence
299 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
300 -- Nothing clause of rnDerivs that calls it at all I think).
302 -- For List and Tuple types it's important to get the correct
303 -- isLocallyDefined flag, which is used in turn when deciding
304 -- whether there are any instance decls in this module are "special".
305 -- The name cache should have the correct provenance, though.
307 lookupImplicitOccRn :: RdrName -> RnMS s Name
308 lookupImplicitOccRn (Qual mod occ hif)
309 = newGlobalName mod occ hif `thenRn` \ name ->
310 addOccurrenceName name
312 addImplicitOccRn :: Name -> RnMS s Name
313 addImplicitOccRn name = addOccurrenceName name
315 addImplicitOccsRn :: [Name] -> RnMS s ()
316 addImplicitOccsRn names = addOccurrenceNames names
318 listType_RDR = qual (modAndOcc listType_name)
319 tupleType_RDR n = qual (modAndOcc (tupleType_name n))
321 charType_name = getName charTyCon
322 listType_name = getName listTyCon
323 tupleType_name n = getName (tupleTyCon n)
327 lookupFixity :: RdrName -> RnMS s Fixity
328 lookupFixity rdr_name
329 = getFixityEnv `thenRn` \ fixity_env ->
330 returnRn (lookupFixityEnv fixity_env rdr_name)
335 %************************************************************************
337 \subsection{Envt utility functions}
339 %************************************************************************
341 =============== RnEnv ================
343 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
344 = plusNameEnvRn n1 n2 `thenRn` \ n ->
345 plusFixityEnvRn f1 f2 `thenRn` \ f ->
349 =============== NameEnv ================
351 plusNameEnvRn :: NameEnv -> NameEnv -> RnM s d NameEnv
352 plusNameEnvRn env1 env2
353 = mapRn (addErrRn.nameClashErr) (conflictsFM conflicting_name env1 env2) `thenRn_`
354 returnRn (env1 `plusFM` env2)
356 addOneToNameEnv :: NameEnv -> RdrName -> Name -> RnM s d NameEnv
357 addOneToNameEnv env rdr_name name
358 = case lookupFM env rdr_name of
359 Just name2 | conflicting_name name name2
360 -> addErrRn (nameClashErr (rdr_name, (name, name2))) `thenRn_`
363 other -> returnRn (addToFM env rdr_name name)
365 conflicting_name n1 n2 = (n1 /= n2) ||
366 (isLocallyDefinedName n1 && isLocallyDefinedName n2)
367 -- We complain of a conflict if one RdrName maps to two different Names,
368 -- OR if one RdrName maps to the same *locally-defined* Name. The latter
369 -- case is to catch two separate, local definitions of the same thing.
371 -- If a module imports itself then there might be a local defn and an imported
372 -- defn of the same name; in this case the names will compare as equal, but
373 -- will still have different provenances.
375 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
376 lookupNameEnv = lookupFM
378 delOneFromNameEnv :: NameEnv -> RdrName -> NameEnv
379 delOneFromNameEnv env rdr_name = delFromFM env rdr_name
382 =============== FixityEnv ================
384 plusFixityEnvRn f1 f2
385 = mapRn (addErrRn.fixityClashErr) (conflictsFM bad_fix f1 f2) `thenRn_`
386 returnRn (f1 `plusFM` f2)
388 addOneToFixityEnv env rdr_name fixity = addToFM env rdr_name fixity
390 lookupFixityEnv env rdr_name
391 = case lookupFM env rdr_name of
392 Just (fixity,_) -> fixity
393 Nothing -> Fixity 9 InfixL -- Default case
395 bad_fix :: (Fixity, Provenance) -> (Fixity, Provenance) -> Bool
396 bad_fix (f1,_) (f2,_) = f1 /= f2
398 pprFixityProvenance :: PprStyle -> (Fixity,Provenance) -> Doc
399 pprFixityProvenance sty (fixity, prov) = pprProvenance sty prov
404 =============== Avails ================
406 mkExportAvails :: Bool -> Module -> [AvailInfo] -> ExportAvails
407 mkExportAvails unqualified_import mod_name avails
408 = (mod_avail_env, entity_avail_env)
410 -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
411 mod_avail_env | unqualified_import = unitFM mod_name avails
412 | otherwise = emptyFM
414 entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
415 name <- availEntityNames avail]
417 plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails
418 plusExportAvails (m1, e1) (m2, e2)
419 = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
423 =============== AvailInfo ================
425 plusAvail (Avail n1) (Avail n2) = Avail n1
426 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
427 plusAvail a NotAvailable = a
428 plusAvail NotAvailable a = a
431 plusAvail a1 a2 = panic ("RnEnv.plusAvail " ++ (show (hsep [pprAvail PprDebug a1,pprAvail PprDebug a2])))
434 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
435 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
437 availsToNameSet :: [AvailInfo] -> NameSet
438 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
440 availName :: AvailInfo -> Name
441 availName (Avail n) = n
442 availName (AvailTC n _) = n
444 availNames :: AvailInfo -> [Name]
445 availNames NotAvailable = []
446 availNames (Avail n) = [n]
447 availNames (AvailTC n ns) = ns
449 -- availEntityNames is used to extract the names that can appear on their own in
450 -- an export or import list. For class decls, class methods can appear on their
451 -- own, thus import A( op )
452 -- but constructors cannot; thus
454 -- means import type T from B, not constructor T.
456 availEntityNames :: AvailInfo -> [Name]
457 availEntityNames NotAvailable = []
458 availEntityNames (Avail n) = [n]
459 availEntityNames (AvailTC n ns) = n : filter (isVarOcc . nameOccName) ns
461 filterAvail :: RdrNameIE -- Wanted
462 -> AvailInfo -- Available
463 -> AvailInfo -- Resulting available;
464 -- NotAvailable if wanted stuff isn't there
466 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
467 | sub_names_ok = AvailTC n (filter is_wanted ns)
468 | otherwise = pprTrace "filterAvail" (hsep [ppr PprDebug ie, pprAvail PprDebug avail]) $
471 is_wanted name = nameOccName name `elem` wanted_occs
472 sub_names_ok = all (`elem` avail_occs) wanted_occs
473 avail_occs = map nameOccName ns
474 wanted_occs = map rdrNameOcc (want:wants)
476 filterAvail (IEThingAbs _) (AvailTC n ns)
477 | n `elem` ns = AvailTC n [n]
479 filterAvail (IEThingAbs _) avail@(Avail n) = avail -- Type synonyms
481 filterAvail (IEVar _) avail@(Avail n) = avail
482 filterAvail (IEVar v) avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
484 wanted n = nameOccName n == occ
486 -- The second equation happens if we import a class op, thus
488 -- where op is a class operation
490 filterAvail (IEThingAll _) avail@(AvailTC _ _) = avail
492 filterAvail ie avail = NotAvailable
495 -- In interfaces, pprAvail gets given the OccName of the "host" thing
496 pprAvail PprInterface avail = ppr_avail (pprOccName PprInterface . nameOccName) avail
497 pprAvail sty avail = ppr_avail (ppr sty) avail
499 ppr_avail pp_name NotAvailable = ptext SLIT("NotAvailable")
500 ppr_avail pp_name (AvailTC n ns) = hsep [
502 parens $ hsep $ punctuate comma $
505 ppr_avail pp_name (Avail n) = pp_name n
511 %************************************************************************
513 \subsection{Finite map utilities}
515 %************************************************************************
518 Generally useful function on finite maps to check for overlap.
522 => (b->b->Bool) -- False <=> no conflict; you can pick either
523 -> FiniteMap a b -> FiniteMap a b
525 conflictsFM bad fm1 fm2
526 = filter (\(a,(b1,b2)) -> bad b1 b2)
527 (fmToList (intersectFM_C (\b1 b2 -> (b1,b2)) fm1 fm2))
531 -> FiniteMap a b -> a -> b
533 conflictFM bad fm key elt
534 = case lookupFM fm key of
535 Just elt' | bad elt elt' -> [(key,(elt,elt'))]
540 %************************************************************************
542 \subsection{Envt utility functions}
544 %************************************************************************
548 nameClashErr (rdr_name, (name1,name2)) sty
549 = hang (hsep [ptext SLIT("Conflicting definitions for:"), ppr sty rdr_name])
550 4 (vcat [pprNameProvenance sty name1,
551 pprNameProvenance sty name2])
553 fixityClashErr (rdr_name, (fp1,fp2)) sty
554 = hang (hsep [ptext SLIT("Conflicting fixities for:"), ppr sty rdr_name])
555 4 (vcat [pprFixityProvenance sty fp1,
556 pprFixityProvenance sty fp2])
558 shadowedNameWarn shadow sty
559 = hcat [ptext SLIT("This binding for"),
561 ptext SLIT("shadows an existing binding")]
563 unknownNameErr name sty
564 = sep [text flavour, ptext SLIT("not in scope:"), ppr sty name]
566 flavour = occNameFlavour (rdrNameOcc name)
568 qualNameErr descriptor (name,loc)
570 addErrRn (\sty -> hsep [ ptext SLIT("Invalid use of qualified name"),
575 dupNamesErr descriptor ((name,loc) : dup_things)
577 addErrRn (\sty -> hsep [ptext SLIT("Conflicting definitions for"),
579 ptext SLIT("in"), descriptor sty])