X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FGHC.hs;h=b2c86df78245607b4fac97019983d05aa65823fc;hp=d1d1e78960418d29b1ec3cce8d3b7acd6f8fd285;hb=3eacdc7faf0d0e87a7201253f9f12c1fb4db7249;hpb=44ebaafe969002e74855c2290261bed672602c67

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index d1d1e78..b2c86df 100644
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -208,13 +208,12 @@ import InstEnv		( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
 import SrcLoc
 import DriverPipeline
 import DriverPhases	( Phase(..), isHaskellSrcFilename, startPhase )
-import GetImports	( getImports )
+import HeaderInfo	( getImports, getOptions )
 import Packages		( isHomePackage )
 import Finder
-import HscMain		( newHscEnv, hscFileCheck, HscResult(..) )
+import HscMain		( newHscEnv, hscFileCheck, HscChecked(..) )
 import HscTypes
 import DynFlags
-import StaticFlags
 import SysTools		( initSysTools, cleanTempFiles )
 import Module
 import FiniteMap
@@ -234,7 +233,7 @@ import Maybes		( expectJust, mapCatMaybes )
 
 import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist )
-import Data.Maybe	( isJust, isNothing, fromJust )
+import Data.Maybe	( isJust, isNothing )
 import Data.List	( partition, nub )
 import qualified Data.List as List
 import Control.Monad	( unless, when )
@@ -244,7 +243,6 @@ import Control.Exception as Exception hiding (handle)
 import Data.IORef
 import System.IO
 import System.IO.Error	( isDoesNotExistError )
-import System.IO.Unsafe	( unsafePerformIO )
 import Prelude hiding (init)
 
 #if __GLASGOW_HASKELL__ < 600
@@ -712,7 +710,7 @@ discardProg hsc_env
 -- used to fish out the preprocess output files for the purposes of
 -- cleaning up.  The preprocessed file *might* be the same as the
 -- source file, but that doesn't do any harm.
-ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
+ppFilesFromSummaries summaries = map ms_hspp_file summaries
 
 -- -----------------------------------------------------------------------------
 -- Check module
@@ -762,32 +760,17 @@ checkModule session@(Session ref) mod = do
    case [ ms | ms <- mg, ms_mod ms == mod ] of
 	[] -> return Nothing
 	(ms:_) -> do 
-	   -- Add in the OPTIONS from the source file This is nasty:
-	   -- we've done this once already, in the compilation manager
-	   -- It might be better to cache the flags in the
-	   -- ml_hspp_file field, say
-	   let dflags0 = hsc_dflags hsc_env
-	       hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
-	       filename = fromJust (ml_hs_file (ms_location ms))
-	       opts = getOptionsFromStringBuffer hspp_buf filename
-	   (dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
-	   if (not (null leftovers))
-		then do printErrorsAndWarnings dflags1 (optionsErrorMsgs leftovers opts filename)
-		        return Nothing
-		else do
-
-	   r <- hscFileCheck hsc_env{hsc_dflags=dflags1} ms
-	   case r of
-		HscFail -> 
-		   return Nothing
-		HscChecked parsed renamed Nothing ->
+	   mbChecked <- hscFileCheck hsc_env{hsc_dflags=ms_hspp_opts ms} ms
+	   case mbChecked of
+             Nothing -> return Nothing
+             Just (HscChecked parsed renamed Nothing) ->
 		   return (Just (CheckedModule {
 					parsedSource = parsed,
 					renamedSource = renamed,
 					typecheckedSource = Nothing,
 					checkedModuleInfo = Nothing }))
-		HscChecked parsed renamed
-			   (Just (tc_binds, rdr_env, details)) -> do
+             Just (HscChecked parsed renamed
+			   (Just (tc_binds, rdr_env, details))) -> do
 		   let minf = ModuleInfo {
 				minf_type_env  = md_types details,
 				minf_exports   = md_exports details,
@@ -799,8 +782,6 @@ checkModule session@(Session ref) mod = do
 					renamedSource = renamed,
 					typecheckedSource = Just tc_binds,
 					checkedModuleInfo = Just minf }))
-		_other ->
-			panic "checkModule"
 
 -- ---------------------------------------------------------------------------
 -- Unloading
@@ -1437,7 +1418,8 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
 
         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
 			     ms_location = location,
-                             ms_hspp_file = Just hspp_fn,
+                             ms_hspp_file = hspp_fn,
+                             ms_hspp_opts = dflags',
 			     ms_hspp_buf  = Just buf,
                              ms_srcimps = srcimps, ms_imps = the_imps,
 			     ms_hs_date = src_timestamp,
@@ -1446,7 +1428,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
 findSummaryBySourceFile summaries file
   = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
-			         fromJust (ml_hs_file (ms_location ms)) == file ] of
+			         expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
 	[] -> Nothing
 	(x:xs) -> Just x
 
@@ -1547,7 +1529,8 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
 	return (Just ( ModSummary { ms_mod       = wanted_mod, 
 				    ms_hsc_src   = hsc_src,
 				    ms_location  = location,
-				    ms_hspp_file = Just hspp_fn,
+				    ms_hspp_file = hspp_fn,
+                                    ms_hspp_opts = dflags',
 				    ms_hspp_buf  = Just buf,
 				    ms_srcimps   = srcimps,
 				    ms_imps      = the_imps,
@@ -1572,9 +1555,9 @@ preprocessFile dflags src_fn mb_phase (Just (buf, time))
   = do
 	-- case we bypass the preprocessing stage?
 	let 
-	    local_opts = getOptionsFromStringBuffer buf src_fn
+	    local_opts = getOptions buf src_fn
 	--
-	(dflags', errs) <- parseDynamicFlags dflags (map snd local_opts)
+	(dflags', errs) <- parseDynamicFlags dflags (map unLoc local_opts)
 
 	let
 	    needs_preprocessing
@@ -2065,6 +2048,6 @@ showModule s mod_summary = withSession s $ \hsc_env -> do
 	Nothing	      -> panic "missing linkable"
 	Just mod_info -> return (showModMsg obj_linkable mod_summary)
 		      where
-			 obj_linkable = isObjectLinkable (fromJust (hm_linkable mod_info))
+			 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
 #endif /* GHCI */