X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=f08b613555b2c2a68390f98fe9cfa85960a8953c;hb=c3693c2d32ffb9d312a598a65cbc62f3c3270008;hp=157539eabad41735c11ebc09dddffe0b414e60c7;hpb=9a025cdda1c042caafd1fc540e3f93a439c40ae8;p=ghc-hetmet.git diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 157539e..f08b613 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -239,7 +239,7 @@ import CoreSyn import TidyPgm import DriverPipeline import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase ) -import HeaderInfo ( getImports, getOptions ) +import HeaderInfo import Finder import HscMain import HscTypes @@ -255,10 +255,7 @@ import FiniteMap import Panic import Digraph import Bag ( unitBag, listToBag ) -import ErrUtils ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg, - mkPlainErrMsg, printBagOfErrors, printBagOfWarnings, - WarnMsg ) -import qualified ErrUtils +import ErrUtils import Util import StringBuffer ( StringBuffer, hGetStringBuffer ) import Outputable @@ -351,8 +348,8 @@ newSession mb_top_dir = do installSignalHandlers initStaticOpts - dflags0 <- initSysTools mb_top_dir defaultDynFlags - dflags <- initDynFlags dflags0 + dflags0 <- initDynFlags defaultDynFlags + dflags <- initSysTools mb_top_dir dflags0 env <- newHscEnv dflags ref <- newIORef env return (Session ref) @@ -1772,7 +1769,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf let dflags = hsc_dflags hsc_env (dflags', hspp_fn, buf) - <- preprocessFile dflags file mb_phase maybe_buf + <- preprocessFile hsc_env file mb_phase maybe_buf (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file @@ -1893,7 +1890,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc = do -- Preprocess the source file and get its imports -- The dflags' contains the OPTIONS pragmas - (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf + (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn when (mod_name /= wanted_mod) $ @@ -1923,22 +1920,24 @@ getObjTimestamp location is_boot else modificationTimeIfExists (ml_obj_file location) -preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime) +preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime) -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile dflags src_fn mb_phase Nothing +preprocessFile hsc_env src_fn mb_phase Nothing = do - (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase) + (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase) buf <- hGetStringBuffer hspp_fn return (dflags', hspp_fn, buf) -preprocessFile dflags src_fn mb_phase (Just (buf, _time)) +preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) = do + let dflags = hsc_dflags hsc_env -- case we bypass the preprocessing stage? let - local_opts = getOptions buf src_fn + local_opts = getOptions dflags buf src_fn -- - (dflags', _errs) <- parseDynamicFlags dflags (map unLoc local_opts) - -- XXX: shouldn't we be reporting the errors? + (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts) + checkProcessArgsResult leftovers src_fn + handleFlagWarnings dflags' warns let needs_preprocessing