Frontend plugins.

Summary:
Frontend plugins enable users to write plugins to replace
GHC major modes.  E.g. instead of saying

    ghc --make A B C

a user can now say

    ghc --frontend GHC.Frontend.Shake A B C

which might provide an alternative implementation of a multi-module
build.  For more details, see the manual entry.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonmar, bgamari, austin, simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1598

GHC Trac Issues: #11194

4 files changed, 34 insertions, 7 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 4aedc43054..3dfd1ef660 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -780,6 +780,7 @@ data DynFlags = DynFlags {
   -- Plugins
   pluginModNames        :: [ModuleName],
   pluginModNameOpts     :: [(ModuleName,String)],
+  frontendPluginOpts    :: [String],
 
   -- GHC API hooks
   hooks                 :: Hooks,
@@ -1504,6 +1505,7 @@ defaultDynFlags mySettings =
 
         pluginModNames          = [],
         pluginModNameOpts       = [],
+        frontendPluginOpts      = [],
         hooks                   = emptyHooks,
 
         outputFile              = Nothing,
@@ -1986,6 +1988,9 @@ addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, o
           [] -> "" -- should probably signal an error
           (_:plug_opt) -> plug_opt -- ignore the ':' from break
 
+addFrontendPluginOption :: String -> DynFlags -> DynFlags
+addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d }
+
 parseDynLibLoaderMode f d =
  case splitAt 8 f of
    ("deploy", "")       -> d{ dynLibLoader = Deployable }
@@ -2594,6 +2599,7 @@ dynamic_flags = [
         ------ Plugin flags ------------------------------------------------
   , defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)
   , defGhcFlag "fplugin"     (hasArg addPluginModuleName)
+  , defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption)
 
         ------ Optimisation flags ------------------------------------------
   , defGhcFlag "O"      (noArgM (setOptLevel 1))
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index 5942d6c91c..0d4b84252f 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -5,6 +5,7 @@ module DynamicLoading (
 #ifdef GHCI
         -- * Loading plugins
         loadPlugins,
+        loadFrontendPlugin,
 
         -- * Force loading information
         forceLoadModuleInterfaces,
@@ -30,11 +31,11 @@ import LoadIface        ( loadPluginInterface )
 import RdrName          ( RdrName, ImportSpec(..), ImpDeclSpec(..)
                         , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
                         , gre_name, mkRdrQual )
-import OccName          ( mkVarOcc )
+import OccName          ( OccName, mkVarOcc )
 import RnNames          ( gresFromAvails )
 import DynFlags
-import Plugins          ( Plugin, CommandLineOption )
-import PrelNames        ( pluginTyConName )
+import Plugins          ( Plugin, FrontendPlugin, CommandLineOption )
+import PrelNames        ( pluginTyConName, frontendPluginTyConName )
 
 import HscTypes
 import BasicTypes       ( HValue )
@@ -68,8 +69,14 @@ loadPlugins hsc_env
                             , opt_mod_nm == mod_nm ]
 
 loadPlugin :: HscEnv -> ModuleName -> IO Plugin
-loadPlugin hsc_env mod_name
-  = do { let plugin_rdr_name = mkRdrQual mod_name (mkVarOcc "plugin")
+loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName
+
+loadFrontendPlugin :: HscEnv -> ModuleName -> IO FrontendPlugin
+loadFrontendPlugin = loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
+
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO a
+loadPlugin' occ_name plugin_name hsc_env mod_name
+  = do { let plugin_rdr_name = mkRdrQual mod_name occ_name
              dflags = hsc_dflags hsc_env
        ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name
                         plugin_rdr_name
@@ -81,7 +88,7 @@ loadPlugin hsc_env mod_name
                           , ppr plugin_rdr_name ]) ;
             Just name ->
 
-     do { plugin_tycon <- forceLoadTyCon hsc_env pluginTyConName
+     do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
         ; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
         ; case mb_plugin of
             Nothing ->
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index d936e288b4..6a8c761db8 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -1,10 +1,13 @@
 module Plugins (
+    FrontendPlugin(..), defaultFrontendPlugin,
     Plugin(..), CommandLineOption,
     defaultPlugin
     ) where
 
 import CoreMonad ( CoreToDo, CoreM )
 import TcRnTypes ( TcPlugin )
+import GhcMonad
+import DriverPhases
 
 
 -- | Command line options gathered from the -PModule.Name:stuff syntax
@@ -36,3 +39,10 @@ defaultPlugin = Plugin {
         installCoreToDos = const return
       , tcPlugin         = const Nothing
     }
+
+type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
+data FrontendPlugin = FrontendPlugin {
+      frontend :: FrontendPluginAction
+    }
+defaultFrontendPlugin :: FrontendPlugin
+defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index a9b43227f5..a963a07f30 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -345,6 +345,7 @@ basicKnownKeyNames
 
         -- Plugins
         , pluginTyConName
+        , frontendPluginTyConName
 
         -- Generics
         , genClassName, gen1ClassName
@@ -1347,6 +1348,8 @@ pLUGINS :: Module
 pLUGINS = mkThisGhcModule (fsLit "Plugins")
 pluginTyConName :: Name
 pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey
+frontendPluginTyConName :: Name
+frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey
 
 -- Static pointers
 staticPtrInfoTyConName :: Name
@@ -1606,8 +1609,9 @@ constraintKindTyConKey                  = mkPreludeTyConUnique 92
 starKindTyConKey                        = mkPreludeTyConUnique 93
 unicodeStarKindTyConKey                 = mkPreludeTyConUnique 94
 
-pluginTyConKey :: Unique
+pluginTyConKey, frontendPluginTyConKey :: Unique
 pluginTyConKey                          = mkPreludeTyConUnique 102
+frontendPluginTyConKey                  = mkPreludeTyConUnique 103
 
 unknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey,
     opaqueTyConKey :: Unique