diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Plugins.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Plugins.hs | 8 |
3 files changed, 26 insertions, 8 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 4c17228852..3fa3d581ce 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -450,8 +450,6 @@ hscParse' mod_summary PFailed pst -> handleWarningsThrowErrors (getPsMessages pst) POk pst rdr_module -> do - let (warns, errs) = getPsMessages pst - logDiagnostics (GhcPsMessage <$> warns) liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed "Parser" FormatHaskell (ppr rdr_module) liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed_ast "Parser AST" @@ -460,7 +458,6 @@ hscParse' mod_summary rdr_module) liftIO $ putDumpFileMaybe logger Opt_D_source_stats "Source Statistics" FormatText (ppSourceStats False rdr_module) - when (not $ isEmptyMessages errs) $ throwErrors (GhcPsMessage <$> errs) -- To get the list of extra source files, we take the list -- that the parser gave us, @@ -496,9 +493,15 @@ hscParse' mod_summary -- apply parse transformation of plugins let applyPluginAction p opts - = parsedResultAction p opts mod_summary + = uncurry (parsedResultAction p opts mod_summary) hsc_env <- getHscEnv - withPlugins (hsc_plugins hsc_env) applyPluginAction res + (transformed, (warns, errs)) <- + withPlugins (hsc_plugins hsc_env) applyPluginAction (res, getPsMessages pst) + + logDiagnostics (GhcPsMessage <$> warns) + unless (isEmptyMessages errs) $ throwErrors (GhcPsMessage <$> errs) + + return transformed checkBidirectionFormatChars :: PsLoc -> StringBuffer -> Maybe (NonEmpty (PsLoc, Char, String)) checkBidirectionFormatChars start_loc sb diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs index 9afb556311..64e82c42b6 100644 --- a/compiler/GHC/Driver/Plugins.hs +++ b/compiler/GHC/Driver/Plugins.hs @@ -63,12 +63,15 @@ import GHC.Unit.Module import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModSummary +import GHC.Parser.Errors.Types (PsWarning, PsError) + import qualified GHC.Tc.Types import GHC.Tc.Types ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports ) import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR ) import GHC.Core.Opt.Monad ( CoreToDo, CoreM ) import GHC.Hs +import GHC.Types.Error (Messages) import GHC.Utils.Fingerprint import GHC.Utils.Outputable (Outputable(..), text, (<+>)) @@ -119,9 +122,13 @@ data Plugin = Plugin { , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile -- ^ Specify how the plugin should affect recompilation. , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule - -> Hsc HsParsedModule + -> (Messages PsWarning, Messages PsError) + -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError)) -- ^ Modify the module when it is parsed. This is called by - -- "GHC.Driver.Main" when the parsing is successful. + -- "GHC.Driver.Main" when the parser has produced no or only non-fatal + -- errors. + -- Compilation will fail if the messages produced by this function contain + -- any errors. , renamedResultAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn) -- ^ Modify each group after it is renamed. This is called after each @@ -230,7 +237,7 @@ defaultPlugin = Plugin { , driverPlugin = const return , pluginRecompile = impurePlugin , renamedResultAction = \_ env grp -> return (env, grp) - , parsedResultAction = \_ _ -> return + , parsedResultAction = \_ _ mod msgs -> return (mod, msgs) , typeCheckResultAction = \_ _ -> return , spliceRunAction = \_ -> return , interfaceLoadAction = \_ -> return diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs index 95ae21aba7..2de8d8d370 100644 --- a/compiler/GHC/Plugins.hs +++ b/compiler/GHC/Plugins.hs @@ -58,6 +58,9 @@ module GHC.Plugins , module GHC.Unit.Module.ModIface , module GHC.Types.Meta , module GHC.Types.SourceError + , module GHC.Parser.Errors.Types + , module GHC.Types.Error + , module GHC.Hs , -- * Getting 'Name's thNameToGhcName ) @@ -140,6 +143,11 @@ import GHC.Tc.Utils.Env ( lookupGlobal ) import GHC.Tc.Errors.Hole.FitTypes +-- For parse result plugins +import GHC.Parser.Errors.Types ( PsWarning, PsError ) +import GHC.Types.Error ( Messages ) +import GHC.Hs ( HsParsedModule ) + import qualified Language.Haskell.TH as TH {- This instance is defined outside GHC.Core.Opt.Monad so that |