-- \section[Hooks]{Low level API hooks}

-- NB: this module is SOURCE-imported by DynFlags, and should primarily
--     refer to *types*, rather than *code*

{-# LANGUAGE RankNTypes, TypeFamilies #-}

module GHC.Driver.Hooks
   ( Hooks
   , HasHooks (..)
   , ContainsHooks (..)
   , emptyHooks
     -- the hooks:
   , DsForeignsHook
   , dsForeignsHook
   , tcForeignImportsHook
   , tcForeignExportsHook
   , hscFrontendHook
   , hscCompileCoreExprHook
   , ghcPrimIfaceHook
   , runPhaseHook
   , runMetaHook
   , linkHook
   , runRnSpliceHook
   , getValueSafelyHook
   , createIservProcessHook
   , stgToCmmHook
   , cmmToRawCmmHook
   )
where

import GHC.Prelude

import GHC.Driver.Env
import GHC.Driver.DynFlags
import GHC.Driver.Pipeline.Phases

import GHC.Hs.Decls
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Extension

import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Id
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.CostCentre
import GHC.Types.IPE
import GHC.Types.Meta

import GHC.Unit.Module
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.ModIface
import GHC.Unit.Home.ModInfo

import GHC.Core
import GHC.Core.TyCon
import GHC.Core.Type

import GHC.Tc.Types
import GHC.Stg.Syntax
import GHC.StgToCmm.CgUtils (CgStream)
import GHC.StgToCmm.Types (ModuleLFInfos)
import GHC.StgToCmm.Config
import GHC.Cmm

import GHCi.RemoteTypes

import GHC.Data.Bag

import qualified Data.Kind
import System.Process
import GHC.Linker.Types

{-
************************************************************************
*                                                                      *
\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
emptyHooks = Hooks
  { dsForeignsHook :: Maybe DsForeignsHook
dsForeignsHook         = Maybe DsForeignsHook
forall a. Maybe a
Nothing
  , tcForeignImportsHook :: Maybe
  ([LForeignDecl GhcRn]
   -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignImportsHook   = Maybe
  ([LForeignDecl GhcRn]
   -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
Maybe
  ([GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
   -> TcM
        ([Id], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
         Bag GlobalRdrElt))
forall a. Maybe a
Nothing
  , tcForeignExportsHook :: Maybe
  ([LForeignDecl GhcRn]
   -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignExportsHook   = Maybe
  ([LForeignDecl GhcRn]
   -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
Maybe
  ([GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
   -> TcM
        ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)],
         [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt))
forall a. Maybe a
Nothing
  , hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook        = Maybe (ModSummary -> Hsc FrontendResult)
forall a. Maybe a
Nothing
  , hscCompileCoreExprHook :: Maybe
  (HscEnv
   -> SrcSpan
   -> CoreExpr
   -> IO (ForeignHValue, [Linkable], PkgsLoaded))
hscCompileCoreExprHook = Maybe
  (HscEnv
   -> SrcSpan
   -> CoreExpr
   -> IO (ForeignHValue, [Linkable], PkgsLoaded))
forall a. Maybe a
Nothing
  , ghcPrimIfaceHook :: Maybe ModIface
ghcPrimIfaceHook       = Maybe ModIface
forall a. Maybe a
Nothing
  , runPhaseHook :: Maybe PhaseHook
runPhaseHook           = Maybe PhaseHook
forall a. Maybe a
Nothing
  , runMetaHook :: Maybe (MetaHook TcM)
runMetaHook            = Maybe (MetaHook TcM)
Maybe
  (MetaRequest
   -> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> TcM MetaResult)
forall a. Maybe a
Nothing
  , linkHook :: Maybe
  (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook               = Maybe
  (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
forall a. Maybe a
Nothing
  , runRnSpliceHook :: Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn))
runRnSpliceHook        = Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn))
forall a. Maybe a
Nothing
  , getValueSafelyHook :: Maybe
  (HscEnv
   -> Name
   -> Type
   -> IO (Either Type (HValue, [Linkable], PkgsLoaded)))
getValueSafelyHook     = Maybe
  (HscEnv
   -> Name
   -> Type
   -> IO (Either Type (HValue, [Linkable], PkgsLoaded)))
forall a. Maybe a
Nothing
  , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
createIservProcessHook = Maybe (CreateProcess -> IO ProcessHandle)
forall a. Maybe a
Nothing
  , stgToCmmHook :: Maybe
  (StgToCmmConfig
   -> InfoTableProvMap
   -> [TyCon]
   -> CollectedCCs
   -> [CgStgTopBinding]
   -> CgStream CmmGroup ModuleLFInfos)
stgToCmmHook           = Maybe
  (StgToCmmConfig
   -> InfoTableProvMap
   -> [TyCon]
   -> CollectedCCs
   -> [CgStgTopBinding]
   -> CgStream CmmGroup ModuleLFInfos)
forall a. Maybe a
Nothing
  , cmmToRawCmmHook :: forall a.
Maybe
  (DynFlags
   -> Maybe Module
   -> CgStream CmmGroupSRTs a
   -> IO (CgStream RawCmmGroup a))
cmmToRawCmmHook        = Maybe
  (DynFlags
   -> Maybe Module
   -> CgStream CmmGroupSRTs a
   -> IO (CgStream RawCmmGroup a))
forall a. Maybe a
forall a.
Maybe
  (DynFlags
   -> Maybe Module
   -> CgStream CmmGroupSRTs a
   -> IO (CgStream RawCmmGroup a))
Nothing
  }

{- Note [The Decoupling Abstract Data Hack]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The "Abstract Data" idea is due to Richard Eisenberg in
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1957, where the pattern is
described in more detail.

Here we use it as a temporary measure to break the dependency from the Parser on
the Desugarer until the parser is free of DynFlags. We introduced a nullary type
family @DsForeignsook@, whose single definition is in GHC.HsToCore.Types, where
we instantiate it to

   [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr))

In doing so, the Hooks module (which is an hs-boot dependency of DynFlags) can
be decoupled from its use of the DsM definition in GHC.HsToCore.Types. Since
both DsM and the definition of @ForeignsHook@ live in the same module, there is
virtually no difference for plugin authors that want to write a foreign hook.

An awkward consequences is that the `type instance DsForeignsHook`, in
GHC.HsToCore.Types is an orphan instance.
-}

-- See Note [The Decoupling Abstract Data Hack]
type family DsForeignsHook :: Data.Kind.Type

data Hooks = Hooks
  { Hooks -> Maybe DsForeignsHook
dsForeignsHook         :: !(Maybe DsForeignsHook)
  -- ^ Actual type:
  -- @Maybe ([LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))@
  , Hooks
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignImportsHook   :: !(Maybe ([LForeignDecl GhcRn]
                          -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)))
  , Hooks
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignExportsHook   :: !(Maybe ([LForeignDecl GhcRn]
            -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)))
  , Hooks -> Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook        :: !(Maybe (ModSummary -> Hsc FrontendResult))
  , Hooks
-> Maybe
     (HscEnv
      -> SrcSpan
      -> CoreExpr
      -> IO (ForeignHValue, [Linkable], PkgsLoaded))
hscCompileCoreExprHook :: !(Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)))
  , Hooks -> Maybe ModIface
