From 075067254fc30ef56bad67ac65dd3c5f4101f8fa Mon Sep 17 00:00:00 2001 From: Andreas Klebinger Date: Wed, 24 Jun 2020 16:58:25 +0200 Subject: Update for UniqFM changes. --- haddock-api/src/Haddock/InterfaceFile.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) (limited to 'haddock-api/src') 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) -- cgit v1.2.3