, InterpreterLibraryContents(..)

   , writeBytecodeLib

   , readBytecodeLib

   , decodeOnDiskModuleByteCode

   , decodeOnDiskBytecodeLib

   )

 import GHC.Linker.Types

 import System.IO.Unsafe (unsafeInterleaveIO)

 import GHC.Utils.Outputable

 {- Note [Overview of persistent bytecode]

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

 -- 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

                                                  }

     put_ bh bytecodeLibForeign

 writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()

 writeBytecodeLib lib path = do

   odbco <- encodeBytecodeLib lib

 instance Binary OnDiskModuleByteCode where

   get bh = do

     odgbc_module <- get bh

     odgbc_compiled_byte_code <- get bh

     odgbc_foreign <- get bh

     pure OnDiskModuleByteCode {..}

   put_ bh OnDiskModuleByteCode {..} = do

     put_ bh odgbc_module

     put_ bh odgbc_compiled_byte_code

     put_ bh odgbc_foreign

   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.

   putWithUserData QuietBinIFace NormalCompression bh odbco

   writeBinMem bh f

 instance Binary CompiledByteCode where

   get bh = do

     bc_bcos <- get bh

   , 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))

            | otherwise -> do

                -- Check the status of all the linkable types we might need.

                -- 1. The in-memory linkable we had at hand.

                -- 2. The bytecode object file

                bc_obj_linkable <- checkByteCodeFromObject hsc_env mod_summary

                -- 3. Bytecode from an interface's whole core bindings.

   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.

 --

 -}

 -- | 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

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

 -- modules and direct object files for pkg dependencies

           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

     fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg

     librarySpecToUsage :: LibrarySpec -> IO [Usage]

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

     librarySpecToUsage (Archive fn) = traverse (fing Nothing) [fn]

 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

     SigsMergeChanged         -> text "Signatures to merge in changed"

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

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

     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

   case maybe_bytecode_time of

     Nothing -> return Nothing

     Just bytecode_time -> do

       -- Also load the interface, for reasons to do with recompilation avoidance.

       -- See Note [Recompilation avoidance with bytecode objects]

       _ <- initIfaceLoad hsc_env $

   ********************************************************************* -}

 -- | Load the dependencies of a linkable, and then load the linkable itself.

 loadDecls interp hsc_env span linkable = do

     -- Initialise the linker (if it's not been done already)

     initLoaderState interp hsc_env

     (objs, bcos) = partitionLinkables linkables

 linkableInSet l objs_loaded =

   case lookupModuleEnv objs_loaded (linkableModule l) of

         Nothing -> False

                         then addWay WayProf

                         else id

                -> [Linkable]    -- New linkables

                    [Linkable])  -- New linkables (excluding dups)

 rmDupLinkables already ls

   = go already [] ls

     go already extras [] = (already, extras)

     go already extras (l:ls)

         | linkableInSet l already = go already     extras     ls

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

 dynLinkBCOs :: Interp -> LoaderState -> KeepModuleLinkableDefinitions -> [Linkable] -> IO LoaderState

 dynLinkBCOs interp pls keep_spec bcos =

             pls1                     = pls { bcos_loaded = bcos_loaded' }

             cbcs :: [CompiledByteCode]

   -- we're unloading some code.  -fghci-leak-check with the tests in

   -- testsuite/ghci can detect space leaks here.

   mapM_ unloadObjs linkables_to_unload

   -- If we unloaded any object files at all, we need to purge the cache

   -- of lookupSymbol results.

     purgeLookupSymbolCache interp

   let !new_pls = pls { bco_loader_state = modifyHomePackageBytecodeState bco_loader_state $ \_ -> emptyBytecodeState,

   return new_pls

   where

     unloadObjs lnk

       | interpreterDynamic interp = return ()

         -- We don't do any cleanup when linking objects with the

         -- not much benefit.

       | otherwise

                 -- The components of a BCO linkable may contain

                 -- dot-o files (generated from C stubs).

                 --

    , WholeCoreBindingsLinkable

    , LinkableWith(..)

    , mkModuleByteCodeLinkable

    , LinkablePart(..)

    , LinkableObjectSort (..)

    , linkableIsNativeCodeOnly

    , linkableFilterNative

    , partitionLinkables

    , ModuleByteCode(..)

    )

 where

 import GHC.Prelude

 import GHC.ByteCode.Types

 import GHCi.BreakArray

 import GHCi.RemoteTypes

 import qualified Data.List.NonEmpty as NE

 import Control.Applicative ((<|>))

 import Data.Functor.Identity

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

         -- ^ Information about bytecode objects we have loaded into the

         -- interpreter.

         -- ^ The currently loaded interpreted modules (home package)

         -- ^ And the currently-loaded compiled modules (home package)

     , pkgs_loaded :: !PkgsLoaded

 type WholeCoreBindingsLinkable = LinkableWith WholeCoreBindings

 mkLinkableSet ls = mkModuleEnv [(linkableModule l, l) | l <- ls]

 -- | Union of LinkableSets.

 --

 -- In case of conflict, keep the most recent Linkable (as per linkableTime)

 unionLinkableSet = plusModuleEnv_C go

   where

     go l1 l2

   | DotDLL FilePath

       -- ^ Dynamically linked library file (.so, .dll, .dylib)

 -- | The in-memory representation of a bytecode object

 data ModuleByteCode = ModuleByteCode { gbc_module :: Module

                                       , gbc_compiled_byte_code :: CompiledByteCode

                                       , gbc_foreign_files :: [FilePath]  -- ^ Path to object files

                                       }

 mkModuleByteCodeLinkable :: UTCTime -> ModuleByteCode -> Linkable

   Linkable linkable_time (gbc_module bco) (pure (DotGBC bco))

 instance Outputable ModuleByteCode where

 instance Outputable LinkablePart where

   ppr (DotO path sort)   = text "DotO" <+> text path <+> pprSort sort

 -- Contrary to linkableBCOs, this includes byte-code from LazyBCOs.

 linkablePartBCOs :: LinkablePart -> [CompiledByteCode]

 linkablePartBCOs = \case

 linkableFilter :: (LinkablePart -> [LinkablePart]) -> Linkable -> Maybe Linkable

 linkableFilter f linkable = do