ghcPrimIfaceHook       :: !(Maybe ModIface)
  , Hooks -> Maybe PhaseHook
runPhaseHook           :: !(Maybe PhaseHook)
  , Hooks -> Maybe (MetaHook TcM)
runMetaHook            :: !(Maybe (MetaHook TcM))
  , Hooks
-> Maybe
     (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook               :: !(Maybe (GhcLink -> DynFlags -> Bool
                                         -> HomePackageTable -> IO SuccessFlag))
  , Hooks
-> Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn))
runRnSpliceHook        :: !(Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn)))
  , Hooks
-> Maybe
     (HscEnv
      -> Name
      -> Type
      -> IO (Either Type (HValue, [Linkable], PkgsLoaded)))
getValueSafelyHook     :: !(Maybe (HscEnv -> Name -> Type
                                         -> IO (Either Type (HValue, [Linkable], PkgsLoaded))))
  , Hooks -> Maybe (CreateProcess -> IO ProcessHandle)
createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))
  , Hooks
-> Maybe
     (StgToCmmConfig
      -> InfoTableProvMap
      -> [TyCon]
      -> CollectedCCs
      -> [CgStgTopBinding]
      -> CgStream CmmGroup ModuleLFInfos)
stgToCmmHook           :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs
                                 -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos))
  , Hooks
-> forall a.
   Maybe
     (DynFlags
      -> Maybe Module
      -> CgStream CmmGroupSRTs a
      -> IO (CgStream RawCmmGroup a))
cmmToRawCmmHook        :: !(forall a . Maybe (DynFlags -> Maybe Module -> CgStream CmmGroupSRTs a
                                 -> IO (CgStream RawCmmGroup a)))
  }

class HasHooks m where
    getHooks :: m Hooks

class ContainsHooks a where
    extractHooks :: a -> Hooks