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

Cheng Shao (@TerrorJack) gitlab at gitlab.haskell.org
Tue Jun 25 01:14:25 UTC 2024



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


Commits:
0b8fee54 by Cheng Shao at 2024-06-25T01:14:15+00:00
WIP: oneshot bytecode support

- - - - -


6 changed files:

- compiler/GHC/Driver/Main.hs
- + compiler/GHC/Driver/Main.hs-boot
- + compiler/GHC/Driver/Make.hs-boot
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs


Changes:

=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -106,6 +106,7 @@ module GHC.Driver.Main
     , showModuleIndex
     , hscAddSptEntries
     , writeInterfaceOnlyMode
+    , loadByteCode
     ) where
 
 import GHC.Prelude


=====================================
compiler/GHC/Driver/Main.hs-boot
=====================================
@@ -0,0 +1,15 @@
+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
=====================================
@@ -0,0 +1,33 @@
+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/Iface/Load.hs
=====================================
@@ -516,11 +516,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/Linker/Deps.hs
=====================================
@@ -55,6 +55,15 @@ 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
 
 
 data LinkDepsOpts = LinkDepsOpts
@@ -70,6 +79,7 @@ data LinkDepsOpts = LinkDepsOpts
   , ldWays        :: !Ways                          -- ^ Enabled ways
   , ldLoadIface   :: SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface)
                                                     -- ^ Interface loader function
+  , ldHscEnv      :: !HscEnv
   }
 
 data LinkDeps = LinkDeps
@@ -283,13 +293,23 @@ 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 {
+            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
-               mb_lnk <- findObjectLinkableMaybe mod loc ;
-               case mb_lnk of {
-                  Nothing  -> no_obj mod ;
-                  Just lnk -> adjust_linkable lnk
-              }}
+               pure bytecode_ul
+               -- mb_lnk <- findObjectLinkableMaybe mod loc
+               -- case mb_lnk of {
+               --   Nothing  -> no_obj mod ;
+               --   Just lnk -> adjust_linkable lnk
+               --}
 
             adjust_linkable lnk
                 | Just new_osuf <- maybe_normal_osuf = do


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b8fee54d7fdd1f4884e7a27601218c437b8cd73

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b8fee54d7fdd1f4884e7a27601218c437b8cd73
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/20240624/21810ae4/attachment-0001.html>


More information about the ghc-commits mailing list