Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.