tcPluginStop of a type checker plugin is not called if an error occurs

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:

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:

{-# 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:

{-# 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

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

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.

Trac metadata

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