1
1
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
2
+ {-# LANGUAGE BangPatterns #-}
2
3
{-# OPTIONS_GHC -fno-warn-orphans #-}
3
4
-----------------------------------------------------------------------------
4
5
-- |
@@ -276,7 +277,7 @@ putName BinSymbolTable{
276
277
277
278
data BinSymbolTable = BinSymbolTable {
278
279
bin_symtab_next :: ! FastMutInt , -- The next index to use
279
- bin_symtab_map :: ! (IORef (UniqFM (Int ,Name )))
280
+ bin_symtab_map :: ! (IORef (UniqFM Name (Int ,Name )))
280
281
-- indexed by Name
281
282
}
282
283
@@ -286,24 +287,24 @@ putFastString BinDictionary { bin_dict_next = j_r,
286
287
bin_dict_map = out_r} bh f
287
288
= do
288
289
out <- readIORef out_r
289
- let unique = getUnique f
290
- case lookupUFM out unique of
290
+ let ! unique = getUnique f
291
+ case lookupUFM_Directly out unique of
291
292
Just (j, _) -> put_ bh (fromIntegral j :: Word32 )
292
293
Nothing -> do
293
294
j <- readFastMutInt j_r
294
295
put_ bh (fromIntegral j :: Word32 )
295
296
writeFastMutInt j_r (j + 1 )
296
- writeIORef out_r $! addToUFM out unique (j, f)
297
+ writeIORef out_r $! addToUFM_Directly out unique (j, f)
297
298
298
299
299
300
data BinDictionary = BinDictionary {
300
301
bin_dict_next :: ! FastMutInt , -- The next index to use
301
- bin_dict_map :: ! (IORef (UniqFM (Int ,FastString )))
302
+ bin_dict_map :: ! (IORef (UniqFM FastString (Int ,FastString )))
302
303
-- indexed by FastString
303
304
}
304
305
305
306
306
- putSymbolTable :: BinHandle -> Int -> UniqFM (Int ,Name ) -> IO ()
307
+ putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int ,Name ) -> IO ()
307
308
putSymbolTable bh next_off symtab = do
308
309
put_ bh next_off
309
310
let names = elems (array (0 ,next_off- 1 ) (eltsUFM symtab))
@@ -346,7 +347,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
346
347
}
347
348
348
349
349
- serialiseName :: BinHandle -> Name -> UniqFM (Int ,Name ) -> IO ()
350
+ serialiseName :: BinHandle -> Name -> UniqFM Name (Int ,Name ) -> IO ()
350
351
serialiseName bh name _ = do
351
352
let modu = nameModule name
352
353
put_ bh (moduleUnit modu, moduleName modu, nameOccName name)
0 commit comments