    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE UnboxedTuples #-}

    {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
    -- We always optimise this, otherwise performance of a non-optimised
    -- compiler is severely affected

    --
    -- (c) The University of Glasgow 2002-2006
    --
    -- 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 GHC.Utils.Binary
      ( {-type-}  Bin,
        {-class-} Binary(..),
        {-type-}  BinHandle,
        SymbolTable, Dictionary,

       BinData(..), dataHandle, handleData,
       unsafeUnpackBinBuffer,

       openBinMem,
    --   closeBin,

       seekBin,
       tellBin,
       castBin,
       withBinBuffer,

       foldGet, foldGet',

       writeBinMem,
       readBinMem,
       readBinMemN,

       putAt, getAt,
       forwardPut, forwardPut_, forwardGet,

       -- * For writing instances
       putByte,
       getByte,
       putByteString,
       getByteString,

       -- * Variable length encodings
       putULEB128,
       getULEB128,
       putSLEB128,
       getSLEB128,

       -- * Fixed length encoding
       FixedLengthEncoding(..),

       -- * Lazy Binary I/O
       lazyGet,
       lazyPut,
       lazyGetMaybe,
       lazyPutMaybe,

       -- * User data
       UserData(..), getUserData, setUserData,
       newReadState, newWriteState, noUserData,

       -- * String table ("dictionary")
       putDictionary, getDictionary, putFS,
       FSTable, initFSTable, getDictFastString, putDictFastString,

       -- * Newtype wrappers
       BinSpan(..), BinSrcSpan(..), BinLocated(..)
      ) where

    import GHC.Prelude

    import Language.Haskell.Syntax.Module.Name (ModuleName(..))

    import {-# SOURCE #-} GHC.Types.Name (Name)
    import GHC.Data.FastString
    import GHC.Utils.Panic.Plain
    import GHC.Types.Unique.FM
    import GHC.Data.FastMutInt
    import GHC.Utils.Fingerprint
    import GHC.Types.SrcLoc
    import GHC.Types.Unique
    import qualified GHC.Data.Strict as Strict
    import GHC.Utils.Outputable( JoinPointHood(..) )

    import Control.DeepSeq
    import Foreign hiding (shiftL, shiftR, void)
    import Data.Array
    import Data.Array.IO
    import Data.Array.Unsafe
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Internal as BS
    import qualified Data.ByteString.Unsafe   as BS
    import Data.IORef
    import Data.Char                ( ord, chr )
    import Data.List.NonEmpty       ( NonEmpty(..))
    import qualified Data.List.NonEmpty as NonEmpty
    import Data.Set                 ( Set )
    import qualified Data.Set as Set
    import Data.Time
    import Data.List (unfoldr)
    import Control.Monad            ( when, (<$!>), unless, forM_, void )
    import System.IO as IO
    import System.IO.Unsafe         ( unsafeInterleaveIO )
    import System.IO.Error          ( mkIOError, eofErrorType )
    import GHC.Real                 ( Ratio(..) )
    import Data.IntMap (IntMap)
    import qualified Data.IntMap as IntMap
    #if MIN_VERSION_base(4,15,0)
    import GHC.ForeignPtr           ( unsafeWithForeignPtr )
    #endif

    type BinArray = ForeignPtr Word8

    #if !MIN_VERSION_base(4,15,0)
    unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr = withForeignPtr
    #endif

    ---------------------------------------------------------------
    -- BinData
    ---------------------------------------------------------------

    data BinData = BinData Int BinArray

    instance NFData BinData where
      rnf :: BinData -> ()
    rnf (BinData Int
    sz BinArray
    _) = Int -> ()
    forall a. NFData a => a -> ()
    rnf Int
    sz

    instance Binary BinData where
      put_ :: BinHandle -> BinData -> IO ()
    put_ BinHandle
    bh (BinData Int
    sz BinArray
    dat) = do
        BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    sz
        BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    bh Int
    sz ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    dest ->
          BinArray -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr BinArray
    dat ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    orig ->
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    dest Ptr Word8
    orig Int
    sz
      --
      get :: BinHandle -> IO BinData
    get BinHandle
    bh = do
        sz <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        dat <- mallocForeignPtrBytes sz
        getPrim bh sz $ \Ptr Word8
    orig ->
          BinArray -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr BinArray
    dat ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    dest ->
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    dest Ptr Word8
    orig Int
    sz
        return (BinData sz dat)

    dataHandle :: BinData -> IO BinHandle
    dataHandle :: BinData -> IO BinHandle
    dataHandle (BinData Int
    size BinArray
    bin) = do
      ixr <- Int -> IO FastMutInt
    newFastMutInt Int
    0
      szr <- newFastMutInt size
      binr <- newIORef bin
      return (BinMem noUserData ixr szr binr)

    handleData :: BinHandle -> IO BinData
    handleData :: BinHandle -> IO BinData
    handleData (BinMem UserData
    _ FastMutInt
    ixr FastMutInt
    _ IORef BinArray
    binr) = Int -> BinArray -> BinData
    BinData (Int -> BinArray -> BinData) -> IO Int -> IO (BinArray -> BinData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ixr IO (BinArray -> BinData) -> IO BinArray -> IO BinData
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    binr

    ---------------------------------------------------------------
    -- 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.

    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 }

    -- | Get access to the underlying buffer.
    withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a
    withBinBuffer :: forall a. BinHandle -> (ByteString -> IO a) -> IO a
    withBinBuffer (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    _ IORef BinArray
    arr_r) ByteString -> IO a
    action = do
      arr <- IORef BinArray -> IO BinArray
    forall a. IORef a -> IO a
    readIORef IORef BinArray
    arr_r
      ix <- readFastMutInt ix_r
      action $ BS.fromForeignPtr arr 0 ix

    unsafeUnpackBinBuffer :: ByteString -> IO BinHandle
    unsafeUnpackBinBuffer :: ByteString -> IO BinHandle
    unsafeUnpackBinBuffer (BS.BS BinArray
    arr Int
    len) = do
      arr_r <- BinArray -> IO (IORef BinArray)
    forall a. a -> IO (IORef a)
    newIORef BinArray
    arr
      ix_r <- newFastMutInt 0
      sz_r <- newFastMutInt len
      return (BinMem noUserData ix_r sz_r arr_r)

    ---------------------------------------------------------------
    -- 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. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall k (a :: k). Bin a -> Bin a -> Bool
    $c== :: forall k (a :: k). Bin a -> Bin a -> Bool
    == :: Bin a -> Bin a -> Bool
    $c/= :: forall k (a :: k). 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 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 k (a :: k). Eq (Bin a)
    forall k (a :: k). Bin a -> Bin a -> Bool
    forall k (a :: k). Bin a -> Bin a -> Ordering
    forall k (a :: k). Bin a -> Bin a -> Bin a
    $ccompare :: forall k (a :: k). Bin a -> Bin a -> Ordering
    compare :: Bin a -> Bin a -> Ordering
    $c< :: forall k (a :: k). Bin a -> Bin a -> Bool
    < :: Bin a -> Bin a -> Bool
    $c<= :: forall k (a :: k). Bin a -> Bin a -> Bool
    <= :: Bin a -> Bin a -> Bool
    $c> :: forall k (a :: k). Bin a -> Bin a -> Bool
    > :: Bin a -> Bin a -> Bool
    $c>= :: forall k (a :: k). Bin a -> Bin a -> Bool
    >= :: Bin a -> Bin a -> Bool
    $cmax :: forall k (a :: k). Bin a -> Bin a -> Bin a
    max :: Bin a -> Bin a -> Bin a
    $cmin :: forall k (a :: k). 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 -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall k (a :: k). Int -> Bin a -> ShowS
    forall k (a :: k). [Bin a] -> ShowS
    forall k (a :: k). Bin a -> String
    $cshowsPrec :: forall k (a :: k). Int -> Bin a -> ShowS
    showsPrec :: Int -> Bin a -> ShowS
    $cshow :: forall k (a :: k). Bin a -> String
    show :: Bin a -> String
    $cshowList :: forall k (a :: k). [Bin a] -> ShowS
    showList :: [Bin a] -> ShowS
    Show, Bin a
    Bin a -> Bin a -> Bounded (Bin a)
    forall a. a -> a -> Bounded a
    forall k (a :: k). Bin a
    $cminBound :: forall k (a :: k). Bin a
    minBound :: Bin a
    $cmaxBound :: forall k (a :: k). Bin a
    maxBound :: Bin a
    Bounded)

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

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

    -- | Do not rely on instance sizes for general types,
    -- we use variable length encoding for many of them.
    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; return ()
        put BinHandle
    bh a
    a  = do p <- BinHandle -> IO (Bin a)
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh; put_ bh a; return 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 {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin a
    p; BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    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 {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin a
    p; BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    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
    "GHC.Utils.Binary.openBinMem: size must be >= 0"
     | Bool
    otherwise = do
       arr <- Int -> IO BinArray
    forall a. Int -> IO (ForeignPtr a)
    mallocForeignPtrBytes Int
    size
       arr_r <- newIORef arr
       ix_r <- newFastMutInt 0
       sz_r <- newFastMutInt size
       return (BinMem noUserData ix_r sz_r arr_r)

    tellBin :: BinHandle -> IO (Bin a)
    tellBin :: forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin (BinMem UserData
    _ FastMutInt
    r FastMutInt
    _ IORef BinArray
    _) = do ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    r; return (BinPtr ix)

    seekBin :: BinHandle -> Bin a -> IO ()
    seekBin :: forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin h :: BinHandle
    h@(BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    _) (BinPtr !Int
    p) = do
      sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
      if (p > sz)
            then do expandBin h p; writeFastMutInt ix_r p
            else writeFastMutInt ix_r p

    -- | 'seekBinNoExpand' moves the index pointer to the location pointed to
    -- by 'Bin a'.
    -- This operation may 'panic', if the pointer location is out of bounds of the
    -- buffer of 'BinHandle'.
    seekBinNoExpand :: BinHandle -> Bin a -> IO ()
    seekBinNoExpand :: forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBinNoExpand (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    _) (BinPtr !Int
    p) = do
      sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
      if (p > sz)
            then panic "seekBinNoExpand: seek out of range"
            else writeFastMutInt ix_r p

    writeBinMem :: BinHandle -> FilePath -> IO ()
    writeBinMem :: BinHandle -> String -> IO ()
    writeBinMem (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    _ IORef BinArray
    arr_r) String
    fn = do
      h <- String -> IOMode -> IO Handle
    openBinaryFile String
    fn IOMode
    WriteMode
      arr <- readIORef arr_r
      ix  <- readFastMutInt ix_r
      unsafeWithForeignPtr arr $ \Ptr Word8
    p -> Handle -> Ptr Word8 -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    hPutBuf Handle
    h Ptr Word8
    p Int
    ix
      hClose h

    readBinMem :: FilePath -> IO BinHandle
    readBinMem :: String -> IO BinHandle
    readBinMem String
    filename = do
      String -> IOMode -> (Handle -> IO BinHandle) -> IO BinHandle
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    filename IOMode
    ReadMode ((Handle -> IO BinHandle) -> IO BinHandle)
    -> (Handle -> IO BinHandle) -> IO BinHandle
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        filesize' <- Handle -> IO Integer
    hFileSize Handle
    h
        let filesize = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    filesize'
        readBinMem_ filesize h

    readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle)
    readBinMemN :: Int -> String -> IO (Maybe BinHandle)
    readBinMemN Int
    size String
    filename = do
      String
    -> IOMode
    -> (Handle -> IO (Maybe BinHandle))
    -> IO (Maybe BinHandle)
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    filename IOMode
    ReadMode ((Handle -> IO (Maybe BinHandle)) -> IO (Maybe BinHandle))
    -> (Handle -> IO (Maybe BinHandle)) -> IO (Maybe BinHandle)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        filesize' <- Handle -> IO Integer
    hFileSize Handle
    h
        let filesize = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    filesize'
        if filesize < size
          then pure Nothing
          else Just <$> readBinMem_ size h

    readBinMem_ :: Int -> Handle -> IO BinHandle
    readBinMem_ :: Int -> Handle -> IO BinHandle
    readBinMem_ Int
    filesize Handle
    h = do
      arr <- Int -> IO BinArray
    forall a. Int -> IO (ForeignPtr a)
    mallocForeignPtrBytes Int
    filesize
      count <- unsafeWithForeignPtr arr $ \Ptr Word8
    p -> Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBuf Handle
    h Ptr Word8
    p Int
    filesize
      when (count /= filesize) $
           error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
      arr_r <- newIORef arr
      ix_r <- newFastMutInt 0
      sz_r <- newFastMutInt filesize
      return (BinMem noUserData ix_r sz_r 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
    _ FastMutInt
    sz_r IORef BinArray
    arr_r) !Int
    off = do
       !sz <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    sz_r
       let !sz' = Int -> Int
    getSize Int
    sz
       arr <- readIORef arr_r
       arr' <- mallocForeignPtrBytes sz'
       withForeignPtr arr $ \Ptr Word8
    old ->
         BinArray -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr BinArray
    arr' ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    new ->
           Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    new Ptr Word8
    old Int
    sz
       writeFastMutInt sz_r sz'
       writeIORef arr_r arr'
       where
        getSize :: Int -> Int
        getSize :: Int -> Int
    getSize !Int
    sz
          | Int
    sz Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    off
          = Int
    sz
          | Bool
    otherwise
          = Int -> Int
    getSize (Int
    sz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2)

    foldGet
      :: Binary a
      => Word -- n elements
      -> BinHandle
      -> b -- initial accumulator
      -> (Word -> a -> b -> IO b)
      -> IO b
    foldGet :: forall a b.
    Binary a =>
    Word -> BinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
    foldGet Word
    n BinHandle
    bh b
    init_b Word -> a -> b -> IO b
    f = Word -> b -> IO b
    go Word
    0 b
    init_b
      where
        go :: Word -> b -> IO b
    go Word
    i b
    b
          | Word
    i Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    n    = b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    b
          | Bool
    otherwise = do
              a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
              b' <- f i a b
              go (i+1) b'

    foldGet'
      :: Binary a
      => Word -- n elements
      -> BinHandle
      -> b -- initial accumulator
      -> (Word -> a -> b -> IO b)
      -> IO b
    {-# INLINE foldGet' #-}
    foldGet' :: forall a b.
    Binary a =>
    Word -> BinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
    foldGet' Word
    n BinHandle
    bh b
    init_b Word -> a -> b -> IO b
    f = Word -> b -> IO b
    go Word
    0 b
    init_b
      where
        go :: Word -> b -> IO b
    go Word
    i !b
    b
          | Word
    i Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    n    = b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    b
          | Bool
    otherwise = do
              !a  <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
              b'  <- f i a b
              go (i+1) b'

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

    -- | Takes a size and action writing up to @size@ bytes.
    --   After the action has run advance the index to the buffer
    --   by size bytes.
    putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim h :: BinHandle
    h@(BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) Int
    size Ptr Word8 -> IO ()
    f = do
      ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
      sz <- readFastMutInt sz_r
      when (ix + size > sz) $
        expandBin h (ix + size)
      arr <- readIORef arr_r
      unsafeWithForeignPtr arr $ \Ptr Word8
    op -> Ptr Word8 -> IO ()
    f (Ptr Word8
    op Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    ix)
      writeFastMutInt ix_r (ix + size)

    -- -- | Similar to putPrim but advances the index by the actual number of
    -- -- bytes written.
    -- putPrimMax :: BinHandle -> Int -> (Ptr Word8 -> IO Int) -> IO ()
    -- putPrimMax h@(BinMem _ ix_r sz_r arr_r) size f = do
    --   ix <- readFastMutInt ix_r
    --   sz <- readFastMutInt sz_r
    --   when (ix + size > sz) $
    --     expandBin h (ix + size)
    --   arr <- readIORef arr_r
    --   written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)
    --   writeFastMutInt ix_r (ix + written)

    getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim :: forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim (BinMem UserData
    _ FastMutInt
    ix_r FastMutInt
    sz_r IORef BinArray
    arr_r) Int
    size Ptr Word8 -> IO a
    f = do
      ix <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    ix_r
      sz <- readFastMutInt sz_r
      when (ix + size > sz) $
          ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
      arr <- readIORef arr_r
      w <- unsafeWithForeignPtr arr $ \Ptr Word8
    p -> Ptr Word8 -> IO a
    f (Ptr Word8
    p Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    ix)
        -- This is safe WRT #17760 as we we guarantee that the above line doesn't
        -- diverge
      writeFastMutInt ix_r (ix + size)
      return w

    putWord8 :: BinHandle -> Word8 -> IO ()
    putWord8 :: BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    h !Word8
    w = BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    h Int
    1 (\Ptr Word8
    op -> Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    op Word8
    w)

    getWord8 :: BinHandle -> IO Word8
    getWord8 :: BinHandle -> IO Word8
    getWord8 BinHandle
    h = BinHandle -> Int -> (Ptr Word8 -> IO Word8) -> IO Word8
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    h Int
    1 Ptr Word8 -> IO Word8
    forall a. Storable a => Ptr a -> IO a
    peek

    putWord16 :: BinHandle -> Word16 -> IO ()
    putWord16 :: BinHandle -> Word16 -> IO ()
    putWord16 BinHandle
    h Word16
    w = BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    h Int
    2 (\Ptr Word8
    op -> do
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    0 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    1 (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))
      )

    getWord16 :: BinHandle -> IO Word16
    getWord16 :: BinHandle -> IO Word16
    getWord16 BinHandle
    h = BinHandle -> Int -> (Ptr Word8 -> IO Word16) -> IO Word16
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    h Int
    2 (\Ptr Word8
    op -> do
      w0 <- Word8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word16) -> IO Word8 -> IO Word16
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    op Int
    0
      w1 <- fromIntegral <$> peekElemOff op 1
      return $! w0 `shiftL` 8 .|. w1
      )

    putWord32 :: BinHandle -> Word32 -> IO ()
    putWord32 :: BinHandle -> Word32 -> IO ()
    putWord32 BinHandle
    h Word32
    w = BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    h Int
    4 (\Ptr Word8
    op -> do
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    0 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    1 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    2 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    3 (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))
      )

    getWord32 :: BinHandle -> IO Word32
    getWord32 :: BinHandle -> IO Word32
    getWord32 BinHandle
    h = BinHandle -> Int -> (Ptr Word8 -> IO Word32) -> IO Word32
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    h Int
    4 (\Ptr Word8
    op -> do
      w0 <- Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word32) -> IO Word8 -> IO Word32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    op Int
    0
      w1 <- fromIntegral <$> peekElemOff op 1
      w2 <- fromIntegral <$> peekElemOff op 2
      w3 <- fromIntegral <$> peekElemOff op 3

      return $! (w0 `shiftL` 24) .|.
                (w1 `shiftL` 16) .|.
                (w2 `shiftL` 8)  .|.
                w3
      )

    putWord64 :: BinHandle -> Word64 -> IO ()
    putWord64 :: BinHandle -> Word64 -> IO ()
    putWord64 BinHandle
    h Word64
    w = BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    h Int
    8 (\Ptr Word8
    op -> do
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    0 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    1 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    2 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    3 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    4 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    5 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    6 (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))
      Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    op Int
    7 (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))
      )

    getWord64 :: BinHandle -> IO Word64
    getWord64 :: BinHandle -> IO Word64
    getWord64 BinHandle
    h = BinHandle -> Int -> (Ptr Word8 -> IO Word64) -> IO Word64
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    h Int
    8 (\Ptr Word8
    op -> do
      w0 <- Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word64) -> IO Word8 -> IO Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    op Int
    0
      w1 <- fromIntegral <$> peekElemOff op 1
      w2 <- fromIntegral <$> peekElemOff op 2
      w3 <- fromIntegral <$> peekElemOff op 3
      w4 <- fromIntegral <$> peekElemOff op 4
      w5 <- fromIntegral <$> peekElemOff op 5
      w6 <- fromIntegral <$> peekElemOff op 6
      w7 <- fromIntegral <$> peekElemOff op 7

      return $! (w0 `shiftL` 56) .|.
                (w1 `shiftL` 48) .|.
                (w2 `shiftL` 40) .|.
                (w3 `shiftL` 32) .|.
                (w4 `shiftL` 24) .|.
                (w5 `shiftL` 16) .|.
                (w6 `shiftL` 8)  .|.
                w7
      )

    putByte :: BinHandle -> Word8 -> IO ()
    putByte :: BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh !Word8
    w = BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    w

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

    -- -----------------------------------------------------------------------------
    -- Encode numbers in LEB128 encoding.
    -- Requires one byte of space per 7 bits of data.
    --
    -- There are signed and unsigned variants.
    -- Do NOT use the unsigned one for signed values, at worst it will
    -- result in wrong results, at best it will lead to bad performance
    -- when coercing negative values to an unsigned type.
    --
    -- We mark them as SPECIALIZE as it's extremely critical that they get specialized
    -- to their specific types.
    --
    -- TODO: Each use of putByte performs a bounds check,
    --       we should use putPrimMax here. However it's quite hard to return
    --       the number of bytes written into putPrimMax without allocating an
    --       Int for it, while the code below does not allocate at all.
    --       So we eat the cost of the bounds check instead of increasing allocations
    --       for now.

    -- Unsigned numbers
    {-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-}
    {-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-}
    putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
    putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
    putULEB128 BinHandle
    bh a
    w =
    #if defined(DEBUG)
        (if w < 0 then panic "putULEB128: Signed number" else id) $
    #endif
        a -> IO ()
    go a
    w
      where
        go :: a -> IO ()
        go :: a -> IO ()
    go a
    w
          | a
    w a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (a
    127 :: a)
          = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh (a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    w :: Word8)
          | Bool
    otherwise = do
            -- bit 7 (8th bit) indicates more to come.
            let !byte :: Word8
    byte = Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    setBit (a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    w) Int
    7 :: Word8
            BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    byte
            a -> IO ()
    go (a
    w a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    7)

    {-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-}
    {-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-}
    getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
    getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
    getULEB128 BinHandle
    bh =
        Int -> a -> IO a
    go Int
    0 a
    0
      where
        go :: Int -> a -> IO a
        go :: Int -> a -> IO a
    go Int
    shift a
    w = do
            b <- BinHandle -> IO Word8
    getByte BinHandle
    bh
            let !hasMore = Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word8
    b Int
    7
            let !val = a
    w a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. ((a -> Int -> a
    forall a. Bits a => a -> Int -> a
    clearBit (Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    b) Int
    7) a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    shift) :: a
            if hasMore
                then do
                    go (shift+7) val
                else
                    return $! val

    -- Signed numbers
    {-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-}
    {-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-}
    putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
    putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
    putSLEB128 BinHandle
    bh a
    initial = a -> IO ()
    go a
    initial
      where
        go :: a -> IO ()
        go :: a -> IO ()
    go a
    val = do
            let !byte :: Word8
    byte = a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int -> a
    forall a. Bits a => a -> Int -> a
    clearBit a
    val Int
    7) :: Word8
            let !val' :: a
    val' = a
    val a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    7
            let !signBit :: Bool
    signBit = Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word8
    byte Int
    6
            let !done :: Bool
    done =
                    -- Unsigned value, val' == 0 and last value can
                    -- be discriminated from a negative number.
                    ((a
    val' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    signBit) Bool -> Bool -> Bool
    ||
                    -- Signed value,
                     (a
    val' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1 Bool -> Bool -> Bool
    && Bool
    signBit))

            let !byte' :: Word8
    byte' = if Bool
    done then Word8
    byte else Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    setBit Word8
    byte Int
    7
            BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    byte'

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    done (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ a -> IO ()
    go a
    val'

    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-}
    {-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-}
    getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
    getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
    getSLEB128 BinHandle
    bh = do
        (val,shift,signed) <- Int -> a -> IO (a, Int, Bool)
    go Int
    0 a
    0
        if signed && (shift < finiteBitSize val )
            then return $! ((complement 0 `unsafeShiftL` shift) .|. val)
            else return val
        where
            go :: Int -> a -> IO (a,Int,Bool)
            go :: Int -> a -> IO (a, Int, Bool)
    go Int
    shift a
    val = do
                byte <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                let !byteVal = Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    clearBit Word8
    byte Int
    7) :: a
                let !val' = a
    val a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. (a
    byteVal a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    shift)
                let !more = Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word8
    byte Int
    7
                let !shift' = Int
    shiftInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    7
                if more
                    then go (shift') val'
                    else do
                        let !signed = Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word8
    byte Int
    6
                        return (val',shift',signed)

    -- -----------------------------------------------------------------------------
    -- Fixed length encoding instances

    -- Sometimes words are used to represent a certain bit pattern instead
    -- of a number. Using FixedLengthEncoding we will write the pattern as
    -- is to the interface file without the variable length encoding we usually
    -- apply.

    -- | Encode the argument in its full length. This is different from many default
    -- binary instances which make no guarantee about the actual encoding and
    -- might do things using variable length encoding.
    newtype FixedLengthEncoding a
      = FixedLengthEncoding { forall a. FixedLengthEncoding a -> a
    unFixedLength :: a }
      deriving (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> Eq (FixedLengthEncoding a)
    forall a.
    Eq a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a.
    Eq a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    == :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    $c/= :: forall a.
    Eq a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    /= :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    Eq,Eq (FixedLengthEncoding a)
    Eq (FixedLengthEncoding a) =>
    (FixedLengthEncoding a -> FixedLengthEncoding a -> Ordering)
    -> (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> (FixedLengthEncoding a -> FixedLengthEncoding a -> Bool)
    -> (FixedLengthEncoding a
        -> FixedLengthEncoding a -> FixedLengthEncoding a)
    -> (FixedLengthEncoding a
        -> FixedLengthEncoding a -> FixedLengthEncoding a)
    -> Ord (FixedLengthEncoding a)
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    FixedLengthEncoding a -> FixedLengthEncoding a -> Ordering
    FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding 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. Ord a => Eq (FixedLengthEncoding a)
    forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Ordering
    forall a.
    Ord a =>
    FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding a
    $ccompare :: forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Ordering
    compare :: FixedLengthEncoding a -> FixedLengthEncoding a -> Ordering
    $c< :: forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    < :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    $c<= :: forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    <= :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    $c> :: forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    > :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    $c>= :: forall a.
    Ord a =>
    FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    >= :: FixedLengthEncoding a -> FixedLengthEncoding a -> Bool
    $cmax :: forall a.
    Ord a =>
    FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding a
    max :: FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding a
    $cmin :: forall a.
    Ord a =>
    FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding a
    min :: FixedLengthEncoding a
    -> FixedLengthEncoding a -> FixedLengthEncoding a
    Ord,Int -> FixedLengthEncoding a -> ShowS
    [FixedLengthEncoding a] -> ShowS
    FixedLengthEncoding a -> String
    (Int -> FixedLengthEncoding a -> ShowS)
    -> (FixedLengthEncoding a -> String)
    -> ([FixedLengthEncoding a] -> ShowS)
    -> Show (FixedLengthEncoding a)
    forall a. Show a => Int -> FixedLengthEncoding a -> ShowS
    forall a. Show a => [FixedLengthEncoding a] -> ShowS
    forall a. Show a => FixedLengthEncoding a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> FixedLengthEncoding a -> ShowS
    showsPrec :: Int -> FixedLengthEncoding a -> ShowS
    $cshow :: forall a. Show a => FixedLengthEncoding a -> String
    show :: FixedLengthEncoding a -> String
    $cshowList :: forall a. Show a => [FixedLengthEncoding a] -> ShowS
    showList :: [FixedLengthEncoding a] -> ShowS
    Show)

    instance Binary (FixedLengthEncoding Word8) where
      put_ :: BinHandle -> FixedLengthEncoding Word8 -> IO ()
    put_ BinHandle
    h (FixedLengthEncoding Word8
    x) = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    h Word8
    x
      get :: BinHandle -> IO (FixedLengthEncoding Word8)
    get BinHandle
    h = Word8 -> FixedLengthEncoding Word8
    forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding (Word8 -> FixedLengthEncoding Word8)
    -> IO Word8 -> IO (FixedLengthEncoding Word8)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO Word8
    getByte BinHandle
    h

    instance Binary (FixedLengthEncoding Word16) where
      put_ :: BinHandle -> FixedLengthEncoding Word16 -> IO ()
    put_ BinHandle
    h (FixedLengthEncoding Word16
    x) = BinHandle -> Word16 -> IO ()
    putWord16 BinHandle
    h Word16
    x
      get :: BinHandle -> IO (FixedLengthEncoding Word16)
    get BinHandle
    h = Word16 -> FixedLengthEncoding Word16
    forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding (Word16 -> FixedLengthEncoding Word16)
    -> IO Word16 -> IO (FixedLengthEncoding Word16)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO Word16
    getWord16 BinHandle
    h

    instance Binary (FixedLengthEncoding Word32) where
      put_ :: BinHandle -> FixedLengthEncoding Word32 -> IO ()
    put_ BinHandle
    h (FixedLengthEncoding Word32
    x) = BinHandle -> Word32 -> IO ()
    putWord32 BinHandle
    h Word32
    x
      get :: BinHandle -> IO (FixedLengthEncoding Word32)
    get BinHandle
    h = Word32 -> FixedLengthEncoding Word32
    forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding (Word32 -> FixedLengthEncoding Word32)
    -> IO Word32 -> IO (FixedLengthEncoding Word32)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO Word32
    getWord32 BinHandle
    h

    instance Binary (FixedLengthEncoding Word64) where
      put_ :: BinHandle -> FixedLengthEncoding Word64 -> IO ()
    put_ BinHandle
    h (FixedLengthEncoding Word64
    x) = BinHandle -> Word64 -> IO ()
    putWord64 BinHandle
    h Word64
    x
      get :: BinHandle -> IO (FixedLengthEncoding Word64)
    get BinHandle
    h = Word64 -> FixedLengthEncoding Word64
    forall a. a -> FixedLengthEncoding a
    FixedLengthEncoding (Word64 -> FixedLengthEncoding Word64)
    -> IO Word64 -> IO (FixedLengthEncoding Word64)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO Word64
    getWord64 BinHandle
    h

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

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

    instance Binary Word16 where
      put_ :: BinHandle -> Word16 -> IO ()
    put_ = BinHandle -> Word16 -> IO ()
    forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
    putULEB128
      get :: BinHandle -> IO Word16
    get  = BinHandle -> IO Word16
    forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
    getULEB128

    instance Binary Word32 where
      put_ :: BinHandle -> Word32 -> IO ()
    put_ = BinHandle -> Word32 -> IO ()
    forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
    putULEB128
      get :: BinHandle -> IO Word32
    get  = BinHandle -> IO Word32
    forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
    getULEB128

    instance Binary Word64 where
      put_ :: BinHandle -> Word64 -> IO ()
    put_ = BinHandle -> Word64 -> IO ()
    forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
    putULEB128
      get :: BinHandle -> IO Word64
    get = BinHandle -> IO Word64
    forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
    getULEB128

    -- -----------------------------------------------------------------------------
    -- 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 w <- BinHandle -> IO Word8
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; return $! (fromIntegral (w::Word8))

    instance Binary Int16 where
      put_ :: BinHandle -> Int16 -> IO ()
    put_ = BinHandle -> Int16 -> IO ()
    forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
    putSLEB128
      get :: BinHandle -> IO Int16
    get = BinHandle -> IO Int16
    forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
    getSLEB128

    instance Binary Int32 where
      put_ :: BinHandle -> Int32 -> IO ()
    put_ = BinHandle -> Int32 -> IO ()
    forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
    putSLEB128
      get :: BinHandle -> IO Int32
    get = BinHandle -> IO Int32
    forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
    getSLEB128

    instance Binary Int64 where
      put_ :: BinHandle -> Int64 -> IO ()
    put_ BinHandle
    h Int64
    w = BinHandle -> Int64 -> IO ()
    forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
    putSLEB128 BinHandle
    h Int64
    w
      get :: BinHandle -> IO Int64
    get BinHandle
    h    = BinHandle -> IO Int64
    forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
    getSLEB128 BinHandle
    h

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

    instance Binary () where
        put_ :: BinHandle -> () -> IO ()
    put_ BinHandle
    _ () = () -> 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 ()

    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 x <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh; return $! (toEnum (fromIntegral x))

    instance Binary Char where
        put_ :: BinHandle -> Char -> IO ()
    put_  BinHandle
    bh Char
    c = BinHandle -> Word32 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c) :: Word32)
        get :: BinHandle -> IO Char
    get  BinHandle
    bh   = do x <- BinHandle -> IO Word32
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; return $! (chr (fromIntegral (x :: Word32)))

    instance Binary Int where
        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
            x <- BinHandle -> IO Int64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            return $! (fromIntegral (x :: Int64))

    instance Binary a => Binary [a] where
        put_ :: BinHandle -> [a] -> IO ()
    put_ BinHandle
    bh [a]
    l = do
            let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    l
            BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    len
            (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]
    l
        get :: BinHandle -> IO [a]
    get BinHandle
    bh = do
            len <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int -- Int is variable length encoded so only
                                    -- one byte for small lists.
            let loop Int
    0 = [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                loop Int
    n = do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; as <- loop (n-1); return (a:as)
            loop len

    -- | This instance doesn't rely on the determinism of the keys' 'Ord' instance,
    -- so it works e.g. for 'Name's too.
    instance (Binary a, Ord a) => Binary (Set a) where
      put_ :: BinHandle -> Set a -> IO ()
    put_ BinHandle
    bh Set a
    s = BinHandle -> [a] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Set a -> [a]
    forall a. Set a -> [a]
    Set.toList Set a
    s)
      get :: BinHandle -> IO (Set a)
    get BinHandle
    bh = [a] -> Set a
    forall a. Ord a => [a] -> Set a
    Set.fromList ([a] -> Set a) -> IO [a] -> IO (Set a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO [a]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    instance Binary a => Binary (NonEmpty a) where
        put_ :: BinHandle -> NonEmpty a -> IO ()
    put_ BinHandle
    bh = BinHandle -> [a] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh ([a] -> IO ()) -> (NonEmpty a -> [a]) -> NonEmpty a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty a -> [a]
    forall a. NonEmpty a -> [a]
    NonEmpty.toList
        get :: BinHandle -> IO (NonEmpty a)
    get BinHandle
    bh = [a] -> NonEmpty a
    forall a. HasCallStack => [a] -> NonEmpty a
    NonEmpty.fromList ([a] -> NonEmpty a) -> IO [a] -> IO (NonEmpty a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO [a]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

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

    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 <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                           b <- get bh
                           return (a,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 <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                             b <- get bh
                             c <- get bh
                             return (a,b,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 <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                               b <- get bh
                               c <- get bh
                               d <- get bh
                               return (a,b,c,d)

    instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where
        put_ :: BinHandle -> (a, b, c, d, e) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b,c
    c,d
    d, e
    e) = 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; BinHandle -> e -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh e
    e;
        get :: BinHandle -> IO (a, b, c, d, e)
    get BinHandle
    bh               = do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                                  b <- get bh
                                  c <- get bh
                                  d <- get bh
                                  e <- get bh
                                  return (a,b,c,d,e)

    instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where
        put_ :: BinHandle -> (a, b, c, d, e, f) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b,c
    c,d
    d, e
    e, f
    f) = 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; BinHandle -> e -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh e
    e; BinHandle -> f -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh f
    f;
        get :: BinHandle -> IO (a, b, c, d, e, f)
    get BinHandle
    bh                  = do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                                     b <- get bh
                                     c <- get bh
                                     d <- get bh
                                     e <- get bh
                                     f <- get bh
                                     return (a,b,c,d,e,f)

    instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a,b,c,d,e,f,g) where
        put_ :: BinHandle -> (a, b, c, d, e, f, g) -> IO ()
    put_ BinHandle
    bh (a
    a,b
    b,c
    c,d
    d,e
    e,f
    f,g
    g) = 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; BinHandle -> e -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh e
    e; BinHandle -> f -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh f
    f; BinHandle -> g -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh g
    g
        get :: BinHandle -> IO (a, b, c, d, e, f, g)
    get BinHandle
    bh                  = do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                                     b <- get bh
                                     c <- get bh
                                     d <- get bh
                                     e <- get bh
                                     f <- get bh
                                     g <- get bh
                                     return (a,b,c,d,e,f,g)

    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 h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
                              case 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 x <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; return (Just x)

    instance Binary a => Binary (Strict.Maybe a) where
        put_ :: BinHandle -> Maybe a -> IO ()
    put_ BinHandle
    bh Maybe a
    Strict.Nothing = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
        put_ BinHandle
    bh (Strict.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 h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
             case 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
    Strict.Nothing
               Word8
    _ -> do x <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; return (Strict.Just 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 h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
                               case h of
                                 Word8
    0 -> do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh ; return (Left a)
                                 Word8
    _ -> do b <- BinHandle -> IO b
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh ; return (Right b)

    instance Binary UTCTime where
        put_ :: BinHandle -> UTCTime -> IO ()
    put_ BinHandle
    bh UTCTime
    u = do BinHandle -> Day -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (UTCTime -> Day
    utctDay UTCTime
    u)
                       BinHandle -> DiffTime -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (UTCTime -> DiffTime
    utctDayTime UTCTime
    u)
        get :: BinHandle -> IO UTCTime
    get BinHandle
    bh = do day <- BinHandle -> IO Day
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                    dayTime <- get bh
                    return $ UTCTime { utctDay = day, utctDayTime = dayTime }

    instance Binary Day where
        put_ :: BinHandle -> Day -> IO ()
    put_ BinHandle
    bh Day
    d = BinHandle -> Integer -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Day -> Integer
    toModifiedJulianDay Day
    d)
        get :: BinHandle -> IO Day
    get BinHandle
    bh = do i <- BinHandle -> IO Integer
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                    return $ ModifiedJulianDay { toModifiedJulianDay = i }

    instance Binary DiffTime where
        put_ :: BinHandle -> DiffTime -> IO ()
    put_ BinHandle
    bh DiffTime
    dt = BinHandle -> Rational -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (DiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational DiffTime
    dt)
        get :: BinHandle -> IO DiffTime
    get BinHandle
    bh = do r <- BinHandle -> IO Rational
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                    return $ fromRational r

    instance Binary JoinPointHood where
        put_ :: BinHandle -> JoinPointHood -> IO ()
    put_ BinHandle
    bh JoinPointHood
    NotJoinPoint = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
        put_ BinHandle
    bh (JoinPoint Int
    ar) = do
            BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1
            BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    ar
        get :: BinHandle -> IO JoinPointHood
    get BinHandle
    bh = do
            h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
            case h of
                Word8
    0 -> JoinPointHood -> IO JoinPointHood
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JoinPointHood
    NotJoinPoint
                Word8
    _ -> do { ar <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; return (JoinPoint ar) }

    {-
    Finally - a reasonable portable Integer instance.

    We used to encode values in the Int32 range as such,
    falling back to a string of all things. In either case
    we stored a tag byte to discriminate between the two cases.

    This made some sense as it's highly portable but also not very
    efficient.

    However GHC stores a surprisingly large number of large Integer
    values. In the examples looked at between 25% and 50% of Integers
    serialized were outside of the Int32 range.

    Consider a value like `2724268014499746065`, some sort of hash
    actually generated by GHC.
    In the old scheme this was encoded as a list of 19 chars. This
    gave a size of 77 Bytes, one for the length of the list and 76
    since we encode chars as Word32 as well.

    We can easily do better. The new plan is:

    * Start with a tag byte
      * 0 => Int64 (LEB128 encoded)
      * 1 => Negative large integer
      * 2 => Positive large integer
    * Followed by the value:
      * Int64 is encoded as usual
      * Large integers are encoded as a list of bytes (Word8).
        We use Data.Bits which defines a bit order independent of the representation.
        Values are stored LSB first.

    This means our example value `2724268014499746065` is now only 10 bytes large.
    * One byte tag
    * One byte for the length of the [Word8] list.
    * 8 bytes for the actual date.

    The new scheme also does not depend in any way on
    architecture specific details.

    We still use this scheme even with LEB128 available,
    as it has less overhead for truly large numbers. (> maxBound :: Int64)

    The instance is used for in Binary Integer and Binary Rational in GHC.Types.Literal
    -}

    instance Binary Integer where
        put_ :: BinHandle -> Integer -> IO ()
    put_ BinHandle
    bh Integer
    i
          | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    lo64 Bool -> Bool -> Bool
    && Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    hi64 = do
              BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    0
              BinHandle -> Int64 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: Int64)
          | Bool
    otherwise = do
              if Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0
                then BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    1
                else BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    2
              BinHandle -> [Word8] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Integer -> [Word8]
    unroll (Integer -> [Word8]) -> Integer -> [Word8]
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    i)
          where
            lo64 :: Integer
    lo64 = Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    forall a. Bounded a => a
    minBound :: Int64)
            hi64 :: Integer
    hi64 = Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    forall a. Bounded a => a
    maxBound :: Int64)
        get :: BinHandle -> IO Integer
    get BinHandle
    bh = do
          int_kind <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
          case int_kind of
            Word8
    0 -> Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Integer) -> IO Int64 -> IO Integer
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> (BinHandle -> IO Int64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int64)
            -- Large integer
            Word8
    1 -> Integer -> Integer
    forall a. Num a => a -> a
    negate (Integer -> Integer) -> IO Integer -> IO Integer
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> IO Integer
    getInt
            Word8
    2 -> IO Integer
    getInt
            Word8
    _ -> String -> IO Integer
    forall a. HasCallStack => String -> a
    panic String
    "Binary Integer - Invalid byte"
            where
              getInt :: IO Integer
              getInt :: IO Integer
    getInt = [Word8] -> Integer
    roll ([Word8] -> Integer) -> IO [Word8] -> IO Integer
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> (BinHandle -> IO [Word8]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO [Word8])

    unroll :: Integer -> [Word8]
    unroll :: Integer -> [Word8]
    unroll = (Integer -> Maybe (Word8, Integer)) -> Integer -> [Word8]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr Integer -> Maybe (Word8, Integer)
    forall {b} {a}. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
    step
      where
        step :: b -> Maybe (a, b)
    step b
    0 = Maybe (a, b)
    forall a. Maybe a
    Nothing
        step b
    i = (a, b) -> Maybe (a, b)
    forall a. a -> Maybe a
    Just (b -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral b
    i, b
    i b -> Int -> b
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)

    roll :: [Word8] -> Integer
    roll :: [Word8] -> Integer
    roll   = (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Integer -> Word8 -> Integer
    forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
    unstep Integer
    0 ([Word8] -> Integer) -> ([Word8] -> [Word8]) -> [Word8] -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> [Word8]
    forall a. [a] -> [a]
    reverse
      where
        unstep :: a -> a -> a
    unstep a
    a a
    b = a
    a a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8 a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    b

        {-
        -- This code is currently commented out.
        -- See https://gitlab.haskell.org/ghc/ghc/issues/3379#note_104346 for
        -- discussion.

        put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
        put_ bh (J# s# a#) = do
            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 ()
    writeByteArray arr i (W8# w) = IO $ \s ->
      case writeWord8Array# arr i w s of { s ->
      (# s, () #) }

    indexByteArray :: ByteArray# -> Int# -> Word8
    indexByteArray a# n# = W8# (indexWord8Array# a# n#)

    -}
    instance (Binary a) => Binary (Ratio a) where
        put_ :: BinHandle -> Ratio a -> IO ()
    put_ BinHandle
    bh (a
    a :% a
    b) = do BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    a; BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    b
        get :: BinHandle -> IO (Ratio a)
    get BinHandle
    bh = do a <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; b <- get bh; return (a :% b)

    -- Instance uses fixed-width encoding to allow inserting
    -- Bin placeholders in the stream.
    instance Binary (Bin a) where
      put_ :: BinHandle -> Bin a -> IO ()
    put_ BinHandle
    bh (BinPtr Int
    i) = BinHandle -> Word32 -> IO ()
    putWord32 BinHandle
    bh (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i :: Word32)
      get :: BinHandle -> IO (Bin a)
    get BinHandle
    bh = do i <- BinHandle -> IO Word32
    getWord32 BinHandle
    bh; return (BinPtr (fromIntegral (i :: Word32)))

    -- -----------------------------------------------------------------------------
    -- Forward reading/writing

    -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B
    -- by using a forward reference
    forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b)
    forwardPut :: forall b a. BinHandle -> (b -> IO a) -> IO b -> IO (a, b)
    forwardPut BinHandle
    bh b -> IO a
    put_A IO b
    put_B = do
      -- write placeholder pointer to A
      pre_a <- BinHandle -> IO (Bin (Bin (ZonkAny 7)))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
      put_ bh pre_a

      -- write B
      r_b <- put_B

      -- update A's pointer
      a <- tellBin bh
      putAt bh pre_a a
      seekBinNoExpand bh a

      -- write A
      r_a <- put_A r_b
      pure (r_a,r_b)

    forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO ()
    forwardPut_ :: forall b a. BinHandle -> (b -> IO a) -> IO b -> IO ()
    forwardPut_ BinHandle
    bh b -> IO a
    put_A IO b
    put_B = IO (a, b) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (a, b) -> IO ()) -> IO (a, b) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ BinHandle -> (b -> IO a) -> IO b -> IO (a, b)
    forall b a. BinHandle -> (b -> IO a) -> IO b -> IO (a, b)
    forwardPut BinHandle
    bh b -> IO a
    put_A IO b
    put_B

    -- | Read a value stored using a forward reference
    forwardGet :: BinHandle -> IO a -> IO a
    forwardGet :: forall a. BinHandle -> IO a -> IO a
    forwardGet BinHandle
    bh IO a
    get_A = do
        -- read forward reference
        p <- BinHandle -> IO (Bin (ZonkAny 1))
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh -- a BinPtr
        -- store current position
        p_a <- tellBin bh
        -- go read the forward value, then seek back
        seekBinNoExpand bh p
        r <- get_A
        seekBinNoExpand bh p_a
        pure r

    -- -----------------------------------------------------------------------------
    -- 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:
        pre_a <- BinHandle -> IO (Bin (Bin (ZonkAny 9)))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
        put_ bh pre_a       -- save a slot for the ptr
        put_ bh a           -- dump the object
        q <- tellBin bh     -- q = ptr to after object
        putAt bh pre_a q    -- fill in slot before a with ptr to q
        seekBin bh 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
        p <- BinHandle -> IO (Bin (ZonkAny 5))
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh -- a BinPtr
        p_a <- tellBin bh
        a <- unsafeInterleaveIO $ do
            -- NB: Use a fresh off_r variable in the child thread, for thread
            -- safety.
            off_r <- newFastMutInt 0
            getAt bh { _off_r = off_r } p_a
        seekBin bh p -- skip over the object for now
        return a

    -- | Serialize the constructor strictly but lazily serialize a value inside a
    -- 'Just'.
    --
    -- This way we can check for the presence of a value without deserializing the
    -- value itself.
    lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO ()
    lazyPutMaybe :: forall a. Binary a => BinHandle -> Maybe a -> IO ()
    lazyPutMaybe BinHandle
    bh Maybe a
    Nothing  = BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    0
    lazyPutMaybe BinHandle
    bh (Just a
    x) = do
      BinHandle -> Word8 -> IO ()
    putWord8 BinHandle
    bh Word8
    1
      BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    lazyPut BinHandle
    bh a
    x

    -- | Deserialize a value serialized by 'lazyPutMaybe'.
    lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a)
    lazyGetMaybe :: forall a. Binary a => BinHandle -> IO (Maybe a)
    lazyGetMaybe BinHandle
    bh = do
      h <- BinHandle -> IO Word8
    getWord8 BinHandle
    bh
      case h of
        Word8
    0 -> Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    forall a. Maybe a
    Nothing
        Word8
    _ -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> IO a -> IO (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    lazyGet BinHandle
    bh

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

    -- | Information we keep around during interface file
    -- serialization/deserialization. Namely we keep the functions for serializing
    -- and deserializing 'Name's and 'FastString's. We do this because we actually
    -- use serialization in two distinct settings,
    --
    -- * When serializing interface files themselves
    --
    -- * When computing the fingerprint of an IfaceDecl (which we computing by
    --   hashing its Binary serialization)
    --
    -- These two settings have different needs while serializing Names:
    --
    -- * Names in interface files are serialized via a symbol table (see Note
    --   [Symbol table representation of names] in "GHC.Iface.Binary").
    --
    -- * During fingerprinting a binding Name is serialized as the OccName and a
    --   non-binding Name is serialized as the fingerprint of the thing they
    --   represent. See Note [Fingerprinting IfaceDecls] for further discussion.
    --
    data UserData =
       UserData {
            -- for *deserialising* only:
            UserData -> BinHandle -> IO Name
    ud_get_name :: BinHandle -> IO Name,
            UserData -> BinHandle -> IO FastString
    ud_get_fs   :: BinHandle -> IO FastString,

            -- for *serialising* only:
            UserData -> BinHandle -> Name -> IO ()
    ud_put_nonbinding_name :: BinHandle -> Name -> IO (),
            -- ^ serialize a non-binding 'Name' (e.g. a reference to another
            -- binding).
            UserData -> BinHandle -> Name -> IO ()
    ud_put_binding_name :: BinHandle -> Name -> IO (),
            -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl)
            UserData -> BinHandle -> FastString -> IO ()
    ud_put_fs   :: BinHandle -> FastString -> IO ()
       }

    newReadState :: (BinHandle -> IO Name)   -- ^ how to deserialize 'Name's
                 -> (BinHandle -> IO FastString)
                 -> UserData
    newReadState :: (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
    newReadState BinHandle -> IO Name
    get_name BinHandle -> IO FastString
    get_fs
      = UserData { ud_get_name :: BinHandle -> IO Name
    ud_get_name = BinHandle -> IO Name
    get_name,
                   ud_get_fs :: BinHandle -> IO FastString
    ud_get_fs   = BinHandle -> IO FastString
    get_fs,
                   ud_put_nonbinding_name :: BinHandle -> Name -> IO ()
    ud_put_nonbinding_name = String -> BinHandle -> Name -> IO ()
    forall a. String -> a
    undef String
    "put_nonbinding_name",
                   ud_put_binding_name :: BinHandle -> Name -> IO ()
    ud_put_binding_name    = String -> BinHandle -> Name -> IO ()
    forall a. String -> a
    undef String
    "put_binding_name",
                   ud_put_fs :: BinHandle -> FastString -> IO ()
    ud_put_fs   = String -> BinHandle -> FastString -> IO ()
    forall a. String -> a
    undef String
    "put_fs"
                 }

    newWriteState :: (BinHandle -> Name -> IO ())
                     -- ^ how to serialize non-binding 'Name's
                  -> (BinHandle -> Name -> IO ())
                     -- ^ how to serialize binding 'Name's
                  -> (BinHandle -> FastString -> IO ())
                  -> UserData
    newWriteState :: (BinHandle -> Name -> IO ())
    -> (BinHandle -> Name -> IO ())
    -> (BinHandle -> FastString -> IO ())
    -> UserData
    newWriteState BinHandle -> Name -> IO ()
    put_nonbinding_name BinHandle -> Name -> IO ()
    put_binding_name BinHandle -> FastString -> IO ()
    put_fs
      = UserData { ud_get_name :: BinHandle -> IO Name
    ud_get_name = String -> BinHandle -> IO Name
    forall a. String -> a
    undef String
    "get_name",
                   ud_get_fs :: BinHandle -> IO FastString
    ud_get_fs   = String -> BinHandle -> IO FastString
    forall a. String -> a
    undef String
    "get_fs",
                   ud_put_nonbinding_name :: BinHandle -> Name -> IO ()
    ud_put_nonbinding_name = BinHandle -> Name -> IO ()
    put_nonbinding_name,
                   ud_put_binding_name :: BinHandle -> Name -> IO ()
    ud_put_binding_name    = BinHandle -> Name -> IO ()
    put_binding_name,
                   ud_put_fs :: BinHandle -> FastString -> IO ()
    ud_put_fs   = BinHandle -> FastString -> IO ()
    put_fs
                 }

    noUserData :: UserData
    noUserData :: UserData
    noUserData = UserData
      { ud_get_name :: BinHandle -> IO Name
    ud_get_name            = String -> BinHandle -> IO Name
    forall a. String -> a
    undef String
    "get_name"
      , ud_get_fs :: BinHandle -> IO FastString
    ud_get_fs              = String -> BinHandle -> IO FastString
    forall a. String -> a
    undef String
    "get_fs"
      , ud_put_nonbinding_name :: BinHandle -> Name -> IO ()
    ud_put_nonbinding_name = String -> BinHandle -> Name -> IO ()
    forall a. String -> a
    undef String
    "put_nonbinding_name"
      , ud_put_binding_name :: BinHandle -> Name -> IO ()
    ud_put_binding_name    = String -> BinHandle -> Name -> IO ()
    forall a. String -> a
    undef String
    "put_binding_name"
      , ud_put_fs :: BinHandle -> FastString -> IO ()
    ud_put_fs              = String -> BinHandle -> FastString -> IO ()
    forall a. String -> a
    undef String
    "put_fs"
      }

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

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

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

    putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO ()
    putDictionary :: BinHandle -> Int -> UniqFM FastString (Int, FastString) -> IO ()
    putDictionary BinHandle
    bh Int
    sz UniqFM FastString (Int, FastString)
    dict = do
      BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    sz
      (FastString -> IO ()) -> [FastString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> FastString -> IO ()
    putFS BinHandle
    bh) (Array Int FastString -> [FastString]
    forall i e. Array i e -> [e]
    elems ((Int, Int) -> [(Int, FastString)] -> Array Int FastString
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Int
    0,Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (UniqFM FastString (Int, FastString) -> [(Int, FastString)]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM FastString (Int, FastString)
    dict)))
        -- It's OK to use nonDetEltsUFM here because the elements have indices
        -- that array uses to create order

    getDictionary :: BinHandle -> IO Dictionary
    getDictionary :: BinHandle -> IO (Array Int FastString)
    getDictionary BinHandle
    bh = do
      sz <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int
      mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString)
      forM_ [0..(sz-1)] $ \Int
    i -> do
        fs <- BinHandle -> IO FastString
    getFS BinHandle
    bh
        writeArray mut_arr i fs
      unsafeFreeze mut_arr

    getDictFastString :: Dictionary -> BinHandle -> IO FastString
    getDictFastString :: Array Int FastString -> BinHandle -> IO FastString
    getDictFastString Array Int FastString
    dict BinHandle
    bh = do
        j <- BinHandle -> IO Word32
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        return $! (dict ! fromIntegral (j :: Word32))

    initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int)
    initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int)
    initFSTable BinHandle
    bh = do
      dict_next_ref <- Int -> IO FastMutInt
    newFastMutInt Int
    0
      dict_map_ref <- newIORef emptyUFM
      let bin_dict = FSTable
            { fs_tab_next :: FastMutInt
    fs_tab_next = FastMutInt
    dict_next_ref
            , fs_tab_map :: IORef (UniqFM FastString (Int, FastString))
    fs_tab_map  = IORef (UniqFM FastString (Int, FastString))
    dict_map_ref
            }
      let put_dict = do
            fs_count <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    dict_next_ref
            dict_map  <- readIORef dict_map_ref
            putDictionary bh fs_count dict_map
            pure fs_count

      -- BinHandle with FastString writing support
      let ud = BinHandle -> UserData
    getUserData BinHandle
    bh
      let ud_fs = UserData
    ud { ud_put_fs = putDictFastString bin_dict }
      let bh_fs = BinHandle -> UserData -> BinHandle
    setUserData BinHandle
    bh UserData
    ud_fs

      return (bh_fs,bin_dict,put_dict)

    putDictFastString :: FSTable -> BinHandle -> FastString -> IO ()
    putDictFastString :: FSTable -> BinHandle -> FastString -> IO ()
    putDictFastString FSTable
    dict BinHandle
    bh FastString
    fs = FSTable -> FastString -> IO Word32
    allocateFastString FSTable
    dict FastString
    fs IO Word32 -> (Word32 -> 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
    >>= BinHandle -> Word32 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh

    allocateFastString :: FSTable -> FastString -> IO Word32
    allocateFastString :: FSTable -> FastString -> IO Word32
    allocateFastString FSTable { fs_tab_next :: FSTable -> FastMutInt
    fs_tab_next = FastMutInt
    j_r
                               , fs_tab_map :: FSTable -> IORef (UniqFM FastString (Int, FastString))
    fs_tab_map  = IORef (UniqFM FastString (Int, FastString))
    out_r
                               } FastString
    f = do
        out <- IORef (UniqFM FastString (Int, FastString))
    -> IO (UniqFM FastString (Int, FastString))
    forall a. IORef a -> IO a
    readIORef IORef (UniqFM FastString (Int, FastString))
    out_r
        let !uniq = FastString -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique FastString
    f
        case lookupUFM_Directly out uniq of
            Just (Int
    j, FastString
    _)  -> Word32 -> IO Word32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    j :: Word32)
            Maybe (Int, FastString)
    Nothing -> do
               j <- FastMutInt -> IO Int
    readFastMutInt FastMutInt
    j_r
               writeFastMutInt j_r (j + 1)
               writeIORef out_r $! addToUFM_Directly out uniq (j, f)
               return (fromIntegral j :: Word32)

    -- FSTable is an exact copy of Haddock.InterfaceFile.BinDictionary. We rename to
    -- avoid a collision and copy to avoid a dependency.
    data FSTable = FSTable { FSTable -> FastMutInt
    fs_tab_next :: !FastMutInt -- The next index to use
                           , FSTable -> IORef (UniqFM FastString (Int, FastString))
    fs_tab_map  :: !(IORef (UniqFM FastString (Int,FastString)))
                                    -- indexed by FastString
      }

    ---------------------------------------------------------
    -- The Symbol Table
    ---------------------------------------------------------

    -- On disk, the symbol table is an array of IfExtName, when
    -- reading it in we turn it into a SymbolTable.

    type SymbolTable = Array Int Name

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

    putFS :: BinHandle -> FastString -> IO ()
    putFS :: BinHandle -> FastString -> IO ()
    putFS BinHandle
    bh FastString
    fs = BinHandle -> ByteString -> IO ()
    putBS BinHandle
    bh (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> ByteString
    bytesFS FastString
    fs

    getFS :: BinHandle -> IO FastString
    getFS :: BinHandle -> IO FastString
    getFS BinHandle
    bh = do
      l  <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int
      getPrim bh l (\Ptr Word8
    src -> FastString -> IO FastString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FastString -> IO FastString) -> FastString -> IO FastString
    forall a b. (a -> b) -> a -> b
    $! Ptr Word8 -> Int -> FastString
    mkFastStringBytes Ptr Word8
    src Int
    l )

    -- | Put a ByteString without its length (can't be read back without knowing the
    -- length!)
    putByteString :: BinHandle -> ByteString -> IO ()
    putByteString :: BinHandle -> ByteString -> IO ()
    putByteString BinHandle
    bh ByteString
    bs =
      ByteString -> (CStringLen -> IO ()) -> IO ()
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BS.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    ptr, Int
    l) -> do
        BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    bh Int
    l (\Ptr Word8
    op -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    op (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    ptr) Int
    l)

    -- | Get a ByteString whose length is known
    getByteString :: BinHandle -> Int -> IO ByteString
    getByteString :: BinHandle -> Int -> IO ByteString
    getByteString BinHandle
    bh Int
    l =
      Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    BS.create Int
    l ((Ptr Word8 -> IO ()) -> IO ByteString)
    -> (Ptr Word8 -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    dest -> do
        BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    bh Int
    l (\Ptr Word8
    src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    dest Ptr Word8
    src Int
    l)

    putBS :: BinHandle -> ByteString -> IO ()
    putBS :: BinHandle -> ByteString -> IO ()
    putBS BinHandle
    bh ByteString
    bs =
      ByteString -> (CStringLen -> IO ()) -> IO ()
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BS.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    ptr, Int
    l) -> do
        BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Int
    l
        BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    putPrim BinHandle
    bh Int
    l (\Ptr Word8
    op -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    op (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    ptr) Int
    l)

    getBS :: BinHandle -> IO ByteString
    getBS :: BinHandle -> IO ByteString
    getBS BinHandle
    bh = do
      l <- BinHandle -> IO Int
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int
      BS.create l $ \Ptr Word8
    dest -> do
        BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
    forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
    getPrim BinHandle
    bh Int
    l (\Ptr Word8
    src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    dest Ptr Word8
    src Int
    l)

    instance Binary ByteString where
      put_ :: BinHandle -> ByteString -> IO ()
    put_ BinHandle
    bh ByteString
    f = BinHandle -> ByteString -> IO ()
    putBS BinHandle
    bh ByteString
    f
      get :: BinHandle -> IO ByteString
    get BinHandle
    bh = BinHandle -> IO ByteString
    getBS BinHandle
    bh

    instance Binary FastString where
      put_ :: BinHandle -> FastString -> IO ()
    put_ BinHandle
    bh FastString
    f =
        case BinHandle -> UserData
    getUserData BinHandle
    bh of
            UserData { ud_put_fs :: UserData -> BinHandle -> FastString -> IO ()
    ud_put_fs = BinHandle -> FastString -> IO ()
    put_fs } -> BinHandle -> FastString -> IO ()
    put_fs BinHandle
    bh FastString
    f

      get :: BinHandle -> IO FastString
    get BinHandle
    bh =
        case BinHandle -> UserData
    getUserData BinHandle
    bh of
            UserData { ud_get_fs :: UserData -> BinHandle -> IO FastString
    ud_get_fs = BinHandle -> IO FastString
    get_fs } -> BinHandle -> IO FastString
    get_fs BinHandle
    bh

    deriving instance Binary NonDetFastString
    deriving instance Binary LexicalFastString

    instance Binary Fingerprint where
      put_ :: BinHandle -> Fingerprint -> IO ()
    put_ BinHandle
    h (Fingerprint Word64
    w1 Word64
    w2) = do BinHandle -> Word64 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h Word64
    w1; BinHandle -> Word64 -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    h Word64
    w2
      get :: BinHandle -> IO Fingerprint
    get  BinHandle
    h = do w1 <- BinHandle -> IO Word64
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    h; w2 <- get h; return (Fingerprint w1 w2)

    instance Binary ModuleName where
      put_ :: BinHandle -> ModuleName -> IO ()
    put_ BinHandle
    bh (ModuleName FastString
    fs) = BinHandle -> FastString -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh FastString
    fs
      get :: BinHandle -> IO ModuleName
    get BinHandle
    bh = do fs <- BinHandle -> IO FastString
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh; return (ModuleName fs)

    -- instance Binary TupleSort where
    --     put_ bh BoxedTuple      = putByte bh 0
    --     put_ bh UnboxedTuple    = putByte bh 1
    --     put_ bh ConstraintTuple = putByte bh 2
    --     get bh = do
    --       h <- getByte bh
    --       case h of
    --         0 -> do return BoxedTuple
    --         1 -> do return UnboxedTuple
    --         _ -> do return ConstraintTuple

    -- instance Binary Activation where
    --     put_ bh NeverActive = do
    --             putByte bh 0
    --     put_ bh FinalActive = do
    --             putByte bh 1
    --     put_ bh AlwaysActive = do
    --             putByte bh 2
    --     put_ bh (ActiveBefore src aa) = do
    --             putByte bh 3
    --             put_ bh src
    --             put_ bh aa
    --     put_ bh (ActiveAfter src ab) = do
    --             putByte bh 4
    --             put_ bh src
    --             put_ bh ab
    --     get bh = do
    --             h <- getByte bh
    --             case h of
    --               0 -> do return NeverActive
    --               1 -> do return FinalActive
    --               2 -> do return AlwaysActive
    --               3 -> do src <- get bh
    --                       aa <- get bh
    --                       return (ActiveBefore src aa)
    --               _ -> do src <- get bh
    --                       ab <- get bh
    --                       return (ActiveAfter src ab)

    -- instance Binary InlinePragma where
    --     put_ bh (InlinePragma s a b c d) = do
    --             put_ bh s
    --             put_ bh a
    --             put_ bh b
    --             put_ bh c
    --             put_ bh d

    --     get bh = do
    --            s <- get bh
    --            a <- get bh
    --            b <- get bh
    --            c <- get bh
    --            d <- get bh
    --            return (InlinePragma s a b c d)

    -- instance Binary RuleMatchInfo where
    --     put_ bh FunLike = putByte bh 0
    --     put_ bh ConLike = putByte bh 1
    --     get bh = do
    --             h <- getByte bh
    --             if h == 1 then return ConLike
    --                       else return FunLike

    -- instance Binary InlineSpec where
    --     put_ bh NoUserInlinePrag = putByte bh 0
    --     put_ bh Inline           = putByte bh 1
    --     put_ bh Inlinable        = putByte bh 2
    --     put_ bh NoInline         = putByte bh 3

    --     get bh = do h <- getByte bh
    --                 case h of
    --                   0 -> return NoUserInlinePrag
    --                   1 -> return Inline
    --                   2 -> return Inlinable
    --                   _ -> return NoInline

    -- instance Binary RecFlag where
    --     put_ bh Recursive = do
    --             putByte bh 0
    --     put_ bh NonRecursive = do
    --             putByte bh 1
    --     get bh = do
    --             h <- getByte bh
    --             case h of
    --               0 -> do return Recursive
    --               _ -> do return NonRecursive

    -- instance Binary OverlapMode where
    --     put_ bh (NoOverlap    s) = putByte bh 0 >> put_ bh s
    --     put_ bh (Overlaps     s) = putByte bh 1 >> put_ bh s
    --     put_ bh (Incoherent   s) = putByte bh 2 >> put_ bh s
    --     put_ bh (Overlapping  s) = putByte bh 3 >> put_ bh s
    --     put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
    --     get bh = do
    --         h <- getByte bh
    --         case h of
    --             0 -> (get bh) >>= \s -> return $ NoOverlap s
    --             1 -> (get bh) >>= \s -> return $ Overlaps s
    --             2 -> (get bh) >>= \s -> return $ Incoherent s
    --             3 -> (get bh) >>= \s -> return $ Overlapping s
    --             4 -> (get bh) >>= \s -> return $ Overlappable s
    --             _ -> panic ("get OverlapMode" ++ show h)

    -- instance Binary OverlapFlag where
    --     put_ bh flag = do put_ bh (overlapMode flag)
    --                       put_ bh (isSafeOverlap flag)
    --     get bh = do
    --         h <- get bh
    --         b <- get bh
    --         return OverlapFlag { overlapMode = h, isSafeOverlap = b }

    -- instance Binary FixityDirection where
    --     put_ bh InfixL = do
    --             putByte bh 0
    --     put_ bh InfixR = do
    --             putByte bh 1
    --     put_ bh InfixN = do
    --             putByte bh 2
    --     get bh = do
    --             h <- getByte bh
    --             case h of
    --               0 -> do return InfixL
    --               1 -> do return InfixR
    --               _ -> do return InfixN

    -- instance Binary Fixity where
    --     put_ bh (Fixity src aa ab) = do
    --             put_ bh src
    --             put_ bh aa
    --             put_ bh ab
    --     get bh = do
    --           src <- get bh
    --           aa <- get bh
    --           ab <- get bh
    --           return (Fixity src aa ab)

    -- instance Binary WarningTxt where
    --     put_ bh (WarningTxt s w) = do
    --             putByte bh 0
    --             put_ bh s
    --             put_ bh w
    --     put_ bh (DeprecatedTxt s d) = do
    --             putByte bh 1
    --             put_ bh s
    --             put_ bh d

    --     get bh = do
    --             h <- getByte bh
    --             case h of
    --               0 -> do s <- get bh
    --                       w <- get bh
    --                       return (WarningTxt s w)
    --               _ -> do s <- get bh
    --                       d <- get bh
    --                       return (DeprecatedTxt s d)

    -- instance Binary StringLiteral where
    --   put_ bh (StringLiteral st fs _) = do
    --             put_ bh st
    --             put_ bh fs
    --   get bh = do
    --             st <- get bh
    --             fs <- get bh
    --             return (StringLiteral st fs Nothing)

    newtype BinLocated a = BinLocated { forall a. BinLocated a -> Located a
    unBinLocated :: Located a }

    instance Binary a => Binary (BinLocated a) where
        put_ :: BinHandle -> BinLocated a -> IO ()
    put_ BinHandle
    bh (BinLocated (L SrcSpan
    l a
    x)) = do
                BinHandle -> BinSrcSpan -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (BinSrcSpan -> IO ()) -> BinSrcSpan -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> BinSrcSpan
    BinSrcSpan SrcSpan
    l
                BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    x

        get :: BinHandle -> IO (BinLocated a)
    get BinHandle
    bh = do
                l <- BinSrcSpan -> SrcSpan
    unBinSrcSpan (BinSrcSpan -> SrcSpan) -> IO BinSrcSpan -> IO SrcSpan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO BinSrcSpan
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                x <- get bh
                return $ BinLocated (L l x)

    newtype BinSpan = BinSpan { BinSpan -> RealSrcSpan
    unBinSpan :: RealSrcSpan }

    -- See Note [Source Location Wrappers]
    instance Binary BinSpan where
      put_ :: BinHandle -> BinSpan -> IO ()
    put_ BinHandle
    bh (BinSpan RealSrcSpan
    ss) = do
                BinHandle -> FastString -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    ss)
                BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    ss)
                BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    ss)
                BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    ss)
                BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    ss)

      get :: BinHandle -> IO BinSpan
    get BinHandle
    bh = do
                f <- BinHandle -> IO FastString
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                sl <- get bh
                sc <- get bh
                el <- get bh
                ec <- get bh
                return $ BinSpan (mkRealSrcSpan (mkRealSrcLoc f sl sc)
                                                (mkRealSrcLoc f el ec))

    instance Binary UnhelpfulSpanReason where
      put_ :: BinHandle -> UnhelpfulSpanReason -> IO ()
    put_ BinHandle
    bh UnhelpfulSpanReason
    r = case UnhelpfulSpanReason
    r of
        UnhelpfulSpanReason
    UnhelpfulNoLocationInfo -> BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
        UnhelpfulSpanReason
    UnhelpfulWiredIn        -> BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1
        UnhelpfulSpanReason
    UnhelpfulInteractive    -> BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    2
        UnhelpfulSpanReason
    UnhelpfulGenerated      -> BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    3
        UnhelpfulOther FastString
    fs       -> BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    4 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BinHandle -> FastString -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh FastString
    fs

      get :: BinHandle -> IO UnhelpfulSpanReason
    get BinHandle
    bh = do
        h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
        case h of
          Word8
    0 -> UnhelpfulSpanReason -> IO UnhelpfulSpanReason
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnhelpfulSpanReason
    UnhelpfulNoLocationInfo
          Word8
    1 -> UnhelpfulSpanReason -> IO UnhelpfulSpanReason
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnhelpfulSpanReason
    UnhelpfulWiredIn
          Word8
    2 -> UnhelpfulSpanReason -> IO UnhelpfulSpanReason
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnhelpfulSpanReason
    UnhelpfulInteractive
          Word8
    3 -> UnhelpfulSpanReason -> IO UnhelpfulSpanReason
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnhelpfulSpanReason
    UnhelpfulGenerated
          Word8
    _ -> FastString -> UnhelpfulSpanReason
    UnhelpfulOther (FastString -> UnhelpfulSpanReason)
    -> IO FastString -> IO UnhelpfulSpanReason
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO FastString
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    newtype BinSrcSpan = BinSrcSpan { BinSrcSpan -> SrcSpan
    unBinSrcSpan :: SrcSpan }

    -- See Note [Source Location Wrappers]
    instance Binary BinSrcSpan where
      put_ :: BinHandle -> BinSrcSpan -> IO ()
    put_ BinHandle
    bh (BinSrcSpan (RealSrcSpan RealSrcSpan
    ss Maybe BufSpan
    _sb)) = do
              BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    0
              -- BufSpan doesn't ever get serialised because the positions depend
              -- on build location.
              BinHandle -> BinSpan -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (BinSpan -> IO ()) -> BinSpan -> IO ()
    forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> BinSpan
    BinSpan RealSrcSpan
    ss

      put_ BinHandle
    bh (BinSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
    s)) = do
              BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1
              BinHandle -> UnhelpfulSpanReason -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh UnhelpfulSpanReason
    s

      get :: BinHandle -> IO BinSrcSpan
    get BinHandle
    bh = do
              h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
              case h of
                Word8
    0 -> do BinSpan ss <- BinHandle -> IO BinSpan
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        return $ BinSrcSpan (RealSrcSpan ss Strict.Nothing)
                Word8
    _ -> do s <- BinHandle -> IO UnhelpfulSpanReason
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        return $ BinSrcSpan (UnhelpfulSpan s)

    {-
    Note [Source Location Wrappers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Source locations are banned from interface files, to
    prevent filepaths affecting interface hashes.

    Unfortunately, we can't remove all binary instances,
    as they're used to serialise .hie files, and we don't
    want to break binary compatibility.

    To this end, the Bin[Src]Span newtypes wrappers were
    introduced to prevent accidentally serialising a
    source location as part of a larger structure.
    -}

    --------------------------------------------------------------------------------
    -- Instances for the containers package
    --------------------------------------------------------------------------------

    instance (Binary v) => Binary (IntMap v) where
      put_ :: BinHandle -> IntMap v -> IO ()
    put_ BinHandle
    bh IntMap v
    m = BinHandle -> [(Int, v)] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (IntMap v -> [(Int, v)]
    forall a. IntMap a -> [(Int, a)]
    IntMap.toList IntMap v
    m)
      get :: BinHandle -> IO (IntMap v)
    get BinHandle
    bh = [(Int, v)] -> IntMap v
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromList ([(Int, v)] -> IntMap v) -> IO [(Int, v)] -> IO (IntMap v)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO [(Int, v)]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh