never executed always true always false
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
6 {-# LANGUAGE RankNTypes, TypeFamilies #-}
7
8 module GHC.Driver.Hooks
9 ( Hooks
10 , HasHooks (..)
11 , ContainsHooks (..)
12 , emptyHooks
13 -- the hooks:
14 , DsForeignsHook
15 , dsForeignsHook
16 , tcForeignImportsHook
17 , tcForeignExportsHook
18 , hscFrontendHook
19 , hscCompileCoreExprHook
20 , ghcPrimIfaceHook
21 , runPhaseHook
22 , runMetaHook
23 , linkHook
24 , runRnSpliceHook
25 , getValueSafelyHook
26 , createIservProcessHook
27 , stgToCmmHook
28 , cmmToRawCmmHook
29 )
30 where
31
32 import GHC.Prelude
33
34 import GHC.Driver.Env
35 import GHC.Driver.Session
36 import GHC.Driver.Pipeline.Phases
37
38 import GHC.Hs.Decls
39 import GHC.Hs.Binds
40 import GHC.Hs.Expr
41 import GHC.Hs.Extension
42
43 import GHC.Types.Name.Reader
44 import GHC.Types.Name
45 import GHC.Types.Id
46 import GHC.Types.SrcLoc
47 import GHC.Types.Basic
48 import GHC.Types.CostCentre
49 import GHC.Types.IPE
50 import GHC.Types.Meta
51 import GHC.Types.HpcInfo
52
53 import GHC.Unit.Module
54 import GHC.Unit.Module.ModSummary
55 import GHC.Unit.Module.ModIface
56 import GHC.Unit.Home.ModInfo
57
58 import GHC.Core
59 import GHC.Core.TyCon
60 import GHC.Core.Type
61
62 import GHC.Tc.Types
63 import GHC.Stg.Syntax
64 import GHC.StgToCmm.Types (ModuleLFInfos)
65 import GHC.Cmm
66
67 import GHCi.RemoteTypes
68
69 import GHC.Data.Stream
70 import GHC.Data.Bag
71
72 import qualified Data.Kind
73 import System.Process
74
75 {-
76 ************************************************************************
77 * *
78 \subsection{Hooks}
79 * *
80 ************************************************************************
81 -}
82
83 -- | Hooks can be used by GHC API clients to replace parts of
84 -- the compiler pipeline. If a hook is not installed, GHC
85 -- uses the default built-in behaviour
86
87 emptyHooks :: Hooks
88 emptyHooks = Hooks
89 { dsForeignsHook = Nothing
90 , tcForeignImportsHook = Nothing
91 , tcForeignExportsHook = Nothing
92 , hscFrontendHook = Nothing
93 , hscCompileCoreExprHook = Nothing
94 , ghcPrimIfaceHook = Nothing
95 , runPhaseHook = Nothing
96 , runMetaHook = Nothing
97 , linkHook = Nothing
98 , runRnSpliceHook = Nothing
99 , getValueSafelyHook = Nothing
100 , createIservProcessHook = Nothing
101 , stgToCmmHook = Nothing
102 , cmmToRawCmmHook = Nothing
103 }
104
105 {- Note [The Decoupling Abstract Data Hack]
106 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
107 The "Abstract Data" idea is due to Richard Eisenberg in
108 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1957, where the pattern is
109 described in more detail.
110
111 Here we use it as a temporary measure to break the dependency from the Parser on
112 the Desugarer until the parser is free of DynFlags. We introduced a nullary type
113 family @DsForeignsook@, whose single definition is in GHC.HsToCore.Types, where
114 we instantiate it to
115
116 [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr))
117
118 In doing so, the Hooks module (which is an hs-boot dependency of DynFlags) can
119 be decoupled from its use of the DsM definition in GHC.HsToCore.Types. Since
120 both DsM and the definition of @ForeignsHook@ live in the same module, there is
121 virtually no difference for plugin authors that want to write a foreign hook.
122 -}
123
124 -- See Note [The Decoupling Abstract Data Hack]
125 type family DsForeignsHook :: Data.Kind.Type
126
127 data Hooks = Hooks
128 { dsForeignsHook :: !(Maybe DsForeignsHook)
129 -- ^ Actual type:
130 -- @Maybe ([LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))@
131 , tcForeignImportsHook :: !(Maybe ([LForeignDecl GhcRn]
132 -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)))
133 , tcForeignExportsHook :: !(Maybe ([LForeignDecl GhcRn]
134 -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)))
135 , hscFrontendHook :: !(Maybe (ModSummary -> Hsc FrontendResult))
136 , hscCompileCoreExprHook ::
137 !(Maybe (HscEnv -> (SrcSpan, Maybe ModuleNameWithIsBoot) -> CoreExpr -> IO ForeignHValue))
138 , ghcPrimIfaceHook :: !(Maybe ModIface)
139 , runPhaseHook :: !(Maybe PhaseHook)
140 , runMetaHook :: !(Maybe (MetaHook TcM))
141 , linkHook :: !(Maybe (GhcLink -> DynFlags -> Bool
142 -> HomePackageTable -> IO SuccessFlag))
143 , runRnSpliceHook :: !(Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn)))
144 , getValueSafelyHook :: !(Maybe (HscEnv -> Maybe ModuleNameWithIsBoot -> Name -> Type
145 -> IO (Maybe HValue)))
146 , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))
147 , stgToCmmHook :: !(Maybe (DynFlags -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs
148 -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos))
149 , cmmToRawCmmHook :: !(forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a
150 -> IO (Stream IO RawCmmGroup a)))
151 }
152
153 class HasHooks m where
154 getHooks :: m Hooks
155
156 class ContainsHooks a where
157 extractHooks :: a -> Hooks