summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJakob Bruenker <jakob.bruenker@gmail.com>2022-03-30 11:42:47 +0200
committerMatthew Pickering <matthewtpickering@gmail.com>2022-04-01 10:54:28 +0100
commit18e6c85b2ccc8c52dca22bfa7f6c278bd1610736 (patch)
tree0836d11379afdef7411a948415057cee5e44e26f
parent1daaefdf3f772d74838c0ef0a6be0e5a0ce6ca23 (diff)
downloadhaskell-18e6c85b2ccc8c52dca22bfa7f6c278bd1610736.tar.gz
new datatypes for parsedResultAction
Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult.
-rw-r--r--compiler/GHC/Driver/Main.hs7
-rw-r--r--compiler/GHC/Driver/Plugins.hs22
-rw-r--r--docs/users_guide/9.4.1-notes.rst11
-rw-r--r--docs/users_guide/extending_ghc.rst45
-rw-r--r--testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs9
-rw-r--r--testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs11
-rw-r--r--testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs11
-rw-r--r--testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs9
8 files changed, 69 insertions, 56 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 3fa3d581ce..7fd07d31cf 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -493,10 +493,11 @@ hscParse' mod_summary
-- apply parse transformation of plugins
let applyPluginAction p opts
- = uncurry (parsedResultAction p opts mod_summary)
+ = parsedResultAction p opts mod_summary
hsc_env <- getHscEnv
- (transformed, (warns, errs)) <-
- withPlugins (hsc_plugins hsc_env) applyPluginAction (res, getPsMessages pst)
+ (ParsedResult transformed (PsMessages warns errs)) <-
+ withPlugins (hsc_plugins hsc_env) applyPluginAction
+ (ParsedResult res (uncurry PsMessages $ getPsMessages pst))
logDiagnostics (GhcPsMessage <$> warns)
unless (isEmptyMessages errs) $ throwErrors (GhcPsMessage <$> errs)
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index 64e82c42b6..67d8422562 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -12,6 +12,8 @@ module GHC.Driver.Plugins (
, Plugin(..)
, defaultPlugin
, CommandLineOption
+ , PsMessages(..)
+ , ParsedResult(..)
-- ** Recompilation checking
, purePlugin, impurePlugin, flagRecompile
, PluginRecompile(..)
@@ -89,6 +91,19 @@ import GHC.Types.Unique.DFM
-- are given to you as this type
type CommandLineOption = String
+-- | Errors and warnings produced by the parser
+data PsMessages = PsMessages { psWarnings :: Messages PsWarning
+ , psErrors :: Messages PsError
+ }
+
+-- | Result of running the parser and the parser plugin
+data ParsedResult = ParsedResult
+ { -- | Parsed module, potentially modified by a plugin
+ parsedResultModule :: HsParsedModule
+ , -- | Warnings and errors from parser, potentially modified by a plugin
+ parsedResultMessages :: PsMessages
+ }
+
-- | 'Plugin' is the compiler plugin data type. Try to avoid
-- constructing one of these directly, and just modify some fields of
-- 'defaultPlugin' instead: this is to try and preserve source-code
@@ -121,9 +136,8 @@ data Plugin = Plugin {
, pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
-- ^ Specify how the plugin should affect recompilation.
- , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+ , parsedResultAction :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
-- ^ Modify the module when it is parsed. This is called by
-- "GHC.Driver.Main" when the parser has produced no or only non-fatal
-- errors.
@@ -237,7 +251,7 @@ defaultPlugin = Plugin {
, driverPlugin = const return
, pluginRecompile = impurePlugin
, renamedResultAction = \_ env grp -> return (env, grp)
- , parsedResultAction = \_ _ mod msgs -> return (mod, msgs)
+ , parsedResultAction = \_ _ -> return
, typeCheckResultAction = \_ _ -> return
, spliceRunAction = \_ -> return
, interfaceLoadAction = \_ -> return
diff --git a/docs/users_guide/9.4.1-notes.rst b/docs/users_guide/9.4.1-notes.rst
index 3ccbf4c3ec..a77b6b451b 100644
--- a/docs/users_guide/9.4.1-notes.rst
+++ b/docs/users_guide/9.4.1-notes.rst
@@ -64,11 +64,12 @@ Compiler
defaults for ambiguous variables that would otherwise cause errors
just like the built-in defaulting mechanism.
-- ``GHC.Plugins.parsedResultAction`` now takes and returns a tuple of warnings
- and errors encountered by the parser before they're shown to the user, as
- long as none of the errors prevented the AST from being built. This means
- plugins can remove, modify, or add any of these, or simply pass them through
- unchanged.
+- ``GHC.Plugins.parsedResultAction`` now takes and returns a value of type
+ ``ParsedResult``, containing the ``HsParsedModule`` as well as ``PsMessages``,
+ which contains warnings and errors encountered by the parser before
+ they're shown to the user, as long as none of the errors prevented the AST
+ from being built. This means plugins can remove, modify, or add any of these,
+ or simply pass them through unchanged.
- The way GHC checks for representation polymorphism has been overhauled:
all the checks are now done during typechecking. The error messages
diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst
index 4a987bca87..b2b555c005 100644
--- a/docs/users_guide/extending_ghc.rst
+++ b/docs/users_guide/extending_ghc.rst
@@ -754,23 +754,24 @@ in the source code as well as the original syntax tree of the compiled module.
::
- parsed :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError)
+ parsed :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
The ``ModSummary`` contains useful
-meta-information about the compiled module. The ``HsParsedModule`` contains the
-lexical and syntactical information we mentioned before. The result that you
-return will change the result of the parsing. If you don't want to change the
-result, just return the ``HsParsedModule`` that you received as the argument.
+meta-information about the compiled module. The ``ParsedResult`` contains a
+``HsParsedModule``, which contains the lexical and syntactical information we
+mentioned before. The result that you return will change the result of the
+parsing. If you don't want to change the result, just return the
+``ParsedResult`` that you received as the argument.
If the parser encounters any errors that prevent an AST from being constructed,
the plugin will not be run, but other kinds of errors, as well as warnings,
-will be given to the plugin via the ``Messages`` tuple. This allows you to
-modify, remove, and add warnings or errors before they are displayed to the
-user, although in most cases, you will likely want to return the tuple
-unmodified. The parsing pass will fail if the returned ``Messages PsError``
-collection is not empty after all parsing plugins have been run.
+will be given to the plugin via the ``PsMessages`` value of the
+``ParsedResult``. This allows you to modify, remove, and add warnings or errors
+before they are displayed to the user, although in most cases, you will likely
+want to return the messages unmodified. The parsing pass will fail if the
+``Messages PsError`` collection inside the return ``ParsedResult`` is not empty
+after all parsing plugins have been run.
Type checked representation
^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -892,6 +893,7 @@ displayed.
import GHC.Types.Avail
import GHC.Utils.Outputable
import GHC.Hs.Doc
+ import GHC
plugin :: Plugin
plugin = defaultPlugin
@@ -902,15 +904,14 @@ displayed.
, interfaceLoadAction = interfaceLoadPlugin
}
- parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
- parsedPlugin _ _ pm msgs@(warns, errs)
+ parsedPlugin :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
+ parsedPlugin _ _ parsed@(ParsedResult pm msgs)
= do dflags <- getDynFlags
- liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
- liftIO $ putStrLn $ "parsePlugin warnings: \n" ++ (showSDoc dflags $ ppr warns)
- liftIO $ putStrLn $ "parsePlugin errors: \n" ++ (showSDoc dflags $ ppr errs)
- return (pm, msgs)
+ liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
+ liftIO $ putStrLn $ "parsePlugin warnings: \n" ++ (showSDoc dflags $ ppr $ psWarnings msgs)
+ liftIO $ putStrLn $ "parsePlugin errors: \n" ++ (showSDoc dflags $ ppr $ psErrors msgs)
+ return parsed
renamedAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction _ tc gr = do
@@ -1320,10 +1321,10 @@ Defaulting plugins have a single access point in the `GHC.Tc.Types` module
, deProposalCts :: [Ct]
-- ^ The constraints against which defaults are checked.
}
-
+
type DefaultingPluginResult = [DefaultingProposal]
type FillDefaulting = WantedConstraints -> TcPluginM DefaultingPluginResult
-
+
-- | A plugin for controlling defaulting.
data DefaultingPlugin = forall s. DefaultingPlugin
{ dePluginInit :: TcPluginM s
diff --git a/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
index e055204acf..74738a75f1 100644
--- a/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
+++ b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
@@ -17,14 +17,13 @@ import System.IO
plugin :: Plugin
plugin = defaultPlugin {parsedResultAction = parsedAction}
-parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedAction _ _ pm (warns, _) = do
+parsedAction :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
+parsedAction _ _ (ParsedResult pm msgs) = do
liftIO $ putStrLn "parsePlugin"
-- TODO: Remove #20791
liftIO $ hFlush stdout
- pure (pm, (warns, mkMessages $ unitBag err))
+ pure (ParsedResult pm msgs{psErrors = mkMessages $ unitBag err})
where
err = MsgEnvelope
{ errMsgSpan = UnhelpfulSpan UnhelpfulNoLocationInfo
diff --git a/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
index 1cf44edd8a..b8c761a82e 100644
--- a/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
+++ b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
@@ -30,20 +30,19 @@ replaceHoles new = gmapT \case
Eq.Refl | HsUnboundVar _ _ <- d -> Just new
_ -> Nothing
-parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedAction _ _ (HsParsedModule lmod srcFiles) (warns, errs) = do
+parsedAction :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
+parsedAction _ _ (ParsedResult (HsParsedModule lmod srcFiles) msgs) = do
liftIO $ putStrLn "parsePlugin"
liftIO $ putStrLn $ showPprUnsafe newModule
-- TODO: Remove #20791
liftIO $ hFlush stdout
- pure (HsParsedModule newModule srcFiles, (warns, otherErrs))
+ pure (ParsedResult (HsParsedModule newModule srcFiles) msgs{psErrors = otherErrs})
where
PsErrBangPatWithoutSpace (L _ holeExpr) = errMsgDiagnostic noSpaceBang
(bagToList -> [noSpaceBang], mkMessages -> otherErrs) =
- partitionBag (isNoSpaceBang . errMsgDiagnostic) . getMessages $ errs
+ partitionBag (isNoSpaceBang . errMsgDiagnostic) . getMessages $ psErrors msgs
isNoSpaceBang (PsErrBangPatWithoutSpace _) = True
isNoSpaceBang _ = False
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 8cb2d87c85..24ed240cfc 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -27,12 +27,11 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
, interfaceLoadAction = interfaceLoadPlugin'
}
-parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedPlugin [name, "parse"] _ pm msgs
- = return (pm { hpm_module = removeParsedBinding name (hpm_module pm) }, msgs)
-parsedPlugin _ _ pm msgs = return (pm, msgs)
+parsedPlugin :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
+parsedPlugin [name, "parse"] _ (ParsedResult pm msgs)
+ = return (ParsedResult pm { hpm_module = removeParsedBinding name (hpm_module pm) } msgs)
+parsedPlugin _ _ parsed = return parsed
removeParsedBinding :: String -> Located HsModule
-> Located HsModule
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
index 172a052817..e918b02cc9 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
@@ -25,14 +25,13 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
, renamedResultAction = renamedAction
}
-parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
- -> (Messages PsWarning, Messages PsError)
- -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
-parsedPlugin opts _ pm msgs
+parsedPlugin :: [CommandLineOption] -> ModSummary
+ -> ParsedResult -> Hsc ParsedResult
+parsedPlugin opts _ parsed
= do liftIO $ putStrLn $ "parsePlugin(" ++ intercalate "," opts ++ ")"
-- TODO: Remove #20791
liftIO $ hFlush stdout
- return (pm, msgs)
+ return parsed
renamedAction :: [CommandLineOption]
-> TcGblEnv -> HsGroup GhcRn