{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables       #-}
-- |Strict Decoder Primitives
module Flat.Decoder.Prim (
    dBool,
    dWord8,
    dBE8,
    dBE16,
    dBE32,
    dBE64,
    dBEBits8,
    dBEBits16,
    dBEBits32,
    dBEBits64,
    dropBits,
    dFloat,
    dDouble,
    getChunksInfo,
    dByteString_,
    dLazyByteString_,
    dByteArray_,

    ConsState(..),consOpen,consClose,consBool,consBits
    ) where

import           Control.Monad
import qualified Data.ByteString         as B
import qualified Data.ByteString.Lazy    as L
import           Flat.Decoder.Types
import           Flat.Endian
import           Flat.Memory
import           Data.FloatCast
import           Data.Word
import           Foreign

-- $setup
-- >>> :set -XBinaryLiterals
-- >>> import Data.Word
-- >>> import Data.Int
-- >>> import Flat.Run

{- |A special state, optimised for constructor decoding.

It consists of:

* The bits to parse, the top bit being the first to parse (could use a Word16 instead, no difference in performance)

* The number of decoded bits

Supports up to 512 constructors (9 bits).
-}
data ConsState =
  ConsState {-# UNPACK #-} !Word !Int

-- |Switch to constructor decoding
-- {-# INLINE consOpen  #-}
consOpen :: Get ConsState
consOpen :: Get ConsState
consOpen = (Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState)
-> (Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  let u :: Int
u = S -> Int
usedBits S
s
  Word
w <- case Ptr Word8 -> Ptr Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (S -> Ptr Word8
currPtr S
s) Ptr Word8
endPtr of
    Ordering
LT -> do -- two different bytes
      Word16
w16::Word16 <- Word16 -> Word16
toBE16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
      Word -> IO Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> IO Word) -> Word -> IO Word
forall a b. (a -> b) -> a -> b
$ Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w16 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
wordSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16))
    Ordering
EQ -> do
        Word8
w8 :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
        Word -> IO Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> IO Word) -> Word -> IO Word
forall a b. (a -> b) -> a -> b
$ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
wordSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8))
    Ordering
GT -> Ptr Word8 -> S -> IO Word
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
  GetResult ConsState -> IO (GetResult ConsState)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult ConsState -> IO (GetResult ConsState))
-> GetResult ConsState -> IO (GetResult ConsState)
forall a b. (a -> b) -> a -> b
$ S -> ConsState -> GetResult ConsState
forall a. S -> a -> GetResult a
GetResult S
s (Word -> Int -> ConsState
ConsState Word
w Int
0)

