[Git][ghc/ghc][wip/bytecode-serialize] WIP

[Cheng Shao (@TerrorJack)]

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


Commits:
178bc0d4 by Cheng Shao at 2025-02-15T03:58:38+00:00
WIP

- - - - -


1 changed file:

- compiler/GHC/ByteCode/Serialize.hs


Changes:

=====================================
compiler/GHC/ByteCode/Serialize.hs
=====================================
@@ -47,19 +47,20 @@ testBinByteCode hsc_env cbc at CompiledByteCode {..}
 
 roundtripBinByteCode :: HscEnv -> FilePath -> CompiledByteCode -> IO CompiledByteCode
 roundtripBinByteCode hsc_env f cbc = do
-  writeBinByteCode hsc_env f cbc
-  readBinByteCode hsc_env f
+  env_ref <- newIORef emptyOccEnv
+  writeBinByteCode hsc_env env_ref f cbc
+  readBinByteCode hsc_env env_ref f
 
-readBinByteCode :: HscEnv -> FilePath -> IO CompiledByteCode
-readBinByteCode hsc_env f = do
+readBinByteCode :: HscEnv -> IORef (OccEnv Name) -> FilePath -> IO CompiledByteCode
+readBinByteCode hsc_env env_ref f = do
   bh' <- readBinMem f
-  bh <- addSerializableNameReader hsc_env bh'
+  bh <- addSerializableNameReader hsc_env env_ref bh'
   getWithUserData (hsc_NC hsc_env) bh
 
-writeBinByteCode :: HscEnv -> FilePath -> CompiledByteCode -> IO ()
-writeBinByteCode hsc_env f cbc = do
+writeBinByteCode :: HscEnv -> IORef (OccEnv Name) -> FilePath -> CompiledByteCode -> IO ()
+writeBinByteCode hsc_env env_ref f cbc = do
   bh' <- openBinMem (1024*1024)
-  bh <- addSerializableNameWriter hsc_env bh'
+  bh <- addSerializableNameWriter hsc_env env_ref bh'
   putWithUserData QuietBinIFace NormalCompression bh cbc
   writeBinMem bh f
 
@@ -179,8 +180,8 @@ putViaSerializableName :: WriteBinHandle -> Name -> IO ()
 putViaSerializableName bh nm = case findUserDataWriter Proxy bh of
   BinaryWriter f -> f bh $ SerializableName nm
 
-addSerializableNameWriter :: HscEnv -> WriteBinHandle -> IO WriteBinHandle
-addSerializableNameWriter HscEnv {..} bh' = do
+addSerializableNameWriter :: HscEnv -> IORef (OccEnv Name) -> WriteBinHandle -> IO WriteBinHandle
+addSerializableNameWriter HscEnv {..} env_ref bh' = do
   nc <- evaluate hsc_NC
   evaluate
     $ flip addWriterToUserData bh'
@@ -201,11 +202,11 @@ addSerializableNameWriter HscEnv {..} bh' = do
           | otherwise -> do
               putByte bh 1
               put_ bh $ occName nm
+              atomicModifyIORef' env_ref $ \env -> (extendOccEnv env (occName nm) nm, ())
 
-addSerializableNameReader :: HscEnv -> ReadBinHandle -> IO ReadBinHandle
-addSerializableNameReader HscEnv {..} bh' = do
+addSerializableNameReader :: HscEnv -> IORef (OccEnv Name) -> ReadBinHandle -> IO ReadBinHandle
+addSerializableNameReader HscEnv {..} env_ref bh' = do
   nc <- evaluate hsc_NC
-  env_ref <- newIORef emptyOccEnv
   evaluate $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do
     t <- getByte bh
     case t of



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/178bc0d4c5a33d5e12cabeb7c9e186904e3ea42c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/178bc0d4c5a33d5e12cabeb7c9e186904e3ea42c
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/20250214/18bdd825/attachment-0001.html>