diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 12 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 17 |
2 files changed, 13 insertions, 16 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9ac973cbc4..78e4a810d7 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -64,6 +64,8 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup import Ar +import Bag ( unitBag ) +import FastString ( mkFastString ) import Exception import System.Directory @@ -91,8 +93,11 @@ preprocess :: HscEnv -> Maybe StringBuffer -- ^ optional buffer to use instead of reading input file -> Maybe Phase -- ^ starting phase - -> IO (DynFlags, FilePath) + -> IO (Either ErrorMessages (DynFlags, FilePath)) preprocess hsc_env input_fn mb_input_buf mb_phase = + handleSourceError (\err -> return (Left (srcErrorMessages err))) $ + ghandle handler $ + fmap Right $ ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn) runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase) Nothing @@ -101,6 +106,11 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = (Temporary TFL_GhcSession) Nothing{-no ModLocation-} []{-no foreign objects-} + where + srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1 + handler (ProgramError msg) = return $ Left $ unitBag $ + mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg + handler ex = throwGhcExceptionIO ex -- --------------------------------------------------------------------------- diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 341356f775..f3a1cfaaca 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -2489,19 +2489,6 @@ getObjTimestamp location is_boot = if is_boot == IsBoot then return Nothing else modificationTimeIfExists (ml_obj_file location) - -preprocessFile :: HscEnv - -> FilePath - -> Maybe Phase -- ^ Starting phase - -> Maybe (StringBuffer,UTCTime) - -> IO (DynFlags, FilePath, StringBuffer) -preprocessFile hsc_env src_fn mb_phase maybe_buf - = do - (dflags', hspp_fn) - <- preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - buf <- hGetStringBuffer hspp_fn - return (dflags', hspp_fn, buf) - data PreprocessedImports = PreprocessedImports { pi_local_dflags :: DynFlags @@ -2523,8 +2510,8 @@ getPreprocessedImports -> ExceptT ErrorMessages IO PreprocessedImports getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do (pi_local_dflags, pi_hspp_fn) - <- liftIO $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - pi_hscpp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn + <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase + pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn (pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name) <- ExceptT $ getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn return PreprocessedImports {..} |