[project @ 2003-04-10 15:46:11 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnMonad.lhs
index 51cd7bc..927f7e2 100644 (file)
@@ -116,7 +116,8 @@ initTc  (HscEnv { hsc_mode   = ghci_mode,
        usg_var  <- newIORef emptyUsages ;
        nc_var   <- newIORef (pcs_nc pcs) ;
        eps_var  <- newIORef eps ;
-   
+       ie_var   <- newIORef (mkImpInstEnv dflags eps hpt) ;
+
        let {
             env = Env { env_top = top_env,
                         env_gbl = gbl_env,
@@ -139,8 +140,7 @@ initTc  (HscEnv { hsc_mode   = ghci_mode,
                tcg_fix_env  = emptyFixityEnv,
                tcg_default  = defaultDefaultTys,
                tcg_type_env = emptyNameEnv,
-               tcg_ist      = mkImpTypeEnv eps hpt,
-               tcg_inst_env = mkImpInstEnv dflags eps hpt,
+               tcg_inst_env = ie_var,
                tcg_exports  = [],
                tcg_imports  = init_imports,
                tcg_binds    = EmptyMonoBinds,
@@ -246,6 +246,12 @@ updLclEnv upd = updEnv (\ env@(Env { env_lcl = lcl }) ->
 
 setLclEnv :: m -> TcRn m a -> TcRn n a
 setLclEnv lcl_env = updEnv (\ env -> env { env_lcl = lcl_env })
+
+getEnvs :: TcRn m (TcGblEnv, m)
+getEnvs = do { env <- getEnv; return (env_gbl env, env_lcl env) }
+
+setEnvs :: (TcGblEnv, m) -> TcRn m a -> TcRn m a
+setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl = lcl_env })
 \end{code}
 
 Command-line flags
@@ -476,6 +482,7 @@ forkM :: SDoc -> TcM a -> TcM (Maybe a)
 -- Run thing_inside in an interleaved thread.  It gets a separate
 --     * errs_var, and
 --     * unique supply, 
+--     * LIE var is set to bottom (should never be used)
 -- but everything else is shared, so this is DANGEROUS.  
 --
 -- It returns Nothing if the computation fails
@@ -487,7 +494,8 @@ forkM doc thing_inside
  = do {        us <- newUniqueSupply ;
        unsafeInterleaveM $
        do { us_var <- newMutVar us ;
-            (msgs, mb_res) <- tryTcLIE (setUsVar us_var thing_inside) ;
+            (msgs, mb_res) <- tryTc (setLIEVar (panic "forkM: LIE used") $
+                                     setUsVar us_var thing_inside) ;
             case mb_res of
                Just r  -> return (Just r) 
                Nothing -> do {