aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index c26ab762..39de2395 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
@@ -276,7 +277,7 @@ putName BinSymbolTable{
data BinSymbolTable = BinSymbolTable {
bin_symtab_next :: !FastMutInt, -- The next index to use
- bin_symtab_map :: !(IORef (UniqFM (Int,Name)))
+ bin_symtab_map :: !(IORef (UniqFM Name (Int,Name)))
-- indexed by Name
}
@@ -286,24 +287,24 @@ putFastString BinDictionary { bin_dict_next = j_r,
bin_dict_map = out_r} bh f
= do
out <- readIORef out_r
- let unique = getUnique f
- case lookupUFM out unique of
+ let !unique = getUnique f
+ case lookupUFM_Directly out unique of
Just (j, _) -> put_ bh (fromIntegral j :: Word32)
Nothing -> do
j <- readFastMutInt j_r
put_ bh (fromIntegral j :: Word32)
writeFastMutInt j_r (j + 1)
- writeIORef out_r $! addToUFM out unique (j, f)
+ writeIORef out_r $! addToUFM_Directly out unique (j, f)
data BinDictionary = BinDictionary {
bin_dict_next :: !FastMutInt, -- The next index to use
- bin_dict_map :: !(IORef (UniqFM (Int,FastString)))
+ bin_dict_map :: !(IORef (UniqFM FastString (Int,FastString)))
-- indexed by FastString
}
-putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
+putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO ()
putSymbolTable bh next_off symtab = do
put_ bh next_off
let names = elems (array (0,next_off-1) (eltsUFM symtab))
@@ -346,7 +347,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
}
-serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
+serialiseName :: BinHandle -> Name -> UniqFM Name (Int,Name) -> IO ()
serialiseName bh name _ = do
let modu = nameModule name
put_ bh (moduleUnit modu, moduleName modu, nameOccName name)