| ... |
... |
@@ -48,6 +48,7 @@ import GHC.Utils.Logger |
|
48
|
48
|
import GHC.Linker.Types
|
|
49
|
49
|
import System.IO.Unsafe (unsafeInterleaveIO)
|
|
50
|
50
|
import GHC.Utils.Outputable
|
|
|
51
|
+import GHC.Types.Name.Env
|
|
51
|
52
|
|
|
52
|
53
|
{- Note [Overview of persistent bytecode]
|
|
53
|
54
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| ... |
... |
@@ -382,8 +383,13 @@ putViaBinName :: WriteBinHandle -> Name -> IO () |
|
382
|
383
|
putViaBinName bh nm = case findUserDataWriter Proxy bh of
|
|
383
|
384
|
BinaryWriter f -> f bh $ BinName nm
|
|
384
|
385
|
|
|
|
386
|
+data BytecodeNameEnv = ByteCodeNameEnv { _bytecode_next_id :: !Word64
|
|
|
387
|
+ , _bytecode_name_subst :: NameEnv Word64
|
|
|
388
|
+ }
|
|
|
389
|
+
|
|
385
|
390
|
addBinNameWriter :: WriteBinHandle -> IO WriteBinHandle
|
|
386
|
|
-addBinNameWriter bh' =
|
|
|
391
|
+addBinNameWriter bh' = do
|
|
|
392
|
+ env_ref <- newIORef (ByteCodeNameEnv 0 emptyNameEnv)
|
|
387
|
393
|
evaluate
|
|
388
|
394
|
$ flip addWriterToUserData bh'
|
|
389
|
395
|
$ BinaryWriter
|
| ... |
... |
@@ -394,10 +400,17 @@ addBinNameWriter bh' = |
|
394
|
400
|
put_ bh nm
|
|
395
|
401
|
| otherwise -> do
|
|
396
|
402
|
putByte bh 1
|
|
397
|
|
- put_ bh
|
|
398
|
|
- $ occNameFS (occName nm)
|
|
399
|
|
- `appendFS` mkFastString
|
|
400
|
|
- (show $ nameUnique nm)
|
|
|
403
|
+ key <- getBinNameKey env_ref nm
|
|
|
404
|
+ -- Delimit the OccName from the deterministic counter to keep the
|
|
|
405
|
+ -- encoding injective, avoiding collisions like "foo1" vs "foo#1".
|
|
|
406
|
+ put_ bh (occNameFS (occName nm) `appendFS` mkFastString ('#' : show key))
|
|
|
407
|
+ where
|
|
|
408
|
+ -- Find a deterministic key for local names. This
|
|
|
409
|
+ getBinNameKey ref name = do
|
|
|
410
|
+ atomicModifyIORef ref (\b@(ByteCodeNameEnv next subst) ->
|
|
|
411
|
+ case lookupNameEnv subst name of
|
|
|
412
|
+ Just idx -> (b, idx)
|
|
|
413
|
+ Nothing -> (ByteCodeNameEnv (next + 1) (extendNameEnv subst name next), next))
|
|
401
|
414
|
|
|
402
|
415
|
addBinNameReader :: HscEnv -> ReadBinHandle -> IO ReadBinHandle
|
|
403
|
416
|
addBinNameReader HscEnv {..} bh' = do
|
| ... |
... |
@@ -423,9 +436,6 @@ addBinNameReader HscEnv {..} bh' = do |
|
423
|
436
|
|
|
424
|
437
|
-- Note [Serializing Names in bytecode]
|
|
425
|
438
|
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
426
|
|
--- NOTE: This approach means that bytecode objects are not deterministic.
|
|
427
|
|
--- We need to revisit this in order to make the output deterministic.
|
|
428
|
|
---
|
|
429
|
439
|
-- The bytecode related types contain various Names which we need to
|
|
430
|
440
|
-- serialize. Unfortunately, we can't directly use the Binary instance
|
|
431
|
441
|
-- of Name: it is only meant to be used for serializing external Names
|
| ... |
... |
@@ -433,9 +443,8 @@ addBinNameReader HscEnv {..} bh' = do |
|
433
|
443
|
--
|
|
434
|
444
|
-- We also need to maintain the invariant that: any pair of internal
|
|
435
|
445
|
-- Names with equal/different uniques must also be deserialized to
|
|
436
|
|
--- have the same equality. So normally uniques aren't supposed to be
|
|
437
|
|
--- serialized, but for this invariant to work, we do append uniques to
|
|
438
|
|
--- OccNames of internal Names, so that they can be uniquely identified
|
|
439
|
|
--- by OccName alone. When deserializing, we check a global cached
|
|
440
|
|
--- mapping from OccName to Unique, and create the real Name with the
|
|
441
|
|
--- right Unique if it's already deserialized at least once. |
|
|
446
|
+-- have the same equality. Therefore when we write the names to the interface, we
|
|
|
447
|
+-- use an incrementing counter to give each local name it's own unique number. A substitution
|
|
|
448
|
+-- is maintained to give each occurence of the Name the same unique key. When the interface
|
|
|
449
|
+-- is read, a reverse mapping is used from these unique keys to a Name.
|
|
|
450
|
+-- |