| ... |
... |
@@ -20,7 +20,7 @@ module GHC.ByteCode.Binary ( |
|
20
|
20
|
import GHC.Prelude
|
|
21
|
21
|
|
|
22
|
22
|
import GHC.ByteCode.Types
|
|
23
|
|
-import GHC.Data.FastString
|
|
|
23
|
+import qualified GHC.Data.Word64Map.Strict as Word64Map
|
|
24
|
24
|
import GHC.Types.Name
|
|
25
|
25
|
import GHC.Types.Name.Cache
|
|
26
|
26
|
import GHC.Types.Name.Env
|
| ... |
... |
@@ -291,9 +291,8 @@ addBinNameWriter bh' = do |
|
291
|
291
|
| otherwise -> do
|
|
292
|
292
|
putByte bh 1
|
|
293
|
293
|
key <- getBinNameKey env_ref nm
|
|
294
|
|
- -- Delimit the OccName from the deterministic counter to keep the
|
|
295
|
|
- -- encoding injective, avoiding collisions like "foo1" vs "foo#1".
|
|
296
|
|
- put_ bh (occNameFS (occName nm) `appendFS` mkFastString ('#' : show key))
|
|
|
294
|
+ put_ bh $ occNameFS $ occName nm
|
|
|
295
|
+ put_ bh key
|
|
297
|
296
|
where
|
|
298
|
297
|
-- Find a deterministic key for local names. This
|
|
299
|
298
|
getBinNameKey ref name = do
|
| ... |
... |
@@ -304,7 +303,7 @@ addBinNameWriter bh' = do |
|
304
|
303
|
|
|
305
|
304
|
addBinNameReader :: NameCache -> ReadBinHandle -> IO ReadBinHandle
|
|
306
|
305
|
addBinNameReader nc bh' = do
|
|
307
|
|
- env_ref <- newIORef emptyOccEnv
|
|
|
306
|
+ env_ref <- newIORef Word64Map.empty
|
|
308
|
307
|
pure $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do
|
|
309
|
308
|
t <- getByte bh
|
|
310
|
309
|
case t of
|
| ... |
... |
@@ -313,15 +312,16 @@ addBinNameReader nc bh' = do |
|
313
|
312
|
pure $ BinName nm
|
|
314
|
313
|
1 -> do
|
|
315
|
314
|
occ <- mkVarOccFS <$> get bh
|
|
|
315
|
+ key <- get bh
|
|
316
|
316
|
-- We don't want to get a new unique from the NameCache each time we
|
|
317
|
317
|
-- see a name.
|
|
318
|
318
|
nm' <- unsafeInterleaveIO $ do
|
|
319
|
319
|
u <- takeUniqFromNameCache nc
|
|
320
|
320
|
evaluate $ mkInternalName u occ noSrcSpan
|
|
321
|
321
|
fmap BinName $ atomicModifyIORef' env_ref $ \env ->
|
|
322
|
|
- case lookupOccEnv env occ of
|
|
|
322
|
+ case Word64Map.lookup key env of
|
|
323
|
323
|
Just nm -> (env, nm)
|
|
324
|
|
- _ -> nm' `seq` (extendOccEnv env occ nm', nm')
|
|
|
324
|
+ _ -> nm' `seq` (Word64Map.insert key nm' env, nm')
|
|
325
|
325
|
_ -> panic "Binary BinName: invalid byte"
|
|
326
|
326
|
|
|
327
|
327
|
-- Note [Serializing Names in bytecode]
|