X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=8a0b4f4826782aa5fffe5fb9b015690864ff3376;hb=a6f29db07ac47b8a924a65c7e07ce73bc491d0e5;hp=88de1ca8fd4b938a91b2281ba59e9233d702b458;hpb=5cc715b218c2da096055a38a453054cbe0b676c0;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 88de1ca..8a0b4f4 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -31,7 +31,6 @@ import ErrUtils import SrcLoc import NameEnv import NameSet -import OccName import Bag import Outputable import UniqSupply @@ -45,6 +44,7 @@ import Util import System.IO import Data.IORef +import qualified Data.Set as Set import Control.Monad \end{code} @@ -72,8 +72,9 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tvs_var <- newIORef emptyVarSet ; dfuns_var <- newIORef emptyNameSet ; keep_var <- newIORef emptyNameSet ; + used_rdrnames_var <- newIORef Set.empty ; th_var <- newIORef False ; - dfun_n_var <- newIORef 1 ; + dfun_n_var <- newIORef emptyOccSet ; type_env_var <- case hsc_type_env_var hsc_env of { Just (_mod, te_var) -> return te_var ; Nothing -> newIORef emptyNameEnv } ; @@ -97,9 +98,10 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tcg_th_used = th_var, tcg_exports = [], tcg_imports = emptyImportAvails, + tcg_used_rdrnames = used_rdrnames_var, tcg_dus = emptyDUs, - tcg_rn_imports = maybe_rn_syntax [], + tcg_rn_imports = [], tcg_rn_exports = maybe_rn_syntax [], tcg_rn_decls = maybe_rn_syntax emptyRnGroup, @@ -834,12 +836,15 @@ debugTc thing %************************************************************************ \begin{code} -nextDFunIndex :: TcM Int -- Get the next dfun index -nextDFunIndex = do { env <- getGblEnv - ; let dfun_n_var = tcg_dfun_n env - ; n <- readMutVar dfun_n_var - ; writeMutVar dfun_n_var (n+1) - ; return n } +chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName +chooseUniqueOccTc fn = + do { env <- getGblEnv + ; let dfun_n_var = tcg_dfun_n env + ; set <- readMutVar dfun_n_var + ; let occ = fn set + ; writeMutVar dfun_n_var (extendOccSet set occ) + ; return occ + } getLIEVar :: TcM (TcRef LIE) getLIEVar = do { env <- getLclEnv; return (tcl_lie env) }