X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=8f7b05c96a4a556a07f509e77acd77b5f078a1f3;hb=5e12e5be4fe676a79669f9a0cb5265e5cd33bebe;hp=c4c49bedd68e40a558f4e0963eecea21f7ebb2f9;hpb=8d48737f404f079a3deec1c00c86aa028a124efb;p=ghc-hetmet.git

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index c4c49be..8f7b05c 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -52,7 +52,7 @@ import MonadUtils
 
 import Data.Either
 import Exception
-import Data.IORef	( readIORef, writeIORef, IORef )
+import Data.IORef	( readIORef )
 import GHC.Exts		( Int(..) )
 import System.Directory
 import System.FilePath
@@ -103,7 +103,26 @@ compile :: GhcMonad m =>
         -> Maybe Linkable  -- ^ old linkable, if we have one
         -> m HomeModInfo   -- ^ the complete HomeModInfo, if successful
 
-compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch)
+
+type Compiler m a = HscEnv -> ModSummary -> Bool
+                  -> Maybe ModIface -> Maybe (Int, Int)
+                  -> m a
+
+compile' :: GhcMonad m =>
+           (Compiler m (HscStatus, ModIface, ModDetails),
+            Compiler m (InteractiveStatus, ModIface, ModDetails),
+            Compiler m (HscStatus, ModIface, ModDetails))
+        -> HscEnv
+        -> ModSummary      -- ^ summary for module being compiled
+        -> Int             -- ^ module N ...
+        -> Int             -- ^ ... of M
+        -> Maybe ModIface  -- ^ old interface, if we have one
+        -> Maybe Linkable  -- ^ old linkable, if we have one
+        -> m HomeModInfo   -- ^ the complete HomeModInfo, if successful
+
+compile' (nothingCompiler, interactiveCompiler, batchCompiler)
+        hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
  = do
    let dflags0     = ms_hspp_opts summary
        this_mod    = ms_mod summary
@@ -211,15 +230,13 @@ compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
                                      hm_linkable = linkable })
    -- run the compiler
    case hsc_lang of
-      HscInterpreted
-        | isHsBoot src_flavour -> 
-                runCompiler hscCompileNothing handleBatch
-        | otherwise -> 
-                runCompiler hscCompileInteractive handleInterpreted
+      HscInterpreted ->
+                runCompiler interactiveCompiler handleInterpreted
       HscNothing -> 
-                runCompiler hscCompileNothing handleBatch
+                runCompiler nothingCompiler handleBatch
       _other -> 
-                runCompiler hscCompileBatch handleBatch
+                runCompiler batchCompiler handleBatch
+
 
 -----------------------------------------------------------------------------
 -- stub .h and .c files (for foreign export support)
@@ -1051,13 +1068,13 @@ runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe
 	-- Save the number of split files for future references
 	s <- readFile n_files_fn
 	let n_files = read s :: Int
-	writeIORef v_Split_info (split_s_prefix, n_files)
+	    dflags' = dflags { splitInfo = Just (split_s_prefix, n_files) }
 
 	-- Remember to delete all these files
-	addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
-			| n <- [1..n_files]]
+	addFilesToClean dflags' [ split_s_prefix ++ "__" ++ show n ++ ".s"
+	                        | n <- [1..n_files]]
 
-	return (SplitAs, dflags, maybe_loc, "**splitmangle**")
+	return (SplitAs, dflags', maybe_loc, "**splitmangle**")
 	  -- we don't use the filename
 
 -----------------------------------------------------------------------------
@@ -1115,7 +1132,9 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc
 
         let as_opts = getOpts dflags opt_a
 
-        (split_s_prefix, n) <- readIORef v_Split_info
+        let (split_s_prefix, n) = case splitInfo dflags of
+                                  Nothing -> panic "No split info"
+                                  Just x -> x
 
         let split_s   n = split_s_prefix ++ "__" ++ show n <.> "s"
             split_obj n = split_odir </>
@@ -1709,5 +1728,3 @@ hscMaybeAdjustTarget dflags stop _ current_hsc_lang
 		-- otherwise, stick to the plan
 		 | otherwise = current_hsc_lang
 
-GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
-	-- The split prefix and number of files