-\begin{code}
--------------------------------------
-bindLocatedLocalsRn :: SDoc -- Documentation string for error message
- -> [(RdrName,SrcLoc)]
- -> ([Name] -> RnMS a)
- -> RnMS 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_`
-
- getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
- getModeRn `thenRn` \ mode ->
- 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 :: [HsTyVar 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)