[Git][ghc/ghc][wip/T24634-oneshot-bytecode] add new EPS field to avoid having to create ModDetails badly

Torsten Schmits (@torsten.schmits) gitlab at gitlab.haskell.org
Thu Aug 1 18:05:07 UTC 2024



Torsten Schmits pushed to branch wip/T24634-oneshot-bytecode at Glasgow Haskell Compiler / GHC


Commits:
8affc8a4 by Torsten Schmits at 2024-08-01T20:04:46+02:00
add new EPS field to avoid having to create ModDetails badly

- - - - -


3 changed files:

- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Unit/External.hs


Changes:

=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -277,7 +277,8 @@ import GHC.SysTools (initSysTools)
 import GHC.SysTools.BaseDir (findTopDir)
 
 import Data.Data hiding (Fixity, TyCon)
-import Data.List        ( nub, isPrefixOf, partition )
+import Data.Foldable (fold)
+import Data.List ( nub, isPrefixOf, partition )
 import qualified Data.List.NonEmpty as NE
 import Control.Monad
 import Data.IORef
@@ -1002,10 +1003,10 @@ initWcbWithTcEnv ::
   HscEnv ->
   HscEnv ->
   ModIface ->
-  ModDetails ->
+  TypeEnv ->
   Linkable ->
   IO Linkable
-initWcbWithTcEnv tc_env hsc_env mod_iface details (LM utc_time this_mod uls) = do
+initWcbWithTcEnv tc_env hsc_env mod_iface type_env (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
@@ -1024,15 +1025,15 @@ initWcbWithTcEnv tc_env hsc_env mod_iface details (LM utc_time this_mod uls) = d
       -- the laziness is OK because generateByteCode just depends on things already loaded
       -- in the interface file.
       LoadedBCOs <$> (unsafeInterleaveIO $ do
-        type_env <- newIORef (md_types details)
+        kv <- newIORef type_env
         let
           tc_hsc_env_with_kv = tc_env {
             hsc_type_env_vars =
-              knotVarsFromModuleEnv (mkModuleEnv [(this_mod, type_env)])
+              knotVarsFromModuleEnv (mkModuleEnv [(this_mod, kv)])
           }
         core_binds <- initIfaceCheck (text "l") tc_hsc_env_with_kv $
-                      typecheckWholeCoreBindings type_env fi
-        let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons (md_types details)) NoStubs Nothing []
+                      typecheckWholeCoreBindings kv fi
+        let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons type_env) NoStubs Nothing []
         trace_if (hsc_logger hsc_env) (text "Generating ByteCode for" <+> ppr this_mod)
         generateByteCode hsc_env cgi_guts (wcb_mod_location fi))
     go ul = return ul
@@ -1041,15 +1042,15 @@ initWcbWithTcEnv tc_env hsc_env mod_iface details (LM utc_time this_mod uls) = d
 -- can obtain a 'ModDetails'.
 initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
 initWholeCoreBindings hsc_env iface details =
-  initWcbWithTcEnv (add_iface_to_hpt iface details hsc_env) hsc_env iface details
+  initWcbWithTcEnv (add_iface_to_hpt iface details hsc_env) hsc_env iface (md_types details)
 
 -- | Hydrate core bindings for a module in the external package state.
 -- This is used for home modules as well when compiling in oneshot mode.
 initWholeCoreBindingsEps :: HscEnv -> ModIface -> Linkable -> IO Linkable
 initWholeCoreBindingsEps hsc_env iface lnk = do
-  -- details <- genModDetails hsc_env iface
-  details <- initIfaceLoadModule hsc_env (mi_module iface) (typecheckIface iface)
-  initWcbWithTcEnv hsc_env hsc_env iface details lnk
+  eps <- hscEPS hsc_env
+  let type_env = fold (lookupModuleEnv (eps_PTT eps) (mi_module iface))
+  initWcbWithTcEnv hsc_env hsc_env iface type_env lnk
 
 
 {-


=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -513,6 +513,11 @@ 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)
@@ -531,6 +536,8 @@ loadInterface doc_str mod from
                 eps {
                   eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
                   eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
+                  eps_PTT =
+                    extendModuleEnv (eps_PTT eps) mod (mkNameEnv new_eps_decls),
                   eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
                                                         new_eps_rules,
                   eps_complete_matches


=====================================
compiler/GHC/Unit/External.hs
=====================================
@@ -45,6 +45,8 @@ type PackageCompleteMatches  = CompleteMatches
 type PackageIfaceTable = ModuleEnv ModIface
         -- Domain = modules in the imported packages
 
+type PackageTypeTable = ModuleEnv TypeEnv
+
 -- | Constructs an empty PackageIfaceTable
 emptyPackageIfaceTable :: PackageIfaceTable
 emptyPackageIfaceTable = emptyModuleEnv
@@ -68,6 +70,7 @@ initExternalPackageState = EPS
   , eps_PIT              = emptyPackageIfaceTable
   , eps_free_holes       = emptyInstalledModuleEnv
   , eps_PTE              = emptyTypeEnv
+  , eps_PTT              = emptyModuleEnv
   , eps_inst_env         = emptyInstEnv
   , eps_fam_inst_env     = emptyFamInstEnv
   , eps_rule_base        = mkRuleBase builtinRules
@@ -139,6 +142,8 @@ data ExternalPackageState
                 -- interface files we have sucked in. The domain of
                 -- the mapping is external-package modules
 
+        eps_PTT :: !PackageTypeTable,
+
         eps_inst_env     :: !PackageInstEnv,   -- ^ The total 'InstEnv' accumulated
                                                -- from all the external-package modules
         eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8affc8a4c4794b4be86d21829eff91b52216eb57

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8affc8a4c4794b4be86d21829eff91b52216eb57
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/20240801/142e94c8/attachment-0001.html>


More information about the ghc-commits mailing list