[GHC] #10078: tcPluginStop of a type checker plugin is not called if an error occurs

[GHC]

#10078: tcPluginStop of a type checker plugin is not called if an error occurs
-------------------------------------+-------------------------------------
              Reporter:  jbracker    |             Owner:
                  Type:  bug         |            Status:  new
              Priority:  normal      |         Milestone:
             Component:  Compiler    |           Version:  7.11
  (Type checker)                     |  Operating System:  Linux
              Keywords:              |   Type of failure:  Incorrect result
          Architecture:  x86_64      |  at runtime
  (amd64)                            |        Blocked By:
             Test Case:              |   Related Tickets:
              Blocking:              |
Differential Revisions:              |
-------------------------------------+-------------------------------------
 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.

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10078>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler