[Git][ghc/ghc][wip/mpickering-hannes] Add created interface sharing

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Wed Mar 20 09:40:23 UTC 2024



Matthew Pickering pushed to branch wip/mpickering-hannes at Glasgow Haskell Compiler / GHC


Commits:
0974da17 by Matthew Pickering at 2024-03-20T09:40:10+00:00
Add created interface sharing

- - - - -


4 changed files:

- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Utils/Binary.hs


Changes:

=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -160,7 +160,7 @@ import GHC.JS.Syntax
 
 import GHC.IfaceToCore  ( typecheckIface, typecheckWholeCoreBindings )
 
-import GHC.Iface.Load   ( ifaceStats, writeIface )
+import GHC.Iface.Load   ( ifaceStats, writeIface , pprModIface )
 import GHC.Iface.Make
 import GHC.Iface.Recomp
 import GHC.Iface.Tidy
@@ -168,6 +168,8 @@ import GHC.Iface.Ext.Ast    ( mkHieFile )
 import GHC.Iface.Ext.Types  ( getAsts, hie_asts, hie_module )
 import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result)
 import GHC.Iface.Ext.Debug  ( diffFile, validateScopes )
+import GHC.Iface.Binary
+import GHC.Utils.Binary
 
 import GHC.Core
 import GHC.Core.Lint.Interactive ( interactiveInScope )
@@ -239,7 +241,7 @@ import GHC.Types.IPE
 import GHC.Types.SourceFile
 import GHC.Types.SrcLoc
 import GHC.Types.Name
-import GHC.Types.Name.Cache ( initNameCache )
+import GHC.Types.Name.Cache ( initNameCache, NameCache )
 import GHC.Types.Name.Reader
 import GHC.Types.Name.Ppr
 import GHC.Types.TyThing
@@ -962,12 +964,25 @@ loadByteCode iface mod_sum = do
 -- Compilers
 --------------------------------------------------------------
 
+shareIface :: NameCache -> ModIface -> IO ModIface
+shareIface nc mi = do
+  bh <- openBinMem (1024 * 1024)
+  -- Todo, not quite right (See ext fields etc)
+  start <- tellBin @() bh
+  putWithUserData QuietBinIFace bh mi
+  seekBin bh start
+  res <- getWithUserData nc bh
+  let resiface = res { mi_src_hash = mi_src_hash mi }
+  forceModIface  resiface
+  return resiface
+
 
 -- Knot tying!  See Note [Knot-tying typecheckIface]
 -- See Note [ModDetails and --make mode]
-initModDetails :: HscEnv -> ModIface -> IO ModDetails
-initModDetails hsc_env iface =
-  fixIO $ \details' -> do
+initModDetails :: HscEnv -> ModIface -> IO (ModIface, ModDetails)
+initModDetails hsc_env raw_iface = do
+  iface <- shareIface (hsc_NC hsc_env) raw_iface
+  d <- fixIO $ \details' -> do
     let act hpt  = addToHpt hpt (moduleName $ mi_module iface)
                                 (HomeModInfo iface details' emptyHomeModInfoLinkable)
     let !hsc_env' = hscUpdateHPT act hsc_env
@@ -976,6 +991,7 @@ initModDetails hsc_env iface =
     -- any further typechecking.  It's much more useful
     -- in make mode, since this HMI will go into the HPT.
     genModDetails hsc_env' iface
+  return (iface, d)
 
 -- Hydrate any WholeCoreBindings linkables into BCOs
 initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable
@@ -987,16 +1003,16 @@ initWholeCoreBindings hsc_env mod_iface details (LM utc_time this_mod uls) = LM
         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 }
-        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 []
         -- 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 []
                   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


=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -244,9 +244,9 @@ compileOne' mHscMessage
    let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, upd_summary, status)
    (iface, linkable) <- runPipeline (hsc_hooks plugin_hsc_env) pipeline
    -- See Note [ModDetails and --make mode]
-   details <- initModDetails plugin_hsc_env iface
-   linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable)
-   return $! HomeModInfo iface details (linkable { homeMod_bytecode = linkable' })
+   (shared_iface, details) <- initModDetails plugin_hsc_env iface
+   linkable' <- traverse (initWholeCoreBindings plugin_hsc_env shared_iface details) (homeMod_bytecode linkable)
+   return $! HomeModInfo shared_iface details (linkable { homeMod_bytecode = linkable' })
 
  where lcl_dflags  = ms_hspp_opts summary
        location    = ms_location summary


=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -4,7 +4,7 @@
 --  (c) The University of Glasgow 2002-2006
 --
 
-{-# OPTIONS_GHC -O0 -ddump-simpl -ddump-to-file #-}
+{-# OPTIONS_GHC -O2 -ddump-simpl -ddump-to-file #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
 


=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1267,6 +1267,7 @@ getGenericSymtab :: Binary a => SymbolTable a
               -> BinHandle -> IO a
 getGenericSymtab symtab bh = do
   i :: Word32 <- get bh
+  pprTraceM "getting" (ppr (bounds symtab, i))
   return $! symtab ! fromIntegral i
 
 data SomeCache = forall a . SomeCache (TypeRep, CachedBinary a)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0974da17b15d2b9dd4176148096e95ac24f3a8fa

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0974da17b15d2b9dd4176148096e95ac24f3a8fa
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/20240320/8359b66a/attachment-0001.html>


More information about the ghc-commits mailing list