- getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
- let
- n = length rdr_names_w_loc
- (us', us1) = splitUniqSupply us
- uniqs = uniqsFromSupply n us1
- names = [ mk_name uniq (rdrNameOcc rdr_name) loc
- | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
- ]
- mk_name = case mode of
- SourceMode -> mkLocalName
- InterfaceMode -> mkImportedLocalName
- -- Keep track of whether the name originally came from
- -- an interface file.
- in
- setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
-
- 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)
-
-bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
- -> RnMS (a, FreeVars)
- -- A specialised variant when renaming stuff from interface
- -- files (of which there is a lot)
- -- * one at a time
- -- * no checks for shadowing
- -- * always imported
- -- * deal with free vars
-bindCoreLocalFVRn rdr_name enclosed_scope
- = getSrcLocRn `thenRn` \ loc ->
- getLocalNameEnv `thenRn` \ name_env ->
- getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
- let
- (us', us1) = splitUniqSupply us
- uniq = uniqFromSupply us1
- name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
- in
- setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_`
- let
- new_name_env = extendRdrEnv name_env rdr_name name
- in
- setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) ->
- returnRn (result, delFromNameSet fvs name)
-
-bindCoreLocalsFVRn [] thing_inside = thing_inside []
-bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' ->
- bindCoreLocalsFVRn bs $ \ names' ->
- thing_inside (name':names')
-
--------------------------------------
-bindLocalRn doc rdr_name enclosed_scope
- = getSrcLocRn `thenRn` \ loc ->
- bindLocatedLocalsRn doc [(rdr_name,loc)] $ \ (n:ns) ->
- ASSERT( null ns )
- enclosed_scope n
-
-bindLocalsRn doc rdr_names enclosed_scope
- = getSrcLocRn `thenRn` \ loc ->
- bindLocatedLocalsRn doc
- (rdr_names `zip` repeat loc)
- enclosed_scope
-
- -- binLocalsFVRn is the same as bindLocalsRn
- -- except that it deals with free vars
-bindLocalsFVRn doc rdr_names enclosed_scope
- = bindLocalsRn doc rdr_names $ \ names ->
- enclosed_scope names `thenRn` \ (thing, fvs) ->
- returnRn (thing, delListFromNameSet fvs names)
-
--------------------------------------
-bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
-bindUVarRn = bindLocalRn
-
--------------------------------------
-extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (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 -> [HsTyVarBndr RdrName]
- -> ([HsTyVarBndr Name] -> RnMS a)
- -> RnMS 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 -> [HsTyVarBndr RdrName]
- -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
- -> RnMS 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 -> [HsTyVarBndr RdrName]
- -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
- -> RnMS (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)
-
-bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
- -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
- -> RnMS (a, FreeVars)
-bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
- = bindTyVars2Rn doc_str rdr_names $ \ names tyvars ->
- enclosed_scope names tyvars `thenRn` \ (thing, fvs) ->
- returnRn (thing, delListFromNameSet fvs names)
-
-
--------------------------------------
-checkDupOrQualNames, checkDupNames :: SDoc
- -> [(RdrName, SrcLoc)]
- -> RnM d ()
- -- Works in any variant of the renamer monad
-
-checkDupOrQualNames doc_str rdr_names_w_loc
- = -- Check for use of qualified names
- mapRn_ (qualNameErr doc_str) quals `thenRn_`
- checkDupNames doc_str rdr_names_w_loc