- -- It also means that if there are two defns for the same thing
- -- in a module, then each gets a separate SrcLoc
- Just name -> let
- new_name = setNameProvenance name (mk_prov new_name)
- new_cache = addToFM cache key new_name
- in
- setNameSupplyRn (us, inst_ns, new_cache) `thenRn_`
- returnRn new_name
-
- -- Miss in the cache!
- -- Build a new original name, and put it in the cache
- Nothing -> let
- (us', us1) = splitUniqSupply us
- uniq = uniqFromSupply us1
- new_name = mkGlobalName uniq mod occ (mk_prov new_name)
- new_cache = addToFM cache key new_name
- in
- setNameSupplyRn (us', inst_ns, new_cache) `thenRn_`
- returnRn new_name
-
-
-newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
-newLocalNames rdr_names
- = getNameSupplyRn `thenRn` \ (us, inst_ns, cache) ->
- let
- n = length rdr_names
- (us', us1) = splitUniqSupply us
- uniqs = uniqsFromSupply n us1
- locals = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
- | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
- ]
- in
- setNameSupplyRn (us', inst_ns, cache) `thenRn_`
- returnRn locals
-
-newDFunName cl_occ tycon_occ (Just n) src_loc -- Imported ones have "Just n"
- = newImportedGlobalFromRdrName n
-
-newDFunName cl_occ tycon_occ Nothing src_loc -- Local instance decls have a "Nothing"
- = getModuleRn `thenRn` \ mod_name ->
- newInstUniq (cl_occ, tycon_occ) `thenRn` \ inst_uniq ->
- let
- dfun_occ = mkDFunOcc cl_occ tycon_occ inst_uniq
- in
- newLocallyDefinedGlobalName mod_name dfun_occ (\_ -> Exported) src_loc
-
-
--- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
--- during compiler debugging.
-mkUnboundName :: RdrName -> Name
-mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
-
-isUnboundName :: Name -> Bool
-isUnboundName name = getUnique name == unboundKey
-\end{code}
-
-\begin{code}
--------------------------------------
-bindLocatedLocalsRn :: SDoc -- Documentation string for error message
- -> [(RdrName,SrcLoc)]
- -> ([Name] -> RnMS s a)
- -> RnMS s a
-bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
- = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
-
- getLocalNameEnv `thenRn` \ name_env ->
- (if opt_WarnNameShadowing
- then
- mapRn (check_shadow name_env) rdr_names_w_loc
- else
- returnRn []
- ) `thenRn_`
-
- newLocalNames rdr_names_w_loc `thenRn` \ names ->
- let
- new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
- in
- setLocalNameEnv new_name_env (enclosed_scope names)
- where
- check_shadow name_env (rdr_name,loc)
- = case lookupRdrEnv name_env rdr_name of
- Nothing -> returnRn ()
- Just name -> pushSrcLocRn loc $
- addWarnRn (shadowedNameWarn rdr_name)
-
-
--------------------------------------
-bindLocalsRn doc_str rdr_names enclosed_scope
- = getSrcLocRn `thenRn` \ loc ->
- bindLocatedLocalsRn (text doc_str)
- (rdr_names `zip` repeat loc)
- enclosed_scope
-
- -- binLocalsFVRn is the same as bindLocalsRn
- -- except that it deals with free vars
-bindLocalsFVRn doc_str rdr_names enclosed_scope
- = bindLocalsRn doc_str rdr_names $ \ names ->
- enclosed_scope names `thenRn` \ (thing, fvs) ->
- returnRn (thing, delListFromNameSet fvs names)
-
--------------------------------------
-extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS s (a, FreeVars) -> RnMS s (a, FreeVars)
- -- This tiresome function is used only in rnDecl on InstDecl
-extendTyVarEnvFVRn tyvars enclosed_scope
- = getLocalNameEnv `thenRn` \ env ->
- let
- tyvar_names = map getTyVarName tyvars
- new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name)
- | name <- tyvar_names
- ]
- in
- setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) ->
- returnRn (thing, delListFromNameSet fvs tyvar_names)
-
-bindTyVarsRn :: SDoc -> [HsTyVar RdrName]
- -> ([HsTyVar Name] -> RnMS s a)
- -> RnMS s a
-bindTyVarsRn doc_str tyvar_names enclosed_scope
- = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars ->
- enclosed_scope tyvars
-
--- Gruesome name: return Names as well as HsTyVars
-bindTyVars2Rn :: SDoc -> [HsTyVar RdrName]
- -> ([Name] -> [HsTyVar Name] -> RnMS s a)
- -> RnMS s a
-bindTyVars2Rn doc_str tyvar_names enclosed_scope
- = getSrcLocRn `thenRn` \ loc ->
- let
- located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
- in
- bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
- enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
-
-bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName]
- -> ([HsTyVar Name] -> RnMS s (a, FreeVars))
- -> RnMS s (a, FreeVars)
-bindTyVarsFVRn doc_str rdr_names enclosed_scope
- = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
- enclosed_scope tyvars `thenRn` \ (thing, fvs) ->
- returnRn (thing, delListFromNameSet fvs names)