GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2019-07-07T18:37:39Zhttps://gitlab.haskell.org/ghc/ghc/-/issues/10078tcPluginStop of a type checker plugin is not called if an error occurs2019-07-07T18:37:39ZjbrackertcPluginStop of a type checker plugin is not called if an error occursWhen a module using a type checker plugin produces a compiler error the clean up function `tcPluginStop` of the plugin is not called.
I am not sure if this is intended, but according to the description of the wiki page (Plugins/TypeChec...When a module using a type checker plugin produces a compiler error the clean up function `tcPluginStop` of the plugin is not called.
I am not sure if this is intended, but according to the description of the wiki page (Plugins/TypeChecker) this should always be called.
### Test plugin
`MyPlugin.hs`:
```hs
module MyPlugin
( plugin ) where
import Plugins
import TcRnTypes
import TcPluginM
plugin :: Plugin
plugin = defaultPlugin
{ tcPlugin = \clos -> Just $ TcPlugin
{ tcPluginInit = tcPluginIO $ putStrLn ">>> Plugin Init"
, tcPluginSolve = \_ _ _ _ -> do
tcPluginIO $ putStrLn ">>> Plugin Solve"
return $ TcPluginOk [] []
, tcPluginStop = \_ -> tcPluginIO $ putStrLn ">>> Plugin Stop"
}
}
```
### Minimal example (with type error)
`Main.hs`:
```hs
{-# OPTIONS_GHC -fplugin MyPlugin #-}
module Main where
main :: (Monad m) => m ()
main = do
return 1
```
Compiling this will lead to the following output:
```
$ ~/ghc/inplace/bin/ghc-stage2 --make -package ghc-7.11.20150209 -dynamic Main.hs
[2 of 2] Compiling Main ( Main.hs, Main.o )
>>> Plugin Init
>>> Plugin Solve
>>> Plugin Solve
>>> Plugin Solve
Main.hs:6:10:
Could not deduce (Num ()) arising from the literal ‘1’
from the context: Monad m
bound by the type signature for: main :: Monad m => m ()
at Main.hs:4:9-25
In the first argument of ‘return’, namely ‘1’
In a stmt of a 'do' block: return 1
In the expression: do { return 1 }
```
Which means `tcPluginStop` was _not_ called.
### Minimal example (without type error)
`Main.hs`:
```hs
{-# OPTIONS_GHC -fplugin MyPlugin #-}
module Main where
main :: (Monad m) => m ()
main = do
return ()
```
Compiling this will lead to the following output:
```
$ ~/ghc/inplace/bin/ghc-stage2 --make -package ghc-7.11.20150209 -dynamic Main.hs
[2 of 2] Compiling Main ( Main.hs, Main.o ) [MyPlugin changed]
>>> Plugin Init
>>> Plugin Solve
>>> Plugin Solve
>>> Plugin Stop
Linking Main ...
```
Which means `tcPluginStop` _was_ called.
### Possible solution
As far as I can see, the solution to this should be to change the plugin code at the bottom of `typechecker/TcRnDriver.hs` from
```hs
withTcPlugins :: HscEnv -> TcM a -> TcM a
withTcPlugins hsc_env m =
do plugins <- liftIO (loadTcPlugins hsc_env)
case plugins of
[] -> m -- Common fast case
_ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins
res <- updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m
mapM_ runTcPluginM stops
return res
where
startPlugin (TcPlugin start solve stop) =
do s <- runTcPluginM start
return (solve s, stop s)
```
to
```hs
withTcPlugins :: HscEnv -> TcM a -> TcM a
withTcPlugins hsc_env m =
do plugins <- liftIO (loadTcPlugins hsc_env)
case plugins of
[] -> m -- Common fast case
_ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins
eitherRes <- tryM $ do updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m
mapM_ runTcPluginM stops
case eitherRes of
Left e -> failM
Right res -> return res
where
startPlugin (TcPlugin start solve stop) =
do s <- runTcPluginM start
return (solve s, stop s)
```
.
I have tried this. It compiles and my minimal example delivers the correct result.
Are there any arguments against this change? If not, I would try to commit a patch for this problem sometime this weekend.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ----------------------- |
| Version | 7.11 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler (Type checker) |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | adamgundry |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"tcPluginStop of a type checker plugin is not called if an error occurs","status":"New","operating_system":"","component":"Compiler (Type checker)","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.11","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":["adamgundry"],"type":"Bug","description":"When a module using a type checker plugin produces a compiler error the clean up function `tcPluginStop` of the plugin is not called.\r\n\r\nI am not sure if this is intended, but according to the description of the wiki page (Plugins/TypeChecker) this should always be called.\r\n\r\n=== Test plugin\r\n\r\n`MyPlugin.hs`:\r\n{{{#!hs\r\nmodule MyPlugin\r\n ( plugin ) where\r\n\r\nimport Plugins\r\nimport TcRnTypes\r\nimport TcPluginM\r\n\r\nplugin :: Plugin\r\nplugin = defaultPlugin \r\n { tcPlugin = \\clos -> Just $ TcPlugin \r\n { tcPluginInit = tcPluginIO $ putStrLn \">>> Plugin Init\"\r\n , tcPluginSolve = \\_ _ _ _ -> do\r\n tcPluginIO $ putStrLn \">>> Plugin Solve\"\r\n return $ TcPluginOk [] []\r\n , tcPluginStop = \\_ -> tcPluginIO $ putStrLn \">>> Plugin Stop\"\r\n }\r\n }\r\n}}}\r\n\r\n=== Minimal example (with type error)\r\n\r\n`Main.hs`:\r\n{{{#!hs\r\n{-# OPTIONS_GHC -fplugin MyPlugin #-}\r\nmodule Main where\r\n\r\nmain :: (Monad m) => m ()\r\nmain = do\r\n return 1\r\n}}}\r\n\r\nCompiling this will lead to the following output:\r\n{{{\r\n$ ~/ghc/inplace/bin/ghc-stage2 --make -package ghc-7.11.20150209 -dynamic Main.hs\r\n[2 of 2] Compiling Main ( Main.hs, Main.o )\r\n>>> Plugin Init\r\n>>> Plugin Solve\r\n>>> Plugin Solve\r\n>>> Plugin Solve\r\n\r\nMain.hs:6:10:\r\n Could not deduce (Num ()) arising from the literal ‘1’\r\n from the context: Monad m\r\n bound by the type signature for: main :: Monad m => m ()\r\n at Main.hs:4:9-25\r\n In the first argument of ‘return’, namely ‘1’\r\n In a stmt of a 'do' block: return 1\r\n In the expression: do { return 1 }\r\n}}}\r\nWhich means `tcPluginStop` was _not_ called.\r\n\r\n=== Minimal example (without type error)\r\n\r\n`Main.hs`:\r\n{{{#!hs\r\n{-# OPTIONS_GHC -fplugin MyPlugin #-}\r\nmodule Main where\r\n\r\nmain :: (Monad m) => m ()\r\nmain = do\r\n return ()\r\n}}}\r\n\r\nCompiling this will lead to the following output:\r\n{{{\r\n$ ~/ghc/inplace/bin/ghc-stage2 --make -package ghc-7.11.20150209 -dynamic Main.hs\r\n[2 of 2] Compiling Main ( Main.hs, Main.o ) [MyPlugin changed]\r\n>>> Plugin Init\r\n>>> Plugin Solve\r\n>>> Plugin Solve\r\n>>> Plugin Stop\r\nLinking Main ...\r\n}}}\r\nWhich means `tcPluginStop` _was_ called.\r\n\r\n=== Possible solution\r\n\r\nAs far as I can see, the solution to this should be to change the plugin code at the bottom of `typechecker/TcRnDriver.hs` from\r\n{{{#!hs\r\nwithTcPlugins :: HscEnv -> TcM a -> TcM a\r\nwithTcPlugins hsc_env m =\r\n do plugins <- liftIO (loadTcPlugins hsc_env)\r\n case plugins of\r\n [] -> m -- Common fast case\r\n _ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins\r\n res <- updGblEnv (\\e -> e { tcg_tc_plugins = solvers }) m\r\n mapM_ runTcPluginM stops\r\n return res\r\n where\r\n startPlugin (TcPlugin start solve stop) =\r\n do s <- runTcPluginM start\r\n return (solve s, stop s)\r\n}}}\r\nto\r\n{{{#!hs\r\nwithTcPlugins :: HscEnv -> TcM a -> TcM a\r\nwithTcPlugins hsc_env m =\r\n do plugins <- liftIO (loadTcPlugins hsc_env)\r\n case plugins of\r\n [] -> m -- Common fast case\r\n _ -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins\r\n eitherRes <- tryM $ do updGblEnv (\\e -> e { tcg_tc_plugins = solvers }) m\r\n mapM_ runTcPluginM stops\r\n case eitherRes of\r\n Left e -> failM\r\n Right res -> return res\r\n where\r\n startPlugin (TcPlugin start solve stop) =\r\n do s <- runTcPluginM start\r\n return (solve s, stop s)\r\n}}}\r\n.\r\n\r\nI have tried this. It compiles and my minimal example delivers the correct result.\r\n\r\nAre there any arguments against this change? If not, I would try to commit a patch for this problem sometime this weekend.","type_of_failure":"OtherFailure","blocking":[]} -->7.10.1jbrackerjbracker