[Git][ghc/ghc][wip/torsten.schmits/oneshot-bytecode-squashed] Oneshot bytecode linking
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Sun Jul 28 11:53:02 UTC 2024
Torsten Schmits pushed to branch wip/torsten.schmits/oneshot-bytecode-squashed at Glasgow Haskell Compiler / GHC
Commits:
64a16717 by Cheng Shao at 2024-07-28T13:52:52+02:00
Oneshot bytecode linking
- - - - -
15 changed files:
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/Driver/Main.hs-boot
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Module/ModIface.hs
- testsuite/tests/bytecode/T24634/Hello.hs
- testsuite/tests/bytecode/T24634/Makefile
- + testsuite/tests/bytecode/T24634/T24634.stdout
- testsuite/tests/bytecode/T24634/all.T
- testsuite/tests/bytecode/T24634/hello.c → testsuite/tests/bytecode/T24634/hello_c.c
- testsuite/tests/bytecode/T24634/hello.h → testsuite/tests/bytecode/T24634/hello_c.h
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -50,6 +50,7 @@ module GHC.Driver.Main
, HscBackendAction (..), HscRecompStatus (..)
, initModDetails
, initWholeCoreBindings
+ , initWholeCoreBindingsEps
, hscMaybeWriteIface
, hscCompileCmmFile
@@ -106,6 +107,7 @@ module GHC.Driver.Main
, showModuleIndex
, hscAddSptEntries
, writeInterfaceOnlyMode
+ , loadByteCode
) where
import GHC.Prelude
@@ -292,6 +294,8 @@ import GHC.Types.TypeEnv
import System.IO
import {-# SOURCE #-} GHC.Driver.Pipeline
import Data.Time
+import Data.Traversable
+import qualified Data.ByteString as BS
import System.IO.Unsafe ( unsafeInterleaveIO )
import GHC.Iface.Env ( trace_if )
@@ -989,30 +993,70 @@ initModDetails hsc_env iface =
-- in make mode, since this HMI will go into the HPT.
genModDetails hsc_env' iface
--- Hydrate any WholeCoreBindings linkables into BCOs
-initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
-initWholeCoreBindings hsc_env mod_iface details (LM utc_time this_mod uls) = LM utc_time this_mod <$> mapM go uls
+-- | Hydrate any WholeCoreBindings linkables into BCOs, using the supplied
+-- action to initialize the appropriate environment for type checking.
+initWholeCoreBindingsWith ::
+ IO (HscEnv, IORef TypeEnv, TypeEnv) ->
+ HscEnv ->
+ ModIface ->
+ Linkable ->
+ IO Linkable
+initWholeCoreBindingsWith mk_tc_env hsc_env mod_iface (LM utc_time this_mod uls) = do
+ -- If a module is compiled with -fbyte-code-and-object-code and it
+ -- makes use of foreign stubs, then the interface file will also
+ -- contain serialized stub dynamic objects, and we can simply write
+ -- them to temporary objects and refer to them as unlinked items
+ -- directly.
+ stub_uls <- for (mi_stub_objs mod_iface) $ \stub_obj -> do
+ f <- newTempName (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (tmpDir (hsc_dflags hsc_env)) TFL_GhcSession "dyn_o"
+ BS.writeFile f stub_obj
+ pure $ DotO f
+ bytecode_uls <- for uls go
+ pure $ LM utc_time this_mod $ stub_uls ++ bytecode_uls
where
go (CoreBindings fi) = do
- let act hpt = addToHpt hpt (moduleName $ mi_module mod_iface)
- (HomeModInfo mod_iface details emptyHomeModInfoLinkable)
- types_var <- newIORef (md_types details)
- let kv = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)])
- let hsc_env' = hscUpdateHPT act hsc_env { hsc_type_env_vars = kv }
-- The bytecode generation itself is lazy because otherwise even when doing
-- recompilation checking the bytecode will be generated (which slows things down a lot)
-- the laziness is OK because generateByteCode just depends on things already loaded
-- in the interface file.
LoadedBCOs <$> (unsafeInterleaveIO $ do
- core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckWholeCoreBindings types_var fi
- -- MP: The NoStubs here is only from (I think) the TH `qAddForeignFilePath` feature but it's a bit unclear what to do
- -- with these files, do we have to read and serialise the foreign file? I will leave it for now until someone
- -- reports a bug.
- let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons (md_types details)) NoStubs Nothing []
+ (tc_hsc_env, types_var, initial_types) <- mk_tc_env
+ core_binds <- initIfaceCheck (text "l") tc_hsc_env $
+ typecheckWholeCoreBindings types_var fi
+ let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons initial_types) NoStubs Nothing []
trace_if (hsc_logger hsc_env) (text "Generating ByteCode for" <+> (ppr this_mod))
+ -- TODO why are we not using tc_hsc_env here?
generateByteCode hsc_env cgi_guts (wcb_mod_location fi))
go ul = return ul
+-- | Hydrate core bindings for a module in the home package table, for which we
+-- can obtain a 'ModDetails'.
+initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
+initWholeCoreBindings hsc_env mod_iface details linkable at LM {linkableModule} =
+ initWholeCoreBindingsWith mk_tc_env hsc_env mod_iface linkable
+ where
+ mk_tc_env = do
+ types_var <- newIORef initial_types
+ let
+ kv = knotVarsFromModuleEnv (mkModuleEnv [(linkableModule, types_var)])
+ hsc_env' = hscUpdateHPT act hsc_env { hsc_type_env_vars = kv }
+ pure (hsc_env', types_var, initial_types)
+ where
+ initial_types = md_types details
+ act hpt = addToHpt hpt (moduleName $ mi_module mod_iface)
+ (HomeModInfo mod_iface details emptyHomeModInfoLinkable)
+
+-- | Hydrate core bindings for a module in the external package state.
+initWholeCoreBindingsEps :: HscEnv -> ModIface -> Linkable -> IO Linkable
+initWholeCoreBindingsEps hsc_env =
+ initWholeCoreBindingsWith mk_tc_env hsc_env
+ where
+ mk_tc_env = do
+ initial_types <- eps_PTE <$> hscEPS hsc_env
+ types_var <- newIORef initial_types
+ pure (hsc_env, types_var, initial_types)
+
+
{-
Note [ModDetails and --make mode]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2044,7 +2088,10 @@ generateByteCode hsc_env cgguts mod_location = do
stub_o <- case hasStub of
Nothing -> return []
Just stub_c -> do
- stub_o <- compileForeign hsc_env LangC stub_c
+ -- Always compile foreign stubs as shared objects so
+ -- they can be properly loaded later when the bytecode
+ -- is loaded.
+ stub_o <- compileForeign (hscUpdateFlags setDynamicNow hsc_env) LangC stub_c
return [DotO stub_o]
let hs_unlinked = [BCOs comp_bc spt_entries]
=====================================
compiler/GHC/Driver/Main.hs-boot
=====================================
@@ -0,0 +1,8 @@
+module GHC.Driver.Main where
+
+import GHC.Driver.Env
+import GHC.Linker.Types
+import GHC.Prelude
+import GHC.Unit.Module.ModIface
+
+initWholeCoreBindingsEps :: HscEnv -> ModIface -> Linkable -> IO Linkable
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -796,7 +796,7 @@ hscBackendPipeline pipe_env hsc_env mod_sum result =
HscUpdate iface -> return (iface, emptyHomeModInfoLinkable)
HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing) <*> pure emptyHomeModInfoLinkable
-- TODO: Why is there not a linkable?
- -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing
+ -- Interpreter -> (,) <$> use (T_IO (mkFullIfaceWithForeignStubs hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing
hscGenBackendPipeline :: P m
=> PipeEnv
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -582,9 +582,23 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
do
output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location)
(outputFilename, mStub, foreign_files, stg_infos, cg_infos) <-
-
hscGenHardCode hsc_env cgguts mod_location output_fn
- final_iface <- mkFullIface hsc_env partial_iface stg_infos cg_infos
+
+ -- When compiling with -fprefer-byte-code, always
+ -- compile foreign stubs as shared objects to ensure
+ -- they can be properly loaded.
+ let hsc_env_stub
+ | gopt Opt_WriteIfSimplifiedCore dflags = hscUpdateFlags setDynamicNow hsc_env
+ | otherwise = hsc_env
+ stub_o <- mapM (compileStub hsc_env_stub) mStub
+ foreign_os <-
+ mapM (uncurry (compileForeign hsc_env_stub)) foreign_files
+ let fos = maybe [] return stub_o ++ foreign_os
+ iface_fos
+ | gopt Opt_WriteIfSimplifiedCore dflags = fos
+ | otherwise = []
+
+ final_iface <- mkFullIfaceWithForeignStubs hsc_env partial_iface stg_infos cg_infos iface_fos
-- See Note [Writing interface files]
hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location
@@ -596,12 +610,6 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
else return emptyHomeModInfoLinkable
-
- stub_o <- mapM (compileStub hsc_env) mStub
- foreign_os <-
- mapM (uncurry (compileForeign hsc_env)) foreign_files
- let fos = (maybe [] return stub_o ++ foreign_os)
-
-- This is awkward, no linkable is produced here because we still
-- have some way to do before the object file is produced
-- In future we can split up the driver logic more so that this function
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -513,11 +513,6 @@ loadInterface doc_str mod from
; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
; let final_iface = iface
- & set_mi_decls (panic "No mi_decls in PIT")
- & set_mi_insts (panic "No mi_insts in PIT")
- & set_mi_fam_insts (panic "No mi_fam_insts in PIT")
- & set_mi_rules (panic "No mi_rules in PIT")
- & set_mi_anns (panic "No mi_anns in PIT")
; let bad_boot = mi_boot iface == IsBoot
&& isJust (lookupKnotVars (if_rec_types gbl_env) mod)
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -12,6 +12,7 @@
module GHC.Iface.Make
( mkPartialIface
, mkFullIface
+ , mkFullIfaceWithForeignStubs
, mkIfaceTc
, mkIfaceExports
)
@@ -88,6 +89,8 @@ import GHC.Unit.Module.ModGuts
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Deps
+import qualified Data.ByteString as BS
+import Data.Traversable
import Data.Function
import Data.List ( sortBy )
import Data.Ord
@@ -126,23 +129,30 @@ mkPartialIface hsc_env core_prog mod_details mod_summary import_decls
= mkIface_ hsc_env this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env warns hpc_info self_trust
safe_mode usages docs mod_summary mod_details
+-- | Backwards compat interface for 'mkFullIfaceWithForeignStubs'.
+mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface
+mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos =
+ mkFullIfaceWithForeignStubs hsc_env partial_iface mb_stg_infos mb_cmm_infos []
+
-- | Fully instantiate an interface. Adds fingerprints and potentially code
-- generator produced information.
--
-- CmmCgInfos is not available when not generating code (-fno-code), or when not
-- generating interface pragmas (-fomit-interface-pragmas). See also
-- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types.
-mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface
-mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do
+mkFullIfaceWithForeignStubs :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [FilePath] -> IO ModIface
+mkFullIfaceWithForeignStubs hsc_env partial_iface mb_stg_infos mb_cmm_infos fos = do
let decls
| gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
= mi_decls partial_iface
| otherwise
= updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos
+ stub_objs <- for fos BS.readFile
+
full_iface <-
{-# SCC "addFingerprints" #-}
- addFingerprints hsc_env (set_mi_decls decls partial_iface)
+ addFingerprints hsc_env $ set_mi_stub_objs stub_objs $ set_mi_decls decls partial_iface
-- Debug printing
let unit_state = hsc_units hsc_env
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -52,10 +52,14 @@ import Control.Applicative
import qualified Data.Set as Set
import qualified Data.Map as M
-import Data.List (isSuffixOf)
import System.FilePath
import System.Directory
+import GHC.Driver.Env
+import {-# SOURCE #-} GHC.Driver.Main
+import Data.Time.Clock
+import GHC.Driver.Flags
+import GHC.Driver.Session
data LinkDepsOpts = LinkDepsOpts
{ ldObjSuffix :: !String -- ^ Suffix of .o files
@@ -70,6 +74,7 @@ data LinkDepsOpts = LinkDepsOpts
, ldWays :: !Ways -- ^ Enabled ways
, ldLoadIface :: SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface)
-- ^ Interface loader function
+ , ldHscEnv :: !HscEnv
}
data LinkDeps = LinkDeps
@@ -140,7 +145,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
-- 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
+ lnks_needed <- mapM get_linkable mods_needed
return $ LinkDeps
{ ldNeededLinkables = lnks_needed
@@ -266,7 +271,7 @@ 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
+ get_linkable mod -- A home-package module
| Just mod_info <- lookupHugByModule mod (ue_home_unit_graph unit_env)
= adjust_linkable (expectJust "getLinkDeps" (homeModLinkable mod_info))
| otherwise
@@ -283,13 +288,27 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
Found loc mod -> found loc mod
_ -> no_obj (moduleName mod)
where
- found loc mod = do {
- -- ...and then find the linkable for it
- mb_lnk <- findObjectLinkableMaybe mod loc ;
- case mb_lnk of {
- Nothing -> no_obj mod ;
- Just lnk -> adjust_linkable lnk
- }}
+ found loc mod
+ | prefer_bytecode = do
+ Succeeded iface <- ldLoadIface opts (text "makima") mod
+ case mi_extra_decls iface of
+ Just extra_decls -> do
+ t <- getCurrentTime
+ initWholeCoreBindingsEps hsc_env iface $ LM t mod [CoreBindings $ WholeCoreBindings extra_decls mod undefined]
+ _ -> fallback_no_bytecode loc mod
+ | otherwise = fallback_no_bytecode loc mod
+
+ fallback_no_bytecode loc mod = do
+ mb_lnk <- findObjectLinkableMaybe mod loc
+ case mb_lnk of
+ Nothing -> no_obj mod
+ Just lnk -> adjust_linkable lnk
+
+ prefer_bytecode = gopt Opt_UseBytecodeRatherThanObjects dflags
+
+ dflags = hsc_dflags hsc_env
+
+ hsc_env = ldHscEnv opts
adjust_linkable lnk
| Just new_osuf <- maybe_normal_osuf = do
@@ -300,9 +319,13 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
return lnk
adjust_ul new_osuf (DotO file) = do
- massert (osuf `isSuffixOf` file)
- let file_base = fromJust (stripExtension osuf file)
- new_file = file_base <.> new_osuf
+ -- file may already has new_osuf suffix. One example
+ -- is when we load bytecode from whole core bindings,
+ -- then the corresponding foreign stub objects are
+ -- compiled as shared objects and file may already has
+ -- .dyn_o suffix. And it's okay as long as the file to
+ -- load is already there.
+ let new_file = file -<.> new_osuf
ok <- doesFileExist new_file
if (not ok)
then dieWith opts span $
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -648,6 +648,7 @@ initLinkDepsOpts hsc_env = opts
, ldUseByteCode = gopt Opt_UseBytecodeRatherThanObjects dflags
, ldMsgOpts = initIfaceMessageOpts dflags
, ldWays = ways dflags
+ , ldHscEnv = hsc_env
}
dflags = hsc_dflags hsc_env
load_iface msg mod = initIfaceCheck (text "loader") hsc_env
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -22,6 +22,7 @@ module GHC.Unit.Module.ModIface
, mi_anns
, mi_decls
, mi_extra_decls
+ , mi_stub_objs
, mi_top_env
, mi_insts
, mi_fam_insts
@@ -56,6 +57,7 @@ module GHC.Unit.Module.ModIface
, set_mi_rules
, set_mi_decls
, set_mi_extra_decls
+ , set_mi_stub_objs
, set_mi_top_env
, set_mi_hpc
, set_mi_trust
@@ -119,6 +121,7 @@ import GHC.Utils.Binary
import Control.DeepSeq
import Control.Exception
import qualified GHC.Data.Strict as Strict
+import Data.ByteString (ByteString)
{- Note [Interface file stages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -282,6 +285,13 @@ data ModIface_ (phase :: ModIfacePhase)
-- combined with mi_decls allows us to restart code generation.
-- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs]
+ mi_stub_objs_ :: ![ByteString],
+ -- ^ Serialized foreign stub dynamic objects when
+ -- compiled with -fbyte-code-and-object-code, empty
+ -- and unused in other cases. This is required to make
+ -- whole core bindings properly work with foreign
+ -- stubs (see #24634).
+
mi_top_env_ :: !(Maybe IfaceTopEnv),
-- ^ Just enough information to reconstruct the top level environment in
-- the /original source/ code for this module. which
@@ -453,6 +463,7 @@ instance Binary ModIface where
mi_anns_ = anns,
mi_decls_ = decls,
mi_extra_decls_ = extra_decls,
+ mi_stub_objs_ = stub_objs,
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
mi_rules_ = rules,
@@ -497,6 +508,7 @@ instance Binary ModIface where
lazyPut bh anns
put_ bh decls
put_ bh extra_decls
+ put_ bh stub_objs
put_ bh insts
put_ bh fam_insts
lazyPut bh rules
@@ -529,6 +541,7 @@ instance Binary ModIface where
anns <- {-# SCC "bin_anns" #-} lazyGet bh
decls <- {-# SCC "bin_tycldecls" #-} get bh
extra_decls <- get bh
+ stub_objs <- get bh
insts <- {-# SCC "bin_insts" #-} get bh
fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
rules <- {-# SCC "bin_rules" #-} lazyGet bh
@@ -558,6 +571,7 @@ instance Binary ModIface where
mi_warns_ = warns,
mi_decls_ = decls,
mi_extra_decls_ = extra_decls,
+ mi_stub_objs_ = stub_objs,
mi_top_env_ = Nothing,
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
@@ -611,6 +625,7 @@ emptyPartialModIface mod
mi_rules_ = [],
mi_decls_ = [],
mi_extra_decls_ = Nothing,
+ mi_stub_objs_ = [],
mi_top_env_ = Nothing,
mi_hpc_ = False,
mi_trust_ = noIfaceTrustInfo,
@@ -664,7 +679,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
rnf (PrivateModIface
{ mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_, mi_usages_
, mi_exports_, mi_used_th_, mi_fixities_, mi_warns_, mi_anns_
- , mi_decls_, mi_extra_decls_, mi_top_env_, mi_insts_
+ , mi_decls_, mi_extra_decls_, mi_stub_objs_, mi_top_env_, mi_insts_
, mi_fam_insts_, mi_rules_, mi_hpc_, mi_trust_, mi_trust_pkg_
, mi_complete_matches_, mi_docs_, mi_final_exts_
, mi_ext_fields_, mi_src_hash_ })
@@ -681,6 +696,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf mi_anns_
`seq` rnf mi_decls_
`seq` rnf mi_extra_decls_
+ `seq` rnf mi_stub_objs_
`seq` rnf mi_top_env_
`seq` rnf mi_insts_
`seq` rnf mi_fam_insts_
@@ -844,6 +860,9 @@ set_mi_decls val iface = clear_mi_hi_bytes $ iface { mi_decls_ = val }
set_mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase
set_mi_extra_decls val iface = clear_mi_hi_bytes $ iface { mi_extra_decls_ = val }
+set_mi_stub_objs :: [ByteString] -> ModIface_ phase -> ModIface_ phase
+set_mi_stub_objs stub_objs iface = clear_mi_hi_bytes $ iface { mi_stub_objs_ = stub_objs }
+
set_mi_top_env :: Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }
@@ -940,6 +959,7 @@ However, with the pragma, the correct core is generated:
{-# INLINE mi_anns #-}
{-# INLINE mi_decls #-}
{-# INLINE mi_extra_decls #-}
+{-# INLINE mi_stub_objs #-}
{-# INLINE mi_top_env #-}
{-# INLINE mi_insts #-}
{-# INLINE mi_fam_insts #-}
@@ -957,7 +977,7 @@ However, with the pragma, the correct core is generated:
pattern ModIface ::
Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] ->
[IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings ->
- [IfaceAnnotation] -> [IfaceDeclExts phase] -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] ->
+ [IfaceAnnotation] -> [IfaceDeclExts phase] -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> [ByteString] ->
Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase ->
@@ -975,6 +995,7 @@ pattern ModIface
, mi_anns
, mi_decls
, mi_extra_decls
+ , mi_stub_objs
, mi_top_env
, mi_insts
, mi_fam_insts
@@ -1001,6 +1022,7 @@ pattern ModIface
, mi_anns_ = mi_anns
, mi_decls_ = mi_decls
, mi_extra_decls_ = mi_extra_decls
+ , mi_stub_objs_ = mi_stub_objs
, mi_top_env_ = mi_top_env
, mi_insts_ = mi_insts
, mi_fam_insts_ = mi_fam_insts
=====================================
testsuite/tests/bytecode/T24634/Hello.hs
=====================================
@@ -7,7 +7,7 @@ module Hello where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
-foreign import capi "hello.h say_hello" say_hello :: IO Int
+foreign import capi "hello_c.h say_hello" say_hello :: IO Int
mkHello :: DecsQ
mkHello = do
=====================================
testsuite/tests/bytecode/T24634/Makefile
=====================================
@@ -2,8 +2,8 @@ TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
-bytecode-capi:
- $(TEST_HC) -c hello.c
+T24634:
+ $(TEST_HC) -c -dynamic hello_c.c -o hello_c.o
$(TEST_HC) -c -fbyte-code-and-object-code Hello.hs
- $(TEST_HC) -fprefer-byte-code hello.o Main.hs
+ $(TEST_HC) -fbyte-code-and-object-code -fprefer-byte-code hello_c.o Main.hs
./Main
=====================================
testsuite/tests/bytecode/T24634/T24634.stdout
=====================================
@@ -0,0 +1,3 @@
+[2 of 3] Compiling Main ( Main.hs, Main.o, interpreted )
+[3 of 3] Linking Main
+42
=====================================
testsuite/tests/bytecode/T24634/all.T
=====================================
@@ -1,7 +1,7 @@
test('T24634',
- [extra_files(['hello.h', 'hello.c', 'Hello.hs', 'Main.hs']),
- req_interp,
- expect_broken(24634),
+ [extra_files(['hello_c.h', 'hello_c.c', 'Hello.hs', 'Main.hs']),
+ req_c,
+ req_th,
],
makefile_test,
- [''])
+ [])
=====================================
testsuite/tests/bytecode/T24634/hello.c → testsuite/tests/bytecode/T24634/hello_c.c
=====================================
@@ -1,4 +1,4 @@
-#include "hello.h"
+#include "hello_c.h"
int say_hello() {
return 42;
=====================================
testsuite/tests/bytecode/T24634/hello.h → testsuite/tests/bytecode/T24634/hello_c.h
=====================================
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64a16717711cf9f944fbf67a1354e480216f8a91
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64a16717711cf9f944fbf67a1354e480216f8a91
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/20240728/7da60a8e/attachment-0001.html>
More information about the ghc-commits
mailing list