    {-# LANGUAGE CPP, ScopedTypeVariables #-}
    --
    -- (c) The University of Glasgow 2002
    --
    -- Binary I/O library, with special tweaks for GHC
    --
    -- Based on the nhc98 Binary library, which is copyright
    -- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.
    -- Under the terms of the license for that software, we must tell you
    -- where you can obtain the original version of the Binary library, namely
    --     http://www.cs.york.ac.uk/fp/nhc98/

    module Binary
      ( {-type-}  Bin,
        {-class-} Binary(..),
        {-type-}  BinHandle,

       openBinIO, openBinIO_,
       openBinMem,
    --   closeBin,

       seekBin,
       tellBin,
       castBin,

       writeBinMem,
       readBinMem,

       isEOFBin,

       -- for writing instances:
       putByte,
       getByte,
       putSharedString,
       getSharedString,

       -- lazy Bin I/O
       lazyGet,
       lazyPut,

    #if __GLASGOW_HASKELL__<610
       -- GHC only:
       ByteArray(..),
       getByteArray,
       putByteArray,
    #endif

       getBinFileWithDict,  -- :: Binary a => FilePath -> IO a
       putBinFileWithDict,  -- :: Binary a => FilePath -> ModuleName -> a -> IO ()

      ) where

    #if __GLASGOW_HASKELL__>=604
    #include "ghcconfig.h"
    #else
    #include "config.h"
    #endif

    import FastMutInt

    import Map (Map)
    import qualified Map as Map
    #if __GLASGOW_HASKELL__>=602
    # if __GLASGOW_HASKELL__>=707
    import Data.HashTable.Class as HashTable
                  (HashTable)
    import Data.HashTable.IO as HashTable
                  (BasicHashTable, toList, new, insert, lookup)
    # else
    import Data.HashTable as HashTable
    # endif
    #endif
    import Data.Array.IO
    import Data.Array
    import Data.Bits
    import Data.Int
    import Data.Word
    import Data.IORef
    import Data.Char                ( ord, chr )
    import Data.Array.Base          ( unsafeRead, unsafeWrite )
    import Control.Monad            ( when, liftM )
    import System.IO as IO
    import System.IO.Unsafe         ( unsafeInterleaveIO )
    import System.IO.Error          ( mkIOError, eofErrorType )
    import GHC.Real                 ( Ratio(..) )
    import GHC.Exts
    # if __GLASGOW_HASKELL__>=612
    import GHC.IO     (IO(IO))
    #else
    import GHC.IOBase (IO(IO))
    #endif
    import GHC.Word                 ( Word8(..) )
    # if __GLASGOW_HASKELL__<602
    import GHC.Handle               ( hSetBinaryMode )
    # endif
    -- for debug
    import System.CPUTime           (getCPUTime)
    import Numeric                  (showFFloat)

    #define SIZEOF_HSINT SIZEOF_VOID_P

    type BinArray = IOUArray Int Word8

    ---------------------------------------------------------------
    --              BinHandle
    ---------------------------------------------------------------

    data BinHandle
      = BinMem {            -- binary data stored in an unboxed array
         BinHandle -> UserData
    bh_usr :: UserData,        -- sigh, need parameterized modules :-)
         BinHandle -> FastMutInt
    off_r :: !FastMutInt,              -- the current offset
         BinHandle -> FastMutInt
    sz_r  :: !FastMutInt,              -- size of the array (cached)
         BinHandle -> IORef BinArray
    arr_r :: !(IORef BinArray)         -- the array (bounds: (0,size-1))
        }
            -- XXX: should really store a "high water mark" for dumping out
            -- the binary data to a file.

      | BinIO {             -- binary data stored in a file
         bh_usr :: UserData,
         off_r :: !FastMutInt,              -- the current offset (cached)
         BinHandle -> Handle
    hdl   :: !IO.Handle                -- the file handle (must be seekable)
       }
            -- cache the file ptr in BinIO; using hTell is too expensive
            -- to call repeatedly.  If anyone else is modifying this Handle
            -- at the same time, we'll be screwed.

    getUserData :: BinHandle -> UserData
    getUserData :: BinHandle -> UserData
    getUserData BinHandle
    bh = BinHandle -> UserData
    bh_usr BinHandle
    bh

    setUserData :: BinHandle -> UserData -> BinHandle
    setUserData :: BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh UserData
    us = BinHandle
    bh { bh_usr = us }

    ---------------------------------------------------------------
    --              Bin
    ---------------------------------------------------------------

    newtype Bin a = BinPtr Int
      deriving (Bin a -> Bin a -> Bool
    (Bin a -> Bin a -> Bool) -> (Bin a -> Bin a -> Bool) -> Eq (Bin a)
    forall a. Bin a -> Bin a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Bin a -> Bin a -> Bool
    == :: Bin a -> Bin a -> Bool
    $c/= :: forall a. Bin a -> Bin a -> Bool
    /= :: Bin a -> Bin a -> Bool
    Eq, Eq (Bin a)
    Eq (Bin a) =>
    (Bin a -> Bin a -> Ordering)
    -> (Bin a -> Bin a -> Bool)
    -> (Bin a -> Bin a -> Bool)
    -> (Bin a -> Bin a -> Bool)
    -> (Bin a -> Bin a -> Bool)
    -> (Bin a -> Bin a -> Bin a)
    -> (Bin a -> Bin a -> Bin a)
    -> Ord (Bin a)
    Bin a -> Bin a -> Bool
    Bin a -> Bin a -> Ordering
    Bin a -> Bin a -> Bin a
    forall a. Eq (Bin a)
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Bin a -> Bin a -> Bool
    forall a. Bin a -> Bin a -> Ordering
    forall a. Bin a -> Bin a -> Bin a
    $ccompare :: forall a. Bin a -> Bin a -> Ordering
    compare :: Bin a -> Bin a -> Ordering
    $c< :: forall a. Bin a -> Bin a -> Bool
    < :: Bin a -> Bin a -> Bool
    $c<= :: forall a. Bin a -> Bin a -> Bool
    <= :: Bin a -> Bin a -> Bool
    $c> :: forall a. Bin a -> Bin a -> Bool
    > :: Bin a -> Bin a -> Bool
    $c>= :: forall a. Bin a -> Bin a -> Bool
    >= :: Bin a -> Bin a -> Bool
    $cmax :: forall a. Bin a -> Bin a -> Bin a
    max :: Bin a -> Bin a -> Bin a
    $cmin :: forall a. Bin a -> Bin a -> Bin a
    min :: Bin a -> Bin a -> Bin a
    Ord, Int -> Bin a -> ShowS
    [Bin a] -> ShowS
    Bin a -> String
    (Int -> Bin a -> ShowS)
    -> (Bin a -> String) -> ([Bin a] -> ShowS) -> Show (Bin a)
    forall a. Int -> Bin a -> ShowS
    forall a. [Bin a] -> ShowS
    forall a. Bin a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> Bin a -> ShowS
    showsPrec :: Int -> Bin a -> ShowS
    $cshow :: forall a. Bin a -> String
    show :: Bin a -> String
    $cshowList :: forall a. [Bin a] -> ShowS
    showList :: [Bin a] -> ShowS
    Show, Bin a
    Bin a -> Bin a -> Bounded (Bin a)
    forall a. Bin a
    forall a. a -> a -> Bounded a
    $cminBound :: forall a. Bin a
    minBound :: Bin a
    $cmaxBound :: forall a. Bin a
    maxBound :: Bin a
    Bounded)

    castBin :: Bin a -> Bin b
    castBin :: forall a b. Bin a -> Bin b
    castBin (BinPtr Int
    i) = Int -> Bin b
    forall a. Int -> Bin a
    BinPtr Int
    i

    ---------------------------------------------------------------
    --              class Binary
    ---------------------------------------------------------------

    class Binary a where
        put_   :: BinHandle -> a -> IO ()
        put    :: BinHandle -> a -> IO (Bin a)
        get    :: BinHandle -> IO a

        -- define one of put_, put.  Use of put_ is recommended because it
        -- is more likely that tail-calls can kick in, and we rarely need the
        -- position return value.
        put_ BinHandle
    bh a
    a = do BinHandle -> a -> IO (Bin a)
    forall a. Binary a => BinHandle -> a -> IO (Bin a)
    put BinHandle
    bh a
    a; () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        put BinHandle
    bh a
    a  = do Bin a
    p <- BinHandle -> IO (Bin a)
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh; BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a; Bin a -> IO (Bin a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bin a
    p

    putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt :: forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin a
    p a
    x = do BinHandle -> Bin a -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin a
    p; BinHandle -> a -> IO (Bin a)
    forall a. Binary a => BinHandle -> a -> IO (Bin a)
    put BinHandle
    bh a
    x; () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    getAt  :: Binary a => BinHandle -> Bin a -> IO a
    getAt :: forall a. Binary a => BinHandle -> Bin a -> IO a
    getAt BinHandle
    bh Bin a
    p = do BinHandle -> Bin a -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin a
    p; BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    openBinIO_ :: IO.Handle -> IO BinHandle
    openBinIO_ :: Handle -> IO BinHandle
    openBinIO_ Handle
    h = Handle -> IO BinHandle
    openBinIO Handle
    h

    openBinIO :: IO.Handle -> IO BinHandle
    openBinIO :: Handle -> IO BinHandle
    openBinIO Handle
    h = do
      FastMutInt
    r <- IO FastMutInt
    newFastMutInt
      FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    r Int
    0
      BinHandle -> IO BinHandle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UserData -> FastMutInt -> Handle -> BinHandle
    BinIO UserData
    forall {a}. a
    noUserData FastMutInt
    r Handle
    h)

    openBinMem :: Int -> IO BinHandle
    openBinMem :: Int -> IO BinHandle
    openBinMem Int
    size
     | Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = String -> IO BinHandle
    forall a. HasCallStack => String -> a
    error String
    "Data.Binary.openBinMem: size must be >= 0"
     | Bool
    otherwise = do
       BinArray
    arr <- (Int, Int) -> IO BinArray
    forall i. Ix i => (i, i) -> IO (IOUArray i Word8)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ (Int
    0,Int
    sizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
       IORef BinArray
    arr_r <- BinArray -> IO (IORef BinArray)
    forall a. a -> IO (IORef a)
    newIORef BinArray
    arr
       FastMutInt
    ix_r <- IO FastMutInt
    newFastMutInt
       FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r Int
    0
       FastMutInt
    sz_r <- IO FastMutInt
    newFastMutInt
       FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    sz_r Int
    size
       BinHandle -> IO BinHandle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UserData -> FastMutInt -> FastMutInt -> IORef BinArray -> BinHandle
    BinMem UserData
    forall {a}. a
    noUserData FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r)

    tellBin :: BinHandle -> IO (Bin a)
    tellBin :: forall a. BinHandle -> IO (Bin a)
    tellBin (BinIO  UserData
    _ FastMutInt
    r Handle
    _)   = do Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    r; Bin a -> IO (Bin a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Bin a
    forall a. Int -> Bin a
    BinPtr Int
    ix)
    tellBin (BinMem UserData
    _ FastMutInt
    r FastMutInt
    _ IORef BinArray
    _) = do Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    r; Bin a -> IO (Bin a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Bin a
    forall a. Int -> Bin a
    BinPtr Int
    ix)

    seekBin :: BinHandle -> Bin a -> IO ()
    seekBin :: forall a. BinHandle -> Bin a -> IO ()
    seekBin (BinIO UserData
    _ FastMutInt
    ix_r Handle
    h) (BinPtr Int
    p) = do
      FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r Int
    p
      Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    p)
    seekBin h :: BinHandle
    h@(BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    a) (BinPtr Int
    p) = do
      Int
    sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
      if (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sz)
            then do BinHandle -> Int -> IO ()
    expandBin BinHandle
    h Int
    p; FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r Int
    p
            else FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r Int
    p

    isEOFBin :: BinHandle -> IO Bool
    isEOFBin :: BinHandle -> IO Bool
    isEOFBin (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    a) = do
      Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
      Int
    sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sz)
    isEOFBin (BinIO UserData
    _ FastMutInt
    ix_r Handle
    h) = Handle -> IO Bool
    hIsEOF Handle
    h

    writeBinMem :: BinHandle -> FilePath -> IO ()
    writeBinMem :: BinHandle -> String -> IO ()
    writeBinMem (BinIO UserData
    _ FastMutInt
    _ Handle
    _) String
    _ = String -> IO ()
    forall a. HasCallStack => String -> a
    error String
    "Data.Binary.writeBinMem: not a memory handle"
    writeBinMem (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) String
    fn = do
      Handle
    h <- String -> IOMode -> IO Handle
    openFile String
    fn IOMode
    WriteMode
      Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    h Bool
    True
      BinArray
    arr <- IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    arr_r
      Int
    ix  <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
      Handle -> BinArray -> Int -> IO ()
    hPutArray Handle
    h BinArray
    arr Int
    ix
      Handle -> IO ()
    hClose Handle
    h

    readBinMem :: FilePath -> IO BinHandle
    -- Return a BinHandle with a totally undefined State
    readBinMem :: String -> IO BinHandle
    readBinMem String
    filename = do
      Handle
    h <- String -> IOMode -> IO Handle
    openFile String
    filename IOMode
    ReadMode
      Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    h Bool
    True
      Integer
    filesize' <- Handle -> IO Integer
    hFileSize Handle
    h
      let filesize :: Int
    filesize = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    filesize'
      BinArray
    arr <- (Int, Int) -> IO BinArray
    forall i. Ix i => (i, i) -> IO (IOUArray i Word8)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ (Int
    0,Int
    filesizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
      Int
    count <- Handle -> BinArray -> Int -> IO Int
    hGetArray Handle
    h BinArray
    arr Int
    filesize
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    count Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    filesize)
            (String -> IO ()
    forall a. HasCallStack => String -> a
    error (String
    "Binary.readBinMem: only read " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    count String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes"))
      Handle -> IO ()
    hClose Handle
    h
      IORef BinArray
    arr_r <- BinArray -> IO (IORef BinArray)
    forall a. a -> IO (IORef a)
    newIORef BinArray
    arr
      FastMutInt
    ix_r <- IO FastMutInt
    newFastMutInt
      FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r Int
    0
      FastMutInt
    sz_r <- IO FastMutInt
    newFastMutInt
      FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    sz_r Int
    filesize
      BinHandle -> IO BinHandle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UserData -> FastMutInt -> FastMutInt -> IORef BinArray -> BinHandle
    BinMem UserData
    forall {a}. a
    noUserData FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r)

    -- expand the size of the array to include a specified offset
    expandBin :: BinHandle -> Int -> IO ()
    expandBin :: BinHandle -> Int -> IO ()
    expandBin (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) Int
    off = do
       Int
    sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
       let sz' :: Int
    sz' = [Int] -> Int
    forall a. HasCallStack => [a] -> a
    head ((Int -> Bool) -> [Int] -> [Int]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    off) ((Int -> Int) -> Int -> [Int]
    forall a. (a -> a) -> a -> [a]
    iterate (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2) Int
    sz))
       BinArray
    arr <- IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    arr_r
       BinArray
    arr' <- (Int, Int) -> IO BinArray
    forall i. Ix i => (i, i) -> IO (IOUArray i Word8)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ (Int
    0,Int
    sz'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
       [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ BinArray -> Int -> IO Word8
    forall i. Ix i => IOUArray i Word8 -> Int -> IO Word8
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> m e
    unsafeRead BinArray
    arr Int
    i IO Word8 -> (Word8 -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= BinArray -> Int -> Word8 -> IO ()
    forall i. Ix i => IOUArray i Word8 -> Int -> Word8 -> IO ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> e -> m ()
    unsafeWrite BinArray
    arr' Int
    i
                 | Int
    i <- [ Int
    0 .. Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1 ] ]
       FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    sz_r Int
    sz'
       IORef BinArray -> BinArray -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef BinArray
    arr_r BinArray
    arr'
    #ifdef DEBUG
       hPutStrLn stderr ("Binary: expanding to size: " ++ show sz')
    #endif
       () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    expandBin (BinIO UserData
    _ FastMutInt
    _ Handle
    _) Int
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            -- no need to expand a file, we'll assume they expand by themselves.
    {-# INLINE expandBin #-}

    -- -----------------------------------------------------------------------------
    -- Low-level reading/writing of bytes

    putWord8 :: BinHandle -> Word8 -> IO ()
    putWord8 :: BinHandle -> Word8 -> IO ()
    putWord8 h :: BinHandle
    h@(BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) Word8
    w = do
        Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
        Int
    sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
            -- double the size of the array if it overflows
        if (Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sz)
            then do BinHandle -> Int -> IO ()
    expandBin BinHandle
    h Int
    ix
                    BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    h Word8
    w
            else do BinArray
    arr <- IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    arr_r
                    BinArray -> Int -> Word8 -> IO ()
    forall i. Ix i => IOUArray i Word8 -> Int -> Word8 -> IO ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> e -> m ()
    unsafeWrite BinArray
    arr Int
    ix Word8
    w
                    FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
                    () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    putWord8 (BinIO UserData
    _ FastMutInt
    ix_r Handle
    h) Word8
    w = do
        Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
        Handle -> Char -> IO ()
    hPutChar Handle
    h (Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w))   -- XXX not really correct
        FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
        () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    getWord8 :: BinHandle -> IO Word8
    getWord8 :: BinHandle -> IO Word8
    getWord8 (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) = do
        Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
        Int
    sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sz)  (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            IOError -> IO ()
    forall a. IOError -> IO a
    ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
    mkIOError IOErrorType
    eofErrorType String
    "Data.Binary.getWord8" Maybe Handle
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)
        BinArray
    arr <- IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    arr_r
        Word8
    w <- BinArray -> Int -> IO Word8
    forall i. Ix i => IOUArray i Word8 -> Int -> IO Word8
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> m e
    unsafeRead BinArray
    arr Int
    ix
        FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
        Word8 -> IO Word8
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word8
    w
    getWord8 (BinIO UserData
    _ FastMutInt
    ix_r Handle
    h) = do
        Int
    ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
        Char
    c <- Handle -> IO Char
    hGetChar Handle
    h
        FastMutInt -> Int -> IO ()
    writeFastMutInt FastMutInt
    ix_r (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
        Word8 -> IO Word8
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word8 -> IO Word8) -> Word8 -> IO Word8
    forall a b. (a -> b) -> a -> b
    $! (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c))    -- XXX not really correct

    putByte :: BinHandle -> Word8 -> IO ()
    putByte :: BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    w = BinHandle -> Word8 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Word8
    w

    getByte :: BinHandle -> IO Word8
    getByte :: BinHandle -> IO Word8
    getByte = BinHandle -> IO Word8
    getWord8

    -- -----------------------------------------------------------------------------
    -- Primitive Word writes

    instance Binary Word8 where
      put_ :: BinHandle -> Word8 -> IO ()
    put_ = BinHandle -> Word8 -> IO ()
    putWord8
      get :: BinHandle -> IO Word8
    get  = BinHandle -> IO Word8
    getWord8

    instance Binary Word16 where
      put_ :: BinHandle -> Word16 -> IO ()
    put_ BinHandle
    h Word16
    w = do -- XXX too slow.. inline putWord8?
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    w Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    w Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. Word16
    0xff))
      get :: BinHandle -> IO Word16
    get BinHandle
    h = do
        Word8
    w1 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w2 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word16 -> IO Word16
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word16 -> IO Word16) -> Word16 -> IO Word16
    forall a b. (a -> b) -> a -> b
    $! ((Word8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w1 Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w2)

    instance Binary Word32 where
      put_ :: BinHandle -> Word32 -> IO ()
    put_ BinHandle
    h Word32
    w = do
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word32
    w Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)  Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0xff))
      get :: BinHandle -> IO Word32
    get BinHandle
    h = do
        Word8
    w1 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w2 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w3 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w4 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word32 -> IO Word32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32 -> IO Word32) -> Word32 -> IO Word32
    forall a b. (a -> b) -> a -> b
    $! ((Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w1 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    24) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w2 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w3 Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `shiftL`  Int
    8) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w4))

    instance Binary Word64 where
      put_ :: BinHandle -> Word64 -> IO ()
    put_ BinHandle
    h Word64
    w = do
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    56))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    40) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word64
    w Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR`  Int
    8) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
        BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    w Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0xff))
      get :: BinHandle -> IO Word64
    get BinHandle
    h = do
        Word8
    w1 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w2 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w3 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w4 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w5 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w6 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w7 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word8
    w8 <- BinHandle -> IO Word8
    getWord8 BinHandle
    h
        Word64 -> IO Word64
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word64 -> IO Word64) -> Word64 -> IO Word64
    forall a b. (a -> b) -> a -> b
    $! ((Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w1 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    56) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w2 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    48) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w3 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    40) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w4 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    32) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w5 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    24) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w6 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w7 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL`  Int
    8) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|.
                   (Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w8))

    -- -----------------------------------------------------------------------------
    -- Primitive Int writes

    instance Binary Int8 where
      put_ :: BinHandle -> Int8 -> IO ()
    put_ BinHandle
    h Int8
    w = BinHandle -> Word8 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h (Int8 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int8
    w :: Word8)
      get :: BinHandle -> IO Int8
    get BinHandle
    h    = do Word8
    w <- BinHandle -> IO Word8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; Int8 -> IO Int8
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int8 -> IO Int8) -> Int8 -> IO Int8
    forall a b. (a -> b) -> a -> b
    $! (Word8 -> Int8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    w::Word8))

    instance Binary Int16 where
      put_ :: BinHandle -> Int16 -> IO ()
    put_ BinHandle
    h Int16
    w = BinHandle -> Word16 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h (Int16 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int16
    w :: Word16)
      get :: BinHandle -> IO Int16
    get BinHandle
    h    = do Word16
    w <- BinHandle -> IO Word16
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; Int16 -> IO Int16
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int16 -> IO Int16) -> Int16 -> IO Int16
    forall a b. (a -> b) -> a -> b
    $! (Word16 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    w::Word16))

    instance Binary Int32 where
      put_ :: BinHandle -> Int32 -> IO ()
    put_ BinHandle
    h Int32
    w = BinHandle -> Word32 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h (Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    w :: Word32)
      get :: BinHandle -> IO Int32
    get BinHandle
    h    = do Word32
    w <- BinHandle -> IO Word32
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; Int32 -> IO Int32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int32 -> IO Int32) -> Int32 -> IO Int32
    forall a b. (a -> b) -> a -> b
    $! (Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32
    w::Word32))

    instance Binary Int64 where
      put_ :: BinHandle -> Int64 -> IO ()
    put_ BinHandle
    h Int64
    w = BinHandle -> Word64 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h (Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    w :: Word64)
      get :: BinHandle -> IO Int64
    get BinHandle
    h    = do Word64
    w <- BinHandle -> IO Word64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; Int64 -> IO Int64
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int64 -> IO Int64) -> Int64 -> IO Int64
    forall a b. (a -> b) -> a -> b
    $! (Word64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    w::Word64))

    -- -----------------------------------------------------------------------------
    -- Instances for standard types

    instance Binary () where
        put_ :: BinHandle -> () -> IO ()
    put_ BinHandle
    bh () = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        get :: BinHandle -> IO ()
    get  BinHandle
    _     = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    --    getF bh p  = case getBitsF bh 0 p of (_,b) -> ((),b)

    instance Binary Bool where
        put_ :: BinHandle -> Bool -> IO ()
    put_ BinHandle
    bh Bool
    b = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum Bool
    b))
        get :: BinHandle -> IO Bool
    get  BinHandle
    bh   = do Word8
    x <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh; Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $! (Int -> Bool
    forall a. Enum a => Int -> a
    toEnum (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    x))
    --    getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b)

    instance Binary Char where
        put_ :: BinHandle -> Char -> IO ()
    put_  BinHandle
    bh Char
    c = BinHandle -> Word8 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c) :: Word8)
        get :: BinHandle -> IO Char
    get  BinHandle
    bh   = do Word8
    x <- BinHandle -> IO Word8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; Char -> IO Char
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> IO Char) -> Char -> IO Char
    forall a b. (a -> b) -> a -> b
    $! (Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    x :: Word8)))
    --    getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b)

    instance Binary Int where
    #if SIZEOF_HSINT == 4
        put_ bh i = put_ bh (fromIntegral i :: Int32)
        get  bh = do
            x <- get bh
            return $! (fromIntegral (x :: Int32))
    #elif SIZEOF_HSINT == 8
        put_ :: BinHandle -> Int -> IO ()
    put_ BinHandle
    bh Int
    i = BinHandle -> Int64 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i :: Int64)
        get :: BinHandle -> IO Int
    get  BinHandle
    bh = do
            Int64
    x <- BinHandle -> IO Int64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $! (Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    x :: Int64))
    #else
    #error "unsupported sizeof(HsInt)"
    #endif
    --    getF bh   = getBitsF bh 32

    instance Binary a => Binary [a] where
        put_ :: BinHandle -> [a] -> IO ()
    put_ BinHandle
    bh [a]
    list = do BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    list)
                          (a -> IO ()) -> [a] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh) [a]
    list
        get :: BinHandle -> IO [a]
    get BinHandle
    bh = do Int
    len <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                    let getMany :: Int -> IO [a]
                        getMany :: Int -> IO [a]
    getMany Int
    0 = [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                        getMany Int
    n = do a
    x <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                                       [a]
    xs <- Int -> IO [a]
    getMany (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                                       [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs)
                    Int -> IO [a]
    getMany Int
    len

    instance (Binary a, Binary b) => Binary (a,b) where
        put_ :: BinHandle -> (a, b) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b) = do BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a; BinHandle -> b -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh b
    b
        get :: BinHandle -> IO (a, b)
    get BinHandle
    bh        = do a
    a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                           b
    b <- BinHandle -> IO b
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                           (a, b) -> IO (a, b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a,b
    b)

    instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
        put_ :: BinHandle -> (a, b, c) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b,c
    c) = do BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a; BinHandle -> b -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh b
    b; BinHandle -> c -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh c
    c
        get :: BinHandle -> IO (a, b, c)
    get BinHandle
    bh          = do a
    a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             b
    b <- BinHandle -> IO b
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             c
    c <- BinHandle -> IO c
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             (a, b, c) -> IO (a, b, c)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a,b
    b,c
    c)

    instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
        put_ :: BinHandle -> (a, b, c, d) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b,c
    c,d
    d) = do BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a; BinHandle -> b -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh b
    b; BinHandle -> c -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh c
    c; BinHandle -> d -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh d
    d
        get :: BinHandle -> IO (a, b, c, d)
    get BinHandle
    bh          = do a
    a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             b
    b <- BinHandle -> IO b
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             c
    c <- BinHandle -> IO c
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             d
    d <- BinHandle -> IO d
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             (a, b, c, d) -> IO (a, b, c, d)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a,b
    b,c
    c,d
    d)

    instance Binary a => Binary (Maybe a) where
        put_ :: BinHandle -> Maybe a -> IO ()
    put_ BinHandle
    bh Maybe a
    Nothing  = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
        put_ BinHandle
    bh (Just a
    a) = do BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1; BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a
        get :: BinHandle -> IO (Maybe a)
    get BinHandle
    bh           = do Word8
    h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
                              case Word8
    h of
                                Word8
    0 -> Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
                                Word8
    _ -> do a
    x <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)

    instance (Binary a, Binary b) => Binary (Either a b) where
        put_ :: BinHandle -> Either a b -> IO ()
    put_ BinHandle
    bh (Left  a
    a) = do BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0; BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a
        put_ BinHandle
    bh (Right b
    b) = do BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1; BinHandle -> b -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh b
    b
        get :: BinHandle -> IO (Either a b)
    get BinHandle
    bh            = do Word8
    h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
                               case Word8
    h of
                                 Word8
    0 -> do a
    a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh ; Either a b -> IO (Either a b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Either a b
    forall a b. a -> Either a b
    Left a
    a)
                                 Word8
    _ -> do b
    b <- BinHandle -> IO b
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh ; Either a b -> IO (Either a b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> Either a b
    forall a b. b -> Either a b
    Right b
    b)

    instance (Binary a, Binary i, Ix i) => Binary (Array i a) where
      put_ :: BinHandle -> Array i a -> IO ()
    put_ BinHandle
    bh Array i a
    arr = do BinHandle -> (i, i) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Array i a -> (i, i)
    forall i e. Array i e -> (i, i)
    Data.Array.bounds Array i a
    arr)
                       BinHandle -> [a] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Array i a -> [a]
    forall i e. Array i e -> [e]
    Data.Array.elems Array i a
    arr)
      get :: BinHandle -> IO (Array i a)
    get BinHandle
    bh = do (i, i)
    bounds <- BinHandle -> IO (i, i)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                  [a]
    elems <- BinHandle -> IO [a]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                  Array i a -> IO (Array i a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Array i a -> IO (Array i a)) -> Array i a -> IO (Array i a)
    forall a b. (a -> b) -> a -> b
    $ (i, i) -> [a] -> Array i a
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (i, i)
    bounds [a]
    elems

    instance (Binary key, Ord key, Binary elem) => Binary (Map key elem) where
    --    put_ bh fm = put_ bh (Map.toList fm)
    --    get bh = do list <- get bh
    --                return (Map.fromList list)

        put_ :: BinHandle -> Map key elem -> IO ()
    put_ BinHandle
    bh Map key elem
    fm = do let list :: [(key, elem)]
    list = Map key elem -> [(key, elem)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map key elem
    fm
                        BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh ([(key, elem)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(key, elem)]
    list)
                        ((key, elem) -> IO ()) -> [(key, elem)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\(key
    key, elem
    val) -> do BinHandle -> key -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh key
    key
                                                 BinHandle -> elem -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    lazyPut BinHandle
    bh elem
    val) [(key, elem)]
    list
        get :: BinHandle -> IO (Map key elem)
    get BinHandle
    bh = do Int
    len <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                    let getMany :: Int -> IO [(key,elem)]
                        getMany :: Int -> IO [(key, elem)]
    getMany Int
    0 = [(key, elem)] -> IO [(key, elem)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                        getMany Int
    n = do key
    key <- BinHandle -> IO key
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                                       elem
    val <- BinHandle -> IO elem
    forall a. Binary a => BinHandle -> IO a
    lazyGet BinHandle
    bh
                                       [(key, elem)]
    xs <- Int -> IO [(key, elem)]
    getMany (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                                       [(key, elem)] -> IO [(key, elem)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((key
    key,elem
    val)(key, elem) -> [(key, elem)] -> [(key, elem)]
    forall a. a -> [a] -> [a]
    :[(key, elem)]
    xs)
    --                printElapsedTime "before get Map"
                    [(key, elem)]
    list <- Int -> IO [(key, elem)]
    getMany Int
    len
    --                printElapsedTime "after get Map"
                    Map key elem -> IO (Map key elem)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(key, elem)] -> Map key elem
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(key, elem)]
    list)

    #ifdef __GLASGOW_HASKELL__
    #if __GLASGOW_HASKELL__<610
    instance Binary Integer where
        put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
        put_ bh (J# s# a#) = do
            p <- putByte bh 1;
            put_ bh (I# s#)
            let sz# = sizeofByteArray# a#  -- in *bytes*
            put_ bh (I# sz#)  -- in *bytes*
            putByteArray bh a# sz#

        get bh = do
            b <- getByte bh
            case b of
              0 -> do (I# i#) <- get bh
                      return (S# i#)
              _ -> do (I# s#) <- get bh
                      sz <- get bh
                      (BA a#) <- getByteArray bh sz
                      return (J# s# a#)

    putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()
    putByteArray bh a s# = loop 0#
      where loop n#
               | n# ==# s# = return ()
               | otherwise = do
                    putByte bh (indexByteArray a n#)
                    loop (n# +# 1#)

    getByteArray :: BinHandle -> Int -> IO ByteArray
    getByteArray bh (I# sz) = do
      (MBA arr) <- newByteArray sz
      let loop n
               | n ==# sz = return ()
               | otherwise = do
                    w <- getByte bh
                    writeByteArray arr n w
                    loop (n +# 1#)
      loop 0#
      freezeByteArray arr

    data ByteArray = BA ByteArray#
    data MBA = MBA (MutableByteArray# RealWorld)

    newByteArray :: Int# -> IO MBA
    newByteArray sz = IO $ \s ->
      case newByteArray# sz s of { (# s, arr #) ->
      (# s, MBA arr #) }

    freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray
    freezeByteArray arr = IO $ \s ->
      case unsafeFreezeByteArray# arr s of { (# s, arr #) ->
      (# s, BA arr #) }

    writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()

    #if __GLASGOW_HASKELL__ < 503
    writeByteArray arr i w8 = IO $ \s ->
      case word8ToWord w8 of { W# w# ->
      case writeCharArray# arr i (chr# (word2Int# w#)) s  of { s ->
      (# s , () #) }}
    #else
    writeByteArray arr i (W8# w) = IO $ \s ->
      case writeWord8Array# arr i w s of { s ->
      (# s, () #) }
    #endif

    #if __GLASGOW_HASKELL__ < 503
    indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))
    #else
    indexByteArray a# n# = W8# (indexWord8Array# a# n#)
    #endif

    instance (Integral a, Binary a) => Binary (Ratio a) where
        put_ bh (a :% b) = do put_ bh a; put_ bh b
        get bh = do a <- get bh; b <- get bh; return (a :% b)

    #else

    instance Binary Integer where
        put_ :: BinHandle -> Integer -> IO ()
    put_ BinHandle
    h Integer
    n = do
          BinHandle -> Int8 -> IO (Bin Int8)
    forall a. Binary a => BinHandle -> a -> IO (Bin a)
    put BinHandle
    h ((Integer -> Int8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Int8) -> Integer -> Int8
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Num a => a -> a
    signum Integer
    n) :: Int8)
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    n Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let n' :: Integer
    n' = Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    n
                nBytes :: Int
    nBytes = Integer -> Int
    forall {p}. (Ord p, Bits p, Num p) => p -> Int
    byteSize Integer
    n'
            BinHandle -> Word64 -> IO (Bin Word64)
    forall a. Binary a => BinHandle -> a -> IO (Bin a)
    put BinHandle
    h (Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    nBytes :: Word64)
            (Word8 -> IO ()) -> [Word8] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h) [ Integer -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Integer
    n' Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` (Int
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8)) Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .&. Integer
    0xff)
                              | Int
    b <- [ Int
    nBytesInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1, Int
    nBytesInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    2 .. Int
    0 ] ]
          where byteSize :: p -> Int
    byteSize p
    n =
                    let f :: Int -> Int
    f Int
    b = if (p
    1 p -> Int -> p
    forall a. Bits a => a -> Int -> a
    `shiftL` (Int
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8)) p -> p -> Bool
    forall a. Ord a => a -> a -> Bool
    > p
    n
                                 then Int
    b
                                 else Int -> Int
    f (Int
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                    in Int -> Int
    f Int
    0
        get :: BinHandle -> IO Integer
    get BinHandle
    h = do
          Int8
    sign :: Int8 <- BinHandle -> IO Int8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h
          if Int8
    sign Int8 -> Int8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int8
    0
             then Integer -> IO Integer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    0
             else do
               Word64
    nBytes :: Word64 <- BinHandle -> IO Word64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h
               Integer
    n <- Word64 -> Integer -> IO Integer
    forall {t} {t}. (Bits t, Num t, Num t, Eq t) => t -> t -> IO t
    accumBytes Word64
    nBytes Integer
    0
               Integer -> IO Integer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> IO Integer) -> Integer -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ Int8 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int8
    sign Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    n
          where accumBytes :: t -> t -> IO t
    accumBytes t
    nBytes t
    acc | t
    nBytes t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    0 = t -> IO t
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return t
    acc
                                      | Bool
    otherwise = do
                    Word8
    b <- BinHandle -> IO Word8
    getByte BinHandle
    h
                    t -> t -> IO t
    accumBytes (t
    nBytes t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) ((t
    acc t -> Int -> t
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) t -> t -> t
    forall a. Bits a => a -> a -> a
    .|. Word8 -> t
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    b)
    #endif

    #endif

    instance Binary (Bin a) where
      put_ :: BinHandle -> Bin a -> IO ()
    put_ BinHandle
    bh (BinPtr Int
    i) = BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    i
      get :: BinHandle -> IO (Bin a)
    get BinHandle
    bh = do Int
    i <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; Bin a -> IO (Bin a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Bin a
    forall a. Int -> Bin a
    BinPtr Int
    i)

    -- -----------------------------------------------------------------------------
    -- Lazy reading/writing

    lazyPut :: Binary a => BinHandle -> a -> IO ()
    lazyPut :: forall a. Binary a => BinHandle -> a -> IO ()
    lazyPut BinHandle
    bh a
    a = do
            -- output the obj with a ptr to skip over it:
        Bin (Bin Any)
    pre_a <- BinHandle -> IO (Bin (Bin Any))
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        BinHandle -> Bin (Bin Any) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    pre_a       -- save a slot for the ptr
        BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a           -- dump the object
        Bin Any
    q <- BinHandle -> IO (Bin Any)
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh     -- q = ptr to after object
        BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
    forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    pre_a Bin Any
    q    -- fill in slot before a with ptr to q
        BinHandle -> Bin Any -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    q        -- finally carry on writing at q

    lazyGet :: Binary a => BinHandle -> IO a
    lazyGet :: forall a. Binary a => BinHandle -> IO a
    lazyGet BinHandle
    bh = do
        Bin Any
    p <- BinHandle -> IO (Bin Any)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh         -- a BinPtr
        Bin a
    p_a <- BinHandle -> IO (Bin a)
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        a
    a <- IO a -> IO a
    forall a. IO a -> IO a
    unsafeInterleaveIO (BinHandle -> Bin a -> IO a
    forall a. Binary a => BinHandle -> Bin a -> IO a
    getAt BinHandle
    bh Bin a
    p_a)
        BinHandle -> Bin Any -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    p -- skip over the object for now
        a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- --------------------------------------------------------------
    --      Main wrappers: getBinFileWithDict, putBinFileWithDict
    --
    --      This layer is built on top of the stuff above,
    --      and should not know anything about BinHandles
    -- --------------------------------------------------------------

    initBinMemSize :: Int
    initBinMemSize       = (Int
    1024Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024) :: Int
    binaryInterfaceMagic :: Word32
    binaryInterfaceMagic = Word32
    0x1face :: Word32

    getBinFileWithDict :: Binary a => FilePath -> IO a
    getBinFileWithDict :: forall a. Binary a => String -> IO a
    getBinFileWithDict String
    file_path = do
      BinHandle
    bh <- String -> IO BinHandle
    Binary.readBinMem String
    file_path

            -- Read the magic number to check that this really is a GHC .hi file
            -- (This magic number does not change when we change
            --  GHC interface file format)
      Word32
    magic <- BinHandle -> IO Word32
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word32
    magic Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    binaryInterfaceMagic) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    forall a. HasCallStack => String -> a
    error String
    "magic number mismatch: old/corrupt interface file?"

            -- Read the dictionary
            -- The next word in the file is a pointer to where the dictionary is
            -- (probably at the end of the file)
      Bin Any
    dict_p <- BinHandle -> IO (Bin Any)
    forall a. Binary a => BinHandle -> IO a
    Binary.get BinHandle
    bh       -- Get the dictionary ptr
      Bin Any
    data_p <- BinHandle -> IO (Bin Any)
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh          -- Remember where we are now
      BinHandle -> Bin Any -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    dict_p
      Dictionary
    dict <- BinHandle -> IO Dictionary
    getDictionary BinHandle
    bh
      BinHandle -> Bin Any -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    data_p             -- Back to where we were before

            -- Initialise the user-data field of bh
      let bh' :: BinHandle
    bh' = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh (Dictionary -> UserData
    initReadState Dictionary
    dict)

            -- At last, get the thing
      BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh'

    putBinFileWithDict :: Binary a => FilePath -> a -> IO ()
    putBinFileWithDict :: forall a. Binary a => String -> a -> IO ()
    putBinFileWithDict String
    file_path a
    the_thing = do
    --  hnd <- openBinaryFile file_path WriteMode
    --  bh <- openBinIO hnd
      BinHandle
    bh <- Int -> IO BinHandle
    openBinMem Int
    initBinMemSize
      BinHandle -> Word32 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Word32
    binaryInterfaceMagic

            -- Remember where the dictionary pointer will go
      Bin (Bin Any)
    dict_p_p <- BinHandle -> IO (Bin (Bin Any))
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
      BinHandle -> Bin (Bin Any) -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    dict_p_p      -- Placeholder for ptr to dictionary

            -- Make some initial state
      UserData
    usr_state <- IO UserData
    newWriteState

            -- Put the main thing,
      BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ (BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh UserData
    usr_state) a
    the_thing

            -- Get the final-state
      Int
    j <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef  (UserData -> IORef Int
    ud_next UserData
    usr_state)
    #if __GLASGOW_HASKELL__>=602
      [(String, Int)]
    fm <- IOHashTable HashTable String Int -> IO [(String, Int)]
    forall (h :: * -> * -> * -> *) k v.
    (HashTable h, Eq k, Hashable k) =>
    IOHashTable h k v -> IO [(k, v)]
    HashTable.toList (UserData -> IOHashTable HashTable String Int
    ud_map  UserData
    usr_state)
    #else
      fm <- liftM Map.toList $ readIORef (ud_map  usr_state)
    #endif
      Bin Any
    dict_p <- BinHandle -> IO (Bin Any)
    forall a. BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh  -- This is where the dictionary will start

            -- Write the dictionary pointer at the fornt of the file
      BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
    forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    dict_p_p Bin Any
    dict_p      -- Fill in the placeholder
      BinHandle -> Bin Any -> IO ()
    forall a. BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    dict_p             -- Seek back to the end of the file

            -- Write the dictionary itself
      BinHandle -> Int -> Dictionary -> IO ()
    putDictionary BinHandle
    bh Int
    j (Int -> [(String, Int)] -> Dictionary
    constructDictionary Int
    j [(String, Int)]
    fm)

            -- And send the result to the file
      BinHandle -> String -> IO ()
    writeBinMem BinHandle
    bh String
    file_path
    --  hClose hnd

    -- -----------------------------------------------------------------------------
    -- UserData
    -- -----------------------------------------------------------------------------

    data UserData =
       UserData {   -- This field is used only when reading
                  UserData -> Dictionary
    ud_dict :: Dictionary,

                    -- The next two fields are only used when writing
                  UserData -> IORef Int
    ud_next :: IORef Int,     -- The next index to use
    #if __GLASGOW_HASKELL__>=602
    # if __GLASGOW_HASKELL__>=707
                  UserData -> IOHashTable HashTable String Int
    ud_map  :: BasicHashTable String Int -- The index of each string
    # else
                  ud_map  :: HashTable String Int -- The index of each string
    # endif
    #else
                  ud_map  :: IORef (Map String Int)
    #endif
            }

    noUserData :: a
    noUserData = String -> a
    forall a. HasCallStack => String -> a
    error String
    "Binary.UserData: no user data"

    initReadState :: Dictionary -> UserData
    initReadState :: Dictionary -> UserData
    initReadState Dictionary
    dict = UserData{ ud_dict :: Dictionary
    ud_dict = Dictionary
    dict,
                                   ud_next :: IORef Int
    ud_next = String -> IORef Int
    forall {a}. String -> a
    undef String
    "next",
                                   ud_map :: IOHashTable HashTable String Int
    ud_map  = String -> HashTable RealWorld String Int
    forall {a}. String -> a
    undef String
    "map" }

    newWriteState :: IO UserData
    newWriteState :: IO UserData
    newWriteState = do
      IORef Int
    j_r <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
    #if __GLASGOW_HASKELL__>=602
    # if __GLASGOW_HASKELL__>=707
      HashTable RealWorld String Int
    out_r <- IO (HashTable RealWorld String Int)
    IO (IOHashTable HashTable String Int)
    forall (h :: * -> * -> * -> *) k v.
    HashTable h =>
    IO (IOHashTable h k v)
    HashTable.new
    # else
      out_r <- HashTable.new (==) HashTable.hashString
    # endif
    #else
      out_r <- newIORef Map.empty
    #endif
      UserData -> IO UserData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UserData { ud_dict :: Dictionary
    ud_dict = String -> Dictionary
    forall a. HasCallStack => String -> a
    error String
    "dict",
                         ud_next :: IORef Int
    ud_next = IORef Int
    j_r,
                         ud_map :: IOHashTable HashTable String Int
    ud_map  = HashTable RealWorld String Int
    IOHashTable HashTable String Int
    out_r })

    undef :: String -> a
    undef String
    s = String -> a
    forall a. HasCallStack => String -> a
    error (String
    "Binary.UserData: no " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s)

    ---------------------------------------------------------
    --              The Dictionary
    ---------------------------------------------------------

    type Dictionary = Array Int String      -- The dictionary
                                            -- Should be 0-indexed

    putDictionary :: BinHandle -> Int -> Dictionary -> IO ()
    putDictionary :: BinHandle -> Int -> Dictionary -> IO ()
    putDictionary BinHandle
    bh Int
    sz Dictionary
    dict = do
      BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    sz
      (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> String -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh) (Dictionary -> [String]
    forall i e. Array i e -> [e]
    elems Dictionary
    dict)

    getDictionary :: BinHandle -> IO Dictionary
    getDictionary :: BinHandle -> IO Dictionary
    getDictionary BinHandle
    bh = do
      Int
    sz <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
      [String]
    elems <- [IO String] -> IO [String]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence (Int -> [IO String] -> [IO String]
    forall a. Int -> [a] -> [a]
    take Int
    sz (IO String -> [IO String]
    forall a. a -> [a]
    repeat (BinHandle -> IO String
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh)))
      Dictionary -> IO Dictionary
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, Int) -> [String] -> Dictionary
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [String]
    elems)

    constructDictionary :: Int -> [(String,Int)] -> Dictionary
    constructDictionary :: Int -> [(String, Int)] -> Dictionary
    constructDictionary Int
    j [(String, Int)]
    fm = (Int, Int) -> [(Int, String)] -> Dictionary
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Int
    0,Int
    jInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (((String, Int) -> (Int, String))
    -> [(String, Int)] -> [(Int, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    x,Int
    y) -> (Int
    y,String
    x)) [(String, Int)]
    fm)

    ---------------------------------------------------------
    --              Reading and writing memoised Strings
    ---------------------------------------------------------

    putSharedString :: BinHandle -> String -> IO ()
    putSharedString :: BinHandle -> String -> IO ()
    putSharedString BinHandle
    bh String
    str =
      case BinHandle -> UserData
    getUserData BinHandle
    bh of
        UserData { ud_next :: UserData -> IORef Int
    ud_next = IORef Int
    j_r, ud_map :: UserData -> IOHashTable HashTable String Int
    ud_map = IOHashTable HashTable String Int
    out_r, ud_dict :: UserData -> Dictionary
    ud_dict = Dictionary
    dict} -> do
    #if __GLASGOW_HASKELL__>=602
          Maybe Int
    entry <- IOHashTable HashTable String Int -> String -> IO (Maybe Int)
    forall (h :: * -> * -> * -> *) k v.
    (HashTable h, Eq k, Hashable k) =>
    IOHashTable h k v -> k -> IO (Maybe v)
    HashTable.lookup IOHashTable HashTable String Int
    out_r String
    str
    #else
          fm <- readIORef out_r
          let entry = Map.lookup str fm
    #endif
          case Maybe Int
    entry of
            Just Int
    j  -> BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    j
            Maybe Int
    Nothing -> do
                         Int
    j <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    j_r
                         BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    j
                         IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    j_r (Int
    jInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
    #if __GLASGOW_HASKELL__>=602
                         IOHashTable HashTable String Int -> String -> Int -> IO ()
    forall (h :: * -> * -> * -> *) k v.
    (HashTable h, Eq k, Hashable k) =>
    IOHashTable h k v -> k -> v -> IO ()
    HashTable.insert IOHashTable HashTable String Int
    out_r String
    str Int
    j
    #else
                         modifyIORef out_r (\fm -> Map.insert str j fm)
    #endif

    getSharedString :: BinHandle -> IO String
    getSharedString :: BinHandle -> IO String
    getSharedString BinHandle
    bh = do
            Int
    j <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $! (UserData -> Dictionary
    ud_dict (BinHandle -> UserData
    getUserData BinHandle
    bh) Dictionary -> Int -> String
    forall i e. Ix i => Array i e -> i -> e
    ! Int
    j)

    {-
    ---------------------------------------------------------
    --              Reading and writing FastStrings
    ---------------------------------------------------------

    putFS bh (FastString id l ba) = do
      put_ bh (I# l)
      putByteArray bh ba l
    putFS bh s = error ("Binary.put_(FastString): " ++ unpackFS s)
            -- Note: the length of the FastString is *not* the same as
            -- the size of the ByteArray: the latter is rounded up to a
            -- multiple of the word size.

    {- -- possible faster version, not quite there yet:
    getFS bh@BinMem{} = do
      (I# l) <- get bh
      arr <- readIORef (arr_r bh)
      off <- readFastMutInt (off_r bh)
      return $! (mkFastSubStringBA# arr off l)
    -}
    getFS bh = do
      (I# l) <- get bh
      (BA ba) <- getByteArray bh (I# l)
      return $! (mkFastSubStringBA# ba 0# l)

    instance Binary FastString where
      put_ bh f@(FastString id l ba) =
        case getUserData bh of {
            UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do
        out <- readIORef out_r
        let uniq = getUnique f
        case lookupUFM out uniq of
            Just (j,f)  -> put_ bh j
            Nothing -> do
               j <- readIORef j_r
               put_ bh j
               writeIORef j_r (j+1)
               writeIORef out_r (addToUFM out uniq (j,f))
        }
      put_ bh s = error ("Binary.put_(FastString): " ++ show (unpackFS s))

      get bh = do
            j <- get bh
            return $! (ud_dict (getUserData bh) ! j)
    -}

    printElapsedTime :: String -> IO ()
    printElapsedTime :: String -> IO ()
    printElapsedTime String
    msg = do
      Integer
    time <- IO Integer
    getCPUTime
      Handle -> String -> IO ()
    hPutStr Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "elapsed time: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe Int -> Double -> ShowS
    forall a. RealFloat a => Maybe Int -> a -> ShowS
    Numeric.showFFloat (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    2) ((Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    time) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    10Double -> Integer -> Double
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Integer
    12) String
    " (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")\n"