diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 3f0b455ce23ff52480dc12b7ef0f829cf61c8871..604f7a7abc24c419041aa16dec83b53f613c2d23 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -136,6 +136,7 @@ newHscEnv dflags
 			   hsc_FC      = fc_var,
 			   hsc_MLC     = mlc_var,
 			   hsc_OptFuel = optFuel,
+                           hsc_type_env_var = Nothing,
                            hsc_global_rdr_env = emptyGlobalRdrEnv,
                            hsc_global_type_env = emptyNameEnv } ) }
 			
@@ -335,7 +336,19 @@ type Compiler result =  HscEnv
 
 -- Compile Haskell, boot and extCore in OneShot mode.
 hscCompileOneShot :: Compiler HscStatus
-hscCompileOneShot
+hscCompileOneShot hsc_env mod_summary src_changed mb_old_iface mb_i_of_n
+  = do
+     -- One-shot mode needs a knot-tying mutable variable for interface files.
+     -- See TcRnTypes.TcGblEnv.tcg_type_env_var.
+    type_env_var <- newIORef emptyNameEnv
+    let 
+       mod = ms_mod mod_summary
+       hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
+    ---
+    hscCompilerOneShot' hsc_env' mod_summary src_changed mb_old_iface mb_i_of_n
+
+hscCompilerOneShot' :: Compiler HscStatus
+hscCompilerOneShot'
    = hscCompiler norecompOneShot oneShotMsg (genComp backend boot_backend)
    where
      backend inp  = hscSimplify inp >>= hscNormalIface >>= hscWriteIface >>= hscOneShot
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index c9ea1f7c4fe3f62ef1498db3a4c59f784ad17f55..244b312127b36624ba7f01ea43496e73324c9e35 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -206,6 +206,10 @@ data HscEnv
                 -- by limiting the number of transformations,
                 -- we can use binary search to help find compiler bugs.
 
+        hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
+                -- Used for one-shot compilation only, to initialise
+                -- the IfGblEnv.  See TcRnTypes.TcGblEnv.tcg_type_env_var
+
         hsc_global_rdr_env :: GlobalRdrEnv,
         hsc_global_type_env :: TypeEnv
  }
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index f0dd1f4b639bd90abff60bc4e2f29c880aa3f0f4..804098a8854c7e1849ec1ccf7e7b601d54fb148a 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -69,11 +69,13 @@ initTc :: HscEnv
 initTc hsc_env hsc_src keep_rn_syntax mod do_this
  = do { errs_var     <- newIORef (emptyBag, emptyBag) ;
       	tvs_var      <- newIORef emptyVarSet ;
-	type_env_var <- newIORef emptyNameEnv ;
 	dfuns_var    <- newIORef emptyNameSet ;
 	keep_var     <- newIORef emptyNameSet ;
 	th_var	     <- newIORef False ;
 	dfun_n_var   <- newIORef 1 ;
+	type_env_var <- case hsc_type_env_var hsc_env of {
+                           Just (_mod, te_var) -> return te_var ;
+                           Nothing             -> newIORef emptyNameEnv } ;
       	let {
 	     maybe_rn_syntax empty_val
 		| keep_rn_syntax = Just empty_val
@@ -951,9 +953,11 @@ initIfaceCheck :: HscEnv -> IfG a -> IO a
 -- Used when checking the up-to-date-ness of the old Iface
 -- Initialise the environment with no useful info at all
 initIfaceCheck hsc_env do_this
- = do	{ let gbl_env = IfGblEnv { if_rec_types = Nothing }
-	; initTcRnIf 'i' hsc_env gbl_env () do_this
-    }
+ = do let rec_types = case hsc_type_env_var hsc_env of
+                         Just (mod,var) -> Just (mod, readMutVar var)
+                         Nothing        -> Nothing
+          gbl_env = IfGblEnv { if_rec_types = rec_types }
+      initTcRnIf 'i' hsc_env gbl_env () do_this
 
 initIfaceTc :: ModIface 
  	    -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a