| ... |
... |
@@ -50,7 +50,9 @@ import GHC.Iface.Type (IfaceType, putIfaceType) |
|
50
|
50
|
import GHC.Types.Name.Cache
|
|
51
|
51
|
import GHC.Types.Unique
|
|
52
|
52
|
import GHC.Types.Unique.FM
|
|
|
53
|
+import GHC.Types.Name.Env
|
|
53
|
54
|
import GHC.Unit.State
|
|
|
55
|
+import GHC.Unit.Module.Env
|
|
54
|
56
|
import GHC.Utils.Binary
|
|
55
|
57
|
import Haddock.Types
|
|
56
|
58
|
import Text.ParserCombinators.ReadP (readP_to_S)
|
| ... |
... |
@@ -139,7 +141,7 @@ binaryInterfaceMagic = 0xD0Cface |
|
139
|
141
|
--
|
|
140
|
142
|
binaryInterfaceVersion :: Word16
|
|
141
|
143
|
#if MIN_VERSION_ghc(9,11,0) && !MIN_VERSION_ghc(10,2,0)
|
|
142
|
|
-binaryInterfaceVersion = 46
|
|
|
144
|
+binaryInterfaceVersion = 47
|
|
143
|
145
|
|
|
144
|
146
|
binaryInterfaceVersionCompatibility :: [Word16]
|
|
145
|
147
|
binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
|
| ... |
... |
@@ -170,7 +172,7 @@ writeInterfaceFile filename iface = do |
|
170
|
172
|
|
|
171
|
173
|
-- Make some intial state
|
|
172
|
174
|
symtab_next <- newFastMutInt 0
|
|
173
|
|
- symtab_map <- newIORef emptyUFM
|
|
|
175
|
+ symtab_map <- newIORef emptyModuleEnv
|
|
174
|
176
|
let bin_symtab =
|
|
175
|
177
|
BinSymbolTable
|
|
176
|
178
|
{ bin_symtab_next = symtab_next
|
| ... |
... |
@@ -269,18 +271,31 @@ putName |
|
269
|
271
|
name =
|
|
270
|
272
|
do
|
|
271
|
273
|
symtab_map <- readIORef symtab_map_ref
|
|
272
|
|
- case lookupUFM symtab_map name of
|
|
273
|
|
- Just (off, _) -> put_ bh (fromIntegral off :: Word32)
|
|
|
274
|
+ let mod' = nameModule name
|
|
|
275
|
+ case lookupModuleEnv symtab_map mod' of
|
|
|
276
|
+ Just nm_env ->
|
|
|
277
|
+ case lookupDNameEnv nm_env name of
|
|
|
278
|
+ Just (off, _) -> put_ bh (fromIntegral off :: Word32)
|
|
|
279
|
+ Nothing -> do
|
|
|
280
|
+ off <- freshIndex
|
|
|
281
|
+ writeIORef symtab_map_ref $!
|
|
|
282
|
+ extendModuleEnv symtab_map mod' (extendDNameEnv nm_env name (off, name))
|
|
|
283
|
+ put_ bh (fromIntegral off :: Word32)
|
|
274
|
284
|
Nothing -> do
|
|
275
|
|
- off <- readFastMutInt symtab_next
|
|
276
|
|
- writeFastMutInt symtab_next (off + 1)
|
|
|
285
|
+ off <- freshIndex
|
|
277
|
286
|
writeIORef symtab_map_ref $!
|
|
278
|
|
- addToUFM symtab_map name (off, name)
|
|
|
287
|
+ extendModuleEnv symtab_map mod' (extendDNameEnv emptyDNameEnv name (off, name))
|
|
279
|
288
|
put_ bh (fromIntegral off :: Word32)
|
|
|
289
|
+ where
|
|
|
290
|
+ freshIndex :: IO Int
|
|
|
291
|
+ freshIndex = do
|
|
|
292
|
+ off <- readFastMutInt symtab_next
|
|
|
293
|
+ writeFastMutInt symtab_next (off + 1)
|
|
|
294
|
+ return off
|
|
280
|
295
|
|
|
281
|
296
|
data BinSymbolTable = BinSymbolTable
|
|
282
|
297
|
{ bin_symtab_next :: !FastMutInt -- The next index to use
|
|
283
|
|
- , bin_symtab_map :: !(IORef (UniqFM Name (Int, Name)))
|
|
|
298
|
+ , bin_symtab_map :: !(IORef (ModuleEnv (DNameEnv (Int, Name))))
|
|
284
|
299
|
-- indexed by Name
|
|
285
|
300
|
}
|
|
286
|
301
|
|