0001-Adds-Plugins-with-installHook-capability.diff

From 70cc0573a842be39f01227051d27209c55a4956d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz@lichtzwerge.de>
Date: Mon, 24 Nov 2014 18:34:18 +0100
Subject: [PATCH] Adds Plugins with installHook capability.

---
 compiler/simplCore/CoreMonad.lhs |  2 ++
 compiler/simplCore/SimplCore.lhs |  6 +++++-
 ghc/Main.hs                      | 30 ++++++++++++++++++++++++++++++
 3 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 7f45850..62c8e89 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -508,6 +508,7 @@ 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.
+        , installHooks :: [CommandLineOption] -> DynFlags -> DynFlags
      }
 
 -- | Default plugin: does nothing at all! For compatability reasons you should base all your
@@ -515,6 +516,7 @@ data Plugin = Plugin {
 defaultPlugin :: Plugin
 defaultPlugin = Plugin {
         installCoreToDos = const return
+        , installHooks = const id
     }
 
 -- | A description of the plugin pass itself
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index c487c98..44b48ba 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -4,7 +4,11 @@
 \section[SimplCore]{Driver for simplifying @Core@ programs}
 
 \begin{code}
-module SimplCore ( core2core, simplifyExpr ) where
+module SimplCore ( core2core, simplifyExpr
+#ifdef GHCI
+                 , loadPlugins
+#endif
+) where
 
 #include "HsVersions.h"
 
diff --git a/ghc/Main.hs b/ghc/Main.hs
index d8be08a..877684b 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -26,6 +26,9 @@ import DriverPipeline   ( oneShot, compileFile )
 import DriverMkDepend   ( doMkDependHS )
 #ifdef GHCI
 import InteractiveUI    ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
+-- plugins
+import SimplCore        ( loadPlugins )
+import CoreMonad        ( Plugin(..), CommandLineOption )
 #endif
 
 
@@ -205,7 +208,23 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   -- we've finished manipulating the DynFlags, update the session
   _ <- GHC.setSessionDynFlags dflags5
+  
+  -- to enable the hook plugins.
+#ifdef GHCI
+  dflags6' <- GHC.getSessionDynFlags
+  -- load any pipeline modules
+  hsc_env0 <- GHC.getSession
+  named_plugins <- liftIO (loadPlugins hsc_env0)
+
+  let dflags6'' = foldr installPluginHooks dflags6' named_plugins
+
+  -- we've allowed to manipulating the DynFlags, update the session
+  _ <- GHC.setSessionDynFlags dflags6''
+#endif
+
   dflags6 <- GHC.getSessionDynFlags
+
+  -- get the hsc_env
   hsc_env <- GHC.getSession
 
         ---------------- Display configuration -----------
@@ -233,6 +252,17 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   liftIO $ dumpFinalStats dflags6
 
+#ifdef GHCI
+  where
+    installPluginHooks :: (GHC.ModuleName, Plugin)
+                       -> DynFlags -> DynFlags
+    installPluginHooks (mod_nm, plug) dflags = installHooks plug options dflags
+      where
+        options :: [CommandLineOption]
+        options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
+                           , opt_mod_nm == mod_nm ]
+#endif
+
 ghciUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
 #ifndef GHCI
 ghciUI _ _ = throwGhcException (CmdLineError "not built for interactive use")
-- 
2.1.3