module GHC.Driver.Env.Types

   ( Hsc(..)

   , HscEnv(..)

   ) where

 import GHC.Driver.Errors.Types ( GhcMessage )

 import Control.Monad.Trans.State

 import Data.IORef

 import GHC.Driver.Env.KnotVars

 -- | The Hsc monad: Passing an environment and diagnostic state

 newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))

 instance HasLogger Hsc where

     getLogger = Hsc $ \e w -> return (hsc_logger e, w)

 -- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable.

 -- An HscEnv is used to compile a single module from plain Haskell source

                 -- ^ target code interpreter (if any) to use for TH and GHCi.

                 -- See Note [Target code interpreter]

         , hsc_plugins :: !Plugins

                 -- ^ Plugins

                   , hsc_FC             = fc_var

                   , hsc_type_env_vars  = emptyKnotVars

                   , hsc_interp         = Nothing

                   , hsc_unit_env       = unit_env

                   , hsc_plugins        = emptyPlugins

                   , hsc_hooks          = emptyHooks

   -- Take lock for the actual work.

   (dep_linkables, dep_units) <- modifyLoaderState interp $ \pls -> do

     -- Find what packages and linkables are required

     -- We update the LinkerState even if the JS interpreter maintains its linker

     -- state independently to load new objects here.

   ( LinkDepsOpts (..)

   , LinkDeps (..)

   , getLinkDeps

   )

 where

 import GHC.Unit.Home.ModInfo

 import GHC.Iface.Errors.Types

 import GHC.Utils.Misc

 import GHC.Unit.Home

 import GHC.Data.Maybe

 import Control.Applicative

 import Control.Monad.IO.Class (MonadIO (liftIO))

 import Data.Foldable (traverse_)

 import qualified Data.Set as Set

 import System.FilePath

 import System.Directory

 import GHC.Utils.Logger (Logger)

 import GHC.Unit.Home.Graph

 data LinkDepsOpts = LinkDepsOpts

   , ldLogger :: !Logger

   }

 -- | Find all the packages and linkables that a set of modules depends on

 --

   -> [Module]     -- If you need these

   -> IO LinkDeps  -- ... then link these first

 getLinkDeps opts interp pls span mods = do

 -- | Determine which parts of a module and its dependencies should be linked

 -- when resolving external dependencies.

   }

 instance Outputable LinkExternal where

 -- | The decision about the linking method used for a given module.

 data LinkModule =

     LinkObjectModule mod _ -> ppr mod

     LinkByteCodeModule mod _ -> ppr mod <+> brackets (text "BC")

   where

     mod_graph = ldModuleGraph opts

     unit_env  = ldUnitEnv     opts

     noninteractive = filterOut isInteractiveModule mods

     --

     make_deps = do

       (dep_ext, mmods) <- unzip <$> mapM get_mod_info all_home_mods

         Nothing -> throwProgramError opts $

           text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid

     no_obj :: Outputable a => a -> IO b

     no_obj mod = dieWith opts span $

                      text "cannot find object file for module" <+>

   -- results.

     module_linkable = \case

       LinkHomeModule hmi ->

       LinkObjectModule mod loc -> do

         findObjectLinkableMaybe mod loc >>= \case

       CoreBindings WholeCoreBindings {wcb_module} ->

         pprPanic "Unhydrated core bindings" (ppr wcb_module)

 data LinkDep =

   LinkModules !(UniqDFM ModuleName LinkModule)

   |

     LinkModules mods -> text "modules:" <+> ppr (eltsUDFM mods)

     LinkLibrary uid -> text "library:" <+> ppr uid

 -- | Compute the transitive dependency closure of the given modules.

 --

 -- Used for all oneshot mode dependencies and for external dependencies of home

   [LinkExternal] ->

   IO [LinkDep]

 external_deps opts mods =

 external_deps_loop ::

   LinkDepsOpts ->

   [LinkExternal] ->

   UniqDFM UnitId LinkDep ->

 external_deps_loop _ [] acc =

   pure acc

 external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do

     -- link an object file (which happens for home unit modules, since those

     -- have no libraries).

     process_module = \case

     -- @LinkOnlyPackages@ is used for make mode home modules, so all imports

     -- that are not external are already processed otherwise.

       | otherwise

       = False

     add_library =

       pure (addToUDFM acc mod_unit_id (LinkLibrary mod_unit_id), [], Just "library")

     with_deps acc iface local action =

       pure (addListToUDFM acc link, new_local ++ new_package, Just action)

       where

         | (_, GWIB m _) <- Set.toList (dep_direct_mods (mi_deps iface))

       ]

     is_home

       | Just home <- ue_homeUnit (ldUnitEnv opts)

       = homeUnitAsUnit home == mod_unit

     mod_unit_id = moduleUnitId mod

     mod_unit = moduleUnit mod

 -- | Split link dependencies into the sets of modules and packages that have

 -- been linked previously and those that need to be linked now by checking for

 -- their presence in the 'LoaderState':

    , rmDupLinkables

    , modifyLoaderState

    , initLinkDepsOpts

    )

 where

 import qualified Data.Set as Set

 import Data.Char (isSpace)

 import Data.Functor ((<&>))

 import Data.IORef

 import Data.List (intercalate, isPrefixOf, nub, partition)

 import Data.Maybe

 #endif

 import GHC.Utils.Exception

 -- Note [Linkers and loaders]

 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~

   -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required

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

 loadDependencies interp hsc_env pls span needed_mods = do

    -- Find what packages and linkables are required

    let this_pkgs_needed = ldAllUnits deps

       EPS {eps_iface_bytecode} <- hscEPS hsc_env

       pure (lookupModuleEnv eps_iface_bytecode mod)

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

         lazyPut bh warns

         lazyPut bh anns

         put_ bh decls

         put_ bh foreign_

         put_ bh insts

         put_ bh fam_insts

         warns       <- {-# SCC "bin_warns" #-} lazyGet bh

         anns        <- {-# SCC "bin_anns" #-} lazyGet bh

         decls       <- {-# SCC "bin_tycldecls" #-} get bh

         foreign_    <- get bh

         insts       <- {-# SCC "bin_insts" #-} get bh

         fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh