[project @ 2005-05-05 10:52:43 by ross]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnMonad.lhs

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 6ff9043..306a71b 100644 (file)
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -77,6 +77,7 @@ initTc hsc_env hsc_src mod do_this
        dfuns_var    <- newIORef emptyNameSet ;
        keep_var     <- newIORef emptyNameSet ;
        th_var       <- newIORef False ;
+       dfun_n_var   <- newIORef 1 ;
 
        let {
             gbl_env = TcGblEnv {
@@ -93,11 +94,13 @@ initTc hsc_env hsc_src mod do_this
                tcg_exports  = emptyNameSet,
                tcg_imports  = init_imports,
                tcg_dus      = emptyDUs,
+               tcg_rn_decls = Nothing,
                tcg_binds    = emptyLHsBinds,
                tcg_deprecs  = NoDeprecs,
                tcg_insts    = [],
                tcg_rules    = [],
                tcg_fords    = [],
+               tcg_dfun_n   = dfun_n_var,
                tcg_keep     = keep_var
             } ;
             lcl_env = TcLclEnv {
@@ -106,6 +109,7 @@ initTc hsc_env hsc_src mod do_this
                tcl_ctxt       = [],
                tcl_rdr        = emptyLocalRdrEnv,
                tcl_th_ctxt    = topStage,
+               tcl_arrow_ctxt = NoArrowCtxt,
                tcl_env        = emptyNameEnv,
                tcl_tyvars     = tvs_var,
                tcl_lie        = panic "initTc:LIE",    -- LIE only valid inside a getLIE
@@ -713,6 +717,13 @@ debugTc thing = return ()
 %************************************************************************
 
 \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 }
+
 getLIEVar :: TcM (TcRef LIE)
 getLIEVar = do { env <- getLclEnv; return (tcl_lie env) }
 
@@ -836,16 +847,16 @@ initIfaceCheck hsc_env do_this
        ; initTcRnIf 'i' hsc_env gbl_env () do_this
     }
 
-initIfaceTc :: HscEnv -> ModIface 
-           -> (TcRef TypeEnv -> IfL a) -> IO a
+initIfaceTc :: ModIface 
+           -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a
 -- Used when type-checking checking an up-to-date interface file
 -- No type envt from the current module, but we do know the module dependencies
-initIfaceTc hsc_env iface do_this
- = do  { tc_env_var <- newIORef emptyTypeEnv
+initIfaceTc iface do_this
+ = do  { tc_env_var <- newMutVar emptyTypeEnv
        ; let { gbl_env = IfGblEnv { if_rec_types = Just (mod, readMutVar tc_env_var) } ;
              ; if_lenv = mkIfLclEnv mod doc
           }
-       ; initTcRnIf 'i' hsc_env gbl_env if_lenv (do_this tc_env_var)
+       ; setEnvs (gbl_env, if_lenv) (do_this tc_env_var)
     }
   where
     mod = mi_module iface