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
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 )
import Data.IORef
import System.IO
import System.IO.Error ( isDoesNotExistError )
-import System.IO.Unsafe ( unsafePerformIO )
import Prelude hiding (init)
#if __GLASGOW_HASKELL__ < 600
-- 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
type TypecheckedSource = LHsBinds Id
-- NOTE:
--- - things that aren't in the output of the renamer:
--- - the export list
--- - the imports
-- - things that aren't in the output of the typechecker right now:
-- - the export list
-- - the imports
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,
renamedSource = renamed,
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf }))
- _other ->
- panic "checkModule"
-- ---------------------------------------------------------------------------
-- Unloading
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,
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
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,
= 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
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 */