Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fix a bug to do with recursive modules in one-shot mode

The problem was that when loading interface files in checkOldIface, we
were not passing the If monad the mutable variable for use when
looking up entities in the *current* module, with the result that the
knots wouldn't be tied properly, and some instances of TyCons would
be incorrectly abstract.

This bug has subtle effects: for example, recompiling a module without
making any changes might lead to a slightly different result (noticed
due to the new interface-file fingerprints).  The bug doesn't lead to
any direct failures that we're aware of.
  • Loading branch information...
commit d83e1ac43a43dc30c7e4f5b64f7b77e32d31886d 1 parent 0d80489
Simon Marlow authored
15  compiler/main/HscMain.lhs
@@ -136,6 +136,7 @@ newHscEnv dflags
136 136
 			   hsc_FC      = fc_var,
137 137
 			   hsc_MLC     = mlc_var,
138 138
 			   hsc_OptFuel = optFuel,
  139
+                           hsc_type_env_var = Nothing,
139 140
                            hsc_global_rdr_env = emptyGlobalRdrEnv,
140 141
                            hsc_global_type_env = emptyNameEnv } ) }
141 142
 			
@@ -335,7 +336,19 @@ type Compiler result =  HscEnv
335 336
 
336 337
 -- Compile Haskell, boot and extCore in OneShot mode.
337 338
 hscCompileOneShot :: Compiler HscStatus
338  
-hscCompileOneShot
  339
+hscCompileOneShot hsc_env mod_summary src_changed mb_old_iface mb_i_of_n
  340
+  = do
  341
+     -- One-shot mode needs a knot-tying mutable variable for interface files.
  342
+     -- See TcRnTypes.TcGblEnv.tcg_type_env_var.
  343
+    type_env_var <- newIORef emptyNameEnv
  344
+    let 
  345
+       mod = ms_mod mod_summary
  346
+       hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
  347
+    ---
  348
+    hscCompilerOneShot' hsc_env' mod_summary src_changed mb_old_iface mb_i_of_n
  349
+
  350
+hscCompilerOneShot' :: Compiler HscStatus
  351
+hscCompilerOneShot'
339 352
    = hscCompiler norecompOneShot oneShotMsg (genComp backend boot_backend)
340 353
    where
341 354
      backend inp  = hscSimplify inp >>= hscNormalIface >>= hscWriteIface >>= hscOneShot
4  compiler/main/HscTypes.lhs
@@ -206,6 +206,10 @@ data HscEnv
206 206
                 -- by limiting the number of transformations,
207 207
                 -- we can use binary search to help find compiler bugs.
208 208
 
  209
+        hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
  210
+                -- Used for one-shot compilation only, to initialise
  211
+                -- the IfGblEnv.  See TcRnTypes.TcGblEnv.tcg_type_env_var
  212
+
209 213
         hsc_global_rdr_env :: GlobalRdrEnv,
210 214
         hsc_global_type_env :: TypeEnv
211 215
  }
12  compiler/typecheck/TcRnMonad.lhs
@@ -69,11 +69,13 @@ initTc :: HscEnv
69 69
 initTc hsc_env hsc_src keep_rn_syntax mod do_this
70 70
  = do { errs_var     <- newIORef (emptyBag, emptyBag) ;
71 71
       	tvs_var      <- newIORef emptyVarSet ;
72  
-	type_env_var <- newIORef emptyNameEnv ;
73 72
 	dfuns_var    <- newIORef emptyNameSet ;
74 73
 	keep_var     <- newIORef emptyNameSet ;
75 74
 	th_var	     <- newIORef False ;
76 75
 	dfun_n_var   <- newIORef 1 ;
  76
+	type_env_var <- case hsc_type_env_var hsc_env of {
  77
+                           Just (_mod, te_var) -> return te_var ;
  78
+                           Nothing             -> newIORef emptyNameEnv } ;
77 79
       	let {
78 80
 	     maybe_rn_syntax empty_val
79 81
 		| keep_rn_syntax = Just empty_val
@@ -951,9 +953,11 @@ initIfaceCheck :: HscEnv -> IfG a -> IO a
951 953
 -- Used when checking the up-to-date-ness of the old Iface
952 954
 -- Initialise the environment with no useful info at all
953 955
 initIfaceCheck hsc_env do_this
954  
- = do	{ let gbl_env = IfGblEnv { if_rec_types = Nothing }
955  
-	; initTcRnIf 'i' hsc_env gbl_env () do_this
956  
-    }
  956
+ = do let rec_types = case hsc_type_env_var hsc_env of
  957
+                         Just (mod,var) -> Just (mod, readMutVar var)
  958
+                         Nothing        -> Nothing
  959
+          gbl_env = IfGblEnv { if_rec_types = rec_types }
  960
+      initTcRnIf 'i' hsc_env gbl_env () do_this
957 961
 
958 962
 initIfaceTc :: ModIface 
959 963
  	    -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a

0 notes on commit d83e1ac

Please sign in to comment.
Something went wrong with that request. Please try again.