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