{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
#if MIN_VERSION_base(4,16,0)
#define HAS_TYPELITCHAR
#endif
module GHC.Utils.Binary
( Bin,
Binary(..),
BinHandle,
SymbolTable, Dictionary,
BinData(..), dataHandle, handleData,
openBinMem,
seekBin,
tellBin,
castBin,
withBinBuffer,
writeBinMem,
readBinMem,
putAt, getAt,
putByte,
getByte,
putULEB128,
getULEB128,
putSLEB128,
getSLEB128,
FixedLengthEncoding(..),
lazyGet,
lazyPut,
UserData(..), getUserData, setUserData,
newReadState, newWriteState,
putDictionary, getDictionary, putFS,
) where
#include "HsVersions.h"
import GHC.Prelude
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 Control.DeepSeq
import Foreign hiding (shiftL, shiftR)
import Data.Array
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.Time
import Data.List (unfoldr)
import Control.Monad ( when, (<$!>), unless )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import GHC.Real ( Ratio(..) )
#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
data BinData = BinData Int BinArray
instance NFData BinData where
rnf :: BinData -> ()
rnf (BinData Int
sz BinArray
_) = 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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
sz
BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
putPrim BinHandle
bh Int
sz forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
dat forall a b. (a -> b) -> a -> b
$ \Ptr Word8
orig ->
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
Int
sz <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
BinArray
dat <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sz
forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
bh Int
sz forall a b. (a -> b) -> a -> b
$ \Ptr Word8
orig ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
dat forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest ->
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dest Ptr Word8
orig Int
sz
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> BinArray -> BinData
BinData Int
sz BinArray
dat)
dataHandle :: BinData -> IO BinHandle
dataHandle :: BinData -> IO BinHandle
dataHandle (BinData Int
size BinArray
bin) = do
FastMutInt
ixr <- Int -> IO FastMutInt
newFastMutInt Int
0
FastMutInt
szr <- Int -> IO FastMutInt
newFastMutInt Int
size
IORef BinArray
binr <- forall a. a -> IO (IORef a)
newIORef BinArray
bin
forall (m :: * -> *) a. Monad m => a -> m a
return (UserData -> FastMutInt -> FastMutInt -> IORef BinArray -> BinHandle
BinMem forall a. a
noUserData FastMutInt
ixr FastMutInt
szr IORef BinArray
binr)
handleData :: BinHandle -> IO BinData
handleData :: BinHandle -> IO BinData
handleData (BinMem UserData
_ FastMutInt
ixr FastMutInt
_ IORef BinArray
binr) = Int -> BinArray -> BinData
BinData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastMutInt -> IO Int
readFastMutInt FastMutInt
ixr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IORef a -> IO a
readIORef IORef BinArray
binr
data BinHandle
= BinMem {
BinHandle -> UserData
bh_usr :: UserData,
BinHandle -> FastMutInt
_off_r :: !FastMutInt,
BinHandle -> FastMutInt
_sz_r :: !FastMutInt,
BinHandle -> IORef BinArray
_arr_r :: !(IORef BinArray)
}
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 :: UserData
bh_usr = UserData
us }
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
BinArray
arr <- forall a. IORef a -> IO a
readIORef IORef BinArray
arr_r
Int
ix <- FastMutInt -> IO Int
readFastMutInt FastMutInt
ix_r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
CStringLen -> IO ByteString
BS.unsafePackCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
ix) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO a
action
newtype Bin a = BinPtr Int
deriving (Bin a -> Bin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
Eq, 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
min :: Bin a -> Bin a -> Bin a
$cmin :: forall k (a :: k). Bin a -> Bin a -> Bin a
max :: Bin a -> Bin a -> Bin a
$cmax :: forall k (a :: k). Bin a -> Bin a -> Bin a
>= :: 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
$c< :: forall k (a :: k). Bin a -> Bin a -> Bool
compare :: Bin a -> Bin a -> Ordering
$ccompare :: forall k (a :: k). Bin a -> Bin a -> Ordering
Ord, Int -> Bin a -> ShowS
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
showList :: [Bin a] -> ShowS
$cshowList :: forall k (a :: k). [Bin a] -> ShowS
show :: Bin a -> String
$cshow :: forall k (a :: k). Bin a -> String
showsPrec :: Int -> Bin a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> Bin a -> ShowS
Show, Bin a
forall a. a -> a -> Bounded a
forall k (a :: k). Bin a
maxBound :: Bin a
$cmaxBound :: forall k (a :: k). Bin a
minBound :: Bin a
$cminBound :: forall k (a :: k). Bin a
Bounded)
castBin :: Bin a -> Bin b
castBin :: forall {k} {k} (a :: k) (b :: k). Bin a -> Bin b
castBin (BinPtr Int
i) = forall {k} (a :: k). Int -> Bin a
BinPtr Int
i
class Binary a where
put_ :: BinHandle -> a -> IO ()
put :: BinHandle -> a -> IO (Bin a)
get :: BinHandle -> IO a
put_ BinHandle
bh a
a = do Bin a
_ <- forall a. Binary a => BinHandle -> a -> IO (Bin a)
put BinHandle
bh a
a; forall (m :: * -> *) a. Monad m => a -> m a
return ()
put BinHandle
bh a
a = do Bin a
p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall (m :: * -> *) a. Monad m => a -> m a
return Bin a
p
putAt :: Binary a => BinHandle -> Bin a -> a -> IO ()
putAt :: forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
putAt BinHandle
bh Bin a
p a
x = do forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin a
p; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
x; 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 forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin a
p; forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
openBinMem :: Int -> IO BinHandle
openBinMem :: Int -> IO BinHandle
openBinMem Int
size
| Int
size forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => String -> a
error String
"Data.Binary.openBinMem: size must be >= 0"
| Bool
otherwise = do
BinArray
arr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size
IORef BinArray
arr_r <- forall a. a -> IO (IORef a)
newIORef BinArray
arr
FastMutInt
ix_r <- Int -> IO FastMutInt
newFastMutInt Int
0
FastMutInt
sz_r <- Int -> IO FastMutInt
newFastMutInt Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return (UserData -> FastMutInt -> FastMutInt -> IORef BinArray -> BinHandle
BinMem forall a. a
noUserData FastMutInt
ix_r FastMutInt
sz_r IORef BinArray
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 Int
ix <- FastMutInt -> IO Int
readFastMutInt FastMutInt
r; forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (a :: k). Int -> Bin a
BinPtr Int
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
Int
sz <- FastMutInt -> IO Int
readFastMutInt FastMutInt
sz_r
if (Int
p forall a. Ord a => a -> a -> Bool
>= Int
sz)
then do BinHandle -> Int -> IO ()
expandBin BinHandle
h Int
p; FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
ix_r Int
p
else FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
ix_r Int
p
writeBinMem :: BinHandle -> FilePath -> IO ()
writeBinMem :: BinHandle -> String -> IO ()
writeBinMem (BinMem UserData
_ FastMutInt
ix_r FastMutInt
_ IORef BinArray
arr_r) String
fn = do
Handle
h <- String -> IOMode -> IO Handle
openBinaryFile String
fn IOMode
WriteMode
BinArray
arr <- forall a. IORef a -> IO a
readIORef IORef BinArray
arr_r
Int
ix <- FastMutInt -> IO Int
readFastMutInt FastMutInt
ix_r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Word8
p Int
ix
Handle -> IO ()
hClose Handle
h
readBinMem :: FilePath -> IO BinHandle
readBinMem :: String -> IO BinHandle
readBinMem String
filename = do
Handle
h <- String -> IOMode -> IO Handle
openBinaryFile String
filename IOMode
ReadMode
Integer
filesize' <- Handle -> IO Integer
hFileSize Handle
h
let filesize :: Int
filesize = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesize'
BinArray
arr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
filesize
Int
count <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
p Int
filesize
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count forall a. Eq a => a -> a -> Bool
/= Int
filesize) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error (String
"Binary.readBinMem: only read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
count forall a. [a] -> [a] -> [a]
++ String
" bytes")
Handle -> IO ()
hClose Handle
h
IORef BinArray
arr_r <- forall a. a -> IO (IORef a)
newIORef BinArray
arr
FastMutInt
ix_r <- Int -> IO FastMutInt
newFastMutInt Int
0
FastMutInt
sz_r <- Int -> IO FastMutInt
newFastMutInt Int
filesize
forall (m :: * -> *) a. Monad m => a -> m a
return (UserData -> FastMutInt -> FastMutInt -> IORef BinArray -> BinHandle
BinMem forall a. a
noUserData FastMutInt
ix_r FastMutInt
sz_r IORef BinArray
arr_r)
expandBin :: BinHandle -> Int -> IO ()
expandBin :: BinHandle -> Int -> IO ()
expandBin (BinMem UserData
_ FastMutInt
_ FastMutInt
sz_r IORef BinArray
arr_r) !Int
off = do
!Int
sz <- FastMutInt -> IO Int
readFastMutInt FastMutInt
sz_r
let !sz' :: Int
sz' = Int -> Int
getSize Int
sz
BinArray
arr <- forall a. IORef a -> IO a
readIORef IORef BinArray
arr_r
BinArray
arr' <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sz'
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
old ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr BinArray
arr' forall a b. (a -> b) -> a -> b
$ \Ptr Word8
new ->
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
new Ptr Word8
old Int
sz
FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
sz_r Int
sz'
forall a. IORef a -> a -> IO ()
writeIORef IORef BinArray
arr_r BinArray
arr'
where
getSize :: Int -> Int
getSize :: Int -> Int
getSize !Int
sz
| Int
sz forall a. Ord a => a -> a -> Bool
> Int
off
= Int
sz
| Bool
otherwise
= Int -> Int
getSize (Int
sz forall a. Num a => a -> a -> a
* Int
2)
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
Int
ix <- FastMutInt -> IO Int
readFastMutInt FastMutInt
ix_r
Int
sz <- FastMutInt -> IO Int
readFastMutInt FastMutInt
sz_r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix forall a. Num a => a -> a -> a
+ Int
size forall a. Ord a => a -> a -> Bool
> Int
sz) forall a b. (a -> b) -> a -> b
$
BinHandle -> Int -> IO ()
expandBin BinHandle
h (Int
ix forall a. Num a => a -> a -> a
+ Int
size)
BinArray
arr <- forall a. IORef a -> IO a
readIORef IORef BinArray
arr_r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
op -> Ptr Word8 -> IO ()
f (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ix)
FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
ix_r (Int
ix forall a. Num a => a -> a -> a
+ Int
size)
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
Int
ix <- FastMutInt -> IO Int
readFastMutInt FastMutInt
ix_r
Int
sz <- FastMutInt -> IO Int
readFastMutInt FastMutInt
sz_r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix forall a. Num a => a -> a -> a
+ Int
size forall a. Ord a => a -> a -> Bool
> Int
sz) forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType String
"Data.Binary.getPrim" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
BinArray
arr <- forall a. IORef a -> IO a
readIORef IORef BinArray
arr_r
a
w <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr BinArray
arr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO a
f (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ix)
FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
ix_r (Int
ix forall a. Num a => a -> a -> a
+ Int
size)
forall (m :: * -> *) a. Monad m => a -> m a
return a
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 -> 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 = forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
h Int
1 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
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w forall a. Bits a => a -> a -> a
.&. Word16
0xFF))
)
getWord16 :: BinHandle -> IO Word16
getWord16 :: BinHandle -> IO Word16
getWord16 BinHandle
h = forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
h Int
2 (\Ptr Word8
op -> do
Word16
w0 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
0
Word16
w1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Word16
w0 forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. Word16
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
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word32
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8) forall a. Bits a => a -> a -> a
.&. Word32
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> a -> a
.&. Word32
0xFF))
)
getWord32 :: BinHandle -> IO Word32
getWord32 :: BinHandle -> IO Word32
getWord32 BinHandle
h = forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
h Int
4 (\Ptr Word8
op -> do
Word32
w0 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
0
Word32
w1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
1
Word32
w2 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
2
Word32
w3 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Word32
w0 forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall a. Bits a => a -> a -> a
.|.
(Word32
w1 forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|.
(Word32
w2 forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|.
Word32
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
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
5 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
6 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8) forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
op Int
7 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> a -> a
.&. Word64
0xFF))
)
getWord64 :: BinHandle -> IO Word64
getWord64 :: BinHandle -> IO Word64
getWord64 BinHandle
h = forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
h Int
8 (\Ptr Word8
op -> do
Word64
w0 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
0
Word64
w1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
1
Word64
w2 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
2
Word64
w3 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
3
Word64
w4 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
4
Word64
w5 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
5
Word64
w6 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
6
Word64
w7 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
op Int
7
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Word64
w0 forall a. Bits a => a -> Int -> a
`shiftL` Int
56) forall a. Bits a => a -> a -> a
.|.
(Word64
w1 forall a. Bits a => a -> Int -> a
`shiftL` Int
48) forall a. Bits a => a -> a -> a
.|.
(Word64
w2 forall a. Bits a => a -> Int -> a
`shiftL` Int
40) forall a. Bits a => a -> a -> a
.|.
(Word64
w3 forall a. Bits a => a -> Int -> a
`shiftL` Int
32) forall a. Bits a => a -> a -> a
.|.
(Word64
w4 forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall a. Bits a => a -> a -> a
.|.
(Word64
w5 forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|.
(Word64
w6 forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|.
Word64
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
{-# 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 forall a. Ord a => a -> a -> Bool
<= (a
127 :: a)
= BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w :: Word8)
| Bool
otherwise = do
let !byte :: Word8
byte = forall a. Bits a => a -> Int -> a
setBit (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 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
Word8
b <- BinHandle -> IO Word8
getByte BinHandle
bh
let !hasMore :: Bool
hasMore = forall a. Bits a => a -> Int -> Bool
testBit Word8
b Int
7
let !val :: a
val = a
w forall a. Bits a => a -> a -> a
.|. ((forall a. Bits a => a -> Int -> a
clearBit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Int
7) forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift) :: a
if Bool
hasMore
then do
Int -> a -> IO a
go (Int
shiftforall a. Num a => a -> a -> a
+Int
7) a
val
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
val
{-# 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
clearBit a
val Int
7) :: Word8
let !val' :: a
val' = a
val forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7
let !signBit :: Bool
signBit = forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
6
let !done :: Bool
done =
((a
val' forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
signBit) Bool -> Bool -> Bool
||
(a
val' 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 forall a. Bits a => a -> Int -> a
setBit Word8
byte Int
7
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
byte'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
done 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
(a
val,Int
shift,Bool
signed) <- Int -> a -> IO (a, Int, Bool)
go Int
0 a
0
if Bool
signed Bool -> Bool -> Bool
&& (Int
shift forall a. Ord a => a -> a -> Bool
< forall b. FiniteBits b => b -> Int
finiteBitSize a
val )
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ((forall a. Bits a => a -> a
complement a
0 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift) forall a. Bits a => a -> a -> a
.|. a
val)
else forall (m :: * -> *) a. Monad m => a -> m a
return a
val
where
go :: Int -> a -> IO (a,Int,Bool)
go :: Int -> a -> IO (a, Int, Bool)
go Int
shift a
val = do
Word8
byte <- BinHandle -> IO Word8
getByte BinHandle
bh
let !byteVal :: a
byteVal = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
7) :: a
let !val' :: a
val' = a
val forall a. Bits a => a -> a -> a
.|. (a
byteVal forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift)
let !more :: Bool
more = forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
7
let !shift' :: Int
shift' = Int
shiftforall a. Num a => a -> a -> a
+Int
7
if Bool
more
then Int -> a -> IO (a, Int, Bool)
go (Int
shift') a
val'
else do
let !signed :: Bool
signed = forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
6
forall (m :: * -> *) a. Monad m => a -> m a
return (a
val',Int
shift',Bool
signed)
newtype FixedLengthEncoding a = FixedLengthEncoding { forall a. FixedLengthEncoding a -> a
unFixedLength :: a }
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 = forall a. a -> FixedLengthEncoding a
FixedLengthEncoding 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 = forall a. a -> FixedLengthEncoding a
FixedLengthEncoding 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 = forall a. a -> FixedLengthEncoding a
FixedLengthEncoding 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 = forall a. a -> FixedLengthEncoding a
FixedLengthEncoding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Word64
getWord64 BinHandle
h
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_ = forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
putULEB128
get :: BinHandle -> IO Word16
get = forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
getULEB128
instance Binary Word32 where
put_ :: BinHandle -> Word32 -> IO ()
put_ = forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
putULEB128
get :: BinHandle -> IO Word32
get = forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
getULEB128
instance Binary Word64 where
put_ :: BinHandle -> Word64 -> IO ()
put_ = forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
putULEB128
get :: BinHandle -> IO Word64
get = forall a. (Integral a, FiniteBits a) => BinHandle -> IO a
getULEB128
instance Binary Int8 where
put_ :: BinHandle -> Int8 -> IO ()
put_ BinHandle
h Int8
w = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
h (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
w :: Word8)
get :: BinHandle -> IO Int8
get BinHandle
h = do Word8
w <- forall a. Binary a => BinHandle -> IO a
get BinHandle
h; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w::Word8))
instance Binary Int16 where
put_ :: BinHandle -> Int16 -> IO ()
put_ = forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
putSLEB128
get :: BinHandle -> IO Int16
get = forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
getSLEB128
instance Binary Int32 where
put_ :: BinHandle -> Int32 -> IO ()
put_ = forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
putSLEB128
get :: BinHandle -> IO Int32
get = 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 = forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()
putSLEB128 BinHandle
h Int64
w
get :: BinHandle -> IO Int64
get BinHandle
h = forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
getSLEB128 BinHandle
h
instance Binary () where
put_ :: BinHandle -> () -> IO ()
put_ BinHandle
_ () = forall (m :: * -> *) a. Monad m => a -> m a
return ()
get :: BinHandle -> IO ()
get BinHandle
_ = 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Bool
b))
get :: BinHandle -> IO Bool
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getWord8 BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
instance Binary Char where
put_ :: BinHandle -> Char -> IO ()
put_ BinHandle
bh Char
c = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word32)
get :: BinHandle -> IO Char
get BinHandle
bh = do Word32
x <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
x :: Word32)))
instance Binary Int where
put_ :: BinHandle -> Int -> IO ()
put_ BinHandle
bh Int
i = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Int64)
get :: BinHandle -> IO Int
get BinHandle
bh = do
Int64
x <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
x :: Int64))
instance Binary a => Binary [a] where
put_ :: BinHandle -> [a] -> IO ()
put_ BinHandle
bh [a]
l = do
let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
len
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh) [a]
l
get :: BinHandle -> IO [a]
get BinHandle
bh = do
Int
len <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Int
let loop :: Int -> IO [a]
loop Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
loop Int
n = do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; [a]
as <- Int -> IO [a]
loop (Int
nforall a. Num a => a -> a -> a
-Int
1); forall (m :: * -> *) a. Monad m => a -> m a
return (a
aforall a. a -> [a] -> [a]
:[a]
as)
Int -> IO [a]
loop Int
len
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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> (i, i)
bounds Array a b
arr
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> [e]
elems Array a b
arr
get :: BinHandle -> IO (Array a b)
get BinHandle
bh = do
(a, a)
bounds <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[b]
xs <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (a, a)
bounds [b]
xs
instance (Binary a, Binary b) => Binary (a,b) where
put_ :: BinHandle -> (a, b) -> IO ()
put_ BinHandle
bh (a
a,b
b) = do forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b
get :: BinHandle -> IO (a, b)
get BinHandle
bh = do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)
instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
put_ :: BinHandle -> (a, b, c) -> IO ()
put_ BinHandle
bh (a
a,b
b,c
c) = do forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh c
c
get :: BinHandle -> IO (a, b, c)
get BinHandle
bh = do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
c
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c)
instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
put_ :: BinHandle -> (a, b, c, d) -> IO ()
put_ BinHandle
bh (a
a,b
b,c
c,d
d) = do forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh c
c; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh d
d
get :: BinHandle -> IO (a, b, c, d)
get BinHandle
bh = do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
c
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
d
d <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
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 forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh c
c; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh d
d; 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
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
c
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
d
d <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
e
e <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
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 forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh c
c; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh d
d; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh e
e; 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
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
c
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
d
d <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
e
e <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
f
f <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
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 forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh c
c; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh d
d; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh e
e; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh f
f; 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
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
c
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
d
d <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
e
e <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
f
f <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
g
g <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
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; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a
get :: BinHandle -> IO (Maybe a)
get BinHandle
bh = do Word8
h <- BinHandle -> IO Word8
getWord8 BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Word8
_ -> do a
x <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
instance (Binary a, Binary b) => Binary (Either a b) where
put_ :: BinHandle -> Either a b -> IO ()
put_ BinHandle
bh (Left a
a) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0; 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; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh b
b
get :: BinHandle -> IO (Either a b)
get BinHandle
bh = do Word8
h <- BinHandle -> IO Word8
getWord8 BinHandle
bh
case Word8
h of
Word8
0 -> do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
a)
Word8
_ -> do b
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right b
b)
instance Binary UTCTime where
put_ :: BinHandle -> UTCTime -> IO ()
put_ BinHandle
bh UTCTime
u = do forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (UTCTime -> Day
utctDay UTCTime
u)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (UTCTime -> DiffTime
utctDayTime UTCTime
u)
get :: BinHandle -> IO UTCTime
get BinHandle
bh = do Day
day <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
DiffTime
dayTime <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UTCTime { utctDay :: Day
utctDay = Day
day, utctDayTime :: DiffTime
utctDayTime = DiffTime
dayTime }
instance Binary Day where
put_ :: BinHandle -> Day -> IO ()
put_ BinHandle
bh Day
d = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Day -> Integer
toModifiedJulianDay Day
d)
get :: BinHandle -> IO Day
get BinHandle
bh = do Integer
i <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModifiedJulianDay { toModifiedJulianDay :: Integer
toModifiedJulianDay = Integer
i }
instance Binary DiffTime where
put_ :: BinHandle -> DiffTime -> IO ()
put_ BinHandle
bh DiffTime
dt = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a. Real a => a -> Rational
toRational DiffTime
dt)
get :: BinHandle -> IO DiffTime
get BinHandle
bh = do Rational
r <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
r
instance Binary Integer where
put_ :: BinHandle -> Integer -> IO ()
put_ BinHandle
bh Integer
i
| Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
lo64 Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
hi64 = do
BinHandle -> Word8 -> IO ()
putWord8 BinHandle
bh Word8
0
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64)
| Bool
otherwise = do
if Integer
i 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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Integer -> [Word8]
unroll forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Integer
i)
where
lo64 :: Integer
lo64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int64)
hi64 :: Integer
hi64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int64)
get :: BinHandle -> IO Integer
get BinHandle
bh = do
Word8
int_kind <- BinHandle -> IO Word8
getWord8 BinHandle
bh
case Word8
int_kind of
Word8
0 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Int64)
Word8
1 -> forall a. Num a => a -> a
negate forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> IO Integer
getInt
Word8
2 -> IO Integer
getInt
Word8
_ -> forall a. String -> a
panic String
"Binary Integer - Invalid byte"
where
getInt :: IO Integer
getInt :: IO Integer
getInt = [Word8] -> Integer
roll forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO [Word8])
unroll :: Integer -> [Word8]
unroll :: Integer -> [Word8]
unroll = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b} {a}. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
step
where
step :: b -> Maybe (a, b)
step b
0 = forall a. Maybe a
Nothing
step b
i = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i, b
i forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
roll :: [Word8] -> Integer
roll :: [Word8] -> Integer
roll = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
unstep Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
where
unstep :: a -> a -> a
unstep a
a a
b = a
a forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b
instance (Binary a) => Binary (Ratio a) where
put_ :: BinHandle -> Ratio a -> IO ()
put_ BinHandle
bh (a
a :% a
b) = do forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
b
get :: BinHandle -> IO (Ratio a)
get BinHandle
bh = do a
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; a
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall a. a -> a -> Ratio a
:% a
b)
instance Binary (Bin a) where
put_ :: BinHandle -> Bin a -> IO ()
put_ BinHandle
bh (BinPtr Int
i) = BinHandle -> Word32 -> IO ()
putWord32 BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word32)
get :: BinHandle -> IO (Bin a)
get BinHandle
bh = do Word32
i <- BinHandle -> IO Word32
getWord32 BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (a :: k). Int -> Bin a
BinPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
i :: Word32)))
lazyPut :: Binary a => BinHandle -> a -> IO ()
lazyPut :: forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh a
a = do
Bin (Bin Any)
pre_a <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bin (Bin Any)
pre_a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
a
Bin Any
q <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
putAt BinHandle
bh Bin (Bin Any)
pre_a Bin Any
q
forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin Any
q
lazyGet :: Binary a => BinHandle -> IO a
lazyGet :: forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh = do
Bin Any
p <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bin a
p_a <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
a
a <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ do
FastMutInt
off_r <- Int -> IO FastMutInt
newFastMutInt Int
0
forall a. Binary a => BinHandle -> Bin a -> IO a
getAt BinHandle
bh { _off_r :: FastMutInt
_off_r = FastMutInt
off_r } Bin a
p_a
forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin Any
p
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
data UserData =
UserData {
UserData -> BinHandle -> IO Name
ud_get_name :: BinHandle -> IO Name,
UserData -> BinHandle -> IO FastString
ud_get_fs :: BinHandle -> IO FastString,
UserData -> BinHandle -> Name -> IO ()
ud_put_nonbinding_name :: BinHandle -> Name -> IO (),
UserData -> BinHandle -> Name -> IO ()
ud_put_binding_name :: BinHandle -> Name -> IO (),
UserData -> BinHandle -> FastString -> IO ()
ud_put_fs :: BinHandle -> FastString -> IO ()
}
newReadState :: (BinHandle -> IO Name)
-> (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 = forall a. String -> a
undef String
"put_nonbinding_name",
ud_put_binding_name :: BinHandle -> Name -> IO ()
ud_put_binding_name = forall a. String -> a
undef String
"put_binding_name",
ud_put_fs :: BinHandle -> FastString -> IO ()
ud_put_fs = forall a. String -> a
undef String
"put_fs"
}
newWriteState :: (BinHandle -> Name -> IO ())
-> (BinHandle -> Name -> IO ())
-> (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 = forall a. String -> a
undef String
"get_name",
ud_get_fs :: BinHandle -> IO FastString
ud_get_fs = 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 :: a
noUserData :: forall a. a
noUserData = forall a. String -> a
undef String
"UserData"
undef :: String -> a
undef :: forall a. String -> a
undef String
s = forall a. String -> a
panic (String
"Binary.UserData: no " forall a. [a] -> [a] -> [a]
++ String
s)
type Dictionary = Array Int FastString
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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
sz
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinHandle -> FastString -> IO ()
putFS BinHandle
bh) (forall i e. Array i e -> [e]
elems (forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
szforall a. Num a => a -> a -> a
-Int
1) (forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM FastString (Int, FastString)
dict)))
getDictionary :: BinHandle -> IO Dictionary
getDictionary :: BinHandle -> IO Dictionary
getDictionary BinHandle
bh = do
Int
sz <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[FastString]
elems <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall a. Int -> [a] -> [a]
take Int
sz (forall a. a -> [a]
repeat (BinHandle -> IO FastString
getFS BinHandle
bh)))
forall (m :: * -> *) a. Monad m => a -> m a
return (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
szforall a. Num a => a -> a -> a
-Int
1) [FastString]
elems)
type SymbolTable = Array Int Name
putFS :: BinHandle -> FastString -> IO ()
putFS :: BinHandle -> FastString -> IO ()
putFS BinHandle
bh FastString
fs = BinHandle -> ByteString -> IO ()
putBS BinHandle
bh forall a b. (a -> b) -> a -> b
$ FastString -> ByteString
bytesFS FastString
fs
getFS :: BinHandle -> IO FastString
getFS :: BinHandle -> IO FastString
getFS BinHandle
bh = do
Int
l <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Int
forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
bh Int
l (\Ptr Word8
src -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> FastString
mkFastStringBytes Ptr Word8
src Int
l )
putBS :: BinHandle -> ByteString -> IO ()
putBS :: BinHandle -> ByteString -> IO ()
putBS BinHandle
bh ByteString
bs =
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
l) -> do
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 ()
BS.memcpy Ptr Word8
op (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
Int
l <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Int
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BS.create Int
l forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest -> do
forall a. BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a
getPrim BinHandle
bh Int
l (\Ptr Word8
src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BS.memcpy 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 forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
h Word64
w1; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
h Word64
w2
get :: BinHandle -> IO Fingerprint
get BinHandle
h = do Word64
w1 <- forall a. Binary a => BinHandle -> IO a
get BinHandle
h; Word64
w2 <- forall a. Binary a => BinHandle -> IO a
get BinHandle
h; forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Fingerprint
Fingerprint Word64
w1 Word64
w2)
instance Binary a => Binary (Located a) where
put_ :: BinHandle -> Located a -> IO ()
put_ BinHandle
bh (L SrcSpan
l a
x) = do
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SrcSpan
l
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
x
get :: BinHandle -> IO (Located a)
get BinHandle
bh = do
SrcSpan
l <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
a
x <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (forall l e. l -> e -> GenLocated l e
L SrcSpan
l a
x)
instance Binary RealSrcSpan where
put_ :: BinHandle -> RealSrcSpan -> IO ()
put_ BinHandle
bh RealSrcSpan
ss = do
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)
get :: BinHandle -> IO RealSrcSpan
get BinHandle
bh = do
FastString
f <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
sl <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
sc <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
el <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
ec <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
f Int
sl Int
sc)
(FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
f Int
el Int
ec))
instance Binary BufPos where
put_ :: BinHandle -> BufPos -> IO ()
put_ BinHandle
bh (BufPos Int
i) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
i
get :: BinHandle -> IO BufPos
get BinHandle
bh = Int -> BufPos
BufPos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary BufSpan where
put_ :: BinHandle -> BufSpan -> IO ()
put_ BinHandle
bh (BufSpan BufPos
start BufPos
end) = do
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BufPos
start
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BufPos
end
get :: BinHandle -> IO BufSpan
get BinHandle
bh = do
BufPos
start <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
BufPos
end <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (BufPos -> BufPos -> BufSpan
BufSpan BufPos
start BufPos
end)
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
get :: BinHandle -> IO UnhelpfulSpanReason
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return UnhelpfulSpanReason
UnhelpfulNoLocationInfo
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return UnhelpfulSpanReason
UnhelpfulWiredIn
Word8
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return UnhelpfulSpanReason
UnhelpfulInteractive
Word8
3 -> forall (m :: * -> *) a. Monad m => a -> m a
return UnhelpfulSpanReason
UnhelpfulGenerated
Word8
_ -> FastString -> UnhelpfulSpanReason
UnhelpfulOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary SrcSpan where
put_ :: BinHandle -> SrcSpan -> IO ()
put_ BinHandle
bh (RealSrcSpan RealSrcSpan
ss Maybe BufSpan
sb) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh RealSrcSpan
ss
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe BufSpan
sb
put_ BinHandle
bh (UnhelpfulSpan UnhelpfulSpanReason
s) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh UnhelpfulSpanReason
s
get :: BinHandle -> IO SrcSpan
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do RealSrcSpan
ss <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe BufSpan
sb <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
ss Maybe BufSpan
sb)
Word8
_ -> do UnhelpfulSpanReason
s <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
s)