Make TcPlugin part of Plugin so we can eliminate -ftc-pluginwip/tc-plugins

6 files changed, 31 insertions, 55 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d3fbe16f1d..fbfd17e9a9 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -26,7 +26,6 @@ module DynFlags (
         PlatformConstants(..),
         FatalMessager, LogAction, FlushOut(..), FlushErr(..),
         ProfAuto(..),
-        PluginType(..),
         glasgowExtsFlags,
         dopt, dopt_set, dopt_unset,
         gopt, gopt_set, gopt_unset,
@@ -617,8 +616,6 @@ getSigOf dflags n =
         SigOf m -> Just m
         SigOfMap m -> Map.lookup n m
 
-data PluginType = PluginCore2Core | PluginTypeCheck
-
 -- | Contains not only a collection of 'GeneralFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
@@ -721,7 +718,7 @@ data DynFlags = DynFlags {
   hpcDir                :: String,      -- ^ Path to store the .mix files
 
   -- Plugins
-  pluginModNames        :: [(ModuleName, PluginType)],
+  pluginModNames        :: [ModuleName],
   pluginModNameOpts     :: [(ModuleName, String)],
 
   -- GHC API hooks
@@ -1731,7 +1728,7 @@ setLanguage l = upd (`lang_set` Just l)
 
 -- | Some modules have dependencies on others through the DynFlags rather than textual imports
 dynFlagDependencies :: DynFlags -> [ModuleName]
-dynFlagDependencies = map fst . pluginModNames
+dynFlagDependencies = pluginModNames
 
 -- | Is the -fpackage-trust mode on
 packageTrustOn :: DynFlags -> Bool
@@ -1882,9 +1879,9 @@ parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of
 setSigOf :: String -> DynFlags -> DynFlags
 setSigOf s d = d { sigOf = parseSigOf s }
 
-addPluginModuleName :: PluginType -> String -> DynFlags -> DynFlags
-addPluginModuleName pty name d =
-  d { pluginModNames = (mkModuleName name, pty) : (pluginModNames d) }
+addPluginModuleName :: String -> DynFlags -> DynFlags
+addPluginModuleName name d =
+  d { pluginModNames = mkModuleName name : pluginModNames d }
 
 addPluginModuleNameOption :: String -> DynFlags -> DynFlags
 addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
@@ -2459,8 +2456,7 @@ dynamic_flags = [
 
         ------ Plugin flags ------------------------------------------------
   , Flag "fplugin-opt"    (hasArg addPluginModuleNameOption)
-  , Flag "fplugin"        (hasArg (addPluginModuleName PluginCore2Core))
-  , Flag "ftc-plugin"     (hasArg (addPluginModuleName PluginTypeCheck))
+  , Flag "fplugin"        (hasArg addPluginModuleName)
 
         ------ Optimisation flags ------------------------------------------
   , Flag "O"      (noArgM (setOptLevel 1))
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index c89b544826..87b97f2839 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -33,7 +33,7 @@ import RdrName          ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(.
 import OccName          ( mkVarOcc )
 import RnNames          ( gresFromAvails )
 import DynFlags
-import Plugins          ( Plugin )
+import Plugins          ( Plugin, CommandLineOption )
 import PrelNames        ( pluginTyConName )
 
 import HscTypes
@@ -55,12 +55,18 @@ import Data.Maybe        ( mapMaybe )
 import GHC.Exts          ( unsafeCoerce# )
 
 
-loadPlugins :: HscEnv -> IO [(ModuleName, Plugin)]
+loadPlugins :: HscEnv -> IO [(ModuleName, Plugin, [CommandLineOption])]
 loadPlugins hsc_env
-  = do { let to_load = [ m | (m,PluginCore2Core) <-
-                                    pluginModNames (hsc_dflags hsc_env) ]
-       ; plugins <- mapM (loadPlugin hsc_env) to_load
-       ; return $ to_load `zip` plugins }
+  = do { plugins <- mapM (loadPlugin hsc_env) to_load
+       ; return $ map attachOptions $ to_load `zip` plugins }
+  where
+    dflags  = hsc_dflags hsc_env
+    to_load = pluginModNames dflags
+
+    attachOptions (mod_nm, plug) = (mod_nm, plug, options)
+      where
+        options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
+                            , opt_mod_nm == mod_nm ]
 
 loadPlugin :: HscEnv -> ModuleName -> IO Plugin
 loadPlugin hsc_env mod_name
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index ccce5be60c..7e8ce5b41c 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -4,6 +4,7 @@ module Plugins (
     ) where
 
 import CoreMonad ( CoreToDo, CoreM )
+import TcRnTypes ( TcPlugin )
 
 
 -- | Command line options gathered from the -PModule.Name:stuff syntax are given to you as this type
@@ -21,6 +22,8 @@ data Plugin = Plugin {
                 -- This is called as the Core pipeline is built for every module
                 --  being compiled, and plugins get the opportunity to modify
                 -- the pipeline in a nondeterministic order.
+      , tcPlugin :: [CommandLineOption] -> Maybe TcPlugin
+                -- ^ A type-checker plugin (TODO document)
      }
 
 -- | Default plugin: does nothing at all! For compatability reasons you should base all your
@@ -28,4 +31,5 @@ data Plugin = Plugin {
 defaultPlugin :: Plugin
 defaultPlugin = Plugin {
         installCoreToDos = const return
+      , tcPlugin         = const Nothing
     }
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 974e045b94..1cfd9bd1e7 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -325,11 +325,8 @@ addPluginPasses dflags builtin_passes
        ; named_plugins <- liftIO (loadPlugins hsc_env)
        ; foldM query_plug builtin_passes named_plugins }
   where
-    query_plug todos (mod_nm, plug)
+    query_plug todos (mod_nm, plug, options)
        = installCoreToDos plug options todos
-       where
-         options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
-                            , opt_mod_nm == mod_nm ]
 #endif
 \end{code}
 
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 4544ef74f2..aed04c227d 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -95,9 +95,8 @@ import RnExpr
 import MkId
 import TidyPgm    ( globaliseAndTidyId )
 import TysWiredIn ( unitTy, mkListTy )
-import DynamicLoading ( forceLoadTyCon, getValueSafely
-                      , lookupRdrNameInModuleForPlugins )
-import Panic ( throwGhcExceptionIO, GhcException(CmdLineError) )
+import DynamicLoading ( loadPlugins )
+import Plugins ( tcPlugin )
 #endif
 import TidyPgm    ( mkBootModDetailsTc )
 
@@ -2032,8 +2031,8 @@ withTcPlugins hsc_env m =
                 mapM_ runTcPluginM stops
                 return res
   where
-  startPlugin (TcPlugin start solve stop, opts) =
-    do s <- runTcPluginM (start opts)
+  startPlugin (TcPlugin start solve stop) =
+    do s <- runTcPluginM start
        return (solve s, stop s)
 
 -- | Perform some IO, typically to interact with an external tool.
@@ -2045,38 +2044,12 @@ tcPluginTrace :: String -> SDoc -> TcPluginM ()
 tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)
 
 
-loadTcPlugins :: HscEnv -> IO [ (TcPlugin, [String]) ]
+loadTcPlugins :: HscEnv -> IO [TcPlugin]
 #ifndef GHCI
 loadTcPlugins _ = return []
 #else
 loadTcPlugins hsc_env =
-  mapM load [ m | (m, PluginTypeCheck) <- pluginModNames dflags ]
-  where
-  dflags    = hsc_dflags hsc_env
-  getOpts mod_name = [ opt | (m,opt) <- pluginModNameOpts dflags
-                           , m == mod_name ]
-  load mod_name =
-    do let plugin_rdr_name = mkRdrQual mod_name (mkVarOcc "tcPlugin")
-       mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name
-                                                            plugin_rdr_name
-       case mb_name of
-         Nothing ->
-             throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
-                       [ ptext (sLit "The module"), ppr mod_name
-                       , ptext (sLit "did not export the plugin name")
-                       , ppr plugin_rdr_name ])
-         Just name ->
-
-           do tcPluginTycon <- forceLoadTyCon hsc_env tcPluginTyConName
-              let ty = mkTyConTy tcPluginTycon
-              mb_plugin <- getValueSafely hsc_env name ty
-              case mb_plugin of
-                Nothing ->
-                    throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $ hsep
-                        [ ptext (sLit "The value"), ppr name
-                        , ptext (sLit "did not have the type")
-                        , ppr ty, ptext (sLit "as required")
-                        ]
-                Just plugin -> return (plugin, getOpts mod_name)
+ do named_plugins <- loadPlugins hsc_env
+    return $ catMaybes $ map (\ (_, plug, opts) -> tcPlugin plug opts) named_plugins
 #endif
 \end{code}
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 57b2ec2692..3e0c053fd2 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -2006,7 +2006,7 @@ unsafeTcPluginTcM :: TcM a -> TcPluginM a
 unsafeTcPluginTcM = TcPluginM
 
 data TcPlugin = forall s. TcPlugin
-  { tcPluginInit  :: [String] -> TcPluginM s
+  { tcPluginInit  :: TcPluginM s
     -- ^ Initialize plugin, when entering type-checker.
 
   , tcPluginSolve :: s -> TcPluginSolver