- -- 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