1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
-- \section[Hooks]{Low level API hooks}
-- NB: this module is SOURCE-imported by DynFlags, and should primarily
-- refer to *types*, rather than *code*
{-# LANGUAGE CPP #-}
module Hooks ( Hooks
, emptyHooks
, lookupHook
, getHooked
-- the hooks:
, dsForeignsHook
, tcForeignImportsHook
, tcForeignExportsHook
, hscFrontendHook
, hscCompileCoreExprHook
, ghcPrimIfaceHook
, runPhaseHook
, runMetaHook
, linkHook
, runRnSpliceHook
, getValueSafelyHook
, createIservProcessHook
) where
import GhcPrelude
import DynFlags
import PipelineMonad
import HscTypes
import HsDecls
import HsBinds
import HsExpr
import OrdList
import TcRnTypes
import Bag
import RdrName
import Name
import Id
import CoreSyn
import GHCi.RemoteTypes
import SrcLoc
import Type
import System.Process
import BasicTypes
import HsExtension
import Data.Maybe
{-
************************************************************************
* *
\subsection{Hooks}
* *
************************************************************************
-}
-- | 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
{ dsForeignsHook = Nothing
, tcForeignImportsHook = Nothing
, tcForeignExportsHook = Nothing
, hscFrontendHook = Nothing
, hscCompileCoreExprHook = Nothing
, ghcPrimIfaceHook = Nothing
, runPhaseHook = Nothing
, runMetaHook = Nothing
, linkHook = Nothing
, runRnSpliceHook = Nothing
, getValueSafelyHook = Nothing
, createIservProcessHook = Nothing
}
data Hooks = Hooks
{ dsForeignsHook :: Maybe ([LForeignDecl GhcTc]
-> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
, tcForeignImportsHook :: Maybe ([LForeignDecl GhcRn]
-> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
, tcForeignExportsHook :: Maybe ([LForeignDecl GhcRn]
-> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt))
, hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
, hscCompileCoreExprHook ::
Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
, ghcPrimIfaceHook :: Maybe ModIface
, runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags
-> CompPipeline (PhasePlus, FilePath))
, runMetaHook :: Maybe (MetaHook TcM)
, linkHook :: Maybe (GhcLink -> DynFlags -> Bool
-> HomePackageTable -> IO SuccessFlag)
, runRnSpliceHook :: Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
, getValueSafelyHook :: Maybe (HscEnv -> Name -> Type
-> IO (Maybe HValue))
, createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
}
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
|
