Restructure compilation pipeline to allow hooks

This commit exposes GHC's internal compiler pipeline through a `Hooks`
module in the GHC API. It currently allows you to hook:

 * Foreign import/exports declarations
 * The frontend up to type checking
 * The one shot compilation mode
 * Core compilation, and the module iface
 * Linking and the phases in DriverPhases.hs
 * Quasiquotation

Authored-by: Luite Stegeman <stegeman@gmail.com>
Authored-by: Edsko de Vries <edsko@well-typed.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 80 insertions, 0 deletions

diff --git a/compiler/main/Hooks.lhs b/compiler/main/Hooks.lhs
new file mode 100644
index 0000000000..24bfb104bc
--- /dev/null
+++ b/compiler/main/Hooks.lhs
@@ -0,0 +1,80 @@
+\section[Hooks]{Low level API hooks}
+
+\begin{code}
+module Hooks ( Hooks
+             , emptyHooks
+             , lookupHook
+             , getHooked
+               -- the hooks:
+             , dsForeignsHook
+             , tcForeignImportsHook
+             , tcForeignExportsHook
+             , hscFrontendHook
+             , hscCompileOneShotHook
+             , hscCompileCoreExprHook
+             , ghcPrimIfaceHook
+             , runPhaseHook
+             , linkHook
+             , runQuasiQuoteHook
+             , getValueSafelyHook
+             ) where
+
+import DynFlags
+import HsTypes
+import Name
+import PipelineMonad
+import HscTypes
+import HsDecls
+import HsBinds
+import {-# SOURCE #-} DsMonad
+import OrdList
+import Id
+import TcRnTypes
+import Bag
+import RdrName
+import CoreSyn
+import BasicTypes
+import Type
+import SrcLoc
+
+import Data.Maybe
+\end{code}
+
+%************************************************************************
+%*                                                                      *
+\subsection{Hooks}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+
+-- | Hooks can be used by GHC API clients to replace parts of
+--   the compiler pipeline. If a hook is not installed, GHC
+--   uses the default built-in behaviour
+
+emptyHooks :: Hooks
+emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing Nothing
+                   Nothing Nothing Nothing Nothing Nothing
+
+data Hooks = Hooks
+  { dsForeignsHook         :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
+  , tcForeignImportsHook   :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
+  , tcForeignExportsHook   :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
+  , hscFrontendHook        :: Maybe (ModSummary -> Hsc TcGblEnv)
+  , hscCompileOneShotHook  :: Maybe (HscEnv -> FilePath -> ModSummary -> SourceModified -> IO HscStatus)
+  , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue)
+  , ghcPrimIfaceHook       :: Maybe ModIface
+  , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
+  , linkHook               :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
+  , runQuasiQuoteHook      :: Maybe (HsQuasiQuote Name -> RnM (HsQuasiQuote Name))
+  , getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
+  }
+
+getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a
+getHooked hook def = fmap (lookupHook hook def) getDynFlags
+
+lookupHook :: (Hooks -> Maybe a) -> a -> DynFlags -> a
+lookupHook hook def = fromMaybe def . hook . hooks
+
+\end{code}
+