    {-|
      Copyright   :  (C) 2013-2016, University of Twente,
                         2016-2017, Myrtle Software Ltd
                         2022-2024, QBayLogic B.V.
      License     :  BSD2 (see the file LICENSE)
      Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TupleSections #-}

    module Clash.GHC.LoadInterfaceFiles
      ( loadExternalExprs
      , loadExternalBinders
      , getUnresolvedPrimitives
      , LoadedBinders(..)
      )
    where

    -- External Modules
    import           Control.Monad.IO.Class      (MonadIO (..))
    import           Control.Monad               (forM_, join)
    import           Control.Monad.State.Strict
      (StateT, gets, MonadState (get), MonadTrans (lift), execStateT)
    import           Control.Monad.Trans.State.Strict (modify)
    import           Control.Monad.Extra         (unlessM)
    import qualified Data.ByteString.Lazy.UTF8   as BLU
    import qualified Data.ByteString.Lazy        as BL
    import qualified Data.Sequence               as Seq
    import           Data.Sequence               (Seq)
    import           Data.Either                 (partitionEithers)
    #if !MIN_VERSION_base(4,20,0)
    import           Data.Foldable               (foldl')
    #endif
    import           Data.List                   (elemIndex)
    import qualified Data.Text                   as Text
    import           Data.Maybe                  (isNothing, mapMaybe, catMaybes)
    import           Data.Map.Strict             (Map)
    import qualified Data.Map.Strict             as Map
    import           Data.Set                    (Set)
    import qualified Data.Set                    as Set
    import           Data.Word                   (Word8)

    -- GHC
    #if MIN_VERSION_ghc(9,8,0)
    import GHC.Types.Error (defaultOpts)
    import GHC.Iface.Errors.Ppr (missingInterfaceErrorDiagnostic)
    #endif
    #if MIN_VERSION_ghc(9,4,0)
    import           GHC.Driver.Env.KnotVars (emptyKnotVars)
    #endif
    #if MIN_VERSION_ghc(9,0,0)
    import           GHC.Types.Annotations (Annotation(..))
    import qualified GHC.Types.Annotations as Annotations
    import qualified GHC.Core.Class as Class
    import qualified GHC.Core.FVs as CoreFVs
    import qualified GHC.Core as CoreSyn
    import qualified GHC.Types.Demand as Demand
    import qualified GHC
    import qualified GHC.Types.Id as Id
    import qualified GHC.Types.Id.Info as IdInfo
    import qualified GHC.Iface.Syntax as IfaceSyn
    import qualified GHC.Iface.Load as LoadIface
    import qualified GHC.Data.Maybe as Maybes
    import qualified GHC.Core.Make as MkCore
    import qualified GHC.Unit.Module as Module
    import qualified GHC.Unit.Module.Env as ModuleEnv
    import qualified GHC.Utils.Monad as MonadUtils
    import qualified GHC.Types.Name as Name
    import qualified GHC.Types.Name.Env as NameEnv
    import           GHC.Utils.Outputable as Outputable (text)
    import qualified GHC.Plugins as GhcPlugins (deserializeWithData, fromSerialized)
    import qualified GHC.IfaceToCore as TcIface
    import qualified GHC.Tc.Utils.Monad as TcRnMonad
    import qualified GHC.Tc.Types as TcRnTypes
    import qualified GHC.Types.Unique.FM as UniqFM
    import qualified GHC.Types.Var as Var
    import qualified GHC.Unit.Types as UnitTypes
    #else
    import           Annotations (Annotation(..), getAnnTargetName_maybe)
    import qualified Annotations
    import qualified Class
    import qualified CoreFVs
    import qualified CoreSyn
    import qualified Demand
    import qualified GHC
    import qualified Id
    import qualified IdInfo
    import qualified IfaceSyn
    import qualified LoadIface
    import qualified Maybes
    import qualified MkCore
    import qualified Module
    import qualified MonadUtils
    import qualified Name
    import           Outputable                  (text)
    import qualified GhcPlugins                  (deserializeWithData, fromSerialized)
    import qualified TcIface
    import qualified TcRnMonad
    import qualified TcRnTypes
    import qualified UniqFM
    import qualified Var
    #endif

    -- Internal Modules
    import           Clash.Annotations.BitRepresentation.Internal
      (DataRepr', dataReprAnnToDataRepr')
    import           Clash.Annotations.Primitive
    import           Clash.Annotations.BitRepresentation (DataReprAnn)
    import           Clash.Debug                         (traceIf)
    import           Clash.Primitives.Types              (UnresolvedPrimitive, name)
    import           Clash.Primitives.Util               (decodeOrErrJson, decodeOrErrYaml)
    import           Clash.GHC.GHC2Core                  (qualifiedNameString')
    import           Clash.Util                          (curLoc)
    import qualified Clash.Util.Interpolate              as I
    import           Clash.GHC.Util

    -- | Data structure tracking loaded binders (and their related data)
    data LoadedBinders = LoadedBinders
      { LoadedBinders -> Map CoreBndr CoreExpr
    lbBinders :: !(Map CoreSyn.CoreBndr CoreSyn.CoreExpr)
      -- ^ Binder + expression it's binding
      , LoadedBinders -> Map CoreBndr Int
    lbClassOps :: !(Map CoreSyn.CoreBndr Int)
      -- ^ Type class dict projection functions
      , LoadedBinders -> Set CoreBndr
    lbUnlocatable :: !(Set CoreSyn.CoreBndr)
      -- ^ Binders with missing unfoldings
      , LoadedBinders -> Seq (Either UnresolvedPrimitive String)
    lbPrims :: !(Seq (Either UnresolvedPrimitive FilePath))
      -- ^ Primitives; either an primitive data structure or a path to a directory
      -- containing json files
      , LoadedBinders -> Seq DataRepr'
    lbReprs :: !(Seq DataRepr')
      -- ^ Custom data representations
      , LoadedBinders -> DeclCache
    lbCache :: !DeclCache
      -- ^ Loaded module cache
      }

    type LoadedBinderT m a = StateT LoadedBinders m a

    -- | Stores modules with easy binder lookup
    type DeclCache = Map GHC.Module (Maybe (Map GHC.Name IfaceSyn.IfaceDecl))

    -- | Collects free variables in an expression, and splits them into "normal"
    -- free variables and class ops.
    bndrsInExpr :: CoreSyn.CoreExpr -> ([CoreSyn.CoreBndr], [(CoreSyn.CoreBndr, Int)])
    bndrsInExpr :: CoreExpr -> ([CoreBndr], [(CoreBndr, Int)])
    bndrsInExpr CoreExpr
    e = [Either CoreBndr (CoreBndr, Int)]
    -> ([CoreBndr], [(CoreBndr, Int)])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ((CoreBndr -> Either CoreBndr (CoreBndr, Int))
    -> [CoreBndr] -> [Either CoreBndr (CoreBndr, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreBndr -> Either CoreBndr (CoreBndr, Int)
    go [CoreBndr]
    freeVars)
     where
      freeVars :: [CoreBndr]
    freeVars = InterestingVarFun -> CoreExpr -> [CoreBndr]
    CoreFVs.exprSomeFreeVarsList InterestingVarFun
    isInteresting CoreExpr
    e
      isInteresting :: InterestingVarFun
    isInteresting CoreBndr
    v = InterestingVarFun
    Var.isId CoreBndr
    v Bool -> Bool -> Bool
    && Maybe DataCon -> Bool
    forall a. Maybe a -> Bool
    isNothing (CoreBndr -> Maybe DataCon
    Id.isDataConId_maybe CoreBndr
    v)

      go :: Var.Var -> Either Var.Id (CoreSyn.CoreBndr, Int)
      go :: CoreBndr -> Either CoreBndr (CoreBndr, Int)
    go CoreBndr
    v = case CoreBndr -> Maybe Class
    Id.isClassOpId_maybe CoreBndr
    v of
        Just Class
    cls -> (CoreBndr, Int) -> Either CoreBndr (CoreBndr, Int)
    forall a b. b -> Either a b
    Right (CoreBndr
    v, CoreBndr -> Class -> Int
    goClsOp CoreBndr
    v Class
    cls)
        Maybe Class
    Nothing -> CoreBndr -> Either CoreBndr (CoreBndr, Int)
    forall a b. a -> Either a b
    Left CoreBndr
    v

      goClsOp :: Var.Var -> GHC.Class -> Int
      goClsOp :: CoreBndr -> Class -> Int
    goClsOp CoreBndr
    v Class
    c =
        case CoreBndr -> [CoreBndr] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex CoreBndr
    v (Class -> [CoreBndr]
    Class.classAllSelIds Class
    c) of
          Maybe Int
    Nothing -> String -> Int
    forall a. HasCallStack => String -> a
    error [I.i|
            Internal error: couldn't find class method

              #{showPprUnsafe v}

            in class

              #{showPprUnsafe c}
          |]
          Just Int
    n -> Int
    n

    -- | Add a binder to the appropriate fields of 'LoadedBinders', and recursively
    -- load binders found in the optionally supplied expression.
    addBndrM ::
      GHC.GhcMonad m =>
      HDL ->
      CoreSyn.CoreBndr ->
      Maybe CoreSyn.CoreExpr ->
      LoadedBinderT m ()
    addBndrM :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> Maybe CoreExpr -> LoadedBinderT m ()
    addBndrM HDL
    hdl CoreBndr
    bndr Maybe CoreExpr
    exprM =
      case Maybe CoreExpr
    exprM of
        Maybe CoreExpr
    Nothing ->
          (LoadedBinders -> LoadedBinders) -> LoadedBinderT m ()
    forall (m :: Type -> Type) s. Monad m => (s -> s) -> StateT s m ()
    modify ((LoadedBinders -> LoadedBinders) -> LoadedBinderT m ())
    -> (LoadedBinders -> LoadedBinders) -> LoadedBinderT m ()
    forall a b. (a -> b) -> a -> b
    $ \lb :: LoadedBinders
    lb@LoadedBinders{DeclCache
    Map CoreBndr Int
    Map CoreBndr CoreExpr
    Set CoreBndr
    Seq (Either UnresolvedPrimitive String)
    Seq DataRepr'
    lbBinders :: LoadedBinders -> Map CoreBndr CoreExpr
    lbClassOps :: LoadedBinders -> Map CoreBndr Int
    lbUnlocatable :: LoadedBinders -> Set CoreBndr
    lbPrims :: LoadedBinders -> Seq (Either UnresolvedPrimitive String)
    lbReprs :: LoadedBinders -> Seq DataRepr'
    lbCache :: LoadedBinders -> DeclCache
    lbBinders :: Map CoreBndr CoreExpr
    lbClassOps :: Map CoreBndr Int
    lbUnlocatable :: Set CoreBndr
    lbPrims :: Seq (Either UnresolvedPrimitive String)
    lbReprs :: Seq DataRepr'
    lbCache :: DeclCache
    ..} ->
            LoadedBinders
    lb{lbUnlocatable=Set.insert bndr lbUnlocatable}
        Just CoreExpr
    expr -> do
          -- Add current expression and its class ops
          let ([CoreBndr]
    fvs, [(CoreBndr, Int)]
    clsOps) = CoreExpr -> ([CoreBndr], [(CoreBndr, Int)])
    bndrsInExpr CoreExpr
    expr
          (LoadedBinders -> LoadedBinders) -> LoadedBinderT m ()
    forall (m :: Type -> Type) s. Monad m => (s -> s) -> StateT s m ()
    modify ((LoadedBinders -> LoadedBinders) -> LoadedBinderT m ())
    -> (LoadedBinders -> LoadedBinders) -> LoadedBinderT m ()
    forall a b. (a -> b) -> a -> b
    $ \lb :: LoadedBinders
    lb@LoadedBinders{DeclCache
    Map CoreBndr Int
    Map CoreBndr CoreExpr
    Set CoreBndr
    Seq (Either UnresolvedPrimitive String)
    Seq DataRepr'
    lbBinders :: LoadedBinders -> Map CoreBndr CoreExpr
    lbClassOps :: LoadedBinders -> Map CoreBndr Int
    lbUnlocatable :: LoadedBinders -> Set CoreBndr
    lbPrims :: LoadedBinders -> Seq (Either UnresolvedPrimitive String)
    lbReprs :: LoadedBinders -> Seq DataRepr'
    lbCache :: LoadedBinders -> DeclCache
    lbBinders :: Map CoreBndr CoreExpr
    lbClassOps :: Map CoreBndr Int
    lbUnlocatable :: Set CoreBndr
    lbPrims :: Seq (Either UnresolvedPrimitive String)
    lbReprs :: Seq DataRepr'
    lbCache :: DeclCache
    ..} ->
            LoadedBinders
    lb { lbBinders=Map.insert bndr expr lbBinders
               , lbClassOps=mapInsertAll lbClassOps clsOps }

          -- Load all free variables - if not yet loaded
          [CoreBndr]
    -> (CoreBndr -> LoadedBinderT m ()) -> LoadedBinderT m ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [CoreBndr]
    fvs ((CoreBndr -> LoadedBinderT m ()) -> LoadedBinderT m ())
    -> (CoreBndr -> LoadedBinderT m ()) -> LoadedBinderT m ()
    forall a b. (a -> b) -> a -> b
    $ \CoreBndr
    v ->
            StateT LoadedBinders m Bool
    -> LoadedBinderT m () -> LoadedBinderT m ()
    forall (m :: Type -> Type). Monad m => m Bool -> m () -> m ()
    unlessM (CoreBndr -> StateT LoadedBinders m Bool
    forall (m :: Type -> Type).
    Monad m =>
    CoreBndr -> LoadedBinderT m Bool
    isLoadedBinderM CoreBndr
    v) (HDL -> CoreBndr -> LoadedBinderT m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> LoadedBinderT m ()
    loadExprFromIface HDL
    hdl CoreBndr
    v)
     where
      -- Insert a list of keys and values into a 'Map'
      mapInsertAll :: Ord k => Map k a -> [(k, a)] -> Map k a
      mapInsertAll :: forall k a. Ord k => Map k a -> [(k, a)] -> Map k a
    mapInsertAll = (Map k a -> (k, a) -> Map k a) -> Map k a -> [(k, a)] -> Map k a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Map k a
    m (k
    k, a
    v) -> k -> a -> Map k a -> Map k a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert k
    k a
    v Map k a
    m)

    isLoadedBinderM :: Monad m => CoreSyn.CoreBndr -> LoadedBinderT m Bool
    isLoadedBinderM :: forall (m :: Type -> Type).
    Monad m =>
    CoreBndr -> LoadedBinderT m Bool
    isLoadedBinderM CoreBndr
    bndr = (LoadedBinders -> Bool) -> StateT LoadedBinders m Bool
    forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
    gets ((LoadedBinders -> Bool) -> StateT LoadedBinders m Bool)
    -> (LoadedBinders -> Bool) -> StateT LoadedBinders m Bool
    forall a b. (a -> b) -> a -> b
    $ \LoadedBinders{DeclCache
    Map CoreBndr Int
    Map CoreBndr CoreExpr
    Set CoreBndr
    Seq (Either UnresolvedPrimitive String)
    Seq DataRepr'
    lbBinders :: LoadedBinders -> Map CoreBndr CoreExpr
    lbClassOps :: LoadedBinders -> Map CoreBndr Int
    lbUnlocatable :: LoadedBinders -> Set CoreBndr
    lbPrims :: LoadedBinders -> Seq (Either UnresolvedPrimitive String)
    lbReprs :: LoadedBinders -> Seq DataRepr'
    lbCache :: LoadedBinders -> DeclCache
    lbBinders :: Map CoreBndr CoreExpr
    lbClassOps :: Map CoreBndr Int
    lbUnlocatable :: Set CoreBndr
    lbPrims :: Seq (Either UnresolvedPrimitive String)
    lbReprs :: Seq DataRepr'
    lbCache :: DeclCache
    ..} ->
         CoreBndr -> Map CoreBndr CoreExpr -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member CoreBndr
    bndr Map CoreBndr CoreExpr
    lbBinders
      Bool -> Bool -> Bool
    || CoreBndr -> Map CoreBndr Int -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member CoreBndr
    bndr Map CoreBndr Int
    lbClassOps
      Bool -> Bool -> Bool
    || CoreBndr -> Set CoreBndr -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member CoreBndr
    bndr Set CoreBndr
    lbUnlocatable

    emptyLb :: LoadedBinders
    emptyLb :: LoadedBinders
    emptyLb = LoadedBinders
      { lbBinders :: Map CoreBndr CoreExpr
    lbBinders = Map CoreBndr CoreExpr
    forall a. Monoid a => a
    mempty
      , lbClassOps :: Map CoreBndr Int
    lbClassOps = Map CoreBndr Int
    forall a. Monoid a => a
    mempty
      , lbUnlocatable :: Set CoreBndr
    lbUnlocatable = Set CoreBndr
    forall a. Monoid a => a
    mempty
      , lbPrims :: Seq (Either UnresolvedPrimitive String)
    lbPrims = Seq (Either UnresolvedPrimitive String)
    forall a. Monoid a => a
    mempty
      , lbReprs :: Seq DataRepr'
    lbReprs = Seq DataRepr'
    forall a. Monoid a => a
    mempty
      , lbCache :: DeclCache
    lbCache = DeclCache
    forall a. Monoid a => a
    mempty
      }

    #if MIN_VERSION_ghc(9,0,0)
    notBoot :: UnitTypes.IsBootInterface
    notBoot :: IsBootInterface
    notBoot = IsBootInterface
    UnitTypes.NotBoot
    #else
    notBoot :: Bool
    notBoot = False
    #endif

    runIfl :: GHC.GhcMonad m => GHC.Module -> TcRnTypes.IfL a -> m a
    runIfl :: forall (m :: Type -> Type) a.
    GhcMonad m =>
    GenModule Unit -> IfL a -> m a
    runIfl GenModule Unit
    modName IfL a
    action = do
      let
        localEnv :: IfLclEnv
    localEnv = TcRnTypes.IfLclEnv
          { if_mod :: GenModule Unit
    TcRnTypes.if_mod = GenModule Unit
    modName
          , if_boot :: IsBootInterface
    TcRnTypes.if_boot = IsBootInterface
    notBoot
          , if_loc :: SDoc
    TcRnTypes.if_loc = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "runIfl"
          , if_nsubst :: Maybe NameShape
    TcRnTypes.if_nsubst = Maybe NameShape
    forall a. Maybe a
    Nothing
          , if_implicits_env :: Maybe TypeEnv
    TcRnTypes.if_implicits_env = Maybe TypeEnv
    forall a. Maybe a
    Nothing
          , if_tv_env :: FastStringEnv CoreBndr
    TcRnTypes.if_tv_env = FastStringEnv CoreBndr
    forall {k} (key :: k) elt. UniqFM key elt
    UniqFM.emptyUFM
          , if_id_env :: FastStringEnv CoreBndr
    TcRnTypes.if_id_env = FastStringEnv CoreBndr
    forall {k} (key :: k) elt. UniqFM key elt
    UniqFM.emptyUFM
          }

        globalEnv :: IfGblEnv
    globalEnv = TcRnTypes.IfGblEnv
          { if_doc :: SDoc
    TcRnTypes.if_doc = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Clash.runIfl"
    #if MIN_VERSION_ghc(9,4,0)
          , if_rec_types :: KnotVars (IfG TypeEnv)
    TcRnTypes.if_rec_types = KnotVars (IfG TypeEnv)
    forall a. KnotVars a
    emptyKnotVars
    #else
          , TcRnTypes.if_rec_types = Nothing
    #endif
          }

      hscEnv <- m HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
      MonadUtils.liftIO $
        TcRnMonad.initTcRnIf 'r' hscEnv globalEnv localEnv action

    loadDecl :: IfaceSyn.IfaceDecl -> TcRnTypes.IfL GHC.TyThing
    loadDecl :: IfaceDecl -> IfL TyThing
    loadDecl = Bool -> IfaceDecl -> IfL TyThing
    TcIface.tcIfaceDecl Bool
    False

    #if MIN_VERSION_ghc(9,4,0)
    loadIface :: GHC.HscEnv -> GHC.Module -> IO (Maybe GHC.ModIface)
    loadIface :: HscEnv -> GenModule Unit -> IO (Maybe ModIface)
    loadIface HscEnv
    env GenModule Unit
    foundMod = do
    #else
    loadIface :: GHC.Module -> TcRnTypes.IfL (Maybe GHC.ModIface)
    loadIface foundMod = do
    #endif
    #if MIN_VERSION_ghc(9,4,0)
      ifaceFailM <- HscEnv
    -> SDoc
    -> InstalledModule
    -> GenModule Unit
    -> IsBootInterface
    -> IO (MaybeErr MissingInterfaceError (ModIface, String))
    LoadIface.findAndReadIface HscEnv
    env (String -> SDoc
    forall doc. IsLine doc => String -> doc
    Outputable.text String
    "loadIface")
                      ((InstalledModule, Maybe InstantiatedModule) -> InstalledModule
    forall a b. (a, b) -> a
    fst (GenModule Unit -> (InstalledModule, Maybe InstantiatedModule)
    Module.getModuleInstantiation GenModule Unit
    foundMod)) GenModule Unit
    foundMod IsBootInterface
    UnitTypes.NotBoot
    #elif MIN_VERSION_ghc(9,0,0)
      ifaceFailM <- LoadIface.findAndReadIface (Outputable.text "loadIface")
                      (fst (Module.getModuleInstantiation foundMod)) foundMod UnitTypes.NotBoot
    #else
      ifaceFailM <- LoadIface.findAndReadIface (Outputable.text "loadIface")
                      (fst (Module.splitModuleInsts foundMod)) foundMod False
    #endif
      case ifaceFailM of
        Maybes.Succeeded (ModIface
    modInfo,String
    _) -> Maybe ModIface -> IO (Maybe ModIface)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (ModIface -> Maybe ModIface
    forall a. a -> Maybe a
    Just ModIface
    modInfo)
        Maybes.Failed MissingInterfaceError
    msg -> let msg' :: String
    msg' = [String] -> String
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ $(curLoc)
                                               , String
    "Failed to load interface for module: "
                                               , GenModule Unit -> String
    forall a. Outputable a => a -> String
    showPprUnsafe GenModule Unit
    foundMod
                                               , String
    "\nReason: "
    #if MIN_VERSION_ghc(9,8,0)
                                               , SDoc -> String
    showSDocUnsafe (IfaceMessageOpts -> MissingInterfaceError -> SDoc
    missingInterfaceErrorDiagnostic IfaceMessageOpts
    forall opts. HasDefaultDiagnosticOpts opts => opts
    defaultOpts MissingInterfaceError
    msg)
    #else
                                               , showSDocUnsafe msg
    #endif
                                               ]
                             in Bool -> String -> IO (Maybe ModIface) -> IO (Maybe ModIface)
    forall a. Bool -> String -> a -> a
    traceIf Bool
    True String
    msg' (Maybe ModIface -> IO (Maybe ModIface)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe ModIface
    forall a. Maybe a
    Nothing)

    -- | Given a list of top-level binders, recursively load all the binders,
    -- primitives, and type classes it is using. (Exported function.)
    loadExternalBinders :: GHC.GhcMonad m => HDL -> [CoreSyn.CoreBndr] -> m LoadedBinders
    loadExternalBinders :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBndr] -> m LoadedBinders
    loadExternalBinders HDL
    hdl [CoreBndr]
    bndrs =
      (StateT LoadedBinders m () -> LoadedBinders -> m LoadedBinders)
    -> LoadedBinders -> StateT LoadedBinders m () -> m LoadedBinders
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT LoadedBinders m () -> LoadedBinders -> m LoadedBinders
    forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m s
    execStateT LoadedBinders
    emptyLb (StateT LoadedBinders m () -> m LoadedBinders)
    -> StateT LoadedBinders m () -> m LoadedBinders
    forall a b. (a -> b) -> a -> b
    $
        (CoreBndr -> StateT LoadedBinders m ())
    -> [CoreBndr] -> StateT LoadedBinders m ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (HDL -> CoreBndr -> StateT LoadedBinders m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> LoadedBinderT m ()
    loadExprFromIface HDL
    hdl) [CoreBndr]
    bndrs

    -- Given a list of binds, recursively load all its binders, primitives, and
    -- type classes it is using. (Exported function.)
    loadExternalExprs :: GHC.GhcMonad m => HDL -> [CoreSyn.CoreBind] -> m LoadedBinders
    loadExternalExprs :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBind] -> m LoadedBinders
    loadExternalExprs HDL
    hdl [CoreBind]
    binds0 =
      (StateT LoadedBinders m () -> LoadedBinders -> m LoadedBinders)
    -> LoadedBinders -> StateT LoadedBinders m () -> m LoadedBinders
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT LoadedBinders m () -> LoadedBinders -> m LoadedBinders
    forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m s
    execStateT LoadedBinders
    initLb (StateT LoadedBinders m () -> m LoadedBinders)
    -> StateT LoadedBinders m () -> m LoadedBinders
    forall a b. (a -> b) -> a -> b
    $
        ((CoreBndr, CoreExpr) -> StateT LoadedBinders m ())
    -> [(CoreBndr, CoreExpr)] -> StateT LoadedBinders m ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\(CoreBndr
    b, CoreExpr
    e) -> HDL -> CoreBndr -> Maybe CoreExpr -> StateT LoadedBinders m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> Maybe CoreExpr -> LoadedBinderT m ()
    addBndrM HDL
    hdl CoreBndr
    b (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    e)) [(CoreBndr, CoreExpr)]
    binds1
     where
      -- 'lbBinders' is preinitialized with all binders in given binds, as the given
      -- binders can't be loaded from precompiled modules
      initLb :: LoadedBinders
    initLb = LoadedBinders
    emptyLb{lbBinders=Map.fromList binds1}
      binds1 :: [(CoreBndr, CoreExpr)]
    binds1 = [CoreBind] -> [(CoreBndr, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    CoreSyn.flattenBinds [CoreBind]
    binds0

    -- | Try to fetch a IfaceDecl from a 'DeclCache'. If a module has not been loaded
    -- before, load it using GHC. Additionally, add annotations mentioned in the
    -- module to 'LoadedBinders'.
    getIfaceDeclM ::
      forall m.
      GHC.GhcMonad m =>
      HDL ->
      -- | Binder to load
      CoreSyn.CoreBndr ->
      -- | Declaration, if found
      LoadedBinderT m (Maybe (GHC.Module, IfaceSyn.IfaceDecl))
    getIfaceDeclM :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL
    -> CoreBndr -> LoadedBinderT m (Maybe (GenModule Unit, IfaceDecl))
    getIfaceDeclM HDL
    hdl CoreBndr
    bndr = do
      let modM :: Maybe (GenModule Unit)
    modM = Name -> Maybe (GenModule Unit)
    Name.nameModule_maybe Name
    bndrName
      Maybe (Maybe (GenModule Unit, IfaceDecl))
    -> Maybe (GenModule Unit, IfaceDecl)
    forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe (GenModule Unit, IfaceDecl))
     -> Maybe (GenModule Unit, IfaceDecl))
    -> StateT
         LoadedBinders m (Maybe (Maybe (GenModule Unit, IfaceDecl)))
    -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GenModule Unit
     -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl)))
    -> Maybe (GenModule Unit)
    -> StateT
         LoadedBinders m (Maybe (Maybe (GenModule Unit, IfaceDecl)))
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM GenModule Unit
    -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl))
    go Maybe (GenModule Unit)
    modM
     where
      bndrName :: Name
    bndrName = CoreBndr -> Name
    Var.varName CoreBndr
    bndr

      go :: GHC.Module -> LoadedBinderT m (Maybe (GHC.Module, IfaceSyn.IfaceDecl))
      go :: GenModule Unit
    -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl))
    go GenModule Unit
    nameMod = do
        LoadedBinders{lbCache} <- StateT LoadedBinders m LoadedBinders
    forall s (m :: Type -> Type). MonadState s m => m s
    get
        case Map.lookup nameMod lbCache of
          Maybe (Maybe (Map Name IfaceDecl))
    Nothing -> do
            -- Not loaded before
    #if MIN_VERSION_ghc(9,4,0)
            env <- m HscEnv -> StateT LoadedBinders m HscEnv
    forall (m :: Type -> Type) a.
    Monad m =>
    m a -> StateT LoadedBinders m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
            ifaceM <- lift (liftIO (loadIface env nameMod))
    #else
            ifaceM <- lift (runIfl nameMod (loadIface nameMod))
    #endif
            case ifaceM of
              Just ModIface
    iface -> do
                -- Add binder : decl map to cache
                let
                  decls :: [IfaceDecl]
    decls = ((Fingerprint, IfaceDecl) -> IfaceDecl)
    -> [(Fingerprint, IfaceDecl)] -> [IfaceDecl]
    forall a b. (a -> b) -> [a] -> [b]
    map (Fingerprint, IfaceDecl) -> IfaceDecl
    forall a b. (a, b) -> b
    snd (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
    forall (phase :: ModIfacePhase).
    ModIface_ phase -> [IfaceDeclExts phase]
    GHC.mi_decls ModIface
    iface)
                  names :: [Name]
    names = (IfaceDecl -> Name) -> [IfaceDecl] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map IfaceDecl -> Name
    IfaceSyn.ifName [IfaceDecl]
    decls
                let declMap :: Maybe (Map Name IfaceDecl)
    declMap = Map Name IfaceDecl -> Maybe (Map Name IfaceDecl)
    forall a. a -> Maybe a
    Just ([(Name, IfaceDecl)] -> Map Name IfaceDecl
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([Name] -> [IfaceDecl] -> [(Name, IfaceDecl)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    names [IfaceDecl]
    decls))
                (LoadedBinders -> LoadedBinders) -> StateT LoadedBinders m ()
    forall (m :: Type -> Type) s. Monad m => (s -> s) -> StateT s m ()
    modify (\LoadedBinders
    lb -> LoadedBinders
    lb{lbCache=Map.insert nameMod declMap lbCache})

                -- Load annotations and add them to state
                HDL -> GenModule Unit -> ModIface -> StateT LoadedBinders m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> GenModule Unit -> ModIface -> StateT LoadedBinders m ()
    loadAnnotationsM HDL
    hdl GenModule Unit
    nameMod ModIface
    iface
              Maybe ModIface
    Nothing ->
                -- XXX: 'runIfl' should probably error hard if this happens?
                (LoadedBinders -> LoadedBinders) -> StateT LoadedBinders m ()
    forall (m :: Type -> Type) s. Monad m => (s -> s) -> StateT s m ()
    modify (\LoadedBinders
    lb -> LoadedBinders
    lb{lbCache=Map.insert nameMod Nothing lbCache})

            -- Update cache and try again
            go nameMod

          Just Maybe (Map Name IfaceDecl)
    Nothing ->
            -- Loaded before, but couldn't find decl
            Maybe (GenModule Unit, IfaceDecl)
    -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl))
    forall a. a -> StateT LoadedBinders m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe (GenModule Unit, IfaceDecl)
    forall a. Maybe a
    Nothing
          Just (Just Map Name IfaceDecl
    declMap) ->
            -- Loaded before, decl found
            Maybe (GenModule Unit, IfaceDecl)
    -> StateT LoadedBinders m (Maybe (GenModule Unit, IfaceDecl))
    forall a. a -> StateT LoadedBinders m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((GenModule Unit
    nameMod,) (IfaceDecl -> (GenModule Unit, IfaceDecl))
    -> Maybe IfaceDecl -> Maybe (GenModule Unit, IfaceDecl)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Map Name IfaceDecl -> Maybe IfaceDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    bndrName Map Name IfaceDecl
    declMap)

    loadAnnotationsM ::
      GHC.GhcMonad m =>
      HDL ->
      GHC.Module ->
      GHC.ModIface ->
      StateT LoadedBinders m ()
    loadAnnotationsM :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> GenModule Unit -> ModIface -> StateT LoadedBinders m ()
    loadAnnotationsM HDL
    hdl GenModule Unit
    modName ModIface
    iface = do
      anns <- m [Annotation] -> StateT LoadedBinders m [Annotation]
    forall (m :: Type -> Type) a.
    Monad m =>
    m a -> StateT LoadedBinders m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (GenModule Unit -> IfL [Annotation] -> m [Annotation]
    forall (m :: Type -> Type) a.
    GhcMonad m =>
    GenModule Unit -> IfL a -> m a
    runIfl GenModule Unit
    modName ([IfaceAnnotation] -> IfL [Annotation]
    TcIface.tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
    forall (phase :: ModIfacePhase).
    ModIface_ phase -> [IfaceAnnotation]
    GHC.mi_anns ModIface
    iface)))
      primFPs <- loadPrimitiveAnnotations hdl anns
      let reprs = [Annotation] -> [DataRepr']
    loadCustomReprAnnotations [Annotation]
    anns
      modify $ \lb :: LoadedBinders
    lb@LoadedBinders{DeclCache
    Map CoreBndr Int
    Map CoreBndr CoreExpr
    Set CoreBndr
    Seq (Either UnresolvedPrimitive String)
    Seq DataRepr'
    lbBinders :: LoadedBinders -> Map CoreBndr CoreExpr
    lbClassOps :: LoadedBinders -> Map CoreBndr Int
    lbUnlocatable :: LoadedBinders -> Set CoreBndr
    lbPrims :: LoadedBinders -> Seq (Either UnresolvedPrimitive String)
    lbReprs :: LoadedBinders -> Seq DataRepr'
    lbCache :: LoadedBinders -> DeclCache
    lbBinders :: Map CoreBndr CoreExpr
    lbClassOps :: Map CoreBndr Int
    lbUnlocatable :: Set CoreBndr
    lbPrims :: Seq (Either UnresolvedPrimitive String)
    lbReprs :: Seq DataRepr'
    lbCache :: DeclCache
    ..} -> LoadedBinders
    lb
        { lbPrims = lbPrims <> Seq.fromList primFPs
        , lbReprs = lbReprs <> Seq.fromList reprs
        }

    loadExprFromIface ::
      GHC.GhcMonad m =>
      HDL ->
      CoreSyn.CoreBndr ->
      LoadedBinderT m ()
    loadExprFromIface :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> LoadedBinderT m ()
    loadExprFromIface HDL
    hdl CoreBndr
    bndr = do
      namedDeclM <- HDL
    -> CoreBndr -> LoadedBinderT m (Maybe (GenModule Unit, IfaceDecl))
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL
    -> CoreBndr -> LoadedBinderT m (Maybe (GenModule Unit, IfaceDecl))
    getIfaceDeclM HDL
    hdl CoreBndr
    bndr
      case namedDeclM of
        Maybe (GenModule Unit, IfaceDecl)
    Nothing -> HDL -> CoreBndr -> Maybe CoreExpr -> StateT LoadedBinders m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> CoreBndr -> Maybe CoreExpr -> LoadedBinderT m ()
    addBndrM HDL
    hdl CoreBndr
    bndr Maybe CoreExpr
    forall a. Maybe a
    Nothing
        Just (GenModule Unit
    nameMod, IfaceDecl
    namedDecl) -> do
          tyThing <- m TyThing -> StateT LoadedBinders m TyThing
    forall (m :: Type -> Type) a.
    Monad m =>
    m a -> StateT LoadedBinders m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (GenModule Unit -> IfL TyThing -> m TyThing
    forall (m :: Type -> Type) a.
    GhcMonad m =>
    GenModule Unit -> IfL a -> m a
    runIfl GenModule Unit
    nameMod (IfaceDecl -> IfL TyThing
    loadDecl IfaceDecl
    namedDecl))
          addBndrM hdl bndr (loadExprFromTyThing bndr tyThing)

    loadCustomReprAnnotations :: [Annotations.Annotation] -> [DataRepr']
    loadCustomReprAnnotations :: [Annotation] -> [DataRepr']
    loadCustomReprAnnotations [Annotation]
    anns =
      ((Name, [DataReprAnn]) -> Maybe DataRepr')
    -> [(Name, [DataReprAnn])] -> [DataRepr']
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Name, [DataReprAnn]) -> Maybe DataRepr'
    go ([(Name, [DataReprAnn])] -> [DataRepr'])
    -> [(Name, [DataReprAnn])] -> [DataRepr']
    forall a b. (a -> b) -> a -> b
    $ [Maybe (Name, [DataReprAnn])] -> [(Name, [DataReprAnn])]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Name, [DataReprAnn])] -> [(Name, [DataReprAnn])])
    -> [Maybe (Name, [DataReprAnn])] -> [(Name, [DataReprAnn])]
    forall a b. (a -> b) -> a -> b
    $ (Annotation -> [DataReprAnn] -> Maybe (Name, [DataReprAnn]))
    -> [Annotation] -> [[DataReprAnn]] -> [Maybe (Name, [DataReprAnn])]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Annotation -> [DataReprAnn] -> Maybe (Name, [DataReprAnn])
    filterNameless [Annotation]
    anns [[DataReprAnn]]
    reprs
     where
      env :: AnnEnv
    env = [Annotation] -> AnnEnv
    Annotations.mkAnnEnv [Annotation]
    anns
      deserialize :: [Word8] -> DataReprAnn
    deserialize = [Word8] -> DataReprAnn
    forall a. Data a => [Word8] -> a
    GhcPlugins.deserializeWithData :: [Word8] -> DataReprAnn

    #if MIN_VERSION_ghc(9,4,0)
      (ModuleEnv [DataReprAnn]
    mEnv, NameEnv [DataReprAnn]
    nEnv) = ([Word8] -> DataReprAnn)
    -> AnnEnv -> (ModuleEnv [DataReprAnn], NameEnv [DataReprAnn])
    forall a.
    Typeable a =>
    ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
    Annotations.deserializeAnns [Word8] -> DataReprAnn
    deserialize AnnEnv
    env
      reprs :: [[DataReprAnn]]
    reprs = ModuleEnv [DataReprAnn] -> [[DataReprAnn]]
    forall a. ModuleEnv a -> [a]
    ModuleEnv.moduleEnvElts ModuleEnv [DataReprAnn]
    mEnv [[DataReprAnn]] -> [[DataReprAnn]] -> [[DataReprAnn]]
    forall a. Semigroup a => a -> a -> a
    <> NameEnv [DataReprAnn] -> [[DataReprAnn]]
    forall a. NameEnv a -> [a]
    NameEnv.nonDetNameEnvElts NameEnv [DataReprAnn]
    nEnv
    #elif MIN_VERSION_ghc(9,0,0)
      (mEnv, nEnv) = Annotations.deserializeAnns deserialize env
      reprs = ModuleEnv.moduleEnvElts mEnv <> NameEnv.nameEnvElts nEnv
    #else
      reprs = UniqFM.eltsUFM (Annotations.deserializeAnns deserialize env)
    #endif

      filterNameless :: Annotation -> [DataReprAnn] -> Maybe (Name.Name, [DataReprAnn])
      filterNameless :: Annotation -> [DataReprAnn] -> Maybe (Name, [DataReprAnn])
    filterNameless (Annotation CoreAnnTarget
    ann_target AnnPayload
    _) [DataReprAnn]
    reprs' =
        (,[DataReprAnn]
    reprs') (Name -> (Name, [DataReprAnn]))
    -> Maybe Name -> Maybe (Name, [DataReprAnn])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> CoreAnnTarget -> Maybe Name
    forall name. AnnTarget name -> Maybe name
    getAnnTargetName_maybe CoreAnnTarget
    ann_target

      go :: (Name.Name, [DataReprAnn]) -> Maybe DataRepr'
      go :: (Name, [DataReprAnn]) -> Maybe DataRepr'
    go (Name
    _name, []) = Maybe DataRepr'
    forall a. Maybe a
    Nothing
      go (Name
    _name,  [DataReprAnn
    repr]) = DataRepr' -> Maybe DataRepr'
    forall a. a -> Maybe a
    Just (DataRepr' -> Maybe DataRepr') -> DataRepr' -> Maybe DataRepr'
    forall a b. (a -> b) -> a -> b
    $ DataReprAnn -> DataRepr'
    dataReprAnnToDataRepr' DataReprAnn
    repr
      go (Name
    name, [DataReprAnn]
    reprs')   =
        String -> Maybe DataRepr'
    forall a. HasCallStack => String -> a
    error [I.i|
          Multiple DataReprAnn annotations for same type:

            #{showPprUnsafe name}

          Reprs:

            #{reprs'}
        |]

    loadPrimitiveAnnotations ::
      MonadIO m
      => HDL
      -> [Annotations.Annotation]
      -> m [Either UnresolvedPrimitive FilePath]
    loadPrimitiveAnnotations :: forall (m :: Type -> Type).
    MonadIO m =>
    HDL -> [Annotation] -> m [Either UnresolvedPrimitive String]
    loadPrimitiveAnnotations HDL
    hdl [Annotation]
    anns =
      [[Either UnresolvedPrimitive String]]
    -> [Either UnresolvedPrimitive String]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[Either UnresolvedPrimitive String]]
     -> [Either UnresolvedPrimitive String])
    -> m [[Either UnresolvedPrimitive String]]
    -> m [Either UnresolvedPrimitive String]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((CoreAnnTarget, Primitive)
     -> m [Either UnresolvedPrimitive String])
    -> [(CoreAnnTarget, Primitive)]
    -> m [[Either UnresolvedPrimitive String]]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (HDL
    -> (CoreAnnTarget, Primitive)
    -> m [Either UnresolvedPrimitive String]
    forall (m :: Type -> Type).
    MonadIO m =>
    HDL
    -> (CoreAnnTarget, Primitive)
    -> m [Either UnresolvedPrimitive String]
    getUnresolvedPrimitives HDL
    hdl) [(CoreAnnTarget, Primitive)]
    prims
      where
        prims :: [(CoreAnnTarget, Primitive)]
    prims = (Annotation -> Maybe (CoreAnnTarget, Primitive))
    -> [Annotation] -> [(CoreAnnTarget, Primitive)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Annotation -> Maybe (CoreAnnTarget, Primitive)
    filterPrim [Annotation]
    anns
        filterPrim :: Annotation -> Maybe (CoreAnnTarget, Primitive)
    filterPrim (Annotations.Annotation CoreAnnTarget
    target AnnPayload
    value) =
          (CoreAnnTarget
    target,) (Primitive -> (CoreAnnTarget, Primitive))
    -> Maybe Primitive -> Maybe (CoreAnnTarget, Primitive)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> AnnPayload -> Maybe Primitive
    deserialize AnnPayload
    value
        deserialize :: AnnPayload -> Maybe Primitive
    deserialize =
          ([Word8] -> Primitive) -> AnnPayload -> Maybe Primitive
    forall a. Typeable a => ([Word8] -> a) -> AnnPayload -> Maybe a
    GhcPlugins.fromSerialized
            ([Word8] -> Primitive
    forall a. Data a => [Word8] -> a
    GhcPlugins.deserializeWithData :: [Word8] -> Primitive)

    getUnresolvedPrimitives
      :: MonadIO m
      => HDL
      -> (Annotations.CoreAnnTarget, Primitive)
      -> m [Either UnresolvedPrimitive FilePath]
    getUnresolvedPrimitives :: forall (m :: Type -> Type).
    MonadIO m =>
    HDL
    -> (CoreAnnTarget, Primitive)
    -> m [Either UnresolvedPrimitive String]
    getUnresolvedPrimitives HDL
    hdl (CoreAnnTarget
    target, Primitive
    prim) | HDL
    hdl HDL -> [HDL] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem` Primitive -> [HDL]
    primHdls Primitive
    prim =
      case Primitive
    prim of
        Primitive [HDL]
    _ String
    fp -> [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [String -> Either UnresolvedPrimitive String
    forall a b. b -> Either a b
    Right String
    fp]

        InlineYamlPrimitive [HDL]
    _ String
    contentOrFp ->
          case CoreAnnTarget
    target of
            -- Module annotation, can house many primitives
            Annotations.ModuleTarget GenModule Unit
    _ ->
              IO [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (String -> ByteString -> [Either UnresolvedPrimitive String]
    forall a. (HasCallStack, FromJSON a) => String -> ByteString -> a
    decodeOrErrYaml String
    contentOrFp (ByteString -> [Either UnresolvedPrimitive String])
    -> IO ByteString -> IO [Either UnresolvedPrimitive String]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO ByteString
    BL.readFile String
    contentOrFp)
            Annotations.NamedTarget Name
    targetName0 ->
              let targetName1 :: String
    targetName1 = Text -> String
    Text.unpack (Name -> Text
    qualifiedNameString' Name
    targetName0)
                  primOrErr :: UnresolvedPrimitive
    primOrErr = String -> ByteString -> UnresolvedPrimitive
    forall a. (HasCallStack, FromJSON a) => String -> ByteString -> a
    decodeOrErrYaml String
    targetName1 (String -> ByteString
    BLU.fromString String
    contentOrFp)
                  primName :: String
    primName = Text -> String
    Text.unpack (UnresolvedPrimitive -> Text
    forall a b c d. Primitive a b c d -> Text
    name UnresolvedPrimitive
    primOrErr) in

              if String
    primName String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    targetName1
              then String -> String -> m [Either UnresolvedPrimitive String]
    forall {a}. String -> String -> a
    inlineNameError String
    targetName1 String
    primName
              else [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [UnresolvedPrimitive -> Either UnresolvedPrimitive String
    forall a b. a -> Either a b
    Left UnresolvedPrimitive
    primOrErr]

        InlinePrimitive [HDL]
    _ String
    contentOrFp ->
          case CoreAnnTarget
    target of
            -- Module annotation, can house many primitives
            Annotations.ModuleTarget GenModule Unit
    _ ->
              IO [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (String -> ByteString -> [Either UnresolvedPrimitive String]
    forall a. (HasCallStack, FromJSON a) => String -> ByteString -> a
    decodeOrErrJson String
    contentOrFp (ByteString -> [Either UnresolvedPrimitive String])
    -> IO ByteString -> IO [Either UnresolvedPrimitive String]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO ByteString
    BL.readFile String
    contentOrFp)
            Annotations.NamedTarget Name
    targetName0 ->
              let targetName1 :: String
    targetName1 = Text -> String
    Text.unpack (Name -> Text
    qualifiedNameString' Name
    targetName0)
                  primOrErr :: UnresolvedPrimitive
    primOrErr =
                    case String -> ByteString -> [UnresolvedPrimitive]
    forall a. (HasCallStack, FromJSON a) => String -> ByteString -> a
    decodeOrErrJson String
    targetName1 (String -> ByteString
    BLU.fromString String
    contentOrFp) of
                      [] -> String -> UnresolvedPrimitive
    forall a. HasCallStack => String -> a
    error (String -> UnresolvedPrimitive) -> String -> UnresolvedPrimitive
    forall a b. (a -> b) -> a -> b
    $ String
    "No annotations found for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targetName1
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " even though it had an InlinePrimitive annotation."
                      [UnresolvedPrimitive
    p] -> UnresolvedPrimitive
    p
                      [UnresolvedPrimitive]
    _ -> String -> UnresolvedPrimitive
    forall a. HasCallStack => String -> a
    error (String -> UnresolvedPrimitive) -> String -> UnresolvedPrimitive
    forall a b. (a -> b) -> a -> b
    $ String
    "Multiple primitive definitions found in "
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "InlinePrimitive annotation for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targetName1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ". "
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Expected a single one."

                  primName :: String
    primName = Text -> String
    Text.unpack (UnresolvedPrimitive -> Text
    forall a b c d. Primitive a b c d -> Text
    name UnresolvedPrimitive
    primOrErr) in

              if String
    primName String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    targetName1
              then String -> String -> m [Either UnresolvedPrimitive String]
    forall {a}. String -> String -> a
    inlineNameError String
    targetName1 String
    primName
              else [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [UnresolvedPrimitive -> Either UnresolvedPrimitive String
    forall a b. a -> Either a b
    Left UnresolvedPrimitive
    primOrErr]
     where
      inlineNameError :: String -> String -> a
    inlineNameError String
    targetName String
    primName =
        String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat
          [ String
    "Function " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targetName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " was annotated with an inline "
          , String
    "primitive for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    primName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ". These names "
          , String
    "should be the same." ]

      primHdls :: Primitive -> [HDL]
    primHdls = \case
        Primitive [HDL]
    hdls String
    _ -> [HDL]
    hdls
        InlinePrimitive [HDL]
    hdls String
    _ -> [HDL]
    hdls
        InlineYamlPrimitive [HDL]
    hdls String
    _ -> [HDL]
    hdls

    getUnresolvedPrimitives HDL
    _ (CoreAnnTarget, Primitive)
    _  = [Either UnresolvedPrimitive String]
    -> m [Either UnresolvedPrimitive String]
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return []

    loadExprFromTyThing :: CoreSyn.CoreBndr -> GHC.TyThing -> Maybe CoreSyn.CoreExpr
    loadExprFromTyThing :: CoreBndr -> TyThing -> Maybe CoreExpr
    loadExprFromTyThing CoreBndr
    bndr TyThing
    tyThing = case TyThing
    tyThing of
      GHC.AnId CoreBndr
    _id | InterestingVarFun
    Var.isId CoreBndr
    _id ->
        let _idInfo :: IdInfo
    _idInfo    = HasDebugCallStack => CoreBndr -> IdInfo
    CoreBndr -> IdInfo
    Var.idInfo CoreBndr
    _id
    #if MIN_VERSION_ghc(9,4,0)
            unfolding :: Unfolding
    unfolding  = IdInfo -> Unfolding
    IdInfo.realUnfoldingInfo IdInfo
    _idInfo
    #else
            unfolding  = IdInfo.unfoldingInfo _idInfo
    #endif
        in case Unfolding
    unfolding of
          CoreSyn.CoreUnfolding {} ->
            CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Unfolding -> CoreExpr
    CoreSyn.unfoldingTemplate Unfolding
    unfolding)
          CoreSyn.DFunUnfolding [CoreBndr]
    dfbndrs DataCon
    dc [CoreExpr]
    es ->
            CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ([CoreBndr] -> CoreExpr -> CoreExpr
    MkCore.mkCoreLams [CoreBndr]
    dfbndrs (DataCon -> [CoreExpr] -> CoreExpr
    MkCore.mkCoreConApps DataCon
    dc [CoreExpr]
    es))
          Unfolding
    CoreSyn.NoUnfolding
    #if MIN_VERSION_ghc(9,4,0)
            | DmdSig -> Bool
    Demand.isDeadEndSig (DmdSig -> Bool) -> DmdSig -> Bool
    forall a b. (a -> b) -> a -> b
    $ IdInfo -> DmdSig
    IdInfo.dmdSigInfo IdInfo
    _idInfo
    #elif MIN_VERSION_ghc(9,0,0)
            | Demand.isDeadEndSig $ IdInfo.strictnessInfo _idInfo
    #else
            | Demand.isBottomingSig $ IdInfo.strictnessInfo _idInfo
    #endif
            -> do
              let noUnfoldingErr :: String
    noUnfoldingErr = String
    "no_unfolding " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CoreBndr -> String
    forall a. Outputable a => a -> String
    showPprUnsafe CoreBndr
    bndr
              CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Type -> String -> CoreExpr
    MkCore.mkAbsentErrorApp (CoreBndr -> Type
    Var.varType CoreBndr
    _id) String
    noUnfoldingErr)
          Unfolding
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
      TyThing
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing

    #if MIN_VERSION_ghc(9,0,0)
    -- | Get the 'name' of an annotation target if it exists.
    getAnnTargetName_maybe :: Annotations.AnnTarget name -> Maybe name
    getAnnTargetName_maybe :: forall name. AnnTarget name -> Maybe name
    getAnnTargetName_maybe (Annotations.NamedTarget name
    nm) = name -> Maybe name
    forall a. a -> Maybe a
    Just name
    nm
    getAnnTargetName_maybe AnnTarget name
    _                            = Maybe name
    forall a. Maybe a
    Nothing
    #endif