Let 'loadModule' generate proper code depending on the 'hscTarget'.

With this change it should be possible to perform something similar to
'load' by traversing the module graph in dependency order and calling
'{parse,typecheck,load}Module' on each.  Of course, if you want smart
recompilation checking you should still use 'load'.

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index c4c49be..5253a2a 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -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)

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index df415b6..3f72101 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1100,17 +1100,21 @@ loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
 loadModule tcm = do
    let ms = modSummary tcm
    let mod = ms_mod_name ms
-   let (tcg, details) = tm_internals tcm
+   let (tcg, _details) = tm_internals tcm
    hpt_new <-
        withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
-         (iface, _) <- makeSimpleIface Nothing tcg details
-         let mod_info = HomeModInfo {
-                          hm_iface = iface,
-                          hm_details = details,
-                          hm_linkable = Just (LM (ms_hs_date ms)
-                                                 (ms_mod ms)
-                                                 []) }
+
+         let compilerBackend comp env ms' _ _mb_old_iface _ =
+               withTempSession (\_ -> env) $
+                 hscBackend comp tcg ms'
+                            Nothing
          hsc_env <- getSession
+         mod_info
+             <- compile' (compilerBackend hscNothingCompiler
+                         ,compilerBackend hscInteractiveCompiler
+                         ,compilerBackend hscBatchCompiler)
+                         hsc_env ms 1 1 Nothing Nothing
+         -- compile' shouldn't change the environment
          return $ addToUFM (hsc_HPT hsc_env) mod mod_info
    modifySession $ \e -> e{ hsc_HPT = hpt_new }
    return tcm