[Git][ghc/ghc][wip/T24634-oneshot-bytecode] 3 commits: use the EPS type env when typechecking core bindings in oneshot mode
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Sun Jul 28 11:52:04 UTC 2024
Torsten Schmits pushed to branch wip/T24634-oneshot-bytecode at Glasgow Haskell Compiler / GHC
Commits:
47f8895d by Torsten Schmits at 2024-07-28T13:51:51+02:00
use the EPS type env when typechecking core bindings in oneshot mode
- - - - -
c403fde2 by Torsten Schmits at 2024-07-28T13:51:51+02:00
avoid case-insensitivity clobber in test
- - - - -
4d5349bd by Torsten Schmits at 2024-07-28T13:51:51+02:00
compile exe in test with core bindings to avoid recompilation of Hello
- - - - -
9 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Main.hs-boot
- compiler/GHC/Linker/Deps.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
@@ -992,9 +993,15 @@ 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) = do
+-- | 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
@@ -1008,22 +1015,48 @@ initWholeCoreBindings hsc_env mod_iface details (LM utc_time this_mod uls) = do
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
- 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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Driver/Main.hs-boot
=====================================
@@ -3,9 +3,6 @@ module GHC.Driver.Main where
import GHC.Driver.Env
import GHC.Linker.Types
import GHC.Prelude
-import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModIface
-initModDetails :: HscEnv -> ModIface -> IO ModDetails
-
-initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
+initWholeCoreBindingsEps :: HscEnv -> ModIface -> Linkable -> IO Linkable
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -293,9 +293,8 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
Succeeded iface <- ldLoadIface opts (text "makima") mod
case mi_extra_decls iface of
Just extra_decls -> do
- details <- initModDetails hsc_env iface
t <- getCurrentTime
- initWholeCoreBindings hsc_env iface details $ LM t mod [CoreBindings $ WholeCoreBindings extra_decls mod undefined]
+ initWholeCoreBindingsEps hsc_env iface $ LM t mod [CoreBindings $ WholeCoreBindings extra_decls mod undefined]
_ -> fallback_no_bytecode loc mod
| otherwise = fallback_no_bytecode loc mod
=====================================
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
=====================================
@@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
T24634:
- $(TEST_HC) -c -dynamic hello.c -o hello.o
+ $(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
=====================================
@@ -1,3 +1,3 @@
-[2 of 3] Compiling Main ( Main.hs, Main.o )
+[2 of 3] Compiling Main ( Main.hs, Main.o, interpreted )
[3 of 3] Linking Main
42
=====================================
testsuite/tests/bytecode/T24634/all.T
=====================================
@@ -1,8 +1,7 @@
test('T24634',
- [extra_files(['hello.h', 'hello.c', 'Hello.hs', 'Main.hs']),
+ [extra_files(['hello_c.h', 'hello_c.c', 'Hello.hs', 'Main.hs']),
req_c,
req_th,
- ignore_stderr
],
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/-/compare/26e5520db301b01225f36959673af5c9eec24992...4d5349bd5721aff30f0c2a1d76c622abb1e71247
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26e5520db301b01225f36959673af5c9eec24992...4d5349bd5721aff30f0c2a1d76c622abb1e71247
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/64834b87/attachment-0001.html>
More information about the ghc-commits
mailing list