diff --git a/changelog.md b/changelog.md index 6dbfe05..1a72571 100644 --- a/changelog.md +++ b/changelog.md @@ -1,7 +1,21 @@ +# Version 0.19.0.0 (2026-05-12) + +- Starting from GHC 10.0, typechecker plugins are kept running during the + desugaring phase, in order to improve the accuracy of pattern-match warnings. + + For this reason, the `tcPluginStop` function has been split into two: + - `tcPluginPostTc`, for actions to run at the end of typechecking. + - `tcPluginShutdown`, to shut down the plugin. This action runs in `IO` + instead of a `TcM`-like monad. + + On GHC versions prior to 10.0, both of these actions will run at the end of + typechecking, and typechecker plugins aren't invoked during pattern-match + checking. + # Version 0.18.2.1 (2026-04-28) -- Add support for GHC 10.0. +- Add preliminary support for GHC 10.0. # Version 0.18.2.0 (2025-01-14) diff --git a/examples/EqSat/src/EqSat/Plugin.hs b/examples/EqSat/src/EqSat/Plugin.hs index 781bb51..d449747 100644 --- a/examples/EqSat/src/EqSat/Plugin.hs +++ b/examples/EqSat/src/EqSat/Plugin.hs @@ -89,10 +89,11 @@ plugin = tcPlugin :: TcPlugin tcPlugin = TcPlugin - { tcPluginInit = return () - , tcPluginSolve = pluginSolve - , tcPluginRewrite = \ _ -> emptyUFM - , tcPluginStop = \ _ -> return () + { tcPluginInit = return () + , tcPluginSolve = pluginSolve + , tcPluginRewrite = \ _ -> emptyUFM + , tcPluginPostTc = \ _ -> return () + , tcPluginShutdown = \ _ -> return () } pluginSolve :: () -> [ Ct ] -> [ Ct ] -> TcPluginM Solve TcPluginSolveResult diff --git a/examples/RewriterPlugin/plugin/RewriterPlugin.hs b/examples/RewriterPlugin/plugin/RewriterPlugin.hs index 2c4dcf8..b447117 100644 --- a/examples/RewriterPlugin/plugin/RewriterPlugin.hs +++ b/examples/RewriterPlugin/plugin/RewriterPlugin.hs @@ -34,10 +34,11 @@ plugin = tcPlugin :: API.TcPlugin tcPlugin = API.TcPlugin - { API.tcPluginInit = tcPluginInit - , API.tcPluginSolve = tcPluginSolve - , API.tcPluginRewrite = tcPluginRewrite - , API.tcPluginStop = tcPluginStop + { API.tcPluginInit = tcPluginInit + , API.tcPluginSolve = tcPluginSolve + , API.tcPluginRewrite = tcPluginRewrite + , API.tcPluginPostTc = const $ pure () + , API.tcPluginShutdown = const $ pure () } -- Definitions used by the plugin. @@ -78,10 +79,6 @@ tcPluginInit = do tcPluginSolve :: PluginDefs -> [ API.Ct ] -> [ API.Ct ] -> API.TcPluginM API.Solve API.TcPluginSolveResult tcPluginSolve _ _ _ = pure $ API.TcPluginOk [] [] --- Nothing to shutdown. -tcPluginStop :: PluginDefs -> API.TcPluginM API.Stop () -tcPluginStop _ = pure () - -------------------------------------------------------------------------------- -- Simplification of type family applications. diff --git a/examples/SystemF/src/SystemF/Plugin.hs b/examples/SystemF/src/SystemF/Plugin.hs index 1f54d60..5ecce1d 100644 --- a/examples/SystemF/src/SystemF/Plugin.hs +++ b/examples/SystemF/src/SystemF/Plugin.hs @@ -46,10 +46,11 @@ plugin = tcPlugin :: TcPlugin tcPlugin = TcPlugin - { tcPluginInit = pluginInit - , tcPluginSolve = pluginSolve - , tcPluginRewrite = pluginRewrite - , tcPluginStop = pluginStop + { tcPluginInit = pluginInit + , tcPluginSolve = pluginSolve + , tcPluginRewrite = pluginRewrite + , tcPluginPostTc = const $ pure () + , tcPluginShutdown = const $ pure () } data PluginDefs = @@ -86,9 +87,6 @@ pluginInit = do pluginSolve :: PluginDefs -> [ Ct ] -> [ Ct ] -> TcPluginM Solve TcPluginSolveResult pluginSolve _ _ _ = pure $ TcPluginOk [] [] -pluginStop :: PluginDefs -> TcPluginM Stop () -pluginStop _ = pure () - -------------------------------------------------------------------------------- -- Simplification of type family applications. diff --git a/ghc-tcplugin-api.cabal b/ghc-tcplugin-api.cabal index f682299..63747a1 100644 --- a/ghc-tcplugin-api.cabal +++ b/ghc-tcplugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghc-tcplugin-api -version: 0.18.2.1 +version: 0.19.0.0 synopsis: An API for type-checker plugins. license: BSD-3-Clause build-type: Simple @@ -15,7 +15,7 @@ description: for writing GHC type-checking plugins. Each stage in a type-checking plugin (initialisation, solving, rewriting, - shutdown) has a corresponding monad, preventing operations that are only + post-tc) has a corresponding monad, preventing operations that are only allowed in some stages to be used in the other stages. Operations that work across multiple stages are overloaded across monads using MTL-like typeclasses. diff --git a/readme.md b/readme.md index 7c750cc..6800805 100644 --- a/readme.md +++ b/readme.md @@ -5,7 +5,7 @@ This library provides a convenient and cross-compatible interface for authors of GHC type-checking plugins (starting from GHC 8.8). -Different stages of a type-checking plugin (initialisation, solving, rewriting, shutdown) are given +Different stages of a type-checking plugin (initialisation, solving, rewriting, post-tc) are given different monads to operate within. This ensures operations that only make sense in one context aren't mistakenly carried out in another. diff --git a/src/GHC/TcPlugin/API/Internal.hs b/src/GHC/TcPlugin/API/Internal.hs index 690a864..a62c69d 100644 --- a/src/GHC/TcPlugin/API/Internal.hs +++ b/src/GHC/TcPlugin/API/Internal.hs @@ -166,10 +166,14 @@ import GHC.TcPlugin.API.Internal.Shim -- | Stage of a type-checking plugin, used as a data kind. data TcPluginStage + -- | Plugin initialisation = Init + -- | Solve constraints | Solve + -- | Rewrite type-families | Rewrite - | Stop + -- | End of typechecking + | PostTc -- | The @solve@ function of a type-checking plugin takes in Given and Wanted -- constraints, and should return a 'GHC.Tc.Types.TcPluginSolveResult' @@ -213,22 +217,22 @@ type TcPluginRewriter -- > myTcPlugin args = ... data TcPlugin = forall s. TcPlugin { tcPluginInit :: TcPluginM Init s - -- ^ Initialise plugin, when entering type-checker. + -- ^ Initialize plugin (once per module), when starting the type-checker. , tcPluginSolve :: s -> TcPluginSolver -- ^ Solve some constraints. -- -- This function will be invoked at two points in the constraint solving - -- process: once to manipulate given constraints, and once to solve - -- wanted constraints. In the first case (and only in the first case), - -- no wanted constraints will be passed to the plugin. + -- process: once to simplify Given constraints, and once to solve + -- Wanted constraints. In the first case (and only in the first case), + -- no Wanted constraints will be passed to the plugin. -- -- The plugin can either return a contradiction, -- or specify that it has solved some constraints (with evidence), - -- and possibly emit additional wanted constraints. + -- and possibly emit additional constraints. These returned constraints + -- must be Givens in the first case, and Wanteds in the second. -- - -- Use @ \\ _ _ _ -> pure $ TcPluginOK [] [] @ if your plugin - -- does not provide this functionality. + -- Use @ \\ _ _ _ _ -> pure $ TcPluginOk [] [] @ if your plugin , tcPluginRewrite :: s -> GHC.UniqFM @@ -247,8 +251,18 @@ data TcPlugin = forall s. TcPlugin -- -- Use @ const emptyUFM @ if your plugin does not provide this functionality. - , tcPluginStop :: s -> TcPluginM Stop () - -- ^ Clean up after the plugin, when exiting the type-checker. + , tcPluginPostTc :: s -> TcPluginM PostTc () + -- ^ Action to run at the end of typechecking a module, e.g. to intercept + -- the final 'TcGblEnv'/'TcLclEnv' at the end of typechecking, possibly + -- modifying mutable fields. + -- + -- Should not terminate the plugin, as the plugin may continue to be invoked + -- when desugaring the module (as the pattern-match checker may invoke the + -- constraint solver). + + , tcPluginShutdown :: s -> IO () + -- ^ Clean up after the plugin, when GHC is done processing the given + -- module (e.g. after desugaring). } -- | The monad used for a type-checker plugin, parametrised by @@ -272,8 +286,8 @@ newtype instance TcPluginM Rewrite a = TcPluginRewriteM { tcPluginRewriteM :: BuiltinDefs -> RewriteEnv -> GHC.TcPluginM a } deriving ( Functor, Applicative, Monad ) via ( ReaderT BuiltinDefs ( ReaderT RewriteEnv GHC.TcPluginM ) ) -newtype instance TcPluginM Stop a = - TcPluginStopM { tcPluginStopM :: GHC.TcPluginM a } +newtype instance TcPluginM PostTc a = + TcPluginPostTcM { tcPluginPostTcM :: GHC.TcPluginM a } deriving newtype ( Functor, Applicative, Monad ) -- | Ask for the evidence currently gathered by the type-checker. @@ -384,14 +398,14 @@ instance MonadTcPlugin ( TcPluginM Rewrite ) where #endif . ( \ f -> f builtinDefs rewriteEnv ) . tcPluginRewriteM ) -instance MonadTcPlugin ( TcPluginM Stop ) where - liftTcPluginM = TcPluginStopM +instance MonadTcPlugin ( TcPluginM PostTc ) where + liftTcPluginM = TcPluginPostTcM unsafeWithRunInTcM runInTcM = unsafeLiftTcM $ runInTcM #ifdef HAS_REWRITING - ( GHC.runTcPluginM . tcPluginStopM ) + ( GHC.runTcPluginM . tcPluginPostTcM ) #else - ( ( `GHC.runTcPluginM` ( error "tcPluginStop: cannot access EvBindsVar" ) ) . tcPluginStopM ) + ( ( `GHC.runTcPluginM` ( error "tcPluginPostTc: cannot access EvBindsVar" ) ) . tcPluginPostTcM ) #endif -- | Take a function whose argument and result types are both within the 'GHC.Tc.TcM' monad, @@ -409,19 +423,26 @@ mkTcPlugin ( TcPlugin { tcPluginInit = tcPluginInit :: TcPluginM Init userDefs , tcPluginSolve , tcPluginRewrite - , tcPluginStop + , tcPluginPostTc + , tcPluginShutdown } ) = GHC.TcPlugin - { GHC.tcPluginInit = adaptUserInit tcPluginInit + { GHC.tcPluginInit = adaptUserInit tcPluginInit #ifdef HAS_REWRITING - , GHC.tcPluginSolve = adaptUserSolve tcPluginSolve - , GHC.tcPluginRewrite = adaptUserRewrite tcPluginRewrite + , GHC.tcPluginSolve = adaptUserSolve tcPluginSolve + , GHC.tcPluginRewrite = adaptUserRewrite tcPluginRewrite +#else + , GHC.tcPluginSolve = adaptUserSolveAndRewrite + tcPluginSolve tcPluginRewrite +#endif +#if MIN_VERSION_ghc(10,0,0) + , GHC.tcPluginPostTc = adaptUserPostTc tcPluginPostTc + , GHC.tcPluginShutdown = adaptUserShutdown tcPluginShutdown #else - , GHC.tcPluginSolve = adaptUserSolveAndRewrite - tcPluginSolve tcPluginRewrite + , GHC.tcPluginStop = adaptUserStop + tcPluginPostTc tcPluginShutdown #endif - , GHC.tcPluginStop = adaptUserStop tcPluginStop } where adaptUserInit :: TcPluginM Init userDefs -> GHC.TcPluginM ( TcPluginDefs userDefs ) @@ -518,9 +539,22 @@ mkTcPlugin ( TcPlugin #endif #endif - adaptUserStop :: ( userDefs -> TcPluginM Stop () ) -> TcPluginDefs userDefs -> GHC.TcPluginM () - adaptUserStop userStop ( TcPluginDefs { tcPluginUserDefs } ) = - tcPluginStopM $ userStop tcPluginUserDefs +#if MIN_VERSION_ghc(10,0,0) + adaptUserPostTc :: ( userDefs -> TcPluginM PostTc () ) -> TcPluginDefs userDefs -> GHC.TcPluginM () + adaptUserPostTc userPostTc ( TcPluginDefs { tcPluginUserDefs } ) = + tcPluginPostTcM $ userPostTc tcPluginUserDefs + adaptUserShutdown :: ( userDefs -> IO () ) -> TcPluginDefs userDefs -> IO () + adaptUserShutdown userShutdown ( TcPluginDefs { tcPluginUserDefs } ) = + userShutdown tcPluginUserDefs +#else + -- Prior to GHC 10.0, run the "post-tc" and "shutdown" actions in sequence, + -- at the end of typechecking. Typechecker plugins do not persist to desugaring. + adaptUserStop :: ( userDefs -> TcPluginM PostTc () ) -> ( userDefs -> IO () ) -> TcPluginDefs userDefs -> GHC.TcPluginM () + adaptUserStop userPostTc userShutdown ( TcPluginDefs { tcPluginUserDefs } ) = do + tcPluginPostTcM $ userPostTc tcPluginUserDefs + GHC.unsafeTcPluginTcM . liftIO $ userShutdown tcPluginUserDefs +#endif + -- | @since 0.15.0.0 instance ( Monad ( TcPluginM s ), MonadTcPlugin ( TcPluginM s ) ) => MonadIO ( TcPluginM s ) where @@ -531,7 +565,7 @@ instance ( Monad ( TcPluginM s ), MonadTcPlugin ( TcPluginM s ) ) => MonadIO ( T -- -- These operations are supported by the monads that 'tcPluginSolve' -- and 'tcPluginRewrite' use; it is not possible to emit work or --- throw type errors in 'tcPluginInit' or 'tcPluginStop'. +-- throw type errors in 'tcPluginInit' or 'tcPluginPostTc'. -- -- See 'mkTcPluginErrorTy' and 'GHC.TcPlugin.API.emitWork' for functions -- which require this typeclass. @@ -553,9 +587,9 @@ instance MonadTcPluginWork ( TcPluginM Rewrite ) where instance TypeError ( 'Text "Cannot emit new work in 'tcPluginInit'." ) => MonadTcPluginWork ( TcPluginM Init ) where askBuiltins = error "Cannot emit new work in 'tcPluginInit'." -instance TypeError ( 'Text "Cannot emit new work in 'tcPluginStop'." ) - => MonadTcPluginWork ( TcPluginM Stop ) where - askBuiltins = error "Cannot emit new work in 'tcPluginStop'." +instance TypeError ( 'Text "Cannot emit new work in 'tcPluginPostTc'." ) + => MonadTcPluginWork ( TcPluginM PostTc ) where + askBuiltins = error "Cannot emit new work in 'tcPluginPostTc'." -- | Use this type like 'GHC.TypeLits.ErrorMessage' to write an error message. -- This error message can then be thrown at the type-level by the plugin, @@ -588,8 +622,8 @@ mkTcPluginErrorTy msg = do errorMsgTy = interpretErrorMessage builtinDefs msg pure $ GHC.mkTyConApp typeErrorTyCon [ GHC.constraintKind, errorMsgTy ] -instance ( Monad (TcPluginM s), MonadTcPlugin (TcPluginM s) ) - => MonadThings (TcPluginM s) where +instance ( Monad ( TcPluginM s ), MonadTcPlugin ( TcPluginM s ) ) + => MonadThings ( TcPluginM s ) where lookupThing = unsafeLiftTcM . lookupThing --------------------------------------------------------------------------------