Add hook for creating ghci external interpreter
[ghc.git] / compiler / main / Hooks.hs
1 -- \section[Hooks]{Low level API hooks}
2
3 -- NB: this module is SOURCE-imported by DynFlags, and should primarily
4 -- refer to *types*, rather than *code*
5 -- If you import too muchhere , then the revolting compiler_stage2_dll0_MODULES
6 -- stuff in compiler/ghc.mk makes DynFlags link to too much stuff
7
8 {-# LANGUAGE CPP #-}
9 module Hooks ( Hooks
10 , emptyHooks
11 , lookupHook
12 , getHooked
13 -- the hooks:
14 , dsForeignsHook
15 , tcForeignImportsHook
16 , tcForeignExportsHook
17 , hscFrontendHook
18 #ifdef GHCI
19 , hscCompileCoreExprHook
20 #endif
21 , ghcPrimIfaceHook
22 , runPhaseHook
23 , runMetaHook
24 , linkHook
25 , runRnSpliceHook
26 #ifdef GHCI
27 , getValueSafelyHook
28 , createIservProcessHook
29 #endif
30 ) where
31
32 import DynFlags
33 import Name
34 import PipelineMonad
35 import HscTypes
36 import HsDecls
37 import HsBinds
38 import HsExpr
39 import OrdList
40 import Id
41 import TcRnTypes
42 import Bag
43 import RdrName
44 import CoreSyn
45 #ifdef GHCI
46 import GHCi.RemoteTypes
47 import SrcLoc
48 import Type
49 import System.Process
50 #endif
51 import BasicTypes
52
53 import Data.Maybe
54
55 {-
56 ************************************************************************
57 * *
58 \subsection{Hooks}
59 * *
60 ************************************************************************
61 -}
62
63 -- | Hooks can be used by GHC API clients to replace parts of
64 -- the compiler pipeline. If a hook is not installed, GHC
65 -- uses the default built-in behaviour
66
67 emptyHooks :: Hooks
68 emptyHooks = Hooks
69 { dsForeignsHook = Nothing
70 , tcForeignImportsHook = Nothing
71 , tcForeignExportsHook = Nothing
72 , hscFrontendHook = Nothing
73 #ifdef GHCI
74 , hscCompileCoreExprHook = Nothing
75 #endif
76 , ghcPrimIfaceHook = Nothing
77 , runPhaseHook = Nothing
78 , runMetaHook = Nothing
79 , linkHook = Nothing
80 , runRnSpliceHook = Nothing
81 #ifdef GHCI
82 , getValueSafelyHook = Nothing
83 , createIservProcessHook = Nothing
84 #endif
85 }
86
87 data Hooks = Hooks
88 { dsForeignsHook :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
89 , tcForeignImportsHook :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
90 , tcForeignExportsHook :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
91 , hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
92 #ifdef GHCI
93 , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
94 #endif
95 , ghcPrimIfaceHook :: Maybe ModIface
96 , runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
97 , runMetaHook :: Maybe (MetaHook TcM)
98 , linkHook :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
99 , runRnSpliceHook :: Maybe (HsSplice Name -> RnM (HsSplice Name))
100 #ifdef GHCI
101 , getValueSafelyHook :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
102 , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
103 #endif
104 }
105
106 getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a
107 getHooked hook def = fmap (lookupHook hook def) getDynFlags
108
109 lookupHook :: (Hooks -> Maybe a) -> a -> DynFlags -> a
110 lookupHook hook def = fromMaybe def . hook . hooks