diff options
Diffstat (limited to 'src/Haddock/InterfaceFile.hs')
-rw-r--r-- | src/Haddock/InterfaceFile.hs | 48 |
1 files changed, 26 insertions, 22 deletions
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index fcf7fe65..970093df 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -22,24 +22,25 @@ module Haddock.InterfaceFile ( import Haddock.Types import Haddock.Utils hiding (out) -import Data.List -import Data.Word +import Control.Monad import Data.Array import Data.IORef +import Data.List import qualified Data.Map as Map import Data.Map (Map) +import Data.Word -import GHC hiding (NoLink) -import Binary import BinIface (getSymtabName, getDictFastString) -import Name -import UniqSupply -import UniqFM -import IfaceEnv -import HscTypes -import GhcMonad (withSession) +import Binary import FastMutInt import FastString +import GHC hiding (NoLink) +import GhcMonad (withSession) +import HscTypes +import IfaceEnv +import Name +import UniqFM +import UniqSupply import Unique @@ -65,13 +66,13 @@ binaryInterfaceMagic = 0xD0Cface -- we version our interface files accordingly. binaryInterfaceVersion :: Word16 #if __GLASGOW_HASKELL__ == 702 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 703 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 704 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 705 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #else #error Unknown GHC version #endif @@ -110,8 +111,8 @@ writeInterfaceFile filename iface = do bin_dict_map = dict_map_ref } -- put the main thing - bh <- return $ setUserData bh0 $ newWriteState (putName bin_symtab) - (putFastString bin_dict) + let bh = setUserData bh0 $ newWriteState (putName bin_symtab) + (putFastString bin_dict) put_ bh iface -- write the symtab pointer at the front of the file @@ -295,12 +296,9 @@ putSymbolTable bh next_off symtab = do getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name) getSymbolTable bh namecache = do sz <- get bh - od_names <- sequence (replicate sz (get bh)) - let - arr = listArray (0,sz-1) names - (namecache', names) = - mapAccumR (fromOnDiskName arr) namecache od_names - -- + od_names <- replicateM sz (get bh) + let arr = listArray (0,sz-1) names + (namecache', names) = mapAccumR (fromOnDiskName arr) namecache od_names return (namecache', arr) @@ -469,6 +467,9 @@ instance (Binary id) => Binary (Doc id) where put_ bh (DocIdentifierUnchecked x) = do putByte bh 16 put_ bh x + put_ bh (DocWarning ag) = do + putByte bh 17 + put_ bh ag get bh = do h <- getByte bh case h of @@ -523,6 +524,9 @@ instance (Binary id) => Binary (Doc id) where 16 -> do x <- get bh return (DocIdentifierUnchecked x) + 17 -> do + ag <- get bh + return (DocWarning ag) _ -> fail "invalid binary data found" |