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

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

    module Clash.GHC.LoadModules
      ( loadModules
      , ghcLibDir
      , setWantedLanguageExtensions
      )
    where

    #ifndef USE_GHC_PATHS
    #ifndef TOOL_VERSION_ghc
    #error TOOL_VERSION_ghc undefined
    #endif
    #endif

    -- External Modules
    import           Clash.Annotations.Primitive     (HDL, PrimitiveGuard(..))
    import           Clash.Annotations.TopEntity     (TopEntity (..))
    import           Clash.Primitives.Types          (UnresolvedPrimitive)
    import           Clash.Util                      (ClashException(..), pkgIdFromTypeable)
    import qualified Clash.Util.Interpolate          as I
    import           Control.Arrow                   (first)
    import           Control.Exception               (SomeException, throw)
    import           Control.Monad                   (forM, join, when)
    import           Data.List.Extra                 (nubSort)
    import           Control.Exception               (throwIO)
    import           Control.Monad                   (foldM)
    #if MIN_VERSION_ghc(9,0,0)
    import           Control.Monad.Catch             as MC (try)
    #endif
    import           Control.Monad.IO.Class          (liftIO)
    import           Data.Char                       (isDigit)
    import           Data.Generics.Uniplate.DataOnly (transform)
    import           Data.Data                       (Data)
    import           Data.Functor                    ((<&>))
    import           Data.Foldable                   (toList)
    import           Data.HashMap.Strict             (HashMap)
    import qualified Data.HashMap.Strict             as HashMap
    import           Data.Typeable                   (Typeable)
    import           Data.List                       (foldl', nub, find)
    import qualified Data.Map                        as Map
    import           Data.Maybe
      (catMaybes, fromMaybe, listToMaybe, mapMaybe)
    import qualified Data.Text                       as Text
    import qualified Data.Text.Encoding              as Text
    import qualified Data.Time.Clock                 as Clock
    import qualified Data.Set                        as Set
    import qualified Data.Sequence                   as Seq
    import           Debug.Trace
    import           Language.Haskell.TH.Syntax      (lift)
    import           GHC.Natural                     (naturalFromInteger)
    import           GHC.Stack                       (HasCallStack)
    #if MIN_VERSION_ghc(9,4,0)
    import           System.FilePath.Posix           (dropExtension, takeDirectory)
    #endif
    import           Text.Read                       (readMaybe)

    #ifdef USE_GHC_PATHS
    import           GHC.Paths                       (libdir)
    #else
    import           System.Exit                     (ExitCode (..))
    import           System.IO                       (hGetLine)
    import           System.IO.Error                 (tryIOError)
    import           System.Process                  (runInteractiveCommand,
                                                      waitForProcess)
    #endif

    -- GHC API
    #if MIN_VERSION_ghc(9,0,0)
    #if MIN_VERSION_ghc(9,4,0)
    import           GHC.Driver.Phases (StopPhase(NoStop))
    import           GHC.Driver.Pipeline (mkPipeEnv, runPipeline, hscBackendPipeline)
    #if MIN_VERSION_ghc(9,6,0)
    import           GHC.SysTools.Cpp (offsetIncludePaths)
    import           GHC.Unit.Home.ModInfo (homeMod_bytecode)
    #else
    import           GHC.Driver.Pipeline.Execute (offsetIncludePaths)
    import           GHC.Driver.Pipeline.Monad (PipelineOutput(NoOutputFile, Persistent))
    #endif
    import           GHC.Driver.Pipeline.Monad ( MonadUse(use) )
    import           GHC.Driver.Pipeline.Phases (TPhase(T_HscPostTc))
    import           GHC.Data.Bool (OverridingBool)
    import           GHC.Driver.Config.Tidy (initTidyOpts)
    import           GHC.Driver.Errors.Types (GhcMessage(GhcTcRnMessage))
    import           GHC.Driver.Monad (modifySession)
    import           GHC.Unit.Env (addHomeModInfoToHug)
    import           GHC.Unit.Home.ModInfo (HomeModInfo(HomeModInfo))
    import           GHC.Unit.Module.ModSummary (findTarget)
    #else
    import           GHC.Utils.Misc (OverridingBool)
    #endif
    #if MIN_VERSION_ghc(9,2,0)
    import qualified GHC.Driver.Env as HscTypes
    import qualified GHC.Unit.Module.ModGuts as HscTypes
    import qualified GHC.Types.SourceError as HscTypes
    import qualified GHC.Unit.Module.Deps as HscTypes
    import qualified GHC.Driver.Backend as Backend
    import qualified GHC.Unit.Module.Graph as Graph
    import qualified GHC.Platform.Ways as Ways
    #if !MIN_VERSION_ghc(9,4,0)
    import qualified GHC.Types.Error as Error
    #endif
    #else
    import qualified GHC.Driver.Types as HscTypes
    import qualified GHC.Driver.Ways as Ways
    #endif
    import qualified GHC.Types.Annotations as Annotations
    import qualified GHC.Core.FVs as CoreFVs
    import qualified GHC.Core as CoreSyn
    import qualified GHC.Core.DataCon as DataCon
    import qualified GHC.Data.Graph.Directed as Digraph
    import qualified GHC.Runtime.Loader as DynamicLoading
    import           GHC.Driver.Session (GeneralFlag (..))
    import qualified GHC.Driver.Session as DynFlags
    import qualified GHC.Data.FastString as FastString
    import qualified GHC
    import qualified GHC.Driver.Main as HscMain
    import qualified GHC.Utils.Monad as MonadUtils
    import qualified GHC.Utils.Panic as Panic
    import qualified GHC.Serialized as Serialized (deserializeWithData)
    import qualified GHC.Unit.Types as UnitTypes (unitIdString)
    import qualified GHC.Tc.Utils.Monad as TcRnMonad
    import qualified GHC.Tc.Types as TcRnTypes
    import qualified GHC.Iface.Tidy as TidyPgm
    import qualified GHC.Core.TyCon as TyCon
    import qualified GHC.Core.Type as Type
    import qualified GHC.Types.Unique as Unique
    import qualified GHC.Tc.Instance.Family as FamInst
    import qualified GHC.Core.FamInstEnv as FamInstEnv
    import qualified GHC.LanguageExtensions as LangExt
    import qualified GHC.Types.Name as Name
    import qualified GHC.Types.Name.Occurrence as OccName
    import           GHC.Utils.Outputable (ppr)
    import qualified GHC.Utils.Outputable as Outputable
    import qualified GHC.Types.Unique.Set as UniqSet
    import qualified GHC.Types.Var as Var
    import qualified GHC.Unit.Module.Env as ModuleEnv
    import qualified GHC.Types.Name.Env as NameEnv
    #else
    import qualified Annotations
    import qualified CoreFVs
    import qualified CoreSyn
    import qualified DataCon
    import qualified Digraph
    import qualified DynamicLoading
    import           DynFlags                        (GeneralFlag (..))
    import qualified DynFlags
    import qualified Exception
    import qualified FastString
    import qualified GHC
    import qualified HscMain
    import qualified HscTypes
    import qualified MonadUtils
    import qualified Panic
    import qualified GhcPlugins                      (deserializeWithData, installedUnitIdString)
    import qualified TcRnMonad
    import qualified TcRnTypes
    import qualified TidyPgm
    import qualified TyCon
    import qualified Type
    import qualified Unique
    import qualified UniqFM
    import qualified FamInst
    import qualified FamInstEnv
    import qualified GHC.LanguageExtensions          as LangExt
    import qualified Name
    import qualified OccName
    import           Outputable                      (ppr)
    import qualified Outputable
    import qualified UniqSet
    import           Util (OverridingBool)
    import qualified Var
    #endif

    -- Internal Modules
    import           Clash.GHC.GHC2Core                           (modNameM, qualifiedNameString')
    import           Clash.GHC.LoadInterfaceFiles
      (loadExternalExprs, getUnresolvedPrimitives, loadExternalBinders,
       LoadedBinders(..))
    import           Clash.GHCi.Common                            (checkMonoLocalBindsMod)
    import           Clash.Util                                   (curLoc, noSrcSpan, reportTimeDiff
                                                                  ,wantedLanguageExtensions, unwantedLanguageExtensions)
    import           Clash.Annotations.BitRepresentation.Internal
      (DataRepr', dataReprAnnToDataRepr')

    import           Clash.Signal.Internal

    ghcLibDir :: IO FilePath
    #ifdef USE_GHC_PATHS
    ghcLibDir = return libdir
    #else
    ghcLibDir :: IO FilePath
    ghcLibDir = do
      (Maybe FilePath
    libDirM,ExitCode
    exitCode) <- FilePath -> IO (Maybe FilePath, ExitCode)
    getProcessOutput (FilePath -> IO (Maybe FilePath, ExitCode))
    -> FilePath -> IO (Maybe FilePath, ExitCode)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "ghc-" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ TOOL_VERSION_ghc ++ " --print-libdir"
      case ExitCode
    exitCode of
         ExitCode
    ExitSuccess   -> case Maybe FilePath
    libDirM of
           Just FilePath
    libDir -> FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return FilePath
    libDir
           Maybe FilePath
    Nothing     -> FilePath -> IO FilePath
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError FilePath
    noGHC
         ExitFailure Int
    i -> case Int
    i of
           Int
    127         -> FilePath -> IO FilePath
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError FilePath
    noGHC
           Int
    i'          -> FilePath -> IO FilePath
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Calling GHC failed with error code: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    i'
      where
        noGHC :: FilePath
    noGHC = FilePath
    "Clash needs the GHC compiler it was built with, ghc-" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ TOOL_VERSION_ghc ++
                FilePath
    ", but it was not found. Make sure its location is in your PATH variable."

    getProcessOutput :: String -> IO (Maybe String, ExitCode)
    getProcessOutput :: FilePath -> IO (Maybe FilePath, ExitCode)
    getProcessOutput FilePath
    command =
         -- Create the process
      do (Handle
    _, Handle
    pOut, Handle
    _, ProcessHandle
    handle) <- FilePath -> IO (Handle, Handle, Handle, ProcessHandle)
    runInteractiveCommand FilePath
    command
         -- Wait for the process to finish and store its exit code
         ExitCode
    exitCode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    handle
         -- Get the standard output.
         Maybe FilePath
    output   <- (IOError -> Maybe FilePath)
    -> (FilePath -> Maybe FilePath)
    -> Either IOError FilePath
    -> Maybe FilePath
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe FilePath -> IOError -> Maybe FilePath
    forall a b. a -> b -> a
    const Maybe FilePath
    forall a. Maybe a
    Nothing) FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (Either IOError FilePath -> Maybe FilePath)
    -> IO (Either IOError FilePath) -> IO (Maybe FilePath)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO FilePath -> IO (Either IOError FilePath)
    forall a. IO a -> IO (Either IOError a)
    tryIOError (Handle -> IO FilePath
    hGetLine Handle
    pOut)
         -- return both the output and the exit code.
         (Maybe FilePath, ExitCode) -> IO (Maybe FilePath, ExitCode)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe FilePath
    output, ExitCode
    exitCode)
    #endif

    -- | Search databases for given module
    loadExternalModule
      :: (HasCallStack, GHC.GhcMonad m)
      => HDL
      -> String
      -- ^ Module name. Can either be a filepath pointing to a .hs file, or a
      -- qualified module name (example: "Data.List").
      -> m (Either
              SomeException
              ( [CoreSyn.CoreBndr]                     -- Root binders
              , FamInstEnv.FamInstEnv                  -- Local type family instances
              , GHC.ModuleName                         -- Module name
              , LoadedBinders
              , [CoreSyn.CoreBind]                     -- All bindings
              ) )
    #if MIN_VERSION_ghc(9,0,0)
    loadExternalModule :: forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    HDL
    -> FilePath
    -> m (Either
            SomeException
            ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    loadExternalModule HDL
    hdl FilePath
    modName0 = m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    -> m (Either
            SomeException
            ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    forall (m :: Type -> Type) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    MC.try (m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
     -> m (Either
             SomeException
             ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])))
    -> m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders,
          [CoreBind])
    -> m (Either
            SomeException
            ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    forall a b. (a -> b) -> a -> b
    $ do
    #else
    loadExternalModule hdl modName0 = Exception.gtry $ do
    #endif
      let modName1 :: ModuleName
    modName1 = FilePath -> ModuleName
    GHC.mkModuleName FilePath
    modName0
      Module
    foundMod <- ModuleName -> Maybe FastString -> m Module
    forall (m :: Type -> Type).
    GhcMonad m =>
    ModuleName -> Maybe FastString -> m Module
    GHC.findModule ModuleName
    modName1 Maybe FastString
    forall a. Maybe a
    Nothing
      let errMsg :: FilePath
    errMsg = FilePath
    "Internal error: found  module, but could not load it"
      ModuleInfo
    modInfo <- ModuleInfo -> Maybe ModuleInfo -> ModuleInfo
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> ModuleInfo
    forall a. HasCallStack => FilePath -> a
    error FilePath
    errMsg) (Maybe ModuleInfo -> ModuleInfo)
    -> m (Maybe ModuleInfo) -> m ModuleInfo
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Module -> m (Maybe ModuleInfo)
    forall (m :: Type -> Type).
    GhcMonad m =>
    Module -> m (Maybe ModuleInfo)
    GHC.getModuleInfo Module
    foundMod)
      [TyThing]
    tyThings <- [Maybe TyThing] -> [TyThing]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TyThing] -> [TyThing]) -> m [Maybe TyThing] -> m [TyThing]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> m (Maybe TyThing)) -> [Name] -> m [Maybe TyThing]
    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 Name -> m (Maybe TyThing)
    forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
    GHC.lookupGlobalName (ModuleInfo -> [Name]
    GHC.modInfoExports ModuleInfo
    modInfo)
      let rootIds :: [CoreBndr]
    rootIds = [CoreBndr
    id_ | GHC.AnId CoreBndr
    id_ <- [TyThing]
    tyThings]
      LoadedBinders
    loaded <- HDL -> [CoreBndr] -> m LoadedBinders
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBndr] -> m LoadedBinders
    loadExternalBinders HDL
    hdl [CoreBndr]
    rootIds
      let allBinders :: [CoreBind]
    allBinders = [(CoreBndr, CoreExpr)] -> [CoreBind]
    makeRecursiveGroups (Map CoreBndr CoreExpr -> [(CoreBndr, CoreExpr)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs (LoadedBinders -> Map CoreBndr CoreExpr
    lbBinders LoadedBinders
    loaded))
      ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    -> m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders,
          [CoreBind])
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([CoreBndr]
    rootIds, FamInstEnv
    FamInstEnv.emptyFamInstEnv, ModuleName
    modName1, LoadedBinders
    loaded, [CoreBind]
    allBinders)

    setupGhc
      :: GHC.GhcMonad m
      => OverridingBool
      -> Maybe GHC.DynFlags
      -> [FilePath]
      -> m ()
    setupGhc :: forall (m :: Type -> Type).
    GhcMonad m =>
    OverridingBool -> Maybe DynFlags -> [FilePath] -> m ()
    setupGhc OverridingBool
    useColor Maybe DynFlags
    dflagsM [FilePath]
    idirs = do
      DynFlags
    dflags <-
        case Maybe DynFlags
    dflagsM of
          Just DynFlags
    df -> DynFlags -> m DynFlags
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return DynFlags
    df
          Maybe DynFlags
    Nothing -> do
            -- Make sure we read the .ghc environment files
            DynFlags
    df <- do
              DynFlags
    df <- m DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
    #if MIN_VERSION_ghc(9,0,0)
    #if MIN_VERSION_ghc(9,2,0)
              Logger
    logger <- m Logger
    forall (m :: Type -> Type). HasLogger m => m Logger
    GHC.getLogger
              DynFlags
    df1 <- IO DynFlags -> m DynFlags
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Logger -> DynFlags -> IO DynFlags
    GHC.interpretPackageEnv Logger
    logger DynFlags
    df)
    #else
              df1 <- liftIO (GHC.interpretPackageEnv df)
    #endif
              ()
    _ <- DynFlags -> m ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags DynFlags
    df1

    #else
              _ <- GHC.setSessionDynFlags df {DynFlags.pkgDatabase = Nothing}
    #endif
              m DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags

            let df1 :: DynFlags
    df1 = DynFlags -> DynFlags
    setWantedLanguageExtensions DynFlags
    df
                ghcTyLitNormPlugin :: ModuleName
    ghcTyLitNormPlugin = FilePath -> ModuleName
    GHC.mkModuleName FilePath
    "GHC.TypeLits.Normalise"
                ghcTyLitExtrPlugin :: ModuleName
    ghcTyLitExtrPlugin = FilePath -> ModuleName
    GHC.mkModuleName FilePath
    "GHC.TypeLits.Extra.Solver"
                ghcTyLitKNPlugin :: ModuleName
    ghcTyLitKNPlugin   = FilePath -> ModuleName
    GHC.mkModuleName FilePath
    "GHC.TypeLits.KnownNat.Solver"
                dfPlug :: DynFlags
    dfPlug = DynFlags
    df1 { DynFlags.pluginModNames = nub $
                                    ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
                                    ghcTyLitKNPlugin : DynFlags.pluginModNames df1
                               , DynFlags.useColor = useColor
                               , DynFlags.importPaths = idirs
                               }
            DynFlags -> m DynFlags
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return DynFlags
    dfPlug

      let dflags1 :: DynFlags
    dflags1 = DynFlags
    dflags
                      { DynFlags.ghcMode  = GHC.CompManager
                      , DynFlags.ghcLink  = GHC.LinkInMemory
    #if !MIN_VERSION_ghc(9,4,0)
                      , DynFlags.optLevel = 2
    #endif
    #if MIN_VERSION_ghc(9,2,0)
                      , DynFlags.backend  =
                          if Ways.hostIsProfiled
    #if MIN_VERSION_ghc(9,6,0)
                             then Backend.noBackend
    #else
                             then Backend.NoBackend
    #endif
                             else Backend.platformDefaultBackend (DynFlags.targetPlatform dflags)
    #else
                      , DynFlags.hscTarget
    #if MIN_VERSION_ghc(9,0,0)
                          = if Ways.hostIsProfiled
    #else
                          = if DynFlags.rtsIsProfiled
    #endif
                               then DynFlags.HscNothing
                               else DynFlags.defaultObjectTarget $
    #if !MIN_VERSION_ghc(8,10,0)
                                      DynFlags.targetPlatform
    #endif
                                        dflags
    #endif
                      , DynFlags.reductionDepth = 1000
                      }
      let dflags2 :: DynFlags
    dflags2 = DynFlags -> DynFlags
    unwantedOptimizationFlags DynFlags
    dflags1
          ghcDynamic :: Bool
    ghcDynamic = case FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup FilePath
    "GHC Dynamic" (DynFlags -> [(FilePath, FilePath)]
    DynFlags.compilerInfo DynFlags
    dflags) of
                        Just FilePath
    "YES" -> Bool
    True
                        Maybe FilePath
    _          -> Bool
    False
          dflags3 :: DynFlags
    dflags3 = if Bool
    ghcDynamic then DynFlags -> GeneralFlag -> DynFlags
    DynFlags.gopt_set DynFlags
    dflags2 GeneralFlag
    DynFlags.Opt_BuildDynamicToo
                                  else DynFlags
    dflags2

      Bool -> m () -> m ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (GeneralFlag -> DynFlags -> Bool
    DynFlags.gopt GeneralFlag
    DynFlags.Opt_WorkerWrapper DynFlags
    dflags3) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> m () -> m ()
    forall a. FilePath -> a -> a
    trace
          ([FilePath] -> FilePath
    unlines [FilePath
    "WARNING:"
                   ,FilePath
    "`-fworker-wrapper` option is globally enabled, this can result in incorrect code."
                   ,FilePath
    "Are you compiling with `-O` or `-O2`? Consider adding `-fno-worker-wrapper`."
                   ,FilePath
    "`-fworker-wrapper` can be use in a diligent manner on a file-by-file basis"
                   ,FilePath
    "by using a `{-# OPTIONS_GHC -fworker-wrapper` #-} pragma."
                   ])
          (() -> m ()
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ())

    #if MIN_VERSION_ghc(9,2,0)
      ()
    _ <- DynFlags -> m ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags DynFlags
    dflags3
      HscEnv
    hscenv <- m HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
      HscEnv
    hscenv1 <- IO HscEnv -> m HscEnv
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO (HscEnv -> IO HscEnv
    DynamicLoading.initializePlugins HscEnv
    hscenv)
      HscEnv -> m ()
    forall (m :: Type -> Type). GhcMonad m => HscEnv -> m ()
    GHC.setSession HscEnv
    hscenv1
    #elif MIN_VERSION_ghc(9,0,0)
      _ <- GHC.setSessionDynFlags dflags3
      hscenv <- GHC.getSession
      dflags4 <- MonadUtils.liftIO (DynamicLoading.initializePlugins hscenv dflags3)
      _ <- GHC.setSessionDynFlags dflags4
    #else
      hscenv <- GHC.getSession
      dflags4 <- MonadUtils.liftIO (DynamicLoading.initializePlugins hscenv dflags3)
      _ <- GHC.setSessionDynFlags dflags4
    #endif

      () -> m ()
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    -- | Load a module from a Haskell file. Function does NOT look in currently
    -- loaded modules.
    loadLocalModule
      :: GHC.GhcMonad m
      => HDL
      -> String
      -- ^ Module name. Can either be a filepath pointing to a .hs file, or a
      -- qualified module name (example: "Data.List").
      -> m ( [CoreSyn.CoreBndr]                     -- Root binders
           , FamInstEnv.FamInstEnv                  -- Local type family instances
           , GHC.ModuleName                         -- Module name
           , LoadedBinders
           , [CoreSyn.CoreBind]                     -- All bindings
           )
    loadLocalModule :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL
    -> FilePath
    -> m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders,
          [CoreBind])
    loadLocalModule HDL
    hdl FilePath
    modName = do
    #if MIN_VERSION_ghc(9,4,0)
      Target
    target <- FilePath -> Maybe UnitId -> Maybe Phase -> m Target
    forall (m :: Type -> Type).
    GhcMonad m =>
    FilePath -> Maybe UnitId -> Maybe Phase -> m Target
    GHC.guessTarget FilePath
    modName Maybe UnitId
    forall a. Maybe a
    Nothing Maybe Phase
    forall a. Maybe a
    Nothing
    #else
      target <- GHC.guessTarget modName Nothing
    #endif
      [Target] -> m ()
    forall (m :: Type -> Type). GhcMonad m => [Target] -> m ()
    GHC.setTargets [Target
    target]
      ModuleGraph
    modGraph <- [ModuleName] -> Bool -> m ModuleGraph
    forall (m :: Type -> Type).
    GhcMonad m =>
    [ModuleName] -> Bool -> m ModuleGraph
    GHC.depanal [] Bool
    False
      let modGraph' :: ModuleGraph
    modGraph' = (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
    GHC.mapMG ModSummary -> ModSummary
    disableOptimizationsFlags ModuleGraph
    modGraph
          -- 'topSortModuleGraph' ensures that modGraph2, and hence tidiedMods
          -- are in topological order, i.e. the root module is last.
          modGraph2 :: [ModSummary]
    modGraph2 = [SCC ModSummary] -> [ModSummary]
    forall a. [SCC a] -> [a]
    Digraph.flattenSCCs ([SCC ModSummary] -> [ModSummary])
    -> [SCC ModSummary] -> [ModSummary]
    forall a b. (a -> b) -> a -> b
    $
    #if MIN_VERSION_ghc(9,2,0)
                      -- TODO: this might break backpack
                      [SCC ModuleGraphNode] -> [SCC ModSummary]
    Graph.filterToposortToModules ([SCC ModuleGraphNode] -> [SCC ModSummary])
    -> [SCC ModuleGraphNode] -> [SCC ModSummary]
    forall a b. (a -> b) -> a -> b
    $
    #endif
                      Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    GHC.topSortModuleGraph Bool
    True ModuleGraph
    modGraph' Maybe HomeUnitModule
    forall a. Maybe a
    Nothing

      IO () -> m ()
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ (ModSummary -> IO ()) -> [ModSummary] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ModSummary -> IO ()
    checkMonoLocalBindsMod [ModSummary]
    modGraph2

      [([CoreBind], FamInstEnv)]
    tidiedMods <- [ModSummary]
    -> (ModSummary -> m ([CoreBind], FamInstEnv))
    -> m [([CoreBind], FamInstEnv)]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [ModSummary]
    modGraph2 ((ModSummary -> m ([CoreBind], FamInstEnv))
     -> m [([CoreBind], FamInstEnv)])
    -> (ModSummary -> m ([CoreBind], FamInstEnv))
    -> m [([CoreBind], FamInstEnv)]
    forall a b. (a -> b) -> a -> b
    $ \ModSummary
    m -> do
        DynFlags
    oldDFlags <- m DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
        ParsedModule
    pMod  <- ModSummary -> m ParsedModule
    forall (m :: Type -> Type).
    GhcMonad m =>
    ModSummary -> m ParsedModule
    parseModule ModSummary
    m
        ()
    _ <- DynFlags -> m ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags (ModSummary -> DynFlags
    GHC.ms_hspp_opts (ParsedModule -> ModSummary
    GHC.pm_mod_summary ParsedModule
    pMod))
        TypecheckedModule
    tcMod <- ParsedModule -> m TypecheckedModule
    forall (m :: Type -> Type).
    GhcMonad m =>
    ParsedModule -> m TypecheckedModule
    GHC.typecheckModule (ParsedModule -> ParsedModule
    removeStrictnessAnnotations ParsedModule
    pMod)

        -- The purpose of the home package table (HPT) is to track
        -- the already compiled modules, so subsequent modules can
        -- rely/use those compilation results
        --
        -- We need to update the home package table (HPT) ourselves
        -- as we can no longer depend on 'GHC.load' to create a
        -- proper HPT.
        --
        -- The reason we have to cannot rely on 'GHC.load' is that
        -- it runs the rename/type-checker, which we also run in
        -- the code above. This would mean that the renamer/type-checker
        -- is run twice, which in turn means that template haskell
        -- splices are run twice.
        --
        -- Given that TH splices can do non-trivial computation and I/O,
        -- running TH twice must be avoid.
    #if MIN_VERSION_ghc(9,4,0)
        let (TcGblEnv
    tc_result,ModDetails
    _) = TypecheckedModule -> (TcGblEnv, ModDetails)
    GHC.tm_internals_ TypecheckedModule
    tcMod
        let tcMod' :: TypecheckedModule
    tcMod' = TypecheckedModule
    tcMod
    #else
        tcMod' <- GHC.loadModule tcMod
    #endif
        ModGuts
    dsMod <- (DesugaredModule -> ModGuts) -> m DesugaredModule -> m ModGuts
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap DesugaredModule -> ModGuts
    forall m. DesugaredMod m => m -> ModGuts
    GHC.coreModule (m DesugaredModule -> m ModGuts) -> m DesugaredModule -> m ModGuts
    forall a b. (a -> b) -> a -> b
    $ TypecheckedModule -> m DesugaredModule
    forall (m :: Type -> Type).
    GhcMonad m =>
    TypecheckedModule -> m DesugaredModule
    GHC.desugarModule TypecheckedModule
    tcMod'
        HscEnv
    hsc_env <- m HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
        ModGuts
    simpl_guts <- IO ModGuts -> m ModGuts
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO (IO ModGuts -> m ModGuts) -> IO ModGuts -> m ModGuts
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> [FilePath] -> ModGuts -> IO ModGuts
    HscMain.hscSimplify HscEnv
    hsc_env [] ModGuts
    dsMod
        ModGuts -> m ()
    forall (m :: Type -> Type). Monad m => ModGuts -> m ()
    checkForInvalidPrelude ModGuts
    simpl_guts
    #if MIN_VERSION_ghc(9,4,0)
        TidyOpts
    opts <- IO TidyOpts -> m TidyOpts
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> IO TidyOpts
    initTidyOpts HscEnv
    hsc_env)
        (CgGuts
    tidy_guts,ModDetails
    _) <- IO (CgGuts, ModDetails) -> m (CgGuts, ModDetails)
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO (IO (CgGuts, ModDetails) -> m (CgGuts, ModDetails))
    -> IO (CgGuts, ModDetails) -> m (CgGuts, ModDetails)
    forall a b. (a -> b) -> a -> b
    $ TidyOpts -> ModGuts -> IO (CgGuts, ModDetails)
    TidyPgm.tidyProgram TidyOpts
    opts ModGuts
    simpl_guts
    #else
        (tidy_guts,_) <- MonadUtils.liftIO $ TidyPgm.tidyProgram hsc_env simpl_guts
    #endif
    #if MIN_VERSION_ghc(9,4,0)
        let
          loadAsByteCode :: Bool
    loadAsByteCode
            | Just GHC.Target { targetAllowObjCode :: Target -> Bool
    targetAllowObjCode = Bool
    obj }
                <- ModSummary -> [Target] -> Maybe Target
    findTarget ModSummary
    m (HscEnv -> [Target]
    HscTypes.hsc_targets HscEnv
    hsc_env)
            , Bool -> Bool
    not Bool
    obj
            = Bool
    True
            | Bool
    otherwise = Bool
    False
          lcl_dflags :: DynFlags
    lcl_dflags = ModSummary -> DynFlags
    GHC.ms_hspp_opts ModSummary
    m
          old_paths :: IncludeSpecs
    old_paths  = DynFlags -> IncludeSpecs
    GHC.includePaths DynFlags
    lcl_dflags
          location :: ModLocation
    location = ModSummary -> ModLocation
    GHC.ms_location ModSummary
    m
          input_fn :: FilePath
    input_fn = FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> FilePath
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "loadLocalModule") (ModLocation -> Maybe FilePath
    GHC.ml_hs_file ModLocation
    location)
          basename :: FilePath
    basename = FilePath -> FilePath
    dropExtension FilePath
    input_fn
          current_dir :: FilePath
    current_dir = FilePath -> FilePath
    takeDirectory FilePath
    basename
    #if MIN_VERSION_ghc(9,6,0)
          interpreterBackend :: Backend
    interpreterBackend = Backend
    Backend.interpreterBackend
    #else
          interpreterBackend = Backend.Interpreter
    #endif
          (Backend
    bcknd, DynFlags
    dflags3)
            | Bool
    loadAsByteCode
            = ( Backend
    interpreterBackend
              , DynFlags -> GeneralFlag -> DynFlags
    DynFlags.gopt_set
                  (DynFlags
    lcl_dflags { GHC.backend = interpreterBackend })
                  GeneralFlag
    Opt_ForceRecomp
              )
            | Bool
    otherwise
            = (DynFlags -> Backend
    GHC.backend DynFlags
    dflags, DynFlags
    lcl_dflags)
          dflags :: DynFlags
    dflags = DynFlags
    dflags3
                  { GHC.includePaths = offsetIncludePaths dflags3 $
                                        DynFlags.addImplicitQuoteInclude
                                          old_paths
                                          [current_dir] }
    #if MIN_VERSION_ghc(9,6,0)
          pipelineOutput :: PipelineOutput
    pipelineOutput = Backend -> PipelineOutput
    Backend.backendPipelineOutput Backend
    bcknd
    #else
          pipelineOutput = case bcknd of
            GHC.Interpreter -> NoOutputFile
            GHC.NoBackend -> NoOutputFile
            _ -> Persistent
    #endif
          upd_summary :: ModSummary
    upd_summary = ModSummary
    m { GHC.ms_hspp_opts = dflags }
          hsc_env1 :: HscEnv
    hsc_env1 = (() :: Constraint) => DynFlags -> HscEnv -> HscEnv
    DynFlags -> HscEnv -> HscEnv
    HscTypes.hscSetFlags DynFlags
    dflags HscEnv
    hsc_env
          pipe_env :: PipeEnv
    pipe_env = StopPhase -> FilePath -> Maybe Phase -> PipelineOutput -> PipeEnv
    mkPipeEnv StopPhase
    NoStop FilePath
    input_fn Maybe Phase
    forall a. Maybe a
    Nothing PipelineOutput
    pipelineOutput
          pipeline :: HookedUse (ModIface, HomeModLinkable)
    pipeline = do
            HscBackendAction
    ac <- TPhase HscBackendAction -> HookedUse HscBackendAction
    forall a. TPhase a -> HookedUse a
    forall (f :: Type -> Type) (m :: Type -> Type) a.
    MonadUse f m =>
    f a -> m a
    use (HscEnv
    -> ModSummary
    -> FrontendResult
    -> Messages GhcMessage
    -> Maybe Fingerprint
    -> TPhase HscBackendAction
    T_HscPostTc HscEnv
    hsc_env1 ModSummary
    upd_summary
                          (TcGblEnv -> FrontendResult
    TcRnTypes.FrontendTypecheck TcGblEnv
    tc_result) Messages GhcMessage
    forall a. Monoid a => a
    mempty Maybe Fingerprint
    forall a. Maybe a
    Nothing )
            PipeEnv
    -> HscEnv
    -> ModSummary
    -> HscBackendAction
    -> HookedUse (ModIface, HomeModLinkable)
    forall (m :: Type -> Type).
    P m =>
    PipeEnv
    -> HscEnv
    -> ModSummary
    -> HscBackendAction
    -> m (ModIface, HomeModLinkable)
    hscBackendPipeline PipeEnv
    pipe_env HscEnv
    hsc_env1 ModSummary
    upd_summary HscBackendAction
    ac
        (ModIface
    iface, HomeModLinkable
    linkable) <- IO (ModIface, HomeModLinkable) -> m (ModIface, HomeModLinkable)
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Hooks
    -> HookedUse (ModIface, HomeModLinkable)
    -> IO (ModIface, HomeModLinkable)
    forall a. Hooks -> HookedUse a -> IO a
    runPipeline (HscEnv -> Hooks
    HscTypes.hsc_hooks HscEnv
    hsc_env1) HookedUse (ModIface, HomeModLinkable)
    pipeline)
    #if MIN_VERSION_ghc(9,6,0)
        ModDetails
    details <- IO ModDetails -> m ModDetails
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> ModIface -> IO ModDetails
    HscMain.initModDetails HscEnv
    hsc_env1 ModIface
    iface)
        Maybe Linkable
    linkable1 <- IO (Maybe Linkable) -> m (Maybe Linkable)
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO ((Linkable -> IO Linkable) -> Maybe Linkable -> IO (Maybe Linkable)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse (HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
    HscMain.initWholeCoreBindings HscEnv
    hsc_env1 ModIface
    iface ModDetails
    details)
                                      (HomeModLinkable -> Maybe Linkable
    homeMod_bytecode HomeModLinkable
    linkable))
        let linkable2 :: HomeModLinkable
    linkable2 = HomeModLinkable
    linkable {homeMod_bytecode = linkable1}
    #else
        details <- liftIO (HscMain.initModDetails hsc_env1 upd_summary iface)
        let linkable2 = linkable
    #endif
        let mod_info :: HomeModInfo
    mod_info = ModIface -> ModDetails -> HomeModLinkable -> HomeModInfo
    HomeModInfo ModIface
    iface ModDetails
    details HomeModLinkable
    linkable2
        (HscEnv -> HscEnv) -> m ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    (HscEnv -> HscEnv) -> m ()
    modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv
    HscTypes.hscUpdateHUG (HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
    addHomeModInfoToHug HomeModInfo
    mod_info)
    #endif
        let pgm :: [CoreBind]
    pgm        = CgGuts -> [CoreBind]
    HscTypes.cg_binds CgGuts
    tidy_guts
        let modFamInstEnv :: FamInstEnv
    modFamInstEnv = TcGblEnv -> FamInstEnv
    TcRnTypes.tcg_fam_inst_env (TcGblEnv -> FamInstEnv) -> TcGblEnv -> FamInstEnv
    forall a b. (a -> b) -> a -> b
    $ (TcGblEnv, ModDetails) -> TcGblEnv
    forall a b. (a, b) -> a
    fst ((TcGblEnv, ModDetails) -> TcGblEnv)
    -> (TcGblEnv, ModDetails) -> TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ TypecheckedModule -> (TcGblEnv, ModDetails)
    GHC.tm_internals_ TypecheckedModule
    tcMod
        ()
    _ <- DynFlags -> m ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags DynFlags
    oldDFlags
        ([CoreBind], FamInstEnv) -> m ([CoreBind], FamInstEnv)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([CoreBind]
    pgm,FamInstEnv
    modFamInstEnv)

      let ([[CoreBind]]
    binders,[FamInstEnv]
    modFamInstEnvs) = [([CoreBind], FamInstEnv)] -> ([[CoreBind]], [FamInstEnv])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [([CoreBind], FamInstEnv)]
    tidiedMods
          binderIds :: [CoreBndr]
    binderIds                = ((CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> CoreBndr
    forall a b. (a, b) -> a
    fst ([CoreBind] -> [(CoreBndr, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    CoreSyn.flattenBinds ([[CoreBind]] -> [CoreBind]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[CoreBind]]
    binders))
          plusFamInst :: FamInstEnv -> FamInstEnv -> FamInstEnv
    plusFamInst FamInstEnv
    f1 FamInstEnv
    f2        = FamInstEnv -> [FamInst] -> FamInstEnv
    FamInstEnv.extendFamInstEnvList FamInstEnv
    f1 (FamInstEnv -> [FamInst]
    FamInstEnv.famInstEnvElts FamInstEnv
    f2)
          modFamInstEnvs' :: FamInstEnv
    modFamInstEnvs'          = (FamInstEnv -> FamInstEnv -> FamInstEnv)
    -> FamInstEnv -> [FamInstEnv] -> FamInstEnv
    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' FamInstEnv -> FamInstEnv -> FamInstEnv
    plusFamInst FamInstEnv
    FamInstEnv.emptyFamInstEnv [FamInstEnv]
    modFamInstEnvs
          rootModule :: ModuleName
    rootModule               = ModSummary -> ModuleName
    GHC.ms_mod_name (ModSummary -> ModuleName)
    -> ([ModSummary] -> ModSummary) -> [ModSummary] -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ModSummary] -> ModSummary
    forall a. HasCallStack => [a] -> a
    last ([ModSummary] -> ModuleName) -> [ModSummary] -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ [ModSummary]
    modGraph2

      -- Because tidiedMods is in topological order, binders is also, and hence
      -- the binders belonging to the "root" module are the last binders
      let rootIds :: [CoreBndr]
    rootIds = ((CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> CoreBndr
    forall a b. (a, b) -> a
    fst ([(CoreBndr, CoreExpr)] -> [CoreBndr])
    -> ([CoreBind] -> [(CoreBndr, CoreExpr)])
    -> [CoreBind]
    -> [CoreBndr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [CoreBind] -> [(CoreBndr, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    CoreSyn.flattenBinds ([CoreBind] -> [CoreBndr]) -> [CoreBind] -> [CoreBndr]
    forall a b. (a -> b) -> a -> b
    $ [[CoreBind]] -> [CoreBind]
    forall a. HasCallStack => [a] -> a
    last [[CoreBind]]
    binders
      LoadedBinders
    loaded0 <- HDL -> [CoreBind] -> m LoadedBinders
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBind] -> m LoadedBinders
    loadExternalExprs HDL
    hdl ([[CoreBind]] -> [CoreBind]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[CoreBind]]
    binders)

      -- Find local primitive annotations
      [Either UnresolvedPrimitive FilePath]
    localPrims <- HDL -> [CoreBndr] -> m [Either UnresolvedPrimitive FilePath]
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBndr] -> m [Either UnresolvedPrimitive FilePath]
    findPrimitiveAnnotations HDL
    hdl [CoreBndr]
    binderIds
      let loaded1 :: LoadedBinders
    loaded1 = LoadedBinders
    loaded0{lbPrims=lbPrims loaded0 <> Seq.fromList localPrims}

      let allBinders :: [CoreBind]
    allBinders = [(CoreBndr, CoreExpr)] -> [CoreBind]
    makeRecursiveGroups (Map CoreBndr CoreExpr -> [(CoreBndr, CoreExpr)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs (LoadedBinders -> Map CoreBndr CoreExpr
    lbBinders LoadedBinders
    loaded0))
      ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    -> m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders,
          [CoreBind])
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([CoreBndr]
    rootIds, FamInstEnv
    modFamInstEnvs', ModuleName
    rootModule, LoadedBinders
    loaded1, [CoreBind]
    allBinders)

    nameString :: Name.Name -> String
    nameString :: Name -> FilePath
    nameString = OccName -> FilePath
    OccName.occNameString (OccName -> FilePath) -> (Name -> OccName) -> Name -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    Name.nameOccName

    varNameString :: Var.Var -> String
    varNameString :: CoreBndr -> FilePath
    varNameString = Name -> FilePath
    nameString (Name -> FilePath) -> (CoreBndr -> Name) -> CoreBndr -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> Name
    Var.varName

    loadModules
      :: GHC.Ghc ()
      -- ^ Allows us to have some initial action, such as sharing a linker state
      -- See https://github.com/clash-lang/clash-compiler/issues/1686 and
      -- https://mail.haskell.org/pipermail/ghc-devs/2021-March/019605.html
      -> OverridingBool
      -- ^ Use color
      -> HDL
      -- ^ HDL target
      -> String
      -- ^ Module name
      -> Maybe (DynFlags.DynFlags)
      -- ^ Flags to run GHC with
      -> [FilePath]
      -- ^ Import dirs to use when no DynFlags are provided
      -> IO ( [CoreSyn.CoreBind]                     -- Binders
            , [(CoreSyn.CoreBndr,Int)]               -- Class operations
            , [CoreSyn.CoreBndr]                     -- Unlocatable Expressions
            , FamInstEnv.FamInstEnvs
            , [(CoreSyn.CoreBndr, Maybe TopEntity, Bool)]  -- binder + synthesize annotation + is testbench?
            , [Either UnresolvedPrimitive FilePath]
            , [DataRepr']
            , [(Text.Text, PrimitiveGuard ())]
            , HashMap Text.Text VDomainConfiguration -- domain names to configuration
            )
    loadModules :: Ghc ()
    -> OverridingBool
    -> HDL
    -> FilePath
    -> Maybe DynFlags
    -> [FilePath]
    -> IO
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    loadModules Ghc ()
    startAction OverridingBool
    useColor HDL
    hdl FilePath
    modName Maybe DynFlags
    dflagsM [FilePath]
    idirs = do
      FilePath
    libDir <- IO FilePath -> IO FilePath
    forall a. IO a -> IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO IO FilePath
    ghcLibDir
      UTCTime
    startTime <- IO UTCTime
    Clock.getCurrentTime
      Maybe FilePath
    -> Ghc
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    -> IO
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    forall a. Maybe FilePath -> Ghc a -> IO a
    GHC.runGhc (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    libDir) (Ghc
       ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
        [(CoreBndr, Maybe TopEntity, Bool)],
        [Either UnresolvedPrimitive FilePath], [DataRepr'],
        [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
     -> IO
          ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
           [(CoreBndr, Maybe TopEntity, Bool)],
           [Either UnresolvedPrimitive FilePath], [DataRepr'],
           [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration))
    -> Ghc
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    -> IO
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    forall a b. (a -> b) -> a -> b
    $ do
        Ghc ()
    startAction
        -- 'mainFunIs' is set to Nothing due to issue #1304:
        -- https://github.com/clash-lang/clash-compiler/issues/1304
        OverridingBool -> Maybe DynFlags -> [FilePath] -> Ghc ()
    forall (m :: Type -> Type).
    GhcMonad m =>
    OverridingBool -> Maybe DynFlags -> [FilePath] -> m ()
    setupGhc OverridingBool
    useColor ((\DynFlags
    d -> DynFlags
    d{GHC.mainFunIs=Nothing}) (DynFlags -> DynFlags) -> Maybe DynFlags -> Maybe DynFlags
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe DynFlags
    dflagsM) [FilePath]
    idirs
        UTCTime
    setupTime <- IO UTCTime -> Ghc UTCTime
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO IO UTCTime
    Clock.getCurrentTime
        let setupStartDiff :: FilePath
    setupStartDiff = UTCTime -> UTCTime -> FilePath
    reportTimeDiff UTCTime
    setupTime UTCTime
    startTime
        IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "GHC: Setting up GHC took: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    setupStartDiff

        -- TODO: We currently load the transitive closure of _all_ bindings found
        -- TODO: in the top module. This is wasteful if one or more binders don't
        -- TODO: contribute to any top entities. This effect is worsened when using
        -- TODO: -main-is, which only synthesizes a single top entity (and all its
        -- TODO: dependencies).
        ([CoreBndr]
    rootIds, FamInstEnv
    modFamInstEnvs, ModuleName
    _rootModule, LoadedBinders{Set CoreBndr
    DeclCache
    Map CoreBndr Int
    Map CoreBndr CoreExpr
    Seq (Either UnresolvedPrimitive FilePath)
    Seq DataRepr'
    lbBinders :: LoadedBinders -> Map CoreBndr CoreExpr
    lbPrims :: LoadedBinders -> Seq (Either UnresolvedPrimitive FilePath)
    lbBinders :: Map CoreBndr CoreExpr
    lbClassOps :: Map CoreBndr Int
    lbUnlocatable :: Set CoreBndr
    lbPrims :: Seq (Either UnresolvedPrimitive FilePath)
    lbReprs :: Seq DataRepr'
    lbCache :: DeclCache
    lbClassOps :: LoadedBinders -> Map CoreBndr Int
    lbUnlocatable :: LoadedBinders -> Set CoreBndr
    lbReprs :: LoadedBinders -> Seq DataRepr'
    lbCache :: LoadedBinders -> DeclCache
    ..}, [CoreBind]
    allBinders) <-
          -- We need to try and load external modules first, because we can't
          -- recover from errors in 'loadLocalModule'.
          HDL
    -> FilePath
    -> Ghc
         (Either
            SomeException
            ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    HDL
    -> FilePath
    -> m (Either
            SomeException
            ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    loadExternalModule HDL
    hdl FilePath
    modName Ghc
      (Either
         SomeException
         ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    -> (Either
          SomeException
          ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
        -> Ghc
             ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind]))
    -> Ghc
         ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Left SomeException
    _loadExternalErr -> HDL
    -> FilePath
    -> Ghc
         ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    forall (m :: Type -> Type).
    GhcMonad m =>
    HDL
    -> FilePath
    -> m ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders,
          [CoreBind])
    loadLocalModule HDL
    hdl FilePath
    modName
            Right ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    res -> ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    -> Ghc
         ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    forall a. a -> Ghc a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([CoreBndr], FamInstEnv, ModuleName, LoadedBinders, [CoreBind])
    res

        let allBinderIds :: [CoreBndr]
    allBinderIds = ((CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> CoreBndr
    forall a b. (a, b) -> a
    fst ([CoreBind] -> [(CoreBndr, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    CoreSyn.flattenBinds [CoreBind]
    allBinders)

        UTCTime
    modTime <- [CoreBndr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [CoreBndr]
    allBinderIds Int -> Ghc UTCTime -> Ghc UTCTime
    forall a b. a -> b -> b
    `seq` IO UTCTime -> Ghc UTCTime
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO IO UTCTime
    Clock.getCurrentTime
        let modStartDiff :: FilePath
    modStartDiff = UTCTime -> UTCTime -> FilePath
    reportTimeDiff UTCTime
    modTime UTCTime
    setupTime
        IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    MonadUtils.liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "GHC: Compiling and loading modules took: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    modStartDiff

        -- Get type family instances: accumulated by GhcMonad during
        -- 'loadExternalBinders' / 'loadExternalExprs'
        HscEnv
    hscEnv <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
        FamInstEnvs
    famInstEnvs <- do
          (Messages TcRnMessage
    msgs, Maybe FamInstEnvs
    m) <- IO (Messages TcRnMessage, Maybe FamInstEnvs)
    -> Ghc (Messages TcRnMessage, Maybe FamInstEnvs)
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    TcRnMonad.liftIO (IO (Messages TcRnMessage, Maybe FamInstEnvs)
     -> Ghc (Messages TcRnMessage, Maybe FamInstEnvs))
    -> IO (Messages TcRnMessage, Maybe FamInstEnvs)
    -> Ghc (Messages TcRnMessage, Maybe FamInstEnvs)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> TcM FamInstEnvs -> IO (Messages TcRnMessage, Maybe FamInstEnvs)
    forall a. HscEnv -> TcM a -> IO (Messages TcRnMessage, Maybe a)
    TcRnMonad.initTcInteractive HscEnv
    hscEnv TcM FamInstEnvs
    FamInst.tcGetFamInstEnvs
          case Maybe FamInstEnvs
    m of
            Maybe FamInstEnvs
    Nothing -> IO FamInstEnvs -> Ghc FamInstEnvs
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    TcRnMonad.liftIO (IO FamInstEnvs -> Ghc FamInstEnvs)
    -> IO FamInstEnvs -> Ghc FamInstEnvs
    forall a b. (a -> b) -> a -> b
    $ SourceError -> IO FamInstEnvs
    forall e a. Exception e => e -> IO a
    throwIO
                                        (SourceError -> IO FamInstEnvs) -> SourceError -> IO FamInstEnvs
    forall a b. (a -> b) -> a -> b
    $ Messages GhcMessage -> SourceError
    HscTypes.mkSrcErr
    #if MIN_VERSION_ghc(9,4,0)
                                        (Messages GhcMessage -> SourceError)
    -> Messages GhcMessage -> SourceError
    forall a b. (a -> b) -> a -> b
    $ (TcRnMessage -> GhcMessage)
    -> Messages TcRnMessage -> Messages GhcMessage
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcRnMessage -> GhcMessage
    GhcTcRnMessage Messages TcRnMessage
    msgs
    #elif MIN_VERSION_ghc(9,2,0)
                                        $ Error.getErrorMessages msgs
    #else
                                        $ snd msgs
    #endif
            Just FamInstEnvs
    x  -> FamInstEnvs -> Ghc FamInstEnvs
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return FamInstEnvs
    x

        Map CoreBndr TopEntity
    allSyn     <- [(CoreBndr, TopEntity)] -> Map CoreBndr TopEntity
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(CoreBndr, TopEntity)] -> Map CoreBndr TopEntity)
    -> Ghc [(CoreBndr, TopEntity)] -> Ghc (Map CoreBndr TopEntity)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [CoreBndr] -> Ghc [(CoreBndr, TopEntity)]
    forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m [(CoreBndr, TopEntity)]
    findSynthesizeAnnotations [CoreBndr]
    allBinderIds
        [CoreBndr]
    topSyn     <- ((CoreBndr, TopEntity) -> CoreBndr)
    -> [(CoreBndr, TopEntity)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, TopEntity) -> CoreBndr
    forall a b. (a, b) -> a
    fst ([(CoreBndr, TopEntity)] -> [CoreBndr])
    -> Ghc [(CoreBndr, TopEntity)] -> Ghc [CoreBndr]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [CoreBndr] -> Ghc [(CoreBndr, TopEntity)]
    forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m [(CoreBndr, TopEntity)]
    findSynthesizeAnnotations [CoreBndr]
    rootIds
        Map CoreBndr [CoreBndr]
    benchAnn   <- [CoreBndr] -> Ghc (Map CoreBndr [CoreBndr])
    forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m (Map CoreBndr [CoreBndr])
    findTestBenches [CoreBndr]
    rootIds
        [DataRepr']
    reprs'     <- Ghc [DataRepr']
    forall (m :: Type -> Type). GhcMonad m => m [DataRepr']
    findCustomReprAnnotations
        [(Text, PrimitiveGuard ())]
    primGuards <- [CoreBndr] -> Ghc [(Text, PrimitiveGuard ())]
    forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m [(Text, PrimitiveGuard ())]
    findPrimitiveGuardAnnotations [CoreBndr]
    allBinderIds
        let
          -- All binders synthesized with Synthesize, all binders annotated with
          -- TestBench and the binders they're pointing to, plus magically named
          -- functions called "topEntity" or "testBench". Synthesized in case user
          -- didn't specify a particular target.
          isMagicName :: FilePath -> Bool
    isMagicName = (FilePath -> [FilePath] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem` [FilePath
    "topEntity", FilePath
    "testBench"])
          allImplicit :: [CoreBndr]
    allImplicit = [CoreBndr] -> [CoreBndr]
    forall a. Ord a => [a] -> [a]
    nubSort ([CoreBndr] -> [CoreBndr]) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> a -> b
    $
               Map CoreBndr [CoreBndr] -> [CoreBndr]
    forall k a. Map k a -> [k]
    Map.keys Map CoreBndr [CoreBndr]
    benchAnn
            [CoreBndr] -> [CoreBndr] -> [CoreBndr]
    forall a. Semigroup a => a -> a -> a
    <> Map CoreBndr TopEntity -> [CoreBndr]
    forall k a. Map k a -> [k]
    Map.keys Map CoreBndr TopEntity
    allSyn
            [CoreBndr] -> [CoreBndr] -> [CoreBndr]
    forall a. Semigroup a => a -> a -> a
    <> [[CoreBndr]] -> [CoreBndr]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat (Map CoreBndr [CoreBndr] -> [[CoreBndr]]
    forall k a. Map k a -> [a]
    Map.elems Map CoreBndr [CoreBndr]
    benchAnn)
            [CoreBndr] -> [CoreBndr] -> [CoreBndr]
    forall a. Semigroup a => a -> a -> a
    <> (CoreBndr -> Bool) -> [CoreBndr] -> [CoreBndr]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FilePath -> Bool
    isMagicName (FilePath -> Bool) -> (CoreBndr -> FilePath) -> CoreBndr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> FilePath
    varNameString) [CoreBndr]
    rootIds
            [CoreBndr] -> [CoreBndr] -> [CoreBndr]
    forall a. Semigroup a => a -> a -> a
    <> [CoreBndr]
    topSyn

          -- Top entities we wish to synthesize. Users can filter these with -main-is.
          topEntities1 :: [CoreBndr]
    topEntities1 =
            case DynFlags -> Maybe FilePath
    GHC.mainFunIs (DynFlags -> Maybe FilePath) -> Maybe DynFlags -> Maybe FilePath
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe DynFlags
    dflagsM of
              Just FilePath
    mainIsNm ->
                -- Use requested top entity.
                --
                -- TODO: Look up associated test benches in 'benchAnn'. This would
                --       be wasted effort if implemented right now, as 'getMainTopEntity'
                --       would later remove them again. Functionality of that function
                --       should be moved here.
                --
                -- TODO: Handle fully qualified names to -main-is
                case (CoreBndr -> Bool) -> [CoreBndr] -> Maybe CoreBndr
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Maybe a
    find ((FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    mainIsNm) (FilePath -> Bool) -> (CoreBndr -> FilePath) -> CoreBndr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> FilePath
    varNameString) [CoreBndr]
    rootIds of
                  Maybe CoreBndr
    Nothing ->
                    FilePath -> [CoreBndr]
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError [I.i|
                      No top-level function called '#{mainIsNm}' found. Did you
                      forget to export it?
                    |]
                  Just CoreBndr
    top ->
                    -- Note that we return /all/ top entities here, even the ones
                    -- we don't which to synthesize. 'getMainTopEntity' will later
                    -- restrict this to just this top entity (and its dependencies,
                    -- which is why we return everything in the first place).
                    --
                    -- This is quite wasteful though; als Clash will load all
                    -- definitions even though it will end up using just a few. TODO
                    [CoreBndr] -> [CoreBndr]
    forall a. Ord a => [a] -> [a]
    nubSort (CoreBndr
    topCoreBndr -> [CoreBndr] -> [CoreBndr]
    forall a. a -> [a] -> [a]
    :[CoreBndr]
    allImplicit)
              Maybe FilePath
    Nothing ->
                -- User didn't specify anything.
                case [CoreBndr]
    allImplicit of
                  [] ->
                    FilePath -> [CoreBndr]
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError [I.i|
                      No top-level function called 'topEntity' or 'testBench' found,
                      nor any function annotated with a 'Synthesize' or 'TestBench'
                      annotation. If you want to synthesize a specific binder in
                      #{show modName}, use '-main-is myTopEntity'.
                    |]
                  [CoreBndr]
    _ ->
                    [CoreBndr]
    allImplicit

          -- Include whether found top entity is a test bench
          allBenchIds :: Set CoreBndr
    allBenchIds = [CoreBndr] -> Set CoreBndr
    forall a. Ord a => [a] -> Set a
    Set.fromList ([[CoreBndr]] -> [CoreBndr]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat (Map CoreBndr [CoreBndr] -> [[CoreBndr]]
    forall k a. Map k a -> [a]
    Map.elems Map CoreBndr [CoreBndr]
    benchAnn))
          topEntities2 :: [(CoreBndr, Maybe TopEntity, Bool)]
    topEntities2 = [CoreBndr]
    topEntities1 [CoreBndr]
    -> (CoreBndr -> (CoreBndr, Maybe TopEntity, Bool))
    -> [(CoreBndr, Maybe TopEntity, Bool)]
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
    <&> \CoreBndr
    tid ->
            ( CoreBndr
    tid
            , CoreBndr
    tid CoreBndr -> Map CoreBndr TopEntity -> Maybe TopEntity
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map CoreBndr TopEntity
    allSyn       -- include top entity annotation (if any)
            , CoreBndr
    tid CoreBndr -> Set CoreBndr -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set CoreBndr
    allBenchIds  -- indicate whether top entity is test bench
            )

        let reprs1 :: Seq DataRepr'
    reprs1 = Seq DataRepr'
    lbReprs Seq DataRepr' -> Seq DataRepr' -> Seq DataRepr'
    forall a. Semigroup a => a -> a -> a
    <> [DataRepr'] -> Seq DataRepr'
    forall a. [a] -> Seq a
    Seq.fromList [DataRepr']
    reprs'

        let famInstEnvs' :: FamInstEnvs
    famInstEnvs' = (FamInstEnvs -> FamInstEnv
    forall a b. (a, b) -> a
    fst FamInstEnvs
    famInstEnvs, FamInstEnv
    modFamInstEnvs)
            allTCInsts :: [FamInst]
    allTCInsts   = FamInstEnv -> [FamInst]
    FamInstEnv.famInstEnvElts (FamInstEnvs -> FamInstEnv
    forall a b. (a, b) -> a
    fst FamInstEnvs
    famInstEnvs')
                             [FamInst] -> [FamInst] -> [FamInst]
    forall a. [a] -> [a] -> [a]
    ++ FamInstEnv -> [FamInst]
    FamInstEnv.famInstEnvElts (FamInstEnvs -> FamInstEnv
    forall a b. (a, b) -> b
    snd FamInstEnvs
    famInstEnvs')

            knownConfs :: [FamInst]
    knownConfs   = (FamInst -> Bool) -> [FamInst] -> [FamInst]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\FamInst
    x -> FilePath
    "KnownConf" FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> FilePath
    nameString (FamInst -> Name
    FamInstEnv.fi_fam FamInst
    x)) [FamInst]
    allTCInsts

    #if MIN_VERSION_ghc(8,10,0)
            fsToText :: FastString -> Text
    fsToText     = ByteString -> Text
    Text.decodeUtf8 (ByteString -> Text)
    -> (FastString -> ByteString) -> FastString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> ByteString
    FastString.bytesFS
    #else
            fsToText     = Text.decodeUtf8 . FastString.fastStringToByteString
    #endif

            famToDomain :: FamInst -> Text
    famToDomain  = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> Text
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "KnownConf: Expected Symbol at LHS of type family")
                             (Maybe Text -> Text) -> (FamInst -> Maybe Text) -> FamInst -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Maybe Text) -> Maybe Text
    forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe Text) -> Maybe Text)
    -> (FamInst -> Maybe (Maybe Text)) -> FamInst -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe FastString -> Maybe Text)
    -> Maybe (Maybe FastString) -> Maybe (Maybe Text)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((FastString -> Text) -> Maybe FastString -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FastString -> Text
    fsToText) (Maybe (Maybe FastString) -> Maybe (Maybe Text))
    -> (FamInst -> Maybe (Maybe FastString))
    -> FamInst
    -> Maybe (Maybe Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Maybe FastString)
    -> Maybe Type -> Maybe (Maybe FastString)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Maybe FastString
    Type.isStrLitTy
                             (Maybe Type -> Maybe (Maybe FastString))
    -> (FamInst -> Maybe Type) -> FamInst -> Maybe (Maybe FastString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Type] -> Maybe Type
    forall a. [a] -> Maybe a
    listToMaybe ([Type] -> Maybe Type)
    -> (FamInst -> [Type]) -> FamInst -> Maybe Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FamInst -> [Type]
    FamInstEnv.fi_tys
            famToConf :: FamInst -> VDomainConfiguration
    famToConf    = Type -> VDomainConfiguration
    unpackKnownConf (Type -> VDomainConfiguration)
    -> (FamInst -> Type) -> FamInst -> VDomainConfiguration
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FamInst -> Type
    FamInstEnv.fi_rhs

            knownConfNms :: [Text]
    knownConfNms = (FamInst -> Text) -> [FamInst] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FamInst -> Text
    famToDomain [FamInst]
    knownConfs
            knownConfDs :: [VDomainConfiguration]
    knownConfDs  = (FamInst -> VDomainConfiguration)
    -> [FamInst] -> [VDomainConfiguration]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FamInst -> VDomainConfiguration
    famToConf [FamInst]
    knownConfs

            knownConfMap :: HashMap Text VDomainConfiguration
    knownConfMap = [(Text, VDomainConfiguration)] -> HashMap Text VDomainConfiguration
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([Text] -> [VDomainConfiguration] -> [(Text, VDomainConfiguration)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    knownConfNms [VDomainConfiguration]
    knownConfDs)

        ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
     [(CoreBndr, Maybe TopEntity, Bool)],
     [Either UnresolvedPrimitive FilePath], [DataRepr'],
     [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    -> Ghc
         ([CoreBind], [(CoreBndr, Int)], [CoreBndr], FamInstEnvs,
          [(CoreBndr, Maybe TopEntity, Bool)],
          [Either UnresolvedPrimitive FilePath], [DataRepr'],
          [(Text, PrimitiveGuard ())], HashMap Text VDomainConfiguration)
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ( [CoreBind]
    allBinders
               , Map CoreBndr Int -> [(CoreBndr, Int)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map CoreBndr Int
    lbClassOps
               , Set CoreBndr -> [CoreBndr]
    forall a. Set a -> [a]
    Set.toList Set CoreBndr
    lbUnlocatable
               , FamInstEnvs
    famInstEnvs'
               , [(CoreBndr, Maybe TopEntity, Bool)]
    topEntities2
               , Seq (Either UnresolvedPrimitive FilePath)
    -> [Either UnresolvedPrimitive FilePath]
    forall a. Seq a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList Seq (Either UnresolvedPrimitive FilePath)
    lbPrims
               , Seq DataRepr' -> [DataRepr']
    forall a. Seq a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList Seq DataRepr'
    reprs1
               , [(Text, PrimitiveGuard ())]
    primGuards
               , HashMap Text VDomainConfiguration
    knownConfMap
               )

    -- | Given a type that represents the RHS of a KnownConf type family instance,
    -- unpack the fields of the DomainConfiguration and make a VDomainConfiguration.
    --
    unpackKnownConf :: Type.Type -> VDomainConfiguration
    unpackKnownConf :: Type -> VDomainConfiguration
    unpackKnownConf Type
    ty
      | [Type
    d,Type
    p,Type
    ae,Type
    rk,Type
    ib,Type
    rp] <- HasCallStack => Type -> [Type]
    Type -> [Type]
    Type.tyConAppArgs Type
    ty
        -- Domain name
      , Just FilePath
    dom <- (FastString -> FilePath) -> Maybe FastString -> Maybe FilePath
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FastString -> FilePath
    FastString.unpackFS (Type -> Maybe FastString
    Type.isStrLitTy Type
    d)
        -- Period
      , Just Natural
    period <- (Integer -> Natural) -> Maybe Integer -> Maybe Natural
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> Natural
    naturalFromInteger (Type -> Maybe Integer
    Type.isNumLitTy Type
    p)
        -- Active Edge
      , TyCon
    aeTc <- (() :: Constraint) => Type -> TyCon
    Type -> TyCon
    Type.tyConAppTyCon Type
    ae
      , Just DataCon
    aeDc <- TyCon -> Maybe DataCon
    TyCon.isPromotedDataCon_maybe TyCon
    aeTc
      , FilePath
    aeNm <- OccName -> FilePath
    OccName.occNameString (OccName -> FilePath) -> OccName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Name -> OccName
    Name.nameOccName (DataCon -> Name
    DataCon.dataConName DataCon
    aeDc)
        -- Reset Kind
      , TyCon
    rkTc <- (() :: Constraint) => Type -> TyCon
    Type -> TyCon
    Type.tyConAppTyCon Type
    rk
      , Just DataCon
    rkDc <- TyCon -> Maybe DataCon
    TyCon.isPromotedDataCon_maybe TyCon
    rkTc
      , FilePath
    rkNm <- OccName -> FilePath
    OccName.occNameString (OccName -> FilePath) -> OccName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Name -> OccName
    Name.nameOccName (DataCon -> Name
    DataCon.dataConName DataCon
    rkDc)
        -- Init Behavior
      , TyCon
    ibTc <- (() :: Constraint) => Type -> TyCon
    Type -> TyCon
    Type.tyConAppTyCon Type
    ib
      , Just DataCon
    ibDc <- TyCon -> Maybe DataCon
    TyCon.isPromotedDataCon_maybe TyCon
    ibTc
      , FilePath
    ibNm <- OccName -> FilePath
    OccName.occNameString (OccName -> FilePath) -> OccName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Name -> OccName
    Name.nameOccName (DataCon -> Name
    DataCon.dataConName DataCon
    ibDc)
        -- Reset Polarity
      , TyCon
    rpTc <- (() :: Constraint) => Type -> TyCon
    Type -> TyCon
    Type.tyConAppTyCon Type
    rp
      , Just DataCon
    rpDc <- TyCon -> Maybe DataCon
    TyCon.isPromotedDataCon_maybe TyCon
    rpTc
      , FilePath
    rpNm <- OccName -> FilePath
    OccName.occNameString (OccName -> FilePath) -> OccName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Name -> OccName
    Name.nameOccName (DataCon -> Name
    DataCon.dataConName DataCon
    rpDc)
      = FilePath
    -> Natural
    -> ActiveEdge
    -> ResetKind
    -> InitBehavior
    -> ResetPolarity
    -> VDomainConfiguration
    VDomainConfiguration FilePath
    dom Natural
    period
          (HasCallStack => FilePath -> ActiveEdge
    FilePath -> ActiveEdge
    asActiveEdge FilePath
    aeNm)
          (HasCallStack => FilePath -> ResetKind
    FilePath -> ResetKind
    asResetKind FilePath
    rkNm)
          (HasCallStack => FilePath -> InitBehavior
    FilePath -> InitBehavior
    asInitBehavior FilePath
    ibNm)
          (HasCallStack => FilePath -> ResetPolarity
    FilePath -> ResetPolarity
    asResetPolarity FilePath
    rpNm)

      | Bool
    otherwise
      = FilePath -> VDomainConfiguration
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> VDomainConfiguration)
    -> FilePath -> VDomainConfiguration
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "Could not unpack domain configuration."
     where
      asActiveEdge :: HasCallStack => String -> ActiveEdge
      asActiveEdge :: HasCallStack => FilePath -> ActiveEdge
    asActiveEdge FilePath
    x = ActiveEdge -> Maybe ActiveEdge -> ActiveEdge
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> ActiveEdge
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ActiveEdge) -> FilePath -> ActiveEdge
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "Unknown active edge: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    x) (FilePath -> Maybe ActiveEdge
    forall a. Read a => FilePath -> Maybe a
    readMaybe FilePath
    x)

      asResetKind :: HasCallStack => String -> ResetKind
      asResetKind :: HasCallStack => FilePath -> ResetKind
    asResetKind FilePath
    x = ResetKind -> Maybe ResetKind -> ResetKind
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> ResetKind
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ResetKind) -> FilePath -> ResetKind
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "Unknown reset kind: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    x) (FilePath -> Maybe ResetKind
    forall a. Read a => FilePath -> Maybe a
    readMaybe FilePath
    x)

      asInitBehavior :: HasCallStack => String -> InitBehavior
      asInitBehavior :: HasCallStack => FilePath -> InitBehavior
    asInitBehavior FilePath
    x = InitBehavior -> Maybe InitBehavior -> InitBehavior
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> InitBehavior
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> InitBehavior) -> FilePath -> InitBehavior
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "Unknown init behavior: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    x) (FilePath -> Maybe InitBehavior
    forall a. Read a => FilePath -> Maybe a
    readMaybe FilePath
    x)

      asResetPolarity :: HasCallStack => String -> ResetPolarity
      asResetPolarity :: HasCallStack => FilePath -> ResetPolarity
    asResetPolarity FilePath
    x = ResetPolarity -> Maybe ResetPolarity -> ResetPolarity
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> ResetPolarity
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ResetPolarity) -> FilePath -> ResetPolarity
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "Unknown reset polarity: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    x) (FilePath -> Maybe ResetPolarity
    forall a. Read a => FilePath -> Maybe a
    readMaybe FilePath
    x)

    -- | Given a set of bindings, make explicit non-recursive bindings and
    -- recursive binding groups.
    --
    -- Needed because:
    -- 1. GHC does not preserve this information in interface files,
    -- 2. Binders in Clash's BindingsMap are not allowed to be mutually recursive,
    --    only self-recursive.
    -- 3. Clash.GHC.GenerateBindings.mkBindings turns groups of mutually recursive
    --    bindings into self-recursive bindings which can go into the BindingsMap.
    makeRecursiveGroups
      :: [(CoreSyn.CoreBndr,CoreSyn.CoreExpr)]
      -> [CoreSyn.CoreBind]
    makeRecursiveGroups :: [(CoreBndr, CoreExpr)] -> [CoreBind]
    makeRecursiveGroups
      = (SCC (CoreBndr, CoreExpr) -> CoreBind)
    -> [SCC (CoreBndr, CoreExpr)] -> [CoreBind]
    forall a b. (a -> b) -> [a] -> [b]
    map SCC (CoreBndr, CoreExpr) -> CoreBind
    makeBind
      ([SCC (CoreBndr, CoreExpr)] -> [CoreBind])
    -> ([(CoreBndr, CoreExpr)] -> [SCC (CoreBndr, CoreExpr)])
    -> [(CoreBndr, CoreExpr)]
    -> [CoreBind]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Node Unique (CoreBndr, CoreExpr)] -> [SCC (CoreBndr, CoreExpr)]
    forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC payload]
    Digraph.stronglyConnCompFromEdgedVerticesUniq
      ([Node Unique (CoreBndr, CoreExpr)] -> [SCC (CoreBndr, CoreExpr)])
    -> ([(CoreBndr, CoreExpr)] -> [Node Unique (CoreBndr, CoreExpr)])
    -> [(CoreBndr, CoreExpr)]
    -> [SCC (CoreBndr, CoreExpr)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((CoreBndr, CoreExpr) -> Node Unique (CoreBndr, CoreExpr))
    -> [(CoreBndr, CoreExpr)] -> [Node Unique (CoreBndr, CoreExpr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> Node Unique (CoreBndr, CoreExpr)
    makeNode
      where
        makeNode
          :: (CoreSyn.CoreBndr,CoreSyn.CoreExpr)
          -> Digraph.Node Unique.Unique (CoreSyn.CoreBndr,CoreSyn.CoreExpr)
        makeNode :: (CoreBndr, CoreExpr) -> Node Unique (CoreBndr, CoreExpr)
    makeNode (CoreBndr
    b,CoreExpr
    e) =
          (CoreBndr, CoreExpr)
    -> Unique -> [Unique] -> Node Unique (CoreBndr, CoreExpr)
    forall key payload. payload -> key -> [key] -> Node key payload
    Digraph.DigraphNode
            (CoreBndr
    b,CoreExpr
    e)
            (CoreBndr -> Unique
    Var.varUnique CoreBndr
    b)
            (UniqSet CoreBndr -> [Unique]
    forall elt. UniqSet elt -> [Unique]
    UniqSet.nonDetKeysUniqSet ((CoreBndr -> Bool) -> CoreExpr -> UniqSet CoreBndr
    CoreFVs.exprSomeFreeVars CoreBndr -> Bool
    Var.isId CoreExpr
    e))

        makeBind
          :: Digraph.SCC (CoreSyn.CoreBndr,CoreSyn.CoreExpr)
          -> CoreSyn.CoreBind
        makeBind :: SCC (CoreBndr, CoreExpr) -> CoreBind
    makeBind (Digraph.AcyclicSCC (CoreBndr
    b,CoreExpr
    e)) = CoreBndr -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    CoreSyn.NonRec CoreBndr
    b CoreExpr
    e
        makeBind (Digraph.CyclicSCC [(CoreBndr, CoreExpr)]
    bs)     = [(CoreBndr, CoreExpr)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    CoreSyn.Rec [(CoreBndr, CoreExpr)]
    bs

    errOnDuplicateAnnotations
      :: String
      -- ^ Name of annotation
      -> [CoreSyn.CoreBndr]
      -- ^ Binders searched for
      -> [[a]]
      -- ^ Parsed annotations
      -> [(CoreSyn.CoreBndr, a)]
    errOnDuplicateAnnotations :: forall a. FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    errOnDuplicateAnnotations FilePath
    nm =
      (a -> a -> Either FilePath a)
    -> FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    forall a.
    (a -> a -> Either FilePath a)
    -> FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    combineAnnotationsWith a -> a -> Either FilePath a
    forall {p} {p} {b}. p -> p -> Either FilePath b
    err FilePath
    nm
     where
      err :: p -> p -> Either FilePath b
    err p
    _ p
    _ = FilePath -> Either FilePath b
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath b) -> FilePath -> Either FilePath b
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "A binder can't have more than one '" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    nm FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "' annotation."

    combineAnnotationsWith
      :: forall a. (a -> a -> Either String a)
      -- ^ function to (attempts to) combine different annotations
      -> String
      -- ^ Name of annotation
      -> [CoreSyn.CoreBndr]
      -- ^ Binders searched for
      -> [[a]]
      -- ^ Parsed annotations
      -> [(CoreSyn.CoreBndr, a)]
    combineAnnotationsWith :: forall a.
    (a -> a -> Either FilePath a)
    -> FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    combineAnnotationsWith a -> a -> Either FilePath a
    f FilePath
    nm [CoreBndr]
    bndrs [[a]]
    anns =
      [(CoreBndr, [a])] -> [(CoreBndr, a)]
    go ([CoreBndr] -> [[a]] -> [(CoreBndr, [a])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [CoreBndr]
    bndrs [[a]]
    anns)
     where
      go :: [(CoreSyn.CoreBndr, [a])] -> [(CoreSyn.CoreBndr, a)]
      go :: [(CoreBndr, [a])] -> [(CoreBndr, a)]
    go []             = []
      go ((CoreBndr
    _, []):[(CoreBndr, [a])]
    ps)   = [(CoreBndr, [a])] -> [(CoreBndr, a)]
    go [(CoreBndr, [a])]
    ps
      go ((CoreBndr
    b, (a
    a:[a]
    as)):[(CoreBndr, [a])]
    ps) = case (a -> a -> Either FilePath a) -> a -> [a] -> Either FilePath a
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM a -> a -> Either FilePath a
    f a
    a [a]
    as of
        Left FilePath
    err ->
          FilePath -> [(CoreBndr, a)]
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError (FilePath -> [(CoreBndr, a)]) -> FilePath -> [(CoreBndr, a)]
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Error processing '" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    nm FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "' annotations on "
                           FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ SDoc -> FilePath
    Outputable.showSDocUnsafe (Name -> SDoc
    pprQualified (Name -> SDoc) -> Name -> SDoc
    forall a b. (a -> b) -> a -> b
    $ CoreBndr -> Name
    Var.varName CoreBndr
    b)
                           FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ":\n" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    err
        Right a
    x -> (CoreBndr
    b, a
    x) (CoreBndr, a) -> [(CoreBndr, a)] -> [(CoreBndr, a)]
    forall a. a -> [a] -> [a]
    : [(CoreBndr, [a])] -> [(CoreBndr, a)]
    go [(CoreBndr, [a])]
    ps
      pprQualified :: Name.Name -> Outputable.SDoc
      pprQualified :: Name -> SDoc
    pprQualified Name
    x = case Name -> Maybe Module
    Name.nameModule_maybe Name
    x of
        Just Module
    m  -> [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    Outputable.hcat [Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    m, SDoc
    forall doc. IsLine doc => doc
    Outputable.dot, Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    x]
        Maybe Module
    Nothing -> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    x

    -- | Find annotations by given targets
    findAnnotationsByTargets
      :: (GHC.GhcMonad m, Data a, Typeable a)
      => [Annotations.AnnTarget Name.Name]
      -> m [[a]]
    findAnnotationsByTargets :: forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [AnnTarget Name] -> m [[a]]
    findAnnotationsByTargets [AnnTarget Name]
    targets =
    #if MIN_VERSION_ghc(9,0,0)
      (AnnTarget Name -> m [a]) -> [AnnTarget Name] -> m [[a]]
    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 (([Word8] -> a) -> AnnTarget Name -> m [a]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Typeable a) =>
    ([Word8] -> a) -> AnnTarget Name -> m [a]
    GHC.findGlobalAnns [Word8] -> a
    forall a. Data a => [Word8] -> a
    Serialized.deserializeWithData) [AnnTarget Name]
    targets
    #else
      mapM (GHC.findGlobalAnns GhcPlugins.deserializeWithData) targets
    #endif

    -- | Find all annotations of a certain type in all modules seen so far.
    findAllModuleAnnotations
      :: (GHC.GhcMonad m, Data a, Typeable a)
      => m [a]
    findAllModuleAnnotations :: forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    m [a]
    findAllModuleAnnotations = do
      HscEnv
    hsc_env <- m HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
      AnnEnv
    ann_env <- IO AnnEnv -> m AnnEnv
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO AnnEnv -> m AnnEnv) -> IO AnnEnv -> m AnnEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> Maybe ModGuts -> IO AnnEnv
    HscTypes.prepareAnnotations HscEnv
    hsc_env Maybe ModGuts
    forall a. Maybe a
    Nothing
      [a] -> m [a]
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([a] -> m [a]) -> [a] -> m [a]
    forall a b. (a -> b) -> a -> b
    $ [[a]] -> [a]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat
    #if MIN_VERSION_ghc(9,4,0)
            ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (\(ModuleEnv [a]
    mEnv,NameEnv [a]
    nEnv) -> ModuleEnv [a] -> [[a]]
    forall a. ModuleEnv a -> [a]
    ModuleEnv.moduleEnvElts ModuleEnv [a]
    mEnv [[a]] -> [[a]] -> [[a]]
    forall a. Semigroup a => a -> a -> a
    <> NameEnv [a] -> [[a]]
    forall a. NameEnv a -> [a]
    NameEnv.nonDetNameEnvElts NameEnv [a]
    nEnv)
    #elif MIN_VERSION_ghc(9,0,0)
             $ (\(mEnv,nEnv) -> ModuleEnv.moduleEnvElts mEnv <> NameEnv.nameEnvElts nEnv)
    #else
             $ UniqFM.nonDetEltsUFM
    #endif
             ((ModuleEnv [a], NameEnv [a]) -> [[a]])
    -> (ModuleEnv [a], NameEnv [a]) -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
    forall a.
    Typeable a =>
    ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
    Annotations.deserializeAnns
    #if MIN_VERSION_ghc(9,0,0)
                  [Word8] -> a
    forall a. Data a => [Word8] -> a
    Serialized.deserializeWithData
    #else
                  GhcPlugins.deserializeWithData
    #endif
                  AnnEnv
    ann_env

    -- | Find all annotations belonging to all binders seen so far.
    findNamedAnnotations
      :: (GHC.GhcMonad m, Data a, Typeable a)
      => [CoreSyn.CoreBndr]
      -> m [[a]]
    findNamedAnnotations :: forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [CoreBndr] -> m [[a]]
    findNamedAnnotations [CoreBndr]
    bndrs =
      [AnnTarget Name] -> m [[a]]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [AnnTarget Name] -> m [[a]]
    findAnnotationsByTargets ((CoreBndr -> AnnTarget Name) -> [CoreBndr] -> [AnnTarget Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> AnnTarget Name
    forall name. name -> AnnTarget name
    Annotations.NamedTarget (Name -> AnnTarget Name)
    -> (CoreBndr -> Name) -> CoreBndr -> AnnTarget Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> Name
    Var.varName) [CoreBndr]
    bndrs)

    findPrimitiveGuardAnnotations
      :: GHC.GhcMonad m
      => [CoreSyn.CoreBndr]
      -> m [(Text.Text, (PrimitiveGuard ()))]
    findPrimitiveGuardAnnotations :: forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m [(Text, PrimitiveGuard ())]
    findPrimitiveGuardAnnotations [CoreBndr]
    bndrs = do
      [[PrimitiveGuard ()]]
    anns0 <- [CoreBndr] -> m [[PrimitiveGuard ()]]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [CoreBndr] -> m [[a]]
    findNamedAnnotations [CoreBndr]
    bndrs
      let anns1 :: [(CoreBndr, PrimitiveGuard ())]
    anns1 = (PrimitiveGuard ()
     -> PrimitiveGuard () -> Either FilePath (PrimitiveGuard ()))
    -> FilePath
    -> [CoreBndr]
    -> [[PrimitiveGuard ()]]
    -> [(CoreBndr, PrimitiveGuard ())]
    forall a.
    (a -> a -> Either FilePath a)
    -> FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    combineAnnotationsWith PrimitiveGuard ()
    -> PrimitiveGuard () -> Either FilePath (PrimitiveGuard ())
    forall {a} {a}.
    PrimitiveGuard a
    -> PrimitiveGuard a -> Either FilePath (PrimitiveGuard ())
    combinePrimGuards FilePath
    "PrimitiveGuard" [CoreBndr]
    bndrs [[PrimitiveGuard ()]]
    anns0
      [(Text, PrimitiveGuard ())] -> m [(Text, PrimitiveGuard ())]
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (((CoreBndr, PrimitiveGuard ()) -> (Text, PrimitiveGuard ()))
    -> [(CoreBndr, PrimitiveGuard ())] -> [(Text, PrimitiveGuard ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CoreBndr -> Text)
    -> (CoreBndr, PrimitiveGuard ()) -> (Text, PrimitiveGuard ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: Type -> Type -> Type) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (Name -> Text
    qualifiedNameString' (Name -> Text) -> (CoreBndr -> Name) -> CoreBndr -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> Name
    Var.varName)) [(CoreBndr, PrimitiveGuard ())]
    anns1)
     where
      combinePrimGuards :: PrimitiveGuard a
    -> PrimitiveGuard a -> Either FilePath (PrimitiveGuard ())
    combinePrimGuards PrimitiveGuard a
    a PrimitiveGuard a
    b = case (PrimitiveGuard a
    a,PrimitiveGuard a
    b) of
        (HasBlackBox [PrimitiveWarning]
    x a
    _, HasBlackBox [PrimitiveWarning]
    y a
    _) -> PrimitiveGuard () -> Either FilePath (PrimitiveGuard ())
    forall a b. b -> Either a b
    Right ([PrimitiveWarning] -> () -> PrimitiveGuard ()
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox ([PrimitiveWarning]
    x[PrimitiveWarning] -> [PrimitiveWarning] -> [PrimitiveWarning]
    forall a. [a] -> [a] -> [a]
    ++[PrimitiveWarning]
    y) ())
        (PrimitiveGuard a
    DontTranslate  , PrimitiveGuard a
    DontTranslate)   -> PrimitiveGuard () -> Either FilePath (PrimitiveGuard ())
    forall a b. b -> Either a b
    Right PrimitiveGuard ()
    forall a. PrimitiveGuard a
    DontTranslate
        (PrimitiveGuard a
    _,PrimitiveGuard a
    _) -> FilePath -> Either FilePath (PrimitiveGuard ())
    forall a b. a -> Either a b
    Left FilePath
    "One binder can't have both HasBlackBox and DontTranslate annotations."

    -- | Find annotations of type @DataReprAnn@ and convert them to @DataRepr'@
    findCustomReprAnnotations
      :: GHC.GhcMonad m
      => m [DataRepr']
    findCustomReprAnnotations :: forall (m :: Type -> Type). GhcMonad m => m [DataRepr']
    findCustomReprAnnotations =
      (DataReprAnn -> DataRepr') -> [DataReprAnn] -> [DataRepr']
    forall a b. (a -> b) -> [a] -> [b]
    map DataReprAnn -> DataRepr'
    dataReprAnnToDataRepr' ([DataReprAnn] -> [DataRepr']) -> m [DataReprAnn] -> m [DataRepr']
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> m [DataReprAnn]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    m [a]
    findAllModuleAnnotations

    -- | Find synthesize annotations and make sure each binder has no more than
    -- a single annotation.
    findSynthesizeAnnotations
      :: GHC.GhcMonad m
      => [CoreSyn.CoreBndr]
      -> m [(CoreSyn.CoreBndr, TopEntity)]
    findSynthesizeAnnotations :: forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m [(CoreBndr, TopEntity)]
    findSynthesizeAnnotations [CoreBndr]
    bndrs = do
      [[TopEntity]]
    anns <- [CoreBndr] -> m [[TopEntity]]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [CoreBndr] -> m [[a]]
    findNamedAnnotations [CoreBndr]
    bndrs
      [(CoreBndr, TopEntity)] -> m [(CoreBndr, TopEntity)]
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (FilePath -> [CoreBndr] -> [[TopEntity]] -> [(CoreBndr, TopEntity)]
    forall a. FilePath -> [CoreBndr] -> [[a]] -> [(CoreBndr, a)]
    errOnDuplicateAnnotations FilePath
    "Synthesize" [CoreBndr]
    bndrs (([TopEntity] -> [TopEntity]) -> [[TopEntity]] -> [[TopEntity]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TopEntity -> Bool) -> [TopEntity] -> [TopEntity]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TopEntity -> Bool
    isSyn) [[TopEntity]]
    anns))
     where
      isSyn :: TopEntity -> Bool
    isSyn (Synthesize {}) = Bool
    True
      isSyn TopEntity
    _               = Bool
    False

    -- | Find test bench annotations and return a map tying top entities to their
    -- test benches. If there is a binder called @testBench@ _without_ an annotation
    -- it assumed to belong to a binder called @topEntity@. If the latter does not
    -- exist, the function @testBench@ is left alone.
    findTestBenches ::
      GHC.GhcMonad m =>
      -- | Root binders
      [CoreSyn.CoreBndr] ->
      -- | (design under test, associated test benches)
      m (Map.Map CoreSyn.CoreBndr [CoreSyn.CoreBndr])
    findTestBenches :: forall (m :: Type -> Type).
    GhcMonad m =>
    [CoreBndr] -> m (Map CoreBndr [CoreBndr])
    findTestBenches [CoreBndr]
    bndrs0 = do
      [[TopEntity]]
    anns <- [CoreBndr] -> m [[TopEntity]]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [CoreBndr] -> m [[a]]
    findNamedAnnotations [CoreBndr]
    bndrs0
      let
        duts0 :: Map CoreBndr [CoreBndr]
    duts0 = (Map CoreBndr [CoreBndr]
     -> (CoreBndr, CoreBndr) -> Map CoreBndr [CoreBndr])
    -> Map CoreBndr [CoreBndr]
    -> [(CoreBndr, CoreBndr)]
    -> Map CoreBndr [CoreBndr]
    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 CoreBndr [CoreBndr]
    -> (CoreBndr, CoreBndr) -> Map CoreBndr [CoreBndr]
    forall {k} {a}. Ord k => Map k [a] -> (k, a) -> Map k [a]
    insertTb Map CoreBndr [CoreBndr]
    forall k a. Map k a
    Map.empty ([[(CoreBndr, CoreBndr)]] -> [(CoreBndr, CoreBndr)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ((CoreBndr -> [TopEntity] -> [(CoreBndr, CoreBndr)])
    -> [CoreBndr] -> [[TopEntity]] -> [[(CoreBndr, CoreBndr)]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith CoreBndr -> [TopEntity] -> [(CoreBndr, CoreBndr)]
    go0 [CoreBndr]
    bndrs0 [[TopEntity]]
    anns))
        duts1 :: Map CoreBndr [CoreBndr]
    duts1 = Map CoreBndr [CoreBndr] -> Map CoreBndr [CoreBndr]
    specialCaseMagicName Map CoreBndr [CoreBndr]
    duts0
      Map CoreBndr [CoreBndr] -> m (Map CoreBndr [CoreBndr])
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Map CoreBndr [CoreBndr]
    duts1
     where
      insertTb :: Map k [a] -> (k, a) -> Map k [a]
    insertTb Map k [a]
    m (k
    dut, a
    tb) = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith [a] -> [a] -> [a]
    forall a. Semigroup a => a -> a -> a
    (<>) k
    dut [a
    tb] Map k [a]
    m
      bndrsMap :: HashMap Text CoreBndr
    bndrsMap = [(Text, CoreBndr)] -> HashMap Text CoreBndr
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ((CoreBndr -> (Text, CoreBndr)) -> [CoreBndr] -> [(Text, CoreBndr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\CoreBndr
    x -> (CoreBndr -> Text
    toQualNm CoreBndr
    x, CoreBndr
    x)) [CoreBndr]
    bndrs0)

      -- Special case magic name 'testBench'. See function documentation.
      specialCaseMagicName :: Map CoreBndr [CoreBndr] -> Map CoreBndr [CoreBndr]
    specialCaseMagicName Map CoreBndr [CoreBndr]
    m =
        let
          topEntM :: Maybe CoreBndr
    topEntM = (CoreBndr -> Bool) -> [CoreBndr] -> Maybe CoreBndr
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Maybe a
    find ((FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "topEntity") (FilePath -> Bool) -> (CoreBndr -> FilePath) -> CoreBndr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> FilePath
    varNameString) [CoreBndr]
    bndrs0
          tbM :: Maybe CoreBndr
    tbM = (CoreBndr -> Bool) -> [CoreBndr] -> Maybe CoreBndr
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Maybe a
    find ((FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "testBench") (FilePath -> Bool) -> (CoreBndr -> FilePath) -> CoreBndr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> FilePath
    varNameString) [CoreBndr]
    bndrs0
        in
          case (Maybe CoreBndr
    topEntM, Maybe CoreBndr
    tbM) of
            (Just CoreBndr
    dut, Just CoreBndr
    tb) -> Map CoreBndr [CoreBndr]
    -> (CoreBndr, CoreBndr) -> Map CoreBndr [CoreBndr]
    forall {k} {a}. Ord k => Map k [a] -> (k, a) -> Map k [a]
    insertTb Map CoreBndr [CoreBndr]
    m (CoreBndr
    dut, CoreBndr
    tb)
            (Maybe CoreBndr, Maybe CoreBndr)
    _ -> Map CoreBndr [CoreBndr]
    m

      -- go0 + go1: map over all annotations; look for test bench annotations and
      -- tie them to top entities indicated in the annotation.
      go0 :: CoreBndr -> [TopEntity] -> [(CoreBndr, CoreBndr)]
    go0 CoreBndr
    bndr [TopEntity]
    anns = (TopEntity -> Maybe (CoreBndr, CoreBndr))
    -> [TopEntity] -> [(CoreBndr, CoreBndr)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (CoreBndr -> TopEntity -> Maybe (CoreBndr, CoreBndr)
    go1 CoreBndr
    bndr) [TopEntity]
    anns
      go1 :: CoreBndr -> TopEntity -> Maybe (CoreBndr, CoreBndr)
    go1 CoreBndr
    tbBndr (TestBench Name
    dutNm) =
        case Text -> HashMap Text CoreBndr -> Maybe CoreBndr
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup (FilePath -> Text
    Text.pack (Name -> FilePath
    forall a. Show a => a -> FilePath
    show Name
    dutNm)) HashMap Text CoreBndr
    bndrsMap of
          Maybe CoreBndr
    Nothing ->
            FilePath -> Maybe (CoreBndr, CoreBndr)
    forall a. HasCallStack => FilePath -> a
    Panic.pgmError [I.i|
              Could not find design under test #{show (show dutNm)}, associated with
              test bench #{show (toQualNm tbBndr)}. Note that testbenches should be
              exported from the same module as the design under test.
            |]
          Just CoreBndr
    dutBndr ->
            (CoreBndr, CoreBndr) -> Maybe (CoreBndr, CoreBndr)
    forall a. a -> Maybe a
    Just (CoreBndr
    dutBndr, CoreBndr
    tbBndr)
      go1 CoreBndr
    _ TopEntity
    _ = Maybe (CoreBndr, CoreBndr)
    forall a. Maybe a
    Nothing

    -- | Create a fully qualified name from a var, excluding package. Example
    -- output: @Clash.Sized.Internal.BitVector.low@.
    toQualNm :: Var.Var -> Text.Text
    toQualNm :: CoreBndr -> Text
    toQualNm CoreBndr
    bndr =
      let
        bndrNm :: Name
    bndrNm  = CoreBndr -> Name
    Var.varName CoreBndr
    bndr
        occName :: Text
    occName = FilePath -> Text
    Text.pack (OccName -> FilePath
    OccName.occNameString (Name -> OccName
    Name.nameOccName Name
    bndrNm))
      in
        Text -> (Text -> Text) -> Maybe Text -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
          Text
    occName
          (\Text
    modName -> Text
    modName Text -> Text -> Text
    `Text.append` (Char
    '.' Char -> Text -> Text
    `Text.cons` Text
    occName))
          (Name -> Maybe Text
    modNameM Name
    bndrNm)

    -- | Find primitive annotations bound to given binders, or annotations made
    -- in modules of those binders.
    findPrimitiveAnnotations
      :: GHC.GhcMonad m
      => HDL
      -> [CoreSyn.CoreBndr]
      -> m [Either UnresolvedPrimitive FilePath]
    findPrimitiveAnnotations :: forall (m :: Type -> Type).
    GhcMonad m =>
    HDL -> [CoreBndr] -> m [Either UnresolvedPrimitive FilePath]
    findPrimitiveAnnotations HDL
    hdl [CoreBndr]
    bndrs = do
      let
        annTargets :: [Maybe (AnnTarget name)]
    annTargets =
         (Name -> Maybe (AnnTarget name))
    -> [Name] -> [Maybe (AnnTarget name)]
    forall a b. (a -> b) -> [a] -> [b]
    map
           ((Module -> AnnTarget name)
    -> Maybe Module -> Maybe (AnnTarget name)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Module -> AnnTarget name
    forall name. Module -> AnnTarget name
    Annotations.ModuleTarget (Maybe Module -> Maybe (AnnTarget name))
    -> (Name -> Maybe Module) -> Name -> Maybe (AnnTarget name)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe Module
    Name.nameModule_maybe)
           ((CoreBndr -> Name) -> [CoreBndr] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreBndr -> Name
    Var.varName [CoreBndr]
    bndrs)

      let
        targets :: [AnnTarget Name]
    targets =
          ([Maybe (AnnTarget Name)] -> [AnnTarget Name]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (AnnTarget Name)]
    forall {name}. [Maybe (AnnTarget name)]
    annTargets) [AnnTarget Name] -> [AnnTarget Name] -> [AnnTarget Name]
    forall a. [a] -> [a] -> [a]
    ++
            ((CoreBndr -> AnnTarget Name) -> [CoreBndr] -> [AnnTarget Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> AnnTarget Name
    forall name. name -> AnnTarget name
    Annotations.NamedTarget (Name -> AnnTarget Name)
    -> (CoreBndr -> Name) -> CoreBndr -> AnnTarget Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> Name
    Var.varName) [CoreBndr]
    bndrs)

      [[Primitive]]
    anns <- [AnnTarget Name] -> m [[Primitive]]
    forall (m :: Type -> Type) a.
    (GhcMonad m, Data a, Typeable a) =>
    [AnnTarget Name] -> m [[a]]
    findAnnotationsByTargets [AnnTarget Name]
    targets

      [[Either UnresolvedPrimitive FilePath]]
    -> [Either UnresolvedPrimitive FilePath]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[Either UnresolvedPrimitive FilePath]]
     -> [Either UnresolvedPrimitive FilePath])
    -> m [[Either UnresolvedPrimitive FilePath]]
    -> m [Either UnresolvedPrimitive FilePath]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        ((AnnTarget Name, Primitive)
     -> m [Either UnresolvedPrimitive FilePath])
    -> [(AnnTarget Name, Primitive)]
    -> m [[Either UnresolvedPrimitive FilePath]]
    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
    -> (AnnTarget Name, Primitive)
    -> m [Either UnresolvedPrimitive FilePath]
    forall (m :: Type -> Type).
    MonadIO m =>
    HDL
    -> (AnnTarget Name, Primitive)
    -> m [Either UnresolvedPrimitive FilePath]
    getUnresolvedPrimitives HDL
    hdl)
        ([[(AnnTarget Name, Primitive)]] -> [(AnnTarget Name, Primitive)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[(AnnTarget Name, Primitive)]] -> [(AnnTarget Name, Primitive)])
    -> [[(AnnTarget Name, Primitive)]] -> [(AnnTarget Name, Primitive)]
    forall a b. (a -> b) -> a -> b
    $ (AnnTarget Name -> [Primitive] -> [(AnnTarget Name, Primitive)])
    -> [AnnTarget Name]
    -> [[Primitive]]
    -> [[(AnnTarget Name, Primitive)]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\AnnTarget Name
    t -> (Primitive -> (AnnTarget Name, Primitive))
    -> [Primitive] -> [(AnnTarget Name, Primitive)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((,) AnnTarget Name
    t)) [AnnTarget Name]
    targets [[Primitive]]
    anns)

    parseModule :: GHC.GhcMonad m => GHC.ModSummary -> m GHC.ParsedModule
    parseModule :: forall (m :: Type -> Type).
    GhcMonad m =>
    ModSummary -> m ParsedModule
    parseModule ModSummary
    modSum = do
    #if MIN_VERSION_ghc(9,2,0)
      (GHC.ParsedModule ModSummary
    pmModSum ParsedSource
    pmParsedSource [FilePath]
    extraSrc) <-
        ModSummary -> m ParsedModule
    forall (m :: Type -> Type).
    GhcMonad m =>
    ModSummary -> m ParsedModule
    GHC.parseModule ModSummary
    modSum
      ParsedModule -> m ParsedModule
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (ModSummary -> ParsedSource -> [FilePath] -> ParsedModule
    GHC.ParsedModule
                (ModSummary -> ModSummary
    disableOptimizationsFlags ModSummary
    pmModSum)
                ParsedSource
    pmParsedSource [FilePath]
    extraSrc)
    #else
      (GHC.ParsedModule pmModSum pmParsedSource extraSrc anns) <-
        GHC.parseModule modSum
      return (GHC.ParsedModule
                (disableOptimizationsFlags pmModSum)
                pmParsedSource extraSrc anns)
    #endif

    disableOptimizationsFlags :: GHC.ModSummary -> GHC.ModSummary
    disableOptimizationsFlags :: ModSummary -> ModSummary
    disableOptimizationsFlags ms :: ModSummary
    ms@(GHC.ModSummary {Bool
    FilePath
    [(PkgQual, Located ModuleName)]
    Maybe StringBuffer
    Maybe HsParsedModule
    Maybe UTCTime
    Fingerprint
    Module
    ModLocation
    HscSource
    DynFlags
    ms_hspp_opts :: ModSummary -> DynFlags
    ms_location :: ModSummary -> ModLocation
    ms_mod :: Module
    ms_hsc_src :: HscSource
    ms_location :: ModLocation
    ms_hs_hash :: Fingerprint
    ms_obj_date :: Maybe UTCTime
    ms_dyn_obj_date :: Maybe UTCTime
    ms_iface_date :: Maybe UTCTime
    ms_hie_date :: Maybe UTCTime
    ms_srcimps :: [(PkgQual, Located ModuleName)]
    ms_textual_imps :: [(PkgQual, Located ModuleName)]
    ms_ghc_prim_import :: Bool
    ms_parsed_mod :: Maybe HsParsedModule
    ms_hspp_file :: FilePath
    ms_hspp_opts :: DynFlags
    ms_hspp_buf :: Maybe StringBuffer
    ms_mod :: ModSummary -> Module
    ms_hsc_src :: ModSummary -> HscSource
    ms_hs_hash :: ModSummary -> Fingerprint
    ms_obj_date :: ModSummary -> Maybe UTCTime
    ms_dyn_obj_date :: ModSummary -> Maybe UTCTime
    ms_iface_date :: ModSummary -> Maybe UTCTime
    ms_hie_date :: ModSummary -> Maybe UTCTime
    ms_srcimps :: ModSummary -> [(PkgQual, Located ModuleName)]
    ms_textual_imps :: ModSummary -> [(PkgQual, Located ModuleName)]
    ms_ghc_prim_import :: ModSummary -> Bool
    ms_parsed_mod :: ModSummary -> Maybe HsParsedModule
    ms_hspp_file :: ModSummary -> FilePath
    ms_hspp_buf :: ModSummary -> Maybe StringBuffer
    ..})
      = ModSummary
    ms {GHC.ms_hspp_opts = dflags}
      where
        dflags :: DynFlags
    dflags = DynFlags -> DynFlags
    unwantedOptimizationFlags (DynFlags
    ms_hspp_opts
                  { DynFlags.reductionDepth = 1000
    #if !MIN_VERSION_ghc(9,4,0)
                  , DynFlags.optLevel = 2
    #endif
                  })

    unwantedOptimizationFlags :: GHC.DynFlags -> GHC.DynFlags
    unwantedOptimizationFlags :: DynFlags -> DynFlags
    unwantedOptimizationFlags DynFlags
    df =
      (DynFlags -> Extension -> DynFlags)
    -> DynFlags -> [Extension] -> DynFlags
    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' DynFlags -> Extension -> DynFlags
    DynFlags.xopt_unset
        ((DynFlags -> GeneralFlag -> DynFlags)
    -> DynFlags -> [GeneralFlag] -> DynFlags
    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' DynFlags -> GeneralFlag -> DynFlags
    DynFlags.gopt_unset DynFlags
    df [GeneralFlag]
    unwanted) [Extension]
    unwantedLang
      where
        unwanted :: [GeneralFlag]
    unwanted = [ GeneralFlag
    Opt_LiberateCase -- Perform unrolling of recursive RHS: avoid
                   , GeneralFlag
    Opt_SpecConstr -- Creates local-functions: avoid
                   , GeneralFlag
    Opt_IgnoreAsserts -- We don't care about assertions
                   , GeneralFlag
    Opt_DoEtaReduction -- We want eta-expansion
                   , GeneralFlag
    Opt_UnboxStrictFields -- Unboxed types are not handled properly: avoid
                   , GeneralFlag
    Opt_UnboxSmallStrictFields -- Unboxed types are not handled properly: avoid
                   , GeneralFlag
    Opt_RegsGraph -- Don't care
                   , GeneralFlag
    Opt_RegsGraph -- Don't care
                   , GeneralFlag
    Opt_PedanticBottoms -- Stops eta-expansion through case: avoid
                   -- , Opt_LlvmTBAA -- Don't care
                   , GeneralFlag
    Opt_CmmSink -- Don't care
                   , GeneralFlag
    Opt_CmmElimCommonBlocks -- Don't care
                   , GeneralFlag
    Opt_OmitYields -- Don't care
                   , GeneralFlag
    Opt_IgnoreInterfacePragmas -- We need all the unfoldings we can get
                   , GeneralFlag
    Opt_OmitInterfacePragmas -- We need all the unfoldings we can get
                   , GeneralFlag
    Opt_IrrefutableTuples -- Introduce irrefutPatError: avoid
                   , GeneralFlag
    Opt_Loopification -- STG pass, don't care
                   , GeneralFlag
    Opt_CprAnal -- The worker/wrapper introduced by CPR breaks Clash, see [NOTE: CPR breaks Clash]
                   , GeneralFlag
    Opt_FullLaziness -- increases sharing, but seems to result in worse circuits (in both area and propagation delay)
                   ]

        -- Coercions between Integer and Clash' numeric primitives cause Clash to
        -- fail. As strictness only affects simulation behavior, removing them
        -- is perfectly safe.
        unwantedLang :: [Extension]
    unwantedLang = [ Extension
    LangExt.Strict
                       , Extension
    LangExt.StrictData
                       ]

    -- [NOTE: CPR breaks Clash]
    -- We used to completely disable strictness analysis because it causes GHC to
    -- do the so-called "Constructed Product Result" (CPR) analysis, which in turn
    -- creates an annoying worker/wrapper which does the following:
    --
    --   * Scrutinise a Signal, and pack the head and tail of the
    --     Signal in an unboxed tuple.
    --   * Scrutinise on the unboxed tuple, and recreate the Signal.
    --
    -- This is problematic because the 'Signal' type is essentially treated as a "transparent"
    -- type by the Clash compiler, so observing its constructor leads to all kinds
    -- of problems.
    --
    -- The current solution is to disable strictness analysis in "Clash.Signal.Internal"
    -- so that functions manipulating 'Signal' constructor do not get a strictness/
    -- demand/CPR annotation, which in turn ensures GHC doesn't create worker/wrappers
    -- for when these functions are called in user code.
    --
    -- Ultimately we should stop treating Signal as a "transparent" type and deal
    -- handling of the Signal type, and the involved co-recursive functions,
    -- properly. At the moment, Clash cannot deal with this recursive type and the
    -- recursive functions involved, and hence we need to disable this useful transformation. After
    -- everything is done properly, we should enable it again.

    setWantedLanguageExtensions :: GHC.DynFlags -> GHC.DynFlags
    setWantedLanguageExtensions :: DynFlags -> DynFlags
    setWantedLanguageExtensions DynFlags
    df =
       (DynFlags -> GeneralFlag -> DynFlags)
    -> DynFlags -> [GeneralFlag] -> DynFlags
    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' DynFlags -> GeneralFlag -> DynFlags
    DynFlags.gopt_set
        ((DynFlags -> Extension -> DynFlags)
    -> DynFlags -> [Extension] -> DynFlags
    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' DynFlags -> Extension -> DynFlags
    DynFlags.xopt_unset
          ((DynFlags -> Extension -> DynFlags)
    -> DynFlags -> [Extension] -> DynFlags
    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' DynFlags -> Extension -> DynFlags
    DynFlags.xopt_set DynFlags
    df [Extension]
    wantedLanguageExtensions)
          [Extension]
    unwantedLanguageExtensions)
        [GeneralFlag]
    wantedOptimizations
     where
      wantedOptimizations :: [GeneralFlag]
    wantedOptimizations =
        [ GeneralFlag
    Opt_CSE -- CSE
        , GeneralFlag
    Opt_Specialise -- Specialise on types, specialise type-class-overloaded function defined in this module for the types
        , GeneralFlag
    Opt_DoLambdaEtaExpansion -- transform nested series of lambdas into one with multiple arguments, helps us achieve only top-level lambdas
        , GeneralFlag
    Opt_CaseMerge -- We want fewer case-statements
        , GeneralFlag
    Opt_DictsCheap -- Makes dictionaries seem cheap to optimizer: hopefully inline
        , GeneralFlag
    Opt_ExposeAllUnfoldings -- We need all the unfoldings we can get
        , GeneralFlag
    Opt_ForceRecomp -- Force recompilation: never bad
        , GeneralFlag
    Opt_EnableRewriteRules -- Reduce number of functions
        , GeneralFlag
    Opt_SimplPreInlining -- Inlines simple functions, we only care about the major first-order structure
        , GeneralFlag
    Opt_StaticArgumentTransformation -- Turn on the static argument transformation, which turns a recursive function into a non-recursive one with a local recursive loop.
        , GeneralFlag
    Opt_FloatIn -- Moves let-bindings inwards, although it defeats the normal-form with a single top-level let-binding, it helps with other transformations
        , GeneralFlag
    Opt_DictsStrict -- Hopefully helps remove class method selectors
        , GeneralFlag
    Opt_DmdTxDictSel -- I think demand and strictness are related, strictness helps with dead-code, enable
        , GeneralFlag
    Opt_Strictness -- Strictness analysis helps with dead-code analysis. However, see [NOTE: CPR breaks Clash]
        , GeneralFlag
    Opt_SpecialiseAggressively -- Needed to compile Fixed point number functions quickly
        , GeneralFlag
    Opt_CrossModuleSpecialise -- Needed to compile Fixed point number functions quickly
        ]

    -- | Remove all strictness annotations:
    --
    -- * Remove strictness annotations from data type declarations
    --   (only works for data types that are currently being compiled, i.e.,
    --    that are not part of a pre-compiled imported library)
    --
    -- We need to remove strictness annotations because GHC will introduce casts
    -- between Integer and Clash' numeric primitives otherwise, where Clash will
    -- error when it sees such casts. The reason it does this is because
    -- Integer is a completely unconstrained integer type and is currently
    -- (erroneously) translated to a 64-bit integer in the HDL; this means that
    -- we could lose bits when the original numeric type had more bits than 64.
    --
    -- Removing these strictness annotations is perfectly safe, as they only
    -- affect simulation behavior.
    removeStrictnessAnnotations ::
         GHC.ParsedModule
      -> GHC.ParsedModule
    removeStrictnessAnnotations :: ParsedModule -> ParsedModule
    removeStrictnessAnnotations ParsedModule
    pm =
        ParsedModule
    pm {GHC.pm_parsed_source = fmap rmPS (GHC.pm_parsed_source pm)}
      where
        -- rmPS :: GHC.DataId name => GHC.HsModule name -> GHC.HsModule name
        rmPS :: HsModule p -> HsModule p
    rmPS HsModule p
    hsm = HsModule p
    hsm {GHC.hsmodDecls = (fmap . fmap) rmHSD (GHC.hsmodDecls hsm)}

        -- rmHSD :: GHC.DataId name => GHC.HsDecl name -> GHC.HsDecl name
        rmHSD :: HsDecl GhcPs -> HsDecl GhcPs
    rmHSD (GHC.TyClD XTyClD GhcPs
    x TyClDecl GhcPs
    tyClDecl) = XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
    forall p. XTyClD p -> TyClDecl p -> HsDecl p
    GHC.TyClD XTyClD GhcPs
    x (TyClDecl GhcPs -> TyClDecl GhcPs
    rmTyClD TyClDecl GhcPs
    tyClDecl)
        rmHSD HsDecl GhcPs
    hsd                  = HsDecl GhcPs
    hsd

        -- rmTyClD :: GHC.DataId name => GHC.TyClDecl name -> GHC.TyClDecl name
        rmTyClD :: TyClDecl GhcPs -> TyClDecl GhcPs
    rmTyClD dc :: TyClDecl GhcPs
    dc@(GHC.DataDecl {}) = TyClDecl GhcPs
    dc {GHC.tcdDataDefn = rmDataDefn (GHC.tcdDataDefn dc)}
        rmTyClD TyClDecl GhcPs
    tyClD = TyClDecl GhcPs
    tyClD

        -- rmDataDefn :: GHC.DataId name => GHC.HsDataDefn name -> GHC.HsDataDefn name
    #if MIN_VERSION_ghc(9,2,0)
        rmDataDefn :: GHC.HsDataDefn GHC.GhcPs -> GHC.HsDataDefn GHC.GhcPs
    #endif
        rmDataDefn :: HsDataDefn GhcPs -> HsDataDefn GhcPs
    rmDataDefn HsDataDefn GhcPs
    hdf = HsDataDefn GhcPs
    hdf {GHC.dd_cons = (fmap . fmap) rmCD (GHC.dd_cons hdf)}

        -- rmCD :: GHC.DataId name => GHC.ConDecl name -> GHC.ConDecl name
        rmCD :: ConDecl GhcPs -> ConDecl GhcPs
    rmCD gadt :: ConDecl GhcPs
    gadt@(GHC.ConDeclGADT {}) = ConDecl GhcPs
    gadt {GHC.con_res_ty = rmHsType (GHC.con_res_ty gadt)
    #if MIN_VERSION_ghc(9,2,0)
                                              ,GHC.con_g_args = rmGConDetails (GHC.con_g_args gadt)
    #else
                                              ,GHC.con_args   = rmConDetails (GHC.con_args gadt)
    #endif
                                              }
        rmCD h98 :: ConDecl GhcPs
    h98@(GHC.ConDeclH98 {})   = ConDecl GhcPs
    h98  {GHC.con_args = rmConDetails (GHC.con_args h98)}
    #if !MIN_VERSION_ghc(9,0,0)
        rmCD xcon                      = xcon
    #endif

    #if MIN_VERSION_ghc(9,4,0)
        rmGConDetails :: GHC.HsConDeclGADTDetails GHC.GhcPs -> GHC.HsConDeclGADTDetails GHC.GhcPs
        rmGConDetails :: HsConDeclGADTDetails GhcPs -> HsConDeclGADTDetails GhcPs
    rmGConDetails (GHC.PrefixConGADT [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
    args) = [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
    -> HsConDeclGADTDetails GhcPs
    forall pass.
    [HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
    GHC.PrefixConGADT ((HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
     -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
    -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    rmHsScaledType [HsScaled GhcPs (XRec GhcPs (HsType GhcPs))]
    [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    args)
        rmGConDetails (GHC.RecConGADT XRec GhcPs [XRec GhcPs (ConDeclField GhcPs)]
    rec LHsUniToken "->" "\8594" GhcPs
    tkn) = XRec GhcPs [XRec GhcPs (ConDeclField GhcPs)]
    -> LHsUniToken "->" "\8594" GhcPs -> HsConDeclGADTDetails GhcPs
    forall pass.
    XRec pass [LConDeclField pass]
    -> LHsUniToken "->" "\8594" pass -> HsConDeclGADTDetails pass
    GHC.RecConGADT ((([GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
     -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
    -> GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    -> GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    forall a b.
    (a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
      -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
     -> GenLocated
          SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
     -> GenLocated
          SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
    -> ((ConDeclField GhcPs -> ConDeclField GhcPs)
        -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
        -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
    -> (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    -> GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
     -> GenLocated SrcSpanAnnA (ConDeclField GhcPs))
    -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((GenLocated SrcSpanAnnA (ConDeclField GhcPs)
      -> GenLocated SrcSpanAnnA (ConDeclField GhcPs))
     -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
     -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
    -> ((ConDeclField GhcPs -> ConDeclField GhcPs)
        -> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
        -> GenLocated SrcSpanAnnA (ConDeclField GhcPs))
    -> (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    forall a b.
    (a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ConDeclField GhcPs -> ConDeclField GhcPs
    rmConDeclF XRec GhcPs [XRec GhcPs (ConDeclField GhcPs)]
    GenLocated
      SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
    rec) LHsUniToken "->" "\8594" GhcPs
    tkn
    #elif MIN_VERSION_ghc(9,2,0)
        rmGConDetails :: GHC.HsConDeclGADTDetails GHC.GhcPs -> GHC.HsConDeclGADTDetails GHC.GhcPs
        rmGConDetails (GHC.PrefixConGADT args) = GHC.PrefixConGADT (fmap rmHsScaledType args)
        rmGConDetails (GHC.RecConGADT rec)     = GHC.RecConGADT ((fmap . fmap . fmap) rmConDeclF rec)
    #endif

        -- type HsConDeclDetails name = HsConDetails (LBangType name) (Located [LConDeclField name])
        -- rmConDetails :: _ => GHC.HsConDeclDetails name -> GHC.HsConDeclDetails name
    #if MIN_VERSION_ghc(9,2,0)
        rmConDetails :: HsConDetails
      tyarg
      (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
      (f (f (f (ConDeclField GhcPs))))
    -> HsConDetails
         tyarg
         (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
         (f (f (f (ConDeclField GhcPs))))
    rmConDetails (GHC.PrefixCon [tyarg]
    tys [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    args) = [tyarg]
    -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    -> HsConDetails
         tyarg
         (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
         (f (f (f (ConDeclField GhcPs))))
    forall tyarg arg rec.
    [tyarg] -> [arg] -> HsConDetails tyarg arg rec
    GHC.PrefixCon [tyarg]
    tys ((HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
     -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
    -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    rmHsScaledType [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
    args)
        rmConDetails (GHC.InfixCon HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    l HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    r)   = HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsConDetails
         tyarg
         (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
         (f (f (f (ConDeclField GhcPs))))
    forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
    GHC.InfixCon (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    rmHsScaledType HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    l) (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    rmHsScaledType HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    r)
    #elif MIN_VERSION_ghc(9,0,0)
        rmConDetails (GHC.PrefixCon args) = GHC.PrefixCon (fmap rmHsScaledType args)
        rmConDetails (GHC.InfixCon l r)   = GHC.InfixCon (rmHsScaledType l) (rmHsScaledType r)
    #else
        rmConDetails (GHC.PrefixCon args) = GHC.PrefixCon (fmap rmHsType args)
        rmConDetails (GHC.InfixCon l r)   = GHC.InfixCon (rmHsType l) (rmHsType r)
    #endif
        rmConDetails (GHC.RecCon f (f (f (ConDeclField GhcPs)))
    rec)     = f (f (f (ConDeclField GhcPs)))
    -> HsConDetails
         tyarg
         (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
         (f (f (f (ConDeclField GhcPs))))
    forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
    GHC.RecCon (((f (f (ConDeclField GhcPs)) -> f (f (ConDeclField GhcPs)))
    -> f (f (f (ConDeclField GhcPs))) -> f (f (f (ConDeclField GhcPs)))
    forall a b. (a -> b) -> f a -> f b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((f (f (ConDeclField GhcPs)) -> f (f (ConDeclField GhcPs)))
     -> f (f (f (ConDeclField GhcPs)))
     -> f (f (f (ConDeclField GhcPs))))
    -> ((ConDeclField GhcPs -> ConDeclField GhcPs)
        -> f (f (ConDeclField GhcPs)) -> f (f (ConDeclField GhcPs)))
    -> (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> f (f (f (ConDeclField GhcPs)))
    -> f (f (f (ConDeclField GhcPs)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (f (ConDeclField GhcPs) -> f (ConDeclField GhcPs))
    -> f (f (ConDeclField GhcPs)) -> f (f (ConDeclField GhcPs))
    forall a b. (a -> b) -> f a -> f b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((f (ConDeclField GhcPs) -> f (ConDeclField GhcPs))
     -> f (f (ConDeclField GhcPs)) -> f (f (ConDeclField GhcPs)))
    -> ((ConDeclField GhcPs -> ConDeclField GhcPs)
        -> f (ConDeclField GhcPs) -> f (ConDeclField GhcPs))
    -> (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> f (f (ConDeclField GhcPs))
    -> f (f (ConDeclField GhcPs))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ConDeclField GhcPs -> ConDeclField GhcPs)
    -> f (ConDeclField GhcPs) -> f (ConDeclField GhcPs)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap) ConDeclField GhcPs -> ConDeclField GhcPs
    rmConDeclF f (f (f (ConDeclField GhcPs)))
    rec)

        -- rmHsType :: GHC.DataId name => GHC.Located (GHC.HsType name) -> GHC.Located (GHC.HsType name)
        rmHsType :: GenLocated SrcSpanAnnA (HsType GhcPs)
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    rmHsType = (GenLocated SrcSpanAnnA (HsType GhcPs)
     -> GenLocated SrcSpanAnnA (HsType GhcPs))
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    forall on. Uniplate on => (on -> on) -> on -> on
    transform XRec GhcPs (HsType GhcPs) -> XRec GhcPs (HsType GhcPs)
    GenLocated SrcSpanAnnA (HsType GhcPs)
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    go
          where
    #if MIN_VERSION_ghc(9,2,0)
            go ::
              GHC.LBangType GHC.GhcPs ->
              GHC.LBangType GHC.GhcPs
    #endif
            go :: XRec GhcPs (HsType GhcPs) -> XRec GhcPs (HsType GhcPs)
    go (XRec GhcPs (HsType GhcPs) -> HsType GhcPs
    GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
    forall l e. GenLocated l e -> e
    GHC.unLoc -> GHC.HsBangTy XBangTy GhcPs
    _ HsSrcBang
    _ XRec GhcPs (HsType GhcPs)
    ty) = XRec GhcPs (HsType GhcPs)
    ty
            go XRec GhcPs (HsType GhcPs)
    ty                               = XRec GhcPs (HsType GhcPs)
    ty

    #if MIN_VERSION_ghc(9,0,0)
        rmHsScaledType :: HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    rmHsScaledType = (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
     -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    forall on. Uniplate on => (on -> on) -> on -> on
    transform HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    -> HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    go
          where
    #if MIN_VERSION_ghc(9,2,0)
            go ::
              GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs) ->
              GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
    #endif
            go :: HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    -> HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    go (GHC.HsScaled HsArrow GhcPs
    m (XRec GhcPs (HsType GhcPs) -> HsType GhcPs
    GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
    forall l e. GenLocated l e -> e
    GHC.unLoc -> GHC.HsBangTy XBangTy GhcPs
    _ HsSrcBang
    _ XRec GhcPs (HsType GhcPs)
    ty)) = HsArrow GhcPs
    -> GenLocated SrcSpanAnnA (HsType GhcPs)
    -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    forall pass a. HsArrow pass -> a -> HsScaled pass a
    GHC.HsScaled HsArrow GhcPs
    m XRec GhcPs (HsType GhcPs)
    GenLocated SrcSpanAnnA (HsType GhcPs)
    ty
            go HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    ty = HsScaled GhcPs (XRec GhcPs (HsType GhcPs))
    ty
    #endif

        -- rmConDeclF :: GHC.DataId name => GHC.ConDeclField name -> GHC.ConDeclField name
        rmConDeclF :: ConDeclField GhcPs -> ConDeclField GhcPs
    rmConDeclF ConDeclField GhcPs
    cdf = ConDeclField GhcPs
    cdf {GHC.cd_fld_type = rmHsType (GHC.cd_fld_type cdf)}

    -- | The package id of the clash-prelude we were built with
    preludePkgId :: String
    preludePkgId :: FilePath
    preludePkgId = $(lift $ pkgIdFromTypeable (undefined :: TopEntity))

    -- | Check that we're using the same clash-prelude as we were built with
    --
    -- Because if they differ clash won't be able to recognize any ANNotations.
    checkForInvalidPrelude :: Monad m => HscTypes.ModGuts -> m ()
    checkForInvalidPrelude :: forall (m :: Type -> Type). Monad m => ModGuts -> m ()
    checkForInvalidPrelude ModGuts
    guts =
      case (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter FilePath -> Bool
    isWrongPrelude [FilePath]
    pkgIds of
        []    -> () -> m ()
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
        (FilePath
    x:[FilePath]
    _) -> ClashException -> m ()
    forall a e. Exception e => e -> a
    throw (SrcSpan -> FilePath -> Maybe FilePath -> ClashException
    ClashException SrcSpan
    noSrcSpan (FilePath -> FilePath
    msgWrongPrelude FilePath
    x) Maybe FilePath
    forall a. Maybe a
    Nothing)
      where
    #if MIN_VERSION_ghc(9,4,0)
        pkgs :: Set UnitId
    pkgs = Dependencies -> Set UnitId
    HscTypes.dep_direct_pkgs (Dependencies -> Set UnitId)
    -> (ModGuts -> Dependencies) -> ModGuts -> Set UnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModGuts -> Dependencies
    HscTypes.mg_deps (ModGuts -> Set UnitId) -> ModGuts -> Set UnitId
    forall a b. (a -> b) -> a -> b
    $ ModGuts
    guts
    #else
        pkgs = HscTypes.dep_pkgs . HscTypes.mg_deps $ guts
    #endif
    #if MIN_VERSION_ghc(9,4,0)
        pkgIds :: [FilePath]
    pkgIds = (UnitId -> FilePath) -> [UnitId] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitId -> FilePath
    UnitTypes.unitIdString) (Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList Set UnitId
    pkgs)
    #elif MIN_VERSION_ghc(9,0,0)
        pkgIds = map (UnitTypes.unitIdString . fst) pkgs
    #else
        pkgIds = map (GhcPlugins.installedUnitIdString . fst) pkgs
    #endif
        prelude :: FilePath
    prelude = FilePath
    "clash-prelude-"
        isPrelude :: FilePath -> Bool
    isPrelude FilePath
    pkg = case Int -> FilePath -> (FilePath, FilePath)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (FilePath -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length FilePath
    prelude) FilePath
    pkg of
          (FilePath
    x,Char
    y:FilePath
    _) | FilePath
    x FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    prelude Bool -> Bool -> Bool
    && Char -> Bool
    isDigit Char
    y -> Bool
    True     -- check for a digit so we don't match clash-prelude-extras
          (FilePath, FilePath)
    _ -> Bool
    False
        isWrongPrelude :: FilePath -> Bool
    isWrongPrelude FilePath
    pkg = FilePath -> Bool
    isPrelude FilePath
    pkg Bool -> Bool -> Bool
    && FilePath
    pkg FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FilePath
    preludePkgId
        msgWrongPrelude :: FilePath -> FilePath
    msgWrongPrelude FilePath
    pkg = [FilePath] -> FilePath
    unlines [FilePath
    "Clash only works with the exact clash-prelude it was built with."
                                      ,FilePath
    "Clash was built with: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    preludePkgId
                                      ,FilePath
    "So can't run with:    " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    pkg
                                      ]