@@ -4,7 +4,6 @@
44-- |
55-- Module : Data.Binary.Bits.Get
66-- Copyright : (c) Lennart Kolmodin 2010-2011
7−-- (c) Sylvain Henry 2015
87-- License : BSD3-style (see LICENSE)
98--
109-- Maintainer : kolmodin@gmail.com
@@ -60,19 +59,11 @@ module Data.Binary.Bits.Get
6059
6160 -- ** Get bytes
6261 , getBool
63− , getBool#
6462 , getWord8
65− , getWord16
66− , getWord32
67− , getWord64
6863 , getWord16be
6964 , getWord32be
7065 , getWord64be
7166
72− -- ** Skip bits
73− , skipBits
74− , alignByte
75−
7667 -- * Blocks
7768
7869 -- $blocks
@@ -82,9 +73,6 @@ module Data.Binary.Bits.Get
8273 -- ** Read in Blocks
8374 , bool
8475 , word8
85− , word16
86− , word32
87− , word64
8876 , word16be
8977 , word32be
9078 , word64be
@@ -95,28 +83,24 @@ module Data.Binary.Bits.Get
9583
9684 ) where
9785
98−import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
86+import Data.Binary.Get as B ( runGet, Get, getByteString, getLazyByteString, isEmpty )
9987import Data.Binary.Get.Internal as B ( get, put, ensureN )
100−import Data.Binary.Bits.BitOrder
101−import Data.Binary.Bits.Internal
102−import Data.Binary.Bits.Alignment
10388
10489import Data.ByteString as B
10590import qualified Data.ByteString.Lazy as L
10691import Data.ByteString.Unsafe
107−import Foreign.Marshal.Alloc (mallocBytes)
108−import Foreign.Ptr
109−import Foreign.Storable (poke)
110−import System.IO.Unsafe (unsafePerformIO)
11192
11293import Data.Bits
11394import Data.Word
11495import Control.Applicative
115−import Control.Monad (when,foldM_)
11696
11797import Prelude as P
98+
99+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
100+import GHC.Base
118101import GHC.Word
119−import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8#, (-#), Int#, xorI#, eqWord8#, TYPE)
102+#endif
103+
120104
121105-- $bitget
122106-- Parse bits using a monad.
@@ -165,120 +149,191 @@ import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8
165149-- @
166150
167151data S = S {-# UNPACK #-} !ByteString -- Input
168− {-# UNPACK #-} !Int -- Bit offset (0-7)
169− !BitOrder -- Bit order
152+ {-# UNPACK #-} !Int -- Bit offset (0-7)
170153 deriving (Show)
171154
172−-- | Increment the current bit offset
155+-- | A block that will be read with only one boundry check. Needs to know the
156+-- number of bits in advance.
157+data Block a = Block Int (S -> a)
158+
159+instance Functor Block where
160+ fmap f (Block i p) = Block i (\s -> f (p s))
161+
162+instance Applicative Block where
163+ pure a = Block 0 (\_ -> a)
164+ (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
165+ (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
166+ (Block i p) <* (Block j _) = Block (i+j) p
167+
168+-- | Get a block. Will be read with one single boundry check, and
169+-- therefore requires a statically known number of bits.
170+-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
171+-- 'byteString' and 'Applicative'.
172+block :: Block a -> BitGet a
173+block (Block i p) = do
174+ ensureBits i
175+ s <- getState
176+ putState $! (incS i s)
177+ return $! p s
178+
173179incS :: Int -> S -> S
174−incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
175− where
176− !o' = (n+o)
177− !d = byte_offset o'
178− !n' = bit_offset o'
180+incS o (S bs n) =
181+ let !o' = (n+o)
182+ !d = o' `shiftR` 3
183+ !n' = o' .&. make_mask 3
184+ in S (unsafeDrop d bs) n'
185+
186+-- | make_mask 3 = 00000111
187+make_mask :: (Bits a, Num a) => Int -> a
188+make_mask n = (1 `shiftL` fromIntegral n) - 1
189+{-# SPECIALIZE make_mask :: Int -> Int #-}
190+{-# SPECIALIZE make_mask :: Int -> Word #-}
191+{-# SPECIALIZE make_mask :: Int -> Word8 #-}
192+{-# SPECIALIZE make_mask :: Int -> Word16 #-}
193+{-# SPECIALIZE make_mask :: Int -> Word32 #-}
194+{-# SPECIALIZE make_mask :: Int -> Word64 #-}
195+
196+bit_offset :: Int -> Int
197+bit_offset n = make_mask 3 .&. n
198+
199+byte_offset :: Int -> Int
200+byte_offset n = n `shiftR` 3
179201
180−-- | Read a single bit
181202readBool :: S -> Bool
182−readBool (S bs o bo) = case bo of
183− BB -> testBit (unsafeHead bs) (7-o)
184− BL -> testBit (unsafeHead bs) (7-o)
185− LL -> testBit (unsafeHead bs) o
186− LB -> testBit (unsafeHead bs) o
187−
188−-- | Read a single bit
189−readBool# :: S -> Int
190−readBool# (S bs (I# o) bo) = case bo of
191− BB -> testBit# (7# -# o)
192− BL -> testBit# (7# -# o)
193− LL -> testBit# o
194− LB -> testBit# o
195− where
196− !(W8# w) = unsafeHead bs
197− testBit# n = I# (((w `andWord8#` (wordToWord8# 1## `uncheckedShiftLWord8#` n)) `eqWord8#` wordToWord8# 0##) `xorI#` 1#)
198−
199−
200−-- | Extract a range of bits from (ws :: ByteString)
201−--
202−-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
203−extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
204−extract bo bs o n
205− | n == 0 = 0
206− | B.length bs == 0 = error "Empty ByteString"
207− | otherwise = rev . mask n . foldlWithIndex' f 0 $ bs
208− where
209− -- B.foldl' with index
210− foldlWithIndex' op b = fst . B.foldl' g (b,0)
211− where g (b',i) w = (op b' w i, (i+1))
212−
213− -- 'or' correctly shifted words
214− f b w i = b .|. (fromIntegral w `fastShift` off i)
215−
216− -- co-offset
217− r = B.length bs * 8 - (o + n)
218−
219− -- shift offset depending on the byte position (0..B.length-1)
220− off i = case bo of
221− LL -> 8*i - o
222− LB -> 8*i - o
223− BB -> (B.length bs -1 - i) * 8 - r
224− BL -> (B.length bs -1 - i) * 8 - r
225−
226− -- reverse bits if necessary
227− rev = case bo of
228− LB -> reverseBits n
229− BL -> reverseBits n
230− BB -> id
231− LL -> id
232−
233−
234−-- | Generic readWord
235−readWord :: (Num a, FastBits a) => Int -> S -> a
236−readWord n (S bs o bo)
237− | n == 0 = 0
238− | otherwise = extract bo (unsafeTake nbytes bs) o n
239− where nbytes = byte_offset (o+n+7)
240−
241−-- | Check that the number of bits to read is not greater than the first parameter
242−{-# INLINE readWordChecked #-}
243−readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
244−readWordChecked m n s
245− | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
246− | otherwise = readWord n s
247−
248−-- | Read the given number of bytes and return them in Big-Endian order
249−--
250−-- Examples:
251−-- BB: xxxABCDE FGHIJKLM NOPxxxxx -> ABCDEFGH IJKLMNOP
252−-- LL: LMNOPxxx DEFGHIJK xxxxxABC -> ABCDEFGH IJKLMNOP
253−-- BL: xxxPONML KJIHGFED CBAxxxxx -> ABCDEFGH IJKLMNOP
254−-- LB: EDCBAxxx MLKJIHGF xxxxxPON -> ABCDEFGH IJKLMNOP
203+readBool (S bs n) = testBit (unsafeHead bs) (7-n)
204+
205+{-# INLINE readWord8 #-}
206+readWord8 :: Int -> S -> Word8
207+readWord8 n (S bs o)
208+ -- no bits at all, return 0
209+ | n == 0 = 0
210+
211+ -- all bits are in the same byte
212+ -- we just need to shift and mask them right
213+ | n <= 8 - o = let w = unsafeHead bs
214+ m = make_mask n
215+ w' = (w `shiftr_w8` (8 - o - n)) .&. m
216+ in w'
217+
218+ -- the bits are in two different bytes
219+ -- make a word16 using both bytes, and then shift and mask
220+ | n <= 8 = let w = (fromIntegral (unsafeHead bs) `shiftl_w16` 8) .|.
221+ (fromIntegral (unsafeIndex bs 1))
222+ m = make_mask n
223+ w' = (w `shiftr_w16` (16 - o - n)) .&. m
224+ in fromIntegral w'
225+
226+{-# INLINE readWord16be #-}
227+readWord16be :: Int -> S -> Word16
228+readWord16be n s@(S bs o)
229+
230+ -- 8 or fewer bits, use readWord8
231+ | n <= 8 = fromIntegral (readWord8 n s)
232+
233+ -- handle 9 or more bits, stored in two bytes
234+
235+ -- no offset, plain and simple 16 bytes
236+ | o == 0 && n == 16 = let msb = fromIntegral (unsafeHead bs)
237+ lsb = fromIntegral (unsafeIndex bs 1)
238+ w = (msb `shiftl_w16` 8) .|. lsb
239+ in w
240+
241+ -- no offset, but not full 16 bytes
242+ | o == 0 = let msb = fromIntegral (unsafeHead bs)
243+ lsb = fromIntegral (unsafeIndex bs 1)
244+ w = (msb `shiftl_w16` (n-8)) .|. (lsb `shiftr_w16` (16-n))
245+ in w
246+
247+ -- with offset, and n=9-16
248+ | n <= 16 = readWithOffset s shiftl_w16 shiftr_w16 n
249+
250+ | otherwise = error "readWord16be: tried to read more than 16 bits"
251+
252+{-# INLINE readWord32be #-}
253+readWord32be :: Int -> S -> Word32
254+readWord32be n s@(S _ o)
255+ -- 8 or fewer bits, use readWord8
256+ | n <= 8 = fromIntegral (readWord8 n s)
257+
258+ -- 16 or fewer bits, use readWord16be
259+ | n <= 16 = fromIntegral (readWord16be n s)
260+
261+ | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
262+
263+ | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
264+
265+ | otherwise = error "readWord32be: tried to read more than 32 bits"
266+
267+
268+{-# INLINE readWord64be #-}
269+readWord64be :: Int -> S -> Word64
270+readWord64be n s@(S _ o)
271+ -- 8 or fewer bits, use readWord8
272+ | n <= 8 = fromIntegral (readWord8 n s)
273+
274+ -- 16 or fewer bits, use readWord16be
275+ | n <= 16 = fromIntegral (readWord16be n s)
276+
277+ | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
278+
279+ | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
280+
281+ | otherwise = error "readWord64be: tried to read more than 64 bits"
282+
283+
255284readByteString :: Int -> S -> ByteString
256−readByteString n (S bs o bo) =
257− let
258− bs' = unsafeTake (n+1) bs
259− bs'' = unsafeTake n bs
260− rev = B.map (reverseBits 8)
261− in case (o,bo) of
262− (0,BB) -> bs''
263− (0,LL) -> B.reverse bs''
264− (0,LB) -> rev bs''
265− (0,BL) -> rev . B.reverse $ bs''
266− (_,LL) -> readByteString n (S (B.reverse bs') (8-o) BB)
267− (_,BL) -> rev . B.reverse $ readByteString n (S bs' o BB)
268− (_,LB) -> rev . B.reverse $ readByteString n (S bs' o LL)
269− (_,BB) -> unsafePerformIO $ do
270− let len = n+1
271− ptr <- mallocBytes len
272− let f r i = do
273− let
274− w = unsafeIndex bs (len-i)
275− w' = (w `fastShiftL` o) .|. r
276− r' = w `fastShiftR` (8-o)
277− poke (ptr `plusPtr` (len-i)) w'
278− return r'
279− foldM_ f 0 [1..len]
280− unsafeInit <$> unsafePackMallocCStringLen (ptr,len)
285+readByteString n s@(S bs o)
286+ -- no offset, easy.
287+ | o == 0 = unsafeTake n bs
288+ -- offset. ugg. this is really naive and slow. but also pretty easy :)
289+ | otherwise = B.pack (P.map (readWord8 8) (P.take n (iterate (incS 8) s)))
290+
291+readWithoutOffset :: (Bits a, Num a)
292+ => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
293+readWithoutOffset (S bs o) shifterL shifterR n
294+ | o /= 0 = error "readWithoutOffset: there is an offset"
295+
296+ | bit_offset n == 0 && byte_offset n <= 4 =
297+ let segs = byte_offset n
298+ bn 0 = fromIntegral (unsafeHead bs)
299+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
300+
301+ in bn (segs-1)
302+
303+ | n <= 64 = let segs = byte_offset n
304+ o' = bit_offset (n - 8 + o)
305+
306+ bn 0 = fromIntegral (unsafeHead bs)
307+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
308+
309+ msegs = bn (segs-1) `shifterL` o'
310+
311+ last = (fromIntegral (unsafeIndex bs segs)) `shifterR` (8 - o')
281312
313+ w = msegs .|. last
314+ in w
315+
316+readWithOffset :: (Bits a, Num a)
317+ => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
318+readWithOffset (S bs o) shifterL shifterR n
319+ | n <= 64 = let bits_in_msb = 8 - o
320+ (n',top) = (n - bits_in_msb
321+ , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shifterL` n')
322+
323+ segs = byte_offset n'
324+
325+ bn 0 = 0
326+ bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
327+
328+ o' = bit_offset n'
329+
330+ mseg = bn segs `shifterL` o'
331+
332+ last | o' > 0 = (fromIntegral (unsafeIndex bs (segs + 1))) `shifterR` (8 - o')
333+ | otherwise = 0
334+
335+ w = top .|. mseg .|. last
336+ in w
282337
283338------------------------------------------------------------------------
284339-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'
@@ -287,6 +342,7 @@ newtype BitGet a = B { runState :: S -> Get (S,a) }
287342
288343instance Monad BitGet where
289344 return x = B $ \s -> return (s,x)
345+ fail str = B $ \(S inp n) -> putBackState inp n >> fail str
290346 (B f) >>= g = B $ \s -> do (s',a) <- f s
291347 runState (g a) s'
292348
@@ -297,51 +353,25 @@ instance Applicative BitGet where
297353 pure x = return x
298354 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
299355
300−instance BitOrderable BitGet where
301− setBitOrder bo = do
302− (S bs o _) <- getState
303− putState (S bs o bo)
304−
305− getBitOrder = do
306− (S _ _ bo) <- getState
307− return bo
308−
309−instance Alignable BitGet where
310− -- | Skip the given number of bits
311− skipBits n = do
312− ensureBits n
313− withState (incS n)
314−
315− -- | Skip bits if necessary to align to the next byte
316− alignByte = do
317− (S _ o _) <- getState
318− when (o /= 0) $
319− skipBits (8-o)
320−
321−
322−
323356-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
324357-- been partially consumed it will be discarded once 'runBitGet' is finished.
325358runBitGet :: BitGet a -> Get a
326359runBitGet bg = do
327360 s <- mkInitState
328− (s',a) <- runState bg s
329− putBackState s'
361+ ((S str' n),a) <- runState bg s
362+ putBackState str' n
330363 return a
331364
332365mkInitState :: Get S
333366mkInitState = do
334− bs <- get
367+ str <- get
335368 put B.empty
336− return (S bs 0 BB)
369+ return (S str 0)
337370
338−putBackState :: S -> Get ()
339−putBackState (S bs o _) = do
371+putBackState :: B.ByteString -> Int -> Get ()
372+putBackState bs n = do
340373 remaining <- get
341− let bs' = case o of
342− 0 -> bs
343− _ -> unsafeDrop 1 bs
344− put (bs' `B.append` remaining)
374+ put (B.drop (if n==0 then 0 else 1) bs `B.append` remaining)
345375
346376getState :: BitGet S
347377getState = B $ \s -> return (s,s)
@@ -349,66 +379,38 @@ getState = B $ \s -> return (s,s)
349379putState :: S -> BitGet ()
350380putState s = B $ \_ -> return (s,())
351381
352−withState :: (S -> S) -> BitGet ()
353−withState f = do
354− s <- getState
355− putState $! f s
356−
357382-- | Make sure there are at least @n@ bits.
358383ensureBits :: Int -> BitGet ()
359384ensureBits n = do
360− (S bs o bo) <- getState
385+ (S bs o) <- getState
361386 if n <= (B.length bs * 8 - o)
362387 then return ()
363388 else do let currentBits = B.length bs * 8 - o
364− let byteCount = byte_offset (n - currentBits + 7)
389+ let byteCount = (n - currentBits + 7) `div` 8
365390 B $ \_ -> do B.ensureN byteCount
366391 bs' <- B.get
367392 put B.empty
368− return (S (bs`append`bs') o bo, ())
369−
370−-- | Test whether all input has been consumed, i.e. there are no remaining
371−-- undecoded bytes.
372−isEmpty :: BitGet Bool
373−isEmpty = B $ \ (S bs o bo) -> if B.null bs
374− then B.isEmpty >>= \e -> return (S bs o bo, e)
375− else return (S bs o bo, False)
393+ return (S (bs`append`bs') o, ())
376394
377395-- | Get 1 bit as a 'Bool'.
378396getBool :: BitGet Bool
379397getBool = block bool
380398
381−-- | Get 1 bit as a 'Bool'.
382−getBool# :: BitGet Int
383−getBool# = block bool#
384−
385399-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
386400getWord8 :: Int -> BitGet Word8
387401getWord8 n = block (word8 n)
388402
389403-- | Get @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
390−getWord16 :: Int -> BitGet Word16
391−getWord16 n = block (word16 n)
392−
393404getWord16be :: Int -> BitGet Word16
394−getWord16be = getWord16
395−{-# DEPRECATED getWord16be "Use 'getWord16' instead" #-}
405+getWord16be n = block (word16be n)
396406
397407-- | Get @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
398−getWord32 :: Int -> BitGet Word32
399−getWord32 n = block (word32 n)
400−
401408getWord32be :: Int -> BitGet Word32
402−getWord32be = getWord32
403−{-# DEPRECATED getWord32be "Use 'getWord32' instead" #-}
409+getWord32be n = block (word32be n)
404410
405411-- | Get @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
406−getWord64 :: Int -> BitGet Word64
407−getWord64 n = block (word64 n)
408−
409412getWord64be :: Int -> BitGet Word64
410−getWord64be = getWord64
411−{-# DEPRECATED getWord64be "Use 'getWord64' instead" #-}
413+getWord64be n = block (word64be n)
412414
413415-- | Get @n@ bytes as a 'ByteString'.
414416getByteString :: Int -> BitGet ByteString
@@ -417,80 +419,86 @@ getByteString n = block (byteString n)
417419-- | Get @n@ bytes as a lazy ByteString.
418420getLazyByteString :: Int -> BitGet L.ByteString
419421getLazyByteString n = do
420− (S _ o bo) <- getState
422+ (S _ o) <- getState
421423 case o of
422− 0 -> B $ \s -> do
423− putBackState s
424+ 0 -> B $ \ (S bs o') -> do
425+ putBackState bs o'
424426 lbs <- B.getLazyByteString (fromIntegral n)
425− return (S B.empty 0 bo, lbs)
427+ return (S B.empty 0, lbs)
426428 _ -> L.fromChunks . (:[]) <$> Data.Binary.Bits.Get.getByteString n
427429
428−
429−
430−
431−
432−-- | A block that will be read with only one boundary check. Needs to know the
433−-- number of bits in advance.
434−data Block a = Block Int (S -> a)
435−
436−instance Functor Block where
437− fmap f (Block i p) = Block i (\s -> f (p s))
438−
439−instance Applicative Block where
440− pure a = Block 0 (\_ -> a)
441− (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
442− (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
443− (Block i p) <* (Block j _) = Block (i+j) p
444−
445−-- | Get a block. Will be read with one single boundry check, and
446−-- therefore requires a statically known number of bits.
447−-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
448−-- 'byteString' and 'Applicative'.
449−block :: Block a -> BitGet a
450−block (Block i p) = do
451− ensureBits i
452− s <- getState
453− putState $! (incS i s)
454− return $! p s
430+-- | Test whether all input has been consumed, i.e. there are no remaining
431+-- undecoded bytes.
432+isEmpty :: BitGet Bool
433+isEmpty = B $ \ (S bs o) -> B.isEmpty >>= \e -> return (S bs o, e)
455434
456435-- | Read a 1 bit 'Bool'.
457436bool :: Block Bool
458437bool = Block 1 readBool
459438
460−-- | Read a 1 bit 'Bool'.
461−bool# :: Block Int
462−bool# = Block 1 readBool#
463−
464439-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
465440word8 :: Int -> Block Word8
466−word8 n = Block n (readWordChecked 8 n)
441+word8 n = Block n (readWord8 n)
467442
468443-- | Read @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
469−word16 :: Int -> Block Word16
470−word16 n = Block n (readWordChecked 16 n)
471−
472444word16be :: Int -> Block Word16
473−word16be = word16
474−{-# DEPRECATED word16be "Use 'word16' instead" #-}
445+word16be n = Block n (readWord16be n)
475446
476447-- | Read @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
477−word32 :: Int -> Block Word32
478−word32 n = Block n (readWordChecked 32 n)
479−
480448word32be :: Int -> Block Word32
481−word32be = word32
482−{-# DEPRECATED word32be "Use 'word32' instead" #-}
449+word32be n = Block n (readWord32be n)
483450
484451-- | Read @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
485−word64 :: Int -> Block Word64
486−word64 n = Block n (readWordChecked 64 n)
487−
488452word64be :: Int -> Block Word64
489−word64be = word64
490−{-# DEPRECATED word64be "Use 'word64' instead" #-}
453+word64be n = Block n (readWord64be n)
491454
492455-- | Read @n@ bytes as a 'ByteString'.
493456byteString :: Int -> Block ByteString
494457byteString n | n > 0 = Block (n*8) (readByteString n)
495458 | otherwise = Block 0 (\_ -> B.empty)
496459
460+------------------------------------------------------------------------
461+-- Unchecked shifts, from the package binary
462+
463+shiftl_w16 :: Word16 -> Int -> Word16
464+shiftl_w32 :: Word32 -> Int -> Word32
465+shiftl_w64 :: Word64 -> Int -> Word64
466+
467+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
468+shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
469+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
470+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
471+
472+shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
473+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
474+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
475+
476+
477+#if WORD_SIZE_IN_BITS < 64
478+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
479+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
480+
481+#if __GLASGOW_HASKELL__ <= 606
482+-- Exported by GHC.Word in GHC 6.8 and higher
483+foreign import ccall unsafe "stg_uncheckedShiftL64"
484+ uncheckedShiftL64# :: Word64# -> Int# -> Word64#
485+foreign import ccall unsafe "stg_uncheckedShiftRL64"
486+ uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
487+#endif
488+
489+#else
490+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
491+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
492+#endif
493+
494+#else
495+shiftl_w8 = shiftL
496+shiftl_w16 = shiftL
497+shiftl_w32 = shiftL
498+shiftl_w64 = shiftL
499+
500+shiftr_w8 = shiftR
501+shiftr_w16 = shiftR
502+shiftr_w32 = shiftR
503+shiftr_w64 = shiftR
504+#endif