X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=c4bdf9602b9becaac9ed4f719a0367a37de6290d;hb=03b53752e99e09edea7d20533019e0ed885e3a23;hp=df415b6e60d6d38be01dd72b60c1753c18adb915;hpb=9a4607c35c107bca78f08f7e57896044c66118be;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index df415b6..c4bdf96 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -43,7 +43,8 @@ module GHC (
 
 	-- * Loading\/compiling the program
 	depanal,
-	load, loadWithLogger, LoadHowMuch(..), SuccessFlag(..),	-- also does depanal
+	load, loadWithLogger, LoadHowMuch(..),
+	SuccessFlag(..), succeeded, failed,
         defaultWarnErrLogger, WarnErrLogger,
 	workingDirectoryChanged,
         parseModule, typecheckModule, desugarModule, loadModule,
@@ -1100,17 +1101,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
@@ -1329,7 +1334,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 	scc_mods = map ms_mod_name scc
 	home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
 
-        scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
+        scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
 	    -- all imports outside the current SCC, but in the home pkg
 	
 	stable_obj_imps = map (`elem` stable_obj) scc_allimps
@@ -1366,9 +1371,6 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 			linkableTime l >= ms_hs_date ms
 		_other  -> False
 
-ms_allimps :: ModSummary -> [ModuleName]
-ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
-
 -- -----------------------------------------------------------------------------
 
 -- | Prune the HomePackageTable
@@ -1812,8 +1814,8 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
             | (s, key) <- numbered_summaries
              -- Drop the hi-boot ones if told to do so
             , not (isBootSummary s && drop_hs_boot_nodes)
-            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
-                             out_edge_keys HsSrcFile   (map unLoc (ms_imps s)) ++
+            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
+                             out_edge_keys HsSrcFile   (map unLoc (ms_home_imps s)) ++
                              (-- see [boot-edges] below
                               if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile 
                               then [] 
@@ -1860,8 +1862,8 @@ warnUnnecessarySourceImports sccs =
   logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
   where check ms =
 	   let mods_in_this_cycle = map ms_mod_name ms in
-	   [ warn i | m <- ms, i <- ms_srcimps m,
-			unLoc i `notElem`  mods_in_this_cycle ]
+	   [ warn i | m <- ms, i <- ms_home_srcimps m,
+	              unLoc i `notElem`  mods_in_this_cycle ]
 
 	warn :: Located ModuleName -> WarnMsg
 	warn (L loc mod) = 
@@ -1983,8 +1985,20 @@ msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
 -- Remember, this pass isn't doing the topological sort.  It's
 -- just gathering the list of all relevant ModSummaries
 msDeps s = 
-    concat [ [(m,True), (m,False)] | m <- ms_srcimps s ] 
-	 ++ [ (m,False) | m <- ms_imps s ] 
+    concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ] 
+	 ++ [ (m,False) | m <- ms_home_imps s ] 
+
+home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
+home_imps imps = [ ideclName i |  L _ i <- imps, isNothing (ideclPkgQual i) ]
+
+ms_home_allimps :: ModSummary -> [ModuleName]
+ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
+
+ms_home_srcimps :: ModSummary -> [Located ModuleName]
+ms_home_srcimps = home_imps . ms_srcimps
+
+ms_home_imps :: ModSummary -> [Located ModuleName]
+ms_home_imps = home_imps . ms_imps
 
 -----------------------------------------------------------------------------
 -- Summarising modules