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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
-- \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
, stgToCmmHook
, cmmToRawCmmHook
) where
import GhcPrelude
import DynFlags
import PipelineMonad
import HscTypes
import GHC.Hs.Decls
import GHC.Hs.Binds
import GHC.Hs.Expr
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 Module
import TyCon
import CostCentre
import GHC.Stg.Syntax
import Stream
import Cmm
import GHC.Hs.Extension
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
, stgToCmmHook = Nothing
, cmmToRawCmmHook = 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)
, stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs
-> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ())
, cmmToRawCmmHook :: Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroup ()
-> IO (Stream IO RawCmmGroup ()))
}
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
|
