diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2020-06-24 16:58:25 +0200 | 
|---|---|---|
| committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2020-07-02 17:44:18 +0200 | 
| commit | 075067254fc30ef56bad67ac65dd3c5f4101f8fa (patch) | |
| tree | a3a62bfa170b0368aff4f68c66b26822e4886b4c | |
| parent | 9bd65ee47a43529af2ad8e350fdd0c372bc5964c (diff) | |
Update for UniqFM changes.
| -rw-r--r-- | haddock-api/src/Haddock/InterfaceFile.hs | 15 | 
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)  | 
