- rdr_mod = rdrNameModule rdr_name
-
-newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
-newGlobalName mod occ loc
- = -- First check the cache
- getNameCache `thenM` \ name_supply ->
- case lookupOrigNameCache (nsNames name_supply) mod occ of
-
- -- A hit in the cache! We are at the binding site of the name.
- -- This is the moment when we know the defining SrcLoc
- -- of the Name, so we set the SrcLoc of the name we return.
- --
- -- Main reason: then (bogus) multiple bindings of the same Name
- -- get different SrcLocs can can be reported as such.
- --
- -- Possible other reason: it might be in the cache because we
- -- encountered an occurrence before the binding site for an
- -- implicitly-imported Name. Perhaps the current SrcLoc is
- -- better... but not really: it'll still just say 'imported'
- --
- -- IMPORTANT: Don't mess with wired-in names.
- -- Their wired-in-ness is in the SrcLoc
-
- Just name | isWiredInName name -> returnM name
- | otherwise -> returnM (setNameSrcLoc name loc)
-
- -- Miss in the cache!
- -- Build a completely new Name, and put it in the cache
- Nothing -> addNewName name_supply mod occ loc
-
--- Look up a "system name" in the name cache.
--- This is done by the type checker...
-lookupSysName :: Name -- Base name
- -> (OccName -> OccName) -- Occurrence name modifier
- -> TcRn m Name -- System name
-lookupSysName base_name mk_sys_occ
- = newGlobalName (nameModule base_name)
- (mk_sys_occ (nameOccName base_name))
- (nameSrcLoc base_name)
-
-
-newGlobalNameFromRdrName rdr_name -- Qualified original name
- = newGlobalName2 (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
-
-newGlobalName2 :: ModuleName -> OccName -> TcRn m Name
- -- This one starts with a ModuleName, not a Module, because
- -- we may be simply looking at an occurrence M.x in an interface file.
- --
- -- Used for *occurrences*. Even if we get a miss in the
- -- original-name cache, we make a new External Name.
- -- We get its Module either from the OrigNameCache, or (if this
- -- is the first Name from that module) from the Finder
- --
- -- In the case of a miss, we have to make up the SrcLoc, but that's
- -- OK: it must be an implicitly-imported Name, and that never occurs
- -- in an error message.
-
-newGlobalName2 mod_name occ
- = getNameCache `thenM` \ name_supply ->
- let
- new_name mod = addNewName name_supply mod occ importedSrcLoc
- in
- case lookupModuleEnvByName (nsNames name_supply) mod_name of
- Just (mod, occ_env) ->
- -- There are some names from this module already
- -- Next, look up in the OccNameEnv
- case lookupFM occ_env occ of
- Just name -> returnM name
- Nothing -> new_name mod
-
- Nothing -> -- No names from this module yet
- ioToTcRn (findModule mod_name) `thenM` \ mb_loc ->
- case mb_loc of
- Right (mod, _) -> new_name mod
- Left files ->
- getDOpts `thenM` \ dflags ->
- addErr (noIfaceErr dflags mod_name False files) `thenM_`
- -- Things have really gone wrong at this point,
- -- so having the wrong package info in the
- -- Module is the least of our worries.
- new_name (mkHomeModule mod_name)
-
-
-newIPName rdr_name_ip
- = getNameCache `thenM` \ name_supply ->
- let
- ipcache = nsIPs name_supply
- in
- case lookupFM ipcache key of
- Just name_ip -> returnM name_ip
- Nothing -> setNameCache new_ns `thenM_`
- returnM name_ip
- where
- (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)