-- |Switch back to normal decoding
-- {-# NOINLINE consClose  #-}
consClose :: Int -> Get ()
consClose :: Int -> Get ()
consClose Int
n =  (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ())) -> Get ())
-> (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  let u' :: Int
u' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+S -> Int
usedBits S
s
  if Int
u' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
     then GetResult () -> IO (GetResult ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S
s {usedBits :: Int
usedBits=Int
u'}) ()
     else if S -> Ptr Word8
currPtr S
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
            then Ptr Word8 -> S -> IO (GetResult ())
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
          else GetResult () -> IO (GetResult ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,usedBits :: Int
usedBits=Int
u'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8}) ()

  {- ensureBits endPtr s n = when ((endPtr `minusPtr` currPtr s) * 8 - usedBits s < n) $ notEnoughSpace endPtr s
  dropBits8 s n =
    let u' = n+usedBits s
    in if u' < 8
        then s {usedBits=u'}
        else s {currPtr=currPtr s `plusPtr` 1,usedBits=u'-8}
  -}

  --ensureBits endPtr s n
  --return $ GetResult (dropBits8 s n) ()

-- |Decode a single bit
consBool :: ConsState -> (ConsState,Bool)
consBool :: ConsState -> (ConsState, Bool)
consBool ConsState
cs =  (Word
0Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Word -> Bool) -> (ConsState, Word) -> (ConsState, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Int -> (ConsState, Word)
consBits ConsState
cs Int
1

-- consBool (ConsState w usedBits) = (ConsState (w `unsafeShiftL` 1) (1+usedBits),0 /= 32768 .&. w)

-- |Decode from 1 to 3 bits
-- 
-- It could read more bits that are available, but it doesn't matter, errors will be checked in consClose.
consBits :: ConsState -> Int -> (ConsState, Word)
consBits :: ConsState -> Int -> (ConsState, Word)
consBits ConsState
cs Int
3 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
3 Word
7
consBits ConsState
cs Int
2 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
2 Word
3
consBits ConsState
cs Int
1 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
1 Word
1
consBits ConsState
_  Int
_ = [Char] -> (ConsState, Word)
forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"

consBits_ :: ConsState -> Int -> Word -> (ConsState, Word)

-- Different decoding primitives
-- All with equivalent performance
-- #define CONS_ROT
-- #define CONS_SHL
#define CONS_STA

#ifdef CONS_ROT
consBits_ (ConsState w usedBits) numBits mask =
  let usedBits' = numBits+usedBits
      w' = w `rotateL` numBits -- compiles to an or+shiftl+shiftr
  in (ConsState w' usedBits',w' .&. mask)
#endif

#ifdef CONS_SHL
consBits_ (ConsState w usedBits) numBits mask =
  let usedBits' = numBits+usedBits
      w' = w `unsafeShiftL` numBits
  in (ConsState w' usedBits', (w `shR` (wordSize - numBits)) .&. mask)
#endif

#ifdef CONS_STA
consBits_ :: ConsState -> Int -> Word -> (ConsState, Word)
consBits_ (ConsState Word
w Int
usedBits) Int
numBits Word
mask =
  let usedBits' :: Int
usedBits' = Int
numBitsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
usedBits
  in (Word -> Int -> ConsState
ConsState Word
w Int
usedBits', (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shR` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
usedBits')) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
mask)
#endif

wordSize :: Int
wordSize :: Int
wordSize = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)

{-# INLINE ensureBits #-}
-- |Ensure that the specified number of bits is available
ensureBits :: Ptr Word8 -> S -> Int -> IO ()
ensureBits :: Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Ptr Word8
endPtr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> S -> IO ()
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s

{-# INLINE dropBits #-}
-- |Drop the specified number of bits
dropBits :: Int -> Get ()
dropBits :: Int -> Get ()
dropBits Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ())) -> Get ())
-> (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
      GetResult () -> IO (GetResult ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits_ S
s Int
n) ()
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = [Char] -> Get ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Get ()) -> [Char] -> Get ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"dropBits",Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n]

{-# INLINE dropBits_ #-}
dropBits_ :: S -> Int -> S
dropBits_ :: S -> Int -> S
dropBits_ S
s Int
n =
  let (Int
bytes,Int
bits) = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+S -> Int
usedBits S
s) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
  -- let
  --   n' = n+usedBits s
  --   bytes = n' `shR` 3
  --   bits = n' .|. 7
  in S :: Ptr Word8 -> Int -> S
S {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytes,usedBits :: Int
usedBits=Int
bits}

{-# INLINE dBool #-} 
-- Inlining dBool massively increases compilation time and decreases run time by a third
-- TODO: test dBool inlining for ghc >= 8.8.4
-- |Decode a boolean
dBool :: Get Bool
dBool :: Get Bool
dBool = (Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool)
-> (Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s ->
  if S -> Ptr Word8
currPtr S
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
    then Ptr Word8 -> S -> IO (GetResult Bool)
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
    else do
      !Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
      let !b :: Bool
b = Word8
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
128 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` S -> Int
usedBits S
s))
      let !s' :: S
s' = if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7
                  then S
s { currPtr :: Ptr Word8
currPtr = S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1, usedBits :: Int
usedBits = Int
0 }
                  else S
s { usedBits :: Int
usedBits = S -> Int
usedBits S
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
      GetResult Bool -> IO (GetResult Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Bool -> IO (GetResult Bool))
-> GetResult Bool -> IO (GetResult Bool)
forall a b. (a -> b) -> a -> b
$ S -> Bool -> GetResult Bool
forall a. S -> a -> GetResult a
GetResult S
s' Bool
b


{-# INLINE dBEBits8  #-}
{- | Return the n most significant bits (up to maximum of 8)

The bits are returned right shifted:
>>> unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111
True
-}
dBEBits8 :: Int -> Get Word8
dBEBits8 :: Int -> Get Word8
dBEBits8 Int
n = (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8)
-> (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
      S -> Int -> IO (GetResult Word8)
take8 S
s Int
n

{-# INLINE dBEBits16  #-}
-- |Return the n most significant bits (up to maximum of 16)
-- The bits are returned right shifted.
dBEBits16 :: Int -> Get Word16
dBEBits16 :: Int -> Get Word16
dBEBits16 Int
n = (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16)
-> (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
      Int -> S -> IO (GetResult Word16)
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s

{-# INLINE dBEBits32  #-}
-- |Return the n most significant bits (up to maximum of 32)
-- The bits are returned right shifted.
dBEBits32 :: Int -> Get Word32
dBEBits32 :: Int -> Get Word32
dBEBits32 Int
n = (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32)
-> (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
      Int -> S -> IO (GetResult Word32)
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s

{-# INLINE dBEBits64  #-}
-- |Return the n most significant bits (up to maximum of 64)
-- The bits are returned right shifted.
dBEBits64 :: Int -> Get Word64
dBEBits64 :: Int -> Get Word64
dBEBits64 Int
n = (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64)
-> (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
      Int -> S -> IO (GetResult Word64)
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s

-- {-# INLINE take8 #-}
-- take8 :: Int -> S -> IO (GetResult Word8)
-- take8 n s
--   | n == 0 = return $ GetResult s 0

--   -- all bits in the same byte
--   | n <= 8 - usedBits s = do
--       w <- peek (currPtr s)
--       let (bytes,bits) = (n+usedBits s) `divMod` 8
--       return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) ((w `unsafeShiftL` usedBits s) `shR` (8 - n))

--   -- two different bytes
--   | n <= 8 = do
--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)
--       return $ GetResult (S {currPtr=currPtr s `plusPtr` 1,usedBits=(usedBits s + n) `mod` 8}) (fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n))

--   | otherwise = error $ unwords ["take8: cannot take",show n,"bits"]

{-# INLINE take8 #-}
take8 :: S -> Int -> IO (GetResult Word8)
-- take8 s n = GetResult (dropBits_ s n) <$> read8 s n
take8 :: S -> Int -> IO (GetResult Word8)
take8 S
s Int
n = S -> Word8 -> GetResult Word8
forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits8 S
s Int
n) (Word8 -> GetResult Word8) -> IO Word8 -> IO (GetResult Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> S -> Int -> IO Word8
read8 S
s Int
n
  where
    --{-# INLINE read8 #-}
    read8 :: S -> Int -> IO Word8
    read8 :: S -> Int -> IO Word8
read8 S
s Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
8 =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s
            then do  -- all bits in the same byte
              Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
              Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            else do -- two different bytes
              Word16
w::Word16 <- Word16 -> Word16
toBE16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
              Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shR` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
          | Bool
otherwise = [Char] -> IO Word8
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO Word8) -> [Char] -> IO Word8
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"read8: cannot read",Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n,[Char]
"bits"]
    -- {-# INLINE dropBits8 #-}
    -- -- Assume n <= 8
    dropBits8 :: S -> Int -> S
    dropBits8 :: S -> Int -> S
dropBits8 S
s Int
n =
      let u' :: Int
u' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+S -> Int
usedBits S
s
      in if Int
u' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
          then S
s {usedBits :: Int
usedBits=Int
u'}
          else S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,usedBits :: Int
usedBits=Int
u'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8}


{-# INLINE takeN #-}
takeN :: (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN :: Int -> S -> IO (GetResult a)
takeN Int
n S
s = S -> a -> Int -> Int -> IO (GetResult a)
forall t.
(Bits t, Num t) =>
S -> t -> Int -> Int -> IO (GetResult t)
read S
s a
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
8)) Int
n
   where
     read :: S -> t -> Int -> Int -> IO (GetResult t)
read S
s t
r Int
sh Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 = GetResult t -> IO (GetResult t)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult t -> IO (GetResult t))
-> GetResult t -> IO (GetResult t)
forall a b. (a -> b) -> a -> b
$ S -> t -> GetResult t
forall a. S -> a -> GetResult a
GetResult S
s t
r
                   | Bool
otherwise = do
                     let m :: Int
m = Int
n Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
8
                     GetResult S
s' Word8
b <- S -> Int -> IO (GetResult Word8)
take8 S
s Int
m
                     S -> t -> Int -> Int -> IO (GetResult t)
read S
s' (t
r t -> t -> t
forall a. Bits a => a -> a -> a
.|. (Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)) ((Int
shInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8)

-- takeN n = Get $ \endPtr s -> do
--   ensureBits endPtr s n
--   let (bytes,bits) = (n+usedBits s) `divMod` 8
--   r <- case bytes of
--     0 -> do
--       w <- peek (currPtr s)
--       return . fromIntegral $ ((w `unsafeShiftL` usedBits s) `shR` (8 - n))
--     1 -> do
--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)
--       return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n)
--     2 -> do
--       let r = 0
--       w1 <- fromIntegral <$> r8 s
--       w2 <- fromIntegral <$> r16 s
--       w1
--   return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) r

-- r8 s = peek (currPtr s)
-- r16 s = toBE16 <$> peek (castPtr $ currPtr s)

-- |Return the 8 most significant bits (same as dBE8)
dWord8 :: Get Word8
dWord8 :: Get Word8
dWord8 = Get Word8
dBE8

{-# INLINE dBE8  #-}
-- |Return the 8 most significant bits
dBE8 :: Get Word8
dBE8 :: Get Word8
dBE8 = (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8)
-> (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
      Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
8
      !Word8
w1 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
      !Word8
w <- if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w1
            else do
                   !Word8
w2 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                   Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ (Word8
w1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
      GetResult Word8 -> IO (GetResult Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word8 -> IO (GetResult Word8))
-> GetResult Word8 -> IO (GetResult Word8)
forall a b. (a -> b) -> a -> b
$ S -> Word8 -> GetResult Word8
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1}) Word8
w

{-# INLINE dBE16 #-}
-- |Return the 16 most significant bits
dBE16 :: Get Word16
dBE16 :: Get Word16
dBE16 = (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16)
-> (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
16
  !Word16
w1 <- Word16 -> Word16
toBE16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word16
w <- if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w1
        else do
           !(Word8
w2::Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
           Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> IO Word16) -> Word16 -> IO Word16
forall a b. (a -> b) -> a -> b
$ Word16
w1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s  Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
  GetResult Word16 -> IO (GetResult Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word16 -> IO (GetResult Word16))
-> GetResult Word16 -> IO (GetResult Word16)
forall a b. (a -> b) -> a -> b
$ S -> Word16 -> GetResult Word16
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2}) Word16
w

{-# INLINE dBE32 #-}
-- |Return the 32 most significant bits
dBE32 :: Get Word32
dBE32 :: Get Word32
dBE32 = (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32)
-> (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
32
  !Word32
w1 <- Word32 -> Word32
toBE32 (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word32) -> Ptr Word8 -> Ptr Word32
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word32
w <- if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w1
        else do
           !(Word8
w2::Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
           Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
  GetResult Word32 -> IO (GetResult Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word32 -> IO (GetResult Word32))
-> GetResult Word32 -> IO (GetResult Word32)
forall a b. (a -> b) -> a -> b
$ S -> Word32 -> GetResult Word32
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4}) Word32
w

{-# INLINE dBE64 #-}
-- |Return the 64 most significant bits
dBE64 :: Get Word64
dBE64 :: Get Word64
dBE64 = (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64)
-> (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
64
  -- !w1 <- toBE64 <$> peek (castPtr $ currPtr s)
  !Word64
w1 <- Word64 -> Word64
toBE64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
peek64 (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word64) -> Ptr Word8 -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word64
w <- if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w1
        else do
           !(Word8
w2::Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
           Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64
w1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shR` (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
  GetResult Word64 -> IO (GetResult Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word64 -> IO (GetResult Word64))
-> GetResult Word64 -> IO (GetResult Word64)
forall a b. (a -> b) -> a -> b
$ S -> Word64 -> GetResult Word64
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8}) Word64
w
    where
      -- {-# INLINE peek64 #-}
      peek64 :: Ptr Word64 -> IO Word64
      peek64 :: Ptr Word64 -> IO Word64
peek64 = Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek
      -- peek64 ptr = fix64 <$> peek ptr

{-# INLINE dFloat #-}
-- |Decode a Float
dFloat :: Get Float
dFloat :: Get Float
dFloat = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
dBE32

{-# INLINE dDouble #-}
-- |Decode a Double
dDouble :: Get Double
dDouble :: Get Double
dDouble = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
dBE64

-- |Decode a Lazy ByteString
dLazyByteString_ :: Get L.ByteString
dLazyByteString_ :: Get ByteString
dLazyByteString_ = ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
dByteString_

-- |Decode a ByteString
dByteString_ :: Get B.ByteString
dByteString_ :: Get ByteString
dByteString_ = (Ptr Word8, [Int]) -> ByteString
chunksToByteString ((Ptr Word8, [Int]) -> ByteString)
-> Get (Ptr Word8, [Int]) -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Ptr Word8, [Int])
getChunksInfo

-- |Decode a ByteArray and its length
dByteArray_ :: Get (ByteArray,Int)
dByteArray_ :: Get (ByteArray, Int)
dByteArray_ = (Ptr Word8, [Int]) -> (ByteArray, Int)
chunksToByteArray ((Ptr Word8, [Int]) -> (ByteArray, Int))
-> Get (Ptr Word8, [Int]) -> Get (ByteArray, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Ptr Word8, [Int])
getChunksInfo

-- |Decode an Array (a list of chunks up to 255 bytes long) returning the pointer to the first data byte and a list of chunk sizes
getChunksInfo :: Get (Ptr Word8, [Int])
getChunksInfo :: Get (Ptr Word8, [Int])
getChunksInfo = (Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
-> Get (Ptr Word8, [Int])
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
 -> Get (Ptr Word8, [Int]))
-> (Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
-> Get (Ptr Word8, [Int])
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do

   let getChunks :: Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks Ptr b
srcPtr [Int] -> c
l = do
          Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
8
          !Int
n <- b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Int) -> IO b -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
srcPtr
          if Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0
            then (Ptr b, c) -> IO (Ptr b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b
srcPtr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,[Int] -> c
l [])
            else do
              Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s ((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8)
              Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (Ptr b
srcPtr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) ([Int] -> c
l ([Int] -> c) -> ([Int] -> [Int]) -> [Int] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
nInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) -- ETA: stack overflow (missing tail call optimisation)

   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> S -> [Char] -> IO ()
forall a. Ptr Word8 -> S -> [Char] -> IO a
badEncoding Ptr Word8
endPtr S
s [Char]
"usedBits /= 0"
   (Ptr Word8
currPtr',[Int]
ns) <- Ptr Word8 -> ([Int] -> [Int]) -> IO (Ptr Word8, [Int])
forall b c b.
(Integral b, Storable b) =>
Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (S -> Ptr Word8
currPtr S
s) [Int] -> [Int]
forall a. a -> a
id
   GetResult (Ptr Word8, [Int]) -> IO (GetResult (Ptr Word8, [Int]))
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult (Ptr Word8, [Int]) -> IO (GetResult (Ptr Word8, [Int])))
-> GetResult (Ptr Word8, [Int])
-> IO (GetResult (Ptr Word8, [Int]))
forall a b. (a -> b) -> a -> b
$ S -> (Ptr Word8, [Int]) -> GetResult (Ptr Word8, [Int])
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=Ptr Word8
currPtr'}) (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,[Int]
ns)

-- Fix for ghcjs bug:  https://github.com/ghcjs/ghcjs/issues/706
-- TODO: verify if actually needed here and if also needed in encoder
-- {- |
-- Shift right with sign extension.

-- >>> shR (0b1111111111111111::Word16) 3 == 0b0001111111111111
-- True

-- >>> shR (-1::Int16) 3 
-- -1
-- -}  
{-# INLINE shR #-}
shR :: Bits a => a -> Int -> a
#ifdef ghcjs_HOST_OS
shR val 0 = val
shR val n = shift val (-n)
#else
shR :: a -> Int -> a
shR = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR
#endif