import GHC.ByteCode.Types

 import GHC.Data.FastString

 import GHC.Types.Name

 import GHC.Types.Name.Cache

 import GHC.Types.Name.Env

 import GHC.Utils.Exception

 import GHC.Utils.Panic

 import GHC.Utils.Outputable

 import Control.Monad

 import Data.Binary qualified as Binary

 -- contained by 'ModuleByteCode' are stored in-memory rather than as file paths to

 -- temporary files.

 data OnDiskModuleByteCode = OnDiskModuleByteCode { odgbc_module :: Module

                                                  , odgbc_compiled_byte_code :: CompiledByteCode

                                                  , odgbc_foreign :: [ByteString]  -- ^ Contents of object files

                                                  }

     putByte bh 1

     put_ bh contents

 instance Binary OnDiskBytecodeLib where

   get bh = do

     bytecodeLibUnitId <- get bh

     put_ bh bytecodeLibFiles

     put_ bh bytecodeLibForeign

 instance Binary CompiledByteCode where

   get bh = do

     bc_bcos <- get bh

           Just idx -> (b, idx)

           Nothing  -> (ByteCodeNameEnv (next + 1) (extendNameEnv subst name next), next))

   env_ref <- newIORef emptyOccEnv

   pure $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do

     t <- getByte bh

         -- We don't want to get a new unique from the NameCache each time we

         -- see a name.

         nm' <- unsafeInterleaveIO $ do

           evaluate $ mkInternalName u occ noSrcSpan

         fmap BinName $ atomicModifyIORef' env_ref $ \env ->

           case lookupOccEnv env occ of

 {-# LANGUAGE RecordWildCards #-}

 -- Orphans are here since the Binary instances use an ad-hoc means of serialising

 -- names which we don't want to pollute the rest of the codebase with.

 {- | This module implements the serialization of bytecode objects to and from disk.

 -}

 module GHC.ByteCode.Serialize

   , BytecodeLibX(..)

   , BytecodeLib

   , OnDiskBytecodeLib

   , InterpreterLibraryContents(..)

   , writeBytecodeLib

   , readBytecodeLib

   , decodeOnDiskModuleByteCode

   , decodeOnDiskBytecodeLib

   )

 where

 import GHC.Driver.Env

 import GHC.Iface.Binary

 import GHC.Utils.Binary

 import GHC.Utils.TmpFs

 import Data.ByteString (ByteString)

 import qualified Data.ByteString as BS

 import Data.Traversable

 {- Note [Overview of persistent bytecode]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib

 readBytecodeLib hsc_env path = do

   bh' <- readBinMem path

   res <- getWithUserData (hsc_NC hsc_env) bh

   pure res

   pure $ ModuleByteCode {

     gbc_module = odgbc_module odbco,

     gbc_compiled_byte_code = odgbc_compiled_byte_code odbco,

    }

 decodeOnDiskBytecodeLib :: HscEnv -> OnDiskBytecodeLib -> IO BytecodeLib

   pure $ OnDiskModuleByteCode {

     odgbc_module = gbc_module bco,

     odgbc_compiled_byte_code = gbc_compiled_byte_code bco,

    }

 -- | Read a 'ModuleByteCode' from a file.

 readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode

 readOnDiskModuleByteCode hsc_env f = do

   bh' <- readBinMem f

   getWithUserData (hsc_NC hsc_env) bh

 -- | Write a 'ModuleByteCode' to a file.

   odbco <- encodeOnDiskModuleByteCode cbc

   putWithUserData QuietBinIFace NormalCompression bh odbco

   writeBinMem bh f

   , tcForeignExportsHook   :: !(Maybe ([LForeignDecl GhcRn]

             -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)))

   , hscFrontendHook        :: !(Maybe (ModSummary -> Hsc FrontendResult))

   , ghcPrimIfaceHook       :: !(Maybe ModIface)

   , runPhaseHook           :: !(Maybe PhaseHook)

   , runMetaHook            :: !(Maybe (MetaHook TcM))

                                          -> HomePackageTable -> IO SuccessFlag))

   , runRnSpliceHook        :: !(Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn)))

   , getValueSafelyHook     :: !(Maybe (HscEnv -> Name -> Type

   , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))

   , stgToCmmHook           :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs

                                  -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos))

 import Data.Bifunctor

 import qualified GHC.Unit.Home.Graph as HUG

 import GHC.Unit.Home.PackageTable

 {- **********************************************************************

 %*                                                                      *

 -- | Check to see if we can reuse the old linkable, by this point we will

 -- have just checked that the old interface matches up with the source hash, so

 -- no need to check that again here

 checkByteCodeInMemory hsc_env mod_sum mb_old_linkable =

   case mb_old_linkable of

     Just old_linkable

       -- If `-fwrite-byte-code` is enabled, then check that the .gbc file is

       -- up-to-date with the linkable we have in our hand.

       -- If ms_bytecode_date is Nothing, then the .gbc file does not exist yet.

       -- Otherwise, check that the date matches the linkable date exactly.

           then maybe False (linkableTime old_linkable ==) (ms_bytecode_date mod_sum)

           else True

       -> return $ (UpToDateItem old_linkable)

     _ -> return $ outOfDateItemBecause MissingBytecode Nothing

 -- | Load bytecode from a ".gbc" object file if it exists and is up-to-date

 checkByteCodeFromObject hsc_env mod_sum = do

   let

     obj_fn = ml_bytecode_file (ms_location mod_sum)

           -- Don't force this if we reuse the linkable already loaded into memory, but we have to check

           -- that the one we have on disk would be suitable as well.

           linkable <- unsafeInterleaveIO $ do

           return $ UpToDateItem linkable

     _ -> return $ outOfDateItemBecause MissingBytecode Nothing

   ModIface ->

   ModLocation ->

   TypeEnv ->

 loadIfaceByteCodeLazy hsc_env iface location type_env =

   case iface_core_bindings iface location of

     Nothing -> return Nothing

       Just <$> compile wcb

   where

     compile decls = do

     linkable parts = do

       if_time <- modificationTimeIfExists (ml_hi_file_ospath location)

   where

     type_env = md_types details

     go (NormalLinkable l) = pure l

     go (WholeCoreBindingsLinkable wcbl) =

       fmap Just $ for wcbl $ \wcb -> do

         add_iface_to_hpt iface details hsc_env

 -- | Hydrate interface Core bindings and compile them to bytecode.

 --

   -- See Note [-fwrite-byte-code is not the default]

   when (gopt Opt_WriteByteCode dflags) $ do

     let bc_path = ml_bytecode_file mod_location

   return comp_bc

 {-

 -}

 -- | Generate a 'ModuleByteCode' and write it to disk if `-fwrite-byte-code` is enabled.

 generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do

   bco_object <- generateAndWriteByteCode hsc_env cgguts mod_location

   -- Either, get the same time as the .gbc file if it exists, or just the current time.

   -- It's important the time of the linkable matches the time of the .gbc file for recompilation

   -- checking.

   bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file_ospath mod_location)

 mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode

 mkModuleByteCode hsc_env mod mod_location cgguts = do

   bcos <- hscGenerateByteCode hsc_env cgguts mod_location

   objs <- outputAndCompileForeign hsc_env mod mod_location (cgi_foreign_files cgguts) (cgi_foreign cgguts)

 -- | Generate a fresh 'ModuleByteCode' for a given module but do not write it to disk.

 generateFreshByteCodeLinkable :: HscEnv

 %*                                                                      *

 %********************************************************************* -}

 hscCompileCoreExpr hsc_env loc expr =

   case hscCompileCoreExprHook (hsc_hooks hsc_env) of

       Nothing -> hscCompileCoreExpr' hsc_env loc expr

       Just h  -> h                   hsc_env loc expr

 hscCompileCoreExpr' hsc_env srcspan ds_expr = do

   {- Simplify it -}

   -- Question: should we call SimpleOpt.simpleOptExpr here instead?

       {- load it -}

       bco_time <- getCurrentTime

       (mods_needed, units_needed) <- loadDecls interp hsc_env srcspan $

       -- Get the foreign reference to the name we should have just loaded.

       mhvs <- lookupFromLoadedEnv interp (idName binding_id)

       {- Get the HValue for the root -}

   -> Module

   -> [(CgStgTopBinding,IdSet)]

   -> Id

 jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do

   let logger           = hsc_logger hsc_env

       tmpfs            = hsc_tmpfs hsc_env

                 let obj_files = concatMap linkableObjs linkables

                 in action obj_files

             linkBytecodeLinkable action =

                 let bytecode = concatMap linkableModuleByteCodes linkables

                 in action bytecode

       -- The purpose of this field is to cache the plugins so they

       -- don't have to be loaded each time they are needed.  See

       -- 'GHC.Runtime.Loader.initializePlugins'.

   -- ^ The object files required by the loaded plugins

   -- See Note [Plugin dependencies]

   }

 import GHC.Prelude

 import GHC.Tc.Types

 import GHC.Iface.Load

 import GHC.Unit

 import GHC.Unit.Env

 import GHC.Unit.Module.Imported

 import GHC.Unit.Module.ModIface

 import GHC.Unit.Module.Deps

 import GHC.Data.Maybe

 import GHC.Data.FastString

 import Data.List (sortBy)

 import Data.Map (Map)

 import qualified Data.Map as Map

 import qualified Data.Set as Set

 import GHC.Linker.Types

 import GHC.Unit.Finder

 import GHC.Types.Unique.DFM

 import GHC.Driver.Plugins

 import qualified GHC.Unit.Home.Graph as HUG

 {- Note [Module self-dependency]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv

             -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet

             -> IfG [Usage]

 mkUsageInfo uc plugins fc unit_env

   this_mod dir_imp_mods imp_decls used_names

   dependent_files dependent_dirs merged needed_links needed_pkgs

   = do

     file_hashes <- liftIO $ mapM getFileHash dependent_files

     dirs_hashes <- liftIO $ mapM getDirHash dependent_dirs

     let hu = ue_unsafeHomeUnit unit_env

     -- Dependencies on object files due to TH and plugins

     let all_home_ids = HUG.allUnits (ue_home_unit_graph unit_env)

     mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod

                                        dir_imp_mods imp_decls used_names

 1. The existence of the .gbc file for the module you are currently compiling.

 2. The usage of bytecode to evaluate TH splices (similar to Note [Object File Dependencies])

 -}

 -- | Find object files corresponding to the transitive closure of given home

 -- modules and direct object files for pkg dependencies

       let ls = ordNubOn linkableModule (th_links_needed ++ plugins_links_needed)

           ds = concatMap loaded_pkg_hs_objs $ eltsUDFM (plusUDFM th_pkgs_needed plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well

           (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps plugins

       concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds)

   where

     msg m = moduleNameString (moduleName m) ++ "[TH] changed"

     librarySpecToUsage :: LibrarySpec -> IO [Usage]

     librarySpecToUsage (Objects os) = traverse (fing Nothing) os

 import Data.Functor

 import Data.Bifunctor (first)

 import GHC.Types.PkgQual

 {-

   -----------------------------------------------

   | ModuleAdded (ImportLevel, UnitId, ModuleName)

   | ModuleChangedRaw ModuleName

   | ModuleChangedIface ModuleName

   | FileChanged FilePath

   | DirChanged FilePath

   | CustomReason String

     ModuleChanged m          -> ppr m <+> text "changed"

     ModuleChangedRaw m       -> ppr m <+> text "changed (raw)"

     ModuleChangedIface m     -> ppr m <+> text "changed (interface)"

     ModuleRemoved (_st, _uid, m)   -> ppr m <+> text "removed"

     ModuleAdded (_st, _uid, m)     -> ppr m <+> text "added"

     FileChanged fp           -> text fp <+> text "changed"

         Nothing -> return $ NeedsRecompile MustCompile

         Just iface -> liftIO $ continue iface

 tryGetModIface :: String -> Module -> IfG (Maybe ModIface)

 tryGetModIface doc_msg mod

   = do  -- Load the imported interface if possible

                   -- import and it's been deleted

       Succeeded iface -> pure $ Just iface

 -- | Given the usage information extracted from the old

 -- M.hi file for the module being compiled, figure out

 -- whether M needs to be recompiled.

   needInterface mod $ \iface -> do

     let reason = ModuleChangedRaw (moduleName mod)

     checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface)

                                                  , usg_unit_id = uid

   let mod = mkModule (RealUnit (Definite uid)) mod_name

   logger <- getLogger

 checkModUsage _ UsageHomeModule{

                                 usg_mod_name = mod_name,

   = out_of_date_hash logger reason (text "  Module fingerprint has changed")

                      old_mod_hash new_mod_hash

   :: Logger

   -> RecompReason

   -> Fingerprint

   -> Fingerprint

   -> IO RecompileRequired

   | otherwise

 ------------------------

 checkEntityUsage :: Logger

           ppr (usg_dir_hash usage)]

 pprUsage usage@UsageMergedRequirement{}

   = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]

                                , ppr (usg_unit_id usage)

 pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc

 pprUsageImport mod hash safe

          , ppr hash ]

     where

         pp_safe | safe      = text "safe"

   on_disk_bcos <- mapM (readBinByteCode hsc_env) bytecodeObjects

   interpreter_foreign_lib <- mkInterpreterLib hsc_env (concat foreign_stubs ++ objectFiles)

           return $ Just (InterpreterSharedObject foreign_stub_lib_path foreign_stub_lib_dir foreign_stub_lib_name)

         Nothing -> pure Nothing

     False -> do

 data LinkDeps = LinkDeps

   { ldNeededLinkables :: [Linkable]

   , ldUnits           :: [UnitId]

   , ldNeededUnits     :: UniqDSet UnitId

   }

       return $ LinkDeps

         { ldNeededLinkables = lnks_needed

         , ldUnits           = pkgs_needed

         , ldNeededUnits     = pkgs_s

         }

 -- | Load the module containing the given Name and get its associated 'HValue'.

 --

 -- Throws a 'ProgramError' if loading fails or the name cannot be found.

 loadName interp hsc_env name = do

   initLoaderState interp hsc_env

   modifyLoaderState interp $ \pls0 -> do

   -> LoaderState

   -> SrcSpan

   -> [Module]

 -- When called, the loader state must have been initialized (see `initLoaderState`)

 loadDependencies interp hsc_env pls span needed_mods = do

    let opts = initLinkDepsOpts hsc_env

     dflags = hsc_dflags hsc_env

     ldLoadByteCode mod locn = do

       case bytecode_linkable of

         Nothing -> findWholeCoreBindings hsc_env mod

         Just bco -> return (Just bco)

       sequence (lookupModuleEnv eps_iface_bytecode mod)

   let bytecode_fn    = ml_bytecode_file locn