[Git][ghc/ghc][wip/torsten.schmits/package-deps-bytecode-squashed] 2 commits: Link interface bytecode from package DBs if possible
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Tue Oct 29 18:51:19 UTC 2024
Torsten Schmits pushed to branch wip/torsten.schmits/package-deps-bytecode-squashed at Glasgow Haskell Compiler / GHC
Commits:
be1b06b5 by Torsten Schmits at 2024-10-29T19:49:47+01:00
Link interface bytecode from package DBs if possible
Part of #25090.
MR !13068
When splices are executed with `-fprefer-byte-code`, the loader will
compile Core bindings to bytecode if those are present in interfaces of
module dependencies.
So far, this only applied to local modules (i.e. home modules in make
mode and non-package deps in oneshot mode).
This patch extends support to interfaces loaded from a package DB.
In `getLinkDeps`, the dependencies chosen for recursion were restricted
to `dep_direct_mods`, which has been changed to include external
dependencies, stored in a new field named `dep_direct_pkg_mods`.
In order to unify treatment of the different link variants across
make/oneshot mode, the algorithm's intermediate results have been
abstracted into the data types `LinkDep` and `LinkModule`.
Metric Decrease:
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
- - - - -
f3c844d2 by Torsten Schmits at 2024-10-29T19:49:47+01:00
add new field to iface for package deps
Metric Decrease:
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
- - - - -
23 changed files:
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- docs/users_guide/phases.rst
- + testsuite/tests/bytecode/T25090/Dep.hs
- + testsuite/tests/bytecode/T25090/DepApi.hs
- + testsuite/tests/bytecode/T25090/Local.hs
- testsuite/tests/bytecode/T25090/Makefile
- + testsuite/tests/bytecode/T25090/Num.hs
- + testsuite/tests/bytecode/T25090/Num.hs-boot
- + testsuite/tests/bytecode/T25090/PkgBytecode.hs
- + testsuite/tests/bytecode/T25090/PkgBytecode.stdout
- testsuite/tests/bytecode/T25090/all.T
- + testsuite/tests/bytecode/T25090/dep.conf
- + testsuite/tests/bytecode/T25090/prep.bash
- + testsuite/tests/bytecode/T25090/run.bash
- + testsuite/tests/bytecode/T25090/unit1
- + testsuite/tests/bytecode/T25090/unit2
Changes:
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -843,6 +843,7 @@ data GeneralFlag
| Opt_BuildDynamicToo
| Opt_WriteIfSimplifiedCore
| Opt_UseBytecodeRatherThanObjects
+ | Opt_PackageDbBytecode
-- safe haskell flags
| Opt_DistrustAllPackages
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2543,6 +2543,7 @@ fFlagsDeps = [
flagSpec "link-rts" Opt_LinkRts,
flagSpec "byte-code-and-object-code" Opt_ByteCodeAndObjectCode,
flagSpec "prefer-byte-code" Opt_UseBytecodeRatherThanObjects,
+ flagSpec "package-db-byte-code" Opt_PackageDbBytecode,
flagSpec' "compact-unwind" Opt_CompactUnwind
(\turn_on -> updM (\dflags -> do
unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on)
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -117,6 +117,7 @@ import System.Directory
import GHC.Driver.Env.KnotVars
import {-# source #-} GHC.Driver.Main (loadIfaceByteCode)
import GHC.Iface.Errors.Types
+import GHC.Runtime.Context (emptyInteractiveContext)
import Data.Function ((&))
{-
@@ -533,12 +534,22 @@ loadInterface doc_str mod from
--
-- See Note [Interface Files with Core Definitions]
add_bytecode old
- | Just action <- loadIfaceByteCode purged_hsc_env iface loc (mkNameEnv new_eps_decls)
+ | Just action <- loadIfaceByteCode hydration_env iface loc (mkNameEnv new_eps_decls)
= extendModuleEnv old mod action
-- Don't add an entry if the iface doesn't have 'extra_decls'
-- so 'get_link_deps' knows that it should load object code.
| otherwise
= old
+ where
+ -- @dontLeakTheHUG@ purges @InteractiveContext@, but when
+ -- bytecode is compiled in @hscInteractive@ with CoreLint
+ -- enabled, the context is used to find variables defined in
+ -- GHCi to prevent false positives.
+ -- Since code loaded from interface Core bindings cannot
+ -- depend on variables in the interactive session, we provide
+ -- an empty context here.
+ hydration_env =
+ purged_hsc_env {hsc_IC = emptyInteractiveContext (hsc_dflags purged_hsc_env)}
; warnPprTrace bad_boot "loadInterface" (ppr mod) $
updateEps_ $ \ eps ->
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
module GHC.Linker.Deps
( LinkDepsOpts (..)
@@ -22,12 +23,12 @@ import GHC.Runtime.Interpreter
import GHC.Linker.Types
-import GHC.Types.SourceFile
import GHC.Types.SrcLoc
import GHC.Types.Unique.DSet
import GHC.Types.Unique.DFM
import GHC.Utils.Outputable
+import qualified GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Error
@@ -47,15 +48,19 @@ import GHC.Utils.Misc
import GHC.Unit.Home
import GHC.Data.Maybe
-import Control.Monad
import Control.Applicative
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Data.Foldable (traverse_)
import qualified Data.Set as Set
import qualified Data.Map as M
import Data.List (isSuffixOf)
import System.FilePath
import System.Directory
+import GHC.Utils.Logger (Logger)
+import Control.Monad ((<$!>))
data LinkDepsOpts = LinkDepsOpts
{ ldObjSuffix :: !String -- ^ Suffix of .o files
@@ -64,19 +69,23 @@ data LinkDepsOpts = LinkDepsOpts
, ldUnitEnv :: !UnitEnv
, ldPprOpts :: !SDocContext -- ^ Rendering options for error messages
, ldUseByteCode :: !Bool -- ^ Use bytecode rather than objects
+ , ldPkgByteCode :: !Bool -- ^ Use bytecode for external packages
, ldMsgOpts :: !(DiagnosticOpts IfaceMessage) -- ^ Options for diagnostics
, ldWays :: !Ways -- ^ Enabled ways
- , ldFinderCache :: !FinderCache
- , ldFinderOpts :: !FinderOpts
- , ldLoadIface :: !(SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface))
- , ldLoadByteCode :: !(Module -> IO (Maybe Linkable))
+ , ldLoadIface :: !(SDoc -> Module -> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation)))
+ -- ^ When linking oneshot or package dependencies, we need interfaces and
+ -- locations to find object files and traverse dependencies.
+ , ldLoadByteCode :: !(Module -> IO (Maybe (IO Linkable)))
+ -- ^ Consult the EPS about the given module, return an action that compiles
+ -- Core bindings to bytecode if it's available.
+ , ldLogger :: !Logger
}
data LinkDeps = LinkDeps
{ ldNeededLinkables :: [Linkable]
, ldAllLinkables :: [Linkable]
- , ldUnits :: [UnitId]
- , ldNeededUnits :: UniqDSet UnitId
+ , ldNeededUnits :: [UnitId]
+ , ldAllUnits :: UniqDSet UnitId
}
-- | Find all the packages and linkables that a set of modules depends on
@@ -100,9 +109,80 @@ getLinkDeps opts interp pls span mods = do
-- then we need to find & link object files built the "normal" way.
maybe_normal_osuf <- checkNonStdWay opts interp span
- get_link_deps opts pls maybe_normal_osuf span mods
-
+ withTiming (ldLogger opts) (text "getLinkDeps" <+> brackets (ppr span)) (const ()) $
+ get_link_deps opts pls maybe_normal_osuf span mods
+
+-- | Determine which parts of a module and its dependencies should be linked
+-- when resolving external dependencies.
+data LinkExternalDetails =
+ -- | A module that should be linked, including its dependencies in the home
+ -- unit and external packages.
+ -- Can be a home module in oneshot mode or a package dependency module in
+ -- either mode.
+ LinkAllDeps
+ |
+ -- | A home module whose package dependencies should be linked, but not the
+ -- module itself or its home unit dependencies.
+ -- Can either be a direct target or the implementation module corresponding to
+ -- a target boot module, but only in make mode.
+ -- The 'ModIface' is taken from the 'HomeModInfo', avoiding another lookup in
+ -- 'external_deps'.
+ -- The importing module and its home unit dependencies are not processed by
+ -- 'external_deps', since the readily available 'HomeModInfo's can be linked
+ -- without further analysis.
+ LinkOnlyPackages !ModIface
+
+instance Outputable LinkExternalDetails where
+ ppr = \case
+ LinkAllDeps -> text "all"
+ LinkOnlyPackages _ -> text "only-packages"
+
+-- | A module that should be examined by 'external_deps' to decide how to link
+-- it and its dependencies.
+data LinkExternal =
+ LinkExternal {
+ le_details :: LinkExternalDetails,
+ le_module :: !Module
+ }
+instance Outputable LinkExternal where
+ ppr LinkExternal {..} = ppr le_module <> brackets (ppr le_details)
+
+-- | The decision about the linking method used for a given module.
+data LinkModule =
+ -- | In make mode, we can use 'HomeModInfo' without any further analysis.
+ LinkHomeModule !HomeModInfo
+ |
+ -- | A module that must be linked as native code, because bytecode is disabled
+ -- or unavailable.
+ LinkObjectModule !Module !ModLocation
+ |
+ -- | A module that has bytecode available.
+ -- The 'IO' that compiles the bytecode from Core bindings is obtained from the
+ -- EPS.
+ -- See Note [Interface Files with Core Definitions].
+ LinkByteCodeModule !Module !(IO Linkable)
+
+link_module :: LinkModule -> Module
+link_module = \case
+ LinkHomeModule hmi -> mi_module (hm_iface hmi)
+ LinkObjectModule mod _ -> mod
+ LinkByteCodeModule mod _ -> mod
+
+instance Outputable LinkModule where
+ ppr = \case
+ LinkHomeModule hmi -> ppr (mi_module (hm_iface hmi)) <+> brackets (text "HMI")
+ LinkObjectModule mod _ -> ppr mod
+ LinkByteCodeModule mod _ -> ppr mod <+> brackets (text "BC")
+
+-- | Compute the linkables for the given module set's dependencies.
+--
+-- Home modules in make mode are treated separately in a preprocessing step,
+-- then all the remaining external deps are processed for both modes.
+-- If bytecode is available, transitive external deps are included, otherwise
+-- the module's library is linked and processing stops.
+--
+-- The results are split into sets of needed/loaded modules/packages.
get_link_deps
:: LinkDepsOpts
-> LoaderState
@@ -111,46 +191,36 @@ get_link_deps
-> [Module]
-> IO LinkDeps
get_link_deps opts pls maybe_normal_osuf span mods = do
- -- 1. Find the dependent home-pkg-modules/packages from each iface
- -- (omitting modules from the interactive package, which is already linked)
- (mods_s, pkgs_s) <-
- -- Why two code paths here? There is a significant amount of repeated work
- -- performed calculating transitive dependencies
- -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests)
- if ldOneShotMode opts
- then follow_deps (filterOut isInteractiveModule mods)
- emptyUniqDSet emptyUniqDSet;
- else do
- (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods
- return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs))
-
- let
- -- 2. Exclude ones already linked
- -- Main reason: avoid findModule calls in get_linkable
- (mods_needed, links_got) = partitionWith split_mods mods_s
- pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls
-
- split_mods mod =
- let is_linked = lookupModuleEnv (objs_loaded pls) mod
- <|> lookupModuleEnv (bcos_loaded pls) mod
- in case is_linked of
- Just linkable -> Right linkable
- Nothing -> Left mod
-
- -- 3. For each dependent module, find its linkable
- -- This will either be in the HPT or (in the case of one-shot
- -- compilation) we may need to use maybe_getFileLinkable
- lnks_needed <- mapM (get_linkable (ldObjSuffix opts)) mods_needed
-
- return $ LinkDeps
- { ldNeededLinkables = lnks_needed
- , ldAllLinkables = links_got ++ lnks_needed
- , ldUnits = pkgs_needed
- , ldNeededUnits = pkgs_s
- }
+ (link_deps_home, module_deps_external) <- separate_home_deps
+ link_deps_external <- external_deps opts module_deps_external
+ let (loaded_modules, needed_modules, ldAllUnits, ldNeededUnits) =
+ classify_deps pls link_deps_home link_deps_external
+ ldNeededLinkables <- mapM module_linkable needed_modules
+ pure LinkDeps {
+ ldNeededLinkables,
+ ldAllLinkables = loaded_modules ++ ldNeededLinkables,
+ ldNeededUnits,
+ ldAllUnits
+ }
where
mod_graph = ldModuleGraph opts
unit_env = ldUnitEnv opts
+ noninteractive = filterOut isInteractiveModule mods
+
+ -- Preprocess the dependencies in make mode to remove all home modules,
+ -- since the transitive dependency closure is already cached for those in
+ -- the HUG (see MultiLayerModulesTH_* tests for the performance impact).
+ --
+ -- Returns the remaining, external, dependencies on the right, which is the
+ -- entire set for oneshot mode.
+ separate_home_deps =
+ if ldOneShotMode opts
+ then pure ([], LinkExternal LinkAllDeps <$!> noninteractive)
+ else make_deps
+
+ make_deps = do
+ (dep_ext, mmods) <- unzip <$> mapM get_mod_info all_home_mods
+ pure (mmods, init_ext ++ dep_ext)
-- This code is used in `--make` mode to calculate the home package and unit dependencies
-- for a set of modules.
@@ -160,9 +230,9 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
-- It is also a matter of correctness to use the module graph so that dependencies between home units
-- is resolved correctly.
- make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey)
+ make_deps_loop :: ([LinkExternal], Set.Set NodeKey) -> [ModNodeKeyWithUid] -> ([LinkExternal], Set.Set NodeKey)
make_deps_loop found [] = found
- make_deps_loop found@(found_units, found_mods) (nk:nexts)
+ make_deps_loop found@(external, found_mods) (nk:nexts)
| NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts
| otherwise =
case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of
@@ -171,93 +241,46 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
-- See #936 and the ghci.prog007 test for why we have to continue traversing through
-- boot modules.
todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps]
- in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts)
+ in make_deps_loop (external, deps `Set.union` found_mods) (todo_boot_mods ++ nexts)
Nothing ->
- let (ModNodeKeyWithUid _ uid) = nk
- in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts
+ let (ModNodeKeyWithUid (GWIB mod_name _) uid) = nk
+ mod = Module (RealUnit (Definite uid)) mod_name
+ in make_deps_loop (LinkExternal LinkAllDeps mod : external, found_mods) nexts
mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m)
- (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods)
+ (init_ext, all_deps) = make_deps_loop ([], Set.empty) $ map mkNk noninteractive
all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps]
get_mod_info (ModNodeKeyWithUid gwib uid) =
case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of
- Just hmi ->
- let iface = (hm_iface hmi)
- mmod = case mi_hsc_src iface of
- HsBootFile -> link_boot_mod_error (mi_module iface)
- _ -> return $ Just (mi_module iface)
-
- in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod
+ Just hmi -> do
+ let iface = hm_iface hmi
+ pure (LinkExternal (LinkOnlyPackages iface) (mi_module iface), hmi)
Nothing -> throwProgramError opts $
text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid
-
- -- This code is used in one-shot mode to traverse downwards through the HPT
- -- to find all link dependencies.
- -- The ModIface contains the transitive closure of the module dependencies
- -- within the current package, *except* for boot modules: if we encounter
- -- a boot module, we have to find its real interface and discover the
- -- dependencies of that. Hence we need to traverse the dependency
- -- tree recursively. See bug #936, testcase ghci/prog007.
- follow_deps :: [Module] -- modules to follow
- -> UniqDSet Module -- accum. module dependencies
- -> UniqDSet UnitId -- accum. package dependencies
- -> IO ([Module], UniqDSet UnitId) -- result
- follow_deps [] acc_mods acc_pkgs
- = return (uniqDSetToList acc_mods, acc_pkgs)
- follow_deps (mod:mods) acc_mods acc_pkgs
- = do
- mb_iface <- ldLoadIface opts msg mod
- iface <- case mb_iface of
- Failed err -> throwProgramError opts $
- missingInterfaceErrorDiagnostic (ldMsgOpts opts) err
- Succeeded iface -> return iface
-
- when (mi_boot iface == IsBoot) $ link_boot_mod_error mod
-
- let
- pkg = moduleUnit mod
- deps = mi_deps iface
-
- pkg_deps = dep_direct_pkgs deps
- (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $
- \case
- (_, GWIB m IsBoot) -> Left m
- (_, GWIB m NotBoot) -> Right m
-
- mod_deps' = case ue_homeUnit unit_env of
- Nothing -> []
- Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps))
- acc_mods' = case ue_homeUnit unit_env of
- Nothing -> acc_mods
- Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps)
- acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps)
-
- case ue_homeUnit unit_env of
- Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods)
- acc_mods' acc_pkgs'
- _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
- where
- msg = text "need to link module" <+> ppr mod <+>
- text "due to use of Template Haskell"
-
-
-
- link_boot_mod_error :: Module -> IO a
- link_boot_mod_error mod = throwProgramError opts $
- text "module" <+> ppr mod <+>
- text "cannot be linked; it is only available as a boot module"
-
no_obj :: Outputable a => a -> IO b
no_obj mod = dieWith opts span $
- text "cannot find object file for module " <>
+ text "cannot find object file for module" <+>
quotes (ppr mod) $$
while_linking_expr
while_linking_expr = text "while linking an interpreted expression"
+ -- Extract the 'Linkable's for unlinked modules from the intermediate
+ -- results.
+ module_linkable = \case
+ LinkHomeModule hmi ->
+ adjust_linkable (expectJust "getLinkDeps" (homeModLinkable hmi))
+
+ LinkObjectModule mod loc -> do
+ findObjectLinkableMaybe mod loc >>= \case
+ Nothing -> no_obj mod
+ Just lnk -> adjust_linkable lnk
+
+ LinkByteCodeModule _ load_bytecode ->
+ load_bytecode
-- See Note [Using Byte Code rather than Object Code for Template Haskell]
homeModLinkable :: HomeModInfo -> Maybe Linkable
@@ -266,57 +289,244 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
then homeModInfoByteCode hmi <|> homeModInfoObject hmi
else homeModInfoObject hmi <|> homeModInfoByteCode hmi
- get_linkable osuf mod -- A home-package module
- | Just mod_info <- lookupHugByModule mod (ue_home_unit_graph unit_env)
- = adjust_linkable (expectJust "getLinkDeps" (homeModLinkable mod_info))
- | otherwise
- = do -- It's not in the HPT because we are in one shot mode,
- -- so use the Finder to get a ModLocation...
- case ue_homeUnit unit_env of
- Nothing -> no_obj mod
- Just home_unit -> do
- from_bc <- ldLoadByteCode opts mod
- maybe (fallback_no_bytecode home_unit mod) pure from_bc
- where
-
- fallback_no_bytecode home_unit mod = do
- let fc = ldFinderCache opts
- let fopts = ldFinderOpts opts
- mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod)
- case mb_stuff of
- Found loc _ -> do
- mb_lnk <- findObjectLinkableMaybe mod loc
- case mb_lnk of
- Nothing -> no_obj mod
- Just lnk -> adjust_linkable lnk
- _ -> no_obj (moduleName mod)
-
- adjust_linkable lnk
- | Just new_osuf <- maybe_normal_osuf = do
- new_parts <- mapM (adjust_part new_osuf)
- (linkableParts lnk)
- return lnk{ linkableParts=new_parts }
- | otherwise =
- return lnk
-
- adjust_part new_osuf part = case part of
- DotO file ModuleObject -> do
- massert (osuf `isSuffixOf` file)
- let file_base = fromJust (stripExtension osuf file)
- new_file = file_base <.> new_osuf
- ok <- doesFileExist new_file
- if (not ok)
- then dieWith opts span $
- text "cannot find object file "
- <> quotes (text new_file) $$ while_linking_expr
- else return (DotO new_file ModuleObject)
- DotO file ForeignObject -> pure (DotO file ForeignObject)
- DotA fp -> panic ("adjust_ul DotA " ++ show fp)
- DotDLL fp -> panic ("adjust_ul DotDLL " ++ show fp)
- BCOs {} -> pure part
- LazyBCOs{} -> pure part
- CoreBindings WholeCoreBindings {wcb_module} ->
- pprPanic "Unhydrated core bindings" (ppr wcb_module)
+ adjust_linkable lnk
+ | Just new_osuf <- maybe_normal_osuf = do
+ new_uls <- mapM (adjust_part (ldObjSuffix opts) new_osuf)
+ (linkableParts lnk)
+ return lnk {linkableParts = new_uls}
+ | otherwise =
+ return lnk
+
+ adjust_part osuf new_osuf part = case part of
+ DotO file ModuleObject -> do
+ massert (osuf `isSuffixOf` file)
+ let file_base = fromJust (stripExtension osuf file)
+ new_file = file_base <.> new_osuf
+ ok <- doesFileExist new_file
+ if (not ok)
+ then dieWith opts span $
+ text "cannot find object file"
+ <+> quotes (text new_file) $$ while_linking_expr
+ else return (DotO new_file ModuleObject)
+ DotO file ForeignObject -> pure (DotO file ForeignObject)
+ DotA fp -> panic ("adjust_part DotA " ++ show fp)
+ DotDLL fp -> panic ("adjust_part DotDLL " ++ show fp)
+ BCOs {} -> pure part
+ LazyBCOs{} -> pure part
+ CoreBindings WholeCoreBindings {wcb_module} ->
+ pprPanic "Unhydrated core bindings" (ppr wcb_module)
+
+data LinkDep =
+ LinkModules !(UniqDFM ModuleName LinkModule)
+ |
+ LinkLibrary !UnitId
+
+instance Outputable LinkDep where
+ ppr = \case
+ LinkModules mods -> text "modules:" <+> ppr (eltsUDFM mods)
+ LinkLibrary uid -> text "library:" <+> ppr uid
+
+data OneshotError =
+ NoInterface !MissingInterfaceError
+ |
+ LinkBootModule !Module
+
+-- | Compute the transitive dependency closure of the given modules.
+--
+-- Used for all oneshot mode dependencies and for external dependencies of home
+-- modules in make mode.
+external_deps ::
+ LinkDepsOpts ->
+ -- | Modules whose imports to follow
+ [LinkExternal] ->
+ IO [LinkDep]
+external_deps opts mods =
+ runExceptT (external_deps_loop opts mods emptyUDFM) >>= \case
+ Right a -> pure (eltsUDFM a)
+ Left err -> throwProgramError opts (message err)
+ where
+ message = \case
+ NoInterface err ->
+ missingInterfaceErrorDiagnostic (ldMsgOpts opts) err
+ LinkBootModule mod ->
+ link_boot_mod_error mod
+
+external_deps_loop ::
+ LinkDepsOpts ->
+ [LinkExternal] ->
+ UniqDFM UnitId LinkDep ->
+ ExceptT OneshotError IO (UniqDFM UnitId LinkDep)
+external_deps_loop _ [] acc =
+ pure acc
+external_deps_loop opts (job at LinkExternal {le_module = mod, ..} : mods) acc = do
+ (new_acc, new_mods, action) <-
+ if already_seen
+ then done
+ else process_module le_details
+ traverse_ debug_log action
+ external_deps_loop opts (new_mods ++ mods) new_acc
+ where
+ debug_log action =
+ liftIO $ debugTraceMsg (ldLogger opts) 3 $
+ text "TH dep" <+> ppr job <+>
+ brackets (sep (punctuate comma [
+ if is_home then text "home" else Outputable.empty,
+ text action
+ ]))
+
+ done = pure (acc, [], Nothing)
+
+ -- Decide how this module needs to be processed.
+ -- We only need an interface if we want to load bytecode or if we have to
+ -- link an object file (which happens for home unit modules, since those
+ -- have no libraries).
+ process_module = \case
+ LinkAllDeps | is_home || package_bc -> try_iface
+ | otherwise -> add_library
+
+ -- @LinkOnlyPackages@ is used for make mode home modules, so all imports
+ -- that are not external are already processed otherwise.
+ LinkOnlyPackages iface -> with_deps acc iface False "only packages"
+
+ -- Check whether the current module was processed before.
+ -- Since the accumulator is keyed by unit ID, we have to perform two
+ -- lookups.
+ -- If another module from this module's unit has been determined to be
+ -- linked as a library previously, we skip this module, assuming that no
+ -- bytecode is available for the entire package.
+ already_seen
+ | Just (LinkModules mods) <- mod_dep
+ = elemUDFM mod_name mods
+ | Just (LinkLibrary _) <- mod_dep
+ = True
+ | otherwise
+ = False
+
+ -- Load the iface and attempt to get bytecode from Core bindings.
+ try_iface =
+ liftIO (ldLoadIface opts load_reason mod) >>= \case
+ Failed err -> throwE (NoInterface err)
+ Succeeded (iface, loc) -> do
+ mb_load_bc <- liftIO (ldLoadByteCode opts (mi_module iface))
+ with_iface iface loc mb_load_bc
+
+ -- Decide how to link this module.
+ -- If bytecode or an object file is available, use those in that order.
+ -- Otherwise fall back to linking a library.
+ with_iface iface loc mb_load_bc
+ | IsBoot <- mi_boot iface
+ = throwE (LinkBootModule mod)
+
+ | ldUseByteCode opts
+ , is_home || package_bc
+ , Just load_bc <- mb_load_bc
+ = add_module iface (LinkByteCodeModule mod load_bc) "bytecode"
+
+ | is_home
+ = add_module iface (LinkObjectModule mod loc) "object"
+
+ | otherwise
+ = add_library
+
+ add_library =
+ pure (addToUDFM acc mod_unit_id (LinkLibrary mod_unit_id), [], Just "library")
+
+ add_module iface lmod action =
+ with_deps with_mod iface True action
+ where
+ with_mod = alterUDFM (add_package_module lmod) acc mod_unit_id
+
+ add_package_module lmod = \case
+ Just (LinkLibrary u) -> Just (LinkLibrary u)
+ Just (LinkModules old) -> Just (LinkModules (addToUDFM old mod_name lmod))
+ Nothing -> Just (LinkModules (unitUDFM mod_name lmod))
+
+ with_deps acc iface local action =
+ pure (addListToUDFM acc link, new_local ++ new_package, Just action)
+ where
+ !(!link, !new_package) = package_deps iface
+ new_local = if local then local_deps iface else []
+
+ local_deps iface =
+ [
+ LinkExternal LinkAllDeps (mkModule mod_unit m)
+ | (_, GWIB m _) <- Set.toList (dep_direct_mods (mi_deps iface))
+ ]
+
+ -- If bytecode linking of external dependencies is enabled, add them to the
+ -- jobs passed to the next iteration of 'external_deps_loop'.
+ -- Otherwise, link all package deps as libraries.
+ package_deps iface
+ | package_bc
+ = ([], [LinkExternal LinkAllDeps m | m <- Set.toList (dep_direct_pkg_mods (mi_deps iface))])
+ | otherwise
+ = ([(u, LinkLibrary u) | u <- Set.toList (dep_direct_pkgs (mi_deps iface))], [])
+
+ load_reason =
+ text "need to link module" <+> ppr mod <+>
+ text "due to use of Template Haskell"
+
+ package_bc = ldPkgByteCode opts
+
+ -- In multiple home unit mode, this only considers modules from the same
+ -- unit as the splice's module to be eligible for linking bytecode when
+ -- @-fpackage-db-byte-code@ is off.
+ -- For make mode, this is irrelevant, since any bytecode from the HUG is
+ -- obtained directly, not going through 'external_deps'.
+ is_home
+ | Just home <- ue_homeUnit (ldUnitEnv opts)
+ = homeUnitAsUnit home == mod_unit
+ | otherwise
+ = False
+
+ mod_dep = lookupUDFM acc mod_unit_id
+ mod_name = moduleName mod
+ mod_unit_id = moduleUnitId mod
+ mod_unit = moduleUnit mod
+
+link_boot_mod_error :: Module -> SDoc
+link_boot_mod_error mod =
+ text "module" <+> ppr mod <+>
+ text "cannot be linked; it is only available as a boot module"
+
+-- | 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':
+--
+-- - For module dependencies, in the sets of loaded objects and BCOs
+-- ('objs_loaded' and 'bcos_loaded')
+-- - For package dependencies, in the set of loaded packages ('pkgs_loaded')
+classify_deps ::
+ LoaderState ->
+ [HomeModInfo] ->
+ [LinkDep] ->
+ ([Linkable], [LinkModule], UniqDSet UnitId, [UnitId])
+classify_deps pls hmis deps =
+ (loaded_modules' ++ loaded_modules'', needed_modules' ++ needed_modules'', all_packages, needed_packages)
+ where
+ (loaded_modules', needed_modules') = partitionWith loaded_or_needed_home_module hmis
+ (loaded_modules'', needed_modules'') =
+ partitionWith loaded_or_needed_module (concatMap eltsUDFM modules)
+
+ needed_packages =
+ eltsUDFM (getUniqDSet all_packages `minusUDFM` pkgs_loaded pls)
+
+ all_packages = mkUniqDSet packages
+
+ (modules, packages) = flip partitionWith deps $ \case
+ LinkModules mods -> Left mods
+ LinkLibrary lib -> Right lib
+
+ loaded_or_needed_home_module lm =
+ maybe (Right (LinkHomeModule lm)) Left (loaded_module (mi_module (hm_iface lm)))
+
+ loaded_or_needed_module lm =
+ maybe (Right lm) Left (loaded_module (link_module lm))
+
+ loaded_module mod =
+ lookupModuleEnv (objs_loaded pls) mod
+ <|>
+ lookupModuleEnv (bcos_loaded pls) mod
{-
Note [Using Byte Code rather than Object Code for Template Haskell]
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -77,11 +77,13 @@ import GHC.Utils.TmpFs
import GHC.Unit.Env
import GHC.Unit.External (ExternalPackageState (EPS, eps_iface_bytecode))
+import GHC.Unit.Finder
import GHC.Unit.Module
import GHC.Unit.State as Packages
import qualified GHC.Data.ShortText as ST
import GHC.Data.FastString
+import qualified GHC.Data.Maybe as Maybe
import GHC.Linker.Deps
import GHC.Linker.MacOS
@@ -94,6 +96,7 @@ import Control.Monad
import qualified Data.Set as Set
import Data.Char (isSpace)
import qualified Data.Foldable as Foldable
+import Data.Functor ((<&>))
import Data.IORef
import Data.List (intercalate, isPrefixOf, nub, partition)
import Data.Maybe
@@ -231,10 +234,10 @@ loadDependencies interp hsc_env pls span needed_mods = do
-- Find what packages and linkables are required
deps <- getLinkDeps opts interp pls span needed_mods
- let this_pkgs_needed = ldNeededUnits deps
+ let this_pkgs_needed = ldAllUnits deps
-- Link the packages and modules required
- pls1 <- loadPackages' interp hsc_env (ldUnits deps) pls
+ pls1 <- loadPackages' interp hsc_env (ldNeededUnits deps) pls
(pls2, succ) <- loadModuleLinkables interp hsc_env pls1 (ldNeededLinkables deps)
let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed
all_pkgs_loaded = pkgs_loaded pls2
@@ -643,21 +646,40 @@ initLinkDepsOpts hsc_env = opts
, ldModuleGraph = hsc_mod_graph hsc_env
, ldUnitEnv = hsc_unit_env hsc_env
, ldPprOpts = initSDocContext dflags defaultUserStyle
- , ldFinderCache = hsc_FC hsc_env
- , ldFinderOpts = initFinderOpts dflags
, ldUseByteCode = gopt Opt_UseBytecodeRatherThanObjects dflags
+ , ldPkgByteCode = gopt Opt_PackageDbBytecode dflags
, ldMsgOpts = initIfaceMessageOpts dflags
, ldWays = ways dflags
, ldLoadIface
, ldLoadByteCode
+ , ldLogger = hsc_logger hsc_env
}
dflags = hsc_dflags hsc_env
- ldLoadIface msg mod = initIfaceCheck (text "loader") hsc_env
- $ loadInterface msg mod (ImportByUser NotBoot)
+
+ ldLoadIface msg mod =
+ initIfaceCheck (text "loader") hsc_env (loadInterface msg mod (ImportByUser NotBoot)) >>= \case
+ Maybe.Failed err -> pure (Maybe.Failed err)
+ Maybe.Succeeded iface ->
+ find_location mod <&> \case
+ InstalledFound loc _ -> Maybe.Succeeded (iface, loc)
+ err -> Maybe.Failed $
+ cannotFindInterface unit_state home_unit
+ (targetProfile dflags) (moduleName mod) err
+
+ find_location mod =
+ liftIO $
+ findExactModule (hsc_FC hsc_env) (initFinderOpts dflags)
+ other_fopts unit_state home_unit (toUnitId <$> mod)
+
+ other_fopts = initFinderOpts . homeUnitEnv_dflags <$> hsc_HUG hsc_env
+
+ unit_state = hsc_units hsc_env
+
+ home_unit = ue_homeUnit (hsc_unit_env hsc_env)
ldLoadByteCode mod = do
EPS {eps_iface_bytecode} <- hscEPS hsc_env
- sequence (lookupModuleEnv eps_iface_bytecode mod)
+ pure (lookupModuleEnv eps_iface_bytecode mod)
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -753,7 +753,7 @@ mkStubPaths fopts mod location = do
src_basename = OsPath.dropExtension <$> ml_hs_file_ospath location
-- -----------------------------------------------------------------------------
--- findLinkable isn't related to the other stuff in here,
+-- findObjectLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -4,6 +4,7 @@ module GHC.Unit.Module.Deps
, mkDependencies
, noDependencies
, dep_direct_mods
+ , dep_direct_pkg_mods
, dep_direct_pkgs
, dep_sig_mods
, dep_trusted_pkgs
@@ -35,6 +36,7 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Binary
import GHC.Utils.Outputable
+import qualified Data.Map.Strict as Map
import Data.List (sortBy, sort, partition)
import Data.Set (Set)
import qualified Data.Set as Set
@@ -99,6 +101,9 @@ data Dependencies = Deps
-- does NOT include us, unlike 'imp_finsts'. See Note
-- [The type family instance consistency story].
+ -- TODO strict?
+ , dep_direct_pkg_mods :: Set Module
+
}
deriving( Eq )
-- Equality used only for old/new comparison in GHC.Iface.Recomp.addFingerprints
@@ -145,6 +150,8 @@ mkDependencies home_unit mod imports plugin_mods =
sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports
+ dep_direct_pkg_mods = Set.filter ((homeUnitAsUnit home_unit /=) . moduleUnit) (Map.keysSet (imp_mods imports))
+
in Deps { dep_direct_mods = direct_mods
, dep_direct_pkgs = direct_pkgs
, dep_plugin_pkgs = plugin_units
@@ -155,6 +162,7 @@ mkDependencies home_unit mod imports plugin_mods =
, dep_finsts = sortBy stableModuleCmp (imp_finsts imports)
-- sort to get into canonical order
-- NB. remember to use lexicographic ordering
+ , dep_direct_pkg_mods
}
-- | Update module dependencies containing orphans (used by Backpack)
@@ -179,6 +187,7 @@ instance Binary Dependencies where
put_ bh (dep_boot_mods deps)
put_ bh (dep_orphs deps)
put_ bh (dep_finsts deps)
+ put_ bh (dep_direct_pkg_mods deps)
get bh = do dms <- get bh
dps <- get bh
@@ -188,14 +197,16 @@ instance Binary Dependencies where
sms <- get bh
os <- get bh
fis <- get bh
+ dep_direct_pkg_mods <- get bh
return (Deps { dep_direct_mods = dms
, dep_direct_pkgs = dps
, dep_plugin_pkgs = plugin_pkgs
, dep_sig_mods = hsigms
, dep_boot_mods = sms
, dep_trusted_pkgs = tps
- , dep_orphs = os,
- dep_finsts = fis })
+ , dep_orphs = os
+ , dep_finsts = fis
+ , dep_direct_pkg_mods })
noDependencies :: Dependencies
noDependencies = Deps
@@ -207,6 +218,7 @@ noDependencies = Deps
, dep_trusted_pkgs = Set.empty
, dep_orphs = []
, dep_finsts = []
+ , dep_direct_pkg_mods = Set.empty
}
-- | Pretty-print unit dependencies
=====================================
compiler/GHC/Unit/Module/WholeCoreBindings.hs
=====================================
@@ -68,7 +68,7 @@ traverses a splice's or GHCi expression's dependencies and collects the needed
build artifacts, which can be objects or bytecode, depending on the build
settings.
-1. In make mode, all eligible modules are part of the dependency graph.
+1. In make mode, all eligible home modules are part of the dependency graph.
Their interfaces are loaded unconditionally and in dependency order by the
compilation manager, and each module's bytecode is prepared before its
dependents are compiled, in one of two ways:
@@ -88,9 +88,10 @@ settings.
2. In oneshot mode, which compiles individual modules without a shared home unit
graph, a previously compiled module is not reprocessed as described for make
mode above.
- When 'get_link_deps' encounters a dependency on a local module, it requests
- its bytecode from the External Package State, who loads the interface
- on-demand.
+ 'get_link_deps' requests the bytecode of dependencies from the External
+ Package State, who loads the interface on-demand.
+ This works for modules in local directories (via @-i@ and @-hidir@) as well
+ as those exposed from a package DB.
Since the EPS stores interfaces for all package dependencies in addition to
local modules in oneshot mode, it has a substantial memory footprint.
@@ -109,6 +110,18 @@ settings.
storing the intermediate representation as rehydrated Core bindings, since
the latter have a significantly greater memory footprint.
+3. In both of the above modes, whenever a module from an external package
+ (loaded from a package DB) is encountered, the workflow is the same as for
+ oneshot mode if the flag @-fpackage-db-byte-code@ is enabled; otherwise, object
+ code is loaded.
+ Interfaces for external modules are stored together with local oneshot mode
+ modules, so almost no special treatment is necessary, with the exception of:
+ - When external package modules are compiled, the @InteractiveContext@ in
+ @HscEnv@ is accessed, which is not available due to its impact on retention
+ of outdated build products.
+ This is solved by writing an empty @InteractiveContext@ to the env used for
+ compilation.
+
Note [Size of Interface Files with Core Definitions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -210,7 +223,9 @@ If the 'HomeModLinkable' already contains bytecode (case 1), this is a no-op.
Otherwise, the stub objects from the interface are compiled to objects in
'generateByteCode' and added to the 'HomeModLinkable' as well.
-Case 3 is not implemented yet (!13042).
+In case 3, Core bindings are loaded from the EPS, where stubs only exist in
+their serialized form in the interface, so they must be regenerated like in case
+2.
Problem 3:
=====================================
docs/users_guide/phases.rst
=====================================
@@ -826,6 +826,17 @@ Options affecting code generation
will generate byte-code rather than object code.
+.. ghc-flag:: -fpackage-db-byte-code
+ :shortdesc: Use byte-code from package DB dependencies
+ :type: dynamic
+ :category: codegen
+
+ GHC normally only considers local modules to be eligible for loading
+ bytecode from interfaces for splices with :ghc-flag:`-fprefer-byte-code`.
+ When this flag is specified additionally, bytecode will be loaded from
+ interfaces for all external package dependencies that provide it.
+
+
.. _options-linker:
Options affecting linking
=====================================
testsuite/tests/bytecode/T25090/Dep.hs
=====================================
@@ -0,0 +1,15 @@
+module Dep where
+
+data A = A Int
+
+used :: Int
+used = 9681
+
+dep :: A
+dep = A used
+
+unused1 :: A
+unused1 = A 1
+
+unused2 :: A
+unused2 = unused1
=====================================
testsuite/tests/bytecode/T25090/DepApi.hs
=====================================
@@ -0,0 +1,7 @@
+module DepApi (A (A), dep) where
+
+import Dep (A (A))
+import qualified Dep
+
+dep :: A
+dep = Dep.dep
=====================================
testsuite/tests/bytecode/T25090/Local.hs
=====================================
@@ -0,0 +1,15 @@
+{-# language PackageImports #-}
+
+module Local where
+
+import GHC.Prim
+import Language.Haskell.TH (ExpQ)
+import Language.Haskell.TH.Syntax (lift)
+-- just to be sure that the file isn't accidentally picked up locally
+import "dep" DepApi (dep, A (A))
+import {-# source #-} Num (num)
+
+splc :: ExpQ
+splc = lift @_ @Int (num + d)
+ where
+ A d = dep
=====================================
testsuite/tests/bytecode/T25090/Makefile
=====================================
@@ -19,3 +19,35 @@ T25090a:
T25090b:
$(TEST_HC) -fbyte-code-and-object-code -fprefer-byte-code A -o exe -v0
./exe
+
+DB := -package-db db -package dep
+BASIC := $(TEST_HC_OPTS) $(DB) -this-unit-id=pkgdep -v0
+BC := -fprefer-byte-code -fbyte-code-and-object-code
+ARGS := $(BASIC) $(BC)
+
+T25090_pkg:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "shared"
+ ./run.bash "$(TEST_HC)" "$(ARGS) -dynamic"
+
+T25090_pkg_empty:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "shared-empty"
+ ./run.bash "$(TEST_HC)" "$(ARGS) -dynamic"
+
+T25090_pkg_nolib:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "none"
+ ./run.bash "$(TEST_HC)" "$(ARGS)"
+
+T25090_pkg_obj_code:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "shared"
+ ./run.bash "$(TEST_HC)" "$(BASIC) -dynamic -fbyte-code-and-object-code"
+
+T25090_pkg_multi_unit:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "shared"
+ mkdir -p unit2-src/
+ mv Local.hs Num.hs Num.hs-boot unit2-src/
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ARGS) -fpackage-db-byte-code -dynamic -unit @unit1 -unit @unit2
+ ./PkgBytecode
+
+T25090_pkg_archive:
+ ./prep.bash "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(GHC_PKG)" "$(dllext)" "archive"
+ ./run.bash "$(TEST_HC)" "$(ARGS)"
=====================================
testsuite/tests/bytecode/T25090/Num.hs
=====================================
@@ -0,0 +1,4 @@
+module Num where
+
+num :: Int
+num = 48332
=====================================
testsuite/tests/bytecode/T25090/Num.hs-boot
=====================================
@@ -0,0 +1,3 @@
+module Num where
+
+num :: Int
=====================================
testsuite/tests/bytecode/T25090/PkgBytecode.hs
=====================================
@@ -0,0 +1,12 @@
+{-# language TemplateHaskell #-}
+
+module Main where
+
+import GHC.Prim
+import Local (splc)
+
+a :: Int
+a = $(splc)
+
+main :: IO ()
+main = putStrLn (show a)
=====================================
testsuite/tests/bytecode/T25090/PkgBytecode.stdout
=====================================
@@ -0,0 +1 @@
+58013
=====================================
testsuite/tests/bytecode/T25090/all.T
=====================================
@@ -16,3 +16,36 @@ def test_T25090(name):
test_T25090('T25090a')
test_T25090('T25090b')
+
+def test_pkg(name, files = []):
+ test(
+ name,
+ [
+ extra_files([
+ 'PkgBytecode.hs',
+ 'Local.hs',
+ 'Dep.hs',
+ 'DepApi.hs',
+ 'Num.hs',
+ 'Num.hs-boot',
+ 'dep.conf',
+ 'prep.bash',
+ 'run.bash',
+ ] + files),
+ req_th,
+ js_skip,
+ windows_skip,
+ use_specs({'stdout': 'PkgBytecode.stdout'}),
+ ],
+ makefile_test,
+ [],
+ )
+
+test_pkg('T25090_pkg')
+test_pkg('T25090_pkg_empty')
+test_pkg('T25090_pkg_nolib')
+test_pkg('T25090_pkg_obj_code')
+test_pkg('T25090_pkg_multi_unit', ['unit1', 'unit2'])
+# TODO this doesn't work, because `locateLib` ignores static archives when the interpreter is dynamic, even though a
+# comment says "search for .so libraries _first_" (rather than "only").
+# test_pkg('T25090_pkg_archive')
=====================================
testsuite/tests/bytecode/T25090/dep.conf
=====================================
@@ -0,0 +1,8 @@
+name: dep
+version: 1.0
+id: dep-1.0
+key: dep-1.0
+exposed: True
+exposed-modules: DepApi
+import-dirs: ${pkgroot}/dep
+library-dirs: ${pkgroot}/dep
=====================================
testsuite/tests/bytecode/T25090/prep.bash
=====================================
@@ -0,0 +1,59 @@
+#!/usr/bin/env bash
+
+set -eu
+
+ghc_cmd="$1"
+ghc_opts="$2"
+ghc_pkg_cmd="$3"
+so_ext="$4"
+library="$5"
+
+base="$PWD"
+db="$base/db"
+dep="$base/dep"
+conf_dep="${dep}/dep.conf"
+
+mkdir -p "$dep" "$db"
+mv Dep.hs DepApi.hs "$dep/"
+cp dep.conf "$dep/"
+
+ghc_pkg()
+{
+ eval "${ghc_pkg_cmd at Q} --no-user-package-db --package-db=${db at Q} $@"
+}
+
+ghc()
+{
+ eval "${ghc_cmd at Q} ${ghc_opts/-rtsopts/} -package-db ${db at Q} -hidir ${dep at Q} -O0 -this-unit-id dep-1.0 -fbyte-code-and-object-code $@"
+}
+
+version=$(ghc "--numeric-version")
+
+ghc_pkg recache
+
+ghc "-c ${dep at Q}/Dep.hs ${dep at Q}/DepApi.hs"
+ghc "-dynamic -c -osuf dyn_o -hisuf dyn_hi ${dep at Q}/Dep.hs ${dep at Q}/DepApi.hs"
+
+if [[ "$library" == 'shared' ]]
+then
+ ghc "-dynamic -shared -o ${dep at Q}/libHSdep-1.0-ghc${version}${so_ext} ${dep at Q}/Dep.dyn_o ${dep at Q}/DepApi.dyn_o"
+ echo 'hs-libraries: HSdep-1.0' >> "$conf_dep"
+elif [[ "$library" == 'shared-empty' ]]
+then
+ echo 'module Dummy where' > Dummy.hs
+ ghc "-dynamic-too -c Dummy.hs"
+ ghc "-dynamic -shared -o ${dep at Q}/libHSdep-1.0-ghc${version}${so_ext} Dummy.dyn_o"
+ echo 'hs-libraries: HSdep-1.0' >> "$conf_dep"
+elif [[ "$library" == 'archive' ]]
+then
+ $AR cqs "${dep}/libHSdep-1.0.a" "${dep}/Dep.o" "${dep}/DepApi.o"
+ echo 'hs-libraries: HSdep-1.0' >> "$conf_dep"
+elif [[ "$library" == 'none' ]]
+then
+ :
+else
+ echo "Invalid argument for 'library': $library"
+ exit 1
+fi
+
+ghc_pkg -v0 register "${conf_dep at Q}"
=====================================
testsuite/tests/bytecode/T25090/run.bash
=====================================
@@ -0,0 +1,16 @@
+#!/usr/bin/env bash
+
+set -eu
+
+ghc_cmd="$1"
+ghc_opts="$2"
+
+ghc()
+{
+ eval "${ghc_cmd at Q} $ghc_opts $@"
+}
+
+ghc -c Num.hs-boot Num.hs Local.hs
+ghc -fpackage-db-byte-code -c PkgBytecode.hs
+ghc PkgBytecode.o -o PkgBytecode
+./PkgBytecode
=====================================
testsuite/tests/bytecode/T25090/unit1
=====================================
@@ -0,0 +1 @@
+-i -i. PkgBytecode -this-unit-id unit1 -package-id unit2
=====================================
testsuite/tests/bytecode/T25090/unit2
=====================================
@@ -0,0 +1 @@
+-i -i./unit2-src Local Num -this-unit-id unit2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca0cef6d45cef6ff7cf5ff772b82207f02f845fa...f3c844d266353e0d6faaf90c092eace5afa60e3c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca0cef6d45cef6ff7cf5ff772b82207f02f845fa...f3c844d266353e0d6faaf90c092eace5afa60e3c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241029/380e7799/attachment-0001.html>
More information about the ghc-commits
mailing list