[Git][ghc/ghc][wip/T24634-oneshot-bytecode] WIP

[Cheng Shao (@TerrorJack)]

Cheng Shao pushed to branch wip/T24634-oneshot-bytecode at Glasgow Haskell Compiler / GHC


Commits:
3f0167c0 by Cheng Shao at 2024-07-01T18:46:45+00:00
WIP

- - - - -


3 changed files:

- compiler/GHC/Driver/Main.hs-boot
- − compiler/GHC/Driver/Make.hs-boot
- compiler/GHC/Linker/Deps.hs


Changes:

=====================================
compiler/GHC/Driver/Main.hs-boot
=====================================
@@ -1,15 +1,11 @@
 module GHC.Driver.Main where
 
 import GHC.Driver.Env
-import GHC.Iface.Recomp
 import GHC.Linker.Types
 import GHC.Prelude
 import GHC.Unit.Module.ModDetails
 import GHC.Unit.Module.ModIface
-import GHC.Unit.Module.ModSummary
 
 initModDetails :: HscEnv -> ModIface -> IO ModDetails
 
-loadByteCode :: ModIface -> ModSummary -> IO (MaybeValidated Linkable)
-
 initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable


=====================================
compiler/GHC/Driver/Make.hs-boot deleted
=====================================
@@ -1,33 +0,0 @@
-module GHC.Driver.Make where
-
-import qualified Data.Map as M
-import Data.Time.Clock
-import GHC.Data.StringBuffer
-import GHC.Driver.Env
-import GHC.Driver.Errors.Types
-import GHC.Prelude
-import GHC.Types.PkgQual
-import GHC.Types.SrcLoc
-import GHC.Unit.Home
-import GHC.Unit.Module.ModSummary
-import GHC.Unit.Types
-import Language.Haskell.Syntax
-
-data SummariseResult =
-        FoundInstantiation InstantiatedUnit
-      | FoundHomeWithError (UnitId, DriverMessages)
-      | FoundHome ModSummary
-      | External UnitId
-      | NotThere
-
-summariseModule
-          :: HscEnv
-          -> HomeUnit
-          -> M.Map (UnitId, FilePath) ModSummary
-          -- ^ Map of old summaries
-          -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
-          -> Located ModuleName -- Imported module to be summarised
-          -> PkgQual
-          -> Maybe (StringBuffer, UTCTime)
-          -> [ModuleName]               -- Modules to exclude
-          -> IO SummariseResult


=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -56,14 +56,10 @@ import qualified Data.Map as M
 import System.FilePath
 import System.Directory
 import GHC.Driver.Env
-import GHC.Tc.Utils.Monad
-import GHC.IfaceToCore
 import {-# SOURCE #-} GHC.Driver.Main
-import GHC.Unit.Module.ModSummary
-import {-# SOURCE #-} GHC.Driver.Make
-import GHC.Driver.Session
-import GHC.Types.PkgQual
 import Data.Time.Clock
+import GHC.Driver.Flags
+import GHC.Driver.Session
 
 
 data LinkDepsOpts = LinkDepsOpts
@@ -293,23 +289,28 @@ 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
-               Succeeded !iface <- ldLoadIface opts (text "makima") mod
-               !details <- initModDetails (ldHscEnv opts) iface
-               -- let home_unit = (ue_unitHomeUnit (homeUnitId_ (hsc_dflags (ldHscEnv opts))) (hsc_unit_env (ldHscEnv opts)))
-               -- !(FoundHome r) <- summariseModule (ldHscEnv opts) home_unit mempty NotBoot (noLoc (moduleName mod)) (ThisPkg (homeUnitId home_unit)) Nothing []
-               --- !bc_linkable <- loadByteCode iface undefined ;
-               t <- getCurrentTime
-               !bytecode_ul <- initWholeCoreBindings (ldHscEnv opts) iface details (LM t mod [CoreBindings $ WholeCoreBindings (fromJust $ mi_extra_decls iface) mod undefined]) ;
-               -- !mod_details <- initIfaceLoadModule (ldHscEnv opts) (mi_module iface) (typecheckIface iface) ;
-               putStrLn $ "[DEBUG] found " ++ show (moduleName mod)
-                -- ...and then find the linkable for it
-               pure bytecode_ul
-               -- 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
+                      details <- initModDetails hsc_env iface
+                      t <- getCurrentTime
+                      initWholeCoreBindings hsc_env iface details $ 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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0167c0c8af3c0b30dd00593c72868f86d7bdef

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0167c0c8af3c0b30dd00593c72868f86d7bdef
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/20240701/9a838657/attachment-0001.html>