- (us', us1) = splitUniqSupply us
- uniq = uniqFromSupply us1
- mod = mkVanillaModule mod_name
- name = mkGlobalName uniq mod occ implicitImportProvenance
- new_cache = addToFM cache key name
-
-updateProvenances :: [Name] -> RnM d ()
--- Update the provenances of everything that is in scope.
--- We must be careful not to disturb the Module package info
--- already in the cache. Why not? Consider
--- module A module M( f )
--- import M( f ) import N( f)
--- import N
--- So f is defined in N, and M re-exports it.
--- When processing module A:
--- 1. We read M.hi first, and make a vanilla name N.f
--- (without reading N.hi). The package info says <THIS>
--- for lack of anything better.
--- 2. Now we read N, which update the cache to record
--- the correct package for N.f.
--- 3. Finally we update provenances (once we've read all imports).
--- Step 3 must not destroy package info recorded in Step 2.
-
-updateProvenances names
- = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
- setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
+ (us', us1) = splitUniqSupply (nsUniqs name_supply)
+ uniq = uniqFromSupply us1
+ name_ip = mapIPName mk_name rdr_name_ip
+ mk_name rdr_name = mkIPName uniq (rdrNameOcc rdr_name)
+ new_ipcache = addToFM ipcache key name_ip
+ new_ns = name_supply {nsUniqs = us', nsIPs = new_ipcache}
+ where
+ key = rdr_name_ip -- Ensures that ?x and %x get distinct Names
+
+-- A local helper function
+addNewName name_supply mod occ loc
+ = setNameCache new_name_supply `thenM_`
+ returnM name
+ where
+ (new_name_supply, name) = newExternalName name_supply mod occ loc
+
+
+newExternalName :: NameCache -> Module -> OccName -> SrcLoc
+ -> (NameCache,Name)
+-- Allocate a new unique, manufacture a new External Name,
+-- put it in the cache, and return the two
+newExternalName name_supply mod occ loc
+ = (new_name_supply, name)
+ where
+ (us', us1) = splitUniqSupply (nsUniqs name_supply)
+ uniq = uniqFromSupply us1
+ name = mkExternalName uniq mod occ loc
+ new_cache = extend_name_cache (nsNames name_supply) mod occ name
+ new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
+
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+ = case lookupModuleEnv nc mod of
+ Nothing -> Nothing
+ Just (_, occ_env) -> lookupFM occ_env occ
+
+extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache nc name
+ = extend_name_cache nc (nameModule name) (nameOccName name) name
+
+extend_name_cache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extend_name_cache nc mod occ name
+ = extendModuleEnv_C combine nc mod (mod, unitFM occ name)
+ where
+ combine (mod, occ_env) _ = (mod, addToFM occ_env occ name)
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Looking up names}
+%* *
+%*********************************************************
+
+Looking up a name in the RnEnv.
+
+\begin{code}
+lookupBndrRn rdr_name
+ = getLocalRdrEnv `thenM` \ local_env ->
+ case lookupRdrEnv local_env rdr_name of
+ Just name -> returnM name
+ Nothing -> lookupTopBndrRn rdr_name
+
+lookupTopBndrRn rdr_name
+-- Look up a top-level local binder. We may be looking up an unqualified 'f',
+-- and there may be several imported 'f's too, which must not confuse us.
+-- So we have to filter out the non-local ones.
+-- A separate function (importsFromLocalDecls) reports duplicate top level
+-- decls, so here it's safe just to choose an arbitrary one.
+
+-- There should never be a qualified name in a binding position in Haskell,
+-- but there can be if we have read in an external-Core file.
+-- The Haskell parser checks for the illegal qualified name in Haskell
+-- source files, so we don't need to do so here.
+
+ = getModeRn `thenM` \ mode ->
+ case mode of
+ InterfaceMode mod ->
+ getSrcLocM `thenM` \ loc ->
+ newTopBinder mod rdr_name loc
+
+ other -> lookupTopSrcBndr rdr_name
+
+lookupTopSrcBndr :: RdrName -> TcRn m Name
+lookupTopSrcBndr rdr_name
+ = lookupTopSrcBndr_maybe rdr_name `thenM` \ maybe_name ->
+ case maybe_name of
+ Just name -> returnM name
+ Nothing -> unboundName rdr_name
+
+
+lookupTopSrcBndr_maybe :: RdrName -> TcRn m (Maybe Name)
+-- Look up a source-code binder
+
+-- Ignores imported names; for example, this is OK:
+-- import Foo( f )
+-- infix 9 f -- The 'f' here does not need to be qualified
+-- f x = x -- Nor here, of course
+
+lookupTopSrcBndr_maybe rdr_name
+ | Just name <- isExact_maybe rdr_name
+ -- This is here just to catch the PrelBase defn of (say) [] and similar
+ -- The parser reads the special syntax and returns an Exact RdrName
+ -- But the global_env contains only Qual RdrNames, so we won't
+ -- find it there; instead just get the name via the Orig route
+ --
+ -- We are at a binding site for the name, so check first that it
+ -- the current module is the correct one; otherwise GHC can get
+ -- very confused indeed. This test rejects code like
+ -- data T = (,) Int Int
+ -- unless we are in GHC.Tup
+ = getModule `thenM` \ mod ->
+ checkErr (moduleName mod == moduleName (nameModule name))
+ (badOrigBinding rdr_name) `thenM_`
+ returnM (Just name)
+
+ | otherwise
+ = getGlobalRdrEnv `thenM` \ global_env ->
+ case lookupRdrEnv global_env rdr_name of
+ Nothing -> returnM Nothing
+ Just gres -> case [gre_name gre | gre <- gres, isLocalGRE gre] of
+ [] -> returnM Nothing
+ (n:ns) -> returnM (Just n)
+
+
+-- lookupSigOccRn is used for type signatures and pragmas
+-- Is this valid?
+-- module A
+-- import M( f )
+-- f :: Int -> Int
+-- f x = x
+-- It's clear that the 'f' in the signature must refer to A.f
+-- The Haskell98 report does not stipulate this, but it will!
+-- So we must treat the 'f' in the signature in the same way
+-- as the binding occurrence of 'f', using lookupBndrRn
+lookupSigOccRn :: RdrName -> RnM Name
+lookupSigOccRn = lookupBndrRn
+
+-- lookupInstDeclBndr is used for the binders in an
+-- instance declaration. Here we use the class name to
+-- disambiguate.
+
+lookupInstDeclBndr :: Name -> RdrName -> RnM Name
+ -- We use the selector name as the binder
+lookupInstDeclBndr cls_name rdr_name
+ | isUnqual rdr_name
+ = -- Find all the things the class op name maps to
+ -- and pick the one with the right parent name
+ getGblEnv `thenM` \ gbl_env ->
+ let
+ avail_env = imp_env (tcg_imports gbl_env)
+ in
+ case lookupAvailEnv avail_env cls_name of
+ Nothing ->
+ -- If the class itself isn't in scope, then cls_name will
+ -- be unboundName, and there'll already be an error for
+ -- that in the error list. Example:
+ -- e.g. import Prelude hiding( Ord )
+ -- instance Ord T where ...
+ -- The program is wrong, but that should not cause a crash.
+ returnM (mkUnboundName rdr_name)
+
+ Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
+ (n:ns)-> ASSERT( null ns ) returnM n
+ [] -> unboundName rdr_name
+
+ other -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
+
+
+ | otherwise -- Occurs in derived instances, where we just
+ -- refer directly to the right method, and avail_env
+ -- isn't available
+ = ASSERT2( not (isQual rdr_name), ppr rdr_name )
+ -- NB: qualified names are rejected by the parser
+ lookupOrigName rdr_name
+